使MDI窗口有一个背景图象或使它平铺
【打印文章】
确定你已在在你的主窗体对象中加入了下面的变量:
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
{ MDI的背景代码 }
procedure TMainForm.ClientWndProc(var Message: TMessage);
var
Dc : hDC;
Row : Integer;
Col : Integer;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
Dc := TWMEraseBkGnd(Message).Dc;
// 在DC上平铺图象
for Row := 0 to ClientHeight div Image1.Picture.Height do
for Col := 0 to ClientWidth div Image1.Picture.Width do
BitBlt(Dc,
Col * Image1.Picture.Width,
Row * Image1.Picture.Height,
Image1.Picture.Width,
Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle,
0,
0,
SRCCOPY);
Result := 1;
end;
else // 传递其他消息
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
end;
end;
- 在你的主窗体的OnShow事件中加入以下代码:
// MDI背景平铺代码,与WndProc链接
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
SetWindowLong(ClientHandle,GWL_WNDPROC,LongInt(FClientInstance));
- 现在你有一个背景了!
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
{ MDI的背景代码 }
procedure TMainForm.ClientWndProc(var Message: TMessage);
var
Dc : hDC;
Row : Integer;
Col : Integer;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
Dc := TWMEraseBkGnd(Message).Dc;
// 在DC上平铺图象
for Row := 0 to ClientHeight div Image1.Picture.Height do
for Col := 0 to ClientWidth div Image1.Picture.Width do
BitBlt(Dc,
Col * Image1.Picture.Width,
Row * Image1.Picture.Height,
Image1.Picture.Width,
Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle,
0,
0,
SRCCOPY);
Result := 1;
end;
else // 传递其他消息
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
end;
end;
- 在你的主窗体的OnShow事件中加入以下代码:
// MDI背景平铺代码,与WndProc链接
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
SetWindowLong(ClientHandle,GWL_WNDPROC,LongInt(FClientInstance));
- 现在你有一个背景了!
本栏文章均来自于互联网,版权归原作者和各发布网站所有,本站收集这些文章仅供学习参考之用。任何人都不能将这些文章用于商业或者其他目的。( Pfan.cn )
【编程爱好者论坛】