?? bmpclock.pas
字號:
{ *********************************************************************** }
{ }
{ BmpClock V 3.0 (AnalogClock Component); }
{ TBmpClock Unit }
{ }
{ Copyright (c) 2003-2005 sail2000 studio }
{ }
{ *********************************************************************** }
///////////////////////////////////////////////////////////////
// //
// 可以自由設置表針的長度,反向長度,自定義位圖背景, //
// 透明位圖,并使用后臺雙緩沖消除閃爍，減少資源占用。 //
// //
// E-MAIL : sail2000@126.com //
///////////////////////////////////////////////////////////////
// //
// 重點改進了時鐘的表針的算法; 而且增加了多個可以由用戶 //
// 自定義的功能，將主要的屬性定義都交給用戶,方便使用; //
// //
// 本軟件由“小帆工作室”，版權所有，保留全部權利。 //
// //
// 如果你對此代碼進行改進,請遵守 GNU GPL 條約，本軟 //
// 件受 GNU GPL 條約的保護。 //
// 請保留原作者的一切信息，同時，請不要忘記給我也寄 //
// 一份你修改后的源代碼! //
// //
// ** 如果你找到或者寫了更好的組件，請不忘也給我一份哦！** //
// //
///////////////////////////////////////////////////////////////
// //
// 重 要 事 項 //
// 本軟件（包括全部源代碼，演示程序，以及軟件相關附帶 //
// 檔案），未經作者的正式書面許可和授權，不得用于商業場合。//
// 如有違反此授權協議，將會受到法律起訴，所有責任將由違反 //
// 此授權協議的一方承擔全部法律責任。 //
// 小帆 //
// 2005.05.01 //
// //
///////////////////////////////////////////////////////////////
// //
// 源代碼統計結果輸出 //
// 文件名：BmpClock.pas //
// 總字節數：28,666 //
// 代碼字節數：16,698 //
// 注釋字節數：7,318 //
// 總行數：986 //
// 有效行數：838 //
// 空行數：148 //
// 代碼行數：728 //
// 注釋行數：168 //
// 注釋塊數：168 //
// //
///////////////////////////////////////////////////////////////
unit BmpClock;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs, Forms,
ExtCtrls, jpeg;
type
THour = procedure(Sender: TObject; Hour: word) of object;
TMinute = procedure(Sender: TObject; Minute: word) of object;
TSecond = procedure(Sender: TObject; Second: word) of object;
TBgStyle = (bgPicture, bgColor);
TPictureStyle = (psNone, psStretch, psTile);
TThemeStyle = (tsNone, tsCircle, tsRoundRect);
TBmpClock = class; //申明 TBmpClock
TCenter = class(TPersistent) //建立鐘表指針
private
FX: Integer;
FY: Integer;
FParent: TBmpClock;
procedure SetX(Value: Integer);
procedure SetY(Value: Integer);
protected
procedure UpdateParent;
public
constructor Create;
property Parent: TBmpClock read FParent write FParent;
published
property X: Integer read FX write SetX default 50;
property Y: Integer read FY write SetY default 50;
end;
THand = class(TPersistent) //建立鐘表指針
private
FRadius: Integer;
FBackRadius: Integer;
FWidth: Integer;
FColor: TColor;
FParent: TBmpClock;
procedure SetRadius(Value: Integer);
procedure SetBackRadius(Value: Integer);
procedure SetWidth(Value: Integer);
procedure SetColor(Value: TColor);
protected
procedure UpdateParent;
public
constructor Create;
property Parent: TBmpClock read FParent write FParent;
published
property Radius: Integer read FRadius write SetRadius;
property BackRadius: Integer read FBackRadius write SetBackRadius;
property Width: Integer read FWidth write SetWidth;
property Color: TColor read FColor write SetColor;
end;
TCenterPoint = class(TPersistent) //建立中心點
private
FPointSize: Integer;
FPenSize: Integer;
FFillColor: TColor;
FPenColor: TColor;
FParent: TBmpClock;
procedure SetPonitSize(Value: Integer);
procedure SetPenSize(Value: Integer);
procedure SetPenColor(Value: TColor);
procedure SetFillColor(Value: TColor);
protected
procedure UpdateParent;
public
constructor Create;
property Parent: TBmpClock read FParent write FParent;
published
property PointSize: Integer read FPointSize write SetPonitSize default 4; //中心填充點大小
property PenSize: Integer read FPenSize write SetPenSize default 1; //中心邊緣圓圈大小
property FillColor: TColor read FFillColor write SetFillColor default clBlack; //填充顏色
property PenColor: TColor read FPenColor write SetPenColor default clWhite; //邊緣顏色
end;
TBmpClock = class(TCustomControl)
private
FTransParentColor: TColor; //透明的顏色 ;
FTransparent: Boolean;
FStepTime: TTimer;
FInterval: Word;
FInterActive: Boolean;
FPicture: TPicture;
WorkImage, DisImage: TBitmap;
h, m, s: Word;
OldHour, OldMinute, OldSecond: Word;
FHour: THour;
FMinute: TMinute;
FSecond: TSecond;
FOnTimer: TNotifyEvent;
FVerInfo: string;
FColorOrBmp: TBgStyle;
FPictureStyle: TPictureStyle;
FBgUseColor: TColor;
FCenterPoint: Boolean;
FCenter: TCenter;
FHourHand: THand; //建立指針
FMinuteHand: THand;
FSecondHand: THand;
FDrawCenterPoint: TCenterPoint;
FAutoCenter: Boolean;
FCurAngle: Real; //讀取當前指針角度
FThemeStyle: TThemeStyle;
FRoundX: Integer;
FRoundY: Integer;
FoldWidth, FoldHeight: Integer;
FHourHandEnabled, FMinuteHandEnabled, FSecondHandEnabled: Boolean;
FHoleRound: Boolean; //中間鏤空指針效果；
procedure SetPicture(Value: TPicture); //設置位圖過程 ;
procedure SetTransParent(Value: Boolean); //設置透明
procedure SetTransParentColor(Value: TColor); //設置透明遮罩顏色
procedure SetInterval(Value: Word); //設置時鐘周期
procedure SetActive(Value: Boolean); //設置計時開始
procedure VersionMark(Value: string); //版本信息 (唯讀屬性）
procedure SetBgColor(Value: TColor); //設置背景顏色
procedure SetBgStyle(Value: TBgStyle); //啟用背景顏色
procedure SetCenterPoint(Value: Boolean); //設置中心點圖像
procedure SetAutoCenter(Value: Boolean); //設置自動中心
procedure SetHourHandEnabled(Value: Boolean);
procedure SetMinuteHandEnabled(Value: Boolean);
procedure SetSecondHandEnabled(Value: Boolean);
procedure SetPictureStyle(Value: TPictureStyle); //設置背景拉伸效果
procedure SetThemeStyle(Value: TThemeStyle);
procedure SetRoundX(Value: Integer);
procedure SetRoundY(Value: Integer);
procedure SetHoleRound(Value: Boolean);
protected
procedure CmEnabledChanged(var message: TWMNoParams); message CM_ENABLEDCHANGED;
procedure UpdateClock(Sender: TObject); //事件定義過程;
procedure DrawHand(Radius, BackRadius, HandWidth: Integer; HandColor: TColor; Angle: Real);
procedure Drawponit(PointSize, PenSize: Integer; FillColor, PenColor: TColor);
procedure StyleChanged;
procedure Loaded; override;
procedure Paint; override; //重畫時鐘;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;
published
property Picture: TPicture read FPicture write SetPicture; //自定義背景圖
property TransParentColor: TColor read FTransParentColor write SetTransParentColor default clFuchsia; //設置透明顏色
property TransParent: Boolean read FTransparent write SetTransParent default False;
property Interval: Word read FInterval write SetInterval default 1000; //時鐘周期
property Active: Boolean read FInterActive write SetActive default False; //啟用計時
property OnHour: THour read FHour write FHour;
property OnMinute: TMinute read FMinute write FMinute;
property OnSecond: TSecond read FSecond write FSecond;
property OnTime: TNotifyEvent read FOnTimer write FOnTimer;
property VersionInfo: string read FVerInfo write VersionMark stored False;
property BackGroundStyle: TBgStyle read FColorOrBmp write SetBgStyle default bgPicture;
property BackGroundColor: TColor read FBgUseColor write SetBgColor default clBlack; //設置單顏色背景色
property CenterPoint: Boolean read FCenterPoint write SetCenterPoint default False;
property AutoCenter: Boolean read FAutoCenter write SetAutoCenter default True;
property HourHandEnabled: Boolean read FHourHandEnabled write SetHourHandEnabled default True;
property MinuteHandEnabled: Boolean read FMinuteHandEnabled write SetMinuteHandEnabled default True;
property SecondHandEnabled: Boolean read FSecondHandEnabled write SetSecondHandEnabled default True;
property Center: TCenter read FCenter write FCenter;
property HourHand: THand read FHourHand write FHourHand;
property MinuteHand: THand read FMinuteHand write FMinuteHand;
property SecondHand: THand read FSecondHand write FSecondHand;
property CenterMark: TCenterPoint read FDrawCenterPoint write FDrawCenterPoint;
property PictureStyle: TPictureStyle read FPictureStyle write SetPictureStyle default psNone; //背景圖樣式
property ThemeStyle: TThemeStyle read FThemeStyle write SetThemeStyle default tsNone;
property RoundX: Integer read FRoundX write SetRoundX default 25;
property RoundY: Integer read FRoundY write SetRoundY default 25;
property RoundHole: Boolean read FHoleRound write SetHoleRound default False;
property Align;
property Color;
property Enabled;
property Hint;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property PopupMenu;
property ParentShowHint;
property ShowHint;
property Visible;
end;
procedure Register;
implementation
//**********************************開始 TBmpclock *****************************
{$R BmpClock.RES}
{===================初始化并創建組件====================}
constructor TBmpClock.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 100;
Height := 100;
FoldWidth := Width;
FoldHeight := Height;
FTransParentColor := clFuchsia;
FTransparent := False;
DisImage := TBitmap.Create;
WorkImage := TBitmap.Create;
FPicture := TPicture.Create;
FPicture.Bitmap.LoadFromResourceName(HInstance, 'BMPCLOCK');
FSteptime := TTimer.Create(self); //建立時鐘發生器
FInterval := 1000;
FInterActive := True;
FSteptime.Enabled := FInterActive;
FSteptime.Interval := FInterval;
FSteptime.OnTimer := UpdateClock;
FVerInfo := 'BmpClock V3.0 版權所有(C) 2003-2005 小帆工作室';
FColorOrBmp := bgPicture;
FAutoCenter := True;
FHourHandEnabled := True;
FMinuteHandEnabled := True;
FSecondHandEnabled := True;
FPictureStyle := psNone;
FThemeStyle := tsNone;
FRoundX := 25;
FRoundY := 25;
FHoleRound := False;
FCenter := TCenter.Create;
with FCenter do
begin
Parent := Self;
FX := 50;
FY := 50;
end;
{------畫時針------}
FHourHand := THand.Create;
with FHourHand do
begin
Parent := Self;
BackRadius := 6;
Color := clGreen;
Radius := 25;
Width := 2;
end;
{------畫分針------}
FMinuteHand := THand.Create;
with FMinuteHand do
begin
Parent := Self;
BackRadius := 6;
Color := clBlue;
Radius := 30;
Width := 2;
end;
{------畫秒針------}
FSecondHand := THand.Create;
with FSecondHand do
begin
Parent := Self;
BackRadius := 11;
Color := clRed;
Radius := 38;
Width := 1;
end;
{-----畫中心點----}
FDrawCenterPoint := TCenterPoint.Create;
with FDrawCenterPoint do
begin
Parent := Self;
PointSize := 4;
PenSize := 1;
FillColor := clBlack;
PenColor := clWhite;
end;
end;
{======================銷毀對像=========================}
destructor TBmpClock.Destroy;
begin
FStepTime.Free;
WorkImage.Free;
DisImage.Free;
FPicture.Free;
inherited Destroy;
end;
{=================時鐘重畫,產生時間比較=================}
procedure TBmpClock.UpdateClock(Sender: TObject);
var
HSec: Word;
begin
DecodeTime(Time, h, m, s, HSec);
paint; // <--------此處必須為 Paint, 不能為 Repaint, 否則組件閃爍得厲害!!!
if s <> OldSecond then begin //于整秒事件
if Assigned(FSecond) then FSecond(Self, s);
OldSecond := s;
end;
if m <> OldMinute then begin //于整分事件
if Assigned(FMinute) then FMinute(Self, m);
OldMinute := m;
end;
if h <> OldHour then begin //于整點事件
if Assigned(FHour) then FHour(Self, h);
OldHour := h;
end;
if Assigned(FOnTimer) then FOnTimer(Self); //于計時周期事件
end;
procedure TBmpClock.Loaded;
var
HSec: Word;
begin
inherited Loaded;
DecodeTime(Now, OldHour, OldMinute, OldSecond, HSec);
end;
{========在發生定時器事件時重畫表盤 (核心代碼 II)=======}
procedure TBmpClock.Paint;
var
H, M, S, MS: word; //從 DecodeTime 函數取得時間;
R: TRect;
X, Y, Wi, Hi: LongInt;
begin
if (csDestroying in Componentstate) then Exit;
DisImage.Assign(FPicture.Graphic);
WorkImage.Height := Height;
WorkImage.Width := Width;
WorkImage.Canvas.Brush.Color := Self.Color;
WorkImage.Canvas.Brush.Style := bsSolid;
WorkImage.Canvas.Pen.Color := Self.Color;
R.Left := 0;
R.Top := 0;
R.Right := Width;
R.Bottom := Height;
WorkImage.Canvas.Rectangle(0, 0, Width, Height);
if FColorOrBmp = bgColor then begin //用顏色填充背景作為背景顏色
WorkImage.Canvas.Brush.Color := FBgUseColor;
WorkImage.Canvas.Rectangle(0, 0, Width, Height);
end
else begin //位圖背景
case FPictureStyle of
psStretch: //拉伸背景
begin
DisImage.Width := Width;
DisImage.Height := Height;
DisImage.Canvas.StretchDraw(R, FPicture.Bitmap);
if FTransparent then begin
WorkImage.Canvas.BrushCopy(ClientRect, DisImage, ClientRect, FTransParentColor);
end
else begin
WorkImage.Canvas.Draw(0, 0, DisImage);
end;
end;
psNone:
begin //原來背景
if FTransparent then //透明背景
WorkImage.Canvas.BrushCopy(ClientRect, DisImage, ClientRect, FTransParentColor)
else //非透明背景
WorkImage.Canvas.Draw(0, 0, DisImage);
end;
psTile:
begin //平鋪背景
DisImage.Width := Width;
DisImage.Height := Height;
with FPicture.Bitmap do
begin
Wi := Width;
Hi := Height;
end;
Y := 0;
while Y < Height do
begin
X := 0;
while X < Width do
begin
if FTransparent then begin //透明背景
DisImage.Canvas.Draw(X, Y, FPicture.Bitmap);
WorkImage.Canvas.BrushCopy(ClientRect, DisImage, ClientRect, FTransParentColor)
end
else begin //非透明背景，平鋪
WorkImage.Canvas.Draw(X, Y, DisImage);
end;
Inc(X, Wi);
end; {while X}
Inc(Y, Hi);
end; {while Y}
end; {with}
end; {case}
end; {else}
with WorkImage do
begin
{---------取出時針,分針,秒針 的旋轉角度--------}
Decodetime(Now, H, M, S, MS);
{---------畫出時針-----------}
FCurAngle := 2 * pi * (H + M / 60) / 12; //當前應該畫出的角度
if FHourHandEnabled then begin
DrawHand(HourHand.Radius, HourHand.BackRadius, HourHand.Width, HourHand.Color, FCurAngle);
end;
{---------畫出分針-----------}
FCurAngle := 2 * Pi * M / 60;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -