////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Application level routines and tools.                                      //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20230702 - Created by A.K. from _stdapp                                    //
// 20240320 - GetWidgetSetName,IsWidgetSetName                                //
// 20240614 - MsgNoSupportOnThisPlatform                                      //
// 20240620 - MsgNotImplementedYet                                            //
// 20240625 - Form_ApplyParams_PosSize,Form_ApplyParams_Font                  //
// 20240703 - SafeApplicationProcessMessages                                  //
// 20240826 - StringToCursorDef,GetCursorIdentList                            //
// 20241213 - ExecuteFileDialog                                               //
// 20250227 - GetDaqControlDialogCaption,IsDaqControlDialogCaption            //
// 20250227 - Form_ApplyParams_PosSize updates (*.RightBottom, *.Absolute)    //
////////////////////////////////////////////////////////////////////////////////

unit _crw_apptools; //  Application tools.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, types, lcltype, rtlconsts, lmessages, lclproc,
 forms, controls, stdctrls, comctrls, dialogs, menus, buttons, actnlist,
 process, printers, lclintf, gettext, character, graphics, strutils, clipbrd,
 _crw_alloc, _crw_cmdargs, _crw_environ, _crw_fpu, _crw_ef, _crw_pscap,
 _crw_str, _crw_fio, _crw_rtc, _crw_proc, _crw_riff, _crw_snd,
 _crw_plut, _crw_eldraw, _crw_base64, _crw_hl, _crw_uart,
 _crw_polling, _crw_guard, _crw_pio, _crw_uac, _crw_calib,
 _crw_couple, _crw_sysid, _crw_wmctrl, _crw_assoc, _crw_zmqman,
 _crw_geoid, _crw_lngid, _crw_utf8, _crw_colors, _crw_iana,
 _crw_apputils, _crw_appforms, _crw_sect;

 { Provides access to the widgetset handle for the application instance.  }
function ApplicationHandle:THandle; inline;

 { Return (safe) Application.MainForm. }
function ApplicationMainForm:TForm; inline;

 { Return WindowManager's handle of Application.MainForm. }
function ApplicationMainFormWnd(Update:Boolean=false):HWND;

 { Adjust Form desktop according to MainForm or Application.MainForm. }
function AdjustFormDesktop(Form:TForm; MainForm:TForm=nil):Integer;

 { Check Form is exposed on Screen, i.e. Visible and not Minimized. }
function FormIsExposed(Form:TForm):Boolean;

 { Check Application.MainForm is exposed. }
function ApplicationMainFormIsExposed:Boolean;

 { Activate (Show,BringToFront,SetFocus) the Form. }
function ActivateTheForm(aForm:TForm; Mode:Integer=0):Boolean;

 { Activate (Show,BringToFront,SetFocus) the Application.MainForm. }
function ActivateApplicationMainForm:Boolean;

 { Find (safe) Application.MainForm.ActiveMdiChild and return true if found. }
function FindActiveMdiChild(out aMdiChild:TForm):Boolean;

 { Keyboard shortcut to text like "Ctrl-C". }
function ShortCutToText(ShortCut:TShortCut):LongString;

 { Text shortcut like "Ctrl-C" to keyboard code. }
function TextToShortCut(const ShortCutText:LongString):TShortCut;

 {
 Maximal recursion level for SafeApplicationProcessMessages.
 Uses to avoid recursion loops with Application.ProcessMessages.
 }
const
 MaxApplicationProcessMessagesLevel:SizeInt=10;

 {
 Protected (safe) version of Application.ProcessMessages.
 Handle exceptions, resursion and thread protection.
 }
procedure SafeApplicationProcessMessages;

 {
 Get height of Form window caption.
 Return GetSystemMetrics(SM_CYCAPTION) if (Form=nil).
 }
function  GetWindowCaptionHeight(Form:TForm=nil):Integer;

 {
 Return true if Name looks as file name.
 Assume file names contains at least nmin directory separators,
 and don't contains bad chars like ( & | ^ ; @ % ).
 }
function LooksLikeFileName(const Name:LongString; nmin:Integer=1):Boolean;

 {
 MinimizeFileName function will return a shortened version of FileName,
 so that it fits on the given Canvas, with a given MaxWidth, MaxLen.
 eg. C:\Documents and Settings\User\Application Data\Microsoft\Word\custom.dic
 would become something like: C:\…\Word\custom.dic.
 Notes:
  MaxWidth is max pixel width in Canvas, MaxLen is max char length,
  dots is filler (by default "…") to replace.
 }
function MinimizeFileName(FileName:LongString; Canvas:TCanvas;
                 MaxWidth,MaxLen:Integer; dots:LongString=ThreeDots):LongString;

 {
 Get LCL version string .
 }
function GetLclVersion:LongString;

 {
 Get list of available WidgetSet items, for example:
 gtk,gtk2,gtk3,win32,wince,carbon,qt,qt5,fpgui,nogui,cocoa,customdrawn,mui.
 }
function GetListOfWidgetSets(const Delim:LongString=EOL):LongString;

 {
 Get build platform of LCL WidgetSet - it's one of GetListOfWidgetSets items.
 }
function GetBuildLCLWidgetName:LongString;

 {
 Get name of current WidgetSet - it's one of GetListOfWidgetSets items.
 }
function GetWidgetSetName:LongString;

 {
 Check WidgetSet name is in comma separated list aList,
 for example: IsWidgetSetName('gtk,gtk2,gtk3') then ...
 }
function IsWidgetSetName(const aList:LongString):Boolean;

 {
 Get class name of WidgetSet uses by aControl.
 }
function GetWidgetSetClassName(aControl:TControl):LongString;

 {
 Get monitor on which Form is shown.
 }
function GetFormMonitorNum(Form:TForm):Integer;

 {
 Convert string to cursor or return default.
 }
function StringToCursorDef(const S:LongString; Def:TCursor=crDefault):TCursor;

 {
 Get list of cursor identifiers with EOL delimiters.
 crDefault,crNone,crArrow,crCross,crIBeam,crSizeNESW,crSizeNS,crSizeNWSE,crSizeWE,crUpArrow,crHourGlass,
 crDrag,crNoDrop,crHSplit,crVSplit,crMultiDrag,crSQLWait,crNo,crAppStart,crHelp,crHandPoint,crSizeAll,
 crSizeNW,crSizeN,crSizeNE,crSizeW,crSizeE,crSizeSW,crSizeS,crSizeSE
 }
function GetCursorIdentList:LongString;

 {
 Return the name of Console window.
 Language (lang) - ru: 'КОНСОЛЬ', en: 'CONSOLE'.
 }
function GetLangConsoleCaption(lang:LongString=''):LongString;

 {
 Return the name of SystemConsole window.
 Language (lang) - ru: 'ГЛАВНАЯ КОНСОЛЬ', en: 'MAIN CONSOLE'.
 }
function GetMainConsoleCaption(lang:LongString=''):LongString;

 {
 Return true if aCapttion is name of SystemConsole window.
 }
function IsMainConsoleCaption(aCaption:LongString):Boolean;

 {
 Return the name of DaqControlDialog window.
 Language (lang) - ru: 'DAQ-СИСТЕМА', en: 'DAQ-SYSTEM'.
 }
function GetDaqControlDialogCaption(lang:LongString=''):LongString;

{
Return true if aCapttion is name of DaqControlDialog window.
}
function IsDaqControlDialogCaption(aCaption:LongString):Boolean;

 {
 Return favorite, application default Pascal project type.
 It's file extension for Pascal projects, default is .lpr.
 }
function FavoritePascalProjectType(SetType:LongString=''):LongString;

 {
 Shrink command (cmd) relative HomeDir using Mode=0/1.
 Case Mode=1 replace HomeDir to $CRW_DAQ_SYS_HOME_DIR.
 Case Mode=0 just delete AddPathDelim(HomeDir) from command.
 Note: to avoid buffer overflow in ExpressionEvaluator command parser
 for long commands (over 230 chars) try to replace HomeDir substring
 to $CRW_DAQ_SYS_HOME_DIR or %CRW_DAQ_SYS_HOME_DIR% reference.
 }
function ShrinkCommandRelativeHomeDir(const cmd:LongString;
                                      Mode:Integer=0;
                                      HomeDir:LongString='';
                                      EnvVarDir:LongString='';
                                      Threshold:Integer=230):LongString;

{$IFNDEF WINDOWS}
 //////////////////////////////////
 // Windows compatibility constants
 //////////////////////////////////
const
 MB_TOPMOST            = $00040000;

const
 HKEY_CLASSES_ROOT     = HKEY($80000000);
 HKEY_CURRENT_USER     = HKEY($80000001);
 HKEY_LOCAL_MACHINE    = HKEY($80000002);
 HKEY_USERS            = HKEY($80000003);
 HKEY_PERFORMANCE_DATA = HKEY($80000004);
 HKEY_CURRENT_CONFIG   = HKEY($80000005);
 HKEY_DYN_DATA         = HKEY($80000006);
{$ENDIF ~WINDOWS}

const
 SM_CMETRICS            = 83;              // D5 MultiMon.pas

function  GetMainFormTitle:LongString;
function  MessageDlgApplyParamsPos(const Params:LongString):TPoint;

 {
 ****************
 Standard dialogs
 ****************
 }
function  MsgDlgCaption(DlgType:TMsgDlgType; Mode:Integer):LongString;
function  MessageDlg(const Msg:LongString; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint; Params:LongString=''): Integer;
function  Warning(const Msg:LongString; Params:LongString=''):Integer;
function  Information(const Msg:LongString; Params:LongString=''):Integer;
function  YesNo(const Msg:LongString; Params:LongString=''):Integer;
function  YesNoCancel(const Msg:LongString; Params:LongString=''):Integer;
function  Error(const Msg:LongString; Params:LongString=''):Integer;
function  Trouble(Check:boolean; const Msg:LongString; Params:LongString=''):Boolean;
function  NoProblem(Check:boolean; const Msg:LongString; Params:LongString=''):Boolean;
function  mrVoice(Code:TModalResult):TModalResult;
function  mrCaption(Code:TModalResult):LongString;
function  StandardExitConfirmation:Boolean;
procedure UpdateStatusLine(const aMessage:LongString);
procedure ShouldBeDone;

const
 UseSystemMessageBox : Boolean = true; // Use system MessageBox for MessageDlg
 UseEditSettings     : Boolean = true; // Use edit('@set ...'), i.e. Params

const
 OnUpdateStatusLine: procedure(const aMessage:LongString) = nil;
 mrError = mrYesToAll + 1;

function MenuRightSpace:String;

const MenuRightSpaceWidth : Integer = 1;

const                        // Form_ApplyParams_xxx flags:
 apf_FormLeft   = $00000001; // Applied Form.Left
 apf_FormTop    = $00000002; // Applied Form.Top
 apf_FormWidth  = $00000004; // Applied Form.Width
 apf_FormHeight = $00000008; // Applied Form.Height
 apf_Fonts1st   = $00000010; // Applied Fonts - first
 apf_Fonts2nd   = $00000020; // Applied Fonta - second
 apf_FormPos    = apf_FormLeft+apf_FormTop;
 apf_FormSize   = apf_FormWidth+apf_FormHeight;
 apf_FontsAll   = apf_Fonts1st+apf_Fonts2nd;

 {
 Parse and apply parameters like:
 @set Form.Left    400  relative "WindowTitle" ComponentName
 @set Form.Top     400  relative "WindowTitle" ComponentName
 @set Form.Top     400  relative "WindowTitle" ComponentName.RightBottom
 @set Form.Top     400  relative "WindowTitle" ComponentName.CenterMiddle
 @set Form.Width   400                         (absolute pixel width)
 @set Form.Height  300                         (absolute pixel height)
 @set Form.Width   -50 relative "WindowTitle"  ComponentName.Absolute
 @set Form.Width   80  relative Screen         (80% of Screen width)
 @set Form.Height  50  relative Desktop        (50% of Desktop height)
 @set Form.Width   70  relative WorkArea       (70% of WorkArea width)
 Note:
  ComponentName expected to be simple name (lex_name)
  ComponentName.Right    uses to set origin point.x for Form.Left
  ComponentName.Bottom   uses to set origin point.y for Form.Top
  ComponentName.Center   uses to set origin point.x for Form.Left
  ComponentName.Middle   uses to set origin point.y for Form.Top
  ComponentName.Absolute uses to set absolute size (delta) for Form.Width/Height
              by default uses percent (relative) size for Form.Width/Height
 }
function Form_ApplyParams_PosSize(Form:TForm; const Params:LongString):Integer;

 {
 Parse and apply parameters like:
 @set Panel.Font   Name:PT_Mono\Size:10\Color:Black\Style:[Regular]
 @set Editor.Font  Name:PT_Mono\Size:10\Color:Black\Style:[Regular]
 Example:
 Result:=Form_ApplyParams_Font(Panel.Font,Params,'Panel.Font',apf_Fonts1st)
      or Form_ApplyParams_Font(Editor.Font,Params,'Editor.Font',apf_Fonts2nd)
 }
function Form_ApplyParams_Font(Font:TFont; const Params,Key:LongString; Flag:Integer):Integer;

 {
 Return Params:
  @set Form.Width  x relative Screen
  @set Form.Height y relative Screen
 with (x,y) from Control.
 }
function ControlPosParams(Control:TControl; Anchors:LongString='LT';
                          dX:Integer=0; dY:Integer=0):LongString;

 {
 ************************
 General purpose utilites
 ************************
 }
type
 TForEachMdiChildAction = procedure(Form      : TForm;
                                    Index     : Integer;
                                var Terminate : Boolean;
                                    Custom    : Pointer);
procedure ForEachMdiChild(Action:TForEachMdiChildAction; Custom:Pointer; Backward:Boolean=false);

type
 TForEachComponentAction = procedure(Component : TComponent;
                                     Index     : Integer;
                                 var Terminate : Boolean;
                                     Custom    : Pointer);
procedure ForEachComponent(Component:TComponent; Action:TForEachComponentAction; Custom:Pointer; Backward:Boolean=false);

type
 TForEachFormAction = procedure(Form      : TForm;
                                Index     : Integer;
                            var Terminate : Boolean;
                                Custom    : Pointer);
procedure ForEachForm(Action:TForEachFormAction; Custom:Pointer; Backward:Boolean=false);
procedure ForEachFormInZOrder(Action:TForEachFormAction; Custom:Pointer);

function  FormExists(Form:TForm):Boolean;

function  FindRelativePos(const Pos:TPoint; Window:TForm; Control:TControl; const Ext:LongString):TPoint; overload;
function  FindRelativePos(const Pos:TPoint; const WindowTitle,ControlName:LongString):TPoint; overload;
function  FindRelativeSize(const P:TPoint; Window:TForm; Control:TControl; base:Integer=100):TPoint; overload;
function  FindRelativeSize(const P:TPoint; const WindowTitle,ControlName:LongString):TPoint; overload;
function  GetFormBounds(Form:TForm):TRect;
function  GetScreenDesktopBounds:TRect;
function  GetValidFormPosition(Form:TForm; const PadX,PadY:Integer):TPoint;
procedure ValidateFormPosition(Form:TForm; const PadX:Integer=30; const PadY:Integer=30);
function  SelectMDIChildDialog(const Caption,Title:LongString):TForm;
function  ActivateMDIChild(aForm:TForm):Boolean;
procedure UpdateAllMdiForms;
procedure SetEnabledActions(Enabled:Boolean; const Actions:array of TAction);
procedure SetVisibleControls(Visible:Boolean; const Controls:array of TControl);
procedure SetEnabledControls(Enabled:Boolean; const Controls:array of TControl);
procedure ShowControls(const Controls:array of TControl);
procedure HideControls(const Controls:array of TControl);
procedure UpdateMenu(aMenu:TMenuItem; const aCaption,aHint:LongString; aShortCut:TShortCut);
procedure UpdateActionCap(aAction:TAction; const aCaption,aHint:LongString; aShortCut:TShortCut);
procedure SetAllButtonsCursor(Form:TForm; Cursor:TCursor);
procedure RecordComboBoxHistory(aComboBox:TComboBox; HistoryLength:Integer);
procedure OpenDialogTypeChangeStdExecute(OpenDialog:TOpenDialog);
procedure OpenDialogSelectType(OpenDialog:TOpenDialog; const FileName:LongString; SetInitialDir:Boolean=True);
function  ExecuteFileDialog(const Dialog:TFileDialog; const Params:LongString=''):Boolean;
procedure LocateFormToCenterOfScreen(Form:TForm);
procedure LocateFormToCenterOfMouse(Form:TForm);
function  StdDateTimeStr(ms:Double=0; mode:Integer=0):LongString;
function  StdDateTimePrompt(ms:Double=0; Prompt:PChar=nil; mode:Integer=0):LongString;
function  HasPrinters:Boolean;
function  HasPrintersDialog(Mode:Integer=0; const Params:LongString=''):Boolean;
function  GetPrinterPageCaptionAsText:LongString;
function  GetPrinterPageSettingsAsText:LongString;
function  ExecutePrinterPageSettingsDialog(const Params:LongString):TModalResult;
function  ReportPrinterSettings(Mode:Integer):LongString;
function  SetEnvironPrinter(Mode:Integer; aPrinter:LongString=''):Boolean;
function  SetEnvironLpPageIndents:Boolean;
function  ExternalTextFilePrint(const FileName:LongString):Boolean;
function  ExternalTextLinesPrint(const aTextLines:LongString):Boolean;
function  GetImageOfControl(aControl:TControl):TBitmap;
function  SubSystemTurnOn(const SubSystemSectionName:LongString):Boolean;
function  SubSystemIniFile(const SubSystemSectionName:LongString):LongString;
function  SubSystemDataPath(const SubSystemSectionName:LongString):LongString;
function  GetBackUpName(const FileName,NewExtension:LongString):LongString;
function  IsControlContainsClientPos(Control:TControl; const ClientPos:TPoint):Boolean;
function  IsControlContainsScreenPos(Control:TControl; const ScreenPos:TPoint):Boolean;
function  IsMainThread:Boolean;
function  IsModalFormActive:Boolean;
function  NumberOfModalFormsNow:Cardinal;
function  GetFormModalResult(Form:TForm):TModalResult;
function  CanShowModal(aForm:TForm=nil; aLimit:Cardinal=High(Cardinal)):Boolean;
function  IsAdministrator(aError:PParsingBuffer=nil):Boolean;
function  GetRootKeyByName(const Name:LongString):HKey;
function  GetDieselPascalExe:LongString;
function  HasDieselPascalExe:Boolean;
procedure EchoBriefSystemInfo;
procedure EchoBriefSystemInfoEx(verbose:Boolean);
function  GetSystemParamStr(const Category,ParamName:LongString):LongString;
function  GetWordUnderCursor(const aText:LongString; aCursor:Integer; const SpecChars:LongString=''):LongString; overload;
function  GetWordUnderCursor(const aText:WideString; aCursor:Integer; const SpecChars:WideString=''):WideString; overload;
function  GuardOpenDialog(OpenDialog:TOpenDialog):TOpenDialog;
function  CheckEditPasswordChar(Edit:TEdit; aPasswordChar:Char):Char;
{$IFDEF WINDOWS}
function  IsWindowTopMost(Handle:HWND):Boolean; overload;
function  IsWindowTopMost(Form:TForm):Boolean; overload;
procedure MakeWindowTopMost(Handle:HWND); overload;
{$ENDIF ~WINDOWS}
procedure MakeWindowTopMost(Form:TForm; aSysWide:Boolean=false); overload;
function  GetAppFormBounds:TRect;
function  GetAppFormBoundsStr(delim:Char=' '):LongString;
function  GetAppClientBounds:TRect;
function  GetAppClientBoundsStr(delim:Char=' '):LongString;

const     TheUnixExe     : LongString = '';
const     TheFpQuiTipExe : LongString = '';
const     PreferTooltip  : Boolean    = false;
function  ShowTooltip(const arg:LongString):Integer;
procedure InitTooltip;
procedure FreeTooltip;

 // Get color depth (bitness) of the Screen.
function GetScreenColorDepth:Integer;

 // Convert centimeters to inchs (1 in = 2.54 cm).
function CentimeterToInch(aCm:Double):Double;

 // Convert inchs to centimeters (1 in = 2.54 cm).
function InchToCentimeter(aIn:Double):Double;

var // Uses to print a Forms
 PrinterPageSettings : packed record
  Indent : TRect2D;
  Scale  : Double;
  Adjust : Integer;
 end = (
  Indent : ( a:(x:1; y:1); b:(x:1; y:1) );
  Scale  : 1;
  Adjust : 1;
 );

{$IFDEF WINDOWS}
const                             // Get/SetProcessShutdownParameters
 SHUTDOWN_NORETRY    = 1;         // The system terminates the process without displaying a retry dialog box for the user. 

const                             // GetSystemMetrics
 SM_SHUTTINGDOWN     = $2000;     // System is shutting down.

const                             // WM_QUERYENDSESSION, WM_ENDSESSION:
 ENDSESSION_CLOSEAPP = $00000001; // Application must shut down.
 ENDSESSION_CRITICAL = $40000000; // The application is forced to shut down.
 ENDSESSION_LOGOFF   = $80000000; // The user is logging off.
 
function IsSystemShuttingDown:Boolean;
function SetProcessShutdownParameters(dwLevel,dwFlags:DWORD):BOOL; stdcall;
function GetProcessShutdownParameters(lpdwLevel,lpdwFlags:LPDWORD):BOOL; stdcall;
{$ENDIF ~WINDOWS}

const
 ThePasswordChar = '*';

const
 DefaultCanShowModalLimit : Cardinal = 0;

{$IFDEF WINDOWS}
type
 EHelpError = class(ESoftException);

function  OpenWinHelpTopic(const Path:LongString; const Topic:LongString=''):Boolean;
function  OpenWinHelpTopicByLink(const HomeDir,IniFile,Section,Link:LongString; const Topic:LongString=''):Boolean;
{$ENDIF ~WINDOWS}

function  IsClipboardHasFormat(cf:TClipboardFormat):Boolean;

function MsgNotImplementedYet(const What:LongString):LongString;
function MsgNoSupportOnThisPlatform(const What:LongString):LongString;

 {
 *******************************************************************************
 RIFF file utilities
 *******************************************************************************
 }

 {
 Utility dialog to select ITEM object from RIFF CRWF file.
 }
function SelectRiffItemDialog(const FileName:LongString):TRiffChunk;

 {
 *******************************************************************************
 MUI support functions
 *******************************************************************************
 }
function GetACP:LANGID;
function GetOEMCP:LANGID;
function GetSystemDefaultUILanguage:LANGID;
function GetUserDefaultUILanguage:LANGID;
function GetSystemDefaultLangID:LANGID;
function GetUserDefaultLangID:LANGID;
function GetThreadUILanguage:LANGID;
function GetSystemDefaultLCID:LCID;
function GetUserDefaultLCID:LCID;
function GetThreadLocale:LCID;
{$IFDEF WINDOWS}
function GetSystemDefaultLocaleName(lpLocaleName:PWideChar; cchLocaleName:Integer):Integer stdcall;
{$ENDIF ~WINDOWS}
function GetSystemDefaultLocaleNameStr:LongString;

const // List of language options, like "program --lang ru"
 ListLanguageOptionNames:LongString='-l;-lng;-lang;-language;--lng;--lang;--language';

 { Get default language (lng_English/Russian) by CodePage or $LANG. }
function GetDefLanguage:Integer;

 { Get language from options. }
function GetOptLanguage(def:Integer; LangOpts:LongString=''):Integer;

 {
 *******************************************************************************
 Initialize standard subsystems, standard timer actions
 *******************************************************************************
 }
const
  SayTimeInterval : LongInt = 15;
  CpuFrequencyMHz : Double  = 0;

procedure Init_CpuFrequencyMHz;
procedure Init_Sound_SubSystem;
procedure Done_Sound_SubSystem;
procedure Init_Calculator_SubSystem;
procedure Done_Calculator_SubSystem;
procedure Init_Thermocouple_SubSystem;
procedure Done_Thermocouple_SubSystem;
procedure Init_IOPM_SubSystem;
procedure Done_IOPM_SubSystem;
procedure Timer_CheckConfigCache;
procedure Timer_SayTime;
procedure SayTimeHhMm(const t:TSystemTime; const Prefix:LongString='теквремя');

implementation

uses
 LCLVersion,
 InterfaceBase,
 LCLPlatformDef,
 Form_Calculator,
 Form_ListBoxSelection,
 Form_StringGridEditDialog;

{$PUSH}
{$WARN 5044 off : Symbol "$1" is not portable}
function ApplicationHandle:THandle;
begin
 if Assigned(Application)
 then Result:=Application.Handle
 else Result:=0;
end;
{$POP}

function ApplicationMainForm:TForm;
begin
 if Assigned(Application)
 then Result:=Application.MainForm
 else Result:=nil;
end;

function ApplicationMainFormWnd(Update:Boolean=false):HWND;
var Form:TForm; const wnd:HWND=0;
begin
 Result:=0;
 Form:=ApplicationMainForm;
 // Modern version:
 if (Form is TMasterForm) then begin
  if Update then TMasterForm(Form).WmReset;
  Result:=TMasterForm(Form).WmWnd;
  Exit;
 end;
 // Obsolete version:
 if not Assigned(Form) then Exit(0);
 if IsWindows then Exit(Form.Handle);
 if IsUnix then begin
  if Update then wnd:=0;
  if (wnd=0) then wnd:=wmctrl.FindWindow(GetCurrentProcessId,'',Form.Caption);
  Result:=wnd;
 end;
end;

function AdjustFormDesktop(Form:TForm; MainForm:TForm=nil):Integer;
var mw,win:HWND; md:Integer;
begin
 Result:=IfThen(IsWindows,0,-1);
 if IsUnix and (wmctrl.DesktopCount>1) then begin
  // Modern version:
  if not Assigned(MainForm) then MainForm:=ApplicationMainForm;
  if (MainForm is TMasterForm) then begin
   mw:=TMasterForm(MainForm).WmWnd;
   md:=TMasterForm(MainForm).WmDesktop;
   if not Assigned(Form) then Exit(md);
   if (Form is TMasterForm) then begin
    win:=TMasterForm(Form).WmWnd;
    TMasterForm(Form).WmDesktop:=md;
    Result:=TMasterForm(Form).WmDesktop;
    Exit;
   end;
  end;
  // Obsolete version:
  if Assigned(MainForm)
  then mw:=wmctrl.FindWindow(GetCurrentProcessId,'',MainForm.Caption)
  else mw:=ApplicationMainFormWnd;
  if wmctrl.IsWindow(mw) then md:=wmctrl.WindowDesktop(mw) else md:=-1;
  if not Assigned(Form) then Exit(md);
  win:=wmctrl.FindWindow(GetCurrentProcessId,'',Form.Caption);
  if wmctrl.IsWindow(win) then begin
   if (md>=0) then
   if wmctrl.SetWindowDesktop(win,md)
   then Result:=wmctrl.WindowDesktop(win);
  end;
 end;
end;

function FormIsExposed(Form:TForm):Boolean;
begin
 if Assigned(Form)
 then Result:=Form.Visible and (Form.WindowState<>wsMinimized)
 else Result:=false;
end;

function ApplicationMainFormIsExposed:Boolean;
begin
 Result:=FormIsExposed(ApplicationMainForm);
end;

function ActivateTheForm(aForm:TForm; Mode:Integer=0):Boolean;
begin
 Result:=false;
 try
  if Assigned(aForm) then begin
   if not aForm.Visible then aForm.Show;
   if not aForm.Enabled then aForm.Enabled:=true;
   if (aForm.WindowState<>wsNormal) then aForm.WindowState:=wsNormal;
   aForm.BringToFront;
   if not aForm.Focused then
   if aForm.CanSetFocus then begin
    aForm.SetFocus;
    Result:=true;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'ActivateForm');
 end;
end;

function ActivateApplicationMainForm:Boolean;
begin
 Result:=ActivateTheForm(ApplicationMainForm);
end;

function FindActiveMdiChild(out aMdiChild:TForm):Boolean;
var MainForm:TForm; Child:TCustomForm;
begin
 if Assigned(Application) then MainForm:=Application.MainForm else MainForm:=nil;
 if Assigned(MainForm) then Child:=MainForm.ActiveMDIChild else Child:=nil;
 if (Child is TForm) then aMdiChild:=TForm(Child) else aMdiChild:=nil;
 Result:=Assigned(aMdiChild);
end;

{$PUSH}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
function ShortCutToText(ShortCut:TShortCut):LongString;
begin
 Result:=lclproc.ShortCutToText(ShortCut);
end;
function TextToShortCut(const ShortCutText:LongString):TShortCut;
begin
 Result:=lclproc.TextToShortCut(ShortCutText);
end;
{$POP}

procedure SafeApplicationProcessMessages;
const ExeLevel:SizeInt=0;
var MaxLevel:SizeInt;
begin
 if IsMainThread then
 try
  Inc(ExeLevel);
  try
   MaxLevel:=MaxApplicationProcessMessagesLevel;
   if (ExeLevel<=MaxLevel) or (MaxLevel<=0) then begin
    if Assigned(Application)
    then Application.ProcessMessages;
   end;
  finally
   Dec(ExeLevel);
  end;
 except
  on E:Exception do BugReport(E,nil,'SafeApplicationProcessMessages');
 end;
end;

function GetWindowCaptionHeight(Form:TForm=nil):Integer;
begin
 if Assigned(Form)
 then Result:=Form.Height-Form.ClientHeight
 else Result:=GetSystemMetrics(SM_CYCAPTION);
end;

function LooksLikeFileName(const Name:LongString; nmin:Integer=1):Boolean;
const BadChars=[#0..#31,'&','|',';',',','^','%','#','@',QuoteMark,Apostrophe]+[PathSep];
var s:LongString;
begin
 Result:=false;
 if HasChars(Name,BadChars) then Exit;
 s:=AdaptFileName(Name); if IsEmptyStr(s) then Exit;
 if (CountChars(s,[PathDelim])>=nmin) then Exit(true);
end;

function MinimizeFileName(FileName:LongString; Canvas:TCanvas;
                 MaxWidth,MaxLen:Integer; dots:LongString=ThreeDots):LongString;
var Drive,Dir,Fn,ComposedName:LongString;
 procedure RemoveFirstDir(var Dir:LongString);
 var p:Integer;
 begin
  p:=Pos(PathDelim,Dir);
  if (p>0) then Dir:=Copy(Dir,p+1,Length(Dir)-p);
 end;
 function NameIsMatch(const S:LongString):Boolean;
 var Len,Wid:Integer;
 begin
  if utf8_valid(S) then Len:=utf8_length(S) else Len:=Length(S);
  if Assigned(Canvas) then Wid:=Canvas.TextWidth(S) else Wid:=0;
  Result:=(Len<=MaxLen) and (Wid<=MaxWidth);
 end;
begin
 Result:=FileName;
 if (dots='') then dots:=ThreeDots;
 if NameIsMatch(FileName) then Exit;           // No need to do anyhing
 if not LooksLikeFileName(FileName) then Exit; // Not looks as file name
 Drive:=SysUtils.ExtractFileDrive(FileName);
 Dir:=SysUtils.ExtractFilePath(FileName);
 Fn:=SysUtils.ExtractFileName(FileName);
 //Remove Drive from Dir
 if (Length(Drive)>0) then System.Delete(Dir,1,Length(Drive));
 //Transfer all PathDelimiters at the start of Dir to Drive
 while (Length(Dir)>0) and (Dir[1] in ['/','\']) do begin
  Drive:=Drive+Dir[1];
  System.Delete(Dir,1,1);
 end;
 // if Dir is empty then we cannot shorten it, and we know at this point
 // that Drive+FileName is too long, so we return only filename
 if (Length(Dir)=0) then begin
  Result:=Fn;
  Exit;
 end;
 // at this point we know that Dir ends with PathDelim (otherwise we exited
 // before), so RemoveFirstDir will return truncated Dir or empty string
 repeat
  RemoveFirstDir(Dir);
  ComposedName:=Drive+dots+PathDelim+Dir+Fn;
 until (Pos(PathDelim,Dir)=0) or NameIsMatch(ComposedName);
 if NameIsMatch(ComposedName) then Result:=ComposedName else Result:=Fn;
end;

function GetLclVersion:LongString;
begin
 Result:=LCLVersion.lcl_version;
end;

function GetListOfWidgetSets(const Delim:LongString=EOL):LongString;
var p:TLCLPlatform;
begin
 Result:='';
 for p:=Low(p) to High(p) do Result:=Result+LCLPlatformDirNames[p]+EOL;
 if (Delim<>EOL) then Result:=StringReplace(Trim(Result),EOL,Delim,[rfReplaceAll]);
end;

function GetBuildLCLWidgetName:LongString;
begin
 Result:=LCLPlatformDirNames[GetBuildLCLWidgetType];
end;

function GetWidgetSetName:LongString;
begin
 if Assigned(WidgetSet)
 then Result:=LCLPlatformDirNames[WidgetSet.LCLPlatform]
 else Result:='ERROR';
end;

function IsWidgetSetName(const aList:LongString):Boolean;
begin
 if (aList<>'') and Assigned(WidgetSet)
 then Result:=(WordIndex(GetWidgetSetName,aList,ScanSpaces)>0)
 else Result:=false;
end;

function GetWidgetSetClassName(aControl:TControl):LongString;
begin
 Result:='';
 if Assigned(aControl) then
 if Assigned(aControl.WidgetSetClass) then
 Result:=aControl.WidgetSetClass.ClassName;
end;

function GetFormMonitorNum(Form:TForm):Integer;
begin
 Result:=-1;
 if Assigned(Form) then
 if Assigned(Form.Monitor) then
 Result:=Form.Monitor.MonitorNum;
end;

function StringToCursorDef(const S:LongString; Def:TCursor=crDefault):TCursor;
var cr:LongInt;
begin
 cr:=Def;
 if (S='') then Result:=Def else
 if IdentToCursor(S,cr) then Result:=cr else
 if TryStrToInt(S,cr) then Result:=cr else Result:=Def;
end;

function GetCursorIdentList:LongString;
var cr:TCursor; id:String;
begin
 Result:=''; id:='';
 for cr:=crHigh downto crLow do
 if CursorToIdent(cr,id) then if (id<>'') then Result:=Result+id+EOL;
end;

function GetLangConsoleCaption(lang:LongString=''):LongString;
begin
 Result:='CONSOLE'; // Default value
 if (lang='') then lang:=RusEng('ru','en');
 if SameText(lang,'ru') then Result:='КОНСОЛЬ';
end;

function GetMainConsoleCaption(lang:LongString=''):LongString;
begin
 Result:='MAIN CONSOLE'; // Default value
 if (lang='') then lang:=RusEng('ru','en');
 if SameText(lang,'ru') then Result:='ГЛАВНАЯ КОНСОЛЬ';
end;

function IsMainConsoleCaption(aCaption:LongString):Boolean;
begin
 Result:=false;
 aCaption:=Trim(aCaption); if (aCaption='') then Exit;
 if IsSameText(aCaption,GetMainConsoleCaption('ru')) then Exit(true);
 if IsSameText(aCaption,GetMainConsoleCaption('en')) then Exit(true);
end;

function GetDaqControlDialogCaption(lang:LongString=''):LongString;
begin
 Result:='DAQ-SYSTEM'; // Default value
 if (lang='') then lang:=RusEng('ru','en');
 if SameText(lang,'ru') then Result:='DAQ-СИСТЕМА';
end;

function IsDaqControlDialogCaption(aCaption:LongString):Boolean;
begin
 Result:=false;
 aCaption:=Trim(aCaption); if (aCaption='') then Exit;
 if IsSameText(aCaption,GetDaqControlDialogCaption('ru')) then Exit(true);
 if IsSameText(aCaption,GetDaqControlDialogCaption('en')) then Exit(true);
end;

function FavoritePascalProjectType(SetType:LongString=''):LongString;
const TheType:LongString='';
begin
 if (SetType<>'') and (Pos('.',SetType)=1) then
 if IsLexeme(Copy(SetType,2,Length(SetType)-1),lex_Name)
 then TheType:=TrimDef(ExtractFileExt(Trim(SetType)),TheType);
 if (TheType='') then TheType:='.lpr';
 Result:=TheType;
end;

function ShrinkCommandRelativeHomeDir(const cmd:LongString;
                                      Mode:Integer=0;
                                      HomeDir:LongString='';
                                      EnvVarDir:LongString='';
                                      Threshold:Integer=230):LongString;
const rfFlags=[rfReplaceAll,rfIgnoreCase];
var RefDir,PatStr:LongString;
begin
 Result:=Trim(cmd);
 if (Result='') then Exit;
 if (Length(cmd)<Threshold) then Exit;
 if (HomeDir='') then HomeDir:=_crw_fio.HomeDir;
 if HasFlags(Mode,1) and (EnvVarDir='') then EnvVarDir:='CRW_DAQ_SYS_HOME_DIR';
 if IsEmptyStr(EnvVarDir) or not HasFlags(Mode,1) then begin
  PatStr:=AddPathDelim(HomeDir);
  if (PosI(PatStr,cmd)>0) then begin
   Result:=StringReplace(' '+cmd,' '+PatStr,' ',rfFlags);
   Delete(Result,1,1);
   if HasChars(Result,[Apostrophe,QuoteMark]) then begin
    Result:=StringReplace(cmd,Apostrophe+PatStr,Apostrophe,rfFlags);
    Result:=StringReplace(cmd,QuoteMark+PatStr,QuoteMark,rfFlags);
   end;
  end;
 end else begin
  RefDir:=IfThen(IsWindows,'%'+EnvVarDir+'%','$'+EnvVarDir);
  if (Length(HomeDir)>Length(RefDir)) then
  if (PosI(HomeDir,cmd)>0) then Result:=StringReplace(cmd,HomeDir,RefDir,rfFlags);
 end;
end;

 // @set Form.Left 400  relative WindowName ComponentName
 // @set Form.Top  400  relative WindowName ComponentName
function MessageDlgApplyParamsPos(const Params:LongString):TPoint;
var pars:TText; i,l,t:Integer; line:LongString;
begin
 Result:=Point(Low(Integer),Low(Integer));
 if (SysUtils.Trim(Params)<>'') then
 try
  pars:=NewText;
  try
   pars.Text:=SysUtils.Trim(Params);
   for i:=0 to pars.Count-1 do begin
    line:=Trim(pars[i]);
    if (StrFetch(line,1)='@') then begin
     if SameText(ExtractWord(1,line,ScanSpaces),'@set') then begin
      if SameText(ExtractWord(2,line,ScanSpaces),'Form.Left') then begin
       if Str2Int(ExtractWord(3,line,ScanSpaces),l) then begin
        if SameText(ExtractWord(4,line,ScanSpaces),'relative')
        then Result.x:=FindRelativePos(Point(l,0),ExtractWord(5,line,ScanSpaces),ExtractWord(6,line,ScanSpaces)).x;
       end;
      end;
      if SameText(ExtractWord(2,line,ScanSpaces),'Form.Top') then begin
       if Str2Int(ExtractWord(3,line,ScanSpaces),t) then begin
        if SameText(ExtractWord(4,line,ScanSpaces),'relative')
        then Result.y:=FindRelativePos(Point(0,t),ExtractWord(5,line,ScanSpaces),ExtractWord(6,line,ScanSpaces)).y;
       end;
      end;
     end;
    end;
   end;
  finally
   Kill(pars);
  end;
 except
  on E:Exception do BugReport(E,nil,'ApplyParamsPos');
 end;
end;

const
 MessageDlgRec : record
  Pid    : Cardinal;
  Pos    : TPoint;
  wClass : LongString;
  wTitle : LongString;
 end = ( Pid:0; Pos:(X:0; Y:0); wClass:''; wTitle:'');

procedure MessageDlgPosUpdate;
var wnd:HWND; R:TRect; arg,sg,sx,sy,sw,sh:LongString; gravity:Integer;
begin
 try
  with MessageDlgRec do
  if (Pid>0) and ((wClass<>'') or (wTitle<>'')) and ((Pos.x<>Low(Integer)) or (Pos.y<>Low(Integer))) then begin
   wnd:=wmctrl.FindWindow(Pid,wClass,wTitle);
   if not wmctrl.IsWindow(wnd) then Exit;
   R:=wmctrl.WindowBounds(wnd);
   if R.IsEmpty then Exit;
   gravity:=0;
   sg:=IntToStr(gravity);
   sx:=IntToStr(Pos.x);
   sy:=IntToStr(Pos.y);
   sw:=IntToStr(R.Width);
   sh:=IntToStr(R.Height);
   if (Pos.x=Low(Integer)) then sx:='*';
   if (Pos.y=Low(Integer)) then sy:='*';
   arg:=Format('%s,%s,%s,%s,%s',[sg,sx,sy,sw,sh]);
   if not wmctrl.MoveResizeWindow(wnd,arg) then Exit;
   Pid:=0; Pos:=Point(0,0); wClass:=''; wTitle:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'MessageDlgPosUpdate');
 end;
end;

procedure MessageDlgRecInit(Pid:Cardinal; Pos:TPoint; wClass,wTitle:String);
begin
 MessageDlgRec.Pid:=Pid;       MessageDlgRec.Pos:=Pos;
 MessageDlgRec.wClass:=wClass; MessageDlgRec.wTitle:=wTitle;
 if (Pid>0) then Tick55Actions.Add(MessageDlgPosUpdate) else Tick55Actions.Remove(MessageDlgPosUpdate);
end;

function MsgDlgCaption(DlgType:TMsgDlgType; Mode:Integer):LongString;
const MsgDlgCaptions: array[TMsgDlgType] of Pointer =
      (@SMsgDlgWarning,@SMsgDlgError,@SMsgDlgInformation,@SMsgDlgConfirm,nil);
begin
 Result:='';
 if HasFlags(Mode,1) then begin
  case DlgType of
   mtWarning:      Result:=RusEng('Предупреждение','Warning');
   mtInformation:  Result:=RusEng('Информация','Information');
   mtConfirmation: Result:=RusEng('Подтверждение','Confirmation');
   mtError:        Result:=RusEng('Ошибка','Error');
  end;
 end;
 if (Result='') then
 if (DlgType<>mtCustom)
 then Result:=LoadResString(MsgDlgCaptions[DlgType])
 else Result:=Application.Title;
 if HasFlags(Mode,2) then begin
  if (DlgType<>mtCustom) then
  Result:=GetMainFormTitle+' - '+Result;
 end;
end;

function GetMainFormTitle:LongString;
begin
 if (Application=nil) then Result:=SysUtils.ExtractFileName(ParamStr(0)) else
 if (Application.MainForm=nil) then Result:=Application.Title else Result:=Application.MainForm.Caption;
end;

 {
 *******************************
 Standard dialogs implementation
 *******************************
 }
function MessageDlgClass:LongString;
begin
 Result:='';
 if IsWindows then begin
  Result:='TMessageForm';
  Exit;
 end;
 if IsUnix then begin
  Result:=wmctrl.IcccmClass;
  Exit;
 end;
end;

function MessageDlg(const Msg:LongString; DlgType:TMsgDlgType; Buttons:TMsgDlgButtons; HelpCtx:Longint; Params:LongString=''): Integer;
var Flags:LongInt; Cap:LongString; SysMsgBox:Boolean;
begin
 Result:=mrCancel;
 try
  Params:=SysUtils.Trim(Params);
  if not UseEditSettings then Params:='';
  try
   SysMsgBox:=UseSystemMessageBox and IsWindows;
   Flags:=MB_TOPMOST;
   Cap:=MsgDlgCaption(DlgType,1+2);
   case DlgType of
    mtWarning:      Flags:=Flags or MB_ICONWARNING;
    mtInformation:  Flags:=Flags or MB_ICONINFORMATION;
    mtConfirmation: Flags:=Flags or MB_ICONQUESTION;
    mtError:        Flags:=Flags or MB_ICONERROR;
   end;
   if Buttons = [mbOk]                then Flags:=Flags or MB_OK          else
   if Buttons = [mbOk,mbCancel]       then Flags:=Flags or MB_OKCANCEL    else
   if Buttons = [mbYes,mbNo]          then Flags:=Flags or MB_YESNO       else
   if Buttons = [mbYes,mbNo,mbCancel] then Flags:=Flags or MB_YESNOCANCEL else SysMsgBox:=false;
   if SysMsgBox then begin
    if (Params<>'') then MessageDlgRecInit(GetCurrentProcessId,MessageDlgApplyParamsPos(Params),swc_DialogBox,Cap);
    Result:=mrVoice(Application.MessageBox(PChar(Msg),PChar(Cap),Flags))
   end else begin
    if (Params<>'') then MessageDlgRecInit(GetCurrentProcessId,MessageDlgApplyParamsPos(Params),MessageDlgClass,Cap);
    Result:=mrVoice(Dialogs.MessageDlg(Cap,Msg,DlgType,Buttons,HelpCtx));
   end;
  finally
   if (Params<>'') then MessageDlgRecInit(0,Point(0,0),'','');
  end;
 except
  on E:Exception do BugReport(E,nil,'MessageDlg');
 end;
end;

function Warning(const Msg:LongString; Params:LongString=''):Integer;
begin
 Result:=MessageDlg(Msg, mtWarning, [mbOk,mbCancel], 0, Params);
end;

function Information(const Msg:LongString; Params:LongString=''):Integer;
begin
 Result:=MessageDlg(Msg, mtInformation, [mbOk,mbCancel], 0, Params);
end;

function YesNo(const Msg:LongString; Params:LongString=''):Integer;
begin
 Result:=MessageDlg(Msg, mtConfirmation, [mbYes,mbNo], 0, Params);
end;

function YesNoCancel(const Msg:LongString; Params:LongString=''):Integer;
begin
 Result:=MessageDlg(Msg, mtConfirmation, [mbYes,mbNo,mbCancel], 0, Params);
end;

function Error(const Msg:LongString; Params:LongString=''):Integer;
begin
 Result:=MessageDlg(Msg, mtError, [mbOk], 0, Params);
end;

function Trouble(Check:boolean; const Msg:LongString; Params:LongString=''):Boolean;
begin
 if Check and (Msg<>'') then Error(Msg,Params);
 Result:=Check;
end;

function NoProblem(Check:boolean; const Msg:LongString; Params:LongString=''):Boolean;
begin
 Result:=not Trouble(not Check,Msg,Params);
end;

function mrVoice(Code:TModalResult):TModalResult;
const
 sayOk     : LongString  = '';
 sayCancel : LongString  = '';
 sayAbort  : LongString  = '';
 sayYes    : LongString  = '';
 sayNo     : LongString  = '';
 sayRetry  : LongString  = '';
 sayIgnore : LongString  = '';
 sayError  : LongString  = '';
 IsLoaded  : Boolean      = false;
begin
 Result:=Code;
 if EnableSystemVoice then begin
  if not IsLoaded then begin
   ReadIniFileAlpha(SysIniFile, '[SysVoice]', 'ClickOk%a',     sayOk);
   ReadIniFileAlpha(SysIniFile, '[SysVoice]', 'ClickCancel%a', sayCancel);
   ReadIniFileAlpha(SysIniFile, '[SysVoice]', 'ClickAbort%a',  sayAbort);
   ReadIniFileAlpha(SysIniFile, '[SysVoice]', 'ClickYes%a',    sayYes);
   ReadIniFileAlpha(SysIniFile, '[SysVoice]', 'ClickNo%a',     sayNo);
   ReadIniFileAlpha(SysIniFile, '[SysVoice]', 'ClickRetry%a',  sayRetry);
   ReadIniFileAlpha(SysIniFile, '[SysVoice]', 'ClickIgnore%a', sayIgnore);
   ReadIniFileAlpha(SysIniFile, '[SysVoice]', 'ClickError%a',  sayError);
   IsLoaded:=true;
  end;
  case Code of
   mrNone   : ;
   mrOk     : SysVoice(sayOk);
   mrCancel : SysVoice(sayCancel);
   mrAbort  : SysVoice(sayAbort);
   mrYes    : SysVoice(sayYes);
   mrNo     : SysVoice(sayNo);
   mrRetry  : SysVoice(sayRetry);
   mrIgnore : SysVoice(sayIgnore);
   mrError  : SysVoice(sayError);
  end;
 end;
end;

function mrCaption(Code:TModalResult):LongString;
begin
 case Code of
  mrNone     : Result:='';
  mrOk       : Result:=RusEng('Ладно','Ok');
  mrCancel   : Result:=RusEng('Отмена','Cancel');
  mrAbort    : Result:=RusEng('Прервать','Abort');
  mrYes      : Result:=RusEng('Да','Yes');
  mrNo       : Result:=RusEng('Нет','No');
  mrRetry    : Result:=RusEng('Повтор','Retry');
  mrIgnore   : Result:=RusEng('Пропустить','Ignore');
  mrError    : Result:=RusEng('Ошибка','Error');
  mrAll      : Result:=RusEng('Все','All');
  mrNoToAll  : Result:=RusEng('Нет для Всех','No to All');
  mrYesToAll : Result:=RusEng('Да для Всех','Yes to All');
  else         Result:='';
 end;
end;

function StandardExitConfirmation:Boolean;
var x,y:Integer;
begin
 x:=0; y:=EnsureRange(GetWindowCaptionHeight,0,100);
 Result:=YesNo(RusEng('Вы действительно хотите выйти из программы?',
                      'Do you really want to exit program now?'),
                      ControlPosParams(ApplicationMainForm,'LT',x,y))=mrYes;
end;

procedure UpdateStatusLine(const aMessage:LongString);
begin
 if Assigned(OnUpdateStatusLine) then OnUpdateStatusLine(aMessage);
end;

procedure ShouldBeDone;
begin
 Warning('Should be done.');
end;

function MenuRightSpace:String;
begin
 Result:=StringOfChar(' ',MenuRightSpaceWidth);
end;

// @set Form.Left    400  relative "WindowTitle" ComponentName
// @set Form.Top     400  relative "WindowTitle" ComponentName
// @set Form.Top     400  relative "WindowTitle" ComponentName.RightBottom
// @set Form.Top     400  relative "WindowTitle" ComponentName.CenterMiddle
// @set Form.Width   400                         (absolute pixel width)
// @set Form.Height  300                         (absolute pixel height)
// @set Form.Width   -50 relative "WindowTitle"  ComponentName.Absolute
// @set Form.Width   80  relative Screen         (80% of Screen width)
// @set Form.Height  50  relative Desktop        (50% of Desktop height)
// @set Form.Width   70  relative WorkArea       (70% of WorkArea width)
function Form_ApplyParams_PosSize(Form:TForm; const Params:LongString):Integer;
var pars:TStringList; i,w,h,l,t:Integer; line:LongString;
var Delims:TCharSet; p:TPoint;
begin
 Result:=0;
 if UseEditSettings then
 if (Trim(Params)<>'') then
 if (Form<>nil) then with Form do
 try
  pars:=TStringList.Create;
  try
   Delims:=EolnDelims;
   pars.Text:=ValidateEol(Trim(Params));
   for i:=0 to pars.Count-1 do begin
    line:=Trim(PhraseListToTextLines(pars[i],ScanSpaces));
    if IsLexeme(line,lex_AtCall) then begin
     if SameText(ExtractWord(1,line,Delims),'@set') then begin
      if SameText(ExtractWord(2,line,Delims),'Form.Width') then begin
       if Str2Int(ExtractWord(3,line,Delims),w) then begin
        if SameText(ExtractWord(4,line,Delims),'relative')
        then w:=FindRelativeSize(Point(w,0),ExtractWord(5,line,Delims),ExtractWord(6,line,Delims)).x;
        UpdateWidth(w);
        Result:=Result or apf_FormWidth;
       end;
      end;
      if SameText(ExtractWord(2,line,Delims),'Form.Height') then begin
       if Str2Int(ExtractWord(3,line,Delims),h) then begin
        if SameText(ExtractWord(4,line,Delims),'relative')
        then h:=FindRelativeSize(Point(0,h),ExtractWord(5,line,Delims),ExtractWord(6,line,Delims)).y;
        UpdateHeight(h);
        Result:=Result or apf_FormHeight;
       end;
      end;
      if SameText(ExtractWord(2,line,Delims),'Form.Left') then begin
       if Str2Int(ExtractWord(3,line,Delims),l) then begin
        p:=Point(l,0);
        if SameText(ExtractWord(4,line,Delims),'relative')
        then p:=FindRelativePos(p,ExtractWord(5,line,Delims),ExtractWord(6,line,Delims));
        UpdateLeft(p.x);
        Result:=Result or apf_FormLeft;
       end;
      end;
      if SameText(ExtractWord(2,line,Delims),'Form.Top') then begin
       if Str2Int(ExtractWord(3,line,Delims),t) then begin
        p:=Point(0,t);
        if SameText(ExtractWord(4,line,Delims),'relative')
        then p:=FindRelativePos(p,ExtractWord(5,line,Delims),ExtractWord(6,line,Delims));
        UpdateTop(p.y);
        Result:=Result or apf_FormTop;
       end;
      end;
     end;
    end;
   end;
   if (Result<>0) then ValidateFormPosition(Form);
  finally
   Kill(pars);
  end;
 except
  on E:Exception do BugReport(E,nil,'Form_ApplyParams_PosSize');
 end;
end;

// @set Panel.Font   Name:PT_Mono\Size:10\Color:Black\Style:[Regular]
function Form_ApplyParams_Font(Font:TFont; const Params,Key:LongString; Flag:Integer):Integer;
var pars:TStringList; i:Integer; line:LongString; FontPars:TFontParams;
var Delims:TCharSet;
begin
 Result:=0;
 if Assigned(Font) then
 if UseEditSettings then
 if (Trim(Params)<>'') then
 if (Key<>'') and (Flag<>0) then
 try
  pars:=TStringList.Create;
  try
   Delims:=EolnDelims;
   pars.Text:=ValidateEol(Trim(Params));
   SafeFillChar(FontPars,SizeOf(FontPars),0);
   for i:=0 to pars.Count-1 do begin
    line:=Trim(PhraseListToTextLines(pars[i],ScanSpaces));
    if IsLexeme(line,lex_AtCall) then begin
     if SameText(ExtractWord(1,line,Delims),'@set') then begin
      if SameText(ExtractWord(2,line,Delims),Key) then begin
       if ReadBufferedFont(FontPars,ExtractWord(3,line,Delims),true,StandardFont)
       then RestoreFont(Font,FontPars);
       Result:=Result or Flag;
      end;
     end;
    end;
   end;
  finally
   Kill(pars);
  end;
 except
  on E:Exception do BugReport(E,nil,'Form_ApplyParams_Fonts');
 end;
end;

function ControlPosParams(Control:TControl; Anchors:LongString='LT';
                          dX:Integer=0; dY:Integer=0):LongString;
var pt:TPoint;
begin
 Result:=''; pt:=Point(0,0);
 if not Assigned(Control) then Exit;
 if (PosI('R',Anchors)>0) then pt.x:=Control.Width;        //Right
 if (PosI('B',Anchors)>0) then pt.y:=Control.Height;       //Bottom
 if (PosI('C',Anchors)>0) then pt.x:=Control.Width div 2;  //Center
 if (PosI('M',Anchors)>0) then pt.y:=Control.Height div 2; //Middle
 pt:=Control.ClientToScreen(pt); Inc(pt.x,dx); Inc(pt.y,dy);
 Result:='@set Form.Left '+IntToStr(pt.x)+' relative Screen'+EOL
        +'@set Form.Top  '+IntToStr(pt.y)+' relative Screen'+EOL;
end;

 {
 ************************
 General purpose utilites
 ************************
 }
procedure ForEachMdiChild(Action:TForEachMdiChildAction; Custom:Pointer; Backward:Boolean=false);
var
 Index     : Integer;
 MainForm  : TForm;
 ChildForm : TCustomForm;
 Terminate : Boolean;
begin
 try
  Terminate:=false;
  if Assigned(Action) then
  if Application is TApplication then begin
   MainForm:=Application.MainForm;
   if MainForm is TForm then begin
    if Backward then begin
     for Index:=MainForm.MDIChildCount-1 downto 0 do begin
      ChildForm:=MainForm.MDIChildren[Index];
      if (ChildForm is TForm) then Action(TForm(ChildForm),Index,Terminate,Custom);
      if Terminate then break;
     end;
    end else begin
     for Index:=0 to MainForm.MDIChildCount-1 do begin
      ChildForm:=MainForm.MDIChildren[Index];
      if (ChildForm is TForm) then Action(TForm(ChildForm),Index,Terminate,Custom);
      if Terminate then break;
     end;
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'ForEachMdiChild');
 end;
end;

procedure ForEachComponent(Component:TComponent; Action:TForEachComponentAction; Custom:Pointer; Backward:Boolean=false);
var
 Item      : TComponent;
 Index     : Integer;
 Terminate : Boolean;
begin
 try
  Terminate:=false;
  if (Component is TComponent) and Assigned(Action) then
  if Backward then begin
   for Index:=Component.ComponentCount-1 downto 0 do begin
    Item:=Component.Components[Index];
    if Item is TComponent then Action(Item,Index,Terminate,Custom);
    if Terminate then break;
   end;
  end else begin
   for Index:=0 to Component.ComponentCount-1 do begin
    Item:=Component.Components[Index];
    if Item is TComponent then Action(Item,Index,Terminate,Custom);
    if Terminate then break;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'ForEachComponent');
 end;
end;

type
 TFEF_Rec = packed record
  Action : TForEachFormAction;
  Custom : Pointer;
  Index  : Integer;
 end;

procedure FEF_Action(Component:TComponent; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if Component is TForm then begin
  TFEF_Rec(Custom^).Action(Component as TForm, TFEF_Rec(Custom^).Index,
                           Terminate,          TFEF_Rec(Custom^).Custom);
  inc(TFEF_Rec(Custom^).Index);
 end;
end;

procedure ForEachForm(Action:TForEachFormAction; Custom:Pointer; Backward:Boolean=false);
var
 FEF_Rec : TFEF_Rec;
begin
 if Assigned(Action) then
 if Application is TApplication then begin
  FEF_Rec.Action:=Action;
  FEF_Rec.Custom:=Custom;
  FEF_Rec.Index:=0;
  ForEachComponent(Application, FEF_Action, @FEF_Rec, Backward);
 end;
end;

procedure ForEachFormInZOrder(Action:TForEachFormAction; Custom:Pointer);
var i,Index:Integer; Form:TCustomForm; Terminate:Boolean;
begin
 try
  Index:=0;
  Terminate:=false;
  if Assigned(Action) then
  if (Application is TApplication) then begin
   for i:=0 to Screen.CustomFormZOrderCount-1 do begin
    Form:=Screen.CustomFormsZOrdered[i];
    if (Form is TForm) then begin
      Action(TForm(Form),Index,Terminate,Custom);
      Inc(Index);
    end;
    if Terminate then break;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'ForEachFormInZOrder');
 end;
end;

procedure FormExistsCallback(Form:TForm; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if Assigned(Custom) then begin
  if (Pointer(Custom^)=Form) then begin
   Pointer(Custom^):=nil;
   Terminate:=true;
  end;
 end else Terminate:=true;
end;

function FormExists(Form:TForm):Boolean;
var aForm:TForm;
begin
 Result:=false;
 if Assigned(Form) then begin
  aForm:=Form;
  ForEachForm(FormExistsCallback,@aForm);
  Result:=(aForm=nil);
 end;
end;

type
 TFRP_Rec = packed record    // Uses by FindRelativePos, FindRelativeSize
   Window      : TForm;      // Window  reference
   Control     : TControl;   // Control reference
   WindowTitle : LongString; // Window Caption or CLASS::NAME
   ControlName : LongString; // The name of control to find
 end;

function HasWindowClassAndName(const S:LongString):Boolean;
var p:Integer;
begin
 p:=Pos('::',S); Result:=(p>1) and (p+2<=Length(S));
end;
function ExtractWindowClass(const S:LongString):LongString;
var p:Integer;
begin
 p:=Pos('::',S); if (p>0) then Result:=Copy(S,1,p-1) else Result:='';
end;
function ExtractWindowName(const S:LongString):LongString;
var p:Integer;
begin
 p:=Pos('::',S); if (p>0) then Result:=Copy(S,p+2,MaxInt) else Result:=S;
end;

function FRP_FormMatch(Form:TForm; const WindowTitle:LongString):Boolean;
var wc,wn:LongString;
begin
 Result:=false;
 if (Form is TForm) then
 if SameText(Form.Caption,WindowTitle) then Result:=true else
 if HasWindowClassAndName(WindowTitle) then begin
  wc:=ExtractWindowClass(WindowTitle);
  wn:=ExtractWindowName(WindowTitle);
  if SameText(wc,'*') or SameText(wc,Form.ClassName) then
  if SameText(wn,'*') or SameText(wn,Form.Name) then Result:=true;
 end;
end;

procedure FRP_FormProc(Form:TForm; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if (Form is TForm) then
 if (Custom<>nil) then with TFRP_Rec(Custom^) do
 if FRP_FormMatch(Form,WindowTitle) then begin
  Terminate:=true;
  Window:=Form;
 end;
end;

procedure FRP_ContProc(Component:TComponent; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if (Component is TControl) then
 if (Custom<>nil) then with TFRP_Rec(Custom^) do
 if SameText(Component.Name,ControlName) then begin
  Control:=TControl(Component);
  Terminate:=true;
 end;
end;

function FindRelativePos(const Pos:TPoint; Window:TForm; Control:TControl; const Ext:LongString):TPoint; overload;
begin
 if (Control<>nil) then Result:=Control.ClientToScreen(Pos) else
 if (Window<>nil) then Result:=Window.ClientToScreen(Pos) else
 Result:=Pos;
 if IsNonEmptyStr(Ext) then begin
  if (PosI('Right',Ext)>0) then begin
   if (Control<>nil) then Inc(Result.x,Control.Width) else
   if (Window<>nil) then Inc(Result.x,Window.Width);
  end else
  if (PosI('Center',Ext)>0) then begin
   if (Control<>nil) then Inc(Result.x,Control.Width div 2) else
   if (Window<>nil) then Inc(Result.x,Window.Width div 2);
  end;
  if (PosI('Bottom',Ext)>0) then begin
   if (Control<>nil) then Inc(Result.y,Control.Height) else
   if (Window<>nil) then Inc(Result.y,Window.Height);
  end else
  if (PosI('Middle',Ext)>0) then begin
   if (Control<>nil) then Inc(Result.y,Control.Height div 2) else
   if (Window<>nil) then Inc(Result.y,Window.Height div 2);
  end;
 end;
end;

function FindRelativePos(const Pos:TPoint; const WindowTitle,ControlName:LongString):TPoint; overload;
var R:TFRP_Rec; Ext:LongString;
begin
 Result:=Pos;
 R:=Default(TFRP_Rec);
 try
  R.Window:=nil; R.Control:=nil;
  R.WindowTitle:=StringBuffer(Trim(WindowTitle));
  R.ControlName:=StringBuffer(Trim(ExtractBaseName(ControlName)));
  Ext:=ExtractFileExt(ControlName);
  if (R.WindowTitle='') then Exit;
  if SameText(R.WindowTitle,'Screen') then Exit;
  if SameText(R.WindowTitle,'Desktop') then begin
   Inc(Result.x,Screen.DesktopLeft);
   Inc(Result.y,Screen.DesktopTop);
   Exit;
  end;
  if SameText(R.WindowTitle,'WorkArea') then begin
   Inc(Result.x,Screen.WorkAreaLeft);
   Inc(Result.y,Screen.WorkAreaTop);
   Exit;
  end;
  if (R.Window=nil) then ForEachMdiChild(FRP_FormProc,@R);
  if (R.Window=nil) then ForEachForm(FRP_FormProc,@R);
  if (R.Window=nil) then Exit;
  if (R.ControlName<>'') then ForEachComponent(R.Window,FRP_ContProc,@R);
  Result:=FindRelativePos(Pos,R.Window,R.Control,Ext);
 finally
  R.WindowTitle:='';
  R.ControlName:='';
  Ext:='';
 end;
end;

function RelativeSize(const p,s:TPoint; base:Integer=100):TPoint;
begin
 if (base<=0)
 then Result:=Point(p.x+s.x,p.y+s.y)
 else Result:=Point((Int64(p.x)*s.x) div base,(Int64(p.y)*s.y) div base);
end;

function FindRelativeSize(const P:TPoint; Window:TForm; Control:TControl; base:Integer=100):TPoint; overload;
begin
 if (Control<>nil) then Result:=RelativeSize(P,Point(Control.Width,Control.Height),base) else
 if (Window<>nil) then Result:=RelativeSize(P,Point(Window.Width,Window.Height),base) else
 Result:=P;
end;

function FindRelativeSize(const P:TPoint; const WindowTitle,ControlName:LongString):TPoint; overload;
var R:TFRP_Rec; Ext:LongString; base:Integer;
begin
 Result:=P;
 R:=Default(TFRP_Rec);
 try
  R.Window:=nil; R.Control:=nil;
  R.WindowTitle:=StringBuffer(Trim(WindowTitle));
  R.ControlName:=StringBuffer(Trim(ExtractBaseName(ControlName)));
  Ext:=ExtractFileExt(ControlName); base:=IfThen((PosI('.Abs',Ext)>0),0,100);
  if (R.WindowTitle='') then Exit;
  if SameText(R.WindowTitle,'Screen') then begin
   Result:=RelativeSize(P,Point(Screen.Width,Screen.Height),base);
   Exit;
  end;
  if SameText(R.WindowTitle,'Desktop') then begin
   Result:=RelativeSize(P,Point(Screen.DesktopWidth,Screen.DesktopHeight),base);
   Exit;
  end;
  if SameText(R.WindowTitle,'WorkArea') then begin
   Result:=RelativeSize(P,Point(Screen.WorkAreaWidth,Screen.WorkAreaHeight),base);
   Exit;
  end;
  if (R.Window=nil) then ForEachMdiChild(FRP_FormProc,@R);
  if (R.Window=nil) then ForEachForm(FRP_FormProc,@R);
  if (R.Window=nil) then Exit;
  if (R.ControlName<>'') then ForEachComponent(R.Window,FRP_ContProc,@R);
  Result:=FindRelativeSize(P,R.Window,R.Control,base);
 finally
  R.WindowTitle:='';
  R.ControlName:='';
 end;
end;

function GetFormBounds(Form:TForm):TRect;
begin
 if (Form=nil)
 then Result:=Rect(0,0,0,0)
 else with Form do Result:=Rect(Left,Top,Left+Width,Top+Height);
end;

function GetScreenDesktopBounds:TRect;
begin
 Result.Left:=Screen.DesktopLeft;
 Result.Top:=Screen.DesktopTop;
 Result.Right:=Result.Left+Screen.DesktopWidth;
 Result.Bottom:=Result.Top+Screen.DesktopHeight;
end;

function GetValidFormDesktopPosition(Form:TForm):TPoint;
var RF,RS:TRect;
begin
 if (Form=nil) then Result:=Point(0,0) else begin
  RF:=GetFormBounds(Form); RS:=GetScreenDesktopBounds;
  Result.x:=Max(RS.Left,Min(RF.Left,RS.Right-(RF.Right-RF.Left)));
  Result.y:=Max(RS.Top,Min(RF.Top,RS.Bottom-(RF.Bottom-RF.Top)));
 end;
end;

function GetValidFormPosition(Form:TForm; const PadX,PadY:Integer):TPoint;
var Monitor:TMonitor; P,D:TPoint; FR,MR:TRect;
begin
 Result:=Point(0,0);
 if Assigned(Form) then
 try
  Monitor:=Form.Monitor;
  if Assigned(Monitor) then begin
   FR:=Form.BoundsRect;
   MR:=Monitor.WorkAreaRect;
   D.X:=Max(0,FR.Right-MR.Right+PadX);
   D.Y:=Max(0,FR.Bottom-MR.Bottom+PadY);
   P:=FR.TopLeft.Subtract(D);
   P.X:=Max(P.X,MR.Left);
   P.Y:=Max(P.Y,MR.Top);
   Result:=P;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetValidFormPosition');
 end;
end;

procedure ValidateFormPosition(Form:TForm; const PadX,PadY:Integer);
begin
 if (Form<>nil) then
 with GetValidFormPosition(Form,PadX,PadY) do begin
  if (Form.Left<>x) then Form.Left:=x;
  if (Form.Top<>y) then Form.Top:=y;
 end;
end;

procedure AddToMdiList(Form:TForm; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 TText(Custom).Addln(Form.Caption);
end;

function SelectMDIChildDialog(const Caption,Title:LongString):TForm;
var List:TText; Index:Integer; aForm:TCustomForm;
begin
 Result:=nil;
 try
  List:=NewText;
  try
   ForEachMdiChild(AddToMdiList,List);
   if List.Count>0 then begin
    Index:=0; aForm:=nil;
    if ListBoxSelection(Caption,Title,List.Text,Index)=mrOk then
    if (Index>=0) and (Index<Application.MainForm.MDIChildCount)
    then aForm:=Application.MainForm.MDIChildren[Index];
    if (aForm is TForm) then Result:=TForm(aForm);
   end;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'SelectMDIChildDialog');
 end;
end;

function ActivateMDIChild(aForm:TForm):Boolean;
var i:integer;
begin
 Result:=false;
 try
  if aForm is TForm then
  if aForm.FormStyle=fsMDIChild then
  if Application is TApplication then
  if Application.MainForm is TForm then
  with Application.MainForm do
  if FormStyle=fsMDIForm then
  for i:=0 to MDIChildCount-1 do begin
   if ActiveMDIChild=aForm then begin
    Result:=true;
    break;
   end;
   Next;
   if ActiveMDIChild=aForm then begin
    Result:=true;
    break;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'ActivateMDIChild');
 end;
end;

procedure UpdateTheForm(Form:TForm; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if Form is TForm then Form.Update;
end;

procedure UpdateAllMdiForms;
begin
 ForEachMdiChild(UpdateTheForm,nil);
end;

procedure SetEnabledActions(Enabled:Boolean; const Actions:array of TAction);
var i:Integer;
begin
 for i:=Low(Actions) to High(Actions) do
 if Actions[i] is TAction then
 if Actions[i].Enabled<>Enabled then Actions[i].Enabled:=Enabled;
end;

procedure SetVisibleControls(Visible:Boolean; const Controls:array of TControl);
var i:Integer;
begin
 for i:=Low(Controls) to High(Controls) do
 if Controls[i] is TControl then Controls[i].Visible:=Visible;
end;

procedure SetEnabledControls(Enabled:Boolean; const Controls:array of TControl);
var i:Integer;
begin
 for i:=Low(Controls) to High(Controls) do
 if Controls[i] is TControl then
 if Controls[i].Enabled<>Enabled then Controls[i].Enabled:=Enabled;
end;

procedure ShowControls(const Controls:array of TControl);
begin
 SetVisibleControls(true,Controls);
end;

procedure HideControls(const Controls:array of TControl);
begin
 SetVisibleControls(false,Controls);
end;

function IsValidShortcut(sc:Integer):Boolean;
begin
 Result:=(sc>=0) and (sc<=MaxWord);
end;

const
 VirtualKeys   : THashList = nil;
 MenuShortcuts : THashList = nil;

procedure InitMenuShortcuts;
var Lines:TText; i:Integer; Line,id,sk,ss:LongString; sc,Key:Integer; Shift:TShiftState;
begin
 if (MenuShortcuts<>nil) then Exit;
 try
  {
  VirtualKeys from [Virtual.Key.Codes]
  }
  Kill(VirtualKeys);
  VirtualKeys:=NewHashList(false,HashList_DefaultHasher);
  VirtualKeys.Master:=@VirtualKeys;
  Lines:=ExtractListSection(SysIniFile,'[Virtual.Key.Codes]',efConfigNC);
  try
   for i:=0 to Lines.Count-1 do begin
    Line:=Trim(Lines[i]); if IsEmptyStr(Line) then continue;
    id:=ExtractWord(1,Line,ScanSpaces); sk:=ExtractWord(2,Line,ScanSpaces);
    if (Length(id)<4) or not SameText(Copy(id,1,3),'VK_') then continue;
    if Str2Int(sk,Key) then VirtualKeys.KeyedLinks[id]:=Key;
   end;
   DebugOut(stdfDebug,EOL+'[Virtual.Key.Codes]');
   for i:=0 to VirtualKeys.Count-1 do begin
    id:=VirtualKeys.Keys[i]; sc:=VirtualKeys.KeyedLinks[id];
    DebugOut(stdfDebug,Format('%-12s = %d',[id,sc]));
   end;
   DebugOut(stdfDebug,'[]');
  finally
   Kill(Lines);
  end;
  {
  MenuShortcuts from [System.Menu.ShortCut.Table]
  }
  Kill(MenuShortcuts);
  MenuShortcuts:=NewHashList(false,HashList_DefaultHasher);
  MenuShortcuts.Master:=@MenuShortcuts;
  Lines:=ExtractListSection(SysIniFile,'[System.Menu.ShortCut.Table]',efConfigNC);
  try
   for i:=0 to Lines.Count-1 do begin
    Line:=Trim(Lines[i]); if IsEmptyStr(Line) then continue;
    if not SameText(ExtractWord(2,Line,ScanSpaces),'ShortCut') then continue;
    id:=ExtractWord(1,Line,ScanSpaces); sk:=ExtractWord(3,Line,ScanSpaces);
    ss:=Trim(SkipWords(3,Line,ScanSpaces)); if IsEmptyStr(sk) then continue;
    Shift:=[]; Key:=-1; sc:=-1;
    if Str2Int(sk,Key) and IsEmptyStr(ss) then sc:=Key else begin
     if (Length(sk)=3) and (StrFetch(sk,1)=Apostrophe) and (StrFetch(sk,3)=Apostrophe) then Key:=Ord(StrFetch(sk,2)) else
     if (VirtualKeys.IndexOf(sk)>=0) then Key:=VirtualKeys.KeyedLinks[sk] else continue;
     if (WordIndex('Alt',ss,ScanSpaces)>0) then Include(Shift,ssAlt);
     if (WordIndex('Ctrl',ss,ScanSpaces)>0) then Include(Shift,ssCtrl);
     if (WordIndex('Shift',ss,ScanSpaces)>0) then Include(Shift,ssShift);
     if (sc<0) and (Key>=0) then sc:=ShortCut(Key,Shift);
    end;
    if IsValidShortcut(sc) then MenuShortcuts.KeyedLinks[id]:=sc;
   end;
   DebugOut(stdfDebug,EOL+'[System.Menu.ShortCut.Table]');
   for i:=0 to MenuShortcuts.Count-1 do begin
    id:=MenuShortcuts.Keys[i]; sc:=MenuShortcuts.KeyedLinks[id];
    DebugOut(stdfDebug,Format('%-60s ShortCut %s',[id,ShortCutToText(sc)]));
   end;
   DebugOut(stdfDebug,'[]');
  finally
   Kill(Lines);
  end;
 except
  on E:Exception do BugReport(E,nil,'InitMenuShortcuts');
 end;
end;

procedure FreeMenuShortcuts;
begin
 Kill(MenuShortcuts);
 Kill(VirtualKeys);
end;

procedure ApplyMenuShortcut(aMenu:TMenuItem; aShortCut:TShortCut);
var ClassRef:TClass;
 function Found(const arg:LongString):Boolean;
 var sc:Integer;
 begin
  Result:=(MenuShortcuts.IndexOf(arg)>=0);
  if Result then sc:=MenuShortcuts.KeyedLinks[arg] else sc:=-1;
  if IsValidShortcut(sc) then aMenu.ShortCut:=sc;
 end;
begin
 try
  InitMenuShortcuts;
  if (aMenu=nil) then Exit;
  if Found(aMenu.Name) then Exit;
  if (aMenu.Owner=nil) then Exit;
  ClassRef:=aMenu.Owner.ClassType;
  while (ClassRef<>nil) do begin
   if Found(ClassRef.ClassName+'.'+aMenu.Name) then Exit;
   ClassRef:=ClassRef.ClassParent;
  end;
  if aShortCut<>0 then aMenu.ShortCut:=aShortCut;
 except
  on E:Exception do BugReport(E,nil,'ApplyMenuShortcut');
 end;
end;

procedure UpdateMenu(aMenu:TMenuItem; const aCaption,aHint:LongString; aShortCut:TShortCut);
begin
 if (aMenu=nil) then Exit;
 aMenu.Caption:=aCaption;
 aMenu.Hint:=aHint;
 ApplyMenuShortcut(aMenu,aShortCut);
 if (aMenu.Action is TAction) then
 with (aMenu.Action as TAction) do begin
  ShortCut:=aMenu.ShortCut;
  Caption:=aMenu.Caption;
  Hint:=aMenu.Hint;
 end;
end;

procedure ApplyActionShortcut(aAction:TAction; aShortCut:TShortCut);
var ClassRef:TClass;
 function Found(const arg:LongString):Boolean;
 var sc:Integer;
 begin
  Result:=(MenuShortcuts.IndexOf(arg)>=0);
  if not Result then Result:=(MenuShortcuts.IndexOf(StringReplace(arg,'Action','Menu',[rfIgnoreCase]))>=0);
  if Result then sc:=MenuShortcuts.KeyedLinks[arg] else sc:=-1;
  if IsValidShortcut(sc) then aAction.ShortCut:=sc;
 end;
begin
 try
  InitMenuShortcuts;
  if (aAction=nil) then Exit;
  if Found(aAction.Name) then Exit;
  if (aAction.Owner=nil) then Exit;
  ClassRef:=aAction.Owner.ClassType;
  while (ClassRef<>nil) do begin
   if Found(ClassRef.ClassName+'.'+aAction.Name) then Exit;
   ClassRef:=ClassRef.ClassParent;
  end;
  if aShortCut<>0 then aAction.ShortCut:=aShortCut;
 except
  on E:Exception do BugReport(E,nil,'ApplyActionShortcut');
 end;
end;

procedure UpdateActionCap(aAction:TAction; const aCaption,aHint:LongString; aShortCut:TShortCut);
begin
 if Assigned(aAction) then begin
  ApplyActionShortcut(aAction,aShortcut);
  aAction.Caption:=aCaption;
  aAction.Hint:=aHint;
 end;
end;

procedure SetButtonCursor(Component:TComponent; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if (Component is TButton)
 then (Component as TButton).Cursor:=TCursor(PointerToPtrInt(Custom));
 if (Component is TToolButton)
 then (Component as TToolButton).Cursor:=TCursor(PointerToPtrInt(Custom));
 if (Component is TBitBtn)
 then (Component as TBitBtn).Cursor:=TCursor(PointerToPtrInt(Custom));
 if (Component is TSpeedButton)
 then (Component as TSpeedButton).Cursor:=TCursor(PointerToPtrInt(Custom));
end;

procedure SetAllButtonsCursor(Form:TForm; Cursor:TCursor);
begin
 if Form is TForm then ForEachComponent(Form,SetButtonCursor,PtrIntToPointer(Cursor));
end;

procedure RecordComboBoxHistory(aComboBox:TComboBox; HistoryLength:Integer);
var i,j:Integer; s:LongString;
begin
 if aComboBox is TComboBox then
 with aComboBox do begin
  s:=Text;
  if IsEmptyStr(s) then Exit;
  j:=-1;
  for i:=0 to Items.Count-1 do if Items[i]=s then begin
   j:=i;
   break;
  end;
  if j>=0 then Items.Delete(j);
  Items.Insert(0,s);
  while Items.Count>max(HistoryLength,0) do Items.Delete(Items.Count-1);
  Text:=s;
 end;
end;

procedure OpenDialogTypeChangeStdExecute(OpenDialog:TOpenDialog);
var Ext:LongString;
begin
 Ext:=ExtractFilterExt(OpenDialog.Filter,OpenDialog.FilterIndex);
 Ext:=TrimLeadChars(Ext,['.',' ']);
 if IsEmptyStr(Ext) or IsWildCard(Ext) then Ext:='';
 OpenDialog.DefaultExt:=Ext;
end;

procedure OpenDialogSelectType(OpenDialog:TOpenDialog; const FileName:LongString; SetInitialDir:Boolean=True);
var T:TText; i:Integer;
begin
 if OpenDialog is TOpenDialog then
 try
  OpenDialog.FilterIndex:=1;
  OpenDialog.DefaultExt:='';
  T:=NewText;
  try
   T.Text:=StringReplace(OpenDialog.Filter,'|',EOL,[rfReplaceAll]);
   for i:=1 to T.Count div 2 do begin
    if WordIndex(UnifyAlias(ExtractFileExt(FileName)),UnifyAlias(T[i*2-1]),[' ',#9,'*',';'])>0 then begin
     OpenDialog.DefaultExt:=LowerCase(TrimLeadChars(UnifyAlias(ExtractFileExt(FileName)),['.',' ']));
     OpenDialog.FilterIndex:=i;
     Break;
    end;
    if UnifyAlias(T[i*2-1])='*.*' then begin
     OpenDialog.FilterIndex:=i;
     Break;
    end;
   end;
   if SetInitialDir then begin
    if IsNonEmptyStr(ExtractFilePath(FileName)) then
    if DirExists(ExtractFilePath(FileName)) then OpenDialog.InitialDir:=ExtractFilePath(UnifyFileAlias(FileName));
    if IsEmptyStr(OpenDialog.InitialDir) then OpenDialog.InitialDir:=HomeDir;
   end;
  finally
   Kill(T);
  end;
 except
  on E:Exception do BugReport(E,nil,'OpenDialogSelectType');
 end;
end;

const
 efdData: record
  pid:TPid; wClass,wTitle:LongString; Pos:TPoint;
 end = (pid:0; wClass:''; wTitle:''; Pos:(x:0;y:0));

procedure efdPosUpdate;
var wnd:HWND; R:TRect; arg,sg,sx,sy,sw,sh:LongString; gravity:Integer;
begin
 try
  with efdData do
  if (Pid>0) and ((wClass<>'') or (wTitle<>'')) and ((Pos.x<>Low(Integer)) or (Pos.y<>Low(Integer))) then begin
   wnd:=wmctrl.FindWindow(Pid,wClass,wTitle);
   if not wmctrl.IsWindow(wnd) then Exit;
   R:=wmctrl.WindowBounds(wnd);
   if R.IsEmpty then Exit;
   gravity:=0;
   sg:=IntToStr(gravity);
   sx:=IntToStr(Pos.x);
   sy:=IntToStr(Pos.y);
   sw:=IntToStr(R.Width);
   sh:=IntToStr(R.Height);
   if (Pos.x=Low(Integer)) then sx:='*';
   if (Pos.y=Low(Integer)) then sy:='*';
   arg:=Format('%s,%s,%s,%s,%s',[sg,sx,sy,sw,sh]);
   if not wmctrl.MoveResizeWindow(wnd,arg) then Exit;
   Pid:=0; Pos:=Point(0,0); wClass:=''; wTitle:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'efdPosUpdate');
 end;
end;

procedure efdTimer;
begin
 if (efdData.pid=0)
 then Tick55Actions.Remove(efdTimer)
 else efdPosUpdate;
end;

function ExecuteFileDialog(const Dialog:TFileDialog; const Params:LongString=''):Boolean;
var Dir,BN,Ext:LongString;
begin
 Result:=false;
 if Assigned(Dialog) then
 try
  Dir:=ExtractFileDir(Dialog.FileName);
  BN:=ExtractBaseName(Dialog.FileName);
  Ext:=ExtractFileExt(Dialog.FileName);
  if DirExists(Dir) then Dialog.InitialDir:=Dir;
  if IsNonEmptyStr(Ext) and not IsWildCard(Ext) then Dialog.DefaultExt:=Ext;
  if IsWildCard(BN+Ext) then Dialog.FileName:='';
  with efdData do
  try
   pid:=0; wClass:=''; wTitle:='';
   if IsNonEmptyStr(Params) then Tick55Actions.Add(efdTimer);
   wClass:=IfThen(IsWindows,swc_DialogBox,wmctrl.IcccmClass);
   pid:=GetCurrentProcessId; wTitle:=Dialog.Title;
   Pos:=MessageDlgApplyParamsPos(Params);
   Result:=Dialog.Execute;
  finally
   Tick55Actions.Remove(efdTimer);
   pid:=0; wClass:=''; wTitle:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'ExecuteFileDialog');
 end;
end;

procedure LocateFormToCenterOfScreen(Form:TForm);
begin
 if Form is TForm then begin
  Form.Left := Screen.DesktopLeft + ((Screen.DesktopWidth  - Form.Width)  div 2);
  Form.Top  := Screen.DesktopTop  + ((Screen.DesktopHeight - Form.Height) div 2);
 end;
end;

procedure LocateFormToCenterOfMouse(Form:TForm);
begin
 if Form is TForm then begin
  Form.Top  := max(Screen.DesktopTop,  min(Mouse.CursorPos.Y-(Form.Height div 2),Screen.DesktopHeight-Form.Height));
  Form.Left := max(Screen.DesktopLeft, min(Mouse.CursorPos.X-(Form.Width div 2),Screen.DesktopWidth-Form.Width));
 end;
end;

function StdDateTimeStr(ms:Double=0; mode:Integer=0):LongString;
begin
 if (ms=0) then ms:=mSecNow;
 Result:=_crw_rtc.StdDateTimeStr(ms,mode);
end;

function StdDateTimePrompt(ms:Double=0; Prompt:PChar=nil; mode:Integer=0):LongString;
begin
 if (ms=0) then ms:=mSecNow;
 if (Prompt=nil) then Prompt:=' => ';
 Result:=_crw_rtc.StdDateTimeStr(ms,mode)+Prompt;
end;

function HasPrinters;
begin
 Result:=(Printer.Printers.Count>0);
end;

function HasPrintersDialog(Mode:Integer=0; const Params:LongString=''):Boolean;
var pn,np:Integer;
begin
 Result:=NoProblem(HasPrinters,RusEng('Нет доступных принтеров!','No printers available!'));
 if Result and (Printer.Printers.Count>1) then
 try
  if HasFlags(Mode,1) then begin
   pn:=Max(0,Printer.PrinterIndex);
   np:=ListBoxMenu(RusEng('Выбор Принтера','Choose Printer'),
                  RusEng('Укажите Принтер для печати','Select Printer for printing'),
                  Printers.Printer.Printers.Text,pn,Params);
   if (np<>pn) then begin
    if Printer.Printing
    then Echo('Нельзя выбрать Принтер во время печати.',
              'Could not select Printer while printing.')
    else Printer.PrinterIndex:=np;
    Echo(RusEng('Выбран Принтер: ','Selected Printer: ')+Printer.PrinterName);
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'HasPrintersDialog');
 end;
end;

function GetPrinterPageCaptionAsText:LongString;
var cap:LongString;
begin
 cap:=RusEng('Параметры страницы для Принтера ','Page settings of Printer ')+Printer.PrinterName;
 Result:=Trim(Cap);
end;

function GetPrinterPageSettingsAsText:LongString;
var tab:LongString;
begin
 with PrinterPageSettings do
 tab:=RusEng('Отступ слева,  см | ','Left   Inner, cm | ')+Format('%1.3f',[Indent.a.x])+EOL
     +RusEng('Отступ сверху, см | ','Top    Inner, cm | ')+Format('%1.3f',[Indent.a.y])+EOL
     +RusEng('Отступ справа, см | ','Right  Inner, cm | ')+Format('%1.3f',[Indent.b.x])+EOL
     +RusEng('Отступ снизу,  см | ','Bottom Inner, cm | ')+Format('%1.3f',[Indent.b.y])+EOL
     +RusEng('Фактор размера    | ','Scale factor     | ')+Format('%1.3f',[Scale])+EOL
     +RusEng('Подгонять размер  | ','Adjust big size  | ')+Format('%d',[Adjust])+EOL;
 Result:=tab;
end;

function ExecutePrinterPageSettingsDialog(const Params:LongString):TModalResult;
var cap,tab,s:LongString;
begin
 cap:=GetPrinterPageCaptionAsText;
 tab:=GetPrinterPageSettingsAsText;
 Result:=ExecuteFormStringGridEditDialog(cap,tab,'|',0,1,false,Params);
 if (Result=mrOk) then with PrinterPageSettings do begin
  s:=ExtractWord(2,ExtractWord(1,tab,EolnDelims),['|']);
  Indent.a.x:=StrToFloatDef(s,Indent.a.x);
  s:=ExtractWord(2,ExtractWord(2,tab,EolnDelims),['|']);
  Indent.a.y:=StrToFloatDef(s,Indent.a.y);
  s:=ExtractWord(2,ExtractWord(3,tab,EolnDelims),['|']);
  Indent.b.x:=StrToFloatDef(s,Indent.b.x);
  s:=ExtractWord(2,ExtractWord(4,tab,EolnDelims),['|']);
  Indent.b.y:=StrToFloatDef(s,Indent.b.y);
  s:=ExtractWord(2,ExtractWord(5,tab,EolnDelims),['|']);
  Scale:=StrToFloatDef(s,Scale);
  s:=ExtractWord(2,ExtractWord(6,tab,EolnDelims),['|']);
  Adjust:=StrToIntDef(s,Adjust);
 end;
end;

 // Mode=1:Echo,2:$PRINTER;4:$LP_PAGE_INDENTS
function ReportPrinterSettings(Mode:Integer):LongString;
var ppn:LongString;
begin
 Result:=GetPrinterPageCaptionAsText+EOL+GetPrinterPageSettingsAsText;
 if HasFlags(Mode,2) then begin
  ppn:=Trim(Printer.PrinterName);
  if IsNonEmptyStr(ppn) then begin
   if SetEnvironPrinter(1,ppn) then begin
    if IsUnix then Result:=Result+'$PRINTER = '+ppn+EOL;
    if IsWindows then Result:=Result+'%PRINTER% = '+ppn+EOL;
   end;
  end;
 end;
 if HasFlags(Mode,1) then Echo(Result);
end;

function SetEnvironPrinter(Mode:Integer; aPrinter:LongString=''):Boolean;
begin
 Result:=false;
 if HasFlags(Mode,1) or (GetEnv('PRINTER')='') then
 try
  if (aPrinter='') then aPrinter:=Printer.PrinterName;
  if (aPrinter<>'') then Result:=SetEnv('PRINTER',aPrinter);
 except
  on E:Exception do BugReport(E,nil,'SetEnvironPrinter');
 end;
end;

function SetEnvironLpPageIndents:Boolean;
var s:LongString;
begin
 with PrinterPageSettings,Indent do
 s:=Format('%1.3f %1.3f %1.3f %1.3f %1.3f %d',[a.x,a.y,b.x,b.y,Scale,Adjust]);
 Result:=SetEnv('LP_PAGE_INDENTS',s);
end;

function ExternalTextFilePrint(const FileName:LongString):Boolean;
var exe,cmd:LongString; n:Integer;
begin
 Result:=false; exe:='';
 if FileExists(FileName) then
 if ReadIniFilePath(SysIniFile,SectSystem,'ScriptForTextFilePrint',HomeDir,exe) then
 try
  exe:=UnifyFileAlias(AdaptExeFileName(exe));
  cmd:=AnsiQuotedIfNeed(exe)+' '+AnsiQuotedIfNeed(FileName);
  n:=SendToMainConsole('@run '+IfThen(IsWindows,'-sw7 ','')+cmd+EOL);
  Result:=(n>0);
 except
  on E:Exception do BugReport(E,nil,'ExternalTextFilePrint');
 end;
end;

function ExternalTextLinesPrint(const aTextLines:LongString):Boolean;
var FileName:LongString; n:SizeInt;
begin
 Result:=false; if (aTextLines='') then Exit;
 FileName:=CreateTempFile('lpr_.tmp',GetEnv('CRW_DAQ_SYS_TMP_DIR'));
 n:=WriteBufferToFile(FileName,aTextLines); if (n<=0) then Exit;
 Result:=ExternalTextFilePrint(FileName);
 if not Result then FileErase(FileName);
end;

 // 1 in = 2.54 cm
function CentimeterToInch(aCm:Double):Double;
begin
 Result:=aCm/2.54;
end;
function InchToCentimeter(aIn:Double):Double;
begin
 Result:=aIn*2.54;
end;

function GetImageOfControl(aControl:TControl):TBitmap;
var aRect:TRect; wc:TWinControl;
begin
 Result:=nil;
 if Assigned(aControl) then
 try
  if (aControl is TForm) then begin
   Result:=TForm(aControl).GetFormImage;
   Exit;
  end;
  if (aControl is TWinControl) then begin
   wc:=TWinControl(aControl);
   Result:=TBitmap.Create;
   try
    aRect:=Default(TRect);
    Result.SetSize(wc.ClientWidth,wc.ClientHeight);
    LCLIntf.GetWindowRect(wc.Handle,aRect);
    with wc.ClientOrigin do
    wc.PaintTo(Result.Canvas,aRect.Left-X,aRect.Top-Y);
   except
    FreeAndNil(Result);
    raise;
   end;
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetImageOfControl');
 end;
end;

function SubSystemTurnOn(const SubSystemSectionName:LongString):Boolean;
var IsTurnOn:Boolean;
begin
 IsTurnOn:=false;
 Result:=ReadIniFileBoolean(SysIniFile, SubSystemSectionName, 'TurnOn%b',
                            IsTurnOn) and IsTurnOn;
end;

function SubSystemIniFile(const SubSystemSectionName:LongString):LongString;
var Path:LongString;
begin
 Path:='';
 ReadIniFilePath(SysIniFile, SubSystemSectionName, 'IniFile',
                 ExtractFilePath(SysIniFile), Path);
 Result:=Path;
end;

function SubSystemDataPath(const SubSystemSectionName:LongString):LongString;
var Path:LongString;
begin
 Path:='';
 ReadIniFilePath(SysIniFile, SubSystemSectionName, 'DataPath',
                 ExtractFilePath(SysIniFile), Path);
 Result:=Path;
 if IsNonEmptyStr(Result) then
 if not FileExists(Result,faDirectory) then MkDir(Result);
end;

function GetBackUpName(const FileName,NewExtension:LongString):LongString;
begin
 if IsNonEmptyStr(TempDir)
 then Result:=ForceExtension(AddBackSlash(TempDir)+ExtractFileName(FileName), NewExtension)
 else Result:=ForceExtension(FileName, NewExtension);
end;

function  IsControlContainsClientPos(Control:TControl; const ClientPos:TPoint):Boolean;
begin
 if Control is TControl
 then Result:=RectContainsPoint(Rect2I(Control.ClientRect),Point2I(ClientPos))
 else Result:=false;
end;

function IsControlContainsScreenPos(Control:TControl; const ScreenPos:TPoint):Boolean;
begin
 if Control is TControl
 then Result:=RectContainsPoint(Rect2I(Control.ClientRect),Point2I(Control.ScreenToClient(ScreenPos)))
 else Result:=false;
end;

function IsMainThread:Boolean;
begin
 Result:=(GetCurrentThreadID = MainThreadID);
end;

function IsModalFormActive:Boolean;
begin
 Result:=false;
 try
  Result:=(Screen is TScreen) and
          (Screen.ActiveCustomForm is TCustomForm) and
          (fsModal in Screen.ActiveCustomForm.FormState);
 except
  on E:Exception do BugReport(E,nil,'IsModalFormActive');
 end;
end;

procedure NumberOfModalFormsNowCallback(Form:TForm; Index:Integer; var Terminate:Boolean; Custom:Pointer);
begin
 if fsModal in Form.FormState then Inc(Cardinal(Custom^));
end;

function NumberOfModalFormsNow:Cardinal;
begin
 Result:=0;
 ForEachForm(NumberOfModalFormsNowCallback,@Result);
end;

function  GetFormModalResult(Form:TForm):TModalResult;
begin
 if Assigned(Form) then Result:=Form.ModalResult else Result:=0;
end;

function CanShowModal(aForm:TForm; aLimit:Cardinal):Boolean;
begin
 Result:=false;
 if aLimit=High(Cardinal) then aLimit:=DefaultCanShowModalLimit;
 try
  if not IsMainThread then Exit;
  if NumberOfModalFormsNow>aLimit then Exit;
  if aLimit=High(Cardinal) then if IsModalFormActive then Exit;
  if Assigned(aForm) then begin
   if aForm.Visible then Exit;
   if not aForm.Enabled then Exit;
   if fsModal in aForm.FormState then Exit;
   if aForm.FormStyle = fsMDIChild then Exit;
  end;
  Result:=true;
 except
  on E:Exception do BugReport(E,nil,'CanShowModal');
 end;
end;

{$IFDEF WINDOWS}
function IsAdministrator(aError:PParsingBuffer=nil):Boolean;
const
 DOMAIN_ALIAS_RID_ADMINS      = $00000220;
 SECURITY_BUILTIN_DOMAIN_RID  = $00000020;
 SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
var
 I         : Integer;
 Count     : DWORD;
 Token     : THandle;
 psidAdmin : Pointer;
 TokenInfo : PTokenGroups;
 HaveToken : Boolean;
begin
 Result:=False;
 if Win32Platform<VER_PLATFORM_WIN32_NT then Result:=True else
 try
  psidAdmin:=nil;
  TokenInfo:=nil;
  HaveToken:=False;
  if SupportsCheckTokenMembership then Result:=IsUserAnAdmin else
  try
   Token:=0; Count:=0;
   HaveToken:=OpenThreadToken(GetCurrentThread, TOKEN_QUERY,True,Token);
   if (not HaveToken) and (GetLastError=ERROR_NO_TOKEN)
   then HaveToken:=OpenProcessToken(GetCurrentProcess,TOKEN_QUERY,Token);
   if HaveToken then begin
    Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY,2,
     SECURITY_BUILTIN_DOMAIN_RID,DOMAIN_ALIAS_RID_ADMINS,0,0,0,0,0,0,psidAdmin));
    if GetTokenInformation(Token, TokenGroups,nil,0,Count)
    or (GetLastError<>ERROR_INSUFFICIENT_BUFFER)
    then RaiseLastWin32Error;
    TokenInfo := PTokenGroups(AllocMem(Count));
    Win32Check(GetTokenInformation(Token,TokenGroups,TokenInfo,Count,Count));
    for I:=0 to TokenInfo^.GroupCount-1 do begin
     Result:=EqualSid(psidAdmin,TokenInfo^.Groups[I].Sid);
     if Result then Break;
    end;
   end;
  finally
   if TokenInfo <> nil then FreeMem(TokenInfo);
   if HaveToken then CloseHandle(Token);
   if psidAdmin <> nil then FreeSid(psidAdmin);
  end;
 except
  on E:Exception do if Assigned(aError) then StrCopyBuff(aError^,E.Message);
 end;
end;
{$ENDIF ~WINDOWS}

{$IFDEF UNIX}
function IsAdministrator(aError:PParsingBuffer=nil):Boolean;
begin
 Result:=IsIamRoot;
end;
{$ENDIF ~UNIX}

function GetRootKeyByName(const Name:LongString):HKey;
begin
 if SameText(Name,'HKEY_LOCAL_MACHINE')  or SameText(Name,'HKLM') then Result:=HKEY_LOCAL_MACHINE  else
 if SameText(Name,'HKEY_CURRENT_USER')   or SameText(Name,'HKCU') then Result:=HKEY_CURRENT_USER   else
 if SameText(Name,'HKEY_CLASSES_ROOT')   or SameText(Name,'HKCR') then Result:=HKEY_CLASSES_ROOT   else
 if SameText(Name,'HKEY_USERS')          or SameText(Name,'HKU')  then Result:=HKEY_USERS          else
 if SameText(Name,'HKEY_CURRENT_CONFIG') or SameText(Name,'HKCC') then Result:=HKEY_CURRENT_CONFIG else
 Result:=0;
end;

function GetDieselPascalExe:LongString;
begin
 Result:='';
 if IsWindows then Result:=GetSystemAssocExe('.lm9');
 if IsUnix then Result:=Trim(FileSearch('CrossMachine',GetEnv('PATH'),false));
end;

function HasDieselPascalExe:Boolean;
begin
 Result:=false;
 if IsWindows then Result:=HasSystemAssocExe('.lm9');
 if IsUnix then Result:=(GetDieselPascalExe<>'');
end;

function LanguageInfoStr(id:LCID):LongString;
var i:Integer; ltag,lang,name:LongString;
begin
 Result:=Format('$%X',[id]); if (id<=0) then Exit;
 ltag:=MsLcidMapping.KeyedParams[IntToStr(id)];
 lang:=ExtractWord(1,ltag,ScanSpaces+['-','_']);
 i:=iso639.IndexOf(lang); if IsEmptyStr(ltag) then Exit;
 if (i>=0) then name:=iso639.Items[i].Name else name:='';
 Result:=Format('%s,%s,%s',[Result,ltag,name]);
end;

function GetFormWmDescription(Form:TForm):LongString;
begin
 if (Form is TMasterForm)
 then Result:=TMasterForm(Form).WmDescription
 else Result:='';
end;

procedure EchoBriefSystemInfo;
begin
 EchoBriefSystemInfoEx(false);
end;

procedure EchoBriefSystemInfoEx(verbose:Boolean);
const Rights : array[Boolean] of PChar=('user','root');
var s1,s2:LongString; verb,i,j,m1,m2:Integer; pid:TPid; prc:DWORD; aff:QWORD;
var hs:THeapStatus; fhs:TFpcHeapStatus;
begin
 try
  if verbose then verb:=1 else verb:=0;
  Echo(RusEng('Краткая системная информация:','Brief system information:'));
  //
  // OS info
  //
  Echo(Format(' Computer   : %s',[ComputerName]));
  Echo(Format(' OS version : %s',[GetOSVersionString]));
  Echo(Format(' SystemRoot : %s',[SystemRootDir]));
  Echo(Format(' ComSpec    : %s',[GetComSpec]));
  Echo(Format(' CrwRoot    : %s',[HomeDir]));
  Echo(Format(' CurrentDir : %s',[GetCurrDir]));
  //
  // Log and Debug file(s)
  //
  if IsNonEmptyStr(TempDir)
  then Echo(Format(' TempDir    : %s',[TempDir]));
  if IsNonEmptyStr(ResourceLeakageLogFile)
  then Echo(Format(' LeakageLog : %s',[ResourceLeakageLogFile]));
  for i:=Low(Byte) to High(Byte) do begin
   s1:=DebugOutGetFile(i);
   if IsNonEmptyStr(s1) then begin
    s2:=Format('[%d]',[i]);
    Echo(Format(' Debug%-5s : %s',[s2,s1]));
   end;
  end;
  //
  // RAM info
  //
  Echo(Format(' RAM        : %d MB total, %d MB free, %d MB = %d %% used',
      [ReadProcMemInfo('MemTotal') shr 20,
       (ReadProcMemInfo('MemAvailable')+ReadProcMemInfo('MemFree')) shr 20,
       ReadProcMemInfo('MemUsed') shr 20,
       ReadProcMemInfo('MemLoad') ]));
  Echo(Format(' SWAP       : %d MB total, %d MB free, %d MB = %d %% used',
      [ReadProcMemInfo('SwapTotal') shr 20,
       ReadProcMemInfo('SwapFree') shr 20,
       ReadProcMemInfo('SwapUsed') shr 20,
       ReadProcMemInfo('SwapLoad') ]));
  Echo(Format(' STACK      : %u KB',
      [(StackLength shr 10)]));
  hs:=GetHeapStatus;
  Echo(Format(' MEM HEAP   : %u/%u/%u/%u/%u MB - aspc/alloc/free/ovh/com',
      [(hs.TotalAddrSpace shr 20), (hs.TotalAllocated shr 20),
       (hs.TotalFree shr 20), (hs.Overhead shr 20),
       (hs.TotalCommitted shr 20) ]));
  fhs:=GetFpcHeapStatus;
  Echo(Format(' FPC HEAP   : %u/%u/%u/%u/%u MB - size/used/free/peak/max',
      [(fhs.CurrHeapSize shr 20), (fhs.CurrHeapUsed shr 20),
       (fhs.CurrHeapFree shr 20), (fhs.MaxHeapUsed shr 20),
       (fhs.MaxHeapSize shr 20) ]));
  //
  // Model info
  //
  s1:=GetSystemModelInfo;
  if (Length(s1)>0) then
  Echo(Format(' Model      : %s',[s1]));
  //
  // System info
  //
  s1:=GetSystemVersionString;
  if (Length(s1)>0) then
  Echo(Format(' System     : %s',[s1]));
  s1:=GetFpcTargetPlatform;
  s1:=s1+' FPC '+GetFpcVersion;
  s1:=s1+' LCL '+GetLclVersion;
  s1:=s1+' WidgetSet '+GetWidgetSetName;
  Echo(Format(' Platform   : %s',[s1]));
  //
  // Shells
  //
  m1:=glosh_Default or glosh_DelPath;
  m2:=glosh_Default or glosh_DelPath or glosh_IfExist;
  s1:=StringReplace(Trim(GetListOfShells(m1)),EOL,', ',[rfReplaceAll]);
  s2:=StringReplace(Trim(GetListOfShells(m2)),EOL,', ',[rfReplaceAll]);
  if (Length(s1)>0) then
  Echo(Format(' Shells     : Enabled: %s; Exist: %s.',[s1,s2]));
  //
  // VideoBios info
  //
  s1:=GetVideoBiosInfo;
  if (Length(s1)>0) then
  Echo(Format(' VideoBios  : %s',[s1]));
  //
  // Video system info
  //
  s1:=wmctrl.WindowManagerName;
  if (Length(s1)>0) then
  Echo(Format(' WinMan     : %s',[s1]));
  s1:=wmctrl.XLibInfo;
  if (Length(s1)>0) then
  Echo(Format(' XServer    : %s',[s1]));
  s1:=wmctrl.DisplayInfo;
  if (Length(s1)>0) then
  Echo(Format(' Display    : %s',[s1]));
  s1:=GetFormWmDescription(ApplicationMainForm);
  if (Length(s1)>0) then
  Echo(Format(' MainForm   : %s',[s1]));
  //
  // SystemBios info
  //
  s1:=GetSystemBiosInfo;
  if (Length(s1)>0) then
  Echo(Format(' SystemBios : %s',[s1]));
  //
  // CPU info
  //
  if (cpu_count>1) then begin
   j:=0; s1:='';
   aff:=GetProcessAffinityMask;
   for i:=0 to cpu_count-1 do
   if HasFlags(aff shr i,1) then begin
    if j>0
    then s1:=Format('%s,%d',[s1,i])
    else s1:=Format('%d',[i]);
    inc(j);
   end;
   s1:=Format('(%s)',[s1]);
  end else s1:='(0)';
  Echo(Format(' CPU Info   : Count:%d, List:%s, Arch:%s, Ident:%s',
      [cpu_count,s1,GetCpuVersionInfo(0,'Architecture'),
      GetCpuVersionInfo(0,'Identifier')]));
  for i:=0 to cpu_count-1 do begin
   s1:=Trim(GetCpuVersionInfo(i,'ProcessorNameString')); if Length(s1)=0 then continue;
   s2:=Trim(GetCpuVersionInfo(i,'VendorIdentifier'));    if Length(s2)>0 then s1:=Format('%s, %s',[s1,s2]);
   s2:=Trim(GetCpuVersionInfo(i,'Identifier'));          if Length(s2)>0 then s1:=Format('%s, %s',[s1,s2]);
   Echo(Format(' CPU %-2d     : %s',[i,s1]));
  end;
  if (CpuFrequencyMHz>0) or (GetCpuFreqMHzNominal>0) then
  Echo(Format(' CPU Freq   : %1.3f MHz (eastimated), %d MHz (nominal)',[CpuFrequencyMHz,GetCpuFreqMHzNominal]));
  //
  // FPU info
  //
  Echo(Format(' FPU Modes  : %s',[GetFpuModesAsText(FpuGetCurrentModes)]));
  //
  // Clock Resolution info
  //
  Echo(Format(' ClockRes   : Std=%1.3f,Max=%1.3f,Min=%1.3f,Act=%1.3f ms',
             [GetClockResolution(cr_StdRes)/FileTimesPerMSec,
              GetClockResolution(cr_MinRes)/FileTimesPerMSec,
              GetClockResolution(cr_MaxRes)/FileTimesPerMSec,
              GetClockResolution(cr_ActRes)/FileTimesPerMSec]));
  //
  // COM ports info
  //
  s1:=EnumComPorts(',');
  if IsEmptyStr(s1) then s1:='NONE';
  Echo(Format(' COM ports  : %s',[s1]));
  //
  //  Language information.
  //
  s1:=posix_getlocale;
  s2:=GetSystemDefaultLocaleNameStr;
  Echo(Format(' Locale     : %s, $%4.4x, %s',[s1,LocaleToMsLcid(s1),s2]));
  Echo(Format(' CodePage   : ANSI CP%d, OEM CP%d.',[GetACP,GetOEMCP]));
  Echo(Format(' Language   : System=%s; User=%s.',[LanguageInfoStr(GetSystemDefaultUILanguage),LanguageInfoStr(GetUserDefaultUILanguage)]));
  Echo(Format(' LCID       : System=%s; User=%s.',[LanguageInfoStr(GetSystemDefaultLCID),LanguageInfoStr(GetUserDefaultLCID)]));
  //
  // Process info
  //
  Echo(Format(' User       : %s',[GetListOfUserMembership(',',true)]));
  Echo(Format(' Login      : %s@%s on %s, as %s',[UserName,UserDomain(UserName,HostName),ComputerName,Rights[IsAdministrator]]));
  pid:=GetCurrentProcessID;
  prc:=ProcessPriorityToClass(GetProcessPriority);
  Echo(Format(' Process    : PID %u, with %s priority (%d)',[pid,GetPriorityClassName(prc),GetPriorityClassLevel(prc)]));
  if IsUnix then begin // File/Process capabilities
   Echo(Format(' EXE caps   : %s',[PsCap.read_exe_getcap]));
   Echo(Format(' PID caps   : %s',[PsCap.read_pid_getpcaps]));
   with PsCap.read_proc_pid_status_caps do
   Echo(Format(' i,e,p,b,a  : %x,%x,%x,%x,%x',[CapInh,CapEff,CapPrm,CapBnd,CapAmb]));
  end;
  Echo(Format(' Network    : %s %s %s',[HostName(verb),GetIPAddresses,GetMacAddresses]));
  Echo(Format(' CmdLine    : %s',[GetCommandLine]));
  //
  // ZeroMQ
  //
  if ZmqMan.ValidApi(True) then
  Echo(Format(' ZeroMQ     : %s',[ZmqMan.BriefInfo]));
  // IanaPorts
  Echo(Format(' IANA Ports : %s',[IanaMan.BriefStatInfo]));
 except
  on E:Exception do BugReport(E,nil,'EchoBriefSystemInfoEx');
 end;
end;

function GetSystemParamStr(const Category,ParamName:LongString):LongString;
 function GetSystemIdStr(const ParamName:LongString):LongString;
 begin
  Result:='';
  if IsSameText(ParamName,'FpcTargetPlatform') then Result:=GetFpcTargetPlatform     else
  if IsSameText(ParamName,'FpcTargetCPU')      then Result:=GetFpcTargetCPU          else
  if IsSameText(ParamName,'FpcTargetOS')       then Result:=GetFpcTargetOS           else
  if IsSameText(ParamName,'FpcVersion')        then Result:=GetFpcVersion            else
  if IsSameText(ParamName,'LclVersion')        then Result:=GetLclVersion            else
  if IsSameText(ParamName,'WidgetSet')         then Result:=GetWidgetSetName         else
  if IsSameText(ParamName,'SystemVersion')     then Result:=GetSystemVersionString   else
  if IsSameText(ParamName,'WindowManager')     then Result:=wmctrl.WindowManagerName else
  Result:='Unknown';
 end;
 function GetSystemOsStr(const ParamName:LongString):LongString;
 begin
  Result:='';
  if IsSameText(ParamName,'Platform') then begin
   if IsWindows then Result:='Windows' else
   if IsLinux   then Result:='Linux'   else
   if IsUnix    then Result:='Unix'    else
   Result:='Unknown';
  end else
  if IsSameText(ParamName,'Version') then Result:=GetOSVersionString else
  if IsSameText(ParamName,'SysRoot') then Result:=SystemRootDir      else
  if IsSameText(ParamName,'ComSpec') then Result:=GetComSpec         else
  if IsSameText(ParamName,'Shell')   then Result:=GetShell           else
  if IsSameText(ParamName,'Shells')  then Result:=GetListOfShells    else
  Result:='Unknown';
 end;
 function GetSystemRamStr(const ParamName:LongString):LongString;
 {$IFDEF WINDOWS}
 var ms:TMemoryStatus;
 {$ENDIF WINDOWS}
 begin
  Result:='';
  if IsSameText(ParamName,'MemTotal')      then Result:=IntToStr(ReadProcMemInfo('MemTotal'))     else
  if IsSameText(ParamName,'TotalPhys')     then Result:=IntToStr(ReadProcMemInfo('MemTotal'))     else
  if IsSameText(ParamName,'MemAvailable')  then Result:=IntToStr(ReadProcMemInfo('MemAvailable')) else
  if IsSameText(ParamName,'AvailPhys')     then Result:=IntToStr(ReadProcMemInfo('MemAvailable')) else
  if IsSameText(ParamName,'MemLoad')       then Result:=IntToStr(ReadProcMemInfo('MemLoad'))      else
  if IsSameText(ParamName,'MemoryLoad')    then Result:=IntToStr(ReadProcMemInfo('MemLoad'))      else
  if IsSameText(ParamName,'SwapTotal')     then Result:=IntToStr(ReadProcMemInfo('SwapTotal'))    else
  if IsSameText(ParamName,'TotalPageFile') then Result:=IntToStr(ReadProcMemInfo('SwapTotal'))    else
  if IsSameText(ParamName,'SwapFree')      then Result:=IntToStr(ReadProcMemInfo('SwapFree'))     else
  if IsSameText(ParamName,'AvailPageFile') then Result:=IntToStr(ReadProcMemInfo('SwapFree'))     else
  {$IFDEF WINDOWS}
  SafeFillChar(ms,sizeof(ms),0); ms.dwLength:=sizeof(ms); GlobalMemoryStatus(ms);
  if IsSameText(ParamName,'TotalVirtual')  then Result:=IntToStr(ms.dwTotalVirtual)  else
  if IsSameText(ParamName,'AvailVirtual')  then Result:=IntToStr(ms.dwAvailVirtual)  else
  {$ENDIF ~WINDOWS}
  Result:='';
 end;
 function GetSystemProcessStr(const ParamName:LongString):LongString;
 var pc,pe,pk,pu,tc,te,tk,tu:Int64; {$IFDEF WINDOWS}var hCnt:DWORD;{$ENDIF}
 begin
  Result:='';
  if IsSameText(ParamName,'Id')                  then Result:=IntToStr(GetCurrentProcessId) else
  if IsSameText(ParamName,'ParentId')            then Result:=IntToStr(GetParentProcessId)  else
  if IsSameText(ParamName,'ParentExe')           then Result:=GetParentProcessName          else
  if IsSameText(ParamName,'AllocMemSize')        then Result:=IntToStr(GetAllocMemSize)     else
  if IsSameText(ParamName,'AllocMemCount')       then Result:=IntToStr(GetAllocMemCount)    else
  {$IFDEF WINDOWS}
  if IsSameText(ParamName,'GdiObjectsQuota')     then Result:=IntToStr(GetGdiProcessHandleQuota)    else
  if IsSameText(ParamName,'UserObjectsQuota')    then Result:=IntToStr(GetUserProcessHandleQuota)   else
  if IsSameText(ParamName,'KernelObjectsQuota')  then Result:=IntToStr(GetKernelProcessHandleQuota) else
  if IsSameText(ParamName,'GdiObjects')          then Result:=IntToStr(GetGuiResources(GetCurrentProcess,GR_GDIOBJECTS))       else
  if IsSameText(ParamName,'UserObjects')         then Result:=IntToStr(GetGuiResources(GetCurrentProcess,GR_USEROBJECTS))      else
  if IsSameText(ParamName,'GdiObjects_Peak')     then Result:=IntToStr(GetGuiResources(GetCurrentProcess,GR_GDIOBJECTS_PEAK))  else
  if IsSameText(ParamName,'UserObjects_Peak')    then Result:=IntToStr(GetGuiResources(GetCurrentProcess,GR_USEROBJECTS_PEAK)) else
  if IsSameText(ParamName,'KernelObjects') then begin
   hCnt:=0;
   if GetProcessHandleCount(GetCurrentProcess,hCnt)
   then Result:=IntToStr(hCnt) else Result:='0';
  end else
  if IsSameText(ParamName,'Times') then begin
   pc:=0;pe:=0;pk:=0;pu:=0;tc:=0;te:=0;tk:=0;tu:=0;
   if GetProcessTimes(GetCurrentProcess,TFileTime(pc),TFileTime(pe),TFileTime(pk),TFileTime(pu))
   and GetThreadTimes(GetCurrentThread, TFileTime(tc),TFileTime(te),TFileTime(tk),TFileTime(tu))
   then Result:=Format('%d,%d,%d,%d,%d,%d,%d,%d',[pc,pe,pk,pu,tc,te,tk,tu]);
  end else
  {$ENDIF ~WINDOWS}
  {$IFDEF UNIX}
  if IsSameText(ParamName,'Times') then begin
   pc:=GetProcessStartTimeAsFileTime;
   pe:=0;pk:=0;pu:=0;tc:=0;te:=0;tk:=0;tu:=0;
   if GetProcessTimesAsFileTime(pk,pu) and GetThreadTimesAsFileTime(tk,tu)
   then Result:=Format('%d,%d,%d,%d,%d,%d,%d,%d',[pc,pe,pk,pu,tc,te,tk,tu]);
  end else
  {$ENDIF ~UNIX}
  Result:='';
 end;
 function GetSystemMetricsStr(const ParamName:LongString):LongString;
 var Code:Integer;
  function GetSystemMetricsName(Code:Integer):LongString;
  begin
   case Code of
    SM_CXSCREEN          : Result:='SM_CXSCREEN';
    SM_CYSCREEN          : Result:='SM_CYSCREEN';
    SM_CXVSCROLL         : Result:='SM_CXVSCROLL';
    SM_CYHSCROLL         : Result:='SM_CYHSCROLL';
    SM_CYCAPTION         : Result:='SM_CYCAPTION';
    SM_CXBORDER          : Result:='SM_CXBORDER';
    SM_CYBORDER          : Result:='SM_CYBORDER';
    SM_CXDLGFRAME        : Result:='SM_CXDLGFRAME';
    SM_CYDLGFRAME        : Result:='SM_CYDLGFRAME';
    SM_CYVTHUMB          : Result:='SM_CYVTHUMB';
    SM_CXHTHUMB          : Result:='SM_CXHTHUMB';
    SM_CXICON            : Result:='SM_CXICON';
    SM_CYICON            : Result:='SM_CYICON';
    SM_CXCURSOR          : Result:='SM_CXCURSOR';
    SM_CYCURSOR          : Result:='SM_CYCURSOR';
    SM_CYMENU            : Result:='SM_CYMENU';
    SM_CXFULLSCREEN      : Result:='SM_CXFULLSCREEN';
    SM_CYFULLSCREEN      : Result:='SM_CYFULLSCREEN';
    SM_CYKANJIWINDOW     : Result:='SM_CYKANJIWINDOW';
    SM_MOUSEPRESENT      : Result:='SM_MOUSEPRESENT';
    SM_CYVSCROLL         : Result:='SM_CYVSCROLL';
    SM_CXHSCROLL         : Result:='SM_CXHSCROLL';
    SM_DEBUG             : Result:='SM_DEBUG';
    SM_SWAPBUTTON        : Result:='SM_SWAPBUTTON';
    SM_RESERVED1         : Result:='SM_RESERVED1';
    SM_RESERVED2         : Result:='SM_RESERVED2';
    SM_RESERVED3         : Result:='SM_RESERVED3';
    SM_RESERVED4         : Result:='SM_RESERVED4';
    SM_CXMIN             : Result:='SM_CXMIN';
    SM_CYMIN             : Result:='SM_CYMIN';
    SM_CXSIZE            : Result:='SM_CXSIZE';
    SM_CYSIZE            : Result:='SM_CYSIZE';
    SM_CXFRAME           : Result:='SM_CXFRAME';
    SM_CYFRAME           : Result:='SM_CYFRAME';
    SM_CXMINTRACK        : Result:='SM_CXMINTRACK';
    SM_CYMINTRACK        : Result:='SM_CYMINTRACK';
    SM_CXDOUBLECLK       : Result:='SM_CXDOUBLECLK';
    SM_CYDOUBLECLK       : Result:='SM_CYDOUBLECLK';
    SM_CXICONSPACING     : Result:='SM_CXICONSPACING';
    SM_CYICONSPACING     : Result:='SM_CYICONSPACING';
    SM_MENUDROPALIGNMENT : Result:='SM_MENUDROPALIGNMENT';
    SM_PENWINDOWS        : Result:='SM_PENWINDOWS';
    SM_DBCSENABLED       : Result:='SM_DBCSENABLED';
    SM_CMOUSEBUTTONS     : Result:='SM_CMOUSEBUTTONS';
    SM_SECURE            : Result:='SM_SECURE';
    SM_CXEDGE            : Result:='SM_CXEDGE';
    SM_CYEDGE            : Result:='SM_CYEDGE';
    SM_CXMINSPACING      : Result:='SM_CXMINSPACING';
    SM_CYMINSPACING      : Result:='SM_CYMINSPACING';
    SM_CXSMICON          : Result:='SM_CXSMICON';
    SM_CYSMICON          : Result:='SM_CYSMICON';
    SM_CYSMCAPTION       : Result:='SM_CYSMCAPTION';
    SM_CXSMSIZE          : Result:='SM_CXSMSIZE';
    SM_CYSMSIZE          : Result:='SM_CYSMSIZE';
    SM_CXMENUSIZE        : Result:='SM_CXMENUSIZE';
    SM_CYMENUSIZE        : Result:='SM_CYMENUSIZE';
    SM_ARRANGE           : Result:='SM_ARRANGE';
    SM_CXMINIMIZED       : Result:='SM_CXMINIMIZED';
    SM_CYMINIMIZED       : Result:='SM_CYMINIMIZED';
    SM_CXMAXTRACK        : Result:='SM_CXMAXTRACK';
    SM_CYMAXTRACK        : Result:='SM_CYMAXTRACK';
    SM_CXMAXIMIZED       : Result:='SM_CXMAXIMIZED';
    SM_CYMAXIMIZED       : Result:='SM_CYMAXIMIZED';
    SM_NETWORK           : Result:='SM_NETWORK';
    SM_CLEANBOOT         : Result:='SM_CLEANBOOT';
    SM_CXDRAG            : Result:='SM_CXDRAG';
    SM_CYDRAG            : Result:='SM_CYDRAG';
    SM_SHOWSOUNDS        : Result:='SM_SHOWSOUNDS';
    SM_CXMENUCHECK       : Result:='SM_CXMENUCHECK';
    SM_CYMENUCHECK       : Result:='SM_CYMENUCHECK';
    SM_SLOWMACHINE       : Result:='SM_SLOWMACHINE';
    SM_MIDEASTENABLED    : Result:='SM_MIDEASTENABLED';
    SM_MOUSEWHEELPRESENT : Result:='SM_MOUSEWHEELPRESENT';
    SM_XVIRTUALSCREEN    : Result:='SM_XVIRTUALSCREEN';
    SM_YVIRTUALSCREEN    : Result:='SM_YVIRTUALSCREEN';
    SM_CXVIRTUALSCREEN   : Result:='SM_CXVIRTUALSCREEN';
    SM_CYVIRTUALSCREEN   : Result:='SM_CYVIRTUALSCREEN';
    SM_CMONITORS         : Result:='SM_CMONITORS';
    SM_SAMEDISPLAYFORMAT : Result:='SM_SAMEDISPLAYFORMAT';
    SM_CMETRICS          : Result:='SM_CMETRICS';
    else                   Result:='';
   end;
  end;
 begin
  Result:='';
  if IsNonEmptyStr(ParamName) then
  for Code:=0 to SM_CMETRICS do
  if IsSameText(ParamName,GetSystemMetricsName(Code)) then begin
   Result:=IntToStr(GetSystemMetrics(Code));
   Break;
  end;
 end;
 function GetSystemScreenStr(const ParamName:LongString):LongString;
 var i:Integer; rcWork:TRect; MonInfo:TMonitorInfo; currMonitor,primMonitor:TMonitor; s:LongString;
 begin
  Result:='';
  if SameText(ParamName,'width')         then Result:=IntToStr(Screen.Width)             else
  if SameText(ParamName,'height')        then Result:=IntToStr(Screen.Height)            else
  if SameText(ParamName,'desktopleft')   then Result:=IntToStr(Screen.DesktopLeft)       else
  if SameText(ParamName,'desktoptop')    then Result:=IntToStr(Screen.DesktopTop)        else
  if SameText(ParamName,'desktopwidth')  then Result:=IntToStr(Screen.DesktopWidth)      else
  if SameText(ParamName,'desktopheight') then Result:=IntToStr(Screen.DesktopHeight)     else
  if SameText(ParamName,'pixelsperinch') then Result:=IntToStr(Screen.PixelsPerInch)     else
  if SameText(ParamName,'monitorcount')  then Result:=IntToStr(Screen.MonitorCount)      else
  if SameText(ParamName,'colordepth')    then Result:=IntToStr(GetScreenColorDepth);
  if (Result<>'') then Exit;
  if SameText(Copy(ParamName,1,4),'work') then
  if SystemParametersInfo(SPI_GETWORKAREA, 0, @rcWork, 0) then begin
   if SameText(ParamName,'workleft')     then Result:=IntToStr(rcWork.Left)              else
   if SameText(ParamName,'worktop')      then Result:=IntToStr(rcWork.Top)               else
   if SameText(ParamName,'workwidth')    then Result:=IntToStr(rcWork.Right-rcWork.Left) else
   if SameText(ParamName,'workheight')   then Result:=IntToStr(rcWork.Bottom-rcWork.Top);
  end;
  if (Result<>'') then Exit;
  currMonitor:=nil; primMonitor:=nil;
  if SameText(Copy(ParamName,1,7),'monitor') then
  for i:=0 to Screen.MonitorCount-1 do begin
   s:=Format('monitor%dleft',  [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(Screen.Monitors[i].Left);   break; end;
   s:=Format('monitor%dtop',   [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(Screen.Monitors[i].Top);    break; end;
   s:=Format('monitor%dwidth', [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(Screen.Monitors[i].Width);  break; end;
   s:=Format('monitor%dheight',[i]);  if SameText(ParamName,s) then begin Result:=IntToStr(Screen.Monitors[i].Height); break; end;
   MonInfo.cbSize:=sizeof(MonInfo);
   if GetMonitorInfo(Screen.Monitors[i].Handle,@MonInfo) then begin
    s:=Format('monitor%dworkleft',  [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(MonInfo.rcWork.Left);  break; end;
    s:=Format('monitor%dworktop',   [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(MonInfo.rcWork.Top);   break; end;
    s:=Format('monitor%dworkwidth', [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(MonInfo.rcWork.Right-MonInfo.rcWork.Left); break; end;
    s:=Format('monitor%dworkheight',[i]);  if SameText(ParamName,s) then begin Result:=IntToStr(MonInfo.rcWork.Bottom-MonInfo.rcWork.Top); break; end;
    s:=Format('monitor%dflags',     [i]);  if SameText(ParamName,s) then begin Result:=IntToStr(MonInfo.dwFlags);      break; end;
    if MonInfo.dwFlags and MONITORINFOF_PRIMARY <> 0 then primMonitor:=Screen.Monitors[i];
   end;
  end;
  if (Result<>'') then Exit;
  if Application.MainForm is TForm then currMonitor:=Application.MainForm.Monitor;
  if currMonitor is TMonitor then if SameText(ParamName,'monitornumber')  then Result:=IntToStr(currMonitor.MonitorNum);
  if primMonitor is TMonitor then if SameText(ParamName,'monitorprimary') then Result:=IntToStr(primMonitor.MonitorNum);
 end;
begin
 Result:='';
 if IsSameText(Category,'Id')      then Result:=GetSystemIdStr(ParamName) else
 if IsSameText(Category,'OS')      then Result:=GetSystemOsStr(ParamName) else
 if IsSameText(Category,'Ram')     then Result:=GetSystemRamStr(ParamName) else
 if IsSameText(Category,'Process') then Result:=GetSystemProcessStr(ParamName) else
 if IsSameText(Category,'Metrics') then Result:=GetSystemMetricsStr(ParamName) else
 if IsSameText(Category,'Screen')  then Result:=GetSystemScreenStr(ParamName);
end;

{$IFDEF WINDOWS}
function OpenWinHelpTopic(const Path:LongString; const Topic:LongString=''):Boolean;
begin
 Result:=false;
 try
  if not FileExists(Path) then RAISE EHelpError.Create(Format('File not found:%s%s',[EOL,Path]));
  if IsEmptyStr(Topic) then begin
   if not WinHelp(0,PChar(Path),HELP_INDEX,0)
   then RAISE EHelpError.Create(Format('Could not open help file:%s%s',[EOL,Path]));
  end else begin
   if not WinHelp(0,PChar(Path),HELP_CONTENTS,0)
   or not WinHelp(0,PChar(Path),HELP_KEY,PointerToPtrUInt(PChar(Topic)))
   then RAISE EHelpError.Create(Format('Could not open help file:%s%s',[EOL,Path]));
  end;
  Result:=true;
 except
  on E:Exception do BugReport(E,nil,'OpenWinHelpTopic');
 end;
end;

function OpenWinHelpTopicByLink(const HomeDir,IniFile,Section,Link:LongString; const Topic:LongString=''):Boolean;
var Path:LongString;
begin
 Result:=false;
 try
  Path:='';
  if not ReadIniFilePath(IniFile,Section,Link,HomeDir,Path)
  then RAISE EHelpError.Create(Format('%s is not defined in %s %s',[Link,ExtractFileNameExt(IniFile),Section]));
  Result:=OpenWinHelpTopic(Path,Topic);
 except
  on E:Exception do BugReport(E,nil,'OpenWinHelpTopicByLink');
 end;
end;
{$ENDIF ~WINDOWS}

function IsClipboardHasFormat(cf:TClipboardFormat):Boolean;
begin
 Result:=False;
 try
  if Assigned(Clipboard) then Result:=Clipboard.HasFormat(cf);
 except
  on E:Exception do BugReport(E,nil,'IsClipboardHasFormat');
 end;
end;

function MsgNotImplementedYet(const What:LongString):LongString;
begin
 Result:='';
 if (What<>'') then Result:=What+': ';
 Result:=Result+RusEng('Пока не реализовано.','Not implemented yet.');
end;

function MsgNoSupportOnThisPlatform(const What:LongString):LongString;
begin
 Result:=Trim(Trim(What)+RusEng(' не поддерживается на этой платформе.',
                                ' is not supported on this platform.'));
end;

function  GetWordUnderCursor(const aText:LongString; aCursor:Integer; const SpecChars:LongString=''):LongString;
 function IsWordChar(c:Char):Boolean; begin Result:=(c in ['a'..'z','A'..'Z','0'..'9','_']); end;
var i,c,b,e:Integer;
begin
 Result:='';
 if Length(aText)>0 then
 try
  c:=Max(1,Min(aCursor+1,Length(aText)));
  b:=c+1;
  e:=c-1;
  for i:=c downto 1 do if IsWordChar(aText[i]) then b:=i else Break;
  for i:=c to Length(aText) do if IsWordChar(aText[i]) then e:=i else Break;
  if (e>=b) then Result:=Copy(aText,b,e-b+1) else
  if (Pos(aText[c],SpecChars)>0) then Result:=aText[c];
 except
  on E:Exception do BugReport(E,nil,'GetWordUnderCursor');
 end;
end;

function  GetWordUnderCursor(const aText:WideString; aCursor:Integer; const SpecChars:WideString=''):WideString;
 function IsWordChar(c:WideChar):Boolean; begin Result:=IsLetterOrDigit(c) or (c='_'); end;
var i,c,b,e:Integer;
begin
 Result:='';
 if Length(aText)>0 then
 try
  c:=Max(1,Min(aCursor+1,Length(aText))); b:=c+1; e:=c-1;
  for i:=c downto 1 do if IsWordChar(aText[i]) then b:=i else Break;
  for i:=c to Length(aText) do if IsWordChar(aText[i]) then e:=i else Break;
  if (e>=b) then Result:=Copy(aText,b,e-b+1) else
  if (Pos(aText[c],SpecChars)>0) then Result:=aText[c];
 except
  on E:Exception do BugReport(E,nil,'GetWordUnderCursor');
 end;
end;

function GuardOpenDialog(OpenDialog:TOpenDialog):TOpenDialog;
begin
 Result:=OpenDialog;
 if Assigned(OpenDialog) then
 try
  if Guard.Level<ga_Root
  then OpenDialog.Options:=OpenDialog.Options+[ofOldStyleDialog,ofNoNetworkButton]
  else OpenDialog.Options:=OpenDialog.Options-[ofOldStyleDialog,ofNoNetworkButton];
  OpenDialog.Options:=OpenDialog.Options+[ofNoChangeDir];
 except
  on E:Exception do BugReport(E,nil,'GuardOpenDialog');
 end;
end;

function CheckEditPasswordChar(Edit:TEdit; aPasswordChar:Char):Char;
begin
 Result:=#0;
 if Assigned(Edit) then
 try
  Result:=Edit.PasswordChar;
  {$IFDEF WINDOWS}
  if Edit.HandleAllocated then begin
   Result:=Chr(SendMessage(Edit.Handle, EM_GETPASSWORDCHAR, 0, 0));
   if Result<>aPasswordChar then begin
    SendMessage(Edit.Handle, EM_SETPASSWORDCHAR, Ord(aPasswordChar), 0);
    Edit.Text:=''; Edit.SetTextBuf(PChar(Edit.Text));
   end;
  end;
  {$ENDIF ~WINDOWS}
  if Result<>aPasswordChar then Edit.PasswordChar:=aPasswordChar;
 except
  on E:Exception do BugReport(E,nil,'CheckEditPasswordChar');
 end;
end;

{$IFDEF WINDOWS}
function IsWindowTopMost(Handle:HWND):Boolean; overload;
var pwi:TWindowInfo;
begin
 Result:=False;
 try
  SafeFillChar(pwi,SizeOf(pwi),0);
  if IsWindow(Handle) then
  if GetWindowInfo(Handle,pwi) then
  if pwi.dwExStyle and WS_EX_TOPMOST <> 0 then Result:=True;
 except
  on E:Exception do BugReport(E,nil,'IsWindowTopMost');
 end;
end;

function IsWindowTopMost(Form:TForm):Boolean; overload;
begin
 Result:=False;
 if Assigned(Form) then
 try
  Result:=IsWindowTopMost(Form.Handle);
 except
  on E:Exception do BugReport(E,nil,'IsWindowTopMost');
 end;
end;
 
procedure MakeWindowTopMost(Handle:HWND); overload;
begin
 try
  if IsWindow(Handle) then
  if not IsWindowTopMost(Handle) then
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
 except
  on E:Exception do BugReport(E,nil,'MakeWindowTopMost');
 end;
end;
{$ENDIF ~WINDOWS}

procedure MakeWindowTopMost(Form:TForm; aSysWide:Boolean=false); overload;
begin
 if Assigned(Form) then
 try
  if aSysWide
  then Form.FormStyle:=fsSystemStayOnTop
  else Form.FormStyle:=fsStayOnTop;
  {$IFDEF WINDOWS}
  if Form.FormStyle in [fsNormal, fsStayOnTop] then MakeWindowTopMost(Form.Handle);
  {$ENDIF ~WINDOWS}
 except
  on E:Exception do BugReport(E,nil,'MakeWindowTopMost');
 end;
end;

function GetAppFormBounds:TRect;
var win:HWND;
begin
 win:=0;
 Result:=Rect(0,0,0,0);
 if (Application<>nil) then
 try
  if (Application.MainForm<>nil) then win:=Application.MainForm.Handle;
  if (win<>0) and IsWindow(win) and (GetWindowRect(win,Result)<>0) then Exit;
  with Screen do Result:=Rect(0,0,Width,Height);
 except
  on E:Exception do BugReport(E,nil,'GetAppFormBounds');
 end;
end;

function GetAppFormBoundsStr(delim:Char=' '):LongString;
begin
 with GetAppFormBounds do Result:=Format('%d %d %d %d',[Left,Top,Right,Bottom]);
 if (delim<>' ') then Result:=StringReplace(Result,' ',delim,[rfReplaceAll]);
end;
 
function GetAppClientBounds:TRect;
var win:HWND;
begin
 win:=0;
 Result:=Rect(0,0,0,0);
 if (Application<>nil) then
 try
  if (Application.MainForm<>nil) then
  if (Application.MainForm.FormStyle=fsMDIForm) then win:=Application.MainForm.ClientHandle;
  if (win<>0) and IsWindow(win) and (GetWindowRect(win,Result)<>0) then Exit;
  with Screen do Result:=Rect(0,0,Width,Height);
 except
  on E:Exception do BugReport(E,nil,'GetAppClientBounds');
 end;
end;

function GetAppClientBoundsStr(delim:Char=' '):LongString;
begin
 with GetAppClientBounds do Result:=Format('%d %d %d %d',[Left,Top,Right,Bottom]);
 if (delim<>' ') then Result:=StringReplace(Result,' ',delim,[rfReplaceAll]);
end;

function  ShowTooltip(const arg:LongString):Integer;
var Iter:Integer; path:LongString;
begin
 Result:=0;
 for Iter:=1 to 2 do begin
  if ((Length(TheFpQuiTipExe)>0) and FileExists(TheFpQuiTipExe))
  or ((Length(TheUnixExe)>0) and FileExists(TheUnixExe)) then begin
   if IsNonEmptyStr(arg) then Result:=SendToMainConsole('@silent @tooltip '+Trim(arg)+EOL) else Result:=1;
   break;
  end;
  if (Iter>1) then break;
  path:=GetEnv('PATH');
  TheUnixExe:=FileSearch(AdaptExeFileName('unix.exe'),path);
  TheFpQuiTipExe:=FileSearch(AdaptExeFileName('fpquitip.exe'),path);
 end;
end;

procedure InitTooltip;
begin
 if (Length(TheUnixExe)=0) or not FileExists(TheUnixExe)
 then TheUnixExe:=FileSearch(AdaptExeFileName('unix.exe'),GetEnv('PATH'));
 if (Length(TheFpQuiTipExe)=0) or not FileExists(TheFpQuiTipExe)
 then TheFpQuiTipExe:=FileSearch(AdaptExeFileName('fpquitip.exe'),GetEnv('PATH'));
end;

procedure FreeTooltip;
begin
 TheUnixExe:='';
 TheFpQuiTipExe:='';
end;

function GetScreenColorDepth:Integer;
var h:{$IFDEF WINDOWS}Windows.{$ENDIF}HDC;
begin
 Result:=0;
 h:=GetDC(0);
 if (h<>0) then begin
  Result:=GetDeviceCaps(h,BITSPIXEL);
  ReleaseDC(0,h);
 end;
end;

{$IFDEF WINDOWS}
 // https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-getsystemmetrics
 // GetSystemMetrics(SM_SHUTTINGDOWN) : Nonzero if the current session is shutting down; otherwise, 0.
function IsSystemShuttingDown:Boolean;
begin
 Result:=(GetSystemMetrics(SM_SHUTTINGDOWN)<>0);
end;

 // https://docs.microsoft.com/en-us/windows/desktop/api/processthreadsapi/nf-processthreadsapi-setprocessshutdownparameters
 // This function sets a shutdown order for a process relative to the other processes in the system.
 // dwLevel = The shutdown priority for a process relative to other processes in the system (from high to low).
 //           Application levels is $100-$3FF, default is $280, shutdown order from hight to low.
 // dwFlags = SHUTDOWN_NORETRY = The system terminates the process without displaying a retry dialog box for the user.
function SetProcessShutdownParameters(dwLevel,dwFlags:DWORD):BOOL; stdcall;
type TFunc=function(dwLevel,dwFlags:DWORD):BOOL stdcall;
var h:THandle; const f:TFunc = nil;
begin
 Result:=FALSE;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'SetProcessShutdownParameters') else f:=nil;
  end;
  if Assigned(f) then Result:=f(dwLevel,dwFlags);
 except
  on E:Exception do BugReport(E,nil,'SetProcessShutdownParameters');
 end;
end;

 // https://docs.microsoft.com/en-us/windows/desktop/api/processthreadsapi/nf-processthreadsapi-getprocessshutdownparameters
 // Retrieves the shutdown parameters for the currently calling process.
function GetProcessShutdownParameters(lpdwLevel,lpdwFlags:LPDWORD):BOOL; stdcall;
type TFunc=function(lpdwLevel,lpdwFlags:LPDWORD):BOOL stdcall;
var h:THandle; const f:TFunc = nil;
begin
 Result:=FALSE;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'GetProcessShutdownParameters') else f:=nil;
  end;
  if Assigned(f) then Result:=f(lpdwLevel,lpdwFlags);
 except
  on E:Exception do BugReport(E,nil,'GetProcessShutdownParameters');
 end;
end;
{$ENDIF ~WINDOWS}

 {
 *******************************************************************************
 MUI support functions
 *******************************************************************************
 }
function GetACP:LANGID;
begin
 {$IFDEF WINDOWS}
 Result:=Windows.GetACP;
 {$ELSE}
 Result:=DefaultSystemCodePage;
 {$ENDIF}
end;

function GetOEMCP:LANGID;
begin
 {$IFDEF WINDOWS}
 Result:=Windows.GetOEMCP;
 {$ELSE}
 Result:=DefaultSystemCodePage;
 {$ENDIF}
end;

{$IFDEF WINDOWS}
// https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getsystemdefaultuilanguage
// Returns the language identifier for the system default UI language of the operating system.
function GetSystemDefaultUILanguage:LANGID;
type TGetLangIdFunc=function():LANGID stdcall;
var h:THandle; const f:TGetLangIdFunc=nil;
begin
 Result:=0;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'GetSystemDefaultUILanguage') else f:=nil;
  end;
  if Assigned(f) then Result:=f();
 except
  on E:Exception do BugReport(E,nil,'GetSystemDefaultUILanguage');
 end;
end;
// https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getuserdefaultuilanguage
// Returns the language identifier for the user UI language for the current user.
function GetUserDefaultUILanguage:LANGID;
type TGetLangIdFunc=function():LANGID stdcall;
var h:THandle; const f:TGetLangIdFunc=nil;
begin
 Result:=0;
 try
  if not Assigned(f) then begin
   h:=GetModuleHandle('kernel32.dll');
   if h<>0 then f:=GetProcAddress(h,'GetUserDefaultUILanguage') else f:=nil;
  end;
  if Assigned(f) then Result:=f();
 except
  on E:Exception do BugReport(E,nil,'GetUserDefaultUILanguage');
 end;
end;
function GetSystemDefaultLangID:LANGID;
begin
 Result:=Windows.GetSystemDefaultLangID;
end;
function GetUserDefaultLangID:LANGID;
begin
 Result:=Windows.GetUserDefaultLangID;
end;
// https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getthreaduilanguage
// Returns the identifier for a language explicitly associated with the thread or a user or system user interface language.
function GetThreadUILanguage:LANGID;
type TGetLangIdFunc=function():LANGID stdcall;
var h:THandle; const f:TGetLangIdFunc=nil;
begin
Result:=0;
try
 if not Assigned(f) then begin
  h:=GetModuleHandle('kernel32.dll');
  if h<>0 then f:=GetProcAddress(h,'GetThreadUILanguage') else f:=nil;
 end;
 if Assigned(f) then Result:=f();
except
 on E:Exception do BugReport(E,nil,'GetThreadUILanguage');
end;
end;
// https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getsystemdefaultlcid
// Returns the locale identifier for the system default locale, identified by LOCALE_SYSTEM_DEFAULT.
function GetSystemDefaultLCID:LCID;
type TGetLcIdFunc=function():LCID stdcall;
var h:THandle; const f:TGetLcIdFunc=nil;
begin
Result:=0;
try
 if not Assigned(f) then begin
  h:=GetModuleHandle('kernel32.dll');
  if h<>0 then f:=GetProcAddress(h,'GetSystemDefaultLCID') else f:=nil;
 end;
 if Assigned(f) then Result:=f();
except
 on E:Exception do BugReport(E,nil,'GetSystemDefaultLCID');
end;
end;
// https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getuserdefaultlcid
// Returns the locale identifier for the user default locale, represented as LOCALE_USER_DEFAULT.
function GetUserDefaultLCID:LCID;
type TGetLcIdFunc=function():LCID stdcall;
var h:THandle; const f:TGetLcIdFunc=nil;
begin
Result:=0;
try
 if not Assigned(f) then begin
  h:=GetModuleHandle('kernel32.dll');
  if h<>0 then f:=GetProcAddress(h,'GetUserDefaultLCID') else f:=nil;
 end;
 if Assigned(f) then Result:=f();
except
 on E:Exception do BugReport(E,nil,'GetUserDefaultLCID');
end;
end;
// https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getthreadlocale
// Returns the locale identifier of the locale associated with the current thread.
function GetThreadLocale:LCID;
type TGetLcIdFunc=function():LCID stdcall;
var h:THandle; const f:TGetLcIdFunc=nil;
begin
Result:=0;
try
 if not Assigned(f) then begin
  h:=GetModuleHandle('kernel32.dll');
  if h<>0 then f:=GetProcAddress(h,'GetThreadLocale') else f:=nil;
 end;
 if Assigned(f) then Result:=f();
except
 on E:Exception do BugReport(E,nil,'GetThreadLocale');
end;
end;
// https://docs.microsoft.com/en-us/windows/win32/api/winnls/nf-winnls-getsystemdefaultlocalename
// Retrieves the system default locale name.
function GetSystemDefaultLocaleName(lpLocaleName:PWideChar; cchLocaleName:Integer):Integer stdcall;
type TFunc=function (lpLocaleName:PWideChar; cchLocaleName:Integer):Integer stdcall;
var h:THandle; const f:TFunc=nil;
begin
Result:=0;
try
 if not Assigned(f) then begin
  h:=GetModuleHandle('kernel32.dll');
  if h<>0 then f:=GetProcAddress(h,'GetSystemDefaultLocaleName') else f:=nil;
 end;
 if Assigned(f) then Result:=f(lpLocaleName,cchLocaleName);
except
 on E:Exception do BugReport(E,nil,'GetSystemDefaultLocaleName');
end;
end;
function GetSystemDefaultLocaleNameStr:LongString;
const LOCALE_NAME_MAX_LENGTH=85;
var Buff:array[0..LOCALE_NAME_MAX_LENGTH-1] of WideChar;
begin
 if GetSystemDefaultLocaleName(Buff,SizeOf(Buff) div SizeOf(Buff[0]))>0
 then Result:=Buff else Result:='';
end;
{$ELSE ~WINDOWS}
function GetSystemDefaultUILanguage:LANGID;
begin
 Result:=LocaleToMsLcid(posix_getlocale,MsLcid_Fallback);
end;
function GetUserDefaultUILanguage:LANGID;
begin
 Result:=LocaleToMsLcid(posix_getlocale,MsLcid_Fallback);
end;
function GetSystemDefaultLangID:LANGID;
begin
 Result:=LocaleToMsLcid(posix_getlocale,MsLcid_Fallback);
end;
function GetUserDefaultLangID:LANGID;
begin
 Result:=LocaleToMsLcid(posix_getlocale,MsLcid_Fallback);
end;
function GetThreadUILanguage:LANGID;
begin
 Result:=LocaleToMsLcid(posix_getlocale,MsLcid_Fallback);
end;
function GetSystemDefaultLCID:LCID;
begin
 Result:=LocaleToMsLcid(posix_getlocale,MsLcid_Fallback);
end;
function GetUserDefaultLCID:LCID;
begin
 Result:=LocaleToMsLcid(posix_getlocale,MsLcid_Fallback);
end;
function GetThreadLocale:LCID;
begin
 Result:=LocaleToMsLcid(posix_getlocale,MsLcid_Fallback);
end;
function GetSystemDefaultLocaleNameStr:LongString;
begin
 Result:=MsLcidMapping.KeyedParams[IntToStr(GetSystemDefaultUILanguage)];
 if (Result='') then Result:=Trim(StringReplace(ForceExtension(posix_getlocale,''),'_','-',[rfReplaceAll]));
end;
{$ENDIF ~WINDOWS}

function GetDefLanguage:Integer;
begin
 Result:=lng_English;
 if IsWindows and ((GetACP=1251) or (GetOEMCP=866)) then Result:=lng_Russian;
 if IsUnix and SameText(Copy(GetEnv('LANG'),1,2),'ru') then Result:=lng_Russian;
end;

function GetOptLanguage(def:Integer; LangOpts:LongString=''):Integer;
var slng,opt:LongString; i:Integer;
begin
 Result:=def; slng:='';
 LangOpts:=Trim(LangOpts);
 if (LangOpts='') then LangOpts:=Trim(ListLanguageOptionNames);
 if (LangOpts='') then Exit;
 CmdArgs.ListOptVal:=CmdArgs.ListOptVal+';'+LangOpts;
 for i:=1 to WordCount(LangOpts,ScanSpaces) do begin
  opt:=ExtractWord(i,LangOpts,ScanSpaces);
  slng:=CmdArgs.GetOptionValue(opt);
  if (slng<>'') then Break;
 end;
 if (slng='') then Exit;
 if (WordIndex(slng,'ru,rus,russian',ScanSpaces)>0) then Result:=lng_Russian;
 if (WordIndex(slng,'en,eng,english',ScanSpaces)>0) then Result:=lng_English;
end;

 {
 *******************************************************************************
 RIFF file utilities
 *******************************************************************************
 }
type
 TItemSearchRec = packed record
  Index : LongInt;
  Count : LongInt;
  Found : TRiffChunk;
 end;

procedure SearchItem(Filer:TRiffFiler; const Chunk:TRiffChunk; var Terminate:Boolean; Custom:Pointer);
begin
 with TItemSearchRec(Custom^) do
 case Chunk.dwSign of
  sig_ITEM: if Index=Count then begin
             Terminate:=true;
             Found:=Chunk;
            end else begin
             inc(Count);
            end;
 end;
end;

type
 TItemListRec = packed record
  Name : LongString;
  Time : Double;
  Vers : LongInt;
 end;

procedure ListItem(Filer:TRiffFiler; const Chunk:TRiffChunk; var Terminate:Boolean; Custom:Pointer);
begin
 with TItemListRec(Custom^) do
 case Chunk.dwSign of
  sig_name : Name:=Filer.ReadString(Chunk.dwSize,rsmf_FixUtf8);
  sig_time : Time:=Filer.ReadDouble;
  sig_vers : Vers:=Filer.ReadLongInt;
 end;
end;

procedure ListItems(Filer:TRiffFiler; const Chunk:TRiffChunk; var Terminate:Boolean; Custom:Pointer);
var Rec:TItemListRec; i:LongInt;
begin
 Rec:=Default(TItemListRec);
 try
  case Chunk.dwSign of
   sig_ITEM : begin
               Rec.Name:='';
               Rec.Time:=_Nan;
               Rec.Vers:=sig_0001;
               Filer.ForEach(ListItem,Chunk,@Rec);
               if Rec.Name='' then Rec.Name:='?';
               if isNan(Rec.Time) then begin
                Rec.Name:=Pad('',19,'?')+'  '+Rec.Name;
               end else begin
                Rec.Name:=StdDateTimeStr(Rec.Time)+'  '+Rec.Name;
               end;
               if Str2Long(dwSign2Str(Rec.Vers),i)
               then Rec.Name:=dwSign2Str(Rec.Vers)+'  '+Rec.Name
               else Rec.Name:='????'+'  '+Rec.Name;
               Rec.Name:=' '+dwSign2Str(Chunk.dwFormID)+'  '+Rec.Name;
               TText(Custom).Insln(0,Rec.Name);
              end;
  end;
 finally
  Rec.Name:='';
 end;
end;

function SelectRiffItemDialog(const FileName:LongString):TRiffChunk;
var
 Filer : TRiffFiler;
 List  : TText;
 Menu  : LongInt;
 Rec   : TItemSearchRec;
begin
 Result:=RiffChunk(0,0,0,0);
 try
  List:=NewText;
  Filer:=NewRiffFiler(FileName,fmOpenRead,sig_CRWF);
  try
   try
    if not Filer.Ok
    then Raise EFOpenError.Create(RusEng('Не могу открыть файл.','Could not open file.'));
    Filer.ForEach(ListItems,Filer.RootForm,List);
    if NoProblem(List.Count>0,RusEng('Нет списка объектов в файле ','No object list in file ')+FileName)
    then Menu:=ListBoxMenu(RusEng('Выбрать объект для ввода из ','Select object to input from ')+FileName,
                           RusEng(' '+'Тип '+'  '+'Верс'+'  '+'Время сохранения   '+'  '+'Имя',
                                  ' '+'Type'+'  '+'Vers'+'  '+'Time when saved    '+'  '+'Name'),
                           List.Text)
    else Menu:=-1;
    if Menu>=0 then  begin
     Rec.Index:=List.Count-1-Menu;
     Rec.Count:=0;
     Rec.Found:=RiffChunk(0,0,0,0);
     Filer.ForEach(SearchItem,Filer.RootForm,@Rec);
     Result:=Rec.Found;
    end
   except
    Filer.Modified:=false;
    Raise;
   end;
  finally
   Kill(Filer);
   Kill(List);
  end;
 except
  on E:Exception do begin
   BugReport(E,nil,'SelectRiffItemDialog');
   Error(E.Message+EOL+RusEng('Файл ','File ')+FileName);
  end;
 end;
end;

 {
 *******************************************************************************
 Initialize standard subsystems
 *******************************************************************************
 }
procedure Init_CpuFrequencyMHz;
begin
 UpdateStatusLine(RusEng('Определяю частоту процессора...','Eastimate CPU frequency...'));
 CpuFrequencyMHz:=EastimateCpuFrequencyMHz(1000);
end;

procedure Init_Sound_SubSystem;
var b:Boolean; s:LongString; d:LongInt;
begin
 b:=false; s:=''; d:=0;
 UpdateStatusLine(RusEng('Инициализирую звук...','Initialize sound...'));
 DebugOut(stdfDebug,'');
 DebugOut(stdfDebug,'Init sound system.');
 DebugOut(stdfDebug,'******************');
 if ReadIniFileBoolean(SysIniFile,'[System]','UseBlaster%b',b) and b then
 if ReadIniFilePath(SysIniFile,'[System]','SoundLibrary',HomeDir,s) then begin
  DebugOut(stdfDebug,'SoundLibrary = '+s);
  if InitBlaster(BlasterDefaultFifoSize,s,0) then begin
   DebugOut(stdfDebug,'Ok.');
   if ReadIniFileLongInt(SysIniFile,'[System]','BlasterCheckDelay%d',d) then BlasterMemoPollPeriod:=d*1000;
   if ReadIniFileLongInt(SysIniFile,'[System]','MaxBlasterDataSize%d',d) then BlasterMaxDataSize:=d*1024;
   if ReadIniFileBoolean(SysIniFile,'[System]','UseSystemVoice%b',b) then EnableSystemVoice:=b;
   if ReadIniFileLongInt(SysIniFile,'[System]','SayTimeInterval%d',d) then SayTimeInterval:=d;
   if ReadIniFileString(SysIniFile,'[SysVoice]','Greeting%s',s) then SysVoice(s);
   Echo(RusEng('Звуковая подсистема : Включена.','Sound subsystem '+ASCII_TAB+': Ok.'));
  end else begin
   DebugOut(stdfDebug,'Fails.');
   Echo(RusEng('Звуковая подсистема : Сбой.','Sound subsystem : Fails.'));
  end;
 end;
end;

procedure Done_Sound_SubSystem;
var s:LongString;
begin
 s:='';
 UpdateStatusLine(RusEng('Завершаю звук...','Finalize sound...'));
 if ReadIniFileString(SysIniFile,'[SysVoice]','Farewell%s',s) then begin
  SysVoice(s);
  Sleep(2000);
 end;
 DoneBlaster;
end;

procedure Init_Calculator_SubSystem;
var s:LongString;
begin
 s:='';
 UpdateStatusLine(RusEng('Инициализирую калькулятор...','Initialize calculator...'));
 if ReadIniFilePath(SysIniFile,'[System]','CalculatorConfig',HomeDir,s)
 then LoadCalculatorParams(s);
end;

procedure Done_Calculator_SubSystem;
var s:LongString;
begin
 s:='';
 UpdateStatusLine(RusEng('Завершаю калькулятор...','Finalize calculator...'));
 if ReadIniFilePath(SysIniFile,'[System]','CalculatorConfig',HomeDir,s)
 then SaveCalculatorParams(s);
end;

procedure Init_Thermocouple_SubSystem;
var p:TText; i:Integer;
begin
 UpdateStatusLine(RusEng('Инициализирую термопары...','Initialize thermocouples...'));
 DebugOut(stdfDebug,'');
 DebugOut(stdfDebug,'Init thermocouples.');
 DebugOut(stdfDebug,'*******************');
 if ThermoCoupleCount=0 then InitCouples(SysIniFile,'[DataBase]','ThermoCouples',stdfDebug);
 if ThermoCoupleCount>0 then begin
  DebugOut(stdfDebug,'Ok.');
  Echo(RusEng('Таблицы термопар : Прочитаны.','Thermocouple tables : Ok.'));
  CalibTransformList.InitThermocouples;
 end else begin
  DebugOut(stdfDebug,'Fails.');
  Echo(RusEng('Таблица термопар : Сбой.','Thermocouple table : Fails.'));
 end;
 UpdateStatusLine(RusEng('Инициализирую калибровки...','Initialize relationships...'));
 DebugOut(stdfDebug,'');
 DebugOut(stdfDebug,'Init relationships.');
 DebugOut(stdfDebug,'*******************');
 if RelationshipCount=0 then InitRelationShips(SysIniFile,'[DataBase]','Relationships',stdfDebug);
 if RelationshipCount>0 then begin
  DebugOut(stdfDebug,'Ok.');
  Echo(RusEng('Таблицы калибровок : Прочитаны.','Calibration tables : Ok.'));
  CalibTransformList.InitRelations;
 end else begin
  DebugOut(stdfDebug,'Fails.');
  Echo(RusEng('Таблицы калибровок : Сбой.','Calibration tables : Fails.'));
 end;
 p:=NewText;
 p.Text:=CalibTransformList.Text;
 DebugOut(stdfDebug,RusEng(EOL+'Список доступных типов калибровок:'+EOL+
                               '**********************************',
                           EOL+'List of available calibration tables:'+EOL+
                               '*************************************'));

 for i:=0 to p.Count-1 do DebugOut(stdfDebug,p[i]);
 Kill(p);
 FreeConfigCache(0);
end;

procedure Done_Thermocouple_SubSystem;
begin
 UpdateStatusLine(RusEng('Завершаю термопары...','Finalize thermocouples...'));
end;

procedure Init_IOPM_SubSystem;
var i:LongInt; p:TText;
begin
 UpdateStatusLine(RusEng('Инициализирую драйвер IOPM...','Initialize IOPM driver...'));
 DebugOut(stdfDebug,'');
 DebugOut(stdfDebug,'Init IOPM driver.');
 DebugOut(stdfDebug,'*****************');
 if IOPM_Open(SysIniFile,'[System]','IOPM_DRIVER') then begin
  try
   for i:=0 to 5 do Sound(1000*(10-i),50);
  except
   on EPrivilege do begin
    DebugOut(stdfDebug,'IOPM driver invalid.');
    Echo(RusEng('Драйвер IOPM : Сбой.','Driver IOPM : Fails.'));
   end;
   on E:Exception do BugReport(E,nil,'Init_IOPM_SubSystem');
  end;
  DebugOut(stdfDebug,'Ok.');
  Echo(RusEng('Драйвер IOPM : Включен.','Driver IOPM : Ok.'));
 end else begin
  DebugOut(stdfDebug,'Fails.');
  Echo(RusEng('Драйвер IOPM : Сбой. Вероятно, нужны права администратора.',
              'Driver IOPM : Fails. Probably, administrator rights needed.'));
 end;
 p:=NewText;
 p.Text:=IOPM_History;
 for i:=0 to p.Count-1 do DebugOut(stdfDebug,p[i]);
 Kill(p);
end;

procedure Done_IOPM_SubSystem;
begin
 UpdateStatusLine(RusEng('Завершаю драйвер IOPM...','Finalize IOPM driver...'));
 IOPM_Close;
end;

procedure Timer_CheckConfigCache;
begin
 CheckConfigCache;
end;

procedure Timer_SayTime;
const Last:word=$FFFF;
var t:TSystemTime;
begin
 if UsesBlaster and (SayTimeInterval>0) then begin
  t:=MSecToNativeTime(msecnow);
  if t.Minute<>Last then begin
   if (SayTimeInterval=1) or (t.Minute mod SayTimeInterval=0) then SayTimeHhMm(t);
   Last:=t.Minute;
  end;
 end;
end;

procedure SayTimeHhMm(const t:TSystemTime; const Prefix:LongString);
var s:LongString;
begin
 s:=SayNumber(t.Minute);
 if t.Minute<10 then s:='0 '+s;
 s:=SayNumber(t.Hour)+' '+s;
 if t.Hour<10 then s:='0 '+s;
 Voice(Prefix+' '+s);
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_apptools;
begin
 {$IFDEF UNIX}
 UseSystemMessageBox:=false;
 {$ENDIF ~UNIX}
end;

procedure Free_crw_apptools;
begin
 FreeMenuShortcuts;
end;

initialization

 Init_crw_apptools;

finalization

 Free_crw_apptools;

end.

//////////////
// END OF FILE
//////////////

