{******************************************************************}
{ GdipComp.pas                                                     }
{                                                                  }
{ Author    : A.Nasir Senturk                                      }
{ Home Page : http://www.shenturk.com                              }
{ Email     : shenturk@gmail.com                                   }
{                                                                  }
{ Date      : 21.01.2007                                           }
{                                                                  }
{ Sizden iki şey rica edicem:                                      }
{ 1. Lutfen bu baslik kismini kaldirmayiniz.                       }
{ 2. Mumkunse bagis yapiniz.                                       }
{ *****************************************************************}

unit GdipComp;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, GdipApi, GdipObj, DirectDraw, TextUtil, ExtCtrls;

type
  TGdipControl = class(TWinControl)
  private
    FCanvas: TGPGraphics;
    FBuffer: TGPBitmap;
    FBrush: TGPSolidBrush;
    FPen: TGPPen;
    FParentCanvas: TGPGraphics;
    procedure AllocateHandle;
    procedure ReleaseHandle;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
    procedure Paint(Canvas: TGPGraphics); virtual;
    procedure CreateWnd; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property ParentCanvas: TGPGraphics read FParentCanvas write FParentCanvas;
  end;

implementation

{ TGdipControl }

procedure TGdipControl.AllocateHandle;
begin
  ReleaseHandle;
  FBuffer := TGPBitmap.Create(Width, Height, PixelFormat32bppARGB);
  FCanvas := TGPGraphics.Create(FBuffer);
  FBrush := TGPSolidBrush.Create(ColorRefToARGB(ColorToRGB(Color)));
  FPen := TGPPen.Create(ColorRefToARGB(ColorToRGB(Color)));
end;

constructor TGdipControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DoubleBuffered := True;
  ControlStyle := ControlStyle - [csOpaque] + [csParentBackground];
  Width := 100;
  Height := 25;
  Color := clBlack;
end;

procedure TGdipControl.CreateWnd;
begin
  inherited CreateWnd;
  SetWindowLong(Parent.Handle, GWL_STYLE, GetWindowLong(Parent.Handle,
    GWL_STYLE) and not WS_CLIPCHILDREN);
end;

destructor TGdipControl.Destroy;
begin
  ReleaseHandle;
  inherited Destroy;
end;

procedure TGdipControl.Paint(Canvas: TGPGraphics);
begin
  Canvas.FillRectangle(FBrush, 0, 0, Width, Height);
end;

procedure TGdipControl.ReleaseHandle;
begin
  if Assigned(FPen) then FreeAndNil(FPen);
  if Assigned(FBrush) then FreeAndNil(FBrush);
  if Assigned(FBuffer) then FreeAndNil(FBuffer);
  if Assigned(FCanvas) then FreeAndNil(FCanvas);
end;

procedure TGdipControl.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin

end;

procedure TGdipControl.WMPaint(var Message: TWMPaint);
var
  Graphics: TGPGraphics;
  PS: TPaintStruct;
begin
  AllocateHandle;
  BeginPaint(Handle, PS);
  Graphics := TGPGraphics.Create(Handle, False);
  try
    Paint(FCanvas);
    if Assigned(FParentCanvas) then
      //FParentCanvas.DrawImage(FBuffer, 0, 0, FBuffer.GetWidth, FBuffer.GetHeight);
      DrawImageTo(FParentCanvas, 0, 0, FBuffer.GetWidth, FBuffer.GetHeight, FBuffer, 180);
  finally
    Graphics.Free;
  end;
  EndPaint(Handle, PS);
  Message.Result := 0;
end;

procedure TGdipControl.WMWindowPosChanging(
  var Message: TWMWindowPosChanging);
var
  R : TRect;
begin
  R := ClientRect;
  InvalidateRect(Handle, @R, False);
end;

end.