Solved

grayscale MDIChild form when it becomes inactive

Posted on 2004-04-05
11
308 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
  • 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
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
LVL 12

Expert Comment

by:esoftbg
ID: 10760516
0
 
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 350 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

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

Suggested Solutions

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Email security requires an ever evolving service that stays up to date with counter-evolving threats. The Email Laundry perform Research and Development to ensure their email security service evolves faster than cyber criminals. We apply our Threat…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

809 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