?? myfan.pas
字號(hào):
// 旋轉(zhuǎn)扇葉控件
// 開發(fā)時(shí)間:2004-10-06
// 版權(quán)所有者:老李
//Email:lifeng@keylab.net lifchina@163.com
//未經(jīng)作者允許不得用于任何商業(yè)用途
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.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -