RnQ/for.RnQ/RQUtil.pas

{
  This file is part of R&Q.
  Under same license
}
(* $IMPORTEDDATA ON *)
unit RQUtil;
{$I ForRnQConfig.inc}

interface

uses
  Windows, Graphics, Classes, // ExtCtrls,
  Controls,
{$IFNDEF NOT_USE_GDIPLUS}
  RnQGraphics,
{$ELSE}
  RnQGraphics32,
{$ENDIF NOT_USE_GDIPLUS}
  RDGlobal,
  RnQDialogs,
  Forms, System.UITypes;

{$I NoRTTI.inc}

// type
// TMsgDlgType = (mtWarning, mtError, mtInformation, mtConfirmation, mtCustom);

function DestRect(const W, H, cw, ch: Integer): TGPRect; overload;
function DestRect(const PicSize, DestSize: TGPSize): TGPRect; overload;
function BoundsSize(srcSize, maxSize: TSize): TSize; overload;
function BoundsSize(srcCX, srcCY, maxCX, maxCY: Longint): TSize; overload;

{ function GradientFill(Handle: HDC;
  pVertex: Pointer;  dwNumVertex: DWORD;
  pMesh: Pointer;  dwNumMesh: DWORD;
  dwMode: DWORD): DWORD; stdcall; External 'msimg32.dll'; }
// procedure GPFillGradient(DC: HDC; ARect: TRect; StartColor, EndColor: Cardinal); overload;
// procedure GPFillGradient(gr : TGPGraphics; ARect: TRect; StartColor, EndColor: Cardinal); overload;

{ function FillGradient(DC: HDC; ARect: TRect; ColorCount: Integer;
  StartColor, EndColor: TColor): Boolean; overload;

  function FillGradient2(DC: HDC; ARect: TRect; ColorCount: Integer;
  StartColor, EndColor: TColor): Boolean; overload;
}

function str2html(const s: string): string;
function strFromHTML(const s: string): string;

function datetocoolstr(d: Tdatetime): string;
function datetimeToStrMinMax(dt: Tdatetime; min: Tdatetime; max: Tdatetime): string;

procedure showForm(frm: Tform); overload;

function absPath(const fn: string): boolean;
function ExtractFileNameOnly(const fn: String): String;

procedure msgDlg(msg: string; NeedTransl: boolean; kind: RDGlobal.TMsgDlgType; const uid: AnsiString = '');
function logTimestamp: string;

procedure drawTxt(hnd: Thandle; x, y: Integer; const s: string);
procedure drawTxtL(hnd: Thandle; x, y: Integer; const s: pchar; L: Integer);
function txtSize(hnd: Thandle; const s: string): TSize;
function txtSizeL(hnd: Thandle; s: pchar; L: Integer): TSize;
function mousePos: Tpoint;
function into(p: Tpoint; r: Trect): boolean;

procedure RestartApp;

procedure LoadTranslit;
procedure UnLoadTranslit;
function Translit(const s: String): String;
function GetShellVersion: Cardinal;
function TxtFromInt(Int: Integer { 3 digits } ): String;

procedure SoundPlay(fn: string); overload;
procedure SoundPlay(fs: TMemoryStream); overload;
procedure SoundStop;
procedure SoundInit;
procedure SoundReset;
procedure SoundUnInit;

function ExistsFlash: boolean;
function ThemeControl(AControl: TControl): boolean;
// function DelayedFailureHook(dliNotify: dliNotification; pdli: PDelayLoadInfo): Pointer; stdcall;

type
  Pmsg = ^Tmsg;

  Tmsg = record
    text: string;
    uid: AnsiString;
    kind: RDGlobal.TMsgDlgType;
    time: Tdatetime;
    // cnt : tcontact;
  end;

var masterMute: boolean = false;
  // msgs :array of Tmsg;

implementation

uses
  sysutils, StrUtils, math, DateUtils,

  // MSACMX,
  // ComObj,
  Themes,
  CommCtrl,
  MMSystem, ActiveX, // ShockwaveFlashObjects_TLB,
{$IFDEF UNICODE}
  AnsiStrings,
{$ENDIF UNICODE}
  RnQBinUtils, RDUtils, RnQGlobal,
  RDFileUtil,
  // RnQFileUtil,
{$IFDEF RNQ}
{$IFDEF RNQ_PLAYER}
  BASSplayer,
{$ELSE RNQ_PLAYER}
  dynamic_bass,
{$ENDIF RNQ_PLAYER}
  RQThemes,
  VirtualTrees, RQlog, RQmsgs,
  RnQlangs,
{$ENDIF RNQ}
{$IFDEF RNQ_PLUGIN}
  RDPlugins,
{$ENDIF RNQ_PLUGIN}
  System.Types;

// var
// Soundhndl : HCHANNEL;

function absPath(const fn: string): boolean;
begin
  result := (length(fn) > 2) and ((fn[2] = ':') or (fn[1] = PathDelim) and (fn[2] = PathDelim))
end;

function ExtractFileNameOnly(const fn: String): String;
var I, K: Integer;
begin
  I := LastDelimiter(PathDelim + DriveDelim, fn);
  K := LastDelimiter('.' + PathDelim + DriveDelim, fn);
  if (K > 0) and (fn[K] = '.') then
    result := Copy(fn, I + 1, K - I - 1)
  else
    result := Copy(fn, I + 1, MaxInt);
end;

function str2html(const s: string): string;
begin
  result := template(s, ['&', '&', '"', '"', '<', '<', '>', '>', CRLF, '', #13,
    '', #10, '']);
end; // str2html

function strFromHTML(const s: string): string;
begin
  result := template(s, ['&', '&', '"', '"', '<', '<', '>', '>', '', CRLF
    // '', #13,
    // '', #10,
    ]);
end; // str2html

procedure msgDlg(msg: string; NeedTransl: boolean; kind: RDGlobal.TMsgDlgType; const uid: AnsiString = '');
const kind2str: array [RDGlobal.TMsgDlgType] of string = ('WARNING', 'ERROR', 'INFO', '', 'INFO', '');
begin
  if NeedTransl then
    msg := getTranslation(msg);

{$IFDEF RNQ}
  loggaEvtS(kind2str[kind] + ': ' + msg, iconNames[kind]);
{$ENDIF RNQ}
  if BringInfoFrgd then
    application.bringToFront;

{$IFDEF RNQ}
  if msgsFrm = NIL then
{$ENDIF RNQ}
    messageDlg(msg, kind, [mbOk], 0, mbOk, MsgShowTime[kind])
    // ShowMessage(msg)
{$IFDEF RNQ}
  else
  begin
    msgsFrm.AddMsg(msg, kind, now, uid);
    if BringInfoFrgd then
      msgsFrm.bringToFront;
  end;
{$ENDIF RNQ}
end; // msgDlg

procedure showForm(frm: Tform);
begin
  if frm = NIL then
    exit;
  {
    if frm = mainFrm then
    begin
    if not formvisible(mainfrm) then mainfrm.toggleVisible;
    exit;
    end; }
  frm.show;
  // ShowWindow(application.handle,SW_HIDE)
end;

procedure drawTxt(hnd: Thandle; x, y: Integer; const s: string);
begin
  textOut(hnd, x, y, pchar(s), length(s))
end;

procedure drawTxtL(hnd: Thandle; x, y: Integer; const s: pchar; L: Integer);
begin
  textOut(hnd, x, y, s, L)
end;

function txtSize(hnd: Thandle; const s: string): TSize;
begin
  GetTextExtentPoint32(hnd, pchar(s), length(s), result)
end;

function txtSizeL(hnd: Thandle; s: pchar; L: Integer): TSize;
begin
  GetTextExtentPoint32(hnd, s, L, result)
end;

function mousePos: Tpoint;
begin
  getCursorPos(result)
end;

function into(p: Tpoint; r: Trect): boolean;
begin
  result := (r.Left <= p.x) and (r.right >= p.x) and (r.top <= p.y) and (r.bottom >= p.y)
end;

procedure UnLoadTranslit;
var I: Integer;
begin
  for I := 0 to TranslitList.Count - 1 do
  begin
    TStrObj(TranslitList.Objects[I]).Free;
    TranslitList.Objects[I] := NIL;
  end;
  FreeAndNil(TranslitList);
end;

procedure LoadTranslit;
var txt: RawByteString; v, K: RawByteString; so: TStrObj;
begin
  TranslitList := TStringList.create;
  TranslitList.Sorted := false;
  txt := loadfileA(myPath + 'translit.txt');
  while txt > '' do
    try
      v := chopline(txt);
      v := trim(chop('#', v));
      if v = '' then
        Continue;
      K := trim(chop('-', v));
      v := trim(v);
      if (K = '') or (v = '') then
        Continue;
      so := TStrObj.create;
      so.str := v;
      TranslitList.AddObject(K, so)
    except
      ;
    end;
  TranslitList.CaseSensitive := True;
  TranslitList.Sorted := True;
  TranslitList.Sort;
end;

function Translit(const s: String): String;
var I, K: Integer;
begin
  if Assigned(TranslitList) and (TranslitList.Count > 0) then
  begin
    for I := 1 to length(s) do
      if s[I] = ' ' then
        result := result + ' '
      else if TranslitList.Find(s[I], K) then
        result := result + TStrObj(TranslitList.Objects[K]).str
      else
        result := result + s[I];
  end
  else
    result := s;
end;

procedure SoundInit;
const
{$IFDEF CPUX64}
  bass_dll_x64_FN = 'bassx64.dll';
{$ELSE ~CPUX64}
{$ENDIF CPUX64}
  bass_dll_FN = 'bass.dll';
var b: boolean;
begin
  audioPresent := false;
{$IFDEF RNQ_PLAYER}
  if not Assigned(RnQbPlayer) then
    RnQbPlayer := TBASSplayer.create(nil);
  audioPresent := RnQbPlayer.PlayerReady;

{$ELSE RNQ_PLAYER}
{$IFDEF CPUX64}
  b := Load_BASSDLL(bass_dll_x64_FN);
  if not b then
{$ENDIF CPUX64}
    b := Load_BASSDLL(bass_dll_FN);
  if b then
  begin
    // Ensure BASS 2.4 was loaded
    if HIWORD(BASS_GetVersion) <> BASSVERSION then
    begin
      Unload_BASSDLL;
      audioPresent := false;
      msgDlg('BASS version 2.4 was not loaded!', True, mtError);
      // halt(1);
    end
    else
      // Initialize audio - default device, 44100hz, stereo, 16 bits
      // if not BASS_Init(1, 44100, 0, 0, nil) then
      // if not BASS_Init(-1, 44100, 0, 0, nil) then

      // if not BASS_Init(-1, 44100, 0, Application.MainFormHandle, nil) then
      if not BASS_Init(-1, 44100, 0, application.MainFormHandle, nil) then
      begin
        audioPresent := false;
        Unload_BASSDLL;
        msgDlg('Error initializing audio!', True, mtError);
      end
      else
        audioPresent := True;
  end
  else
    audioPresent := false;
{$ENDIF RNQ_PLAYER}
end;

procedure SoundPlay(fn: string);
begin
  if masterMute or disablesounds or (not playSounds) then
    exit;
  if length(fn) < 2 then
    exit;
  if fn[2] <> ':' then
    fn := myPath + fn;
  if not audioPresent then
    // waveOutSetVolume (HWAVEOUT hwo, DWORD dwVolume);
    PlaySound(pchar(fn), 0, SND_ASYNC + SND_FILENAME + SND_NODEFAULT + SND_NOWAIT)
    // sound.PlaySound(fn)
  else
  begin
{$IFDEF RNQ_PLAYER}
    RnQbPlayer.PlaySecondSound(fn, Soundvolume * MaxVolume div 100);

{$ELSE RNQ_PLAYER}
    // Play stream, not flushed
    Soundhndl := BASS_StreamCreateFile(false, pchar(fn), 0, 0, BASS_SAMPLE_FLOAT or
      BASS_STREAM_AUTOFREE
{$IFDEF UNICODE} or BASS_UNICODE {$ENDIF UNICODE} );
    // BASS_StreamCreateFile
    // BASS_ChannelSetAttributes( Soundhndl, -1, Soundvolume, -101);
    BASS_ChannelSetAttribute(Soundhndl, BASS_ATTRIB_VOL, Soundvolume / 100);
    // BASS_SetVolume(Soundvolume);
    BASS_ChannelPlay(Soundhndl, false);
{$ENDIF RNQ_PLAYER}
  end;
  // mmsystem.PlaySound(pchar(fn),0,SND_ASYNC+SND_FILENAME+SND_NODEFAULT+SND_NOWAIT)
end; // playSound

procedure SoundStop;
begin
  if disablesounds or (not playSounds) then
    exit;
  if not audioPresent then
    PlaySound(nil, 0, SND_ASYNC + SND_NODEFAULT + SND_NOWAIT)
    // else
    // BASS_ChannelStop(Soundhndl);
end;

function sendMCIcommand(cmd: pchar): string;
var res: array [0 .. 100] of char; trash: Thandle;
begin
  trash := 0; // shut up compiler
  mciSendString(cmd, res, length(res), trash);
  result := res;
end; // sendMCI

procedure SoundPlay(fs: TMemoryStream);
var
  // p : Pointer;
  // a : array of byte;
    sz: Int64;
begin

  if masterMute or disablesounds or (not playSounds) then
    exit;

  sz := fs.Seek(0, soEnd);
  if sz < 2 then
    exit;
  fs.Seek(0, soBeginning);

  if not audioPresent then
  begin
    // SetLength(a, fs.size+1);
    // fs.Position := 0;
    // fs.ReadBuffer(a[0], fs.Size);
    // PlaySound(@a[0], 0, SND_SYNC+SND_MEMORY+SND_NODEFAULT + SND_NOWAIT);
    // SetLength(a, 0);
    PlaySound(fs.Memory, 0, SND_ASYNC + SND_MEMORY + SND_NODEFAULT + SND_NOWAIT);
    /// /////////          VERY BAD!!!!!!!!!!!!!!!!!!!!!!!
    /// Need copy sound and keep it while playing !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    // PlaySound(pAnsiChar(fn), 0, SND_ASYNC+SND_FILENAME+SND_NODEFAULT+SND_NOWAIT)
  end
  else
  begin
{$IFDEF RNQ_PLAYER}
    RnQbPlayer.PlaySecondSound(fn, Soundvolume * MaxVolume div 100);

{$ELSE RNQ_PLAYER}
    { SetLength(a, fs.size+1);
      fs.Position := 0;
      fs.ReadBuffer(a[0], fs.Size);
      // Play stream, not flushed
      Soundhndl := BASS_StreamCreateFile(True, @a[0], 0, fs.Size, BASS_STREAM_AUTOFREE);
    }
    Soundhndl := BASS_StreamCreateFile(True, fs.Memory, 0, sz, BASS_SAMPLE_FLOAT or
      BASS_STREAM_AUTOFREE);
    // BASS_StreamCreateFile
    // BASS_ChannelSetAttributes( Soundhndl, -1, Soundvolume, -101);
    BASS_ChannelSetAttribute(Soundhndl, BASS_ATTRIB_VOL, Soundvolume / 100);
    BASS_ChannelPlay(Soundhndl, false);
    // BASS_ChannelPlay(Soundhndl, True);
    // SetLength(a, 0);
{$ENDIF RNQ_PLAYER}
  end;
  // mmsystem.PlaySound(pchar(fn),0,SND_ASYNC+SND_FILENAME+SND_NODEFAULT+SND_NOWAIT)
end; // playSound

procedure SoundReset;
begin
  if audioPresent then
    try
      Soundvolume := 100;
    except
    end;
end;

procedure SoundUnInit;
begin
{$IFDEF RNQ_PLAYER}
  FreeAndNil(RnQbPlayer);
{$ELSE RNQ_PLAYER}
  // Close BASS
  if audioPresent then
  begin
    if audioPresent and not disablesounds and playSounds then
      while BASS_ChannelIsActive(Soundhndl) = BASS_ACTIVE_PLAYING do
        application.ProcessMessages;

    audioPresent := false;
    disablesounds := True;
    // BASS_ChannelStop(Soundhndl);
    // BASS_Free;
    Unload_BASSDLL;
  end;
{$ENDIF RNQ_PLAYER}
end;

function GetShellVersion: Cardinal;
begin
  if ShellVersion = 0 then
    ShellVersion := GetFileVersion('shell32.dll');
  result := ShellVersion;
end;

function transpColor(cl: TColor; alpha: Byte): TColor;
var dw: Cardinal; cf: Double;
begin
  dw := ColorToRGB(cl);
  cf := alpha / $FF;
  result := round((dw shr 16 and $FF) * cf) shl 16 + round((dw shr 8 and $FF) * cf) shl 8 +
    round((dw and $FF) * cf);
end;

{
  function GPtranspPColor(cl : Cardinal): Cardinal;
  // <20><> <20><> <20> <20><>, <20><> <20><> <20><> <20><> <20><> <20><> <20><>
  var
  // dw : Cardinal;
  cf : Double;
  b  : Byte;
  begin

  //  dw := ColorToRGB(cl);
  cf := (cl and AlphaMask) shr ALPHA_SHIFT / $FF;
  b  := round($FF * (1-cf));
  result := ALPHA_MASK + round((cl shr RED_SHIFT and $FF) * cf +b)shl RED_SHIFT
  + round((cl shr GREEN_SHIFT and $FF) * cf +b) shl GREEN_SHIFT
  + round((cl and $FF) * cf + b);
  end;
}

type
  TMatrix = packed array [0 .. 6, 0 .. 3] of Byte;

var abc: packed array [0 .. 9] of TMatrix = (((0, 1, 1, 0), (1, 0, 0, 1), (1, 0, 0, 1),
    (1, 0, 0, 1), (1, 0, 0, 1), (1, 0, 0, 1), (0, 1, 1, 0)), ((0, 0, 1, 0), (0, 1, 1, 0),
    (1, 0, 1, 0), (0, 0, 1, 0), (0, 0, 1, 0), (0, 0, 1, 0), (1, 1, 1, 1)),
    ((0, 1, 1, 0), (1, 0, 0, 1), (0, 0, 0, 1), (0, 0, 1, 0), (0, 1, 0, 0), (1, 0, 0, 0),
    (1, 1, 1, 1)), ((0, 1, 1, 0), (1, 0, 0, 1), (0, 0, 0, 1), (0, 1, 1, 0), (0, 0, 0, 1),
    (1, 0, 0, 1), (0, 1, 1, 0)), ((1, 0, 0, 1), (1, 0, 0, 1), (1, 0, 0, 1), (1, 1, 1, 1),
    (0, 0, 0, 1), (0, 0, 0, 1), (0, 0, 0, 1)), ((1, 1, 1, 1), (1, 0, 0, 0), (1, 1, 1, 0),
    (0, 0, 0, 1), (0, 0, 0, 1), (1, 0, 0, 1), (0, 1, 1, 0)), ((0, 1, 1, 0), (1, 0, 0, 1),
    (1, 0, 0, 0), (1, 1, 1, 0), (1, 0, 0, 1), (1, 0, 0, 1), (0, 1, 1, 0)),
    ((1, 1, 1, 1), (0, 0, 0, 1), (0, 0, 0, 1), (0, 0, 1, 0), (0, 1, 0, 0), (0, 1, 0, 0),
    (0, 1, 0, 0)), ((0, 1, 1, 0), (1, 0, 0, 1), (1, 0, 0, 1), (0, 1, 1, 0), (1, 0, 0, 1),
    (1, 0, 0, 1), (0, 1, 1, 0)), ((0, 1, 1, 0), (1, 0, 0, 1), (1, 0, 0, 1), (0, 1, 1, 1),
    (0, 0, 0, 1), (1, 0, 0, 1), (0, 1, 1, 0)));

function GetRow(sym, row: Integer): string;
var line: string; I: Integer;
begin
  line := '';
  for I := 0 to 3 do
  begin
    if abc[sym][row, I] = 1 then
      line := line + '#'
    else
      line := line + '_';
  end;
  result := line;
end;

function TxtFromInt(Int: Integer { 3 digits } ): String;
var iArr: array [1 .. 3] of Integer; res, line: String; I, K: Integer;
begin
  // Randomize;
  if (Int < 100) or (Int > 999) then
  begin
    result := 'PLUGIN ERROR: Invalid input parameters' + CRLF;
    exit;
  end;
  iArr[1] := Int div 100;
  iArr[2] := (Int - iArr[1] * 100) div 10;
  iArr[3] := (Int - iArr[1] * 100 - iArr[2] * 10);
  for I := 0 to 6 do
  begin
    line := '';
    for K := 1 to 3 do
    begin
      line := line + '_' + GetRow(iArr[K], I);
    end;
    res := res + CRLF + line;
  end;
  result := res;
end;

function BoundsSize(srcCX, srcCY, maxCX, maxCY: Longint): TSize;
begin
  if (srcCX > maxCX) or (srcCY > maxCY) then
  begin
    if srcCX * maxCY < srcCY * maxCX then
    begin
      result.cx := maxCY * srcCX div srcCY;
      // Result.cx := MulDiv(maxCY, srcCX, srcCY);
      result.cy := maxCY;
    end
    else
    begin
      result.cx := maxCX;
      result.cy := maxCX * srcCY div srcCX;
      // Result.cy := MulDiv(maxCX, srcCY, srcCX);
    end;
  end
  else
  begin
    result.cx := srcCX;
    result.cy := srcCY;
  end;
end;

function BoundsSize(srcSize, maxSize: TSize): TSize;
begin
  if (srcSize.cx > maxSize.cx) or (srcSize.cy > maxSize.cy) then
  begin
    if srcSize.cx * maxSize.cy < srcSize.cy * maxSize.cx then
    begin
      result.cx := maxSize.cy * srcSize.cx div srcSize.cy;
      // Result.cx := MulDiv(maxSize.cy, srcSize.cx, srcSize.cy);
      result.cy := maxSize.cy;
    end
    else
    begin
      result.cx := maxSize.cx;
      result.cy := maxSize.cx * srcSize.cy div srcSize.cx;
    end;
  end
  else
    result := srcSize;
end;

{ function DestRect(W, H, cw, ch :Integer): TRect;
  const
  Stretch = false;
  Proportional = True;
  Center  = True;
  var
  //  w, h, cw, ch: Integer;
  xyaspect: Double;
  begin
  //  w := Picture.GetWidth;
  //  h := Picture.GetHeight;
  //  cw := ClientWidth;
  //  ch := ClientHeight;
  if Stretch or (Proportional and ((w > cw) or (h > ch))) then
  begin
  if Proportional and (w > 0) and (h > 0) then
  begin
  xyaspect := w / h;
  if w > h then
  begin
  w := cw;
  h := Trunc(cw / xyaspect);
  if h > ch then  // woops, too big
  begin
  h := ch;
  w := Trunc(ch * xyaspect);
  end;
  end
  else
  begin
  h := ch;
  w := Trunc(ch * xyaspect);
  if w > cw then  // woops, too big
  begin
  w := cw;
  h := Trunc(cw / xyaspect);
  end;
  end;
  end
  else
  begin
  w := cw;
  h := ch;
  end;
  end;

  with Result do
  begin
  Left := 0;
  Top := 0;
  Right := w;
  Bottom := h;
  end;

  if Center then
  OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
  end; }

function DestRect(const W, H, cw, ch: Integer): TGPRect;
const Stretch = false; Proportional = True; Center = True;
var
  // w, h, cw, ch: Integer;
    xyaspect: Double;
  // i, j : Integer;
begin
  // w := Picture.GetWidth;
  // h := Picture.GetHeight;
  // cw := ClientWidth;
  // ch := ClientHeight;
  with result do
  begin
    // X := 0;
    // Y := 0;
    Width := min(cw, W);
    Height := min(ch, H);
  end;

  if Stretch or (Proportional and ((W > cw) or (H > ch))) then
  begin
    if Proportional and (W > 0) and (H > 0) then
    begin
      xyaspect := W / H;
      if W > H then
      begin
        // w := cw;
        // Result.Width := cw;
        result.Height := Trunc(cw / xyaspect);
        if result.Height > ch then // woops, too big
        begin
          result.Height := ch;
          result.Width := Trunc(ch * xyaspect);
        end;
      end
      else
      begin
        // h := ch;
        result.Width := Trunc(ch * xyaspect);
        if result.Width > cw then // woops, too big
        begin
          result.Width := cw;
          result.Height := Trunc(cw / xyaspect);
        end;
      end;
    end
    { else
      begin
      w := cw;
      h := ch;
      end; }
  end;

  if Center then
  begin
    // OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
    // inc(Result.X, (cw - w) div 2);
    // inc(Result.Y, (ch - h) div 2);
    result.x := (cw - result.Width) div 2;
    result.y := (ch - result.Height) div 2;
  end;
end;

function DestRect(const PicSize, DestSize: TGPSize): TGPRect;
const Stretch = false; Proportional = True; Center = True;
var
  // w, h, cw, ch: Integer;
    xyaspect: Double;
begin
  // w := Picture.GetWidth;
  // h := Picture.GetHeight;
  // cw := ClientWidth;
  // ch := ClientHeight;
  // Result.size := DestSize;
  with result do
  begin
    // X := 0;
    // Y := 0;
    Width := min(DestSize.Width, PicSize.Width);
    Height := min(DestSize.Height, PicSize.Height);
  end;
  if Stretch or (Proportional and ((PicSize.Width > DestSize.Width) or
    (PicSize.Height > DestSize.Height))) then
  begin
    if Proportional and (PicSize.Width > 0) and (PicSize.Height > 0) then
    begin
      xyaspect := PicSize.Width / PicSize.Height;
      if PicSize.Width > PicSize.Height then
      begin
        // Result.Width := DestSize.Width;
        result.Height := Trunc(DestSize.Width / xyaspect);
        if result.Height > DestSize.Height then // woops, too big
        begin
          result.Height := DestSize.Height;
          result.Width := Trunc(DestSize.Height * xyaspect);
        end;
      end
      else
      begin
        // Result.Height := DestSize.Height;
        result.Width := Trunc(DestSize.Height * xyaspect);
        if result.Width > DestSize.Width then // woops, too big
        begin
          result.Width := DestSize.Width;
          result.Height := Trunc(DestSize.Width / xyaspect);
        end;
      end;
    end
    { else
      begin
      Result.Width := DestSize.Width;
      Result.Height := DestSize.Height;
      end; }
  end;
  {
    with Result do
    begin
    X := 0;
    Y := 0;
    Width := w;
    Height := h;
    end;
  }
  if Center then
  begin
    // OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
    // inc(Result.X, (DestSize.Width - Result.Width) div 2);
    // inc(Result.Y, (DestSize.Height - Result.Height) div 2);
    result.x := (DestSize.Width - result.Width) div 2;
    result.y := (DestSize.Height - result.Height) div 2;
  end
  else
  begin
    result.x := 0;
    result.y := 0;
  end
end;

// procedure KillApplication(Restart: boolean);
procedure RestartApp;
var StartInfo: TStartupInfo; ProcInfo: TProcessInformation; StartDir: string;
begin
  // if Restart then
  begin
    GetStartupInfo(StartInfo);
    // StartDir := GetCurrentDir;
    StartDir := myPath;
    FillChar(ProcInfo, SizeOf(TProcessInformation), #0);

    CreateProcess(nil, GetCommandLine, nil, nil, false, CREATE_NEW_PROCESS_GROUP +
      NORMAL_PRIORITY_CLASS, nil, pchar(StartDir), StartInfo, ProcInfo);
  end;
  // TODO: call all the "finalization" sections, with a timeout.
  TerminateProcess(GetCurrentProcess, 1);
end;

function ExistsFlash: boolean;
// var
// rr : HResult; res : Pointer;
begin
  result := True
  // rr := CoGetClassObject(CLASS_ShockwaveFlash, 0, nil, IID_IShockwaveFlash, res);
  // Result := rr = S_OK;
  // if Result then
  // IClassFactory(res)._Release;
end;

function ThemeControl(AControl: TControl): boolean;
begin
  result := false;
  if AControl = nil then
    exit;
  result := (not(csDesigning in AControl.ComponentState) and StyleServices.Enabled) or
    ((csDesigning in AControl.ComponentState) and (AControl.Parent <> nil) and
    (StyleServices.Enabled // and not UnthemedDesigner(AControl.Parent)
    ));
end;

procedure drawCoolText(cnv: Tcanvas; const text: string);
var I, L, n, escpos: Integer; r: Trect; st: Tfontstyles; startX: Integer;

  procedure turnStyle(v: Graphics.TFontStyle);
  begin
    if v in st then
      st := st - [v]
    else
      st := st - [v];
    cnv.font.style := st;
  end;

begin
  I := 1;
  r := cnv.ClipRect;
  L := length(text);
  st := cnv.font.style;
  startX := cnv.penpos.x;
  while I <= L do
  begin
    escpos := I;
    while (escpos <= L) and (text[escpos] <> #27) do
      inc(escpos);
    if escpos > L then
      n := L - I + 1
    else
      n := escpos - I;
    r.Left := cnv.penpos.x;
    r.top := cnv.penpos.y;
    DrawText(cnv.handle, @text[I], n, r, DT_SINGLELINE);
    inc(I, n);
    if escpos <= L then
    begin
      inc(I, 2);
      case text[escpos] of
        'b':
          turnStyle(fsBold);
        'i':
          turnStyle(fsItalic);
        'u':
          turnStyle(fsItalic);
        'r':
          cnv.MoveTo(startX, cnv.penpos.y + cnv.TextHeight('I'));
      end;
    end;
  end;
end; // drawCoolText

function datetimeToStrMinMax(dt: Tdatetime; min: Tdatetime; max: Tdatetime): string; overload;
begin
  if dt = 0 then
    result := ''
  else if (dt < min) or (dt > max) then
    result := getTranslation('Invalid')
  else
    result := formatDatetime(timeformat.info, dt);
end; // datetimeToStrMinMax

function datetocoolstr(d: Tdatetime): string;
begin
  case Trunc(now) - Trunc(d) of
    0:
      result := getTranslation('Today');
    1:
      result := getTranslation('Yesterday');
    2 .. 5:
      result := capitalize(FormatSettings.LongDayNames[dayofweek(d)]);
    else
    begin
      if (Trunc(now) - Trunc(d) > 365) then
        result := intToStr(YearOf(d)) + ' '
      else
        result := '';
      result := result + capitalize(FormatSettings.LongMonthNames[monthOf(d)]) + ' ' +
        intToStr(dayOf(d));
    end;
  end
end; // dateToCoolstr

function logTimestamp: string;
begin
  result := formatDatetime(timeformat.log, now) + '> '
end;

end.