Title: Finally, the correct way: Drawing on the MDI parent form (and fixing some Delphi problems too)
Question: Since Delphi 1 this is a problem. The code bellow resolves the this problem and others:
1- Draw an image on the client area of the main form, showing how to tile a image and put a logo image with many position options (looks great).
2- Put to work the KeyPreview property of the main form;
3- Put to work the F1 key press to correctly call application help.
Answer:
Create a unit and put this there:
=======================================================
unit fNoBugForm;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, extctrls;
type
TImagePos = (ipCenter, ipTopLeft, ipTopRight, ipBottomLeft, ipBottomRight);
TNoBugForm = class(TForm)
protected
procedure DrawBkgnd(DC:hDC); virtual;
function GetPalette: HPalette; override;
private
FBackground: TBitmap;
FBackgroundImage,
FLogoImage: TImage;
FLogoImagePos: TImagePos;
FClientInstance, FPrevClientProc: TFarProc;
procedure ClientWndProc(var Message: TMessage);
public
constructor create(AOwner: TComponent); override;
destructor destroy; override;
property BackgroundImage: TImage read FBackgroundImage write FBackgroundImage;
property LogoImage: TImage read FLogoImage write FLogoImage;
property LogoImagePos: TImagePos read FLogoImagePos write FLogoImagePos;
end;
implementation
function TNoBugForm.GetPalette: HPalette;
begin
if Assigned(FBackgroundImage) then
result:= FBackgroundImage.Picture.Bitmap.Palette
else
result:= 0;
end;
procedure TNoBugForm.DrawBkgnd(DC: hDC);
var
i,Ro,Co : word;
FreeClientHeight,
FreeClientWidth : word;
OldPalette : HPalette;
begin
FreeClientHeight:= ClientHeight;
FreeClientWidth:= ClientWidth;
if ControlCount 0 then
for i:= 0 to ControlCount - 1 do
begin
if (Controls[i].Visible) and (Controls[i].Align in [alTop,alBottom]) then
FreeClientHeight:= FreeClientHeight - Controls[i].Height;
if (Controls[i].Visible) and (Controls[i].Align in [alLeft,alRight]) then
FreeClientWidth:= FreeClientWidth - Controls[i].Width;
end;
if Assigned(FBackgroundImage) then
begin
FBackground.Canvas.CopyMode:= SRCCOPY;
for Ro := 0 to FreeClientHeight div FBackgroundImage.Picture.Height do
for Co := 0 to FreeClientWidth div FBackgroundImage.Picture.Width do
FBackground.Canvas.Draw (Co * FBackgroundImage.Picture.Width, Ro * FBackgroundImage.Picture.Height,
FBackgroundImage.Picture.Bitmap);
end
else
begin
FBackground.Canvas.Brush.Color:= Color;
FBackground.Canvas.FillRect (Rect(0, 0, FreeClientWidth, FreeClientHeight));
end;
if Assigned(FLogoImage) then
begin
FBackground.Canvas.CopyMode:= SRCAND;
case FLogoImagePos of
ipTopLeft : FBackground.Canvas.Draw (10, 10,
FLogoImage.Picture.Bitmap);
ipTopRight : FBackground.Canvas.Draw (FreeClientWidth - FLogoImage.Picture.Width - 10,
10,
FLogoImage.Picture.Bitmap);
ipBottomRight: FBackground.Canvas.Draw (FreeClientWidth - FLogoImage.Picture.Width - 10,
FreeClientHeight - FLogoImage.Picture.Height - 10,
FLogoImage.Picture.Bitmap);
ipBottomLeft : FBackground.Canvas.Draw (10,
FreeClientHeight - FLogoImage.Picture.Height - 10,
FLogoImage.Picture.Bitmap);
else
FBackground.Canvas.Draw ((FreeClientWidth - FLogoImage.Picture.Width ) div 2,
(FreeClientHeight - FLogoImage.Picture.Height) div 2,
FLogoImage.Picture.Bitmap);
end;
end;
if Assigned(FBackgroundImage) then
begin
OldPalette:=SelectPalette (DC, FBackgroundImage.Picture.Bitmap.Palette, FALSE);
RealizePalette (DC);
BitBlt(DC, 0, 0, FreeClientWidth, FreeClientHeight, FBackground.Canvas.Handle, 0, 0, SRCCOPY);
SelectPalette (DC, OldPalette, TRUE);
RealizePalette (DC);
end
else
BitBlt(DC, 0, 0, FreeClientWidth, FreeClientHeight, FBackground.Canvas.Handle, 0, 0, SRCCOPY);
end;
procedure TNoBugForm.ClientWndProc(var Message: TMessage);
begin
with Message do
begin
result:= -1;
case Msg of
WM_ERASEBKGND: DrawBkgnd (TWMEraseBkGnd(Message).DC);
{$IFDEF WIN32}
WM_HELP : if HelpContext0 then
Application.HelpContext (HelpContext);
{$ELSE}
WM_KEYDOWN,
WM_KEYUP : PostMessage (handle, Msg, wParam, lParam);
{$ENDIF}
else
result:= CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;
end;
constructor TNoBugForm.create(AOwner: TComponent);
begin
FBackground:= TBitmap.Create;
FBackground.Width:= Screen.Width;
FBackground.Height:= Screen.Height;
inherited Create (AOwner);
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
end;
destructor TNoBugForm.destroy;
begin
FBackground.free;
inherited;
end;
end.
=======================================================
In your main form use like this:
=======================================================
uses fNoBugForm;
Change declaration from:
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
To:
TForm1 = class(TNoBugForm)
private
{ Private declarations }
public
{ Public declarations }
end;
Example:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fNoBugForm,
Menus, jpeg, ExtCtrls;
type
TForm1 = class(TNoBugForm)
MainMenu1: TMainMenu;
Arquivo1: TMenuItem;
Image1: TImage;
Image2: TImage;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
BackgroundImage:= Image1; // Set a TImage, with a Bitmap (not JPG), to the BackgroundImage property
LogoImage:= Image2; // Set a TImage, with a Bitmap (not JPG), to the LogoImage property if you want one
LogoImagePos:= ipBottomRight; // Set the position of the LogoImage
end;
end.
=======================================================
That's all folks.