GDI + замена для TPaintBox - PullRequest
Новая
       7

GDI + замена для TPaintBox

0 голосов
/ 05 февраля 2019

Я пытаюсь создать новый компонент, чтобы заменить Zoomer.pas Джона Биддискома, чтобы использовать GDI + вместо методов Холста Delphi. 

unit GDIPaintbox;

interface

uses
  System.Classes,
  System.SysUtils,

  Vcl.Controls,

  GDIPAPI,
  GDIPOBJ;

type
  TGDIPaintbox = class( TCustomControl )
    private
      { Private declarations }
      FGDICanvas : TGPGraphics;
      FGDIPen : TGPPen;
      FGDIBrush : TGPBrush;

      FStatus : TStatus;
      FOnPaint: TNotifyEvent;

    protected
      { Protected declarations }
      procedure CreateWnd(); override;
      procedure Paint(); override;

    public
      { Public declarations }
      constructor Create( AOwner : TComponent ); override;
      destructor Destroy(); override;

      property Status : TStatus read FStatus; //Return value for GDI+ methods

    published
      { Published declarations }
      property OnPaint : TNotifyEvent read FOnPaint write FOnPaint;

  end;

procedure Register();

implementation

procedure Register();
  begin
    RegisterComponents( 'Dudley Park', [TGDIPaintbox] );
  end;

{ TGDIPaintbox }

constructor TGDIPaintbox.Create( AOwner : TComponent );
  begin
    inherited Create( AOwner );

    ControlStyle := ControlStyle + [csReplicatable];

    Height := 105;
    Width := 105;

    //FGDIPen := TGPPen.Create(); //GDI+ bug will not return FStatus = OK in susequent calls to FGDIPen

    FGDIPen := TGPPen.Create( $0, 0 );
    FGDIBrush := TGPBrush.Create();
  end;

procedure TGDIPaintbox.CreateWnd();
  begin
    inherited CreateWnd();
    FGDICanvas := TGPGraphics.Create( Canvas.Handle ); //Get handle from TCanvas for drawing operations
  end;

destructor TGDIPaintbox.Destroy();
  begin
    FGDICanvas.Free();
    FGDIPen.Free();
    FGDIBrush.Free();

    inherited Destroy();
  end;

procedure TGDIPaintbox.Paint();
  const
    DashPattern : array[0..1] of single = ( 24.0, 6.0 );

  begin
    if( csDesigning in ComponentState ) then
      begin
        FGDIPen.SetColor( aclBlack );
        FGDIPen.SetWidth( 1.0 );
        FGDIPen.SetDashPattern( @DashPattern[0], 2 );
        FGDICanvas.DrawRectangle( FGDIPen, 0, 0, ClientWidth - 1, ClientHeight - 1 );
      end;

    if Assigned( FOnPaint ) then
      FOnPaint( Self );
  end;

end.

При отбрасывании компонента в форме он не будет рисовать границуЕсли я изменяю размер, то иногда граница является правильной, хотя метод SetDashPattern дает неожиданные результаты.Я ни в коем случае не профессиональный программист, я занимаюсь этим как хобби, так как мне это нравится.Просто ищу образование у моих уважаемых коллег.

...