БОЛЬШОЙ FAQ ПО DELPHI



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

Автор: Neil Rubenkind

Несколько людей уже спрашивали, как залить фон главной 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;
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Видеокурс ВЗЛОМ