📄 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 + -