2007. augusztus 4., szombat
How to wallpaper the client area of a MDI parent form
Problem/Question/Abstract:
How to wallpaper the client area of a MDI parent form
Answer:
Solve 1:
Here are the basics of how it is done:
type
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FClientInstance,
FPrevClientProc: TFarProc;
procedure ClientWndProc(var Message: TMessage);
public
end;
implementation
procedure TForm1.ClientWndProc(var Message: TMessage);
var
MyDC: hDC;
Ro, Co: Word;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
MyDC := TWMEraseBkGnd(Message).DC;
for Ro := 0 to ClientHeight div Image1.Picture.Height do
for Co := 0 to ClientWIDTH div Image1.Picture.Width do
BitBlt(MyDC, Co * Image1.Picture.Width, Ro * Image1.Picture.Height,
Image1.Picture.Width,
Image1.Picture.Height, Image1.Picture.Bitmap.Canvas.Handle, 0, 0,
SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if FileExists(ExtractFilePath(Application.ExeName) + 'backgrnd.bmp') then
begin
Image1.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) +
'backgrnd.bmp');
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if (FPrevClientProc <> nil) then
begin
FClientInstance := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FPrevClientProc));
FreeObjectInstance(FClientInstance);
end;
end;
Solve 2:
You need to do some Windows API level stuff to hook the window proc of MDI client window. This client window occupies the client area of an MDI main from - that's why you can't see the results of your painting.
Here's an example of how you do that. It also illustrates how to create a temporary canvas using a supplied Device Context to facilitate painting the image bitmap. The code looks for the file argyle.bmp in the Windows directory. If you don't have that bitmap, substitute another. Make sure you create an OnDestroy handler and copy the code from FormDestroy here into that handler.
{Example of painting the background of an MDI form}
unit MDIPaint;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FClientInstance: pointer;
FOldClientProc: pointer;
FBackground: TBitmap;
procedure ClientProc(var Message: TMessage);
public
{ Public declarations }
procedure CreateWnd; override;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ClientProc(var Message: TMessage);
var
ARect: TRect;
x, y: integer;
SrcRect: TRect;
begin
{if the message is to erase background, tile with the background bitmap}
with Message do
begin
if Msg = WM_ERASEBKGND then
begin
WinProcs.GetClientRect(ClientHandle, ARect);
with TCanvas.Create do
try
Handle := wParam;
SrcRect := Rect(0, 0, FBackground.Width, FBackground.Height);
y := 0;
while y < ARect.Bottom do
begin
x := 0;
while x < ARect.Right do
begin
CopyRect(Bounds(x, y, FBackground.Width, FBackground.Height),
FBackground.Canvas, SrcRect);
inc(x, FBackground.Width);
end;
inc(y, FBackground.Height);
end;
Result := 1;
finally
Handle := 0;
Free;
end;
end
else
{otherwise call the original window proc}
Result := CallWindowProc(FOldClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;
procedure TForm1.CreateWnd;
begin
inherited CreateWnd;
if FormStyle = fsMDIForm then
begin
FBackground := TBitmap.Create;
FBackground.LoadFromFile('c:\windows\argyle.bmp');
FClientInstance := MakeObjectInstance(ClientProc);
FOldClientProc := pointer(SetWindowLong(ClientHandle, GWL_WNDPROC,
longint(FClientInstance)));
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
{reset the original client proc, free the client instance and the bitmap}
SetWindowLong(ClientHandle, GWL_WNDPROC, longint(FOldClientProc));
FreeObjectInstance(FClientInstance);
FBackground.Free;
end;
end.
Solve 3:
Here are the steps to add a wallpaper to the client area of of a MDI parent form:
1. Create a new project
2. Set the form's FormStyle to fsMDIForm
3. Drop an image on the form and select a bitmap into it.
4. Find the { Private Declarations } comment in the form's definition and add these lines right after it:
FClientInstance, FPrevClientProc: TFarProc;
procedure ClientWndProc(var Message: TMessage);
5. Find the "implementation" line and the {$R *.DFM} line that follows it. After that line, enter this code:
procedure TForm1.ClientWndProc(var Message: TMessage);
var
MyDC: hDC;
Ro, Co: Word;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
MyDC := TWMEraseBkGnd(Message).DC;
for Ro := 0 to ClientHeight div Image1.Picture.Height do
for Co := 0 to ClientWIDTH div Image1.Picture.Width do
BitBlt(MyDC, Co * Image1.Picture.Width, Ro * Image1.Picture.Height,
Image1.Picture.Width,
Image1.Picture.Height, Image1.Picture.Bitmap.Canvas.Handle, 0, 0,
SRCCOPY);
Result := 1;
end
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;
6. Start an OnCreate method for the form and put these lines in it:
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
7. Add a new form to your project and set its FormStyle to fsMDIChild.
Now you have a working MDI project with "wallpaper". The image component is not visible, but its bitmap is replicated to cover the MDI form's client area. There is still one problem; when you minimize the child window its icon will be drawn against a gray rectangle.
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése