mdi 主窗口加背景的问题???(50分)

  • 主题发起人 主题发起人 bluedna
  • 开始时间 开始时间
B

bluedna

Unregistered / Unconfirmed
GUEST, unregistred user!
我在主窗口的create事件中的代码:
var
Mybitmap:Tbitmap;
begin
Mybitmap:=Tbitmap.create;
Mybitmap.loadfromfile('back.bmp');
self.brush.bitmap:=Tbitmap;
end;
背景可以显示,但是如果图片文件尺寸很小,结果背景铺的满屏都是很多小的相同图片,
我只想在背景上显示一副图片,该怎么做???
 
首先在Form定义的private下定义如下变量与过程
private
FClientInstance,FPrevClientProc : TFarProc;
Procedure ClientWndProc(Var Message: TMessage);
//显示MDI窗体图形的过程
接着在Form的Create事件中写如下代码
FClientInstance := MakeObjectInstance(ClientWndProc);
//加载图片
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
所用到的函数如下:
PROCEDURE TFrmMain.ClientWndProc(VAR Message: TMessage);
VAR
MyDC : hDC;
CR:TRect;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
MyDC := TWMEraseBkGnd(Message).DC;
GetWindowRect(ClientHandle,CR);
StretchBlt(MyDc,0,0,CR.Right,CR.Bottom,ImageMain.Picture.Bitmap.Canvas.Handle,0,
0,ImageMain.Picture.Width,ImageMain.Picture.Height,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;
 
直接使用TRzBackground
that's all


 
解决方法:
设置iDrawStyle为0,1或2可以以平铺,拉伸和居中显示图片
unit MDIMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms;
type
TMDIMainForm = class(TForm)
imgMain: TImage;
private
FOldClientProc,
FNewClientProc: TFarProc;
FDrawDC: hDC;
procedure ClientWndProc(var Msg: TMessage);
protected
public
iDrawStyle:integer;
procedure DrawImage(Style:integer);
end;

var
MDIMainForm: TMDIMainForm;
implementation
{$R *.dfm}
procedure TMDIMainForm.CreateWnd;
begin
inherited CreateWnd;
FNewClientProc := MakeObjectInstance(ClientWndProc);
FOldClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FNewClientProc));
end;

procedure TMDIMainForm.DrawImage(Style:integer);
var
Row, Col: Integer;
CR, IR: TRect;
NumRows, NumCols: Integer;
begin
if not FDrawImage then
exit;
GetWindowRect(ClientHandle, CR);
case Style of
0: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);
1:StretchBlt(FDrawDC, 0, 0, CR.Right, CR.Bottom,
imgMain.Picture.Bitmap.Canvas.Handle, 0, 0,
imgMain.Picture.Width, imgMain.Picture.Height, SRCCOPY);
2:begin
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;
end;
end;

procedure TMDIMainForm.ClientWndProc(var Msg: TMessage);
begin
case Msg.Msg of
WM_ERASEBKGND:
begin
CallWindowProc(FOldClientProc, ClientHandle, Msg.Msg, Msg.wParam,
Msg.lParam);
FDrawDC := TWMEraseBkGnd(Msg).DC;
DrawImage(iDrawStyle);
Msg.Result := 1;
end;
WM_VSCROLL, WM_HSCROLL:
begin
Msg.Result := CallWindowProc(FOldClientProc, ClientHandle, Msg.Msg,
Msg.wParam, Msg.lParam);
InvalidateRect(ClientHandle, nil, True);
end;
else
Msg.Result := CallWindowProc(FOldClientProc, ClientHandle, Msg.Msg,
Msg.wParam, Msg.lParam);
end;
end;

procedure TMDIMainForm.FormResize(Sender: TObject);
begin
InvalidateRect(ClientHandle, nil, True);
end;

end.
 
不好意思,TRzBackground 是什么东西?
 
PROCEDURE TMainForm.ClientWndProc(VAR Message: TMessage);
VAR
MyDC : hDC;
Ro, Co : Word;
begin

with Message do

case Msg of
WM_ERASEBKGND:
begin

MyDC := TWMEraseBkGnd(Message).DC;
FOR Ro := 0 TO ClientHeight DIV Image1.Picture.Height do

FOR Co := 0 TO ClientWIDTH DIV Image1.Picture.Width do

BitBlt(MyDC, Co*Image1.Picture.Width, Ro*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;

 
不好意思,TRzBackground 是什么东西?
Raize控件中的一个。
直接加上,设置几个属性,就ok
 
http://www.playicq.com
down一个Raize 252 for D5,D6
 
在MDI程序中,由于MDI的主窗口一般的功能是提供子窗口显示的位置和提供菜单、工具条、状态条等,而窗口的客户区则一般不会有其它的用途,所以Image运行时会不见。不过要显示也可以,你可以试一下以下方法:
第一步:创建一个新的工程。
第二步:将Form1的FormStyle设置为fsMDIForm,设置成MDI的主窗口。
第三步:在Form1上增加一个Image元件,并选择要设置的背景到Image的Picture中。
第四步:在Form1的Private中定义:
FClientInstance,
FPrevClientProc : TFarProc;
PROCEDURE ClientWndProc(VAR Message: TMessage);
第五步:在实现(implementation)中加入上述过程的具体内容:
PROCEDURE TForm1.ClientWndProc(VAR Message: TMessage);
VAR
MyDC : hDC;
Ro, Co : Word;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
MyDC := TWMEraseBkGnd(Message).DC;
FOR Ro := 0 TO ClientHeight DIV Image1.Picture.Height do
FOR Co := 0 TO ClientWIDTH DIV Image1.Picture.Width do
BitBlt(MyDC, Co*Image1.Picture.Width, Ro*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;

第六步:在Form1的创建事件中加入:
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
上面的步骤已经完成了MDI主窗口背景图案的设置,下面可以增加一个MDIChild窗口,实现MDI程序。
第七步:新增加一个Form,并将FormStyle设置为fsMDIChild。
现在你可以编译运行这个程序,你会发现,Image元件并不会在Form上显示出来,但是整个Form的客户区域被Image中的图像所铺满。
 
后退
顶部