Poner una imagen de fondo en una aplicación MDI
Artículo por Club Developers · 31 diciembre 2005
5541 vistas
Para conseguir este propósito, vamos a presentar una unit (componente) que realizará esta tarea por nosotros. De lo que se trata es de sustituir el método que controla la zona cliente de la ventana MDI para reemplazarlo por un método de sustitución que permitirá dibujar una imagen a nuestro gusto.
El componente permite poner la imagen en mosaico o estirado.
Y su forma de uso sencilla:
El componente permite poner la imagen en mosaico o estirado.
delphi
unit imMDIBkg; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type TPositionImage = (piMosaic, piStretch); TimMDIBkg = class(TComponent) private FBitmap: TBitmap; FForm: TForm; FPosImage: TPositionImage; procedure SetBitmap(Value: TBitmap); procedure InternalClientProc(var M: TMessage); procedure SetPosImage(const Value: TPositionImage); protected FClientInstance: TFarProc; FPrevClientProc: TFarProc; property Form: TForm read FForm; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Bitmap: TBitmap read FBitmap write SetBitmap; property PosImage: TPositionImage read FPosImage write SetPosImage; end; implementation { TimMDIBkg } constructor TimMDIBkg.Create(AOwner: TComponent); begin inherited Create(AOwner); FForm := AOwner as TForm; FBitmap := TBitmap.Create; FPosImage := piMosaic; FClientInstance := MakeObjectInstance(InternalClientProc); FPrevClientProc := Pointer( SetWindowLong(Form.ClientHandle, GWL_WNDPROC, Integer(FClientInstance)) ); end; destructor TimMDIBkg.Destroy; begin SetWindowLong(Form.ClientHandle, GWL_WNDPROC, Integer(FPrevClientProc)); FreeObjectInstance(FClientInstance); FBitmap.Free; inherited Destroy; end; procedure TimMDIBkg.InternalClientProc(var M: TMessage); var SrcDC, DstDC: hDC; R, C, H, W: Word; begin if not FBitmap.Empty then case M.Msg of WM_HSCROLL, WM_VSCROLL: InvalidateRect(Form.ClientHandle, nil, False); WM_ERASEBKGND: begin SrcDc := Bitmap.Canvas.Handle; DstDc := TWMEraseBkGnd(M).DC; H := Bitmap.Height; W := Bitmap.Width; case FPosImage of piMosaic: for R := 0 to Form.ClientHeight div H do for C := 0 to Form.ClientWidth div W do BitBlt(DstDC, C * W, R * H, W, H, SrcDC, 0, 0, SRCCOPY); piStretch: StretchBlt(DstDC, 0, 0, Form.ClientWidth, Form.ClientHeight, SrcDC, 0, 0, W, H, SRCCOPY); end; M.Result := 1; Exit; end; end; M.Result := CallWindowProc(FPrevClientProc, Form.ClientHandle, M.Msg, M.wParam, M.lParam); end; procedure TimMDIBkg.SetBitmap(Value: TBitmap); begin FBitmap.Assign(Value); FForm.Invalidate; end; procedure TimMDIBkg.SetPosImage(const Value: TPositionImage); begin FPosImage := Value; FForm.Invalidate; end; end.
Y su forma de uso sencilla:
delphi
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, imMDIBkg; type TForm1 = class(TForm) private imMDIBkg1: TimMDIBkg; public constructor Create(aOwner: TComponent); override; end; var Form1: TForm1; implementation {$R *.dfm} { TForm1 } constructor TForm1.Create(aOwner: TComponent); begin inherited; imMDIBkg1 := TimMDIBkg.Create(Self); imMDIBkg1.Bitmap.LoadFromFile('c:\miImagen.bmp'); imMDIBkg1.PosImage := piStretch; end; end.