lazarus-ccr/components/jvcllaz/run/JvTimeFramework/jvtfutils.pas

{-----------------------------------------------------------------------------
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.delphi-jedi.org

Known Issues:
-----------------------------------------------------------------------------}
// $Id$

unit JvTFUtils;

{$mode objfpc}{$H+}

interface

uses
  //Windows,
  LCLType, LCLIntf, Types,
  Graphics, Controls, Classes, SysUtils;

(*
{$IFNDEF COMPILER12_UP} // Delphi 2009 knows System::TDate and System::TTime
{$HPPEMIT '#ifndef TDate'}
{$HPPEMIT '#define TDate Controls::TDate'}
{$HPPEMIT '#define TTime Controls::TTime'}
{$HPPEMIT '#endif'}
{$ENDIF ~COMPILER12_UP}
*)

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(ACanvas: TCanvas;
  HostRect: TRect; var TextLeft, TextTop: Integer;
  var TextBounds: TRect; AFont: TFont; AAngle: Integer;
  HAlign: TAlignment; VAlign: TJvTFVAlignment; ATxt: String);
{
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: string): Boolean;

function StringsToStr(const List: TStrings; const Sep: string;
  const AllowEmptyString: Boolean = True): string;

implementation

uses
  Math, JvResources;

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;
  X : Cardinal;
begin
  DecodeDate(ADate, Y, M, D);
  X := ((Y * 12) + M - 1 + N);
  Y := X div 12;
  M := (X mod 12) + 1;

  // 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;

function ExtractHours(ATime: TDateTime): Word;
var
  M, S, MS: Word;
begin
  DecodeTime(ATime, Result, M, S, MS);
end;

function ExtractMins(ATime: TDateTime): Word;
var
  H, S, MS: Word;
begin
  DecodeTime(ATime, H, Result, S, MS);
end;

function ExtractSecs(ATime: TDateTime): Word;
var
  H, M, MS: Word;
begin
  DecodeTime(ATime, H, M, Result, MS);
end;

function ExtractMSecs(ATime: TDateTime): Word;
var
  H, M, S: Word;
begin
  DecodeTime(ATime, H, M, S, Result);
end;

function Lesser(N1, N2: Integer): Integer;
begin
  if N1 < N2 then
    Result := N1
  else
    Result := N2;
end;

function Greater(N1, N2: Integer): Integer;
begin
  if N1 > N2 then
    Result := N1
  else
    Result := N2;
end;

function GetDivLength(TotalLength, DivCount, DivNum: Integer): Integer;
begin
  if (DivNum < 0) or (DivNum >= DivCount) then
    Result := -1
  else
  begin
    Result := TotalLength div DivCount;
    if DivNum < TotalLength mod DivCount then
      Inc(Result);
  end;
end;

function GetDivNum(TotalLength, DivCount, X: Integer): Integer;
var
  Base,
    MakeUp,
    MakeUpWidth: Integer;
begin
  if (X < 0) or (X >= TotalLength) then
    Result := -1
  else
  begin
    Base := TotalLength div DivCount;
    MakeUp := TotalLength mod DivCount;
    MakeUpWidth := MakeUp * (Base + 1);

    if X < MakeUpWidth then
      Result := X div (Base + 1)
    else
      Result := (X - MakeUpWidth) div Base + MakeUp;
  end;
end;

function GetDivStart(TotalLength, DivCount, DivNum: Integer): Integer;
var
  Base,
    MakeUp,
    MakeUpWidth: Integer;
begin
  if (DivNum < 0) or (DivNum >= DivCount) then
    Result := -1
  else
  begin
    Base := TotalLength div DivCount;
    MakeUp := TotalLength mod DivCount;
    MakeUpWidth := MakeUp * (Base + 1);

    if DivNum <= MakeUp then
      Result := DivNum * (Base + 1)
    else
      Result := (DivNum - MakeUp) * Base + MakeUpWidth;
  end;
end;

function DOWToBorl(ADOW: TTFDayOfWeek): Integer;
begin
  Result := Ord(ADOW) + 1;
end;

function BorlToDOW(BorlDOW: Integer): TTFDayOfWeek;
begin
  Result := TTFDayOfWeek(BorlDOW - 1);
end;

function DateToDOW(ADate: TDateTime): TTFDayOfWeek;
var
  BorlDOW: Integer;
begin
  BorlDOW := DayOfWeek(ADate);
  Result := BorlToDOW(BorlDOW);
end;

procedure CalcTextPos(ACanvas: TCanvas; HostRect: TRect; var TextLeft, TextTop: Integer;
  var TextBounds: TRect; AFont: TFont; AAngle: Integer;
  HAlign: TAlignment; VAlign: TJvTFVAlignment; ATxt: String);
var
  sinAngle, cosAngle: Extended;
  size: TSize;
  X, Y: Integer;
  A, B, C, D: Integer;
  lb, lt, rb, rt: TPoint;
begin
  SinCos(AAngle * pi / 18000, sinAngle, cosAngle);
  ACanvas.Font := AFont;
  size := ACanvas.TextExtent(ATxt);

  X := 0;
  Y := 0;

  if AAngle <= 90 then
  begin { 1.Quadrant }
    X := 0;
    Y := Trunc(size.cx * sinAngle);
//    Y := Trunc(Size.cx * Sin(AAngle * Pi / 180));
  end
  else
  if AAngle <= 180 then
  begin { 2.Quadrant }
    X := Trunc(size.cx * -cosAngle);
//    X := Trunc(Size.cx * -Cos(AAngle * Pi / 180));
    Y := Trunc(size.cx * sinAngle + size.cy * -cosAngle);
//    Y := Trunc(Size.cx * Sin(AAngle * Pi / 180) + Size.cy * Cos((180 - AAngle) * Pi / 180));
  end
  else
  if AAngle <= 270 then
  begin { 3.Quadrant }
    X := Trunc(size.cx * -cosAngle + size.cy * -sinAngle);
//    X := Trunc(Size.cx * -Cos(AAngle * Pi / 180) + Size.cy * Sin((AAngle - 180) * Pi / 180));
    Y := Trunc(Size.cy * -cosAngle);
//    Y := Trunc(Size.cy * Sin((270 - AAngle) * Pi / 180));
  end
  else
  if AAngle <= 360 then
  begin { 4.Quadrant }
    X := Trunc(size.cy * -sinAngle);
//    X := Trunc(Size.cy * Sin((360 - AAngle) * Pi / 180));
    Y := 0;
  end;

  TextLeft := HostRect.Left + X;
  TextTop := HostRect.Top + Y;
  //ARect.Top := ARect.Top + Y;
  //ARect.Left := ARect.Left + X;

  X := Abs(Trunc(size.cx * cosAngle)) + Abs(Trunc(size.cy * sinAngle));
//  X := Abs(Trunc(Size.cx * Cos(AAngle * Pi / 180))) + Abs(Trunc(Size.cy * Sin(AAngle * Pi / 180)));
  Y := Abs(Trunc(size.cx * sinAngle)) + Abs(Trunc(size.cy * cosAngle));
//  Y := Abs(Trunc(Size.cx * Sin(AAngle * Pi / 180))) + Abs(Trunc(Size.cy * Cos(AAngle * Pi / 180)));

  case HAlign of
    taCenter:
      //ARect.Left := ARect.Left + ((RectWidth(SaveRect) - X) div 2);
      TextLeft := TextLeft + ((RectWidth(HostRect) - X) div 2);
    taRightJustify:
      //ARect.Left := ARect.Left + RectWidth(SaveRect) - X;
      TextLeft := TextLeft + RectWidth(HostRect) - X;
  end;

  case VAlign of
    vaCenter:
      //ARect.Top := ARect.Top + ((RectHeight(SaveRect) - Y) div 2);
      TextTop := TextTop + ((RectHeight(HostRect) - Y) div 2);
    vaBottom:
      //ARect.Top := ARect.Top + RectHeight(SaveRect) - Y;
      TextTop := TextTop + RectHeight(HostRect) - Y;
  end;

  //ARect.Right := ARect.Left + X;
  //ARect.Bottom := ARect.Top + Y;
//********************************************
//  calculate the border areas

  A := Trunc(size.cy * sinAngle);
//  A := Trunc(size.cy * Sin(AAngle * Pi / 180));
  B := Trunc(size.cy * cosAngle);
//  B := Trunc(size.cy * Cos(AAngle * Pi / 180));
  C := Trunc(size.cx * cosAngle);
//  C := Trunc(size.cx * Cos(AAngle * Pi / 180));
  D := Trunc(size.cx * sinAngle);
//  D := Trunc(Size.cx * Sin(AAngle * Pi / 180));

  //lt := ARect.TopLeft;
  lt := Point(TextLeft, TextTop);
  lb := lt;
  lb.X := lb.X + A;
  lb.Y := lb.Y + B;
  rb := lb;
  rb.X := rb.X + C;
  rb.Y := rb.Y - D;
  rt := rb;
  rt.X := rt.X - A;
  rt.Y := rt.Y - B;

  TextBounds.Left := Lesser(Lesser(lt.X, lb.X), Lesser(rb.X, rt.X));
  TextBounds.Right := Greater(Greater(lt.X, lb.X), Greater(rb.X, rt.X));
  TextBounds.Top := Lesser(Lesser(lt.Y, lb.Y), Lesser(rb.Y, rt.Y));
  TextBounds.Bottom := Greater(Greater(lt.Y, lb.Y), Greater(rb.Y, rt.Y));
//*********************************************************************************************
end;

                         (*
//////////////////////////////////////////////////////////////////
// Credit for the CalcTextPos routine goes to Joerg Lingner.    //
// It comes from his JLLabel component (freeware - Torry's).    //
// It is used here with his permission.  Thanks Joerg!          //
// He can be reached at jlingner att t-online dott de           //
//////////////////////////////////////////////////////////////////

procedure CalcTextPos(HostRect: TRect; var TextLeft, TextTop: Integer;
  var TextBounds: TRect; AFont: TFont; AAngle: Integer;
  HAlign: TAlignment; VAlign: TJvTFVAlignment; ATxt: string);
{==========================================================================}
{ Calculate text pos. depend. on: Font, Escapement, Alignment and length   }
{--------------------------------------------------------------------------}
var
  DC: HDC;
  hSavFont: HFONT;
  Size: TSize;
  X, Y: Integer;
    //cStr   : array[0..255] of Char;
  PTxt: PChar;
  A, B, C, D: Integer;
  lb, lt, rb, rt: TPoint;
begin
  AAngle := AAngle div 10;

  PTxt := StrAlloc((Length(ATxt) + 4) * SizeOf(Char));
  StrPCopy(PTxt, ATxt);

  //StrPCopy(cStr, ATxt);
  DC := GetDC(HWND_DESKTOP);
  hSavFont := SelectObject(DC, AFont.Handle);
  //GetTextExtentPoint32(DC, cStr, Length(ATxt), Size);
  Windows.GetTextExtentPoint32(DC, PTxt, StrLen(PTxt), Size);
  StrDispose(PTxt);
  SelectObject(DC, hSavFont);
  ReleaseDC(HWND_DESKTOP, DC);

  X := 0;
  Y := 0;

  if AAngle <= 90 then
  begin { 1.Quadrant }
    X := 0;
    Y := Trunc(Size.cx * Sin(AAngle * Pi / 180));
  end
  else
  if AAngle <= 180 then
  begin { 2.Quadrant }
    X := Trunc(Size.cx * -Cos(AAngle * Pi / 180));
    Y := Trunc(Size.cx * Sin(AAngle * Pi / 180) + Size.cy * Cos((180 - AAngle) * Pi / 180));
  end
  else
  if AAngle <= 270 then
  begin { 3.Quadrant }
    X := Trunc(Size.cx * -Cos(AAngle * Pi / 180) + Size.cy * Sin((AAngle - 180) * Pi / 180));
    Y := Trunc(Size.cy * Sin((270 - AAngle) * Pi / 180));
  end
  else
  if AAngle <= 360 then
  begin { 4.Quadrant }
    X := Trunc(Size.cy * Sin((360 - AAngle) * Pi / 180));
    Y := 0;
  end;

  TextLeft := HostRect.Left + X;
  TextTop := HostRect.Top + Y;
  //ARect.Top := ARect.Top + Y;
  //ARect.Left := ARect.Left + X;

  X := Abs(Trunc(Size.cx * Cos(AAngle * Pi / 180))) + Abs(Trunc(Size.cy * Sin(AAngle * Pi / 180)));
  Y := Abs(Trunc(Size.cx * Sin(AAngle * Pi / 180))) + Abs(Trunc(Size.cy * Cos(AAngle * Pi / 180)));

  case HAlign of
    taCenter:
      //ARect.Left := ARect.Left + ((RectWidth(SaveRect) - X) div 2);
      TextLeft := TextLeft + ((RectWidth(HostRect) - X) div 2);
    taRightJustify:
      //ARect.Left := ARect.Left + RectWidth(SaveRect) - X;
      TextLeft := TextLeft + RectWidth(HostRect) - X;
  end;

  case VAlign of
    vaCenter:
      //ARect.Top := ARect.Top + ((RectHeight(SaveRect) - Y) div 2);
      TextTop := TextTop + ((RectHeight(HostRect) - Y) div 2);
    vaBottom:
      //ARect.Top := ARect.Top + RectHeight(SaveRect) - Y;
      TextTop := TextTop + RectHeight(HostRect) - Y;
  end;

  //ARect.Right := ARect.Left + X;
  //ARect.Bottom := ARect.Top + Y;
//********************************************
//  calculate the border areas

  A := Trunc(Size.cy * Sin(AAngle * Pi / 180));
  B := Trunc(Size.cy * Cos(AAngle * Pi / 180));
  C := Trunc(Size.cx * Cos(AAngle * Pi / 180));
  D := Trunc(Size.cx * Sin(AAngle * Pi / 180));

  //lt := ARect.TopLeft;
  lt := Point(TextLeft, TextTop);
  lb := lt;
  lb.X := lb.X + A;
  lb.Y := lb.Y + B;
  rb := lb;
  rb.X := rb.X + C;
  rb.Y := rb.Y - D;
  rt := rb;
  rt.X := rt.X - A;
  rt.Y := rt.Y - B;

  TextBounds.Left := Lesser(Lesser(lt.X, lb.X), Lesser(rb.X, rt.X));
  TextBounds.Right := Greater(Greater(lt.X, lb.X), Greater(rb.X, rt.X));
  TextBounds.Top := Lesser(Lesser(lt.Y, lb.Y), Lesser(rb.Y, rt.Y));
  TextBounds.Bottom := Greater(Greater(lt.Y, lb.Y), Greater(rb.Y, rt.Y));
//*********************************************************************************************
end;      *)

procedure DrawAngleText(ACanvas: TCanvas; HostRect: TRect;
  var TextBounds: TRect; AAngle: Integer; HAlign: TAlignment;
  VAlign: TJvTFVAlignment; ATxt: string);
var
//  LogFont: TLogFont;
  TxtRect: TRect;
  Flags: UINT;
  PTxt: PChar;
  ClipRgn: HRgn;
  TextLeft, TextTop: Integer;
  ts: TTextStyle;
begin
  //TxtRect := ARect;
  CalcTextPos(ACanvas, HostRect, TextLeft, TextTop, TextBounds, ACanvas.Font,
    AAngle, HAlign, VAlign, ATxt);

  ACanvas.Font.Orientation := AAngle;
  {
  Windows.GetObject(ACanvas.Font.Handle, SizeOf(LogFont), @LogFont);
  LogFont.lfEscapement := AAngle;
  LogFont.lfOrientation := LogFont.lfEscapement;
  ACanvas.Font.Handle := CreateFontIndirect(LogFont);
  Flags := DT_NOPREFIX or DT_LEFT or DT_TOP or DT_NOCLIP or DT_SINGLELINE;
  }
  ts := ACanvas.TextStyle;
  ts.Alignment := taLeftJustify;
  ts.Layout := tlTop;
  ts.Clipping := false;   // why need a ClipRect then?

  {
  PTxt := StrAlloc((Length(ATxt) + 4) * SizeOf(Char));
  StrPCopy(PTxt, ATxt);
  }
  //ClipRgn := Windows.CreateRectRgn(ARect.Left, ARect.Top,
    //                               ARect.Right, ARect.Bottom);
  ACanvas.ClipRect := HostRect;
  {
  ClipRgn := Windows.CreateRectRgn(HostRect.Left, HostRect.Top,
    HostRect.Right, HostRect.Bottom);
  Windows.SelectClipRgn(ACanvas.Handle, ClipRgn);
  }

  //Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
  TxtRect := Rect(TextLeft, TextTop, TextLeft + 1, TextTop + 1);
  ACanvas.TextRect(TxtRect, TxtRect.Left, TxtRect.Top, ATxt, ts);
//  Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);

{
  Windows.SelectClipRgn(ACanvas.Handle, 0);
  Windows.DeleteObject(ClipRgn);
  StrDispose(PTxt);
  ACanvas.Font.Handle := 0;
}
  //ARect := TxtRect;
end;

(*
procedure DrawAngleText(ACanvas: TCanvas; HostRect: TRect;
  var TextBounds: TRect; AAngle: Integer; HAlign: TAlignment;
  VAlign: TJvTFVAlignment; ATxt: string);
var
  LogFont: TLogFont;
  TxtRect: TRect;
  Flags: UINT;
  PTxt: PChar;
  ClipRgn: HRgn;
  TextLeft,
    TextTop: Integer;
begin
  //TxtRect := ARect;
  //CalcTextPos(TxtRect, ACanvas.Font, AAngle, HAlign, VAlign, ATxt);
  CalcTextPos(HostRect, TextLeft, TextTop, TextBounds, ACanvas.Font, AAngle,
    HAlign, VAlign, ATxt);
  Windows.GetObject(ACanvas.Font.Handle, SizeOf(LogFont), @LogFont);
  LogFont.lfEscapement := AAngle;
  LogFont.lfOrientation := LogFont.lfEscapement;
  ACanvas.Font.Handle := CreateFontIndirect(LogFont);
  Flags := DT_NOPREFIX or DT_LEFT or DT_TOP or DT_NOCLIP or DT_SINGLELINE;

  PTxt := StrAlloc((Length(ATxt) + 4) * SizeOf(Char));
  StrPCopy(PTxt, ATxt);
  //ClipRgn := Windows.CreateRectRgn(ARect.Left, ARect.Top,
    //                               ARect.Right, ARect.Bottom);
  ClipRgn := Windows.CreateRectRgn(HostRect.Left, HostRect.Top,
    HostRect.Right, HostRect.Bottom);
  Windows.SelectClipRgn(ACanvas.Handle, ClipRgn);

  //Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
  TxtRect := Rect(TextLeft, TextTop, TextLeft + 1, TextTop + 1);
  Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);

  Windows.SelectClipRgn(ACanvas.Handle, 0);
  Windows.DeleteObject(ClipRgn);
  StrDispose(PTxt);
  ACanvas.Font.Handle := 0;

  //ARect := TxtRect;
end;
*)
function RectWidth(ARect: TRect): Integer;
begin
  Result := ARect.Right - ARect.Left;
end;

function RectHeight(ARect: TRect): Integer;
begin
  Result := ARect.Bottom - ARect.Top;
end;

function EmptyRect: TRect;
begin
  Result := Rect(0, 0, 0, 0);
end;

function IsClassByName(Obj: TObject; ClassName: string): Boolean;
var
  ClassRef: TClass;
begin
  Result := False;
  ClassRef := Obj.ClassType;
  while (ClassRef <> nil) and not Result do
    if ClassRef.ClassName = ClassName then
      Result := True
    else
      ClassRef := ClassRef.ClassParent;
end;


{ Routines copied from JcStrings }

function StringsToStr(const List: TStrings; const Sep: string;
  const AllowEmptyString: Boolean = True): string;
var
  I, L: SizeInt;
begin
  Result := '';
  for I := 0 to List.Count - 1 do
  begin
    if (List[I] <> '') or AllowEmptyString then
    begin
      // don't combine these into one addition, somehow it hurts performance
      Result := Result + List[I];
      Result := Result + Sep;
    end;
  end;
  // remove terminating separator
  if List.Count > 0 then
  begin
    L := Length(Sep);
    Delete(Result, Length(Result) - L + 1, L);
  end;
end;

end.