MDI приложения

Code:

type

.... = class(TForm)

   ....

     procedure FormCreate(Sender: TObject);

   procedure FormDestroy(Sender: TObject);

   ....

   private

   FHBrush: HBRUSH;

   FCover: TBitmap;

   FNewClientInstance: TFarProc;

   FOldClientInstance: TFarProc;

   procedure NewClientWndProc(var Message: TMessage);

   ....

   protected

   ....

     procedure CreateWnd; override;

   ....

end;

.....

implementation

{$R myRes.res} //pесуpс с битмапом фона

procedure.FormCreate(...);

var

LogBrush: TLogbrush;

begin

FCover := TBitmap.Create;

FCover.LoadFromResourceName(hinstance, 'BMPCOVER');

with LogBrush do

begin

   lbStyle := BS_PATTERN;

   lbHatch := FCover.Handle;

end;

FHBrush := CreateBrushIndirect(Logbrush);

end;

procedure.FormDestroy(...);

   begin

     DeleteObject(FHBrush);

     FCover.Free;

   end;

   procedure.CreateWnd;

   begin

     inherited CreateWnd;

     if (ClientHandle <> 0) then

     begin

       if NewStyleControls then

         SetWindowLong(ClientHandle, GWL_EXSTYLE, WS_EX_CLIENTEDGE or

           GetWindowLong(ClientHandle, GWL_EXSTYLE));

       FNewClientInstance := MakeObjectInstance(NewClientWndProc);

       FOldClientInstance := pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));

       SetWindowLong(ClientHandle, GWL_WNDPROC, longint(FNewClientInstance));

     end;

   end;

   procedure.NewClientWndProc(var Message: TMessage);

     procedure Default;

     begin

       with Message do

         Result := CallWindowProc(FOldClientInstance, ClientHandle, Msg,

           wParam,

           lParam);

     end;

   begin

     with Message do

     begin

       case Msg of

         WM_ERASEBKGND:

           begin

             FillRect(TWMEraseBkGnd(Message).DC, ClientRect, FHBrush);

             Result := 1;

           end;

       else

         Default;

       end;

     end;

   end;