MDI приложения

Code:

...

private

OutCanvas: TCanvas;

OldWinProc, NewWinProc: Pointer;

procedure NewWinProcedure(var Msg: TMessage);

...

procedure TMainForm.FormCreate(Sender: TObject);

begin

NewWinProc := MakeObjectInstance(NewWinProcedure);

OldWinProc := Pointer(SetWindowLong(ClientHandle,

   gwl_WndProc, Cardinal(NewWinProc)));

OutCanvas := TCanvas.Create;

end;

procedure TMainForm.NewWinProcedure(var Msg: TMessage);

var

BmpWidth, BmpHeight: Integer;

I, J: Integer;

begin

// default processing first

Msg.Result := CallWindowProc(OldWinProc,

   ClientHandle, Msg.Msg, Msg.wParam, Msg.lParam);

// handle background repaint

if Msg.Msg = wm_EraseBkgnd then

begin

   BmpWidth := MainForm.Image1.Width;

   BmpHeight := MainForm.Image1.Height;

   if (BmpWidth <> 0) and (BmpHeight <> 0) then

   begin

     OutCanvas.Handle := Msg.wParam;

     for I := 0 to MainForm.ClientWidth div BmpWidth do

       for J := 0 to MainForm.ClientHeight div BmpHeight do

         OutCanvas.Draw(I * BmpWidth, J * BmpHeight,

           MainForm.Image1.Picture.Graphic);

   end;

end;

end;

procedure TMainForm.FormDestroy(Sender: TObject);

begin

OutCanvas.Free;

end;