谁能给我个好用的给添加MDI背景的控件, xhyph@21cn.com 谢谢拉(30分)

  • 主题发起人 主题发起人 xhyph
  • 开始时间 开始时间
X

xhyph

Unregistered / Unconfirmed
GUEST, unregistred user!
谢谢拉我找了很久,自己按照书上所说的又不能成功,真奇怪
 
书上怎么说的,帮你试试看[:)]
 
1.建立一个TImage
imgMain :TImage;

2.添加变量
FOldClientProc, FNewClientProc: TFarProc;
FDrawDC: hDC;

3.自定义背景居中过程
procedure DrawCentered;

procedure TMainForm.DrawCentered;

var
CR: TRect;
begin
GetWindowRect(ClientHandle, CR);
with imgMain do
BitBlt(FDrawDC, ((CR.Right - CR.Left) - Picture.Width) div 2,
((CR.Bottom - CR.Top) - Picture.Height) div 2,
Picture.Graphic.Width, Picture.Graphic.Height,
Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

4.自定义背景平铺过程
procedure DrawTiled;

procedure TMainForm.DrawTiled;

var
Row, Col: Integer;
CR, IR: TRect;
NumRows, NumCols: Integer;
begin
GetWindowRect(ClientHandle, CR);
IR := imgMain.ClientRect;
NumRows := CR.Bottom div IR.Bottom;
NumCols := CR.Right div IR.Right;
with imgMain do
for Row := 0 to NumRows+1 do
for Col := 0 to NumCols+1 do
BitBlt(FDrawDC, Col * Picture.Width, Row * Picture.Height,
Picture.Width, Picture.Height, Picture.Bitmap.Canvas.Handle,
0, 0, SRCCOPY);
end;


5.自定义背景自动伸展过程,让Image随MAINForm大小而大小

procedure DrawStretched;

procedure TMainForm.DrawStretched;
{ This procedure stretches the image on the form's client area }
var
CR: TRect;
begin
GetWindowRect(ClientHandle, CR);
StretchBlt(FDrawDC, 0, 0, CR.Right, CR.Bottom,
imgMain.Picture.Bitmap.Canvas.Handle, 0, 0,
imgMain.Picture.Width, imgMain.Picture.Height,
SRCCOPY);
end;


6.自定义背景过程
procedure ClientWndProc(var Message: TMessage);

procedure TMainForm.ClientWndProc(var Message: TMessage);
begin
case Message.Msg of
WM_ERASEBKGND:
begin
CallWindowProc(FOldClientProc,
ClientHandle,
Message.Msg,
Message.wParam,
Message.lParam);
FDrawDC := TWMEraseBkGnd(Message).DC;
//这里是根据菜单项是否选中来决定其显示方式
if mmiStretch.Checked then
DrawStretched
else if mmiCenter.Checked then
DrawCentered
else DrawTiled;
Message.Result := 1;
end;

WM_VSCROLL, WM_HSCROLL:
begin
Message.Result := CallWindowProc(FOldClientProc,
ClientHandle,
Message.Msg,
Message.wParam,
Message.lParam);
InvalidateRect(ClientHandle, nil, True);
end;
else
Message.Result := CallWindowProc(FOldClientProc,
ClientHandle,
Message.Msg,
Message.wParam,
Message.lParam);
end; { case }
end;
7.覆盖创建背景过程
procedure CreateWnd; override;

procedure TMainForm.CreateWnd;
begin
inherited CreateWnd;
FNewClientProc := MakeObjectInstance(ClientWndProc);
FOldClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FNewClientProc));
end;
 
还是给我控件吧
 
给你发过去了,可以加分了吗?
 
to:qiujsh
我已经收到
你能不能简单的跟我讲一下怎么用好吗?

比如说如何把这个文件加入到我的项目里,
为什么Delphi说找不到 .dcu
 
xhysh 我也想要一个这样的控件能给我发一个吗?
iceberg790312@263.net
谢谢
 
MDI Wallpaper v2.0.0
墙纸构件,可将Form背景填充为指定图案,多种填充方式,使用简单。

to xhyph,berg

已经发过去了!
 
给发一个吧
lwave@163.com
 
也发给我一个吧 谢谢。
bluecode@963.com
 
接受答案了.
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部