如何在MDI应用程序的WORKSPACE内设置背景图？(100分)

如何在MDI应用程序的WORKSPACE内设置背景图？
我放置了IMAGE控件，但执行时就看不到了。

源码在这：）给分吧：）
private
{ Private declarations }
FClientInstance, FPrevClientProc : TFarProc;
procedure ClientWndProc(VAR Message: TMessage);
var
mainForm: TmainForm;
implementation
{$R *.DFM}
procedure TmainForm.ClientWndProc(VAR Message: TMessage);
var
MyDC : hDC;
Ro, Co : Word;
begin
with Messagedo
case Msg of
WM_ERASEBKGND:
begin
MyDC := TWMEraseBkGnd(Message).DC;
for Ro := 0 TO ClientHeight DIV imgClient.Picture.Heightdo
for Co := 0 TO ClientWIDTH DIV imgClient.Picture.Widthdo
BitBlt(MyDC, Co*imgClient.Picture.Width, Ro*imgClient.Picture.Height,
imgClient.Picture.Width, imgClient.Picture.Height,
imgClient.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;

procedure TmainForm.FormCreate(Sender: TObject);
begin

FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
end;

Tcompoment
unit uTiler;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TTileMode = (tmTile, tmStretch, tmCenter,
tmLeftVCenter, tmLeftVTop, tmLeftVBottom,
tmRightVCenter, tmRightVTop, tmRightVBottom,
tmCenterVTop, tmCenterVBottom);
TTiler = class(TComponent)
private
FAutomaticAttach: Boolean;
FActive: Boolean;
FBitmap: TBitmap;
FTileMode: TTileMode;
FHandle: HWND;
Form: TForm;
VOffset: Integer;
HOffset: Integer;
FClientInstance: TFarProc;
FDefClientProc: TFarProc;
procedure SetActive(Value: Boolean);
procedure SetBitmap(Value: TBitmap);
procedure SetTileMode(Value: TTileMode);
procedure ClientWndProc(var Message: TMessage);
procedure FillClientArea(DC: HDC);
procedure Stretch(DC: HDC);
procedure Tile(DC: HDC);
procedure Center(DC: HDC);
procedure Spot(DC: HDC);
{ Private declarations }
protected
procedure Loaded;
override;
{ Protected declarations }
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure Attach;
procedure Detach;
procedure Redraw;
{ Public declarations }
published
property AutomaticAttach: Boolean read FAutomaticAttach write FAutomaticAttach;
property Active: Boolean read FActive write SetActive;
property Bitmap: TBitmap read FBitmap write SetBitmap;
property TileMode: TTileMode read FTileMode write SetTileMode;
{ Published declarations }
end;

procedure Register;
implementation
constructor TTiler.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBitmap := TBitmap.Create;
FAutomaticAttach := True;
end;

destructor TTiler.Destroy;
begin
Detach;
FBitmap.Free;
inherited Destroy;
end;

procedure TTiler.Attach;
begin
if not (Owner is TForm)
then
raise Exception.Create('Can''t attach TTiler component to something else
than a TForm.');
if not Assigned(FClientInstance) // only attach once!
then
begin
if (Owner as TForm).FormStyle = fsMDIForm
then
FHandle := (Owner as TForm).ClientHandle
else
FHandle := (Owner as TForm).Handle;
FClientInstance := MakeObjectInstance(ClientWndProc);
FDefClientProc := Pointer(GetWindowLong(FHandle, GWL_WNDPROC));
SetWindowLong(FHandle, GWL_WNDPROC, LongInt(FClientInstance));
Form := Owner as TForm;
if Active
then
begin
Active := False;
Active := True;
end;
end;
end;

procedure TTiler.Detach;
begin
if Active and Assigned(FClientInstance)
then
begin
Active := False;
// clear client area
FActive := True;
// put old value back for redrawing when attach again
end;
if Assigned(FClientInstance) // if attached
then
begin
SetWindowLong(FHandle, GWL_WNDPROC, LongInt(FDefClientProc));
FreeObjectInstance(FClientInstance);
end;
FClientInstance := nil;
end;

procedure TTiler.Redraw;
var b: Boolean;
begin
b := Active;
Active := False;
Active := b;
end;

procedure TTiler.ClientWndProc(var Message: TMessage);
procedure Default;
begin
with Message
do
Result := CallWindowProc(FDefClientProc, FHandle, Msg, wParam, lParam);
end;
begin
with Message
do
begin
case Msg of
WM_NCHITTEST : begin
Default;
if FHandle = Form.ClientHandle
then
if Result = HTCLIENT
then
Result := HTTRANSPARENT;
end;
WM_ERASEBKGND : begin
if Assigned(FBitmap) and Active and (FHandle <> 0) and (FBitmap.Handle <> 0)
then
FillClientArea(TWMEraseBkgnd(Message).DC)
else
FillRect(TWMEraseBkgnd(Message).DC, (Owner as TForm).ClientRect, (Owner as TForm).Brush.Handle);
Result := 1;
end;
WM_VSCROLL,
WM_HSCROLL,
WM_SIZE : begin
Default;
InvalidateRect(FHandle, nil, True);
end;
else
Default;
end;
end;
end;

procedure TTiler.Loaded;
begin
inherited Loaded;
if AutomaticAttach
then
Attach;
end;

procedure TTiler.FillClientArea(DC: HDC);
begin
if FHandle <> 0
then
case FTileMode of
tmTile : Tile(DC);
tmStretch : Stretch(DC);
tmCenter : Center(DC);
tmLeftVCenter,
tmLeftVTop,
tmLeftVBottom,
tmRightVCenter,
tmRightVTop,
tmRightVBottom,
tmCenterVTop,
tmCenterVBottom : Spot(DC);
end;
ReleaseDC(FHandle, DC);
end;

procedure TTiler.Spot(DC: HDC);
var y, x: LongInt;
begin
x := 0;
y := 0;
if TileMode in [tmRightVTop, tmRightVCenter, tmRightVBottom]
then
x := Form.ClientWidth - FBitmap.Width - 1;
if TileMode in [tmCenterVTop, tmCenterVBottom]
then
x := (Form.ClientWidth div 2) - (FBitmap.Width div 2);
case TileMode of
tmLeftVCenter,
tmRightVCenter : y := (Form.ClientHeight div 2) - (FBitmap.Height div 2);
tmLeftVTop,
tmRightVTop,
tmCenterVTop : y := 0;
tmLeftVBottom,
tmRightVBottom,
tmCenterVBottom : y := Form.ClientHeight - FBitmap.Height;
end;
FillRect(DC, (Owner as TForm).ClientRect, (Owner as TForm).Brush.Handle);
BitBlt(DC, x, y, FBitmap.Width, FBitmap.Height, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TTiler.Center(DC: HDC);
var R: TRect;
x, y: LongInt;
w, h: LongInt;
begin
R := Form.ClientRect;
x := (R.Right div 2) - (FBitmap.Width div 2);
y := (R.Bottom div 2) - (FBitmap.Height div 2);
w := x + FBitmap.Width;
h := y + FBitmap.Height;
FillRect(DC, R, Form.Brush.Handle);
BitBlt(DC, x, y, w, h, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TTiler.Stretch(DC: HDC);
var R: TRect;
begin
R := Form.ClientRect;
StretchBlt(DC, R.Left, R.Top, R.Right, R.Bottom, FBitmap.Canvas.Handle, 0, 0, FBitmap.Width, FBitmap.Height, SRCCOPY);
end;

procedure TTiler.Tile(DC: HDC);
var x, y, bmWidth, bmHeight: Integer;
bmHandle: HBITMAP;
begin
bmWidth := FBitmap.Width;
bmHeight := FBitmap.Height;
bmHandle := FBitmap.Canvas.Handle;
x := HOffset;
while x < Form.Width
do
begin
y := 0;
while y < Form.Height
do
begin
BitBlt(DC, x, y, x + bmWidth, y + bmHeight,
bmHandle, 0, 0, SRCCOPY);
BitBlt(DC, x, y + bmHeight, x + bmWidth, y + bmHeight,
bmHandle, 0, 0, SRCCOPY);
BitBlt(DC, x + bmWidth, y, x + bmWidth, y + bmHeight,
bmHandle, 0, 0, SRCCOPY);
BitBlt(DC, x + bmWidth, y + bmHeight, x + bmWidth, y + bmHeight,
bmHandle, 0, 0, SRCCOPY);
y := y + bmHeight * 1;
end;
x := x + bmWidth * 1;
end;
end;

procedure TTiler.SetActive(Value: Boolean);
var msg: TMessage;
begin
if (Value <> FActive) and Assigned(Owner)
then
begin
FActive := Value;
if not (csDesigning in ComponentState)
then
begin
if FHandle <> 0
then
begin
msg.Msg := WM_ERASEBKGND;
TWMEraseBkgnd(msg).DC := GetDC(FHandle);
ClientWndProc(msg) // fire once!
end;
end
else
{if FActive and not (csReading in ComponentState) and not (csLoading in ComponentState)
then
ShowMessage('TTiler won''t show any drawing at designtime...')};
end;
end;

procedure TTiler.SetBitmap(Value: TBitmap);
begin
FBitmap.Assign(Value);
end;

procedure TTiler.SetTileMode(Value: TTileMode);
begin
if Value <> FTileMode
then
begin
FTileMode := Value;
if (not (csDesigning in ComponentState)) and Active
then
begin
Active := False;
// clear all
Active := True;
// start drawing again
end;
end;
end;

procedure Register;
begin
RegisterComponents('MyComponent', [TTiler]);
end;

end.

To: Jhdandcl
你的构件不错，只不过计算位置时没有扣除主窗口的其他控件的位置。如果有menu、
statusbar、toolbar等（一般mdi都有），位置计算就有问题了。

加入IMAGE

使用[red]DBImage[/red]控件

FClientInstance, FPrevClientProc : TFarProc;
procedure ClientWndProc(VAR Message: TMessage);
procedure ShowHint(Sender: TObject);
public
{ Public declarations }
var
mainForm: TmainForm;
implementation
{$R *.DFM}
procedure TmainForm.ClientWndProc(VAR Message: TMessage);
var
MyDC : hDC;
Ro, Co : Word;
begin
with Messagedo
case Msg of
WM_ERASEBKGND:
begin
MyDC := TWMEraseBkGnd(Message).DC;
for Ro := 0 TO ClientHeight DIV imgClient.Picture.Heightdo
for Co := 0 TO ClientWIDTH DIV imgClient.Picture.Widthdo
BitBlt(MyDC, Co*imgClient.Picture.Width, Ro*imgClient.Picture.Height,
imgClient.Picture.Width, imgClient.Picture.Height,
imgClient.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;

procedure TmainForm.FormCreate(Sender: TObject);
var fBKground:TIniFile;
strFileName:String;
strinifile:String;
value: String;
begin

Application.OnHint := ShowHint;
strinifile:= ExtractFilePath((Application.ExeName))+'wtjbb.ini';
fBKGround:=TIniFile.Create(strinifile);
strFileName:=fBKground.ReadString('BKGROUND','BITMAP',strFileName);
value:= fBKground.ReadString('TOOLBAR','SHOW',value);
if (value = 'false') then
mntoolbar.Checked := false
else
mntoolbar.Checked := true;
ControlBar1.Visible := mntoolbar.Checked;
value := '';
value:= fBKground.ReadString('STATUSBAR','SHOW',value);
if (value = 'false') then
mnstatusbar.Checked := false
else
mnstatusbar.Checked := true;
StatusBar1.Visible := mnstatusbar.Checked;
if length(strFileName)<>0 then
Mainform.imgClient.Picture.LoadFromFile(strFileName);
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
end;

最简单的用个第三方控件。代码都不用写！
MDI Wallpaper v2.0.0
墙纸构件，可将Form背景填充为指定图案，多种填充方式，使用简单。
http://www.delphibyte.com/download/softdown.php?softid=30&amp;url=http://61.132.118.165/soft/delphi/Delphi/uestc/Delphi/mdiwallp.zip

Jhdandcl：你的构件不错，有点小毛病（如上所述），我自己想办法克服吧。谢谢！
不懂编程：你的程序我看过了，应该可以，但我没有亲自试验，只能意思意思了，见谅。