Советы по Delphi

         

Заполнение изображением MDI-формы II


Несколько людей уже спрашивали, как залить фон главной MDI-формы повторяющимся изображением. Ключевым моментом здесь является работа с дескриптором окна 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;

Neil Rubenkind [000612]



Содержание раздела