如何画MDI主窗体的背景

unit  MAIN;

interface

uses  Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
  ActnList, ToolWin, ImgList;

type
  TMainForm  =   class (TForm)
    MainMenu1: TMainMenu;
    Window1: TMenuItem;
    Help1: TMenuItem;
    WindowCascadeItem: TMenuItem;
    WindowTileItem: TMenuItem;
    WindowArrangeItem: TMenuItem;
    HelpAboutItem: TMenuItem;
    OpenDialog: TOpenDialog;
    WindowMinimizeItem: TMenuItem;
    StatusBar: TStatusBar;
    ActionList1: TActionList;
    FileExit1: TAction;
    WindowCascade1: TWindowCascade;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowArrangeAll1: TWindowArrange;
    WindowMinimizeAll1: TWindowMinimizeAll;
    HelpAbout1: TAction;
    WindowTileVertical1: TWindowTileVertical;
    WindowTileItem2: TMenuItem;
    ImageList1: TImageList;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    ToolButton18: TToolButton;
    ToolButton1: TToolButton;
    Image1: TImage;
    ToolButton2: TToolButton;
    FileNew1: TAction;
    ToolButton3: TToolButton;
     procedure  FileNew1Execute(Sender: TObject);
     procedure  FileOpen1Execute(Sender: TObject);
     procedure  HelpAbout1Execute(Sender: TObject);
     procedure  FileExit1Execute(Sender: TObject);
   private
     {  Private declarations  }
    FOldWndProc: TFarProc;
    FNewWndProc: TFarProc;
     procedure  CreateMDIChild( const  Name:  string );
     procedure  ClientWndProc( var  Message: TMessage);
   protected
     procedure  DrawBG(DC: HDC);  virtual ;
     procedure  CreateWnd;  override ;
   public
     {  Public declarations  }
   end ;

var
  MainForm: TMainForm;

implementation

{ $R *.dfm }

uses  CHILDWIN, about;

procedure  TMainForm.ClientWndProc( var  Message: TMessage);
var
  R: TRECT;

   procedure  Default;
   begin
     with  Message  do
      Result : =  CallWindowProc(FOldWndProc, ClientHandle, Msg, wParam, lParam);
   end ;
var
  PS: TPaintStruct;
begin
  R : =  ClientRect;
   case  Message.Msg  of
    WM_PAINT:
       begin
        BeginPaint(ClientHandle, PS);
         try
          Canvas.Lock;
           try
            Canvas.Handle : =  PS.hdc;
             try
              Paint;
               if  ControlCount  >   0   then
                PaintControls(PS.hdc, Controls[ 0 ]);
             finally
              Canvas.Handle : =   0 ;
             end ;
           finally
            Canvas.Unlock;
           end ;
         finally
          EndPaint(ClientHandle, PS);
         end ;
       end ;
    WM_ERASEBKGND:
       begin
        DrawBG(TWMEraseBkGnd(Message).DC);
        Message.Result : =   1 ;
       end ;
    WM_VSCROLL, WM_HSCROLL:
       begin
        InvalidateRect(ClientHandle, @R, true);
        Default;
       end ;
    WM_SIZE:
       begin
        InvalidateRect(ClientHandle, @R, true);
        Default;
       end ;
   else
    Default;
   end ;
end ;

procedure  TMainForm.CreateMDIChild( const  Name:  string );
var
  Child: TMDIChild;
begin
   {  create a new MDI child window  }
  Child : =  TMDIChild.Create(Application);
  Child.Caption : =  Name;
   if  FileExists(Name)  then  Child.Memo1.Lines.LoadFromFile(Name);
end ;

procedure  TMainForm.FileNew1Execute(Sender: TObject);
begin
  CreateMDIChild( ' NONAME '   +  IntToStr(MDIChildCount  +   1 ));
end ;

procedure  TMainForm.FileOpen1Execute(Sender: TObject);
begin
   if  OpenDialog.Execute  then
    CreateMDIChild(OpenDialog.FileName);
end ;

procedure  TMainForm.HelpAbout1Execute(Sender: TObject);
begin
  AboutBox.ShowModal;
end ;

procedure  TMainForm.CreateWnd;
begin
   inherited ;
  FNewWndProc : =  Forms.MakeObjectInstance(ClientWndProc);
  FOldWndProc : =  Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
  SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FNewWndProc));
end ;

procedure  TMainForm.DrawBG(DC: HDC);
var
  myRect: TRect;
  str:  string ;
  NewFont, OldFont: Integer;
  FontStyle, FontItalic, FontUnderline, FontStrikeout: Integer;
begin
   if  Brush.Color  <>  clNone  then
    FillRect(DC, ClientRect, Brush.Handle);
  SetBkMode(DC, TRANSPARENT);
  SetTextColor(DC, clRed);

   //  Set font
  FontStyle : =  FW_BOLD;
  FontItalic : =   1 ;
  FontUnderline : =   0 ;
  FontStrikeout : =   0 ;

  NewFont : =  CreateFont( 50 ,  0 ,  0 ,  0 , FontStyle, FontItalic,
    FontUnderline, FontStrikeout, DEFAULT_CHARSET,
    OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
    DEFAULT_PITCH,  ' Arial ' );

  OldFont : =  SelectObject(DC, NewFont);
  str : =   ' GMT ' ;
  myRect : =  Rect(Width  -   200 ,
    Height  -   200 ,
    Width  -   20 ,
    Height  -   20 );
  DrawText(DC, PChar(str), Length(str), myRect, DT_CENTER  or  DT_VCENTER);
  SelectObject(DC, OldFont);
  DeleteObject(NewFont);
end ;

procedure  TMainForm.FileExit1Execute(Sender: TObject);
begin
  Close;
end ;

end .

转载于:https://www.cnblogs.com/yunhaisoft/archive/2009/06/01/1493503.html