如何画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 .

你可能感兴趣的:(如何画MDI主窗体的背景)