{******************************************************************} { ImgUtil.pas } { } { Author : A.Nasir Senturk } { Home Page : http://www.shenturk.com } { Email : shenturk@gmail.com } { } { Date : 28.11.2006 } { } { Sizden iki şey rica edicem: } { 1. Lutfen bu baslik kismini kaldirmayiniz. } { 2. Mumkunse bagis yapiniz. } { *****************************************************************} unit ImgUtil; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, GdipApi, GdipObj, DirectDraw, TextUtil, ExtCtrls; type TGdiImage = class(TWinControl) private FCanvas: TGPGraphics; FBuffer: TGPBitmap; FBitmap: TGPBitmap; FOpacity: Byte; procedure AllocateHandle; procedure ReleaseHandle; protected procedure WMPaint(var Message: TWMPaint); message WM_PAINT; procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND; procedure CreateWnd; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Paint(Canvas: TGPGraphics); virtual; property Bitmap: TGPBitmap read FBitmap write FBitmap; property Opacity: Byte read FOpacity write FOpacity; property Color; end; implementation { TGdiImage } procedure TGdiImage.AllocateHandle; begin FBuffer := TGPBitmap.Create(Width, Height, PixelFormat32bppARGB); FCanvas := TGPGraphics.Create(FBuffer); end; constructor TGdiImage.Create(AOwner: TComponent); begin inherited Create(AOwner); DoubleBuffered := True; ControlStyle := ControlStyle - [csOpaque] + [csParentBackground]; FOpacity := 255; end; procedure TGdiImage.CreateWnd; begin inherited CreateWnd; SetWindowLong(Parent.Handle, GWL_STYLE, GetWindowLong(Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN); end; destructor TGdiImage.Destroy; begin ReleaseHandle; inherited Destroy; end; procedure TGdiImage.Paint(Canvas: TGPGraphics); var SolidBrush: TGPSolidBrush; begin SolidBrush := TGPSolidBrush.Create(ColorRefToARGB(ColorToRGB(Color))); try Canvas.FillRectangle(SolidBrush, 0, 0, Width, Height); if Assigned(FBitmap) then DrawImageTo(Canvas, 0, 0, Width, Height, FBitmap, Opacity); finally SolidBrush.Free; end; end; procedure TGdiImage.ReleaseHandle; begin FreeAndNil(FBuffer); FreeAndNil(FCanvas); end; procedure TGdiImage.WMEraseBkgnd(var Message: TWmEraseBkgnd); begin end; procedure TGdiImage.WMPaint(var Message: TWMPaint); var DC: HDC; PS: TPaintStruct; Graphics: TGPGraphics; begin ReleaseHandle; AllocateHandle; DC := BeginPaint(Handle, PS); if DC = 0 then; Graphics := TGPGraphics.Create(Handle, False); //Graphics := TGPGraphics.Create(DC); try Paint(FCanvas); Graphics.DrawImage(FBuffer, 0, 0, FBuffer.GetWidth, FBuffer.GetHeight); finally Graphics.Free; end; EndPaint(Handle, PS); Message.Result := 0; end; procedure TGdiImage.WMWindowPosChanging(var Message: TWMWindowPosChanging); var R : TRect; begin R := ClientRect; InvalidateRect(Handle, @R, False); end; end.