GDI +替代TPaintBox

时间:2019-02-05 10:52:13

标签: delphi gdi+

我正在尝试创建一个新组件来替换John Biddiscome的Zoomer.pas,以使用GDI +代替Delphi的Canvas方法。

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方法会产生意外的结果。我绝对不是一个专业的程序员,我喜欢它是我的业余爱好。只是从尊敬的同事那里寻求教育。

0 个答案:

没有答案