jvtfutils.pas

East make Tray Icon in delphi

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;

//////////////////////////////////////////////////////////////////
// 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);
  {$IFDEF VCL}
  Windows.GetTextExtentPoint32(DC, PTxt, StrLen(PTxt), Size);
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  GetTextExtentPoint32(DC, PTxt, StrLen(PTxt), Size);
  {$ENDIF VisualCLX}
  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
  {$IFDEF VCL}
  LogFont: TLogFont;
  {$ENDIF VCL}
  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);
  {$IFDEF VCL}
  Windows.GetObject(ACanvas.Font.Handle, SizeOf(LogFont), @LogFont);
  LogFont.lfEscapement := AAngle;
  LogFont.lfOrientation := LogFont.lfEscapement;
  ACanvas.Font.Handle := CreateFontIndirect(LogFont);
  {$ENDIF VCL}
  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);
  {$IFDEF VCL}
  //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;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  ClipRgn := CreateRectRgn(HostRect.Left, HostRect.Top,
    HostRect.Right, HostRect.Bottom);
  SelectClipRgn(ACanvas.Handle, ClipRgn);

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

  SelectClipRgn(ACanvas.Handle, 0);
  DeleteObject(ClipRgn);
  StrDispose(PTxt);
  ACanvas.Font.Handle := nil;
  {$ENDIF VisualCLX}

  //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: ShortString): 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;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.