myfan.pas

用delphi写的一个扇叶转动控件

// 旋转扇叶控件
// 开发时间：2004-10-06
// 版权所有者：老李
//Email:[e-mail] [e-mail]
//未经作者允许不得用于任何商业用途
unit MyFan;

interface

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

type
  TMyFan = class(TGraphicControl)
  private
  i:integer;
  m_width,m_sqrt:integer;
  fBrush:Tbrush;
  fpen:Tpen;
  FInterval: Integer;
  FTimer: TTimer;
  fFilled:boolean;
  fFillColor:TColor;
  FChecked: Boolean;
  FClockWise: Boolean;
  procedure myontimer(Sender: TObject);
  procedure setBrush(value:Tbrush);
  procedure setpen(value:Tpen);
  procedure RepaintRequest(sender:Tobject);
  procedure SetInterval(Value: Integer);
  procedure setfilled(value:boolean);
  procedure SetfillColor(Value: TColor);
  procedure SetChecked(Value: Boolean);
  procedure SetClockWise(Value: Boolean);
    { Private declarations }
  protected
  procedure paint;override;
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    { Protected declarations }
  public
  constructor create(aowner:Tcomponent);override;
  destructor Destroy;override;
    { Public declarations }
  published
  property Width default 60;
  property Height default 60;
  property Brush:Tbrush read fbrush write setbrush;
  property Pen:Tpen read fpen write setpen;
  property Interval: Integer read FInterval write SetInterval;
  property Filled:boolean read fFilled write setfilled default true;
  property FillColor: TColor read FfillColor write SetfillColor default clblack;
  property Checked: Boolean read FChecked write SetChecked;
  property ClockWise: Boolean read FClockWise write SetClockWise default true;
  property OnMouseDown;//: TMouseEvent read FOnMouseDown write FOnMouseDown;
  property OnMouseUp;//: TMouseEvent read FOnMouseUp write FOnMouseUp;
    { Published declarations }
  end;

procedure Register;

implementation
constructor Tmyfan.create(aowner:Tcomponent);
  begin
   inherited create(aowner);
   width:=60;
   height:=60;
   i:=0;
   m_width:=width;
   m_sqrt:=round(sqrt(2)*(m_width/2)*sin(pi/6)/sin(7*pi/12));
   fBrush:=Tbrush.create;
   fpen:=Tpen.create;
   fbrush.onchange:=repaintrequest;
   fpen.onchange:=repaintrequest;
   fbrush.Color:=cllime;
   fpen.Color:=clgreen;
  FClockWise:=true;
  FInterval := 100;
  FTimer := TTimer.Create(Self);
  FTimer.Interval := FInterval;
  FTimer.OnTimer := myontimer;
  FTimer.Enabled := FChecked;
 end;
 destructor Tmyfan.destroy;
  begin
   fbrush.free;
   fpen.free;
   FTimer.Enabled := False;
   FTimer.Free;
   inherited destroy;
  end;
procedure TMyfan.Paint;
begin
 height:=width;
 if m_width<> width then
    begin
     m_width:=width;
     m_sqrt:=round(sqrt(2)*(m_width/2)*sin(pi/6)/sin(7*pi/12));
    end;
 if fFilled then
    begin
     canvas.brush.Color:=Ffillcolor;
     canvas.pen.Color:=Ffillcolor;
     canvas.Ellipse(0,0,width,width);
    end;
 canvas.brush:=fbrush;
 canvas.pen:=fpen;
 if FClockWise then
   begin
     if i=0 then
       begin
        canvas.Pie(0,0,m_width,m_width,m_sqrt,0,0,m_sqrt);
        canvas.Pie(0,0,m_width,m_width,m_width,m_width-m_sqrt,m_width,0);
        canvas.Pie(0,0,m_width,m_width,0,m_width,m_width-m_sqrt,m_width);
       end
     else if i=1 then
       begin
        canvas.Pie(0,0,m_width,m_width,m_width-m_sqrt,0,0,0);
        canvas.Pie(0,0,m_width,m_width,m_width,m_width,m_width,m_sqrt);
        canvas.Pie(0,0,m_width,m_width,0,m_width-m_sqrt,m_sqrt,m_width);
       end
     else if i=2 then
       begin
        canvas.Pie(0,0,m_width,m_width,m_width,0,m_sqrt,0);
        canvas.Pie(0,0,m_width,m_width,m_width-m_sqrt,m_width,m_width,m_width-m_sqrt);
        canvas.Pie(0,0,m_width,m_width,0,m_sqrt,0,m_width);
       end
     else
        begin
          canvas.Pie(0,0,m_width,m_width,m_width,m_sqrt,m_width-m_sqrt,0);
          canvas.Pie(0,0,m_width,m_width,m_sqrt,m_width,m_width,m_width);
          canvas.Pie(0,0,m_width,m_width,0,0,0,m_width-m_sqrt);
        end;
    end
  else
    begin
      if i=0 then
       begin
        canvas.Pie(0,0,m_width,m_width,m_sqrt,0,0,m_sqrt);
        canvas.Pie(0,0,m_width,m_width,m_width,m_width-m_sqrt,m_width,0);
        canvas.Pie(0,0,m_width,m_width,0,m_width,m_width-m_sqrt,m_width);
       end
     else if i=1 then
       begin
        canvas.Pie(0,0,m_width,m_width,m_width,m_sqrt,m_width-m_sqrt,0);
        canvas.Pie(0,0,m_width,m_width,m_sqrt,m_width,m_width,m_width);
        canvas.Pie(0,0,m_width,m_width,0,0,0,m_width-m_sqrt);
       end
     else if i=2 then
       begin
        canvas.Pie(0,0,m_width,m_width,m_width,0,m_sqrt,0);
        canvas.Pie(0,0,m_width,m_width,m_width-m_sqrt,m_width,m_width,m_width-m_sqrt);
        canvas.Pie(0,0,m_width,m_width,0,m_sqrt,0,m_width);
       end
     else
        begin
         canvas.Pie(0,0,m_width,m_width,m_width-m_sqrt,0,0,0);
         canvas.Pie(0,0,m_width,m_width,m_width,m_width,m_width,m_sqrt);
         canvas.Pie(0,0,m_width,m_width,0,m_width-m_sqrt,m_sqrt,m_width);
        end;
    end;
 canvas.Ellipse(round(m_width*7/20),round(m_width*7/20),round(m_width*13/20),round(m_width*13/20));
 if m_width>=110 then
    begin
     canvas.Font.Color:=fpen.Color;
     canvas.Font.Size:=round(m_width/20);
     canvas.brush.Style:=bsclear;
     canvas.TextOut(round(m_width*2/5),round(m_width*9/20),'老李');
    end;
end;
procedure TMyfan.myontimer(Sender: TObject);
begin
 if i=0 then
    i:=1
 else if i=1 then
    i:=2
 else if i=2 then
    i:=3
 else
    i:=0;
 paint;
end;
procedure Tmyfan.setbrush(value:Tbrush);
  begin
   if fbrush<>value then
      begin
       fbrush.assign(value);
       invalidate;
      end;
  end;
   procedure Tmyfan.setpen(value:Tpen);
  begin
   if fpen<>value then
      begin
       fpen.assign(value);
       invalidate;
      end;
  end;
 procedure TMyfan.repaintrequest(sender:Tobject);
  begin
  invalidate;
  end;
procedure TMyfan.SetInterval(Value: Integer);
begin
  if FInterval <> Value then
  begin
    FInterval := Value;
    FTimer.Interval := FInterval;
  end;
end;
procedure TMyfan.setfilled(value:boolean);
  begin
   if fFilled<>value then
      begin
       fFilled:=value;
       invalidate;
      end;
  end;
procedure TMyfan.SetfillColor(Value: TColor);
begin
  if Value <> FfillColor then
  begin
    FfillColor := Value;
    invalidate;
  end;
end;
procedure TMyfan.SetChecked(Value: Boolean);
begin
  if Value <> FChecked then
  begin
    FChecked := Value;
    Ftimer.Enabled:=value;
    invalidate;
  end;
end;  
procedure TMyfan.SetClockWise(Value: Boolean);
begin
  if Value <> FClockWise then
  begin
    FClockWise:= Value;
    invalidate;
  end;
end;
procedure TMyfan.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
    inherited MouseDown(Button, Shift, X, Y);
end;


procedure TMyfan.MouseUP(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
    inherited MouseUp(Button, Shift, X, Y);
end;

procedure Register;
begin
  RegisterComponents('MiniSoft', [TMyFan]);
end;

end.