回复人:rh(强硬的毛主席万岁!伟大的周总理万岁!) (2001-5-22 12:41:00) 得25分 就用如下思路(这是给mdi窗体加背景的!):unit MainFrm;interfaceuses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus, StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, JPeg;type TMainForm = class(TForm) mmMain: TMainMenu; mmiFile: TMenuItem; mmiNew: TMenuItem; mmiClose: TMenuItem; N1: TMenuItem; mmiExit: TMenuItem; mmiImage: TMenuItem; mmiTile: TMenuItem; mmiCenter: TMenuItem; mmiStretch: TMenuItem; imgMain: TImage; procedure mmiNewClick(Sender: TObject); procedure mmiCloseClick(Sender: TObject); procedure mmiExitClick(Sender: TObject); procedure mmiTileClick(Sender: TObject); private FOldClientProc, FNewClientProc: TFarProc; FDrawDC: hDC; procedure CreateMDIChild(const Name: string); procedure ClientWndProc(var Message: TMessage); procedure DrawStretched; procedure DrawCentered; procedure DrawTiled; protected procedure CreateWnd; override; end;var MainForm: TMainForm;implementationuses MdiChildFrm;{$R *.DFM}procedure TMainForm.CreateWnd; begin inherited CreateWnd; // Turn the ClientWndProc method into a valid window procedure FNewClientProc := MakeObjectInstance(ClientWndProc); // Get a pointer to the original window procedure FOldClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC)); // Set ClientWndProc as the new window procedure SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FNewClientProc)); end;procedure TMainForm.DrawCentered; { This procedure centers the image on the form's client area } var CR: TRect; begin GetWindowRect(ClientHandle, CR); with imgMain do BitBlt(FDrawDC, ((CR.Right - CR.Left) - Picture.Width) div 2, ((CR.Bottom - CR.Top) - Picture.Height) div 2, Picture.Graphic.Width, Picture.Graphic.Height, Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY); end;procedure TMainForm.DrawStretched; { This procedure stretches the image on the form's client area } var CR: TRect; begin GetWindowRect(ClientHandle, CR); StretchBlt(FDrawDC, 0, 0, CR.Right, CR.Bottom, imgMain.Picture.Bitmap.Canvas.Handle, 0, 0, imgMain.Picture.Width, imgMain.Picture.Height, SRCCOPY); end;procedure TMainForm.DrawTiled; { This procedure tiles the image on the form's client area } var Row, Col: Integer; CR, IR: TRect; NumRows, NumCols: Integer; begin GetWindowRect(ClientHandle, CR); IR := imgMain.ClientRect; NumRows := CR.Bottom div IR.Bottom; NumCols := CR.Right div IR.Right; with imgMain do for Row := 0 to NumRows+1 do for Col := 0 to NumCols+1 do BitBlt(FDrawDC, Col * Picture.Width, Row * Picture.Height, Picture.Width, Picture.Height, Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY); end;procedure TMainForm.ClientWndProc(var Message: TMessage); begin case Message.Msg of // Capture the WM_ERASEBKGND messages and perform the client area drawing WM_ERASEBKGND: begin CallWindowProc(FOldClientProc, ClientHandle, Message.Msg, Message.wParam, Message.lParam); FDrawDC := TWMEraseBkGnd(Message).DC; if mmiStretch.Checked then DrawStretched else if mmiCenter.Checked then DrawCentered else DrawTiled; Message.Result := 1; end; { Capture the scrolling messages and ensure the client area is redrawn by calling InvalidateRect } WM_VSCROLL, WM_HSCROLL: begin Message.Result := CallWindowProc(FOldClientProc, ClientHandle, Message.Msg, Message.wParam, Message.lParam); InvalidateRect(ClientHandle, nil, True); end; else // By Default, call the original window procedure Message.Result := CallWindowProc(FOldClientProc, ClientHandle, Message.Msg, Message.wParam, Message.lParam); end; { case } end;procedure TMainForm.CreateMDIChild(const Name: string); var MdiChild: TMDIChildForm; begin MdiChild := TMDIChildForm.Create(Application); MdiChild.Caption := Name; end;procedure TMainForm.mmiNewClick(Sender: TObject); begin CreateMDIChild('NONAME' + IntToStr(MDIChildCount + 1)); end;procedure TMainForm.mmiCloseClick(Sender: TObject); begin if ActiveMDIChild <> nil then ActiveMDIChild.Close; end;procedure TMainForm.mmiExitClick(Sender: TObject); begin Close; end;procedure TMainForm.mmiTileClick(Sender: TObject); begin mmiTile.Checked := false; mmiCenter.Checked := False; mmiStretch.Checked := False; { Set the Checked property for the menu item which invoked } { this event handler to Checked } if Sender is TMenuItem then TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked; { Redraw the client area of the form } InvalidateRect(ClientHandle, nil, True); end;end.
Self.Brush.Bitmap:=Image1.Picture.Bitmap;
http://www.csdn.net/expert/topic/104/104222.shtm
就用如下思路(这是给mdi窗体加背景的!):unit MainFrm;interfaceuses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, JPeg;type
TMainForm = class(TForm)
mmMain: TMainMenu;
mmiFile: TMenuItem;
mmiNew: TMenuItem;
mmiClose: TMenuItem;
N1: TMenuItem;
mmiExit: TMenuItem;
mmiImage: TMenuItem;
mmiTile: TMenuItem;
mmiCenter: TMenuItem;
mmiStretch: TMenuItem;
imgMain: TImage;
procedure mmiNewClick(Sender: TObject);
procedure mmiCloseClick(Sender: TObject);
procedure mmiExitClick(Sender: TObject);
procedure mmiTileClick(Sender: TObject);
private
FOldClientProc,
FNewClientProc: TFarProc;
FDrawDC: hDC;
procedure CreateMDIChild(const Name: string);
procedure ClientWndProc(var Message: TMessage);
procedure DrawStretched;
procedure DrawCentered;
procedure DrawTiled;
protected
procedure CreateWnd; override;
end;var
MainForm: TMainForm;implementationuses MdiChildFrm;{$R *.DFM}procedure TMainForm.CreateWnd;
begin
inherited CreateWnd;
// Turn the ClientWndProc method into a valid window procedure
FNewClientProc := MakeObjectInstance(ClientWndProc);
// Get a pointer to the original window procedure
FOldClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
// Set ClientWndProc as the new window procedure
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FNewClientProc));
end;procedure TMainForm.DrawCentered;
{ This procedure centers the image on the form's client area }
var
CR: TRect;
begin
GetWindowRect(ClientHandle, CR);
with imgMain do
BitBlt(FDrawDC, ((CR.Right - CR.Left) - Picture.Width) div 2,
((CR.Bottom - CR.Top) - Picture.Height) div 2,
Picture.Graphic.Width, Picture.Graphic.Height,
Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;procedure TMainForm.DrawStretched;
{ This procedure stretches the image on the form's client area }
var
CR: TRect;
begin
GetWindowRect(ClientHandle, CR);
StretchBlt(FDrawDC, 0, 0, CR.Right, CR.Bottom,
imgMain.Picture.Bitmap.Canvas.Handle, 0, 0,
imgMain.Picture.Width, imgMain.Picture.Height, SRCCOPY);
end;procedure TMainForm.DrawTiled;
{ This procedure tiles the image on the form's client area }
var
Row, Col: Integer;
CR, IR: TRect;
NumRows, NumCols: Integer;
begin
GetWindowRect(ClientHandle, CR);
IR := imgMain.ClientRect;
NumRows := CR.Bottom div IR.Bottom;
NumCols := CR.Right div IR.Right;
with imgMain do
for Row := 0 to NumRows+1 do
for Col := 0 to NumCols+1 do
BitBlt(FDrawDC, Col * Picture.Width, Row * Picture.Height,
Picture.Width, Picture.Height, Picture.Bitmap.Canvas.Handle,
0, 0, SRCCOPY);
end;procedure TMainForm.ClientWndProc(var Message: TMessage);
begin
case Message.Msg of
// Capture the WM_ERASEBKGND messages and perform the client area drawing
WM_ERASEBKGND:
begin
CallWindowProc(FOldClientProc, ClientHandle, Message.Msg, Message.wParam,
Message.lParam);
FDrawDC := TWMEraseBkGnd(Message).DC;
if mmiStretch.Checked then
DrawStretched
else if mmiCenter.Checked then
DrawCentered
else DrawTiled;
Message.Result := 1;
end;
{ Capture the scrolling messages and ensure the client area
is redrawn by calling InvalidateRect }
WM_VSCROLL, WM_HSCROLL:
begin
Message.Result := CallWindowProc(FOldClientProc, ClientHandle, Message.Msg,
Message.wParam, Message.lParam);
InvalidateRect(ClientHandle, nil, True);
end;
else
// By Default, call the original window procedure
Message.Result := CallWindowProc(FOldClientProc, ClientHandle, Message.Msg,
Message.wParam, Message.lParam);
end; { case }
end;procedure TMainForm.CreateMDIChild(const Name: string);
var
MdiChild: TMDIChildForm;
begin
MdiChild := TMDIChildForm.Create(Application);
MdiChild.Caption := Name;
end;procedure TMainForm.mmiNewClick(Sender: TObject);
begin
CreateMDIChild('NONAME' + IntToStr(MDIChildCount + 1));
end;procedure TMainForm.mmiCloseClick(Sender: TObject);
begin
if ActiveMDIChild <> nil then
ActiveMDIChild.Close;
end;procedure TMainForm.mmiExitClick(Sender: TObject);
begin
Close;
end;procedure TMainForm.mmiTileClick(Sender: TObject);
begin
mmiTile.Checked := false;
mmiCenter.Checked := False;
mmiStretch.Checked := False;
{ Set the Checked property for the menu item which invoked }
{ this event handler to Checked }
if Sender is TMenuItem then
TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
{ Redraw the client area of the form }
InvalidateRect(ClientHandle, nil, True);
end;end.