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