可不可以在MDI的主窗口右下角放个图片? (50分)

  • 主题发起人 主题发起人 娃娃
  • 开始时间 开始时间
你知道吗,D6和D7中TWinControl都有一个 Anchors 的属性,正是你所要的!

根据你的需求,只需将 Image 在设计时放好在你MDI窗口上的右下角位置,然后
设置 Anchors 中的 akLeft = False, akTop = False, akRight = True, akBottom = True 即可。
这时(即使在设计时)你可以放大或缩小窗口试试!
一定灵!
 
to bundur
你的这个方法倒真是长了小弟不少见识,不过很可惜,在程序运行的时候不见效啊。

 
不会吧!难道MDI窗口就不是从TWinControl中继承来的!
 
使用yue_shan的代碼
然後把這一段改一下
應該不會花的
WM_ERASEBKGND:
begin
CallWindowProc(FOldClientProc, ClientHandle, Message.Msg,
Message.WParam, Message.LParam);
FDrawDC := TWMEraseBkgnd(Message).DC;
GetWindowRect(ClientHandle, CR);


with Image1 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);
//這一句是把畫在中間
//想畫右下角,吧第2, 3個參數改一下.
//應該是cr.right-picture.width, cr.bottom-picture.height
//理解cr就是mdi的客戶區域就好了

Message.Result := 1;
end;
 
我试了一下可以呀!
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, jpeg, StdCtrls;

type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses
Unit2;

{$R *.dfm}

end.

{=====================}
unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls;

type
TForm2 = class(TForm)
Image1: TImage;
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

end.
 
to bundur 不知道你用的是D几,我的是D6,真的是不行。
 
我真是晕了,难道我的Delphi有问题?为什么总是不行的?

我这里真是不行的啊。我截了几幅图,大家留个信箱帮我看看吧。
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, jpeg, StdCtrls;

type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses
Unit2;

{$R *.dfm}

end.

{=====================}
unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls;

type
TForm2 = class(TForm)
Image1: TImage;
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

end.
可以啊
 
什么东东? 又说我灌水.
 
smallsun007
我不知道是怎么回事,我的真是不行啊。刷新不及时,总是花屏的。

现在主要是要解决当MDI主窗口改变大小的时候保证不花屏,最好也不闪烁。
有MDI子窗口且拖动、改变大小时不会出现花屏及其它异常。
 
我当初想把图片放到中间,也从来没有试验出好的方法,最后只能把图片放到左上角,或者延顶边或左边平铺。如果你最后试出了好方法麻烦你告诉我一声,多谢多谢了。xsfox@sina.com
 
大家伙,明天是星期天,我再等一天吧,高手,出招吧,不是就这个小问题就把大富翁上的高手们都难到了吧?
 
这个可以,显示的位置自己调整吧!
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus;

type
TForm1 = class(TForm)
Image2: TImage;
MainMenu1: TMainMenu;
aaa1: TMenuItem;
bbb1: TMenuItem;
ccc1: TMenuItem;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
PROCEDURE ClientWndProc(VAR Message: TMessage);
public
FClientInstance,FPrevClientProc:TFarProc;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.ClientWndProc(var Message: TMessage);

var MyDC : hDC;
begin
with Message do
case Msg of
// wm_size:
// InvalidateRect(CLientHandle,nil,True);
WM_ERASEBKGND:
begin
MyDC := TWMEraseBkGnd(Message).DC;
{ StretchBlt(MyDC,
0 , 0 , ClientWidth , ClientHeight ,
Image2.Picture.Bitmap.canvas.Handle ,
0, 0 ,Image2.Picture.Width, Image2.Picture.Height,
SRCCOPY);}
FloodFill(mydc,0,0,color);
bitblt(mydc,10,10,50,50,Image2.Picture.Bitmap.Canvas.Handle,0,0,SRCCOPY);
Result := 1;
end;
WM_PAINT:begin
InvalidateRect(CLientHandle,nil,True);
Message.Result:=CallWindowProc(FPrevClientProc,ClientHandle,Message.Msg,Message.WParam,Message.LParam);
Result :=0;
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if Assigned(Image2.Picture) then begin
FClientInstance := Classes.MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
end;

end;

end.
 
加个状态条,在状态条上画个图不就好了,一般Mdi主窗体状态条还是要的吧。
 
不是一个小图片啊,状态条怎么可能放得下呢。

是一个200X100左右的图片。
 
有段C++代码供你参考,在MDI背景上绘图片,写字。很容易能改成Pascal.
代码中用两个TImage控件分别存放背景图片和标题图片,放在MDI主窗体上。

//---------------------------------------------------------------------------
// 窗口背景
//---------------------------------------------------------------------------
void __fastcall TSemMainForm::CreateWnd()
{
// let the base class CreateWnd do what it needs to do to
// create a main window for the program.
TForm::CreateWnd();

// subclass the MDI client window so we can replace its default
// message handler with our own. MakeObjectInstance transposes
// the ClientProc function into a form that the API likes.
// SetWindowLong then subclass the MDI client (ClientHandle)
// using the return value from MakeObjectInstance.
ClientObjectInstance = MakeObjectInstance (ClientProc) ;
OriginalClientProc = (Pointer) SetWindowLong (ClientHandle,
GWL_WNDPROC,
(long) ClientObjectInstance);
}

//---------------------------------------------------------------------------
void __fastcall TSemMainForm::ClientProc (TMessage &Msg)
{

switch(Msg.Msg)
{
case WM_ERASEBKGND:
// intercept the message for painting the background and
// draw the background ourself
DrawClientWindow ((HDC) Msg.WParam) ;
Msg.Result = true;
return;

case WM_HSCROLL:
case WM_VSCROLL:
//scrolling the client area can goof up our drawing. if the user scrolls
//the client area, pass the message on to the original procedure and
//then request a complete repaint of the background.
Msg.Result = CallWindowProc ((FARPROC)OriginalClientProc, ClientHandle,
Msg.Msg, Msg.WParam, Msg.LParam);
InvalidateRect (ClientHandle, 0, true) ;
break ;

default:
// pass all other messages on to the original window procedure
// stored in OriginalClientProc
Msg.Result = CallWindowProc ((FARPROC)OriginalClientProc, ClientHandle,
Msg.Msg, Msg.WParam, Msg.LParam);
}
}

//---------------------------------------------------------------------------
void __fastcall TSemMainForm::DrawClientWindow (HDC &Hdc)
{

if( ClientHandle == 0 )
return;

TRect rect ; // calculate size of backgnd
::GetClientRect (ClientHandle, (RECT *) &rect) ;

// painting a shaded gradient is slow, and can cause flickering
// eliminate flicker by using memory bitmaps and BitBlit
Graphics::TBitmap *MemBitmap = new Graphics::TBitmap;
MemBitmap->Width = rect.Right - rect.Left;
MemBitmap->Height= rect.Bottom- rect.Top;

// Gradient fill background
// GradientFillRect(MemBitmap->Canvas, rect, clBlue, clBlack, fdTopToBottom, 255);
// 用图片填充背景
// imgBkGrd是TImage控件,存放背景图片
for( int x = 0; x < ClientWidth; x += imgBkGrd->Picture->Width )
for( int y = 0; y < ClientHeight; y += imgBkGrd->Picture->Height )
MemBitmap->Canvas->Draw( x, y, imgBkGrd->Picture->Graphic );

// 标题图片
// imgTitle是TImage控件,存放标题
MemBitmap->Canvas->Draw( 14, 20, imgTitle->Picture->Graphic );

MemBitmap->Canvas->Font->Name = "宋体";
MemBitmap->Canvas->Font->Size = 11;
MemBitmap->Canvas->Brush->Style = bsClear;

AnsiString str = String("授权用户:") + FUserOrgn;
int y = 24 + imgTitle->Picture->Graphic->Height;
MemBitmap->Canvas->Font->Color = TColor(0xC7B6A8);
MemBitmap->Canvas->TextOut( 17, y + 2, str );
MemBitmap->Canvas->Font->Color = cl3DDkShadow;
MemBitmap->Canvas->TextOut( 18, y, str );
MemBitmap->Canvas->Font->Color = clAqua;
MemBitmap->Canvas->TextOut( 20, y, str );
MemBitmap->Canvas->Font->Color = clBlue;
MemBitmap->Canvas->TextOut( 19, y, str );

// Use API BitBlt to copy pixels to the screen.
::BitBlt(Hdc,0,0,MemBitmap->Width, MemBitmap->Height,
MemBitmap->Canvas->Handle,0,0,SRCCOPY);
delete MemBitmap; // delete the temporary bitmap.
}

//---------------------------------------------------------------------------
void __fastcall TSemMainForm::DestroyWnd ()
{

SetWindowLong(ClientHandle, GWL_WNDPROC, (long) OriginalClientProc);
FreeObjectInstance(ClientObjectInstance);
TForm::DestroyWnd();
}

//---------------------------------------------------------------------------
void __fastcall TSemMainForm::WMEraseBkgnd(TWMEraseBkgnd &amp;Msg)
{
// tell Windows to forget about the
Msg.Result = false; // background. MDI client will draw
} // it later
//---------------------------------------------------------------------------

头文件申明:
MESSAGE_HANDLER(WM_ERASEBKGND, TWMEraseBkgnd, WMEraseBkgnd)
 
这个问题我已经解决了。但是Delphi6 Mdi下如果使用了Splitter就会出现一条阴影的问题还没有解决。
下面是画图片的代码:
......
private
{ Private declarations }
FClientInstance,
FPrevClientProc : TFarProc;
procedure ClientWndProc(var Message: TMessage);
procedure CreateMDIChild(const Name: string);
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.FormShow(Sender: TObject);
begin
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
end;

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;
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
BitBlt( MyDC,ClientWidth-Image1.Picture.Width,ClientHeight-Image1.Picture.Height,
Image1.Picture.Width,Image1.Picture.Height,Image1.Picture.Bitmap.Canvas.Handle,
0, 0, SRCCOPY);
Result := 1;
end;
WM_PAINT:
begin
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;

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

procedure TMainForm.FormCreate(Sender: TObject);
begin
self.Brush.Color := Image1.Picture.Bitmap.TransparentColor;
end;
 
to lajfox
我试了一下你的代码,不知道是那里错了,CPU的占用率竟然一直是100%
 
真的是这样,我解决不了。
 
有没有朋友再想想办法的。等待中………
 
后退
顶部