ddhstar.pas

Delphi高级开发指南是开发程序的好帮手

unit DdhStar;

interface

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

type
  TDdhStar = class (TCustomControl)
  private
    {data fields for properties}
    fLineColor: TColor;
    fLineSize: Integer;
    fLinesVisible: Boolean;
    Pts: array [0..5] of TPoint;
  protected
    {set and get methods}
    procedure SetLineColor (Value: TColor);
    procedure SetLineSize (Value: Integer);
    procedure SetLinesVisible (Value: Boolean);
  public
    constructor Create (AOwner: TComponent); override;
    procedure CreateHandle; override;
    procedure SetBounds (ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure Paint; override;
  published
    property LineColor: TColor
      read fLineColor write SetLineColor default clBlack;
    property LineSize: Integer
      read fLineSize write SetLineSize default 2;
    property LinesVisible: Boolean
      read fLinesVisible write SetLinesVisible default False;
    property Width default 50;
    property Height default 50;
  end;

procedure Register;

implementation

constructor TDdhStar.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);
  // set default values
  fLineColor := clBlack;
  fLineSize := 2;
  fLinesVisible := False;
  Width := 50;
  Height := 50;
end;

procedure TDdhStar.SetBounds (ALeft, ATop, AWidth, AHeight: Integer);
var
  HRegion1: THandle;
begin
  inherited;
  // compute points
  Pts [0] := Point (AWidth div 2, 0);
  Pts [1] := Point (AWidth, AHeight);
  Pts [2] := Point (0, AHeight div 3);
  Pts [3] := Point (AWidth, AHeight div 3);
  Pts [4] := Point (0, AHeight);
  Pts [5] := Point (Width div 2, 0);
  // set component shape
  if HandleAllocated then
  begin
    HRegion1 := CreatePolygonRgn (Pts,
      sizeof (Pts) div 8, winding);
    SetWindowRgn (Handle, HRegion1, True);
  end;
end;

procedure TDdhStar.CreateHandle;
var
  HRegion1: THandle;
begin
  inherited;
  HRegion1 := CreatePolygonRgn (Pts,
    sizeof (Pts) div 8, winding);
  SetWindowRgn (Handle, HRegion1, True);
end;

procedure TDdhStar.Paint;
begin
  Canvas.Brush.Color := clYellow;
  if fLinesVisible then
  begin
    Canvas.Pen.Color := fLineColor;
    Canvas.Pen.Width := fLineSize;
    SetPolyFillMode (Canvas.Handle, winding);
    Canvas.Polygon (Pts);
  end
  else
  begin
    Canvas.Pen.Width := 1;
    Canvas.Rectangle (-1, -1, Width + 1, Height + 1);
  end;
end;

{property access functions}

procedure TDdhStar.SetLineColor(Value: TColor);
begin
  if Value <> fLineColor then
  begin
    fLineColor := Value;
    Invalidate;
  end;
end;

procedure TDdhStar.SetLineSize(Value: Integer);
begin
  if Value <> fLineSize then
  begin
    fLineSize := Value;
    Invalidate;
  end;
end;

procedure TDdhStar.SetLinesVisible(Value: Boolean);
begin
  if Value <> fLinesVisible then
  begin
    fLinesVisible := Value;
    Invalidate;
  end;
end;

{$R ddhstar.dcr}

procedure Register;
begin
  RegisterComponents('DDHB', [TDdhStar]);
end;

end.