Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

grayscale MDIChild form when it becomes inactive

Posted on 2004-04-05
11
Medium Priority
?
326 Views
Last Modified: 2010-04-05
Hello,

I have an application with many MDIChild forms.  I would like that these forms become grayscaled (a bit like XP desktop before closing Windows) when inactive.  Only the active form will remain colored.

is it possible ?
0
Comment
Question by:fadyg
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 3
  • 2
11 Comments
 
LVL 12

Expert Comment

by:esoftbg
ID: 10759309
for all Child forms:

procedure TForm2.FormActivate(Sender: TObject);
begin
  Color := clBtnFace;
end;

procedure TForm2.FormDeactivate(Sender: TObject);
begin
  Color := clInactiveBorder
end;

emil
0
 
LVL 12

Expert Comment

by:esoftbg
ID: 10759723
procedure TForm2.FormActivate(Sender: TObject);
begin
  Color := clBtnFace;
  Memo1.Color := clWindow;
  Memo1.Font.Color := clWindowText;
end;

procedure TForm2.FormDeactivate(Sender: TObject);
begin
  Color := clInactiveBorder;
  Memo1.Color := clScrollBar;
  Memo1.Font.Color := clGrayText;
end;
0
 

Author Comment

by:fadyg
ID: 10760385
This is not what I meant:  

What is needed is that all the form appears in grayscale (even images on it) as if a colored photo is turned into grayscale.

0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 11

Expert Comment

by:ZhaawZ
ID: 10761132
It could be something like this:

unit Unit1;

interface

uses
  Windows, Classes, Forms, Graphics;

type
  TForm1 = class(TForm)
    procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  GrayBMP : TBitmap;

implementation

{$R *.dfm}

procedure TForm1.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
type
  TLine = array [0..32767] of TRGBTriple;
  PLine = ^TLine;
var
  l : PLine;
  w, h : integer;
begin
if msg.message = 45057 then begin
  GrayBMP := Form1.GetFormImage;
  GrayBMP.PixelFormat := pf24bit;
  for h := 0 to GrayBMP.Height - 1 do begin
    l := GrayBMP.ScanLine[h];
    for w := 0 to GrayBMP.Width - 1 do with l[w] do begin
      rgbtRed := (rgbtRed + rgbtGreen + rgbtBlue) div 3;
      rgbtGreen := rgbtRed;
      rgbtBlue := rgbtRed;
    end;
  end;
  msg.message := 15;
end else if msg.message = 45056 then Form1.Refresh;
if (Msg.message = 15) and not Form1.Active then Canvas.Draw(0,0,GrayBMP);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := ApplicationEventsMessage;
end;
0
 
LVL 12

Expert Comment

by:esoftbg
ID: 10763426
unit Unit_Child;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

const
  First_Child = 1;
  Last_Child = 8;

type
  TPaintMode = (pmColorful, pmGrayScale);
  TForm2 = class(TForm)
    Memo1: TMemo;
    Image1: TImage;
    procedure FormActivate(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private { Private declarations }
    PaintMode:TPaintMode;
  public  { Public declarations }
  end;

var
  Form_2_arr: array[First_Child..Last_Child] of TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormActivate(Sender: TObject);
var
  I:      Integer;
begin
  PaintMode := pmColorful;
  with Parent do
    for I := MDIChildCount-1 downto 0 do
      MDIChildren[I].Repaint;
  for I := 0 to ComponentCount-1 do
    if (Components[I] is TWinControl) then
      (Components[I] as TWinControl).Repaint;
  Repaint;
end;

procedure TForm2.FormDeactivate(Sender: TObject);
var
  I:      Integer;
begin
  PaintMode := pmGrayScale;
  with Parent do
    for I := MDIChildCount-1 downto 0 do
      MDIChildren[I].Repaint;
  Repaint;
end;

procedure TForm2.FormPaint(Sender: TObject);
var
  FmDc:   HDC;
begin
  if (PaintMode=pmGrayScale) then
  begin
    FmDc := GetWindowDC(Self.Handle);
    SelectObject(FmDc, GetStockObject(GRAY_BRUSH));
    PatBlt(FmDc, 0, 0, Width,Height,$A000C9);
    ReleaseDC(Self.Handle, FmDc);
  end;
end;

var
  I:      Integer;
initialization

for I := First_Child to Last_Child do
  Form_2_arr[I] := nil;

end.
0
 

Author Comment

by:fadyg
ID: 10763831
The solution of esoftbg darkens the form but does not convert it to grayscale

The solution of ZhaawZ seems to be a good one BUT: the controls are being re-drawn over their grayscale image, thus effect is lost.  The only way I could decide it was the beginning of good solution is by changing the Canvas.Draw(0,0,GrayBMP) to Canvas.Draw(10,10,GrayBMP) (i.e shifted) and see that controls are being painted in grayscale,  but then overriden by the redraw of real controls themselves.

so ZhaawZ, any solution for that ?
0
 
LVL 11

Accepted Solution

by:
ZhaawZ earned 1400 total points
ID: 10764036
Could be done like this:

unit Unit1;

interface

uses
  Windows, Classes, Forms, Graphics, Controls, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  GrayImg : TImage;
  GrayPnl : TPanel;

implementation

{$R *.dfm}

procedure TForm1.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
type
  TLine = array [0..32767] of TRGBTriple;
  PLine = ^TLine;
var
  l : PLine;
  w, h : integer;
begin
if msg.message = 45057 then begin
  GrayImg := TImage.Create(self);
  GrayImg.Picture.Bitmap := Form1.GetFormImage;
  GrayImg.Picture.Bitmap.PixelFormat := pf24bit;
  GrayPnl := TPanel.Create(self);
  GrayPnl.Parent := Form1;
  GrayPnl.Align := alClient;
  GrayImg.Parent := GrayPnl;
  GrayImg.Align := alClient;
  for h := 0 to GrayImg.Picture.Bitmap.Height - 1 do begin
    l := GrayImg.Picture.Bitmap.ScanLine[h];
    for w := 0 to GrayImg.Picture.Bitmap.Width - 1 do with l[w] do begin
      rgbtRed := (rgbtRed + rgbtGreen + rgbtBlue) div 3;
      rgbtGreen := rgbtRed;
      rgbtBlue := rgbtRed;
    end;
  end;
  msg.message := 15;
end else if msg.message = 45056 then begin
  GrayImg.Free;
  GrayPnl.Free;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := ApplicationEventsMessage;
end;

end.

I don't know how to bring TImage on top of other components (by default graphical objects can't be in front of others, found it in help), therefore I implicated TPanel, which can be on top of other components, and placed TImage on it (if it had Canvas, then it would be possible just to draw on them TBitmap and there would not be need to make TImage).

I hope this will help.
0
 

Author Comment

by:fadyg
ID: 10766575
This should do... thanks
I will accept this as a good answer
0
 
LVL 12

Expert Comment

by:esoftbg
ID: 10766813
My last version is at             http://www.geocities.com/esoftbg
                        file             Q_20944061.exe.zip
emil
0
 
LVL 12

Expert Comment

by:esoftbg
ID: 10766827
ooops,
i am late
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Video by: ITPro.TV
In this episode Don builds upon the troubleshooting techniques by demonstrating how to properly monitor a vSphere deployment to detect problems before they occur. He begins the show using tools found within the vSphere suite as ends the show demonst…
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
Suggested Courses

618 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question