Hintergrundbild in MDI Formular

[Uwe Stachel]

Hallo zusammen,

wie kann ich denn in einem MDI Hauptfenster eine Grafik zentriert auf den Bildschirm bringen?

Gruß
Uwe

[Mario.Noack]

Gar nicht <br>
Wir haben darum ein Rahmenloses Form, was einfach nur eine Grafik enthält und nur so aussieht, wie eine Grafik auf dem Hintergrund. Den Ansatz solltest Du vielleicht auch versuchen, ist eigentlich recht zuverlässig!<p>
Schöne Grüße, Mario Noac

[Jens Schumann]

Hallo Mario,<br>
und wie man sieht, geht es doch<br>
<pre>
<font face="Verdana" size="1" color="#000000">unit Unit1;

interface

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

type
TFormMDI = class(TForm)
MainMenu1: TMainMenu;
Datei1: TMenuItem;
mmNew: TMenuItem;
N1: TMenuItem;
mmClose: TMenuItem;
procedure mmCloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure mmNewClick(Sender: TObject);
private
{ Private-Deklarationen }
FWallpaperBmp : TBitmap;
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure ClientWndProc(var Message: TMessage);
public
{ Public-Deklarationen }
end;

var
FormMDI : TFormMDI;
ApplicationPath : String;

implementation

uses Unit2;

{$R *.DFM}

procedure TFormMDI.mmCloseClick(Sender: TObject);
begin
Close;
end;

procedure TFormMDI.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;
for Row := 0 to ClientHeight div FWallpaperBmp.Height do
for Col := 0 to ClientWidth div FWallpaperBmp.Width do
BitBlt(Dc,
Col * FWallpaperBmp.Width,
Row * FWallpaperBmp.Height,
FWallpaperBmp.Width,
FWallpaperBmp.Height,
FWallpaperBmp.Canvas.Handle,
0,
0,
SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
end;
end;

procedure TFormMDI.FormCreate(Sender: TObject);
begin
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
SetWindowLong(ClientHandle,GWL_WNDPROC, LongInt(FClientInstance));
FWallpaperBmp:=TBitmap.Create;
FWallpaperBmp.LoadFromFile(Applicationpath+'EinBil d.bmp');
end;

procedure TFormMDI.FormDestroy(Sender: TObject);
begin
FWallpaperBmp.Free;
FWallpaperBmp:=Nil;
end;

procedure TFormMDI.mmNewClick(Sender: TObject);
var
NewMDI : TFormChild;
begin
NewMDI:=TFormChild.Create(Self);
NewMDI.Show;
end;

initialization
ApplicationPath:=ExtractFilePath(Application.ExeNa me);
ApplicationPath:=IncludeTrailingBackslash(Applicat ionPath);

end.</font>
</pre>
<b><font face="Verdana" size="2" color="#FF0000">//Quelle: http://community.borland.com/article/0,1410,15176,00.html</font><br>
</b><br&gt

[Jens Schumann]

Hallo,<br>
wenn ein MDI-Child mit der vorherigen Version den sichtbaren Bereich verläßt, sodaß<br>
gescrollt werden muß, wird der Hintergurnd nicht richtig gezeichnet.<br>
Hier die Abhilfe:<br>
<pre>
<font face="Verdana" size="1" color="#000000">unit Unit1;
interface

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

type
TFormMDI = class(TForm)
MainMenu1: TMainMenu;
Datei1: TMenuItem;
mmNew: TMenuItem;
N1: TMenuItem;
mmClose: TMenuItem;
Fenster1: TMenuItem;
procedure mmCloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure mmNewClick(Sender: TObject);
private
{ Private-Deklarationen }
FWallpaperBmp : TBitmap;
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure ClientWndProc(var Message: TMessage);
procedure PaintWallpaper;
public
{ Public-Deklarationen }
end;

var
FormMDI : TFormMDI;
ApplicationPath : String;

implementation

uses Unit2;

{$R *.DFM}

procedure TFormMDI.mmCloseClick(Sender: TObject);
begin
Close;
end;

procedure TFormMDI.ClientWndProc(var Message: TMessage);
var
aDC : hDC;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
PaintWallpaper;
Result:=1;
end;
else
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
end;
end;

procedure TFormMDI.FormCreate(Sender: TObject);
begin
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
SetWindowLong(ClientHandle,GWL_WNDPROC, LongInt(FClientInstance));
FWallpaperBmp:=TBitmap.Create;
FWallpaperBmp.LoadFromFile(Applicationpath+'NanneF ace.bmp');
end;

procedure TFormMDI.FormDestroy(Sender: TObject);
begin
FWallpaperBmp.Free;
FWallpaperBmp:=Nil;
end;

procedure TFormMDI.mmNewClick(Sender: TObject);
var
NewMDI : TFormChild;
begin
NewMDI:=TFormChild.Create(Self);
NewMDI.Show;
end;

procedure TFormMDI.PaintWallpaper;
var
Row : Integer;
Col : Integer;
WndRect : TRect;
WndDC : hDC;
begin
GetWindowRect(ClientHandle,WndRect);
WndDC:=GetDC(ClientHandle);
Try
for Row := 0 to WndRect.Bottom div FWallpaperBmp.Height do
for Col := 0 to WndRect.Right div FWallpaperBmp.Height do
BitBlt(WndDC,
Col * FWallpaperBmp.Width,
Row * FWallpaperBmp.Height,
FWallpaperBmp.Width,
FWallpaperBmp.Height,
FWallpaperBmp.Canvas.Handle,
0,
0,
SRCCOPY);
Finally
ReleaseDC(ClientHandle,WndDC);
end;
end;

initialization
ApplicationPath:=ExtractFilePath(Application.ExeNa me);
ApplicationPath:=IncludeTrailingBackslash(Applicat ionPath);

end.</font>
</pre&gt

[Mario.Noack]

Cool! Das hätte ich damals finden müssen Na ja, wenn ich's noch mal brauche, habe ich es nun ....<p>
Schöne Grüße, Mario Noac

[Markus Felten]

Hallo zusammen,

Es geht auch so : eine Panel-Komponente mit einer Image-Komponente auf's MDI-Form legen.
Im OnShow-Ereignis des Formulars folgendes hinzufügen :

Panel.Parent := nil;

Panel.ParentWindow := ClientHandle;

Im Resize-Ereignis des MDI-Forms die Position des Panels neu berechnen :

Panel.Left := ClientWidth - Panel.Width - x;

Panel.Top := ClientHeigth - Panel.Height - y;

Grüße,
Marku

[Jens Schumann]

Hallo,<br>
hier das Ganze als Komponente:<br>
<pre>
<font face="Verdana" size="1" color="#080000">unit JsWallpaper;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TJsWallpaperMode = (wmTile,wmCenter);

TJsWallpaper = class(TComponent)
private
{ Private-Deklarationen }
FWallpaper : TBitmap;
FMode : TJsWallpaperMode;
FOwnerForm : TForm;
FOwnerHandle : HWND;
FClientInstance : Pointer;
FPrevClientProc : Pointer;
FOnPaint : TNotifyEvent;
procedure SetWallpaper(const Value: TBitmap);
procedure SetMode(const Value: TJsWallpaperMode);
procedure ClientWndProc(var Message: TMessage);
procedure PaintWallpaper(WindowHandle : HWND);
procedure SetNewWndProc;
procedure PaintCenterWallpaper(WndDC: HDC; WndRect : TRect);
procedure PaintTileWallpaper(WndDC: HDC; WndRect : TRect);
protected
{ Protected-Deklarationen }
procedure Loaded; override;
public
{ Public-Deklarationen }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
{ Published-Deklarationen }
property Mode : TJsWallpaperMode read FMode write SetMode default wmTile;
property Wallpaper : TBitmap read FWallpaper write SetWallpaper;
property OnPaint : TNotifyEvent read FOnPaint write FOnPaint;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Mycomps', [TJsWallpaper]);
end;

{ TJsWallpaper }

procedure TJsWallpaper.ClientWndProc(var Message: TMessage);
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
PaintWallpaper(FOwnerHandle);
Result:=1;
end;
else
Result := CallWindowProc(FPrevClientProc,FOwnerHandle,Msg,wP aram,lParam);
end;
end;

constructor TJsWallpaper.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWallpaper:=TBitmap.Create;
FMode:=wmTile;
end;

destructor TJsWallpaper.Destroy;
begin
FWallpaper.Free;
SetWindowLong(FOwnerHandle,GWL_WNDPROC, LongInt(FPrevClientProc));
inherited Destroy;
end;

procedure TJsWallpaper.Loaded;
begin
inherited Loaded;
If Not (csDesigning in ComponentState) then
begin
If (Not (Owner is TForm)) or (Owner=Nil) then
raise Exception.Create('Besitzer von TJsWallpaper muß ein TForm sein');

FOwnerForm:=TForm(Owner);
If FOwnerForm.FormStyle=fsMDIForm then
FOwnerHandle:=FOwnerForm.ClientHandle
else
FOwnerHandle:=FOwnerForm.Handle;
SetNewWndProc;
end; // If Not (csDesigning in ComponentState) then
end;

procedure TJsWallpaper.PaintWallpaper(WindowHandle: HWND);
var
WindowRect : TRect;
WindowDeviceContext : hDC;
begin
If FWallpaper.Empty then
Exit;
GetWindowRect(FOwnerHandle,WindowRect);
WindowDeviceContext:=GetDC(FOwnerHandle);
Try
case FMode of
wmTile : PaintTileWallpaper(WindowDeviceContext,WindowRect) ;
wmCenter : PaintCenterWallpaper(WindowDeviceContext,WindowRec t);
end;
If Assigned(FOnPaint) then
FOnPaint(Self);
Finally
ReleaseDC(FOwnerHandle,WindowDeviceContext);
end;
end;

procedure TJsWallpaper.PaintTileWallpaper(WndDC: HDC; WndRect : TRect);
var
Row : Integer;
Col : Integer;
begin
For Row := 0 to (WndRect.Bottom div FWallpaper.Height)+1 do
For Col := 0 to (WndRect.Right div FWallpaper.Width)+1 do
BitBlt(WndDC,
Col * FWallpaper.Width,
Row * FWallpaper.Height,
FWallpaper.Width,
FWallpaper.Height,
FWallpaper.Canvas.Handle,
0,
0,
SRCCOPY);
end;

procedure TJsWallpaper.PaintCenterWallpaper(WndDC: HDC; WndRect : TRect);
var
CenterX : Integer;
CenterY : Integer;
FillColor : TColo

[Jens Schumann]

Hallo,<br>
hier das Ganze als Komponente:<br>
<pre>
<font face="Verdana" size="1" color="#080000">unit JsWallpaper;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TJsWallpaperMode = (wmTile,wmCenter);

TJsWallpaper = class(TComponent)
private
{ Private-Deklarationen }
FWallpaper : TBitmap;
FMode : TJsWallpaperMode;
FOwnerForm : TForm;
FOwnerHandle : HWND;
FClientInstance : Pointer;
FPrevClientProc : Pointer;
FOnPaint : TNotifyEvent;
procedure SetWallpaper(const Value: TBitmap);
procedure SetMode(const Value: TJsWallpaperMode);
procedure ClientWndProc(var Message: TMessage);
procedure PaintWallpaper(WindowHandle : HWND);
procedure SetNewWndProc;
procedure PaintCenterWallpaper(WndDC: HDC; WndRect : TRect);
procedure PaintTileWallpaper(WndDC: HDC; WndRect : TRect);
protected
{ Protected-Deklarationen }
procedure Loaded; override;
public
{ Public-Deklarationen }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
{ Published-Deklarationen }
property Mode : TJsWallpaperMode read FMode write SetMode default wmTile;
property Wallpaper : TBitmap read FWallpaper write SetWallpaper;
property OnPaint : TNotifyEvent read FOnPaint write FOnPaint;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Mycomps', [TJsWallpaper]);
end;

{ TJsWallpaper }

procedure TJsWallpaper.ClientWndProc(var Message: TMessage);
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
PaintWallpaper(FOwnerHandle);
Result:=1;
end;
else
Result := CallWindowProc(FPrevClientProc,FOwnerHandle,Msg,wP aram,lParam);
end;
end;

constructor TJsWallpaper.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWallpaper:=TBitmap.Create;
FMode:=wmTile;
end;

destructor TJsWallpaper.Destroy;
begin
FWallpaper.Free;
SetWindowLong(FOwnerHandle,GWL_WNDPROC, LongInt(FPrevClientProc));
inherited Destroy;
end;

procedure TJsWallpaper.Loaded;
begin
inherited Loaded;
If Not (csDesigning in ComponentState) then
begin
If (Not (Owner is TForm)) or (Owner=Nil) then
raise Exception.Create('Besitzer von TJsWallpaper muß ein TForm sein');

FOwnerForm:=TForm(Owner);
If FOwnerForm.FormStyle=fsMDIForm then
FOwnerHandle:=FOwnerForm.ClientHandle
else
FOwnerHandle:=FOwnerForm.Handle;
SetNewWndProc;
end; // If Not (csDesigning in ComponentState) then
end;

procedure TJsWallpaper.PaintWallpaper(WindowHandle: HWND);
var
WindowRect : TRect;
WindowDeviceContext : hDC;
begin
If FWallpaper.Empty then
Exit;
GetWindowRect(FOwnerHandle,WindowRect);
WindowDeviceContext:=GetDC(FOwnerHandle);
Try
case FMode of
wmTile : PaintTileWallpaper(WindowDeviceContext,WindowRect) ;
wmCenter : PaintCenterWallpaper(WindowDeviceContext,WindowRec t);
end;
If Assigned(FOnPaint) then
FOnPaint(Self);
Finally
ReleaseDC(FOwnerHandle,WindowDeviceContext);
end;
end;

procedure TJsWallpaper.PaintTileWallpaper(WndDC: HDC; WndRect : TRect);
var
Row : Integer;
Col : Integer;
begin
For Row := 0 to (WndRect.Bottom div FWallpaper.Height)+1 do
For Col := 0 to (WndRect.Right div FWallpaper.Width)+1 do
BitBlt(WndDC,
Col * FWallpaper.Width,
Row * FWallpaper.Height,
FWallpaper.Width,
FWallpaper.Height,
FWallpaper.Canvas.Handle,
0,
0,
SRCCOPY);
end;

procedure TJsWallpaper.PaintCenterWallpaper(WndDC: HDC; WndRect : TRect);
var
CenterX : Integer;
CenterY : Integer;
FillColor : TColo

[Jens Schumann]

Hallo,<br>
ich habe mal eine kleine Komponente daraus gebastelt.<br>
http://home.t-online.de/home/jensschumann/wallpaper/jswallpaper.zip<br>
&#10