如何画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(50000, 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/p/1493503.html