MDI приложения

Code:

...

private

{ Private declarations }

procedure WMIconEraseBkgnd(var Message: TWMIconEraseBkgnd);

message WM_ICONERASEBKGND;

...

USES MdiWal1u;

procedure TForm2.WMIconEraseBkgnd(var Message: TWMIconEraseBkgnd);

begin

TForm1(Application.Mainform).PaintUnderIcon(Self, Message.DC);

Message.Result := 0;

end;

...

{ Private declarations }

bmW, bmH: Integer;

FClientInstance,

FPrevClientProc: TFarProc;

procedure ClientWndProc(var Message: TMessage);

public

   procedure PaintUnderIcon(F: TForm; D: hDC);

   ...

     procedure TForm1.PaintUnderIcon(F: TForm; D: hDC);

   var

     DestR, WndR: TRect;

     Ro, Co,

       xOfs, yOfs,

       xNum, yNum: Integer;

   begin

     {вычисляем необходимое число изображений для заливки D}

     GetClipBox(D, DestR);

     with DestR do

     begin

       xNum := Succ((Right - Left) div bmW);

       yNum := Succ((Bottom - Top) div bmW);

     end;

     {вычисление смещения изображения в D}

     GetWindowRect(F.Handle, WndR);

     with ScreenToClient(WndR.TopLeft) do

     begin

       xOfs := X mod bmW;

       yOfs := Y mod bmH;

     end;

     for Ro := 0 to xNum do

       for Co := 0 to yNum do

         BitBlt(D, Co * bmW - xOfs, Ro * bmH - Yofs, bmW, bmH,

           Image1.Picture.Bitmap.Canvas.Handle,

           0, 0, SRCCOPY);

   end;

   procedure TForm1.ClientWndProc(var Message: TMessage);

   var

     Ro, Co: Word;

   begin

     with Message do

       case Msg of

         WM_ERASEBKGND:

           begin

             for Ro := 0 to ClientHeight div bmH do

               for Co := 0 to ClientWIDTH div bmW do

                 BitBlt(TWMEraseBkGnd(Message).DC,

                   Co * bmW, Ro * bmH, bmW, bmH,

                   Image1.Picture.Bitmap.Canvas.Handle,

                   0, 0, SRCCOPY);

             Result := 1;

           end;

         WM_VSCROLL,

           WM_HSCROLL:

           begin

             Result := CallWindowProc(FPrevClientProc,

               ClientHandle, Msg, wParam, lParam);

             InvalidateRect(ClientHandle, nil, True);

           end;

       else

         Result := CallWindowProc(FPrevClientProc,

           ClientHandle, Msg, wParam, lParam);

       end;

   end;

   procedure TForm1.FormCreate(Sender: TObject);

   begin

     bmW := Image1.Picture.Width;

     bmH := Image1.Picture.Height;

     FClientInstance := MakeObjectInstance(ClientWndProc);

     FPrevClientProc := Pointer(

       GetWindowLong(ClientHandle, GWL_WNDPROC));

     SetWindowLong(ClientHandle, GWL_WNDPROC,

       LongInt(FClientInstance));

   end;