Советы по 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]
