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
  LCLType, LCLIntf, Types,
  Graphics, Controls, Classes, SysUtils;

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, dirUpDown);

  TJvTFVScrollDir = (sdUp, sdDown);

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; out TextLeft, TextTop: Integer;
  out 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;
  out 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;

procedure FixFont(const AFont: TFont);

procedure DrawArrow(ACanvas: TCanvas; ARect: TRect; ADirection: TJvTFDirection);
procedure DrawDblArrow(ACanvas: TCanvas; ARect: TRect; ADirection: TJvTFDirection;
  AColor1, AColor2: TColor);


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; out TextLeft, TextTop: Integer;
  out 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;
  out 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;

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;


{ Fix Lazarus default font size of 0 }

procedure FixFont(const AFont: TFont);
begin
  if AFont.Height = 0 then
    AFont.Size := abs(GetFontData(AFont.Reference.Handle).Height) * 72 div AFont.PixelsPerInch;
end;


{ Draw an arrow }

procedure DoDrawArrow(ACanvas: TCanvas; ARect: TRect; ADirection: TJvTFDirection;
  AColor1, AColor2: TColor);
var
  I, ArrowHeight, ArrowWidth, BaseX, BaseY: Integer;
begin
  ArrowWidth := RectWidth(ARect) - 2;
  if not Odd(ArrowWidth) then
    Dec(ArrowWidth);
  ArrowHeight := (ArrowWidth + 1) div 2;

  ACanvas.Pen.Color := AColor1;
  case ADirection of
    dirUp:
      begin
        BaseX := ARect.Left + RectWidth(ARect) div 2 - ArrowWidth div 2;
        BaseY := ARect.Top + RectHeight(ARect) div 2 + ArrowHeight div 2 - 1;
        for I := ArrowHeight downto 1 do
          with ACanvas do
          begin
            MoveTo(BaseX, BaseY);
            LineTo(BaseX + I * 2 - 1, BaseY);
            Inc(BaseX);
            Dec(BaseY);
          end;
      end;
    dirDown:
      begin
        BaseX := ARect.Left + RectWidth(ARect) div 2 - ArrowWidth div 2;
        BaseY := ARect.Top + RectHeight(ARect) div 2 - ArrowHeight div 2 + 1;
        for I := ArrowHeight downto 1 do
        with ACanvas do
          begin
            MoveTo(BaseX, BaseY);
            LineTo(BaseX + I * 2 - 1, BaseY);
            Inc(BaseX);
            Inc(BaseY);
          end;
      end;
    dirUpDown:
      begin
        // UP arrow
        BaseX := ARect.Left + RectWidth(ARect) div 2 - ArrowWidth div 2;
        BaseY := ARect.Top + RectHeight(ARect) div 2 - 2;
        for I := ArrowHeight downto 1 do
        with ACanvas do
          begin
            MoveTo(BaseX, BaseY);
            LineTo(BaseX + I * 2 - 2, BaseY);
            Inc(BaseX);
            Dec(BaseY);
          end;

        // down arrow
        ACanvas.Pen.Color := AColor2;
        BaseX := ARect.Left + RectWidth(ARect) div 2 - ArrowWidth div 2;
        BaseY := ARect.Top + RectHeight(ARect) div 2 + 2;
        for I := ArrowHeight downto 1 do
        with ACanvas do
          begin
            MoveTo(BaseX, BaseY);
            LineTo(BaseX + I * 2 - 2, BaseY);
            Inc(BaseX);
            Inc(BaseY);
          end;
      end;
    dirLeft:
      begin
        BaseX := ARect.Left + RectWidth(ARect) div 2 + ArrowHeight div 2;
        BaseY := ARect.Top + RectHeight(ARect) div 2 - ArrowWidth div 2;
        for I := ArrowHeight downto 1 do
          with ACanvas do
          begin
            MoveTo(BaseX, BaseY);
            LineTo(BaseX, BaseY + I * 2 - 1);
            Dec(BaseX);
            Inc(BaseY);
          end;
      end;
  else
    BaseX := ARect.Left + RectWidth(ARect) div 2 - ArrowHeight div 2;
    BaseY := ARect.Top + RectHeight(ARect) div 2 - ArrowWidth div 2;
    for I := ArrowHeight downto 1 do
      with ACanvas do
      begin
        MoveTo(BaseX, BaseY);
        LineTo(BaseX, BaseY + I * 2 - 1);
        Inc(BaseX);
        Inc(BaseY);
      end;
  end;
end;

procedure DrawArrow(ACanvas: TCanvas; ARect: TRect; ADirection: TJvTFDirection);
begin
  DoDrawArrow(ACanvas, ARect, ADirection, ACanvas.Pen.Color, clNone);
end;

procedure DrawDblArrow(ACanvas: TCanvas; ARect: TRect;
  ADirection: TJvTFDirection; AColor1, AColor2: TColor);
begin
  DoDrawArrow(ACanvas, ARect, ADirection, AColor1, AColor2);
end;

end.