Несколько людей уже спрашивали, как залить фон главной MDI-формы
повторяющимся изображением. Ключевым моментом здесь является работа с
дескриптором окна MDI-клиента (свойство ClientHandle) и заполнение изображением
окно клиента в ответ на сообщение WM_ERASEBKGND. Тем не менее здесь существует
пара проблем: прокрутка главного окна и перемещение дочернего MDI-окна за
пределы экрана портят фон, и закрашивание за иконками дочерних окон не
происходит.
Ну наконец-то! Похоже я нашел как решить обе проблемы. Вот код для тех, кому
все это интересно. Я начинаю с проблемы дочерних форм, ниже код для решения
проблемы с главной формой (модули с именами MDIWAL2U.PAS и MDIWAL1U.PAS). На
главной форме расположен компонент TImage с именем Image1, содержащий
изображение для заливки фона.
...
{ Private declarations }
bmW, bmH: Integer;
FClientInstance,
FPrevClientProc: TFarProc;
procedure ClientWndProc(varMessage: TMessage);
publicprocedure 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 dobegin
xNum := Succ((Right - Left) div bmW);
yNum := Succ((Bottom - Top) div bmW);
end;
{вычисление смещения изображения в D}
GetWindowRect(F.Handle, WndR);
with ScreenToClient(WndR.TopLeft) dobegin
xOfs := X mod bmW;
yOfs := Y mod bmH;
end;
for Ro := 0 to xNum dofor 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(varMessage: TMessage);
var
Ro, Co: Word;
beginwithMessagedocase Msg of
WM_ERASEBKGND:
beginfor Ro := 0 to ClientHeight div bmH dofor 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;
Заполнение изображением MDI-формы 2: решается проблема прокрутки главного окна и перемещения дочернего MDI-окна за пределы экрана, а также закрашивание за иконками дочерних окон.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.