Заполнение изображением MDI-формы. Способ 2
Ключевым моментом здесь является работа с дескриптором окна MDI-клиента (свойство ClientHandle) и заполнение изображением окно клиента в ответ на сообщение WM_ERASEBKGND. Тем не менее здесь существует пара проблем: прокрутка главного окна и перемещение дочернего MDI-окна за пределы экрана портят фон, и закрашивание за иконками дочерних окон не происходит.

Ну наконец-то! Похоже я нашел как решить обе проблемы. Вот код для тех, кому все это интересно. Я начинаю с проблемы дочерних форм, ниже код для решения проблемы с главной формой (модули с именами MDIWAL2U.PAS и MDIWAL1U.PAS). На главной форме расположен компонент TImage с именем Image1, содержащий изображение для заливки фона.

...
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;

 
« Предыдущая статья   Следующая статья »