MyCircle -Com Image - Delphi - GDI

unit UMyCircle;

interface

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

type
  TMyCircle = class(TGraphicControl)
  private
    procedure DrawCircle(const ACanvas: TCanvas);
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure Resize; override;
  public
  { Public declarations }
  constructor Create(AOwner: TComponent); override;

  end;

procedure Register;

implementation

uses
  Math, Consts, GDIPOBJ, GDIPAPI;

procedure Register;
begin
  RegisterComponents('My Componentes', [TMyCircle]);
end;


{ TMyCircle }

constructor TMyCircle.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csFramed, csOpaque];
  { default values }
  Width := 100;
  Height := 100;
end;

procedure TMyCircle.DrawCircle(const ACanvas: TCanvas);
var
  g: TGPGraphics;
  gOut : TGPGraphics;
  imgInput : TGPImage;
  imgOutput : TGPBitmap;
  tb: TGPTextureBrush;
  Rect : TGPRect;
begin

  try
    imgInput :=TGPImage.Create('C:\Trabalho\Meus Componentes Delphi\MyItemMenu\PaisagemBMP.bmp');
    //cria um bitmap com o tamanho desejado
    imgOutPut:=TGPBitmap.Create(Width, Height, PixelFormat32bppARGB);
    //cria grafico para desenhar no bitmap
    g := TGPGraphics.Create(imgOutPut);
    //seta alta qualidade
    g.SetInterpolationMode(InterpolationModeHighQualityBicubic);
    g.SetPixelOffsetMode(PixelOffsetModeHighQuality);
    g.SetSmoothingMode(SmoothingModeHighQuality);
    //seta composição modo copy
    g.SetCompositingMode(CompositingModeSourceCopy);
    //cria a imagem
    g.DrawImage(imgInput, 0, 0, imgOutput.GetWidth, imgOutput.GetHeight);
    //transforma imgOut em textura
    tb := TGPTextureBrush.Create(imgOutPut);

    //cria grafico para desenhar no canvas
    gOut := TGPGraphics.Create(ACanvas.Handle);
    //seta alta qualidade
    gOut.SetInterpolationMode(InterpolationModeHighQualityBicubic);
    gOut.SetPixelOffsetMode(PixelOffsetModeHighQuality);
    gOut.SetSmoothingMode(SmoothingModeHighQuality);
    //cria um retangulo
    Rect := MakeRect(0, 0, Width , Height);
    //cria elipse usando a textura no tamanho do retangulo
    gOut.FillEllipse(tb, Rect);
  finally
    freeandnil(g);
    freeandnil(gOut);
    freeandnil(imgInput);
    freeandnil(imgOutput);
    freeandnil(tb);
  end;

end;

procedure TMyCircle.Paint;
begin
  inherited;
    DrawCircle(Canvas);
end;

procedure TMyCircle.Resize;
begin
  inherited;
  Repaint;
end;

end.