jvtfutils.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvTFUtils.PAS, released on 2003-08-01.

The Initial Developer of the Original Code is Unlimited Intelligence Limited.
Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
All Rights Reserved.

Contributor(s):
Mike Kolter (original code)

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvTFUtils.pas,v 1.26 2005/02/17 10:20:56 marquardt Exp $

unit JvTFUtils;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Graphics, Controls, Classes, SysUtils;

{$HPPEMIT '#ifndef TDate'}
{$IFDEF VCL}
{$HPPEMIT '#define TDate Controls::TDate'}
{$HPPEMIT '#define TTime Controls::TTime'}
{$ENDIF VCL}
{$IFDEF VisualCLX}
{$HPPEMIT '#define TDate TDateTime'}
{$HPPEMIT '#define TTime TDateTime'}
{$ENDIF VisualCLX}
{$HPPEMIT '#endif'}
  
type
  TJvTFVisibleScrollBars = set of (vsbHorz, vsbVert);
  EJvTFDateError = class(Exception);

  TTFDayOfWeek = (dowSunday, dowMonday, dowTuesday, dowWednesday,
    dowThursday, dowFriday, dowSaturday);
  TTFDaysOfWeek = set of TTFDayOfWeek;

  TJvTFVAlignment = (vaTop, vaCenter, vaBottom);

  TJvTFDirection = (dirUp, dirDown, dirLeft, dirRight);

const
  DOW_WEEK: TTFDaysOfWeek = [dowSunday..dowSaturday];
  DOW_WEEKEND: TTFDaysOfWeek = [dowSunday, dowSaturday];
  DOW_WORKWEEK: TTFDaysOfWeek = [dowMonday..dowFriday];

  ONE_HOUR = 1 / 24;
  ONE_MINUTE = ONE_HOUR / 60;
  ONE_SECOND = ONE_MINUTE / 60;
  ONE_MILLISECOND = ONE_SECOND / 1000;

function ExtractYear(ADate: TDateTime): Word;
function ExtractMonth(ADate: TDateTime): Word;
function ExtractDay(ADate: TDateTime): Word;
function ExtractHours(ATime: TDateTime): Word;
function ExtractMins(ATime: TDateTime): Word;
function ExtractSecs(ATime: TDateTime): Word;
function ExtractMSecs(ATime: TDateTime): Word;
function FirstOfMonth(ADate: TDateTime): TDateTime;
function GetDayOfNthDOW(Year, Month, DOW, N: Word): Word;
function GetWeeksInMonth(Year, Month: Word; StartOfWeek: Integer): Word;

procedure IncBorlDOW(var BorlDOW: Integer; N: Integer = 1);
procedure IncDOW(var DOW: TTFDayOfWeek; N: Integer = 1);
procedure IncDays(var ADate: TDateTime; N: Integer = 1);
procedure IncWeeks(var ADate: TDateTime; N: Integer = 1);
procedure IncMonths(var ADate: TDateTime; N: Integer = 1);
procedure IncYears(var ADate: TDateTime; N: Integer = 1);

function EndOfMonth(ADate: TDateTime): TDateTime;
function IsFirstOfMonth(ADate: TDateTime): Boolean;
function IsEndOfMonth(ADate: TDateTime): Boolean;
procedure EnsureMonth(Month: Word);
procedure EnsureDOW(DOW: Word);
function EqualDates(D1, D2: TDateTime): Boolean;
function Lesser(N1, N2: Integer): Integer;
function Greater(N1, N2: Integer): Integer;
function GetDivLength(TotalLength, DivCount, DivNum: Integer): Integer;
function GetDivNum(TotalLength, DivCount, X: Integer): Integer;
function GetDivStart(TotalLength, DivCount, DivNum: Integer): Integer;
function DOWToBorl(ADOW: TTFDayOfWeek): Integer;
function BorlToDOW(BorlDOW: Integer): TTFDayOfWeek;
function DateToDOW(ADate: TDateTime): TTFDayOfWeek;

procedure CalcTextPos(HostRect: TRect; var TextLeft, TextTop: Integer;
  var TextBounds: TRect; AFont: TFont; AAngle: Integer;
  HAlign: TAlignment; VAlign: TJvTFVAlignment; ATxt: string);

procedure DrawAngleText(ACanvas: TCanvas; HostRect: TRect;
  var TextBounds: TRect; AAngle: Integer; HAlign: TAlignment;
  VAlign: TJvTFVAlignment; ATxt: string);

function RectWidth(ARect: TRect): Integer;
function RectHeight(ARect: TRect): Integer;
function EmptyRect: TRect;
function IsClassByName(Obj: TObject; ClassName: ShortString): Boolean;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvTFUtils.pas,v $';
    Revision: '$Revision: 1.26 $';
    Date: '$Date: 2005/02/17 10:20:56 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

{$IFDEF USEJVCL}
uses
  JvResources;
{$ENDIF USEJVCL}

{$IFNDEF USEJVCL}
resourcestring
  RsEResultDoesNotFallInMonth = 'Result does not fall in given month';
  RsEInvalidMonthValue = 'Invalid Month Value (%d)';
  RsEInvalidDayOfWeekValue = 'Invalid value for day of week (%d)';
{$ENDIF !USEJVCL}

function ExtractYear(ADate: TDateTime): Word;
var
  M, D: Word;
begin
  DecodeDate(ADate, Result, M, D);
end;

function ExtractMonth(ADate: TDateTime): Word;
var
  Y, D: Word;
begin
  DecodeDate(ADate, Y, Result, D);
end;

function ExtractDay(ADate: TDateTime): Word;
var
  Y, M: Word;
begin
  DecodeDate(ADate, Y, M, Result);
end;

function FirstOfMonth(ADate: TDateTime): TDateTime;
var
  Y, M, D: Word;
begin
  DecodeDate(ADate, Y, M, D);
  Result := EncodeDate(Y, M, 1);
end;

function GetDayOfNthDOW(Year, Month, DOW, N: Word): Word;
var
  FirstDayDOW: Word;
  WorkDate: TDateTime;
begin
  WorkDate := EncodeDate(Year, Month, 1);
  FirstDayDOW := DayOfWeek(WorkDate);
  WorkDate := WorkDate + (DOW - FirstDayDOW);
  if DOW < FirstDayDOW then
    WorkDate := WorkDate + 7;

  // WorkDate is now at the first DOW
  // Now adjust for N
  WorkDate := WorkDate + (7 * (N - 1));

  Result := ExtractDay(WorkDate);
  // Finally, check to make sure WorkDate is in the given month
  if Trunc(EncodeDate(Year, Month, 1)) <> Trunc(FirstOfMonth(WorkDate)) then
    raise EJvTFDateError.CreateRes(@RsEResultDoesNotFallInMonth);
end;

function GetWeeksInMonth(Year, Month: Word; StartOfWeek: Integer): Word;
var
  DOW,
    EndOfWeek: Integer;
  EOM,
    WorkDate: TDateTime;
begin
  // Get the end of the week
  EndOfWeek := StartOfWeek;
  IncBorlDOW(EndOfWeek, -1);

  // Start working at the first of the month
  WorkDate := EncodeDate(Year, Month, 1);

  // Get the end of the month
  EOM := EndOfMonth(WorkDate);

  // Get the day the first falls on
  DOW := DayOfWeek(WorkDate);

  // Advance WorkDate to the end of the week
  while DOW <> EndOfWeek do
  begin
    IncBorlDOW(DOW, 1);
    WorkDate := WorkDate + 1;
  end;

  // We're now on week 1
  Result := 1;
  // Now roll through the rest of the month
  while Trunc(WorkDate) < Trunc(EOM) do
  begin
    Inc(Result);
    IncWeeks(WorkDate, 1);
  end;
end;

procedure IncBorlDOW(var BorlDOW: Integer; N: Integer); // N defaults to 1
begin
  BorlDOW := (BorlDOW + (N mod 7)) mod 7;
  if BorlDOW = 0 then
    BorlDOW := 7;
  BorlDOW := Abs(BorlDOW);
end;

procedure IncDOW(var DOW: TTFDayOfWeek; N: Integer);
                                  // N defaults to 1
var
  BorlDOW: Integer;
begin
  BorlDOW := DOWToBorl(DOW);
  IncBorlDOW(BorlDOW, N);
  DOW := BorlToDOW(BorlDOW);
end;

procedure IncDays(var ADate: TDateTime; N: Integer);
                                     // N defaults to 1
begin
  ADate := ADate + N;
end;

procedure IncWeeks(var ADate: TDateTime; N: Integer);
                                     // N defaults to 1
begin
  ADate := ADate + N * 7;
end;

procedure IncMonths(var ADate: TDateTime; N: Integer);
                                      // N defaults to 1
var
  Y, M, D, EOMD: Word;
begin
  DecodeDate(ADate, Y, M, D);
  Inc(Y, N div 12);
  Inc(M, N mod 12);

  // Be careful not to get invalid date in Feb.
  if M = 2 then
  begin
    EOMD := ExtractDay(EndOfMonth(EncodeDate(Y, M, 1)));
    if D > EOMD then
      D := EOMD;
  end;

  ADate := EncodeDate(Y, M, D);
end;

procedure IncYears(var ADate: TDateTime; N: Integer);
                                     // N defaults to 1
var
  Y, M, D, EOMD: Word;
begin
  DecodeDate(ADate, Y, M, D);
  Inc(Y, N);

  // Be careful not to get invalid date in Feb.
  if M = 2 then
  begin
    EOMD := ExtractDay(EndOfMonth(EncodeDate(Y, M, 1)));
    if D > EOMD then
      D := EOMD;
  end;

  ADate := EncodeDate(Y, M, D);
end;

function EndOfMonth(ADate: TDateTime): TDateTime;
var
  Y, M, D: Word;
begin
  DecodeDate(ADate, Y, M, D);
  Inc(M);
  if M > 12 then
  begin
    M := 1;
    Inc(Y);
  end;
  Result := EncodeDate(Y, M, 1) - 1;
end;

function IsFirstOfMonth(ADate: TDateTime): Boolean;
var
  Y, M, D: Word;
begin
  DecodeDate(ADate, Y, M, D);
  Result := D = 1;
end;

function IsEndOfMonth(ADate: TDateTime): Boolean;
begin
  Result := EqualDates(ADate, EndOfMonth(ADate));
end;

procedure EnsureMonth(Month: Word);
begin
  if (Month < 1) or (Month > 12) then
    raise EJvTFDateError.CreateResFmt(@RsEInvalidMonthValue, [Month]);
end;

procedure EnsureDOW(DOW: Word);
begin
  if (DOW < 1) or (DOW > 7) then
    raise EJvTFDateError.CreateResFmt(@RsEInvalidDayOfWeekValue, [DOW]);
end;

function EqualDates(D1, D2: TDateTime): Boolean;
begin
  Result := Trunc(D1) = Trunc(D2);
end;