AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

TfrClock

Ein Thema von Frühlingsrolle · begonnen am 19. Dez 2019
Antwort Antwort
Frühlingsrolle
Registriert seit: 31. Aug 2019
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.
Miniaturansicht angehängter Grafiken
frclock_preview.png  
 
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 23:32 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