Solved

grayscale MDIChild form when it becomes inactive

Posted on 2004-04-05
11
302 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
 
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
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
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

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

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…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
This video discusses moving either the default database or any database to a new volume.
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

746 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now