Советы по Delphi

         

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


Привет всем! Кто-нибудь знает как поместить в MDI-форму изображение и заполнить им всю форму (tile)?

(Tile - "секция, плитка" - непрерывное заполнение определенной области немасштабируемым изображением слева-направо сверху вниз - В.О.)

Да. Это легкий вопрос..

procedure TForm.OnPaint(Sender: TObject);

procedure Tile(c:TCanvas;b:TBitMap);varx,y,h,w,i,j:integer;beginwith b do beginh:=b.height;w:=b.width;end;y:=0;with c.Cliprect do begini:=bottom-top-1; //высотаj:=right-left-1; //ширинаend;while y<i do beginx:=0;while x<j do beginc.draw(x,y,b);inc(x,w);end;inc(y,h);end;end;
begin
if
Sender is TForm thenTile(TForm(Sender).Canvas,fTileWith);end;


Несколько людей уже спрашивали, как залить фон главной 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);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 DOBEGINxNum := Succ((Right-Left) DIV bmW);yNum := Succ((Bottom-Top) DIV bmW);END;{вычисление смещения изображения в D}GetWindowRect(F.Handle, WndR);WITH ScreenToClient(WndR.TopLeft) DOBEGINxOfs := X MOD bmW;yOfs := Y MOD bmH;END;FOR Ro := 0 TO xNum DOFOR Co := 0 TO yNum DOBitBlt(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 docase
Msg ofWM_ERASEBKGND:beginFOR Ro := 0 TO ClientHeight DIV bmH DOFOR Co := 0 TO ClientWIDTH DIV bmW DOBitBlt(TWMEraseBkGnd(Message).DC,Co*bmW, Ro*bmH, bmW, bmH,Image1.Picture.Bitmap.Canvas.Handle,0, 0, SRCCOPY);Result := 1;end;WM_VSCROLL,WM_HSCROLL :beginResult := CallWindowProc(FPrevClientProc,ClientHandle, Msg, wParam, lParam);InvalidateRect(ClientHandle, NIL, True);end;elseResult := 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]




пишет:

В разделе Заполнение изображением MDI-формы повторяющимся изображением. Я нашел (Copyright не мой а из книжки) более простой способ.

...
private

OutCanvas: TCanvas;OldWinProc, NewWinProc: Pointer;procedure NewWinProcedure (var Msg: TMessage);
...
procedure
TMainForm.FormCreate(Sender: TObject);
begin
NewWinProc := MakeObjectInstance (NewWinProcedure);OldWinProc := Pointer (SetWindowLong (ClientHandle, gwl_WndProc, Cardinal (NewWinProc)));OutCanvas := TCanvas.Create;end;

procedure TMainForm.NewWinProcedure (var Msg: TMessage);
var
BmpWidth, BmpHeight: Integer;I, J: Integer;begin
// default processing firstMsg.Result := CallWindowProc (OldWinProc,ClientHandle, Msg.Msg, Msg.wParam, Msg.lParam);
// handle background repaintif Msg.Msg = wm_EraseBkgnd thenbeginBmpWidth := MainForm.Image1.Width;BmpHeight := MainForm.Image1.Height;if (BmpWidth <> 0) and (BmpHeight <> 0) thenbeginOutCanvas.Handle := Msg.wParam;for I := 0 to MainForm.ClientWidth div BmpWidth dofor J := 0 to MainForm.ClientHeight div BmpHeight doOutCanvas.Draw (I * BmpWidth, J * BmpHeight, MainForm.Image1.Picture.Graphic);end;end;end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
OutCanvas.Free;end;

Пока.. [000893]



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