unit DateTimeLabelUnit;  { TDateTimeLabel component. }
{-----------------------------------------------------------------------------}
{  Name   : TDateTimeLabel                                                    }
{  Author : G. Bradley MacDonald                                              }
{  Date   : March 1997                                                        }
{  Cost   : $5.00 US                                                          }
{  Purpose: This component provides the programmer with a Date and Time Label }
{-----------------------------------------------------------------------------}
{  Version:  1.01                                                             }
{            Added property 'RunTimerinDesign' to allow the programmer to see }
{            the timmer event (ie time changing) in Design Mode               }
{  Version:  1.00                                                             }
{            All New                                                          }
{                                                                             }
{-----------------------------------------------------------------------------}

interface

uses
  Windows,
  SysUtils,
  Messages,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  Menus,
  StdCtrls,
  WinTypes,
  WinProcs,
  ExtCtrls;

type
  TShadowStyle = (Raised, Lowered, HasShadow, NormalWithDisable, NoShadow);
  TLabelType = (dtDate, dtTime, dtDateTime);

type
  TDateTimeLabel = class(TCustomLabel)
  private
    FRefreshTimer: TTimer;
    FLabelType: TLabelType;
    FDateTimeFormat: String;
    FAutoFormat: Boolean;
    FRunTimerInDesign: Boolean;

    { Private declarations }
    FRotationAngle: Integer;
    FShadowOffset: Integer;
    FShadowStyle: TShadowStyle;
    FHighlightColor: TColor;
    FShadowColor: TColor;
    {$IFDEF Win32}
    FUnicodeCaption: Boolean;
    {$ENDIF}
    procedure SetRotationAngle(newAngle: Integer);
    procedure SetShadowOffset(newShadowOffset: Integer);
    procedure SetHighlightColor(newColor: TColor);
    procedure SetShadowColor(newColor: TColor);
    procedure SetShadowStyle(newStyle: TShadowStyle);
    procedure RedrawLabel;
    procedure SetDateTimeFormat(newValue: String);
    procedure SetLabelType(newValue: TLabelType);
    procedure SetInterval_FRefreshTimer(newValue: Cardinal);
    function GetInterval_FRefreshTimer: Cardinal;
    procedure Timer_FRefreshTimerHandler(Sender: TObject);  { TNotifyEvent }
  protected
    { Protected declarations }
    procedure Paint; override;
    property Transparent default False;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published properties and events }
    { Inherited properties: }
    property Align;
    property Alignment;
    property AutoSize;
    property Caption;
    property Color;
    property Font;
    property PopupMenu;
    property ShowHint;
    property WordWrap;
    property Rotation: Integer read FRotationAngle write SetRotationAngle default 0;
    property ShadowStyle: TShadowStyle read FShadowStyle write SetShadowStyle;
    property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow;
    property HighlightColor: TColor read FHighlightColor write SetHighlightColor default clBtnHighlight;
    property ShadowOffset: integer read FShadowOffset write SetShadowOffset default 1;
    {$IFDEF Win32}
    property UnicodeCaption: boolean read FUnicodeCaption write FUnicodeCaption default False;
    {$ENDIF}
    property AutoFormat: Boolean read FAutoFormat write FAutoFormat default True;
    property RunTimerinDesign: Boolean read FRunTimerInDesign write FRunTimerInDesign default False;
    property DateTimeFormat: String read FDateTimeFormat write SetDateTimeFormat;
    property LabelType: TLabelType read FLabelType write SetLabelType;
    property Interval_FRefreshTimer: Cardinal read GetInterval_FRefreshTimer write SetInterval_FRefreshTimer default 0;
  end;  { TDateTimeLabel }

procedure Register;

implementation

procedure TDateTimeLabel.SetRotationAngle(newAngle: Integer);
{ sets the angle for text rotation (limited to -180° and +180°, inclusive). }
var
  localTextMetrics: TTextMetric;
begin
    if newAngle > 0 then
    newAngle := newAngle mod 360
    else
    newAngle := -(abs(newAngle) mod 360);

    if newAngle > 180 then
    newAngle := newAngle - 360
    else if newAngle < -180 then
    newAngle := newAngle + 360;

    if newAngle <> FRotationAngle then
  begin
    FRotationAngle := newAngle;
    if (not (csLoading in ComponentState)) and (FRotationAngle <> 0) then    { We're rotating. }
    begin    { Make sure we've got a TrueType font... }
      Canvas.Font := Self.Font;
      GetTextMetrics(Canvas.Handle, localTextMetrics);
      if (localTextMetrics.tmPitchAndFamily and TMPF_TrueType) = 0 then    { Not TrueType! }
      begin
        { You may want to inform users that they can only rotate TrueType fonts. }
        Font.Name := 'Arial';    { Force it. }
      end;    { if }
    end;    { if }
    RedrawLabel;
  end;
end;        { SetRotationAngle }

Procedure TDateTimeLabel.SetShadowOffset(newShadowOffset: Integer);
{ Sets data member FShadowOffset to newShadowOffset. }
begin
  if FShadowOffset <> newShadowOffset then
  begin
    FShadowOffset := newShadowOffset;
    RedrawLabel;
  end;
end;        { SetShadowOffset }

procedure TDateTimeLabel.SetHighlightColor(newColor: TColor);
{ Sets data member FHighlightColor to newColor. }
begin
    if FHighlightColor <> newColor then
    begin
    FHighlightColor := newColor;
    RedrawLabel;
    end;
end;        { SetHighlightColor }

procedure TDateTimeLabel.SetShadowColor(newColor: TColor);
{ Sets data member FShadowColor to newColor. }
begin
  if FShadowColor <> newColor then
  begin
    FShadowColor := newColor;
    RedrawLabel;
  end;
end;        { SetShadowColor }

procedure TDateTimeLabel.SetShadowStyle(newStyle: TShadowStyle);
{ Sets data member SetShadowStyle to newStyle. }
begin
  if FShadowStyle <> newStyle then
  begin
    FShadowStyle := newStyle;
    RedrawLabel;
  end;
end;        { SetShadowStyle }

procedure TDateTimeLabel.RedrawLabel;
{ Forces transparent to false temporarily. }
var
  saveTransparent: boolean;
begin

  If FLabelType = dtDate then Begin
    If FDateTimeFormat = '' then FDateTimeFormat := 'ddddd';
    Caption := FormatDateTime(FDateTimeFormat,Date());
  End;
  If FLabelType = dtTime then Begin
    If FDateTimeFormat = '' then FDateTimeFormat := 't';
    Caption := FormatDateTime(FDateTimeFormat,Time());
  End;
  If FLabelType = dtDateTime then Begin
    If FDateTimeFormat = '' then FDateTimeFormat := 'c';
    Caption := FormatDateTime(FDateTimeFormat,Now());
  End;

  saveTransparent := Transparent;
  Transparent := False;
  Invalidate;
  Transparent := saveTransparent;
end;  { RedrawLabel }

procedure TDateTimeLabel.Paint;
var
  localCaption,
  localFaceName: string;
  localOffset,
  X,
  Y,
  newHeight,
  newWidth: integer;
  newFontHandle: HFont;
  oldFontHandle: HFont;
  stringWidth,
  stringHeight,
  R: real;
  localTextExtent: Longint;
  {$IFDEF Win32}
  Size: TSize;
  {$ENDIF}

  procedure LocalDrawText(deltaX, deltaY: Integer; textColor: TColor);
  var
    localRect: TRect;
  begin
    SetTextColor(Canvas.Handle, ColorToRGB(textColor));
    ExtTextOut(Canvas.Handle, X + deltaX, Y + deltaY, 0, @localRect, @localCaption[1], Length(localCaption), nil);
  end;    { LocalDrawText }

begin       { Paint }
  if not Transparent then  { Erase background. }
    with Canvas do
    begin
      Brush.Color := Self.Color;
      Brush.Style := bsSolid;
        FillRect(ClientRect);
    end;  { with }

  localCaption := Caption;

  { Make localFaceName null-terminated: }
  localFaceName := Font.Name + #0;

  { Create the rotated font: }
  newFontHandle:= CreateFont(Font.Height,
                        0,    { Width }
                        FRotationAngle * 10,    { Escapement - Rotation is in tenths of a degree. }
                        0,    { Orientation }
                        ord(fsBold in Font.Style) * FW_BOLD,    { Weight }
                        ord(fsItalic in Font.Style),    { Italic }
                        ord(fsUnderLine in Font.Style),    { Underline }
                        ord(fsStrikeOut in Font.Style),    { StrikeOut }
                        DEFAULT_CHARSET,    { Charset }
                        OUT_DEFAULT_PRECIS,    { Output Precision }
                        CLIP_DEFAULT_PRECIS,    { Clipping Precision }
                        DEFAULT_QUALITY,    { Quality }
                        DEFAULT_PITCH + FF_DONTCARE,    { Pitch }
                        @localFaceName[1]);    { "[1]" points to first character in string }

  { Select the new font into the HDC }
  oldFontHandle:= SelectObject(Canvas.Handle, newFontHandle);

  { Calculate the height and width of the text. }
  {$IFDEF Win32}
  If FUnicodeCaption Then
    GetTextExtentPointW(Canvas.Handle, @localCaption[1], Length(localCaption), Size)
  Else
    GetTextExtentPointA(Canvas.Handle, @localCaption[1], Length(localCaption), Size);
  stringWidth := Size.cx;
  stringHeight := Size.cy;
  {$ELSE}
  localTextExtent := GetTextExtent(Canvas.Handle, @localCaption[1], Length(localCaption));
  stringWidth := LoWord(localTextExtent);
  stringHeight := HiWord(localTextExtent);
  {$ENDIF}
  R := pi * (FRotationAngle / 180);

  { Calculate the length of the text box: }
  newWidth := Round(Abs( stringHeight * sin(R)) + Abs( stringWidth * cos(R))) + FShadowOffset;
  newHeight := Round(Abs( stringWidth * sin(R)) + Abs( stringHeight * cos(R))) + FShadowOffset;

  if (Align=alTop) or (Align=alNone) or (Align=alBottom) then
    Height := newHeight;
  if (Align=alLeft) or (Align=alRight) or (align=alNone) then
    Width := newWidth;

  { Calculate starting point for text, depending on angle of rotation: }
  if (FRotationAngle >= 0) and (FRotationAngle <= 90) then    { 0..90 degrees }
  begin
    X := 0;
    Y := Abs(Round(stringWidth * sin(R)));
  end
  else if (FRotationAngle >= -90) and (FRotationAngle < 0) then    { -90..-1 degrees }
  begin
    X := Abs(Round(stringHeight * sin(R)));
    Y := 0;
  end
  else if (FRotationAngle > 90) and (FRotationAngle <= 180) then    { 91..180 degrees }
  begin
    X := Abs(Round(stringWidth * cos(R)));
    Y := newHeight;
  end
  else if (FRotationAngle > -180) and (FRotationAngle < -90) then  { -179..-91 degree }
  begin
    X := newWidth;
    Y := Abs(Round(stringHeight * cos(R)));
  end;

  { Use a transparent brush to write the text. }
  Canvas.Brush.Style := bsClear;

  if FShadowStyle <> NoShadow then
  begin
    localOffset := FShadowOffset;
    if ((FShadowStyle <> HasShadow) and (FShadowStyle <> NormalWithDisable)) or
       ((FShadowStyle = NormalWithDisable) and (not Enabled)) then    { Draw highlighting. }
    begin
      if (FShadowStyle = Lowered) or (FShadowStyle = NormalWithDisable) then
        localOffset := -FShadowOffset;
      LocalDrawText(-localOffset, -localOffset, FHighlightColor);
    end;

    if FShadowStyle <> NormalWithDisable then    { Now draw shadow: }
      LocalDrawText(localOffset, localOffset, ShadowColor)
    else if (FShadowStyle = NormalWithDisable) and (not Enabled) then
    begin
      LocalDrawText(0, 0, FShadowColor);
      SelectObject(Canvas.Handle, oldFontHandle);
      DeleteObject(newFontHandle);
      Exit;
    end;
  end;

  { Now draw the normal text on top of shadow and highlighting: }
  LocalDrawText(0, 0, Font.Color);

  { Restore the previous font used in this HDC. }
  SelectObject(Canvas.Handle, oldFontHandle);

  { Delete our rotated font. }
  DeleteObject(newFontHandle);
end;        { Paint }

procedure TDateTimeLabel.SetDateTimeFormat(newValue: String);
{ Sets data member FDateTimeFormat to newValue. }
begin
  if FDateTimeFormat <> newValue then
  begin
    FDateTimeFormat := newValue;
    {  Add display update code here if needed. }
    ReDrawLabel;
  end;
end;  { SetDateTimeFormat }

procedure TDateTimeLabel.SetLabelType(newValue: TLabelType);
{ Sets data member FLabelType to newValue. }
begin
  If FLabelType <> newValue then begin
    FLabelType := newValue;
    { Add display update code here if needed. }
    If (FDateTimeFormat = '') or (FAutoFormat) Then Begin
      If FLabelType = dtDateTime then  FDateTimeFormat := 'c';
      If FLabelType = dtDate     then  FDateTimeFormat := 'ddddd';
      If FLabelType = dtTime     then  FDateTimeFormat := 't';
    End;
    ReDrawLabel;
  End;
end;  { SetLabelType }

{ Exposed properties' Read/Write methods: }
procedure TDateTimeLabel.SetInterval_FRefreshTimer(newValue: Cardinal);
{ Sets the FRefreshTimer subcomponent's Interval property to newValue. }
begin
  FRefreshTimer.Interval := newValue;
end;  { SetInterval_FRefreshTimer }

function TDateTimeLabel.GetInterval_FRefreshTimer: Cardinal;
{ Returns the Interval property from the FRefreshTimer subcomponent. }
begin
  GetInterval_FRefreshTimer := FRefreshTimer.Interval;
end;  { GetInterval_FRefreshTimer }

procedure TDateTimeLabel.Timer_FRefreshTimerHandler(Sender: TObject);
{ Handles the FRefreshTimer OnTimer event. }
begin
  { Place your event handler code here. }
  If (NOT (csDesigning in ComponentState)) or (FRunTimerinDesign) then Begin
    ReDrawLabel;
  End;
end;  { Timer_FRefreshTimerHandler }

destructor TDateTimeLabel.Destroy;
begin
  { Free member variables: }
  { Free allocated memory and created objects here. }
  FRefreshTimer.Free;
  inherited Destroy;
end;  { Destroy }

constructor TDateTimeLabel.Create(AOwner: TComponent);
{ Creates an object of type TDateTimeLabel, and initializes properties. }
begin
  inherited Create(AOwner);
  FShadowColor      := clBtnShadow;
  FHighlightColor   := clBtnHighlight;
  FShadowOffset     := 1;
  Transparent       := False;
  { Initialize properties with default values: }
  FAutoFormat       := True;
  FRunTimerinDesign := False;
  FLabelType        := dtDateTime;
  FDateTimeFormat   := 'c';

  { Create member variables (that are objects): }
  FRefreshTimer          := TTimer.Create(Self);
  FRefreshTimer.Interval := 90000;   { Every 15 Minutes }
  FRefreshTimer.OnTimer  := Timer_FRefreshTimerHandler;
  { Make sure FRefreshTimer has been created (make sure it's valid). }
  FRefreshTimer.OnTimer  := Timer_FRefreshTimerHandler;


  ReDrawLabel;

end;  { Create }

procedure Register;
begin
  RegisterComponents('LDB', [TDateTimeLabel]);
end;  { Register }

end.