Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Software-Projekte der Mitglieder (https://www.delphipraxis.net/26-software-projekte-der-mitglieder/)
-   -   TfrClock (https://www.delphipraxis.net/202881-tfrclock.html)

Frühlingsrolle 19. Dez 2019 04:15

TfrClock
 
Liste der Anhänge anzeigen (Anzahl: 1)
TfrClock

ist eine visuelle Delphi und FreePascal Komponente die eine analoge Uhr darstellt.
Die Zeiger sowie das Zifferblatt können individuell optisch angepasst werden.
Für die Bearbeitung sind folgende Eigenschaften zuständig:
- TfrClock.ClockLabel passt die Beschriftung an.
- TfrClock.ClockPartition passt die Minuten/Stunden Teilstriche an.
- TfrClock.HourHand passt den Stundenzeiger an.
- TfrClock.MinuteHand passt den Minutenzeiger an.
- TfrClock.SecondHand passt den Sekundenzeiger an.
- TfrClock.Font wirkt sich auf die Eigenschaft TfrClock.ClockLabel entsprechend aus.

Konstruktive Krtitik ist wünschenswert.
Danke fürs Lesen und die anschließende Nutzung.

Delphi-Quellcode:
{
  TfrClock

  [-] Version
        * 20191218
  [-] Author
        * Frühlingsrolle
  [-] License
        * WTFPL (http://www.wtfpl.net/about/)
  [-] Note
        * Visual Delphi/FPC component for VCL applications.
        * Displays an analog clock which can be adjusted individual.
}

unit ufrClock;

{$IFNDEF MSWINDOWS}
  {$MESSAGE Fatal 'Not developed for non-Windows OS.'}
{$ENDIF}

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls;

type
  TClockHand = class(TPersistent)
  private
    FColor: TColor;
    FEnabled: Boolean;
    FParentControl: TControl;
    FSize, FThickness: Integer;
    procedure SetColor(Value: TColor);
    procedure SetEnabled(Value: Boolean);
    procedure SetSize(Value: Integer);
    procedure SetThickness(Value: Integer);
  protected
    procedure DoRepaint;
  public
    constructor Create(AParent: TControl; ASize, AThickness: Integer;
      AColor: TColor; AEnabled: Boolean); overload;
    property ParentControl: TControl read FParentControl write FParentControl;
  published
    property Color: TColor read FColor write SetColor;
    property Enabled: Boolean read FEnabled write SetEnabled;
    property Size: Integer read FSize write SetSize;
    property Thickness: Integer read FThickness write SetThickness;
  end;

  TClockLabel = class(TPersistent)
  private
    FEnabled: Boolean;
    FParentControl: TControl;
    FRadius: Integer;
    FValues: TStrings;
    procedure SetEnabled(Value: Boolean);
    procedure SetRadius(Value: Integer);
    procedure SetValues(Value: TStrings);
  protected
    procedure DoRepaint;
  public
    constructor Create; overload;
    constructor Create(AParent: TControl; ARadius: Integer;
      AEnabled: Boolean); overload;
    destructor Destroy; override;
    property ParentControl: TControl read FParentControl write FParentControl;
  published
    property Enabled: Boolean read FEnabled write SetEnabled;
    property Radius: Integer read FRadius write SetRadius;
    property Values: TStrings read FValues write SetValues;
  end;

  TClockPartition = class(TPersistent)
  private
    FEnabled: Boolean;
    FHourColor, FMinuteColor: TColor;
    FHourSize, FMinuteSize: Integer;
    FHourThickness, FMinuteThickness: Integer;
    FParentControl: TControl;
    FRadius: Integer;
    procedure SetEnabled(Value: Boolean);
    procedure SetHourColor(Value: TColor);
    procedure SetMinuteColor(Value: TColor);
    procedure SetHourSize(Value: Integer);
    procedure SetMinuteSize(Value: Integer);
    procedure SetHourThickness(Value: Integer);
    procedure SetMinuteThickness(Value: Integer);
    procedure SetRadius(Value: Integer);
  protected
    procedure DoRepaint;
  public
    constructor Create(AParent: TControl; AHourSize, AHourThickness: Integer;
      AHourColor: TColor; AMinuteSize, AMinuteThickness: Integer;
      AMinuteColor: TColor; ARadius: Integer; AEnabled: Boolean); overload;
    property ParentControl: TControl read FParentControl write FParentControl;
  published
    property Enabled: Boolean read FEnabled write SetEnabled;
    property HourColor: TColor read FHourColor write SetHourColor;
    property MinuteColor: TColor read FMinuteColor write SetMinuteColor;
    property HourSize: Integer read FHourSize write SetHourSize;
    property MinuteSize: Integer read FMinuteSize write SetMinuteSize;
    property HourThickness: Integer read FHourThickness write SetHourThickness;
    property MinuteThickness: Integer read FMinuteThickness
                                      write SetMinuteThickness;
    property Radius: Integer read FRadius write SetRadius;
  end;

type
  TfrCustomClock = class(TControl)
  private
    FBitmap: TBitmap;
    FCanvas: TCanvas;
    FClockLabel: TClockLabel;
    FClockPartition: TClockPartition;
    FCurrentTime: TTime;
    FTimer: TTimer;
    FTimerEnabled: Boolean;
    FTimerInterval: Integer;
    FHourHand, FMinuteHand, FSecondHand: TClockHand;
    FOnPaintAfter, FOnPaintBefore: TNotifyEvent;
    function GetVersion: string;
    procedure SetCurrentTime(Value: TTime);
    procedure SetTimerEnabled(Value: Boolean);
    procedure SetTimerInterval(Value: Integer);
  protected
    function GetAnglePoint(X, Y: Integer; Radius, Angle: Double): TPoint;
    procedure DoPaint; virtual;
    procedure DoTimer(Sender: TObject); virtual;
    procedure DrawClock(ACanvas: TCanvas; ABitmap: TBitmap; AFont: TFont;
      AClockLabel: TClockLabel; AClockPartition: TClockPartition;
      AHourHand, AMinuteHand, ASecondHand: TClockHand; ACurrentTime: TTime);
    procedure DrawClockHands(ACanvas: TCanvas; MX, MY: Integer;
      AHourHand, AMinuteHand, ASecondHand: TClockHand;
      ATime: TDateTime); virtual;
    procedure DrawClockLabel(ACanvas: TCanvas; MX, MY: Integer;
      AClockLabel: TClockLabel); virtual;
    procedure DrawClockPartition(ACanvas: TCanvas; MX, MY: Integer;
      AClockPartition: TClockPartition); virtual;
    procedure WndProc(var Message: TMessage); override;
    property ClockLabel: TClockLabel read FClockLabel write FClockLabel;
    property ClockPartition: TClockPartition read FClockPartition
                                             write FClockPartition;
    property CurrentTime: TTime read FCurrentTime write SetCurrentTime;
    property TimerEnabled: Boolean read FTimerEnabled write SetTimerEnabled;
    property TimerInterval: Integer read FTimerInterval write SetTimerInterval;
    property HourHand: TClockHand read FHourHand write FHourHand;
    property MinuteHand: TClockHand read FMinuteHand write FMinuteHand;
    property SecondHand: TClockHand read FSecondHand write FSecondHand;
    property Version: string read GetVersion;
    property OnPaintAfter: TNotifyEvent read FOnPaintAfter
                                         write FOnPaintAfter;
    property OnPaintBefore: TNotifyEvent read FOnPaintBefore
                                         write FOnPaintBefore;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas: TCanvas read FCanvas;
  end;

  TfrClock = class(TfrCustomClock)
  protected
    property Enabled;
  published
    property Align;
    property ClockLabel;
    property ClockPartition;
    property CurrentTime;
    property Font;
    property HourHand;
    property MinuteHand;
    property SecondHand;
    property TimerEnabled;
    property TimerInterval;
    property Version;
    // Events
    property OnClick;
    property OnMouseDown;
    property OnMouseEnter; // Not included in Delphi 7 or older
    property OnMouseLeave; // Not included in Delphi 7 or older
    property OnMouseMove;
    property OnMouseUp;
    property OnPaintAfter; // Draw after the clock is drawn
    property OnPaintBefore; // Draw before the clock is drawn
  end;

{$IF not Defined(TransparentBlt)}
function TransparentBlt(hdcDest: HDC; xoriginDest, yoriginDest, wDest,
  hDest: Integer; hdcSrc: HDC; xoriginSrc, yoriginSrc, wSrc, hSrc: Integer;
  crTransparent: UINT): Boolean; stdcall; external 'Msimg32.dll';
{$IFEND}

procedure Register;

implementation

uses Math;

const
  FR_CLOCK_VERSION = '20191218';
  DEG = Pi / 180.0;

function Cos(Degree: Double): Double;
begin
  result := System.Cos(Degree * DEG);
end;

function Sin(Degree: Double): Double;
begin
  result := System.Sin(Degree * DEG);
end;

{ TClockHand }

procedure TClockHand.SetColor(Value: TColor);
begin
  FColor := Value;
  DoRepaint;
end;

procedure TClockHand.SetEnabled(Value: Boolean);
begin
  FEnabled := Value;
  DoRepaint;
end;

procedure TClockHand.SetSize(Value: Integer);
begin
  FSize := Value;
  DoRepaint;
end;

procedure TClockHand.SetThickness(Value: Integer);
begin
  FThickness := Value;
  DoRepaint;
end;

procedure TClockHand.DoRepaint;
begin
  if Assigned(FParentControl) then
    FParentControl.Repaint;
end;

constructor TClockHand.Create(AParent: TControl; ASize, AThickness: Integer;
  AColor: TColor; AEnabled: Boolean);
begin
  inherited Create;
  FParentControl := AParent;
  FSize := ASize;
  FThickness := AThickness;
  FColor := AColor;
  FEnabled := AEnabled;
end;

{ TClockLabel }

procedure TClockLabel.SetEnabled(Value: Boolean);
begin
  FEnabled := Value;
  DoRepaint;
end;

procedure TClockLabel.SetRadius(Value: Integer);
begin
  FRadius := Value;
  DoRepaint;
end;

procedure TClockLabel.SetValues(Value: TStrings);
begin
  FValues.Assign(Value);
  DoRepaint
end;

procedure TClockLabel.DoRepaint;
begin
  if Assigned(FParentControl) then
    FParentControl.Repaint;
end;

constructor TClockLabel.Create;
begin
  inherited;
  FValues := TStringList.Create;
end;

constructor TClockLabel.Create(AParent: TControl; ARadius: Integer;
  AEnabled: Boolean);
begin
  inherited Create;
  FValues := TStringList.Create;
  FParentControl := AParent;
  FRadius := ARadius;
  FEnabled := AEnabled;
end;

destructor TClockLabel.Destroy;
begin
  FValues.Free;
  inherited;
end;

{ TClockPartition }

procedure TClockPartition.SetEnabled(Value: Boolean);
begin
  FEnabled := Value;
  DoRepaint;
end;

procedure TClockPartition.SetHourColor(Value: TColor);
begin
  FHourColor := Value;
  DoRepaint;
end;

procedure TClockPartition.SetMinuteColor(Value: TColor);
begin
  FMinuteColor := Value;
  DoRepaint;
end;

procedure TClockPartition.SetHourSize(Value: Integer);
begin
  FHourSize := Value;
  DoRepaint;
end;

procedure TClockPartition.SetMinuteSize(Value: Integer);
begin
  FMinuteSize := Value;
  DoRepaint;
end;

procedure TClockPartition.SetHourThickness(Value: Integer);
begin
  if Value > 0 then
  begin
    FHourThickness := Value;
    DoRepaint;
  end;
end;

procedure TClockPartition.SetMinuteThickness(Value: Integer);
begin
  if Value > 0 then
  begin
    FMinuteThickness := Value;
    DoRepaint;
  end;
end;

procedure TClockPartition.SetRadius(Value: Integer);
begin
  FRadius := Value;
  DoRepaint;
end;

procedure TClockPartition.DoRepaint;
begin
  if Assigned(FParentControl) then
    FParentControl.Repaint;
end;

constructor TClockPartition.Create(AParent: TControl;
  AHourSize, AHourThickness: Integer; AHourColor: TColor;
  AMinuteSize, AMinuteThickness: Integer; AMinuteColor: TColor;
  ARadius: Integer; AEnabled: Boolean);
begin
  inherited Create;
  FParentControl := AParent;
  FHourSize := AHourSize;
  FHourThickness := AHourThickness;
  FHourColor := AHourColor;
  FMinuteSize := AMinuteSize;
  FMinuteThickness := AMinuteThickness;
  FMinuteColor := AMinuteColor;
  FRadius := ARadius;
  FEnabled := AEnabled;
end;

{ TfrCustomClock }

constructor TfrCustomClock.Create(AOwner: TComponent);
begin
  inherited;
  Width := 200;
  Height := 200;

  FCanvas := TControlCanvas.Create;
  FCanvas.Brush.Style := bsClear;
  TControlCanvas(FCanvas).Control := self;

  FBitmap := TBitmap.Create;

  FClockLabel := TClockLabel.Create(self, 80, true);
  FClockLabel.Values.CommaText := '1,2,3,4,5,6,7,8,9,10,11,12';

  FClockPartition := TClockPartition.Create(self, 10, 3, clBlack, 6, 1, clBlack,
                                            100, true);

  FHourHand := TClockHand.Create(self, 60, 3, clBlack, true);
  FMinuteHand := TClockHand.Create(self, 100, 3, clBlack, true);
  FSecondHand := TClockHand.Create(self, 100, 1, clRed, true);

  FCurrentTime := Now;
  FTimer := TTimer.Create(self);
  TimerEnabled := true;
  TimerInterval := 100;
  FTimer.OnTimer := DoTimer;
end;

destructor TfrCustomClock.Destroy;
begin
  FSecondHand.Free;
  FMinuteHand.Free;
  FHourHand.Free;
  FClockPartition.Free;
  FClockLabel.Free;
  FBitmap.Free;
  FCanvas.Free;
  inherited;
end;

function TfrCustomClock.GetVersion: string;
begin
  result := FR_CLOCK_VERSION;
end;

procedure TfrCustomClock.SetCurrentTime(Value: TTime);
begin
  FCurrentTime := Value;
  Repaint;
end;

procedure TfrCustomClock.SetTimerEnabled(Value: Boolean);
begin
  FTimer.Enabled := Value;
  FTimerEnabled := FTimer.Enabled;
end;

procedure TfrCustomClock.SetTimerInterval(Value: Integer);
begin
  FTimer.Interval := Value;
  FTimerInterval := FTimer.Interval;
end;

function TfrCustomClock.GetAnglePoint(X, Y: Integer;
  Radius, Angle: Double): TPoint;
begin
  result.X := X + Round(Cos(Angle) * Radius);
  result.Y := Y - Round(Sin(Angle) * Radius);
end;

procedure TfrCustomClock.DoPaint;
begin
  if Assigned(FOnPaintBefore) then
    FOnPaintBefore(self);

  DrawClock(Canvas, FBitmap, Font, ClockLabel, ClockPartition, HourHand,
            MinuteHand, SecondHand, CurrentTime);

  if Assigned(FOnPaintAfter) then
    FOnPaintAfter(self);
end;

procedure TfrCustomClock.DoTimer(Sender: TObject);
begin
  if not(csDesigning in ComponentState) then
    Repaint;
end;

procedure TfrCustomClock.DrawClock(ACanvas: TCanvas; ABitmap: TBitmap;
  AFont: TFont; AClockLabel: TClockLabel; AClockPartition: TClockPartition;
  AHourHand, AMinuteHand, ASecondHand: TClockHand; ACurrentTime: TTime);
var
  pt: TPoint;
begin
  pt.X := Width div 2;
  pt.Y := Height div 2;

  if not(csDesigning in ComponentState) then
    ACurrentTime := Now;

  ABitmap.Width := Width;
  ABitmap.Height := Height;
  ABitmap.Canvas.FillRect(Rect(0, 0, ABitmap.Width, ABitmap.Height));
  ABitmap.Canvas.Font := AFont;

  DrawClockPartition(ABitmap.Canvas, pt.X, pt.Y, AClockPartition);
  ABitmap.Canvas.Brush.Style := bsClear;
  DrawClockLabel(ABitmap.Canvas, pt.X, pt.Y, AClockLabel);
  ABitmap.Canvas.Brush.Style := bsSolid;
  DrawClockHands(ABitmap.Canvas, pt.X, pt.Y, AHourHand, AMinuteHand,
                 ASecondHand, ACurrentTime);

  TransparentBlt(ACanvas.Handle, 0, 0, Width, Height, ABitmap.Canvas.Handle, 0,
                 0, ABitmap.Width, ABitmap.Height, ABitmap.Canvas.Brush.Color);
end;

procedure TfrCustomClock.DrawClockHands(ACanvas: TCanvas; MX, MY: Integer;
  AHourHand, AMinuteHand, ASecondHand: TClockHand; ATime: TDateTime);
var
  wHour, wMin, wSec, wMSec: Word;
  pt: TPoint;
  lAngle: Double;
begin
  DecodeTime(ATime, wHour, wMin, wSec, wMSec);

  // Draw hour hand
  if AHourHand.Enabled then
  begin
    lAngle := 90 - (30 * wHour + (wMin / 2));
    pt := GetAnglePoint(MX, MY, AHourHand.Size, lAngle);
    ACanvas.Pen.Width := AHourHand.Thickness;
    ACanvas.Pen.Color := AHourHand.Color;
    ACanvas.MoveTo(MX, MY);
    ACanvas.LineTo(pt.X, pt.Y);
  end;

  // Draw minute hand
  if AMinuteHand.Enabled then
  begin
    lAngle := 90 - 6 * wMin;
    pt := GetAnglePoint(MX, MY, AMinuteHand.Size, lAngle);
    ACanvas.Pen.Width := AMinuteHand.Thickness;
    ACanvas.Pen.Color := AMinuteHand.Color;
    ACanvas.MoveTo(MX, MY);
    ACanvas.LineTo(pt.X, pt.Y);
  end;

  // Draw second hand
  if ASecondHand.Enabled then
  begin
    lAngle := 90 - (6 * wSec + (0.36 * (wMSec / 60)));
    pt := GetAnglePoint(MX, MY, ASecondHand.Size, lAngle);
    ACanvas.Pen.Width := ASecondHand.Thickness;
    ACanvas.Pen.Color := ASecondHand.Color;
    ACanvas.MoveTo(MX, MY);
    ACanvas.LineTo(pt.X, pt.Y);
  end;
end;

procedure TfrCustomClock.DrawClockLabel(ACanvas: TCanvas; MX, MY: Integer;
  AClockLabel: TClockLabel);
var
  pt: TPoint;
  i, deltaX, deltaY: Integer;
begin
  if not AClockLabel.Enabled then
    Exit;

  with AClockLabel do
  begin
    for i := 0 to 11 do
    begin
      pt := GetAnglePoint(MX, MY, Radius, 90 - (i + 1) * 30);
      deltaX := ACanvas.TextWidth(Values.Strings[i]) div 2;
      deltaY := ACanvas.TextHeight(Values.Strings[i]) div 2;
      ACanvas.TextOut(pt.X - deltaX, pt.Y - deltaY, Values.Strings[i]);
    end;
  end;
end;

procedure TfrCustomClock.DrawClockPartition(ACanvas: TCanvas; MX, MY: Integer;
  AClockPartition: TClockPartition);
var
  pt, ppt: TPoint;
  i: integer;
begin
  if not AClockPartition.Enabled then
    Exit;

  with AClockPartition do
  begin
    for i := 1 to 60 do
    begin
      if i mod 5 = 0 then // if partition is hour (1..12)
      begin
        ACanvas.Pen.Color := HourColor;
        ACanvas.Pen.Width := HourThickness;
        ppt := GetAnglePoint(MX, MY, Radius - HourSize, 90 - i * 6);
      end else
      begin
        ACanvas.Pen.Color := MinuteColor;
        ACanvas.Pen.Width := MinuteThickness;
        ppt := GetAnglePoint(MX, MY, Radius - MinuteSize, 90 - i * 6);
      end;

      pt := GetAnglePoint(MX, MY, Radius, 90 - i * 6);
      ACanvas.MoveTo(pt.X, pt.Y);
      ACanvas.LineTo(ppt.X, ppt.Y);
    end;
  end;
end;

procedure TfrCustomClock.WndProc(var Message: TMessage);
begin
  inherited;
  case Message.Msg of
    WM_PAINT : DoPaint;
  end;
end;

procedure Register;
var
  author: string;
begin
  {$IFDEF FPC}
  author := 'Fruehlingsrolle';
  {$ELSE}
  author := 'Frühlingsrolle';
  {$ENDIF}
  RegisterComponents(author,[TfrClock]);
end;

end.


Alle Zeitangaben in WEZ +1. Es ist jetzt 03:23 Uhr.

Powered by vBulletin® Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2019 by Daniel R. Wolf