path: root/plugins/Libs/kol.pas

//[START OF KOL.pas]
{****************************************************************

        KKKKK    KKKKK    OOOOOOOOO    LLLLL
        KKKKK    KKKKK  OOOOOOOOOOOOO  LLLLL
        KKKKK    KKKKK  OOOOO   OOOOO  LLLLL
        KKKKK  KKKKK    OOOOO   OOOOO  LLLLL
        KKKKKKKKKK      OOOOO   OOOOO  LLLLL
        KKKKK  KKKKK    OOOOO   OOOOO  LLLLL
        KKKKK    KKKKK  OOOOO   OOOOO  LLLLL
        KKKKK    KKKKK  OOOOOOOOOOOOO  LLLLLLLLLLLLL
        KKKKK    KKKKK    OOOOOOOOO    LLLLLLLLLLLLL

  Key Objects Library (C) 2000 by Vladimir Kladov.

****************************************************************
* VERSION 3.18
****************************************************************

  K.O.L. - is a set of objects and functions to create small programs
  with the Delphi, but without the VCL/CLX. KOL allows to create
  executables of size about 10 times smaller. But this does not mean that
  KOL is less power then the VCL - perhaps just the opposite...

  KOL is provided free with the source code.
  Copyright (C) Vladimir Kladov, 2000-2011.

  For code provided by other  developers (even if later
  changed by me) authors are noted in the source.

  mailto: vk@kolmck.net
  Web-Page: http://kolmck.net

  See also Mirror Classes Kit (M.C.K.) which allows
  to create KOL programs visually.

****************************************************************}

{$I KOLDEF.inc}

{$IFDEF x64}
    {$DEFINE PAS_ONLY}
{$ENDIF}
{$IFDEF PAS_ONLY}
    {$DEFINE PAS_VERSION}
{$ENDIF}

{$IFDEF EXTERNAL_KOLDEFS}
  {$INCLUDE PROJECT_KOL_DEFS.INC}
{$ENDIF}
{$IFDEF EXTERNAL_DEFINES}
        {$INCLUDE EXTERNAL_DEFINES.INC}
{$ENDIF EXTERNAL_DEFINES}

  {$DEFINE GDI}

{$UNDEF LIN} {$UNDEF WIN} {$UNDEF GDI}
{$IFDEF LINUX}
  {$DEFINE UNIX}
  {$DEFINE LIN}
  {$DEFINE PAS_VERSION}
  {$DEFINE NOT_USE_RICHEDIT}
  {$IFNDEF GTK}
    {$IFNDEF XQT}
      {$DEFINE GTK} // it is also possible to define GTK as a project option
    {$ENDIF XQT}    // even for Windows system
  {$ENDIF GTK}
{$ELSE}         // to exploit GTK under Win32 rather then native GDI
  {$DEFINE WIN}
  {$DEFINE GDI}
{$ENDIF}

  {$IFDEF GTK} {$UNDEF GDI} {$DEFINE _X_}
               {$DEFINE NOT_USE_RICHEDIT}
  {$ENDIF}
//{$IFDEF Q_T} {$UNDEF GDI} {$DEFINE _X_} {$ENDIF}

{$IFDEF WIN} {$IFDEF GDI}
  {$DEFINE WIN_GDI}
{$ENDIF GDI} {$ENDIF WIN}

{.$INCLUDE delphidef.inc}

{$IFDEF WIN_GDI}
  //test
{$ENDIF WIN_GDI}
{$IFDEF LIN}
  //test
{$ENDIF LIN}

unit KOL;
{*
   Please note, that KOL does not use keyword 'class'. Instead,
   poor Pascal 'object' is the base of our objects. So, remember,
   how we worked earlier with such Object Pascal's objects:
|<br>
   - to create objects dynamically, use P<objname> instead of
     T<objname> to allocate a pointer for dynamically created
     object instance;
|<br>
   - remember, that constructors of objects can not be virtual.
     Override procedure Init instead in your own derived objects;
|<br>
   - rather then call constructors of objects, call global procedures
     New<objname> (e.g. NewLabel). If not, first (for virtualally
     created objects) call New( ); then call constructor Create
     (which calls Init) - but this is possible only if the constructor
     is overriden by a new one.
|<br>
   - the operator 'is' is not applicable to objects. And operator 'as'
     is not necessary (and is not applicable too), use typecast to desired
     object type, e.g.: "PSomeObjectType( C )" inplace of "C as TSomeClassType".
|<br>
|<hr>
     Also remember, that IF [ MyObj: PMyObj ] THEN

     NOT[ with MyObj do ] BUT[ with MyObj^ do ]

     Though it is possible to skip '^' symbol when accessing member
     fields, methods, properties, e.g. [ MyObj.Execute; ]
|<hr>
|&U=&nbsp;&nbsp;&nbsp;<a href="#%0">%0</a><br>
|&B=<a href="%1.htm">%0</a><br>
|&C=<a href="%1.htm">%0</a>
|     <table border=1 cellpadding=6 width=100%>
|     <colgroup valign=top span=2>
|       <tr>
|         <td>  objects  </td>     <td>   functions by category </td>
|       </tr>
|         <td>
              <C _TObj> <B TObj>
              <C TList> <C TListEx> <C TStrList> <B TStrListEx>
              <C TTree> <C TDirList> <C TIniFile> <C TCabFile>
              <B TStream>
              <B TControl>
              <C TGraphicTool> <C TCanvas> <C TImageList> <C TIcon> <C TBitmap>
              <C TGif> <C TGifDecoder> <B TJpeg>
              <C TTimer> <C TThread> <C TTrayIcon> <C TDirChange> <B TMediaPlayer>
              <C TMenu> <C TOpenSaveDialog> <C TOpenDirDialog> <B TColorDialog>
              <C TAction> <B TActionList>
              <B Exception>
|         </td>
|         <td>
|<a href="kol_pas.htm#visual_objects_constructors">
      Visual objects constructing functions
|</a><br><br>
              <U Working with null-terminated and ansi strings>
              <U Small bit arrays (max 32 bits in array)>
              <U Arithmetics, geometry and other utility functions>
              <U Data sorting (quicksort implementation)>
              <U String to number and number to string conversions>
              <U 64-bit integer numbers>
              <U Floating point numbers>
              <U Date and time handling>
              <U File and directory routines>
              <U System functions and working with windows>
              <U Text in clipboard operations>
              <U Wrappers to registry API functions>
|         </td>
|     </table>

  Following conditional symbols can be used in a project
  (Project | Options | Directories/Conditional Defines)
  to change code generated a bit. There are following:
|<pre>

  EXTERNAL_KOLDEFS      - since there are a lot of such symbols, it may be not
                          possible to include all the desired optional symbols
                          in the Project Options (Delphi has a restriction to 256
                          characters in a semicolon-separated list of included
                          options). This symbol allows to exceed this restriction:
                          you place your defines in an included file
                          EXTERNAL_DEFINES.INC, located in your project directory.
                          Since this is a normal pascal source, use usual Pascal
                          syntax:  add a directive (*$DEFINE symbol*) for each
                          symbol you want, and you can decorate it with usual
                          comments if necessary.
  ENABLE_DEPRECATED     - some old declaration made "deprecated" and moved to
                          KOL_deprecated.inc. This symbol provides including
                          such declarations into KOL.pas and makes it available
                          again.
  DISABLE_DEPRECATED    - (default) - disables deprecated declaration.
  WIN                   - (default) - version for Windows.
  LINUX                 - version for Linux (only PAS_VERSION) -- not yet ready
                          When not defined, symbol WIN is defined automatically.
  LINUX_USE_HOME_STARTFDIR - in Linux app, HOME directory of the user will be
                          returned by GetStartDir function.
  GTK                   - version for GTK (Linux or Win32) -- not yet ready
  XQT                   - version for QT (Linux or Win32) -- not yet ready
  FPC                   - Free Pascal version. KOL can be used with such compiler
                          to create Win32 applications. To create Win-CE
                          applications (with FPC compiler)), use the separate
                          version of KOL specially designed for it.
  INPACKAGE             - version for Mirror Classes Library package (design-time
                          only). This option should be included only in MCK package
                          options and never in options of the KOL/MCK application.
  PAS_VERSION           - to use Pascal version of the code.
  PARANOIA              - to force short versions of asm instructions (for D5
                          and below, D6 and higher use those instructions always).
  USE_CMOV              - force using CMOV machine instruction in asm code (not
                          recommended, still on some machines your application
                          will not work).
  SMALLEST_CODE         - to create minimal code application (affected:
                          (o) SimpleGetCtlBrushHandle - returns solid silver brush
                              always;
                          (o) _NewWindowed
                              - only default system font used by default;
                              font of the parent control is not applied to its
                              children automatically (but see SMALLEST_CODE_PARENTFONT);
                              - fBrush always set to NIL by default (parent Brush
                              is not applied);
                          (o) WndProcDoEraseBkgnd
                              - child controls windows are not created in WM_ERASEBKGND
                              if were not created earlier (in most case, all OK
                              with this - controls are created BTW);
                              - SetBkColor, SetBkMode, SetBrushOrgEx are not
                              called (all OK therefore)
                          (o) by default, NOT_UNLOAD_RICHEDITLIB is defined if
                              UNLOAD_RICHEDITLIB is not defined in project options
                              (this minimizes finalization section).
                          (o) _NewControl
                              - BoundsRect initialized with a rectangle
                                (aParent.fMarginLeft, aParent.fMarginTop,
                                 aParent.fMarginLeft+64, aParent.fMargin+64)
                                rather then with (aParent.fMargin+aParent.fMarginLeft,
                                aParent.fMargin+aParent.fMarginTop,
                                aParent.fMargin+aParent.fMarginLeft+64,
                                aParent.fMargin+aParent.fMarginTop+64).
                                In most cases this is enough.
                          (o) Int2Hex
                              there are no check for second perameter > 15
                          (o) .... other see in code
  SMALLER_CODE          - like smallest code, but fuctionality is the same.
                          The speed can be lower therefore.
  SMALLEST_CODE_PARENTFONT - Parent font therefore is applied for child controls,
                             but initially only.
  SPEED_FASTER          - by default (but off when SMALLEST_CODE on) - sorting of
                          TStrList.AnsiSort and comparing using AnsiCompareStrA,
                          AnsiCompareStrNoCaseA is much faster (about 5-6 times).
                          Also, sorting of lists and strlists is redircted to
                          SortArray which is faster about 5-15% (vs SortData).
                          To turn off, add a symbol SPEED_NORMAL.
  REGKEYGETSTREX_ALWAYS - If you use already RegKeyGetStrEx, add this option to
                          redirect RegKeyGetStr to it.
  NOT_USE_KOLMATH       - Only for _X_ (GTK + Linux): to prevent referencing
                          KOLmath in uses. This makes method TCanvas.Arc
                          unavailable, but the application become smaller.
  NOT_USE_EXCEPTIONS    - to prevent referencing unit ERR.PAS in uses even when
                          KOLmath is listed there.
  REDEFINE_ABS          - usual Abs works as a macro which is better in most
                          cases. But who knows...
  CUSTOM_APPICON        - when this option is defined, the resource name for the
                          application icon is extracted from a file
                          CusomAppIconRsrcName_PAS.inc (place it in your project
                          folder and type there name of the recource in qutations).
                          By default, string 'MAIN' is used like in usual Delphi
                          application.
  USE_NAMES             - to use property Name with any TObj. This makes also
                          available method TObj.FindObj( name ): PObj.
  UNIQUE_NAMES          - provide Name property to be unique among all siblings.
  USE_MHTOOLTIP         - to use KOLMHTOOLTIP.pas (actually it is not a separate
                          unit but a set of portions of code included into KOL.pas
                          in different places). This unit provides tooltips (hints)
                          for arbitrary controls which appear when mouse is over
                          such controls.
  USE_GRUSH             - to use ToGRush.pas unit, which provides automatic
                          redirection of the most cintrols creation functions
                          to the KOLGRushControls.pas.
  (USE_CONSTRUCTORS     - to use constructors like in VCL. Note: this option is
                          not carefully tested!)
  TLIST_FAST            - very fast implementation of TList (for coast of some
                          additional code).
  DFLT_TLIST_NOUSE_BLOCKS - for TLIST_FAST: by default, do not make all TList
                          objects using new (fast) algoritms, but only those of
                          TList objects, which property UseBlocks was set to
                          TRUE after creating it.
  STREAM_LARGE64        - turns on support of streams (and files) of size larger
                          then 4 Gbytes. Data type Int64 used for parameters of
                          the most of methods and functions in such case. (Note:
                          Int64 was introduced since Delphi5, so in earlier Delphi
                          versions using this symbol is not possible).
  STREAM_COMPAT         - still STREAM_LARGE64 appeared (in v2.84), most of
                          methods and functions declarations became incompatible
                          with earlier created extensions. This symbol provides
                          compatibility for such extensions, but it desables
                          using large streams.
  OLD_STREAM_CAPACITY   - to use elder TStream.SetCapacity algorithm (it did not
                          make Capacity smaller than already achieved, but in
                          newer version, Capacity can be set to a smaller value,
                          and for memory streams, rest of memory is freeing in
                          such case).
  OLD_MEMSTREAMS_SETSIZE - to use elder TStream.SetSize for memory streams. In
                          a new version, setting new size also changes Capacity
                          to the same value (in earlier case, a value for
                          Capacity property was calculated to become a bit
                          greater then a value set for Size property).
  OLD_COMPAT            - to use symbol ';' as a file list separator (all operations
                          using DoFileOp function such as DeleteFile2Recycle and
                          CopyMoveFiles).
  OLD_REGKEYGETSUBKEYS  - to use elder version of RegKeyGetSubKeys functions
                          (new version is faster).
  OLD_REGKEYGETVALUENAMES - to use elder version of RegKeyGetValueNames
                          (newer version is faster).
  USE_CUSTOMEXTENSIONS  - to extend TControl with custom additions.
  DATE0_0001            - to correct correctly TDateTime to TSystemTime and vice
                          versa even for dates earlier then 1-Jan-1601.
  UNICODE_CTRLS         - to use Unicode versions of controls (WM_XXXXW messages,
                          etc.)
  SAFE_CODE             - use more safe code in some algorithms (but more slowly
                          and taking more code a bit).
  USE_OnIdle            - to use OnIdle event
  SNAPMOUSE2DFLTBTN     - for all MessageBox-based functions, snap mouse to
                          default button is provided if such option is on in
                          mouse driver settings.
  BUTTON_DBLCLICK       - to prevent clicking buttons with double click (separate
                          event OnMouseDblClk is fired in such case), this takes
                          smaller code but buttons can not be pressed with mouse
                          fast. When SMALLEST_CODE on, this option also is on.
  ALL_BUTTONS_RESPOND_TO_ENTER - obvious (by default, buttons respond to key
                        SPACE, since those are working this way in Windows).
  CLICK_DEFAULT_CANCEL_BTN_DIRECTLY - to prevent visual effect of default/cancel
                             button pressing with Enter/Escape keys. Also, button
                             don't become focused in such case.
  DEFAULT_CANCEL_BTN_EXCLUSIVE - to disable assigning to a button properties
                             DefaultBtn and CancelBtn simultaneously.
  NO_DEFAULT_BUTTON_BOLD - to prevent DefaultBtn to be visually with
                             a bold border.
  BITBTN_DISABLEDGLYPH2 - to restore old behaviour of multi-glyph bitbtn, when
                          index 2 was used to represent the button in disabled
                          state, and glyph with index 1 was used forpressed dtate.
                          Now by default index 1 corresponds to the disabled state,
                          and index 2 to the pressed state, i.e. these are swapped.
  ESC_CLOSE_DIALOGS     - to allow closing all dialogs with ESCAPE.
  KEY_PREVIEW           - form also receive WM_KEYDOWN (OnKeyDown event fired)
  SUPPORT_ONDEADCHAR    - to support OnKeyDeadChar event in responce to
                          WM_DEADCHAR, WM_SYSDEADCHAR
  OpenSaveDialog_Extended - to allow using custom extensions for OpenSaveDialog.
  AUTO_CONTEXT_HELP     - to use automatic respond to WM_CONTEXTMENU to call
                        context help.
  NOT_FIX_CURINDEX      - to use old version of TControl.SetItems, which could
                        lead to loose CurIndex value (e.g. for Combobox)
  NOT_FIX_MODAL         - not to fix modal (if fixed, click on any window
                          activates the application. If not fixed, code is
                          smaller very a little, but only click on modal form
                          activates the application). This does not fix calling
                          MsgBox though.
  MODAL_ACTIVATE_FIX    - if this option is set, all the windows of clicked app
                          with active modal form are brought to foreground, not
                          only modal form itself. This option is not necessary if
                          only two forms are visible at a time (the main form and
                          the active modal form).
  NEW_MODAL             - to use extended modalness.
  USE_SETMODALRESULT    - to guarantee ModalResult property assigning handling.
  USE_SHOWMODALPARENTED_ALWAYS - to use TControl.ShowModalParented( Applet )
                          instead of TControl.ShowModal always.
  USE_MENU_CURCTL       - to use CurCtl property in popup menu to detect which
                        control initiated a pop-up.
  NEW_MENU_ACCELL       - to use new menu accelerators handling, without
                        AcceleratorTable (not tested for all cases)
  USE_DROPDOWNCOUNT     - to force setting combobox dropdown count.
  NOT_UNLOAD_RICHEDITLIB - to stop unload Rich Edit library in finalization
                        section (to economy several byte of code).
  NOT_USE_RICHEDIT      - not use richedit (it will not be possible to create richedit)
  TV_DRAG_RBUTTON       - to allow dragging tree view items with right mouse
                          button too.
  TOOLBAR_FORCE_CHILDALIGN - this option provides Align working for child
                          controls of the toolbar control, but when with this option
                          is turned on it is impossible to have neighbour controls
                          on a form correctly aligned. This last disadvantage is
                          not important if a toolbar is always placed on a separate
                          panel-like control as a child.
                          Note: this option has no effect for Win9x, still use of
                          it under Win9x can crash the application!!!
  TOOLBAR_DOT_NOAUTOSIZE_BUTTON - this option forces prefix dot character in
                          button caption to be treated as an instruction to
                          remove TBSTYLE_AUTOSIZE from the button style. Actually,
                          this feature not necessary still custom button size can
                          be set even if such style is on for a button.
  CANRESIZE_THICKFRAME  - to use elder version of CanResize, changing border
                          style of the window (this cause incorrect form view in
                          Vista Aero theme (due a bug in Vista?)).
  ANCHORS_WM_SIZE       - to check WM_SIZE message in Anchor handling window
                          procedure. By default, now used WM_WINDOWPOSCHANGED.
  USE_PROP              - to use GetProp / SetProp (old style) in place of
                          Get / SetWindowLong( wnd, GWL_USERDATA... ) (slower?)

  PROVIDE_EXITCODE      - PostQuitMessage( value ) assigns value to ExitCode
  INITIALFORMSIZE_FIXMENU - form size initially is really the same as defined at
                          design time even for forms having main menu bar
  USE_GRAPHCTLS         - to use graphic (non-windowed) controls
  RICHEDIT_XPBORDER     - provide correct drawing rich edit control border with
                          XP themes.
  GRAPHCTL_XPSTYLES     - to use XP themed Visual styles for drawing graphic
                          controls. This does not affect windowed controls
                          which visual style is controlled by the manifest.
                          This option also turns on RICHEDIT_XPBORDER option.
  GRAPHCTL_HOTTRACK     - to use hot-tracking also together with XP themed
                          graphic controls (otherwise only static XP themed
                          view is provided). Also, turn this option on if you
                          want to handle OnMouseEnter and OnMouseLeabe events
                          for graphic controls.
  NEW_OPEN_DIR_STYLE_EX - to use new code for TOpenDirDialog, which provides
                          correct working of the dialog with an option
                          odNewDialogStyle set (even in Windows 9x system).
  HTMLHELP_NOTOP        - when Html help is called, its window become a child of
                          the desktop, not application (in such case it is not
                          closed together with the application, and it is apper
                          not on top of the application).
  ICON_DIFF_WH          - to support icons having Width <> Height
  ICONLOAD_PRESERVEBMPS - when an icon is loaded, its bitmap and mask are
                          extracted and in case when such symbol is defined,
                          these one or two bitmaps are preserved until TIcon
                          object is destroyed.
  LOADEX                - to use TBitmap.LoadFromStreamEx while loading icon
                          from a stream or a file.
  USE_OLDCONVERT2MASK   - to use elder Convert2Mask method (newer is more correct).
  FIX_TRANSPBMPPALETTE  - for TBitmap.StretchDrawMasked, bitmaps with PixelFormat
                          = pf4bit or pf8bit are first converted (in a temporary
                          TBitmap object) to pf32bit, and then are drawn. This
                          fixes problems with palette usage for such DIB bitmaps.
  FILL_BROKEN_BITMAP    - TBitmap.LoadFromStreamEx: broken bitmaps rest of
                          scanlines are be filled with zeroes (usually black color)
                          rather then left containing trash memory bits.
  AUTO_REPLACE_CLEARTYPE- to replace automatically CLEARTYPE_QUALITY fonts
                          with ANTIALIASED_QUALITY when running under elder
                          Windows version than XP.
  FORCE_ALTERNATEFILENAME- TDirList.ScanDirectoryFORCE_ALTERNATEFILENAME - forced
                          using an alternate file path and filename for unicode
                          paths (ïðèíóäèòåëüíîå èñïîëüçîâàíèå àëüòåðíàòèâíîãî èìåíè
                          ïóòè è èìåíè ôàéëà äëÿ þíèêîä ïóòåé)

  NEW_GRADIENT - to use new gradient painting by homm (fast).
  OLD_ALIGN    - to prevent using new Align by Galkov.
  NEW_ALIGN    - (default) - to use new Align implementation (faster).
  OLD_TRANSPARENT       - to prevent using NEW_TRANSPARENT
  NEW_TRANSPARENT       - created by Alexander Karpinsky a.k.a. homm (faster)
  SBOX_OLDPOS           - to use elder formulas to calculate scroll box positions
                          (just for compatibility with very old apps using it).
  OLD_REFCOUNT          - to prevent using new RefInc / RefDec behaviour
                          (new style of using RefCount works better).
  OLD_FREE              - to declare Free as a method as in earlier versions of KOL.
                          In new versions, Free is declared as a property, and
                          "calling" it just redirects call to RefDec. OLD_FREE
                          can be used for compatibility with compilers not
                          understanding "calling" a property without assigning
                          something to or from it (Turbo Delphi?).
  SCROLL_OLD            - for compatibility with the old applications using
                          TScrollBar: there was another method of adjusting
                          SBMax and SBPageSize: SBMax should be corrected to
                          (nMaxItems-1-SBPageSize).
  FILE_EXISTS_EX - to use more correct (but a bit large code in FileExists functon)
  USE_AUTOFREE4CONTROLS - (default) - from 2.40, most of control sub-objects are
                          destroying using Add2AutoFree (smaller code).
  NOT_USE_AUTOFREE4CONTROLS - this option returns to previous behaviour (just to
                          compare code size). Will be deprecated in future.
                          Ignored when UNION_FIELDS is used (by default)
  ENDSESSION_HALT - to halt the process when WM_ENDSESSION comes.
  FILESTREAM_POSITION   - in PAS_VERSION, Stream..fData.fPosition always show
                          current position (for debug purposes)
  PSEUDO_THREADS        - to use pseudo-threads instead of normal threads.
  WAIT_SLEEP            - for PSEUDO_THREADS: sleep 10 ms in a
                          WaitForMultipleObjects loop.
  ENUM_DYN_HANDLERS_AFTER_RUN - to allow all the events handling even when
                        AppletTerminated become TRUE.
  STOP_WNDPROCTRANSPARENT_AFTER_APPLETTERMINATED - use this long-named otpion to
                          prevent any functionality of WndProcTransparent after
                          AppletTerminated is set to true.
  STOPTIMER_AFTER_APPLETTERMINATED - use this symbol to prevent timer event
                          firing after setting AppletTerminated to TRUE.
  TIMER_APPLETWND       - to use Applet window to handle WM_TIMER events
                          (otherwise special single invisible window is created
                          to handle such events).
  SUPPORT_LONG_TIMER    - LINUX only: set this option if TTimer.Interval can be
                          set to a value greater then 1,800,000 (30 minutes).
  DEBUG_MENU            - to debug menu.
  DEBUG_GDIOBJECTS      - to allow counting all the GDI objects used.
  CHK_BITBLT            - to check BitBlt operations.
  DEBUG_ENDSESSION      - to allow debugging WM_ENDSESSION handling.
  DEBUG_CREATEWINDOW    - to debug CreateWindow.
  CRASH_DEBUG           - to fill object memory with $DD before freeing it
                          (program really crashes when the object is
                          attempted to destroy more then once and in most
                          cases when a destroyed object is accessed after the
                          destruction).
  DEBUG_MCK             - specially designed to debug Mirror Classes Kit.
  DEBUG_OBJKIND         - for each TControl object kind a reference to PChar
                          with object kind name is stored in the structure of
                          the object (field fObjKind).
  DEBUG                 - other debugging.
  EXTERNAL_DEFINES      - if count of options necessary to set is very large
                          Delphi ignores past of those. To avoid this problem,
                          set only this option in Project's options, and place
                          all other options to ExternalDefines.inc file as a
                          sequence of {$DEFINE ... directives.
                          But note, such file should be located in a
                          project directory, but not in the directory where KOL.pas
                          is located. This is enough to provide different sets
                          of defines for each project.
  ---- from version 3.00, following symbols are added:
  USE_FLAGS             - to compress boolean flags used (about 6 bytes instead
                          more then 50 flags occupying earlies 1 byte for each
                          flag). This option is turned on by default. To turn off,
                          define a symbol USE_OLD_FLAGS !
  EVENTS_DYNAMIC        - to create events record (about 600 bytes) only for
                          controls having assigned events. To turn off, define a
                          symbol EVENTS_STATIC.
  NIL_EVENTS            - by default, is off. This option returns back again checking
                          TControl's events if it is assigned before calling. By
                          default, now this option is off, all events are assigned
                          to dummy event handlers at create, so checking if the handler
                          is assigned is not necessary. But it is not allowed to
                          assign NIL to the event, instead call ResetEvent method
                          with the correspondent index (e.g. idx_fOnMessage).
  COMMANDACTIONS_OBJ    - to store command actions certain for different control
                          kinds in shared objects, separately from TControl object
                          instances. To turn off, define a symbol COMMANDACTIONS_RECORD.
  PACK_COMMANDACTIONS   - this option must be defined together with COMMANDACTIONS_OBJ
                          and must not with COMMANDACTIONS_RECORD (just do nothing
                          and this is applied automatically).
  |</pre>
}
{= K.O.L - êëþ÷åâàÿ áèáëèîòåêà îáúåêòîâ. (C) Êëàäîâ Âëàäèìèð, 2000-2007.
}

{$A-} // align off, otherwise code is not good

{$Q-} // no overflow check: this option makes code wrong
{$R-} // no range checking: this option makes code wrong
{$T-} // not typed @-operator
//{$D+}
//______________________________________________________________________________
//
//{$DEFINE INPACKAGE} // Uncomment this line while rebuild MCK package
// for Delphi3 only, then restore the comment mark!!!!!!!!!!!!!!!!!!!!
//______________________________________________________________________________

{$IFDEF INPACKAGE} // use this symbol in packages requiring kol.pas
  {$WARNINGS OFF}
  //{$DEFINE NOT_USE_AUTOFREE4CONTROLS}
  {$DEFINE PAS_VERSION}
  {$UNDEF ASM_VERSION}
  {$UNDEF ASM_UNICODE}
  {$IFDEF _D2009orHigher}
      {$DEFINE UNICODE_CTRLS}
  {$ENDIF}
{$ENDIF}
{$IFDEF _D7orHigher}
  {$WARN UNSAFE_TYPE OFF} // Too many such warnings in Delphi7
  {$WARN UNSAFE_CODE OFF}
  {$WARN UNSAFE_CAST OFF}
{$ENDIF}

interface

{$IFnDEF CREATE_VISIBLE}
         {$DEFINE CREATE_HIDDEN}
{$ENDIF}

{$IFDEF NEW_ALIGN}
  {$UNDEF OLD_ALIGN}
{$ELSE}
  {$IFNDEF OLD_ALIGN}
    {$DEFINE NEW_ALIGN}
  {$ENDIF}
{$ENDIF}

{$IFDEF OLD_ALIGN}
  {$UNDEF NEW_ALIGN}
{$ELSE}
  {$IFNDEF NEW_ALIGN}
    {$DEFINE NEW_ALIGN}
  {$ENDIF}
{$ENDIF}

{$IFNDEF OLD_TRANSPARENT}
  {$DEFINE NEW_TRANSPARENT}
{$ENDIF}

{$IFNDEF NOT_UNION_FIELDS}
         {$DEFINE UNION_FIELDS}
{$ENDIF}

{$IFDEF UNION_FIELDS}
        {$UNDEF NOT_USE_AUTOFREE4CONTROLS}
{$ENDIF}

{$IFNDEF NOT_USE_AUTOFREE4CONTROLS}
  {$DEFINE USE_AUTOFREE4CONTROLS}
  {$DEFINE USE_AUTOFREE4CHILDREN}
{$ENDIF}

{$IFDEF SMALLEST_CODE}
  {$DEFINE NOT_UNLOAD_RICHEDITLIB}
  {$DEFINE SMALLER_CODE}
  {$DEFINE CREATE_VISIBLE}
{$ELSE}
  {$IFnDEF SPEED_NORMAL}
           {$DEFINE SPEED_FASTER}
  {$ENDIF}
{$ENDIF}
{$IFDEF _D2}
        {$UNDEF SPEED_FASTER}
{$ENDIF}

{$IFDEF SAFE_CODE}
        {$UNDEF NO_SAFE_CODE}
{$ENDIF}
{$IFDEF NO_SAFE_CODE}
        {$UNDEF SAFE_CODE}
{$ENDIF}
{$IFnDEF NO_SAFE_CODE}
{$IFnDEF SMALLER_CODE}
        {$DEFINE SAFE_CODE}
{$ENDIF}
{$ENDIF}

{$IFDEF NOT_USE_RICHEDIT}
  {$DEFINE NOT_UNLOAD_RICHEDITLIB}
{$ENDIF}

//{$DEFINE DEBUG_GDIOBJECTS}
//{$DEFINE CHK_GDI}

uses {$IFDEF WIN}messages, windows {$IFNDEF NOT_USE_RICHEDIT}, RichEdit {$ENDIF}{$ENDIF WIN}
     {$IFDEF LIN}, Libc, Xlib{$ENDIF}
     {$IFDEF GTK}, Glib2 , Gdk2, Gtk2, pango {$ENDIF GTK}
     {$IFDEF CHK_GDI}, ChkGdi {$ENDIF};

{$IFDEF LIN}
  {$DEFINE global_declare} {$I KOL_Linux.inc} {$UNDEF global_declare}
////type HDC = TGC; // from Xlib (temporary definition?)
{$ENDIF LIN}

var
  AppTheming: Boolean;
{$IFDEF DEBUG_GDIOBJECTS}
var
  BrushCount: Integer;
  FontCount: Integer;
  PenCount: Integer;
{$ENDIF}

{$IFDEF _D2009orHigher}
type KOLWideString = UnicodeString;
{$ELSE}
{$IFDEF _D3orHigher}
type KOLWideString = WideString;
{$ENDIF}
{$ENDIF}

{$IFDEF UNICODE_CTRLS}
  {$IFDEF _D2}
    {$ERROR 'Delphi 2 cannot compile with UNICODE_CTRLS defined!'}
  {$ENDIF}
const
	SizeOfKOLChar = SizeOf(WideChar);

 type
	 KOLString = KOLWideString;
         KOL_String = type KOLWideString;
	 KOLChar = type WideChar;
	 PKOLChar = PWideChar;
         PKOL_Char = type PWideChar;
{$ELSE}
const
	SizeOfKOLChar = SizeOf(AnsiChar);

 type
	 KOLString = AnsiString;
         KOL_String = type AnsiString;
	 KOLChar = type AnsiChar;
	 PKOLChar = PAnsiChar;
         PKOL_Char = type PAnsiChar;
   {$IFDEF ASM_VERSION}
     {$IFNDEF ASM_NOUNICODE}
       {$DEFINE ASM_UNICODE}
     {$ENDIF}
     {$UNDEF PAS_VERSION}
   {$ENDIF}
{$ENDIF}

{$IFNDEF ASM_VERSION}
  {$DEFINE PAS_VERSION}
{$ENDIF ASM_VERSION}

{$IFDEF PAS_VERSION}
        {$UNDEF ASM_VERSION}
        {$UNDEF ASM_UNICODE}
        {$UNDEF ASM_TLIST}
{$ENDIF}

{BCB++}(*type DWORD = Windows.DWORD;*){--BCB}

{$IFDEF WIN}
//{_#IF [DELPHI]}
  {$INCLUDE delphicommctrl.inc}
  {$IFNDEF FPC}
    {$IFDEF UNICODE_CTRLS}
      {$DEFINE interface_part} {$I KOL_unicode.inc} {$UNDEF interface_part}
    {$ELSE} // ANSI_CTRLS
      {$DEFINE interface_part} {$I KOL_ansi.inc} {$UNDEF interface_part}
    {$ENDIF UNICODE_CTRLS}
  {$ENDIF}
//{_#ENDIF}
{$ENDIF WIN}

type
   _TObj = object
   {* auxiliary object type. See TObj. }
   protected
     procedure Init; virtual;
     {* Is called from a constructor to initialize created object instance
        filling its fields with 0. Can be overriden in descendant objects
        to add another initialization code there. (Main reason of intending
        is what constructors can not be virtual in poor objects). }
     {= Âûçûâàåòñÿ äëÿ èíèöèàëèçàöèè îáúåêòà. }
   public
     function VmtAddr: Pointer;
     {* Returns addres of virtual methods table of object. ? }
     {= âîçâðàùàåò àäðåñ òàáëèöû âèðòóàëüíûõ ìåòîäîâ (VMT). ? }
   end;

  PObj = ^TObj;
  {* }

  PList = ^TList;
  {* }

   PPointerList = ^TPointerList;
   TPointerList = array[0..{$IFDEF _DXE2orHigher} 65536
                           {$ELSE} MaxInt div 4 - 1 {$ENDIF}] of Pointer;

  TObjectMethod = procedure of object;
  {* }
  TOnEvent = procedure( Sender: PObj ) of object;
  {* This type of event is the most common - event handler when called can
     know only what object was a sender of this call. Replaces good known
     VCL TNotifyEvent event type. }

  TOnEventMoving = procedure( Sender: PObj; P: PRect ) of object;

{ ---------------------------------------------------------------------
                  TObj - base object to derive all others
---------------------------------------------------------------------- }
//[TObj DEFINITION]
   TObj = object( _TObj )
   {* Prototype for all objects of KOL. All its methods are important to
      implement objects in a manner similar to Delphi TObject class. }
   {= Áàçîâûé êëàññ äëÿ âñåõ ïðî÷èõ îáúåêòîâ KOL. }
   protected
     {$IFDEF DEBUG_OBJKIND}
     fObjKind: PChar;
     {$ENDIF}
     fRefCount: Integer;
     fOnDestroy: TOnEvent;
     {$IFDEF OLD_REFCOUNT}
     procedure DoDestroy;
     {$ENDIF}
   protected
     fAutoFree: PList;
     {* Is called from a constructor to initialize created object instance
        filling its fields with 0. Can be overriden in descendant objects
        to add another initialization code there. (Main reason of intending
        is what constructors can not be virtual in poor objects). }
     {= Âûçûâàåòñÿ äëÿ èíèöèàëèçàöèè îáúåêòà. }
     fTag: DWORD;
     {* Custom data. }
   public
     destructor Destroy; virtual;
     {* Disposes memory, allocated to an object. Does not release huge strings,
        dynamic arrays and so on. Such memory should be freeing in overriden
        destructor. }
     {= Îñâîáîæäàåò ïàìÿòü, âûäåëåííóþ äëÿ îáúåêòà. Íå îñâîáîæäàåò ïàìÿòü, âûäåëåííóþ
        äëÿ ñòðîê, äèíàìè÷èñêèõ ìàññèâîâ è ò.ï. Òàêàÿ ïàìÿòü äîëæíà áûòü îñâîáîæäåíà
        â ïåðåîïðåäåëåííîì äåñòðóêòîðå îáúåêòà. }
     {$IFnDEF NIL_EVENTS}
     //procedure Init; virtual;
     {* Can be overriden in descendant objects
        to add initialization code there. (Main reason of intending
        is what constructors can not be virtual in poor objects). }
     {$ENDIF NIL_EVENTS}
     procedure Final;
     {* It is called in destructor to perform OnDestroy event call and to
        released objects, added to fAutoFree list. }
   public
     procedure RefInc;
     {* See comments below. }
     {= Ñì. RefDec íèæå. }
     function RefDec: Integer;
     {* Decrements reference count. If it is becoming <0, and Free
        method was already called, object is (self-) destroyed. Otherwise,
        Free method does not destroy object, but only sets flag
        "Free was called".
     |<br>
        Use RefInc..RefDec to provide a block of code, where
        object can not be destroyed by call of Free method.
        This makes code more safe from intersecting flows of processing,
        where some code want to destroy object, but others suppose that it
        is yet existing.
     |<br>
        If You want to release object at the end of block RefInc..RefDec,
        do it immediately BEFORE call of last RefDec (to avoid situation,
        when object is released in result of RefDec, and attempt to
        destroy it follow leads to AV exception).
     |<br>
         Actually, this "function" is a procedure and does not return
         any sensible value. It is declared as a function for internal
         needs (to avoid creating separate code for Free method)
     }
     {= Óìåíüøàåò ñ÷åò÷èê èñïîëüçîâàíèÿ. Åñëè â ðåçóëüòàòå ñ÷åò÷èê ñòàíîâèòñÿ
        < 0, è ìåòîä Free óæå áûë âûçâàí, îáúåêò (ñàìî-) ðàçðóøàåòñÿ. Èíà÷å,
        ìåòîä Free íå ðàçðóøàåò îáúåêò, à òîëüêî óñòàíàâëèâàåò ôëàã "Free áûë
        âûçâàí".
        |<br>
        Èñïîëüçóéòå RefInc..RefDec äëÿ ïðåäîòâðàùåíèÿ ðàçðóøåíèÿ îáúåêòà íà
        íåêîòîðîì ó÷àñòêå êîäà (åñëè åñòü òàêàÿ íåîáõîäèìîñòü).
        |<br>
        Åñëè íóæíî óáèòü (âðåìåííûé) îáúåêò âìåñòå ñ ïîñëåäíèì RefDec, ñäåëàéòå
        âûçîâ Free íåìåäëåííî ÏÅÐÅÄ ïîñëåäíèì RefDec. }
     property RefCount: Integer read fRefCount;
     {* }
     {$IFDEF OLD_FREE}
     procedure Free;
     {$ELSE NEW_FREE}
     property Free: Integer read RefDec;
     {* Before calling destructor of object, checks if passed pointer is not
        nil - similar what is done in VCL for TObject. It is ALWAYS recommended
        to use Free instead of Destroy - see also comments to RefInc, RefDec. }
     {= Äî âûçîâà äåñòðóêòîðà, ïðîâåðÿåò, íå ïåðåäàí ëè nil â êà÷åñòâå ïàðàìåòðà.
        ÂÑÅÃÄÀ ðåêîìåíäóåòñÿ èñïîëüçîâàòü Free âìåñòî Destroy - ñì. òàê æå RefInc,
        RefDec. }
     {$ENDIF NEW_FREE}

     // By Vyacheslav Gavrik:
     function InstanceSize: Integer;
     {* Returns a size of object instance. }

     constructor Create;
     {* Constructor. Do not call it. Instead, use New<objectname> function
        call for certain object, e.g., NewLabel( AParent, 'caption' ); }
     {= Êîíñòðóêòîð. Íå ñëåäóåò âûçûâàòü åãî. Äëÿ êîíñòðóèðîâàíèÿ îáúåêòîâ,
        âûçûâàéòå ñîîòâåòñòâóþùóþ ãëîáàëüíóþ ôóíêöèþ New<èìÿ-îáúåêòà>. Íàïðèìåð,
        NewLabel( MyForm, 'Ìåòêà¹1' ); }
     class function AncestorOfObject( Obj: Pointer ): Boolean;
     {* Is intended to replace 'is' operator, which is not applicable to objects. }
     function VmtAddr: Pointer;
     {* Returns addres of virtual methods table of object. }
     {= âîçâðàùàåò àëðåñ òàáëèöû âèðòóàëüíûõ ìåòîäîâ (VMT). }
     property OnDestroy: TOnEvent read fOnDestroy write fOnDestroy;
     {* This event is provided for any KOL object, so You can provide your own
        OnDestroy event for it. }
     {= Äàííîå ñîáûòèå îáåñïå÷èâàåòñÿ äëÿ âñåõ îáúåêòîâ KOL. Ïîçâîëÿåò ñäåëàòü
        ÷òî-íèáóäü â ñâÿçè ñ ðàçðóøåíèåì îáúåêòà. }
    procedure Add2AutoFree( Obj: PObj );
    {* Adds an object to the list of objects, destroyed automatically
       when the object is destroyed. Do not add here child controls of
       the TControl (these are destroyed by another way). Only non-control
       objects, which are not destroyed automatically, should be added here. }
    procedure Add2AutoFreeEx( Proc: TObjectMethod );
    {* Adds an event handler to the list of events, called in destructor.
       This method is mainly for internal use, and allows to auto-destroy
       VCL components, located on KOL form at design time (in MCK project). }
    procedure RemoveFromAutoFree( Obj: PObj );
    {* Removes an object from auto-free list }
    procedure RemoveFromAutoFreeEx( Proc: TObjectMethod );
    {* Removes a procedure from auto-free list }
    property Tag: DWORD read fTag write fTag;
    {* Custom data field. }
   protected
     {$IFDEF USE_NAMES}
     fName: AnsiString;
     fNamedObjList: Plist;
     fOwnerObj: PObj;
     {$ENDIF}
   public
     {$IFDEF USE_NAMES}
     procedure SetName( NewOwnerObj: PObj; NewName: AnsiString);
     property  Name: Ansistring read FName;

     property  NamedObjList : PList read fNamedObjList;
     property  OwnerObj: PObj read FOwnerObj;
     function  FindObj(const ObjName: Ansistring): PObj;
     {$ENDIF}
   end;

{ ---------------------------------------------------------------------
        TList - object to implement list of pointers (or dwords)
---------------------------------------------------------------------- }
  TList = object( TObj )
  {* Simple list of pointers. It is used in KOL instead of standard VCL
     TList to store any kind data (or pointers to these ones). Can be created
     calling function NewList. }
  {= Ïðîñòîé ñïèñîê óêàçàòåëåé. }
  protected
    fItems: PPointerList;
    fCount: Integer;
    fCapacity: Integer;
    fAddBy: Integer;
    procedure SetCount(const Value: Integer);
    procedure SetAddBy(Value: Integer);
    destructor Destroy; virtual;
    {* Destroys list, freeing memory, allocated for pointers. Programmer
       is resposible for destroying of data, referenced by the pointers. }
    procedure SetCapacity( Value: Integer );
    function Get( Idx: Integer ): Pointer;
    procedure Put( Idx: Integer; Value: Pointer );
    {$IFDEF USE_CONSTRUCTORS}
    procedure Init; virtual;
    {$ENDIF}
  protected
    {$IFDEF TLIST_FAST}
    fBlockList: PList;
    fLastKnownBlockIdx: Integer;
    fLastKnownCountBefore: Integer;
    fUseBlocks: Boolean;
    fNotOptimized: Boolean;
    {$ENDIF}
  public
    procedure Clear;
    {* Makes Count equal to 0. Not responsible for freeing (or destroying)
       data, referenced by released pointers. }
    procedure Add( Value: Pointer );
    {* Adds pointer to the end of list, increasing Count by one. }
    procedure Insert( Idx: Integer; Value: Pointer );
    {* Inserts pointer before given item. Returns Idx, i.e. index of
       inserted item in the list. Indeces of items, located after insertion
       point, are increasing. To add item to the end of list, pass Count
       as index parameter. To insert item before first item, pass 0 there. }
    function IndexOf( Value: Pointer ): Integer;
    {* Searches first (from start) item pointer with given value and returns
       its index (zero-based) if found. If not found, returns -1. }
    procedure Delete( Idx: Integer );
    {* Deletes given (by index) pointer item from the list, shifting all
       follow item indeces up by one. }
    procedure DeleteRange( Idx, Len: Integer );
    {* Deletes Len items starting from Idx. }
    procedure Remove( Value: Pointer );
    {* Removes first entry of a Value in the list. }
    property Count: Integer read fCount write SetCount;
    {* Returns count of items in the list. It is possible to delete a number
       of items at the end of the list, keeping only first Count items alive,
       assigning new value to Count property (less then Count it is). }
    property Capacity: Integer read fCapacity write SetCapacity;
    {* Returns number of pointers which could be stored in the list
       without reallocating of memory. It is possible change this value
       for optimize usage of the list (for minimize number of reallocating
       memory operations). }
    property Items[ Idx: Integer ]: Pointer read Get write Put; default;
    {* Provides access (read and write) to items of the list. Please note,
       that TList is not responsible for freeing memory, referenced by stored
       pointers. }
    function Last: Pointer;
    {* Returns the last item (or nil, if the list is empty). }
    procedure Swap( Idx1, Idx2: Integer );
    {* Swaps two items in list directly (fast, but without testing of
       index bounds). }
    procedure MoveItem( OldIdx, NewIdx: Integer );
    {* Moves item to new position. Pass NewIdx >= Count to move item
       after the last one. }
    procedure Release;
    {* Especially for lists of pointers to dynamically allocated memory.
       Releases all pointed memory blocks and destroys object itself. }
    procedure ReleaseObjects;
    {* Especially for a list of objects derived from TObj.
       Calls Free for every of the object in the list, and then calls
       Free for the object itself. }
    property AddBy: Integer read fAddBy write SetAddBy;
    {* Value to increment capacity when new items are added or inserted
       and capacity need to be increased. }
    property DataMemory: PPointerList read fItems;
    {* Raw data memory. Can be used for direct access to items of a list.
       Do not use it for TLIST_FAST ! }
    procedure Assign( SrcList: PList );
    {* Copies all source list items. }
    {$IFDEF _D4orHigher}
    procedure AddItems( const AItems: array of Pointer );
    {* Adds a list of items given by a dynamic array. }
    {$ENDIF}
    function ItemAddress( Idx: Integer ): Pointer;
    {* Returns an address of memory occupying by the item with index Idx.
       (If the item is a pointer, returned value is a pointer to a pointer).
       Item with index requested must exist. }
  {$IFDEF TLIST_FAST}
    property UseBlocks: Boolean read fUseBlocks write fUseBlocks;
  {$ENDIF}
    procedure OptimizeForRead;
  end;

function NewList: PList;
{* Returns pointer to newly created TList object. Use it instead usual
   TList.Create as it is done in VCL or XCL. }

{$IFDEF _D4orHigher}
function NewListInit( const AItems: array of Pointer ): PList;
{* Creates a list filling it initially with certain Items. }
{$ENDIF}

{$IFNDEF TLIST_FAST}
{$IFNDEF PAS_ONLY}
procedure FastIncNum2Elements( List: TList; FromIdx, Count, Value: Integer );
{* Very fast adds Value to List elements from List[FromIdx] to List[FromIdx+Count-1].
   Given elements must exist. Count must be > 0. }
{$ENDIF}
{$ENDIF}

procedure Free_And_Nil( var Obj );
{* Obj.Free and Obj := nil, where Obj *MUST* be TObj or its descendant
   (TControl, TMenu, etc.) This procedure is not compatible with VCL's
   FreeAndNil, which works with TObject, since this it has another name. }

{$IFDEF WIN_GDI}
{ ------------------------------- threads ------------------------------------ }

const
  ABOVE_NORMAL_PRIORITY_CLASS = $8000; // only for Windows 2K
  BELOW_NORMAL_PRIORITY_CLASS = $4000; // and higher !

type
  PThread = ^TThread;

  TThreadMethod = procedure of object;
  TThreadMethodEx = procedure( Sender: PThread; Param: Pointer ) of object;

  TOnThreadExecute = function(Sender: PThread): Integer of object;
  {* Event to be called when Execute method is called for TThread }

{ ---------------------------------------------------------------------
                            TThread object
---------------------------------------------------------------------- }
  TThread = object(TObj)
  private
    function GetPriorityBoost: Boolean;
    procedure SetPriorityBoost(const Value: Boolean);
  {* Thread object. It is possible not to derive Your own thread-based
     object, but instead create thread Suspended and assign event
     OnExecute. To create, use one of NewThread of NewThreadEx functions,
     or derive Your own descendant object and write creation function
     (or constructor) for it.
     |<br><br>
     Aknowledgements. Originally class ZThread was developed for XCL:
     |<br> * By: Tim Slusher : junior@nlcomm.com
     |<br> * Home: http://www.nlcomm.com/~junior
   }
  protected
    FSuspended,
    FTerminated: Boolean;
    FHandle: THandle;
    FThreadId: DWORD;
    FOnSuspend: TObjectMethod;
    FOnResume: TOnEvent;
    FData : Pointer;
    FOnExecute : TOnThreadExecute;
    FMethod: TThreadMethod;
    FMethodEx: TThreadMethodEx;
    F_AutoFree: Boolean;
    FPriority: Integer;
    function GetPriorityCls: Integer;
    function GetThrdPriority: Integer;
    procedure SetPriorityCls(Value: Integer);
    procedure SetThrdPriority(Value: Integer);
    procedure Init; virtual;
    destructor Destroy; virtual;
    {* }
  public
    {$IFDEF PSEUDO_THREADS}
    FPrtyCls: Integer;
    DoNotWakeUntil: DWORD;
    AllThreads: PList;        // only for MainThread
    CurrentThread: PThread;
    StackBottom: Pointer;     // except for MainThread
    CurStackPos: Pointer;
    Stack_Empty: Boolean;
    procedure SwitchToThread( T: PThread ); // methods of MainThread
    procedure NextThread;
    {$ENDIF}
  public
    FResult: Integer;
    function Execute: integer; virtual;
    {* Executes thread. Do not call this method from another thread! (Even do
       not call this method at all!) Instead, use Resume.
       |<br>
       Note also that in contrast to VCL, it is not necessary to create your
       own descendant object from TThread and override Execute method. In KOL,
       it is sufficient to create an instance of TThread object (see NewThread,
       NewThreadEx, NewThreadAutoFree functions) and assign OnExecute event
       handler for it. }
    procedure Resume;
    {* Continues executing. It is necessary to make call for every
       nested Suspend. }
    procedure Suspend;
    {* Suspends thread until it will be resumed. Can be called from another
       thread or from the thread itself. }
    procedure Terminate;
    {* Terminates thread. }
    function WaitFor: Integer;
    {* Waits (infinitively) until thead will be finished. }
    function WaitForTime( T: DWORD ): Integer;
    {* Waits (T milliseconds) until thead will be finished. }

    property Handle: THandle read FHandle;
    {* Thread handle. It is created immediately when object is created
       (using NewThread). }
    property Suspended: Boolean read FSuspended;
    {* True, if suspended. }
    property Terminated: Boolean read FTerminated;
    {* True, if terminated. }
    property ThreadId: DWORD read FThreadId;
    {* Thread id. }
    property PriorityClass: Integer read GetPriorityCls write SetPriorityCls;
    {* Thread priority class. One of following values: HIGH_PRIORITY_CLASS,
       IDLE_PRIORITY_CLASS, NORMAL_PRIORITY_CLASS, REALTIME_PRIORITY_CLASS. }
    property ThreadPriority: Integer read GetThrdPriority write SetThrdPriority;
    {* Thread priority value. One of following values: THREAD_PRIORITY_ABOVE_NORMAL,
       THREAD_PRIORITY_BELOW_NORMAL, THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_IDLE,
       THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_TIME_CRITICAL. }
    property Data : Pointer read FData write FData;
    {* Custom data pointer. Use it for Youe own purpose. }

    property OnExecute: TOnThreadExecute read FOnExecute write FOnExecute;
    {* Is called, when Execute is starting. }
    property OnSuspend: TObjectMethod read FOnSuspend write FOnSuspend;
    {* Is called, when Suspend is performed. }
    property OnResume: TOnEvent read FOnResume write FOnResume;
    {* Is called, when resumed. }
    procedure Synchronize( Method: TThreadMethod );
    {* Call it to execute given method in main thread context. Applet variable
       must exist for that time. }
    procedure SynchronizeEx( Method: TThreadMethodEx; Param: Pointer );
    {* Call it to execute given method in main thread context, with a given
       parameter. Applet variable must exist for that time. Param must not be nil. }
    {$IFDEF USE_CONSTRUCTORS}
    constructor ThreadCreate;
    constructor ThreadCreateEx( const Proc: TOnThreadExecute );
    {$ENDIF USE_CONSTRUCTORS}

    property AutoFree: Boolean read F_AutoFree write F_AutoFree;
    {* Set this property to true to provide automatic destroying of thread
       object when its executing is finished. }
    property PriorityBoost: Boolean read GetPriorityBoost write SetPriorityBoost;
    {* By default, priority boost is enabled for all threads. }
  end;

function NewThread: PThread;
{* Creates thread object (always suspended). After creating, set event
   OnExecute and perform Resume operation. }

function NewThreadEx( const Proc: TOnThreadExecute ): PThread; stdcall;
{* Creates thread object, assigns Proc to its OnExecute event and runs
   it. }

function NewThreadAutoFree( const Proc: TOnThreadExecute ): PThread;
{* Creates thread object similar to NewThreadEx, but freeing automatically
   when executing of such thread finished. Be sure that a thread is resumed
   at least to provide its object keeper freeing. }

{$IFDEF PSEUDO_THREADS}
var MainThread: PThread;
    PseudoThreadStackSize: DWORD = 1024 * 1024;
    CreatingMainThread: Boolean;

function WaitForSingleObject( hHandle: THandle; dwMilliseconds: DWORD ): DWORD; stdcall;
function WaitForMultipleObjects( nCount: DWORD;
  lpHandles: PHandle; fWaitAll: BOOL; dwMilliseconds: DWORD ): DWORD; stdcall;
procedure Sleep( n: DWORD );
{$ENDIF}

{ ----------------------------------- streams -------------------------------- }

{$ENDIF WIN_GDI}
type
  TMoveMethod = ( spBegin, spCurrent, spEnd );
{$IFDEF WIN_GDI}
type
  {$IFDEF STREAM_LARGE64}
  TStrmSize = Int64;
  TStrmMove = Int64;
    {$UNDEF ASM_STREAM}
    {$UNDEF STREAM_COMPAT}
  {$ELSE}
  TStrmSize = DWORD;
  TStrmMove = Integer;
    {$IFDEF ASM_VERSION}
      {$IFNDEF ASM_NOSTREAM}
        {$DEFINE ASM_STREAM}
      {$ENDIF}
    {$ENDIF}
  {$ENDIF}

  PStream = ^TStream;

  PStreamMethods = ^TStreamMethods;
  TStreamMethods = Packed Record
    fSeek: function( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveMethod: TMoveMethod ): TStrmSize;
    fGetSiz: function( Strm: PStream ): TStrmSize;
    fSetSiz: procedure( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Value: TStrmSize );
    fRead: function( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
    fWrite: function( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
    fClose: procedure( Strm: PStream );
    fCustom: Pointer;
    fWait: procedure( Strm: PStream );
  end;

  TStreamData = Packed Record
    fHandle: THandle;
    fCapacity, fSize, fPosition: TStrmSize;
    fThread: PThread;
    CASE Integer OF
    2: (
         fStream1,
         fStream2: PStream;
       );
    3: (
         fBaseStream: PStream;
         fFromPos: TStrmSize;
       );
    4: (
         fBlkSize: Integer;
         fBlocks: PList;
         fJustWrittenBlkAddress: Pointer;
       );
  end;

{ ---------------------------------------------------------------------
                TStream - streaming objects incapsulation
---------------------------------------------------------------------- }
  TStream = object(TObj)
  {* Simple stream object. Can be opened for file, or as memory stream (see
     NewReadFileStream, NewWriteFileStream, NewMemoryStream, etc.). And, another
     type of streaming object can be derived (without inheriting new object
     type, just by writing another New...Stream method, which calls
     _NewStream and pass methods record to it). }
  protected
    fPMethods: PStreamMethods;
    fMethods: TStreamMethods;
    fMemory: Pointer;
    fData: TStreamData;
    fParam1, fParam2: TStrmMove; // parameters to use in thread
    fOnChangePos: TOnEvent;
    function GetCapacity: TStrmSize;
    procedure SetCapacity(const Value: TStrmSize);
    function DoAsyncRead( Sender: PThread ): Integer;
    function DoAsyncWrite( Sender: PThread ): Integer;
    function DoAsyncSeek( Sender: PThread ): Integer;
  protected
    function GetFileStreamHandle: THandle;
    procedure SetPosition(const Value: TStrmSize);
    function GetPosition: TStrmSize;
    function GetSize: TStrmSize;
    procedure SetSize(const NewSize: TStrmSize);
    destructor Destroy; virtual;
  public
    function Read(var Buffer; const Count: TStrmSize): TStrmSize;
    {* Reads Count bytes from a stream. Returns number of bytes read. }
    function Seek({$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveMethod: TMoveMethod): TStrmSize;
    {* Allows to change current position or to obtain it. Property
       Position uses this method both for get and set position. }
    function Write(var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize): TStrmSize;
    {* Writes Count bytes from Buffer, starting from current position
       in a stream. Returns how much bytes are written. }
    function WriteVal( Value: DWORD; Count: DWORD ): DWORD;
    {* Writes maximum 4 bytes of Value to a stream. Allows writing constants
       easier than via Write. }
    function WriteStr( S: AnsiString ): DWORD;
    {* Writes string to the stream, not including ending #0. Exactly
       Length( S ) characters are written. }
    function WriteStrZ( S: AnsiString ): DWORD;
    {* Writes string, adding #0. Number of bytes written is returned. }
    {$IFDEF _D3orHigher}
    function WriteWStrZ( S: KOLWideString ): DWORD;
    {* Writes string, adding #0. Number of bytes written is returned. }
    {$ENDIF}
    function ReadStrZ: AnsiString;
    {* Reads string, finished by #0. After reading, current position in
       the stream is set to the byte, follows #0. }
    {$IFDEF _D3orHigher}
    function ReadWStrZ: KOLWideString;
    {* Reads string, finished by #0. After reading, current position in
       the stream is set to the byte, follows #0. }
    {$ENDIF}
    function ReadStr: AnsiString;
    {* Reads string, finished by #13, #10 or #13#10 symbols. Terminating symbols
       #13 and/or #10 are not added to the end of returned string though
       stream positioned follow it. }
    function ReadStrLen( Len: Integer ): AnsiString;
    {* Reads string of the given length Len. }
    function WriteStrEx(S: AnsiString): DWord;
    {* Writes string S to stream, also saving its size for future use by
       ReadStrEx* functions. Returns number of actually written characters. }
    function ReadStrExVar(var S: AnsiString): DWord;
    {* Reads string from stream and assigns it to S.
       Returns number of actually read characters.
       Note:
         String must be written by using WriteStrEx function.
         Return value is count of characters READ, not the length of string. }
    function ReadStrEx: AnsiString;
    {* Reads string from stream and returns it. }
    function WriteStrPas( S: AnsiString ): DWORD;
    {* Writes a string in Pascal short string format - 1 byte length, then string
       itself without trailing #0 char. S parameter length should not exceed 255
       chars, rest chars are truncated while writing. Total amount of bytes
       written is returned. }
    function ReadStrPas: AnsiString;
    {* Reads 1 byte from a stream, then treat it as a length of following string
       which is read and returned. A purpose of this function is reading strings
       written using WriteStrPas. }
    property Size: TStrmSize read GetSize write SetSize;
    {* Returns stream size. For some custom streams, can be slow
       operation, or even always return undefined value (-1 recommended). }
    property Position: TStrmSize read GetPosition write SetPosition;
    {* Current position. }

    property Memory: Pointer read fMemory;
    {* Only for memory stream. }
    property Handle: THandle read GetFileStreamHandle;
    {* Only for file stream. It is possible to check that Handle <>
       INVALID_HANDLE_VALUE to ensure that file stream is created OK. }

    //---------- for asynchronous operations (using thread - not tested):
    procedure SeekAsync(MoveTo: TStrmMove; MoveMethod: TMoveMethod);
    {* Changes current position asynchronously. To wait for finishing the
       operation, use method Wait. }
    procedure ReadAsync(var Buffer; Count: DWord);
    {* Reads Count bytes from a stream asynchronously. To wait finishing the
       operation, use method Wait. }
    procedure WriteAsync(var Buffer; Count: DWord);
    {* Writes Count bytes from Buffer, starting from current position
       in a stream - asynchronously. To wait finishing the operation,
       use method Wait. }
    function Busy: Boolean;
    {* Returns TRUE until finishing the last asynchronous operation
       started by calling SeekAsync, ReadAsync, WriteAsync methods. }
    procedure Wait;
    {* Waits for finishing the last asynchronous operation. }

    property Methods: PStreamMethods read fPMethods;
    {* Pointer to TStreamMethods record. Useful to implement custom-defined
       streams, which can access its fCustom field, or even to change
       methods when necessary. }
    property Data: TStreamData read fData;
    {* Pointer to TStreamData record. Useful to implement custom-defined
    streams, which can access Data fields directly when implemented. }

    property Capacity: TStrmSize read GetCapacity write SetCapacity;
    {* Amound of memory allocated for data (MemoryStream). }

    procedure SaveToFile( const Filename: KOLString; const Start, CountSave: TStrmSize );
    {* }

    property OnChangePos: TOnEvent read fOnChangePos write fOnChangePos;
    {* To allow using this event, create stream with special constructing
       function like NewMemoryStreamWithEvent or NewReadFileStreamWithEvent,
       or replace reading / writing methods to certain supporting OnChangePos
       event. }
  end;

function _NewStream( const StreamMethods: TStreamMethods ): PStream;
{* Use this method only to define your own stream type. See also declared
   below (in KOL.pas) methods used to implement standard KOL streams. You can use it in
   your code to create streams, which are partially based on standard
   methods. }

// Methods below are declared here to simplify creating your
// own streams with some methods standard and some non-standard
// together:
function SeekFileStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
function GetSizeFileStream( Strm: PStream ): TStrmSize;
function ReadFileStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
function ReadFileStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
var ReadFileStreamProc: function( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize
    = ReadFileStream;

function WriteFileStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
function WriteFileStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
function WriteFileStreamEOF( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
function WriteFileStreamEOFWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
procedure CloseFileStream( Strm: PStream );
function SeekMemStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
function SeekMemStreamWithEvent( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
function GetSizeMemStream( Strm: PStream ): TStrmSize;

var CapacityMask: DWORD = $4000 - 1; // must be 2**n-1
procedure SetSizeMemStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
function ReadMemStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
function ReadMemStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
function WriteMemStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
function WriteMemStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
procedure CloseMemStream( Strm: PStream );
procedure SetSizeFileStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );

function ReadMemBlkStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
function SeekMemBlkStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
function WriteMemBlkStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
procedure ResizeMemBlkStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
procedure FreeMemBlkStream( Strm: PStream );

function SeekConcatStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
function GetSizeConcatStream( Strm: PStream ): TStrmSize;
procedure SetSizeConcatStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
function ReadConcatStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
function WriteConcatStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
procedure CloseConcatStream( Strm: PStream );

function SeekSubStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
function GetSizeSubStream( Strm: PStream ): TStrmSize;
procedure SetSizeSubStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
function ReadSubStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
function WriteSubStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
procedure CloseSubStream( Strm: PStream );

procedure DummyCloseStream( Strm: PStream );

function DummyReadWrite( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
procedure DummySetSize( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Value: TStrmSize );
procedure DummyStreamProc(Strm: PStream);

function NewFileStream( const FileName: KOLString; Options: DWORD ): PStream;
{* Creates file stream for read and write. Exact set of open attributes
   should be passed through Options parameter (see FileCreate where those
   flags are listed). }

function NewFileStreamWithEvent( const FileName: KOLString; Options: DWORD ): PStream;
{* Creates file stream for read and write. Exact set of open attributes
   should be passed through Options parameter (see FileCreate where those
   flags are listed). Also, resulting stream is supporting OnChangePos event. }

function NewReadFileStream( const FileName: KOLString ): PStream;
{* Creates file stream for read only. }

function NewReadFileStreamWithEvent( const FileName: KOLString ): PStream;
{* Creates file stream for read only, supporting OnChangePos event. }

function NewWriteFileStream( const FileName: KOLString ): PStream;
{* Creates file stream for write only. Truncating of file (if needed)
   is provided automatically. }

function NewWriteFileStreamWithEvent( const FileName: KOLString ): PStream;
{* Creates file stream for write only. Truncating of file (if needed)
   is provided automatically. Created stream supports OnChangePos event. }

function NewReadWriteFileStream( const FileName: KOLString ): PStream;
{* Creates stream for read and write file. To truncate file, if it is
   necessary, change Size property. }

{$IFDEF _D3orHigher}
function NewReadFileStreamW( const FileName: KOLWideString ): PStream;
{* Creates file stream for read only. }

function NewWriteFileStreamW( const FileName: KOLWideString ): PStream;
{* Creates file stream for write only. Truncating of file (if needed)
   is provided automatically. }

function NewReadWriteFileStreamW( const FileName: KOLWideString ): PStream;
{* Creates stream for read and write file. To truncate file, if it is
   necessary, change Size property. }
{$ENDIF}

function NewExFileStream( F: HFile ): PStream;
{* Creates read only stream to read from opened file or pipe from the current
   position.
   When stream is destroyed, file handle still not closed (your code should do
   this) and file position is not changed (after the last read operation). }

function NewMemoryStream: PStream;
{* Creates memory stream (read and write). }

function NewMemoryStreamWithEvent: PStream;
{* Creates memory stream (read and write). Created stream support OnChangePos
   event. }

function NewExMemoryStream( ExistingMem: Pointer; Size: DWORD ): PStream;
{* Creates memory stream on base of existing memory. It is not possible
   to write out of top bound given by Size (i.e. memory can not be resized,
   or reallocated. When stream object is destroyed this memory is not freed. }

function NewMemBlkStream( BlkSize: Integer ): PStream;
{* Creates memory stream which consists from blocks of given size. Contrary to
   a memory stream, contents of the blocks stream should not be accessed
   directly via fMemory but therefore it is possible to access its parts by
   portions written to blocks still those were written contigously. To do so,
   get an address of just written portion for further usage via field
   fJustWrittenBlkAddress. It is guarantee that blocks of memory allocated
   during write process never are relocated until destruction the stream. }

function NewMemBlkStream_WriteOnly( BlkSize: Integer ): PStream;
{* Same as NewMemoryStream}

function NewConcatStream( Stream1, Stream2: PStream ): PStream;
{* Creates a stream which is a concatenation of two source stream. After
   the call, both source streams are belonging to the resulting stream and these
   will be destroyed together with the resulting stream. (So forget about it).

   After the call, first stream will not be changed in size via methods of
   concatenated stream (and it is not recommended to use further Stream1 and
   Stream2 methods too). But Stream2 can still be increased, if it allows doing
   so when some data are appended or Size of resulting stream is changed (but
   not less then Stream1.Size).

   Nature and physical location of Stream1 and Stream2 are not important and
   can be absolutely different. But it is supposed that both streams are not
   compressed and its Size is known always and Seek operation is valid.

   This function accepts recursive (multi-level) usage: resulting concatenation
   stream can be used as a left or right parameter to create another concatenation
   stream later, so it is possible to build a tree of streams concatenated,
   concatenating this way several different streams and use it as a single
   data streaming object.
}

function NewSubStream( BaseStream: PStream; const FromPos, Size: TStrmSize ): PStream;
{* Creates a stream which is a subpart of BaseStream passes, starting from
   FromPos and with given Size. Like in function NewConcatStream, passes
   BaseStream become owned by newly created sub-stream object, and will be
   destroyed automatically together with a sub-stream.

   If you want to provide more long life time for a base stream (e.g. if you
   plan to use it after a sub-stream based on it is destroyed), use method
   RefInc for base stream once to prevent it from destroying when the sub-stream
   is destroyed.

   Note: be careful and avoid direct calling methods and properties of the base
   stream, while you have a sub-stream created on base it, since the sub-stream
   actually redirects all the requests to the parent base stream.

   Sub-stream accepts setting Size to greater value later, and if some data
   are written to it, it is written actually to the base stream, and when it
   is written beyond the end position, this will increase size of the base
   stream too (and if it is a file stream, this also will increase size of the
   file on which the base stream was created).

   This function accepts recursive (multi-level) usage: it is possible to create
   later another sub-stream on base of existing sub-stream, still it is actully
   can be treated as usual stream.
}

function Stream2Stream( Dst, Src: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
{* Copies Count (or less, if the rest of Src is not sufficiently long)
   bytes from Src to Dst, but with optimizing in cases, when Src or/and
   Dst are memory streams (intermediate buffer is not allocated). }
function Stream2StreamEx( Dst, Src: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
{* Copies Count bytes from Src to Dst, but without any optimization.
   Unlike Stream2Stream function, it can be applied to very large streams.
   See also Stream2StreamExBufSz. }
function Stream2StreamExBufSz( Dst, Src: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize; BufSz: DWORD ): TStrmSize;
{* Copies Count bytes from Src to Dst using buffer of given size, but without
   other optimizations.
   Unlike Stream2Stream function, it can be applied to very large streams }
function Resource2Stream( DestStrm : PStream; Inst : HInst;
                          ResName : PKOLChar; ResType : PKOLChar ): Integer;
{* Loads given resource to DestStrm. Useful for non-standard
   resources to load it into memory (use memory stream for such
   purpose). Use one of following resource types to pass as ResType:
   |<pre>
RT_ACCELERATOR	Accelerator table
RT_ANICURSOR	Animated cursor
RT_ANIICON	Animated icon
RT_BITMAP	Bitmap resource
RT_CURSOR	Hardware-dependent cursor resource
RT_DIALOG	Dialog box
RT_FONT	        Font resource
RT_FONTDIR	Font directory resource
RT_GROUP_CURSOR	Hardware-independent cursor resource
RT_GROUP_ICON	Hardware-independent icon resource
RT_ICON	        Hardware-dependent icon resource
RT_MENU	        Menu resource
RT_MESSAGETABLE	Message-table entry
RT_RCDATA	Application-defined resource (raw data)
RT_STRING	String-table entry
RT_VERSION	Version resource
   |</pre>
   |<br>For example:
   !var MemStrm: PStream;
   !    JpgObj: PJpeg;
   !......
   ! MemStrm := NewMemoryStream;
   ! JpgObj := NewJpeg;
   !......
   ! Resource2Stream( MemStrm, hInstance, 'MYJPEG', RT_RCDATA );
   ! MemStrm.Position := 0;
   ! JpgObj.LoadFromStream( MemStrm );
   ! MemStrm.Free;
   !......
   }
{$ENDIF WIN_GDI}

{ ------------------------- string list objects ------------------------------ }

type
  TCompareStrListFun = function( const S1, S2: PAnsiChar ): Integer;
  TCompareEvent = function (const Data: Pointer; const e1,e2 : Dword) : Integer;
  {* Event type to define comparison function between two elements of an array.
     This event handler must return negative or positive value (correspondently
     for cases e1<e2 and e2>e2), or 0 if items are equal. Items are enumerated
     from 0 to uNElem. }
  TSwapEvent = procedure (const Data : Pointer; const e1,e2 : Dword);
  {* Event type to define swap procedure which is swapping two elements of the
     sorting data. }
  TCompareArrayEvent = function(e1,e2 : DWord) : Integer;
  {* Event type to define comparison function between two elements of an array.
     Like in TCompareEvent, but e1 and e2 are not indexes in the array but items
     itselves. }

  PStrList = ^TStrList;
{ ---------------------------------------------------------------------
                TStrList - string list
---------------------------------------------------------------------- }
  TStrList = object(TObj)
  {* Easy string list implementation (non-visual, just to store
     string data). It is well improved and has very high performance
     allowing to work fast with huge text files (more then megabyte
     of text data).
     |
     Please note that #0 charaster if stored in string lines, will cut it
     preventing reading the rest of a line. Be careful, if your data
     contain such characters. }
  protected
    procedure Init; virtual;
  protected
    fList: PList;
    fCount: Integer;
    fCaseSensitiveSort: Boolean;
    fAnsiSort: Boolean;
    fTextBuf: PAnsiChar;
    fTextSiz: DWORD;
    fCompareStrListFun: TCompareStrListFun;
    function GetPChars(Idx: Integer): PAnsiChar;
    //procedure AddTextBuf( Src: PAnsiChar; Len: DWORD );
  protected
    function Get(Idx: integer): Ansistring;
    function GetTextStr: Ansistring;
    procedure Put(Idx: integer; const Value: Ansistring);
    procedure SetTextStr(const Value: Ansistring);
    destructor Destroy; virtual;
  protected
    // by Dod:
    procedure SetValue(const AName, Value: Ansistring);
    function GetValue(const AName: Ansistring): Ansistring;
  public
    // by Dod:
    function IndexOfName(AName: Ansistring): Integer;
    {* by Dod. Returns index of line starting like Name=... }
    function IndexOfName_NoCase(AName: Ansistring): Integer;
    property Values[const AName: Ansistring]: Ansistring read GetValue write SetValue;
    {* by Dod. Returns right side of a line starting like Name=... }
  public
    function Add(const S: Ansistring): integer;
    {* Adds a string to list. }
    procedure AddStrings(Strings: PStrList);
    {* Merges string list with given one. Very fast - more preferrable to
       use than any loop with calling Add method. }
    procedure Assign(Strings: PStrList);
    {* Fills string list with strings from other one. The same as AddStrings,
       but Clear is called first. }
    procedure Clear;
    {* Makes string list empty. }
    procedure Delete(Idx: integer);
    {* Deletes string with given index (it *must* exist). }
    procedure DeleteLast;
    {* Deletes the last string (it *must* exist). }
    function IndexOf(const S: AnsiString): integer;
    {* Returns index of first string, equal to given one. }
    function IndexOf_NoCase(const S: Ansistring): integer;
    {* Returns index of first string, equal to given one (while comparing it
       without case sensitivity). }
    function IndexOfStrL_NoCase( Str: PAnsiChar; L: Integer ): integer;
    {* Returns index of first string, equal to given one (while comparing it
       without case sensitivity). }
    function Find(const S: AnsiString; var Index: Integer): Boolean;
    {* Returns Index of the string, equal or greater to given pattern, but
       works only for sorted TStrList object. Returns TRUE if exact string found,
       otherwise nearest (greater then a pattern) string index is returned,
       and the result is FALSE. And in such _case Index is returned negated
       when the S string is less then the string found. }
    function FindFirst(const S: AnsiString; var Index: Integer): Boolean;
    {* Like above but always returns Index of the first string, equal or greater
       to given pattern. Also works only for sorted TStrList object. Returns TRUE
       if exact string found, otherwise nearest (greater then a pattern) string
       index is returned, and the result is FALSE. }
    procedure Insert(Idx: integer; const S: Ansistring);
    {* Inserts string before one with given index. }
    procedure Move(CurIndex, NewIndex: integer);
    {* Moves string to another location. }
    procedure SetText(const S: Ansistring; Append2List: Boolean);
    {* Allows to set strings of string list from given string (in which
       strings are separated by $0D,$0A or $0D characters). Text must not
       contain #0 characters. Works very fast. This method is used in
       all others, working with text arrays (LoadFromFile, MergeFromFile,
       Assign, AddStrings). }
    procedure SetUnixText( const S: AnsiString; Append2List: Boolean );
    {* Allows to assign UNIX-style text (with #10 as string separator). }
    property Count: integer read fCount;
    {* Number of strings in a string list. }
    property Items[Idx: integer]: Ansistring read Get write Put; default;
    {* Strings array items. If item does not exist, empty string is returned.
       But for assign to property, string with given index *must* exist. }
    property ItemPtrs[ Idx: Integer ]: PAnsiChar read GetPChars;
    {* Fast access to item strings as PChars. }
    function Last: AnsiString;
    {* Last item (or '', if string list is empty). }
    property Text: Ansistring read GetTextStr write SetTextStr;
    {* Content of string list as a single string (where strings are separated
       by characters $0D,$0A). }
    procedure Swap( Idx1, Idx2 : Integer );
    {* Swaps to strings with given indeces. }
    procedure Sort( CaseSensitive: Boolean );
    {* Call it to sort string list. }
    procedure AnsiSort( CaseSensitive: Boolean );
    {* Call it to sort ANSI string list. }
    procedure SortEx(const CompareFun: TCompareEvent); // by Dufa
    {* Call it to sort via your own compare procedure }
  protected // by Alexander Pravdin:
    fNameDelim: AnsiChar;
    function GetLineName( Idx: Integer ): AnsiString;
    procedure SetLineName( Idx: Integer; const NV: AnsiString );
    function GetLineValue(Idx: Integer): Ansistring;
    procedure SetLineValue(Idx: Integer; const Value: Ansistring);
  public
    property LineName[ Idx: Integer ]: Ansistring read GetLineName write SetLineName;
    property LineValue[ Idx: Integer ]: Ansistring read GetLineValue write SetLineValue;
    property NameDelimiter: AnsiChar read fNameDelim write fNameDelim;
    function Join( const sep: AnsiString ): AnsiString;
    {* by Sergey Shishmintzev }
    {$IFDEF WIN_GDI}
    function LoadFromFile(const FileName: KOLString): Boolean;
    {* Loads string list from a file. (If file does not exist, nothing
       happens). Very fast even for huge text files. }
    procedure LoadFromStream(Stream: PStream; Append2List: Boolean);
    {* Loads string list from a stream (from current position to the end of
       a stream). Very fast even for huge text. }
    procedure MergeFromFile(const FileName: KOLString);
    {* Merges string list with strings in a file. Fast. }
    function SaveToFile(const FileName: KOLString): Boolean;
    {* Stores string list to a file. }
    procedure SaveToStream(Stream: PStream);
    {* Saves string list to a stream (from current position). }
    function AppendToFile(const FileName: KOLString): Boolean;
    {* Appends strings of string list to the end of a file. }
    {$ENDIF WIN_GDI}
    procedure OptimizeForRead;
  end;

var DefaultNameDelimiter: AnsiChar = '=';
    ThsSeparator: KOLChar = ',';

function NewStrList: PStrList;
{* Creates string list object. }

{$IFNDEF _FPC}
function WStrLen( W: PWideChar ): Integer;
{* Returns Length of null-terminated Unicode string. }

{$IFDEF _D3orHigher}
function UTF8_2KOLWideString( const s: AnsiString ): KOLWideString;
{$ENDIF}
{$ENDIF _FPC}

type
  PStrListEx = ^TStrListEx;

  TStrListEx = object( TStrList )
  {* Extended string list object. Has additional capability to associate
     numbers or objects with string list items. }
  protected
    FObjects: PList;
    function GetObjects(Idx: Integer): DWORD;
    function GetObjectCount: Integer;
    procedure SetObjects(Idx: Integer; const Value: DWORD);
    procedure Init; virtual;
    procedure ProvideObjCapacity( NewCap: Integer );
  public
    destructor Destroy; virtual;
    {* }
    property Objects[ Idx: Integer ]: DWORD read GetObjects write SetObjects;
    {* Objects are just 32-bit values. You can treat and use it as pointers to
       any other data in the memory. But it is your task to free allocated
       memory in such case therefore.
       |<br>
       If the last item of a string list is deleted vis DeleteLast method (but
       not via Delete method), it's object still is preserved. As well, it is
       possible to set Objects[idx] for idx >= Count.
       To get know object's count, rather then strings count, use ObjectCount
       property. }
    property ObjectCount: Integer read GetObjectCount;
    {* Returns number of objects available. This value can differ from Count
       after some operations: objects are stored in the independant list and
       only synchronization is provided while using methods Delete, Insert,
       Add, AddObject, InsertObject while changing the list. }
    procedure AddStrings(Strings: PStrListEx);
    {* Merges string list with given one. Very fast - more preferrable to
       use than any loop with calling Add method. }
    procedure Assign(Strings: PStrListEx);
    {* Fills string list with strings from other one. The same as AddStrings,
       but Clear is called first. }
    procedure Clear;
    {* Makes string list empty. }
    procedure Delete(Idx: integer);
    {* Deletes string with given index (it *must* exist). }
    procedure DeleteLast;
    {* Deletes the last string and correspondent object in the list. }
    procedure Move(CurIndex, NewIndex: integer);
    {* Moves string to another location. }
    procedure Swap( Idx1, Idx2 : Integer );
    {* Swaps to strings with given indeces. }
    procedure Sort( CaseSensitive: Boolean );
    {* Call it to sort string list. }
    procedure AnsiSort( CaseSensitive: Boolean );
    {* Call it to sort ANSI string list. }
    function LastObj: DWORD;
    {* Object assotiated with the last string. }
    function AddObject( const S: AnsiString; Obj: DWORD ): Integer;
    {* Adds a string and associates given number with it. Index of the item added
       is returned. }
    procedure InsertObject( Before: Integer; const S: AnsiString; Obj: DWORD );
    {* Inserts a string together with object associated. }
    function IndexOfObj( Obj: Pointer ): Integer;
    {* Returns an index of a string associated with the object passed as a
       parameter. If there are no such strings, -1 is returned. }
    procedure OptimizeForRead;
  end;

function NewStrListEx: PStrListEx;
{* Creates extended string list object. }

{$IFNDEF _FPC}
procedure WStrCopy( Dest, Src: PWideChar );
{* Copies null-terminated Unicode string (terminated null also copied). }
procedure WStrLCopy( Dest, Src: PWideChar; MaxLen: Integer );
{* Copies null-terminated Unicode string (terminated null also copied). }
function WStrCmp( W1, W2: PWideChar ): Integer;
{* Compares two null-terminated Unicode strings. }
{$IFDEF _D3orHigher}
function WStrCmp_NoCase( W1, W2: PWideChar ): Integer;
{* Compares two null-terminated Unicode strings. }
{$ENDIF}
{$ENDIF _FPC}

{$IFDEF WIN_GDI}
{$IFNDEF _D2} //------------------ WideString is not supported in D2 -----------

type
  PWStrList = ^TWstrList;
  {* }
  TWStrList = object( TObj )
  {* String list to store Unicode (null-terminated) strings. }
  protected
    function GetCount: Integer;
    function GetItems(Idx: Integer): KOLWideString;
    procedure SetItems(Idx: Integer; const Value: KOLWideString);
    function GetPtrs(Idx: Integer): PWideChar;
    function GetText: KOLWideString;
  protected
    fList: PList;
    fText: PWideChar;
    fTextBufSz: Integer;
    fTmp1, fTmp2: KOLWideString;
    procedure Init; virtual;
  public
    procedure SetText(const Value: KOLWideString);
    {* See also TStrList.SetText }
    destructor Destroy; virtual;
    {* }
    procedure Clear;
    {* See also TStrList.Clear }
    property Items[ Idx: Integer ]: KOLWideString read GetItems write SetItems;
    {* See also TStrList.Items }
    property ItemPtrs[ Idx: Integer ]: PWideChar read GetPtrs;
    {* See also TStrList.ItemPtrs }
    property Count: Integer read GetCount;
    {* See also TStrList.Count }
    function Add( const W: KOLWideString ): Integer;
    {* See also TStrList.Add }
    procedure Insert( Idx: Integer; const W: KOLWideString );
    {* See also TStrList.Insert }
    procedure Delete( Idx: Integer );
    {* See also TStrList.Delete }
    property Text: KOLWideString read GetText write SetText;
    {* See also TStrList.Text }
    procedure AddWStrings( WL: PWStrList );
    {* See also TStrList.AddStrings }
    procedure Assign( WL: PWStrList );
    {* See also TStrList.Assign }
    function LoadFromFile( const Filename: KOLString ): Boolean;
    {* See also TStrList.LoadFromFile }
    procedure LoadFromStream( Strm: PStream; AppendToList: Boolean );
    {* See also TStrList.LoadFromStream }
    function MergeFromFile( const Filename: KOLString ): Boolean;
    {* See also TStrList.MergeFromFile }
    procedure MergeFromStream( Strm: PStream );
    {* See also TStrList.MergeFromStream }
    function SaveToFile( const Filename: KOLString ): Boolean;
    {* See also TStrList.SaveToFile }
    procedure SaveToStream( Strm: PStream );
    {* See also TStrList.SaveToStream }
    function AppendToFile( const Filename: KOLString ): Boolean;
    {* See also TStrList.AppendToFile }
    procedure Swap( Idx1, Idx2: Integer );
    {* See also TStrList.Swap }
    procedure Sort( CaseSensitive: Boolean );
    {* See also TStrList.Sort }
    procedure Move( IdxOld, IdxNew: Integer );
    {* See also TStrList.Move }
    function IndexOf( const s: KOLWideString ): Integer;
    {* }
    function IndexOf_NoCase( const s: KOLWideString ): Integer;
    {* }
    function Last: KOLWideString;
    {* }
    procedure Put(Idx: integer; const Value: KOLWideString);
    {* +azsd for TBButton }
  protected // by Alexander Pravdin:
    fNameDelim: WideChar;
    function GetLineName( Idx: Integer ): KOLWideString;
    procedure SetLineName( Idx: Integer; const NV: KOLWideString );
    function GetLineValue(Idx: Integer): KOLWideString;
    procedure SetLineValue(Idx: Integer; const Value: KOLWideString);
  public
    property LineName[ Idx: Integer ]: KOLWideString read GetLineName write SetLineName;
    property LineValue[ Idx: Integer ]: KOLWideString read GetLineValue write SetLineValue;
    property NameDelimiter: WideChar read fNameDelim write fNameDelim;
    procedure OptimizeForRead;
  protected // ++++++++++++++ by rdnks
    procedure SetValue(const AName, Value: KOLWideString);
    function GetValue(const AName: KOLWideString): KOLWideString;
  public
    function IndexOfName(AName: KOLWideString): Integer;
    property Values[const AName: KOLWideString]: KOLWideString read GetValue write SetValue;
  end;

  PWStrListEx = ^TWStrListEx;

  TWStrListEx = object( TWStrList )
  {* Extended Unicode string list (with Objects). }
  protected
    function GetObjects(Idx: Integer): DWORD;
    procedure SetObjects(Idx: Integer; const Value: DWORD);
    procedure ProvideObjectsCapacity( NewCap: Integer );
  protected
    fObjects: PList;
    procedure Init; virtual;
  public
    destructor Destroy; virtual;
    {* }
    property Objects[ Idx: Integer ]: DWORD read GetObjects write SetObjects;
    {* }
    procedure AddWStrings( WL: PWStrListEx );
    {* }
    procedure Assign( WL: PWStrListEx );
    {* }
    procedure Clear;
    {* }
    procedure Delete( Idx: Integer );
    {* }
    procedure Move( IdxOld, IdxNew: Integer );
    {* }
    procedure Swap( Idx1, Idx2: Integer );
    {* See also TStrList.Swap }
    procedure Sort( CaseSensitive: Boolean );
    {* See also TStrList.Sort }
    function AddObject( const S: KOLWideString; Obj: DWORD ): Integer;
    {* Adds a string and associates given number with it. Index of the item added
       is returned. }
    procedure InsertObject( Before: Integer; const S: KOLWideString; Obj: DWORD );
    {* Inserts a string together with object associated. }
    function IndexOfObj( Obj: Pointer ): Integer;
    {* Returns an index of a string associated with the object passed as a
       parameter. If there are no such strings, -1 is returned. }
    procedure OptimizeForRead;
  end;

function NewWStrList: PWStrList;
{* Creates new TWStrList object and returns a pointer to it. }

function NewWStrListEx: PWStrListEx;
{* Creates new TWStrListEx objects and returns a pointer to it. }

{$ENDIF not _D2}
{$ENDIF WIN_GDI}

{$IFDEF UNICODE_CTRLS}
{$IFNDEF _D2}
type TKOLStrList = TWStrList;
     PKOLStrList = PWStrList;
     TKOLStrListEx = TWStrListEx;
     PKOLStrListEx = PWStrListEx;
{$ELSE}
type TKOLStrList = TStrList;
     PKOLStrList = PStrList;
     TKOLStrListEx = TStrListEx;
     PKOLStrListEx = PStrListEx;
{$ENDIF}
{$ELSE}
type TKOLStrList = TStrList;
     PKOLStrList = PStrList;
     TKOLStrListEx = TStrListEx;
     PKOLStrListEx = PStrListEx;
{$ENDIF}

function NewKOLStrList: PKOLStrList;
function NewKOLStrListEx: PKOLStrListEx;

{$IFDEF WIN}
function  GetFileList(const dir: KOLString): PKOLStrList;
{* By Alexander Shakhaylo. Returns list of file names of the given directory. }
{$ENDIF WIN}

////////////////////////////////////////////////////////////////////////////////
//                            GRAPHIC OBJECTS                                 //
////////////////////////////////////////////////////////////////////////////////
{
  It is very important, that the most of code, implementing graphic objets
  from this section, is included into executable ONLY if really accessed in your
  project directly (e.g., if Font or Brush properies of a control are accessed
  or changed).
}
type
  TColor = Integer;
const
  clScrollBar       = TColor(COLOR_SCROLLBAR or $80000000);
  clBackground      = TColor(COLOR_BACKGROUND or $80000000);
  clActiveCaption   = TColor(COLOR_ACTIVECAPTION or $80000000);
  clInactiveCaption = TColor(COLOR_INACTIVECAPTION or $80000000);
  clMenu            = TColor(COLOR_MENU or $80000000);
  clWindow          = TColor(COLOR_WINDOW or $80000000);
  clWindowFrame     = TColor(COLOR_WINDOWFRAME or $80000000);
  clMenuText        = TColor(COLOR_MENUTEXT or $80000000);
  clWindowText      = TColor(COLOR_WINDOWTEXT or $80000000);
  clCaptionText     = TColor(COLOR_CAPTIONTEXT or $80000000);
  clActiveBorder    = TColor(COLOR_ACTIVEBORDER or $80000000);
  clInactiveBorder  = TColor(COLOR_INACTIVEBORDER or $80000000);
  clAppWorkSpace    = TColor(COLOR_APPWORKSPACE or $80000000);
  clHighlight       = TColor(COLOR_HIGHLIGHT or $80000000);
  clHighlightText   = TColor(COLOR_HIGHLIGHTTEXT or $80000000);
  clBtnFace         = TColor(COLOR_BTNFACE or $80000000);
  clBtnShadow       = TColor(COLOR_BTNSHADOW or $80000000);
  clGrayText        = TColor(COLOR_GRAYTEXT or $80000000);
  clGreyText        = TColor(COLOR_GRAYTEXT or $80000000);
  clBtnText         = TColor(COLOR_BTNTEXT or $80000000);
  clInactiveCaptionText = TColor(COLOR_INACTIVECAPTIONTEXT or $80000000);
  clBtnHighlight    = TColor(COLOR_BTNHIGHLIGHT or $80000000);
  cl3DDkShadow      = TColor(COLOR_3DDKSHADOW or $80000000);
  cl3DLight         = TColor(COLOR_3DLIGHT or $80000000);
  clInfoText        = TColor(COLOR_INFOTEXT or $80000000);
  clInfoBk          = TColor(COLOR_INFOBK or $80000000);

  clBlack = TColor($000000);
  clMaroon = TColor($000080);
  clGreen = TColor($008000);
  clOlive = TColor($008080);
  clNavy = TColor($800000);
  clPurple = TColor($800080);
  clTeal = TColor($808000);
  clGray = TColor($808080);
  clGrey = TColor($808080);
  clSilver = TColor($C0C0C0);
  clRed = TColor($0000FF);
  clLime = TColor($00FF00);
  clYellow = TColor($00FFFF);
  clBlue = TColor($FF0000);
  clFuchsia = TColor($FF00FF);
  clAqua = TColor($FFFF00);
  clLtGray = TColor($C0C0C0);
  clLtGrey = TColor($C0C0C0);
  clDkGray = TColor($808080);
  clDkGrey = TColor($808080);
  clWhite = TColor($FFFFFF);
  clNone = TColor($1FFFFFFF);
  clDefault = TColor($20000000);

  clMoneyGreen = TColor($C0DCC0);
  clSkyBlue = TColor($F0CAA6);
  clCream = TColor($F0FBFF);
  clMedGray = TColor($A4A0A0);
  clMedGrey = TColor($A4A0A0);
  clOrange = TColor( $3399FF );
  clBrown = TColor( $505080 );
  clDkBrown = TColor( $282840 );

  clGRushHiLight = TColor( $F3706C );
  clGRushLighten = TColor( $F1EEDF );
  clGRushLight = TColor( $e1cebf );
  clGRushNormal = TColor( $D1beaf );
  clGRushMedium = TColor( $b6bFc6 );
  clGRushDark = TColor( $9EACB4 );

const
  go_Color                 = 0;
  go_FontHeight            = 4;
  go_FontWidth             = 8;
  go_FontEscapement        = 12;
  go_FontOrientation       = 16;
  go_FontWeight            = 20;
  go_FontItalic            = 24;
  go_FontUnderline         = 25;
  go_FontStrikeOut         = 26;
  go_FontCharSet           = 27;
  go_FontOutPrecision      = 28;
  go_FontClipPrecision     = 29;
  go_FontQuality           = 30;
  go_FontPitch             = 31;
  go_FontName              = 32;
  go_BrushBitmap           = 4;
  go_BrushStyle            = 8;
  go_BrushLineColor        = 9;
  go_PenBrushBitmap        = 4;
  go_PenBrushStyle         = 8;
  go_PenStyle              = 9;
  go_PenWidth              = 10;
  go_PenMode               = 14;
  go_PenGeometric          = 15;
  go_PenEndCap             = 16;
  go_PenJoin               = 17;

type
   TGraphicToolType = ( gttBrush, gttFont, gttPen );
   {* Graphic object types, mainly for internal use. }

   PGraphicTool = ^TGraphicTool;
   {* }
   TOnGraphicChange = procedure ( Sender: PGraphicTool ) of object;
   {* An event mainly for internal use. }

   TBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical,
    bsFDiagonal, bsBDiagonal, bsCross, bsDiagCross);
   {* Available brush styles. }

   TFontStyles = (fsBold, fsItalic, fsUnderline, fsStrikeOut);
   {* Available font styles. }
   TFontStyle = set of TFontStyles;
   {* Font style is representing as a set of XFontStyles. }
   TFontPitch = (fpDefault, fpFixed, fpVariable);
   {* Availabe font pitch values. }
   TFontName = type string;
   {* Font name is represented as a string. }
   TFontCharset = 0..255;
   {* Font charset is represented by number from 0 to 255. }
   TFontQuality = (fqDefault, fqDraft, fqProof, fqNonAntialiased, fqAntialiased
                , fqClearType);
   {* Font quality. }

   TPenStyle = (psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear,
    psInsideFrame);
   {* Available pen styles. For more info see Delphi or Win32 help files. }
   TPenMode = (pmBlack, pmNotMerge, pmMaskNotPen, pmNotCopy, pmMaskPenNot,
               pmNot, pmXor, pmNotMask, pmMask, pmNotXor, pmNop, pmMergePenNot,
               pmCopy, pmMergeNotPen, pmMerge, pmWhite);
   {* Available pen modes. For more info see Delphi or Win32 help files. }
   TPenEndCap = (pecRound, pecSquare, pecFlat);
   {* Avalable (for geometric pen) end cap styles. }
   TPenJoin = (pjRound, pjBevel, pjMiter);
   {* Available (for geometric pen) join styles. }

   TGDIFont = packed record
     Height: Integer;
     Width: Integer;
     Escapement: Integer;
     Orientation: Integer;
     Weight: Integer;
     Italic: Boolean;
     Underline: Boolean;
     StrikeOut: Boolean;
     CharSet: TFontCharset;
     OutPrecision: Byte;
     ClipPrecision: Byte;
     Quality: TFontQuality;
     Pitch: TFontPitch;
     Name: array[0..LF_FACESIZE - 1] of KOLChar;
   end;

   TGDIBrush = packed record
     Bitmap: HBitmap;
     Style: TBrushStyle;
     LineColor: TColor;
   end;

   TGDIPen = packed record
     BrushBitmap: HBitmap;
     BrushStyle: TBrushStyle;
     Style: TPenStyle;
     Width: Integer;
     Mode: TPenMode;
     Geometric: Boolean;
     EndCap: TPenEndCap;
     Join: TPenJoin;
   end;

   TGDIToolData = packed record
     Color: TColor;
     case Integer of
     1: (Font: TGDIFont);
     2: (Pen: TGDIPen);
     3: (Brush: TGDIBrush);
   end;

   TNewGraphicTool = function: PGraphicTool;

{ ---------------------------------------------------------------------
     TGraphicTool - object to implement GDI-tools (brush, pen, font)
---------------------------------------------------------------------- }
  TGraphicTool = object( TObj )
  {* Incapsulates all GDI objects: Pen, Brush and Font. }
  protected
    fType: TGraphicToolType;
    {$IFDEF GDI}
    fHandle: THandle;
    fParentGDITool: PGraphicTool;
    {$ENDIF GDI}
    fColorRGB: TColor;
    fOnGTChange: TOnGraphicChange;
    fData: TGDIToolData;
    fNewProc: TNewGraphicTool;
    {$IFDEF GDI}
    fMakeHandleProc: function( Self_: PGraphicTool ): THandle;
    {$ENDIF GDI}
    procedure SetInt( const Index: Integer; Value: Integer );
    function GetInt( const Index: Integer ): Integer;
    procedure SetColor( Value: TColor );
    {$IFDEF GDI}
    function GetBrushBitmap: HBitmap; // for BCB only
    procedure SetBrushBitmap(const Value: HBitmap);
    function GetBrushStyle: TBrushStyle; // for BCB only
    {$ENDIF GDI}
    procedure SetBrushStyle(const Value: TBrushStyle);
    function GetFontName: KOLString;
    procedure SetFontName(const Value: KOLString);
    function GetFontStyle: TFontStyle;
    procedure SetFontStyle(const Value: TFontStyle);
    function GetFontWeight: Integer; // for BCB only
    procedure SetFontWeight(const Value: Integer);
    {$IFDEF GDI}
    function GetFontCharset: TFontCharset; // for BCB only
    procedure SetFontCharset(const Value: TFontCharset);
    function GetFontQuality: TFontQuality; // for BCB only
    procedure SetFontQuality(const Value: TFontQuality);
    function GetFontOrientation: Integer; // for BCB only
    procedure SetFontOrientation(Value: Integer);
    function GetFontPitch: TFontPitch; // for BCB only
    procedure SetFontPitch(const Value: TFontPitch);
    function GetPenMode: TPenMode; // for BCB only
    procedure SetPenMode(const Value: TPenMode);
    function GetPenStyle: TPenStyle; // for BCB only
    procedure SetPenStyle(const Value: TPenStyle);
    function GetGeometricPen: Boolean; // for BCB only
    procedure SetGeometricPen(const Value: Boolean);
    function GetPenEndCap: TPenEndCap; // for BCB only
    procedure SetPenEndCap(const Value: TPenEndCap);
    function GetPenJoin: TPenJoin; // for BCB only
    procedure SetPenJoin(const Value: TPenJoin);
    procedure SetLogFontStruct(const Value: TLogFont);
    function GetLogFontStruct: TLogFont;
    {$ENDIF GDI}
  protected
    procedure Changed;
    {* }
    {$IFDEF GDI}
    function GetHandle: THandle;
    {* }
    {$ENDIF GDI}
  protected
    {$IFDEF _X_}
    {$IFDEF GTK}
    fPangoFontDesc: PPangoFontDescription;
    FUNCTION GetPangoFontDesc: PPangoFontDescription;
    {$ENDIF GTK}
    {$ENDIF _X_}
  public
    destructor Destroy; virtual;
    {* }
    {$IFDEF _X_}
    {$IFDEF GTK}
    PROPERTY FontHandle: PPangoFontDescription read GetPangoFontDesc;
    {$ENDIF GTK}
    {$ENDIF _X_}
    {$IFDEF GDI}
    property Handle: THandle read GetHandle;
    {* Every time, when accessed, real GDI object is created (if it is
       not yet created). So, to prevent creating of the handle, use
       HandleAllocated instead of comparing Handle with value 0.  }
    function HandleAllocated: Boolean;
    {* Returns True, if handle is allocated (i.e., if real GDI
       objet is created. }
    {$ENDIF GDI}
    property OnChange: TOnGraphicChange read fOnGTChange write fOnGTChange;
    {* Called, when object is changed. }
    {$IFDEF GDI}
    function ReleaseHandle: THANDLE;
    {* Returns Handle value (if allocated), releasing it from the
       object (so, it is no more knows about this handle and its
       HandleAllocated function returns False. }
    {$ENDIF GDI}
    property Color: TColor {index go_Color} read fData.Color write SetColor;
    {* Color is the most common property for all Pen, Brush and
       Font objects, so it is placed in its common for all of them. }
    function Assign( Value: PGraphicTool ): PGraphicTool;
    {* Assigns properties of the same (only) type graphic object,
       excluding Handle. If assigning is really leading to change
       object, procedure Changed is called. }
    {$IFDEF GDI}
    procedure AssignHandle( NewHandle: THANDLE );
    {* Assigns value to Handle property. }

    property BrushBitmap: HBitmap read {-BCB-}fData.Brush.Bitmap{+BCB+}
                                       {BCB++}(*GetBrushBitmap*){--BCB}
       write SetBrushBitmap;
    {* Brush bitmap. For more info about using brush bitmap,
       see Delphi or Win32 help files. }
    {$ENDIF GDI}
    property BrushStyle: TBrushStyle read {-BCB-}fData.Brush.Style{+BCB+}
                                          {BCB++}(*GetBrushStyle*){--BCB}
       write SetBrushStyle;
    {$IFDEF GDI}
    {* Brush style. }
    property BrushLineColor: TColor index go_BrushLineColor
             {$IFDEF F_P}
             read GetInt
             {$ELSE DELPHI}
             read {-BCB-}fData.Brush.LineColor{+BCB+}
                  {BCB++}(*GetInt*){--BCB}
             {$ENDIF F_P/DELPHI}
             write SetInt;
    {* Brush line color, used to represent lines in hatched brush. Default value is clBlack. }

    {$ENDIF GDI}
    property FontHeight: Integer index go_FontHeight
             {$IFDEF F_P}
             read GetInt
             {$ELSE DELPHI}
             read {-BCB-}fData.Font.Height{+BCB+}
                  {BCB++}(*GetInt*){--BCB}
             {$ENDIF F_P/DELPHI}
             write SetInt;
    {* Font height. Value 0 (default) says to use system default value,
       negative values are to represent font height in "points", positive
       - in pixels. In XCL usually positive values (if not 0) are used to
       make appearance independent from different local settings. }
    {$IFDEF GDI}
    property FontWidth: Integer index go_FontWidth
             {$IFDEF F_P}
             read GetInt
             {$ELSE DELPHI}
             read {-BCB-}fData.Font.Width{+BCB+}
                  {BCB++}(*GetInt*){--BCB}
             {$ENDIF F_P/DELPHI}
             write SetInt;
    {* Font width in logical units. If FontWidth = 0, then as it is said
       in Win32.hlp, "the aspect ratio of the device is matched against the
       digitization aspect ratio of the available fonts to find the closest match,
       determined by the absolute value of the difference." }
    property FontPitch: TFontPitch read {-BCB-}fData.Font.Pitch{+BCB+}
                                        {BCB++}(*GetFontPitch*){--BCB}
      write SetFontPitch;
    {* Font pitch. Change it very rare. }
    {$ENDIF GDI}
    property FontStyle: TFontStyle read GetFontStyle write SetFontStyle;
    {* Very useful property to control text appearance. }
    {$IFDEF GDI}
    property FontCharset: TFontCharset read {-BCB-}fData.Font.Charset{+BCB+}
                                            {BCB++}(*GetFontCharset*){--BCB}
      write SetFontCharset;
    {* Do not change it if You do not know what You do. }
    property FontQuality: TFontQuality read {-BCB-}fData.Font.Quality{+BCB+}
                                            {BCB++}(*GetFontQuality*){--BCB}
      write SetFontQuality;
    {* Font quality. }
    property FontOrientation: Integer read {-BCB-}fData.Font.Orientation{+BCB+}
                                           {BCB++}(*GetFontOrientation*){--BCB}
      write SetFontOrientation;
    {* It is possible to rotate text in XCL just by changing this
       property of a font (tenths of degree, i.e. value 900 represents
       90 degree - text written from bottom to top). }
    {$ENDIF GDI}
    property FontWeight: Integer read {-BCB-}fData.Font.Weight{+BCB+}
                                      {BCB++}(*GetFontWeight*){--BCB}
      write SetFontWeight;
    {* Additional font weight for bold fonts (must be 0..1000). When set to
       value <> 0, fsBold is added to FontStyle. And otherwise, when set to 0,
       fsBold is removed from FontStyle. Value 700 corresponds to Bold,
       400 to Normal. }
    property FontName: KOLString read GetFontName write SetFontName;
    {* Font face name. }
    {$IFDEF GDI}
    function IsFontTrueType: Boolean;
    {* Returns True, if font is True Type. Requires of creating of a Handle,
       if it is not yet created. }

    property PenWidth: Integer index go_PenWidth
             {$IFDEF F_P}
             read GetInt
             {$ELSE DELPHI}
             read {-BCB-}fData.Pen.Width{+BCB+}
                  {BCB++}(*GetInt*){--BCB}
             {$ENDIF F_P/DELPHI}
             write SetInt;
    {* Value 0 means default pen width. }
    property PenStyle: TPenStyle read {-BCB-}fData.Pen.Style{+BCB+}
                                      {BCB++}(*GetPenStyle*){--BCB}
      write SetPenStyle;
    {* Pen style. }
    property PenMode: TPenMode read {-BCB-}fData.Pen.Mode{+BCB+}
                                    {BCB++}(*GetPenMode*){--BCB}
      write SetPenMode;
    {* Pen mode. }

    property GeometricPen: Boolean read {-BCB-}fData.Pen.Geometric{+BCB+}
                                        {BCB++}(*GetGeometricPen*){--BCB}
      write SetGeometricPen;
    {* True if Pen is geometric. Note, that under Win95/98 only pen styles
       psSolid, psNull, psInsideFrame are supported by OS. }
    property PenBrushStyle: TBrushStyle read {-BCB-}fData.Pen.BrushStyle{+BCB+}
                                             {BCB++}(*GetBrushStyle*){--BCB}
      write SetBrushStyle;
    {* Brush style for hatched geometric pen. }
    property PenBrushBitmap: HBitmap read {-BCB-}fData.Pen.BrushBitmap{+BCB+}
                                          {BCB++}(*GetBrushBitmap*){--BCB}
      write SetBrushBitmap;
    {* Brush bitmap for geometric pen (if assigned Pen is functioning as
       its style = BS_PATTERN, regadless of PenBrushStyle value). }
    property PenEndCap: TPenEndCap read {-BCB-}fData.Pen.EndCap{+BCB+}
                                        {BCB++}(*GetPenEndCap*){--BCB}
      write SetPenEndCap;
    {* Pen end cap mode - for GeometricPen only. }
    property PenJoin: TPenJoin read {-BCB-}fData.Pen.Join{+BCB+}
                                    {BCB++}(*GetPenJoin*){--BCB}
      write SetPenJoin;
    {* Pen join mode - for GeometricPen only. }
    property LogFontStruct: TLogFont read GetLogFontStruct write SetLogFontStruct;
    {* by Alex Pravdin: a property to change all font structure items at once. }
    {$ENDIF GDI}
  end;

function Color2RGB( Color: TColor ): TColor;
{* Function to get RGB color from system color. Parameter can be also RGB
   color, in that case result is just equal to a parameter. }
function RGB2BGR( Color: TColor ): TColor;
{* Converts RGB color to BGR }
{$IFDEF GTK}
FUNCTION Color2GDKColor( Color: TColor ): TGdkColor;
{$ENDIF GTK}
function ColorsMix( Color1, Color2: TColor ): TColor;
{* Returns color, which RGB components are build as an (approximate)
   arithmetic mean of correspondent RGB components of both source
   colors (these both are first converted from system to RGB, and
   result is always RGB color). Please note: this function is fast,
   but can be not too exact. }
{$IFDEF WIN_GDI}
function Color2RGBQuad( Color: TColor ): TRGBQuad;
{* Converts color to RGB, used to represent RGB values in palette entries
   (actually swaps R and B bytes). }
function Color2Color16( Color: TColor ): WORD;
{* Converts Color to RGB, packed to word (as it is used in format pf16bit). }
function Color2Color15( Color: TColor ): WORD;
{* Converts Color to RGB, packed to word (as it is used in format pf15bit). }

var    // New TFont instances are intialized with the values in this structure:
  DefFont: TGDIFont = (
     Height: 0;
     Width: 0;
     Escapement: 0;
     Orientation: 0;
     Weight: 0;
     Italic: FALSE;
     Underline: FALSE;
     StrikeOut: FALSE;
     CharSet: 1;
     OutPrecision: 0;
     ClipPrecision: 0;
     Quality: fqDefault;
     Pitch: fpDefault;
     {$IFDEF UNICODE_CTRLS}
     Name: ( 'T', 'a', 'h', 'o', 'm', 'a',
             #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
             #0, #0, #0, #0, #0, #0, #0, #0, #0 );
     {$ELSE}
     Name: 'System';
     {$ENDIF}
  );
  DefFontColor: TColor = clWindowText;
  {* Default font color. }

  GlobalGraphics_UseFontOrient: Boolean;
  {* Global flag. If stays False (default), Orientation property of Font
     objects is ignored. This flag is set to True automatically in
     RotateFonts add-on. }

{$ENDIF WIN_GDI}

function NewFont: PGraphicTool;
{* Creates and returns font graphic tool object. }
function NewBrush: PGraphicTool;
{* Creates and returns new brush object. }
function NewPen: PGraphicTool;
{* Creates and returns new pen object. }

{ ------------------------------ TCanvas object ------------------------------ }
const
  HandleValid = 1;
  PenValid    = 2;
  BrushValid  = 4;
  FontValid   = 8;
  ChangingCanvas = 16;

{$IFDEF WIN_GDI}
type
   TFillStyle = (fsSurface, fsBorder);
   {* Available filling styles. For more info see Win32 or Delphi help files. }
   TFillMode = (fmAlternate, fmWinding);
   {* Available filling modes. For more info see Win32 or Delphi help files. }
   TCopyMode = Integer;
   {* Available copying modes are following:
      |  cmBlackness<br>
      |  cmDstInvert<br>
      |  cmMergeCopy<br>
      |  cmMergePaint<br>
      |  cmNotSrcCopy<br>
      |  cmNotSrcErase<br>
      |  cmPatCopy<br>
      |  cmPatInvert<br>
      |  cmPatPaint<br>
      |  cmSrcAnd<br>
      |  cmSrcCopy<br>
      |  cmSrcErase<br>
      |  cmSrcInvert<br>
      |  cmSrcPaint<br>
      |  cmWhiteness<br>&nbsp;&nbsp;&nbsp;
      Also it is possible to use any other available ROP2 modes. For more info,
      see Win32 help files. }

const
  cmBlackness = BLACKNESS;
  cmDstInvert = DSTINVERT;
  cmMergeCopy = MERGECOPY;
  cmMergePaint = MERGEPAINT;
  cmNotSrcCopy = NOTSRCCOPY;
  cmNotSrcErase = NOTSRCERASE;
  cmPatCopy = PATCOPY;
  cmPatInvert = PATINVERT;
  cmPatPaint = PATPAINT;
  cmSrcAnd = SRCAND;
  cmSrcCopy = SRCCOPY;
  cmSrcErase = SRCERASE;
  cmSrcInvert = SRCINVERT;
  cmSrcPaint = SRCPAINT;
  cmWhiteness = WHITENESS;

{$ENDIF WIN_GDI}
type
  {$IFDEF _X_}
  {$IFDEF GTK}
  HDC = PGdkGC;
  {$ENDIF GTK}
  {$ENDIF _X_}
  PCanvas = ^TCanvas;
  {* }
  TOnGetHandle = function( Canvas: PCanvas ): HDC of object;
  {* For internal use mainly. }
  TOnTextArea = procedure( Sender: PCanvas; var Size : TSize; var P0 : TPoint );
  {* Event to calculate actual area, occupying by a text. It is used
     to optionally extend calculating of TextArea taking into considaration
     font Orientation property. }

{ ---------------------------------------------------------------------
                TCanvas - high-level drawing helper object
----------------------------------------------------------------------- }
  TCanvas = object( TObj )
  {* Very similar to VCL's TCanvas object. But with some changes, specific
     for KOL: there is no necessary to use canvases in all applications.
     And graphic tools objects are not created with canvas, but only
     if really accessed in program. (Actually, even if paint box used,
     only programmer decides, if to implement painting using Canvas or
     to call low level API drawing functions working directly with DC).
     Therefore TCanvas has some powerful extensions: rotated text support,
     geometric pen support - just by changing correspondent properties
     of certain graphic tool objects (Font.FontOrientation, Pen.GeometricPen).
     See also additional Font properties (Font.FontWeight, Font.FontQuality,
     etc. }
  protected
    fOwnerControl: Pointer; //PControl;
    {$IFDEF _X_}
    {$IFDEF GTK}
    fDrawable: PGdkDrawable;
    fTmpColor: PGdkColor;
    {$ENDIF GTK}
    {$ENDIF _X_}
    fHandle : HDC;
    fPenPos : TPoint;
    fState : Byte;
    fBrush, fPen: PGraphicTool;
    fFont : PGraphicTool; // order is important for ASM version
  {$IFDEF GDI}
    fCopyMode : TCopyMode;
    fOnChangeCanvas: TOnEvent;
    {$ENDIF GDI}
    fOnGetHandle: TOnGetHandle;
    {$IFDEF _X_}
    {$IFDEF GTK}
    fSavedState: TGdkGCValues;
    PROCEDURE SaveState;
    PROCEDURE RestoreState;
    {$ENDIF GTK}
    {$ENDIF _X_}
    {$IFDEF GDI}
    procedure SetHandle( Value : HDC );
    {$ENDIF GDI}
    procedure SetPenPos( const Value : TPoint );
    {$IFDEF GDI}
    procedure CreatePen;
    procedure CreateBrush;
    procedure CreateFont;
    procedure Changing;
    {$ENDIF GDI}
    procedure ObjectChanged( Sender : PGraphicTool );
    function GetBrush: PGraphicTool;
    function GetFont: PGraphicTool;
    function GetPen: PGraphicTool;
    function GetHandle: HDC;
    procedure AssignChangeEvents;
    {$IFDEF GDI}
    function GetPixels(X, Y: Integer): TColor;
    procedure SetPixels(X, Y: Integer; const Value: TColor);
  protected
    fIsPaintDC : Boolean;
    {* TRUE, if DC obtained during current WM_PAINT (or WM_ERASEBKGND?)
       processing for a control. This affects a way how Handle is released. }
    fIsAlienDC: Boolean;
    {* TRUE if Canvas was created on base of existing DC, so DC is not
       beloning to the Canvas and should not be deleted when the Canvas object
       is destroyed. }
    destructor Destroy; virtual;
    {* }
    {$ENDIF GDI}
    property OnGetHandle: TOnGetHandle read fOnGetHandle write fOnGetHandle;
    {* For internal use only. }
    {$IFDEF GDI}
  {$ENDIF GDI}
  public
    property Handle : HDC read GetHandle {$IFDEF GDI} write SetHandle {$ENDIF GDI};
    {* GDI device context object handle. Never created by
       Canvas itself (to use Canvas with memory bitmaps,
       always create DC by yourself and assign it to the
       Handle property of Canvas object, or use property
       Canvas of a bitmap). }
    property PenPos : TPoint read FPenPos write SetPenPos;
    {* Position of a pen. }
    property Pen : PGraphicTool read GetPen;
    {* Pen of Canvas object. Do not change its Pen.OnChange event value. }
    property Brush : PGraphicTool read GetBrush;
    {* Brush of Canvas object. Do not change its Brush.OnChange event value. }
    property Font : PGraphicTool read GetFont;
    {* Font of Canvas object. Do not change its Font.OnChange event value. }
    procedure OffsetAndRotate( Xoff, Yoff: Integer; Angle: Double );
    {* Transforms world coordinates so that Xoff and Yoff become the
       coordinates of the origin (0,0) and all further drawing is done
       rotated around that point by the Angle (which is given in radians) }
    {$IFNDEF NOT_USE_KOLMATH} // if using KOLmath disabled, Arc becomes unavailable
    procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall;
    {* Draws arc. For more info, see Delphi TCanvas help. }
    {$ENDIF NOT_USE_KOLMATH}
    {$IFDEF GDI}
    procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall;
    {* Draws chord. For more info, see Delphi TCanvas help. }
    procedure DrawFocusRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);
    {* Draws rectangle to represent focused visual object.
       For more info, see Delphi TCanvas help. }
    procedure Ellipse(X1, Y1, X2, Y2: Integer);
    {* Draws an ellipse. For more info, see Delphi TCanvas help. }
    {$ENDIF GDI}
    procedure FillRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);
    {* Fills rectangle. For more info, see Delphi TCanvas help. }
    {$IFDEF GDI}
    procedure FillRgn( const Rgn : HRgn );
    {* Fills region. For more info, see Delphi TCanvas help. }
    procedure FloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle);
    {* Fills a figure with givien color, floodfilling its surface.
       For more info, see Delphi TCanvas help. }
    procedure FrameRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);
    {* Draws a rectangle using Brush settings (color, etc.).
       For more info, see Delphi TCanvas help. }
    {$ENDIF GDI}
    procedure MoveTo( X, Y : Integer );
    {* Moves current PenPos to a new position.
       For more info, see Delphi TCanvas help. }
    procedure LineTo( X, Y : Integer );
    {* Draws a line from current PenPos up to new position.
       For more info, see Delphi TCanvas help. }
    {$IFDEF GDI}
    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall;
    {* Draws a pie. For more info, see Delphi TCanvas help. }
    procedure Polygon(const Points: array of TPoint);
    {* Draws a polygon. For more info, see Delphi TCanvas help. }
    procedure Polyline(const Points: array of TPoint);
    {* Draws a bound for polygon. For more info, see Delphi TCanvas help. }
    procedure Rectangle(X1, Y1, X2, Y2: Integer);
    {* Draws a rectangle using current Pen and/or Brush.
       For more info, see Delphi TCanvas help. }
    procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
    {* Draws a rounded rectangle. For more info, see Delphi TCanvas help. }
    {$ENDIF GDI}
    procedure TextOutA(X, Y: Integer; const Text: AnsiString); stdcall;
    {* Draws an ANSI text. For more info, see Delphi TCanvas help. }
    procedure TextOut(X, Y: Integer; const Text: KOLString); stdcall;
    {* Draws a text. For more info, see Delphi TCanvas help. }
    procedure ExtTextOut( X, Y: Integer; Options: DWORD; const Rect: TRect; const Text: AnsiString;
              const Spacing: array of Integer );
    {* }
    procedure TextRect(const Rect: TRect; X, Y: Integer; const Text: Ansistring);
    {* Draws a text, clipping output into given rectangle.
       For more info, see Delphi TCanvas help. }
    {$IFDEF GDI}
    procedure DrawText(Text: AnsiString; var Rect:TRect; Flags:DWord);
    {* }
    {$ENDIF GDI}
    function TextExtent(const Text: KOLString): TSize;
    {* Calculates size of a Text, using current Font settings.
       Does not need in Handle for Canvas object (if it is not
       yet allocated, temporary device context is created and used. }
    procedure TextArea( const Text : KOLString; var Sz : TSize; var P0 : TPoint );
    {* Calculates size and starting point to output Text,
       taking into considaration all Font attributes, including
       Orientation (only if GlobalGraphics_UseFontOrient flag
       is set to True, i.e. if rotated fonts are used).
       Like for TextExtent, does not need in Handle (and if this
       last is not yet allocated/assigned, temporary device context
       is created and used). }
    {$IFDEF _D3orHigher}
    procedure WTextArea( const Text : KOLWideString; var Sz : TSize; var P0 : TPoint );
    {* Calculates size and starting point to output Text,
       taking into considaration all Font attributes, including
       Orientation (only if GlobalGraphics_UseFontOrient flag
       is set to True, i.e. if rotated fonts are used).
       Like for TextExtent, does not need in Handle (and if this
       last is not yet allocated/assigned, temporary device context
       is created and used). }
    {$ENDIF _D3orHigher}
    function TextWidth(const Text: KOLString): Integer;
    {* Calculates text width (using TextArea). }
    function TextHeight(const Text: KOLString): Integer;
    {* Calculates text height (using TextArea). }
    {$IFDEF GDI}
    function ClipRect: TRect;
    {* returns ClipBox. by Dmitry Zharov. }

    {$IFNDEF _FPC}
    {$IFNDEF _D2} //------- KOLWideString not supported in D2
    procedure WTextOut(X, Y: Integer; const WText: KOLWideString); stdcall;
    {* Draws a Unicode text. }
    procedure WExtTextOut( X, Y: Integer; Options: DWORD; const Rect: TRect;
              const WText: KOLWideString; const Spacing: array of Integer );
    {* }
    procedure WDrawText(WText: KOLWideString; var Rect:TRect; Flags:DWord);
    {* }
    procedure WTextRect(const Rect: TRect; X, Y: Integer;
              const WText: KOLWideString);
    {* Draws a Unicode text, clipping output into given rectangle. }
    function WTextExtent( const WText: KOLWideString ): TSize;
    {* Calculates Unicode text width and height. }
    function WTextWidth( const WText: KOLWideString ): Integer;
    {* Calculates Unicode text width. }
    function WTextHeight( const WText: KOLWideString ): Integer;
    {* Calculates Unicode text height. }
    {$ENDIF _D2}
    {$ENDIF _FPC}

    property ModeCopy : TCopyMode read fCopyMode write fCopyMode;
    {* Current copy mode. Is used in CopyRect method. }
    procedure CopyRect( const DstRect : TRect; SrcCanvas : PCanvas; const SrcRect : TRect );
    {* Copyes a rectangle from source to destination, using StretchBlt. }
    property OnChange: TOnEvent read fOnChangeCanvas write fOnChangeCanvas;
    {* }
    function Assign( SrcCanvas : PCanvas ) : Boolean;
    {* }
    {$ENDIF GDI}
    {$IFDEF _X_}
    protected // for _X_ case, RequiredState is protected yet (???)
      procedure ForeBack(fg_color, bk_color: TColor); // install colors just before drawing
    {$ENDIF _X_}
    {$IFDEF GDI}
    function RequiredState( ReqState : DWORD ): HDC; stdcall;// public now
    {* It is possible to call this method before using Handle property
       to pass it into API calls - to provide valid combinations of
       pen, brush and font, selected into device context. This method
       can not provide valid Handle - You always must create it by
       yourself and assign to TCanvas.Handle property manually.
       To optimize assembler version, returns Handle value. }
  public
    {$ENDIF GDI}
    procedure DeselectHandles;
    {* Call this method to deselect all graphic tool objects from the canvas. }
    {$IFDEF GDI}
    property Pixels[ X, Y: Integer ]: TColor read GetPixels write SetPixels;
    {* Obvious. }
    {$ENDIF GDI}
  end;

function NewCanvas( DC: HDC ): PCanvas;
{* Use to construct Canvas on base of memory DC. }

procedure DummyObjProc( Sender: PObj );

var
    GlobalCanvas_OnTextArea : Pointer = @DummyObjProc;
    {* Global event to extend Canvas with possible add-ons, applied
       when rotated fonts are used only (to take into consideration
       Font.Orientation property in TextArea method). }

{$IFDEF WIN_GDI}

{ ------------------------------ Image list object --------------------------- }

type
  TImageListColors = (ilcColor,ilcColor4,ilcColor8,ilcColor16,
                      ilcColor24,ilcColor32,ilcColorDDB,ilcDefault);
  {* ImageList color schemes available. }

  TDrawingStyles = ( dsBlend25, dsBlend50, dsMask, dsTransparent );
  {* ImageList drawing styles available. }
  TDrawingStyle = Set of TDrawingStyles;
  {* Style of drawing is a combination of all available drawing styles. }

  TImageType = (itBitmap,itIcon,itCursor);
  {* ImageList types available. }

  PImageList = ^TImageList;
  {* }

  TImgLOVrlayIdx = 1..15;

{ ---------------------------------------------------------------------
                TImageList - images container
----------------------------------------------------------------------- }
  TImageList = object( TObj )
  private
    fOverlayIdx: Integer;
  {* ImageList incapsulation. }
  protected
    FHandle: THandle;
    FControl: Pointer; // PControl;
    fPrev, fNext: PImageList;
    FColors: TImageListColors;
    FMasked: Boolean;
    FImgWidth: Integer;
    FImgHeight: Integer;
    FDrawingStyle: TDrawingStyle;
    FBlendColor: TColor;
    fBkColor: TColor;
    FAllocBy: Integer;
    FShareImages: Boolean;
    FOverlay: array[ TImgLOVrlayIdx ] of Integer;
    function HandleNeeded : Boolean;
    procedure SetColors(const Value: TImageListColors);
    procedure SetMasked(const Value: Boolean);
    procedure SetImgWidth(const Value: Integer);
    procedure SetImgHeight(const Value: Integer);
    function GetCount: Integer;
    function GetBkColor: TColor;
    procedure SetBkColor(const Value: TColor);
    function GetBitmap: HBitmap;
    function GetMask: HBitmap;
    function GetDrawStyle : DWord;
    procedure SetAllocBy(const Value: Integer);
    function GetHandle: THandle;
    function GetOverlay(Idx: TImgLOVrlayIdx): Integer;
    procedure SetOverlay(Idx: TImgLOVrlayIdx; const Value: Integer);
  protected
    procedure SetHandle(const Value: THandle);
    {*}
  public
    destructor Destroy; virtual;
    {*}
    property Handle : THandle read GetHandle write SetHandle;
    {* Handle of ImageList object. }
    property ShareImages : Boolean read FShareImages write FShareImages;
    {* True if images are shared between processes (it is set to True,
       if its Handle is assigned to given value, which is a handle of
       already existing ImageList object). }
    property Colors : TImageListColors read FColors write SetColors;
    {* Colors used to represent images. }
    property Masked : Boolean read FMasked write SetMasked;
    {* True, if mask is used. It is set to True, if first added image
       is icon, e.g. }
    property ImgWidth : Integer read FImgWidth write SetImgWidth;
    {* Width of every image in list. If change, ImageList is cleared. }
    property ImgHeight : Integer read FImgHeight write SetImgHeight;
    {* Height of every image in list. If change, ImageList is cleared. }
    property Count : Integer read GetCount;
    {* Number of images in list. }
    property AllocBy : Integer read FAllocBy write SetAllocBy;
    {* Allocation factor. Default is 1. Set it to size of ImageList if this
       value is known - to optimize speed of allocation. }
    property BkColor : TColor read GetBkColor write SetBkColor;
    {* Background color. }
    property BlendColor : TColor read FBlendColor write FBlendColor;
    {* Blend color. }

    property Bitmap : HBitmap read GetBitmap;
    {* Bitmap, containing all ImageList images (tiled horizontally). }
    property Mask : HBitmap read GetMask;
    {* Monochrome bitmap, containing masks for all images in list (if not
       Masked, always returns nil). }
    function ImgRect( Idx : Integer ) : TRect;
    {* Rectangle occupied of given image in ImageList. }

    function Add( Bmp, Msk : HBitmap ) : Integer;
    {* Adds bitmap and given mask to ImageList. }
    function AddMasked( Bmp : HBitmap; Color : TColor ) : Integer;
    {* Adds bitmap to ImageList, using given color to create mask. }
    function AddIcon( Ico : HIcon ) : Integer;
    {* Adds icon to ImageList (always masked). }
    procedure Delete( Idx : Integer );
    {* Deletes given image from ImageList. }
    procedure Clear;
    {* Makes ImageList empty. }
    function Replace( Idx : Integer; Bmp, Msk : HBitmap ) : Boolean;
    {* Replaces given (by index) image with bitmap and its mask with mask bitmap. }
    function ReplaceIcon( Idx : Integer; Ico : HIcon ) : Boolean;
    {* Replaces given (by index) image with an icon. }
    function Merge( Idx : Integer; ImgList2 : PImageList; Idx2 : Integer; X, Y : Integer )
             : PImageList;
    {* Merges two ImageList objects, returns resulting ImageList. }
    function ExtractIcon( Idx : Integer ) : HIcon;
    {* Extracts icon by index. }
    function ExtractIconEx( Idx : Integer ) : HIcon;
    {* Extracts icon (is created using current drawing style). }

    property DrawingStyle : TDrawingStyle read FDrawingStyle write FDrawingStyle;
    {* Drawing style. }
    procedure Draw( Idx : Integer; DC : HDC; X, Y : Integer );
    {* Draws given (by index) image from ImageList onto passed Device Context. }
    procedure StretchDraw( Idx : Integer; DC : HDC; const Rect : TRect );
    {* Draws given image with stratching. }

    function LoadBitmap( ResourceName : PKOLChar; TranspColor : TColor ) : Boolean;
    {* Loads ImageList from resource. }
    //function LoadIcon( ResourceName : PAnsiChar ) : Boolean;
    //function LoadCursor( ResourceName : PAnsiChar ) : Boolean;
    function LoadFromFile( FileName : PKOLChar; TranspColor : TColor; ImgType : TImageType ) : Boolean;
    {* Loads ImageList from file. }
    function LoadSystemIcons( SmallIcons : Boolean ) : Boolean;
    {* Assigns ImageList to system icons list (big or small). }

    property Overlay[ Idx: TImgLOVrlayIdx ]: Integer read GetOverlay write SetOverlay;
    {* Overlay images for image list (images, used as overlay images to draw over
       other images from the image list). These overalay images can be used in
       listview and treeview as overlaying images (up to four masks at the same
       time). }
    property OverlayIdx: Integer read fOverlayIdx write fOverlayIdx;
    {* Set this value to 1..15 to draw images overlayed (using Draw or DrawEx). }
    {$IFDEF USE_CONSTRUCTORS}
    constructor CreateImageList( POwner: Pointer );
    {$ENDIF USE_CONSTRUCTORS}
  end;

const
  CLR_NONE                = $FFFFFFFF;
  CLR_DEFAULT             = $FF000000;

type
  HImageList = THandle;

const
  ILC_MASK                = $0001;
  ILC_COLOR               = $00FE;
  ILC_COLORDDB            = $00FE;
  ILC_COLOR4              = $0004;
  ILC_COLOR8              = $0008;
  ILC_COLOR16             = $0010;
  ILC_COLOR24             = $0018;
  ILC_COLOR32             = $0020;
  ILC_PALETTE             = $0800;

const
  ILD_NORMAL              = $0000;
  ILD_TRANSPARENT         = $0001;
  ILD_MASK                = $0010;
  ILD_IMAGE               = $0020;
  ILD_BLEND25             = $0002;
  ILD_BLEND50             = $0004;
  ILD_OVERLAYMASK         = $0F00;

const
  ILD_SELECTED            = ILD_BLEND50;
  ILD_FOCUS               = ILD_BLEND25;
  ILD_BLEND               = ILD_BLEND50;
  CLR_HILIGHT             = CLR_DEFAULT;

function ImageList_Create(CX, CY: Integer; Flags: UINT;
  Initial, Grow: Integer): HImageList; stdcall;
function ImageList_Destroy(ImageList: HImageList): Bool; stdcall;
function ImageList_GetImageCount(ImageList: HImageList): Integer; stdcall;
function ImageList_SetImageCount(ImageList: HImageList; Count: Integer): Integer; stdcall;
function ImageList_Add(ImageList: HImageList; Image, Mask: HBitmap): Integer; stdcall;
function ImageList_ReplaceIcon(ImageList: HImageList; Index: Integer;
  Icon: HIcon): Integer; stdcall;
function ImageList_SetBkColor(ImageList: HImageList; ClrBk: TColorRef): TColorRef; stdcall;
function ImageList_GetBkColor(ImageList: HImageList): TColorRef; stdcall;
function ImageList_SetOverlayImage(ImageList: HImageList; Image: Integer;
  Overlay: Integer): Bool; stdcall;

function ImageList_AddIcon(ImageList: HImageList; Icon: HIcon): Integer;

function Index2OverlayMask(Index: Integer): Integer;

function ImageList_Draw(ImageList: HImageList; Index: Integer;
  Dest: HDC; X, Y: Integer; Style: UINT): Bool; stdcall;

function ImageList_Replace(ImageList: HImageList; Index: Integer;
  Image, Mask: HBitmap): Bool; stdcall;
function ImageList_AddMasked(ImageList: HImageList; Image: HBitmap;
  Mask: TColorRef): Integer; stdcall;
function ImageList_DrawEx(ImageList: HImageList; Index: Integer;
  Dest: HDC; X, Y, DX, DY: Integer; Bk, Fg: TColorRef; Style: Cardinal): Bool; stdcall;
function ImageList_Remove(ImageList: HImageList; Index: Integer): Bool; stdcall;
function ImageList_GetIcon(ImageList: HImageList; Index: Integer;
  Flags: Cardinal): HIcon; stdcall;
{$IFDEF UNICODE_CTRLS}
function ImageList_LoadImage(Instance: THandle; Bmp: PWideChar; CX, Grow: Integer;
  Mask: TColorRef; pType, Flags: Cardinal): HImageList; stdcall;
{$ELSE}
function ImageList_LoadImage(Instance: THandle; Bmp: PAnsiChar; CX, Grow: Integer;
  Mask: TColorRef; pType, Flags: Cardinal): HImageList; stdcall;
{$ENDIF}
function ImageList_BeginDrag(ImageList: HImageList; Track: Integer;
  XHotSpot, YHotSpot: Integer): Bool; stdcall;
function ImageList_EndDrag: Bool; stdcall;
function ImageList_DragEnter(LockWnd: HWnd; X, Y: Integer): Bool; stdcall;
function ImageList_DragLeave(LockWnd: HWnd): Bool; stdcall;
function ImageList_DragMove(X, Y: Integer): Bool; stdcall;
function ImageList_SetDragCursorImage(ImageList: HImageList; Drag: Integer;
  XHotSpot, YHotSpot: Integer): Bool; stdcall;
function ImageList_DragShowNolock(Show: Bool): Bool; stdcall;
function ImageList_GetDragImage(Point, HotSpot: PPoint): HImageList; stdcall;

{ macros }
procedure ImageList_RemoveAll(ImageList: HImageList); stdcall;
function ImageList_ExtractIcon(Instance: THandle; ImageList: HImageList;
  Image: Integer): HIcon; stdcall;
function ImageList_LoadBitmap(Instance: THandle; Bmp: PKOLChar;
  CX, Grow: Integer; MasK: TColorRef): HImageList; stdcall;

type
  PImageInfo = ^TImageInfo;
  TImageInfo = packed record
    hbmImage: HBitmap;
    hbmMask: HBitmap;
    Unused1: Integer;
    Unused2: Integer;
    rcImage: TRect;
  end;

function ImageList_GetIconSize(ImageList: HImageList; var CX, CY: Integer): Bool; stdcall;
function ImageList_SetIconSize(ImageList: HImageList; CX, CY: Integer): Bool; stdcall;
function ImageList_GetImageInfo(ImageList: HImageList; Index: Integer;
  var ImageInfo: TImageInfo): Bool; stdcall;
function ImageList_Merge(ImageList1: HImageList; Index1: Integer;
  ImageList2: HImageList; Index2: Integer; DX, DY: Integer)://Bool - ERROR IN VCL
  HImageList; stdcall;

function LoadBmp( Instance: Integer; Rsrc: PKOLChar; MasterObj: PObj ): HBitmap;
function LoadBmp32( Instance: Integer; Rsrc: PKOLChar; MasterObj: PObj ): HBitmap;

type
  tagBitmap = Windows.TBitmap;

  TPixelFormat = ( pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit,
                   pf32bit, pfCustom );
  {* Available pixel formats. }
  TBitmapHandleType = ( bmDIB, bmDDB );
  {* Available bitmap handle types. }

  PBitmap = ^TBitmap;
{ ----------------------------------------------------------------------
                      TBitmap - bitmap image
----------------------------------------------------------------------- }
  TBitmap = object( TObj )
  {* Bitmap incapsulation object. }
  protected
    fHeight: Integer;
    fWidth: Integer;
    fHandle: HBitmap;
    fCanvas: PCanvas;
    fScanLineSize: Integer;
    fBkColor: TColor;
    fApplyBkColor2Canvas: procedure( Sender: PBitmap );
    fDetachCanvas: procedure( Sender: PBitmap );
    fCanvasAttached : Integer;
    fHandleType: TBitmapHandleType;
    fDIBHeader: PBitmapInfo;
    fDIBBits: Pointer;
    fDIBSize: Integer;
    fNewPixelFormat: TPixelFormat;
    fFillWithBkColor: procedure( BmpObj: PBitmap; DC: HDC; oldW, oldH: Integer );
                        //stdcall;
    fTransMaskBmp: PBitmap;
    fTransColor: TColor;
    fGetDIBPixels: function( Bmp: PBitmap; X, Y: Integer ): TColor;
    fSetDIBPixels: procedure( Bmp: PBitmap; X, Y: Integer; Value: TColor );
    fScanLine0: PByte;
    fScanLineDelta: Integer;
    fPixelMask: DWORD;
    fPixelsPerByteMask: Integer;
    fBytesPerPixel: Integer;
    fDIBAutoFree: Boolean;
    procedure SetHeight(const Value: Integer);
    procedure SetWidth(const Value: Integer);
    function GetEmpty: Boolean;
    function GetHandle: HBitmap;
    function GetHandleAllocated: Boolean;
    procedure SetHandle(const Value: HBitmap);
    procedure SetPixelFormat(Value: TPixelFormat);
    procedure FormatChanged;
    function GetCanvas: PCanvas;
    procedure CanvasChanged( Sender: PObj );
    function GetScanLine(Y: Integer): Pointer;
    function GetScanLineSize: Integer;
    procedure ClearData;
    procedure ClearTransImage;
    procedure SetBkColor(const Value: TColor);
    function GetDIBPalEntries(Idx: Integer): TColor;
    function GetDIBPalEntryCount: Integer;
    procedure SetDIBPalEntries(Idx: Integer; const Value: TColor);
    procedure SetHandleType(const Value: TBitmapHandleType);
    function GetPixelFormat: TPixelFormat;
    function GetPixels(X, Y: Integer): TColor;
    procedure SetPixels(X, Y: Integer; const Value: TColor);
    function GetDIBPixels(X, Y: Integer): TColor;
    procedure SetDIBPixels(X, Y: Integer; const Value: TColor);
    function GetBoundsRect: TRect;
  protected
    destructor Destroy; virtual;
  public
    property Width: Integer read fWidth write SetWidth;
    {* Width of bitmap. To make code smaller, avoid changing Width or Height
       after bitmap is created (using NewBitmap) or after it is loaded from
       file, stream of resource. }
    property Height: Integer read fHeight write SetHeight;
    {* Height of bitmap. To make code smaller, avoid changing Width or Height
       after bitmap is created (using NewBitmap) or after it is loaded from
       file, stream of resource. }
    property BoundsRect: TRect read GetBoundsRect;
    {* Returns rectangle (0,0,Width,Height). }
    property Empty: Boolean read GetEmpty;
    {* Returns True if Width or Height is 0. }
    procedure Clear;
    {* Makes bitmap empty, setting its Width and Height to 0. }
    procedure LoadFromFile( const Filename: KOLString );
    {* Loads bitmap from file (LoadFromStream used). }
    function LoadFromFileEx( const Filename: KOLString ): Boolean;
    {* Loads bitmap from a file. If necessary, bitmap is RLE-decoded. Code given
       by Vyacheslav A. Gavrik. }
    procedure SaveToFile( const Filename: KOLString );
    {* Stores bitmap to file (SaveToStream used). }
    procedure CoreSaveToFile( const Filename: KOLString );
    {* Stores bitmap to file (CoreSaveToStream used). }
    procedure RLESaveToFile( const Filename: KOLString );
    {* Stores bitmap to file (CoreSaveToStream used). }
    procedure LoadFromStream( Strm: PStream );
    {* Loads bitmap from stream. Follow loading, bitmap has DIB format (without
       handle allocated). It is possible to draw DIB bitmap without creating
       handle for it, which can economy GDI resources. }
    function LoadFromStreamEx( Strm: PStream ): Boolean;
    {* Loads bitmap from a stream. Difference is that RLE decoding supported.
       Code given by Vyacheslav A. Gavrik. }
    procedure SaveToStream( Strm: PStream );
    {* Saves bitmap to stream. If bitmap is not DIB, it is converted to DIB
       before saving. }
    procedure CoreSaveToStream( Strm: PStream );
    {* Saves bitmap to stream using CORE format with RGBTRIPLE palette and
       with BITMAPCOREHEADER as a header.
       If bitmap is not DIB, it is converted to DIB before saving. }
    procedure RLESaveToStream( Strm: PStream );
    {* Saves bitmap to stream using CORE format with RGBTRIPLE palette and
       with BITMAPCOREHEADER as a header.
       If bitmap is not DIB, it is converted to DIB before saving. }
    procedure LoadFromResourceID( Inst: DWORD; ResID: Integer );
    {* Loads bitmap from resource using integer ID of resource. To load by name,
       use LoadFromResurceName. To load resource of application itself, pass
       hInstance as first parameter. This method also can be used to load system
       predefined bitmaps, if 0 is passed as Inst parameter:
       |<pre>
       OBM_BTNCORNERS	OBM_REDUCE
       OBM_BTSIZE       OBM_REDUCED
       OBM_CHECK        OBM_RESTORE
       OBM_CHECKBOXES   OBM_RESTORED
       OBM_CLOSE        OBM_RGARROW
       OBM_COMBO        OBM_RGARROWD
       OBM_DNARROW      OBM_RGARROWI
       OBM_DNARROWD     OBM_SIZE
       OBM_DNARROWI     OBM_UPARROW
       OBM_LFARROW      OBM_UPARROWD
       OBM_LFARROWD     OBM_UPARROWI
       OBM_LFARROWI     OBM_ZOOM
       OBM_MNARROW      OBM_ZOOMD
       |</pre>        }
    procedure LoadFromResourceName( Inst: DWORD; ResName: PKOLChar );
    {* Loads bitmap from resurce (using passed name of bitmap resource. }
    function Assign( SrcBmp: PBitmap ): Boolean;
    {* Assigns bitmap from another. Returns False if not success.
       Note: remember, that Canvas is not assigned - only bitmap image
       is copied. And for DIB, handle is not allocating due this process. }
    property Handle: HBitmap read GetHandle write SetHandle;
    {* Handle of bitmap. Created whenever property accessed. To check if handle
       is allocated (without allocating it), use HandleAllocated property. }
    property HandleAllocated: Boolean read GetHandleAllocated;
    {* Returns True, if Handle already allocated. }
    function ReleaseHandle: HBitmap;
    {* Returns Handle and releases it, so bitmap no more know about handle.
       This method does not destroy bitmap image, but converts it into DIB.
       Returned Handle actually is a handle of copy of original bitmap. If
       You need not in keping it up, use Dormant method instead. }
    procedure Dormant;
    {* Releases handle from bitmap and destroys it. But image is not destroyed
       and its data are preserved in DIB format. Please note, that in KOL, DIB
       bitmaps can be drawn onto given device context without allocating of
       handle. So, it is very useful to call Dormant preparing it using
       Canvas drawing operations - to economy GDI resources. }
    property HandleType: TBitmapHandleType read fHandleType write SetHandleType;
    {* bmDIB, if DIB part of image data is filled and stored internally in
       TBitmap object. DIB image therefore can have Handle allocated, which
       require resources. Use HandleAllocated funtion to determine if handle
       is allocated and Dormant method to remove it, if You want to economy
       GDI resources. (Actually Handle needed for DIB bitmap only in case
       when Canvas is used to draw on bitmap surface). Please note also, that
       before saving bitmap to file or stream, it is converted to DIB. }
    property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat;
    {* Current pixel format. If format of bitmap is unknown, or bitmap is DDB,
       value is pfDevice. Setting PixelFormat to any other format converts
       bitmap to DIB, back to pfDevice converts bitmap to DDB again. Avoid
       such conversations for large bitmaps or for numerous bitmaps in your
       application to keep good performance. }
    function BitsPerPixel: Integer;
    {* Returns bits per pixel if possible. }
    procedure Draw( DC: HDC; X, Y: Integer );
    {* Draws bitmap to given device context. If bitmap is DIB, it is always
       drawing using SetDIBitsToDevice API call, which does not require bitmap
       handle (so, it is very sensible to call Dormant method to free correspondent
       GDI resources). }
    procedure StretchDraw( DC: HDC; const Rect: TRect );
    {* Draws bitmap onto DC, stretching it to fit given rectangle Rect. }
    procedure DrawTransparent( DC: HDC; X, Y: Integer; TranspColor: TColor );
    {* Draws bitmap onto DC transparently, using TranspColor as transparent.
       See function DesktopPixelFormat also. }
    procedure StretchDrawTransparent( DC: HDC; const Rect: TRect; TranspColor: TColor );
    {* Draws bitmap onto given rectangle of destination DC (with stretching it
       to fit Rect) - transparently, using TranspColor as transparent.
       See function DesktopPixelFormat also. }
    procedure DrawMasked( DC: HDC; X, Y: Integer; Mask: HBitmap );
    {* Draws bitmap to destination DC transparently by mask. It is possible
       to pass as a mask handle of another TBitmap, previously converted to
       monochrome mask using Convert2Mask method. }
    procedure StretchDrawMasked( DC: HDC; const Rect: TRect; Mask: HBitmap );
    {* Like DrawMasked, but with stretching image onto given rectangle. }
    procedure Convert2Mask( TranspColor: TColor );
    {* Converts bitmap to monochrome (mask) bitmap with TranspColor replaced
       to clBlack and all other ones to clWhite. Such mask bitmap can be used
       to draw original bitmap transparently, with given TranspColor as
       transparent. (To preserve original bitmap, create new instance of
       TBitmap and assign original bitmap to it). See also DrawTransparent and
       StretchDrawTransparent methods. }
    procedure Invert;
    {* Obvious. }
    property Canvas: PCanvas read GetCanvas;
    {* Canvas can be used to draw onto bitmap. Whenever it is accessed, handle
       is allocated for bitmap, if it is not yet (to make it possible
       to select bitmap to display compatible device context). }
    procedure RemoveCanvas;
    {* Call this method to destroy Canvas and free GDI resources. }
    property BkColor: TColor read fBkColor write SetBkColor;
    {* Used to fill background for Bitmap, when its width or height is increased.
       Although this value always synchronized with Canvas.Brush.Color, use it
       instead if You do not use Canvas for drawing on bitmap surface. }
    property Pixels[ X, Y: Integer ]: TColor read GetPixels write SetPixels;
    {* Allows to obtain or change certain pixels of a bitmap. This method is
       both for DIB and DDB bitmaps, and leads to allocate handle anyway. For
       DIB bitmaps, it is possible to use property DIBPixels[ ] instead,
       which is much faster and does not require in Handle. }
    property ScanLineSize: Integer read GetScanLineSize;
    {* Returns size of scan line in bytes. Use it to measure size of a single
       ScanLine. To calculate increment value from first byte of ScanLine to
       first byte of next ScanLine, use difference
       !  Integer(ScanLine[1]-ScanLine[0])
       (this is because bitmap can be oriented from bottom to top, so
       step can be negative). }
    property ScanLine[ Y: Integer ]: Pointer read GetScanLine;
    {* Use ScanLine to access DIB bitmap pixels in memory to direct access it
       fast. Take in attention, that for different pixel formats, different
       bit counts are used to represent bitmap pixels. Also do not forget, that
       for formats pf4bit and pf8bit, pixels actually are indices to palette
       entries, and for formats pf16bit, pf24bit and pf32bit are actually
       RGB values (for pf16bit B:5-G:6-R:5, for pf15bit B:5-G:5-R:5 (high order
       bit not used), for pf24bit B:8-G:8-R:8, and for pf32bit high order byte
       of TRGBQuad structure is not used). }
    property DIBPixels[ X, Y: Integer ]: TColor read GetDIBPixels write SetDIBPixels;
    {* Allows direct access to pixels of DIB bitmap, faster then Pixels[ ]
       property. Access to read is slower for pf15bit, pf16bit formats (because
       some conversation needed to translate packed RGB color to TColor). And
       for write, operation performed most slower for pf4bit, pf8bit (searching
       nearest color required) and fastest for pf24bit, pf32bit and pf1bit. }
    property DIBPalEntryCount: Integer read GetDIBPalEntryCount;
    {* Returns palette entries count for DIB image. Always returns 2 for pf1bit,
       16 for pf4bit, 256 for pf8bit and 0 for other pixel formats. }
    property DIBPalEntries[ Idx: Integer ]: TColor read GetDIBPalEntries write
             SetDIBPalEntries;
    {* Provides direct access to DIB palette. }
    function DIBPalNearestEntry( Color: TColor ): Integer;
    {* Returns index of entry in DIB palette with color nearest (or matching)
       to given one. }
    property DIBBits: Pointer read fDIBBits;
    {* This property is mainly for internal use. }
    property DIBSize: Integer read fDIBSize;
    {* Size of DIBBits array. }
    property DIBHeader: PBitmapInfo read fDIBHeader;
    {* This property is mainly for internal use. }
    procedure DIBDrawRect( DC: HDC; X, Y: Integer; const R: TRect );
    {* This procedure copies given rectangle to the target device context,
       but only for DIB bitmap (using SetDIBBitsToDevice API call). }
    procedure RotateRight;
    {* Rotates bitmap right (90 degree). Bitmap must be DIB. If You definitevely
       know format of a bitmap, use instead one of methods RotateRightMono,
       RotateRight4bit, RotateRight8bit, RotateRight16bit or RotateRightTrueColor
       - this will economy code. But if for most of formats such methods are
       called, this can be more economy just to call always universal method
       RotateRight. }
    procedure RotateLeft;
    {* Rotates bitmap left (90 degree). Bitmap must be DIB. If You definitevely
       know format of a bitmap, use instead one of methods RotateLeftMono,
       RotateLeft4bit, RotateLeft8bit, RotateLeft16bit or RotateLeftTrueColor
       - this will economy code. But if for most of formats such methods are
       called, this can be more economy just to call always universal method
       RotateLeft. }
    procedure RotateRightMono;
    {* Rotates bitmat right, but only if bitmap is monochrome (pf1bit). }
    procedure RotateLeftMono;
    {* Rotates bitmap left, but only if bitmap is monochrome (pf1bit). }
    procedure RotateRight4bit;
    {* Rotates bitmap right, but only if PixelFormat is pf4bit. }
    procedure RotateLeft4bit;
    {* Rotates bitmap left, but only if PixelFormat is pf4bit. }
    procedure RotateRight8bit;
    {* Rotates bitmap right, but only if PixelFormat is pf8bit. }
    procedure RotateLeft8bit;
    {* Rotates bitmap left, but only if PixelFormat is pf8bit. }
    procedure RotateRight16bit;
    {* Rotates bitmap right, but only if PixelFormat is pf16bit. }
    procedure RotateLeft16bit;
    {* Rotates bitmap left, but only if PixelFormat is pf16bit. }
    procedure RotateRightTrueColor;
    {* Rotates bitmap right, but only if PixelFormat is pf24bit or pf32bit. }
    procedure RotateLeftTrueColor;
    {* Rotates bitmap left, but only if PixelFormat is pf24bit or pf32bit. }
    procedure FlipVertical;
    {* Flips bitmap vertically }
    procedure FlipHorizontal;
    {* Flips bitmap horizontally }
    procedure CopyRect( const DstRect : TRect; SrcBmp : PBitmap; const SrcRect : TRect );
    {* It is possible to use Canvas.CopyRect for such purpose, but if You
       do not want use TCanvas, it is possible to copy rectangle from one
       bitmap to another using this function. }
    function CopyToClipboard: Boolean;
    {* Copies bitmap to clipboard. }
    function PasteFromClipboard: Boolean;
    {* Takes CF_DIB format bitmap from clipboard and assigns it to the
       TBitmap object. }
  end;

function Bits2PixelFormat( BitsPerPixel: Integer ): TPixelFormat;

function NewBitmap( W, H: Integer ): PBitmap;
{* Creates bitmap object of given size. If it is possible, do not change its
   size (Width and Heigth) later - this can economy code a bit. See TBitmap. }
function NewDIBBitmap( W, H: Integer; PixelFormat: TPixelFormat ): PBitmap;
{* Creates DIB bitmap object of given size and pixel format. If it is possible,
   do not change its size (Width and Heigth) later - this can economy code a bit.
   See TBitmap. }
function CalcScanLineSize( Header: PBitmapInfoHeader ): Integer;
{* May be will be useful. }

var
  DefaultPixelFormat: TPixelFormat = pf32bit; //pf16bit;

function LoadMappedBitmap( hInst: THandle; BmpResID: Integer; const Map: array of TColor )
         : HBitmap;
{* This function can be used to load bitmap and replace some it colors to
   desired ones. This function especially useful when loaded by the such way
   bitmap is used as toolbar bitmap - to replace some original colors to
   system default colors. To use this function properly, the bitmap shoud
   be prepared as 16-color bitmap, which uses only system colors. To do so,
   create a new 16-color bitmap with needed dimensions in Borland Image Editor
   and paste a bitmap image, copyed in another graphic tool, and then save it.
   If this is not done, bitmap will not be loaded correctly! }
function LoadMappedBitmapEx( MasterObj: PObj; hInst: THandle; BmpResName: PKOLChar;
         const Map: array of TColor ): HBitmap;
{* by Alex Pravdin: like LoadMappedBitmap, but much powerful. It uses
   CreateMappedBitmapEx, so it understands any bitmap color format, including
   pf24bit. Also, LoadMappedBitmapEx provides auto-destroying loaded resource
   when MasterObj is destroyed. }
function CreateMappedBitmap(Instance: THandle; Bitmap: Integer;
  Flags: UINT; ColorMap: PColorMap; NumMaps: Integer): HBitmap; stdcall;
{* Creates mapped bitmap replacing colors correspondently to the
   ColorMap (each pare of colors defines color replaced and a color
   used for replace it in the bitmap). See also CreateMappedBitmapEx. }
function CreateMappedBitmapEx(Instance: THandle; BmpRsrcName: PKOLChar; Flags:
  Cardinal; ColorMap: PColorMap; NumMaps: Integer): HBitmap;
{* By Alex Pravdin.
Creates mapped bitmap independently from bitmap color format (works
correctly with bitmaps having format deeper than 8bit per pixel). }

type
  PIcon = ^TIcon;
{ ----------------------------------------------------------------------
                          TIcon - icon image
----------------------------------------------------------------------- }
  TIcon = object( TObj )
  {* Object type to incapsulate icon or cursor image. }
  protected
    {$IFDEF ICON_DIFF_WH}
    FWidth: Integer;
    FHeight: Integer;
    {$ELSE}
    FSize : Integer;
    {$ENDIF}
    FHandle: HIcon;
    FShareIcon: Boolean;
    procedure SetSize(const Value: Integer);
    {$IFDEF ICON_DIFF_WH}
    function GetIconSize: Integer;
    {$ENDIF}
    procedure SetHandle(const Value: HIcon);
    function GetHotSpot: TPoint;
    function GetEmpty: Boolean;
  protected
    destructor Destroy; virtual;
  public
    {$IFDEF ICONLOAD_PRESERVEBMPS}
    ImgBmp, MskBmp : PBitmap;
    Only_Bmp: Boolean;
    {$ENDIF ICONLOAD_PRESERVEBMPS}
    property Size : Integer read
      {$IFDEF ICON_DIFF_WH}
      GetIconSize
      {$ELSE}
      FSize
      {$ENDIF}
    write SetSize;
    {* Icon dimension (width and/or height, which are equal to each other always). }
    {$IFDEF ICON_DIFF_WH}
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    {$ENDIF}
    property Handle : HIcon read FHandle write SetHandle;
    {* Windows icon object handle. }
    procedure SetHandleEx( NewHandle: HIcon );
    {* Set Handle without changing Size (Width/Height). }
    procedure Clear;
    {* Clears icon, freeing image and allocated GDI resource (Handle). }
    property Empty: Boolean read GetEmpty;
    {* Returns True if icon is Empty. }
    property ShareIcon : Boolean read FShareIcon write FShareIcon;
    {* True, if icon object is shared and can not be deleted when TIcon object
       is destroyed (set this flag is to True, if an icon is obtained from another
       TIcon object, for example). }
    property HotSpot : TPoint read GetHotSpot;
    {* Hot spot point - for cursors. }
    procedure Draw( DC : HDC; X, Y : Integer );
    {* Draws icon onto given device context. Icon always is drawn transparently
       using its transparency mask (stored internally in icon object). }
    procedure StretchDraw( DC : HDC; Dest : TRect );
    {* Draws icon onto given device context with stretching it to fit destination
       rectangle. See also Draw. }
    procedure LoadFromStream( Strm : PStream );
    {* Loads icon from stream. If stream contains several icons (of
       different dimentions), icon with the most appropriate size is loading. }
    procedure LoadFromFile( const FileName : KOLString );
    {* Load icon from file. If file contains several icons (of
       different dimensions), icon with the most appropriate size is loading. }
    procedure LoadFromResourceID( Inst: Integer; ResID: Integer; DesiredSize: Integer );
    {* Loads icon from resource. To load system default icon, pass 0 as Inst and
       one of followin values as ResID:
       |<pre>
       IDI_APPLICATION  Default application icon.
       IDI_ASTERISK     Asterisk (used in informative messages).
       IDI_EXCLAMATION  Exclamation point (used in warning messages).
       IDI_HAND         Hand-shaped icon (used in serious warning messages).
       IDI_QUESTION     Question mark (used in prompting messages).
       IDI_WINLOGO      Windows logo.
       |</pre> It is also possible to load icon from resources of another module,
       if pass instance handle of loaded module as Inst parameter. }
    procedure LoadFromResourceName( Inst: Integer; ResName: PKOLChar; DesiredSize: Integer );
    {* Loads icon from resource. To load own application resource, pass
       hInstance as Inst parameter. It is possible to load resource from
       another module, if pass its instance handle as Inst. }
    procedure LoadFromExecutable( const FileName: KOLString; IconIdx: Integer );
    {* Loads icon from executable (exe or dll file). Always default sized icon
       is loaded. It is possible also to get know how much icons are contained
       in executable using gloabl function GetFileIconCount. To obtain icon of
       another size, try to load given executable and use LoadFromResourceID
       method. }
    procedure SaveToStream( Strm : PStream );
    {* Saves single icon to stream. To save icons with several different
       dimensions, use global procedure SaveIcons2Stream. }
    procedure SaveToFile( const FileName : KOLString );
    {* Saves single icon to file. To save icons with several different
       dimensions, use global procedure SaveIcons2File. }
    function Convert2Bitmap( TranColor: TColor ): HBitmap;
    {* Converts icon to bitmap, returning Windows GDI bitmap resource as
       a result. It is possible later to assign returned bitmap handle to
       Handle property of TBitmap object to use features of TBitmap.
       Pass TranColor to replace transparent area of icon with given color. }
  end;

  procedure SaveIcons2Stream( const Icons : array of PIcon; Strm : PStream );
  {* Saves several icons (of different dimentions) to stream. }
  function SaveIcons2StreamEx( const BmpHandles: array of HBitmap; Strm: PStream ): Boolean;
  {* Saves icons creating it from pairs of bitmaps and their masks.
     BmpHandles array must contain pairs of bitmap handles, each pair
     of color bitmap and mask bitmap of the same size. }
  procedure SaveIcons2File( const Icons : array of PIcon; const FileName : KOLString );
  {* Saves several icons (of different dimentions) to file. (Single file
     with extension .ico can contain several different sized icon images
     to use later one with the most appropriate size). }

  function NewIcon: PIcon;
  {* Creates new icon object, setting its Size to 32 by default. Created icon
     is Empty. }
  function GetFileIconCount( const FileName: KOLString ): Integer;
  {* Returns number of icon resources stored in given (executable) file. }

type
  TIconHeader = packed record
    idReserved: Word; (* Always set to 0 *)
    idType: Word;     (* Always set to 1 *)
    idCount: Word;    (* Number of icon images *)
    (* immediately followed by idCount TIconDirEntries *)
  end;

  TIconDirEntry = packed record
    bWidth: Byte;          (* Width *)
    bHeight: Byte;         (* Height *)
    bColorCount: Byte;     (* Nr. of colors used *)
    bReserved: Byte;       (* not used, 0 *)
    wPlanes: Word;         (* not used, 0 *)
    wBitCount: Word;       (* not used, 0 *)
    dwBytesInRes: Longint; (* total number of bytes in images *)
    dwImageOffset: Longint;(* location of image from the beginning of file *)
  end;

function LoadImgIcon( RsrcName: PKOLChar; Size: Integer ): HIcon;
{* Loads icon of specified size from the resource. }

////////////////////////////////////////////////////////////////////////////////
//                       UNIVERSAL CONTROL OBJECT                             //
////////////////////////////////////////////////////////////////////////////////

const
  CM_EXECPROC       = $8FFF;
  CM_BASE           = $B000;
  CM_ACTIVATE       = CM_BASE + 0;
  CM_DEACTIVATE     = CM_BASE + 1;
  CM_ENTER          = CM_BASE + 2;
  CM_RELEASE        = CM_BASE + 3;
  CM_QUIT           = CM_BASE + 4;
  CM_COMMAND        = CM_BASE + 5;
  CM_MEASUREITEM    = CM_BASE + 6;
  CM_DRAWITEM       = CM_BASE + 7;
  CM_TRAYICON       = CM_BASE + 8;
  CM_INVALIDATE     = CM_BASE + 9;
  CM_UPDATE         = CM_BASE + 10;
  CM_NCUPDATE       = CM_BASE + 11;
  CM_SIZEPOS        = CM_BASE + 12;
  CM_SIZE           = CM_BASE + 13;
  CM_SETFOCUS       = CM_BASE + 14;
  CM_CBN_SELCHANGE  = 15;

  CM_UIACTIVATE     = CM_BASE + 16;
  CM_UIDEACTIVATE   = CM_BASE + 17;
  CM_PROCESS        = CM_BASE + 18;
  CM_SHOW           = CM_BASE + 19;

  CM_AUTOSIZE          = CM_BASE + 20;
  CM_MDIClientShowEdge = CM_BASE + 21;

  CM_INVALIDATECHILD   = CM_BASE + 22;
  CM_FOCUSGRAPHCTL     = CM_BASE + 23;

  WM_SYNCPAINT         = $88;

  CN_BASE = $BC00;
  CN_CHARTOITEM        = CN_BASE + WM_CHARTOITEM;
  CN_COMMAND           = CN_BASE + WM_COMMAND;
  CN_COMPAREITEM       = CN_BASE + WM_COMPAREITEM;

  CN_CTLCOLORMSGBOX    = CN_BASE + WM_CTLCOLORMSGBOX;
  CN_CTLCOLOREDIT      = CN_BASE + WM_CTLCOLOREDIT;
  CN_CTLCOLORLISTBOX   = CN_BASE + WM_CTLCOLORLISTBOX;
  CN_CTLCOLORBTN       = CN_BASE + WM_CTLCOLORBTN;
  CN_CTLCOLORDLG       = CN_BASE + WM_CTLCOLORDLG;
  CN_CTLCOLORSCROLLBAR = CN_BASE + WM_CTLCOLORSCROLLBAR;
  CN_CTLCOLORSTATIC    = CN_BASE + WM_CTLCOLORSTATIC;

  CN_DELETEITEM        = CN_BASE + WM_DELETEITEM;
  CN_DRAWITEM          = CN_BASE + WM_DRAWITEM;
  CN_HSCROLL           = CN_BASE + WM_HSCROLL;
  CN_MEASUREITEM       = CN_BASE + WM_MEASUREITEM;
  CN_PARENTNOTIFY      = CN_BASE + WM_PARENTNOTIFY;
  CN_VKEYTOITEM        = CN_BASE + WM_VKEYTOITEM;
  CN_VSCROLL           = CN_BASE + WM_VSCROLL;
  CN_KEYDOWN           = CN_BASE + WM_KEYDOWN;
  CN_KEYUP             = CN_BASE + WM_KEYUP;
  CN_CHAR              = CN_BASE + WM_CHAR;
  CN_SYSKEYDOWN        = CN_BASE + WM_SYSKEYDOWN;
  CN_SYSCHAR           = CN_BASE + WM_SYSCHAR;
  CN_NOTIFY            = CN_BASE + WM_NOTIFY;

{$ENDIF WIN_GDI}
const
  ID_SELF: array[ 0..5 ] of KOLChar = ( 'S','E','L','F','_',#0 );
  {* Identifier for window property "Self", stored directly in window, when
     it is created. This property is used to [fast] find TControl object,
     correspondent to given window handle (using API call GetProp). }

{$IFDEF WIN_GDI}
  ID_PREVPROC: array[ 0..9 ] of KOLChar = ( 'P','R','E','V','_','P','R','O','C',#0 );
  {$IFNDEF USE_FLAGS}
  RADIO_LAST: array[ 0..7 ] of KOLChar = ( 'R','A','D','_','L','S','T',#0 );
  RADIO_1ST: array[ 0..7 ] of KOLChar = ( 'R','A','D','_','1','S','T',#0 );
  {$ENDIF}
  MIN_WND: array[ 0..7 ] of KOLChar = ( 'M','I','N','_','W','N','D',#0 );
  DFLT_BTN: array[ 0..7 ] of KOLChar = ( 'D','F','L','T','_','B','T',#0 );
  CNCL_BTN: array[ 0..7 ] of KOLChar = ( 'C','N','C','L','_','B','T',#0 );
  DRAG_XY: array[ 0..7 ] of KOLChar = ( 'D','R','A','G','_','X','Y',#0 );
  MDI_CHLDRN: array[ 0..10 ] of KOLChar = ( 'M','D','I','_','C','H','L','D','R','N',#0 );

{$ENDIF WIN_GDI}
const
  MK_LBUTTON = 1;
  MK_RBUTTON = 2;
  MK_SHIFT = 4;
  MK_CONTROL = 8;
  MK_MBUTTON = $10;
  MK_ALT = $20;  // MK_ALT DEFINED
  MK_LOCK = $40; // CAPS LOCK or SHIFT LOCK
{$IFDEF WIN_GDI}

{$IFNDEF NOT_USE_RICHEDIT}
type
  {$IFDEF UNICODE_CTRLS}
  TCharFormat2 = TCharFormat2W;
  {$ELSE}
  {$IFDEF _D3orHigher}
  TCharFormat2 = TCharFormat2A;
  {$ELSE} // Delphi2
  TCharFormat2 = packed record
    cbSize: UINT;
    dwMask: DWORD;
    dwEffects: DWORD;
    yHeight: Longint;
    yOffset: Longint;
    crTextColor: TColorRef;
    bCharSet: Byte;
    bPitchAndFamily: Byte;
    szFaceName: array[0..LF_FACESIZE - 1] of KOLChar;
    R2Bytes: Word;
    wWeight: Word;                   { Font weight (LOGFONT value)		 }
    sSpacing: Smallint;              { Amount to space between letters	 }
    crBackColor: TColorRef;          { Background color					 }
    lid: LCID;                       { Locale ID						 }
    dwReserved: DWORD;               { Reserved. Must be 0				 }
    sStyle: Smallint;                { Style handle						 }
    wKerning: Word;                  { Twip size above which to kern char pair }
    bUnderlineType: Byte;            { Underline type					 }
    bAnimation: Byte;                { Animated text like marching ants	 }
    bRevAuthor: Byte;                { Revision author index			 }
    bReserved1: Byte;
  end;  {$ENDIF _D3orHigher}
  {$ENDIF}

  PParaFormat2 = ^TParaFormat2;
  TParaFormat2 = packed record
    cbSize: UINT;
    dwMask: DWORD;
    wNumbering: Word;
    wReserved: Word;
    dxStartIndent: Longint;
    dxRightIndent: Longint;
    dxOffset: Longint;
    wAlignment: Word;
    cTabCount: Smallint;
    rgxTabs: array [0..MAX_TAB_STOPS - 1] of Longint;
    dySpaceBefore: Longint;     { Vertical spacing before para			 }
    dySpaceAfter: Longint;      { Vertical spacing after para			 }
    dyLineSpacing: Longint;     { Line spacing depending on Rule		 }
    sStyle: Smallint;           { Style handle							 }
    bLineSpacingRule: Byte;     { Rule for line spacing (see tom.doc)	 }
    bCRC: Byte;                 { Reserved for CRC for rapid searching	 }
    wShadingWeight: Word;       { Shading in hundredths of a per cent	 }
    wShadingStyle: Word;        { Nibble 0: style, 1: cfpat, 2: cbpat	 }
    wNumberingStart: Word;      { Starting value for numbering			 }
    wNumberingStyle: Word;      { Alignment, roman/arabic, (), ), ., etc. }
    wNumberingTab: Word;        { Space bet 1st indent and 1st-line text }
    wBorderSpace: Word;         { Space between border and text (twips) }
    wBorderWidth: Word;         { Border pen width (twips)				 }
    wBorders: Word;             { Byte 0: bits specify which borders	 }
                                { Nibble 2: border style, 3: color index }
  end;

  TGetTextLengthEx = packed record
    flags: DWORD;              { flags (see GTL_XXX defines)				 }
    codepage: UINT;            { code page for translation (CP_ACP for default,
                                 1200 for Unicode 					 }
  end;

const
  PFM_SPACEBEFORE                     = $00000040;
  PFM_SPACEAFTER                      = $00000080;
  PFM_LINESPACING                     = $00000100;
  PFM_STYLE                           = $00000400;
  PFM_BORDER                          = $00000800;      { (*)	 }
  PFM_SHADING                         = $00001000;      { (*)	 }
  PFM_NUMBERINGSTYLE                  = $00002000;      { (*)	 }
  PFM_NUMBERINGTAB                    = $00004000;      { (*)	 }
  PFM_NUMBERINGSTART                  = $00008000;      { (*)	 }

  PFM_RTLPARA                         = $00010000;
  PFM_KEEP                            = $00020000;      { (*)	 }
  PFM_KEEPNEXT                        = $00040000;      { (*)	 }
  PFM_PAGEBREAKBEFORE                 = $00080000;      { (*)	 }
  PFM_NOLINENUMBER                    = $00100000;      { (*)	 }
  PFM_NOWIDOWCONTROL                  = $00200000;      { (*)	 }
  PFM_DONOTHYPHEN                     = $00400000;      { (*)	 }
  PFM_SIDEBYSIDE                      = $00800000;      { (*)	 }

  PFM_TABLE                           = $c0000000;      { (*)	 }
  EM_REDO                             = WM_USER + 84;
  EM_AUTOURLDETECT                    = WM_USER + 91;
  EM_GETAUTOURLDETECT                 = WM_USER + 92;
  CFM_UNDERLINETYPE           = $00800000;              { (*)	 }
  CFM_HIDDEN                  = $0100;                  { (*)	 }
  CFM_BACKCOLOR               = $04000000;
  CFE_AUTOBACKCOLOR           = CFM_BACKCOLOR;
  GTL_USECRLF         = 1;      { compute answer using CRLFs for paragraphs }
  GTL_PRECISE         = 2;      { compute a precise answer					 }
  GTL_CLOSE           = 4;      { fast computation of a "close" answer		 }
  GTL_NUMCHARS        = 8;      { return the number of characters			 }
  GTL_NUMBYTES        = 16;     { return the number of _bytes_				 }
  EM_GETTEXTLENGTHEX                  = WM_USER + 95;
  EM_SETLANGOPTIONS                   = WM_USER + 120;
  EM_GETLANGOPTIONS                   = WM_USER + 121;

  EM_SETEDITSTYLE = $400 + 204;
  EM_GETEDITSTYLE = $400 + 205;

  SES_EMULATESYSEDIT = 1;
  SES_BEEPONMAXTEXT = 2;
  SES_EXTENDBACKCOLOR = 4;
  SES_MAPCPS = 8;
  SES_EMULATE10 = 16;
  SES_USECRLF = 32;
  SES_USEAIMM = 64;
  SES_NOIME = 128;
  SES_ALLOWBEEPS = 256;
  SES_UPPERCASE = 512;
  SES_LOWERCASE = 1024;
  SES_NOINPUTSEQUENCECHK = 2048;
  SES_BIDI = 4096;
  SES_SCROLLONKILLFOCUS = 8192;
  SES_XLTCRCRLFTOCR = 16384;

  EM_GETSCROLLPOS = WM_USER + 221;
  EM_SETSCROLLPOS = WM_USER + 222;
  EM_GETZOOM	  = WM_USER + 224;
  EM_SETZOOM      = WM_USER + 225;
{$ENDIF NOT_USE_RICHEDIT}
{$ENDIF WIN_GDI}

const
    idx_fOnMessage          = 0;
    idx_fOldOnMessage       = 1;
    idx_fOnClick            = 2;
    idx_fOnMouseDown        = 3;
    idx_fOnMouseUp          = 4;
    idx_fOnMouseMove        = 5;
    idx_fOnMouseDblClk      = 6;
    idx_fOnMouseWheel       = 7;
    idx_fOnMouseEnter       = 8;
    idx_fOnMouseLeave       = 9;
    idx_fOnTestMouseOver    = 10;
    idx_fGraphCtlMouseEvent = 11;
    idx_fMouseLeaveProc     = 12;
    idx_fOnScroll           = 13;
    idx_fOnChar             = 14;
    idx_fOnDeadChar         = 15;
    idx_fOnKeyUp            = 16;
    idx_fOnKeyDown          = 17;
    idx_fOnChangeCtl           = 18;
    idx_fOnEnter            = 19;
    idx_fOnLeave            = 20;
    idx_fLeave              = 21;
    idx_fOnPaint            = 22;
    idx_fOnPaint2           = 23;
    idx_fOnPrepaint         = 24;
    idx_fOnPostPaint        = 25;
    idx_fPaintProc          = 26;
    idx_fOnEraseBkgnd       = 27;
    idx_fOnDrawItem         = 28;
    idx_fOnMeasureItem      = 29;
    idx_fDragCallback       = 30;
    idx_fOnSelChange        = 31;
    idx_fOnResize           = 32;
    idx_fOnHide             = 33;
    idx_fOnShow             = 34;
    idx_fOnClose            = 35;
    idx_fOnMove             = 36;
    idx_fOnMoving           = 37;
    idx_fOnHelp             = 38;
    idx_fOnQueryEndSession  = 39;
    idx_fOnMinimize         = 40;
    idx_fOnMaximize         = 41;
    idx_fOnRestore          = 42;
    idx_fOnLVCustomDraw     = 43;
    idx_fOnEndEditLVITem    = 44;
    idx_fOnLVData           = 45;
    idx_fOnCompareLVItems   = 46;
    idx_FOnLVStateChange    = 47;
    idx_fOnDeleteLVItem     = 48;
    idx_fOnColumnClick      = 49;
    idx_FOnSBBeforeScroll   = 50;
    idx_FOnSBScroll         = 51;
    idx_FOnDropDown         = 52;
    idx_FOnCloseUp          = 53;
    idx_FOnSplit            = 54;
    idx_FOnProgress         = 55;
    idx_FOnBitBtnDraw       = 56;
    idx_FOnTVBeginDrag      = 57;
    idx_FOnTVBeginEdit      = 58;

    idx_FOnTVEndEdit        = 59;
    idx_FOnTVExpanding      = 60;
    idx_FOnTVExpanded       = 61;
    idx_FOnTVSelChanging    = 62;

    idx_FOnTVDelete         = 63;
    idx_FOnDTPUserString    = 64;
    idx_FOnREInsModeChg     = 65;
    idx_FOnREOverURL        = 66;
    idx_FOnREURLClick       = 67;
    idx_fOnDropFiles        = 68;

    idx_LastEvent           = 68;

    idx_fWndFunc            = 69;
    idx_fDoInvalidate       = 70;
    idx_fOnDynHandlers      = 71;
    idx_fPass2DefProc       = 72;
    idx_fWndProcKeybd       = 73;
    idx_fControlClick       = 74;
    idx_fAutoSize           = 75;
    //{-2.95}//idx_fWndProcResizeFlicks
    idx_fGotoControl        = 76;
    idx_fNotifyChild        = 77;
    idx_fScrollChildren     = 78;
    //idx_FBitBtnGetCaption
    //idx_FBitBtnExtDraw
    idx_fCreateWndExt       = 79;
    idx_fExMsgProc          = 80;
    idx_LastProc            = 80;

const
  ANCHOR_LEFT   = 1;
  ANCHOR_RIGHT  = 2;
  ANCHOR_TOP    = 4;
  ANCHOR_BOTTOM = 8;
  SELF_REQ_PAINT = 16;
  PARENT_REQ_PAINT = 32;
  MDI_NOT_AVAILABLE = 64;
  MDI_DESTROYING = 128;

type
///////////////////////////////////////////
{$ifndef _D6orHigher}                    //
///////////////////////////////////////////
   TMethod = packed record
   {* Is defined here because using of VCL classes.pas unit is
      not recommended in XCL. This record type is used often
      to set/access event handlers, referring to a procedure
      of object (usually to set such event to an ordinal
      procedure setting Data field to nil. }
    Code: Pointer; // Pointer to method code.
    {* If used to fake assigning to event handler of type 'procedure
       of object' with ordinal procedure pointer, use symbol '@'
       before method:
       |<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<font face="Courier"><b>
       |    Method.Code := @MyProcedure;
       |</b></font> }
    Data: Pointer; // Pointer to object, owning the method.
    {* To fake event of type 'procedure of object' with setting it to
       ordinal procedure assign here NIL; }
   end;
   {* When assigning TMethod record to event handler, typecast it with
      desired event type, e.g.:
      |<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<font face="Courier"><b>
      |     SomeObject.OnSomeEvent := TOnSomeEvent( Method );
      |</b></font><br> }
///////////////////////////////////////////
{$endif}                                 //
///////////////////////////////////////////
   PMethod = ^TMethod;
   {* }

   function MakeMethod( Data, Code: Pointer ): TMethod;
   {* Help function to construct TMethod record. Can be useful to
      assign regular type procedure/function as event handler for
      event, defined as object method (do not forget, that in that
      case it must have first dummy parameter to replace @Self,
      passed in EAX to methods of object). }

type
  T3Style = ( F3_Maximize, F3_ClipChildren, F3_ClipSiblings,
              F3_Disabled, F3_Visible, F3_Minimize,
              F3_Child, F3_Popup );
  T3Styles = Set of T3Style;

  T2Style = ( F2_Tabstop, F2_Group, F2_Thickframe, F2_Sysmenu,
              F2_HScroll, F2_VScroll, F2_Dlgframe, F2_Border );
  T2Styles = Set of T2Style;

  TStyle = packed record
      CASE Integer OF
      1:  (
            f0_Style: Byte;
            f1_Style: Byte;
            f2_Style: T2Styles;
            f3_Style: T3Styles;
          );
      2:  ( Value: DWORD; );
  end;

  T1Flag = ( G1_WordWrap, G1_PreventResize, G1_IconShared,
             G1_IgnoreWndCaption, G1_SizeRedraw, G1_IsStaticControl,
             G1_CanNotDoublebuf, G1_HasRadio ); //
  T1Flags = Set of T1Flag;

  T2Flag = ( G2_Transparent, G2_DoubleBuffered, G2_ClassicTransparent,
             G2_Destroying, G2_BeginDestroying,
             G2_ChangedPos, G2_ChangedW, G2_ChangedH ); //
  T2Flags = Set of T2Flag;

  T3Flag = ( G3_ClassicTransparent, G3_IsForm, G3_SizeGrip, G3_IsControl,
             G3_IsApplet, G3_IsMDIChild, G3_Flat, G3_MouseInCtl ); //
  T3Flags = Set of T3Flag;

  T4Flag = ( G4_CreateHidden, G4_VisibleWOParent, G4_NotUseAlign,
             G4_CreateVisible, G4_Pushed, G4_Checked, G4_Hot, G4_Pressed ); //
                               // use G4_Pushed also as KeyPreviewing for form
  T4Flags = Set of T4Flag;

  T5Flag = ( G5_IsButton, G5_IsBitBtn, G5_IsSplitter, G5_IsGroupbox,
             G5_IsCommonCtl, G5_3ButtonPress, G5_EraseBkgnd, G5_IgnoreDefault );
  T5Flags = Set of T5Flag;

  T6Flag = ( G6_KeyPreview, G6_DefaultBtn, G6_CancelBtn, G6_Focused,
             G6_GraphicCtl, G6_CtlClassNameChg, G6_RightClick, G6_Dragging );
  T6Flags = Set of T6Flag;

  PControl = ^TControl;
  {* Type of pointer to TControl visual object. All
     |<a href="kol_pas.htm#visual_objects_constructors">
     constructing functions
     |</a>
     New[ControlName] are returning
     pointer of this type. Do not forget about some difference
     of using objects from using classes. Identifier Self for
     methods of object is not of pointer type, and to pass
     pointer to Self, it is necessary to pass @Self instead.
     At the same time, to use pointer to object in 'WITH' operator,
     it is necessary to apply suffix '^' to pointer to get know
     to compiler, what do You want. }
{$IFDEF WIN}
  TWindowFunc = function( Sender: PControl; var Msg: TMsg; var Rslt: Integer )
                          : Boolean;
  {* Event type to define custom extended message handlers (as pointers to
     procedure entry points). Such handlers are usually defined like add-ons,
     extending behaviour of certain controls and attached using AttachProc
     method of TControl. If the handler detects, that it is necessary to stop
     further message processing, it should return True. }
{$ENDIF WIN}

  TMouseButton = ( mbNone, mbLeft, mbRight, mbMiddle );
  {* Available mouse buttons. mbNone is useful to get know, that
     there were no mouse buttons pressed. }

  TMouseEventData = packed Record
  {* Record to pass it to mouse handling routines, assigned to OnMouseXXXX
     events. }
    Button: TMouseButton;
    StopHandling: Boolean; // Set it to True in OnMouseXXXX event handler to
                           // stop further processing
    R1, R2: Byte; // Not used
    Shift : DWORD;    // HiWord( Shift ) = zDelta in WM_MOUSEWHEEL
    X, Y  : SmallInt;
  end;

  TOnMouse = procedure( Sender: PControl; var Mouse: TMouseEventData ) of object;
  {* Common mouse handling event type. }

  TOnKey = procedure( Sender: PControl; var Key: Longint; Shift: DWORD ) of object;
  {* Key events. Shift is a combination of flags MK_SHIFT, MK_CONTROL, MK_ALT.
     (See GetShiftState funtion). }

  TOnChar = procedure( Sender: PControl; var Key: KOLChar; Shift: DWORD ) of object;
  {* Char event. Shift is a combination of flags MK_SHIFT, MK_CONTROL, MK_ALT. }

  TTabKey = ( tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn );
  {* Available tabulating key groups. }
  TTabKeys = Set of TTabKey;
  {* Set of tabulating key groups, allowed to be used in with a control
     (are installed by TControl.LookTabKey property). }

{$IFDEF WIN}
  TOnMessage = function( var Msg: TMsg; var Rslt: Integer ): Boolean of object;
  {* Event type for events, which allows to extend behaviour of windowed controls
     descendants using add-ons. }
{$ENDIF WIN}

  TOnEventAccept = procedure( Sender: PObj; var Accept: Boolean ) of object;
  {* Event type for OnClose event. }
  TCloseQueryReason = ( qClose, qShutdown, qLogoff );
  {* Request reason type to call OnClose and OnQueryEndSession. }
  TWindowState = ( wsNormal, wsMinimized, wsMaximized );
  {* Avalable states of TControl's window object. }

  TOnSplit = function( Sender: PControl; NewSize1, NewSize2: Integer ): Boolean of object;
  {* Event type for OnSplit event handler, designed specially for splitter
     control. Event handler must return True to accept new size of previous
     (to splitter) control and new size of the rest of client area of parent. }

  TOnTVBeginDrag = procedure( Sender: PControl; Item: THandle ) of object;
  {* Event type for OnTVBeginDrag event (defined for tree view control). }
  TOnTVBeginEdit = function( Sender: PControl; Item: THandle ): Boolean of object;
  {* Event type for OnTVBeginEdit event (for tree view control). }
  TOnTVEndEdit = function( Sender: PControl; Item: THandle; const NewTxt: KOL_String )
               : Boolean of object;
  {* Event type for TOnTVEndEdit event. }
  TOnTVExpanding = function( Sender: PControl; Item: THandle; Expand: Boolean )
                 : Boolean of object;
  {* Event type for TOnTVExpanding event. }
  TOnTVExpanded = procedure( Sender: PControl; Item: THandle; Expand: Boolean )
                of object;
  {* Event type for OnTVExpanded event. }
  TOnTVDelete = procedure( Sender: PControl; Item: THandle ) of object;
  {* Event type for OnTVDelete event. }

  //--------- by Sergey Shisminzev :
  TOnTVSelChanging = function(Sender: PControl; oldItem, newItem: THandle): Boolean  //~ss
                  of object;
  {* When the handler returns False, selection is not changed. }
  //-------------------------------
  TOnDrag = function( Sender: PControl; ScrX, ScrY: Integer; var CursorShape: Integer;
            var Stop: Boolean ): Boolean of object;
  {* Event, called during dragging operation (it is initiated
     with method Drag, where callback function of type TOnDrag is
     passed as a parameter). Callback function receives Stop parameter True,
     when operation is finishing. Otherwise, it can set it to True to force
     finishing the operation (in such case, returning False means cancelling
     drag operation, True - successful drag and in this last case callback is
     no more called). During the operation, when input Stop value is False,
     callback function can control Cursor shape, and return True, if the operation
     can be finished successfully at the given ScrX, ScrY position.
     ScrX, ScrY are screen coordinates of the mouse cursor. }

{$IFDEF WIN}
  TCreateParams = packed record
  {* Record to pass it through CreateSubClass method. }
	Caption: PKOLChar;
    Style: cardinal;
    ExStyle: cardinal;
    X, Y: Integer;
    Width, Height: Integer;
    WndParent: HWnd;
    Param: Pointer;
    WindowClass: TWndClass;
    WinClassName: array[0..63] of KOLChar;
  end;

  TCreateWndParams = packed Record
    ExStyle: DWORD;
	WinClassName: PKOLChar;
	Caption: PKOLChar;
    Style: DWORD;
    X, Y, Width, Height: Integer;
    WndParent: HWnd;
    Menu: HMenu;
    Inst: THandle;
    Param: Pointer;
	WinClsNamBuf: array[ 0..63 ] of KOLChar;
	WindowClass: TWndClass;
  end;

  PCommandActions = ^TCommandActions;
  TCommandActions = packed Record
    aClear: procedure( Sender: PControl );
    aAddText: procedure( Sender: PControl; const S: AnsiString );
    aClick, aEnter, aLeave: WORD;
    aChange: SmallInt; aSelChange: SmallInt;
    aGetCount, aSetCount, aGetItemLength, aGetItemText, aSetItemText,
    aGetItemData, aSetItemData: WORD;
    aAddItem, aDeleteItem, aInsertItem: WORD;
    aFindItem, aFindPartial: WORD;
    bItem2Pos, bPos2Item: BYTE;
    aGetSelCount, aGetSelected, aGetSelRange,
    aGetCurrent,
    aSetSelected, aSetCurrent, aSetSelRange, aExSetSelRange,
    aGetSelection, aReplaceSel: WORD;
    aTextAlignLeft, aTextAlignRight, aTextAlignCenter: WORD;
    bTextAlignMask: Byte;
    bVertAlignTop, bVertAlignCenter, bVertAlignBottom: Byte;
    aDir, aSetLimit: Word; aSetImgList: Word;
    aSetBkColor: Word;
    aItem2XY: Word;
  end;

  {$IFDEF COMMANDACTIONS_OBJ}
  PCommandActionsObj = ^TCommandActionsObj;
  TCommandActionsObj = object(TObj)
    aClear: procedure( Sender: PControl );
    aAddText: procedure( Sender: PControl; const S: KOLString );
    aClick, aEnter, aLeave: WORD;
    aChange: SmallInt; aSelChange: SmallInt;
    aGetCount, aSetCount, aGetItemLength, aGetItemText, aSetItemText,
    aGetItemData, aSetItemData: WORD;
    aAddItem, aDeleteItem, aInsertItem: WORD;
    aFindItem, aFindPartial: WORD;
    bItem2Pos, bPos2Item: BYTE;
    aGetSelCount, aGetSelected, aGetSelRange,
    aGetCurrent,
    aSetSelected, aSetCurrent, aSetSelRange, aExSetSelRange,
    aGetSelection, aReplaceSel: WORD;
    aTextAlignLeft, aTextAlignRight, aTextAlignCenter: WORD;
    bTextAlignMask: Byte;
    bVertAlignTop, bVertAlignCenter, bVertAlignBottom: Byte;
    aDir, aSetLimit: Word; aSetImgList: Word;
    aSetBkColor: Word;
    aItem2XY: Word;
    fIndexInActions: Integer;
    destructor Destroy; virtual;
  end;
  {$ENDIF}
{$ENDIF WIN}

  TTextAlign = ( taLeft, taRight, taCenter );
  {* Text alignments available. }
  TRichTextAlign = ( raLeft, raRight, raCenter,
                 // all other are only set but can not be displayed:
                 raJustify, // displayed like raLeft (though stored normally)
                 raInterLetter, raScaled, raGlyphs, raSnapGrid );
  {* Text alignment styles, available for RichEdit control. }
  TVerticalAlign = ( vaTop, vaCenter, vaBottom );
  {* Vertical alignments available. }
  TControlAlign = ( caNone, caLeft, caTop, caRight, caBottom, caClient );
  {* Control alignments available. }
  TAligning = (oaWaitAlign,oaFromSelf,oaAligning);
  TAlignings = set of TAligning;

  TBitBtnOption = ( bboImageList,
                    bboNoBorder,
                    bboNoCaption,
                    bboFixed,
                    bboFocusRect );
  {* Options available for NewBitBtn. }
  TBitBtnOptions = set of TBitBtnOption;
  {* Set of options, available for NewBitBtn. }
  TGlyphLayout = ( glyphLeft, glyphTop, glyphRight, glyphBottom, glyphOver );
  {* Layout of glyph (for NewBitBtn). Layout glyphOver means that text is
     drawn over glyph. }
  TOnBitBtnDraw = function( Sender: PControl; BtnState: Integer ): Boolean of object;
  {* Event type for TControl.OnBitBtnDraw event (which is called just before
     drawing the BitBtn). If handler returns True, there are no drawing occure.
     BtnState, passed to a handler, determines current button state and can
     be following: 0 - not pressed, 1 - pressed, 2 - disabled, 3 - focused.
     Value 4 is reserved for highlight state (then mouse is over it), but
     highlighting is provided only if property Flat is set to True (or one
     of events OnMouseEnter / OnMouseLeave is assigned to something). }

  TListViewStyle = ( lvsIcon, lvsSmallIcon, lvsList, lvsDetail, lvsDetailNoHeader );
  {* Styles of view for ListView control (see NewListVew). }

  TListViewItemStates = ( lvisFocus, lvisSelect, lvisBlend, lvisHighlight );
  TListViewItemState = Set of TListViewItemStates;
  TListViewOption = (
    lvoIconLeft,      // in lvsIcon, lvsSmallIcon place icon left from text (rather then top)
    lvoAutoArrange,   // keep icons auto arranged in lvsIcon and lvsSmallIcon view
    lvoButton,        // icons look like buttons in lvsIcon view
    lvoEditLabel,     // allows edit labels inplace (first column #0 text)
    lvoNoLabelWrap,   // item text on a single line in lvsIcon view (by default, item text may wrap in lvsIcon view).
    lvoNoScroll,      // obvious
    lvoNoSortHeader,  // click on header button does not lead to sort items
    lvoHideSel,       // hide selection when not in focus
    lvoMultiselect,   // allow to select multiple items
    lvoSortAscending,
    lvoSortDescending,
      // extended styles (not documented in my Win32.hlp :( , got from VCL source:
    lvoGridLines,
    lvoSubItemImages,
    lvoCheckBoxes,
    lvoTrackSelect,
    lvoHeaderDragDrop,
    lvoRowSelect,
    lvoOneClickActivate,
    lvoTwoClickActivate,
    lvoFlatsb,
    lvoRegional,
    lvoInfoTip,
    lvoUnderlineHot,
    lvoMultiWorkares,
      // virtual list view style:
    lvoOwnerData,
      // custom draw style:
    lvoOwnerDrawFixed
     );
  TListViewOptions = Set of TListViewOption;

  TOnEditLVItem = function( Sender: PControl; Idx, Col: Integer; NewText: PKOL_Char ): Boolean
                  of object;
  {* Event type for OnEndEditLVItem. Return True in handler to accept new text value. }
  TOnDeleteLVItem = procedure( Sender: PControl; Idx: Integer ) of object;
  {* Event type for OnDeleteLVItem event. }
  TOnLVData = procedure( Sender: PControl; Idx, SubItem: Integer;
              var Txt: KOL_String; var ImgIdx: Integer; var State: DWORD;
              var Store: Boolean ) of object;
  {* Event type for OnLVData event. Used to provide virtual list view control
     (i.e. having lvoOwnerData style) with actual data on request. Use parameter
     Store as a flag if control should store obtained data by itself or not. }
  {$IFDEF ENABLE_DEPRECATED}
  {$DEFINE interface_1} {$I KOL_deprecated.inc} {$UNDEF interface_1}
  {$ENDIF DISABLE_DEPRECATED}
  TOnCompareLVItems = function( Sender: PControl; Idx1, Idx2: Integer ): Integer
                    of object;
  {* Event type to compare two items of the list view (while sorting it). }
  TOnLVColumnClick = procedure( Sender: PControl; Idx: Integer ) of object;
  {* Event type for OnColumnClick event. }
  TOnLVStateChange = procedure( Sender: PControl; IdxFrom, IdxTo: Integer; OldState, NewState: DWORD )
                   of object;
  {* Event type for OnLVStateChange event, called in responce to select/unselect
     a single item or items range in list view control). }

  TDrawActions = ( odaEntire, odaFocus, odaSelect );
  TDrawAction = Set of TDrawActions;
  TDrawStates = ( odsSelected, odsGrayed, odsDisabled, odsChecked, odsFocused,
                  odsDefault, odsHotlist, odsInactive,
                  odsNoAccel, odsNoFocusRect,
                  ods400reserved, ods800reserved,
                  odsComboboxEdit,
                  // specific for common controls:
                  odsMarked, odsIndeterminate );
  {* Possible draw states.
     |<br>odsSelected - The menu item's status is selected.
     |<br>odsGrayed - The item is to be grayed. This bit is used only in a menu.
     |<br>odsDisabled - The item is to be drawn as disabled.
     |<br>odsChecked - The menu item is to be checked. This bit is used only in
                     a menu.
     |<br>odsFocused - The item has the keyboard focus.
     |<br>odsDefault - The item is the default item.
     |<br>odsHotList - <b>Windows 98, Windows 2000:</b> The item is being
                     hot-tracked, that is, the item will be highlighted when
                     the mouse is on the item.
     |<br>odsInactive - <b>Windows 98, Windows 2000:</b> The item is inactive
                      and the window associated with the menu is inactive.
     |<br>odsNoAccel - <b>Windows 2000:</b> The control is drawn without the
                     keyboard accelerator cues.
     |<br>odsNoFocusRect - <b>Windows 2000:</b> The control is drawn without
                         focus indicator cues.
     |<br>odsComboboxEdit - The drawing takes place in the selection field
                          (edit control) of an owner-drawn combo box.
     |<br>odsMarked - for Common controls only. The item is marked. The meaning
                    of this is up to the implementation.
     |<br>odsIndeterminate - for Common Controls only. The item is in an
                           indeterminate state. }
  TDrawState = Set of TDrawStates;
  {* Set of possible draw states. }
  TOnDrawItem = function( Sender: PObj; DC: HDC; const Rect: TRect; ItemIdx: Integer;
                           DrawAction: TDrawAction; ItemState: TDrawState ): Boolean of object;
  {* Event type for OnDrawItem event (applied to list box, combo box, list view). }
  TOnMeasureItem = function( Sender: PObj; Idx: Integer ): Integer of object;
  {* Event type for OnMeasureItem event. The event handler must return height of list box
     item as a result. }
  TGetLVItemPart = ( lvipBounds, lvipIcon, lvipLabel, lvupIconAndLabel );
  {* }
  TWherePosLVItem = ( lvwpOnIcon, lvwpOnLabel, lvwpOnStateIcon, lvwpOnColumn,
                  lvwpOnItem );
  {* }

  TOnLVCustomDraw = function( Sender: PControl; DC: HDC; Stage: DWORD;
                  ItemIdx, SubItemIdx: Integer; const Rect: TRect;
                  ItemState: TDrawState; var TextColor, BackColor: TColor )
                  : DWORD of object;
  {* Event type for OnLVCustomDraw event. }

  TOnPaint = procedure( Sender: PControl; DC: HDC ) of object;
  TPaintProc = procedure( DC: HDC ) of object;

  TGradientStyle = ( gsVertical, gsHorizontal, gsRectangle, gsElliptic, gsRombic,
                     gsTopToBottom, gsBottomToTop );
  {* Gradient fill styles. See also TGradientLayout. }
  TGradientLayout = ( glTopLeft, glTop, glTopRight,
                      glLeft, glCenter, glRight,
                      glBottomLeft, glBottom, glBottomRight );
  {* Position of starting line / point for gradient filling. Depending on
     TGradientStyle, means either position of first line of first rectangle
     (ellipse) to be expanded in a loop to fit entire gradient panel area. }

  TEditOption = ( eoNoHScroll, eoNoVScroll, eoLowercase, eoMultiline,
                  eoNoHideSel, eoOemConvert, eoPassword, eoReadonly,
                  eoUpperCase, eoWantReturn, eoWantTab, eoNumber );
  {* Available edit options.
  |<br> Please note, that eoWantTab option just removes TAB key from a list
  of keys available to tabulate from the edit control. To provide insertion
  of tabulating key, do so in TControl.OnChar event handler. Sorry for
  inconvenience, but this is because such behaviour is not must in all cases.
  See also TControl.EditTabChar property.  }
  TEditOptions = Set of TEditOption;
  {* Set of available edit options. }

  TEditPositions = packed record
    SelStart: Integer;
    SelLength: Integer;
    TopLine: Integer;
    TopColumn: Integer;
    ScrollPos: TPoint;
    RestoreScroll: Boolean;
  end;

  TRichFmtArea = ( raSelection, raWord, raAll );
  {* Characters formatting area for RichEdit. }
  TRETextFormat = ( reRTF, reText, rePlainRTF, reRTFNoObjs, rePlainRTFNoObjs,
                    reTextized, reUnicode, reTextUnicode );
  {* Available formats for transfer RichEdit text using property
     TControl.RE_Text.
     |<pre>
     reRTF - normal rich text (no transformations)
     reText - plain text only (without OLE objects)
     reTextized - plain text with text representation of COM objects
     rePlainRTF - reRTF without language-specific keywords
     reRTFNoObjs - reRTF without OLE objects
     rePlainRTFNoObjs - rePlainRTF without OLE objects
     reUnicode - stream is 2-byte Unicode characters rather then 1-byte Ansi
     |</pre> }
  TRichUnderline = ( ruSingle, ruWord, ruDouble, ruDotted,
                 //all other - only for RichEditv3.0:
                 ruDash, ruDashDot, ruDashDotDot, ruWave, ruThick, ruHairLine );
  {* Rich text exteded underline styles (available only for RichEdit v2.0,
     and even for RichEdit v2.0 additional styles can not displayed - but
     ruDotted under Windows2000 is working). }
  TRichTextSizes = ( rtsNoUseCRLF, rtsNoPrecise, rtsClose, rtsBytes );
  {* Options to calculate size of rich text. Available only for RichEdit2.0
     or higher. }
  TRichTextSize = set of TRichTextSizes;
  {* Set of all available optioins to calculate rich text size using
     property TControl.RE_TextSize[ options ]. }
  TRichNumbering = ( rnNone, rnBullets, rnArabic, rnLLetter, rnULetter,
                rnLRoman, rnURoman );
  {* Advanced numbering styles for paragraph (RichEdit).
     |<pre>
     rnNone     - no numbering
     rnBullets  - bullets only
     rnArabic   - 1, 2, 3, 4, ...
     rnLLetter  - a, b, c, d, ...
     rnULetter  - A, B, C, D, ...
     rnLRoman   - i, ii, iii, iv, ...
     rnURoman   - I, II, III, IV, ...
     rnNoNumber - do not show any numbers (but numbering is taking place).
     |</pre> }
  TRichNumBrackets = ( rnbRight, rnbBoth, rnbPeriod, rnbPlain, rnbNoNumber );
  {* Brackets around number:
     |<pre>
     rnbRight   - 1) 2) 3)     - this is default !
     rnbBoth    - (1) (2) (3)
     rnbPeriod  - 1. 2. 3.
     rnbPlain   - 1 2 3
     |</pre> }
  TBorderEdge = (beLeft, beTop, beRight, beBottom);
  {* Borders of rectangle. }

  {$IFNDEF NOT_USE_RICHEDIT}
  {$IFDEF _D3orHigher}
  TCharFormat = TCharFormat2;
  {$ENDIF _D3orHigher}
  PCharFormat = ^TCharFormat;
  TParaFormat = TParaFormat2;
  {$ENDIF NOT_USE_RICHEDIT}

  TOnTestMouseOver = function( Sender: PControl ): Boolean of object;
  {* Event type for TControl.OnTestMouseOver event. The handler should
     return True, if it detects if the mouse is over control. }

  TEdgeStyle = ( esRaised, esLowered, esNone, esTransparent, esSolid );
  {* Edge styles (for panel - see NewPanel).
     esTransparent and esSolid - special styles equivalent to esNone
     except GRushControls are used via USE_GRUSH symbol (ToGRush.pas) }

  TListOption = ( loNoHideScroll, loNoExtendSel, loMultiColumn, loMultiSelect,
                  loNoIntegralHeight, loNoSel, loSort, loTabstops,
                  loNoStrings, loNoData, loOwnerDrawFixed, loOwnerDrawVariable,
                  loHScroll );
  {* Options for ListBox (see NewListbox).
     To use loHScroll, you also have to send LB_SETHORIZONTALEXTENT with a
     maximum width of a line in pixels (wParam)! }
  TListOptions = Set of TListOption;
  {* Set of available options for Listbox. }

  TComboOption = ( coReadOnly, coNoHScroll, coAlwaysVScroll, coLowerCase,
                   coNoIntegralHeight, coOemConvert, coSort, coUpperCase,
                   coOwnerDrawFixed, coOwnerDrawVariable, coSimple );
  {* Options for combobox. }
  TComboOptions = Set of TComboOption;
  {* Set of options available for combobox. }

  TProgressbarOption = ( pboVertical, pboSmooth );
  {* Options for progress bar. }
  TProgressbarOptions = set of TProgressbarOption;
  {* Set of options available for progress bar. }

  TTreeViewOption = ( tvoNoLines, tvoLinesRoot, tvoNoButtons, tvoEditLabels, tvoHideSel,
                  tvoDragDrop, tvoNoTooltips, tvoCheckBoxes, tvoTrackSelect,
                  tvoSingleExpand, tvoInfoTip, tvoFullRowSelect, tvoNoScroll,
                  tvoNonEvenHeight );
  {* Tree view options. }
  TTreeViewOptions = set of TTreeViewOption;
  {* Set of tree view options. }

  TTabControlOption = ( tcoButtons, tcoFixedWidth, tcoFocusTabs,
                        tcoIconLeft, tcoLabelLeft,
                        tcoMultiline, tcoMultiselect, tcoFitRows, tcoScrollOpposite,
                        tcoBottom, tcoVertical, tcoFlat, tcoHotTrack, tcoBorder,
                        tcoOwnerDrawFixed );
  {* Options, available for TabControl. }
  TTabControlOptions = set of TTabControlOption;
  {* Set of options, available for TAbControl during its creation (by
     NewTabControl function). }

  TToolbarOption = ( tboTextRight, tboTextBottom, tboFlat, tboTransparent,
                 tboWrapable, tboNoDivider, tbo3DBorder, tboCustomErase );
  {* Toolbar options. When tboFlat is set and toolbar is placed onto panel,
     set its property Transparent to TRUE to provide its correct view. }
  TToolbarOptions = Set of TToolbarOption;
  {* Set of toolbar options. }
  TOnToolbarButtonClick = procedure( Sender: PControl; BtnID: Integer ) of object;
  {* Special event type to handle separate toolbar buttons click events. }
  TOnTBCustomDraw = function( Sender: PControl; var NMCD: TNMTBCustomDraw ): Integer of object;
  {* Event type for OnTBCustomDraw event. }

  TDateTimePickerOption = ( dtpoTime, dtpoDateLong, dtpoUpDown, dtpoRightAlign,
    dtpoShowNone, dtpoParseInput );
  {* }
  TDateTimePickerOptions = set of TDateTimePickerOption;
  {* }
  TDTParseInputEvent = procedure(Sender: PControl; const UserString: KOLString;
    var DateAndTime: TDateTime; var AllowChange: Boolean) of object;
  {* }
  TDateTimeRange = packed record
    FromDate, ToDate: TDateTime;
  end;
  {* }
  TDateTimePickerColor = ( dtpcBackground, dtpcText, dtpcTitleBk,
    dtpcTitleText, dtpcMonthBk, dtpcTrailingText );
  {MCSC_BACKGROUND       = 0;   // the background color (between months)
  MCSC_TEXT             = 1;   // the dates
  MCSC_TITLEBK          = 2;   // background of the title
  MCSC_TITLETEXT        = 3;
  MCSC_MONTHBK          = 4;   // background within the month cal
  MCSC_TRAILINGTEXT     = 5;   // the text color of header & trailing days}

  TOnDropFiles = procedure( Sender: PControl; const FileList: KOL_String; const Pt: TPoint ) of object;
  {* An event type for OnDropFiles event. When the event is occur, FileList
     parameter contains a list of files dropped. File names in a list are
     separated with #13 character. This allows You to assign it to TStrList
     object using its property Text (for example):
     ! procedure TSomeObject.DropFiles( Sender: PControl; const FileList: AnsiString;
     !           const Pt: TPoint ); )
     ! var FList: PStrList;
     !     I: Integer;
     ! begin
     !   FList := NewStrList;
     !   FList.Text := FileList;
     !   for I := 0 to FList.Count-1 do
     !   begin
     !     // do something with FList.Items[ I ]
     !   end;
     !   FList.Free;
     ! end; }

  TScrollerBar = ( sbHorizontal, sbVertical );
  TScrollerBars = set of TScrollerBar;

  TOnScroll = procedure( Sender: PControl; Bar: TScrollerBar; ScrollCmd: DWORD;
            ThumbPos: DWORD ) of object;

  TOnHelp = procedure( var Sender: PControl; var Context: Integer; var Popup: Boolean )
            of object;

  TOnSBBeforeScroll =
    procedure(
      Sender: PControl; OldPos, NewPos: Integer; Cmd: Word;
      var AllowChange: Boolean) of object;
  TOnSBScroll = procedure(Sender: PControl; Cmd: Word) of object;

{$IFDEF WIN_GDI}
  TOnGraphCtlMouse = procedure( var Msg: TMsg ) of object;
{$ENDIF WIN_GDI}
  TTriStateCheck = (tsUnchecked{=0}, tsChecked{=1}, tsIndeterminate{=2});

{$IFDEF _X_}
  //---- in GTK+, each type of widget requieres its own getcaption/setcaption call
  TGetCaption = FUNCTION( Ctl: PControl ): KOLString;
  TSetCaption = PROCEDURE( Ctl: PControl; CONST Value: KOLString );

  {$IFDEF GTK}
  //---- in GTK+, to allow setting absolute position for children,
  // we should use one of special clients like gtk_fixed, gtk_layout
  TGetClientArea = FUNCTION( Ctl: PControl ): PGtkWidget;
  TChildSetPos = PROCEDURE( Ctl, Chld: PControl; x, y: Integer );
  {$ENDIF GTK}
{$ENDIF _X_}

  TFormInitFunc = function(Form: PControl): PControl;
  TFormInitFunc1 = function(Form: PControl; intParam: Integer): PControl;
  TFormInitFuncArray = array[0..65535] of TFormInitFunc;
  TFormInitFuncArray1 = array[0..65535] of TFormInitFunc1;
  PFormInitFuncArray = ^TFormInitFuncArray;
  PFormInitFuncArray1 = ^TFormInitFuncArray1;

  TSmallIntArray = array[0..65535] of SmallInt;
  PSmallIntArray = ^TSmallIntArray;

  PPControl = ^PControl;

  {$IFDEF USE_MHTOOLTIP}
  {$DEFINE pre_interface}
  PMHHint = ^TMHHint;
  TKOLMHHint = PMHHint;
  {$UNDEF pre_interface}
  {$ENDIF}

  TOnWndFunc = function( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
  TProcSender = procedure( Sender: PObj );
  TOnGotoControl = function( Self_: PControl; Key: DWORD; CheckOnly: Boolean ): Boolean;

  PEvents = ^TEvents;
  TEvents = record
  CASE Integer OF
  1:(
    //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    //................... most common events ...................................
    fOnMessage: TOnMessage;
    fOldOnMessage: TOnMessage; // for applet only but...
    fOnClick: TOnEvent;
    fOnMouseDown: TOnMouse; // CAUTION!!! Order of mouse event handlers is important. ____
    fOnMouseUp: TOnMouse;                                                               //
    fOnMouseMove: TOnMouse;                                                             //
    fOnMouseDblClk: TOnMouse;                                                           //
    fOnMouseWheel: TOnMouse;     //_____________________________________________________//

    fOnMouseEnter: TOnEvent;
    fOnMouseLeave: TOnEvent;
    fOnTestMouseOver: TOnTestMouseOver; // mainly for bitbtn but...
    fGraphCtlMouseEvent: TOnGraphCtlMouse;
    fMouseLeaveProc: TOnEvent;
    fOnScroll: TOnScroll;

    fOnChar: TOnChar;
    fOnDeadChar: TOnChar;
    fOnKeyUp: TOnKey;
    fOnKeyDown: TOnKey;

    fOnChangeCtl: TOnEvent;
    fOnEnter: TOnEvent;
    fOnLeave: TOnEvent;
    fLeave: TOnEvent;

    fOnPaint: TOnPaint;
    fOnPaint2: TOnPaint;
    fOnPrepaint: TOnPaint;
    fOnPostPaint: TOnPaint;
    fPaintProc: TPaintProc;
    fOnEraseBkgnd: TOnPaint;
    fOnDrawItem: TOnDrawItem;
    fOnMeasureItem: TOnMeasureItem;

    fDragCallback: TOnDrag;

    fOnSelChange: TOnEvent;
    fOnResize: TOnEvent;

    fOnHide: TOnEvent;
    fOnShow: TOnEvent;

    fOnClose: TOnEventAccept; // mainly for form but...

    fOnMove: TOnEvent;
    fOnMoving: TOnEventMoving;
    fOnHelp: TOnHelp;
    //................... other events .........................................
    fOnQueryEndSession: TOnEventAccept;

    //----- order of following 3 events important: // for form only ?
    fOnMinimize: TOnEvent;                         //
    fOnMaximize: TOnEvent;                         //
    fOnRestore: TOnEvent;                          //
    //---------------------------------------------//

    fOnLVCustomDraw: TOnLVCustomDraw;
    fOnEndEditLVItem: TOnEditLVItem;
    fOnLVData: TOnLVData;
    fOnCompareLVItems: TOnCompareLVItems;
    FOnLVStateChange: TOnLVStateChange;
    fOnDeleteLVItem: TOnDeleteLVItem;
    fOnColumnClick: TOnLVColumnClick;

    FOnSBBeforeScroll: TOnSBBeforeScroll;
    FOnSBScroll: TOnSBScroll;

    FOnDropDown: TOnEvent;
    FOnCloseUp: TOnEvent;

    FOnSplit: TOnSplit;

    FOnProgress: TOnEvent;

    FOnBitBtnDraw: TOnBitBtnDraw;

    FOnTVBeginDrag: TOnTVBeginDrag;
    FOnTVBeginEdit: TOnTVBeginEdit;
    FOnTVEndEdit: TOnTVEndEdit;
    FOnTVExpanding: TOnTVExpanding;
    FOnTVExpanded: TOnTVExpanded;
    FOnTVSelChanging: TOnTVSelChanging;

    FOnTVDelete: TOnTVDelete;

    FOnDTPUserString: TDTParseInputEvent;

    FOnREInsModeChg: TOnEvent;
    FOnREOverURL: TOnEvent;
    FOnREURLClick: TOnEvent;
    fOnDropFiles: TOnDropFiles;
    );
  2: ( MethodEvents: array[ 0..idx_LastEvent ] of TMethod;
     );
  end;

  TProcedures = record
  CASE Integer OF
  1: (
    //..........................................................................
    fWndFunc: Pointer;
    fDoInvalidate: TProcSender;
    fOnDynHandlers: TWindowFunc;
    fPass2DefProc: TOnWndFunc;
    fWndProcKeybd: TOnWndFunc;
    fControlClick: TProcSender;                                                     //
    fAutoSize: TProcSender;
    //{-2.95}//fWndProcResizeFlicks: TOnWndFunc;
    fGotoControl: TOnGotoControl;
    {* Initially pointer to WndFunc. For MDI child window, points to DefMDIChildProc. }
    fNotifyChild: procedure( Self_, Child: PControl );
    fScrollChildren: procedure( Self_: PControl );
    fCreateWndExt: procedure( Sender: PControl );
    fExMsgProc: function( Applet: PControl; var Msg: TMsg ): Boolean;
    {* Additional message handler called directly from Applet.ProcessMessage.
       Used to call TranslateMDISysAccel API function for MDI application. }
    );
  2: ( Procedures: array[ 0..idx_LastProc-idx_LastEvent-1 ] of Pointer;
     );
  end;

  // data fields of TControl which are certain for different kinds of control
  // -- so these can be alternated using variant record type to economy run time
  // size of TControl object instance
  TDataFields = packed record
  fCurrentControl: PControl; //---- sometimes it is used for a parent control,
                             // not only for parent form, so should be common.
  {$IFDEF UNION_FIELDS}
  CASE Integer OF
  1:( // Toolbar control fields
  {$ENDIF}
    fOnTBCustomDraw: TOnTBCustomDraw;
    fTBevents: PList; // events for TBAssignEvents
    fTBBtnImgWidth: Integer; // custom toolbar bitmap width
    fTBBtMinWidth: Integer;
    fTBBtMaxWidth: Integer;
    fTBttCmd: PList;
    fTBttTxt: {$IFDEF UNICODE_CTRLS} PWStrList {$ELSE} PStrList {$ENDIF};
    fTBCurItem: Integer;
    fDefaultTBBtnStyle: Byte; // for Toolbars
    fTBDropped: Boolean;
  {$IFDEF UNION_FIELDS}
    );
  2:( // Combobox + Group box
  {$ENDIF}
    fDroppedWidth: Integer; // SmallInt;
    fDropDownCount: Cardinal;
    fCurIdxAtDrop: Integer;
    fErasingBkgnd: Boolean; // for Group box
  {$IFDEF UNION_FIELDS}
    );
  3:( // Form + Applet
  {$ENDIF}
    fModalResult: Integer;
    fModalForm: PControl;
    //fCurrentControl: PControl;
    //FMinimizeWnd: PControl;
    fIcon: HIcon;

    {$IFDEF USE_GRAPHCTLS}
    {$IFDEF GRAPHCTL_HOTTRACK}
    fHotCtl: PControl;
    {$ENDIF}
    {$ENDIF}
    //fDefaultBtnCtl: PControl;
    //fCancelBtnCtl: PControl;
    fWindowState: TWindowState;
    fActivating: Boolean;
    fCloseQueryReason: TCloseQueryReason;
    fFixingModal: ShortInt;
    fShowAction: Byte;
    fKeyPreviewCount: Byte;
    fModal: Byte;
    fAllBtnReturnClick: Boolean;
    //-- âíèìàíèå! ïîðÿäîê ñëåäóþùèõ 3õ ïîëåé íå äîëæåí ìåíÿòüñÿ!!!
    FormCurrentParent: PControl;
    {* êîíòðîë, èñïîëüçóþùèéñÿ â êà÷åñòâå ðîäèòåëüñêîãî, â ôóíêöèÿõ ñîçäàíèÿ }
    FormParams: PAnsiChar;
    {* ñòðîêà êîìàíä è ïàðàìåòðîâ }
    FormAddress: PPControl;
    {* àäðåñ ïîëÿ Form â îáúåêòå ôîðìû MCK - íóæåí äëÿ âû÷èñëåíèÿ àäðåñîâ
       êîíòðîëîâ ïî ñìåùåíèþ, äëÿ ôóíêöèè FormSetCurCtl }
    FormObj: PObj;
    FormAlphabet: PFormInitFuncArray;
    {* àëôàâèò ïðîöåäóð }
    FormLastCreatedChild: PControl;
    {* êîíòðîë, ñîçäàííûé ïîñëåäíèì }
  {$IFDEF UNION_FIELDS}
    );
  4:( // ListView
  {$ENDIF}
    fColumn: Integer; // for listview only (column to sort)
    fOnDeleteAllLVItems: TOnEvent;
    fCtlImageListSml: PImageList;
    {* ImageList object (with small icons 16x16) to use with a control (e.g.,
       with ListView control).
       If not set, but control has a list of image list objects, last added
       image list with small icons is used automatically. }
    fCtlImageListNormal: PImageList;
    {* ImageList object (with big icons 32x32) to use with a control.
       If not set, last added image list with big icons is used. }
    fCtlImgListState: PImageList;
    {* ImageList object to use as a state image list (for ListView control). }
    fLVColCount: Integer;
    fLVTextBkColor: TColor;
    fLVItemHeight: Integer;
    fLVOptions: TListViewOptions;
    fLVStyle: TListViewStyle;
  {$IFDEF UNION_FIELDS}
    );
  5:( // Rich Edit -- 11 dwords
  {$ENDIF}
      {$IFNDEF NOT_USE_RICHEDIT}
        {$IFDEF STATIC_RICHEDIT_DATA}
        fRECharFormatRec: TCharFormat;
        fREParaFmtRec: TParaFormat2;
        {$ELSE}
        fRECharFormatRec: PCharFormat;
        fREParaFmtRec: PParaFormat2;
        {$ENDIF}
        fCharFmtDeltaSz: Integer;
        fParaFmtDeltaSz: Integer;
        fREError: Integer;
        fREStream: PStream;
        fREStrLoadLen: DWORD;
        fREUrl: PKOLChar;
        fTmpFont: PGraphicTool; // for RichEdit
        fREUpdCount: SmallInt;
        fReOvrDisable: Boolean;
        fREOvr: Boolean;
        fREScrolling: Boolean;
        fRECharArea: TRichFmtArea;
        FSupressTab: Boolean;
        fRETransparent: Boolean;
      {$ENDIF NOT_USE_RICHEDIT}
  {$IFDEF UNION_FIELDS}
    );
  6:( // Label Effect + Graphic edit control
  {$ENDIF}
    fShadowDeep: Integer;
    fEditCtl: PControl;
    fEditOptions: TEditOptions;
  {$IFDEF UNION_FIELDS}
    );
  7:( // BitBtn
  {$ENDIF}
    fGlyphBitmap : HBitmap;
    fGlyphCount : Integer;
    fGlyphWidth, fGlyphHeight: Integer;
    fRepeatInterval: Integer;
    fTextShiftX, fTextShiftY: Integer;
    fBitBtnDrawMnemonic: Boolean;
    fBitBtnOptions : TBitBtnOptions;
    fGlyphLayout : TGlyphLayout;
    fButtonIcon: HIcon; // for Graphic button control though...
    FBitBtnGetCaption: function( Self_: PControl; const S: KOLString ): KOLString;
    FBitBtnExtDraw: procedure( Self_: PControl; DC: HDC; X, Y: Integer; const R: TRect;
                    const CapText, CapTxtOrig: KOLString; Color: TColor );
  {$IFDEF UNION_FIELDS}
    );
  8:( // Splitter
  {$ENDIF}
    fSplitStartPos: TPoint;
    fSplitStartPos2: TPoint;
    fSplitStartSize: Integer;
    fSplitMinSize1, fSplitMinSize2: Integer;
    fSecondControl: PControl;
    fSplitLastPos: TPoint;
  {$IFDEF UNION_FIELDS}
    );
  9:( // Gradient panel
  {$ENDIF}
    fColor1: TColor;
    fColor2: TColor;
    fGradientStyle: TGradientStyle;
    fGradientLayout: TGradientLayout;
  {$IFDEF  UNION_FIELDS}
    );
  10:( // Tree view only
  {$ENDIF}
    fTVRightClickSelect: Boolean;
  {$IFDEF UNION_FIELDS}
     );
  11:( // Scroll Bar
  {$ENDIF}
    FScrollLineDist: array[ 0..1 ] of Integer;
    fSBMinMax: TPoint;
    fSBPageSize: Integer;
    fSBPosition: Integer;
  {$IFDEF UNION_FIELDS}
     );
  100:( // for custom controls
  {$ENDIF}
    //fCustom6: Integer;
    //fCustEvent2: TOnEvent;
    fCustom5: Integer;
    fCustom4: Integer;
    fCustEvent1: TOnEvent;
    fCustom3: Integer;
    fCustom2: Integer;
    fCustEvent0: TOnEvent;
    fCustom1: Integer;
    fCustom0: Integer;
    fCustFlag7: Boolean;
    fCustFlag6: Boolean;
    fCustFlag5: Boolean;
    fCustFlag4: Boolean;
    fCustFlag3: Byte;
    fCustFlag2: Byte;
    fCustFlag1: Byte;
    fCustFlag0: Byte;
  {$IFDEF UNION_FIELDS}
      );
  {$ENDIF}
  end;

{ ----------------------------------------------------------------------
             TControl - object to implement any visual control
----------------------------------------------------------------------- }
//[TControl DEFINITION]
  TControl = object( TObj )
  {*! TControl is the basic visual object of KOL. And now, all visual
     objects have the same type PControl, differing only in "constructor",
     which during creating of object adjusts it so it can play role of
     desired control. Idea of incapsulating of all visual objects having
     the most common set of properties, is belonging to Vladimir Kladov,
     (C) 2000.
     |<br>&nbsp;&nbsp;&nbsp;<b> Since all visual objects are represented
     in KOL by this single object type, not all methods, properties and
     events defined in TControl, are applicable to different visual objects.
     See also notes about certain control kinds, located together with its
     |<a href="kol_pas.htm#visual_objects_constructors">
     |constructing functions definitions</a></b>. }
  public
    procedure SetAnchor(const Index: Integer; const Value: Boolean);
  protected
    function GetAnchor(const Index: Integer): Boolean;
    function Get_StatusWnd: HWND;
    function Get_Prop_Int(PropName: PKOLChar): Integer;
    procedure Set_Prop_Int(PropName: PKOLChar; const Value: Integer);
    function GetHelpContext: Integer;
    function Get_Ctl3D: Boolean;
    function Get_OnMouseEvent(const Index: Integer): TOnMouse;
  public
    procedure SetOnMouseEvent(const Index: Integer; const Value: TOnMouse);
  protected
    {$IFDEF EVENTS_DYNAMIC}
    function Get_TOnEvent(const Index: Integer): TOnEvent;
    function Get_OnMessage: TOnMessage;
    function Get_OnHelp: TOnHelp;
    function Get_OnBitBtnDraw: TOnBitBtnDraw;
    function Get_OnMeasureItem: TOnMeasureItem;
    function Get_OnShow: TOnEvent;
    function Get_OnHide: TOnEvent;
    function Get_OnClose: TOnEventAccept;
    function Get_OnQueryEndSession: TOnEventAccept;
    function Get_OnPaint: TOnPaint;
    function Get_OnPrePaint: TOnPaint;
    function Get_OnPostPaint: TOnPaint;
    function Get_OnEraseBkgnd: TOnPaint;
    function Get_OnClick: TOnEvent;
    function Get_OnResize: TOnEvent;
    function Get_OnMove: TOnEvent;
    function Get_OnMoving: TOnEventMoving;
    function Get_OnSplit: TOnSplit;
    function Get_OnKeyDown: TOnKey;
    function Get_OnKeyUp: TOnKey;
    function Get_OnChar: TOnChar;
    function Get_OnDeadChar: TOnChar;
    function Get_OnMouseUp: TOnMouse;
    function Get_OnMouseDown: TOnMouse;
    function Get_OnMouseMove: TOnMouse;
    function Get_OnMouseDblClk: TOnMouse;
    function Get_OnMouseWheel: TOnMouse;
    function Get_OnMouseEnter: TOnEvent;
    function Get_OnMouseLeave: TOnEvent;
    function Get_OnTestMouseOver: TOnTestMouseOver;
    function Get_OnEndEditLVItem: TOnEditLVItem;
    function Get_OnDeleteLVItem: TOnDeleteLVItem;
    function Get_OnLVData: TOnLVData;
    function Get_OnCompareLVItems: TOnCompareLVItems;
    function Get_OnColumnClick: TOnLVColumnClick;
    function Get_OnLVStateChange: TOnLVStateChange;
    function Get_OnDrawItem: TOnDrawItem;
    function Get_OnLVCustomDraw: TOnLVCustomDraw;
    function Get_OnTVBeginDrag: TOnTVBeginDrag;
    function Get_OnTVBeginEdit: TOnTVBeginEdit;
    function Get_OnTVEndEdit: TOnTVEndEdit;
    function Get_OnTVExpanding: TOnTVExpanding;
    function Get_OnTVExpanded: TOnTVExpanded;
    function Get_OnTVDelete: TOnTVDelete;
    function Get_OnTVSelChanging: TOnTVSelChanging;
    function Get_OnDTPUserString: TDTParseInputEvent;
    function Get_OnSBBeforeScroll: TOnSBBeforeScroll;
    function Get_OnSBScroll: TOnSBScroll;
    function Get_OnScroll: TOnScroll;
    function Get_OnDropFiles: TOnDropFiles;
  public
    procedure Set_TOnEvent(const Index: Integer; const Value: TOnEvent);
    procedure Set_OnMessage(const Value: TOnMessage);
    procedure Set_OnHelp(const Value: TOnHelp);
    procedure Set_OnBitBtnDraw(const Value: TOnBitBtnDraw);
    procedure Set_OnPrePaint(const Value: TOnPaint);
    procedure Set_OnPostPaint(const Value: TOnPaint);
    procedure Set_OnEraseBkgnd(const Value: TOnPaint);
    procedure Set_OnSplit(const Value: TOnSplit);
    procedure Set_OnCompareLVItems(const Value: TOnCompareLVItems);
    procedure Set_OnTVBeginDrag(const Value: TOnTVBeginDrag);
    procedure Set_OnTVBeginEdit(const Value: TOnTVBeginEdit);
    procedure Set_OnTVEndEdit(const Value: TOnTVEndEdit);
    procedure Set_OnTVExpanding(const Value: TOnTVExpanding);
    procedure Set_OnTVExpanded(const Value: TOnTVExpanded);
    procedure Set_OnTVSelChanging(const Value: TOnTVSelChanging);
    procedure Set_OnDTPUserString(const Value: TDTParseInputEvent);
    procedure Set_OnSBBeforeScroll(const Value: TOnSBBeforeScroll);
    procedure Set_OnSBScroll(const Value: TOnSBScroll);
    {$ENDIF EVENTS_DYNAMIC}
  protected
    procedure SetTBAutoSizeButtons(const Value: Boolean);
    function GetTBAutoSizeButtons: Boolean;
    function GetTVEditing: Boolean;
    function GetDroppedDown: Boolean;
    {$IFDEF USE_FLAGS}
    function Get_Dragging: Boolean;
    function GetTabStop: Boolean;
    procedure SetTabStop(const Value: Boolean);
    function GetWordWrap: Boolean;
    procedure SetWordWrap(const Value: Boolean);
    function GetCannotDoubleBuf: Boolean;
    procedure SetCannotDoubleBuf(const Value: Boolean);
    function GetDoubleBuffered: Boolean;
    function GetTransparent: Boolean;
    function GetIsForm: Boolean;
    function GetSizeGrip: Boolean;
    procedure SetSizeGrip(const Value: Boolean);
    function GetIsApplet: Boolean;
    function GetIsControl: Boolean;
    function GetIsMDIChild: Boolean;
    function GetCreateVisible: Boolean;
    procedure SetCreateVisible(const Value: Boolean);
    function GetIsButton: Boolean;
    function GetFlat: Boolean;
    function GetMouseInCtl: Boolean;
    function GetEraseBackground: Boolean;
    procedure SetEraseBackground(const Value: Boolean);
    function Get3ButtonPress: Boolean;
    function GetKeyPreview: Boolean;
    procedure SetKeyPreview(const Value: Boolean);
    function GetIgnoreDefault: Boolean;
    procedure SetIgnoreDefault(const Value: Boolean);
    function GetWindowed: Boolean;
    procedure SetWindowed(const Value: Boolean);
    function Get_RightClick: Boolean;
    function Get_SizeRedraw: Boolean;
    procedure Set_SizeRedraw(const Value: Boolean);
    {$ENDIF USE_FLAGS}
  public //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    FormString: KOLString;
    {* ñòðîêà òåêóùåãî ïàðàìåòðà. Î÷èùàåòñÿ ïîñëå êàæäîãî âûçîâà
       FormExecuteCommands, òàê ÷òî ñïåöèàëüíàÿ î÷èñòêà íå òðåáóåòñÿ. }
    function FormGetIntParam: Integer;
    {* èçâëåêàåò î÷åðåäíîé öåëî÷èñëåííûé ïàðàìåòð äî ',' èëè äî ';' }
    function FormGetColorParam: Integer;
    {* èçâëåêàåò î÷åðåäíîé öåëî÷èñëåííûé ïàðàìåòð äî ',' èëè äî ';' }
    procedure FormGetStrParam;
    {* èçâëåêàåò î÷åðåäíîé ñòðîêîâûé ïàðàìåòð äî ',' èëè äî ';' -> FormString }
    procedure FormCreateParameters( alphabet: PFormInitFuncArray; params: PAnsiChar );
    {* çàäàåò ïåðâîíà÷àëüíûé àëôàâèò è ïàðàìåòðû ñ êîìàíäàìè }
    procedure FormExecuteCommands(AForm: PControl; ControlPtrOffsets: PSmallIntArray);
    {* âûïîëíÿåò êîìàíäû (ñ ïàðàìåòðàìè) äî êîíöà èëè äî ';' }
  {$IFDEF GDI}
  protected
    function GetDate: TDateTime;
    function GetTime: TDateTime;
    procedure SetDate(const Value: TDateTime);
    procedure SetTime(const Value: TDateTime);
  {$ENDIF GDI}
  protected
  {$IFDEF GDI}
    function GetHelpPath: KOLString;
    procedure SetHelpPath(const Value: KOLString);
  public
    procedure SetOnQueryEndSession(const Value: TOnEventAccept);
    procedure SetOnMinMaxRestore(const Index: Integer; const Value: TOnEvent);
    procedure SetOnMinimize( const Value: TOnEvent );
    procedure SetOnMaximize( const Value: TOnEvent );
    procedure SetOnRestore( const Value: TOnEvent );
    procedure SetOnScroll(const Value: TOnScroll);
  protected
    procedure SetConstraint(const Index: Integer; Value: SmallInt);
    function GetOnMinMaxRestore(const Index: Integer): TOnEvent;
    function GetConstraint(const Index: Integer): SmallInt;
    function GetLVColalign(Idx: Integer): TTextAlign;
    procedure SetLVColalign(Idx: Integer; const Value: TTextAlign);

    {$ENDIF GDI}
    procedure SetParent( Value: PControl );
    function GetLeft: Integer;
    procedure SetLeft( Value: Integer );
    function GetTop: Integer;
    procedure SetTop( Value: Integer );
    function GetWidth: Integer;
    procedure SetWidth( Value: Integer );
    function GetHeight: Integer;
    procedure SetHeight( Value: Integer );
    function GetPosition: TPoint;
    procedure Set_Position( Value: TPoint );
    function GetMembers(Idx: Integer): PControl;
    function GetFont: PGraphicTool;
    procedure FontChanged( Sender: PGraphicTool );
    {$IFDEF GDI}
    function GetBrush: PGraphicTool;
    procedure BrushChanged( Sender: PGraphicTool );
    function GetClientHeight: Integer;
    function GetClientWidth: Integer;
    procedure SetClientHeight(const Value: Integer);
    procedure SetClientWidth(const Value: Integer);
    function GetHasBorder: Boolean;
  public procedure SetHasBorder(const Value: Boolean);
  protected

    function GetHasCaption: Boolean;
    procedure SetHasCaption(const Value: Boolean);

    function GetCanResize: Boolean;
    procedure SetCanResize( const Value: Boolean );

    function GetStayOnTop: Boolean;
  public  procedure SetStayOnTop(const Value: Boolean);
  protected
    function GetChecked: Boolean;
    procedure Set_Checked(const Value: Boolean);

    function GetCheck3: TTriStateCheck;
    procedure SetCheck3(value: TTriStateCheck);

    function GetSelStart: Integer;
    procedure SetSelStart(const Value: Integer);
    function GetSelLength: Integer;
    procedure SetSelLength(const Value: Integer);

    function GetItems(Idx: Integer): KOLString;
    procedure SetItems(Idx: Integer; const Value: KOLString);

    function GetItemsCount: Integer;
    function GetItemSelected(ItemIdx: Integer): Boolean;
    procedure SetItemSelected(ItemIdx: Integer; const Value: Boolean);

  public procedure SetCtl3D(const Value: Boolean);
  protected
    function GetCurIndex: Integer;
    procedure SetCurIndex(const Value: Integer);

    {$ENDIF GDI}
    function GetTextAlign: TTextAlign;
  public procedure SetTextAlign(const Value: TTextAlign);
  protected
    function GetVerticalAlign: TVerticalAlign;
  public procedure SetVerticalAlign(const Value: TVerticalAlign);
  protected
    function GetCanvas: PCanvas;
    {$IFDEF _X_}
    {$IFDEF GTK}
  protected
    {} fInBkPaint: Boolean;
    {} fSetTextAlign: PROCEDURE( Self_: PControl );
    FUNCTION ProvideCanvasHandle( Sender: PCanvas ): HDC;
    {$ENDIF GTK}
    {$ENDIF _X_}
    {$IFDEF GDI}
    function Dc2Canvas( Sender: PCanvas ): HDC;
    procedure SetShadowDeep(const Value: Integer);
  public procedure SetDoubleBuffered(const Value: Boolean);
  protected

    procedure SetStatusText(Index: Integer; const Value: KOLString);
    function GetStatusText( Index: Integer ): KOLString;
    function GetStatusPanelX(Idx: Integer): Integer;
    procedure SetStatusPanelX(Idx: Integer; const Value: Integer);

  public procedure SetTransparent(const Value: Boolean);
  protected
    function GetImgListIdx(const Index: Integer): PImageList;

    procedure SetImgListIdx(const Index: Integer; const Value: PImageList);
    function GetLVColText(Idx: Integer): KOLString;
    procedure SetLVColText(Idx: Integer; const Value: KOLString);
    {$IFDEF ENABLE_DEPRECATED}
    {$DEFINE interface_2}
    {$I KOL_deprecated.inc}
    {$UNDEF interface_2}
    {$ENDIF DISABLE_DEPRECATED}
  protected
    function LVGetItemText(Idx, Col: Integer): KOLString;
    procedure LVSetItemText(Idx, Col: Integer; const Value: KOLString);
    procedure SetLVOptions(const Value: TListViewOptions);
    procedure SetLVStyle(const Value: TListViewStyle);
    function GetLVColEx(Idx: Integer; const Index: Integer): Integer;
    procedure SetLVColEx(Idx: Integer; const Index: Integer;
      const Value: Integer);
    {$ENDIF GDI}
    function GetChildCount: Integer;
    {$IFDEF GDI}
    function LVGetItemPos(Idx: Integer): TPoint;
    procedure LVSetItemPos(Idx: Integer; const Value: TPoint);
    procedure LVSetColorByIdx(const Index: Integer; const Value: TColor);
    {$IFDEF F_P}
    function LVGetColorByIdx(const Index: Integer): TColor;
    {$ENDIF F_P}
    function GetIntVal(const Index: Integer): Integer;
    procedure SetIntVal(const Index, Value: Integer);
    function GetItemVal(Item: Integer; const Index: Integer): Integer;
    procedure SetItemVal(Item: Integer; const Index, Value: Integer);
    function TBGetButtonVisible(BtnID: Integer): Boolean;
    procedure TBSetButtonVisible(BtnID: Integer; const Value: Boolean);

    function TBGetBtnStt(BtnID: Integer; const Index: Integer): Boolean;
    procedure TBSetBtnStt(BtnID: Integer; const Index: Integer; const Value: Boolean);
    function TBGetButtonText(BtnID: Integer): KOLString;
    function TBGetButtonRect(BtnID: Integer): TRect;

    function TBGetRows: Integer;
    procedure TBSetRows(const Value: Integer);
    procedure SetProgressColor(const Value: TColor);
    function TBGetBtnImgIdx(BtnID: Integer): Integer;
    procedure TBSetBtnImgIdx(BtnID: Integer; const Value: Integer);

    procedure TBSetButtonText(BtnID: Integer; const Value: KOLString);

    function TBGetBtnWidth(BtnID: Integer): Integer;
    procedure TBSetBtnWidth(BtnID: Integer; const Value: Integer);
    procedure TBSetBtMinMaxWidth(const Idx: Integer; const Value: Integer);
    {$IFDEF F_P}
    function TBGetBtMinMaxWidth(const Idx: Integer): Integer;
    {$ENDIF F_P}
    procedure TBFreeTBevents;
    function TBGetButtonLParam(const Idx: Integer): DWORD;
    procedure TBSetButtonLParam(const Idx: Integer; const Value: DWORD);
  public
    procedure Set_Align(const Value: TControlAlign);
  protected
    function GetSelection: KOLString;
    procedure SetSelection(const Value: KOLString);
    procedure SetTabOrder(const Value: SmallInt);
    function GetFocused: Boolean;
    procedure SetFocused(const Value: Boolean);
    {$IFNDEF NOT_USE_RICHEDIT}
    function REGetFont: PGraphicTool;
    procedure RESetFont(Value: PGraphicTool);
    procedure RESetFontEx(const Index: Integer);
    function REGetFontEffects(const Index: Integer): Boolean;
    function REGetFontMask(const Index: Integer): Boolean;
    procedure RESetFontEffect(const Index: Integer; const Value: Boolean);
    function REGetFontAttr(const Index: Integer): Integer;
    procedure RESetFontAttr(const Index, Value: Integer);
    procedure RESetFontAttr1(const Index, Value: Integer);
    function REGetFontSizeValid: Boolean;
    function REGetCharformat: TCharFormat;
    procedure RESetCharFormat(const Value: TCharFormat);
    function REReadText(Format: TRETextFormat; SelectionOnly: Boolean): KOLString;
    procedure REWriteText(Format: TRETextFormat; SelectionOnly: Boolean;
      const Value: KOLString);
    function REGetFontName: KOLString;
    procedure RESetFontName(const Value: KOLString);
    function REGetParaFmt: TParaFormat;
    procedure RESetParaFmt(const Value: TParaFormat);
    function REGetNumbering: Boolean;
    function REGetParaAttr( const Index: Integer ): Integer;
    function REGetParaAttrValid( const Index: Integer ): Boolean;
    function REGetTabCount: Integer;
    function REGetTabs(Idx: Integer): Integer;
    function REGetTextAlign: TRichTextAlign;
    procedure RESetNumbering(const Value: Boolean);
    procedure RESetParaAttr(const Index, Value: Integer);
    procedure RESetTabCount(const Value: Integer);
    procedure RESetTabs(Idx: Integer; const Value: Integer);
    procedure RESetTextAlign(const Value: TRichTextAlign);
    function REGetStartIndentValid: Boolean;
    function REGetAutoURLDetect: Boolean;
  public procedure RESetAutoURLDetect(const Value: Boolean);
  protected
    procedure RESetZoom( const Value: TSmallPoint );
    function REGetZoom: TSmallPoint;

    function GetMaxTextSize: DWORD;
    procedure SetMaxTextSize(const Value: DWORD);
    function REGetUnderlineEx: TRichUnderline;
    procedure RESetUnderlineEx(const Value: TRichUnderline);

    function GetTextSize: Integer;
    function REGetTextSize(Units: TRichTextSize): Integer;

    function REGetNumStyle: TRichNumbering;
    procedure RESetNumStyle(const Value: TRichNumbering);
    function REGetNumBrackets: TRichNumBrackets;
    procedure RESetNumBrackets(const Value: TRichNumBrackets);
    function REGetNumTab: Integer;
    procedure RESetNumTab(const Value: Integer);
    function REGetNumStart: Integer;
    procedure RESetNumStart(const Value: Integer);
    function REGetSpacing(const Index: Integer): Integer;
    procedure RESetSpacing(const Index, Value: Integer);
    function REGetSpacingRule: Integer;
    procedure RESetSpacingRule(const Value: Integer);
    function REGetLevel: Integer;
    function REGetBorder(Side: TBorderEdge; const Index: Integer): Integer;
    procedure RESetBorder(Side: TBorderEdge; const Index: Integer;
      const Value: Integer);
    function REGetParaEffect(const Index: Integer): Boolean;
    procedure RESetParaEffect(const Index: Integer; const Value: Boolean);
    function REGetOverwite: Boolean;
    procedure RESetOverwrite(const Value: Boolean);
    procedure RESetOvrDisable(const Value: Boolean);
    function REGetTransparent: Boolean;
  public procedure RESetTransparent(const Value: Boolean);
  protected
    procedure RESetOnURL(const Index: Integer; const Value: TOnEvent);
    procedure SetOnRE_URLClick( const Value: TOnEvent );
    procedure SetOnRE_OverURL( const Value: TOnEvent );
    function REGetOnURL(const Index: Integer): TOnEvent;
    function REGetLangOptions(const Index: Integer): Boolean;
    procedure RESetLangOptions(const Index: Integer; const Value: Boolean);
    {$ENDIF NOT_USE_RICHEDIT}
  public
    procedure SetOnResize(const Value: TOnEvent);
  protected
    procedure DoSelChange;
    function LVGetItemImgIdx(Idx: Integer): Integer;
    procedure LVSetItemImgIdx(Idx: Integer; const Value: Integer);
  public procedure SetFlat(const Value: Boolean);
    procedure SetOnMouseEnter(const Value: TOnEvent);
    procedure SetOnMouseLeave(const Value: TOnEvent);
  protected
    procedure EdSetTransparent(const Value: Boolean);
    procedure SetOnTestMouseOver(const Value: TOnTestMouseOver);
    function GetPages(Idx: Integer): PControl;
    function TCGetItemText(Idx: Integer): KOLString;
    procedure TCSetItemText(Idx: Integer; const Value: KOLString);
    function TCGetItemImgIDx(Idx: Integer): Integer;
    procedure TCSetItemImgIdx(Idx: Integer; const Value: Integer);
    function TCGetItemRect(Idx: Integer): TRect;
    function TVGetItemIdx(const Index: Integer): THandle;
    procedure TVSetItemIdx(const Index: Integer; const Value: THandle);
    function TVGetItemNext(Item: THandle; const Index: Integer): THandle;
    function TVGetItemRect(Item: THandle; TextOnly: Boolean): TRect;
    function TVGetItemVisible(Item: THandle): Boolean;
    procedure TVSetITemVisible(Item: THandle; const Value: Boolean);
    function TVGetItemStateFlg(Item: THandle; const Index: Integer): Boolean;
    procedure TVSetItemStateFlg(Item: THandle; const Index: Integer;
      const Value: Boolean);
    function TVGetItemImage(Item: THandle; const Index: Integer): Integer;
    procedure TVSetItemImage(Item: THandle; const Index: Integer;
      const Value: Integer);
    function TVGetItemText(Item: THandle): KOLString;
    procedure TVSetItemText(Item: THandle; const Value: KOLString);
    function TV_GetItemHasChildren(Item: THandle): Boolean;
    procedure TV_SetItemHasChildren(Item: THandle; const Value: Boolean);
    function TV_GetItemChildCount(Item: THandle): Integer;
    function TVGetItemData(Item: THandle): Pointer;
    procedure TVSetItemData(Item: THandle; const Value: Pointer);
    function GetToBeVisible: Boolean;
    procedure SetAlphaBlend(const Value: Byte);
    procedure SetMaxProgress(const Index, Value: Integer);
    procedure SetDroppedWidth(const Value: Integer);
    function LVGetItemState(Idx: Integer): TListViewItemState;
    procedure LVSetItemState(Idx: Integer; const Value: TListViewItemState);
    function LVGetSttImgIdx(Idx: Integer): Integer;
    procedure LVSetSttImgIdx(Idx: Integer; const Value: Integer);
    function LVGetOvlImgIdx(Idx: Integer): Integer;
    procedure LVSetOvlImgIdx(Idx: Integer; const Value: Integer);
    function LVGetItemData(Idx: Integer): DWORD;
    procedure LVSetItemData(Idx: Integer; const Value: DWORD);
    function LVGetItemIndent(Idx: Integer): Integer;
    procedure LVSetItemIndent(Idx: Integer; const Value: Integer);
  public
    procedure SetOnDeleteAllLVItems(const Value: TOnEvent);
    procedure SetOnDeleteLVItem(const Value: TOnDeleteLVItem);
    procedure SetOnEndEditLVItem(const Value: TOnEditLVItem);
    procedure SetOnLVData(const Value: TOnLVData);
    procedure SetOnColumnClick(const Value: TOnLVColumnClick);
    procedure SetOnDrawItem(const Value: TOnDrawItem);
    procedure SetOnMeasureItem(const Value: TOnMeasureItem);

    procedure SetItemsCount(const Value: Integer);
  protected
    function GetItemData(Idx: Integer): DWORD;
    procedure SetItemData(Idx: Integer; const Value: DWORD);
    function GetLVCurItem: Integer;
    procedure SetLVCurItem(const Value: Integer);
    function GetLVFocusItem: Integer;
  public
    procedure SetOnDropFiles(const Value: TOnDropFiles);
    procedure SetOnHide(const Value: TOnEvent);
    procedure SetOnShow(const Value: TOnEvent);
    procedure SetClientMargin(const Index: Integer; Value: ShortInt);
  protected
    {$IFDEF F_P}
    function GetClientMargin(const Index: Integer): ShortInt;
    {$ENDIF F_P}
    {$ENDIF GDI}
  protected
    {$IFDEF _X_}
    {$IFDEF GTK}
    {} fExposeEvent: Integer;
    {$ENDIF GTK}
    {$ENDIF _X_}
  public
    procedure SetOnPaint(const Value: TOnPaint);
    {$IFDEF GDI}
    procedure SetOnEraseBkgnd(const Value: TOnPaint);
    procedure SetTVRightClickSelect(const Value: Boolean);
    procedure SetOnLVStateChange(const Value: TOnLVStateChange);
    procedure SetOnMove(const Value: TOnEvent);
    procedure SetOnMoving(const Value: TOnEventMoving);
    procedure SetColor1(const Value: TColor);
    procedure SetColor2(const Value: TColor);
    procedure SetGradientLayout(const Value: TGradientLayout);
    procedure SetGradientStyle(const Value: TGradientStyle);
  protected
    procedure SetDroppedDown(const Value: Boolean);
    function get_ClassName: KOLString;
    procedure set_ClassName(const Value: KOLString);
    procedure SetClsStyle( Value: DWord );

{$IFDEF GRAPHCTL_XPSTYLES}
    function GetEdgeStyle: TEdgeStyle;
    procedure SetEdgeStyle( Value: TEdgeStyle );
{$ENDIF}

    procedure SetStyle( Value: DWord );
    procedure SetExStyle( Value: DWord );

    procedure SetCursor( Value: HCursor );

    procedure SetIcon( Value: HIcon );
    procedure SetMenu( Value: HMenu );
    {$ENDIF GDI}
  protected
    {$IFDEF _X_}
    {} fGetCaption: TGetCaption;
    {} fSetCaption: TSetCaption;
    {$ENDIF _X_}
	function GetCaption: KOLString;
	procedure SetCaption( const Value: KOLString );
    {$IFDEF GDI}

  public procedure SetWindowState( Value: TWindowState );
  protected
    function GetWindowState: TWindowState;
    procedure DoClick;
    function TBAddInsButtons( Idx: Integer; const Buttons: array of PKOLChar;
              const BtnImgIdxArray: array of Integer ): Integer; stdcall;
  public procedure SetBitBtnDrawMnemonic(const Value: Boolean);
  protected
    function GetBitBtnImgIdx: Integer;
    procedure SetBitBtnImgIdx(const Value: Integer);
    function GetBitBtnImageList: THandle;
    procedure SetBitBtnImageList(const Value: THandle);

    function GetModal: Boolean;
    {$IFDEF USE_SETMODALRESULT}
    procedure SetModalResult( const Value: Integer );
    {$ENDIF}

  {$ENDIF GDI}
  protected
    {$IFDEF GDI}
      fHandle: HWnd;
    {$ELSE}
       {$IFDEF GTK} {} fHandle: PGtkWidget;
                    {} fCaptionHandle: PGtkWidget;
                    {} fEventboxHandle: PGtkWidget;
                    {} fGetClientArea: TGetClientArea;
                    {} fClient: PGtkWidget;
                    {} fChildPut: TChildSetPos;
                    {} fChildSetPos: TChildSetPos;
       {$ENDIF}
       {$IFDEF Q_T} fHandle: sometypehere  ;      {$ENDIF}
    {$ENDIF}
  {$IFDEF GDI}
    fClsStyle: DWord;
    fStyle: TStyle;
    fExStyle: DWord;
  {$ENDIF GDI}
    {$IFDEF GDI}
    fDefWndProc: Pointer;
    {$ENDIF GDI}
    FParent: PControl;

    {$IFDEF USE_FLAGS} //................... less memory usage with USE_FLAGS ..
    fFlagsG1: T1Flags;
    fFlagsG2: T2Flags;
    fFlagsG3: T3Flags;
    fFlagsG4: T4Flags;
    fFlagsG5: T5Flags;
    fFlagsG6: T6Flags;
    {$ELSE} //..................................................................
    {} fEnabled: Boolean; // Caution!!! fVisible must follow fEnabled! ___
    {} fVisible: Boolean; //____________________________________________//
    {} fTabstop: Boolean;
    {} fWordWrap: Boolean;
    {} fPreventResize: Boolean;
    // fCursorShared: Boolean;
    {} fIconShared: Boolean;
    {} fIgnoreWndCaption: Boolean;
    {} fSizeRedraw: Boolean; {YS}
    {} fIsStaticControl: Byte;
    {} fCannotDoubleBuf: Boolean;
    {} fDoubleBuffered: Boolean;
    {* True, if cannot set DoubleBuffered to True (RichEdit). }
    {* True, if it is static control with a caption. (Mainly, to prevent
       flicks in DoubleBuffered mode. }
    {} fTransparent: Boolean;
    {} fClassicTransparent : Boolean;
    // FCreating: Boolean;
    {* True, when creating of object is in progress. }
    {} fDestroying: Boolean;
    {* True, when destroying of the window is started. }
    {} fBeginDestroying: Boolean;
    {* true, when destroying of the window is initiated by the system, i.e.
       message WM_DESTROY fired }
    {} fChangedPosSz: Byte;
    {* Flags of changing left (1), top (2), width (4) or height (8) }
    {} fIsForm: Boolean;
    {* True, if the object is form. }
    {} fSizeGrip: Boolean;
    {} fIsApplet: Boolean;
    {* True, if the object represent application taskbar button. }
    {} fIsControl: Boolean;
    {* True, if it is a control on form. }
    {} fIsMDIChild: Boolean;
    {* TRUE, if the object is MDI child form. }
    {} fCreateHidden: Boolean;
    {} fVisibleWoParent: Boolean;
    {} fNotUseAlign: Boolean;
    {} fNotUpdate: Boolean; // was used for PreventResizeFlicks -- now abandoned
    {} fCreateVisible: Boolean;
    {} fIsButton: Boolean;
    {} fIsBitBtn: Boolean;
    {} fIsGroupBox: Boolean;
    {} fIsSplitter: Boolean;
    {} fIsCommonControl: Boolean;
    {* True, if it is common control. }
    {} fFlat: Boolean;
    {} fMouseInControl: Boolean;
    {} fChecked: Boolean;
    {} fPushed: Boolean;
    {} fHot: Boolean;
    {} fFocused: Boolean;
    {} fPressed : Boolean;
    // fDropped: Boolean;
    {} f3ButtonPress: Boolean;
    // fEditing: Boolean;
    {} fEraseUpdRgn: Boolean;
    {} fKeyPreview: Boolean;
    {} fKeyPreviewing: Boolean;
    {} fIgnoreDefault: Boolean;
    {} fDefaultBtn: Boolean;
    {} fCancelBtn: Boolean;
    {} fWindowed: Boolean;                                                                            //
    {* True, if control is windowed (or is a form). It is set to FALSE only for
       graphic controls. }
    {} fCtlClsNameChg: Boolean;                                                                       //
    {* True, if control class name changed and memory is allocated to store it. }                  //
    {} fRightClick: Boolean;
    {} fDragging: Boolean;
    {$ENDIF not USE_FLAGS} //.................................................................
    fTextAlign: TTextAlign;
    fVerticalAlign: TVerticalAlign;
    {$IFDEF STORE_EDGESTYLE}
    {} fEdgeStyle : TEdgeStyle;
    {$ENDIF}
    fLookTabKeys: TTabKeys;
    fTabOrder: SmallInt;
    fAlphaBlend: Byte;

    // Caution!!! order of following 5 fields is important!!!
    fDynHandlers: PList;
    fChildren: PList;
    {* List of children. }
    //________________________________________________________//
    {$IFDEF GDI}

    fTmpBrush: HBrush;
    {* Brush handle to return in response to some color set messages.
       Intended for internal use instead of Brush.Color if possible
       to avoid using it. }
    {$IFDEF STORE_fTmpBrushColorRGB}
    {} fTmpBrushColorRGB: TColor;
    {$ENDIF}
    { }
  public
    {$IFDEF COMMANDACTIONS_OBJ}
    fCommandActions: PCommandActionsObj;
    {$ELSE}
    fCommandActions: TCommandActions;
    {$ENDIF}
    {$IFDEF EVENTS_DYNAMIC}
    EV: PEvents;
  protected
    function ProvideUniqueEvents: PEvents;
    procedure FreeEV;
    {$ELSE}
  protected
    EV: TEvents;
    {$ENDIF}
  protected
    PP: TProcedures;
    fMenu: HMenu;
    {* Usually used to store handle of attached main menu, but sometimes
       is used to store control ID (for standard GUI controls only). }
    {$ENDIF GDI}
    fMenuObj: PObj;
    {* PMenu pointer to TMenu object. Freed automatically with entire
       chain of menu objects attached to a control (or form). }
    {$IFDEF _X_}
    {$IFDEF GTK}
    //fMenuBar: PGtkWidget;
    {$ENDIF GTK}
    {$ENDIF _X_}
    {$IFDEF GDI}
{$IFNDEF NEW_MENU_ACCELL}
    fAccelTable: HAccel;
    procedure DoDestroyAccelTable;
{$ENDIF}
  {$ENDIF GDI}
  protected
  {$IFDEF GDI}
    {* Handle of accelerator table created by menu(s). }
    fImageList: PImageList;
    {* Pointer to first private image list. Control can own several image,
       lists, linked to a chain of image list objects. All these image lists
       are released automatically, when control is destroyed. }
    {$ENDIF GDI}
    {$IFDEF GDI}
    fUpdRgn: HRgn;
    //fCollectUpdRgn: HRGN;
    fPaintDC: HDC;
    {$ENDIF GDI}
  protected
    fAutoPopupMenu: PObj;
    //fHelpContext: Integer;

    {$IFDEF GTK}
    fDeltaX, fDeltaY: Integer;
    {$ENDIF GTK}
    // Order of following fields is important:
    //_______________________________________________________________________________________________
    //{$ENDIF GDI}
    {$IFDEF GDI}
    //                                                                                             //
    {$ENDIF GDI}
    fTextColor: TColor;                                                                            //
    {* Color of text. Used instead of fFont.Color internally to                                    //
       avoid usage of Font object if user is not accessing and changing it. }                      //
    fColor: TColor;                                                                                //
    {* Color of control background. }                                                              //
    fFont: PGraphicTool;                                                                           //
    fBrush: PGraphicTool;                                                                          //
    fMargin: ShortInt;                                                                              //
    fClientTop: ShortInt;
    fClientBottom: ShortInt;
    fClientLeft: ShortInt;
    fClientRight: ShortInt;                                 //
    {* Store adjustment factor of ClientRect for some 'idiosincrasies' windows,                    //
       such as Groupbox or Tabcontrol. }                                                           //
    fCtl3D_child: Byte;                                                                          //
    fBoundsRect: TRect;                                                                            //
    fCursor: HCursor;
    //_____________________________________________________________________________________________//
    // this is the end of fiels set, which order is important
    fCanvas: PCanvas;
    {$IFDEF GDI}
    fDblExcludeRgn: HDC;

    {$ENDIF GDI}
    {$IFDEF GTK}
    {} fClickedEvent: Integer;
    {$ENDIF}
  public
    procedure SetOnClick( const Value: TOnEvent );
  protected
    {$IFDEF GDI}
    //fRadio1st: THandle;
    //fRadioLast : THandle;
    //fDropDownProc: procedure( Sender : PObj );
    //fPrevWndProc: Pointer;

    fCurIndex: Integer;

    //fOldDefWndProc: Pointer;
    procedure SetSBMax(Value: Longint);
    procedure SetSBMin(Value: Longint);
    procedure SetSBPageSize(Value: Integer);
    procedure SetSBPosition(Value: Integer);
    procedure SetSBMinMax(const Value: TPoint);
  protected
    procedure SetOnLVCustomDraw(const Value: TOnLVCustomDraw);
  {$ENDIF GDI}
  protected
  {$IFDEF GDI}
    //fPaintMsg: TMsg;

    {$ENDIF GDI}
    FMaxWidth: SmallInt;
    FMinWidth: SmallInt;
    FMaxHeight: SmallInt;
    FMinHeight: SmallInt;
    {$IFDEF GDI}
    fStatusCtl: PControl;
    //fStatusTxt: PKOLChar;
    {$ENDIF GDI}
    {$IFDEF GDI}
    //fDragStartPos: TSmallPoint;
    //fMouseStartPos: TSmallPoint;
    {$IFDEF FIX_WIDTH_HEIGHT}
    {} FFixWidth: Integer;
    {} FFixHeight: Integer;
    {$ENDIF}
    {$ENDIF GDI}
    //----- order of following 3 fields important: //
    fCaption: KOLString;
    fCustomData: Pointer;
    fControlClassName: PKOLChar;                                                                      //
    {$IFDEF GDI}
    //---------------------------------------------//
    fCustomObj: PObj;
  public
    DF: TDataFields;
    {* Data fields for certain controls. These are overlapped to
       economy size of TControl object. }
    //fCreateParamsExt: procedure( Self_: PControl; var Params: TCreateParams );
  protected

    {$IFDEF USE_MHTOOLTIP}
    {$DEFINE var}
    fHint: PMHHint;
    {$UNDEF var}

    {$DEFINE function}
    function GetHint: PMHHint;
    {$UNDEF function}
    {$ENDIF}

    {$ENDIF GDI}

    procedure Init; virtual;
    {$IFDEF GDI}
    procedure InitParented( AParent: PControl ); virtual;
    {* Initialization of visual object. }
    procedure InitOrthaned( AParentWnd: HWnd ); virtual;
    {* Initialization of visual object. }
    {$ENDIF GDI}
    {$IFDEF _X_}
    {$IFDEF GTK}
    PROCEDURE InitParented( AParent: PControl; widget: PGtkWidget;
      {}need_eventbox: Boolean ); VIRTUAL;
    {* Initialization of visual object. }
    {$ENDIF GTK}
    {$ENDIF _X_}
    {$IFDEF GDI}
    procedure DestroyChildren;
    {* Destroys children. Is called in destructor, and can be
       called in descending classes as earlier as needed to
       prevent problems of too late destroying of visuals.
       |<br>
       Note: since v 2.40, used only for case when a symbol NOT_USE_AUTOFREE4CONTROLS
       is defined, otherwise all children are destroyed using common mechanism of
       Add2AutoFree. }

    function GetParentWnd( NeedHandle: Boolean ): HWnd;
    {* Returns handle of parent window. }
    function GetParentWindow: HWnd;
    {* }
    procedure SetEnabled( Value: Boolean );
    {* Changes Enabled property value. Overriden here to change enabling
       status of a window. }
    function GetEnabled: Boolean;
    {* Returns True, if Enabled. Overriden here to obtain real window
       state. }
    procedure SetVisible( Value: Boolean );
    {* Sets Visible property value. Overriden here to change visibility
       of correspondent window. }
    procedure Set_Visible( Value: Boolean );
    {* }
    function GetVisible: Boolean;
    {* Returns True, if correspondent window is Visible. Overriden
       to get visibility of real window, not just value stored in object. }
    function Get_Visible: Boolean;
    {* Returns True, if correspondent window is Visible, for forms and applet,
       or if fVisible flag is set, for controls. }
  protected
    {$ENDIF GDI}
    procedure SetCtlColor( Value: TColor );
    {* Sets TControl's Color property value. }
    procedure SetBoundsRect( const Value: TRect );
    {* Sets BoudsRect property value. }
    function GetBoundsRect: TRect;
    {* Returns bounding rectangle. }
    {$IFDEF GDI}
    function GetIcon: HIcon;
    {* Returns Icon property. By default, if it is not set,
       returns Icon property of an Applet. }

	procedure CreateSubclass( var Params: TCreateParams; ControlClassName: PKOLChar );
    {* Can be used in descending classes to subclass window with given
       standard Windows ControlClassName - must be called after
       creating Params but before CreateWindow. Usually it is called
       in overriden method CreateParams after calling of the inherited one. }

    function UpdateWndStyles: PControl;
  public
    {* Updates fStyle, fExStyle, fClsStyle from window handle }
    procedure SetOnChar(const Value: TOnChar);
    {* }
    {$IFDEF SUPPORT_ONDEADCHAR}
    procedure SetOnDeadChar(const Value: TOnChar);
    {* }
    {$ENDIF SUPPORT_ONDEADCHAR}
    procedure SetOnKeyDown(const Value: TOnKey);
    {* }
    procedure SetOnKeyUp(const Value: TOnKey);
    {* }
    {$ENDIF GDI}
    {$IFDEF GDI}
    procedure SetHelpContext( Value: Integer );
    {* }
    procedure SetOnTVDelete( const Value: TOnTVDelete );
    {* }
  public procedure SetDefaultBtn(const Index: Integer; const Value: Boolean);
  protected
    function GetDefaultBtn(const Index: Integer): Boolean;
    function DefaultBtnProc( var Msg: TMsg; var Rslt: Integer ): Boolean;
    {* }

    procedure SetDateTime( Value: TDateTime );
    function GetDateTime: TDateTime;
    procedure SetDateTimeRange( Value: TDateTimeRange );
    function GetDateTimeRange: TDateTimeRange;
    procedure SetDateTimePickerColor( Index: TDateTimePickerColor; Value: TColor );
    function GetDateTimePickerColor( Index: TDateTimePickerColor ): TColor;
    procedure SetDateTimeFormat( const Value: KOLString );
    function Get_SystemTime: TSystemTime;
    procedure Set_SystemTime(const Value: TSystemTime);

    procedure SetOnTBCustomDraw( const Value: TOnTBCustomDraw );

  {$ENDIF GDI}
    procedure DoAutoSize;

  public
    {$IFDEF GDI}
    constructor CreateParented( AParent: PControl );
    {* Creates new instance of TControl object, calling InitParented }
    constructor CreateOrthaned( AParentWnd: HWnd );
    {* Creates new instance of TControl object, calling InitOrthaned }
    {$ENDIF GDI}
    {$IFDEF _X_}
    {$IFDEF GTK}
    CONSTRUCTOR CreateParented( AParent: PControl; widget: PGtkWidget;
      {}need_eventbox: Boolean );
    {* Creates new instance of TControl object, calling InitParented }
    {$ENDIF GTK}
    {$ENDIF _X_}
  {$IFDEF GDI}
    destructor Destroy; virtual;
    {* Destroyes object. First of all, destructors for all children
       are called. }

    function GetWindowHandle: HWnd;
    {* Returns window handle. If window is not yet created,
       method CreateWindow is called. }
    procedure CreateChildWindows;
    {* Enumerates all children recursively and calls CreateWindow for all
       of these. }
    {$ENDIF GDI}
    property Parent: PControl read fParent write SetParent;
    {* Parent of TParent object. Also must be of TParent type or derived from TParent. }
    //property Tag: Integer read FTag write FTag; //--------- moved to TObj --------
    {* User-defined pointer, which can contain any data or reference to
       anywhere in memory (when used as a pointer).
    }
    function ChildIndex( Child: PControl ): Integer;
    {* Returns index of given child. }
    procedure MoveChild( Child: PControl; NewIdx: Integer );
    {* Moves given Child into new position. }

    {$IFDEF GDI}
    property Enabled: Boolean read GetEnabled write SetEnabled;
    {* Enabled usually used to decide if control can get keyboard focus
       or been clicked by mouse. }
    procedure EnableChildren( Enable, Recursive: Boolean );
    {* Enables (Enable = TRUE) or disables (Enable = FALSE) all the children
       of the control. If Recursive = TRUE then all the children of all the
       children are enabled or disabled recursively. }
    property Visible: Boolean read Get_Visible write SetVisible;
    {* Obvious. }
    property ToBeVisible: Boolean read GetToBeVisible;
    {* Returns True, if a control is supposed to be visible when its
       form is showing. }
    property CreateVisible: Boolean
             read {$IFDEF USE_FLAGS} GetCreateVisible {$ELSE} fCreateVisible {$ENDIF}
             write {$IFDEF USE_FLAGS} SetCreateVisible {$ELSE} fCreateVisible {$ENDIF};
    {* False by default. If You want your form to be created visible and
       flick due creation, set it to True. This does not affect size of
       executable anyway. }
    {$ENDIF GDI}
    property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
    {* Bounding rectangle of the visual. Coordinates are relative
       to top left corner of parent's ClientRect, or to top left corner
       of screen (for TForm). }
    property Left: Integer read GetLeft write SetLeft;
    {* Left horizontal position. }
    property Top: Integer read GetTop write SetTop;
    {* Top vertical position. }
    property Width: Integer read GetWidth write SetWidth;
    {* Width of TVisual object. }
    property Height: Integer read GetHeight write SetHeight;
    {* Height of TVisual object. }
    property Position: TPoint read GetPosition write Set_Position;
    {* Represents top left position of the object. See also BoundsRect. }
    {$IFDEF GDI}
    property MinWidth: SmallInt index 0
             {$IFDEF F_P}   read GetConstraint
             {$ELSE DELPHI} read FMinWidth
             {$ENDIF F_P/DELPHI} write SetConstraint;
    {* Minimal width constraint. }
    property MinHeight: SmallInt index 1
             {$IFDEF F_P}   read GetConstraint
             {$ELSE DELPHI} read FMinHeight
             {$ENDIF F_P/DELPHI} write SetConstraint;
    {* Minimal height constraint. }
    property MaxWidth: SmallInt index 2
             {$IFDEF F_P}   read GetConstraint
             {$ELSE DELPHI} read FMaxWidth
             {$ENDIF F_P/DELPHI} write SetConstraint;
    {* Maximal width constraint. }
    property MaxHeight: SmallInt index 3
             {$IFDEF F_P}   read GetConstraint
             {$ELSE DELPHI} read FMaxHeight
             {$ENDIF F_P/DELPHI} write SetConstraint;
    {* Maximal height constraint. }

    {$ENDIF GDI}
    function ClientRect: TRect;
    {* Client rectangle of TControl. Contrary to VCL, for some
       classes (e.g. for graphic controls) can be relative
       not to itself, but to top left corner of the parent's ClientRect
       rectangle. }
    {$IFDEF GDI}
    property ClientWidth: Integer read GetClientWidth write SetClientWidth;
    {* Obvious. Accessing this property, program forces window latent creation. }
    property ClientHeight: Integer read GetClientHeight write SetClientHeight;
    {* Obvious. Accessing this property, program forces window latent creation. }

    function ControlRect: TRect;
    {* Absolute bounding rectangle relatively to nearest
       Windowed parent client rectangle (at least to a form, but usually to
       a Parent).
       Useful while drawing on device context, provided by such
       Windowed parent. For form itself is the same as BoundsRect. }

    function ControlAtPos( X, Y: Integer; IgnoreDisabled: Boolean ): PControl;
    {* Searches control at the given position (relatively to top left
       corner of the ClientRect). }
    {$ENDIF GDI}
    procedure Invalidate;
    {* Invalidates rectangle, occupied by the visual (but only if Showing =
       True). }
    {$IFDEF GDI}
  public
    procedure InvalidateEx;
    {* Invalidates the window and all its children. }
    procedure InvalidateNC( Recursive: Boolean );
    {* Invalidates the window and all its children including non-client area. }
    procedure Update;
    {* Updates control's window and calls Update for all child controls. }
    procedure BeginUpdate;
    {* |<#treeview>
       |<#listview>
       |<#richedit>
       |<#memo>
       |<#listbox>
       Call this method to stop visual updates of the control until correspondent
       EndUpdate called (pairs BeginUpdate - EndUpdate can be nested). }
    procedure EndUpdate;
    {* See BeginUpdate. }

    property Windowed: Boolean
             read {$IFDEF USE_FLAGS} GetWindowed {$ELSE} fWindowed {$ENDIF}
             write {$IFDEF USE_FLAGS} SetWindowed {$ELSE} fWindowed {$ENDIF};
    {* Constantly returns True, if object is windowed (i.e. owns
        correspondent window handle). Otherwise, returns False.
        |<br>
        By now, all the controls are windowed (there are no controls in KOL, which are
        emulating window, acually belonging to Parent - like TGraphicControl
        in VCL).
        |<br>
        Writing of this property provided only for internal purposes,
        do not change it directly unless you understand well what you do. }

    function HandleAllocated: Boolean;
    {* Returns True, if window handle is allocated. Has no sense for
       non-Windowed objects (but now, the KOL has no non-Windowed controls). }
    {$ENDIF GDI}

    property ChildCount: Integer read GetChildCount;
    {* Returns number of commonly accessed child objects. }
    property Children[ Idx: Integer ]: PControl read GetMembers;
    {* Child items of TVisual object. Property is reintroduced here
       to separate access to always visible Children[] from restricted
       a bit Members[]. }
    {$IFDEF GDI}
    procedure PaintBackground( DC: HDC; Rect: PRect );
    {* Is called to paint background in given rectangle. This
       method is filling clipped area of the Rect rectangle with
       Color, but only if global event Global_OnPaintBkgnd is
       not assigned. If assigned, this one is called instead here.
       |<br>&nbsp;&nbsp;&nbsp;
       This method made public, so it can be called directly to
       fill some device context's rectangle. But remember, that
       independantly of Rect, top left corner of background piece
       will be located so, if drawing is occure into ControlRect
       rectangle. }
    property WindowedParent: PControl read fParent;
    {* Returns nearest windowed parent, the same as Parent. }
    {$ENDIF GDI}
    function ParentForm: PControl;
    {* |<#form>
       Returns parent form for a control (of @Self for form itself. }
    function FormParentForm: PControl;
    {* |<#form>
       Returns parent form for a control (of @Self for form itself. For a frame,
       returns frame panel instead. }
    function MarkPanelAsForm: PControl;
    {* Special function for MCK to mark panel as frame parent control. }
    {$IFDEF GDI}
    property ActiveControl: PControl read DF.fCurrentControl write DF.fCurrentControl;
    {* }
    function Client2Screen( const P: TPoint ): TPoint;
    {* Converts the client coordinates of a specified point to screen coordinates. }
    function Screen2Client( const P: TPoint ): TPoint;
    {* Converts screen coordinates of a specified point to client coordinates. }
    function CreateWindow: Boolean; virtual;
    {* |<#form>
       Creates correspondent window object. Returns True if success (if
       window is already created, False is returned). If applied to a form,
       all child controls also allocates handles that time.
       |<br>&nbsp;&nbsp;&nbsp;
       Call this method to ensure, that a hanle is allocated for a form,
       an application button or a control. (It is not necessary to do so in
       the most cases, even if You plan to work with control's handle directly.
       But immediately after creating the object, if You want to pass its
       handle to API function, this can be helpful). }
    {$ENDIF GDI}
    {$IFDEF _X_}
    procedure VisualizyWindow; // for _X_, makes actually visible a window and
      // all its subwindows recursively, if they are having Visible = TRUE
    {$ENDIF _X_}
    {$IFDEF GDI}
    procedure Close;
    {* |<#appbutton>
       |<#form>
       Closes window. If a window is the main form, this closes application,
       terminating it. Also it is possible to call Close method for Applet
       window to stop application. }

    {$IFDEF USE_MHTOOLTIP}
    {$DEFINE public}
    property Hint: PMHHint read GetHint;
    {$UNDEF public}
    {$ENDIF}

    property Handle: HWnd read fHandle; //GetHandle;
    {* Returns descriptor of system window object. If window is not yet
       created, 0 is returned. To allocate handle, call CreateWindow method. }

    property ParentWindow: HWnd read GetParentWindow;
    {* Returns handle of parent window (not TControl object, but system
       window object handle). }
    property ClsStyle: DWord read fClsStyle write SetClsStyle;
    {* Window class style. Available styles are:
       |<table border=0>
       |&L=<tr><td valign=top><font face=Fixedsys>%1</font></td><td>
       |&E=</td></tr>
       |&N=<br>&nbsp;&nbsp;&nbsp;
       <L CS_BYTEALIGNCLIENT> - Aligns the window's client area on the byte boundary
          (in the x direction) to enhance performance during
       drawing operations. <E>
       <L CS_BYTEALIGNWINDOW> - Aligns a window on a byte boundary (in the x
          direction). <E>
       <L CS_CLASSDC> - Allocates one device context to be shared by all
          windows in the class. <E>
       <L CS_DBLCLKS> - Sends double-click messages to the window
          procedure when the user double-clicks the mouse while the
          cursor is within a window belonging to the class. <E>
       <L CS_GLOBALCLASS> - Allows an application to create a window of
          the class regardless of the value of the hInstance parameter.
       <N> You can create a global class by creating
          the window class in a dynamic-link library (DLL) and listing the
          name of the DLL in the registry under specific keys. <E>
       <L CS_HREDRAW> - Redraws the entire window if a movement or
          size adjustment changes the width of the client area. <E>
       <L CS_NOCLOSE>  - Disables the Close command on the System menu. <E>
       <L CS_OWNDC> - Allocates a unique device context for each window
          in the class. <E>
       <L CS_PARENTDC> - Sets the clipping region of the child window to
          that of the parent window so that the child can draw on the parent. <E>
       <L CS_SAVEBITS> - Saves, as a bitmap, the portion of the screen
          image obscured by a window. Windows uses the saved bitmap to re-create
          the screen image when the window is removed. <E>
       <L CS_VREDRAW> - Redraws the entire window if a movement or size
          adjustment changes the height of the client area. <E>
       |</table> For more info, see Win32.hlp (keyword 'WndClass');
    }


{$IFDEF GRAPHCTL_XPSTYLES}
    property edgeStyle : TEdgeStyle
             read {$IFnDEF STORE_EDGESTYLE} GetEdgeStyle {$ELSE} fEdgeStyle {$ENDIF}
             write SetEdgeStyle;
{$ENDIF}

    property Style: DWord read fStyle.Value write SetStyle;
    {* Window styles. Available styles are:
       |<table border=0>
       <L WS_BORDER>	Creates a window that has a thin-line border. <E>
       <L WS_CAPTION>	Creates a window that has a title bar (includes the
          WS_BORDER style). <E>
       <L WS_CHILD>	Creates a child window. This style cannot be used with
          the WS_POPUP style. <E>
       <L WS_CHILDWINDOW>	Same as the WS_CHILD style. <E>
       <L WS_CLIPCHILDREN>	Excludes the area occupied by child windows
          when drawing occurs within the parent window. This style is used
          when creating the parent window. <E>
       <L WS_CLIPSIBLINGS>	Clips child windows relative to each other;
          that is, when a particular child window receives a WM_PAINT message,
          the WS_CLIPSIBLINGS style clips all other overlapping child windows
          out of the region of the child window to be updated. If
          WS_CLIPSIBLINGS is not specified and child windows overlap, it is
          possible, when drawing within the client area of a child window,
          to draw within the client area of a neighboring child window. <E>
       <L WS_DISABLED>	Creates a window that is initially disabled. A
          disabled window cannot receive input from the user. <E>
       <L WS_DLGFRAME>	Creates a window that has a border of a style
          typically used with dialog boxes. A window with this style cannot
          have a title bar. <E>
       <L WS_GROUP>	Specifies the first control of a group of controls.
          The group consists of this first control and all  controls defined
          after it, up to the next control with the WS_GROUP style.
          The first control in each group usually has the WS_TABSTOP
          style so that the user can move from group to group. The user
          can subsequently change the keyboard focus from one control in
          the group to the next control in the group by using the direction
          keys. <E>
       <L WS_HSCROLL>	Creates a window that has a horizontal scroll bar. <E>
       <L WS_ICONIC>	Creates a window that is initially minimized. Same as
          the WS_MINIMIZE style. <E>
       <L WS_MAXIMIZE>	Creates a window that is initially maximized. <E>
       <L WS_MAXIMIZEBOX>	Creates a window that has a Maximize button.
          Cannot be combined with the WS_EX_CONTEXTHELP style. The WS_SYSMENU
          style must also be specified. <E>
       <L WS_MINIMIZE>	Creates a window that is initially minimized.
          Same as the WS_ICONIC style. <E>
       <L WS_MINIMIZEBOX>	Creates a window that has a Minimize button.
          Cannot be combined with the WS_EX_CONTEXTHELP style. The WS_SYSMENU
          style must also be specified. <E>
       <L WS_OVERLAPPED>	Creates an overlapped window. An overlapped
          window has a title bar and a border. Same as the WS_TILED style. <E>
       <L WS_OVERLAPPEDWINDOW>	Creates an overlapped window with the
          WS_OVERLAPPED, WS_CAPTION, WS_SYSMENU, WS_THICKFRAME, WS_MINIMIZEBOX,
          and WS_MAXIMIZEBOX styles. Same as the WS_TILEDWINDOW style. <E>
       <L WS_POPUP>	Creates a pop-up window. This style cannot be used with
          the WS_CHILD style. <E>
       <L WS_POPUPWINDOW>	Creates a pop-up window with WS_BORDER,
          WS_POPUP, and WS_SYSMENU styles. The WS_CAPTION and WS_POPUPWINDOW
          styles must be combined to make the window menu visible. <E>
       <L WS_SIZEBOX>	Creates a window that has a sizing border. Same as the
          WS_THICKFRAME style. <E>
       <L WS_SYSMENU>	Creates a window that has a window-menu on its title
          bar. The WS_CAPTION style must also be specified. <E>
       <L WS_TABSTOP>	Specifies a control that can receive the keyboard focus
          when the user presses the TAB key. Pressing the TAB key changes
          the keyboard focus to the next control with the WS_TABSTOP style. <E>
       <L WS_THICKFRAME>	Creates a window that has a sizing border.
          Same as the WS_SIZEBOX style. <E>
       <L WS_TILED>	Creates an overlapped window. An overlapped window has
          a title bar and a border. Same as the WS_OVERLAPPED style. <E>
       <L WS_TILEDWINDOW>	Creates an overlapped window with the
          WS_OVERLAPPED, WS_CAPTION, WS_SYSMENU, WS_THICKFRAME,
          WS_MINIMIZEBOX, and WS_MAXIMIZEBOX styles. Same as the
          WS_OVERLAPPEDWINDOW style. <E>
       <L WS_VISIBLE>	Creates a window that is initially visible. <E>
       <L WS_VSCROLL>	Creates a window that has a vertical scroll bar. <E>
       |</table>
       See also Win32.hlp (topic CreateWindow).
    }
    property ExStyle: DWord read fExStyle write SetExStyle;
    {* Extra window styles. Available flags are following:
       |<table border=0>
       <L WS_EX_ACCEPTFILES>	Specifies that a window created with this style
          accepts drag-drop files. <E>
       <L WS_EX_APPWINDOW>	Forces a top-level window onto the taskbar
          when the window is minimized. <E>
       <L WS_EX_CLIENTEDGE>	Specifies that a window has a border with a
          sunken edge. <E>
       <L WS_EX_CONTEXTHELP>	Includes a question mark in the title bar of
          the window. When the user clicks the question mark, the cursor
          changes to a question mark with a pointer. If the user then clicks
          a child window, the child receives a WM_HELP message. The child
          window should pass the message to the parent window procedure,
          which should call the WinHelp function using the HELP_WM_HELP
          command. The Help application displays a pop-up window that
          typically contains help for the child window.WS_EX_CONTEXTHELP
          cannot be used with the WS_MAXIMIZEBOX or WS_MINIMIZEBOX styles. <E>
       <L WS_EX_CONTROLPARENT> Allows the user to navigate among the child
          windows of the window by using the TAB key. <E>
       <L WS_EX_DLGMODALFRAME> Creates a window that has a double border;
          the window can, optionally, be created with a title bar by
          specifying the WS_CAPTION style in the dwStyle parameter. <E>
       <L WS_EX_LEFT>	Window has generic "left-aligned" properties. This
          is the default. <E>
       <L WS_EX_LEFTSCROLLBAR> If the shell language is Hebrew, Arabic, or
          another language that supports reading order alignment, the
          vertical scroll bar (if present) is to the left of the client
          area. For other languages, the style is ignored and not treated
          as an error. <E>
       <L WS_EX_LTRREADING>	The window text is displayed using Left to
          Right reading-order properties. This is the default. <E>
       <L WS_EX_MDICHILD>	Creates an MDI child window. <E>
       <L WS_EX_NOPARENTNOTIFY>	Specifies that a child window created
          with this style does not send the WM_PARENTNOTIFY message to its
          parent window when it is created or destroyed. <E>
       <L WS_EX_OVERLAPPEDWINDOW>	Combines the WS_EX_CLIENTEDGE and
          WS_EX_WINDOWEDGE styles. <E>
       <L WS_EX_PALETTEWINDOW> Combines the WS_EX_WINDOWEDGE,
          WS_EX_TOOLWINDOW, and WS_EX_TOPMOST styles. <E>
       <L WS_EX_RIGHT> Window has generic "right-aligned" properties.
          This depends on the window class. This style has an effect only
          if the shell language is Hebrew, Arabic, or another language that
          supports reading order alignment; otherwise, the style is
          ignored and not treated as an error. <E>
       <L WS_EX_RIGHTSCROLLBAR> Vertical scroll bar (if present) is to the
          right of the client area. This is the default. <E>
       <L WS_EX_RTLREADING>	If the shell language is Hebrew, Arabic, or
          another language that supports reading order alignment, the
          window text is displayed using Right to Left reading-order
          properties. For other languages, the style is ignored and not
          treated as an error. <E>
       <L WS_EX_STATICEDGE>	Creates a window with a three-dimensional
          border style intended to be used for items that do not accept
          user input. <E>
       <L WS_EX_TOOLWINDOW>	Creates a tool window; that is, a window
          intended to be used as a floating toolbar. A tool window has
          a title bar that is shorter than a normal title bar, and the
          window title is drawn using a smaller font. A tool window does
          not appear in the taskbar or in the dialog that appears when
          the user presses ALT+TAB. <E>
       <L WS_EX_TOPMOST> Specifies that a window created with this style
          should be placed above all non-topmost windows and should stay
          above them, even when the window is deactivated. To add or remove
          this style, use the SetWindowPos function. <E>
       <L WS_EX_TRANSPARENT>	Specifies that a window created with this
          style is to be transparent. That is, any windows that are
          beneath the window are not obscured by the window. A window
          created with this style receives WM_PAINT messages only after
          all sibling windows beneath it have been updated. <E>
       <L WS_EX_WINDOWEDGE>	Specifies that a window has a border with
          a raised edge. <E>
       |</table>
       See also Win32.hlp (topic CreateWindowEx).
    }

    property Cursor: HCursor read fCursor write SetCursor;
    {* Current cursor. For most of controls, sets initially to IDC_ARROW. See
       also ScreenCursor. }
    procedure CursorLoad( Inst: Integer; ResName: PKOLChar );
    {* Loads Cursor from the resource. See also comments for Icon property. }

    property Icon: HIcon read {$IFDEF SMALLEST_CODE} DF.fIcon {$ELSE} GetIcon {$ENDIF}
       write SetIcon;
    {* |<#appbutton>
       |<#form>
       Icon. By default, icon of the Applet is used. To load icon from the
       resource, use IconLoad or IconLoadCursor method - this is more correct, because
       in such case a special flag is set to prevent attempts to destroy
       shared icon object in the destructor of the control. }

    procedure IconLoad( Inst: Integer; ResName: PKOLChar );
    {* |<#appbutton>
       |<#form>
       See Icon property. }
    procedure IconLoadCursor( Inst: Integer; ResName: PKOLChar );
    {* |<#appbutton>
       |<#form>
       Loads Icon from the cursor resource. See also Icon property. }

    property Menu: HMenu read fMenu write SetMenu;

    {* Menu (or ID of control - for standard GUI controls). }
    property HelpContext: Integer read GetHelpContext write SetHelpContext;
    {* Help context. }
    function AssignHelpContext( Context: Integer ): PControl;
    {* Assigns HelpContext and returns @ Self (can be used in initialization
       of a control in a chain of "transparent" calls). }

    procedure CallHelp( Context: Integer; CtxCtl: PControl {; CtlID: Integer} );
    {* Method of a form or Applet. Call it to show help with the given context
       ID. If the Context = 0, help contents is displayed. By default,
       WinHelp is used. To allow using HtmlHelp, call AssignHtmlHelp global
       function. When WinHelp used, HelpPath variable can be assigned directly.
       If HelpPath variable is not assigned, application name
       (and path) is used, with extension replaced to '.hlp'. }

    property HelpPath: KOLString read GetHelpPath write SetHelpPath;
    {* Property of a form or an Applet. Change it to provide custom path to
       WinHelp format help file. If HtmlHelp used, call global procedure
       AssignHtmlHelp instead. }

    property OnHelp: TOnHelp
             read {$IFDEF EVENTS_DYNAMIC} Get_OnHelp {$ELSE} EV.fOnHelp {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnHelp {$ELSE} EV.fOnHelp {$ENDIF};
    {* An event of a form, it is called when F1 pressed or help topic requested
       by any other way. To prevent showing help, nullify Sender. Set Popup to
       TRUE to provide showing help in a pop-up window. It is also possible to
       change Context dynamically. }

    {$ENDIF GDI}
    property Caption: KOLString read GetCaption write SetCaption;
    {* |<#appbutton>
       |<#form>
       |<#button>
       |<#bitbtn>
       |<#label>
       |<#wwlabel>
       |<#3dlabel>
       Caption of a window. For standard Windows buttons, labels and so on
       not a caption of a window, but text of the window. }
    property Text: KOLString read GetCaption write SetCaption;
    {* |<#edit>
       |<#memo>
       The same as Caption. To make more convenient with Edit controls. For
       Rich Edit control, use property RE_Text. }

    {$IFDEF GDI}
    property SelStart: Integer read GetSelStart write SetSelStart;
    {* |<#edit>
       |<#memo>
       |<#richedit>
       Start of selection (editbox - character position). }
    property SelLength: Integer read GetSelLength write SetSelLength;
    {* |<#edit>
       |<#memo>
       |<#richedit>
       |<#listbox>
       |<#listview>
       Length of selection (editbox - number of characters selected, multiselect
       listbox or listview - number of items selected).
       |<br>
       Note, that for combobox and single-select listbox it always returns 0
       (though for single-select listview, returns 1, if there is an item
       selected).
       |<br>
       It is possible to set SelLength only for memo and richedit controls. }

    property Selection: KOLString read GetSelection write SetSelection;
    {* |<#edit>
       |<#memo>
       |<#richedit>
       Selected text (editbox, richedit) as string. Can be useful to replace
       selection. For rich edit, use RE_Text[ reText, TRUE ], if you want to
       read correctly characters from another locale then ANSI only. }
    procedure SelectAll;
    {* |<#edit>
       |<#memo>
       |<#richedit>
       Makes all the text in editbox or RichEdit, or all items in listbox
       selected. }

    procedure ReplaceSelection( const Value: KOLString; aCanUndo: Boolean );
    {* |<#edit>
       |<#memo>
       |<#richedit>
       Replaces selection (in edit, RichEdit). Unlike assigning new value
       to Selection property, it is possible to specify, if operation can
       be undone.
       |<br>
       Use this method or assigning value to a Selection property to format
       text initially in the rich edit. E.g.:
       !    RichEdit1.RE_FmtBold := TRUE;
       !    RichEdit1.Selection := 'bolded text'#13#10;
       !    RichEdit1.RE_FmtBold := FALSE;
       !    RichEdit1.RE_FmtItalic := TRUE;
       !    RichEdit1.Selection := 'italized text';
       !... }

    procedure DeleteLines( FromLine, ToLine: Integer );
    {* |<#edit>
       |<#memo>
       |<#richedit>
       Deletes lines from FromLine to ToLine (inclusively, i.e. 0 to 0 deletes
       one line with index 0). Current selection is restored as possible. }
    property CurIndex: Integer read GetCurIndex write SetCurIndex;
    {* |<#listbox>
       |<#combo>
       |<#toolbar>
       Index of current item (for listbox, combobox) or button index pressed
       or dropped down (for toolbar button, and only in appropriate event
       handler call).
       |<br>
       You cannot use it to set or remove a selection in a multiple-selection
       list box, so you should set option loNoExtendSel to true.
       |<br>
       In OnClick event handler, CurIndex has not yet changed for listbox or combobox.
       Use OnSelChange to respond to selection changes. }

    property Count: Integer read GetItemsCount write SetItemsCount;
    {* |<#listbox>
       |<#combo>
       |<#listview>
       |<#treeview>
       |<#edit>
       |<#memo>
       |<#richedit>
       |<#toolbar>
       Number of items (listbox, combobox, listview) or lines (multiline
       editbox, richedit control) or buttons (toolbar). It is possible to
       assign a value to this property only for listbox control with loNoData
       style and for list view control with lvoOwnerData style (virtual list
       box and list view). }

    property Items[ Idx: Integer ]: KOLString read GetItems write SetItems;
    {* |<#edit>
       |<#listbox>
       |<#combo>
       |<#memo>
       |<#richedit>
       Obvious. Used with editboxes, listbox, combobox. With list view, use
       property LVItems instead. }

    function Item2Pos( ItemIdx: Integer ): DWORD;
    {* |<#edit>
       |<#memo>
       Only for edit controls: converts line index to character position. }
    function Pos2Item( Pos: Integer ): DWORD;
    {* |<#edit>
       |<#memo>
       Only for edit controls: converts character position to line index. }

    function SavePosition: TEditPositions;
    {* |<#edit>
       |<#memo>
       Only for edit controls: saves current editor selection and scroll
       positions. To restore position, use RestorePosition with a structure,
       containing saved position as a parameter. }
    procedure RestorePosition( const p: TEditPositions );
    {* |<#edit>
       |<#memo>
       Call RestorePosition with a structure, containing saved position
       as a parameter (this structure filled in in SavePosition method).
       If you set RestoreScroll to FALSE, only selection is restored,
       without scroll position. }
    procedure UpdatePosition( var p: TEditPositions; FromPos,
              CountInsertDelChars, CountInsertDelLines: Integer );
    {* |<#edit>
       |<#memo>
       If you called SavePosition and then make some changes in the edit control,
       calling RestorePosition will fail if chages are affecting selection size.
       The problem can be solved updating saved position info using this method.
       Pass a count of inserted characters and lines as a positive number and a
       count of deleted characters as a negative number here. CountInsertDelLines
       is optional paramters: if you do not specify it, only selection is fixed.
    }

    function EditTabChar: PControl;
    {* |<#edit>
       |<#memo>
       Call this method (once) to provide insertion of tab character (code #9)
       when tab key is pressed on keyboard. }

    function IndexOf( const S: KOLString ): Integer;
    {* |<#listbox>
       |<#combobox>
       |<#tabcontrol>
       Works for the most of control types, though some of those
       have its own methods to search given item. If a control is not
       list box or combobox, item is finding by enumerating all
       the Items one by one. See also SearchFor method. }
    function SearchFor( const S: KOLString; StartAfter: Integer; Partial: Boolean ): Integer;
    {* |<#listbox>
       |<#combobox>
       |<#tabcontrol>
       Works for the most of control types, though some of those
       have its own methods to search given item. If a control is not
       list box or combobox, item is finding by enumerating all
       the Items one by one. See also IndexOf method. }

    property ItemSelected[ ItemIdx: Integer ]: Boolean read GetItemSelected write SetItemSelected;
    {* |<#edit>
       |<#memo>
       |<#listbox>
       |<#combo>
       |<#listview>
       Returns True, if a line (in editbox) or an item (in listbox, combobox,
       listview) is selected.
       Can be set only for listboxes. For listboxes, which are not multiselect, and
       for combo lists, it is possible only to set to True, to change selection. }

    property ItemData[ Idx: Integer ]: DWORD read GetItemData write SetItemData;
    {* |<#listbox>
       |<#combo>
       Access to user-defined data, associated with the item of a list box and
       combo box. }
    property OnDropDown: TOnEvent index idx_FOnDropDown
             read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnDropDown {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnDropDown {$ENDIF};
    {* |<#combo>
       |<#toolbar>
       Is called when combobox is dropped down (or drop-down button of
       toolbar is pressed - see also OnTBDropDown). }
    property OnCloseUp: TOnEvent index idx_FOnCloseUp
             read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnCloseUp {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnCloseUp {$ENDIF};
    {* |<#combo>
       Is called when combobox is closed up. When drop down list is closed
       because user pressed "Escape" key, previous selection is restored.
       To test if it is so, call GetKeyState( VK_ESCAPE ) and check, if
       negative value is returned (i.e. Escape key is pressed when event
       handler is calling). }
    property DroppedWidth: Integer read DF.FDroppedWidth write SetDroppedWidth;
    {* |<#combo>
       Allows to change width of dropped down items list for combobox (only!)
       control. }
    property DroppedDown: Boolean read GetDroppedDown write SetDroppedDown;
    {* |<#combo>
       Dropped down state for combo box. Set it to TRUE or FALSE to change
       dropped down state. }
    procedure AddDirList( const Filemask: KOLString; Attrs: DWORD );
    {* |<#listbox>
       |<#combo>
       Can be used only with listbox and combobox - to add directory list items,
       filtered by given Filemask (can contain wildcards) and Attrs. Following
       flags can be combined in Attrs:
       |<table border=0>
       |&L=<tr><td>%1</td><td>
       <L DDL_ARCHIVE> Include archived files. <E>
       <L DDL_DIRECTORY> Includes subdirectories. Subdirectory names are
          enclosed in square brackets ([ ]). <E>
       <L DDL_DRIVES> Includes drives. Drives are listed in the form [-x-],
          where x is the drive letter. <E>
       <L DDL_EXCLUSIVE> Includes only files with the specified attributes.
          By default, read-write files are listed even if DDL_READWRITE is
          not specified. Also, this flag needed to list directories only,
          etc. <E>
       <L DDL_HIDDEN> Includes hidden files. <E>
       <L DDL_READONLY> Includes read-only files. <E>
       <L DDL_READWRITE> Includes read-write files with no additional
          attributes. <E>
       <L DDL_SYSTEM> Includes system files. <E>
       </table>
       If the listbox is sorted, directory items will be sorted (alpabetically). }
    property OnBitBtnDraw: TOnBitBtnDraw
             read {$IFDEF EVENTS_DYNAMIC} Get_OnBitBtnDraw {$ELSE} EV.fOnBitBtnDraw {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnBitBtnDraw {$ELSE} EV.fOnBitBtnDraw {$ENDIF};
    {* |<#bitbtn>
       Special event for BitBtn. Using it, it is possible to provide
       additional effects, such as highlighting button text (by changing
       its Font and other properties). If the handler returns True, it is
       supposed that it made all drawing and there are no further drawing
       occure. }
    property BitBtnDrawMnemonic: Boolean read DF.fBitBtnDrawMnemonic write SetBitBtnDrawMnemonic;
    {* |<#bitbtn>
       Set this property to TRUE to provide correct drawing of bit btn control
       caption with '&' characters (to remove such characters, and underline
       follow ones). }
    property TextShiftX: Integer read DF.fTextShiftX write DF.fTextShiftX;
    {* |<#bitbtn>
       Horizontal shift for bitbtn text when the bitbtn is pressed. }
    property TextShiftY: Integer read DF.fTextShiftY write DF.fTextShiftY;
    {* |<#bitbtn>
       Vertical shift for bitbtn text when the bitbtn is pressed. }
    property BitBtnImgIdx: Integer read GetBitBtnImgIdx write SetBitBtnImgIdx;
    {* |<#bitbtn>
       BitBtn image index for the first image in list view, used as bitbtn
       image. It is used only in case when BitBtn is created with bboImageList
       option. }
    property BitBtnImgList: THandle read GetBitBtnImageList write SetBitBtnImageList;
    {* |<#bitbtn>
       BitBtn Image list. Assign image list handle to change it. }

    function SetButtonIcon( aIcon: HIcon ): PControl;
    {* |<#button>
       Sets up button icon image and changes its styles. Returns button itself. }
    function SetButtonBitmap( aBmp: HBitmap ): PControl;
    {* |<#button>
       Sets up button icon image and changes its styles. Returns button itself. }

    property OnMeasureItem: TOnMeasureItem
             read {$IFDEF EVENTS_DYNAMIC} Get_OnMeasureItem {$ELSE} EV.fOnMeasureItem {$ENDIF}
             write SetOnMeasureItem;
    {* |<#combo>
       |<#listbox>
       |<#listview>
       This event is called for owner-drawn controls, such as list box, combo box,
       list view with appropriate owner-drawn style. For fixed item height controls
       (list box with loOwnerDrawFixed style, combobox with coOwnerDrawFixed and
       list view with lvoOwnerDrawFixed option) this event is called once. For
       list box with loOwnerDrawVariable style and for combobox with coOwnerDrawVariable
       style this event is called for every item. }

    property DefaultBtn: Boolean index 13
             {$IFDEF F_P}   read GetDefaultBtn
             {$ELSE DELPHI} read {$IFDEF USE_FLAGS} GetDefaultBtn {$ELSE} fDefaultBtn {$ENDIF}
             {$ENDIF F_P/DELPHI} write SetDefaultBtn;
    {* |<#button>
       |<#bitbtn>
       Set this property to true to make control clicked when ENTER key is pressed.
       This property uses OnMessage event of the parent form, storing it into
       fOldOnMessage field and calling in chain. So, assign default button
       after setting OnMessage event for the form. }
    property CancelBtn: Boolean index 27
             {$IFDEF F_P}   read GetDefaultBtn
             {$ELSE DELPHI} read {$IFDEF USE_FLAGS} GetDefaultBtn {$ELSE} fCancelBtn {$ENDIF}
             {$ENDIF F_P/DELPHI} write SetDefaultBtn;
    {* |<#button>
       |<#bitbtn>
       Set this property to true to make control clicked when escape key is pressed.
       This property uses OnMessage event of the parent form, storing it into
       fOldOnMessage field and calling in chain. So, assign cancel button
       after setting OnMessage event for the form. }
    function AllBtnReturnClick: PControl;
    {* Call this method for a form or control to provide clicking
       a focused button when ENTER pressed. By default, a button can be clicked
       only by SPACE key from the keyboard, or by mouse. }
    property IgnoreDefault: Boolean
             read {$IFDEF USE_FLAGS} GetIgnoreDefault {$ELSE} fIgnoreDefault {$ENDIF}
             write {$IFDEF USE_FLAGS} SetIgnoreDefault {$ELSE} fIgnoreDefault {$ENDIF};
    {* Change this property to TRUE to ignore default button reaction on
       press ENTER key when a focus is grabbed of the control. Default
       value is different for different controls. By default, DefaultBtn
       ignored in memo, richedit (even if read-only). }

    {$ENDIF GDI}
    property Color: TColor read fColor write SetCtlColor;
    {* Property Color is one of the most common for all visual
       elements (like form, control etc.) Please note, that standard GUI button
       can not change its color and the most characteristics of the Font. Also,
       standard button can not become Transparent. Use bitbtn for such purposes.
       Also, changing Color property for some kinds of control has no effect (rich edit,
       list view, tree view, etc.). To solve this, use native (for such controls)
       color property, or call Perform method with appropriate message to set the
       background color. }
    property Font: PGraphicTool read GetFont;
    {* If the Font property is not accessed, correspondent TGraphicTool object
       is not created and its methods are not included into executable. Leaving
       properties Font and Brush untouched can economy executable size a lot. }
    {$IFDEF GDI}
    property Brush: PGraphicTool read GetBrush;
    {* If not accessed, correspondent TGraphicTool object is not created
       and its methods are not referenced. See also note on Font property. }

    property Ctl3D: Boolean read Get_Ctl3D write SetCtl3D;
    {* Inheritable from parent controls to child ones. }

    procedure Show;
    {* |<#appbutton>
       |<#form>
       Makes control visible and activates it. }
    function ShowModal: Integer;
    {* |<#form>
       Can be used only with a forms to show it modal. See also global function
       ShowMsgModal.
       |<br>
       To use a form as a modal, it is possible to make it either auto-created
       or dynamically created. For a first case, You (may be prefer to hide a
       form after showing it as a modal:
       !
       !  procedure TForm1.Button1Click( Sender: PObj );
       !  begin
       !    Form2.Form.ShowModal;
       !    Form2.Form.Hide;
       !  end;
       !
       Another way is to create modal form just before showing it (this economies
       system resources):
       !
       !  procedure TForm1.Button1Click( Sender: PObj );
       !  begin
       !    NewForm2( Form2, Applet );
       !    Form2.Form.ShowModal;
       !    Form2.Form.Free; // Never call Form2.Free or Form2.Form.Close
       !  end;               // but always Form2.Form.Free; (!)
       !
       In samples above, You certainly can place any wished code before and after
       calling ShowModal method.
       |<br>
       Do not forget that if You have more than a single form in your project,
       separate Applet object should be used.
       |<br>
       See also ShowModalEx.
       }
    function ShowModalParented( const AParent: PControl ): Integer;
    {* by Alexander Pravdin. The same as ShowModal, but with a certain
       form as a parent. }
    function ShowModalEx: Integer;
    {* The same as ShowModal, but all the windows of current thread are
       disabled while showing form modal. This is useful if KOL form from
       a DLL is used modally in non-KOL application. }
    property ModalResult: Integer read DF.fModalResult
             write {$IFDEF USE_SETMODALRESULT} SetModalResult {$ELSE} DF.fModalResult {$ENDIF};
    {* |<#form>
       Modal result. Set it to value<>0 to stop modal dialog. By agreement,
       value 1 corresponds 'OK', 2 - 'Cancel'. But it is totally by decision
       of yours how to interpret this value. }
    property Modal: Boolean read GetModal;
    {* |<#form>
       TRUE, if the form is shown modal. }
    property ModalForm: PControl read DF.fModalForm write DF.fModalForm;
    {* |<#form>
       |<#appbutton>
       Form currently shown modal from this form or from Applet. }

    procedure Hide;
    {* |<#appbutton>
       |<#form>
       Makes control hidden. }
    property OnShow: TOnEvent
             read {$IFDEF EVENTS_DYNAMIC} Get_OnShow {$ELSE} EV.FOnShow {$ENDIF}
             write SetOnShow;
    {* Is called when a control or form is to be shown. This event is not fired
       for a form, if its WindowState initially is set to wsMaximized or
       wsMinimized. This behaviour is by design (the window does not receive
       WM_SHOW message in such case). }
    property OnHide: TOnEvent
             read {$IFDEF EVENTS_DYNAMIC} Get_OnHide {$ELSE} EV.FOnHide {$ENDIF}
             write SetOnHide;
    {* Is called when a control or form becomes hidden. }
    property WindowState: TWindowState read GetWindowState write SetWindowState;
    {* |<#form>
       Window state. }

    {$ENDIF GDI}
    property Canvas: PCanvas read GetCanvas;
    {* |<#paintbox>
       Placeholder for Canvas: PCanvas. But in KOL, it is possible to
       create applets without canvases at all. To do so, avoid using
       Canvas and use DC directly (which is passed in OnPaint event). }
    {$IFDEF GDI}
    function CallDefWndProc( var Msg: TMsg ): Integer;
    {* Function to be called in WndProc method to redirect message handling
       to default window procedure. }
    function DoSetFocus: Boolean;
    {* Sets focus for Enabled window. Returns True, if success. }

    procedure MinimizeNormalAnimated;
    {* |<#form>
       Apply this method to a main form (not to another form or Applet,
       even when separate Applet control is not used and main form matches it!).
       This provides normal animated visual minimization for the application.
       It therefore has no effect, if animation during minimize/resore is
       turned off by user.
       |<br>
       Applying this method also provides for the main form (only for it)
       correct restoring the form maximized if it was maximized while
       minimizing the application. See also RestoreNormalMaximized method. }
    procedure RestoreNormalMaximized;
    {* |<#form>
       Apply to any form for which it is important to restore it maximized
       when the application was minimizing while such form was maximized.
       If the method MinimizeNormalAnimated was called for the main form,
       then the correct behaviour is already provided for the main form, so
       in such case it is no more necessary to call also this method, but
       calling it therefore is not an error. }

    property OnMessage: TOnMessage
             read {$IFDEF EVENTS_DYNAMIC} Get_OnMessage {$ELSE} EV.fOnMessage {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnMessage {$ELSE} EV.fOnMessage {$ENDIF};
    {* |<#appbutton>
       |<#form>
       Is called for every message processed by TControl object. And for
       Applet window, this event is called also for all messages, handled by
       all its child windows (forms). }

    {$ENDIF GDI}
    function IsMainWindow: Boolean;
    {* |<#appbutton>
       |<#form>
       Returns True, if a window is the main in application (created first
       after the Applet, or matches the Applet). }
    property IsApplet: Boolean read {$IFDEF USE_FLAGS} GetIsApplet {$ELSE} FIsApplet {$ENDIF};
    {* Returns true, if the control is created using NewApplet (or CreateApplet).
    }
    property IsForm: Boolean read {$IFDEF USE_FLAGS} GetIsForm {$ELSE} fIsForm {$ENDIF};
    {* Returns True, if the object is form window. }
    property IsMDIChild: Boolean read {$IFDEF USE_FLAGS} GetIsMDIChild {$ELSE} fIsMDIChild {$ENDIF};
    {* Returns TRUE, if the object is MDI child form. In such case, IsForm also
       returns TRUE. }
    property IsControl: Boolean read {$IFDEF USE_FLAGS} GetIsControl {$ELSE} fIsControl {$ENDIF};
    {* Returns True, is the control is control (not form or applet). }
    property IsButton: Boolean read {$IFDEF USE_FLAGS} GetIsButton {$ELSE} fIsButton {$ENDIF};
    {* Returns True, if the control is button-like or containing buttons (button,
       bitbtn, checkbox, radiobox, toolbar). }

    {$IFDEF GDI}
    function ProcessMessage: Boolean;
    {* |<#appbutton>
       Processes one message. See also ProcessMessages. }

    procedure ProcessMessages;
    {* |<#appbutton>
       Processes pending messages during long cycle of calculation,
       allowing to window to be repainted if needed and to respond to other
       messages. But if there are no such messages, your application can be
       stopped until such one appear in messages queue. To prevent such
       situation, use method ProcessPendingMessages instead. }

    procedure ProcessMessagesEx;
    {* Version of ProcessMessages, which works always correctly, even if
       the application is minimized or background. }

    procedure ProcessPendingMessages;
    {* |<#appbutton>
       Similar to ProcessMessages, but without waiting of
       message in messages queue. I.e., if there are no pending
       messages, this method immediately returns control to your
       code. This method is better to call during long cycle of
       calculation (then ProcessMessages). }
    procedure ProcessPaintMessages;
    {* }
    function WndProc( var Msg: TMsg ): Integer; virtual; //{$IFNDEF DEBUG_MCK} virtual; {$ENDIF}
    {* Responds to all Windows messages, posted (sended) to the
       window, before all other proceeding. You can override it in
       derived controls, but in KOL there are several other ways
       to control message flow of existing controls without deriving
       another costom controls for only such purposes. See OnMessage,
       AttachProc.  }
    property HasBorder: Boolean read GetHasBorder write SetHasBorder;
    {* |<#form>
       Obvious. Form-aware. }

    property HasCaption: Boolean read GetHasCaption write SetHasCaption;
    {* |<#form>
       Obvious. Form-aware. }
    property CanResize: Boolean read GetCanResize write SetCanResize;
    {* |<#form>
       Obvious. Form-aware. }
    property StayOnTop: Boolean read GetStayOnTop write SetStayOnTop;
    {* |<#form>
       Obvious. Form-aware, but can be applied to controls. }
    property Border: ShortInt read fMargin write fMargin;
    {* |<#form>
       Distance between edges and child controls and between child
       controls by default (if methods PlaceRight, PlaceDown, PlaceUnder,
       ResizeParent, ResizeParentRight, ResizeParentBottom are called).
       |<br>
       Originally was named Margin, now I recommend to use the name 'Border' to
       avoid confusion with MarginTop, MarginBottom, MarginLeft and
       MarginRight properties.
       |<br>
       Initial value is always 2. Border property is used in realigning
       child controls (when its Align property is not caNone), and value
       of this property determines size of borders between edges of children
       and its parent and between aligned controls too.
       |<br>
       See also properties MarginLeft, MarginRight, MarginTop, MarginBottom. }
    function SetBorder( Value: Integer ): PControl;
    {* Assigns new Border value, and returns @ Self. }

    property Margin: ShortInt read fMargin write fMargin;
    {* |<#form>
       Old name for property Border. }

    property MarginTop: ShortInt index 1
             {$IFDEF F_P}   read GetClientMargin
             {$ELSE DELPHI} read fClientTop
             {$ENDIF F_P/DELPHI} write SetClientMargin;
    {* Additional distance between true window client top and logical top of
       client rectangle. This value is added to Top of rectangle, returning
       by property ClientRect. Together with other margins and property Border,
       this property allows to change view of form for case, that Align property
       is used to align controls on parent (it is possible to provide some
       distance from child controls to its parent, and between child controls.
       |<br>
       Originally this property was introduced to compensate incorrect
       ClientRect property, calculated for some types of controls.
       |<br>
       See also properties Border, MarginBottom, MarginLeft, MarginRight. }
    property MarginBottom: ShortInt index 2
             {$IFDEF F_P}   read GetClientMargin
             {$ELSE DELPHI} read fClientBottom
             {$ENDIF F_P/DELPHI} write SetClientMargin;
    {* The same as MarginTop, but a distance between true window Bottom of
       client rectangle and logical bottom one. Take in attention, that this value
       should be POSITIVE to make logical bottom edge located above true edge.
       |<br>
       See also properties Border, MarginTop, MarginLeft, MarginRight. }
    property MarginLeft: ShortInt index 3
             {$IFDEF F_P}   read GetClientMargin
             {$ELSE DELPHI} read fClientLeft
             {$ENDIF F_P/DELPHI} write SetClientMargin;
    {* The same as MarginTop, but a distance between true window Left of
       client rectangle and logical left edge.
       |<br>
       See also properties Border, MarginTop, MarginRight, MarginBottom. }
    property MarginRight: ShortInt index 4
             {$IFDEF F_P}   read GetClientMargin
             {$ELSE DELPHI} read fClientRight
             {$ENDIF F_P/DELPHI} write SetClientMargin;
    {* The same as MarginLeft, but a distance between true window Right of
       client rectangle and logical bottom one. Take in attention, that this value
       should be POSITIVE to make logical right edge located left of true edge.
       |<br>
       See also properties Border, MarginTop, MarginLeft, MarginBottom. }

    property Tabstop: Boolean
             {$IFDEF USE_FLAGS}
             read GetTabStop write SetTabStop
             {$ELSE}
             read fTabstop write fTabstop
             {$ENDIF}
             ;
    {* True, if control can be focused using tabulating between controls.
       Set it to False to make control unavailable for keyboard, but only
       for mouse. }

    property TabOrder: SmallInt read fTabOrder write SetTabOrder;
    {* Order of tabulating of controls. Initially, TabOrder is equal to
       creation order of controls. If TabOrder changed, TabOrder of
       all controls with not less value of one is shifted up. To place
       control before another, assign TabOrder of one to another.
       For example:
       !             Button1.TabOrder := EditBox1.TabOrder;
       In code above, Button1 is placed just before EditBox1 in tabulating
       order (value of TabOrder of EditBox1 is incremented, as well as
       for all follow controls). }

    property Focused: Boolean read GetFocused write SetFocused;
    {* True, if the control is current on form (but check also, what form
       itself is focused). For form it is True, if the form is active (i.e.
       it is foreground and capture keyboard). Set this value to True to make
       control current and focused (if applicable). }

    function BringToFront: PControl;
    {* Changes z-order of the control, bringing it to the topmost level. }
    function SendToBack: PControl;
    {* Changes z-order of the control, sending it to the back of siblings. }
    {$ENDIF GDI}
    property TextAlign: TTextAlign read GetTextAlign write SetTextAlign;
    {* |<#label>
       |<#panel>
       |<#button>
       |<#bitbtn>
       |<#edit>
       |<#memo>
       Text horizontal alignment. Applicable to labels, buttons,
       multi-line edit boxes, panels. }
    property VerticalAlign: TVerticalAlign read GetVerticalAlign write SetVerticalAlign;
    {* |<#button>
       |<#label>
       |<#panel>
       Text vertical alignment. Applicable to buttons, labels and panels. }
    {$IFDEF GDI}
    property WordWrap: Boolean
             {$IFDEF USE_FLAGS}
             read GetWordWrap write SetWordWrap
             {$ELSE}
             read fWordWrap write fWordWrap
             {$ENDIF USE_FLAGS};
    {* TRUE, if this is a label, created using NewWordWrapLabel. }
    property ShadowDeep: Integer read DF.FShadowDeep write SetShadowDeep;
    {* |<#3dlabel>
       Deep of a shadow (for label effect only, created calling NewLabelEffect). }

    property CannotDoubleBuf: Boolean
             {$IFDEF USE_FLAGS}
             read GetCannotDoubleBuf write SetCannotDoubleBuf
             {$ELSE}
             read fCannotDoubleBuf write fCannotDoubleBuf
             {$ENDIF};
    {* }
    property DoubleBuffered: Boolean
             read {$IFDEF USE_FLAGS} GetDoubleBuffered
                  {$ELSE} fDoubleBuffered {$ENDIF}
             write SetDoubleBuffered;
    {* Set it to true for some controls, which are flickering in repainting
       (like label effect). Slow, and requires additional code. This property
       is inherited by all child controls.
       |<br>&nbsp;&nbsp;&nbsp;
       Note: RichEdit control can not become DoubleBuffered. }
    function DblBufTopParent: PControl;
    {* Returns the topmost DoubleBuffered Parent control. }
    property Transparent: Boolean
             read {$IFDEF USE_FLAGS} GetTransparent {$ELSE} fTransparent {$ENDIF}
             write SetTransparent;
    {* Set it to true to get special effects. Transparency also uses
       DoubleBuffered and inherited by child controls.
       |<br>&nbsp;&nbsp;&nbsp;
       Please note, that some controls can not be shown properly, when
       Transparent is set to True for it. If You want to make edit control
       transparent (e.g., over gradient filled panel), handle its OnChanged
       property and call there Invalidate to provide repainting of edit
       control content. Note also, that for RichEdit control property
       Transparent has no effect (as well as DoubleBuffered). But special
       property RE_Transparent is designed especially for RichEdit control
       (it works fine, but with great number of flicks while resizing
       of a control). Another note is about Edit control. To allow editing
       of transparent edit box, it is necessary to invalidate it for
       every pressed character. Or, use Ed_Transparent property instead. }
    property Ed_Transparent: Boolean
             read {$IFDEF USE_FLAGS} GetTransparent {$ELSE} fTransparent {$ENDIF}
             write EdSetTransparent;
    {* |<#edit>
       |<#memo>
       Use this property for editbox to make it really Transparent. Remember,
       that though Transparent property is inherited by child controls from
       its parent, this is not so for Ed_Transparent. So, it is necessary to
       set Ed_Transparent to True for every edit control explicitly. }
    property AlphaBlend: Byte read fAlphaBlend write SetAlphaBlend;
    {* |<#form>
       If assigned to 0..254, makes window (form or control) semi-transparent
       (Win2K only).
       |<br>
       Depending on value assigned, it is possible to adjust transparency
       level ( 0 - totally transparent, 255 - totally opaque).
       |<br>Note: from XP, any control can be alpha blended! }
    function MouseTransparent: PControl;
    {* Call this method to set up mouse transparent control (which always
       returns HTTRANSPARENT in responce to WM_NCHITTEST). This function
       returns a pointer to a control itself. }

    property LookTabKeys: TTabKeys read fLookTabKeys write fLookTabKeys;
    {* Set of keys which can be used as tabulation keys in a control. }
    procedure GotoControl( Key: DWORD );
    {* |<#form>
       Emulates tabulation key press w/o sending message to current control.
       Can be applied to a form or to any its control. If VK_TAB is used,
       state of shift kay is checked in: if it is pressed, tabulate is in
       backward direction. }
    property SubClassName: KOLString read get_ClassName write set_ClassName;
    {* Name of window class - unique for every window class
       in every run session of a program. }

  public
    procedure SetOnClose( const AOnClose: TOnEventAccept );
    procedure SetFormOnClick( const AOnClick: TOnEvent );
  public
    property OnClose: TOnEventAccept
             read {$IFDEF EVENTS_DYNAMIC} Get_OnClose {$ELSE} EV.fOnClose {$ENDIF}
             write SetOnClose;
    {* |<#form>
       |<#applet>
       Called before closing the window. It is possible to set Accept
       parameter to False to prevent closing the window. This event events
       is not called when windows session is finishing (to handle this
       event, handle WM_QUERYENDSESSION message, or assign OnQueryEndSession
       event to another or the same event handler). }

    property OnQueryEndSession: TOnEventAccept
             read {$IFDEF EVENTS_DYNAMIC} Get_OnQueryEndSession {$ELSE} EV.fOnQueryEndSession {$ENDIF}
             write SetOnQueryEndSession;
    {* |<#form>
       |<#applet>
       Called when WM_QUERYENDSESSION message come in. It is possible to set Accept
       parameter to False to prevent closing the window (in such case session ending
       is halted). It is possible to check CloseQueryReason property to find out,
       why event occur.
       |<br>
       To provide normal application close while handling OnQueryEndSession,
       call in your code PostQuitMessage( 0 ) or call method Close for the main form,
       this is enough to provide all OnClose and OnDestroy handlers to be called. }
    property CloseQueryReason: TCloseQueryReason read DF.fCloseQueryReason;
    {* Reason why OnClose or OnQueryEndSession called. }
    property OnMinimize: TOnEvent index 0 read
             {$IFDEF F_P} GetOnMinMaxRestore {$ELSE DELPHI}
                 {$IFDEF EVENTS_DYNAMIC} GetOnMinMaxRestore
                 {$ELSE} EV.fOnMinimize {$ENDIF}
             {$ENDIF F_P/DELPHI} write SetOnMinMaxRestore;
    {* |<#form>
       Called when window is minimized. }
    property OnMaximize: TOnEvent index 8 read
             {$IFDEF F_P}   GetOnMinMaxRestore {$ELSE DELPHI}
                 {$IFDEF EVENTS_DYNAMIC} GetOnMinMaxRestore
                 {$ELSE} EV.fOnMaximize {$ENDIF}
             {$ENDIF F_P/DELPHI} write SetOnMinMaxRestore;
    {* |<#form>
       Called when window is maximized. }
    property OnRestore: TOnEvent index 16 read
             {$IFDEF F_P}   GetOnMinMaxRestore {$ELSE DELPHI}
                 {$IFDEF EVENTS_DYNAMIC} GetOnMinMaxRestore
                 {$ELSE} EV.fOnMaximize {$ENDIF}
             {$ENDIF F_P/DELPHI} write SetOnMinMaxRestore;
    {* |<#form>
       Called when window is restored from minimized or maximized state. }

    property UpdateRgn: HRgn read fUpdRgn;
    {* A handle of update region. Valid only in OnPaint method. You
       can use it to improve painting (for speed), if necessary. When
       UpdateRgn is obtained in response to WM_PAINT message, value
       of the property EraseBackground is used to pass it to the API
       function GetUpdateRgn. If UpdateRgn = 0, this means that entire
       window should be repainted. Otherwise, You (e.g.) can check
       if the rectangle is in clipping region using API function
       RectInRegion. }

    property EraseBackground: Boolean
             read {$IFDEF USE_FLAGS} GetEraseBackground {$ELSE} fEraseUpdRgn {$ENDIF}
             write {$IFDEF USE_FLAGS} SetEraseBackground {$ELSE} fEraseUpdRgn {$ENDIF};
    {* This value is used to pass it to the API function GetUpdateRgn,
       when UpadateRgn property is obtained first in responce to WM_PAINT
       message. If EraseBackground is set to True, system is responsible
       for erasing background of update region before painting. If not
       (default), the entire region invalidated should be painted by your
       event handler. }
    {$ENDIF GDI}
    property OnPaint: TOnPaint
             read {$IFDEF EVENTS_DYNAMIC} Get_OnPaint {$ELSE} EV.fOnPaint {$ENDIF}
             write SetOnPaint;
    {* Event to set to override standard control painting. Can be applied
       to any control (though originally was designed only for paintbox
       control). When an event handler is called, it is possible to use
       UpdateRgn to examine what parts of window require painting to
       improve performance of the painting operation. }
    {$IFDEF GDI}
    property OnPrePaint: TOnPaint
             read {$IFDEF EVENTS_DYNAMIC} Get_OnPrePaint {$ELSE} EV.fOnPrePaint {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnPrePaint {$ELSE} EV.fOnPrePaint {$ENDIF};
    {* Only for graphic controls. If you assign it, call Invalidate also. }
    property OnPostPaint: TOnPaint
             read {$IFDEF EVENTS_DYNAMIC} Get_OnPostPaint {$ELSE} EV.fOnPostPaint {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnPostPaint {$ELSE} EV.fOnPostPaint {$ENDIF};
    {* Only for graphic controls. If you assign it, call Invalidate also. }

    property OnEraseBkgnd: TOnPaint
             read {$IFDEF EVENTS_DYNAMIC} Get_OnEraseBkgnd {$ELSE} EV.fOnEraseBkgnd {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnEraseBkgnd {$ELSE} SetOnEraseBkgnd {$ENDIF};
    {* This event allows to override erasing window background in response
       to WM_ERASEBKGND message. This allows to add some decorations to
       standard controls without overriding its painting in total.
       Note: When erase background, remember, that property ClientRect can
       return not true client rectangle of the window - use GetClientRect
       API function instead. For example:
    !
    !var BkBmp: HBitmap;
    !
    !procedure TForm1.KOLForm1FormCreate(Sender: PObj);
    !begin
    !  Toolbar1.OnEraseBkgnd := DecorateToolbar;
    !  BkBmp := LoadBitmap( hInstance, 'BK1' );
    !end;
    !
    !procedure TForm1.DecorateToolbar(Sender: PControl; DC: HDC);
    !var CR: TRect;
    !begin
    !  GetClientRect( Sender.Handle, CR );
    !  Sender.Canvas.Brush.BrushBitmap := BkBmp;
    !  Sender.Canvas.FillRect( CR );
    !end;
    !
     }

    {$ENDIF GDI}
    property OnClick: TOnEvent
             read {$IFDEF EVENTS_DYNAMIC} Get_OnClick {$ELSE} EV.fOnClick {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} SetOnClick {$ELSE}
      {$IFDEF GDI} EV.fOnClick
      {$ELSE  _X_} SetOnClick {$ENDIF _X_}{$ENDIF};
    {* |<#button>
       |<#checkbox>
       |<#radiobox>
       |<#toolbar>
       Called on click at control. For buttons, checkboxes and radioboxes
       is called regadless if control clicked by mouse or keyboard. For toolbar,
       the same event is used for all toolbar buttons and toolbar itself.
       To determine which toolbar button is clicked, check CurIndex property.
       And note, that all the buttons including separator buttons are enumerated
       starting from 0. Though images are stored (and prepared) only for
       non-separator buttons. And to determine, if toolbar button was clicked
       with right mouse button, check RightClick property.
       |<br>
       This event does not work on a Form, still it is fired in responce to
       WM_COMMAND window message mainly rather direct to mouse down. But, if
       you want to have OnClick event to be fired on a Form, use (following)
       property OnFormClick to assign it. }
    {$IFDEF GDI}
    property OnFormClick: TOnEvent
             read {$IFDEF EVENTS_DYNAMIC} Get_OnClick {$ELSE} EV.fOnClick {$ENDIF}
             write SetFormOnClick;
    {* |<#form>
       Assign you OnClick event handler using this property, if you want it to
       be fired in result of mouse click on a form surface. Use to assign the
       event only for forms (to avoid doublicated firing the handler).
       |<br>
       Note: for a form, in case of WM_xDOUBLECLK event, this event is fired
       for both clicks. So if you install both OnFormClick and OnMouseDblClk,
       handlers will be called in the following sequence for each double click:
       OnFormClick; OnMouseDblClk; OnFormClick. }
    property RightClick: Boolean read {$IFDEF USE_FLAGS} Get_RightClick {$ELSE} fRightClick {$ENDIF};
    {* |<#toolbar>
       |<#listview>
       Use this property to determine which mouse button was clicked
       (applicable to toolbar in the OnClick event handler). }
    property OnEnter: TOnEvent index idx_fOnEnter
             read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnEnter {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnEnter {$ENDIF};
    {* Called when control receives focus. }
    property OnLeave: TOnEvent index idx_fOnLeave
             read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnLeave {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnLeave{$ENDIF};
    {* Called when control looses focus. }
    property OnChange: TOnEvent index idx_fOnChangeCtl
             read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnChangeCtl {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnChangeCtl {$ENDIF};
    {* |<#edit>
       |<#memo>
       |<#listbox>
       |<#combo>
       |<#tabcontrol>
       Called when edit control is changed, or selection in listbox or
       current index in combobox is changed (but if OnSelChanged assigned,
       the last is called for change selection). To respond to check/uncheck
       checkbox or radiobox events, use OnClick instead. }
    property OnSelChange: TOnEvent index idx_fOnSelChange
             read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnSelChange {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnSelChange{$ENDIF};
    {* |<#richedit>
       |<#listbox>
       |<#combo>
       |<#treeview>
       Called for rich edit control, listbox, combobox or treeview when current selection
       (range, or current item) is changed. If not assigned, but OnChange is
       assigned, OnChange is called instead. }
    property OnResize: TOnEvent
             read {$IFDEF EVENTS_DYNAMIC} Get_OnResize {$ELSE} EV.FOnResize {$ENDIF}
             write SetOnResize;
    {* Called whenever control receives message WM_SIZE (thus is, if
       control is resized. }
    property OnMove: TOnEvent
             read {$IFDEF EVENTS_DYNAMIC} Get_OnMove {$ELSE} EV.FOnMove {$ENDIF}
             write SetOnMove;
    {* Called whenever control receives message WM_MOVE (i.e. when control is
       moved over its parent). }
    property OnMoving: TOnEventMoving
             read {$IFDEF EVENTS_DYNAMIC} Get_OnMoving {$ELSE} EV.FOnMoving {$ENDIF}
             write SetOnMoving;
    {* Called whenever control receives message WM_MOVE (i.e. when control is
       moved over its parent). }

    property MinSizePrev: Integer read DF.fSplitMinSize1 write DF.fSplitMinSize1;
    {* |<#splitter>
       Minimal allowed (while dragging splitter) size of previous control
       for splitter (see NewSplitter). }
    property SplitMinSize1: Integer read DF.fSplitMinSize1 write DF.fSplitMinSize1;
    {* The same as MinSizePrev }
    property MinSizeNext: Integer read DF.fSplitMinSize2 write DF.fSplitMinSize2;
    {* |<#splitter>
       Minimal allowed (while dragging splitter) size of the rest of parent
       of splitter or of SecondControl (see NewSplitter). }
    property SplitMinSize2: Integer read DF.fSplitMinSize2 write DF.fSplitMinSize2;
    {* The same as MinSizeNext. }
    property SecondControl: PControl read DF.fSecondControl write DF.fSecondControl;
    {* |<#splitter>
       Second control to check (while dragging splitter) if its size not less
       than SplitMinSize2 (see NewSplitter). By default, second control is
       not necessary, and needed only in rare case when SecondControl can not
       be determined automatically to restrict splitter right (bottom) position. }
    property OnSplit: TOnSplit
             read {$IFDEF EVENTS_DYNAMIC} Get_OnSplit {$ELSE} EV.fOnSplit {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnSplit {$ELSE} EV.fOnSplit{$ENDIF};
    {* |<#splitter>
       Called when splitter control is dragging - to allow for
       your event handler to decide if to accept new size of
       left (top) control, and new size of the rest area of parent. }
    property Dragging: Boolean read {$IFDEF USE_FLAGS} Get_Dragging {$ELSE} FDragging{$ENDIF};
    {* |<#splitter>
       True, if splitter control is dragging now by user with left
       mouse button. Also, this property can be used to detect if the control
       is dragging with mouse (after calling DragStartEx method). }
    procedure DragStart;
    {* Call this method for a form or control to drag it with left mouse button,
       when mouse left button is already down. Dragging is stopped when left mouse
       button is released. See also DragStartEx, DragStopEx. }
    procedure DragStartEx;
    {* Call this method to start dragging the form by mouse. To stop
       dragging, call DragStopEx method. (Tip: to detect mouse up event,
       use OnMouseUp event of the dragging control). This method can be used
       to move any control with the mouse, not only entire form. State of
       mouse button is not significant. Determine dragging state of the control
       checking its Dragging property. }
    procedure DragStopEx;
    {* Call this method to stop dragging the form (started by DragStopEx). }
    procedure DragItem( OnDrag: TOnDrag );
    {* Starts dragging something with mouse. During the process,
       callback function OnDrag is called, which allows to control
       drop target, change cursor shape, etc. }

    property OnKeyDown: TOnKey
             read {$IFDEF EVENTS_DYNAMIC} Get_OnKeyDown {$ELSE} EV.fOnKeyDown {$ENDIF}
             write SetOnKeyDown;
    {* Obvious. }
    property OnKeyUp: TOnKey
             read {$IFDEF EVENTS_DYNAMIC} Get_OnKeyUp {$ELSE} EV.fOnKeyUp {$ENDIF}
             write SetOnKeyUp;
    {* Obvious. }
    property OnChar: TOnChar
             read {$IFDEF EVENTS_DYNAMIC} Get_OnChar {$ELSE} EV.fOnChar {$ENDIF}
             write SetOnChar;
    {* Deprecated event, use OnKeyChar. }
    property OnKeyChar: TOnChar
             read {$IFDEF EVENTS_DYNAMIC} Get_OnChar {$ELSE} EV.fOnChar {$ENDIF}
             write SetOnChar;
    {* Obviuos. }
    {$IFDEF SUPPORT_ONDEADCHAR}
    property OnKeyDeadChar: TOnChar
             read {$IFDEF EVENTS_DYNAMIC} Get_OnDeadChar {$ELSE} EV.fOnDeadChar {$ENDIF}
             write SetOnDeadChar;
    {* Obviuos. }
    {$ENDIF SUPPORT_ONDEADCHAR}

    {$ENDIF GDI}
    property OnMouseUp: TOnMouse index idx_fOnMouseUp
             read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEvent {$ELSE} EV.fOnMouseUp {$ENDIF}
             write SetOnMouseEvent;
    {* Obvious. }
    property OnMouseDown: TOnMouse index idx_fOnMouseDown
             read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEvent {$ELSE} EV.fOnMouseDown {$ENDIF}
             write SetOnMouseEvent;
    {* Obvious. }
    property OnMouseMove: TOnMouse index idx_fOnMouseMove
             read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEvent {$ELSE} EV.fOnMouseMove {$ENDIF}
             write SetOnMouseEvent;
    {* Obvious. }
    property OnMouseDblClk: TOnMouse index idx_fOnMouseDblClk
             read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEvent {$ELSE} EV.fOnMouseDblClk {$ENDIF}
             write SetOnMouseEvent;
    {* Obvious. }
    property ThreeButtonPress: Boolean
        read {$IFDEF USE_FLAGS} Get3ButtonPress {$ELSE} f3ButtonPress {$ENDIF};
    {* GDK (*nix) only. TRUE, if 3 button press detected. Check this flag in
       OnMouseDblClk event handler. If 3rd button click is done for a short
       period of time after the double click, the control receives OnMouseDblClk
       the second time and this flag is set. (Applicable to the GDK and other
       Linux systems). }
    property OnMouseWheel: TOnMouse index idx_fOnMouseWheel
             read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEvent {$ELSE} EV.fOnMouseWheel {$ENDIF}
             write SetOnMouseEvent;
    {* Mouse wheel (up or down) event. In Windows, only focused controls and
       controls having scrollbars (or a scrollbar iteself) receive such
       message. To get direction and amount of wheel, use typecast:
       SmallInt( HiWord( Mouse.Shift ) ). Value 120 corresponds to one wheel
       step (-120 - for step back). }
    {$IFDEF GDI}

    property OnMouseEnter: TOnEvent
             read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEnter {$ELSE} EV.fOnMouseEnter {$ENDIF}
             write SetOnMouseEnter;
    {* Is called when mouse is entered into control. See also OnMouseLeave. }
    property OnMouseLeave: TOnEvent
             read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseLeave {$ELSE} EV.fOnMouseLeave {$ENDIF}
             write SetOnMouseLeave;
    {* Is called when mouse is leaved control. If this event is assigned,
       then mouse is captured on mouse enter event to handle all other
       mouse events until mouse cursor leaves the control. }
    property OnTestMouseOver: TOnTestMouseOver
             read {$IFDEF EVENTS_DYNAMIC} Get_OnTestMouseOver {$ELSE} EV.fOnTestMouseOver {$ENDIF}
             write SetOnTestMouseOver;
    {* |<#bitbtn>
       Special event, which allows to extend OnMouseEnter / OnMouseLeave
       (and also Flat property for BitBtn control). If a handler is assigned
       to this event, actual testing whether mouse is in control or not,
       is occuring in the handler. So, it is possible to simulate more
       careful hot tracking for controls with non-rectangular shape (such
       as glyphed BitBtn control). }

    property MouseInControl: Boolean
             read {$IFDEF USE_FLAGS} GetMouseInCtl {$ELSE} fMouseInControl {$ENDIF};
    {* |<#bitbtn>
       This property can return True only if OnMouseEnter / OnMouseLeave
       event handlers are set for a control (or, for BitBtn, property Flat
       is set to True. Otherwise, False is returned always. }

    property Flat: Boolean read {$IFDEF USE_FLAGS} GetFlat {$ELSE} fFlat {$ENDIF}
                           write SetFlat;
    {* |<#bitbtn>
       Set it to True for BitBtn, to provide either flat border for a button
       or availability of "highlighting" (correspondent to glyph index 4).
       |<br>
       Note: this can work incorrectly a bit under win95 without comctl32.dll
       updated. Therefore, application will launch. To enforce correct working
       even under Win95, use your own timer, which event handler checks for
       mouse over bitbtn control, e.g.:
       !    procedure TForm1.Timer1Timer(Sender: PObj);
       !    var P: TPoint;
       !    begin
       !      if not BitBtn1.MouseInControl then Exit;
       !      GetCursorPos( P );
       !      P := BitBtn1.Screen2Client( P );
       !      if not PtInRect( BitBtn1.ClientRect, P ) then
       !      begin
       !        BitBtn1.Flat := FALSE;
       !        BitBtn1.Flat := TRUE;
       !      end;
       !    end;
    }
    property RepeatInterval: Integer read DF.fRepeatInterval write DF.fRepeatInterval;
    {* |<#bitbtn>
       If this property is set to non-zero, it is interpreted (for BitBtn
       only) as an interval in milliseconds between repeat button down events,
       which are generated after first mouse or button click and until
       button is released. Though, if the button is pressed with keyboard (with
       space key), RepeatInterval value is ignored and frequency of repeatitive
       clicking is determined by user keyboard settings only. }
    function LikeSpeedButton: PControl;
    {* |<#button>
       |<#bitbtn>
       Transparent method (returns control itself). Makes button not focusable. }

    function Add( const S: KOLString ): Integer;
    {* |<#listbox>
       |<#combo>
       Only for listbox and combobox. }

    function Insert( Idx: Integer; const S: KOLString ): Integer;
    {* |<#listbox>
       |<#combo>
       Only for listbox and combobox. }
    procedure Delete( Idx: Integer );
    {* |<#listbox>
       |<#combo>
       |<#listview>
       |<#treeview>
       Only listed controls. }
    procedure Clear;
    {* Clears object content. Has different sense for different controls.
       E.g., for label, editbox, button and other simple controls it
       assigns empty string to Caption property. For listbox, combobox,
       listview it deletes all items. For toolbar, it deletes all buttons.
       Et so on. }

    property Progress: Integer index ((PBM_SETPOS or $8000) shl 16) or PBM_GETPOS
                               read GetIntVal write SetIntVal;
    {* |<#progressbar>
       Only for ProgressBar. }
    property MaxProgress: Integer index ((PBM_SETRANGE32 or $8000) shl 16) or PBM_GETRANGE
                               read GetIntVal write SetMaxProgress;
    {* |<#progressbar>
       Only for ProgressBar. 100 is the default value. }
    property ProgressColor: TColor read fTextColor write SetProgressColor;
    {* |<#progressbar>
       Only for ProgressBar. }
    property ProgressBkColor: TColor read fColor write SetCtlColor; //SetProgressBkColor;
    {* |<#progressbar>
       Obsolete. Now the same as Color. }

    property StatusText[ Idx: Integer ]: KOLString read GetStatusText write SetStatusText;
    {* |<#form>
       Only for forms to set/retrieve status text to/from given status panel.
       Panels are enumerated from 0 to 254, 255 is to indicate simple
       status bar. Size grip in right bottom corner of status window is
       displayed only if form still CanResize.
       |<br>
       When a status text is set first time, status bar window is created
       (always aligned to bottom), and form is resizing to preset client height.
       While status bar is showing, client height value is returned without
       height of status bar. To remove status bar, call RemoveStatus method for
       a form.
       |<br>
       By default, text is left-aligned within the specified part of a status
       window. You can embed tab characters (#9) in the text to center or
       right-align it. Text to the right of a single tab character is centered,
       and text to the right of a second tab character is right-aligned.
       |<br>
       If You use separate status bar onto several panels, these automatically
       align its widths to the same value (width divided to number of panels).
       To adjust status panel widths for every panel, use property StatusPanelRightX.
    }
    property SimpleStatusText: KOLString index 255 read GetStatusText write SetStatusText;
    {* |<#form>
       Only for forms to set/retrive status text to/from simple status bar.
       Size grip in right bottom corner of status window is displayed only
       if form CanResize.
       |<br>
       When status text set first time, (simple) status bar window is created
       (always aligned to bottom), and form is resizing to preset client height.
       While status bar is showing, client height value is returned without
       height of status bar. To remove status bar, call RemoveStatus method for
       a form.
       |<br>
       By default, text is left-aligned within the specified part of a status
       window. You can embed tab characters (#9) in the text to center or
       right-align it. Text to the right of a single tab character is centered,
       and text to the right of a second tab character is right-aligned.
    }
    property StatusCtl: PControl read fStatusCtl;
    {* Pointer to Status bar control. To "create" child controls on
       the status bar, first create it as a child of form, for instance, and
       then change its property Parent, e.g.:
       ! var Progress1: PControl;
       ! ...
       ! Progress1 := NewProgressBar( Form1 );
       ! Progress1.Parent := Form1.StatusCtl;
       (If you use MCK, code should be another a bit, and in this case it is
       possible to create and adjust the control at design-time, and at run-time
       change its parent control. E.g. (Progress1 is created at run-time here too):
       ! Progress1 := NewProgressBar( Form );
       ! Progress1.Parent := Form.StatusCtl;
       ).
       Do not forget to provide StatusCtl to be existing first (e.g. assign
       one-space string to SimpleStatusText property of the form, for MCK do
       so using Object Inspector).

       Please note that not only a form can have status bar
       but any other control too!
       }
    property SizeGrip: Boolean
             read {$IFDEF USE_FLAGS} GetSizeGrip {$ELSE} fSizeGrip {$ENDIF}
             write {$IFDEF USE_FLAGS} SetSizeGrip {$ELSE} fSizeGrip {$ENDIF};
    {* Size grip for status bar. Has effect only before creating window. }

    procedure RemoveStatus;
    {* |<#form>
       Call it to remove status bar from a form (created in result of assigning
       value(s) to StatusText[], SimpleStatusText properties). When status bar is
       removed, form is resized to preset client height. }
    function StatusPanelCount: Integer;
    {* |<#form>
       Returns number of status panels defined in status bar. }
    property StatusPanelRightX[ Idx: Integer ]: Integer read GetStatusPanelX write SetStatusPanelX;
    {* |<#form>
       Use this property to adjust status panel right edges (if the status bar is
       divided onto several subpanels). If the right edge for the last panel is
       set to -1 (by default) it is expanded to the right edge of a form window.
       Otherwise, status bar can be shorter then form width. }
    property StatusWindow: HWND read Get_StatusWnd;
    {* |<#form>
       Provided for case if You want to use API direct message sending to
       status bar. }

    property Color1: TColor read DF.fColor1 write SetColor1;
    {* |<#gradient>
       Top line color for GradientPanel. }
    property Color2: TColor read DF.fColor2 write SetColor2;
    {* |<#gradient>
       |<#3Dlabel>
       Bottom line color for GradientPanel, or shadow color for LabelEffect.
       (If clNone, shadow color for LabelEffect is calculated as a mix bitween
       TextColor and clBlack). }
    property GradientStyle: TGradientStyle read DF.fGradientStyle write SetGradientStyle;
    {* |<#gradient>
       Styles other then gsVertical and gsHorizontal has effect only for
       gradient panel, created by NewGradientPanelEx. }
    property GradientLayout: TGradientLayout read DF.fGradientLayout write SetGradientLayout;
    {* |<#gradient>
       Has only effect for gradient panel, created by NewGradientPanelEx.
       Ignored for styles gsVertical and gsHorizontal. }

    //======== Image lists (for ListView, TreeView, ToolBar and TabControl):
    property ImageListSmall: PImageList index 16 read GetImgListIdx write SetImgListIdx;
    {* |<#listview>
       Image list with small icons used with List View control. If not set,
       last added (i.e. created with a control as an owner) image list with
       small icons is used. }
    property ImageListNormal: PImageList index 32 read GetImgListIdx write SetImgListIdx;
    {* |<#listview>
       |<#treeview>
       |<#tabcontrol>
       |<#bitbtn>
       Image list with normal size icons used with List View control (or with
       icons for BitBtn, TreeView or TabControl). If not set,
       last added (i.e. created with a control as an owner) image list is used.
       }
    property ImageListState: PImageList index 0 read GetImgListIdx write SetImgListIdx;
    {* |<#listview>
       |<#treeview>
       Image list used as a state images list for ListView or TreeView control. }

    //========
    function SetUnicode( Unicode: Boolean ): PControl;
    {* |<#listview>
       |<#treeview>
       |<#tabcontrol>
       Sets control as Unicode or not. The control itself is returned as for
       other "transparent" functions. A conditional define UNICODE_CTRLS must
       be added to a project to provide handling unicode messages. }

    //======== TabControl-specific properties and methods:
    property Pages[ Idx: Integer ]: PControl read GetPages;
    {* |<#tabcontrol>
       Returns controls, which can be used as parent for controls, placed on
       different pages of a tab control. Use it like in follows example:
       | Label1 := NewLabel( TabControl1.Pages[ 0 ], 'Label1' );
       To find number of pages available, check out Count property of the tab
       control. Pages are enumerated from 0 to Count - 1, as usual. }
    property TC_Pages[ Idx: Integer ]: PControl read GetPages;
    {* |<#tabcontrol>
       The same as above. }
    function TC_Insert( Idx: Integer; const TabText: KOLString; TabImgIdx: Integer ): PControl;
    {* |<#tabcontrol>
       Inserts new tab before given, returns correspondent page control
       (which can be used as a parent for controls to place on the page). }
    procedure TC_Delete( Idx: Integer );
    {* |<#tabcontrol>
       Removes tab from tab control, destroying all its child controls. }
{$IFNDEF OLD_ALIGN}
    procedure TC_InsertControl( Idx: Integer; const TabText: KOLString; TabImgIdx: Integer; Page: PControl);
    {* |<#tabcontrol>
       Inserts new tab before given, but not construt this Page
       (this control must be created before inserting, and may be not a Panel). }
    function TC_Remove( Idx: Integer ):PControl;
    {* |<#tabcontrol>
       Only removes tab from tab control, and return this Page as Result. }
{$ENDIF}
    property TC_Items[ Idx: Integer ]: KOLString read TCGetItemText write TCSetItemText;
    {* |<#tabcontrol>
       Text, displayed on tab control tabs. }
    property TC_Images[ Idx: Integer ]: Integer read TCGetItemImgIDx write TCSetItemImgIdx;
    {* |<#tabcontrol>
       Image index for a tab in tab control. }
    property TC_ItemRect[ Idx: Integer ]: TRect read TCGetItemRect;
    {* |<#tabcontrol>
       Item rectangle for a tab in tab control. }
    procedure TC_SetPadding( cx, cy: Integer );
    {* |<#tabcontrol>
       Sets space padding around tab text in a tab of tab control. }
    function TC_TabAtPos( x, y: Integer ): Integer;
    {* |<#tabcontrol>
       Returns index of tab, found at the given position (relative to
       a client rectangle of tab control). If no tabs found at the
       position, -1 is returned. }
    function TC_DisplayRect: TRect;
    {* |<#tabcontrol>
       Returns rectangle, occupied by a page rather then tab. }
    function TC_IndexOf(const S: KOLString): Integer;
    {* |<#tabcontrol>
       By Mr Brdo. Index of page by its Caption. }
    function TC_SearchFor(const S: KOLString; StartAfter: Integer; Partial: Boolean): Integer;
    {* |<#tabcontrol>
       By Mr Brdo. Index of page by its Caption. }

    //======== ListView style and options:
    property LVStyle: TListViewStyle read DF.fLVStyle write SetLVStyle;
    {* |<#listview>
       ListView style of view. Can be changed at run time. }

    property LVOptions: TListViewOptions read DF.fLVOptions write SetLVOptions;
    {* |<#listview>
       ListView options. Can be changed at run time. }

    property LVTextColor: TColor index LVM_GETTEXTCOLOR
             {$IFDEF F_P}   read LVGetColorByIdx
             {$ELSE DELPHI} read fTextColor
             {$ENDIF F_P/DELPHI} write LVSetColorByIdx;
    {* |<#listview>
       ListView text color. Use it instead of Font.Color. }
    property LVTextBkColor: TColor index LVM_GETTEXTBKCOLOR
             {$IFDEF F_P}   read LVGetColorByIdx
             {$ELSE DELPHI} read DF.fLVTextBkColor
             {$ENDIF F_P/DELPHI} write LVSetColorByIdx;
    {* |<#listview>
       ListView background color for text. }
    property LVBkColor: TColor read fColor write SetCtlColor; //LVSetBkColor;
    {* |<#listview>
       ListView background color.  Use it instead of Color. }

    //======== List View columns handling:
    property LVColCount: Integer read DF.fLVColCount;
    {* |<#listview>
       ListView (additional) column count. Value 0 means that there are
       no columns (single item text / icon is used). If You want
       to provide several columns, first call LVColAdd to "insert" column 0,
       i.e. to provide header text for first column (with index 0).
       If there are no column, nothing will be shown in lvsDetail /
       lvsDetailNoHeader view style. }
    procedure LVColAdd( const aText: KOLString; aalign: TTextAlign; aWidth: Integer );
    {* |<#listview>
       Adds new column. Pass 'width' <= 0 to provide default column width.
       'text' is a column header text. }
    procedure LVColInsert( ColIdx: Integer; const aText: KOLString; aAlign: TTextAlign; aWidth: Integer );
    {* |<#listview>
       Inserts new column at the Idx position (1-based column index). }
    procedure LVColDelete( ColIdx: Integer );
    {* |<#listview>
       Deletes column from List View }
    property LVColWidth[ Item: Integer ]: Integer index LVM_GETCOLUMNWIDTH
             read GetItemVal write SetItemVal;
    {* |<#listview>
       Retrieves or changes column width. For lvsList view style, the same width
       is returned for all columns (ColIdx is ignored). It is possible to use
       special values to assign to a property:
       |<br> LVSCW_AUTOSIZE - Automatically sizes the column
       |<br> LVSCW_AUTOSIZE_USEHEADER - Automatically sizes the column to fit
       the header text
       |<br>
       To set coumn width in lvsList view mode, column index must be -1
       (and Width to set must be in range 0..32767 always). }
    property LVColText[ Idx: Integer ]: KOLString read GetLVColText write SetLVColText;
    {* |<#listview>
       Allows to get/change column header text at run time. }
    property LVColAlign[ Idx: Integer ]: TTextAlign read GetLVColalign write SetLVColalign;
    {* |<#listview>
       Column text aligning. }
    property LVColImage[ Idx: Integer ]: Integer index LVCF_IMAGE or (24 shl 16) read GetLVColEx write SetLVColEx;
    {* |<#listview>
       Only starting from comctrl32.dll of version 4.70 (IE4+). Allows to
       set an image for list view column itself from the ImageListSmall.
    }
    property LVColOrder[ Idx: Integer ]: Integer index LVCF_ORDER or (28 shl 16) read GetLVColEx write SetLVColEx;
    {* |<#listview>
       Only starting from comctrl32.dll of version 4.70 (IE4+). Allows to
       set visual order of the list view column from the ImageListSmall.
       This value does not affect the index, by which the column is still
       accessible in the column array.
    }

    //======== List View items handling:
    property LVCount: Integer read GetItemsCount write SetItemsCount;
    {* |<#listview>
       Returns item count for ListView control. It is possible to use Count
       property instead when obtaining of item count is needed only. But this this
       property allows also to set actual count of list view items when a list
       view is virtual. }

    property LVCurItem: Integer read GetLVCurItem write SetLVCurItem;
    {* |<#listview>
       Returns first selected item index in a list view. See also LVNextSelected,
       LVNextItem and LVFocusItem functions. }

    property LVFocusItem: Integer read GetLVFocusItem;
    {* |<#listview>
       Returns focused item index in a list view. See also LVCurItem. }

    function LVNextItem( IdxPrev: Integer; Attrs: DWORD ): Integer;
    {* |<#listview>
       Returns an index of the next after IdxPrev item with given attributes in
       the list view. Attributes can be:
       LVNI_ALL - Searches for a subsequent item by index, the default value.
       |<br><br>
       Searchs by physical relationship to the index of the item where the
       search is to begin.
       LVNI_ABOVE - Searches for an item that is above the specified item.
       LVNI_BELOW - Searches for an item that is below the specified item.
       LVNI_TOLEFT - Searches for an item to the left of the specified item.
       LVNI_TORIGHT - Searches for an item to the right of the specified item.
       |<br><br>
       The state of the item to find can be specified with one or a combination
       of the following values:
       LVNI_CUT - The item has the LVIS_CUT state flag set.
       LVNI_DROPHILITED - The item has the LVIS_DROPHILITED state flag set
       LVNI_FOCUSED - The item has the LVIS_FOCUSED state flag set.
       LVNI_SELECTED - The item has the LVIS_SELECTED state flag set.}
    function LVNextSelected( IdxPrev: Integer ): Integer;
    {* |<#listview>
       Returns an index of next (after IdxPrev) selected item in a list view. }

    function LVAdd( const aText: KOLString; ImgIdx: Integer; State: TListViewItemState;
                     StateImgIdx, OverlayImgIdx: Integer; Data: DWORD ): Integer;
    {* |<#listview>
       Adds new line to the end of ListView control. Only content of item itself
       is set (aText, ImgIdx). To change other column text and attributes of
       item added, use appropriate properties / methods ().
       |<br>
       Returns an index of added item.
       |<br>
       There is no Unicode version defined, use LVItemAddW instead. }
    function LVItemAdd( const aText: KOLString ): Integer;
    {* |<#listview>
       Adds an item to the end of list view. Returns an index of the item added. }
    function LVInsert( Idx: Integer; const aText: KOLString; ImgIdx: Integer;
              State: TListViewItemState;  StateImgIdx, OverlayImgIdx: Integer; Data: DWORD ): Integer;
    {* |<#listview>
       Inserts new line before line with index Idx in ListView control. Only
       content of item itself is set (aText, ImgIdx). To change other column
       text and attributes of item added, use appropriate properties / methods ().
       if ImgIdx = I_IMAGECALLBACK, event handler OnGetLVItemImgIdx is responsible
       for returning image index for an item ( /// not implemented yet /// )
       Pass StateImgIdx and OverlayImgIdx = 0 (ignored in that case) or 1..15 to
       use correspondent icon from ImageListState image list.
       |<br> Returns an index of item inserted.
       |<br> There is no unicode version of this method, use LVItemInsertW. }
    function LVItemInsert( Idx: Integer; const aText: KOLString ): Integer;
    {* |<#listview>
       Inserts an item to Idx position. }

    procedure LVDelete( Idx: Integer );
    {* |<#listview>
       Deletes item of ListView with subitems (full row - in lvsDetail view style. }
    procedure LVSetItem( Idx, Col: Integer; const aText: KOLString; ImgIdx: Integer;
              State: TListViewItemState; StateImgIdx, OverlayImgIdx: Integer; Data: DWORD );
    {* |<#listview>
       Use this method to set item data and item columns data for ListView control.
       It is possible to pass I_SKIP as ImgIdx, StateImgIdx, OverlayImgIdx values to
       skip setting this fields. But all other are set always. Like in LVInsert /
       LVAdd, ImgIdx can be I_IMAGECALLBACK to determine that image will be
       retrieved in OnGetItemImgIdx event handler when needed.
       |<br>
       If this method is called to set data for column > 0, parameters ImgIdx and
       Data are ignored anyway.
       |<br> There is no unicode version of this method, use other methods
       to set up listed properties separately using correspondent W-functions. }

    property LVItemState[ Idx: Integer ]: TListViewItemState read LVGetItemState write LVSetItemState;
    {* |<#listview>
       Access to list view item states set [lvisBlend, lvisHighlight, lvisFocus,
       lvisSelect]. When assign new value to the property, it is possible to use
       special index value -1 to change state for all items for a list view
       (but only when lvoMultiselect style is applied to the list view, otherwise
       index -1 is referring to the last item of the list view). }

    property LVItemIndent[ Idx: Integer ]: Integer read LVGetItemIndent write LVSetItemIndent;
    {* Item indentation. Indentation is calculated as this value multiplied to
       image list ImgWidth value (Image list must be applied to list view).
       Note: indentation supported only if IE3.0 or higher installed. }
    property LVItemStateImgIdx[ Idx: Integer ]: Integer read LVGetSttImgIdx write LVSetSttImgIdx;
    {* |<#listview>
       Access to state image of the item. Use index -1 to assign the same state
       image index to all items of the list view at once (fast).
       Option lvoCheckBoxes just means, that control itself creates special inner
       image list for two state images. Later it is possible to examine checked
       state for items or set checked state programmatically by changing
       LVItemStateImgIdx[ ] property. Value 1 corresponds to unchecked state,
       2 to checked. Value 0 allows to remove checkbox at all. So, to check all
       added items by default (e.g.), do following:
       ! ListView1.LVItemStateImgIdx[ -1 ] := 2;
       |<br>Use 1-based index of the image
       in image list ImageListState. Value 0 reserved to use as "no state image".
       Values 1..15 can be used only - this is the Windows restriction on
       state images. }
    property LVItemOverlayImgIdx[ Idx: Integer ]: Integer read LVGetOvlImgIdx write LVSetOvlImgIdx;
    {* |<#listview>
       Access to overlay image of the item. Use index -1 to assign the same
       overlay image to all items of the list view at once (fast). }
    property LVItemData[ Idx: Integer ]: DWORD read LVGetItemData write LVSetItemData;
    {* |<#listview>
       Access to user defined data, assiciated with the item of the list view. }
    procedure LVSelectAll;
    {* |<#listview>
       Call this method to select all the items of the list view control. }
    property LVSelCount: Integer read GetSelLength; // write SetSelLength;
    {* |<#listview>
       Returns number of items selected in listview. }
    property LVItemImageIndex[ Idx: Integer ]: Integer read LVGetItemImgIdx write LVSetItemImgIdx;
    {* |<#listview>
       Image index of items in listview. When an item is created (using LVItemAdd
       or LVItemInsert), image index 0 is set by default (not -1 like in VCL!). }
    property LVItems[ Idx, Col: Integer ]: KOLString read LVGetItemText write LVSetItemText;
    {* |<#listview>
       Access to List View item text. }
    function LVItemRect( Idx: Integer; Part: TGetLVItemPart ): TRect;
    {* |<#listview>
       Returns rectangle occupied by given item part(s) in ListView window.
       Empty rectangle is returned, if the item is not viewing currently. }
    function LVSubItemRect( Idx, ColIdx: Integer ): TRect;
    {* |<#listview>
       Returns rectangle occupied by given item's subitem in ListView window,
       in lvsDetail or lvsDetailNoHeader style. Empty rectangle (0,0,0,0) is
       returned if the item is not viewing currently. Left or/and right bounds
       of the rectangle returned can be outbound item rectangle if only a part
       of the subitem is visible or the subitem is not visible in the item,
       which is visible itself. }
    property LVItemPos[ Idx: Integer ]: TPoint read LVGetItemPos write LVSetItemPos;
    {* |<#listview>
       Position of List View item (can be changed in icon or small icon view). }
    function LVItemAtPos( X, Y: Integer ): Integer;
    {* |<#listview>
       Return index of item at the given position. }
    function LVItemAtPosEx( X, Y: Integer; var Where: TWherePosLVItem ): Integer;
    {* |<#listview>
       Retrieves index of item and sets in Where, what part of item is under
       given coordinates. If there are no items at the specified position,
       -1 is returned. }
    procedure LVMakeVisible( Item: Integer; PartiallyOK: Boolean );
    {* |<#listview>
       Makes listview item visible. Ignred when Item passed < 0. }
    procedure LVEditItemLabel( Idx: Integer );
    {* |<#listview>
       Begins in-place editing of item label (first column text). }
    procedure LVSort;
    {* |<#listview>
       Initiates sorting of list view items. This sorting procedure is available only
       for Win2K, WinNT4 with IE5, Win98 or Win95 with IE5. See also LVSortData. }
    procedure LVSortData;
    {* |<#listview>
       Initiates sorting of list view items. This sorting procedure is always available
       in Windows95/98, NT/2000. But OnCompareLVItems procedure receives not indexes of
       items compared but its Data field associated instead. }
    procedure LVSortColumn( Idx: Integer );
    {* |<#listview>
       This is a method to simplify sort by column. Just call it in your OnColumnClick
       event passing column index and enjoy with your list view sorted automatically
       when column header is clicked. Requieres Windows2000 or Winows98, not supported
       under WinNT 4.0 and below and under Windows95.
       |<br>
       Either lvoSortAscending or lvoSortDescending option must be set in
       LVOptions, otherwise no sorting is performed. }
    function LVIndexOf( const S: KOLString ): Integer;
    {* Returns first list view item index with caption matching S.
       The same as LVSearchFor( S, -1, FALSE ). }
    function LVSearchFor( const S: KOLString; StartAfter: Integer; Partial: Boolean ): Integer;
    {* Searches an item with Caption equal to S (or starting from S, if Partial = TRUE).
       Searching is started after an item specified by StartAfter parameter. }

    //======== List view page:
    property LVTopItem: Integer index LVM_GETTOPINDEX read GetIntVal; //LVGetTopItem;
    {* |<#listview>
       Returns index of topmost visible item of ListView in lvsList view style. }
    property LVPerPage: Integer index LVM_GETCOUNTPERPAGE read GetIntVal; //LVGetPerPage;
    {* |<#listview>
       Returns the number of fully-visible items if successful. If the current
       view is icon or small icon view, the return value is the total number
       of items in the list view control. }

    //======== List View specific events:
    property OnEndEditLVItem: TOnEditLVItem
             read {$IFDEF EVENTS_DYNAMIC} Get_OnEndEditLVItem {$ELSE} EV.fOnEndEditLVItem {$ENDIF}
             write SetOnEndEditLVItem;
    {* |<#listview>
       Called when edit of an item label in ListView control finished. Return
       True to accept new label text, or false - to not accept it (item label
       will not be changed). If handler not set to an event, all changes are
       accepted. }

    property OnLVDelete: TOnDeleteLVItem
             read {$IFDEF EVENTS_DYNAMIC} Get_OnDeleteLVItem {$ELSE} EV.fOnDeleteLVItem {$ENDIF}
             write SetOnDeleteLVItem;
    {* |<#listview>
       This event is called when an item is deleted in the listview.
       Do not add, delete, or rearrange items in the list view while processing
       this notification. }
    property OnDeleteLVItem: TOnDeleteLVItem
             read {$IFDEF EVENTS_DYNAMIC} Get_OnDeleteLVItem {$ELSE} EV.fOnDeleteLVItem {$ENDIF}
             write SetOnDeleteLVItem;
    {* |<#listview>
       Called for every deleted list view item. }
    property OnDeleteAllLVItems: TOnEvent read DF.fOnDeleteAllLVItems write SetOnDeleteAllLVItems;
    {* |<#listview>
       Called when all the items of the list view control are to be deleted. If after
       returning from this event handler event OnDeleteLVItem is yet assigned,
       an event OnDeleteLVItem will be called for every deleted item. }
    property OnLVData: TOnLVData
             read {$IFDEF EVENTS_DYNAMIC} Get_OnLVData {$ELSE} EV.fOnLVData {$ENDIF}
             write SetOnLVData;
    {* |<#listview>
       Called to provide virtual list view with actual data. To use list view as
       virtaul list view, define also lvsOwnerData style and set Count property
       to actual row count of the list view. This manner of working with list view
       control can greatly improve performance of an application when working with
       huge data sets represented in listview control. }

    property OnCompareLVItems: TOnCompareLVItems
             read {$IFDEF EVENTS_DYNAMIC} Get_OnCompareLVItems {$ELSE} EV.fOnCompareLVItems {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnCompareLVItems {$ELSE} EV.fOnCompareLVItems {$ENDIF};
    {* |<#listview>
       Event to compare two list view items during sort operation (initiated by
       LVSort method call). Do not send any messages to the list view control
       while it is sorting - results can be unpredictable! }
    property OnColumnClick: TOnLVColumnClick
             read {$IFDEF EVENTS_DYNAMIC} Get_OnColumnClick {$ELSE} EV.fOnColumnClick {$ENDIF}
             write SetOnColumnClick;
    {* |<#listview>
       This event handler is called when column of the list view control is clicked.
       You can use this event to initiate sorting of list view items by this column. }
    property OnLVStateChange: TOnLVStateChange
             read {$IFDEF EVENTS_DYNAMIC} Get_OnLVStateChange {$ELSE} EV.FOnLVStateChange {$ENDIF}
             write SetOnLVStateChange;
    {* |<#listview>
       This event occure when an item or items range in list view control are
       changing its state (e.g. selected or unselected). }
    property OnDrawItem: TOnDrawItem
             read {$IFDEF EVENTS_DYNAMIC} Get_OnDrawItem {$ELSE} EV.fOnDrawItem {$ENDIF}
             write SetOnDrawItem;
    {* |<#listview>
       |<#listbox>
       |<#combo>
       This event can be used to implement custom drawing for list view, list box, dropped
       list of a combobox. For a list view, custom drawing using this event is possible
       only in lvsDetail and lvsDetailNoHeader styles, and OnDrawItem is called to draw
       entire row at once only. See also OnLVCustomDraw event. }

    property OnLVCustomDraw: TOnLVCustomDraw
             read {$IFDEF EVENTS_DYNAMIC} Get_OnLVCustomDraw {$ELSE} EV.FOnLVCustomDraw {$ENDIF}
             write SetOnLVCustomDraw;
    {* |<#listview>
       Custom draw event for listview. For every item to be drawn, this event
       can be called several times during a single drawing cycle - depending on
       a result, returned by an event handler. Stage can have one of following
       values:
       |<pre>
       CDDS_PREERASE
       CDDS_POSTERASE
       CDDS_ITEMPREERASE
       CDDS_PREPAINT
       CDDS_ITEMPREPAINT
       CDDS_ITEM
       CDDS_SUBITEM + CDDS_ITEMPREPAINT
       CDDS_SUBITEM + CDDS_ITEMPOSTPAINT
       CDDS_ITEMPOSTPAINT
       CDDS_POSTPAINT
       </pre>
       When called, see on Stage to get know, on what stage the event is
       activated. And depend on the stage and on what you want to paint,
       return a value as a result, which instructs the system, if to use
       default drawing on this (and follows) stage(s) for the item, and if
       to notify further about different stages of drawing the item during
       this drawing cycle. Possible values to return are:
       |<pre>
       CDRF_DODEFAULT - perform default drawing. Do not notify further for this
                      item (subitem) (or for entire listview, if called with
                      flag CDDS_ITEM reset - ?);
       CDRF_NOTIFYITEMDRAW - return this value, when the event is called the
                      first time in a cycle of drawing, with ItemIdx = -1 and
                      flag CDDS_ITEM reset in Stage parameter;
       CDRF_NOTIFYPOSTERASE - usually can be used to provide default erasing,
                      if you want to perform drawing immediately after that;
       CDRF_NOTIFYPOSTPAINT - return this value to provide calling the event
                      after performing default drawing. Useful when you wish
                      redraw only a part of the (sub)item;
       CDRF_SKIPDEFAULT - return this value to inform the system that all
                      drawing is done and system should not peform any more
                      drawing for the (sub)item during this drawing cycle.
       CDRF_NEWFONT - informs the system, that font is changed and default
                      drawing should be performed with changed font;
       |</pre>
       If you want to get notifications for each subitem, do not use option
       lvoOwnerDrawFixed, because such style prevents system from notifying
       the application for each subitem to be drawn in the listview and only
       notifications will be sent about entire items.
       |<br>
       See also NM_CUSTOMDRAW in API Help.
    }

    procedure Set_LVItemHeight(Value: Integer);
    function SetLVItemHeight(Value: Integer): PControl;
    property LVItemHeight: Integer read DF.fLVItemHeight write Set_LVItemHeight;
    {* |<#listview>
       |<#listbox>
       |#combo>
       It is possible to assign a value to LVItemHeight property only to
       control with "owner-draw" style (lvoOwnerDrawFixed for listview,
       loOwnerDrawFixed or loOwnerDrawVariable for listbox and
       coOwnerDrawFixed or coOwnerDrawVariable for combobox. At least, the
       control should have such option while creating it (after showing it
       the first time it is possible to change its options to avoid owner
       drawing later). }

    //======== TreeView specific properties and methods:
    function TVInsert( nParent, nAfter: THandle; const Txt: KOLString ): THandle;
    {* |<#treeview>
       Inserts item to a tree view. If nParent is 0 or TVI_ROOT, the item is
       inserted at the root of tree view. It is possible to pass following special
       values as nAfter parameter:
       |<pre>
       TVI_FIRST        Inserts the item at the beginning of the list.
       TVI_LAST	        Inserts the item at the end of the list.
       TVI_SORT	        Inserts the item into the list in alphabetical order.
       |</pre> }
    procedure TVDelete( Item: THandle );
    {* |<#treeview>
       Removes an item from the tree view. If value TVI_ROOT is passed, all items
       are removed. }

    property TVSelected: THandle index TVGN_CARET read TVGetItemIdx write TVSetItemIdx;
    {* |<#treeview>
       Returns or sets currently selected item handle in tree view. }

    property TVDropHilighted: THandle index TVGN_DROPHILITE read TVGetItemIdx write TVSetItemIdx;
    {* |<#treeview>
       Returns or sets item, which is currently highlighted as a drop target. }
    property TVDropHilited: THandle index TVGN_DROPHILITE read TVGetItemIdx write TVSetItemIdx;
    {* The same as TVDropHilighted. }
    property TVFirstVisible: THandle index TVGN_FIRSTVISIBLE read TVGetItemIdx write TVSetItemIdx;
    {* |<#treeview>
       Returns or sets given item to top of tree view. }

    property TVIndent: Integer index TVM_GETINDENT read GetIntVal write SetIntVal;
    {* |<#treeview>
       The amount, in pixels, that child items are indented relative to their
       parent items. }
    property TVVisibleCount: Integer index TVM_GETVISIBLECOUNT read GetIntVal;
    {* |<#treeview>
       Returns number of fully (not partially) visible items in tree view. }

    property TVRoot: THandle index TVGN_ROOT read TVGetItemIdx;
    {* |<#treeview>
       Returns handle of root item in tree view (or 0, if tree is empty). }
    property TVItemChild[ Item: THandle ]: THandle index TVGN_CHILD read TVGetItemNext;
    {* |<#treeview>
       Returns first child item for given one. }
    property TVItemHasChildren[ Item: THandle ]: Boolean read TV_GetItemHasChildren write TV_SetItemHasChildren;
    {* |<#treeview>
       TRUE, if an Item has children. Set this value to true if you want to
       force [+] sign appearing left from the node, even if there are no
       subnodes added to the node yet. }
    property TVItemChildCount[ Item: THandle ]: Integer read TV_GetItemChildCount;
    {* |<#treeview>
       Returns number of node child items in tree view.
    }
    property TVItemNext[ Item: THandle ]: THandle index TVGN_NEXT read TVGetItemNext;
    {* |<#treeview>
       Returns next sibling item handle for given one (or 0, if passed item is
       the last child for its parent node). }
    property TVItemPrevious[ Item: THandle ]: THandle index TVGN_PREVIOUS read TVGetItemNext;
    {* |<#treeview>
       Returns previous sibling item (or 0, if the is no such item). }
    property TVItemNextVisible[ Item: THandle ]: THandle index TVGN_NEXTVISIBLE read TVGetItemNext;
    {* |<#treeview>
       Returns next visible item (passed item must be visible too, to determine,
       if it is really visible, use property TVItemRect or TVItemVisible. }
    property TVItemPreviousVisible[ Item: THandle ]: THandle index TVGN_PREVIOUSVISIBLE read TVGetItemNext;
    {* |<#treeview>
       Returns previous visible item. }
    property TVItemParent[ Item: THandle ]: THandle index TVGN_PARENT read TVGetItemNext;
    {* |<#treeview>
       Returns parent item for given one (or 0 for root item). }

    property TVItemText[ Item: THandle ]: KOLString read TVGetItemText write TVSetItemText;
    {* |<#treeview>
       Text of tree view item. }
    function TVItemPath( Item: THandle; Delimiter: KOLChar ): KOLString;
    {* |<#treeview>
       Returns full path from the root item to given item. Path is calculated
       as a concatenation of all parent nodes text strings, separated by
       given delimiter character.
       |<br>Please note, that returned path has no trailing delimiter, this
       character is only separating different parts of the path.
       |<br>If Item is not specified ( =0 ), path is returned
       for Selected item. }

    property TVItemRect[ Item: THandle; TextOnly: Boolean ]: TRect read TVGetItemRect;
    {* |<#treeview>
       Returns rectangle, occupied by an item in tree view. }

    property TVItemVisible[ Item: THandle ]: Boolean read TVGetItemVisible write TVSetITemVisible;
    {* |<#treeview>
       Returs True, if item is visible in tree view. It is also possible to
       assign True to this property to ensure that a tree view item is visible
       (if False is assigned, this does nothing). }
    function TVItemAtPos( x, y: Integer; var Where: DWORD ): THandle;
    {* |<#treeview>
       Returns handle of item found at specified position (relative to upper left
       corener of client area of the tree view). If no item found, 0 is returned.
       Variable Where receives additional flags combination, describing more
       detailed, on which part of item or tree view given point is located,
       such as:
       |<pre>
       TVHT_ABOVE              Above the client area
       TVHT_BELOW              Below the client area
       TVHT_NOWHERE            In the client area, but below the last item
       TVHT_ONITEM	       On the bitmap or label associated with an item
       TVHT_ONITEMBUTTON       On the button associated with an item
       TVHT_ONITEMICON	       On the bitmap associated with an item
       TVHT_ONITEMINDENT       In the indentation associated with an item
       TVHT_ONITEMLABEL	       On the label (string) associated with an item
       TVHT_ONITEMRIGHT	       In the area to the right of an item
       TVHT_ONITEMSTATEICON    On the state icon for a tree-view item that is in a user-defined state
       TVHT_TOLEFT	       To the right of the client area
       TVHT_TORIGHT	       To the left of the client area
       |</pre> }

    property TVRightClickSelect: Boolean read DF.fTVRightClickSelect write SetTVRightClickSelect;
    {* |<#treeview>
       Set this property to True to allow change selection to an item, clicked with right mouse button. }
    property TVEditing: Boolean read GetTVEditing;
    {* |<#treeview>
       Returns True, if tree view control is editing its item label. }
    property TVItemBold[ Item: THandle ]: Boolean index TVIS_BOLD read TVGetItemStateFlg write TVSetItemStateFlg;
    {* |<#treeview>
       True, if item is bold. }
    property TVItemCut[ Item: THandle ]: Boolean index TVIS_CUT read TVGetITemStateFlg write TVSetItemStateFlg;
    {* |<#treeview>
       True, if item is selected as part of "cut and paste" operation. }
    property TVItemDropHighlighted[ Item: THandle ]: Boolean index TVIS_DROPHILITED read TVGetITemStateFlg write TVSetItemStateFlg;
    {* |<#treeview>
       True, if item is selected as drop target. }
    property TVItemDropHilited[ Item: THandle ]: Boolean index TVIS_DROPHILITED read TVGetITemStateFlg write TVSetItemStateFlg;
    {* The same as TVItemDropHighlighted. }
    property TVItemExpanded[ Item: THandle ]: Boolean index TVIS_EXPANDED read TVGetITemStateFlg; // write TVSetItemStateFlg;
    {* |<#treeview>
       True, if item's list of child items is currently expanded. To change
       expanded state, use method TVExpand. }
    property TVItemExpandedOnce[ Item: THandle ]: Boolean index TVIS_EXPANDEDONCE read TVGetITemStateFlg; // write TVSetItemStateFlg;
    {* |<#treeview>
       True, if item's list of child items has been expanded at least once. }
    property TVItemSelected[ Item: THandle ]: Boolean index TVIS_SELECTED read TVGetITemStateFlg write TVSetItemStateFlg;
    {* |<#treeview>
       True, if item is selected. }

    procedure TVExpand( Item: THandle; Flags: DWORD );
    {* |<#treeview>
       Call it to expand/collapse item's child nodes. Possible values for Flags
       parameter are:
       <pre>
       TVE_COLLAPSE         Collapses the list.
       TVE_COLLAPSERESET    Collapses the list and removes the child items. Note
                            that TVE_COLLAPSE must also be specified.
       TVE_EXPAND	    Expands the list.
       TVE_TOGGLE	    Collapses the list if it is currently expanded or
                            expands it if it is currently collapsed.
       </pre>
       }
    procedure TVSort( N: THandle );
    {* |<#treeview>
       By Alex Mokrov. Sorts treeview. If N = 0, entire treeview is sorted.
       Otherwise, children of the given node only.
    }

    property TVItemImage[ Item: THandle ]: Integer index TVIF_IMAGE read TVGetItemImage write TVSetItemImage;
    {* |<#treeview>
       Image index for an item of tree view. To tell that there are no image
       set, use index -2 (value -1 is reserved for callback image). }
    property TVItemSelImg[ Item: THandle ]: Integer index TVIF_SELECTEDIMAGE read TVGetItemImage write TVSetItemImage;
    {* |<#treeview>
       Image index for an item of tree view in selected state. Use value -2 to
       provide no image, -1 used for callback image. }
    property TVItemOverlay[ Item: THandle ]: Integer index TVIS_OVERLAYMASK or $80000
                             read TVGetItemImage write TVSetItemImage;
    {* |<#treeview>
       Overlay image index for an item in tree view.
       Values 1..15 can be used only - this is the Windows restriction on
       overlay images. }
    property TVItemStateImg[ Item: THandle ]: Integer index TVIS_STATEIMAGEMASK or $C0000
                              read TVGetItemImage write TVSetItemImage;
    {* |<#treeview>
       State image index for an item in tree view. Use 1-based index of the image
       in image list ImageListState. Value 0 reserved to use as "no state image".
    }

    property TVItemData[ Item: THandle ]: Pointer read TVGetItemData write TVSetItemData;
    {* |<#treeview>
       Stores any program-defined pointer with the item. }
    procedure TVEditItem( Item: THandle );
    {* |<#treeview>
       Begins editing given item label in tree view. }
    procedure TVStopEdit( Cancel: Boolean );
    {* |<#treeview>
       Ends editing item label, started by user or explicitly by TVEditItem method. }

    property OnTVBeginDrag: TOnTVBeginDrag
             read {$IFDEF EVENTS_DYNAMIC} Get_OnTVBeginDrag {$ELSE} EV.fOnTVBeginDrag {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnTVBeginDrag {$ELSE} EV.fOnTVBeginDrag {$ENDIF};
    {* |<#treeview>
       Is called for tree view, when its item is to be dragging. }
    property OnTVBeginEdit: TOnTVBeginEdit
             read {$IFDEF EVENTS_DYNAMIC} Get_OnTVBeginEdit {$ELSE} EV.fOnTVBeginEdit {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnTVBeginEdit {$ELSE} EV.fOnTVBeginEdit {$ENDIF};
    {* |<#treeview>
       Is called for tree view, when its item label is to be editing.
       Return TRUE to allow editing of the item. }
    property OnTVEndEdit: TOnTVEndEdit
             read {$IFDEF EVENTS_DYNAMIC} Get_OnTVEndEdit {$ELSE} EV.fOnTVEndEdit {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnTVEndEdit {$ELSE} EV.fOnTVEndEdit {$ENDIF};
    {* |<#treeview>
       Is called when item label is edited. It is possible to cancel
       edit, returning False as a result. }
    property OnTVExpanding: TOnTVExpanding
             read {$IFDEF EVENTS_DYNAMIC} Get_OnTVExpanding {$ELSE} EV.fOnTVExpanding {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnTVExpanding {$ELSE} EV.fOnTVExpanding {$ENDIF};
    {* |<#treeview>
       Is called just before expanding/collapsing item. It is possible to
       return TRUE to prevent expanding item, otherwise FALSE should be returned. }
    property OnTVExpanded: TOnTVExpanded
             read {$IFDEF EVENTS_DYNAMIC} Get_OnTVExpanded {$ELSE} EV.fOnTVExpanded {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnTVExpanded {$ELSE} EV.fOnTVExpanded {$ENDIF};
    {* |<#treeview>
       Is called after expanding/collapsing item children. }
    property OnTVDelete: TOnTVDelete
             read {$IFDEF EVENTS_DYNAMIC} Get_OnTVDelete {$ELSE} EV.fOnTVDelete {$ENDIF}
             write SetOnTVDelete;
    {* |<#treeview>
       Is called just before deleting item. You may use this event to free
       resources, associated with an item (see TVItemData property). }
    //----------------- by Sergey Shisminzev:
    property OnTVSelChanging: TOnTVSelChanging
             read {$IFDEF EVENTS_DYNAMIC} Get_OnTVSelChanging {$ELSE} EV.fOnTVSelChanging {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnTVSelChanging {$ELSE} EV.fOnTVSelChanging {$ENDIF};
    {* |<#treeview>
       Is called before changing the selection. The handler can return FALSE
       to prevent changing the selection. }
    //--------------------------------------

    //======== Toolbar specific methods:
    procedure TBAddBitmap( Bitmap: HBitmap );
    {* |<#toolbar>
       Adds bitmaps to a toolbar. You can pass special values as Bitmap to
       add one of predefined system button images bitmaps:
       |<br> THandle(-1) to add standard small icons,
       |<br> THandle(-2) to add standard large icons,
       |<br> THandle(-5) to add standard small view icons,
       |<br> THandle(-6) to add standard large view icons,
       |<br> THandle(-9) to add standard small history icons,
       |<br> THandle(-10) to add standard large history icons,
       (in that case use following values as indexes to the standard and view
       bitmaps:
       |<br>
       STD_COPY, STD_CUT, STD_DELETE, STD_FILENEW, STD_FILEOPEN, STD_FILESAVE,
       STD_FIND, STD_HELP, STD_PASTE, STD_PRINT, STD_PRINTPRE, STD_PROPERTIES,
       STD_REDO, STD_REPLACE, STD_UNDO,
       |<br>
       VIEW_LARGEICONS, VIEW_SMALLICONS,
       VIEW_LIST, VIEW_DETAILS, VIEW_SORTNAME, VIEW_SORTSIZE, VIEW_SORTDATE,
       VIEW_SORTTYPE (use it as parameters BtnImgIdxArray in TBAddButtons or
       TBInsertButtons methods, and in assigning value to TBButtonImage[ ]
       property).
       Added bitmaps have indeces starting from previous count of images
       (as these are appended to existing - if any).
       |<br>
       Note, that if You add your own (custom) bitmap, it is not transparent.
       Do not assume that clSilver is always equal to clBtnFace. Use API
       function CreateMappedBitmap to load bitmap from resource and map
       desired colors as you wish (e.g., convert clTeal to clBtnFace). Or,
       call defined in KOL function LoadMappedBitmap to do the same more easy.
       Unfortunately, resource identifier for bitmap to pass it to LoadMappedBitmap
       or to CreateMappedBitmap seems must be integer, so it is necessary to
       create rc-file manually and compile using Borland Resource Compiler to
       figure it out. }

    function TBAddButtons( const Buttons: array of PKOLChar;
             const BtnImgIdxArray: array of Integer ): Integer;
    {* |<#toolbar>
       Adds buttons to toolbar. Last string in Buttons array *must* be empty
       ('' or nil), so to add buttons without text, pass ' ' string (one space
       char). It is not necessary to provide image indexes for all
       buttons (it is sufficient to assign index for first button only).
       But in place, correspondent to separator button (defined by string '-'),
       any integer must be passed to assign follow image indexes correctly.
       See example.
       |*Toolbar adding buttons sample.
       Code below shows how to call TBAddButtons method to add two buttons with
       a separator between these buttons. idxNew and idxOld are integer
       expressions assigning image indexes to buttons 'New' and 'Old'. This
       indexes are zero-based and refer to bitmap images, added earlier (either
       in creating toolbar by call of NewToolbar or later in call of TBAddBitmap).
       !
       !     TBAddButtons( [ '&New', '-', '&Old', '' ], [ idxNew, 0, idxOld ] );
       !
       |*
       To add check buttons, use prefix '+' or '-' in button definition
       string. If next character is '!', such buttons are grouped to a
       radio-group. Also, it is possible to use '^' prefix (must be first) to
       define button with small drop-down section (use also OnTBDropDown event
       to respond to clicking drop down section of such buttons).
       |<br>
       This function returns command id for first added button (other
       id's can be calculated incrementing the result by one for each
       button, except separators, which have no command id).
       |<br>
       Note: for static toolbar (single in application and created
       once) ids are started from value 100. }

    function TBInsertButtons( BeforeIdx: Integer; Buttons: array of PKOLChar;
             const BtnImgIdxArray: array of Integer ): Integer;
    {* |<#toolbar>
       Inserts buttons before button with given index on toolbar. Returns
       command identifier for first button inserted (other can be calculated
       incrementing returned value needed times. See also TBAddButtons. }

    procedure TBDeleteButton( BtnID: Integer );
    {* |<#toolbar>
       Deletes single button given by its command id. To delete separator,
       use TBDeleteBtnByIdx instead. }

    procedure TBDeleteBtnByIdx( Idx: Integer );
    {* |<#toolbar>
       Deletes single button given by its index in toolbar (not by command ID). }

    procedure TBClear;
    {* |<#toolbar>
       Deletes all buttons. Dufa }

    procedure TBAssignEvents( BtnID: Integer; Events: array of TOnToolbarButtonClick );
    {* |<#toolbar>
       Allows to assign separate OnClick events for every toolbar button.
       BtnID should be toolbar button ID or index of the first button to
       assign event. If it is an ID, events are assigned to buttons in
       creation order. Otherwise, events are assigned in placement order.
       Anyway, separator buttons are not skipped, so pass at least nil for such
       button as an event.
       |<br>
       Please note, that though not all buttons should exist before
       assigning events to it, therefore at least the first button
       (specified by BtnID) must be already added before calling TBAssignEvents. }

    procedure TBResetImgIdx( BtnID, BtnCount: Integer );
    {* |<#toolbar>
       Resets image index for BtnCount buttons starting from BtnID. }

    //property CurItem: Integer read DF.fTBCurItem;
    {* |<#toolbar>
       For toolbar, in OnClick event this property can be used to determine
       which button was clicked (100-based button id in toolbar). It is also
       possible to use CurIndex property (zero-based) for this purpose as
       well, but do not assume, that CurItem always equal to CurIndex+100.
       At least, it is possible to call TBItem2Index function to convert
       button ID to its index in toolbar.
    }
    property TBCurItem: Integer read DF.fTBCurItem;
    {* |<#toolbar>
       Same as CurItem. }

    property TBButtonCount: Integer read GetItemsCount; //TBGetButtonCount;
    {* |<#toolbar>
       Returns count of buttons on toolbar. The same as Count. }

    property TBBtnImgWidth: Integer read DF.fTBBtnImgWidth write DF.fTBBtnImgWidth;
    {* |<#toolbar>
       Custom toolbar buttons width. Set it before assigning buttons bitmap.
       Changing this property after assigning the bitmap has no effect. }

    function TBItem2Index( BtnID: Integer ): Integer;
    {* |<#toolbar>
       Converts button command id to button index for tool bar. }

    function TBIndex2Item( Idx: Integer ): Integer;
    {* |<#toolbar>
       Converts toolbar button index to its command ID. }

    procedure TBConvertIdxArray2ID( const IdxVars: array of PDWORD );
    {* |<#toolbar>
       Converts toolbar button indexes to its command IDs for an array
       of indexes (each item in the array passed is a pointer to
       Integer, containing button index when the procedure is callled,
       then all these indexes are relaced with a correspondent button ID).}

    property TBButtonEnabled[ BtnID: Integer ]: Boolean index TB_ENABLEBUTTON
             read TBGetBtnStt write TBSetBtnStt;
    {* |<#toolbar>
       Obvious. }

    property TBButtonVisible[ BtnID: Integer ]: Boolean read TBGetButtonVisible
                              write TBSetButtonVisible;
    {* |<#toolbar>
       Allows to hide/show some of toolbar buttons. }

    property TBButtonChecked[ BtnID: Integer ]: Boolean index TB_CHECKBUTTON
             read TBGetBtnStt write TBSetBtnStt;
    {* |<#toolbar>
       Allows to determine 'checked' state of a button (e.g., radio-button),
       and to check it programmatically. }

    property TBButtonMarked[ BtnID: Integer ]: Boolean index TB_MARKBUTTON
             read TBGetBtnStt write TBSetBtnStt;
    {* |<#toolbar>
       Returns True if toolbar button is marked (highlighted). Allows to
       highlight buttons assigning True to this value. }

    property TBButtonPressed[ BtnID: Integer ]: Boolean index TB_PRESSBUTTON
             read TBGetBtnStt write TBSetBtnStt;
    {* |<#toolbar>
       Allows to detrmine if toolbar button (given by its command ID) pressed,
       and press/unpress it programmatically. }

    property TBButtonText[ BtnID: Integer ]: KOLString read TBGetButtonText write TBSetButtonText;
    {* |<#toolbar>
       Obtains toolbar button text and allows to change it. Be sure that text
       is not empty for all buttons, if You want for it to be shown (if at least
       one button has empty text, no text labels will be shown at all). At
       least set it to ' ' for buttons, which You do not want to show labels,
       if You want from other ones to have it. }

    property TBButtonImage[ BtnID: Integer ]: Integer read TBGetBtnImgIdx write TBSetBtnImgIdx;
    {* |<#toolbar>
       Allows to access/change button image. Do not read this property for
       separator buttons, returning value is not proper. If you do not know,
       is the button a separator, using function below. }

    function TBButtonSeparator( BtnID: Integer ): Boolean;
    {* |<#toolbar>
       Returns TRUE, if a toolbar button is separator. }

    property TBButtonRect[ BtnID: Integer ]: TRect read TBGetButtonRect;
    {* |<#toolbar>
       Obtains rectangle occupied by toolbar button in toolbar window.
       (It is not possible to obtain rectangle for buttons, currently
       not visible). See also function ToolbarButtonRect. }

    property TBButtonWidth[ BtnID: Integer ]: Integer read TBGetBtnWidth write TBSetBtnWidth;
    {* |<#toolbar>
       Allows to obtain / change toolbar button width. }

    property TBButtonLParam[const Idx: Integer]: DWORD read TBGetButtonLParam write TBSetButtonLParam;
    {* |<#toolbar>
       Allows to access/change LParam. Dufa }

    property TBButtonsMinWidth: Integer index 0
             {$IFDEF F_P}   read TBGetBtMinMaxWidth
             {$ELSE DELPHI} read DF.fTBBtMinWidth
             {$ENDIF F_P/DELPHI} write TBSetBtMinMaxWidth;
    {* |<#toolbar>
       Allows to set minimal width for all toolbar buttons. }
    property TBButtonsMaxWidth: Integer index 1
             {$IFDEF F_P}   read TBGetBtMinMaxWidth
             {$ELSE DELPHI} read DF.fTBBtMaxWidth
             {$ENDIF F_P/DELPHI} write TBSetBtMinMaxWidth;
    {* |<#toolbar>
       Allows to set maximal width for all toolbar buttons. }

    function TBButtonAtPos( X, Y: Integer ): Integer;
    {* |<#toolbar>
       Returns command ID of button at the given position on toolbar,
       or -1, if there are no button at the position. Value 0 is returned
       for separators. }

    function TBBtnIdxAtPos( X, Y: Integer ): Integer;
    {* |<#toolbar>
       Returns index of button at the given position on toolbar.
       This also can be index of separator button. -1 is returned if
       there are no buttons found at the position. }

    function TBBtnEvent( Idx: Integer ): TOnToolbarButtonClick;
    {* Returns toolbar event handler assigned to a toolbar button
       (by its index). }

    function TBMoveBtn( FromIdx, ToIdx: Integer ): Boolean;
    {* |<#toolbar>
       By TR"]F. Moves button from one position to another. }

    property TBRows: Integer read TBGetRows write TBSetRows;
    {* |<#toolbar>
       Returns number of rows for toolbar and allows to try to set
       desired number of rows (but system can set another number of
       rows in some cases). This property has no effect if tboWrapable
       style not present in Options when toolbar is created. }

    procedure TBSetTooltips( BtnID1st: Integer; const Tooltips: array of PKOLChar );
    {* |<#toolbar>
       Allows to assign tooltips to several buttons. Until this procedure
       is not called, tooltips list is not created and no code is added
       to executable. This method of tooltips maintainance for toolbar buttons
       is useful both for static and dynamic toolbars (meaning "dynamic" -
       toolbars with buttons, deleted and inserted at run-time). }

    function TBBtnTooltip( BtnID: Integer ): KOLString;
    {* |<#toolbar>  Returns tooltip assigned to a toolbar button. }

    property TBAutoSizeButtons: Boolean read GetTBAutoSizeButtons write SetTBAutoSizeButtons;

    property OnTBDropDown: TOnEvent index idx_FOnDropDown
             read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnDropDown {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnDropDown {$ENDIF};
    {* |<#toolbar>
       This event is called for drop down buttons, when user click drop part
       of drop down button. To determine for which button event is called,
       look at CurItem or CurIndex property. It is also possible to use
       common (with combobox) property OnDropDown. }

    property OnTBClick: TOnEvent
             read {$IFDEF EVENTS_DYNAMIC} Get_OnClick {$ELSE} EV.fOnClick {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} SetOnClick {$ELSE} EV.fOnClick{$ENDIF};
    {* |<#toolbar>
       The same as OnClick. }

    property OnTBCustomDraw: TOnTBCustomDraw read DF.fOnTBCustomDraw write SetOnTBCustomDraw;
    {* |<#toolbar>
       An event (mainly) to customize toolbar background. }
    //----------------------------------------------------------------------
    // DateTimePicker
    property OnDTPUserString: TDTParseInputEvent
             read {$IFDEF EVENTS_DYNAMIC} Get_OnDTPUserString {$ELSE} EV.FOnDTPUserString {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnDTPUserString {$ELSE} EV.FOnDTPUserString{$ENDIF};
    {* Special event to parse input from the application. Option dtpoParseInput
       must be set when control is created. }
    property DateTime: TDateTime read GetDateTime write SetDateTime;
    {* DateTime for DateTimePicker control only. }
    property Date: TDateTime read GetDate write SetDate;
    {* Date only for DateTimePicker control only. }
    property Time: TDateTime read GetTime write SetTime;
    {* Time only for DateTimePicker control only. }
    property SystemTime: TSystemTime read Get_SystemTime write Set_SystemTime;
    {* Date and Time as TSystemTime. When assing, use year 0 to set "no value". }
    property DateTimeRange: TDateTimeRange read GetDateTimeRange
      write SetDateTimeRange;
    {* DateTimePicker range. If first date in the agrument assigned is NAN,
       minimum system allowed value is used as the left bound, and if the second is
       NAN, maximum system allowed is used as the right one. }
    property DateTimePickerColors[ Index: TDateTimePickerColor ]: TColor
      read GetDateTimePickerColor write SetDateTimePickerColor;
    property DateTimeFormat: KOLString write SetDateTimeFormat;

    //----------------------------------------------------------------------

    //----------------------------------------------------------------------
    // ScrollBar
    property SBMin: Longint read DF.fSBMinMax.X write SetSBMin;
    {* Minimum scrolling area position. }
    property SBMax: Longint read DF.fSBMinMax.Y write SetSBMax;
    {* Maximum scrolling area position (size of the text or image to be scrolling).
       For case when SCROLL_OLD defined, this value should be set as scrolling
       object size without SBPageSize. }
    property SBMinMax: TPoint read DF.fSBMinMax write SetSBMinMax;
    {* The property to adjust SBMin and SBMax for a single call (set X to a minimum
       and Y to a maximum value). }
    property SBPosition: Integer read DF.fSBPosition write SetSBPosition;
    {* Current scroll position. When set, should be between SBMin and
       SBMax - max(0, SBPageSize-1) }
    property SBPageSize: Integer read DF.fSBPageSize write SetSBPageSize;
    {* }

    property OnSBBeforeScroll: TOnSBBeforeScroll
             read {$IFDEF EVENTS_DYNAMIC} Get_OnSBBeforeScroll {$ELSE} EV.FOnSBBeforeScroll {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnSBBeforeScroll {$ELSE} EV.FOnSBBeforeScroll {$ENDIF};
    {* }
    property OnSBScroll: TOnSBScroll
             read {$IFDEF EVENTS_DYNAMIC} Get_OnSBScroll {$ELSE} EV.FOnSBScroll {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_OnSBScroll {$ELSE} EV.FOnSBScroll {$ENDIF};
    {* }

    function SBSetScrollInfo(const SI: TScrollInfo): Integer;
    function SBGetScrollInfo(var SI: TScrollInfo): Boolean;
    function GetSBMinMax: TPoint;
    function GetSBPageSize: Integer;
    function GetSBPosition: Integer;
    //----------------------------------------------------------------------

    // "Through", or "transparent" methods to simplify initial
    // adjustment of controls and make non-visual designing of
    // forms more easy. All these functions return @Self as a
    // result, so, it is possible to use such methods immediately
    // in constructing statement, concatenating it with dots, e.g.:
    //
    // NewButton( MyForm, 'Click here' ).PlaceUnder.ResizeParentBottom;
    //
    {$ENDIF GDI}
    function PlaceRight: PControl;
    {* Places control right (to previously created on the same parent). }
    function PlaceDown: PControl;
    {* Places control below (to previously created on the same parent).
       Left position is not changed (thus is, kept equal to Parent.Margin). }
    function PlaceUnder: PControl;
    {* Places control below (to previously created one, aligning its
       Left position to Left position of previous control). }
    function SetSize( W, H: Integer ): PControl;
    {* Changes size of a control. If W or H less or equal to 0,
       correspondent size is not changed. }
    {$IFDEF GDI}
    function Size( W, H: Integer ): PControl;
    {* Like SetSize, but provides automatic resizing of parent control
       (recursively). Especially useful for aligned controls. }
    function SetClientSize( W, H: Integer ): PControl;
    {* Like SetSize, but works setting W = ClientWidth, H = ClientHeight.
       Use this method for forms, which can not be resized (dialogs). }

    {$ENDIF GDI}
    function AutoSize( AutoSzOn: Boolean ): PControl;
    {$IFDEF GDI}
    function MakeWordWrap: PControl;

    {* Determines if to autosize control (like label, button, etc.) }
    function IsAutoSize: Boolean;
    {* TRUE, if a control is autosizing. }
    function AlignLeft( P: PControl ): PControl;
    {* assigns Left := P.Left }
    function AlignTop( P: PControl ): PControl;
    {* assigns Top := P.Top }
    function ResizeParent: PControl;
    {* Resizes parent, calling ResizeParentRight and ResizeParentBottom. }
    function ResizeParentRight: PControl;
    {* Resizes parent right edge (Margin of parent is added to right
       coordinate of a control). If called second time (for the same
       parent), resizes only for increasing of right edge of parent. }

    function ResizeParentBottom: PControl;
    {* Resizes parent bottom edge (Margin of parent is added to
       bottom coordinate of a control). }
    function CenterOnParent: PControl;
    {* Centers control on parent, or if applied to a form, centers
       form on screen. }
    function CenterOnForm( Form1: PControl ): PControl;
    {* Centers form on another form. If Form1 not present, centers on screen. }

    function Shift( dX, dY : Integer ): PControl;
    {* Moves control respectively to current position (Left := Left + dX,
       Top := Top + dY). }
    {$ENDIF GDI}
    function SetPosition( X, Y: Integer ): PControl;
    {* Moves control directly to the specified position. }
    {$IFDEF GDI}

    function Tabulate: PControl;
    {* Call it once for form/applet to provide tabulation between controls on
       form/on all forms using TAB / SHIFT+TAB and arrow keys. }
    function TabulateEx: PControl;
    {* Call it once for form/applet to provide tabulation between controls on
       form/on all forms using TAB / SHIFT+TAB and arrow keys. Arrow keys are
       used more smart, allowing go to nearest control in certain direction. }

    function SetAlign( AAlign: TControlAlign ): PControl;
    {* Assigns passed value to property Align, aligning control on parent,
       and returns @Self (so it is "transparent" function, which can be
       used to adjust control at the creation, e.g.:
       ! MyLabel := NewLabel( MyForm, 'Label1' ).SetAlign( caBottom );
       See also property Align. }
    //{-2.95}//function PreventResizeFlicks: PControl;
    { *
       If called, prevents resizing flicks for child controls, aligned to
       right and bottom (but with a lot of code added to executable - about 3,5K).
       There is sensible to set DoubleBuffered to True also to eliminate the
       most of flicks.
       |<br>&nbsp;&nbsp;&nbsp;
       This method been applied to a form, prevents, resizing flicks for
       form and all controls on the form. If it is called for applet window,
       all forms are affected. And if You want, You can apply it for certain
       control only - in such case only given control and its children will
       be resizing without flicks (e.g., using splitter control). } //{-2.95}

    property Checked: Boolean read GetChecked write Set_Checked;
    {* |<#checkbox>
       |<#radiobox>
       |<#bitbtn>
       For checkbox and radiobox - if it is checked. Do not assign
       value for radiobox - use SetRadioChecked instead. }
    function SetChecked(const Value: Boolean): PControl;
    {* |<#checkbox>
       Use it to check/uncheck check box control or push button.
       Do not apply it to check radio buttons - use SetRadioChecked
       method below. }
    function SetRadioChecked : PControl;
    {* |<#radiobox>
       Use it to check radio button item correctly (unchecking all
       alternative ones). Actually, method Click is called, and control
       itself is returned. }
    property Check3: TTriStateCheck read GetCheck3 write SetCheck3;
    {* |<#checkbox>
       State of checkbox with BS_AUTO3STATE style. }
    procedure Click;
    {* |<#button>
       |<#checkbox>
       |<#radiobox>
       Emulates click on control programmatically, sending WM_COMMAND
       message with BN_CLICKED code. This method is sensible only for
       buttons, checkboxes and radioboxes. }

    function Perform( msgcode: DWORD; wParam, lParam: Integer): Integer; stdcall;
    {* Sends message to control's window (created if needed). }
    function Postmsg( msgcode: DWORD; wParam, lParam: Integer): Boolean; stdcall;
    {* Sends message to control's window (created if needed). }
    procedure AttachProc( Proc: TWindowFunc );
    {* It is possible to attach dynamically any message handler to window
       procedure using this method. Last attached procedure is called first.
       If procedure returns True, further processing of a message is stopped.
       Attached procedure can be detached using DetachProc (but do not
       attach/detach procedures during handling of attached procedure -
       this can hang application). }
    procedure AttachProcEx( Proc: TWindowFunc; ExecuteAfterAppletTerminated: Boolean );
    {* The same as AttachProc, but a handler is executed even after terminating
       the main message loop processing (i.e. after assigning true to
       AppletTerminated global variable. }
    function IsProcAttached( Proc: TWindowFunc ): Boolean;
    {* Returns True, if given procedure is already in chain of attached
       ones for given control window proc. }
    procedure DetachProc( Proc: TWindowFunc );
    {* Detaches procedure attached earlier using AttachProc. }

    property OnDropFiles: TOnDropFiles
             read {$IFDEF EVENTS_DYNAMIC} Get_OnDropFiles {$ELSE} EV.FOnDropFiles {$ENDIF}
             write SetOnDropFiles;
    {* Assign this event to your handler, if You want to accept drag and drop
       files from other applications such as explorer onto your control. When
       this event is assigned to a control or form, this has effect also for
       all its child controls too. }

    property CustomData: Pointer read fCustomData write fCustomData;
    {* Can be used to exend the object when new type of control added. Memory,
       pointed by this pointer, released automatically in the destructor. }
    property CustomObj: PObj read fCustomObj write fCustomObj;
    {* Can be used to exend the object when new type of control added. Object,
       pointed by this pointer, released automatically in the destructor. }
    procedure SetAutoPopupMenu( PopupMenu: PObj );
    {* To assign a popup menu to the control, call SetAutoPopupMenu method of
       the control with popup menu object as a parameter. }

    function SupportMnemonics: PControl;
    {* This method provides supporting mnemonic keys in menus, buttons, checkboxes,
       toolbar buttons. }
    property OnScroll: TOnScroll
             read {$IFDEF EVENTS_DYNAMIC} Get_OnScroll {$ELSE} EV.FOnScroll {$ENDIF}
             write SetOnScroll;
    {* }
  public
    {$IFDEF USE_DROPDOWNCOUNT}
    property DropDownCount: Cardinal read DF.fDropDownCount write DF.fDropDownCount;
    {$ENDIF}
  protected
    {$IFDEF USE_GRAPHCTLS}
    {} fKeyboardProcess: TOnMessage; // for graphic controls ???
    {} fSetFocus: procedure(Ctl: PControl);
    {} fPushedBtn: PControl;
    {} fSaveCursor: HCursor;
    function DoGraphCtlPrepaint: TRect;
    procedure GraphicLabelPaint( DC: HDC );
    procedure GraphicCheckBoxPaint( DC: HDC );
    procedure GraphicCheckBoxMouse( var Msg: TMsg );
    procedure GraphicRadioBoxPaint( DC: HDC );
    procedure GraphicButtonPaint( DC: HDC );
    procedure GraphicButtonMouse( var Msg: TMsg );
    function GraphButtonKeyboardProcess( var Msg: TMsg; var Rslt: Integer ): Boolean;
    procedure LeaveGraphButton( Sender: PObj );
    procedure GraphicEditPaint( DC: HDC );
    procedure GraphicEditMouse( var Msg: TMsg );
    procedure DestroyGraphEdit( Sender: PObj );
    procedure LeaveGraphEdit( Sender: PObj );
    procedure ChangeGraphEdit( Sender: PObj );
    procedure GraphCtlDrawFocusRect( DC: HDC; const R: TRect );
    {$IFDEF GRAPHCTL_HOTTRACK}
    procedure MouseLeaveFromParentOfGraphCtl( Sender: PObj );
    {$ENDIF GRAPHCTL_HOTTRACK}
    procedure GroupBoxPaint( DC: HDC );
    {$ENDIF USE_GRAPHCTLS}
  {$IFDEF KEY_PREVIEW}
  public
    property KeyPreview: Boolean
             read {$IFDEF USE_FLAGS} GetKeyPreview {$ELSE} fKeyPreview {$ENDIF}
             write {$IFDEF USE_FLAGS} SetKeyPreview {$ELSE} fKeyPreview {$ENDIF};
    //property KeyPreviewing: Boolean read fKeyPreviewing write fKeyPreviewing;
  {$ENDIF KEY_PREVIEW}
  protected
    fOldWidth: Word;
    fOldHeight: Word;
    fClickDisabled: Byte;
    fAnchors: Byte;
    fNestedMsgHandling: SmallInt;
    {* level of nested message handling for a control. Only when it is 0 at
       the end of message handling and fBeginDestroying set, the control is
       destroyed. }
    fUpdateCount: SmallInt;
  public
    property AnchorLeft: Boolean index ANCHOR_LEFT read GetAnchor write SetAnchor; //+Sormart
    property AnchorTop: Boolean index ANCHOR_TOP read GetAnchor write SetAnchor;    //+Sormart
    property AnchorRight: Boolean index ANCHOR_RIGHT read GetAnchor write SetAnchor;
    property AnchorBottom: Boolean index ANCHOR_BOTTOM read GetAnchor write SetAnchor;
    function Anchor( aLeft, aTop, aRight, aBottom: Boolean ): PControl;
  public
    {$IFDEF USE_CONSTRUCTORS}
    //------------------------------------------------------------
    // constructors here:
    constructor CreateWindowed( AParent: PControl; AClassName: PKOLChar; ACtl3D: Boolean );
    constructor CreateApplet( const ACaption: AnsiString );
    constructor CreateForm( AParent: PControl; const ACaption: AnsiString );
    constructor CreateControl( AParent: PControl; AClassName: PAnsiChar; AStyle: DWORD;
                               {} ACtl3D: Boolean; Actions: PCommandActions );
    constructor CreateButton( AParent: PControl; const ACaption: AnsiString );
    constructor CreateBitBtn( AParent: PControl; const ACaption: AnsiString;
         {} AOptions: TBitBtnOptions; ALayout: TGlyphLayout; AGlyphBitmap: HBitmap;
         {} AGlyphCount: Integer);
    constructor CreateLabel( AParent: PControl; const ACaption: AnsiString );
    constructor CreateWordWrapLabel( AParent: PControl; const ACaption: AnsiString );
    constructor CreateLabelEffect( AParent: PControl; ACaption: AnsiString; AShadowDeep: Integer );
    constructor CreatePaintBox( AParent: PControl );
    constructor CreateGradientPanel( AParent: PControl; AColor1, AColor2: TColor );
    constructor CreateGradientPanelEx( AParent: PControl; AColor1, AColor2: TColor;
                             {} AStyle: TGradientStyle; ALayout: TGradientLayout );
    constructor CreateGroupbox( AParent: PControl; const ACaption: AnsiString );
    constructor CreateCheckbox( AParent: PControl; const ACaption: AnsiString );
    constructor CreateRadiobox( AParent: PControl; const ACaption: AnsiString );
    constructor CreateEditbox( AParent: PControl; AOptions: TEditOptions );
    constructor CreatePanel( AParent: PControl; AStyle: TEdgeStyle );
    constructor CreateSplitter( AParent: PControl; AMinSizePrev, AMinSizeNext: Integer;
                {} EdgeStyle: TEdgeStyle );
    constructor CreateListbox( AParent: PControl; AOptions: TListOptions );
    constructor CreateCombobox( AParent: PControl; AOptions: TComboOptions );
    constructor CreateCommonControl( AParent: PControl; AClassName: PAnsiChar; AStyle: DWORD;
                            {} ACtl3D: Boolean; Actions: PCommandActions );
    constructor CreateRichEdit( AParent: PControl; AOptions: TEditOptions );
    constructor CreateRichEdit1( AParent: PControl; AOptions: TEditOptions );
    constructor CreateProgressbar( AParent: PControl );
    constructor CreateProgressbarEx( AParent: PControl; AOptions: TProgressbarOptions );
    constructor CreateListView( AParent: PControl; AStyle: TListViewStyle; AOptions: TListViewOptions;
                      {} AImageListSmall, AImageListNormal, AImageListState: PImageList );
    constructor CreateTreeView( AParent: PControl; AOptions: TTreeViewOptions;
                      {} AImgListNormal, AImgListState: PImageList );
    constructor CreateTabControl( AParent: PControl; ATabs: array of String;
         {}AOptions: TTabControlOptions; AImgList: PImageList; AImgList1stIdx: Integer );
    constructor CreateToolbar( AParent: PControl; AAlign: TControlAlign; AOptions: TToolbarOptions;
                     {} ABitmap: HBitmap; AButtons: array of PChar;
                     {} ABtnImgIdxArray: array of Integer );
    {$ENDIF USE_CONSTRUCTORS}

    {$IFDEF USE_CUSTOMEXTENSIONS}
      {$I CUSTOM_TCONTROL_EXTENSION.inc}
    {$ENDIF}
    // If an option USE_CUSTOMEXTENSIONS is enabled (at the beginning of this
    // unit), You can freely extend TControl definition by your own fields,
    // methods and properties. This provides You with capability to extend
    // TControl implementing another kinds of visual controls without deriving
    // new descendant objects from TControl. This way is provided to avoid too
    // large grow of executable size. You also can derive your own controls
    // from TControl using standard OOP capabilities. In such case an option
    // USE_CONSTRUCTORS should be turned on (see it at the start of this unit).
    //   If You choose this "flat" model of extending the TControl with your
    // own properties, fieds, methods, events, etc. You should provide three
    // inc-files: CUSTOM_TCONTROL_EXTENSION.inc, containing such definitions
    // for TControl, CUSTOM_KOL_EXTENSION.inc, containing needed global
    // declarations, and CUSTOM_CODE_EXTENSION.inc, the implementation of those
    // two.
    //   Because KOL is always grow and constantly is extending by me, I also can
    // add my own complements for TControl. To avoid naming conflicts, I suggest
    // to use the same naming rule for all of You. Name your fields, properies, etc.
    // using a form idx_SomeName, where idx is a prefix, containing several
    // (at least one) letters and digits. E.g. ZK65_OnSomething.

  protected // rare used fields are moved here from top to make code smaller a bit
      //fFocusHandle: HWnd; // to store handle of focused control of form ?
      FParentWnd: HWnd;   // <<-- ++ for InitOrthaned !!
      fParentCoordX: SmallInt;
      fParentCoordY: SmallInt;
      {$IFDEF USE_MDI}
      fMDIClient: PControl;
      fCreateWindowProc: function(
          lpClassName, lpWindowName: PKOLChar;
          dwStyle: DWORD; X, Y, nWidth, nHeight: Integer;
          hwndParent: HWnd; hInstance: HInst; lParam: Integer ): HWnd;
          stdcall;
      {* MDI client window control }
      {$ENDIF}
      //fMDIChildren: PList;
      //{* List of MDI children. It is filled for MDI client window. }

      {$IFDEF USE_fNCDestroyed}
      {} fNCDestroyed: Boolean;
      {$ENDIF USE_fNCDestroyed}
  public
    {$IFDEF USE_MDI}
    property MDIClient: PControl read fMDIClient; //Get_MDIClient;
    {* For MDI forms only: returns MDI client window control, containng all MDI
       children. Use this window to send specific messages to rule MDI children. }
    {$ENDIF}
    {$IFDEF OBSOLETE_FIELDS}
    {} fPaintLater: Boolean;
    {$ENDIF OBSOLETE_FIELDS}
  // last changes (1-Jul-06) from ECM [Michalichenko Eugeny, rest in peace, friend]:
  //======== ListBox
  private
    function  GetLBTopIndex: Integer;
    procedure SetLBTopIndex(const Value: Integer);
  public
    function LBItemAtPos(X,Y: Integer): Integer;
    {* |<#listbox>
       Return index of item at the given position. }
    property LBTopIndex: Integer read GetLBTopIndex write SetLBTopIndex;
    {* |<#listbox>
       Index of the first visible item in a list box}
  public
    //================== RichEdit specific: ==================
    {$IFNDEF NOT_USE_RICHEDIT}
    property MaxTextSize: DWORD read GetMaxTextSize write SetMaxTextSize;
    {* |<#richedit>
       This property valid also for simple edit control, not only for RichEdit.
       But for usual edit control, maximum text size available is 32K. For
       RichEdit, limit is 4Gb. By default, RichEdit is limited to
       32767 bytes (to set maximum size available to 2Gb, assign MaxInt value
       to a property). Also, to get current text size of RichEdit, use property
       TextSize or RE_TextSize[ ]. }
    property TextSize: Integer read GetTextSize;
    {* |<#richedit>
       Common for edit and rich edit controls property, which returns size of
       text in edit control. Also, for any other control (or form, or applet
       window) returns size (in characters) of Caption or Text (what is, the
       same property actually). }
    property RE_TextSize[ Units: TRichTextSize ]: Integer read REGetTextSize;
    {* |<#richedit>
       For RichEdit control, it returns text size, measured in desired units
       (rtsChars - characters, including OLE objects, counted as a single
       character; rtsBytes - presize length of text image (if it would be stored
       in file or stream). Please note, that for RichEdit1.0, only size in
       characters can be obtained. }
    function RE_TextSizePrecise: Integer;
    {* |<#richedit>
       By Savva. Returns length of rich edit text. }

    property RE_CharFmtArea: TRichFmtArea read DF.fRECharArea write DF.fRECharArea;
    {* |<#richedit>
       By default, this property is raSelection. Changing it, You determine in
       for which area characters format is applyed, when changing
       character formatting properties below (not paragraph formatting).
       |&A=<a href=#RE_CharFmtArea target=main>%0</a>
    }
    property RE_CharFormat: TCharFormat read REGetCharformat write RESetCharFormat;
    {* |<#richedit>
       In differ to follow properties, which allow to control certain formatting
       attributes, this property provides low level access for formatting current
       character area (see RE_CharFmtArea). It returns TCharFormat structure,
       filled in with formatting attributes, and by assigning another value to
       this property You can change desired attributes as You wish. Even if
       RichEdit1.0 is used, TCharFormat2 is returned (but extended fields are
       ignored for RichEdit1.0). }
    property RE_Font: PGraphicTool read REGetFont write RESetFont;
    {* |<#richedit>
       Font of the first character in current selection (when retrieve).
       When set (or subproperties of RE_Font are set), all font attributes are
       applied to entire <A area>. To apply only needed attributes, use another
       properties: RE_FmtBold, RE_FmtItalic, RE_FmtStrikeout, RE_FmtUnderline,
       RE_FmtName, etc.
       |<br>
       Note, that font size is measured in twips, which is about 1/10 of pixel. }
    property RE_FmtBold: Boolean index CFM_BOLD read REGetFontEffects write RESetFontEffect;
    {* |<#richedit>
       Formatting flag. When retrieve, returns True, if fsBold style RE_Font.FontStyle
       is valid for a first character in the selection. When set, changes fsBold
       style (True - set, False - reset) for all characters in <A area>. }
    property RE_FmtBoldValid: Boolean index CFM_BOLD read REGetFontMask;
    {* }
    property RE_FmtItalic: Boolean index CFM_ITALIC read REGetFontEffects write RESetFontEffect;
    {* |<#richedit>
       Formatting flag. Like RE_FmtBold, when retrieving, shows, is fsItalic
       style valid for the first character of the selection, and when set, changes
       only fsItalic style for an <A area>. }
    property RE_FmtItalicValid: Boolean index CFM_ITALIC read REGetFontMask;
    {* }
    property RE_FmtStrikeout: Boolean index CFM_STRIKEOUT read REGetFontEffects write RESetFontEffect;
    {* |<#richedit>
       Formatting flag. Like RE_FmtBold, when retrieving, shows, is fsStrikeout
       style valid for the first selected character, and when set, changes only
       fsStrikeout style for an <A area>. }
    property RE_FmtStrikeoutValid: Boolean index CFM_STRIKEOUT read REGetFontMask;
    {* }
    property RE_FmtUnderline: Boolean index CFM_UNDERLINE read REGetFontEffects write RESetFontEffect;
    {* |<#richedit>
       Formatting flag. Like RE_FmtBold, when retrieving, shows, is fsUnderline
       style valid for the first selected character, and when set, changes
       fsUnderline style for an <A area>. }
    property RE_FmtUnderlineValid: Boolean index CFM_UNDERLINE read REGetFontMask;
    {* }
    property RE_FmtUnderlineStyle: TRichUnderline
             read REGetUnderlineEx write RESetUnderlineEx;
    {* |<#richedit>
       Extended underline style. To check, if this property is valid for
       entire selection, examine RE_FmtUnderlineValid value. }
    property RE_FmtProtected: Boolean index CFM_PROTECTED read REGetFontEffects write RESetFontEffect;
    {* |<#richedit>
       Formatting flag. When retrieving, shows, is the first character of the selection
       is protected from changing it by user (True) or not (False). To get know,
       if retrived value is valid for entire selection, check the property
       RE_FmtProtectedValid. When set, makes all characters in <A area> protected (
       True) or not (False). }
    property RE_FmtProtectedValid: Boolean index CFM_PROTECTED read REGetFontMask;
    {* |<#richedit>
       True, if property RE_FmtProtected is valid for entire selection, when
       retrieving it. }
    property RE_FmtHidden: Boolean index CFM_HIDDEN read REGetFontEffects write RESetFontEffect;
    {* |<#richedit>
       For RichEdit3.0, makes text hidden (not displayed). }
    property RE_FmtHiddenValid: Boolean index CFM_HIDDEN read REGetFontMask;
    {* |<#richedit>
       Returns True, if RE_FmtHidden style is valid for entire selection. }

    property RE_FmtLink: Boolean index $20 {CFM_LINK} read REGetFontEffects write RESetFontEffect;
    {* |<#richedit>
       Returns True, if the first selected character is a part of link (URL). }
       // by Sergey Shisminzev

    property RE_FmtLinkValid: Boolean index $20 {CFM_LINK} read REGetFontMask;
    {* }
    property RE_FmtFontSize: Integer index (12 shl 16) or CFM_SIZE read REGetFontAttr write RESetFontAttr;
    {* |<#richedit>
       Formatting value: font size, in twips (1/1440 of an inch, or 1/20 of a
       printer's point, or about 1/10 of pixel). When retrieving, returns
       RE_Font.FontHeight.
       When set, changes font size for entire <A area> (but does not change
       other font attributes). }
    property RE_FmtFontSizeValid: Boolean read REGetFontSizeValid;
    {* |<#richedit>
       Returns True, if property RE_FmtFontSize is valid for entire selection,
       when retrieving it. }
    property RE_FmtAutoBackColor: Boolean index CFM_BACKCOLOR read REGetFontEffects write RESetFontEffect;
    {* |<#richedit>
       True, when automatic back color is used. }
    property RE_FmtAutoBackColorValid: Boolean index CFM_BACKCOLOR read REGetFontMask;
    {* }
    property RE_FmtFontColor: Integer index (20 shl 16) or CFM_COLOR read REGetFontAttr write RESetFontAttr1;
    {* |<#richedit>
       Formatting value (font color). When retrieving, returns RE_Font.Color.
       When set, changes font color for entire <A area> (but does not change
       other font attributes). }
    property RE_FmtFontColorValid: Boolean index CFM_COLOR read REGetFontMask;
    {* |<#richedit>
       Returns True, if property RE_FmtFontColor valid for entire selection,
       when retrieving it. }
    property RE_FmtAutoColor: Boolean index CFM_COLOR read REGetFontEffects write RESetFontEffect;
    {* |<#richedit>
       True, when automatic text color is used (in such case, RE_FmtFontColor
       assignment is ignored for current area). }
    property RE_FmtAutoColorValid: Boolean index CFM_COLOR read REGetFontMask;
    {* }
    property RE_FmtBackColor: Integer index ((64
             {$IFDEF UNICODE_CTRLS} + 32 {$ENDIF}
              ) shl 16) or CFM_BACKCOLOR read REGetFontAttr write RESetFontAttr1;
    {* |<#richedit>
       Formatting value (back color). Only available for Rich Edit 2.0 and higher.
       When set, changes background color for entire <A area> (but does not change
       other font attributes). }
    property RE_FmtBackColorValid: Boolean index CFM_BACKCOLOR read REGetFontMask;
    {* }
    property RE_FmtFontOffset: Integer index (16 shl 16) or CFM_OFFSET read REGetFontAttr write RESetFontAttr;
    {* |<#richedit>
       Formatting value (font vertical offset from baseline, positive values
       correspond to subscript). When retrieving, returns offset for first
       character in the selection. When set, changes font offset for entire
       <A area>. To get know, is retrieved value valid for entire selction,
       check RE_FmtFontOffsetValid property. }
    property RE_FmtFontOffsetValid: Boolean index CFM_OFFSET read REGetFontMask;
    {* |<#richedit>
       Returns True, if property RE_FmtFontOffset is valid for entire selection,
       when retrieving it. }
    property RE_FmtFontCharset: Integer index (25 shl 16) or CFM_CHARSET read REGetFontAttr write RESetFontAttr;
    {* |<#richedit>
       Returns charset for first character in current selection, when retrieved
       (and to get know, if this value is valid for entire selection, check
       property RE_FmtFontCharsetValid). When set, changes charset for all
       characters in <A area>, but does not alter other formatting attributes. }
    property RE_FmtFontCharsetValid: Boolean index CFM_CHARSET read REGetFontMask;
    {* |<#richedit>
       Returns True, only if rerieved property RE_FmtFontCharset is valid for
       entire selection. }
    property RE_FmtFontName: KOLString read REGetFontName write RESetFontName;
    {* |<#richedit>
       Returns font face name for first character in the selection, when retrieved,
       and sets font name for entire <A area>, wnen assigned to (without
       changing of other formatting attributes). To get know, if retrived
       font name valid for entire selection, examine property RE_FmtFontNameValid. }
    property RE_FmtFontNameValid: Boolean index CFM_FACE read REGetFontMask;
    {* |<#richedit>
       Returns True, only if the font name is the same for entire selection,
       thus is, if rerieved property value RE_FmtFontName is valid for entire
       selection. }

    property RE_ParaFmt: TParaFormat read REGetParaFmt write RESetParaFmt;
    {* |<#richedit>
       Allows to retrieve or set paragraph formatting attributes for currently
       selected paragraph(s) in RichEdit control. See also following properties,
       which allow to do the same for certain paragraph format attributes
       separately. }
    property RE_TextAlign: TRichTextAlign read REGetTextAlign write RESetTextAlign;
    {* |<#richedit>
       Returns text alignment for current selection and allows to change it
       (without changing other formatting attributes). }
    property RE_TextAlignValid: Boolean index PFM_ALIGNMENT read REGetParaAttrValid;
    {* |<#richedit>
       Returns True, if property RE_TextAlign is valid for entire selection. If
       False, it is concerning only start of selection. }
    property RE_Numbering: Boolean read REGetNumbering write RESetNumbering;
    {* |<#richedit>
       Returns True, if selected text is numbered (or has style of list with
       bullets). To get / change numbering style, see properties
       RE_NumStyle and RE_NumBrackets. }
    property RE_NumStyle: TRichNumbering read REGetNumStyle write RESetNumStyle;
    {* |<#richedit>
       Advanced numbering style, such as rnArabic etc. If You use it, do not
       change RE_Numbering property simultaneously - this can cause changing
       style to rnBullets only. }
    property RE_NumStart: Integer read REGetNumStart write RESetNumStart;
    {* |<#richedit>
       Starting number for advanced numbering style. If this property is not
       set, numbering is starting by default from 0. For rnLRoman and rnURoman
       this cause, that first item has no number to be shown (ancient Roman
       people did not invent '0'). }
    property RE_NumBrackets: TRichNumBrackets read REGetNumBrackets write RESetNumBrackets;
    {* |<#richedit>
       Brackets style for advanced numbering. rnbPlain is default
       brackets style, and every time, when RE_NumStyle is changed,
       RE_NumBrackets is reset to rnbPlain. }
    property RE_NumTab: Integer read REGetNumTab write RESetNumTab;
    {* |<#richedit>
       Tab between start of number and start of paragraph text. If too small too
       view number, number is not displayed. (Default value seems to be sufficient
       though). }
    property RE_NumberingValid: Boolean index PFM_NUMBERING read REGetParaAttrValid;
    {* |<#richedit>
       Returns True, if RE_Numbering, RE_NumStyle, RE_NumBrackets, RE_NumTab,
       RE_NumStart properties are valid for entire selection. }
    property RE_Level: Integer read REGetLevel;
    {* |<#richedit>
       Outline level (for numbering paragraphs?). Read only. }
    property RE_SpaceBefore: Integer index 0 or PFM_SPACEBEFORE read REGetSpacing write RESetSpacing;
    {* |<#richedit>
       Spacing before paragraph. }
    property RE_SpaceBeforeValid: Boolean index PFM_SPACEBEFORE read REGetParaAttrValid;
    {* |<#richedit>
       True, if RE_SpaceBefore value is valid for all selected paragraph (if
       False, this value is valid only for first paragraph. }
    property RE_SpaceAfter: Integer index 4 or PFM_SPACEAFTER read REGetSpacing write RESetSpacing;
    {* |<#richedit>
       Spacing after paragraph. }
    property RE_SpaceAfterValid: Boolean index PFM_SPACEAFTER read REGetParaAttrValid;
    {* |<#richedit>
       True, only if RE_SpaceAfter value is valid for all selected paragraphs. }
    property RE_LineSpacing: Integer index 8 or PFM_LINESPACING read REGetSpacing write RESetSpacing;
    {* |<#richedit>
       Linespacing in paragraph (this value is based on RE_SpacingRule property). }
    property RE_SpacingRule: Integer read REGetSpacingRule write RESetSpacingRule;
    {* |<#richedit>
       Linespacing rule. Do not know what is it. }
    property RE_LineSpacingValid: Boolean index PFM_LINESPACING read REGetParaAttrValid;
    {* |<#richedit>
       True, only if RE_LineSpacing and RE_SpacingRule values are valid for
       entire selection. }
    property RE_Indent: Integer index (20 shl 16) or PFM_OFFSET read REGetParaAttr write RESetParaAttr;
    {* |<#richedit>
       Returns left indentation for paragraph in current selection and allows
       to change it (without changing other formatting attributes). }
    property RE_IndentValid: Boolean index PFM_OFFSET read REGetParaAttrValid;
    {* |<#richedit>
       Returns True, if RE_Indent property is valid for entire selection. }
    property RE_StartIndent: Integer index (12 shl 16) or PFM_STARTINDENT read REGetParaAttr write RESetParaAttr;
    {* |<#richedit>
       Returns left indentation for first line in paragraph for current
       selection, and allows to change it (without changing other formatting
       attributes). }
    property RE_StartIndentValid: Boolean read REGetStartIndentValid;
    {* |<#richedit>
       Returns True, if property RE_StartIndent is valid for entire selection. }
    property RE_RightIndent: Integer index (16 shl 16) or PFM_RIGHTINDENT read REGetParaAttr write RESetParaAttr;
    {* |<#richedit>
       Returns right indent for paragraph in current selection, and allow to
       change it (without changing other formatting attributes). }
    property RE_RightIndentValid: Boolean index PFM_RIGHTINDENT read REGetParaAttrValid;
    {* |<#richedit>
       Returns True, if property RE_RightIndent is valid for entire selection only. }
    property RE_TabCount: Integer read REGetTabCount write RESetTabCount;
    {* |<#richedit>
       Number of tab stops in current selection. This value can not be set greater
       then MAX_TAB_COUNT (32). }
    property RE_Tabs[ Idx: Integer ]: Integer read REGetTabs write RESetTabs;
    {* |<#richedit>
       Tab stops for RichEdit control. }
    property RE_TabsValid: Boolean index PFM_TABSTOPS read REGetParaAttrValid;
    {* |<#richedit>
       Returns True, if properties RE_Tabs[ ] and RE_TabCount are valid for
       entire selection. }

    // following does not work now :
    property RE_BorderWidth[ Side: TBorderEdge ]: Integer index 2 read REGetBorder write RESetBorder;
    { * |<#richedit>
       Border width. }
    property RE_BorderSpace[ Side: TBorderEdge ]: Integer index 0 read REGetBorder write RESetBorder;
    { * |<#richedit>
       Border space. }
    property RE_BorderStyle[ Side: TBorderEdge ]: Integer index 4 read REGetBorder write RESetBorder;
    { * |<#richedit>
       Border style. }
    property RE_BorderValid: Boolean index PFM_BORDER read REGetParaAttrValid;
    { * |<#richedit>
       Returns True, if border style, space and width are the same for all
       paragraphs in selection. }
    property RE_Table: Boolean index $C000 read REGetParaEffect write RESetParaEffect;
    { * |<#richedit>
       True, if current paragraph is a part of table (row, cell or cell end).
       seems working as read only property. }
    // end of experiment section

    function RE_FmtStandard: PControl;
    {* |<#richedit>
       "Transparent" method (returns @Self as a result), which (when called)
       provides "standard" keyboard interface for formatting Rich text (just
       call this method, for example:
       !    RichEd1 := NewRichEdit( Panel1, [ ] ).SetAlign( caClient ).RE_FmtStandard;
       Following keys will be maintained additionally:
       |<pre>
       CTRL+I - switch "Italic",
       CTRL+B - switch "Bold",
       CTRL+U - switch "Underline",
       CTRL+SHIFT+U - swith underline type
                    and turn underline on (note, that some of underline styles
                    can not be shown properly in RichEdit v2.0 and lower,
                    though RichEdit2.0 stores data successfully).
       CTRL+O - switch "StrikeOut",
       CTRL+'gray+' - increase font size,
       CTRL+'gray-' - decrease font size,
       CTRL+SHIFT+'gray+' - superscript,
       CTRL+SHIFT+'gray-' - subscript.
       CTRL+SHIFT+Z - ReDo
       |</pre>
       And, though following standard formatting keys are provided by RichEdit
       control itself in Windows2000, some of these are not functioning
       automatically in earlier Windows versions, even for RichEdit2.0. So,
       functionality of some of these (marked with (*) ) are added here too:
       |<pre>
       CTRL+L - align paragraph left,           (*)
       CTRL+R - align paragraph right,          (*)
       CTRL+E - align paragraph center,         (*)
       CTRL+A - select all,                     (*)
       double-click on word - select word,
       CTRL+Right - to next word,
       CTRL+Left - to previous word,
       CTRL+Home - to the beginning of text,
       CTRL+End - to the end of text.
       CTRL+Z - UnDo
       |</pre>
       If You originally assign some (plain) text to Text property, switching "underline"
       can also change other font attributes, e.g., "bold" - if fsBold style is
       in default Font. To prevent such behavior, select entire text first (see
       SelectAll) and make assignment to RE_Font property, e.g.:
       !        RichEd1.SelectAll;
       !        RichEd1.RE_Font := RichEd1.RE_Font;
       !        RichEd1.SelLength := 0;
       |<br>
       And, some other notices about formatting. Please remember, that only True
       Type fonts can be succefully scaled and transformed to get desired effects
       (e.g., bold). By default, RichEdit uses System font face name, which can
       even have problems with fsBold style. Please remember also, that assigning
       RE_Font to RE_Font just initializying formatting attributes, making all
       those valid in entire text, but does not change font attributes. To use
       True Type font, directly assign face name You wish, e.g.:
       !        RichEd1.SelectAll;
       !        RichEd1.RE_Font := RichEd1.RE_Font;
       !        RichEd1.RE_Font.FontName := 'Arial';
       !        RichEd1.SelLength := 0;
    }
    procedure RE_CancelFmtStandard;
    {* Cancels RE_FmtStandard (detaching window procedure handler). }
    property RE_AutoKeyboard: Boolean index 1 read REGetLangOptions write RESetLangOptions;
    {* |<#richedit>
       True if autokeyboard on (lovely "feature" of automatic switching keyboard
       language when caret is over another language text). For older RichEdit,
       is 'on' always, for newest - 'off' by default. }
    property RE_AutoFont: Boolean index 2 read REGetLangOptions write RESetLangOptions;
    {* |<#richedit>
       True if autofont on (automatic switching font when keyboard layout is
       changes). By default, is 'on' always. It is suggested to turn this option
       off for Unicode control. }
    property RE_AutoFontSizeAdjust: Boolean index 16 read REGetLangOptions write RESetLangOptions;
    {* |<#richedit>
       See IMF_AUTOFONTSIZEADJUST option in SDK:
       Font-bound font sizes are scaled from insertion point size according to
       script. For example, Asian fonts are slightly larger than Western ones.
       This option is turned on by default. }
    property RE_DualFont: Boolean index 128 read REGetLangOptions write RESetLangOptions;
    {* |<#richedit>
       See IMF_DUALFONT option in SDK:
       Sets the control to dual-font mode. Used for Asian language support.
       The control uses an English font for ASCII text and a Asian font for
       Asian text. }
    property RE_UIFonts: Boolean index 32 read REGetLangOptions write RESetLangOptions;
    {* |<#richedit>
       See IMF_UIFONTS option in SDK:
       Use user-interface default fonts. This option is turned off by default. }
    property RE_IMECancelComplete: Boolean index 4 read REGetLangOptions write RESetLangOptions;
    {* |<#richedit>
       See IMF_IMECANCELCOMPLETE option in SDK:
       This flag determines how the control uses the composition string of an
       IME if the user cancels it. If this flag is set, the control discards
       the composition string. If this flag is not set, the control uses the
       composition string as the result string. }
    property RE_IMEAlwaysSendNotify: Boolean index 8 read REGetLangOptions write RESetLangOptions;
    {* |<#richedit>
       See IMF_IMEALWAYSSENDNOTIFY option in SDK:
       Controls how Rich Edit notifies the client during IME composition:
       |<br>
       0: No EN_CHANGED or EN_SELCHANGE notifications during undetermined state.
          Send notification when final string comes in. (default)
       |<br>
       1: Send EN_CHANGED and EN_SELCHANGE events during undetermined state. }

    property RE_OverwriteMode: Boolean read REGetOverwite write RESetOverwrite;
    {* |<#richedit>
       This property allows to control insert/overwrite mode. First, to examine, if
       insert or overwrite mode is current (but it is necessary either to
       access this property, at least once, immediately after creating RichEdit
       control, or to assign event OnRE_InsOvrMode_Change to your handler).
       Second, to set desired mode programmatically - by assigning value to
       this property (You also have to initialize monitoring procedure by either
       reading RE_OverwriteMode property or assigning handler to event
       OnRE_InsOvrMode_Change immediately following RichEdit control creation). }
    property OnRE_InsOvrMode_Change: TOnEvent index idx_FOnREInsModeChg
             read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnREInsModeChg {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnREInsModeChg {$ENDIF};
    {* |<#richedit>
       This event is called, whenever key INSERT is pressed in control (and for
       RichEdit, this means, that insert mode is changed). }
    property RE_DisableOverwriteChange: Boolean read DF.fReOvrDisable write RESetOvrDisable;
    {* |<#richedit>
       It is possible to disable switching between "insert" and "overwrite" mode
       by user (therefore, event OnRE_InsOvrMode_Change continue works, but it
       just called when key INSERT is pressed, though RE_OverwriteMode property
       is not actually changed if switching is disabled). }

    function RE_LoadFromStream( Stream: PStream; Length: Integer;
                                {} Format: TRETextFormat; SelectionOnly: Boolean ): Boolean;
    {* |<#richedit>
       Use this method rather then assignment to RE_Text property, if
       source is stored in file or stream (to minimize resources during
       loading of RichEdit content). Data is loading starting from current
       position in stream and no more then Length bytes are loaded (use -1
       value to load to the end of stream). Loaded data replaces entire
       content of RichEdit control, or selection only, depending on SelectionOnly
       flag.
       |<br>&nbsp;&nbsp;&nbsp;
       If You want to provide progress (e.g. in form of progress bar), assign
       OnProgress event to your handler - and to examine current position of
       loading, read TSream.Position property of soiurce stream). }
    function RE_SaveToStream( Stream: PStream; Format: TRETextFormat; SelectionOnly: Boolean ): Boolean;
    {* |<#richedit>
       Use this method rather then RE_TextProperty to store data to file
       or stream (to minimize resources during saving of RichEdit content).
       Data is saving starting from current position in a stream (until
       end of RichEdit data). If SelectionOnly flag is True, only selected
       part of RichEdit text is saved.
       |<br>&nbsp;&nbsp;&nbsp;
       Like for RE_LoadFromStream, it is possible to assign your method to
       OnProgress event (but to calculate progress of save-to-stream operation,
       compare current stream position with RE_Size[ rsBytes ] property
       value). }

    property OnProgress: TOnEvent index idx_FOnProgress
             read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnProgress {$ENDIF}
             write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnProgress {$ENDIF};
    {* |<#richedit>
       This event is called during RE_SaveToStream, RE_LoadFromStream (and also
       during RE_SaveToFile, RE_LoadFromFile and while accessing or changing
       RE_Text property). To calculate relative progress, it is possible to
       examine current position in stream/file with its total size while reading,
       or with rich edit text size, while writing (property RE_TextSize[ rsBytes ]).
    }
    function RE_LoadFromFile( const Filename: KOLString; Format: TRETextFormat;
             {} SelectionOnly: Boolean ): Boolean;
    {* |<#richedit>
       Use this method rather then other assignments to RE_Text property,
       if a source for RichEdit is the file. See also RE_LoadFromStream. }
    function RE_SaveToFile( const Filename: KOLString; Format: TRETextFormat;
             {} SelectionOnly: Boolean ): Boolean;
    {* |<#richedit>
       Use this method rather then other similar, if You want to store
       entire content of RichEdit or selection only of RichEdit to a file. }

    property RE_Text[ Format: TRETextFormat; SelectionOnly: Boolean ]: KOLString read REReadText write REWriteText;
    {* |<#richedit>
       This property allows to get / replace content of RichEdit control
       (entire text or selection only). Using different formats, it is
       possible to exclude or replace undesired formatting information
       (see TRETextFormat specification). To get or replace entire text
       in reText mode (plain text only), it is possible to use habitual
       for edit controls Text property.
       |<br>&nbsp;&nbsp;&nbsp;
       Note: it is possible to append text to the end of RichEdit control
       using method Add, but only if property RE_Text is accessed at least
       once:
       !               RichEdit1.RE_Text[ reText, True ];
       (This line can be written immediatelly after creating RichEdit control). }

    procedure RE_Append( const S: KOLString; ACanUndo: Boolean );
    {* }
    procedure RE_InsertRTF( const S: KOLString );
    {* }
    property RE_Error: Integer read DF.fREError;
    {* |<#richedit>
       Contains error code, if access to RE_Text failed. }

    procedure RE_HideSelection( aHide: Boolean );
    {* |<#richedit>
       Allows to hide / show selection in RichEdit. }

    function RE_SearchText( const Value: KOLString; MatchCase, WholeWord, ScanForward: Boolean;
                            SearchFrom, SearchTo: Integer ): Integer;
    {* |<#richedit>
       Searches given string starting from SearchFrom position up to SearchTo
       position (to the end of text, if SearchTo is -1). Returns zero-based
       character position of the next match, or -1 if there are no more matches.
       To search in bacward direction, set ScanForward to False, and pass
       SearchFrom > SearchTo (or even SearchFrom = -1 and SearchTo = 0). }
    {$IFNDEF DISABLE_DEPRECATED}
    {$IFNDEF _FPC}
    {$IFNDEF _D2} //------- KOLWideString not supported in D2
    function RE_WSearchText( const Value: KOLWideString; MatchCase, WholeWord, ScanForward: Boolean;
                            SearchFrom, SearchTo: Integer ): Integer;
    {* |<#richedit>
       Searches given string starting from SearchFrom position up to SearchTo
       position (to the end of text, if SearchTo is -1). Returns zero-based
       character position of the next match, or -1 if there are no more matches.
       To search in bacward direction, set ScanForward to False, and pass
       SearchFrom > SearchTo (or even SearchFrom = -1 and SearchTo = 0). }
    {$ENDIF}
    {$ENDIF}
    {$ENDIF DISABLE_DEPRECATED}

    property RE_AutoURLDetect: Boolean read REGetAutoURLDetect write RESetAutoURLDetect;
    {* |<#richedit>
       If set to True, automatically detects URLs (and highlights it with
       blue color, applying fsItalic and fsUnderline font styles (while
       typing and loading). Default value is False. Note: if event OnRE_URLClick
       or event OnRE_OverURL are set, property RE_AutoURLDetect is set to True
       automatically. }

    property RE_URL: PKOLChar read DF.fREUrl;
    {* |<#richedit>
       Detected URL (valid in OnRE_OverURL and OnRE_URLClick event handlers). }
    property OnRE_OverURL: TOnEvent index 0 read {$IFDEF EVENTS_DYNAMIC} REGetOnURL {$ELSE}
             {$IFDEF F_P}   REGetOnURL
             {$ELSE DELPHI} EV.fOnREOverURL
             {$ENDIF F_P/DELPHI} {$ENDIF} write RESetOnURL;
    {* |<#richedit>
       Is called when mouse is moving over URL. This can be used to set
       cursor, for example, depending on type of URL (to determine URL type
       read property RE_URL). }
    property OnRE_URLClick: TOnEvent index 8 read {$IFDEF EVENTS_DYNAMIC} REGetOnURL {$ELSE}
             {$IFDEF F_P}   REGetOnURL
             {$ELSE DELPHI} EV.fOnREURLClick
             {$ENDIF F_P/DELPHI} {$ENDIF} write RESetOnURL;
    {* |<#richedit>
       Is called when click on URL detected. }

    //property RE_SelectionBar: Boolean read REGetSelectionBar write RESetSelectionBar;
    //{* ??? - don't know that is this... }
    function RE_NoOLEDragDrop: PControl;
    {* |<#richedit>
       Just prevents drop OLE objects to the rich edit control. Seems not
       working for some cases. }

    //function RE_Wyswig: PControl;

    function RE_Bottomless: PControl;
    // finished ?

    property RE_Transparent: Boolean read REGetTransparent write RESetTransparent;
    {* |<#richedit>
       Use this property to make richedit control transparent, instead of
       Ed_Transparent or Transparent. But do not place such transparent
       richedit control directly on form - it can be draw incorrectly when
       form is activated and rich editr control is not current active control.
       Use at least panel as a parent instead.
       }
    property RE_Zoom: TSmallPoint read REGetZoom write RESetZoom;
    {* |<#richedit>
       To set zooming for rich edit control (3.0 and above), pass X as numerator
       and Y as denominator. Resulting X/Y must be between 1/64 and 64. }
    {$ENDIF NOT_USE_RICHEDIT}

    //========== both for Edit and RichEdit: =====================
    function CanUndo: Boolean;
    {* |<#richedit>
       |<#edit>
       |<#memo>
       Returns True, if the edit (or RichEdit) control can correctly process
       the EM_UNDO message. }
    procedure EmptyUndoBuffer;
    {* |<#richedit>
       |<#edit>
       |<#memo>
       Reset the undo flag of an edit control, preventing undoing all previous
       changes. }
    function Undo: Boolean;
    {* |<#richedit>
       |<#edit>
       |<#memo>
       For a single-line edit control, the return value is always TRUE. For a
       multiline edit control and RichEdit control, the return value is TRUE if
       the undo operation is successful, or FALSE if the undo operation fails. }

  public
    property PropInt[ PropName: PKOLChar ]: Integer read Get_Prop_Int write Set_Prop_Int;
    {* For any windowed control: use it to store desired property in window
       properties. }
    {$IFNDEF NOT_USE_RICHEDIT}
    function RE_Redo: Boolean;
    procedure FreeCharFormatRec;
    {* |<#richedit>
       Only for RichEdit control: Returns True if successful. }
    {$ENDIF NOT_USE_RICHEDIT}
  public
    aAutoSzX: Byte;
    aAutoSzY: Byte;
  protected
    fAlign: TControlAlign;
    fAligning:TAlignings;
{$ENDIF GDI}
  public
    property Align: TControlAlign read FAlign write Set_Align;
    {* Align style of a control. If this property is not used in your
       application, there are no additional code added. Aligning of
       controls is made in KOL like in VCL. To align controls when
       initially create ones, use "transparent" function SetAlign
       ("transparent" means that it returns @Self as a result).
       |<br>
       Note, that it is better not to align combobox caClient, caLeft or
       caRight (better way is to place a panel with Border = 0 and
       EdgeStyle = esNone, align it as desired and to place a combobox on it
       aligning caTop or caBottom). Otherwise, big problems could be under
       Win9x/Me, and some delay could occur under any other systems.
       |<br> Do not attempt to align some kinds of controls (like combobox)
       caLeft or caRight, this can cause infinite recursion. }
    property SizeRedraw: Boolean
             read {$IFDEF USE_FLAGS} Get_SizeRedraw {$ELSE} fSizeRedraw {$ENDIF}
             write {$IFDEF USE_FLAGS} Set_SizeRedraw {$ELSE} fSizeRedraw {$ENDIF};
    procedure ResetEvent( idx: Integer );
     {$IFDEF FINAL_MARKER}
     protected
     ffinal_offset: Boolean;
     {$ENDIF}
  end;

  {$IFDEF USE_MHTOOLTIP}
  {$DEFINE interface_part}
  {$I KOLMHToolTip_interface.inc}
  {$UNDEF interface_part}
  {$ENDIF}

  {$IFDEF USE_MHTOOLTIP}
  {$DEFINE interface_2}
  {$I KOLMHToolTip_intf2.inc}
  {$UNDEF interface_2}
  {$ENDIF}

{$IFDEF EVENTS_DYNAMIC}
var EmptyEvents: TEvents;
{$ENDIF}

function  DummyProc123_TRUE( Dummy: Pointer; Sender: PControl; param3: Integer ): Boolean;
function  DummyProc123_0( Dummy: Pointer; Sender: PObj; param3: Integer ): Integer;
function  DummyProc4_TRUE( Dummy: Pointer; Sender: PControl; p3, p4: Integer ): Boolean;
function  DummyProc5_TRUE( Dummy: Pointer; Sender: PControl; p3, p4, p5: Integer ): Boolean;
procedure DummyOnLVDataProc( Dummy: Pointer; Sender: PControl; Idx, SubItem: Integer;
          var Txt: KOL_String; var ImgIdx: Integer; var State: DWORD;
          var Store: Boolean );
function  DummyProc4_0( Dummy: Pointer; Sender: PControl; p3, p4: Integer ): Integer;
function  DummyOnDrawItemProc( Dummy:Pointer; Sender: PObj; DC: HDC; const Rect: TRect; ItemIdx: Integer;
          DrawAction: TDrawAction; ItemState: TDrawState ): Boolean;
function  DummyOnLVCustomDrawProc( Dummy: Pointer; Sender: PControl; DC: HDC; Stage: DWORD;
          ItemIdx, SubItemIdx: Integer; const Rect: TRect;
          ItemState: TDrawState; var TextColor, BackColor: TColor ): DWORD;
function  DummyOnSBBeforeScrollProc(Dummy: Pointer; Sender: PControl;
          OldPos, NewPos: Integer; Cmd: Word; var AllowChange: Boolean): Boolean;

{$IFDEF USE_GRAPHCTLS}
procedure InvalidateWindowed( Sender: PObj );
procedure InvalidateNonWindowed( Sender: PObj );
{$ENDIF}

function FormNewLabel( Form: PControl ): PControl;
function FormNewWordWrapLabel( Form: PControl ): PControl;
function FormNewLabelEffect( Form: PControl ): PControl;
function FormNewButton( Form: PControl ): PControl;
function FormNewBitBtn( Form: PControl ): PControl;
function FormNewPanel( Form: PControl ): PControl;
function FormNewGradientPanel( Form: PControl ): PControl;
function FormNewGradientPanelEx( Form: PControl ): PControl;
function FormNewGroupbox( Form: PControl ): PControl;
function FormNewPaintbox( Form: PControl ): PControl;
function FormNewImageShow( Form: PControl ): PControl;
function FormNewEditBox( Form: PControl ): PControl;
{$IFDEF USE_RICHEDIT}
function FormNewRichEdit( Form: PControl ): PControl;
{$ENDIF}
function FormNewCombobox( Form: PControl ): PControl;
function FormNewCheckbox( Form: PControl ): PControl;
function FormNewRadiobox( Form: PControl ): PControl;
function FormNewSplitter( Form: PControl ): PControl;
function FormNewListbox( Form: PControl ): PControl;
function FormNewListView( Form: PControl ): PControl;
function FormNewTreeView( Form: PControl ): PControl;
function FormNewScrollbox( Form: PControl ): PControl;
function FormNewScrollboxEx( Form: PControl ): PControl;
function FormNewScrollBar( Form: PControl ): PControl;
function FormNewProgressBar( Form: PControl ): PControl;
function FormNewProgressBarEx( Form: PControl ): PControl;
//function FormNewToolbar( Form: PControl ): PControl;
function FormNewDateTimePicker( Form: PControl ): PControl;
{$IFDEF _D4orHigher}
function FormNewTabControl( Form: PControl ): PControl;
{$ENDIF}

procedure FormSetSize( Form: PControl );
procedure FormSetHeight( Form: PControl );
procedure FormSetWidth( Form: PControl );
procedure FormSetPosition( Form: PControl );
procedure FormSetClientSize( Form: PControl );
procedure FormSetAlign( Form: PControl );
procedure FormSetTag( Form: PControl );
{$IFDEF USE_NAMES}
procedure FormSetName( Form: PControl );
{$ENDIF USE_NAMES}
{$IFDEF UNICODE_CTRLS}
procedure FormSetUnicode( Form: PControl );
{$ENDIF UNICODE_CTRLS}
procedure FormAssignHelpContext( Form: PControl );
procedure FormSetCanResizeFalse( Form: PControl );
procedure FormInitMenu( Form: PControl );

procedure FormSizeGripFalse( Form: PControl );
procedure FormSetExStyle( Form: PControl );
procedure FormSetVisibleFalse( Form: PControl );
procedure FormSetEnabledFalse( Form: PControl );
procedure FormResetStyles( Form: PControl );
procedure FormSetStyle( Form: PControl );
procedure FormSetAlphaBlend( Form: PControl );
procedure FormSetHasBorderFalse( Form: PControl );
procedure FormSetHasCaptionFalse( Form: PControl );
procedure FormResetCtl3D( Form: PControl );
procedure FormIconLoad_hInstance( Form: PControl );
procedure FormIconLoadCursor_0( Form: PControl );
procedure FormSetIconNeg1( Form: PControl );
procedure FormIconLoad_hInstance_str( Form: PControl );
procedure FormSetWindowState( Form: PControl );
procedure FormCursorLoad_0( Form: PControl );
procedure FormCursorLoad_hInstance( Form: PControl );
procedure FormSetColor( Form: PControl );
procedure FormSetBrushStyle( Form: PControl );
procedure FormSetBrushBitmap( Form: PControl );
procedure FormSetFontColor( Form: PControl );
procedure FormSetFontStyles( Form: PControl );
procedure FormSetFontHeight( Form: PControl );
procedure FormSetFontWidth( Form: PControl );
procedure FormSetFontName( Form: PControl );
procedure FormSetFontOrientation( Form: PControl );
procedure FormSetFontCharset( Form: PControl );
procedure FormSetFontPitch( Form: PControl );
procedure FormSetBorder( Form: PControl );
procedure FormSetMarginTop( Form: PControl );
procedure FormSetMarginBottom( Form: PControl );
procedure FormSetMarginLeft( Form: PControl );
procedure FormSetMarginRight( Form: PControl );
procedure FormSetSimpleStatusText( Form: PControl );
procedure FormSetStatusText( Form: PControl );
procedure FormRemoveCloseIcon( Form: PControl );
procedure FormSetEraseBkgndTrue( Form: PControl );
procedure FormSetMinWidth( Form: PControl );
procedure FormSetMaxWidth( Form: PControl );
procedure FormSetMinHeight( Form: PControl );
procedure FormSetMaxHeight( Form: PControl );
procedure FormSetKeyPreviewTrue( Form: PControl );
// BitBtn only:
procedure FormSetRepeatInterval( Form: PControl );
procedure FormSetTextShiftX( Form: PControl );
procedure FormSetTextShiftY( Form: PControl );
// LabelEffect only:
procedure FormSetColor2( Form: PControl );

procedure FormSetTextAlign( Form: PControl );
procedure FormSetTextVAlign( Form: PControl );
procedure FormSetTabStopFalse( Form: PControl );
procedure FormSetIgnoreDefault( Form: PControl );
procedure FormSetHintText( Form: PControl );
procedure FormSetAnchor( Form: PControl );
procedure FormSetCaption( Form: PControl );
procedure FormSetGradienStyle( Form: PControl );
procedure FormOverrideScrollbars( Form: PControl );
// RichEdit only:
{$IFDEF USE_RICHEDIT}
procedure FormSetRE_AutoFontFalse( Form: PControl );
procedure FormSetRE_AutoFontSizeAdjustFalse( Form: PControl );
procedure FormSetRE_DualFontTrue( Form: PControl );
procedure FormSetRE_UIFontsTrue( Form: PControl );
procedure FormSetRE_IMECancelCompleteTrue( Form: PControl );
procedure FormSetRE_IMEAlwaysSendNotifyTrue( Form: PControl );
procedure FormSetMaxTextSize( Form: PControl );
procedure FormSetRE_AutoKeyboardTrue( Form: PControl );
procedure FormSetRE_DisableOverwriteChangeTrue( Form: PControl );
procedure FormSetRE_Zoom( Form: PControl );
{$ENDIF USE_RICHEDIT}
procedure FormSetListItems( Form: PControl );
procedure FormSetCount( Form: PControl );
procedure FormSetDroppedWidth( Form: PControl );
procedure FormSetButtonIcon( Form: PControl );
procedure FormSetButtonImage( Form: PControl );
procedure FormSetButtonBitmap( Form: PControl );
procedure FormSetDefaultBtn( Form: PControl );
// progress
procedure FormSetMaxProgress( Form: PControl );
procedure FormSetProgress( Form: PControl );
// list view
procedure FormLVColumsAdd( Form: PControl );
procedure FormSetLVColOrder( Form: PControl );
procedure FormSetLVColImage( Form: PControl );
// tree view
procedure FormSetTVIndent( Form: PControl );
// toolbar
procedure FormSetTBBtnImgWidth( Form: PControl );
procedure FormTBAddBitmap( Form: PControl );
procedure FormSetTBButtonSize( Form: PControl );
{$IFDEF _D4orHigher}
procedure FormTBSetTooltips( Form: PControl );
{$ENDIF}
procedure FormSetTBButtonsMinWidth( Form: PControl );
procedure FormSetTBButtonsMaxWidth( Form: PControl );
procedure FormHideToolbarButton( Form: PControl );
procedure FormDisableToolbarButton( Form: PControl );
procedure FormFixFlatXPToolbar( Form: PControl );
// datetimepicker
procedure FormSetDateTimeFormat( Form: PControl );
procedure FormSetDateTimeColor( Form: PControl );
// tabcontrol
procedure FormSetCurrentTab( Form: PControl );
procedure FormSetCurIdx( Form: PControl );
// scrolbar
procedure FormSetSBMin( Form: PControl );
procedure FormSetSBMax( Form: PControl );
procedure FormSetSBPosition( Form: PControl );
procedure FormSetSBPageSize( Form: PControl );


procedure FormLastCreatedChildAsNewCurrentParent( Form: PControl );
procedure FormSetUpperParent( Form: PControl );
procedure FormSetTabpageAsParent( Form: PControl );

procedure FormSetCurCtl( Form: PControl );
procedure FormSetParent( Form: PControl );
procedure FormSetEvent( Form: PControl );
procedure FormSetIndexedEvent( Form: PControl );


{$IFDEF WIN_GDI}
function ToolbarButtonRect( Toolbar: PControl; BtnID: Integer ): TRect;
{* Use this function instead of reading TControl.TBButtonRect, if you want
   to have it working the same way when standard toolbar is used or GRushControl
   toolbar provided in ToGRush.pas unit.
}
procedure ToolbarSetTooltips( Toolbar: PControl; BtnID1st: Integer; const Tooltips: array of PKOLChar );
{* Use this function instead of TContol.TBSetTooltips in your project, when
   you use ToGRush unit.
}
function ToolbarButtonEnabled( Toolbar: PControl; BtnID: Integer ): Boolean;
{* Use this function instead of reading the property TControl.TBButtonEnabled
   when tou use ToGRush unit. }
procedure EnableToolbarButton( Toolbar: PControl; BtnID: Integer; Enable: Boolean );
{* Use this procedure instead of writing the property TControl.TBButtonEnabled
   when you use ToGRush unit. }
function ToolbarButtonVisible( Toolbar: PControl; BtnID: Integer ): Boolean;
{* Use this function instead of reading the property TControl.TBButtonVisible
   when tou use ToGRush unit. }
procedure ShowHideToolbarButton( Toolbar: PControl; BtnID: Integer; Show: Boolean );
{* Use this procedure instead of writing the property TControl.TBButtonVisible
   when you use ToGRush unit. }
function ToolbarButtonChecked( Toolbar: PControl; BtnID: Integer): Boolean;
{* }
procedure ToolbarButtonSetChecked( Toolbar: PControl; BtnID: Integer; Checked: Boolean );
{* }
procedure ToolbarAddButtons( Toolbar: PControl; const Buttons: array of PKOLChar;
   const BtnImgIdxArray: array of Integer; Bitmap: HBitmap );
{* }

function  Scrollbar_GetMinPos( sb: PControl ): Integer;
procedure Scrollbar_SetMinPos( sb: PControl; m: Integer );
procedure Scrollbar_SetAll( sb: PControl; min, max, pg, cur: Integer );
function  Scrollbar_GetMaxPos( sb: PControl ): Integer;
procedure Scrollbar_SetMaxPos( sb: PControl; m: Integer );
function  Scrollbar_GetCurPos( sb: PControl ): Integer;
procedure Scrollbar_SetCurPos( sb: PControl; newp: Integer );
procedure Scrollbar_SetPageSz( sb: PControl; psz: Integer );
function  Scrollbar_GetPageSz( sb: PControl ): Integer;
procedure Scrollbar_SetLineSz( sb: PControl; lnz: Integer );
function  Scrollbar_GetLineSz( sb: PControl ): Integer;
{$ENDIF WIN_GDI}

var ToolbarsIDcmd: Integer = 100;

type
  TOnPaintBkgnd = procedure( Sender: PControl; DC: HDC; Rect: PRect );
  {* Global event definition. Used to define Global_OnPaintBackground
     event placeholder. }

procedure DefaultPaintBackground( Sender: PControl; DC: HDC; Rect: PRect );

var
  Global_OnPaintBkgnd: TOnPaintBkgnd = DefaultPaintBackground;
  {* Global event. It is assigned in XBackgounds.pas add-on to replace
     PaintBackground method for all TVisual objects, allowing great
     visualization effect: transparent controls over [animated] bitmap
     background. Idea:
     | <a href=mailto:"bw@sunv.com">Wei&nbsp;Bao</a>. Implementation:
     | <a href=mailto:"bonanzas@xcl.cjb.net">Kladov&nbsp;Vladimir</a>. }

function GetShiftState: DWORD;
{* Returns shift state. }

{$IFDEF WIN_GDI}
function WndProcMouse( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
function WndProcKeybd( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
function WndProcDummy( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
function WndProcMenu( Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
{$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER}
function WndProcBtnReturnClick( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
{$ENDIF}
function AutoMinimizeApplet(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
{* By Sergey Shishmintzev
   Attach this handler to your modal dialog form handle to provide automatic
   minimization of all other forms in the application together with the dialog. }

procedure InitCommonControlSizeNotify( Ctrl: PControl );
procedure InitCommonControlCommonNotify( Ctrl: PControl );

procedure DummyAttachProcExtension ( DynHandlers: PList );
procedure TransparentAttachProcExtension ( DynHandlers: PList );

{$IFNDEF SMALLEST_CODE}
var Global_AttachProcExtension: procedure( DynHandlers: PList ) = DummyAttachProcExtension;
{$ENDIF}
{$ENDIF WIN_GDI}
var HelpFilePath: PKOLChar;
  {* Path to application help file. If not assigned, application path with
     extension replaced to '.hlp' used. To use '.chm' file (HtmlHelp),
     call AssignHtmlHelp with a path to a html help file (or a name). }

{$IFDEF WIN_GDI}
procedure AssignHtmlHelp( const HtmlHelpPath: KOLString );
procedure HtmlHelpCommand( Wnd: HWnd; const HelpFilePath: KOLString; Cmd, Data: Integer );
{* Use this wrapper procedure to call HtmlHelp API function. }
//+++++++++++ HTML HELP DEFINITIONS SECTION:
// this section is from
//   HTML Help API Interface Unit
//   Copyright (c) 1999 The Helpware Group
// provided for KOL by Alexey Babenko
const
  HH_DISPLAY_TOPIC        = $0000;  {**}
  HH_HELP_FINDER          = $0000;  // WinHelp equivalent
  HH_DISPLAY_TOC          = $0001;  // not currently implemented
  HH_DISPLAY_INDEX        = $0002;  // not currently implemented
  HH_DISPLAY_SEARCH       = $0003;  // not currently implemented
  HH_SET_WIN_TYPE         = $0004;
  HH_GET_WIN_TYPE         = $0005;
  HH_GET_WIN_HANDLE       = $0006;
  HH_ENUM_INFO_TYPE       = $0007;  // Get Info type name, call repeatedly to enumerate, -1 at end
  HH_SET_INFO_TYPE        = $0008;  // Add Info type to filter.
  HH_SYNC                 = $0009;
  HH_RESERVED1            = $000A;
  HH_RESERVED2            = $000B;
  HH_RESERVED3            = $000C;
  HH_KEYWORD_LOOKUP       = $000D;
  HH_DISPLAY_TEXT_POPUP   = $000E;  // display string resource id or text in a popup window
  HH_HELP_CONTEXT         = $000F;  {**}// display mapped numeric value in dwData
  HH_TP_HELP_CONTEXTMENU  = $0010;  // text popup help, same as WinHelp HELP_CONTEXTMENU
  HH_TP_HELP_WM_HELP      = $0011;  // text popup help, same as WinHelp HELP_WM_HELP
  HH_CLOSE_ALL            = $0012;  // close all windows opened directly or indirectly by the caller
  HH_ALINK_LOOKUP         = $0013;  // ALink version of HH_KEYWORD_LOOKUP
  HH_GET_LAST_ERROR       = $0014;  // not currently implemented // See HHERROR.h
  HH_ENUM_CATEGORY        = $0015;	// Get category name, call repeatedly to enumerate, -1 at end
  HH_ENUM_CATEGORY_IT     = $0016;  // Get category info type members, call repeatedly to enumerate, -1 at end
  HH_RESET_IT_FILTER      = $0017;  // Clear the info type filter of all info types.
  HH_SET_INCLUSIVE_FILTER = $0018;  // set inclusive filtering method for untyped topics to be included in display
  HH_SET_EXCLUSIVE_FILTER = $0019;  // set exclusive filtering method for untyped topics to be excluded from display
  HH_INITIALIZE           = $001C;  // Initializes the help system.
  HH_UNINITIALIZE         = $001D;  // Uninitializes the help system.
  HH_PRETRANSLATEMESSAGE  = $00fd;  // Pumps messages. (NULL, NULL, MSG*).
  HH_SET_GLOBAL_PROPERTY  = $00fc;  // Set a global property. (NULL, NULL, HH_GPROP)

  { window properties }

const
  HHWIN_PROP_TAB_AUTOHIDESHOW = $00000001;  // (1 << 0)  Automatically hide/show tri-pane window
  HHWIN_PROP_ONTOP            = $00000002;  // (1 << 1)  Top-most window
  HHWIN_PROP_NOTITLEBAR       = $00000004;  // (1 << 2)  no title bar
  HHWIN_PROP_NODEF_STYLES     = $00000008;  // (1 << 3)  no default window styles (only HH_WINTYPE.dwStyles)
  HHWIN_PROP_NODEF_EXSTYLES   = $00000010;  // (1 << 4)  no default extended window styles (only HH_WINTYPE.dwExStyles)
  HHWIN_PROP_TRI_PANE         = $00000020;  // (1 << 5)  use a tri-pane window
  HHWIN_PROP_NOTB_TEXT        = $00000040;  // (1 << 6)  no text on toolbar buttons
  HHWIN_PROP_POST_QUIT        = $00000080;  // (1 << 7)  post WM_QUIT message when window closes
  HHWIN_PROP_AUTO_SYNC        = $00000100;  // (1 << 8)  automatically ssync contents and index
  HHWIN_PROP_TRACKING         = $00000200;  // (1 << 9)  send tracking notification messages
  HHWIN_PROP_TAB_SEARCH       = $00000400;  // (1 << 10) include search tab in navigation pane
  HHWIN_PROP_TAB_HISTORY      = $00000800;  // (1 << 11) include history tab in navigation pane
  HHWIN_PROP_TAB_FAVORITES    = $00001000;  // (1 << 12) include favorites tab in navigation pane
  HHWIN_PROP_CHANGE_TITLE     = $00002000;  // (1 << 13) Put current HTML title in title bar
  HHWIN_PROP_NAV_ONLY_WIN     = $00004000;  // (1 << 14) Only display the navigation window
  HHWIN_PROP_NO_TOOLBAR       = $00008000;  // (1 << 15) Don't display a toolbar
  HHWIN_PROP_MENU             = $00010000;  // (1 << 16) Menu
  HHWIN_PROP_TAB_ADVSEARCH    = $00020000;  // (1 << 17) Advanced FTS UI.
  HHWIN_PROP_USER_POS         = $00040000;  // (1 << 18) After initial creation, user controls window size/position
  HHWIN_PROP_TAB_CUSTOM1      = $00080000;  // (1 << 19) Use custom tab #1
  HHWIN_PROP_TAB_CUSTOM2      = $00100000;  // (1 << 20) Use custom tab #2
  HHWIN_PROP_TAB_CUSTOM3      = $00200000;  // (1 << 21) Use custom tab #3
  HHWIN_PROP_TAB_CUSTOM4      = $00400000;  // (1 << 22) Use custom tab #4
  HHWIN_PROP_TAB_CUSTOM5      = $00800000;  // (1 << 23) Use custom tab #5
  HHWIN_PROP_TAB_CUSTOM6      = $01000000;  // (1 << 24) Use custom tab #6
  HHWIN_PROP_TAB_CUSTOM7      = $02000000;  // (1 << 25) Use custom tab #7
  HHWIN_PROP_TAB_CUSTOM8      = $04000000;  // (1 << 26) Use custom tab #8
  HHWIN_PROP_TAB_CUSTOM9      = $08000000;  // (1 << 27) Use custom tab #9
  HHWIN_TB_MARGIN             = $10000000;  // (1 << 28) the window type has a margin

  { window parameters }

const
  HHWIN_PARAM_PROPERTIES      = $00000002;  // (1 << 1)  valid fsWinProperties
  HHWIN_PARAM_STYLES          = $00000004;  // (1 << 2)  valid dwStyles
  HHWIN_PARAM_EXSTYLES        = $00000008;  // (1 << 3)  valid dwExStyles
  HHWIN_PARAM_RECT            = $00000010;  // (1 << 4)  valid rcWindowPos
  HHWIN_PARAM_NAV_WIDTH       = $00000020;  // (1 << 5)  valid iNavWidth
  HHWIN_PARAM_SHOWSTATE       = $00000040;  // (1 << 6)  valid nShowState
  HHWIN_PARAM_INFOTYPES       = $00000080;  // (1 << 7)  valid apInfoTypes
  HHWIN_PARAM_TB_FLAGS        = $00000100;  // (1 << 8)  valid fsToolBarFlags
  HHWIN_PARAM_EXPANSION       = $00000200;  // (1 << 9)  valid fNotExpanded
  HHWIN_PARAM_TABPOS          = $00000400;  // (1 << 10) valid tabpos
  HHWIN_PARAM_TABORDER        = $00000800;  // (1 << 11) valid taborder
  HHWIN_PARAM_HISTORY_COUNT   = $00001000;  // (1 << 12) valid cHistory
  HHWIN_PARAM_CUR_TAB         = $00002000;  // (1 << 13) valid curNavType

  { button constants }

const
  HHWIN_BUTTON_EXPAND         = $00000002;  // (1 << 1)  Expand/contract button
  HHWIN_BUTTON_BACK           = $00000004;  // (1 << 2)  Back button
  HHWIN_BUTTON_FORWARD        = $00000008;  // (1 << 3)  Forward button
  HHWIN_BUTTON_STOP           = $00000010;  // (1 << 4)  Stop button
  HHWIN_BUTTON_REFRESH        = $00000020;  // (1 << 5)  Refresh button
  HHWIN_BUTTON_HOME           = $00000040;  // (1 << 6)  Home button
  HHWIN_BUTTON_BROWSE_FWD     = $00000080;  // (1 << 7)  not implemented
  HHWIN_BUTTON_BROWSE_BCK     = $00000100;  // (1 << 8)  not implemented
  HHWIN_BUTTON_NOTES          = $00000200;  // (1 << 9)  not implemented
  HHWIN_BUTTON_CONTENTS       = $00000400;  // (1 << 10) not implemented
  HHWIN_BUTTON_SYNC           = $00000800;  // (1 << 11) Sync button
  HHWIN_BUTTON_OPTIONS        = $00001000;  // (1 << 12) Options button
  HHWIN_BUTTON_PRINT          = $00002000;  // (1 << 13) Print button
  HHWIN_BUTTON_INDEX          = $00004000;  // (1 << 14) not implemented
  HHWIN_BUTTON_SEARCH         = $00008000;  // (1 << 15) not implemented
  HHWIN_BUTTON_HISTORY        = $00010000;  // (1 << 16) not implemented
  HHWIN_BUTTON_FAVORITES      = $00020000;  // (1 << 17) not implemented
  HHWIN_BUTTON_JUMP1          = $00040000;  // (1 << 18)
  HHWIN_BUTTON_JUMP2          = $00080000;  // (1 << 19)
  HHWIN_BUTTON_ZOOM           = $00100000;  // (1 << 20)
  HHWIN_BUTTON_TOC_NEXT       = $00200000;  // (1 << 21)
  HHWIN_BUTTON_TOC_PREV       = $00400000;  // (1 << 22)

  HHWIN_DEF_BUTTONS           = (HHWIN_BUTTON_EXPAND
                                 OR HHWIN_BUTTON_BACK
                                 OR HHWIN_BUTTON_OPTIONS
                                 OR HHWIN_BUTTON_PRINT);

  { Button IDs }

const
  IDTB_EXPAND             = 200;
  IDTB_CONTRACT           = 201;
  IDTB_STOP               = 202;
  IDTB_REFRESH            = 203;
  IDTB_BACK               = 204;
  IDTB_HOME               = 205;
  IDTB_SYNC               = 206;
  IDTB_PRINT              = 207;
  IDTB_OPTIONS            = 208;
  IDTB_FORWARD            = 209;
  IDTB_NOTES              = 210; // not implemented
  IDTB_BROWSE_FWD         = 211;
  IDTB_BROWSE_BACK        = 212;
  IDTB_CONTENTS           = 213; // not implemented
  IDTB_INDEX              = 214; // not implemented
  IDTB_SEARCH             = 215; // not implemented
  IDTB_HISTORY            = 216; // not implemented
  IDTB_FAVORITES          = 217; // not implemented
  IDTB_JUMP1              = 218;
  IDTB_JUMP2              = 219;
  IDTB_CUSTOMIZE          = 221;
  IDTB_ZOOM               = 222;
  IDTB_TOC_NEXT           = 223;
  IDTB_TOC_PREV           = 224;

  { Notification codes }

const
  HHN_FIRST       = (0-860);
  HHN_LAST        = (0-879);

  HHN_NAVCOMPLETE   = (HHN_FIRST-0);
  HHN_TRACK         = (HHN_FIRST-1);
  HHN_WINDOW_CREATE = (HHN_FIRST-2);

type
  {*** Used by command HH_GET_LAST_ERROR
   NOTE: Not part of the htmlhelp.h but documented in HH Workshop help
         You must call SysFreeString(xx.description) to free BSTR
  }
  tagHH_LAST_ERROR = packed record
    cbStruct:      Integer;     // sizeof this structure
    hr:            Integer;     // Specifies the last error code.
    description:   PWideChar;   // (BSTR) Specifies a Unicode string containing a description of the error.
  end;
  HH_LAST_ERROR = tagHH_LAST_ERROR;
  THHLastError = tagHH_LAST_ERROR;

type
  {*** Notify event info for HHN_NAVCOMPLETE, HHN_WINDOW_CREATE }
  PHHNNotify = ^THHNNotify;
  tagHHN_NOTIFY = packed record
    hdr:    TNMHdr;
    pszUrl: PAnsiChar;              //PCSTR: Multi-byte, null-terminated string
  end;
  HHN_NOTIFY = tagHHN_NOTIFY;
  THHNNotify = tagHHN_NOTIFY;

  {** Use by command HH_DISPLAY_TEXT_POPUP}
  PHHPopup = ^THHPopup;
  tagHH_POPUP = packed record
    cbStruct:      Integer;     // sizeof this structure
    hinst:         HINST;       // instance handle for string resource
    idString:      cardinal;    // string resource id, or text id if pszFile is specified in HtmlHelp call
    pszText:       PAnsiChar;       // used if idString is zero
    pt:            TPOINT;      // top center of popup window
    clrForeground: COLORREF;    // use -1 for default
    clrBackground: COLORREF;    // use -1 for default
    rcMargins:     TRect;       // amount of space between edges of window and text, -1 for each member to ignore
    pszFont:       PAnsiChar;       // facename, point size, char set, BOLD ITALIC UNDERLINE
  end;
  HH_POPUP = tagHH_POPUP;
  THHPopup = tagHH_POPUP;

  {** Use by commands - HH_ALINK_LOOKUP, HH_KEYWORD_LOOKUP}
  PHHAKLink = ^THHAKLink;
  tagHH_AKLINK = packed record
    cbStruct:      integer;     // sizeof this structure
    fReserved:     BOOL;        // must be FALSE (really!)
    pszKeywords:   PAnsiChar;       // semi-colon separated keywords
    pszUrl:        PAnsiChar;       // URL to jump to if no keywords found (may be NULL)
    pszMsgText:    PAnsiChar;       // Message text to display in MessageBox if pszUrl is NULL and no keyword match
    pszMsgTitle:   PAnsiChar;       // Message text to display in MessageBox if pszUrl is NULL and no keyword match
    pszWindow:     PAnsiChar;       // Window to display URL in
    fIndexOnFail:  BOOL;        // Displays index if keyword lookup fails.
  end;
  HH_AKLINK = tagHH_AKLINK;
  THHAKLink = tagHH_AKLINK;

const
  HHWIN_NAVTYPE_TOC          = 0;
  HHWIN_NAVTYPE_INDEX        = 1;
  HHWIN_NAVTYPE_SEARCH       = 2;
  HHWIN_NAVTYPE_FAVORITES    = 3;
  HHWIN_NAVTYPE_HISTORY      = 4;   // not implemented
  HHWIN_NAVTYPE_AUTHOR       = 5;
  HHWIN_NAVTYPE_CUSTOM_FIRST = 11;

const
  IT_INCLUSIVE = 0;
  IT_EXCLUSIVE = 1;
  IT_HIDDEN    = 2;

type
  PHHEnumIT = ^THHEnumIT;
  tagHH_ENUM_IT = packed record                  //tagHH_ENUM_IT, HH_ENUM_IT, *PHH_ENUM_IT
    cbStruct:           Integer;     // size of this structure
    iType:              Integer;     // the type of the information type ie. Inclusive, Exclusive, or Hidden
    pszCatName:         PAnsiChar;   // Set to the name of the Category to enumerate the info types in a category; else NULL
    pszITName:          PAnsiChar;   // volitile pointer to the name of the infotype. Allocated by call. Caller responsible for freeing
    pszITDescription:   PAnsiChar;   // volitile pointer to the description of the infotype.
  end;
  THHEnumIT = tagHH_ENUM_IT;

type
  PHHEnumCat = ^THHEnumCat;
  tagHH_ENUM_CAT = packed record                 //tagHH_ENUM_CAT, HH_ENUM_CAT, *PHH_ENUM_CAT
    cbStruct:           Integer;     // size of this structure
    pszCatName:         PAnsiChar;   // volitile pointer to the category name
    pszCatDescription:  PAnsiChar;   // volitile pointer to the category description
  end;
  THHEnumCat = tagHH_ENUM_CAT;

type
  PHHSetInfoType = ^THHSetInfoType;
  tagHH_SET_INFOTYPE = packed record             //tagHH_SET_INFOTYPE, HH_SET_INFOTYPE, *PHH_SET_INFOTYPE
    cbStruct:           Integer;     // the size of this structure
    pszCatName:         PAnsiChar;   // the name of the category, if any, the InfoType is a member of.
    pszInfoTypeName:    PAnsiChar;   // the name of the info type to add to the filter
  end;
  THHSetInfoType = tagHH_SET_INFOTYPE;

type
  HH_INFOTYPE = DWORD;
  THHInfoType = HH_INFOTYPE;
  PHHInfoType = ^THHInfoType;        //PHH_INFOTYPE

const
  HHWIN_NAVTAB_TOP    = 0;
  HHWIN_NAVTAB_LEFT   = 1;
  HHWIN_NAVTAB_BOTTOM = 2;

const
  HH_MAX_TABS  = 19;                 // maximum number of tabs
const
  HH_TAB_CONTENTS     = 0;
  HH_TAB_INDEX        = 1;
  HH_TAB_SEARCH       = 2;
  HH_TAB_FAVORITES    = 3;
  HH_TAB_HISTORY      = 4;
  HH_TAB_AUTHOR       = 5;
  HH_TAB_CUSTOM_FIRST = 11;
  HH_TAB_CUSTOM_LAST  = HH_MAX_TABS;

  HH_MAX_TABS_CUSTOM = (HH_TAB_CUSTOM_LAST - HH_TAB_CUSTOM_FIRST + 1);

  { HH_DISPLAY_SEARCH Command Related Structures and Constants }

const
  HH_FTS_DEFAULT_PROXIMITY = (-1);

type
  {** Used by command HH_DISPLAY_SEARCH}
  PHHFtsQuery = ^THHFtsQuery;
  tagHH_FTS_QUERY = packed record          //tagHH_FTS_QUERY, HH_FTS_QUERY
    cbStruct:          integer;      // Sizeof structure in bytes.
    fUniCodeStrings:   BOOL;         // TRUE if all strings are unicode.
    pszSearchQuery:    PAnsiChar;        // String containing the search query.
    iProximity:        LongInt;      // Word proximity.
    fStemmedSearch:    Bool;         // TRUE for StemmedSearch only.
    fTitleOnly:        Bool;         // TRUE for Title search only.
    fExecute:          Bool;         // TRUE to initiate the search.
    pszWindow:         PAnsiChar;        // Window to display in
  end;
  THHFtsQuery = tagHH_FTS_QUERY;

  { HH_WINTYPE Structure }

type
  {** Used by commands HH_GET_WIN_TYPE, HH_SET_WIN_TYPE}
  PHHWinType = ^THHWinType;
  tagHH_WINTYPE = packed record             //tagHH_WINTYPE, HH_WINTYPE, *PHH_WINTYPE;
    cbStruct:          Integer;      // IN: size of this structure including all Information Types
    fUniCodeStrings:   BOOL;         // IN/OUT: TRUE if all strings are in UNICODE
    pszType:           PAnsiChar;        // IN/OUT: Name of a type of window
    fsValidMembers:    DWORD;        // IN: Bit flag of valid members (HHWIN_PARAM_)
    fsWinProperties:   DWORD;        // IN/OUT: Properties/attributes of the window (HHWIN_)

    pszCaption:        PAnsiChar;        // IN/OUT: Window title
    dwStyles:          DWORD;        // IN/OUT: Window styles
    dwExStyles:        DWORD;        // IN/OUT: Extended Window styles
    rcWindowPos:       TRect;        // IN: Starting position, OUT: current position
    nShowState:        Integer;      // IN: show state (e.g., SW_SHOW)

    hwndHelp:          HWND;         // OUT: window handle
    hwndCaller:        HWND;         // OUT: who called this window

    paInfoTypes:       PHHInfoType;  // IN: Pointer to an array of Information Types

    { The following members are only valid if HHWIN_PROP_TRI_PANE is set }

    hwndToolBar:       HWND;         // OUT: toolbar window in tri-pane window
    hwndNavigation:    HWND;         // OUT: navigation window in tri-pane window
    hwndHTML:          HWND;         // OUT: window displaying HTML in tri-pane window
    iNavWidth:         Integer;      // IN/OUT: width of navigation window
    rcHTML:            TRect;        // OUT: HTML window coordinates

    pszToc:            PAnsiChar;        // IN: Location of the table of contents file
    pszIndex:          PAnsiChar;        // IN: Location of the index file
    pszFile:           PAnsiChar;        // IN: Default location of the html file
    pszHome:           PAnsiChar;        // IN/OUT: html file to display when Home button is clicked
    fsToolBarFlags:    DWORD;        // IN: flags controling the appearance of the toolbar (HHWIN_BUTTON_)
    fNotExpanded:      BOOL;         // IN: TRUE/FALSE to contract or expand, OUT: current state
    curNavType:        Integer;      // IN/OUT: UI to display in the navigational pane
    tabpos:            Integer;      // IN/OUT: HHWIN_NAVTAB_TOP, HHWIN_NAVTAB_LEFT, or HHWIN_NAVTAB_BOTTOM
    idNotify:          Integer;      // IN: ID to use for WM_NOTIFY messages
    tabOrder: packed array[0..HH_MAX_TABS] of Byte;  // IN/OUT: tab order: Contents, Index, Search, History, Favorites, Reserved 1-5, Custom tabs
    cHistory:          Integer;       // IN/OUT: number of history items to keep (default is 30)
    pszJump1:          PAnsiChar;         // Text for HHWIN_BUTTON_JUMP1
    pszJump2:          PAnsiChar;         // Text for HHWIN_BUTTON_JUMP2
    pszUrlJump1:       PAnsiChar;         // URL for HHWIN_BUTTON_JUMP1
    pszUrlJump2:       PAnsiChar;         // URL for HHWIN_BUTTON_JUMP2
    rcMinSize:         TRect;         // Minimum size for window (ignored in version 1)

    cbInfoTypes:       Integer;       // size of paInfoTypes;
    pszCustomTabs:     PAnsiChar;         // multiple zero-terminated strings
  end;
  HH_WINTYPE = tagHH_WINTYPE;
  THHWinType = tagHH_WINTYPE;

const
  HHACT_TAB_CONTENTS   = 0;
  HHACT_TAB_INDEX      = 1;
  HHACT_TAB_SEARCH     = 2;
  HHACT_TAB_HISTORY    = 3;
  HHACT_TAB_FAVORITES  = 4;

  HHACT_EXPAND         = 5;
  HHACT_CONTRACT       = 6;
  HHACT_BACK           = 7;
  HHACT_FORWARD        = 8;
  HHACT_STOP           = 9;
  HHACT_REFRESH        = 10;
  HHACT_HOME           = 11;
  HHACT_SYNC           = 12;
  HHACT_OPTIONS        = 13;
  HHACT_PRINT          = 14;
  HHACT_HIGHLIGHT      = 15;
  HHACT_CUSTOMIZE      = 16;
  HHACT_JUMP1          = 17;
  HHACT_JUMP2          = 18;
  HHACT_ZOOM           = 19;
  HHACT_TOC_NEXT       = 20;
  HHACT_TOC_PREV       = 21;
  HHACT_NOTES          = 22;

  HHACT_LAST_ENUM      = 23;

type
  {*** Notify event info for HHN_TRACK }
  PHHNTrack = ^THHNTrack;
  tagHHNTRACK = packed record                  //tagHHNTRACK, HHNTRACK;
    hdr:               TNMHdr;
    pszCurUrl:         PAnsiChar;                  // Multi-byte, null-terminated string
    idAction:          Integer;                // HHACT_ value
    phhWinType:        PHHWinType;             // Current window type structure
  end;
  HHNTRACK = tagHHNTRACK;
  THHNTrack = tagHHNTRACK;

///////////////////////////////////////////////////////////////////////////////
//
// Global Control Properties.
//
const
  HH_GPROPID_SINGLETHREAD     = 1;      // VARIANT_BOOL: True for single thread
  HH_GPROPID_TOOLBAR_MARGIN   = 2;      // long: Provides a left/right margin around the toolbar.
  HH_GPROPID_UI_LANGUAGE      = 3;      // long: LangId of the UI.
  HH_GPROPID_CURRENT_SUBSET   = 4;      // BSTR: Current subset.
  HH_GPROPID_CONTENT_LANGUAGE = 5;      // long: LandId for desired content.

type
  tagHH_GPROPID = HH_GPROPID_SINGLETHREAD..HH_GPROPID_CONTENT_LANGUAGE;
  HH_GPROPID = tagHH_GPROPID;
  THHGPropID = HH_GPROPID;

{$ENDIF WIN_GDI}

{$IFDEF WIN_GDI}
function SimpleGetCtlBrushHandle( Sender: PControl ): HBrush;

var
  Global_GetCtlBrushHandle: function( Sender: PControl ): HBrush = SimpleGetCtlBrushHandle;
  {* Is called to obtain brush handle. }
{$ENDIF WIN_GDI}

  Global_Align: procedure( Sender: PObj ) = DummyObjProc;
  {* Is set to perform aligning of control, and only if property Align
     is changed for TControl, or SetAlign method is called for it. }

{$IFDEF WIN_GDI}
function WndFunc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer )
                                   : Integer; stdcall;
{* Global message handler for window. Redirects all messages to
   destination windows, obtaining target TControl object address from
   window itself, using GetProp API call. }
{$ENDIF WIN_GDI} //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

var AppletRunning: Boolean;
    {* Is set to True while message loop is processing (in Run procedure). }
    AppletTerminated: Boolean;
    {* Is set to True when message loop is terminated. }
    Applet: PControl;
    {* Applet window object. Actually, can be set to main form if program
       not needed in special applet button window (useful to make applet
       button invisible on taskbar, or to have several forms with single
       applet button - crete it in that case using NewApplet). }
    AppButtonUsed: Boolean;
    {* True if special window to represent applet button (may be invisible)
       is used. If no, every form is represented with its own taskbar button
       (always visible). }

{$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
    ScreenCursor: HCursor;
    {* Set this global variable to override any cursor settings of current
       form or control. }

function ScreenWidth: Integer;
{* Returns screen width in pixels. }
function ScreenHeight: Integer;
{* Returns screen height in pixels. }

type
  TStatusOption = ( soNoSizeGrip, soTop );
  {* Options available for status bars. }
  TStatusOptions = Set of TStatusOption;
  {* Status bar options. }

procedure DrawFormattedText( Ctl: PControl; DC: HDC; var R: TRect; Flags: DWORD {EditCtl: Boolean} );
{* This procedure can be useful to draw control's text in custom-defined controls. }

type TCommandActionsParam = {$IFDEF PACK_COMMANDACTIONS} PAnsiChar
                            {$ELSE} PCommandActions {$ENDIF};

{$IFDEF USE_GRAPHCTLS}

{$IFDEF GRAPHCTL_XPSTYLES}
var DoNotDrawGraphCtlsUsingXPStyles: Boolean;
procedure DrawFormattedTextXP( Theme: THandle; Ctl: PControl; DC: HDC;
  var R: TRect; CtlType, CtlStates, Flags1, Flags2: Integer );
{* This procedure can be useful to draw control's text in custom-defined controls. }
{$ENDIF}

function _NewGraphCtl( AParent: PControl; ATabStop: Boolean;
         ACommandActions: TCommandActionsParam ): PControl;
{* Creates graphic control basics. }

function NewGraphLabel( AParent: PControl; const ACaption: AnsiString ): PControl;
{* Creates graphic label, which does not require a window handle. }

function NewWordWrapGraphLabel( AParent: PControl; const ACaption: KOLString ): PControl;
{* Creates graphic label, which does not require a window handle. }

function NewGraphPaintBox( AParent: PControl ): PControl;
{* Creates graphic paint box (just the same as graphic label, but with empty Caption). }

function NewGraphCheckBox( AParent: PControl; const ACaption: KOLString ): PControl;
{* Creates graphic checkbox. }

function NewGraphRadioBox( AParent: PControl; const ACaption: KOLString ): PControl;
{* Creates graphic radiobox. }

function NewGraphButton( AParent: PControl; const ACaption: KOLString ): PControl;
{* Creates graphic button. }

function NewGraphEditbox( AParent: PControl; Options: TEditOptions ): PControl;
{* Creates graphic edit box. To do editing, this box should be replaced with
   real edit box with a handle (actually, it is enough to place an edit box
   on the same Parent having the same BoundsRect). }
{$ENDIF USE_GRAPHCTLS}
{$ENDIF WIN_GDI}

procedure Run( var AppletCtl: PControl );
{* |<#appbutton>
   Call this procedure to process messages loop of your program.
   Pass here pointer to applet button object (if You have created it
   - see NewApplet) or your main form object of type PControl (created
   using NewForm).
     |<br><br>
     |<h1 align=center><font color=#FF8040><a name="visual_objects_constructors"></a>
       Visual objects constructing functions
     |</font></h1>
   Following constructing functions for visual controls are available:
   |#control
}

{$IFDEF WIN_GDI}

procedure TerminateExecution( var AppletCtl: PControl );

procedure AppletMinimize;
{* Minimizes the application (Applet should be assigned to have effect). }
procedure AppletHide;
{* Minimizes and hides application. }
procedure AppletRestore;
{* Restores Applet when minimized. }

{YS+}
procedure RegisterIdleHandler( const OnIdle: TOnEvent );
{* Registers new Idle handler. Idle handler is called each time when
   message queue becomes empty. }
procedure UnRegisterIdleHandler( const OnIdle: TOnEvent );
{* Unregisters Idle handler. }
{YS-}

{* ComCtrl32 controls initialization. }
procedure InitCommonControls; stdcall;
procedure DoInitCommonControls( dwICC: DWORD );
{* Calls extended initialization for Common Controls (from ComCtrl32).
   Pass one of following constants:
   |<pre>
  ICC_LISTVIEW_CLASSES   = $00000001; // listview, header
  ICC_TREEVIEW_CLASSES   = $00000002; // treeview, tooltips
  ICC_BAR_CLASSES        = $00000004; // toolbar, statusbar, trackbar, tooltips
  ICC_TAB_CLASSES        = $00000008; // tab, tooltips
  ICC_UPDOWN_CLASS       = $00000010; // updown
  ICC_PROGRESS_CLASS     = $00000020; // progress
  ICC_HOTKEY_CLASS       = $00000040; // hotkey
  ICC_ANIMATE_CLASS      = $00000080; // animate
  ICC_WIN95_CLASSES      = $000000FF;
  ICC_DATE_CLASSES       = $00000100; // month picker, date picker, time picker, updown
  ICC_USEREX_CLASSES     = $00000200; // comboex
  ICC_COOL_CLASSES       = $00000400; // rebar (coolbar) control
  ICC_INTERNET_CLASSES   = $00000800;
  ICC_PAGESCROLLER_CLASS = $00001000; // page scroller
  ICC_NATIVEFNTCTL_CLASS = $00002000; // native font control
   |</pre>
    }

const
  ICC_LISTVIEW_CLASSES   = $00000001; // listview, header
  ICC_TREEVIEW_CLASSES   = $00000002; // treeview, tooltips
  ICC_BAR_CLASSES        = $00000004; // toolbar, statusbar, trackbar, tooltips
  ICC_TAB_CLASSES        = $00000008; // tab, tooltips
  ICC_UPDOWN_CLASS       = $00000010; // updown
  ICC_PROGRESS_CLASS     = $00000020; // progress
  ICC_HOTKEY_CLASS       = $00000040; // hotkey
  ICC_ANIMATE_CLASS      = $00000080; // animate
  ICC_WIN95_CLASSES      = $000000FF;
  ICC_DATE_CLASSES       = $00000100; // month picker, date picker, time picker, updown
  ICC_USEREX_CLASSES     = $00000200; // comboex
  ICC_COOL_CLASSES       = $00000400; // rebar (coolbar) control
  ICC_INTERNET_CLASSES   = $00000800;
  ICC_PAGESCROLLER_CLASS = $00001000; // page scroller
  ICC_NATIVEFNTCTL_CLASS = $00002000; // native font control

function OleInit: Boolean;
{* Calls OleInitialize (once - all other calls are simulated by incrementing
   call counter. Every OleInit shoud be complemented with correspondent OleUninit.
   (Though, it is possible to call API function OleUnInitialize once to
   cancel all OleInit calls). }
procedure OleUnInit;
{* Decrements counter and calls OleUnInitialize when it is zeroed. }
var OleInitCount: Integer;

function StringToOleStr(const Source: Ansistring): PWideChar;
{* }

function SysAllocStringLen(psz: PWideChar; len: Integer): PWideChar; stdcall;
procedure SysFreeString( psz: PWideChar ); stdcall;

{$ENDIF WIN_GDI}
{ -- Contructors for visual controls -- }

{$IFDEF GDI}
{$IFDEF COMMANDACTIONS_OBJ}
function NewCommandActionsObj: PCommandActionsObj;
function NewCommandActionsObj_Packed( fromPack: PAnsiChar ): PCommandActionsObj;
{$ENDIF}

function _NewWindowed( AParent: PControl; ControlClassName: PKOLChar;
         Ctl3D: Boolean; ACommandActions: TCommandActionsParam): PControl;
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION _NewWindowed( AParent: PControl; ControlClassName: PAnsiChar;
  widget: PGtkWidget; need_eventbox: Boolean ): PControl;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
function NewApplet( const Caption: KOLString ): PControl;
{* |<#control>
   Creates applet button window, which has to be parent of all other forms
   in your project (but this is *not must*). See also comments about NewForm.
   |<br>
   Following methods, properties and events are useful to work with applet
   control:
   |#appbutton }
{$ENDIF WIN_GDI}

function NewForm( AParent: PControl; const Caption: KOLString ): PControl;
{* |<#control>
   Creates form window object and returns pointer to it. If You use only one form,
   and You are not going to do applet button on task bar invisible, it is not
   necessary to create also special applet button window - just pass
   your (main) form object to Run procedure. In that case, it is a good
   idea to assign pointer to your main form object to Applet variable
   immediately following creating it - because some objects (e.g. TTimer)
   want to have Applet assigned to something.
   |<br>
   |&D=<a href="tcontrol.htm#%1" target=_top> %0 </a>
   Following methods, properties and events are useful to work with forms
   (ones common for all visual objects, such as <D Left>, <D Top>, <D Width>,
   <D Height>, etc. are not listed here - look TControl for it):
   |#form }

function NewAlienPanel( AParentWnd: HWnd; EdgeStyle: TEdgeStyle ): PControl;

{$IFDEF GDI}
function _NewControl( AParent: PControl; ControlClassName: PKOLChar;
         Style: DWORD; Ctl3D: Boolean; Actions: TCommandActionsParam ): PControl;
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION _NewControl( AParent: PControl; ControlClassName: PAnsiChar;
         Style: DWORD; Ctl3D: Boolean; widget: PGtkWidget; need_eventbox: Boolean ): PControl;
{$ENDIF GTK}
{$ENDIF _X_}

function NewButton( AParent: PControl; const Caption: KOLString ): PControl;
{* |<#control>
   Creates button on given parent control or form.
   Please note, that in Windows, buttons can not change its <D Font> color
   and to be <D Transparent>.
   |<br> Following methods, properies and events are (especially) useful with
   a button:
   |#button }

{$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
function NewBitBtn( AParent: PControl; const Caption: KOLString;
         Options: TBitBtnOptions; Layout: TGlyphLayout; GlyphBitmap: HBitmap; GlyphCount: Integer ): PControl;
{* |<#control>
   Creates image button (actually implemented as owner-drawn). In Options,
   it is possible to determine, whether bitmap or image list used to contain
   one or more (up to 5) images, correspondent to certain BitBtn state.
   |<br>&nbsp;&nbsp;&nbsp;
   For case of imagelist (option bboImageList), it is possible to use a
   number of glyphs from the image list, starting from image index given
   by GlyphCount parameter. Number of used glyphs is passed in that case
   in high word of GlyphCount parameter (if 0, one image is used therefore).
   For bboImageList, BitBtn can be Transparent (and in that case bboNoBorder
   style can be useful to draw custom buttons of non-rectangular shape).
   |<br>&nbsp;&nbsp;&nbsp;
   For case of bitmap BitBtn, image is stretched down (if too big), but can
   not be transparent. It is not necessary for bitmap BitBtn to pass correct
   GlyphCount - it is calculated on base of bitmap size, if 0 is passed.
   |<br>&nbsp;&nbsp;&nbsp;
   And, certainly, BitBtn can be without glyph image (text only). For that
   case, it is therefore is more flexible and power than usual Button (but
   requires more code). E.g., BitBtn can change its <D Font>, <D Color>,
   and to be totally <D Transparent>.
   Moreover, BitBtn can be <D Flat>, bboFixed, <D SpeedButton> and
   have property <D RepeatInterval>.
   |<br>&nbsp;&nbsp;&nbsp;
   Note: if You use bboFixed Style, use OnChange event instead of OnClick,
   because <D Checked> state is changed immediately however OnClick occure
   only when mouse or space key released (and can be not called at all if
   mouse button is released out of BitBtn bounds). Also, bboFixed defines
   only which glyph to show (the border if it is not turned off behaves as
   usual for a button, i.e. it becomes lowered and then raised again at any click).
   Here You can find references to other properties, events and methods
   applicable to BitBtn:
   |#bitbtn }

{$ENDIF GDI}
function NewLabel( AParent: PControl; const Caption: KOLString ): PControl;
{* |<#control>
   Creates static text control (native Windows STATIC control).
   Use property <D Caption> at run time to change label text. Also
   it is possible to adjust label <D Font>, <D Brush> or <D Color>.
   Label can be <D Transparent>. If You want to have rotated text
   label, call NewLabelEffect instead and change its <D Font>.FontOrientation.
   Other references certain for a label:
   |#label }
{$IFDEF GDI}

function NewWordWrapLabel( AParent: PControl; const Caption: KOLString ): PControl;
{* |<#control>
   Creates multiline static text control (native Windows STATIC control),
   which can wrap long text onto several lines. See also NewLabel.
   See also:
   |#wwlabel
   |#label }

function NewLabelEffect( AParent: PControl; const Caption: KOLString; ShadowDeep: Integer ): PControl;
{* |<#control>
   Creates 3D-label with capability to rotate its text <D Caption>, which
   is controlled by changing <D Font>.FontOrientation property. If You want
   to get flat effect label (e.g. to rotate it only), pass <D ShadowDeep> = 0.
   Please note, that drawing procedure uses <D Canvas> property, so using of
   LabelEffect leads to increase size of executable.
   See also:
   |#3dlabel
   |#label }

{$ENDIF GDI}
function NewPaintbox( AParent: PControl ): PControl;
{* |<#control>
   Creates owner-drawn STATIC control. Set its <D OnPaint> event to
   perform custom painting.
   |#paintbox }
{$IFDEF GDI}

function NewImageShow( AParent: PControl; AImgList: PImageList; ImgIdx: Integer ): PControl;
{* |<#control>
   Creates an image show control, implemented as a paintbox which is used to
   draw an image from the imagelist. At run-time, use property CurIndex to
   select another image from the imagelist, and a property ImageListNormal to
   use another image list. When the control is created, its size becomes
   equal to dimensions of imagelist (if any). }

function NewScrollBar( AParent: PControl; BarSide: TScrollerBar ): PControl;
{* |<#control>
   Creates simple scroll bar. }

function NewScrollBox( AParent: PControl; EdgeStyle: TEdgeStyle;
         Bars: TScrollerBars ): PControl;
{* |<#control>
   Creates simple scrolling box, which can be used any way you wish, e.g. to scroll
   certain large image. To provide automatic scrolling of a set of child controls,
   use advanced scroll box, created with NewScrollBoxEx. }

procedure NotifyScrollBox( Self_, Child: PControl );

function NewScrollBoxEx( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl;
{* |<#control>
   Creates extended scrolling box control, which automatically scrolls child
   controls (if any). }

function NewGradientPanel( AParent: PControl; Color1, Color2: TColor ): PControl;
{* |<#control>
   Creates gradient-filled STATIC control. To adjust colors at the
   run time, change <D Color1> and <D Color2> properties (which initially are
   assigned from Color1, Color2 parameters), and call <D Invalidate> method
   to repaint control. }

function NewGradientPanelEx( AParent: PControl; Color1, Color2: TColor;
                             Style: TGradientStyle; Layout: TGradientLayout ): PControl;
{* |<#control>
   Creates gradient-filled STATIC control. To adjust colors at the
   run time, change <D Color1> and <D Color2> properties (which initially are
   assigned from Color1, Color2 parameters), and call <D Invalidate> method
   to repaint control. Depending on style and first line/point layout, can
   looking different. Idea: Vladimir Stojiljkovic. }

function NewPanel( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl;
{* |<#control>
   Creates panel, which can be parent for other controls (though, any
   control can be used as a parent for other ones, but panel is specially
   designed for such purpose). }

{$IFDEF USE_MDI}
function NewMDIClient( AParent: PControl; WindowMenu: THandle ): PControl;
{* |<#control>
   Creates MDI client window, which is a special type of child window,
   containing all MDI child windows, created calling NewMDIChild function.
   On a form, MDI client behaves like a panel, so it can be placed and sized
   (or aligned) like any other controls. To minimize flick during resizing
   main form having another aligned controls, place MDI client window on
   a panel and align it caClient in the panel.
   |<br>Note:
   MDI client must be a single on the form. }

function NewMDIChild( AParent: PControl; const ACaption: KOLString ): PControl;
{* |<#control>
   Creates MDI client window. AParent should be a MDI client window,
   created with NewMDIClient function. }
{$ENDIF USE_MDI}

function NewSplitter( AParent: PControl; MinSizePrev, MinSizeNext: Integer ): PControl;
{* |<#control>
   Creates splitter control, which will separate previous one (i.e. last
   created one before splitter on the same parent) from created
   next, allowing to user to adjust size of separated controls by dragging
   the splitter in desired direction. Created splitter becomes vertical
   or horizontal depending on Align style of previous control on the same
   parent (if caLeft/caRight then vertical, if caTop/caBottom then horizontal).
   |<br>&nbsp;&nbsp;&nbsp;
   Please note, what if previous control has no Align equal to caLeft/caRight
   or caTop/caBottom, splitter will not be able to function normally. If
   previous control does not exist, it is yet possible to use splitter as
   a resizeable panel (but set its initial Align value first - otherwise it
   is not set by default. Also, change Cursor property as You wish in that
   case, since it is not set too in case, when previous control does not
   exist).
   |<br>&nbsp;&nbsp;&nbsp;
   Additional parameters determine, which minimal size (width or height -
   correspondently to split direction) is allowed for left (top) control
   and to rest of client area of parent, correspondently. (It is possible
   later to set second control for checking its size with MinSizeNext
   value - using TControl.SecondControl property). If -1 passed,
   correspondent control size is not checked during dragging of splitter.
   Usually 0 is more suitable value (with this value, it is garantee, that
   splitter will be always available even if mouse was released far from the
   edge of form).
   |<br>&nbsp;&nbsp;&nbsp;
   It is possible for user to press Escape any time while dragging splitter
   to abort all adjustments made starting from left mouse button push and
   begin of drag the splitter. But remember please, that such event is
   controlled using timer, and therefore correspondent keyboard events
   are received by currently focused control. Be sure, that pressing Escape
   will not affect to any control on form, which could be focused, otherwise
   filter keyboard messages (by yourself) to prevent undesired handling of
   Escape key by certain controls while splitting. (Use Dragging property
   to check if splitter is dragging by user with mouse).
   |<br>&nbsp;&nbsp;&nbsp;
   See also:
   NewSplitterEx
   |#splitter }

function NewSplitterEx( AParent: PControl; MinSizePrev, MinSizeNext: Integer;
         EdgeStyle: TEdgeStyle ): PControl;
{* |<#control>
   Creates splitter control. Difference from NewSplitter is what it is possible
   to determine if a splitter will be beveled or not. See also NewSplitter. }

function NewGroupbox( AParent: PControl; const Caption: KOLString ): PControl;
{* |<#control>
   Creates group box control. Note, that to group radio items, group
   box is not necessary - any parent can play role of group for radio items.
   See also NewPanel. }

function NewCheckbox( AParent: PControl; const Caption: KOLString ): PControl;
{* |<#control>
   Creates check box control. Special properties, methods, events:
   |#checkbox }

function NewCheckBox3State( AParent: PControl; const Caption: KOLString ): PControl;
{* |<#control>
   Creates check box control with 3 states. Special properties, methods,
   events:
   |#checkbox }

function NewRadiobox( AParent: PControl; const Caption: KOLString ): PControl;
{* |<#control>
   Creates radio box control. Alternative radio items must have the
   same parent window (regardless of its kind, either groupbox (NewGroupbox),
   panel (NewPanel) or form itself). Following properties, methods and events
   are specially for radiobox controls:
   |#radiobox }

function NewEditbox( AParent: PControl; Options: TEditOptions ): PControl;
{* |<#control>
   Creates edit box control. To create multiline edit box, similar to
   TMemo in VCL, apply eoMultiline in Options. Following properties, methods,
   events are special for edit controls:
   |#edit }

{$IFNDEF NOT_USE_RICHEDIT}
var FRichEditModule: Integer;
    RichEditClass: PKOLChar;

const RichEditLibnames: array[ 0..3 ] of PKOLChar =
      ( 'msftedit', 'riched20',
        'riched32', 'riched' );
      RichEditClasses: array[ 0..3 ] of PKOLChar =
      ( 'RichEdit50W', 'RichEdit20A',
        'RichEdit', 'RichEdit'  );
var   RichEditIdx: Byte = High( RichEditLibnames );

function NewRichEdit( AParent: PControl; Options: TEditOptions ): PControl;
{* |<#control>
   Creates rich text edit control. A rich edit control is a window in which
   the user can enter and edit text. The text can be assigned character and
   paragraph formatting, and can include embedded OLE objects. Rich edit
   controls provide a programming interface for formatting text. However, an
   application must implement any user interface components necessary to make
   formatting operations available to the user.
   |<br>&nbsp;&nbsp;&nbsp;
   Note: eoPassword, eoMultiline options have no effect for RichEdit control.
   Some operations are supersided with special versions of those, created
   especially for RichEdit, but in some cases it is necessary to use
   another properties and methods, specially designed for RichEdit (see
   methods and properties, which names are starting from RE_...).
   |<br>&nbsp;&nbsp;&nbsp;
   Following properties, methods, events are special for edit controls:
   |#richedit
   }

function NewRichEdit1( AParent: PControl; Options: TEditOptions ): PControl;
{* |<#control>
   Like NewRichEdit, but to work with older RichEdit control version 1.0
   (window class 'RichEdit' forced to use instead of 'RichEdit20A', even
   if library RICHED20.DLL found and loaded successfully). One more
   difference - OleInit is not called, so the most of OLE capabilities
   of RichEdit could not working. }
{$ENDIF NOT_USE_RICHEDIT}

function NewListbox( AParent: PControl; Options: TListOptions ): PControl;
{* |<#control>
   Creates list box control. Following properties, methods and events are
   special for Listbox:
   |#listbox }

function NewCombobox( AParent: PControl; Options: TComboOptions ): PControl;
{* |<#control>
   Creates new combo box control. Note, that it is not possible to align
   combobox caLeft or caRight: this can cause infinite recursion in the
   application.
   |<br>Following properties, methods and events are
   special for Combobox:
   |#combo }

function _NewCommonControl( AParent: PControl; ClassName: PKOLChar; Style: DWORD;
                            Ctl3D: Boolean; Actions: TCommandActionsParam
                            ): PControl;

function NewProgressbar( AParent: PControl ): PControl;
{* |<#control>
   Creates progress bar control. Following properties are special for
   progress bar:
   |#progressbar
   See also NewProgressEx. }

function NewProgressbarEx( AParent: PControl; Options: TProgressbarOptions ): PControl;
{* |<#control>
   Can create progress bar with smooth style (progress is not segmented
   onto bricks) or/and vertical progress bar - using additional parameter.
   For list of properties, suitable for progress bars, see NewProgressbar. }

function NewListView( AParent: PControl; Style: TListViewStyle; Options: TListViewOptions;
  ImageListSmall, ImageListNormal, ImageListState: PImageList ): PControl;
{* |<#control>
   Creates list view control. It is very powerful control, which can partially
   compensate absence of grid controls (in lvsDetail view mode). Properties,
   methods and events, special for list view control are:
   |#listview }

function NewTreeView( AParent: PControl; Options: TTreeViewOptions;
                      ImgListNormal, ImgListState: PImageList ): PControl;
{* |<#control>
   Creates tree view control. See tree view methods and properties:
   |#treeview }

function NewTabControl( AParent: PControl; const Tabs: array of PKOLChar; Options: TTabControlOptions;
         ImgList: PImageList; ImgList1stIdx: Integer ): PControl;
{* |<#control>
   Creates new tab control (like notebook). To place child control on a certain
   page of TabControl, use property Pages[ Idx ], for example:
   ! Label1 := NewLabel( TabControl1.Pages[ 0 ], 'Label1' );
   | &nbsp;&nbsp;&nbsp;
   To determine number of pages at run time, use property <D Count>;
   |<br> to determine which page is currently selected (or to change
   selection), use property <D CurIndex>;
   |<br> to feedback to switch between tabs assign your handler to OnSelChange
   event;
   |<br>Note, that by default, tab control is created with a border lowered to
   tab control's parent. To remove it, you can apply WS_EX_TRANSPARENT extended
   style (see TControl.ExStyle property), but painting of some child controls
   can be strange a bit in this case (no border drawing for edit controls was
   found, but not always...). You can also apply style WS_THICKFRAME (TControl.Style
   property) to make the border raised.
   |<br> Other methods and properties, suitable for tab control, are:
   |#tabcontrol }
{$IFNDEF OLD_ALIGN}
function NewTabEmpty( AParent: PControl; Options: TTabControlOptions;
         ImgList: PImageList ): PControl;
{* |<#control>
   Creates new empty tab control for using metods TC_Insert (to create Pages as Panel),
   or TC_InsertControl (if you want using your custom Pages).}
{$ENDIF}

var ToolbarDfltWidth: WORD = 1000;
    ToolbarDfltHeight: WORD = 26;

function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarOptions;
                     Bitmap: HBitmap; const Buttons: array of PKOLChar;
                     const BtnImgIdxArray: array of Integer ) : PControl;
{* |<#control>
   Creates toolbar control. Bitmap (if present) must contain images for all buttons
   excluding separators (defined by string '-' in Buttons array) and system images,
   otherwise last buttons will no have images at all. Image width for every button
   is assumed to be equal to Bitmap height (if last of "squares" has
   insufficient width, it will not be used). To define fixed buttons, use
   characters '+' or '-' as a prefix for button string (even empty). To
   create groups of (radio-)buttons, use also '!' follow '+' or '-'. (These rules
   are similar used in menu creation). To define drop down button, use (as
   first) prefix '^'. (Do not forget to set <D OnTBDropDown> event for this
   case). If You want to assign images to buttons not in the same order
   how these are placed in Bitmap (or You use system bitmap), define for every
   button (in BtnImgIdxArray array) indexes for every button (excluding
   separator buttons). Otherwise, it is possible to define index only for first
   button (e.g., [0]). It is also possible to change TBImages[ ] property
   for such purpose, or do the same in method TBSetBtnImgIdx).
   |<br>
   Following properties, methods and event are specially designed to work with
   toolbar control:
   |#toolbar
   |<br>&nbsp;&nbsp;&nbsp;
   If your project uses Align property to align controls, this can conflict with
   toolbar native aligning. To solve such problem, place toolbar to parent panel,
   which has its own Align property assigned to desired value.
   |<br>
   To create toolbar with buttons, drawn from top to bottom, instead from left
   to right, combine caLeft / caRight in Align parameter and style tboWrapable
   when create toolbar. To adjust width of vertically aligned toolbar, it is
   possible to call ResizeParentLeft for it. E.g.:

   ! P0 := NewPanel( W, esRaised ) .SetSize( 30, 0 ) .SetAlign( caLeft );
   ! //                            ^^^^^^^^^^^^^^^^^            //////
   !TB := NewToolbar( P0, caLeft, [ tboNoDivider, tboWrapable ], DWORD(-1),
   ! //                   //////                  ///////////
   !                  [ ' ', ' ', ' ', '-', ' ', ' ' ],
   !      [ STD_FILEOPEN ] ).ResizeParentRight;
   !//Note, that caLeft is *must*, and tboWrapable style too. SetSize for
   !//parent panel is not necessary, but only if ResizeParentRight is called
   !//than for Toolbar.
   |<br><br>
   One more note: if You create toolbar without text labels (passing ' ' for
   each button You add), include also option tboTextRight to fix incorrect
   sizing of buttons under Windows9x.
   |<br>
   And, certainly, if you use image lists rather then bitmap, all written
   above about Bitmap become absolutely incorrect.
   }

function NewDateTimePicker( AParent: PControl; Options: TDateTimePickerOptions )
         : PControl;
{* |<#control>
   Creates date and time picker common control.
}

{ -- Constructor for Image List objet -- }

function NewImageList( AOwner: PControl ): PImageList;
{* Constructor of TImageList object. Unlike other non-visual objects, image list
   can be parented by TControl object (but this does not *must*), and in that
   case it is destroyed automatically when its parent control is destroyed.
   Every control can have several TImageList objects, linked to a simple list.
   But if any TImageList object is destroyed, all following ones are destroyed
   too (at least, now I implemented it so). }

{$ENDIF WIN_GDI}

type
  TTimerKind = ( tkReal, tkProcess, tkProfiler ); // only for UNIX!
  PTimer = ^TTimer;
{ ----------------------------------------------------------------------
                            TTimer object
----------------------------------------------------------------------- }
  TTimer = object( TObj )
  {* Easy timer incapsulation object. It uses separate topmost window,
     common for all timers in the application, to handle WM_TIMER message.
     This allows using timers in non-windowed application (but anyway it
     should contain message handling loop for a thread).
     |<br>
     Note: in UNIX, there are no special windows created, certainly. }
  protected
    fHandle : Integer;
    fEnabled: Boolean;
    fInterval: Integer;
    fOnTimer: TOnEvent;
    {$IFDEF LIN}
    {$IFNDEF GTK}
    {$IFNDEF QT}
    fPrev, fNext: PTimer; // äâóñâÿçíûé ñïèñîê âñåõ _àêòèâíûõ_ òàéìåðîâ
    fTimeStart: clock_t;
    fExpireNext: clock_t;
    fExpireTotal: Int64;
    fTimerHandled: Boolean;
    fResolution: Integer;
    fPeriodic: Boolean;
    fMultimedia: Boolean;
    {$ENDIF  QT}
    {$ENDIF  GTK}
    {$ENDIF}
    procedure SetEnabled(const Value: Boolean); {$IFDEF WIN} virtual; {$ENDIF}
    procedure SetInterval(const Value: Integer);
  protected
    destructor Destroy; virtual;
    {* Destructor. }
  public
    property Handle : Integer read fHandle;
    {* Windows timer object handle. }
    property Enabled : Boolean read fEnabled write SetEnabled;
    {* True, is timer is on. Initially, always False. }
    property Interval : Integer read fInterval write SetInterval;
    {* Interval in milliseconds (1000 is default and means 1 second).
       Note: in UNIX, if an Interval can be set to a value large then 30 minutes,
       add a conditional definition SUPPORT_LONG_TIMER to the project options. }
    property OnTimer : TOnEvent read fOnTimer write fOnTimer;
    {* Event, which is called when time interval is over. }
    {$IFDEF LIN}
    {$IFNDEF GTK}
    {$IFNDEF QT}
    property Resolution: Integer read fResolution write fResolution; // dummy property, just for compatibility
    property Periodic: Boolean read fPeriodic write fPeriodic;
    {$ENDIF  QT}
    {$ENDIF  GTK}
    {$ENDIF LIN}
  end;

function NewTimer( Interval: Integer ): PTimer;
{* Constructs initially disabled timer with interval 1000 (1 second). }

{$IFDEF WIN}
type
  PMMTimer = ^TMMTimer;

  TMMTimer = object( TTimer )
  {* Multimedia timer incapsulation object. Does not require Applet or special
     window to handle it. System creates a thread for each high resolution
     timer, so using many such objects can degrade total PC performance. }
  protected
    FResolution: Integer;
    FPeriodic: Boolean;
    procedure SetEnabled(const Value: Boolean); virtual;
  public
    destructor Destroy; virtual;
    {* }
    property Resolution: Integer read FResolution write FResolution;
    {* Minimum timer resolution. The less the more accuracy (0 is exactly
       Interval milliseconds between timer shots). It is recommended to set
       this property greater to prevent entire system from reducing overhead.
       If you change this value, reset and then set Enabled again to apply
       changes. }
    property Periodic: Boolean read FPeriodic write FPeriodic;
    {* TRUE, if timer is periodic (default). Otherwise, timer is one-shot
       (set it Enabled every time in such case for each shot). If you change
       this property, reset and set Enabled property again to get effect. }
  end;

function NewMMTimer( Interval: Integer ): PMMTimer;
{* Creates multimedia timer object. Initially, it has Resolution = 0,
   Periodic = TRUE and Enabled = FALSE. Do not forget also to assign your
   event handler to OnTimer to do something on timer shot. }
{$ENDIF WIN}

{$IFDEF LIN}
function NewMMTimer( Interval: Integer ): PTimer;
{$ENDIF LIN}

{$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
{ -- TTrayIcon object -- }

type
  TOnTrayIconMouse = procedure( Sender: PObj; Message : Word ) of object;
  {* Event type to be called when Applet receives a message from an icon,
     added to the taskbar tray. }

  PTrayIcon = ^TTrayIcon;
{ ----------------------------------------------------------------------
                TTrayIcon - icon in tray area of taskbar
----------------------------------------------------------------------- }
  TTrayIcon = object(TObj)
  {* Object to place (and change) a single icon onto taskbar tray. }
  protected
    FIcon: HIcon;
    FActive: Boolean;
    FTooltip: KOLString;
    FOnMouse: TOnTrayIconMouse;
    FControl: PControl;
    fAutoRecreate: Boolean;
    FNoAutoDeactivate: Boolean;
    FWnd: HWnd;
    procedure SetIcon(const Value: HIcon);
    procedure SetActive(const Value: Boolean);
    procedure SetTrayIcon( const Value : DWORD );
    procedure SetTooltip(const Value: KOLString);
    procedure SetAutoRecreate(const Value: Boolean);
  protected
    destructor Destroy; virtual;
    {* Destructor. Use Free method instead (as usual). }
  public
    property Icon : HIcon read FIcon write SetIcon;
    {* Icon to be shown on taskbar tray. If not set, value of Active
       property has no effect. It is also possible to assign a value
       to Icon property after assigning True to Active to install
       icon first time or to replace icon with another one (e.g. to
       get animation effect).
       |<br>&nbsp;&nbsp;&nbsp;
       Previously allocated icon (if any) is not deleted using
       DeleteObject. This is normal for icons, loaded from resource
       (e.g., by LoadIcon API call). But if icon was created (e.g.) by
       CreateIconIndirect, your code is responsible for destroying
       of it). }
    property Active : Boolean read FActive write SetActive;
    {* Set it to True to show assigned Icon on taskbar tray. Default
       is False. Has no effect if Icon property is not assigned.
       TrayIcon is deactivated automatically when Applet is finishing
       (but only if Applet window is used as a "parent" for tray
       icon object). }
    property Tooltip : KOLString read FTooltip write SetTooltip;
    {* Tooltip string, showing automatically when mouse is moving
       over installed icon. Though "huge string" type is used, only
       first 63 characters are considered. Also note, that only in
       most recent versions of Windows multiline tooltips are supported. }
    property OnMouse : TOnTrayIconMouse read FOnMouse write FOnMouse;
    {* Is called then mouse message is taking place concerning installed
       icon. Only type of message can be obtained (e.g. WM_MOUSEMOVE,
       WM_LBUTTONDOWN etc.) }
    property AutoRecreate: Boolean read fAutoRecreate write SetAutoRecreate;
    {* If set to TRUE, auto-recreating of tray icon is proveded in case,
       when Explorer is restarted for some (unpredictable) reasons. Otherwise,
       your tray icon is disappeared forever, and if this is the single way
       to communicate with your application, the user nomore can achieve it. }
    property NoAutoDeactivate: Boolean read FNoAutoDeactivate write FNoAutoDeactivate;
    {* If set to true, tray icon is not removed from tray automatically on
       WM_CLOSE message receive by owner control. Set Active := FALSE in
       your code for such case before accepting closing the form. }
    property Wnd: HWnd read FWnd write FWnd;
    {* A window to use as a base window for tray icon messages. Overrides
       parent Control handle is assigned. Note, that if Wnd property used,
       message handling is not done automatically, and you should do this in
       your code, or at least for one tray icon object, call AttachProc2Wnd. }
    procedure AttachProc2Wnd;
    {* Call this method for a tray icon object in case if Wnd used rather then
       control. It is enough to call this method once for each Wnd used, even
       if several other tray icons are also based on the same Wnd. See also
       DetachProc2Wnd method. }
    procedure DetachProc2Wnd;
    {* Call this method to detach window procedure attached via AttachProc2Wnd.
       Do it once for a Wnd, used as a base to handle tray icon messages.
       Caution! If you do not call this method before destroying Wnd, the
       application will not functioning normally. }
  end;
  {* When You create invisible application, which should be represented by
     only the tray icon, prepare a handle for the window, resposible for
     messages handling. Remember, that window handle is created automatically
     only when a window is showing first time. If window's property Visible is
     set to False, You should to call CreateWindow manually.
     <br>
     There is a known bug exist with similar invisible tray-iconized applications.
     When a menu is activated in response to tray mouse event, if there was
     not active window, belonging to the application, the menu is not disappeared
     when mouse is clicked anywhere else. This bug is occure in Windows9x/ME.
     To avoid it, activate first your form window. This last window shoud have
     status visible (but, certainly, there are no needs to place it on visible
     part of screen - change its position, so it will not be visible for user,
     if You wish).
     <br>
     Also, to make your application "invisible" but until special event is occure,
     use Applet separate from the main form, and make for both Visible := False.
     This allows for You to make your form visible any time You wish, and without
     making application button visible if You do not wish.
  }
  {= Êîãäà Âû äåëàåòå íåâèäèìîå ïðèëîæåíèå, êîòîðîå äîëæíî áûòü ïðåäñòàâëåíî
     òîëüêî èêîíêîé â òðåå, îáåñïå÷üòå íåíóëåâîé Handle äëÿ îêíà, îòâå÷àþùåãî
     çà îáðàáîòêó ñîîáùåíèé. Ïîìíèòå, ÷òî Handle îêíà ñîçäàåòñÿ àâòîìàòè÷åñêè
     òîëüêî â òîò ìîìåíò, êîãäà îíî äîëæíî ïîÿâèòüñÿ â ïåðâûé ðàç. Åñëè ñâîéñòâî
     îêíà Visible óñòàíîâëåíî â FALSE, íåîáõîäèìî âûçâàòü CreateWindow ñàìîñòîÿòåëüíî.
     <br>
     Ñóùåñòâóåò èçâåñòíûé BUG ñ ïîäîáíûìè íåâèäèìûìè ìèíèìèçèðîâàííûìè â òðåé
     ïðèëîæåíèÿìè. Êîãäà â îòâåò íà ñîáûòèå ìûøè àêòèâèçèðâàíî âûïàäàþùåå ìåíþ,
     îíî íå èñ÷åçàåò ïî ùåë÷êó ìûøè âíå ýòîãî ìåíþ. Ïðîèñõîäèò ýòî â Windows9x/ME.
     ÷òîáû ðåøèòü ýòó ïðîáëåìó, ñíà÷àëà àêòèâèçèðóéòå ñâîå îêíî (ôîðìó). Ýòî îêíî
     äîëæíî áûòü âèäèìûì (íî, êîíå÷íî, åãî ìîæíî ðàçìåñòèòü âíå ïðåäåëîâ âèäèìîé
     ÷àñòè ýêðàíà, òàê ÷òî ïîëüçîâàòåëþ åãî âèäíî íå áóäåò).
     <br>
     Òàê æå, ÷òîáû ñäåëàòü ïðèëîæåíèå íåâèäèìûì, ïî êðàéíåé ìåðå, ïîêà ýòî íå
     ïîòðåáóåòñÿ, èñïîëüçóéòå îòäåëüíûé ïðåäñòàâèòåëü êëàññà TControl - ãëîáàëüíóþ
     ïåðåìåííóþ Applet, è ïðèñâîéòå FALSE åå ñâîéñòâó Visible.
  }

function NewTrayIcon( Wnd: PControl; Icon: HIcon ): PTrayIcon;
{* Constructor of TTrayIcon object. Pass main form or applet as Wnd
   parameter. }

{ -- JustOne -- }

type
  TOnAnotherInstance = procedure( const CmdLine: KOLString ) of object;
  {* Event type to use in JustOneNotify function. }

function JustOne( Wnd: PControl; const Identifier : KOLString ) : Boolean;
{* Returns True, if this is a first instance. For all other instances
   (application is already running), False is returned. }

function JustOneNotify( Wnd: PControl; const Identifier : KOLString;
                        const aOnAnotherInstance: TOnAnotherInstance ) : Boolean;
{* Returns True, if this is a first instance. For all other instances
   (application is already running), False is returned. If handler
   aOnAnotherInstance passed, it is called (in first instance) every time
   when another instance of an application is started, receiving command
   line used to run it. }

{ -- string (mainly) utility procedures and functions. -- }

{$IFDEF GDI}
function MsgBox( const S: KOLString; Flags: DWORD ): DWORD;
{* Displays message box with the same title as Applet.Caption. If applet
   is not running, and Applet global variable is not assigned, caption
   'Error' is displayed (but actually this is not an error - the system
   does so, if nil is passed as a title).
   |<br>&nbsp;&nbsp;&nbsp;
   Returns ID_... result (correspondently to flags passed (MB_OK, MBYESNO,
   etc. -> ID_OK, ID_YES, ID_NO, etc.) }
procedure MsgOK( const S: KOLString );
{* Displays message box with the same title as Applet.Caption (or 'Error',
   if Applet is not running). }
function ShowMsg( const S: KOLString; Flags: DWORD ): DWORD;
{* Displays message box like MsgBox, but uses Applet.Handle as a parent
   (so the message has no button on a task bar). }
procedure ShowMessage( const S: KOLString );
{* Like ShowMsg, but has only styles MB_OK and MB_SETFOREGROUND. }
{$ENDIF GDI}
{$IFDEF WIN}
{$IFNDEF PAS_ONLY}
procedure SpeakerBeep( Freq: Word; Duration: DWORD );
{* On Windows NT, calls Windows.Beep. On Windows 9x, produces beep on speaker
   of desired frequency during given duration time (in milliseconds). }
{$ENDIF PAS_ONLY}
{$ENDIF WIN}

function SysErrorMessage(ErrorCode: Integer): KOLString;
{* Creates and returns a string containing formatted system error message.
   It is possible then to display this message or write it to a log
   file, e.g.:
   !  ShowMsg( SysErrorMessage( GetLastError ) );

   |&R=<a name="%0"></a><font color=#FF8040><h1>%0</h1></font>
   <R 64-bit integer numbers>
}
{$ENDIF WIN_GDI}
type
  I64 = record
  {* 64 bit integer record. Use it and correspondent functions below in KOL
     projects to avoid dependancy from Delphi version (earlier versions of
     Delphi had no Int64 type). }
    Lo, Hi: DWORD;
  end;
  PI64 = ^I64;
  {* }

{$IFNDEF _D4orHigher}
  Int64 = I64;
  PInt64 = PI64;
{$ENDIF}

function MakeInt64( Lo, Hi: DWORD ): I64;
{* }
{$IFNDEF PAS_ONLY}
function Int2Int64( X: Integer ): I64;
{* }
procedure IncInt64( var I64: I64; Delta: Integer );
{* I64 := I64 + Delta; }
procedure DecInt64( var I64: I64; Delta: Integer );
{* I64 := I64 - Delta; }
function Add64( const X, Y: I64 ): I64;
{* Result := X + Y; }
function Sub64( const X, Y: I64 ): I64;
{* Result := X - Y; }
function Neg64( const X: I64 ): I64;
{* Result := -X; }
function Mul64i( const X: I64; Mul: Integer ): I64;
{* Result := X * Mul; }
function Div64i( const X: I64; D: Integer ): I64;
{* Result := X div D; }
function Mod64i( const X: I64; D: Integer ): Integer;
{* Result := X mod D; }
function Sgn64( const X: I64 ): Integer;
{* Result := sign( X ); i.e.:
   |<br>
   if X < 0 then -1
   |<br>
   if X = 0 then 0
   |<br>
   if X > 0 then 1 }
function Cmp64( const X, Y: I64 ): Integer;
{* Result := sign( X - Y ); i.e.
   |<br>
   if X < Y then -1
   |<br>
   if X = Y then 0
   |<br>
   if X > Y then 1 }
function Int64_2Str( X: I64 ): AnsiString;
{* }
function Int64_2Hex( X: I64; MinDigits: Integer ): KOLString;
{* }
function Str2Int64( const S: AnsiString ): I64;
{* }
function Int64_2Double( const X: I64 ): Double;
{* }
function Double2Int64( D: Double ): I64;
{$ENDIF PAS_ONLY}
{*

  <R Floating point numbers>
}

const
  NAN = 0.0 / 0.0;
  Infinity =  1.0 / 0.0;

function IsNan(const AValue: Double): Boolean;
{* Checks if an argument passed is NAN. }
function IsInfinity(const AValue: Double): Boolean;
{* Checks if an argument passed is Infinite. }
function IntPower(Base: Extended; Exponent: Integer): Extended;
{* Result := Base ^ Exponent; }
function NextPowerOf2( n: DWORD ): DWORD;
{* 0->1, 1->1, 2->2, 3->4, 4->4, 5->8, ... }
function Str2Double( const S: KOLString ): Double;
{* }
function Str2Extended( const S: KOLString ): Extended;
{* }
function Double2Str( D: Double ): KOLString;
{* }
function Extended2Str( E: Extended ): KOLString;
{* }
function Extended2StrDigits( D: Double; n: Integer ): KOLString;
{* Converts floating point number to string, leaving exactly n digits
   following floating point. }
function Double2StrEx( D: Double ): KOLString;
{* experimental, do not use }
{$IFNDEF PAS_ONLY}
function TruncD( D: Double ): Double;
{$ENDIF}
{* Result := trunc( D ) as Double;
|<hr>

  <R Small bit arrays (max 32 bits in array)>
  See also TBits object.
}

function IfThenElseBool( t, e, Cond: Boolean ): Boolean;
function IfThenElseInt( t, e: Integer; Cond: Boolean ): Integer;
function IfThenElseStr( const t, e: AnsiString; Cond: Boolean ): AnsiString;
{$IFDEF _D5orHigher}
function IfThenElse( t, e: Boolean; Cond: Boolean ): Boolean; overload;
function IfThenElse( t, e: Integer; Cond: Boolean ): Integer; overload;
function IfThenElse( t, e: AnsiString; Cond: Boolean ): AnsiString; overload;
function IfThenElse( t, e: Double; Cond: Boolean ): Double; overload;
{$ENDIF}

function GetBits( N: DWORD; first, last: Byte ): DWord;
{* Retuns bits straing from <first> and to <last> inclusively. }
function GetBitsL( N: DWORD; from, len: Byte ): DWord;
{* Retuns len bits starting from index <from>.
|<hr>

  <R Arithmetics, geometry and other utility functions>

  See also units KolMath.pas, CplxMath.pas and Err.pas.
}
//[MulDiv DECLARATION]
{$IFNDEF FPC}
function MulDiv( A, B, C: Integer ): Integer;
{* Returns A * B div C. Small and fast. }
{$ENDIF}

   function MakeRect( Left, Top, Right, Bottom: Integer ): TRect; stdcall;
   {* Use it instead of VCL Rect function }
   function RectsEqual( const R1, R2: TRect ): Boolean;
   {* Returns True if rectangles R1 and R2 have the same bounds }
   function RectsIntersected( const R1, R2: TRect ): Boolean;
   {* Returns TRUE if rectangles R1 and R2 have at least one common point.
      Note, that right and bottom bounds of rectangles are not their part,
      so, if such points are lying on that bounds, FALSE is returned. }
   function PointInRect( const P: TPoint; const R: TRect ): Boolean;
   {* Returns True if point P is located in rectangle R (including
      left and top bounds but without right and bottom bounds of the
      rectangle). }
   function OffsetPoint( const T: TPoint; dX, dY: Integer ): TPoint;
   {* }
   function OffsetSmallPoint( const T: TSmallPoint; dX, dY: SmallInt ): TSmallPoint;
   {* }
   function Point2SmallPoint( const T: TPoint ): TSmallPoint;
   {* }
   function SmallPoint2Point( const T: TSmallPoint ): TPoint;
   {* }
   function MakePoint( X, Y: Integer ): TPoint;
   {* Use instead of VCL function Point }
   function MakeSmallPoint( X, Y: Integer ): TSmallPoint;
   {* Use to construct TSmallPoint }
   function MakeFlags( FlgSet: PDWORD; FlgArray: array of Integer): Integer;
   {* }
   function MakeDateTimeRange( D1, D2: TDateTime ): TDateTimeRange;
   {* Returns TDateTimeRange from two TDateTime bounds. }
   procedure Swap( var X, Y: Integer );
   {* exchanging values }
   function Min( X, Y: Integer ): Integer;
   {* minimum of two integers }
   function Max( X, Y: Integer ): Integer;
   {* maximum of two integers }
{$IFDEF REDEFINE_ABS}
   function Abs( X: Integer ): Integer;
   {* absolute value }
{$ENDIF}
   function Sgn( X: Integer ): Integer;
   {* sign of X: if X < 0, -1 is returned, if > 0, then +1, otherwise 0. }
   function iSqrt( X: Integer ): Integer;
   {* square root }
   function iCbrt( X: DWORD ): Integer;
   {* cubic root
   |<hr>
  <R String to number and number to string conversions>
}
function Int2Hex( Value : DWord; Digits : Integer ) : KOLString;
{* Converts integer Value into string with hex number. Digits parameter
   determines minimal number of digits (will be completed by adding
   necessary number of leading zeroes). }
function Int2Str( Value : Integer ) : KOLString;
{* Obvious. }
procedure Int2PChar( s: PAnsiChar; Value: Integer );
{* Converts Value to string and puts it into buffer s. Buffer must have
   enough size to store the number converted: buffer overflow does
   not checked anyway! }
function UInt2Str( Value: DWORD ): AnsiString;
{* The same as Int2Str, but for unsigned integer value. }
function Int2StrEx( Value, MinWidth: Integer ): KOLString;
{* Like Int2Str, but resulting string filled with leading spaces to provide
   at least MinWidth characters. }
function Int2Rome( Value: Integer ): KOLString;
{* Represents number 1..8999 to Rome numer. }
function Int2Ths( I: Integer ): KOLString;
{* Converts integer into string, separating every three digits from each
   other by character ThsSeparator. (Convert to thousands). You  }
function Int2Digs( Value, Digits: Integer ): KOLString;
{* Converts integer to string, inserting necessary number of leading zeroes
   to provide desired length of string, given by Digits parameter. If
   resulting string is greater then Digits, string is not truncated anyway. }
function Num2Bytes( Value : Double ) : KOLString;
{* Converts double float to string, considering it as a bytes count.
   If Value is sufficiently large, number is represented in kilobytes (with
   following letter K), or in megabytes (M), gigabytes (G) or terabytes (T).
   Resulting string number is truncated to two decimals (.XX) or to one (.X),
   if the second is 0. }
function S2Int( S: PKOLChar ): Integer;
{* Converts null-terminated string to Integer. Scanning stopped when any
   non-digit character found. Even empty string or string not containing
   valid integer number silently converted to 0. }
function Str2Int(const Value : KOLString) : Integer;
{* Converts string to integer. First character, which can not be
   recognized as a part of number, regards as a separator. Even
   empty string or string without number silently converted to 0. }
function Hex2Int( const Value : KOLString) : Integer;
{* Converts hexadecimal number to integer. Scanning is stopped
   when first non-hexadicimal character is found. Leading dollar ('$')
   character is skept (if present). Minus ('-') is not concerning as
   a sign of number and also stops scanning.}
function cHex2Int( const Value : KOLString) : Integer;
{* As Hex2Int, but also checks for leading '0x' and skips it. }
function Octal2Int( const Value: AnsiString ) : Integer;
{* Converts octal number to integer. Scanning is stopped on first
   non-octal digit (any char except 0..7). There are no checking if
   there octal numer in the parameter. If the first char is not octal
   digit, 0 is returned. }
function Binary2Int( const Value: AnsiString ) : Integer;
{* Converts binary number to integer. Like Octal2Int, but only digits
   0 and 1 are allowed. }
type Radix_int = {$IFDEF _D5orHigher} Int64 {$ELSE} Integer {$ENDIF};
function ToRadix( number: Radix_int; radix, min_digits: Integer ): KOLString;
{* Converts unsigned number to string representing it literally in a numeric
   base given by radix parameter. }
function FromRadixStr( var Rslt: Radix_int; s: PKOLChar; radix: Integer ): PKOLChar;
{* Converts unsigned number from string representation in a numeric base given by
   a radix parameter. Returns a pointer to a character next to the last digit of
   the number. }
function FromRadix( const s: AnsiString; radix: Integer ): Radix_int;
{* Converts unsigned number from string representation in a numeric base given by
   a radix parameter. See also: FromRadixStr function. }
function InsertSeparators( const s: KOLString; chars_between: Integer;
    Separator: KOLChar ): KOLString;
{* Inserts given Separator between symbols in s, separating each portion of
   chars_between characters with a Separator starting from right side. See also:
   Int2Ths function. }
{$IFDEF WIN}
{$IFNDEF _FPC}
//{$IFNDEF PAS_ONLY}
function Format( const fmt: KOLString; params: array of const ): KOLString;
//{$ENDIF}
{* Uses API call to wvsprintf, so does not understand extra formats,
   such as floating point, date/time, currency conversions. See list of
   available formats in win32.hlp (topic wsprintf).
|<hr>

   <R Working with null-terminated and ansi strings>
}
{$ENDIF _FPC}
{$ENDIF WIN}
function StrComp(const Str1, Str2: PAnsiChar): Integer;
{* Compares two strings fast. -1: Str1<Str2; 0: Str1=Str2; +1: Str1>Str2 }

{$IFDEF PAS_ONLY}
function StrComp_NoCase(const Str1, Str2: PAnsiChar): Integer;
function StrLComp_NoCase(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer;
{$ELSE}
{$IFDEF SMALLER_CODE}
function StrComp_NoCase(const Str1, Str2: PAnsiChar): Integer;
{* Compares two strings fast without case sensitivity.
   Returns: -1 when Str1<Str2; 0 when Str1=Str2; +1 when Str1>Str2 }
function StrLComp_NoCase(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer;
{* Compare two strings fast without case sensitivity.
   Terminating 0 is not considered, so if strings are equal,
   comparing is continued up to MaxLen bytes.
   Since this, pass minimum of lengths as MaxLen. }
{$ELSE}
function StrComp_NoCase1(const Str1, Str2: PAnsiChar): Integer;
var StrComp_NoCase: function(const Str1, Str2: PAnsiChar): Integer = StrComp_NoCase1;
{* Compares two strings fast without case sensitivity.
   Returns: -1 when Str1<Str2; 0 when Str1=Str2; +1 when Str1>Str2 }
function StrLComp_NoCase1(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer;
var StrLComp_NoCase: function(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer = StrLComp_NoCase1;
{$ENDIF}
{$ENDIF}

function StrLComp(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer;
{* Compare two strings (fast). Terminating 0 is not considered, so if
   strings are equal, comparing is continued up to MaxLen bytes.
   Since this, pass minimum of lengths as MaxLen. }

function StrCopy( Dest, Source: PAnsiChar ): PAnsiChar;
{* Copy source string to destination (fast). Pointer to Dest is returned. }
function StrCat( Dest, Source: PAnsiChar ): PAnsiChar;
{* Append source string to destination (fast). Pointer to Dest is returned. }
function StrLen(const Str: PAnsiChar): Cardinal;
{* StrLen returns the number of characters in Str, not counting the null
  terminator. }
function StrScanLen(Str: PAnsiChar; Chr: AnsiChar; Len: Integer): PAnsiChar;
{* Fast scans string Str of length Len searching character Chr.
   Pointer to a character next to found or to Str[Len] (if no one found)
   is returned. }
function StrScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
{* Fast search of given character in a string. Pointer to found character
   (or nil) is returned. }
function StrRScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
{* StrRScan returns a pointer to the last occurrence of Chr in Str. If Chr
  does not occur in Str, StrRScan returns NIL. The null terminator is
  considered to be part of the string. }
function StrIsStartingFrom( Str, Pattern: PKOLChar ): Boolean;
{* Returns True, if string Str is starting from Pattern, i.e. if
   Copy( Str, 1, StrLen( Pattern ) ) = Pattern. Str must not be nil! }
function StrIsStartingFromNoCase( Str, Pattern: PAnsiChar ): Boolean;
{* Like StrIsStartingFrom above, but without case sensitivity. }
function TrimLeft(const S: KOLString): KOLString;
{* Removes spaces, tabulations and control characters from the starting
   of string S. }
function TrimRight(const S: KOLString): KOLString;
{* Removes spaces, tabulates and other control characters from the
   end of string S. }
function Trim( const S : KOLString): KOLString;
{* Makes TrimLeft and TrimRight for given string. }
function RemoveSpaces( const S: KOLString ): KOLString;
{* Removes all characters less or equal to ' ' in S and returns it. }
procedure Str2LowerCase( S: PAnsiChar );
{* Converts null-terminated string to lowercase (inplace). }
function LowerCase(const S: Ansistring): Ansistring;
{* Obvious. }
function UpperCase(const S: Ansistring): Ansistring;
{* Obvious. }
function AnsiUpperCase(const S: Ansistring): Ansistring;
{* Obvious. }
function AnsiLowerCase(const S: Ansistring): Ansistring;
{* Obvious. }
function KOLUpperCase(const S: KOLString): KOLString;
{* Obvious. }
function KOLLowerCase(const S: KOLString): KOLString;
{* Obvious. }
{$IFDEF _D3orHigher}
function WUpperCase(const S: KOLWideString): KOLWideString;
{* Obvious. }
function WLowerCase(const S: KOLWideString): KOLWideString;
{* Obvious. }
{$ENDIF}
{$IFNDEF _D2}
{$IFNDEF _FPC}
function WAnsiUpperCase(const S: KOLWideString): KOLWideString;
{* Obvious. }
function WAnsiLowerCase(const S: KOLWideString): KOLWideString;
{* Obvious. }
function WStrComp(const S1, S2: KOLWideString): Integer;
{* }
function _WStrComp(S1, S2: PWideChar): Integer;
{* }
function _WStrLComp(S1, S2: PWideChar; Len: Integer): Integer;
{* }
function WStrScan(Str: PWideChar; Chr: WideChar): PWideChar;
{* Fast search of given character in a string. Pointer to found character
   (or nil) is returned. }
function WStrRScan(const Str: PWideChar; Chr: WideChar): PWideChar;
{* StrRScan returns a pointer to the last occurrence of Chr in Str. If Chr
  does not occur in Str, StrRScan returns NIL. The null terminator is
  considered to be part of the string. }
{$ENDIF _FPC}
{$ENDIF _D2}
//--- set of functions to work either with AnsiString or with KOLWideString
//    depending on UNICODE_CTRLS symbol ----------------------------------------
function AnsiCompareStr(const S1, S2: KOLString): Integer;
{* AnsiCompareStr compares S1 to S2, with case-sensitivity. The compare
  operation is controlled by the current Windows locale. The return value
  is the same as for CompareStr. }
function _AnsiCompareStr(S1, S2: PKOLChar): Integer;
{* The same, but for PChar ANSI strings }
function AnsiCompareStrNoCase(const S1, S2: KOLString): Integer;
{* AnsiCompareStrNoCase compares S1 to S2, without case-sensitivity. The compare
  operation is controlled by the current Windows locale. The return value
  is the same as for CompareStr. }
function _AnsiCompareStrNoCase(S1, S2: PKOLChar): Integer;
{* The same, but for PChar ANSI strings }
function AnsiCompareText( const S1, S2: KOLString ): Integer;
{* }
function AnsiEq( const S1, S2 : KOLString ) : Boolean;
{* Returns True, if AnsiLowerCase(S1) = AnsiLowerCase(S2). I.e., if ANSI
   stringsare equal to each other without caring of characters case
   sensitivity. }

//--- set of functions to work always with AnsiString
//    even if UNICODE_CTRLS symbol is defined ----------------------------------
function AnsiCompareStrA(const S1, S2: AnsiString): Integer;
{* AnsiCompareStr compares S1 to S2, with case-sensitivity. The compare
  operation is controlled by the current Windows locale. The return value
  is the same as for CompareStr. }
function _AnsiCompareStrA_Slow(S1, S2: PAnsiChar): Integer;
function _AnsiCompareStrA_Fast(S1, S2: PAnsiChar): Integer;
var _AnsiCompareStrA: function(S1, S2: PAnsiChar): Integer =
    {$IFDEF SPEED_FASTER} _AnsiCompareStrA_Fast
    {$ELSE}               _AnsiCompareStrA_Slow {$ENDIF};
{* The same, but for PChar ANSI strings }
function _AnsiCompareStrA_Fast2(S1, S2: PAnsiChar): Integer;
function _AnsiCompareStrNoCaseA_Fast2(S1, S2: PAnsiChar): Integer;
function AnsiCompareStrNoCaseA(const S1, S2: AnsiString): Integer;
{* AnsiCompareStr compares S1 to S2, with case-sensitivity. The compare
  operation is controlled by the current Windows locale. The return value
  is the same as for CompareStr. }
function _AnsiCompareStrNoCaseA_Slow(S1, S2: PAnsiChar): Integer;
function _AnsiCompareStrNoCaseA_Fast(S1, S2: PAnsiChar): Integer;
var _AnsiCompareStrNoCaseA: function(S1, S2: PAnsiChar): Integer =
    {$IFDEF SPEED_FASTER} _AnsiCompareStrNoCaseA_Fast
    {$ELSE}               _AnsiCompareStrNoCaseA_Slow {$ENDIF};
{* The same, but for PChar ANSI strings }
function AnsiCompareTextA( const S1, S2: AnsiString ): Integer;
{* }

{$IFDEF WIN}
{$IFNDEF _FPC}
function LStrFromPWCharLen(Source: PWideChar; Length: Integer): AnsiString;
{* from Delphi5 - because D2 does not contain it. }
function LStrFromPWChar(Source: PWideChar): AnsiString;
{* from Delphi5 - because D2 does not contain it. }
{$ENDIF _FPC}
function WCharIn( C: KOLChar; const Chars: array of KOLChar ): Boolean;
{$ENDIF WIN}

function CopyEnd( const S : KOLString; Idx : Integer ) : KOLString;
{* Returns copy of source string S starting from Idx up to the end of
   string S. Works correctly for case, when Idx > Length( S ) (returns
   empty string for such case). }
function CopyTail( const S : KOLString; Len : Integer ) : KOLString;
{* Returns last Len characters of the source string. If Len > Length( S ),
   entire string S is returned. }
procedure DeleteTail( var S : KOLString; Len : Integer );
{* Deletes last Len characters from string. }
function IndexOfChar( const S : KOLString; Chr : KOLChar ) : Integer;
{* Returns index of given character (1..Length(S)), or
   -1 if a character not found. }
function IndexOfCharsMin( const S, Chars : KOLString ) : Integer;
{* Returns index (in string S) of those character, what is taking place
   in Chars string and located nearest to start of S. If no such
   characters in string S found, -1 is returned. }
{$IFDEF _D3orHigher}
function WIndexOfChar( const S : KOLWideString; Chr : WideChar ) : Integer;
function WIndexOfCharsMin( const S, Chars : KOLWideString ) : Integer;
{$ENDIF}
{$IFNDEF _D2}
{$IFNDEF _FPC}
function IndexOfWideCharsMin( const S, Chars : KOLWideString ) : Integer;
{* Returns index (in wide string S) of those wide character, what
   is taking place in Chars wide string and located nearest to start of S.
   If no such characters in string S found, -1 is returned. }
{$ENDIF _FPC}
{$ENDIF _D2}

function IndexOfStr( const S, Sub : KOLString ) : Integer;
{* Returns index of given substring in source string S. If found,
   1..Length(S)-Length(Sub), if not found, -1. }
function Parse( var S : KOLString; const Separators : KOLString ) : KOLString;
{* Returns first characters of string S, separated from others by
   one of characters, taking place in Separators string, assigning
   a tail of string (after found separator) to source string. If
   no separator characters found, source string S is returned, and
   source string itself becomes empty. }
{$IFDEF _D3orHigher}
function ParseW( var S : KOLWideString; const Separators : KOLWideString ) : KOLWideString;
{$ENDIF}

{$IFNDEF _FPC}
{$IFNDEF _D2}
function WParse( var S : KOLWideString; const Separators : KOLWideString ) : KOLWideString;
{* Returns first wide characters of wide string S, separated from others
   by one of wide characters, taking place in Separators wide string,
   assigning a tail of wide string (following found separator) to the
   source one. If there are no separator characters found, source wide
   string S is returned, and source wide string itself becomes empty. }
{$ENDIF _D2}
{$ENDIF _FPC}
function ParsePascalString( var S : KOLString; const Separators : KOLString ) : KOLString;
{* Returns first characters of string S, separated from others by
   one of characters, taking place in Separators string, assigning
   a tail of string (after the found separator) to source string. If
   there are no separator characters found, the source string S is returned,
   and the source string itself becomes empty. Additionally: if the first (after
   a blank space) is the quote "'" or '#', pascal string is assumung first
   and is converted to usual string (without quotas) before analizing
   of other separators. }
function String2PascalStrExpr( const S : KOLString ) : KOLString;
{* Converts string to Pascal-like string expression (concatenation of
   strings with quotas and characters with leading '#'). }
function StrEq( const S1, S2 : AnsiString ) : Boolean;
{* Returns True, if LowerCase(S1) = LowerCase(S2). I.e., if strings
   are equal to each other without caring of characters case sensitivity
   (ASCII only). }
{$IFNDEF _D2}
{$IFNDEF _FPC}
function WAnsiEq( const S1, S2 : KOLWideString ) : Boolean;
{* Returns True, if AnsiLowerCase(S1) = AnsiLowerCase(S2). I.e., if ANSI
   stringsare equal to each other without caring of characters case
   sensitivity. }
{$ENDIF _FPC}
{$ENDIF _D2}

function StrIn( const S : AnsiString; const A : array of AnsiString ) : Boolean;
{* Returns True, if S is "equal" to one of strings, taking place
   in A array. To check equality, StrEq function is used, i.e.
   comaprison is taking place without case sensitivity. }
{$IFNDEF _FPC}
type TSetOfChar = Set of AnsiChar;
{$IFNDEF _D2}
function WStrIn( const S : KOLWideString; const A : array of KOLWideString ) : Boolean;
{* Returns True, if S is "equal" to one of strings, taking place
   in A array. To check equality, WAnsiEq function is used, i.e.
   comaprison is taking place without case sensitivity. }
function CharIn( C: KOLChar; const A: TSetOfChar ): Boolean;
{* To replace expressions like S[1] in [ '0'..'z' ] to CharIn( S[ 1 ], [ '0'..'z' ] )
   (and to avoid problems with Unicode version of code). }
{$ENDIF _D2}
{$ENDIF _FPC}
function StrIs( const S : AnsiString; const A : Array of AnsiString; var Idx: Integer ) : Boolean;
{* Returns True, if S is "equal" to one of strings, taking place
   in A array, and in such Case Idx also is assigned to an index of A element
   equal to S. To check equality, StrEq function is used, i.e.
   comaprison is taking place without case sensitivity. }
function IntIn( Value: Integer; const List: array of Integer ): Boolean;
{* Returns TRUE, if Value is found in a List. }
function _StrSatisfy( S, Mask : PKOLChar ) : Boolean;
{* }
function _2StrSatisfy( S, Mask: PKOLChar ): Boolean;
{* }
function StrSatisfy( const S, Mask : KOLString ) : Boolean;
{* Returns True, if S is satisfying to a given Mask (which can contain
   wildcard symbols '*' and '?' interpeted correspondently as 'any
   set of characters' and 'single any character'. If there are no
   such wildcard symbols in a Mask, result is True only if S is maching
   to Mask string.) }
function StrReplace( var S: KOLString; const From, ReplTo: KOLString ): Boolean;
{* Replaces first occurance of From to ReplTo in S, returns True,
   if pattern From was found and replaced. }
function KOLStrReplace( var S: KOLString; const From, ReplTo: KOLString ): Boolean;
{* Replaces first occurance of From to ReplTo in S, returns True,
   if pattern From was found and replaced. }
{$IFNDEF _FPC}
{$IFNDEF _D2}
function WStrReplace( var S: KOLWideString; const From, ReplTo: KOLWideString ): Boolean;
{* Replaces first occurance of From to ReplTo in S, returns True,
   if pattern From was found and replaced. See also function StrReplace.
   This function is not available in Delphi2 (this version of Delphi
   does not support KOLWideString type). }
{$ENDIF _D2}
{$ENDIF _FPC}

function StrRepeat( const S: KOLString; Count: Integer ): KOLString;
{* Repeats given string Count times. E.g., StrRepeat( 'A', 5 ) gives 'AAAAA'. }
{$IFNDEF _FPC}
{$IFNDEF _D2}
function WStrRepeat( const S: KOLWideString; Count: Integer ): KOLWideString;
{* Repeats given wide string Count times. E.g., StrRepeat( 'A', 5 ) gives 'AAAAA'. }
{$ENDIF _D2}
{$ENDIF _FPC}

procedure NormalizeUnixText( var S: AnsiString );
{* In the string S, replaces all occurances of character #10 (without leading #13)
   to the character #13. }
procedure Koi8ToAnsi( s: PAnsiChar );
{* Converts Koi8 text to Ansi (in place) }
const KOI8_Rus: array[ #$C0..#$FF ] of AnsiChar = (
     { 'þ',
       'à', 'á', 'ö', 'ä', 'å', 'ô', 'ã', 'õ', 'è', 'é', 'ê', 'ë', 'ì', 'í', 'î', 'ï',
       'ÿ', 'ð', 'ñ', 'ò', 'ó', 'æ', 'â', 'ü', 'û', 'ç', 'ø', 'ý', 'ù', '÷', 'ú',
       'Þ',
       'À', 'Á', 'Ö', 'Ä', 'Å', 'Ô', 'Ã', 'Õ', 'È', 'É', 'Ê', 'Ë', 'Ì', 'Í', 'Î', 'Ï',
       'ß', 'Ð', 'Ñ', 'Ò', 'Ó', 'Æ', 'Â', 'Ü', 'Û', 'Ç', 'Ø', 'Ý', 'Ù', '×', 'Ú'}
       #$FE,
       #$E0, #$E1, #$F6, #$E4, #$E5, #$F4, #$E3, #$F5, #$E8, #$E9, #$EA, #$EB, #$EC, #$ED, #$EE, #$EF,
       #$FF, #$F0, #$F1, #$F2, #$F3, #$E6, #$E2, #$FC, #$FB, #$E7, #$F8, #$FD, #$F9, #$F7, #$FA,
       #$DE,
       #$C0, #$C1, #$D6, #$C4, #$C5, #$D4, #$C3, #$D5, #$C8, #$C9, #$CA, #$CB, #$CC, #$CD, #$CE, #$CF,
       #$DF, #$D0, #$D1, #$D2, #$D3, #$C6, #$C2, #$DC, #$DB, #$C7, #$D8, #$DD, #$D9, #$D7, #$DA
      );

function StrPCopy(Dest: PAnsiChar; const Source: Ansistring): PAnsiChar;
{* Copyes string into null-terminated. }
function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar;
{* Copyes first MaxLen characters of the Source string into null-terminated Dest. }

function DelimiterLast( const Str, Delimiters: KOLString ): Integer;
{* Returns index of the last of delimiters given by same named parameter
   among characters of Str. If there are no delimiters found, length of
   Str is returned. This function is intended mainly to use in filename
   parsing functions. }
function __DelimiterLast( Str, Delimiters: PKOLChar ): PKOLChar;
{* Returns address of the last of delimiters given by Delimiters parameter
   among characters of Str. If there are no delimeters found, position of
   the null terminator in Str is returned. This function is intended
   mainly to use in filename parsing functions. }
{$IFDEF _D3orHigher}
function W__DelimiterLast( Str, Delimiters: PWideChar ): PWideChar;
{* }
{$ENDIF _D3orHigher}
function SkipSpaces( P: PKOLChar ): PKOLChar;
{* Skips all characters #1..' ' in a string.
}
{$IFDEF F_P}
function DummyStrFun( const S: AnsiString ): AnsiString;
{$ENDIF}

function CompareMem(P1, P2: Pointer; Length: Integer): Boolean;
{* Fast compare of two memory blocks. }
function AllocMem( Size : Integer ) : Pointer;
{* Allocates global memory and unlocks it. }
procedure DisposeMem( var Addr : Pointer );
{* Locks global memory block given by pointer, and frees it.
   Does nothing, if the pointer is nil.
   |<hr>

  <R Text in clipboard operations>
}
{$IFDEF WIN_GDI}

function ClipboardHasText: Boolean;
{* Returns true, if the clipboard contain text to paste from. }
function Clipboard2Text: AnsiString;
{* If clipboard contains text, this function returns it for You. }
{$IFNDEF _FPC}
{$IFNDEF _D2}
function Clipboard2WText: KOLWideString;
{* If clipboard contains text, this function returns it for You (as Unicode string). }
{$ENDIF _D2}
{$ENDIF _FPC}
function Text2Clipboard( const S: AnsiString ): Boolean;
{* Puts given string to a clipboard. }
{$IFNDEF _FPC}
{$IFNDEF _D2}
function WText2Clipboard( const WS: KOLWideString ): Boolean;
{* Puts given Unicode string to a clipboard.
|<hr>
}
{$ENDIF _D2}
{$ENDIF _FPC}

var SearchMnemonics: function ( const S: KOLString ): KOLString
    = {$IFDEF F_P} DummyStrFun {$ELSE}
    {$IFDEF UNICODE_CTRLS} WAnsiUpperCase {$ELSE} AnsiUpperCase {$ENDIF} {$ENDIF};
    MnemonicsLocale: Integer;

procedure SupportAnsiMnemonics( LocaleID: Integer );
{* Provides encoding to work with given locale. Call this global function to
   extend TControl.SupportMnemonics capability (also should be called for a form
   or for Applet variable).

   <R Date and time handling>
}
{$ENDIF WIN_GDI}
{$IFDEF WIN_GDI}

{$IFnDEF _D5orHigher}
            {$DEFINE DATE0_0001}
{$ENDIF _D5orHigher}
{$IFnDEF DATE0_0001}
                    {$DEFINE DATE0_1601}
{$ENDIF} //Starting from the version 3.1415926, (so called PI-version), datetime
         //can be correctly handled (by default) from 1-Jan-1601 to 1-Jan-38827.
         //This made it possible to use short calls to API functions to convert date and time.
         //If you still want to count time correctly from 1-Jan-1 B.C., or a compatibility
         //is required for old applications, define symbol DATE0_0001 in your
         //project options. Actually this does not mean that TDateTime forma changed,
         //but only restrictions are in converting date to TSystemTime from TDateTime
         //and vice versa.
type
  //TDateTime = Double; // well, it is already defined so in System.pas
  {* Basic date and time type. Integer part represents year and days (as is,
     i.e. 1-Jan-2000 is representing by value 730141, which is a number of
     days from 1-Jan-0001 to 1-Jan-2000 inclusively). Fractional part is
     representing hours, minutes, seconds and milliseconds of a day
     proportionally (like in VCL TDateTime type, e.g. 0.5 = 12:00, 0.25 = 6:00,
     etc.). }

  PDayTable = ^TDayTable;
  TDayTable = array[1..12] of Byte;

  TDateFormat = ( dfShortDate, dfLongDate );
  {* Date formats available to use in formatting date/time to string. }
  TTimeFormatFlag = ( tffNoMinutes, tffNoSeconds, tffNoMarker, tffForce24 );
  {* Additional flags, used for formatting time. }
  TTimeFormatFlags = Set of TTimeFormatFlag;
  {* Set of flags, used for formatting time. }

const
  MonthDays: array [Boolean] of TDayTable =
    ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
     (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));
  {* The MonthDays array can be used to quickly find the number of
    days in a month:  MonthDays[IsLeapYear(Y), M].      }

  SecsPerDay = 24 * 60 * 60;
  {* Seconds per day. }
  MSecsPerDay = SecsPerDay * 1000;
  {* Milliseconds per day. }

  Date1601 = 584389;
  VCLDate0 = 693594;
  {* Value to convert VCL "date 0" to KOL "date 0" and back.
     This value corresponds to 30-Dec-1899, 0:00:00. So,
     to convert VCL date to KOL date, just subtract this
     value from VCL date. And to convert back from KOL date
     to VCL date, add this value to KOL date.}

function Now : TDateTime;
{* Returns local date and time on running PC. }
function Date: TDateTime;
{* Returns todaylocal date. }
procedure DecodeDateFully( DateTime: TDateTime; var Year, Month, Day, DayOfWeek: WORD );
{* Decodes date. }
procedure DecodeDate( DateTime: TDateTime; var Year, Month, Day: WORD );
{* Decodes date. }
function EncodeDate( Year, Month, Day: WORD; var DateTime: TDateTime ): Boolean;
{* Encodes date. }
function CompareSystemTime(const D1, D2 : TSystemTime) : Integer;
{* Compares to TSystemTime records. Returns -1, 0, or 1 if, correspondantly,
   D1 < D2, D1 = D2 and D1 > D2. }
procedure IncDays( var SystemTime : TSystemTime; DaysNum : Integer );
{* Increases/decreases day in TSystemTime record onto given days count
   (can be negative). }
procedure IncMonths( var SystemTime : TSystemTime; MonthsNum : Integer );
{* Increases/decreases month number in TSystemTime record onto given
   months count (can be negative). Correct result is not garantee if
   day number is incorrect for newly obtained month. }
function IsLeapYear(Year: Integer): Boolean;
{* Returns True, if given year is "leap" (i.e. has 29 days in the February). }
function DayOfWeek(Date: TDateTime): Integer;
{* Returns day of week (0..6) for given date. }
function SystemTime2DateTime(const SystemTime : TSystemTime; var DateTime : TDateTime ) : Boolean;
{* Converts TSystemTime record to XDateTime variable. }
function DateTime2SystemTime(const DateTime : TDateTime; var SystemTime : TSystemTime ) : Boolean;
{* Converts TDateTime variable to TSystemTime record. }
function DateTime_System2Local( DTSys: TDateTime ): TDateTime;
{* Converts DTSys representing system time (+0 Grinvich) to local time. }
function DateTime_Local2System( DTLoc: TDateTime ): TDateTime;
{* Converts DTLoc representing local time to system time (+0 Grinvich) }
function FileTime2DateTime( const ft: TFileTime; var DT: TDateTime ): Boolean;
{* }
function DateTime2FileTime( DT: TDateTime; var ft: TFileTime ): Boolean;
{* }

procedure DivMod(Dividend: Integer; Divisor: Word; var Result, Remainder: Word);
{* Dividing of integer onto divisor with obtaining both result of division
   and remainder. }

function SystemDate2Str( const SystemTime : TSystemTime; const LocaleID : DWORD;
                         const DfltDateFormat : TDateFormat;
                         const DateFormat : PKOLChar ) : KOLString;
{* Formats date, stored in TSystemTime record into string, using given locale
   and date/time formatting flags. (E.g.: GetUserDefaultLangID). }
function SystemTime2Str( const SystemTime : TSystemTime; const LocaleID : DWORD;
                         const Flags : TTimeFormatFlags;
                         const TimeFormat : PKOLChar ) : KOLString;
{* Formats time, stored in TSystemTime record into string, using given locale
   and date/time formatting flags. }

function Date2StrFmt( const Fmt: KOLString; D: TDateTime ): KOLString;
{* Represents date as a string correspondently to Fmt formatting string.
   See possible pictures in definition of the function Str2DateTimeFmt
   (the first part). If Fmt string is empty, default system date format
   for short date string used. }
function Time2StrFmt( const Fmt: KOLString; D: TDateTime ): KOLString;
{* Represents time as a string correspondently to Fmt formatting string.
   See possible pictures in definition of the function Str2DateTimeFmt
   (the second part). If Fmt string is empty, default system time format
   for short date string used. }
function DateTime2StrShort( D: TDateTime ): KOLString;
{* Formats date and time to string in short date format using current user
   locale. }
function Str2DateTimeFmt( const sFmtStr, sS: KOLString ): TDateTime;
{* Restores date or/and time from string correspondently to a format string.
   Date and time formatting string can contain following pictures (case
   sensitive):
   |<pre>
        DATE PICTURES
   d    Day of the month as digits without leading zeros for single digit days.
   dd   Day of the month as digits with leading zeros for single digit days
   ddd  Day of the week as a 3-letter abbreviation as specified by a
        LOCALE_SABBREVDAYNAME value.
   dddd Day of the week as specified by a LOCALE_SDAYNAME value.
   M    Month as digits without leading zeros for single digit months.
   MM   Month as digits with leading zeros for single digit months
   MMM  Month as a three letter abbreviation as specified by a LOCALE_SABBREVMONTHNAME value.
   MMMM Month as specified by a LOCALE_SMONTHNAME value.
   y    Year represented only be the last digit.
   yy   Year represented only be the last two digits.
   yyyy Year represented by the full 4 digits.
   gg   Period/era string as specified by the CAL_SERASTRING value. The gg
        format picture in a date string is ignored if there is no associated era
        string. In Enlish locales, usual values are BC or AD.

        TIME PICTURES
   h    Hours without leading zeros for single-digit hours (12-hour clock).
   hh   Hours with leading zeros for single-digit hours (12-hour clock).
   H    Hours without leading zeros for single-digit hours (24-hour clock).
   HH   Hours with leading zeros for single-digit hours (24-hour clock).
   m    Minutes without leading zeros for single-digit minutes.
   mm   Minutes with leading zeros for single-digit minutes.
   s    Seconds without leading zeros for single-digit seconds.
   ss   Seconds with leading zeros for single-digit seconds.
   t    One character–time marker string (usually P or A, in English locales).
   tt   Multicharacter–time marker string (usually PM or AM, in English locales).
   |</pre>
   E.g., 'D, yyyy/MM/dd h:mm:ss'.
   See also Str2DateTimeShort function.
  }
function Str2TimeFmt(const sFmtStr, sS: KOLString): TDateTime;
{* Same as above but for time only }
function Str2DateTimeShort( const S: KOLString ): TDateTime;
{* Restores date and time from string correspondently to current user locale. }
function Str2DateTimeShortEx( const S: KOLString ): TDateTime;
{* Like Str2DateTimeShort above, but uses locale defined date and time
   separators to avoid recognizing time as a date in some cases.}
function Str2TimeShort(const S: KOLString): TDateTime;
{* Like Str2DateTimeShort but for time only.
|<hr>

  <R File and directory routines>
}
{$ENDIF WIN_GDI}

const
  ofOpenRead          = {$IFDEF LIN} O_RDONLY {$ELSE} $80000000 {$ENDIF};
  {* Use this flag (in combination with others) to open file for "read" only. }
  ofOpenWrite         = {$IFDEF LIN} O_WRONLY {$ELSE} $40000000 {$ENDIF};
  {* Use this flag (in combination with others) to open file for "write" only. }
  ofOpenReadWrite     = {$IFDEF LIN} O_RDWR {$ELSE} $C0000000 {$ENDIF};
  {* Use this flag (in combination with others) to open file for "read" and "write". }

  ofShareExclusive    = {$IFDEF LIN} $10 {$ELSE} $00 {$ENDIF};
  {* Use this flag (in combination with others) to open file for exclusive use. }
  ofShareDenyWrite    = {$IFDEF LIN} $20 {$ELSE} $01 {$ENDIF};
  {* Use this flag (in combination with others) to open file in share mode, when
     only attempts to open it in other process for "write" will be impossible.
     I.e., other processes could open this file simultaneously for read only
     access. }
  ofShareDenyRead     = {$IFDEF LIN} 0 {not supported} {$ELSE} $02 {$ENDIF};
  {* Use this flag (in combination with others) to open file in share mode, when
     only attempts to open it for "read" in other processes will be disabled.
     I.e., other processes could open it for "write" only access. }
  ofShareDenyNone     = {$IFDEF LIN} $30 {$ELSE} $03 {$ENDIF};
  {* Use this flag (in combination with others) to open file in full sharing mode.
     I.e. any process will be able open this file using the same share flag. }
  ofCreateNew         = {$IFDEF LIN} O_CREAT or O_TRUNC {$ELSE} $100 {$ENDIF};
  {* Default creation disposition. Use this flag for creating new file (usually
     for write access. }
  ofCreateAlways      = {$IFDEF LIN} O_CREAT {$ELSE} $200 {$ENDIF};
  {* Use this flag (in combination with others) to open existing or creating new
     file. If existing file is opened, it is truncated to size 0. }
  ofOpenExisting      = {$IFDEF LIN} 0 {$ELSE} $300 {$ENDIF};
  {* Use this flag (in combination with others) to open existing file only. }
  ofOpenAlways        = {$IFDEF LIN} O_CREAT {$ELSE} $400 {$ENDIF};
  {* Use this flag (in combination with others) to open existing or create new
     (if such file is not yet exists). }
  ofTruncateExisting  = {$IFDEF LIN} O_TRUNC {$ELSE} $500 {$ENDIF};
  {* Use this flag (in combination with others) to open existing file and truncate
     it to size 0. }

  ofAttrReadOnly = {$IFDEF LIN} 0 {$ELSE} $10000 {$ENDIF};
  {* Use this flag to create Read-Only file (?). }
  ofAttrHidden   = {$IFDEF LIN} 0 {$ELSE} $20000 {$ENDIF};
  {* Use this flag to create hidden file. }
  ofAttrSystem   = {$IFDEF LIN} 0 {$ELSE} $40000 {$ENDIF};
  {* Use this flag to create system file. }
  ofAttrTemp       = {$IFDEF LIN} 0 {$ELSE} $1000000 {$ENDIF};
  {* Use this flag to create temp file. }
  ofAttrArchive  = {$IFDEF LIN} 0 {$ELSE} $200000 {$ENDIF};
  {* Use this flag to create archive file. }
  ofAttrCompressed = {$IFDEF LIN} 0 {$ELSE} $8000000 {$ENDIF};
  {* Use this flag to create compressed file. Has effect only on NTFS, and
     only if ofAttrCompressed is not specified also. }
  ofAttrOffline    = {$IFDEF LIN} 0 {$ELSE} $10000000 {$ENDIF};
  {* Use this flag to create cloud file. }

{$IFDEF _D3orHigher}
function WFileCreate(const FileName: KOLWideString; OpenFlags: DWord): THandle;
{* }
{$ENDIF}
function FileCreate(const FileName: KOLString; OpenFlags: DWord): THandle;
{* Call this function to open existing or create new file. OpenFlags
   parameter can be a combination of up to three flags (by one from
   each group:
   |<table border=0>
   |&L=<tr><td valign=top>%0</td><td valign=top>
   |&E=</td></tr>
   <L ofOpenRead, ofOpenWrite, ofOpenReadWrite> - 1st group. Here You decide
      wish You open file for read, write or read-and-write operations; <E>
   <L ofShareExclusive, ofShareDenyWrite, ofShareDenyRead, ofShareDenyNone> -2nd
      group - sharing. Here You can mark out sharing mode, which is used to
      open file. <E>
   <L ofCreateNew, ofCreateAlways, ofOpenExisting, ofOpenAlways, ofTruncateExisting>
      - 3rd group - creation disposition. Here You determine, either to create new
      or open existing file and if to truncate existing or not.
   |</table> }
function FileClose(Handle: THandle): Boolean;
{* Call it to close opened earlier file. }
function FileExists( const FileName: KOLString ) : Boolean;
{* Returns True, if given file exists.
   |<br>Note (by Dod):
   It is not documented in a help for GetFileAttributes, but it seems that
   under NT-based Windows systems, FALSE is always returned for files
   opened for excluseve use like pagefile.sys. }
{$IFDEF _D3orHigher}
function WFileExists( const FileName: KOLWideString ) : Boolean;
{* Returns True, if given file exists.
   |<br>Note (by Dod):
   It is not documented in a help for GetFileAttributes, but it seems that
   under NT-based Windows systems, FALSE is always returned for files
   opened for excluseve use like pagefile.sys. }
{$ENDIF}
function FileSeek(Handle: THandle; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveMethod: TMoveMethod): TStrmSize;
{* Changes current position in file. }
function FileRead(Handle: THandle; var Buffer; Count: DWord): DWord;
{* Reads bytes from current position in file to buffer. Returns number of
   read bytes. }
{$IFDEF LIN}
function GetFileSize( Handle: THandle; HiSize: PDWORD ): DWORD;
{$ENDIF LIN}
function File2Str(Handle: THandle): AnsiString;
{* Reads file from current position to the end and returns result as ansi string. }
{$IFNDEF _D2}
function File2WStr(Handle: THandle): KOLWideString;
{* Reads UNICODE file from current position to the end and returns result as
   unicode string. }
{$ENDIF}
function FileWrite(Handle: THandle; const Buffer; Count: DWord): DWord;
{* Writes bytes from buffer to file from current position, extending its
   size if needed. }
function FileEOF( Handle: THandle ) : Boolean;
{* Returns True, if EOF is achieved during read operations or last byte is
   overwritten or append made to extend file during last write operation. }
function FileFullPath( const FileName : KOLString ) : KOLString;
{* Returns full path name for given file. Validness of source FileName path
   is not checked at all. }
{$IFDEF WIN} //--------------- these functions have not sense in Linux: --------
function FileShortPath( const FileName: KOLString ): KOLString;
{* Returns short path to the file or directory. }
function FileIconSystemIdx( const Path: KOLString ): Integer;
{* Returns index of the index of the system icon correspondent to the file or
   directory in system icon image list. }
function FileIconSysIdxOffline( const Path: KOLString ): Integer;
{* The same as FileIconSystemIdx, but an icon is calculated for the file
   as it were offline (it is possible to get an icon for file even if
   it is not existing, on base of its extension only). }
function DirIconSysIdxOffline( const Path: KOLString ): Integer;
{* The same as FileIconSysIdxOffline, but for a folder rather then for a file. }
{$ENDIF WIN} //-----------------------------------------------------------------
procedure LogFileOutput( const filepath, str: KOLString );
{* Debug function. Use it to append given string to the end of the given file. }

function Str2File( Filename: PKOLChar; Str: PAnsiChar ): Boolean;
{* Save null-terminated string to file directly. If file does not exists, it is
   created. If it exists, it is overriden. If operation failed, FALSE is returned. }
function WStr2File( Filename: PKOLChar; Str: PWideChar ): Boolean;
{* Save null-terminated wide string to file directly. If file does not exists, it is
   created. If it exists, it is overriden. If operation failed, FALSE is returned. }
function StrSaveToFile( const Filename: KOLString; const Str: AnsiString ): Boolean;
{* Saves a string to a file without any changes. If file does not exists, it is
   created. If it exists, it is overriden. If operation failed, FALSE is returned. }
function StrLoadFromFile( const Filename: KOLString ): AnsiString;
{* Reads entire file and returns its content as a string. If operation failed,
   an empty strinng is returned.
   |<br>by Sergey Shishmintzev: it is possible to pass Filename = 'CON' to
   read input from redirected console output. }
{$IFNDEF _D2}
function WStrSaveToFile( const Filename: KOLString; const Str: KOLWideString ): Boolean;
{* Saves a string to a file without any changes. If file does not exists, it is
   created. If it exists, it is overriden. If operation failed, FALSE is returned. }
function WStrLoadFromFile( const Filename: KOLString ): KOLWideString;
{* Reads entire file and returns its content as a string. If operation failed,
   an empty strinng is returned.
   |<br>by Sergey Shishmintzev: it is possible to pass Filename = 'CON' to
   read input from redirected console output. }
{$ENDIF}

function Mem2File( Filename: PKOLChar; Mem: Pointer; Len: Integer ): Integer;
{* Saves memory block to a file (if file exists it is overriden, created new if
   not exists). }
function File2Mem( Filename: PKOLChar; Mem: Pointer; MaxLen: Integer ): Integer;
{* Loads file content to memory. }

{$IFDEF WIN}
type
  PFindFileData = ^TFindFileData;
  TFindFileData = packed record
    // from TWin32FindData: -------------
    dwFileAttributes: DWORD;
    ftCreationTime: TFileTime;
    ftLastAccessTime: TFileTime;
    ftLastWriteTime: TFileTime;
    nFileSizeHigh: DWORD;
    nFileSizeLow: DWORD;
    dwReserved0: DWORD;
    dwReserved1: DWORD;
    cFileName: Array[0..MAX_PATH - 1] of KOLChar;
    cAlternateFileName: Array[0..13] of KOLChar;
    //-------- + handle:
    FindHandle: THandle;
  end;
{$ENDIF WIN}
function Find_First( const FilePathName: KOLString; var F: TFindFileData ): Boolean;
function Find_Next( var F: TFindFileData ): Boolean;
procedure Find_Close( var F: TFindFileData );
{$IFDEF _D2orD3}
function FileSize( const Path: KOLString ) : Integer;
{$ELSE}
function FileSize( const Path: KOLString ) : Int64;
{$ENDIF}
{* Returns file size in bytes without opening it. If file too large
   to represent its size as Integer, -1 is returned. }
procedure FileTime( const Path: KOLString;
  CreateTime, LastAccessTime, LastModifyTime: PFileTime ); stdcall;
{* Returns file times without opening it. }
function GetUniqueFilename( PathName: KOLString ) : KOLString;
{* If file given by PathName exists, modifies it to create unique
   filename in target folder and returns it. Modification is performed
   by incrementing last number in name (if name part of file does not
   represent a number, such number is generated and concatenated to
   it). E.g., if file aaa.aaa is already exist, the function checks
   names aaa1.aaa, aaa2.aaa, ..., aaa10.aaa, etc. For name abc123.ext,
   names abc124.ext, abc125.ext, etc. will be checked. }
function FileTimeCompare( const FT1, FT2 : TFileTime ) : Integer;
{* Compares time of file (createing, writing, accessing. Returns
   -1, 0, 1 if correspondantly FT1<FT2, FT1=FT2, FT1>FT2. }
function DirectoryExists(const Name: KOLString): Boolean;
{* Returns True if given directory (folder) exists. }
function DiskPresent( const DrivePath: KOLString ): Boolean;
{* Returns TRUE if the disk is present }
{$IFDEF _D3orHigher}
function WDirectoryExists(const Name: KOLWideString): Boolean;
{* }
{$ENDIF}
function CheckDirectoryContent( const Name: KOLString; SubDirsOnly: Boolean;
         const Mask: KOLString ): Boolean;
{* Returns TRUE if directory does not contain files (or directories only)
   satisfying given mask. }
function DirectoryEmpty(const Name: KOLString): Boolean;
{* Returns True if given directory is not exists or empty. }
function DirectoryHasSubdirs( const Path: KOLString ): Boolean;
{* Returns TRUE if given directory exists and has subdirectories. }
function GetStartDir: KOLString;
{* Returns path to directory where executable is located (regardless
   of current directory). }
function ExePath: KOLString;
{* Returns the path to the exe-file (in case of dll hook, this is exe-file
   of the process in which context dll hook function is called). }
function ModulePath: KOLString;
{* Returns the path to the module (exe, dll) itself. }



//---------------------------------------------------------
// Following functions/procedures are created by Edward Aretino:
// IncludeTrailingPathDelimiter, ExcludeTrailingPathDelimiter,
// ForceDirectories, CreateDir, ChangeFileExt
//---------------------------------------------------------
function ExcludeTrailingChar( const S: KOLString; C: KOLChar ): KOLString;
{* If S is finished with character C, it is excluded. }
function IncludeTrailingChar( const S: KOLString; C: KOLChar ): KOLString;
{* If S is not finished with character C, it is added. }
function IncludeTrailingPathDelimiter(const S: KOLString): KOLString;
{* by Edward Aretino. Adds '\' to the end if it is not present. }
function ExcludeTrailingPathDelimiter(const S: KOLString): KOLString;
{* by Edward Aretino. Removes '\' at the end if it is present. }

function ExtractFileDrive( const Path: KOLString ) : KOLString;
{* Returns only drive part from exact path to a file or a directory.
   For network paths, returns a computer name together with a following
   name of shared directory (like '\\compname\shared\' ). }
function ExtractFilePath( const Path: KOLString ) : KOLString;
{* Returns only path part from exact path to file. }
{$IFDEF _D3orHigher}
function WExtractFilePath( const Path: KOLWideString ) : KOLWideString;
{* Returns only path part from exact path to file. }
{$ENDIF}
function IsNetworkPath( const Path: KOLString ): Boolean;
{* Returns TRUE, if Path is starting from '\\'. }
function ExtractFileName( const Path: KOLString ) : KOLString;
{* Extracts file name from exact path to file. }
function ExtractFileNameWOext( const Path: KOLString ) : KOLString;
{* Extracts file name from path to file or from filename. }
function ExtractFileExt( const Path: KOLString ) : KOLString;
{* Extracts extention from file name (returns it with dot '.' first) }
function ReplaceExt( const Path, NewExt: KOLString ): KOLString;
{* Returns Path to a file with extension replaced to a new extension.
   Pass a new extension started with '.', e.g. '.txt'. }

function ForceDirectories(Dir: KOLString): Boolean;
{* by Edward Aretino. Creates given directory if not present. All needed
   subdirectories are created if necessary. }
function CreateDir(const Dir: KOLString): Boolean;
{* by Edward Aretino. Creates given directory. }
function ChangeFileExt(FileName: KOLString; const Extension: KOLString): KOLString;
{* by Edward Aretino. Changes file extention. }
function ReplaceFileExt( const Path, NewExt: KOLString ): KOLString;
{* Returns a path with extension replaced to a given one. }
{$IFDEF WIN} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
function ExtractShortPathName( const Path: KOLString ): KOLString;
{* }
{$IFDEF GDI}
function FilePathShortened( const Path: KOLString; MaxLen: Integer ): KOLString;
{* Returns shortened file path to fit MaxLen characters. }
function FilePathShortenPixels( const Path: KOLString; DC: HDC; MaxPixels: Integer ): KOLString;
{* Returns shortened file path to fit MaxPixels for a given DC. If you pass
   Canvas.Handle of any control or bitmap object, ensure that font is valid
   for it (or call TCanvas.RequiredState( FontValid ) method before. If DC passed
   = 0, call is equivalent to call FilePathShortened, and MaxPixels means in such
   case maximum number of characters. }
function MinimizeName( const Path: KOLString; DC: HDC; MaxPixels: Integer ): KOLString;
{* Exactly the same as MinimizeName in FileCtrl.pas (VCL). }
{$ENDIF GDI}

function GetSystemDir: KOLString;
{* Returns path to windows system directory. }
function GetWindowsDir : KOLString;
{* Returns path to Windows directory. }
{$ENDIF WIN} //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
function GetWorkDir : KOLString;
{* Returns path to application's working directory. }
function GetTempDir : KOLString;
{* Returns path to default temp folder (directory to place temporary files). }
function CreateTempFile( const DirPath, Prefix: KOLString ): KOLString;
{* Returns path to just created temporary file. }
function  GetFileListStr(FPath{e.g.'c:\tmp\'}, FMask{e.g.'*.*'}: KOLString): KOLString;
{* List of files in string, separating each path from others with a character stored
   in FileOpSeparator variables (#13 by default).
   E.g.: 'c:\tmp\unit1.dcu'#13'c:\tmp\unit1.~pa' (for use with DeleteFile2Recycle())}
function DeleteFiles( const DirPath: KOLString ): Boolean;
{* Deletes files by file mask (given with wildcards '*' and '?'). }
{$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
var FileOpSeparator: KOLChar = {$IFDEF OLD_COMPAT}';'{$ELSE}#13{$ENDIF};
function DoFileOp( const FromList, ToList: KOLString; FileOp: UINT; Flags: Word;
         Title: PKOLChar): Boolean;
{* By Unknown Mystic. FileOp can be: FO_MOVE, FO_COPY, FO_DELETE, FO_RENAME.
   Flags can be a combination of values: FOF_MULTIDESTFILES, FOF_CONFIRMMOUSE,
   FOF_SILENT, FOF_RENAMEONCOLLISION, FOF_NOCONFIRMATION, FOF_WANTMAPPINGHANDLE,
   FOF_ALLOWUNDO, FOF_FILESONLY, FOF_SIMPLEPROGRESS, FOF_NOCONFIRMMKDIR,
   FOF_NOERRORUI. Title used only with FOF_SIMPLEPROGRESS. }
function DeleteFile2Recycle( const Filename : KOLString ) : Boolean;
{* Deletes file to recycle bin. This operation can be very slow, when
   called for a single file. To delete group of files at once (fast),
   pass a list of paths to files to be deleted, separating each path
   from others with a character stored in FileOpSeparator variable (by default #13,
   but in case when OLD_COMPAT symbol added - ';'). E.g.: 'unit1.dcu'#13'unit1.~pa'
   |<br>
   FALSE is returned only in case when at least one file was not deleted
   successfully.
   |<br>
   Note, that files are deleted not to recycle bin, if wildcards are
   used or not fully qualified paths to files. }
function CopyMoveFiles( const FromList, ToList: KOLString; Move: Boolean ): Boolean;
{* }
{$IFNDEF PAS_ONLY}
function DiskFreeSpace( const Path: KOLString ): I64;
{$ENDIF}
{* Returns disk free space in bytes. Pass a path to root directory,
   e.g. 'C:\'.
  |<hr>

  <R Wrappers to registry API functions>

  These functions can be used independently to simplify access to Windows
  registry. }
{$ENDIF WIN_GDI} //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

{$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
function RegKeyOpenRead( Key: HKey; const SubKey: KOLString ): HKey;
{* Opens registry key for read operations (including enumerating of subkeys).
   Pass either handle of opened earlier key or one of constans
   HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS
   as a first parameter. If not successful, 0 is returned. }
function RegKeyOpenWrite( Key: HKey; const SubKey: KOLString ): HKey;
{* Opens registry key for write operations (including adding new values or
   subkeys), as well as for read operations too. See also RegKeyOpenRead. }
function RegKeyOpenCreate( Key: HKey; const SubKey: KOLString ): HKey;
{* Creates and opens key. }
function RegKeyGetStr( Key: HKey; const ValueName: KOLString ): KOLString;
{* Reads key, which must have type REG_SZ (null-terminated string). If
   not successful, empty string is returned. This function as well as all
   other registry manipulation functions, does nothing, if Key passed is 0
   (without producing any error). }
function RegKeyGetStrEx( Key: HKey; const ValueName: KOLString
  {$IFDEF OPTIONAL_REG_EXPAND_SZ} ; ExpandEnvVars: Boolean {$ENDIF} ): KOLString;
{* Like RegKeyGetStr, but accepts REG_EXPAND_SZ type, expanding all
   environment variables in resulting string.
   |<br>
   Code provided by neuron, e-mailto:neuron@hollowtube.mine.nu }
function RegKeyGetDw( Key: HKey; const ValueName: KOLString ): DWORD;
{* Reads key value, which must have type REG_DWORD. If ValueName passed
   is '' (empty string), unnamed (default) value is reading. If not
   successful, 0 is returned. }
function RegKeySetStr(Key: HKey; const ValueName: KOLString; const Value: KOLString ): Boolean;
{* Writes new key value as null-terminated string (type REG_SZ). If not
   successful, returns False. }
function RegKeySetStrEx( Key: HKey; const ValueName: KOLString; const Value: KOLString;
                         expand: Boolean): Boolean;
{* Writes new key value as REG_SZ or REG_EXPAND_SZ. - by neuron, e-mailto:neuron@hollowtube.mine.nu }
function RegKeySetDw( Key: HKey; const ValueName: KOLString; Value: DWORD ): Boolean;
{* Writes new key value as dword (with type REG_DWORD). Returns False,
   if not successful. }
procedure RegKeyClose( Key: HKey );
{* Closes key, opened using RegKeyOpenRead or RegKeyOpenWrite. (But does
   nothing, if Key passed is 0). }
function RegKeyDelete( Key: HKey; const SubKey: KOLString ): Boolean;
{* Deletes key. Does nothing if key passed is 0 (returns FALSE). }
function RegKeyDeleteValue( Key: HKey; const SubKey: KOLString ): Boolean;
{* Deletes value. - by neuron, e-mailto:neuron@hollowtube.mine.nu }
function RegKeyExists( Key: HKey; const SubKey: KOLString ): Boolean;
{* Returns TRUE, if given subkey exists under given Key. }
function RegKeyValExists( Key: HKey; const ValueName: KOLString ): Boolean;
{* Returns TRUE, if given value exists under the Key.
}
function RegKeyValueSize( Key: HKey; const ValueName: KOLString ): Integer;
{* Returns a size of value. This is a size of buffer needed to store
   registry key value. For string value, size returned is equal to a
   length of string plus 1 for terminated null character. }
function RegKeyGetBinary( Key: HKey; const ValueName: KOLString; var Buffer; Count: Integer ): Integer;
{* Reads binary data from a registry, writing it to the Buffer.
   It is supposed that size of Buffer provided is at least Count bytes.
   Returned value is actul count of bytes read from the registry and written
   to the Buffer.
   |<br>
   This function can be used to get data of any type from the registry, not
   only REG_BINARY. }
function RegKeySetBinary( Key: HKey; const ValueName: KOLString; const Buffer; Count: Integer ): Boolean;
{* Stores binary data in the registry. }
function RegKeyGetDateTime(Key: HKey; const ValueName: KOLString): TDateTime;
{* Returns datetime variable stored in registry in binary format. }
function RegKeySetDateTime(Key: HKey; const ValueName: KOLString; DateTime: TDateTime): Boolean;
{* Stores DateTime variable in the registry. }

//-------------------------------------------------------
// registry functions by Valerian Luft <luft@valerian.de>
//-------------------------------------------------------
function RegKeyGetSubKeys( const Key: HKEY; List: PKOLStrList): Boolean;
{* The function enumerates subkeys of the specified open registry key.
   True is returned, if successful.
}
function RegKeyGetValueNames(const Key: HKEY; List: PKOLStrList): Boolean;
{* The function enumerates value names of the specified open registry key.
   True is returned, if successful.
}
function RegKeyGetValueTyp (const Key:HKEY; const ValueName: KOLString) : DWORD;
{* The function receives the type of data stored in the specified value.
   |<br>
   If the function fails, the return value is the Key value.
   |<br>
   If the function succeeds, the return value return will be one of the following:
   |<br>
   REG_BINARY , REG_DWORD, REG_DWORD_LITTLE_ENDIAN,
   REG_DWORD_BIG_ENDIAN, REG_EXPAND_SZ, REG_LINK , REG_MULTI_SZ,
   REG_NONE, REG_RESOURCE_LIST, REG_SZ

|<hr>

  <R Data sorting (quicksort implementation)>
  This part contains implementation of 'quick sort' algorithm,
   based on following code:

|<pre>
| TQSort by Mike Junkin 10/19/95.
| DoQSort routine adapted from Peter Szymiczek's QSort procedure which
| was presented in issue#8 of The Unofficial Delphi Newsletter.

| TQSort changed by Vladimir Kladov (Mr.Bonanzas) to allow 32-bit
| sorting (of big arrays with more than 64K elements).
|</pre>

  Finally, this sort procedure is adapted to XCL (and then to KOL)
  requirements (no references to SysUtils, Classes etc. TQSort object
  is transferred to a single procedure call and DoQSort method is
  renamed to SortData - which is a regular procedure now). }

{$ENDIF WIN_GDI} //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

procedure SortData( const Data: Pointer; const uNElem: Dword;
                    const CompareFun: TCompareEvent;
                    const SwapProc: TSwapEvent );
{* Call it to sort any array of data of any kind, passing total
   number of items in an array and two defined (regular) function
   and procedure to perform custom compare and swap operations.
   First procedure parameter is to pass it to callback function
   CompareFun and procedure SwapProc. Items are enumerated from
   0 to uNElem-1. }

{$IFDEF _D3orHigher}
procedure SortArray( const Data: Pointer; const uNElem: Dword;
                     const CompareFun: TCompareArrayEvent );
{* Like SortData, but faster and allows to sort only contigous arrays of
   dwords (or integers or pointers occupying for 4 bytes for each item. }
{$ENDIF}

procedure SwapListItems( const L: Pointer; const e1, e2: DWORD );
{* Use this function as the last parameter for SortData call when a PList
   object is sorting. SwapListItems just exchanges two items of the list. }

procedure SortIntegerArray( var A : array of Integer );
{* procedure to sort array of integers. }

procedure SortDwordArray( var A : array of DWORD );
{* Procedure to sort array of unsigned 32-bit integers.
|<hr>
}
{ ------------------- directory list object ---------------------------------- }

type
  TDirItemAction = ( diSkip, diAccept, diCancel );
  TOnDirItem = procedure( Sender: PObj; var DirItem: TFindFileData; var Accept: TDirItemAction )
             of object;
  TSortDirRules = ( sdrNone, sdrFoldersFirst, sdrCaseSensitive, sdrByName, sdrByExt,
                    sdrBySize, sdrBySizeDescending, sdrByDateCreate, sdrByDateChanged,
                    sdrByDateAccessed, sdrInvertOrder );
  {* List of rules (options) to sort directories. Rules are passed to Sort
     method in an array, and first placed rules are applied first. }

  PDirList = ^TDirList;
{ ----------------------------------------------------------------------
                TDirList - Directory scanning
----------------------------------------------------------------------- }
  TDirList = object( TObj )
  {* Allows easy directory scanning. This is not visual object, but
     storage to simplify working with directory content. }
  protected
    FListPositions : PList; //^^^^^^^^^^ Attention: order of FListPositions &
    fStoreFiles: PStream;   //__________ fStoreFiles is IMPORTANT!
    FPath: KOLString;
    fFilters: {$IFDEF UNICODE_CTRLS} PWStrList {$ELSE} PStrList {$ENDIF};
    fOnItem: TOnDirItem;
    function Get(Idx: Integer): PFindFileData;
    function GetCount: Integer;
    function GetNames(Idx: Integer): KOLString;
    function GetIsDirectory(Idx: Integer): Boolean;
  protected
    function SatisfyFilter( FileName : PKOLChar; FileAttr, FindAttr : DWord ) : Boolean;
    destructor Destroy; virtual;
    {* Destructor. As usual, call Free method to destroy an object. }
  public
    property Items[ Idx : Integer ] : PFindfileData read Get; default;
    {* Full access to scanned items (files and subdirectories). }
    property IsDirectory[ Idx: Integer ]: Boolean read GetIsDirectory;
    {* Returns TRUE, if specified item represents a directory, not a file. }
    property Count : Integer read GetCount;
    {* Number of items. }
    property Names[ Idx : Integer ] : KOLString read GetNames;
    {* Full long names of directory items. }
    property Path : KOLString read FPath;
    {* Path of scanned directory. }
    procedure Clear;
    {* Call it to clear list of files. }
    procedure ScanDirectory( const DirPath, Filter : KOLString; Attr : DWord );
    {* Call it to rescan directory or to scan another directory content
       (method Clear is called first). Pass path to directory, file filter
       and attributes to scan directory immediately.
       |<br>&nbsp;&nbsp;&nbsp;
       Note: Pass FILE_ATTRIBUTE_... constants or-combination as Attr
       parameter. If 0 passed, both files and directories are listed. }
    procedure ScanDirectoryEx( const DirPath, Filters : KOLString; Attr : DWord );
    {* Call it to rescan directory or to scan another directory content
       (method Clear is called first). Pass path to directory, file filter
       and attributes to scan directory immediately.
       |<br>&nbsp;&nbsp;&nbsp;
       Note: Pass FILE_ATTRIBUTE_... constants or-combination as Attr
       parameter. }
    procedure Sort( Rules : array of TSortDirRules );
   {* Sorts directory entries. If empty rules array passed, default rules
      array DefSortDirRules is used. }
   function FileList( const Separator {e.g.: ';', or #13}: KOLString;
            Dirs, FullPaths: Boolean ): KOLString;
   {* Returns a string containing all names separated with Separator.
      If Dirs=FALSE, only files are returned. }
   property OnItem: TOnDirItem read fOnItem write fOnItem;
   {* This event is called on reading each item while scanning directory.
      To use it, first create PDirList object with empty path to scan, then
      assign OnItem event and call ScanDirectory with correct path. }
   procedure DeleteItem( Idx: Integer );
   {* Allows to delete an item from the directory list (not from the disk!) }
   procedure AddItem( FindData: PFindFileData );
   {* Allows to add arbitrary item to the list. }
   procedure InsertItem( idx: Integer; FindData: PFindFileData );
   {* Allows to add arbitrary item to the list. }
  end;

function NewDirList( const DirPath, Filter: KOLString; Attr: DWORD ): PDirList;
{* Creates directory list object using easy one-string filter. If Attr = FILE_ATTRIBUTE_NORMAL,
   only files are scanned without directories. If Attr = 0, both files and
   directories are listed. }
function NewDirListEx( const DirPath, Filters: KOLString; Attr: DWORD ): PDirList;
{* Creates directory list object using several filters, separated by ';'.
   Filters starting from '^' consider to be anti-filters, i.e. files,
   satisfying to those masks, are skept during scanning. }
const DefSortDirRules : array[ 0..3 ] of TSortDirRules = ( sdrFoldersFirst,
      sdrByName, sdrBySize, sdrByDateCreate );
{* Default rules to sort directory entries. }
{$IFNDEF PAS_ONLY}
function DirectorySize( const Path: KOLString ): I64;
{* Returns directory size in bytes as large 64 bit integer. }
{$ENDIF}

{$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
type
  TOpenSaveOption = ( OSCreatePrompt,
                      OSExtensionDiffent,
                      OSFileMustExist,
                      OSHideReadonly,
                      OSNoChangedir,
                      OSNoReferenceLinks,
                      OSAllowMultiSelect,
                      OSNoNetworkButton,
                      OSNoReadonlyReturn,
                      OSOverwritePrompt,
                      OSPathMustExist,
                      OSReadonly,
                      OSNoValidate
  //{$IFDEF OpenSaveDialog_Extended}
                      ,
                      OSTemplate,
                      OSHook
  //{$ENDIF}
                    );
  TOpenSaveOptions = set of TOpenSaveOption;
  {* Options available for TOpenSaveDialog. }

  POpenSaveDialog = ^TOpenSaveDialog;
{ ----------------------------------------------------------------------
                              TOpenSaveDialog
----------------------------------------------------------------------- }
  TOpenSaveDialog = object( TObj )
  {* Object to show standard Open/Save dialog. Initially provided
     for XCL by Carlo Kok. }
  protected
    FFilter : KOLString;
    fFilterIndex : Integer;
    fOpenDialog : Boolean;
    FInitialDir : KOLString;
    FDefExtension : KOLString;
    FFilename : KOLString;
    FTitle : KOLString;
    FOptions : TOpenSaveOptions;
    fWnd: THandle;
    fOpenReadOnly: Boolean;
  public
    TemplateName: KOLString; // do not forget to add OpenSaveDialog_Extended
    HookProc: Pointer;    // to project options conditionals!
    NoPlaceBar: Boolean;  // TRUE, if place bar is disabled in the new style
                          // dialogs (if the symbol OpenSaveDialog_Extended is
                          // not added in project options, place bar is always
                          // enabled in Windows 2000 and higher).
    destructor Destroy; virtual;
    {* destructor }
    Function Execute : Boolean;
    {* Call it after creating to perform selecting of file by user. }
    property Filename : KOLString read FFilename write FFileName;
    {*
    Filename is separated by #13 when multiselect is true and the first
    file, is the path of the files selected.
    |<pre>
    |  C:\Projects
    |  Test1.Dpr
    |  Test2.Dpr
    |</pre>
    If only one file is selected, it is provided as (e.g.)
    C:\Projects\Test1.dpr
    |<br> For case when OSAllowMultiselect option used, after each
    call initial value for a Filename containing several files prevents
    system from opening the dialog. To fix this, assign another initial
    value to Filename property in your code, when you use multiselect.
    }
    property InitialDir : KOLString read FInitialDir write FInitialDir;
    {* Initial directory path. If not set, current directory (usually
       directory when program is started) is used. }
    property Filter : KOLString read FFilter write FFilter;
    {* A list of pairs of filter names and filter masks, separated with '|'.
       If a mask contains more than one mask, it should be separated with ';'.
       E.g.:
       ! 'All files|*.*|Text files|*.txt;*.1st;*.diz' }
    property FilterIndex : Integer read FFilterIndex write FFilterIndex;
    {* Index of default filter mask (0 by default, which means "first"). }
    property OpenDialog : Boolean read FOpenDialog write FOpenDialog;
    {* True, if "Open" dialog. False, if "Save" dialog. True is default. }
    property Title : KOLString read Ftitle write Ftitle;
    {* Title for dialog. }
    property Options : TOpenSaveOptions read FOptions write FOptions;
    {* Options. }
    property DefExtension : KOLString read FDefExtension write FDefExtension;
    {* Default extention. Set it to desired extension without leading period,
       e.g. 'txt', but not '.txt'. }
    property WndOwner: THandle read fWnd write fWnd;
    {* Owner window handle. If not assigned, Applet.Handle is used (whenever
       possible). Assign it, if your application has stay-on-top forms, and
       a separate Applet object is used. }
    property OpenReadOnly: Boolean read fOpenReadOnly;
    {* TRUE after Execute, if Read Only check box was checked by the user.
       Options are not affected anyway. }
  end;

const DefOpenSaveDlgOptions: TOpenSaveOptions = [ OSHideReadonly,
  OSOverwritePrompt, OSFileMustExist, OSPathMustExist ];

function NewOpenSaveDialog( const Title, StrtDir: KOLString;
         Options: TOpenSaveOptions ): POpenSaveDialog;
{* Creates object, which can be used (several times) to open file(s)
   selecting dialog. }

type
  POpenDirDialog = ^TOpenDirDialog;

  TOpenDirOption = ( odBrowseForComputer, odBrowseForPrinter, odDontGoBelowDomain,
                   odOnlyFileSystemAncestors, odOnlySystemDirs, odStatusText,
                   odBrowseIncludeFiles, odEditBox, odNewDialogStyle );
  {* Flags available for TOpenDirDialog object. }
                   // odfStatusText - do not support status callback
  TOpenDirOptions = set of TOpenDirOption;
  {* Set of all flags used to control ZOpenDirDialog class. }

  TOnODSelChange = procedure( Sender: POpenDirDialog; NewSelDir: PKOL_Char;
                              var EnableOK: Integer; var StatusText: KOL_String )
                              of object;
  {* Event type to be called when user select another directory in OpenDirDialog.
     Set EnableOK to -1 to disable OK button, or to +1 to enable it.
     It is also possible to set new StatusText string. }

{ ----------------------------------------------------------------------
                               TOpenDirDialog
----------------------------------------------------------------------- }
  TOpenDirDialog = object( TObj )
  {* Dialog for open directories, uses SHBrowseForFolder. }
  protected
    FTitle: KOLString;
    FOptions: TOpenDirOptions;
    FCallBack: Pointer;
    FCenterProc: procedure( Wnd: HWnd );
    FBuf : array[ 0..MAX_PATH ] of KOLChar;
    FInitialPath: KOLString;
    FCenterOnScreen: Boolean;
    FDoSelChanged: procedure( Wnd: HWnd; Msg: DWORD; lParam, lpData: LParam ); stdcall;
    FOnSelChanged: TOnODSelChange;
    FStatusText: KOLString;
    FWnd, FDialogWnd: HWnd;
    function GetPath: KOLString;
    procedure SetInitialPath(const Value: KOLString);
    procedure SetCenterOnScreen(const Value: Boolean);
    procedure SetOnSelChanged(const Value: TOnODSelChange);
    function GetInitialPath: KOLString;
  public
    destructor Destroy; virtual;
    {* destructor }
    function Execute : Boolean;
    {* Call it to select directory by user. Returns True, if operation was
       not cancelled by user. }
    property Title : KOLString read FTitle write FTitle;
    {* Title for a dialog. }
    property Options : TOpenDirOptions read FOptions write FOptions;
    {* Option flags. }
    property Path : KOLString read GetPath;
    {* Resulting (selected by user) path. }
    property InitialPath: KOLString read GetInitialPath write SetInitialPath;
    {* Set this property to a path of directory to be selected initially
       in a dialog. }
    property CenterOnScreen: Boolean read FCenterOnScreen write SetCenterOnScreen;
    {* Set it to True to center dialog on screen. }
    property OnSelChanged: TOnODSelChange read FOnSelChanged write SetOnSelChanged;
    {* This event is called every time, when user selects another directory.
       It is possible to enable/disable OK button in dialog and/or change
       dialog status text in responce to event. }
    property WndOwner: HWnd read FWnd write FWnd;
    {* Owner window. If you want to provide your dialog visible over stay-on-top
       form, fire it as a child of the form, assigning the handle of form window
       to this property first. }
    property DialogWnd: HWnd read FDialogWnd;
    {* Handle to the open directory dialog itself, become available on the
       first call of callback procedure (i.e. on the first call to OnSelChanged).
    }
  end;

function NewOpenDirDialog( const Title: KOLString; Options: TOpenDirOptions ):
         POpenDirDialog;
{* Creates object, which can be used (several times) to open directory
   selecting dialog (using SHBrowseForFolder API call). }

type
  TColorCustomOption = ( ccoFullOpen, ccoShortOpen, ccoPreventFullOpen );

{$IFDEF KOL_MCK}
type  TKOLOpenDirDialog = POpenDirDialog;
{$ENDIF}

  PColorDialog = ^TColorDialog;
{ ----------------------------------------------------------------------
                               TColorDialog
----------------------------------------------------------------------- }
  TColorDialog = object( TObj )
  {* Color choosing dialog. }
  protected
  public
    OwnerWindow: HWnd;
    {* Owner window (can be 0). }
    CustomColors: array[ 1..16 ] of TColor;
    {* Array of stored custom colors. }
    ColorCustomOption: TColorCustomOption;
    {* Options (how to open a dialog). }
    Color: TColor;
    {* Returned color (if the result of Execute is True). }
    function Execute: Boolean;
    {* Call this method to open a dialog and wait its result. }
  end;

function NewColorDialog( FullOpen: TColorCustomOption ): PColorDialog;
{* Creates color choosing dialog object. }
{$ENDIF WIN_GDI}
{$IFDEF WIN_GDI}
type
  TIniFileMode = ( ifmRead, ifmWrite );
  {* ifmRead is default mode (means "read" data from ini-file.
     Set mode to ifmWrite to write data to ini-file, correspondent to
     TIniFile. }

  PIniFile = ^TIniFile;

{ ----------------------------------------------------------------------
                TIniFile - store/load data to ini-files
----------------------------------------------------------------------- }
  TIniFile = object( TObj )
  {* Ini file incapsulation. The main feature is what the same block of
     read-write operations could be defined (difference must be only in
     Mode value).
     |*Ini file sample.
     This sample shows how the same Pascal operators can be used both
     for read and write for the same variables, when working with TIniFile:
     !    procedure ReadWriteIni( Write: Boolean );
     !    var Ini: PIniFile;
     !    begin
     !      Ini := OpenIniFile( 'MyIniFile.ini' );
     !      Ini.Section := 'Main';
     !      if Write then            // if Write, the same operators will save
     !         Ini.Mode := ifmWrite; // data rather then load.
     !      MyForm.Left := Ini.ValueInteger( 'Left', MyForm.Left );
     !      MyForm.Top  := Ini.ValueInteger( 'Top',  MyForm.Top );
     !      Ini.Free;
     !    end;
     !
     |*  }
  protected
    fMode: TIniFileMode;
    fFileName: KOLString;
    fSection: KOLString;
  protected
  public
    destructor Destroy; virtual;
    {* destructor }
    property Mode: TIniFileMode read fMode write fMode;
    {* ifmWrite, if write data to ini-file rather than read it. }
    property FileName: KOLString read fFileName;
    {* Ini file name. }
    property Section: KOLString read fSection write fSection;
    {* Current ini section. }
    function ValueInteger( const Key: KOLString; Value: Integer ): Integer;
    {* Reads or writes integer data value. }
    function ValueString( const Key: KOLString; const Value: KOLString ): KOLString;
    {* Reads or writes string data value. }
    function ValueDouble( const Key: KOLString; const Value: Double ): Double;
    {* Reads or writes Double data value. }
    function ValueBoolean( const Key: KOLString; Value: Boolean ): Boolean;
    {* Reads or writes Boolean data value. }
    function ValueData( const Key: KOLString; Value: Pointer; Count: Integer ): Boolean;
    {* Reads or writes data from/to buffer. Returns True, if success. }
    procedure ClearAll;
    {* Clears all sections of ini-file. }
    procedure ClearSection;
    {* Clears current Section of ini-file. }
    procedure ClearKey( const Key: KOLString );
    {* Clears given key in current section. }

    /////////////// + by Vyacheslav A. Gavrik:
    procedure GetSectionNames(Names:PKOLStrList);
    {* Retrieves section names, storing it in string list passed as a parameter.
       String list does not cleared before processing. Section names are added
       to the end of the string list. }
    procedure SectionData(Names:PKOLStrList);
    {* Read/write current section content to/from string list. (Depending on
       current Mode value). }
    ///////////////

  end;

function OpenIniFile( const FileName: KOLString ): PIniFile;
{* Opens ini file, creating TIniFile object instance to work with it. }
{$ENDIF WIN_GDI}

type
  TMenuitemInfo = packed record
    cbSize: UINT;
    fMask: UINT;
    fType: UINT;             { used if MIIM_TYPE}
    fState: UINT;            { used if MIIM_STATE}
    wID: UINT;               { used if MIIM_ID}
    hSubMenu: HMENU;         { used if MIIM_SUBMENU}
    hbmpChecked: HBITMAP;    { used if MIIM_CHECKMARKS}
    hbmpUnchecked: HBITMAP;  { used if MIIM_CHECKMARKS}
    dwItemData: DWORD;       { used if MIIM_DATA}
    dwTypeData: PKOLChar;    { used if MIIM_TYPE}
    cch: UINT;               { used if MIIM_TYPE}
    hbmpItem: HBITMAP;       { used if MIIM_BITMAP - not exists under Windows95 }
  end;

const
  TPM_HORPOSANIMATION = $0400;
  TPM_HORNEGANIMATION = $0800;
  TPM_VERPOSANIMATION = $1000;
  TPM_VERNEGANIMATION = $2000;
  TPM_NOANIMATION     = $4000;

type
  PMenu = ^TMenu;

  TOnMenuItem = procedure( Sender : PMenu; Item : Integer ) of object;
  {* Event type to define OnMenuItem event. }

  TMenuAccelerator = packed Record
  {* Menu accelerator record. Use MakeAccelerator function to combine desired
     attributes into a record, describing the accelerator. }
    fVirt: Byte; // or-combination of FSHIFT, FCONTROL, FALT, FVIRTKEY, FNOINVERT
    Key: Word;   // character or virtual key code (FVIRTKEY flag is present above)
    NotUsed: Byte; // not used
  end;

  // by Sergey Shisminzev:
  TMenuOption = (moDefault, moDisabled, moChecked,
          moCheckMark, moRadioMark, moSeparator, moBitmap, moSubMenu,
          moBreak, moBarBreak);
  {* Options to add menu items dynamically. }
  TMenuOptions = set of TMenuOption;
  {* Set of options for menu item to use it in TMenu.AddItem method. }

  TMenuBreak = ( mbrNone, mbrBreak, mbrBarBreak );
  {* Possible menu item break types. }

{ ----------------------------------------------------------------------
                TMenu - main, popup menu and menu item
----------------------------------------------------------------------- }
  TMenu = object( TObj )
  protected
  {$IFDEF GDI}
    function GetItemHelpContext(Idx: Integer): Integer;
    procedure SetItemHelpContext(Idx: Integer; const Value: Integer);
  {* Dynamic menu incapsulation object. Can play role of form main menu or popup
     menu, depending on kind of parent window (form or control) and order of
     creation (created first (for a form) become main menu). Does not allow
     merging menus, but items can be hidden. Additionally checkmark bitmaps,
     shortcut key accelerators and other features are available. }
  protected
    FHandle: HMenu;
    FId: Integer;
    FControl: PControl;
    {$ENDIF GDI}
    fNextMenu : PMenu;
    {$IFDEF GDI}
    FMenuBreak: TMenuBreak;
    FOnMenuItem : TOnMenuItem;
    FOnRadioOff : TOnMenuItem;
    fOnPopup: TOnEvent;
    fByAccel: Boolean;
    FIsCheckItem: Boolean;
    FIsSeparator: Boolean;
    FVisible: Boolean;
    FOwnerDraw: Boolean;
    FClearBitmaps: Boolean;
    FNotPopup: Boolean;
    f_DummyFiller: Byte;
    FPopupFlags: DWORD;
    FSavedState: DWORD;
    FData: Pointer;
    {$ENDIF GDI}
    FParentMenu: PMenu;
    FMenuItems: PList;
    FRadioGroup: Integer;
    FCaption: KOLString;
    {$IFDEF _X_}
    {$IFDEF GTK}
    fChecked: Boolean;
    fMnemonics: AnsiString;
    fGtkMenuItem: PGtkWidget;
    fGtkMenuShell: PGtkWidget;
    fGtkMenuBar: PGtkWidget;
    {$ENDIF GTK}
    {$ENDIF _X_}
    {$IFDEF GDI}
    FBitmap: HBitmap;
    FBmpChecked: HBitmap;
    FBmpItem: HBitmap;
    ClearBitmapsProc: procedure( Sender: PMenu );
    FAccelerator: TMenuAccelerator;
    FHelpContext: Integer;
    FOnMeasureItem: TOnMeasureItem;
    FOnDrawItem: TOnDrawItem;
    {$IFDEF USE_MENU_CURCTL}
    fCurCtl: PControl;
    {$ENDIF USE_MENU_CURCTL}
    function GetItems( Id: HMenu ): PMenu;
    function GetCount: Integer;
    function GetTopParent: PMenu;
    function GetState( const Index: Integer ): Boolean;
    procedure SetState( const Index: Integer; Value: Boolean );
    procedure SetMenuVisible( Value: Boolean );
    procedure SetData( Value: Pointer );
    procedure SetMenuItemCaption( const Value: KOLString );
    function FillMenuItems(AHandle: HMenu; StartIdx: Integer;
      const Template: array of PKOLChar): Integer;
    procedure SetMenuBreak( Value: TMenuBreak );
    function GetControl: PControl;
    function GetInfo( var MII: TMenuItemInfo ): Boolean;
    function SetInfo( var MII: TMenuItemInfo ): Boolean;
    function SetTypeInfo( var MII: TMenuItemInfo ): Boolean;
    procedure SetBitmap( Value: HBitmap );
    procedure SetBmpChecked( Value: HBitmap );
    procedure SetBmpItem( Value: HBitmap );
    procedure ClearBitmaps;
    procedure SetAccelerator( const Value: TMenuAccelerator );
    {$IFDEF GDI}
    procedure SetHelpContext( Value: Integer );
    {$ENDIF GDI}
    procedure SetSubmenu( Value: HMenu );
    procedure SetOnMeasureItem( const Value: TOnMeasureItem );
    procedure SetOnDrawItem( const Value: TOnDrawItem );
    procedure SetOwnerDraw( Value: Boolean );
  protected
    function GetItemChecked( Item : Integer ) : Boolean;
    procedure SetItemChecked( Item : Integer; Value : Boolean );
    function GetItemBitmap(Idx: Integer): HBitmap;
    procedure SetItemBitmap(Idx: Integer; const Value: HBitmap);
	function GetItemText(Idx: Integer): KOLString;
	procedure SetItemText(Idx: Integer; const Value: KOLString);
    function GetItemEnabled(Idx: Integer): Boolean;
    procedure SetItemEnabled(Idx: Integer; const Value: Boolean);
    function GetItemVisible(Idx: Integer): Boolean;
    procedure SetItemVisible(Idx: Integer; const Value: Boolean);
    function GetItemAccelerator(Idx: Integer): TMenuAccelerator;
    procedure SetItemAccelerator(Idx: Integer; const Value: TMenuAccelerator);
    function GetItemSubMenu( Idx: Integer ): HMenu;
    {$ENDIF GDI}
  public
    destructor Destroy; virtual;
    {* To release menu dynamically, call Free method instead. All (popup)
       menus created after this (for the same control) are destroyed in
       that case too.
       |<br>
       It is not necessary to release menu object manually: all menus,
       created with given form (or control), are automatically released,
       when owner form (or control) is destroyed.
    }
    {$IFDEF GDI}
    property Handle : HMenu read FHandle;
    {* Handle of Windows menu object. }
    property MenuId: Integer read FId;
    {* Id of the menu item object. If menu item has subitems, it has
       also submenu Handle. Top parent menu object itself has no Id.
       Id-s areassigned automatically starting from 4096. Do not
       (re)create menu items instantly, because such values are not
       reused, and maximum possible Id value must not exceed 65535. }
    property Parent: PMenu read FParentMenu;
    {* Parent menu item (or parent menu). }
    property TopParent: PMenu read GetTopParent;
    {* Top parent menu, owning all nested subitems. }
    property Owner: PControl read GetControl;
    {* Parent control or form. }
    property Caption: KOLString read FCaption write SetMenuItemCaption;
    {* Menu item caption text (including '&' indicating mnemonic characters,
       and keyboard accelerator representation string, usually following
       tabulation character). }
    property Items[ Id: HMenu ]: PMenu read GetItems;
    {* Returns menu item object by its index or by menu id. Since menu id
       values are starting from 4096, values from 0 to 4095 are interpreted
       as absolute index of menu item. Be careful accessing menu items or
       submenus by index, if you dynamically insert or delete items or
       submenus. In this version, separators are enumerating too, like
       all other items. Use index -1 to access object itself. The first
       item of a menu (or the first subitem of submenu item) has index 0.
       Children are enumerating before all siblings. The maximum available
       index is (Count - 1), when accessing menu items by index. }
    property Count: Integer read GetCount;
    {* Count of items together with all its nested subitems. }
    function IndexOf( Item: PMenu ): Integer;
    {* Returns index of an item. This index can be used to access
       menu item. Value -2 is returned, if the Item is not a child for menu
       or menu item, and has no parents, which are children for it, etc.
       Menu object itself always has index -1. }
    property OnMenuItem : TOnMenuItem read FOnMenuItem write FOnMenuItem;
    {* Is called when menu item is clicked. Absolute index of menu item
       clicked is passed as the second parameter. TopParent always is
       passed as a Sender parameter. }
    property ByAccel: Boolean read fByAccel;
    {* True, when OnMenuItem is called not by mouse, but by accelerator key.
       Check this flag for entire menu (TopParent), not for item itself.
       (Note, that Sender in OnMenuItem always is TopParent menu object). )
    }
    property IsSeparator: Boolean read FIsSeparator;
    {* TRUE, if a separator menu item. }
    property MenuBreak: TMenuBreak read FMenuBreak write SetMenuBreak;
    {* Menu item break type. }
    property OnUncheckRadioItem : TOnMenuItem read FOnRadioOff write FOnRadioOff;
    {* Is called when radio item becomes unchecked in menu in result of
       checking another radio item of the same radio group. }
    property RadioGroup: Integer read FRadioGroup write FRadioGroup;
    {* Radio group index. Several neighbour items with the same radio group
       index form radio group. Only single item from the same group can be
       checked at a time. }
    property IsCheckItem: Boolean read FIsCheckItem;
    {* If menu item is defined as check item, it is checked automatically
       when clicked. }
    procedure RadioCheckItem;
    {* Call this method to check radio item. (Calling this method for
       an item, which is not belonging to a radio group, just sets its
       Checked state to TRUE). }
    property Checked: Boolean index MFS_CHECKED read GetState write SetState;
    {* Checked state of the item. }
    property Enabled: Boolean
             {$IFDEF F_P}
             index $80000000 or MFS_DISABLED
             {$ELSE DELPHI}
             index Integer( $80000000 or MFS_DISABLED )
             {$ENDIF F_P/DELPHI}
             read GetState write SetState;
    {* Enabled state of the item. Whaen assigned, Grayed state also is
       set to arbitrary value (i.e., when Enabled is set to true, Grayed
       is set to FALSE. }
    property DefaultItem: Boolean index MFS_DEFAULT read GetState write SetState;
    {* Set this property to TRUE to make menu item default. Default item
       is drawn with bold.
       |<br>If you change DefaultItem at run-time and whant
       to provide changing its visual state, recreate the item first resetting
       Visible property, then setting it again. }
    property Highlight: Boolean index MFS_HILITE read GetState write SetState;
    {* Highlight state of the item. }
    property Visible: Boolean read FVisible write SetMenuVisible;
    {* Visibility of menu item. }
    property Data: Pointer read FData write SetData;
    {* Data pointer, associated with the menu item. }
    property Bitmap: HBitmap read FBitmap write SetBitmap;
    {* Bitmap used for unchecked state of the menu item. }
    property BitmapChecked: HBitmap read FBmpChecked write SetBmpChecked;
    {* Bitmap used for checked state of the menu item. }
    property BitmapItem: HBitmap read FBmpItem write SetBmpItem;
    {* Bitmap used for item itself. In addition, following special values
       are possible:
       HBMMENU_CALLBACK, HBMMENU_MBAR_CLOSE, HBMMENU_MBAR_CLOSE_D,
       HBMMENU_MBAR_MINIMIZE, HBMMENU_MBAR_MINIMIZE_D, HBMMENU_MBAR_RESTORE,
       HBMMENU_POPUP_CLOSE, HBMMENU_POPUP_MAXIMIZE, HBMMENU_POPUP_MINIMIZE,
       HBMMENU_POPUP_RESTORE, HBMMENU_SYSTEM. }
    property Accelerator: TMenuAccelerator read FAccelerator write SetAccelerator;
    {* Accelerator for menu item. }
    {$IFDEF GDI}
    property HelpContext: Integer read FHelpContext write SetHelpContext;
    {* Help context for entire menu (help context can not be assigned to
       individual menu items). }
    {$ENDIF GDI}

    procedure AssignEvents( StartIdx: Integer; const Events: array of TOnMenuItem );
    {* It is possible to assign its own event handler to every menu item
       using this call. This procedure also is called automatically in
       a constructor NewMenuEx. }

    function Popup( X, Y : Integer ): Integer;  {!ecm}
    {* Only for popup menu - to popup it at the given position on screen.
       Return: If you specify TPM_RETURNCMD in the uFlags parameter, the return
       value is the menu-item identifier of the item that the user selected.
       If the user cancels the menu without making a selection, or if an error
       occurs, then the return value is zero.
       If you do not specify TPM_RETURNCMD in the uFlags parameter, the return
       value is nonzero if the function succeeds and zero if it fails. }
    function PopupEx( X, Y: Integer ): Integer; {!ecm}
    {* This version of popup command is very useful, when popup menu is activated
       when its parent window is not visible (e.g., for a kind of applications,
       which always are invisible, and can be activated only using tray icon).
       PopupEx method provides correct tracking of menu disappearing when mouse
       is clicked anywhere else on screen, fixing strange menu behavior in some
       Windows versions (NT).
       |<br>
       Actually, when PopupEx used, parent form is shown but below of visible
       screen, and when menu is disappearing, previous state of the form (visibility
       and position) are restored. If such solvation is not satisfying You,
       You can do something else (e.g., use region clipping, etc.) }
    property OnPopup: TOnEvent read fOnPopup write fOnPopup;
    {* This event occurs before the popup menu is shown. }
    property NotPopup: Boolean read FNotPopup write FNotPopup;
    {* Set this property to true to prevent popup of popup menu, e.g. in
       OnPopup event handler. }
    property Flags: DWORD read FPopupFlags write FPopupFlags;
    {* Pop-up flags, which are used to call TrackPopupMenuEx, when Popup or
       PopupEx method is called. Can be a combination of following values:
       |<br>
       TPM_CENTERALIGN or TPM_LEFTALIGN or TPM_RIGHTALIGN
       |<br>
       TPM_BOTTOMALIGN or TPM_TOPALIGN or TPM_VCENTERALIGN
       |<br>
       TPM_NONOTIFY or TPM_RETURNCMD
       |<br>
       TPM_LEFTBUTTON or TPM_RIGHTBUTTON
       |<br>
       TPM_HORNEGANIMATION or TPM_HORPOSANIMATION or TPM_NOANIMATION or
       TPM_VERNEGANIMATION or TPM_VERPOSANIMATION
       |<br>
       TPM_HORIZONTAL or TPM_VERTICAL.
       |<br>
       By default, a combination TPM_LEFTALIGN or TPM_LEFTBUTTON is used. }
    function Insert(InsertBefore: Integer; ACaption: PKOLChar; Event: TOnMenuItem;
         Options: TMenuOptions): PMenu;
    {* Inserts new menu item before item, given by Id (>=4096) or index
       value InsertBefore. Pointer to an object created is returned. }
    property SubMenu: HMenu read FHandle; // write SetSubMenu;
    {* Submenu associated with the menu item. The same as Handle. It was possible
       in ealier versions to change this value, replacing (removing, assigning)
       entire popup menu as a submenu for menu item.
       But in modern version of TMenu, this is not possible.
       Instead, entire menu object should be added or removed using
       InsertSubmenu or RemoveSubmenu methods. }
    procedure InsertSubMenu( SubMenuToInsert: PMenu; InsertBefore: Integer );
    {* Inserts existing menu item (together with its subitems if any present)
       into given position. See also RemoveSubMenu. }
    function RemoveSubMenu( ItemToRemove: Integer ): PMenu;
    {* Removes menu item from the menu, returning TMenu object, representing it,
       if submenu item, having its own children, detached. If an individual menu
       item is removed, nil is returned.
       This function can be useful to add or remove dynamically entire submenus
       (created together with its subitems). }
    property OnMeasureItem: TOnMeasureItem read FOnMeasureItem write SetOnMeasureItem;
    {* This event is called for owner-drawn menu items. Event handler should return
       menu item height in lower word of a result and item width (for menu) in
       high word of result. If either for height or for width returned value is 0,
       a default one is used. }
    property OnDrawItem: TOnDrawItem read FOnDrawItem write SetOnDrawItem;
    {* This event is called for owner-drawn menu items. }
    property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw;
    {* Set this property to true for some items to make it owner-draw. }

    // For compatibility with old code (be sure that item with given index
    // actually exists):
    function GetMenuItemHandle( Idx : Integer ): DWORD;
    {* Returns Id of menu item with given index. }
    property ItemHandle[ Idx: Integer ]: DWORD read GetMenuItemHandle;
    {* Returns handle for item given by index. }
    property ItemChecked[ Idx : Integer ] : Boolean read GetItemChecked write SetItemChecked;
    {* True, if correspondent menu item is checked. }
    procedure RadioCheck( Idx : Integer );
    {* Call this method to check radio item. For radio items, do not
       use assignment to ItemChecked or Checked properties. }
    property ItemBitmap[ Idx: Integer ]: HBitmap read GetItemBitmap write SetItemBitmap;
    {* This property allows to assign bitmap to menu item (for unchecked state
       only - for checked menu items default checkmark bitmap is used). }
    procedure AssignBitmaps( StartIdx: Integer; Bitmaps: array of HBitmap );
    {* Can be used to assign bitmaps to several menu items during one call. }
	property ItemText[ Idx: Integer ]: KOLString read GetItemText write SetItemText;
    {* This property allows to get / modify menu item text at run time. }
    property ItemEnabled[ Idx: Integer ]: Boolean read GetItemEnabled write SetItemEnabled;
    {* Controls enabling / disabling menu items. Disabled menu items are
       displayed (grayed) but inaccessible to click. }
    property ItemVisible[ Idx: Integer ]: Boolean read GetItemVisible write SetItemVisible;
    {* This property allows to simulate visibility of menu items (implementing
       it by removing or inserting again if needed. For items of submenu, which
       is made invisible, True is returned. If such item made Visible, entire
       submenu with all its parent menu items becomes visible. To release menu
       properly it is necessary to make before all its items visible again.
       This does not matter, if menu is released at the end of execution, but
       can be sensible if owner form is destroyed and re-created at run time
       dynamically. }
    property ItemHelpContext[ Idx: Integer ]: Integer read GetItemHelpContext
      write SetItemHelpContext;
    function ParentItem( Idx: Integer ): Integer;
    {* Returns index of parent menu item (for submenu item). If there are no
       such item (Idx corresponds to root level menu item), -1 is returned. }
    property ItemAccelerator[ Idx: Integer ]: TMenuAccelerator read GetItemAccelerator write SetItemAccelerator;
    {* Allows to get / change accelerator key kodes assigned to menu items.
       Has no effect unless SupportMnemonics called for a form. }
    property ItemSubmenu[ Idx: Integer ]: HMenu read GetItemSubmenu; // write SetItemSubmenu;
    {* Retrieves submenu item dynamically. See also SubMenu property. }

    // by Sergey Shisminzev:
	function AddItem(ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions): Integer;
    {* Adds menu item dynamically. Returns ID of the added item. }
	function InsertItem(InsertBefore: Integer; ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions): Integer;
    {* Inserts menu item before an item with ID, given by InsertBefore parameter. }
	function InsertItemEx(InsertBefore: Integer; ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions;
             ByPosition: Boolean): Integer;
    {* Inserts menu item by command or by position, dependant on ByPosition parameter }
    procedure RedrawFormMenuBar;
    {* }

    {$IFDEF USE_MENU_CURCTL}
    property CurCtl: PControl read fCurCtl write fCurCtl;
    {* By Alexander Pravdin. This property is assigned to a control which were
       initiated a pop-up, for popup menu. }
    {$ENDIF USE_MENU_CURCTL}
  {$ENDIF GDI}
  end;

{$IFDEF WIN_GDI}
function MenuStructSize: Integer;
{* Returns 44 under Windows95, and 48 (=sizeof(TMenuItemInfo) under all other
   Windows versions. }

var FDynamicMenuID: DWORD = $1000;
{$ENDIF WIN_GDI}
function NewMenu( AParent : PControl; MaxCmdReserve: DWORD;
  const Template : array of PKOLChar; aOnMenuItem: TOnMenuItem ): PMenu;
{* Menu constructor. First created menu becomes main menu of form (if AParent
   is a form). All other menus becomes popup (can be activated using Popup
   method). To provide dynamic replacing of main menu, create all popup
   menus as children of any other control, not form itself.
   When Menu is created, pass FirstCmd integer value to set it
   as ID of first menu item (all other ID's obtained by incrementing this value),
   and Template, which is an array of PChar (usually array of string constants),
   containing list of menu item identifiers and/or formatting characters.
|<br>&nbsp;&nbsp;&nbsp;
  FirstCmd value is assigned to first menu item created as its ID,
  all follow menu items are assigned to ID's obtained from FirstCmd incrementing
  it by 1. It is desirable to provide not intersected ranges of ID's for
  defferent menus in the applet.
|<br>&nbsp;&nbsp;&nbsp;
  Following formatting characters can be used in menu template strings:
|&L=<br><b>%1</b>
  <L &amp; (in identifier)> - to underline next character and use it as a shortcut character
           when possible;
  <L + (in front of identifier)> - to make item checked. If also
|<b>!</b> is used before <b>
  &
|</b> than radioitem is defined;
  <L - (in front of identifier)> - item not checked;
  <L - (separate)> - separator (between two items);
  <L ( (separate)> - start of submenu;
  <L ) (separate)> - end of submenu;
|<br>&nbsp;&nbsp;&nbsp;
  To get access to menu items, use constants 0, 1, etc. It is a good idea
  to create special enumerated type to index correspondent menu items
  using Ord( ) operator. Note in that case, that it is necessary only to
  define constants correspondent to identifiers (positions, correspondent
  to separators or submenu brackets are not identified by numbers).
|<br>&nbsp;&nbsp;&nbsp;
}

function NewMenuEx( AParent : PControl; FirstCmd : Integer;
  const Template : array of PKOLChar; aOnMenuItems: array of TOnMenuItem ): PMenu;
{* Creates menu, assigning its own event handler for every (enough) menu item. }
{$IFDEF WIN_GDI}

function MakeAccelerator( fVirt: Byte; Key: Word ): TMenuAccelerator;
{* Creates accelerator item to assign it to TMenu.ItemAccelerator[ ] property
   easy.}

// {YS} added 7 Aug 2004
function GetAcceleratorText( const Accelerator: TMenuAccelerator ): KOLString;
{* Returns text representation of accelerator.
   |<hr>

   <R System functions and working with windows>
}
type
  TWindowChildKind = ( wcActive, wcFocus, wcCapture, wcMenuOwner,
                       wcMoveSize, wcCaret );
  {* Type of window child kind. Used in function GetWindowChild. }

function GetWindowChild( Wnd: HWnd; Kind: TWindowChildKind ): HWnd;
{* Returns child of given top-level window, having given characteristics.
   For example, it is possible to get know for foreground window,
   which of its child window has focus. This function does not work in old
   Windows 95 (returns Wnd in that case). But for Windows 98, Windows NT/2000
   this function works fine. To obtain focused child of the window,
   use GetFocusedWindow, which is independant from Windows version. }

function GetFocusedChild( Wnd: HWnd ): HWnd;
{* Returns focused child of given window (which should be foreground
   and active, certainly). 0 is returned either if Wnd is not active
   or Wnd has no focused child window. }

function Stroke2Window( Wnd: HWnd; const S: AnsiString ): Boolean;
{* Posts characters from string S to those child window of Wnd, which
   has focus now (top-level window Wnd must be foreground, and have
   focused edit-aware control to receive the stroke).
   |<br>
   This function allows only to post typeable characters (including
   such special symbols as #13 (Enter), #9 (Tab), #8 (BackSpace), etc.
   |<br>
   See also function Stroke2WindowEx, which allows to post any key down
   and up events, simulating keyboard for given (automated) application. }

function Stroke2WindowEx( Wnd: HWnd; const S: AnsiString; Wait: Boolean ): Boolean;
{* In addition to function Stroke2Window, this one can send special keys
   to given window, including functional keys and navigation keys. To
   post special key to target window, place a combination of names of
   such key together with keys, which should be passed simultaneously,
   between square or figure brackets. For example, [Ctrl F1], [Alt Shift Home],
   [Ctrl E]. For letters and usual characters, it is not necessary to
   simulate pressing it with determining all Shift combinations and it is
   sufficient to pass characters as is. (E.g., not '[Shift 1]', but '!'). }

function FindWindowByThreadID( ThreadID : DWORD ) : HWnd;
{* Searches for window, belonging to a given thread. }

function DesktopPixelFormat: TPixelFormat;
{* Returns the pixel format correspondent to current desktop color resolution.
   Use this function to decide which format to use for converting bitmap,
   planned to draw transparently using TBitmap.DrawTransparent or
   TBitmap.StretchDrawTransparent methods. }

function GetDesktopRect : TRect;
{* Returns rectangle of screen, free of taskbar and other
   similar app-bars, which reduces size of available desktop
   when created. }
function GetWorkArea: TRect;
{* The same as GetDesktopRect, but obtained calling SystemParametersInfo. }

function ExecuteWait( const AppPath, CmdLine, DfltDirectory: KOLString;
         Show: DWORD; TimeOut: DWORD; ProcID: PDWORD ): Boolean;
{* Allows to execute an application and wait when it is finished. Pass
   INFINITE constant as TimeOut, if You sure that application is finished
   anyway. If another value passed as a TimeOut (in milliseconds), and
   application was not finished for that time, ExecuteWait is returning
   FALSE, and if ProcID is not nil, than ProcID^ contains started process
   handle (it can be used to wait it more, or to terminate it using
   TerminateProcess API function).
   |<br>
   Launching application can be console or GUI - it does not matter.
   Pass SW_SHOW, SW_HIDE or other SW_XXX constant as Show parameter
   as appropriate.
   |<br>
   True is returned only in case when application specified was launched
   successfully and finished for TimeOut specified. Otherwise, check
   ProcID^ variable: if it is 0, process could not be launched (and it
   is possible to get information about error using GetLastError API
   function in a such case). You can freely pass nil in place of ProcID
   parameter, but this is acually correct only when TimeOut is INFINITE. }
function ExecuteIORedirect( const AppPath, CmdLine, DfltDirectory: KOLString;
         Show: DWORD; ProcID: PDWORD; InPipe, OutPipeWr, OutPipeRd: PHandle ): Boolean;
{* Executes an application with its console input and output redirection.
   Terminating of the application is not waiting, but if ProcID pointer
   is defined, it receives process Id launched, so it is possible to
   call WaitForSingleObject for it. InPipe is a pointer to THandle variable
   which receives a handle to input pipe of the console redirected. The same
   is for OutPipeWr and OutPipeRd, but for output of the console redirected.
   Before reading from OutPipeRd^, first close OutPipeWr^. If you run
   simple console application, for which you want to read results after its
   termination, you can use ExecuteConsoleAppIORedirect instead.
   |<br>&nbsp;&nbsp;&nbsp;
   Notes: if your application is not console and it does not create console
   using AllocConsole, this function will fail to redirect input-output. }
function ExecuteConsoleAppIORedirect( const AppPath, CmdLine, DfltDirectory: KOLString;
         Show: DWORD; const InStr: KOLString; var OutStr: KOLString; WaitTimeout: DWORD )
         : Boolean;
{* Executes an application, redirecting its console input and output.
   After redirecting input and output and launching the application,
   content of InStr is written to input stream of the application, then
   the application is waiting for its termination (WaitTimeout milliseconds
   or INFINITE, as passed) and console output of the application is read to
   OutStr. TRUE is returned only in case, when all these tasks are
   completed successfully.
   |<br>&nbsp;&nbsp;&nbsp;
   Notes: if your application is not console and it does not create console
   using AllocConsole, this function will fail to redirect input-output. }

function WindowsShutdown( const Machine : KOLString; Force, Reboot : Boolean ) : Boolean;
{* Shut down of Windows NT. Pass Machine = '' to shutdown this PC.
   Pass Reboot = True to reboot immediatelly after shut down. }
function WindowsLogoff( Force : Boolean ) : Boolean;
{* Logoff of Windows. }


type
  TWindowsVersion = ( wv31, wv95, wv98, wvME, wvNT, wvY2K, wvXP, wvServer2003,
                  wvVista, wvSeven );
  {* Windows versions constants. }
  TWindowsVersions = Set of TWindowsVersion;
  {* Set of Windows version (e.g. to define a range of versions supported by the
     application). }

function WinVer : TWindowsVersion;
{* Returns Windows version. }
function IsWinVer( Ver : TWindowsVersions ) : Boolean;
{* Returns True if Windows version is in given range of values. }
{$IFNDEF PARAMS_DEFAULT}
function SkipParam(P: PKOLChar): PKOLChar; //forward;
function ParamStr( Idx: Integer ): KOLString;
{* Returns command-line parameter by index. This function supersides
   standard ParamStr function. }
function ParamCount: Integer;
{* Returns number of parameters in command line.
|<hr>
}
{$ENDIF}
{$ENDIF WIN_GDI}

{$IFDEF INPACKAGE}
  {$IFDEF ASM_VERSION}
    {$UNDEF ASM_VERSION}
  {$ENDIF}
{$ENDIF}

{$IFDEF WIN_GDI}
//{$DEFINE CHK_BITBLT}
{$IFDEF CHK_BITBLT}
procedure Chk_BitBlt;
{$ENDIF}
{$IFDEF ASM_VERSION}
  {$DEFINE ASM_DC}
{$ENDIF}
{$IFDEF ASM_DC}
procedure StartDC;
procedure FinishDC;
{$ENDIF ASM_VERSION}

function WndProcCtrl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
function WndProcDoEraseBkgnd( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;

var CreatingWindow: PControl;
    //ActiveWindow: HWnd;
{$ENDIF WIN_GDI}
{$IFDEF _D2}
// Assert operator was not available in Delphi2. Provide here easy Assert
// procedure for Delphi2.
procedure Assert( Cond: Boolean; const Msg: AnsiString );

var AssertErrorProc: procedure( const Message, Filename: AnsiString; LineNumber: Integer );
{$ENDIF}

{$IFDEF USE_CUSTOMEXTENSIONS}
  {$I CUSTOM_KOL_EXTENSION.inc} // See comments in TControl
{$ENDIF}

{$IFDEF DEBUG_ENDSESSION}
var EndSession_Initiated: Boolean;
{$ENDIF}

{$IFDEF WIN_GDI}
var
  FMMNotify: procedure( var Msg: TMsg );

procedure ClearText( Sender: PControl );
procedure ClearListbox( Sender: PControl );
procedure ClearCombobox( Sender: PControl );
procedure ClearListView( Sender: PControl );
procedure ClearTreeView( TV: PControl );

{$IFDEF COMMANDACTIONS_OBJ}
const   OTHER_ACTIONS      = 0;
        LABEL_ACTIONS      = 1;
        BUTTON_ACTIONS     = 2;
        EDIT_ACTIONS       = 3;
        LIST_ACTIONS       = 4;
        COMBO_ACTIONS      = 5;
        LISTVIEW_ACTIONS   = 6;
        TREEVIEW_ACTIONS   = 7;
        TABCONTROL_ACTIONS = 8;
        RICHEDIT_ACTIONS   = 9;
        PROGRESS_ACTIONS   = 10;
        TOOLBAR_ACTIONS    = 11;
        LAST_ACTIONS       = 11;
var  AllActions_Objs: array[ 0..LAST_ACTIONS ] of PCommandActionsObj;
{$ENDIF}

const
  {$IFDEF PACK_COMMANDACTIONS}
  ButtonActions_Packed: PAnsiChar = Char(BUTTON_ACTIONS) +
  #0#0 + //BN_CLICKED
  #6#0 + //BN_SETFOCUS
  #7#0 + //BN_KILLFOCUS
  #225 + //25 íóëåé
  #0#1 + //BS_LEFT
  #0#2 + //BS_RIGHT
  #0#3 + //BS_CENTER
  #0#4 + //0, BS_TOP>>8
  #12#8+ // BS_VCENTER>>8, BS_BOTTOM>>8
  #204 //4 íóëÿ
  ;
  {$ELSE}
  ButtonActions: TCommandActions = (
    aClear: ClearText;
    aAddText: nil;
    aClick: BN_CLICKED;
    aEnter: BN_SETFOCUS;
    aLeave: BN_KILLFOCUS;
    aChange: 0;
    aSelChange: 0;
    aGetCount: 0;
    aSetCount: 0;
    aGetItemLength: 0;
    aGetItemText: 0;
    aSetItemText: 0;
    aGetItemData: 0;
    aSetItemData: 0;
    aAddItem: 0;
    aDeleteItem: 0;
    aInsertItem: 0;
    aFindItem: 0;
    aFindPartial: 0;
    bItem2Pos: 0;
    bPos2Item: 0;
    aGetSelCount: 0;
    aGetSelected: 0;
    aGetSelRange: 0;
    aGetCurrent: 0;
    aSetSelected: 0;
    aSetCurrent: 0;
    aSetSelRange: 0;
    aExSetSelRange: 0;
    aGetSelection: 0;
    aReplaceSel: 0;
    aTextAlignLeft: BS_LEFT;
    aTextAlignRight: BS_RIGHT;
    aTextAlignCenter: BS_CENTER;
    bTextAlignMask: 0;
    bVertAlignTop: BS_TOP shr 8;  //=4
    bVertAlignCenter: BS_VCENTER shr 8; //=12
    bVertAlignBottom: BS_BOTTOM shr 8; //=8
    aDir: 0;
    aSetLimit: 0;
    aSetImgList: 0;
    //-----aAutoSzX: 14;
    //-----aAutoSzY: 6;
    aSetBkColor: 0;
  );
  {$ENDIF}

const
  {$IFDEF PACK_COMMANDACTIONS}
    LabelActions_Packed: PAnsiChar = Char( LABEL_ACTIONS ) +
  #229 + //29 íóëåé
  #2#0 + // SS_RIGHT
  #1#0 + // SS_CENTER
  #12#0 + // SS_LEFTNOWORDWRAP, 0
  #2#0 + // SS_CENTERIMAGE>>8, 0
  #205;
  {$ELSE}
  LabelActions: TCommandActions = (
    aClear: ClearText;
    aAddText: nil;
    aClick: 0;
    aEnter: 0;
    aLeave: 0;
    aChange: 0;
    aSelChange: 0;
    aGetCount: 0;
    aSetCount: 0;
    aGetItemLength: 0;
    aGetItemText: 0;
    aSetItemText: 0;
    aGetItemData: 0;
    aSetItemData: 0;
    aAddItem: 0;
    aDeleteItem: 0;
    aInsertItem: 0;
    aFindItem: 0;
    aFindPartial: 0;
    bItem2Pos: 0;
    bPos2Item: 0;
    aGetSelCount: 0;
    aGetSelected: 0;
    aGetSelRange: 0;
    aGetCurrent: 0;
    aSetSelected: 0;
    aSetCurrent: 0;
    aSetSelRange: 0;
    aExSetSelRange: 0;
    aGetSelection: 0;
    aReplaceSel: 0;
    aTextAlignLeft: SS_LEFT;
    aTextAlignRight: SS_RIGHT;
    aTextAlignCenter: SS_CENTER;
    bTextAlignMask: SS_LEFTNOWORDWRAP;
    bVertAlignTop: 0;
    bVertAlignCenter: SS_CENTERIMAGE shr 8;
    bVertAlignBottom: 0;
    aDir: 0;
    aSetLimit: 0;
    aSetImgList: 0;
   //---- aAutoSzX: 1;
   //---- aAutoSzY: 1;
    aSetBkColor: 0;
  );
  {$ENDIF}

const
  EN_LINK                             = $070b;
  {$IFDEF PACK_COMMANDACTIONS}
  EditActions_Packed: PAnsiChar = Char( EDIT_ACTIONS ) +
  #201 +
  #0#1 + // EN_SETFOCUS
  #0#2 + // EN_KILLFOCUS
  #0#3 + // EN_CHANGE
  #201 +
  #$BA#0 + // EM_GETLINECOUNT
  #201 +
  #$C1#0 + // EM_LINELENGTH
  #$C4#0 + // EM_GETLINE
  #$C2#0 + // EM_REPLACESEL
  #207 +
  #$BB#$C9 + // EM_LINEINDEX, EM_LINEFROMCHAR
  #$B0#0 +   // EM_GETSEL
  #201 +
  #$B0#0 +   // EM_GETSEL
  #$BB#0 +   // EM_LINEINDEX
  #202 +
  #$B1#0 +   // EM_SETSEL
  #202 +
  #$C2#0 +   // EM_REPLACESEL
  #201 +     // ES_LEFT
  #2#0 +     // ES_RIGHT
  #1#0 +     // ES_CENTER
  #203 +
  #$C5#0 +   // EM_SETLIMITTEXT
  #202 +
  #200#214#0; // EM_POSFROMCHAR
  {$ELSE}
  EditActions: TCommandActions = (
    aClear: ClearText;
    aAddText: nil;
    aClick: 0;
    aEnter: EN_SETFOCUS;
    aLeave: EN_KILLFOCUS;
    aChange: EN_CHANGE;
    aSelChange: 0;
    aGetCount: EM_GETLINECOUNT;
    aSetCount: 0;
    aGetItemLength: EM_LINELENGTH;
    aGetItemText: EM_GETLINE;
    aSetItemText: EM_REPLACESEL;
    aGetItemData: 0;
    aSetItemData: 0;
    aAddItem: 0;
    aDeleteItem: 0;
    aInsertItem: 0;
    aFindItem: 0;
    aFindPartial: 0;
    bItem2Pos: EM_LINEINDEX;
    bPos2Item: EM_LINEFROMCHAR;
    aGetSelCount: EM_GETSEL;
    aGetSelected: 0;
    aGetSelRange: EM_GETSEL;
    aGetCurrent: EM_LINEINDEX;
    aSetSelected: 0;
    aSetCurrent: 0;
    aSetSelRange: EM_SETSEL;
    aExSetSelRange: 0;
    aGetSelection: 0;
    aReplaceSel: EM_REPLACESEL;
    aTextAlignLeft: ES_LEFT;
    aTextAlignRight: ES_RIGHT;
    aTextAlignCenter: ES_CENTER;
    bTextAlignMask: 0;
    bVertAlignTop: 0;
    bVertAlignCenter: 0;
    bVertAlignBottom: 0;
    aDir: 0;
    aSetLimit: EM_SETLIMITTEXT;
    aSetImgList: 0;
    //---- aAutoSzX: 0;
    //---- aAutoSzY: 6;
    aSetBkColor: 0;
    aItem2XY: EM_POSFROMCHAR;
  );
  {$ENDIF}

const
  {$IFDEF PACK_COMMANDACTIONS}
  ListActions_Packed: PAnsiChar = Char(LIST_ACTIONS) +
  #2#0 + // LBN_DBLCLK
  #4#0 + // LBN_SETFOCUS
  #5#0 + // LBN_KILLFOCUS
  #201 +
  #1#0 + // LBN_SELCHANGE
  #$8B#1 + // LB_GETCOUNT
  #$A7#1 + // LB_SETCOUNT
  #$8A#1 + // LB_GETTEXTLEN
  #$89#1 + // LB_GETTEXT
  #201 +
  #$99#1 + // LB_GETITEMDATA
  #$9A#1 + // LB_SETITEMDATA
  #$80#1 + // LB_ADDSTRING
  #$82#1 + // LB_DELETESTRING
  #$81#1 + // LB_INSERTSTRING
  #$A2#1 + // LB_FINDSTRINGEXACT
  #$8F#1 + // LB_FINDSTRING
  #201 +
  #$90#1 + // LB_GETSELCOUNT
  #$87#1 + // LB_GETSEL
  #201 +
  #$88#1 + // LB_GETCURSEL
  #$85#1 + // LB_SETSEL
  #$86#1 + // LB_SETCURSEL
  #209 +
  #$8D#1 + // LB_DIR
  #203 +
  #$98#1;  // LB_GETITEMRECT
  {$ELSE}
  ListActions: TCommandActions = (
    aClear: ClearListbox;
    aAddText: nil;
    aClick: LBN_DBLCLK;
    aEnter: LBN_SETFOCUS;
    aLeave: LBN_KILLFOCUS;
    aChange: 0;
    aSelChange: LBN_SELCHANGE;
    aGetCount: LB_GETCOUNT;
    aSetCount: LB_SETCOUNT;
    aGetItemLength: LB_GETTEXTLEN;
    aGetItemText: LB_GETTEXT;
    aSetItemText: 0;
    aGetItemData: LB_GETITEMDATA;
    aSetItemData: LB_SETITEMDATA;
    aAddItem: LB_ADDSTRING;
    aDeleteItem: LB_DELETESTRING;
    aInsertItem: LB_INSERTSTRING;
    aFindItem: LB_FINDSTRINGEXACT;
    aFindPartial: LB_FINDSTRING;
    bItem2Pos: 0;
    bPos2Item: 0;
    aGetSelCount: LB_GETSELCOUNT;
    aGetSelected: LB_GETSEL;
    aGetSelRange: 0;
    aGetCurrent: LB_GETCURSEL;
    aSetSelected: LB_SETSEL;
    aSetCurrent: LB_SETCURSEL;
    aSetSelRange: 0;
    aExSetSelRange: 0;
    aGetSelection: 0;
    aReplaceSel: 0;
    aTextAlignLeft: 0;
    aTextAlignRight: 0;
    aTextAlignCenter: 0;
    bTextAlignMask: 0;
    bVertAlignTop: 0;
    bVertAlignCenter: 0;
    bVertAlignBottom: 0;
    aDir: LB_DIR;
    aSetLimit: 0;
    aSetImgList: 0;
    //---- aAutoSzX: 0;
    //---- aAutoSzY: 0;
    aSetBkColor: 0;
    aItem2XY: LB_GETITEMRECT;
  );
  {$ENDIF}

const
  {$IFDEF PACK_COMMANDACTIONS}
  ComboActions_Packed: PAnsiChar = Char(COMBO_ACTIONS) +
  #2#0 + // CBN_DBLCLK
  #3#0 + // CBN_SETFOCUS
  #4#0 + // CBN_KILLFOCUS
  #5#0 + // CBN_EDITCHANGE
  #15#0 + // CM_CBN_SELCHANGE
  #$46#1 + // CB_GETCOUNT
  #201 +
  #$49#1 + // CB_GETLBTEXTLEN
  #$48#1 + // CB_GETLBTEXT
  #201 +
  #$50#1 + // CB_GETITEMDATA
  #$51#1 + // CB_SETITEMDATA
  #$43#1 + // CB_ADDSTRING
  #$44#1 + // CB_DELETESTRING
  #$4A#1 + // CB_INSERTSTRING
  #$58#1 + // CB_FINDSTRINGEXACT
  #$4C#1 + // CB_FINDSTRING
  #202 +
  #$47#1 + // CB_GETCURSEL
  #201 +
  #$47#1 + // CB_GETCURSEL
  #201 +
  #$4E#1 + // CB_SETCURSEL
  #209 +
  #$45#1 + // CB_DIR
  #203;
  {$ELSE}
  ComboActions: TCommandActions = (
    aClear: ClearCombobox;
    aAddText: nil;
    aClick: CBN_DBLCLK;
    aEnter: CBN_SETFOCUS;
    aLeave: CBN_KILLFOCUS;
    aChange: CBN_EDITCHANGE;
    aSelChange: CM_CBN_SELCHANGE;
    aGetCount: CB_GETCOUNT;
    aSetCount: 0;
    aGetItemLength: CB_GETLBTEXTLEN;
    aGetItemText: CB_GETLBTEXT;
    aSetItemText: 0;
    aGetItemData: CB_GETITEMDATA;
    aSetItemData: CB_SETITEMDATA;
    aAddItem: CB_ADDSTRING;
    aDeleteItem: CB_DELETESTRING;
    aInsertItem: CB_INSERTSTRING;
    aFindItem: CB_FINDSTRINGEXACT;
    aFindPartial: CB_FINDSTRING;
    bItem2Pos: 0;
    bPos2Item: 0;
    aGetSelCount: 0;
    aGetSelected: CB_GETCURSEL;
    aGetSelRange: 0;
    aGetCurrent: CB_GETCURSEL;
    aSetSelected: 0;
    aSetCurrent: CB_SETCURSEL;
    aSetSelRange: 0;
    aExSetSelRange: 0;
    aGetSelection: 0;
    aReplaceSel: 0;
    aTextAlignLeft: 0; //ES_LEFT;
    aTextAlignRight: 0; //ES_RIGHT;
    aTextAlignCenter: 0; //ES_CENTER;
    bTextAlignMask: 0;
    bVertAlignTop: 0;
    bVertAlignCenter: 0;
    bVertAlignBottom: 0;
    aDir: CB_DIR;
    aSetLimit: 0;
    aSetImgList: 0;
    //---- aAutoSzX: 0;
    //---- aAutoSzY: 6;
    aSetBkColor: 0;
  );
  {$ENDIF}

const
  {$IFDEF PACK_COMMANDACTIONS}
  ListViewActions_Packed: PAnsiChar = Char( LISTVIEW_ACTIONS ) +
  #203 +
  #$9B#$FF + // LVN_ITEMCHANGED
  #201 +
  #4#$10 +   // LVM_GETITEMCOUNT
  #47#$10 +  // LVM_SETITEMCOUNT
  //#211 +
  #206 + #8#$10 // LVM_DELETEITEM
  + #204 +
  #50#$10 +  // LVM_GETSELECTEDCOUNT
  #44#$10 +  // LVM_GETITEMSTATE
  #201 +
  #12#$10 +  // LVM_GENEXTITEM
  #213 +
  #3#$10 +   // LVM_SETIMAGELIST
  #1#$10 +   // LVM_SETBKCOLOR
  #14#$10;   // LVM_GETITEMRECT
  {$ELSE}
  ListViewActions: TCommandActions = (
    aClear: ClearListView;
    aAddText: nil;
    aClick: 0;
    aEnter: 0;
    aLeave: 0;
    aChange: LVN_ITEMCHANGED;
    aSelChange: 0;
    aGetCount: LVM_GETITEMCOUNT;
    aSetCount: LVM_SETITEMCOUNT;
    aGetItemLength: 0;
    aGetItemText: 0;
    aSetItemText: 0;
    aGetItemData: 0;
    aSetItemData: 0;
    aAddItem: 0;
    aDeleteItem: LVM_DELETEITEM;
    aInsertItem: 0;
    aFindItem: 0;
    aFindPartial: 0;
      bItem2Pos: 0;
      bPos2Item: 0;
    aGetSelCount: { $8000 or} LVM_GETSELECTEDCOUNT;
    aGetSelected: LVM_GETITEMSTATE;
    aGetSelRange: 0;
    aGetCurrent: LVM_GETNEXTITEM;
    aSetSelected: 0;
    aSetCurrent: 0;
    aSetSelRange: 0;
    aExSetSelRange: 0;
    aGetSelection: 0;
    aReplaceSel: 0;
    aTextAlignLeft: 0;
    aTextAlignRight: 0;
    aTextAlignCenter: 0;
    bTextAlignMask: 0;
    bVertAlignTop: 0;
    bVertAlignCenter: 0;
    bVertAlignBottom: 0;
    aDir: 0;
    aSetLimit: 0;
    aSetImgList: LVM_SETIMAGELIST;
    //---- aAutoSzX: 0;
    //---- aAutoSzY: 0;
    aSetBkColor: LVM_SETBKCOLOR;
    aItem2XY: LVM_GETITEMRECT;
  );
  {$ENDIF}

const
  {$IFDEF PACK_COMMANDACTIONS}
  TreeViewActions_Packed: PAnsiChar = Char( TREEVIEW_ACTIONS ) +
  #203 +
  {$IFDEF UNICODE_CTRLS} #$34#$FE {$ELSE} #$65#$FE {$ENDIF} + // TVN_ENDLABELEDIT(W)
  {$IFDEF UNICODE_CTRLS} #$3E#$FE {$ELSE} #$6E#$FE {$ENDIF} + // TVN_SELCHANGED(W)
  #5#$11 + // TVM_GETCOUNT
  #207 +
  #1#$11 + // TVM_DELETEITEM
  #221 +
  #9#$11 + // TVM_SETIMAGELIST
  #29#$11 + // TVM_SETBKCOLOR
  #4#$11;   // TVM_GETITEMRECT
  {$ELSE}
  TreeViewActions: TCommandActions = (
    aClear: ClearTreeView;
    aAddText: nil;
    aClick: 0;
    aEnter: 0;
    aLeave: 0;
    aChange: TVN_ENDLABELEDIT;
    aSelChange: TVN_SELCHANGED;
    aGetCount: TVM_GETCOUNT;
    aSetCount: 0;
    aGetItemLength: 0;
    aGetItemText: 0;
    aSetItemText: 0;
    aGetItemData: 0;
    aSetItemData: 0;
    aAddItem: 0;
    aDeleteItem: TVM_DELETEITEM;
    aInsertItem: 0;
    aFindItem: 0;
    aFindPartial: 0;
    bItem2Pos: 0;
    bPos2Item: 0;
    aGetSelCount: 0;
    aGetSelected: 0;
    aGetSelRange: 0;
    aGetCurrent: 0;
    aSetSelected: 0;
    aSetCurrent: 0;
    aSetSelRange: 0;
    aExSetSelRange: 0;
    aGetSelection: 0;
    aReplaceSel: 0;
    aTextAlignLeft: 0;
    aTextAlignRight: 0;
    aTextAlignCenter: 0;
    bTextAlignMask: 0;
    bVertAlignTop: 0;
    bVertAlignCenter: 0;
    bVertAlignBottom: 0;
    aDir: 0; //CB_DIR;
    aSetLimit: 0;
    aSetImgList: TVM_SETIMAGELIST;
    //---- aAutoSzX: 0;
    //---- aAutoSzY: 0;
    aSetBkColor: TVM_SETBKCOLOR;
    aItem2XY: TVM_GETITEMRECT;
  );
  {$ENDIF}

const
  {$IFDEF PACK_COMMANDACTIONS}
  TabControlActions_Packed: PAnsiChar = Char( TABCONTROL_ACTIONS ) +
  #203 +
  #200#$D9#$FD + // TCN_SELCHANGE
  #200#$D9#$FD + // TCN_SELCHANGE
  #4#$13 +       // TCM_GETITEMCOUNT
  #215 +
  #11#$13 +      // TCM_GETCURSEL
  #201 +
  #12#$13 +      // TCM_SETCURSEL
  #211 +
  #3#$13 +       // TCM_SETIMAGELIST
  #201 +
  #10#$13;       // TCM_GETITEMRECT
  {$ELSE}
  TabControlActions: TCommandActions = (
    aClear: ClearText;
    aAddText: nil;
    aClick: 0;
    aEnter: 0;
    aLeave: 0;
    aChange: TCN_SELCHANGE;
    aSelChange: TCN_SELCHANGE;
    aGetCount: TCM_GETITEMCOUNT;
    aSetCount: 0;
    aGetItemLength: 0;
    aGetItemText: 0;
    aSetItemText: 0;
    aGetItemData: 0;
    aSetItemData: 0;
    aAddItem: 0;
    aDeleteItem: 0;
    aInsertItem: 0;
    aFindItem: 0;
    aFindPartial: 0;
    bItem2Pos: 0;
    bPos2Item: 0;
    aGetSelCount: 0;
    aGetSelected: 0;
    aGetSelRange: 0;
    aGetCurrent: TCM_GETCURSEL;
    aSetSelected: 0;
    aSetCurrent: TCM_SETCURSEL; //TCM_SETCURFOCUS;
    aSetSelRange: 0;
    aExSetSelRange: 0;
    aGetSelection: 0;
    aReplaceSel: 0;
    aTextAlignLeft: 0;
    aTextAlignRight: 0;
    aTextAlignCenter: 0;
    bTextAlignMask: 0;
    bVertAlignTop: 0;
    bVertAlignCenter: 0;
    bVertAlignBottom: 0;
    aDir: 0; // CB_DIR;
    aSetLimit: 0;
    aSetImgList: TCM_SETIMAGELIST;
    //---- aAutoSzX: 0;
    //---- aAutoSzY: 0;
    aSetBkColor: 0;
    aItem2XY: TCM_GETITEMRECT;
  );
  {$ENDIF}

{$IFNDEF NOT_USE_RICHEDIT}
const
  {$IFDEF PACK_COMMANDACTIONS}
  RichEditActions_Packed: PAnsiChar = Char( RICHEDIT_ACTIONS ) +
  #201 +
  #0#1 + // EN_SETFOCUS
  #0#2 + // EN_KILLFOCUS
  #0#3 + // EN_CHANGE
  #2#7 + // EN_SELCHANGE
  #$BA#0 + // EM_GETLINECOUNT
  #201 +
  #$C1#0 + // EM_LINELENGTH
  #$C4#0 + // EM_GETLINE
  #$C2#0 + // EM_REPLACESEL
  #207 +
  #$BB#$C9 + // EM_LINEINDEX, EM_LINEFROMCHAR
  #$B0#0 +   // EM_GETSEL
  #201 +
  #$B0#0 +   // EM_GETSEL
  #$BB#0 +   // EM_LINEINDEX
  #203 +
  #55#4 +    // EM_EXSETSEL
  #62#4 +    // EM_GETSELTEXT
  #$C2#0 +   // EM_REPLACESEL
  #201 +     // ES_LEFT
  #2#0 +     // ES_RIGHT
  #1#0 +     // ES_CENTER
  #203 +
  #53#4 +    // EM_EXLIMITTEXT
  #201 +
  #67#4 +    // EM_SETBKGNDCOLOR
  #200#214#0; // EM_POSFROMCHAR
  {$ELSE}
  RichEditActions: TCommandActions = (
    aClear: ClearText;
    aAddText: nil;
    aClick: 0;
    aEnter: EN_SETFOCUS;
    aLeave: EN_KILLFOCUS;
    aChange: EN_CHANGE;
    aSelChange: EN_SELCHANGE;
    aGetCount: EM_GETLINECOUNT;
    aSetCount: 0;
    aGetItemLength: EM_LINELENGTH;
    aGetItemText: EM_GETLINE;
    aSetItemText: EM_REPLACESEL;
    aGetItemData: 0;
    aSetItemData: 0;
    aAddItem: 0;
    aDeleteItem: 0;
    aInsertItem: 0;
    aFindItem: 0;
    aFindPartial: 0;
    bItem2Pos: EM_LINEINDEX;
    bPos2Item: EM_LINEFROMCHAR;
    aGetSelCount: EM_GETSEL;
    aGetSelected: 0;
    aGetSelRange: EM_GETSEL;
    aGetCurrent: EM_LINEINDEX;
    aSetSelected: 0;
    aSetCurrent: 0;
    aSetSelRange: 0;
    aExSetSelRange: EM_EXSETSEL;
    aGetSelection: EM_GETSELTEXT;
    aReplaceSel: EM_REPLACESEL;
    aTextAlignLeft: ES_LEFT;
    aTextAlignRight: ES_RIGHT;
    aTextAlignCenter: ES_CENTER;
    bTextAlignMask: 0;
    bVertAlignTop: 0;
    bVertAlignCenter: 0;
    bVertAlignBottom: 0;
    aDir: 0;
    aSetLimit: EM_EXLIMITTEXT;
    aSetImgList: 0;
    //---- aAutoSzX: 0;
    //---- aAutoSzY: 0;
    aSetBkColor: EM_SETBKGNDCOLOR;
    aItem2XY: EM_POSFROMCHAR;
  );
  {$ENDIF}

{$ENDIF NOT_USE_RICHEDIT}

const
  BaseFileMethods: TStreamMethods = (
    fSeek: SeekFileStream;
    fGetSiz: GetSizeFileStream;
    fSetSiz: DummySetSize;
    fRead: DummyReadWrite;
    fWrite: DummyReadWrite;
    fClose: CloseFileStream;
    fCustom: nil;
  );

  MemoryMethods: TStreamMethods = (
    fSeek: SeekMemStream;
    fGetSiz: GetSizeMemStream;
    fSetSiz: SetSizeMemStream;
    fRead: ReadMemStream;
    fWrite: WriteMemStream;
    fClose: CloseMemStream;
    fCustom: nil;
  );

  ConcatStreamMethods: TStreamMethods = (
    fSeek: SeekConcatStream;
    fGetSiz: GetSizeConcatStream;
    fSetSiz: SetSizeConcatStream;
    fRead: ReadConcatStream;
    fWrite: WriteConcatStream;
    fClose: CloseConcatStream;
    fCustom: nil;
  );

  SubStreamMethods: TStreamMethods = (
    fSeek: SeekSubStream;
    fGetSiz: GetSizeSubStream;
    fSetSiz: SetSizeSubStream;
    fRead: ReadSubStream;
    fWrite: WriteSubStream;
    fClose: CloseSubStream;
    fCustom: nil;
  );
{$ENDIF WIN_GDI}

{$IFDEF DEBUG_MCK}
procedure dummy_Log( const s: AnsiString );
var mck_Log: procedure( const s: AnsiString ) = dummy_Log;
{$ENDIF}

type
  TThemedElement = (
    teButton,
    teClock,
    teComboBox,
    teEdit,
    teExplorerBar,
    teHeader,
    teListView,
    teMenu,
    tePage,
    teProgress,
    teRebar,
    teScrollBar,
    teSpin,
    teStartPanel,
    teStatus,
    teTab,
    teTaskBand,
    teTaskBar,
    teToolBar,
    teToolTip,
    teTrackBar,
    teTrayNotify,
    teTreeview,
    teWindow
  );

var DrawThemeBackground: function(hTheme: DWORD; hdc: HDC; iPartId, iStateId: Integer;
    const pRect: TRect; pClipRect: PRECT): HRESULT; stdcall;
    OpenThemeData: function(hwnd: HWND; pszClassList: LPCWSTR): DWORD; stdcall;
    ThemeLibrary: THandle;
    IsThemeBackgroundPartiallyTransparent: function(hTheme: DWORD;
      iPartId, iStateId: Integer): BOOL; stdcall;
    DrawThemeParentBackground: function(hwnd: HWND; hdc: HDC; prc: PRECT): HRESULT; stdcall;
    CloseThemeData: function(hTheme: DWORD): HRESULT; stdcall;
    DrawThemeText: function(hTheme: DWORD; hdc: HDC; iPartId, iStateId: Integer;
      pszText: LPCWSTR; iCharCount: Integer; dwTextFlags, dwTextFlags2: DWORD;
      var pRect: TRect): HRESULT; stdcall;
    IsThemeActive: function: BOOL; stdcall;
    IsAppThemed: function: BOOL; stdcall;
    GetThemeColor: function(hTheme: DWORD; iPartId, iStateId, iPropId: Integer;
      var pColor: COLORREF): HRESULT; stdcall;

const
  themelib = 'uxtheme.dll';

type
  PThemedElementDetails = ^TThemedElementDetails;
  TThemedElementDetails = record
    Element: TThemedElement;
    Part,
    State: Integer;
  end;
  TThemedEdit = (
    teEditDontCare,
    teEditRoot,
    teEditTextNormal, teEditTextHot, teEditTextSelected, teEditTextDisabled, teEditTextFocused, teEditTextReadOnly, teEditTextAssist,
    teEditCaret
  );

type TOverrideScrollbarsProc = procedure(Sender: PControl);
procedure DummyOverrideScrollbars(Sender: PControl);
var OverrideScrollbars: TOverrideScrollbarsProc = DummyOverrideScrollbars;

{$IFNDEF PAS_ONLY}
function CrackStack_MapInResource( const MapName: KOLString; Max_length: Integer;
    HandleSuspiciousAddresses: Boolean ): KOLString;
{* Allows to list all procedures and functions called before current cracking
   stack frames. This version loads map-file from the resource.
   Important note: you must provide latest map file created at the last
   application build in the resource! See also CrackStack_MapInFile below. }
function CrackStack_MapInFile( const MapFileName: KOLString; Max_length: Integer;
    HandleSuspiciousAddresses: Boolean ): KOLString;
{* Allows to list all procedures and functions called before current cracking
   stack frames. This version loads map-file from the file.
   Important note: you must have the latest map file created at the last
   application build on a path specified! For example, use path GetStartDir +
   appname_wo_extention + '.map' and do not forget to set flag Map file -
   Detailed in Project Options | Linker. Use flag HandleSuspiciousAddresses
   to show all suspicious addresses found in stack (this may help to find
   errors not shown even by Delphi debugger since stack frames in some cases give
   no enough data). }
{$ENDIF}
//......... these declarations are here to stop hints from Delphi5 while compiling MCK:
function CallTControlCreateWindow( Ctl: PControl ): Boolean;
function DumpWindowed( c: PControl ): PControl;
{$IFNDEF PAS_ONLY}
function WndProcAppAsm( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
{$ENDIF}
//22{$IFDEF ASM_VERSION}
const ButtonClass: array[ 0..6 ] of KOLChar = ( 'B','U','T','T','O','N',#0 );
//22{$ENDIF ASM_VERSION}
{$IFDEF _D3orHigher}
function WndProcUnicodeChars( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
{$ENDIF}
procedure SetMouseEvent( Self_: PControl );
function CompareIntegers( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
function CompareDwords( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
procedure SwapIntegers( const Sender : Pointer; const e1, e2 : DWORD );
function _GetDIBPixelsTrueColorAlpha( Bmp: PBitmap; X, Y: Integer ): TColor;
procedure _SetDIBPixelsTrueColorAlpha( Bmp: PBitmap; X, Y: Integer; Value: TColor );
//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

{$IFDEF DEBUG_MONITOR_MESSAGES}
var OnMonitorMessage: procedure( var M: TMsg; Enter_WndFunc: Boolean ) of object = nil;
{$ENDIF}


{$IFDEF _D2006orHigher}
	{$I MCKfakeClasses200x.inc} // Dufa
{$ENDIF}
implementation

  {$UNDEF CALL_INHERITED}
{$IFDEF _D2orD3}
  {$DEFINE CALL_INHERITED}
{$ENDIF}
{$IFnDEF NIL_EVENTS}
  {$DEFINE CALL_INHERITED}
{$ENDIF}

{ -- don't remove this comment!!!
  uses
  //ShellAPI,
  //commdlg  // removing reference to commdlg decreases executable about 0.5 K
  ; //, commctrl;
            // in Delphi3, including of commctrl.pas increases executable
            // onto about 30K. So, all needed definitions are copied here
            // (see commctrl.inc).}

{$IFDEF _X_}
  {$undef uses_2}
  {$IFNDEF NOT_USE_KOLMATH}
    {$define uses_2}
  {$ENDIF NOT_USE_KOLMATH}
  {$IFDEF uses_2}
    uses {$IFNDEF NOT_USE_KOLMATH} KOLmath
           {$IFNDEF NOT_USE_EXCEPTION} , err
             {$IFDEF REDECLARATION_INSERTED_AUTOMATICALLY}
               , gdk2, pango, gtk2
             {$ENDIF REDECLARATION_INSERTED_AUTOMATICALLY}
           {$ENDIF  NOT_USE_EXCEPTION}
         {$ENDIF NOT_USE_KOLMATH};
  {$ENDIF uses_2}
{$ELSE}
  {$IFDEF USE_GRUSH}
    uses ToGRush;
  {$ELSE}
    {$IFDEF INPACKAGE}
      uses mirror, SysUtils;
    {$ENDIF INPACKAGE}
  {$ENDIF USE_GRUSH}
{$ENDIF _X_}

{$IFDEF WIN}
  {$IFNDEF FPC}
    {$IFDEF UNICODE_CTRLS}
      {$DEFINE implementation_part} {$I KOL_unicode.inc} {$UNDEF implementation_part}
    {$ELSE} // ANSI_CTRLS
      {$DEFINE implementation_part} {$I KOL_ansi.inc} {$UNDEF implementation_part}
    {$ENDIF UNICODE_CTRLS}
  {$ENDIF}
{$ENDIF WIN}

{$IFDEF DEBUG_MCK}
procedure dummy_Log( const s: AnsiString );
begin
  //
end;
{$ENDIF}
{$IFDEF WIN}
type
  PSHFileInfoA = ^TSHFileInfoA;
  PSHFileInfoW = ^TSHFileInfoW;
  PSHFileInfo = PSHFileInfoA;
  _SHFILEINFOA = record
    hIcon: HICON;                      { out: icon }
    iIcon: Integer;                    { out: icon index }
    dwAttributes: DWORD;               { out: SFGAO_ flags }
    szDisplayName: array [0..MAX_PATH-1] of  AnsiChar; { out: display name (or path) }
    szTypeName: array [0..79] of AnsiChar;             { out: type name }
  end;
  _SHFILEINFOW = record
    hIcon: HICON;                      { out: icon }
    iIcon: Integer;                    { out: icon index }
    dwAttributes: DWORD;               { out: SFGAO_ flags }
    szDisplayName: array [0..MAX_PATH-1] of WideChar; { out: display name (or path) }
    szTypeName: array [0..79] of WideChar;             { out: type name }
  end;
  _SHFILEINFO = {$IFDEF UNICODE_CTRLS} _SHFILEINFOW {$ELSE} _SHFILEINFOA {$ENDIF};
  TSHFileInfoA = _SHFILEINFOA;
  TSHFileInfoW = _SHFILEINFOW;
  TSHFileInfo = {$IFDEF UNICODE_CTRLS} TSHFileInfoW {$ELSE} TSHFileInfoA {$ENDIF};
  SHFILEINFOA = _SHFILEINFOA;
  SHFILEINFOW = _SHFILEINFOW;
  SHFILEINFO = {$IFDEF UNICODE_CTRLS} SHFILEINFOW {$ELSE} SHFILEINFOA {$ENDIF};

const
  SHGFI_ICON              = $000000100;     { get icon }
  SHGFI_DISPLAYNAME       = $000000200;     { get display name }
  SHGFI_TYPENAME          = $000000400;     { get type name }
  SHGFI_ATTRIBUTES        = $000000800;     { get attributes }
  SHGFI_ICONLOCATION      = $000001000;     { get icon location }
  SHGFI_EXETYPE           = $000002000;     { return exe type }
  SHGFI_SYSICONINDEX      = $000004000;     { get system icon index }
  SHGFI_LINKOVERLAY       = $000008000;     { put a link overlay on icon }
  SHGFI_SELECTED          = $000010000;     { show icon in selected state }
  SHGFI_LARGEICON         = $000000000;     { get large icon }
  SHGFI_SMALLICON         = $000000001;     { get small icon }
  SHGFI_OPENICON          = $000000002;     { get open icon }
  SHGFI_SHELLICONSIZE     = $000000004;     { get shell size icon }
  SHGFI_PIDL              = $000000008;     { pszPath is a pidl }
  SHGFI_USEFILEATTRIBUTES = $000000010;     { use passed dwFileAttribute }

function SHGetFileInfoA(pszPath: PAnsiChar; dwFileAttributes: DWORD;
  var psfi: TSHFileInfo; cbFileInfo, uFlags: UINT): DWORD; stdcall;
  external 'shell32.dll' name 'SHGetFileInfoA';
{$IFDEF UNICODE_CTRLS}
function SHGetFileInfoW(pszPath: PWideChar; dwFileAttributes: DWORD;
  var psfi: TSHFileInfo; cbFileInfo, uFlags: UINT): DWORD; stdcall;
  external 'shell32.dll' name 'SHGetFileInfoW';
{$ENDIF UNICODE_CTRLS}

type
  FILEOP_FLAGS = Word;
  PRINTEROP_FLAGS = Word;

  PSHFileOpStructA = ^TSHFileOpStructA;
  PSHFileOpStructW = ^TSHFileOpStructW;
  PSHFileOpStruct = PSHFileOpStructA;
  _SHFILEOPSTRUCTA = packed record
    Wnd: HWND;
    wFunc: UINT;
    pFrom: PAnsiChar;
    pTo: PAnsiChar;
    fFlags: FILEOP_FLAGS;
    fAnyOperationsAborted: BOOL;
    hNameMappings: Pointer;
    lpszProgressTitle: PAnsiChar; { only used if FOF_SIMPLEPROGRESS }
  end;
  _SHFILEOPSTRUCTW = packed record
    Wnd: HWND;
    wFunc: UINT;
    pFrom: PWideChar;
    pTo: PWideChar;
    fFlags: FILEOP_FLAGS;
    fAnyOperationsAborted: BOOL;
    hNameMappings: Pointer;
    lpszProgressTitle: PWideChar; { only used if FOF_SIMPLEPROGRESS }
  end;
  _SHFILEOPSTRUCT = _SHFILEOPSTRUCTA;
  TSHFileOpStructA = _SHFILEOPSTRUCTA;
  TSHFileOpStructW = _SHFILEOPSTRUCTW;
  TSHFileOpStruct = TSHFileOpStructA;
  SHFILEOPSTRUCTA = _SHFILEOPSTRUCTA;
  SHFILEOPSTRUCTW = _SHFILEOPSTRUCTW;
  SHFILEOPSTRUCT = SHFILEOPSTRUCTA;

const
  FO_MOVE           = $0001;
  FO_COPY           = $0002;
  FO_DELETE         = $0003;
  FO_RENAME         = $0004;

  FOF_MULTIDESTFILES         = $0001;
  FOF_CONFIRMMOUSE           = $0002;
  FOF_SILENT                 = $0004;  { don't create progress/report }
  FOF_RENAMEONCOLLISION      = $0008;
  FOF_NOCONFIRMATION         = $0010;  { Don't prompt the user. }
  FOF_WANTMAPPINGHANDLE      = $0020;  { Fill in SHFILEOPSTRUCT.hNameMappings
                                         Must be freed using SHFreeNameMappings }
  FOF_ALLOWUNDO              = $0040;
  FOF_FILESONLY              = $0080;  { on *.*, do only files }
  FOF_SIMPLEPROGRESS         = $0100;  { means don't show names of files }
  FOF_NOCONFIRMMKDIR         = $0200;  { don't confirm making any needed dirs }
  FOF_NOERRORUI              = $0400;  { don't put up error UI }


{$IFDEF UNICODE_CTRLS}
function SHFileOperationW(const lpFileOp: TSHFileOpStructW): Integer; stdcall;
         external 'shell32.dll' name 'SHFileOperationW';
{$ENDIF}

function SHFileOperationA(const lpFileOp: TSHFileOpStructA): Integer; stdcall;
         external 'shell32.dll' name 'SHFileOperationA';

type
  PNotifyIconDataA = ^TNotifyIconDataA;
  PNotifyIconDataW = ^TNotifyIconDataW;
  PNotifyIconData = PNotifyIconDataA;
  _NOTIFYICONDATAA = record
    cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
    szTip: array [0..63] of AnsiChar;
  end;
  _NOTIFYICONDATAW = record
    cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
    szTip: array [0..63] of WideChar;
  end;
  _NOTIFYICONDATA = _NOTIFYICONDATAA;
  TNotifyIconDataA = _NOTIFYICONDATAA;
  TNotifyIconDataW = _NOTIFYICONDATAW;
  TNotifyIconData = TNotifyIconDataA;
  NOTIFYICONDATAA = _NOTIFYICONDATAA;
  NOTIFYICONDATAW = _NOTIFYICONDATAW;
  NOTIFYICONDATA = NOTIFYICONDATAA;

const
  NIM_ADD         = $00000000;
  NIM_MODIFY      = $00000001;
  NIM_DELETE      = $00000002;

  NIF_MESSAGE     = $00000001;
  NIF_ICON        = $00000002;
  NIF_TIP         = $00000004;

{$IFDEF UNICODE_CTRLS}
function Shell_NotifyIcon(dwMessage: DWORD; lpData: PNotifyIconDataW): BOOL; stdcall;
         external 'shell32.dll' name 'Shell_NotifyIconW';
{$ELSE}
function Shell_NotifyIcon(dwMessage: DWORD; lpData: PNotifyIconData): BOOL; stdcall;
         external 'shell32.dll' name 'Shell_NotifyIconA';
{$ENDIF UNICODE_CTRLS}

{$IFDEF UNICODE_CTRLS}
function ExtractIcon(hInst: HINST; lpszExeFileName: PKOLChar;
  nIconIndex: UINT): HICON; stdcall;
  external 'shell32.dll' name 'ExtractIconW';
{$ELSE}
function ExtractIcon(hInst: HINST; lpszExeFileName: PKOLChar;
  nIconIndex: UINT): HICON; stdcall;
  external 'shell32.dll' name 'ExtractIconA';
{$ENDIF UNICODE_CTRLS}
{$ENDIF WIN}
{$IFDEF WIN_GDI}

type
  HDROP = Longint;

function DragQueryPoint(Drop: HDROP; var Point: TPoint): BOOL; stdcall;
         external 'shell32.dll' name 'DragQueryPoint';
{$IFDEF UNICODE_CTRLS}
function DragQueryFile(Drop: HDROP; FileIndex: UINT; FileName: PWideChar; cb: UINT): UINT; stdcall;
         external 'shell32.dll' name 'DragQueryFileW';
{$ELSE}
function DragQueryFile(Drop: HDROP; FileIndex: UINT; FileName: PAnsiChar; cb: UINT): UINT; stdcall;
         external 'shell32.dll' name 'DragQueryFileA';
{$ENDIF UNICODE_CTRLS}
procedure DragFinish(Drop: HDROP); stdcall;
          external 'shell32.dll' name 'DragFinish';
procedure DragAcceptFiles(Wnd: HWND; Accept: BOOL); stdcall;
          external 'shell32.dll' name 'DragAcceptFiles';

const
  OFN_READONLY = $00000001;
  OFN_OVERWRITEPROMPT = $00000002;
  OFN_HIDEREADONLY = $00000004;
  OFN_NOCHANGEDIR = $00000008;
  OFN_SHOWHELP = $00000010;
  OFN_ENABLEHOOK = $00000020;
  OFN_ENABLETEMPLATE = $00000040;
  OFN_ENABLETEMPLATEHANDLE = $00000080;
  OFN_NOVALIDATE = $00000100;
  OFN_ALLOWMULTISELECT = $00000200;
  OFN_EXTENSIONDIFFERENT = $00000400;
  OFN_PATHMUSTEXIST = $00000800;
  OFN_FILEMUSTEXIST = $00001000;
  OFN_CREATEPROMPT = $00002000;
  OFN_SHAREAWARE = $00004000;
  OFN_NOREADONLYRETURN = $00008000;
  OFN_NOTESTFILECREATE = $00010000;
  OFN_NONETWORKBUTTON = $00020000;
  OFN_NOLONGNAMES = $00040000;
  OFN_EXPLORER = $00080000;
  OFN_NODEREFERENCELINKS = $00100000;
  OFN_LONGNAMES = $00200000;
  OFN_ENABLEINCLUDENOTIFY = $00400000;
  OFN_ENABLESIZING = $00800000;
  OFN_DONTADDTORECENT = $02000000;
  OFN_FORCESHOWHIDDEN = $10000000;    // Show All files including System and hidden files
  OFN_EX_NOPLACESBAR = $00000001;
  OFN_SHAREFALLTHROUGH = 2;
  OFN_SHARENOWARN = 1;
  OFN_SHAREWARN = 0;
type
  POpenFilename = ^TOpenFilename;
  tagOFN = packed record
    lStructSize: DWORD;
    hWndOwner: HWND;
    hInstance: HINST;
    lpstrFilter: PKOLChar;
    lpstrCustomFilter: PKOLChar;
    nMaxCustFilter: DWORD;
    nFilterIndex: DWORD;
    lpstrFile: PKOLChar;
    nMaxFile: DWORD;
    lpstrFileTitle: PKOLChar;
    nMaxFileTitle: DWORD;
    lpstrInitialDir: PKOLChar;
    lpstrTitle: PKOLChar;
    Flags: DWORD;
    nFileOffset: Word;
    nFileExtension: Word;
    lpstrDefExt: PKOLChar;
    lCustData: LPARAM;
    lpfnHook: function(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall;
    lpTemplateName: PKOLChar;
    {$IFDEF OpenSaveDialog_Extended}
    //---------- added from Windows2000:
    pvReserved: Pointer;
    dwReserved: DWORD;
    FlagsEx: DWORD;
    {$ENDIF}
  end;
  TOpenFilename = tagOFN;
  OPENFILENAME = tagOFN;
{$IFDEF UNICODE_CTRLS}
function GetOpenFileName(var OpenFile: TOpenFilename): Bool; stdcall;
         external 'comdlg32.dll'  name 'GetOpenFileNameW';
function GetSaveFileName(var OpenFile: TOpenFilename): Bool; stdcall;
         external 'comdlg32.dll'  name 'GetSaveFileNameW';
{$ELSE}
function GetOpenFileName(var OpenFile: TOpenFilename): Bool; stdcall;
         external 'comdlg32.dll'  name 'GetOpenFileNameA';
function GetSaveFileName(var OpenFile: TOpenFilename): Bool; stdcall;
         external 'comdlg32.dll'  name 'GetSaveFileNameA';
{$ENDIF UNICODE_CTRLS}

type
  PChooseColorA = ^TChooseColorA;
  PChooseColorW = ^TChooseColorW;
  PChooseColor = PChooseColorA;
  tagCHOOSECOLORA = packed record
    lStructSize: DWORD;
    hWndOwner: HWND;
    hInstance: HWND;
    rgbResult: COLORREF;
    lpCustColors: ^COLORREF;
    Flags: DWORD;
    lCustData: LPARAM;
    lpfnHook: function(Wnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall;
    lpTemplateName: PAnsiChar;
  end;
  tagCHOOSECOLORW = packed record
    lStructSize: DWORD;
    hWndOwner: HWND;
    hInstance: HWND;
    rgbResult: COLORREF;
    lpCustColors: ^COLORREF;
    Flags: DWORD;
    lCustData: LPARAM;
    lpfnHook: function(Wnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall;
    lpTemplateName: PWideChar;
  end;
  tagCHOOSECOLOR = tagCHOOSECOLORA;
  TChooseColorA = tagCHOOSECOLORA;
  TChooseColorW = tagCHOOSECOLORW;
  TChooseColor = TChooseColorA;

const
  CC_RGBINIT = $00000001;
  CC_FULLOPEN = $00000002;
  CC_PREVENTFULLOPEN = $00000004;
  CC_SHOWHELP = $00000008;
  CC_ENABLEHOOK = $00000010;
  CC_ENABLETEMPLATE = $00000020;
  CC_ENABLETEMPLATEHANDLE = $00000040;
  CC_SOLIDCOLOR = $00000080;
  CC_ANYCOLOR = $00000100;

function ChooseColor(var CC: TChooseColor): Bool; stdcall;
         external 'comdlg32.dll'  name 'ChooseColorA';

{$IFDEF GDI}
{$IFDEF CHK_BITBLT}
procedure Chk_BitBlt_ShowError;
var Rslt: Integer;
begin
    Rslt := GetLastError;
    ShowMessage( 'BitBlt ERROR: ' + Int2Str( Rslt )
                 + ' ' + SysErrorMessage( Rslt ) );
end;

procedure Chk_BitBlt;
var Rslt: Integer;
begin
  asm
    MOV Rslt, EAX
  end;
  if Rslt = 0 then
  begin
    Chk_BitBlt_ShowError;
    asm
      int 3;
    end;
  end;
end;
{$ENDIF CHK_BITBLT}
{$ENDIF GDI}

{$ifdef _D2}
procedure Assert( Cond: Boolean; const Msg: AnsiString );
begin
  if not Cond then
  begin
    AssertErrorProc( Msg, '', 0 );
    asm
      int 3;
    end;
  end;
end;

function CreateDIBSection(DC: HDC; const p2: TBitmapInfo; p3: UINT;
  var p4: Pointer; p5: THandle; p6: DWORD): HBITMAP; stdcall;
external gdi32 name 'CreateDIBSection';

procedure _LStrFromPCharLen(var Dest: AnsiString; Source: PAnsiChar; Length: Integer);
asm
        { ->    EAX     pointer to dest }
        {       EDX source              }
        {       ECX length              }

        PUSH    EBX
        PUSH    ESI
        PUSH    EDI

        MOV     EBX,EAX
        MOV     ESI,EDX
        MOV     EDI,ECX

        { allocate new string }

        MOV     EAX,EDI

        CALL    System.@NewAnsiString
        MOV     ECX,EDI
        MOV     EDI,EAX

        TEST    ESI,ESI
        JE      @@noMove

        MOV     EDX,EAX
        MOV     EAX,ESI
        CALL    Move

        { assign the result to dest }

@@noMove:
        MOV     EAX,EBX
        CALL    System.@LStrClr
        MOV     [EBX],EDI

        POP     EDI
        POP     ESI
        POP     EBX
end;
{$endif}

{$IFDEF _D2009orHigher}
{$IFNDEF PAS_ONLY}
procedure _aLStrFromPCharLen(var Dest: AnsiString; Source: PAnsiChar; Length: Integer);
asm
  push 0
  CALL System.@LStrFromPCharLen
end;

procedure _aLStrFromPChar(var Dest: AnsiString; Source: PAnsiChar);
asm
  push ecx
  xor ecx, ecx
  CALL System.@LStrFromPChar
  pop ecx
end;
{$ENDIF}
{$ENDIF}

procedure InitCommonControls; external cctrl name 'InitCommonControls';

type
  TInitCommonControlsEx = packed record
    dwSize: DWORD;
    dwICC: DWORD;
  end;
  PInitCommonControlsEx = ^TInitCommonControlsEx;

var ComCtl32_Module: HModule;
{$IFDEF ASM_UNICODE}
{$ELSE PASCAL}
procedure DoInitCommonControls( dwICC: DWORD );
var Proc: procedure( ICC: PInitCommonControlsEx ); stdcall;
    ICC: TInitCommonControlsEx;
begin
  InitCommonControls;
  if ComCtl32_Module = 0 then
    ComCtl32_Module := LoadLibrary( 'comctl32' );
  @ Proc := GetProcAddress( ComCtl32_Module, 'InitCommonControlsEx' );
  {$IFDEF SAFE_CODE} // DoInitCommonControls should work usually. If not, the System is
  if Assigned( Proc ) then // not in normal state, and should be repaired anyway.
  {$ENDIF}
  begin
    ICC.dwSize := Sizeof( ICC );
    ICC.dwICC := dwICC;
    Proc( @ ICC );
  end;
end;
{$ENDIF}

const size_TRect = 16; // used often in assembler versions of code

{$IFDEF ASM_VERSION}
const
  EmptyString: AnsiString = '';

procedure EAX2PChar;
asm
        TEST     EAX, EAX
        JNZ      @@exit
        MOV      EAX, offset[EmptyString]
        //LEA      EAX, [EmptyString]
        //MOV      EAX, [EmptyString]
@@exit:
end;

procedure EDX2PChar;
asm
        TEST     EDX, EDX
        JNZ      @@exit
        MOV      EDX, offset[EmptyString]
@@exit:
end;

procedure ECX2PChar;
asm
        JECXZ   @@convert
        RET
@@convert:
        MOV     ECX, offset[EmptyString]
@@exit:
end;

procedure RemoveStr;
asm     { <- [ESP+4] = string to remove
          -> ESP := ESP + 4
             EAX = 0 }
        POP      EAX
        XCHG     EAX, [ESP]
        PUSH     EAX
        MOV      EAX, ESP
        CALL     System.@LStrClr
        POP      EAX
end;

{$IFDEF _D3orHigher}
procedure RemoveWStr;
asm     { <- [ESP+4] = string to remove
          -> ESP := ESP + 4
             EAX = 0 }
        POP      EAX
        XCHG     EAX, [ESP]
        PUSH     EAX
        MOV      EAX, ESP
        CALL     System.@WStrClr
        POP      EAX
end;
{$ENDIF _D3orHigher}
{$ENDIF ASM_VERSION}

const PossibleColorBits : array[1..7] of Byte = ( 1, 4, 8, 16, 24, 32, 0 );

function FindFilter( const Filter: KOLString): KOLString; forward;
function WriteExMemoryStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; forward;
procedure CreateComboboxWnd( Combo: PControl ); forward;
procedure ComboboxDropDown( Sender: PObj ); forward;
function WndProcParentResize(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function WndProcResize(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function WndProcJustOneNotify( Control: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; forward;
function WndProcJustOne( Control: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; forward;
function WndProcTreeView( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function CompareAnsiStrListItems( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; forward;
function CompareAnsiStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; forward;
function CompareStrListItems_NoCase( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; forward;
function CompareStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; forward;
procedure ApplyImageLists2Control( Sender: PControl ); forward;
procedure ApplyImageLists2ListView( Sender: PControl ); forward;
function OpenDirCallBack( Wnd: HWnd; Msg: DWORD; lParam, lpData: LParam ): Integer;
         stdcall; forward;
function OpenDirSelChangeCallBack( Wnd: HWnd; Msg: DWORD; lParam, lpData: LParam ):
         Integer; stdcall; forward;
function WndProcShowModal( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function TimerProc( Wnd : HWnd; Msg : Integer; T : PTimer; CurrentTime : DWord ): Integer;
          stdcall; forward;
function PrepareBitmapHeader( W, H, BitsPerPixel: Integer ): PBitmapInfo; forward;
procedure PreparePF16bit( DIBHeader: PBitmapInfo ); forward;
procedure _RotateBitmapMono( var DstBmp: PBitmap; SrcBmp: PBitmap ); forward;
procedure _RotateBitmap4bit( var DstBmp: PBitmap; SrcBmp: PBitmap ); forward;
procedure _RotateBitmap8bit( var DstBmp: PBitmap; SrcBmp: PBitmap ); forward;
procedure _RotateBitmap16bit( var DstBmp: PBitmap; SrcBmp: PBitmap ); forward;
procedure _RotateBitmap2432bit( var DstBmp: PBitmap; SrcBmp: PBitmap ); forward;
procedure _RotateBitmapRight( SrcBmp: PBitmap ); forward;
procedure _SetDIBPixels1bit( Bmp: PBitmap; X, Y: Integer; Value: TColor ); forward;
procedure _SetDIBPixelsPalIdx( Bmp: PBitmap; X, Y: Integer; Value: TColor ); forward;
procedure _SetDIBPixels16bit( Bmp: PBitmap; X, Y: Integer; Value: TColor ); forward;
procedure _SetDIBPixelsTrueColor( Bmp: PBitmap; X, Y: Integer; Value: TColor ); forward;
procedure FillBmpWithBkColor( Bmp: PBitmap; DC2: HDC; oldWidth, oldHeight: Integer ); forward;
procedure DetachBitmapFromCanvas( Sender: PBitmap ); forward;
function ColorBits( ColorsCount : Integer ) : Integer; forward;
procedure AlignChildrenProc(Sender: PObj); forward;
function WndProcUpdate( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function CollectTabControls( Form: PControl ): PList; forward;
{$IFNDEF NOT_USE_RICHEDIT}
function WndProc_RE_LinkNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
{$ENDIF NOT_USE_RICHEDIT}
function WndProc_DrawItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer )
                          : Boolean; forward;
function WndProcTabControl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
  forward;
function WndProcSplitter( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
  forward;
function Tabulate2ControlEx( Self_: PControl; Key: DWORD; checkOnly: Boolean ): Boolean;
  forward;
procedure Tabulate2Next( Form: PControl; Dir: Integer ); forward;
function Tabulate2Control( Self_: PControl; Key: DWORD; checkOnly: Boolean ): Boolean;
  forward;
function GetPrevCtrlBoundsRect( P: PControl; var R: TRect ): Boolean; forward;

////////////---------------------------------------------------/////////////////
function WndProcDateTimePickerNotify( Self_: PControl; var Msg: TMsg;
         var Rslt: Integer ): Boolean; forward;

////////////////////////////////////////////////////////////////////////////////
{$IFNDEF PAS_ONLY}
var MapFile: PKOLStrList;
    LineNumbersFrom: Integer;
    MaxCrackStackLen: Integer;
    HandleSuspicious: Boolean;
    BelowBasePtr: PDWORD;
    CrackedStack: KOLString;

function DoCrackSingleFrame( RetAddr: DWORD; BasePtr: DWORD ): Boolean;
var i, j, R: Integer;
    A, Prev_A, N, Prev_N: DWORD;
    s, CurUnit: KOLString;
    Add_string: KOLString;
    Line_found: Boolean;
begin
    Result := FALSE;
    if Length( CrackedStack ) > MaxCrackStackLen then Exit; {>>>>>>>>>>>>>>>>>>}
    Result := TRUE;
    if RetAddr >= $70000000 then
    begin
        CrackedStack := CrackedStack + #13#10'$' + Int2Hex( RetAddr, 8 );
        Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
    Result := FALSE;
    if RetAddr < $400000 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

    if HandleSuspicious then
        if (BelowBasePtr <> nil) and (BasePtr <> 0)
           and (DWORD( BelowBasePtr ) < BasePtr) then
        begin
            BelowBasePtr := Pointer( DWORD( BelowBasePtr ) + 4 );
            while DWORD( BelowBasePtr ) < BasePtr do
            begin
                A := BelowBasePtr^;
                if (A > $400000) and (A < $700000) then
                    DoCrackSingleFrame( A, 0 );
                BelowBasePtr := Pointer( DWORD( BelowBasePtr ) + 4 );
            end;
        end;
    if BasePtr <> 0 then
        BelowBasePtr := Pointer( BasePtr );

    Add_string := '';

    // 1st: find
    Prev_A := 0;
    for i := 0 to MapFile.Count-1 do
    begin
        s := MapFile.Items[ i ];
        if s = '' then
            Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        R := 0;
        j := 1;
        while (j <= Length( s )) and (s[j] <= ' ') do inc( j );
        while (j <= Length( s )) and
              ( (s[j] >= '0') and (s[j] <= '9') or
                (s[j] >= 'A') and (s[j] <= 'F') ) do
        begin
            if   s[j] <= '9' then R := R * 16 + Ord( s[j] ) - Ord( '0' )
            else R := R * 16 + Ord( s[j] ) - Ord( 'A' ) + 10;
            inc( j );
        end;
        if (j > Length( s )) or (s[ j ] <> ':') then Exit; {>>>>>>>>>>>>>>>>>>>}
        inc( j );
        A := 0;
        while (j <= Length( s )) and
              ( (s[j] >= '0') and (s[j] <= '9') or
                (s[j] >= 'A') and (s[j] <= 'F') ) do
        begin
            if   s[j] <= '9' then A := A * 16 + Ord( s[j] ) - Ord( '0' )
            else A := A * 16 + Ord( s[j] ) - Ord( 'A' ) + 10;
            inc( j );
        end;
        A := A + $401000;
        if (Prev_A <= RetAddr) and (A > RetAddr) and (Prev_A > 0) and (R = 1) then
        begin
            s := MapFile.Items[ i-1 ];
            j := pos( AnsiString(':'), s );
            if j <= 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
            s := Copy( s, j+1, MaxInt );
            for j := 1 to Length( s ) do
                if s[ j ] <= ' ' then
                begin
                    s := Trim( Copy( s, j, MaxInt ) );
                    Add_string := #13#10;
                    if BasePtr = 0 then
                        Add_string := Add_string + '? ' + Int2Hex( RetAddr, 8 ) + ':';
                    Add_string := Add_string + s;
                    Result := TRUE;
                    break;
                end;
        end;
        Prev_A := A;
        if Result then break;
    end;
    if not Result then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

    // 2nd: find line no
    Line_found := FALSE;
    CurUnit := '';
    Prev_N := 0;
    Prev_A := 0;
    for i := LineNumbersFrom to MapFile.Count-1 do
    begin
        s := MapFile.Items[ i ];
        if Copy( s, 1, 4 ) = 'Line' then
        begin
            j := pos( AnsiString('('), s );
            if j > 0 then
            begin
                s := Copy( s, j+1, MaxInt );
                j := pos( AnsiString(')'), s );
                if j > 0 then
                    s := Copy( s, 1, j-1 );
            end;
            CurUnit := s;
            Prev_N := 0;
        end else
        if s <> '' then
        begin
            j := 1;
            while j < Length( s ) do
            begin
                while (j <= Length( s )) and (s[j] <= ' ') do inc( j );
                N := 0;
                while (j <= Length( s )) and
                      (s[j] >= '0') and (s[j] <= '9') do
                begin
                    N := N * 10 + Ord( s[j] ) - Ord( '0' );
                    inc( j );
                end;
                while (j <= Length( s )) and (s[j] <= ' ') do inc( j );
                R := 0;
                while (j < Length( s )) and
                      ( (s[j] >= '0') and (s[j] <= '9') or
                        (s[j] >= 'A') and (s[j] <= 'F') ) do
                begin
                    if s[j] <= '9' then
                        R := R * 16 + Ord( s[j] ) - Ord( '0' )
                    else R := R * 16 + Ord( s[j] ) - Ord( 'A' ) + 10;
                    inc( j );
                end;
                while (j <= Length( s )) and (s[j] <= ' ') do inc( j );
                if (j <= Length(s)) and (s[ j ] = ':') then inc( j );
                while (j <= Length( s )) and (s[j] <= ' ') do inc( j );
                A := 0;
                while (j <= Length( s )) and
                      ( (s[j] >= '0') and (s[j] <= '9') or
                        (s[j] >= 'A') and (s[j] <= 'F') ) do
                begin
                    if s[j] <= '9' then
                        A := A * 16 + Ord( s[j] ) - Ord( '0' )
                    else A := A * 16 + Ord( s[j] ) - Ord( 'A' ) + 10;
                    inc( j );
                end;
                A := A + $401000;
                if (Prev_A <= RetAddr) and (A > RetAddr) then
                begin
                    if (Prev_A > 0) and (Prev_N > 0) then
                    begin
                        Add_string := Add_string + ' in ' + CurUnit + ', line: ' +
                            Int2Str( Prev_N );
                        Line_found := TRUE;
                    end;
                    s := '';
                    break;
                end;
                Prev_N := N;
                Prev_A := A;
                if Line_found then break;
            end;
        end;
        if Line_found then break;
    end;
    if not Line_found and (BasePtr = 0) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    CrackedStack := CrackedStack + Add_string;
    if Length( CrackedStack ) > MaxCrackStackLen then
    begin
        CrackedStack := Copy( CrackedStack, 1, MaxCrackStackLen );
        Result := FALSE; // stop cracking
    end;
end;

procedure DoCrackStack;
asm
    mov  edx, ebp
@@loop:
    mov  ecx, [edx]
    mov  eax, [edx+4]
    mov  edx, ecx
    push edx
    call DoCrackSingleFrame
    pop  edx
    test al, al
    jnz  @@loop
end;

function CrackStack( Max_length: Integer; HandleSuspiciousAddresses: Boolean ): KOLString;
begin
    TRY
        MaxCrackStackLen := Max_length;
        HandleSuspicious := HandleSuspiciousAddresses;
        CrackedStack := '';
        DoCrackStack;
    EXCEPT
    END;
    Result := CrackedStack;
end;

procedure PrepareMapFile;
var i, j: Integer;
    s: KOLString;
begin
    for i := 0 to MapFile.Count-1 do
    begin
        s := MapFile.Items[ i ];
        if pos( AnsiString('Publics by Value'), s ) > 0 then
        begin
            j := i;
            if Trim( MapFile.Items[ j+1 ] ) = '' then
                inc( j );
            for j := j downto 0 do
                MapFile.Delete( j );
            for j := 0 to MapFile.Count-1 do
            begin
                s := Trim( MapFile.Items[ j ] );
                if (s = '') and (LineNumbersFrom = 0) then
                begin
                    LineNumbersFrom := j;
                end;
                if s = 'Bound resource files' then
                begin
                    while MapFile.Count > j do
                        MapFile.Delete( j );
                    break;
                end;
            end;
            break;
        end;
    end;
end;

function CrackStack_MapInResource( const MapName: KOLString; Max_length: Integer;
    HandleSuspiciousAddresses: Boolean ): KOLString;
var MapStrm: PStream;
begin
    Result := '';
    if MapFile = nil then
    begin
        MapStrm := NewMemoryStream;
        TRY
            Resource2Stream( MapStrm, hInstance, PKOLChar( MapName ), PKOLChar(RT_RCDATA) );
            if MapStrm.Size = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
            MapFile := NewKOLStrList;
            MapStrm.Position := 0;
            MapFile.LoadFromStream( MapStrm, FALSE );
            PrepareMapFile;
        FINALLY
            MapStrm.Free;
        END;
    end;
    if MapFile = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    Result := CrackStack( Max_length, HandleSuspiciousAddresses );
end;

function CrackStack_MapInFile( const MapFileName: KOLString; Max_length: Integer;
    HandleSuspiciousAddresses: Boolean ): KOLString;
begin
    Result := '';
    if MapFile = nil then
    begin
        MapFile := NewKOLStrList;
        MapFile.LoadFromFile( MapFileName );
        if MapFile.Count = 0 then
            Free_And_Nil( MapFile )
        else PrepareMapFile;
    end;
    if MapFile = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    Result := CrackStack( Max_length, HandleSuspiciousAddresses );
end;
{$ENDIF _no_PAS_ONLY}

{$IFDEF GRAPHCTL_XPSTYLES}
 {$I visual_xp_styles.inc}
{$ENDIF}

{$IFDEF SNAPMOUSE2DFLTBTN}
var FoundMsgBoxWnd: HWnd;

function EnumProcSnapMouse2DfltBtn( W: HWnd; lParam: Integer ): BOOL; stdcall;
var ClassBuf: array[ 0..31 ] of KOLChar;
begin
  GetClassName( W, ClassBuf, Sizeof( ClassBuf ) div Sizeof( KOLChar ) );
  Result := TRUE;
  if ClassBuf = '#32770' then
  begin
    FoundMsgBoxWnd := W;
    Result := FALSE;
  end;
end;

function WndProcSnapMouse2DfltBtn( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean;
var W: HWnd;
    R: TRect;
    P: TPoint;
    SnapMouse: Integer;
begin
  SnapMouse := 0;
  if SystemParametersInfo( {SPI_GETSNAPTODEFBUTTON}95, 0, @ SnapMouse, 0 ) then
  if SnapMouse <> 0 then
  begin
    FoundMsgBoxWnd := 0;
    EnumThreadWindows( GetCurrentThreadID, @ EnumProcSnapMouse2DfltBtn, 0 );
    if FoundMsgBoxWnd <> 0 then
    begin
      W := GetWindow( FoundMsgBoxWnd, GW_CHILD );
      while W <> 0 do
      begin
        if GetWindowLong( W, GWL_STYLE ) and BS_DEFPUSHBUTTON <> 0 then
        begin
          GetWindowRect( W, R );
          P.X := (R.Left + R.Right) div 2;
          P.Y := (R.Top + R.Bottom) div 2;
          SetCursorPos( P.X, P.Y );
        end;
        W := GetWindow( W, GW_HWNDNEXT );
      end;
      Applet.DetachProc( @WndProcSnapMouse2DfltBtn );
    end;
  end;
  Result := FALSE;
end;
{$ENDIF SNAPMOUSE2DFLTBTN}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function MsgBox( const S: KOLString; Flags: DWORD ): DWORD;
var Title: PKOLChar;
begin
  {$IFnDEF NO_SAFE_CODE} // MsgBox should be called when Applet already created
  Title := nil;      // (and yet not destroyed)
  if assigned( Applet ) then
  {$ENDIF}
  begin
    Title := PKOLChar( Applet.fCaption );
  end;
  {$IFDEF SNAPMOUSE2DFLTBTN}
      {$IFDEF SAFE_CODE}
      if Assigned( Applet ) then
      {$ENDIF}
      begin
        Applet.AttachProc( WndProcSnapMouse2DfltBtn );
        Applet.Postmsg( 0, 0, 0 );
      end;
  {$ENDIF}
  Result := MessageBox( 0, PKOLChar( S ), Title, Flags );
  {$IFDEF SNAPMOUSE2DFLTBTN}
      {$IFnDEF NO_SAFE_CODE}
      if Assigned( Applet ) then
      {$ENDIF}
        Applet.DetachProc( WndProcSnapMouse2DfltBtn );
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

procedure MsgOK( const S: KOLString );
begin
  MsgBox( S, MB_OK );
end;

{$IFDEF ASM_UNICODE}{$ELSE PASCAL}
function ShowMsg( const S: KOLString; Flags: DWORD ): DWORD;
var Title: PKOLChar;
    Wnd: HWnd;
begin
  {$IFDEF SNAPMOUSE2DFLTBTN}
      {$IFDEF SAFE_CODE}
      if Assigned( Applet ) then
      {$ENDIF}
        Applet.AttachProc( WndProcSnapMouse2DfltBtn );
  {$ENDIF}
  {$IFDEF SAFE_CODE}
  Title := nil;
  Wnd := 0;
  if assigned( Applet ) then
  {$ENDIF}
  begin
     Title := PKOLChar( Applet.fCaption );
     //{$IFNDEF SNAPMOUSE2DFLTBTN}
     Wnd := Applet.Handle;
     //{$ENDIF}
  end;
  Result := MessageBox( Wnd, PKOLChar( S ), Title, Flags );
  {$IFDEF SNAPMOUSE2DFLTBTN}
      {$IFDEF SAFE_CODE}
      if Assigned( Applet ) then
      {$ENDIF}
        Applet.DetachProc( WndProcSnapMouse2DfltBtn );
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

procedure ShowMessage( const S: KOLString );
begin
  ShowMsg( S, MB_OK or MB_SETFOREGROUND or MB_DEFBUTTON1 );
end;
{$ENDIF GDI}

{$IFDEF WIN_GDI}
{$IFDEF PAS_ONLY}
procedure SpeakerBeep( Freq: Word; Duration: DWORD );
begin
    Windows.Beep( Freq, Duration );
end;
{$ELSE}
procedure SpeakerBeep( Freq: Word; Duration: DWORD );
begin
  if WinVer >= wvNT then
    Windows.Beep( Freq, Duration )
  else
  begin
    if Freq < 18 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    Freq := 1193181 div Freq;
    if Freq = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    asm
        mov al,0b6H
        out 43H,al
        mov ax,Freq
        //xchg al, ah
        out 42h,al
        xchg al, ah
        out 42h,al
        in  al,61H
        or  al,03H
        out 61H,al
    end {$IFDEF F_P} [ 'EAX' ] {$ENDIF} ;
    Sleep(Duration);
    asm
        in  al,61H
        and al,0fcH
        out 61H,al
    end {$IFDEF F_P} [ 'EAX' ] {$ENDIF} ;
  end;
end;
{$ENDIF}
{$ENDIF WIN_GDI}

function SysErrorMessage(ErrorCode: Integer): KOLString;
var
  Len: Integer;
  Buffer: array[0..255] of KOLChar;
begin
  Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
    FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer,
    SizeOf(Buffer), nil);
  while (Len > 0) and ({(Buffer[Len - 1] >= #0) and} (Buffer[Len - 1] <= ' ')) do Dec(Len);
  SetString(Result, Buffer, Len);
  //Result := Trim( Result );
end;
{$ENDIF WIN_GDI}

function GetShiftState: DWORD;
{$IFDEF WIN}
const Buttons: array[0..6] of Byte = ( VK_SHIFT, VK_CONTROL, VK_MENU, VK_LBUTTON,
  VK_RBUTTON, VK_MBUTTON, VK_CAPITAL );
      Flags: array[0..6] of Byte = ( MK_SHIFT, MK_CONTROL, MK_ALT, MK_LBUTTON,
  MK_RBUTTON, MK_MBUTTON, MK_LOCK );
var i, mask: Integer;
{$ENDIF WIN} //todo: for Linux / GTK ?
begin
  Result := 0;
  {$IFDEF WIN}
  mask := 1;
  for i := High( Buttons ) downto 0 do
  begin
    if GetKeyState( Buttons[ i ] ) and mask <> 0 then
      Result := Result or Flags[ i ];
    mask := $8000;
  end;
  {$ENDIF WIN}
end;

function MakeMethod( Data, Code: Pointer ): TMethod;
begin
  Result.Data := Data;
  Result.Code := Code;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function MakeRect( Left, Top, Right, Bottom: Integer ): TRect; stdcall;
begin
   Result.Left := Left;
   Result.Top  := Top;
   Result.Right:= Right;
   Result.Bottom := Bottom;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function RectsEqual( const R1, R2: TRect ): Boolean;
begin
  Result := CompareMem( @R1, @R2, Sizeof( TRect ) );
end;
{$ENDIF PAS_VERSION}

function RectsIntersected( const R1, R2: TRect ): Boolean;
begin
  Result := ((R1.Left <= R2.Left) and (R1.Right > R2.Left ) or
             (R1.Left <= R2.Right) and (R1.Right >= R2.Right) or
             (R1.Left >= R2.Left) and (R1.Right <= R2.Right))
             and
            ((R1.Top <= R2.Top) and (R1.Bottom > R2.Top) or
             (R1.Top <= R2.Bottom) and (R1.Bottom >= R2.Bottom) or
             (R1.Top >= R2.Top) and (R1.Bottom <= R2.Bottom)) ;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function PointInRect( const P: TPoint; const R: TRect ): Boolean;
begin
   Result := (P.x >= R.Left) and (P.x < R.Right)
             and (P.y >= R.Top) and (P.y < R.Bottom);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} // Pascal
function OffsetPoint( const T: TPoint; dX, dY: Integer ): TPoint;
begin
  Result := MakePoint( T.X + dX, T.Y + dY );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} // Pascal
function OffsetSmallPoint( const T: TSmallPoint; dX, dY: SmallInt ): TSmallPoint;
begin
  Result.x := T.x + dX;
  Result.y := T.y + dY;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} // Pascal
function Point2SmallPoint( const T: TPoint ): TSmallPoint;
begin
  Result.x := T.X;
  Result.y := T.Y;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function SmallPoint2Point( const T: TSmallPoint ): TPoint;
begin
  Result := MakePoint( T.x, T.y );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function MakePoint( X, Y: Integer ): TPoint;
begin
   Result.x := X;
   Result.y := Y;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} // Pascal
function MakeSmallPoint( X, Y: Integer ): TSmallPoint;
begin
  Result.x := X;
  Result.y := Y;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function MakeFlags( FlgSet: PDWORD; FlgArray: array of Integer): Integer;
var I : Integer;
    Mask : DWORD;
begin
  Result := 0;
  Mask := FlgSet^;
  for I := 0 to High( FlgArray ) do
  begin
    if (FlgArray[ I ] < 0) and not LongBool( Mask and 1 ) then
       Result := Result or not FlgArray[ I ]
    else
    if (FlgArray[ I ] >= 0) and LongBool( Mask and 1 ) then
       Result := Result or FlgArray[ I ];
    Mask := Mask shr 1;
  end;
end;
{$ENDIF PAS_VERSION}

function MakeDateTimeRange( D1, D2: TDateTime ): TDateTimeRange;
begin
  Result.FromDate := D1;
  Result.ToDate   := D2;
end;

procedure Swap( var X, Y: Integer );
{$IFDEF F_P}
var Tmp: Integer;
begin
  Tmp := X;
  X := Y;
  Y := Tmp;
end;
{$ELSE DELPHI}
asm
  MOV  ECX, [EDX]
  XCHG ECX, [EAX]
  MOV  [EDX], ECX
end;
{$ENDIF F_P/DELPHI}

function Min( X, Y: Integer ): Integer;
asm
  {$IFDEF F_P}
  MOV EAX, [X]
  MOV EDX, [Y]
  {$ENDIF F_P}
  {$IFDEF USE_CMOV}
  CMP   EAX, EDX
  CMOVG EAX, EDX
  {$ELSE}
  CMP EAX, EDX
  JLE @@exit
  MOV EAX, EDX
@@exit:
  {$ENDIF}
end {$IFDEF F_P} [ 'EAX', 'EDX' ] {$ENDIF};

function Max( X, Y: Integer ): Integer;
asm
  {$IFDEF F_P}
  MOV EAX, [X]
  MOV EDX, [Y]
  {$ENDIF F_P}
  {$IFDEF USE_CMOV}
  CMP EAX, EDX
  CMOVL EAX, EDX
  {$ELSE}
  CMP EAX, EDX
  JGE @@exit
  MOV EAX, EDX
@@exit:
  {$ENDIF}
end {$IFDEF F_P} [ 'EAX', 'EDX' ] {$ENDIF};

{$IFDEF REDEFINE_ABS}
function Abs( X: Integer ): Integer;
asm
  {$IFDEF F_P}
  MOV EAX, [X]
  {$ENDIF F_P}
  cdq
  xor eax, edx
  sub eax, edx
end {$IFDEF F_P} [ 'EAX' ] {$ENDIF};
{$ENDIF}

function Sgn( X: Integer ): Integer;
asm
  CMP EAX, 0
  {$IFDEF USE_CMOV}
  MOV EDX, -1
  CMOVL EAX, EDX
  MOV EDX, 1
  CMOVG EAX, EDX
  {$ELSE}
  JZ  @@exit
  MOV EAX, 1
  JG  @@exit
  MOV EAX, -1
@@exit:
  {$ENDIF}
end;

function iSQRT( X: Integer ): Integer;
{$IFDEF _D4orHigher}
// new version is more efficient but code is not compatible with older compilers
var I, N: Int64;
begin
  Result := 0;
  while Result < X do
  begin
    I := 1;
    while I > 0 do
    begin
      N := (Result + I) * (Result + I);
      if  N > X then
      begin
          I := I shr 1;
          break;
      end else
      if  N = X then
      begin
          Result := Result + I;
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      I := I * 2;
    end;
    if I <= 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    Result := Result + I;
  end;
end;
{$ELSE _D3 or below or FPC1}
var m, y, b: DWORD;
begin
  m := $40000000;
  y := 0;
  while m <> 0 do // 16 times
  begin
    b := y or m;
    y := y shr 1;
    if x >= b then
    begin
      x := x - b;
      y := y or m;
    end;
    m := m shr 2;
  end;
  Result := y;
end;
{$ENDIF}

function iCbrt( X: DWORD ): Integer;
var s: Integer;
    y, b: DWORD;
begin
  s := 30;
  y := 0;
  while s >= 0 do // 11 times
  begin
    y := 2 * y;
    b := (3 * y * (y+1) + 1) shl s;
    s := s - 3;
    if x >= b then
    begin
      x := x - b;
      y := y + 1;
    end;
  end;
  Result := y;
end;
{$IFDEF WIN_GDI}

{$IFDEF ASM_DC}
procedure StartDC;
asm
  { <- EBX : PBitmap
    -> EAX = dc
       [ESP+8] = var dc
       [ESP+4] = var SaveBmp
  }
        PUSH     0
        CALL     CreateCompatibleDC
        POP      EDX
        PUSH     EAX
        PUSH     EDX
        MOV      EAX, EBX
        CALL     [EBX].TBitmap.fDetachCanvas
        MOV      EAX, EBX
        CALL     TBitmap.GetHandle
        PUSH     EAX
        PUSH     dword ptr [ESP+8]
        CALL     SelectObject
        POP      EDX
        PUSH     EAX
        PUSH     EDX
        MOV      EAX, [ESP+8]
end;

procedure FinishDC;
asm
        POP      ECX
        POP      EAX
        POP      EDX
        PUSH     ECX
        PUSH     EDX
        PUSH     EAX
        PUSH     EDX
        CALL     SelectObject
        CALL     DeleteDC
end;
{$ENDIF ASM_DC}

function EnumDynHandlers( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
  forward;

{$ENDIF WIN_GDI}

procedure DummyObjProc( Sender: PObj );
begin     // 1-2-3 parameters, no result
end;

function  DummyProc123_TRUE( Dummy: Pointer; Sender: PControl; param3: Integer ): Boolean;
begin     Result := TRUE;  // 1-2-3 params, Result = TRUE
end;

function  DummyProc123_0( Dummy: Pointer; Sender: PObj; param3: Integer ): Integer;
begin     Result := 0; // 1-2-3 params, Result = 0
end;

function  DummyProc4_TRUE( Dummy: Pointer; Sender: PControl; p3, p4: Integer ): Boolean;
begin     Result := TRUE; // 4 params, result = TRUE
end;

function  DummyProc5_TRUE( Dummy: Pointer; Sender: PControl; p3, p4, p5: Integer): Boolean;
begin     Result := TRUE; // 5 params, result = TRUE
end;

procedure DummyOnLVDataProc( Dummy: Pointer; Sender: PControl; Idx, SubItem: Integer;
          var Txt: KOL_String; var ImgIdx: Integer; var State: DWORD;
          var Store: Boolean );
begin     // 8 params
end;

function  DummyProc4_0( Dummy: Pointer; Sender: PControl; p3, p4: Integer ): Integer;
begin     Result := 0; // 4 params, Result = 0
end;

function  DummyOnDrawItemProc( Dummy:Pointer; Sender: PObj; DC: HDC; const Rect: TRect; ItemIdx: Integer;
          DrawAction: TDrawAction; ItemState: TDrawState ): Boolean;
begin     Result := FALSE; // 7 params, Result = FALSE
end;

function  DummyOnLVCustomDrawProc( Dummy: Pointer; Sender: PControl; DC: HDC; Stage: DWORD;
          ItemIdx, SubItemIdx: Integer; const Rect: TRect;
          ItemState: TDrawState; var TextColor, BackColor: TColor ): DWORD;
begin     Result := 0; // 10 params, Result = 0
end;

function  DummyOnSBBeforeScrollProc(Dummy: Pointer; Sender: PControl;
          OldPos, NewPos: Integer; Cmd: Word; var AllowChange: Boolean): Boolean;
begin     Result := FALSE; // 6 params
end;

var DummyProcTable: array[ 0..11 ] of Pointer = ( @DummyObjProc, @DummyProc123_TRUE,
    @DummyProc123_0, @DummyProc4_TRUE, @DummyProc5_TRUE, @DummyOnLVDataProc,
    @DummyProc4_0, @DummyOnDrawItemProc, @DummyOnLVCustomDrawProc,
    @DummyOnSBBeforeScrollProc, @WndFunc,
    {$IFDEF USE_GRAPHCTLS} @InvalidateWindowed {$ELSE} @DummyObjProc {$ENDIF} );
const idummy123      = 0;         //+
      idummy123_TRUE = 1;         //+
      idummy123_0    = 2;         //+
      idummy4_TRUE   = 3;         //+
      idummy5_TRUE   = 4;         //+
      idummy8        = 5;         //+
      idummy4_0      = 6;         //+
      idummy7        = 7;         //+
      idummy10       = 8;         //+
      idummy6        = 9;         //+
      iWndFunc       = 10;        //+
      iInvalidateWindowed = 11;   //+
const InitEventsTable: array[ 0..idx_LastEvent ] of Byte = (
      idummy123_0 + iWndFunc shl 4,             //idx_fOnMessage + idx_fWndFunc          = 0;                          idx_fWndFunc            = 69;
      idummy123_0 + iInvalidateWindowed shl 4,  //idx_fOldOnMessage + idx_fDoInvalidate  = 1;                          idx_fDoInvalidate       = 70;
      idummy123   + idummy123_0 shl 4,          //idx_fOnClick                           = 2;                          idx_fOnDynHandlers      = 71;
      idummy123   + idummy123_0 shl 4,          //idx_fOnMouseDown                       = 3;                          idx_fPass2DefProc       = 72;
      idummy123   + idummy123_0 shl 4,          //idx_fOnMouseUp                         = 4;                          idx_fWndProcKeybd       = 73;
      idummy123   + idummy123_0 shl 4,          //idx_fOnMouseMove                       = 5;                          idx_fControlClick       = 74;
      idummy123   + idummy123_0 shl 4,          //idx_fOnMouseDblClk                     = 6;                          idx_fAutoSize           = 75;
      idummy123   + idummy123_0 shl 4,          //idx_fOnMouseWheel                      = 7;                          idx_fGotoControl        = 77;
      idummy123   + idummy123_0 shl 4,          //idx_fOnMouseEnter                      = 8;                          idx_fNotifyChild        = 78;
      idummy123   + idummy123_0 shl 4,          //idx_fOnMouseLeave                      = 9;                          idx_fScrollChildren     = 79;
      idummy123_TRUE + idummy123_0 shl 4,       //idx_fOnTestMouseOver                   = 10;                         idx_fCreateWndExt       = 80;
      idummy123   + idummy123_0 shl 4,          //idx_fGraphCtlMouseEvent                = 11;                         idx_fExMsgProc          = 81;
      idummy123,                                //idx_fMouseLeaveProc                    = 12;
      idummy5_TRUE,                             //idx_fOnScroll                          = 13;
      idummy4_TRUE,                             //idx_fOnChar                            = 14;
      idummy4_TRUE,                             //idx_fOnDeadChar                        = 15;
      idummy4_TRUE,      //idx_fOnKeyUp                                                  = 16;
      idummy4_TRUE,      //idx_fOnKeyDown                                                = 17;
      idummy123,         //idx_fOnChangeCtl                                                 = 18;
      idummy123,         //idx_fOnEnter                                                  = 19;
      idummy123,         //idx_fOnLeave                                                  = 20;
      idummy123,         //idx_fLeave                                                    = 21;
      idummy123,         //idx_fOnPaint                                                  = 22;
      idummy123,         //idx_fOnPaint2                                                 = 23;
      idummy123,         //idx_fOnPrepaint                                               = 24;
      idummy123,         //idx_fOnPostPaint                                              = 25;
      idummy123,         //idx_fPaintProc                                                = 26;
      idummy123,         //idx_fOnEraseBkgnd                                             = 27;
      idummy7,           //idx_fOnDrawItem                                               = 28;
      idummy123_0,       //idx_fOnMeasureItem                                            = 29;
      idummy6,           //idx_fDragCallback                                             = 30;
      idummy123,         //idx_fOnSelChange                                              = 31;
      idummy123,         //idx_fOnResize                                                 = 32;
      idummy123,         //idx_fOnHide                                                   = 33;
      idummy123,         //idx_fOnShow                                                   = 34;
      idummy123,         //idx_fOnClose                                                  = 35;
      idummy123,         //idx_fOnMove                                                   = 36;
      idummy123,         //idx_fOnMoving                                                 = 37;
      idummy4_0,         //idx_fOnHelp                                                   = 38;
      idummy123,         //idx_fOnQueryEndSession                                        = 39;
      idummy123,         //idx_fOnMinimize                                               = 40;
      idummy123,         //idx_fOnMaximize                                               = 41;
      idummy123,         //idx_fOnRestore                                                = 42;
      idummy10,          //idx_fOnLVCustomDraw                                           = 43;
      idummy5_TRUE,      //idx_fOnEndEditLVITem                                          = 44;
      idummy8,           //idx_fOnLVData                                                 = 45;
      idummy4_0,         //idx_fOnCompareLVItems                                         = 46;
      idummy6,           //idx_FOnLVStateChange                                          = 47;
      idummy123,         //idx_fOnDeleteLVItem                                           = 48;
      idummy123,         //idx_fOnColumnClick                                            = 49;
      idummy6,           //idx_FOnSBBeforeScroll                                         = 54;
      idummy123,         //idx_FOnSBScroll                                               = 55;
      idummy123,         //idx_FOnDropDown                                               = 56;
      idummy123,         //idx_FOnCloseUp                                                = 57;
      idummy4_TRUE,      //idx_FOnSplit                                                  = 58;
      idummy123,         //idx_FOnProgress                                               = 59;
      idummy123_0,       //idx_FOnBitBtnDraw                                             = 60;
      idummy123,         //idx_FOnTVBeginDrag                                            = 61;
      idummy123_TRUE,    //idx_FOnTVBeginEdit                                            = 62;

      idummy4_TRUE,      //idx_FOnTVEndEdit                                              = 50;
      idummy4_0,         //idx_FOnTVExpanding                                            = 52;
      idummy4_TRUE,      //idx_FOnTVExpanded                                             = 51;
      idummy4_TRUE,      //idx_FOnTVSelChanging                                          = 53;

      idummy123,         //idx_FOnTVDelete                                               = 63;
      idummy5_TRUE,      //idx_FOnDTPUserString                                          = 64;
      idummy123,         //idx_FOnREInsModeChg                                           = 65;
      idummy123,         //idx_FOnREOverURL                                              = 66;
      idummy123,         //idx_FOnREURLClick                                             = 67;
      idummy4_0          //idx_fOnDropFiles                                              = 68;
      );

{ _TObj }

procedure Free_And_Nil( var Obj );
var Obj1: PObj;
begin
  Obj1 := PObj( Obj );
  Pointer( Obj ) := nil;
  Obj1.Free;
end;

procedure _TObj.Init;
begin
{$IFDEF _D2orD3}
  //FillChar( Pointer( Integer(@Self) + 4 )^, Sizeof( Self ) - 4, 0 );
  ZeroMemory( Pointer( Integer(@Self) + 4 ), Sizeof( Self ) - 4 );
{$ENDIF}
end;

function _TObj.VmtAddr: Pointer;
asm
   MOV EAX, [EAX]
end;

{ TObj }

class function TObj.AncestorOfObject(Obj: Pointer): Boolean;
asm
        MOV     ECX, [EAX]
        MOV     EAX, EDX
        JMP     @@loop1
@@loop:
        MOV     EAX,[EAX]
@@loop1:
        TEST    EAX,EAX
        JE      @@exit
        CMP     EAX,ECX
        JNE     @@loop
@@success:
        MOV     AL,1
@@exit:
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
constructor TObj.Create;
begin
  Init;
end;
{$ENDIF PAS_VERSION}

{$IFDEF OLD_REFCOUNT}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TObj.DoDestroy;
begin
  {$IFDEF OLD_REFCOUNT}
  if  fRefCount > 0 then
  begin
      if not LongBool( fRefCount and 1) then
      Dec( fRefCount, 2 );
      RefDec;
  end else
      Self.Destroy;
  if  fRefCount <> 0 then
  begin
      if not LongBool( fRefCount and 1) then
         Dec( fRefCount );
  end else
      Self.Destroy;
  {$ELSE}
  if   fRefCount > 0 then
       RefDec
  else Self.Destroy;
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}
{$ENDIF OLD_REFCOUNT}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TObj.RefDec: Integer;
begin
  Result := 0; // stop Delphi alerting the Warning
  if  @ Self = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Dec( fRefCount, 2 );
  {$IFDEF OLD_REFCOUNT}
  if  (fRefCount < 0) and LongBool(fRefCount and 1) then
      Destroy;
  {$ELSE}
  if  fRefCount < 0 then
      Destroy;
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

procedure TObj.RefInc;
begin
  Inc( fRefCount, 2 );
end;

function TObj.VmtAddr: Pointer;
asm
       //MOV    EAX, [EAX - 4]
       MOV    EAX, [EAX]
end;

function TObj.InstanceSize: Integer;
asm
       //MOV    EAX, [EAX]
       MOV    EAX, [EAX-4]
end;

{$IFDEF OLD_FREE}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
procedure TObj.Free;
begin
    RefDec;
end;
{$ENDIF PAS_VERSION}
{$ENDIF OLD_FREE}

{$UNDEF ASM_LOCAL}
{$IFDEF ASM_VERSION} {$DEFINE ASM_LOCAL} {$ENDIF}
{$IFDEF CRASH_DEBUG} {$UNDEF ASM_LOCAL} {$ENDIF}
{$IFDEF ASM_DEBUG} {$DEFINE ASM_LOCAL} {$ENDIF}

{$IFDEF ASM_LOCAL}
{$ELSE PAS_VERSION} //Pascal
destructor TObj.Destroy;
begin
  Final;

  {$IFDEF DEBUG_ENDSESSION}
  if  EndSession_Initiated then
      LogFileOutput( GetStartDir + 'es_debug.txt',
                   'FINALLED: ' + Int2Hex( DWORD( @ Self ), 8 )
                   {$IFDEF USE_NAMES}
                   + ' (name:' + FName + ')'
                   {$ENDIF}
                   );
  {$ENDIF}
  {$IFDEF USE_NAMES}
  fName := '';
  if  fNamedObjList <> nil then
      Free_And_Nil(fNamedObjList);
  {$ENDIF}
  {$IFDEF CRASH_DEBUG}
  FillChar( Pointer( Integer(@Self) + 4 )^, Sizeof( Self ) - 4, #$DD );
  {$ENDIF}
  FreeMem( @ Self );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}
  {$DEFINE ASM_TLIST}
{$IFDEF TLIST_FAST}
  {$UNDEF ASM_TLIST}
{$ENDIF}
{$ENDIF}

{$IFDEF ASM_TLIST}
procedure TObj.Final;
asm     //cmd    //opd
        PUSH     EBX
        XCHG     EBX, EAX
        XOR      ECX, ECX
        XCHG     ECX, [EBX].fOnDestroy.TMethod.Code
        JECXZ    @@freeloop
        MOV      EDX, EBX
        MOV      EAX, [EDX].fOnDestroy.TMethod.Data
        CALL     ECX
@@freeloop:
        MOV      ECX, [EBX].fAutoFree
        JECXZ    @@eloop
        MOV      EDX, [ECX].TList.fItems
        MOV      ECX, [ECX].TList.fCount
        JECXZ    @@eloop
        MOV      EAX, [EDX+ECX*4-4]
        MOV      EDX, [EDX+ECX*4-8]
        PUSH     EAX
        PUSH     EDX
        MOV      EAX, [EBX].fAutoFree
        LEA      EDX, [ECX-2]
        XOR      ECX, ECX
        MOV      CL, 2
        CALL     TList.DeleteRange
        POP      EDX
        POP      EAX
        CALL     EDX
        JMP      @@freeloop
@@eloop:
        XOR      EAX, EAX
        XCHG     [EBX].fAutoFree, EAX
        CALL     TObj.RefDec
@@exit:
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
procedure TObj.Final;
var N: Integer;
    ProcMethod: TMethod;
    {$IFDEF _D2orD3}
    Proc: TObjectMethod;
    {$ELSE}
    Proc: TObjectMethod Absolute ProcMethod;
    {$ENDIF}
var Destroy_evnt: TOnEvent;
begin
  if Assigned( fOnDestroy ) then
  begin
    Destroy_evnt := fOnDestroy;
    fOnDestroy := nil;
    Destroy_evnt( @Self );
  end;
  while (fAutoFree <> nil) and (fAutoFree.fCount > 0) do
  begin
    N := fAutoFree.fCount - 2;
    ProcMethod.Code := fAutoFree.Items[ N ];
    ProcMethod.Data := fAutoFree.Items[ N + 1 ];
    fAutoFree.DeleteRange( N, 2 );
    {$IFDEF _D2orD3}
    Proc := TObjectMethod( ProcMethod );
    {$ENDIF}
    Proc;
  end;
  fAutoFree.Free;
  fAutoFree := nil;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TObj.Add2AutoFree(Obj: PObj);
begin
  if  fAutoFree = nil then
      fAutoFree := NewList;
  fAutoFree.Insert( 0, Obj );
  fAutoFree.Insert( 0, Pointer( @TObj.RefDec ) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TObj.Add2AutoFreeEx( Proc: TObjectMethod );
{$IFDEF F_P}
var Ptr1, Ptr2: Pointer;
{$ENDIF F_P}
begin
  if fAutoFree = nil then
    fAutoFree := NewList;
  {$IFDEF F_P}
  asm
    MOV  EAX, [Proc]
    MOV  [Ptr1], EAX
    MOV  EAX, [Proc+4]
    MOV  [Ptr2], EAX
  end [ 'EAX' ];
  fAutoFree.Insert( 0, Ptr2 );
  fAutoFree.Insert( 0, Ptr1 );
  {$ELSE DELPHI}
  fAutoFree.Insert( 0, Pointer( TMethod( Proc ).Data ) );
  fAutoFree.Insert( 0, Pointer( TMethod( Proc ).Code ) );
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
procedure TObj.RemoveFromAutoFree(Obj: PObj);
var i: Integer;
begin
  if fAutoFree <> nil then
  begin
    i := fAutoFree.IndexOf( Obj );
    if i >= 0 then
    begin
      fAutoFree.DeleteRange( i and not 1, 2 );
      if fAutoFree.Count = 0 then
        Free_And_Nil( fAutoFree );
    end;
  end;
end;
{$ENDIF PAS_VERSION}

procedure TObj.RemoveFromAutoFreeEx(Proc: TObjectMethod);
var i: Integer;
begin
  if fAutoFree <> nil then
  begin
    for i := 0 to fAutoFree.Count-2 do
      if (fAutoFree.Items[ i ] = TMethod( Proc ).Data) and
         (fAutoFree.Items[ i+1 ] = TMethod( Proc ).Code) then
      begin
        fAutoFree.Delete( i );
        fAutoFree.Delete( i );
        break;
      end;
  end;
end;

{$IFDEF USE_NAMES}
procedure TObj.SetName( NewOwnerObj: PObj; NewName: AnsiString );
{$IFDEF UNIQUE_NAMES}
var i: Integer;
{$ENDIF}
begin
  if (FOwnerObj <> nil) then
    if FOwnerObj <> NewOwnerObj then
    begin
      FOwnerObj.fNamedObjList.Remove( @ Self );
    end;
  FOwnerObj := NewOwnerObj;
  if NewOwnerObj = nil then
  begin
    if NewName = '' then
     begin
      fName := '';
      Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
     end;
    // çäåñü òîò ñëó÷àé, êîãäà â ïðèëîæåíèè áåç Applet'à óñòàíàâëèâàåòñÿ
    // èìÿ äëÿ ãëàâíîé ôîðìû (íàâåðíîå)
    FOwnerObj := @ Self; // âëàäåëüöåì ñïèñêà èìåíîâàííûõ îáúåêòîâ ñòàíîâèòñÿ
    // ñàì îáúåêò. Äëÿ âûøåîçíà÷åííîãî ñëó÷àÿ - ãëàâíàÿ ôîðìà äåðæèò ñåáÿ è
    // äðóãèå ôîðìû.
  end;
  if FOwnerObj.fNamedObjList = nil then
     FOwnerObj.fNamedObjList := NewList;
  {$IFDEF UNIQUE_NAMES}
  for i := 0 to FOwnerObj.fNamedObjList.Count-1 do
  begin
    if PObj( FOwnerObj.fNamedObjList.Items[ i ] ).FName = NewName then
    begin
      NewName := '';
      break;
    end;
  end;
  {$ENDIF}
  FName := NewName;
  if FName = '' then
     FOwnerObj.fNamedObjList.Remove( @ Self )
  else if FOwnerObj.fNamedObjList.IndexOf( @ Self ) < 0 then
     FOwnerObj.fNamedObjList.Add( @ Self );
end;

function TObj.FindObj(const ObjName: Ansistring): PObj;
var i: Integer;
    Obj: PObj;
begin
  if fNamedObjList <> nil then
  for i := 0 to fNamedObjList.Count-1 do
  begin
    Obj := fNamedObjList.Items[ i ];
    if ObjName = Obj.FName then
    begin
      Result := Obj; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end;
  Result := nil;
end;
{$ENDIF}

{ TList }

{$IFDEF USE_CONSTRUCTORS}
procedure TList.Init;
begin
  {$IFDEF CALL_INHERITED}
  inherited;
  {$ENDIF}
  fAddBy := 4;
  {$IFDEF TLIST_FAST}
  {$IFNDEF DFLT_TLIST_NOUSE_BLOCKS} // for debug only
  fUseBlocks := TRUE;
  {$ENDIF}
  {$ENDIF}
end;

function NewList: PList;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  fObjKind := 'TList';
  {$ENDIF}
end;

{$ELSE not_USE_CONSTRUCTORS}
function NewList: PList;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TList';
  {$ENDIF}
  Result.fAddBy := 4;
  {$IFDEF TLIST_FAST}
  {$IFNDEF DFLT_TLIST_NOUSE_BLOCKS} // for debug only
  Result.fUseBlocks := TRUE;
  {$ENDIF}
  {$ENDIF}
end;
{$ENDIF USE_CONSTRUCTORS}

{$IFDEF _D4orHigher}
function NewListInit( const AItems: array of Pointer ): PList;
var i: Integer;
begin
  Result := NewList;
  Result.Capacity := Length( AItems );
  for i := 0 to High( AItems ) do
    Result.Add( AItems[ i ] );
end;
{$ENDIF}

{$IFNDEF PAS_ONLY}
procedure HelpFastIncNum2Els( DataArray: Pointer; Value, Count: Integer );
asm
  PUSH ESI
  PUSH EDI
  {$IFDEF F_P}
  MOV ESI, [DataArray]
  MOV EDX, [Value]
  MOV ECX, [Count]
  {$ELSE DELPHI}
  MOV ESI, EAX
  {$ENDIF F_P/DELPHI}
  MOV EDI, ESI
  CLD

@@1:
  LODSD
  ADD EAX, EDX
  STOSD
  LOOP @@1

  POP EDI
  POP ESI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};

{$IFNDEF TLIST_FAST}
procedure FastIncNum2Elements( List: TList; FromIdx, Count, Value: Integer );
begin
  HelpFastIncNum2Els( @List.fItems[ FromIdx ], Value, Count );
end;
{$ENDIF}
{$ENDIF PAS_ONLY}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TList.Destroy;
begin
   Clear;
   inherited;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
procedure TList.Release;
asm
       TEST      EAX, EAX
       JZ        @@e
       MOV       ECX, [EAX].fCount
       JECXZ     @@e
       MOV       EDX, [EAX].fItems
       PUSH      EAX
@@1:
       MOV       EAX, [EDX+ECX*4-4]
       TEST      EAX, EAX
       JZ        @@2
       PUSH      EDX
       PUSH      ECX
       CALL      System.@FreeMem
       POP       ECX
       POP       EDX
@@2:   LOOP      @@1
       POP       EAX
@@e:   CALL      TObj.RefDec
end;
{$ELSE PAS_VERSION} //Pascal
procedure TList.Release;
var I: Integer;
begin
  if @ Self = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  for I := 0 to fCount - 1 do
    if {$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ] <> nil then
      FreeMem( {$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ] );
  Free;
end;
{$ENDIF PAS_VERSION}

procedure TList.ReleaseObjects;
var I: Integer;
begin
  if @ Self = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  for I := fCount-1 downto 0 do
    PObj( {$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF} [ I ] ).Free;
  Free;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TList.SetCapacity( Value: Integer );
begin
  {$IFDEF TLIST_FAST}
  if fUseBlocks and (fBlockList <> nil) then
  begin
      if  Value > 256 then // Capacitity â îáû÷íîì ñìûñëå ðàáîòàåò òîëüêî äëÿ ïåðâîãî
          Value := 256;    // áëîêà - äî 256 ýëåìåíòîâ, äàëåå îíî ñìûñëà íå èìååò,
      fCapacity := Value;  // ò.ê. âñå ïðî÷èå áëîêè âñåãäà ñîäåðæàò ïî 256 ïîçèöèé
                           // äëÿ ýëåìåíòîâ, íåçàâèñèìî îò ïðîöåíòà èñïîëüçîâàíèÿ.
  end else
  {$ENDIF}
  begin
     if Value < Count then
        Value := Count;
     if Value = fCapacity then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
     ReallocMem( fItems, Value * Sizeof( Pointer ) );
     fCapacity := Value;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TList.Clear;
{$IFDEF TLIST_FAST}
var i: Integer;
{$ENDIF}
begin
   if fItems <> nil then
      FreeMem( fItems );
   fItems := nil;
   fCount := 0;
   fCapacity := 0;
   {$IFDEF TLIST_FAST}
   if fBlockList <> nil then
   begin
     for i := 0 to fBlockList.Count div 2 - 1 do
       FreeMem( fBlockList.Items[ i*2 ] );
     Free_And_Nil( fBlockList );
   end;
   fLastKnownBlockIdx := 0;
   fLastKnownCountBefore := 0;
   {$ENDIF}
end;
{$ENDIF PAS_VERSION}

procedure TList.SetAddBy(Value: Integer);
begin
  if Value < 1 then Value := 1;
  fAddBy := Value;
end;

{$IFDEF ASM_NO_VERSION}  /// ASM-version disabled due some problems - 20-May-2010
{$ELSE PAS_VERSION} //Pascal
procedure TList.Add( Value: Pointer );
{$IFDEF TLIST_FAST}
var LastBlockCount: Integer;
    LastBlockStart: Pointer;
{$ENDIF}
begin
  {$IFDEF TLIST_FAST}
   if fUseBlocks and ((fCount >= 256) or ( fBlockList <> nil )) then
   begin
     if fBlockList = nil then
     begin
         fBlockList := NewList;
         fBlockList.fUseBlocks := FALSE;
         fBlockList.Add( fItems );
         fBlockList.Add( Pointer( fCount ) );
         fItems := nil;
     end;
     if fBlockList.fCount = 0 then
     begin
         fBlockList.Add( nil );
         fBlockList.Add( nil );
         LastBlockCount := 0;
     end else
     begin
         LastBlockCount := Integer( fBlockList.Items[ fBlockList.fCount-1 ] );
         if  LastBlockCount >= 256 then
         begin
             fBlockList.Add( nil );
             fBlockList.Add( nil );
             LastBlockCount := 0;
         end;
     end;
     LastBlockStart := fBlockList.Items[ fBlockList.fCount-2 ];
     if LastBlockStart = nil then
     begin
         GetMem( LastBlockStart, 256 * Sizeof( Pointer ) );
         fBlockList.Items[ fBlockList.fCount-2 ] := LastBlockStart;
     end;
     fBlockList.Items[ fBlockList.fCount-1 ] := Pointer( LastBlockCount+1 );
     PDWORD( Integer(LastBlockStart) + Sizeof(Pointer)*LastBlockCount )^ :=
         DWORD( Value );
   end else
  {$ENDIF}
  begin
     if  fCapacity <= fCount then
     begin
         if   fAddBy <= 0 then
              Capacity := fCount + Min( 1000, fCount div 4 + 1 )
         else Capacity := fCount + fAddBy;
     end;
     fItems[ fCount ] := Value;
  end;
  Inc( fCount );
end;
{$ENDIF PAS_VERSION}

{$IFDEF _D4orHigher}
procedure TList.AddItems(const AItems: array of Pointer);
var i: Integer;
begin
  Capacity := Count + Length( AItems );
  for i := 0 to High( AItems ) do
    Add( AItems[ i ] );
end;
{$ENDIF}

procedure TList.Delete( Idx: Integer );
begin
  DeleteRange( Idx, 1 );
end;

{$IFDEF ASM_TLIST}
procedure TList.DeleteRange(Idx, Len: Integer);
asm     //cmd    //opd
        TEST     ECX, ECX
        JLE      @@exit
        CMP      EDX, [EAX].fCount
        JGE      @@exit
        PUSH     EBX
        XCHG     EBX, EAX
        LEA      EAX, [EDX+ECX]
        CMP      EAX, [EBX].fCount
        JBE      @@1
        MOV      ECX, [EBX].fCount
        SUB      ECX, EDX
@@1:
        MOV      EAX, [EBX].fItems
        PUSH     [EBX].fCount
        SUB      [EBX].fCount, ECX
        MOV      EBX, EDX
        LEA      EDX, [EAX+EDX*4]
        LEA      EAX, [EDX+ECX*4]
        ADD      EBX, ECX
        POP      ECX
        SUB      ECX, EBX
        SHL      ECX, 2
        CALL     System.Move
        POP      EBX
@@exit:
end;
{$ELSE PAS_VERSION} //Pascal
procedure TList.DeleteRange(Idx, Len: Integer);
{$IFDEF TLIST_FAST}
var i, DelFromBlock: Integer;
    CountBefore, CountCurrent: Integer;
    BlockStart: Pointer;
{$ENDIF}
begin
  if Len <= 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Idx >= Count then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$IFDEF KOL_ASSERTIONS}
  Assert( (Idx >= 0), 'TList.DeleteRange: index out of bounds' );
  {$ENDIF KOL_ASSERTIONS}
  if DWORD( Idx + Len ) > DWORD( Count ) then
    Len := Count - Idx;
  {$IFDEF TLIST_FAST}
  if fUseBlocks and ( fBlockList <> nil ) then
  begin
    CountBefore := 0;
    i := 0;
    if (fLastKnownBlockIdx > 0) and
       (Idx >= fLastKnownCountBefore) then
    begin
      i := fLastKnownBlockIdx;
      CountBefore := fLastKnownCountBefore;
    end;
    while i < fBlockList.fCount div 2 do
    begin
      BlockStart := fBlockList.fItems[ i * 2 ];
      CountCurrent := Integer( fBlockList.fItems[ i * 2 + 1 ] );
      if (Idx >= CountBefore) and (Idx < CountBefore + CountCurrent) then
      begin
        DelFromBlock := CountBefore + CountCurrent - Idx;
        if DelFromBlock > Len then
          DelFromBlock := Len;
        if DelFromBlock < CountCurrent then
        begin
          fNotOptimized := TRUE;
          move( Pointer( Integer( BlockStart ) + (Idx - CountBefore + DelFromBlock) * Sizeof( Pointer ) )^,
                Pointer( Integer( BlockStart ) + (Idx - CountBefore) * Sizeof( Pointer ) )^,
                (CountCurrent - (Idx - CountBefore) - DelFromBlock) * Sizeof( Pointer ) );
          dec( CountCurrent, DelFromBlock );
          fBlockList.fItems[ i * 2 + 1 ] := Pointer( CountCurrent );
          dec( fCount, DelFromBlock );
          dec( Len, DelFromBlock );
          if Len <= 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end else
        begin // delete entire block
          //++ fix added: 21.06.08 ++ VK
          fLastKnownBlockIdx := 0;
          fLastKnownCountBefore := 0;
          //++++++++++++++++++++++++++++
          FreeMem( BlockStart );
          fBlockList.DeleteRange( i * 2, 2 );
          dec( fCount, CountCurrent );
          dec( Len, CountCurrent );
          if Len <= 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          CountCurrent := 0;
          dec( i );
        end;
      end;
      inc( i );
      inc( CountBefore, CountCurrent );
    end;
  end else
  {$ENDIF}
  begin
    Move( fItems[ Idx + Len ], fItems[ Idx ], Sizeof( Pointer ) * (Count - Idx - Len) );
    Dec( fCount, Len );
  end;
end;
{$ENDIF PAS_VERSION}

procedure TList.Remove(Value: Pointer);
var I: Integer;
begin
  I := IndexOf( Value );
  if I >= 0 then
    Delete( I );
end;

function TList.ItemAddress(Idx: Integer): Pointer;
{$IFDEF TLIST_FAST}
var i: Integer;
    BlockStart: Pointer;
    CountBefore, CountCurrent: Integer;
{$ENDIF}
begin
  {$IFDEF TLIST_FAST}
  if fUseBlocks and ( fBlockList <> nil ) then
  begin
    CountBefore := 0;
    i := 0;
    if (fLastKnownBlockIdx > 0) and
       (Idx >= fLastKnownCountBefore) then
    begin
      CountBefore := fLastKnownCountBefore;
      i := fLastKnownBlockIdx;
    end;
    CountCurrent := CountBefore + Integer( fBlockList.fItems[ i*2+1 ] );
    if Idx - CountCurrent > fCount - CountCurrent then
    begin // ïîèñê â îáðàòíîì íàïðàâëåíèè ìîæåò îêàçàòüñÿ áûñòðåå
      CountBefore := fCount;
      i := fBlockList.fCount div 2 - 1;
      while TRUE do
      begin
        BlockStart := fBlockList.fItems[ i * 2 ];
        CountCurrent := Integer( fBlockList.fItems[ i * 2 + 1 ] );
        if (CountBefore - CountCurrent <= Idx) and (Idx < CountBefore) then
        begin
          Result := Pointer( Integer( BlockStart ) +
                             (Idx - (CountBefore - CountCurrent))*Sizeof( Pointer ) );
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
        dec( CountBefore, CountCurrent );
        dec( i );
      end;
    end;
    while TRUE { i < fBlockList.Count div 2 } do
    begin
      BlockStart := fBlockList.fItems[ i * 2 ];
      CountCurrent := Integer( fBlockList.fItems[ i * 2 + 1 ] );
      if (CountBefore <= Idx) and (Idx < CountBefore + CountCurrent) then
      begin
        Result := Pointer( Integer( BlockStart ) + (Idx - CountBefore) * Sizeof( Pointer ) );
        Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      inc( CountBefore, CountCurrent );
      inc( i );
    end;
  end else
  {$ENDIF}
      Result := Pointer( Integer( fItems ) + Idx * Sizeof( Pointer ) );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
procedure TList.Put( Idx: Integer; Value: Pointer );
{$IFDEF TLIST_FAST}
var i: Integer;
    BlockStart: Pointer;
    CountBefore, CountCurrent: Integer;
{$ENDIF}
begin
   if Idx < 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   if Idx >= Count then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   {$IFDEF TLIST_FAST}
   if fUseBlocks and ( fBlockList <> nil ) then
   begin
    CountBefore := 0;
    i := 0;
    if (fLastKnownBlockIdx > 0) and
       (Idx >= fLastKnownCountBefore) then
    begin
      i := fLastKnownBlockIdx;
      CountBefore := fLastKnownCountBefore;
    end;
    while i < fBlockList.fCount div 2 do
    begin
      BlockStart := fBlockList.fItems[ i * 2 ];
      CountCurrent := Integer( fBlockList.fItems[ i * 2 + 1 ] );
      if (CountBefore <= Idx) and (Idx < CountBefore + CountCurrent) then
      begin
        fLastKnownBlockIdx := i;
        fLastKnownCountBefore := CountBefore;
        PDWORD( Integer( BlockStart ) + (Idx - CountBefore) * Sizeof( Pointer ) )^ :=
          DWORD( Value );
        Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      inc( CountBefore, CountCurrent );
      inc( i );
    end;
   end else
   {$ENDIF}
       fItems[ Idx ] := Value;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
function TList.Get( Idx: Integer ): Pointer;
{$IFDEF TLIST_FAST}
var i: Integer;
    BlockStart: Pointer;
    CountBefore, CountCurrent: Integer;
{$ENDIF}
begin
  Result := nil;
  if Idx < 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Idx >= fCount then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$IFDEF TLIST_FAST}
  if fUseBlocks and ( fBlockList <> nil ) then
  begin
    if  fNotOptimized then
    begin
        CountBefore := 0;
        i := 0;
        if (fLastKnownBlockIdx > 0) and
           (Idx >= fLastKnownCountBefore) then
        begin
          i := fLastKnownBlockIdx;
          CountBefore := fLastKnownCountBefore;
        end;
        while {i < fBlockList.fCount div 2} TRUE do
        begin
          BlockStart := fBlockList.fItems[ i * 2 ];
          CountCurrent := Integer( fBlockList.fItems[ i * 2 + 1 ] );
          if (CountBefore <= Idx) and (Idx < CountBefore + CountCurrent) then
          begin
            fLastKnownBlockIdx := i;
            fLastKnownCountBefore := CountBefore;
            Result := Pointer( PDWORD( Integer( BlockStart ) + (Idx - CountBefore) * Sizeof( Pointer ) )^ );
            Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          end;
          inc( CountBefore, CountCurrent );
          inc( i );
        end;
    end else
    begin // optimized!
        i := Idx shr 8;
        BlockStart := fBlockList.fItems[ i * 2 ];
        i := Idx and 255;
        Result := Pointer( PDWORD( Integer( BlockStart ) + i * Sizeof( Pointer ) )^ );
    end;
  end else
  {$ENDIF}
      Result := fItems[ Idx ];
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
function TList.IndexOf( Value: Pointer ): Integer;
asm
        PUSH      EDI

        MOV       EDI, [EAX].fItems
        MOV       ECX, [EAX].fCount
          PUSH      EDI
          DEC       EAX            // make "NZ" - EAX always <> 1
          MOV       EAX, EDX
          REPNZ     SCASD
          POP       EDX
        {$IFDEF USE_CMOV}
        CMOVNZ    EDI, EDX
        {$ELSE}
        JZ        @@succ
        MOV       EDI, EDX
@@succ: {$ENDIF}

        MOV       EAX, EDI
        STC
        SBB       EAX, EDX
        SAR       EAX, 2

        POP       EDI
end;
{$ELSE PAS_VERSION} //Pascal
function TList.IndexOf( Value: Pointer ): Integer;
var I: Integer;
    {$IFDEF TLIST_FAST}
    BlockStart: PDWORD;
    j: Integer;
    CountBefore, CountCurrent: Integer;
    {$ENDIF}
begin
  Result := -1;
  {$IFDEF DEBUG_ANY}
  TRY
  {$ENDIF}
     {$IFDEF TLIST_FAST}
     if fUseBlocks and ( fBlockList <> nil ) then
     begin
       CountBefore := 0;
       for I := 0 to fBlockList.fCount div 2 - 1 do
       begin
           BlockStart := fBlockList.fItems[ I * 2 ];
           CountCurrent := Integer( fBlockList.fItems[ I * 2 + 1 ] );
           for j := 0 to CountCurrent-1 do
           begin
               if  BlockStart^ = DWORD( Value ) then
               begin
                   Result := CountBefore + j;  Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>}
               end;
               inc( BlockStart );
           end;
           inc( CountBefore, CountCurrent );
       end;
     end else
     {$ENDIF}
     begin
         for I := 0 to fCount - 1 do
         begin
             if fItems[ I ] = Value then
             begin
                 Result := I;
                 break;
             end;
         end;
     end;
  {$IFDEF DEBUG_ANY}
  EXCEPT
  END;
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
procedure TList.Insert(Idx: Integer; Value: Pointer);
asm
        PUSH      ECX
        PUSH      EAX
        PUSH      [EAX].fCount
          PUSH      EDX
          CALL      TList.Add   // don't matter what to add
          POP       EDX         // EDX = Idx, Eax = Count-1
        POP       EAX
        SUB       EAX, EDX

        SAL       EAX, 2
        MOV       ECX, EAX      // ECX = (Count - Idx - 1) * 4
        POP       EAX
        MOV       EAX, [EAX].fItems
        LEA       EAX, [EAX + EDX*4]
        JL        @@1
          PUSH      EAX
          LEA       EDX, [EAX + 4]
          CALL      System.Move

          POP       EAX          // EAX = @fItems[ Idx ]
@@1:
        POP       ECX            // ECX = Value
        MOV       [EAX], ECX
end;
{$ELSE PAS_VERSION} //Pascal
procedure TList.Insert(Idx: Integer; Value: Pointer);
{$IFDEF TLIST_FAST}
var i: Integer;
    CountBefore, CountCurrent: Integer;
    BlockStart, NewBlock: Pointer;
{$ENDIF}
begin
   {$IFDEF KOL_ASSERTIONS}
   Assert( (Idx >= 0) and (Idx <= FCount+1), 'List index out of bounds' );
   {$ENDIF KOL_ASSERTIONS}
   {$IFDEF TLIST_FAST}
   if fUseBlocks and (( fBlockList <> nil ) or (fCount >= 256)) then
   begin
     if ( fBlockList = nil ) then
     begin
       fBlockList := NewList;
       fBlockList.fUseBlocks := FALSE;
       fBlockList.Add( fItems );
       fBlockList.Add( Pointer( fCount ) );
       fItems := nil;
     end;
     if fBlockList.fCount = 0 then
     begin
       fNotOptimized := FALSE;
       GetMem( NewBlock, 256 * Sizeof( Pointer ) );
       fBlockList.Add( NewBlock );
       fBlockList.Add( nil );
     end;
     CountBefore := 0;
     i := 0;
     if (fLastKnownBlockIdx > 0) and
        (Idx >= fLastKnownCountBefore) then
     begin
       i := fLastKnownBlockIdx;
       CountBefore := fLastKnownCountBefore;
     end;
     while TRUE {i < fBlockList.fCount div 2} do
     begin
       CountCurrent := Integer( fBlockList.Items[ i * 2 + 1 ] );
       if (Idx >= CountBefore) and
          ((Idx < CountBefore + CountCurrent) or
           (Idx = CountBefore + CountCurrent) and
           (CountCurrent < 256)) then // insert in block i
       begin
         BlockStart := fBlockList.fItems[ i * 2 ];
         if BlockStart = nil then
         begin
           GetMem( BlockStart, 256 * Sizeof( Pointer ) );
           fBlockList.fItems[ i * 2 ] := BlockStart;
         end;
         Idx := Idx - CountBefore;
         if CountCurrent < 256 then
         begin
           if Idx < CountCurrent then
             Move( Pointer( Integer( BlockStart ) + Idx * Sizeof( Pointer ) )^,
                   Pointer( Integer( BlockStart ) + (Idx+1) * Sizeof( Pointer ) )^,
                   (CountCurrent - Idx) * Sizeof( Pointer ) );
           PDWORD( Integer( BlockStart ) + Idx * Sizeof( Pointer ) )^ :=
             DWORD( Value );
           fBlockList.fItems[ i * 2 + 1 ] := Pointer( CountCurrent + 1 );
         end else // new block is created since current block is full 256 items
         begin
           fNotOptimized := TRUE;
           GetMem( NewBlock, 256 * Sizeof( Pointer ) );
           fBlockList.Insert( (i+1)*2, Pointer( 256-Idx ) );
           fBlockList.Insert( (i+1)*2, NewBlock );
           move( Pointer( Integer( BlockStart ) + Idx * Sizeof( Pointer ) )^,
                 NewBlock^, (256 - Idx) * Sizeof( Pointer ) );
           PDWORD( Integer( BlockStart ) + Idx * Sizeof( Pointer ) )^ :=
             DWORD( Value );
           fBlockList.fItems[ i * 2 + 1 ] := Pointer( Idx + 1 );
         end;
         fLastKnownBlockIdx := i;
         fLastKnownCountBefore := CountBefore;
         inc( fCount );
         Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
       end;
       inc( CountBefore, CountCurrent );
       inc( i );
       if i >= fBlockList.fCount div 2 then
       begin
         fBlockList.Add( nil );
         fBlockList.Add( nil );
       end;
     end;
   end else
   {$ENDIF}
   begin
       Add( nil );
       if  fCount > Idx then
           Move( FItems[ Idx ], FItems[ Idx + 1 ], (fCount - Idx - 1) * Sizeof( Pointer ) );
       FItems[ Idx ] := Value;
   end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION} {$DEFINE MoveItem_ASM} {$ENDIF}
{$IFDEF TLIST_FAST}  {$UNDEF  MoveItem_ASM} {$ENDIF}

{$IFDEF MoveItem_ASM}
{$ELSE PAS_VERSION} //Pascal
procedure TList.MoveItem(OldIdx, NewIdx: Integer);
var Item: Pointer;
begin
  if OldIdx = NewIdx then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if NewIdx >= Count then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Item := Items[ OldIdx ];
  Delete( OldIdx );
  Insert( NewIdx, Item );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
function TList.Last: Pointer;
asm     //cmd    //opd
        MOV      ECX, [EAX].fCount
        JECXZ    @@0
        MOV      EAX, [EAX].fItems
        DEC      ECX
        MOV      ECX, [EAX + ECX*4]
@@0:    XCHG     EAX, ECX
end;
{$ELSE PAS_VERSION} //Pascal
function TList.Last: Pointer;
begin
  if   Count = 0 then
       Result := nil
  else Result := Items[ Count-1 ];
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
procedure TList.Swap(Idx1, Idx2: Integer);
asm
        MOV       EAX, [EAX].fItems
          PUSH      dword ptr [EAX + EDX*4]
            PUSH      ECX
            MOV       ECX, [EAX + ECX*4]
            MOV       [EAX + EDX*4], ECX
            POP       ECX
          POP       EDX
        MOV       [EAX + ECX*4], EDX
end;
{$ELSE PAS_VERSION} //Pascal
procedure TList.Swap(Idx1, Idx2: Integer);
var Tmp: DWORD;
    AItem1, AItem2: PDWORD;
begin
  {$IFDEF TLIST_FAST}
  AItem1 := ItemAddress( Idx1 );
  AItem2 := ItemAddress( Idx2 );
  {$ELSE}
  AItem1 := Pointer( Integer( fItems ) + Idx1 * Sizeof( Pointer ) );
  AItem2 := Pointer( Integer( fItems ) + Idx2 * Sizeof( Pointer ) );
  {$ENDIF}
  Tmp := AItem1^;
  AItem1^ := AItem2^;
  AItem2^ := Tmp;
end;
{$ENDIF PAS_VERSION}

procedure TList.SetCount(const Value: Integer);
begin
  if Value >= Count then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fCount := Value;
end;

procedure TList.Assign(SrcList: PList);
{$IFDEF TLIST_FAST}
var i, CountCurrent: Integer;
    SrcBlock, DstBlock: Pointer;
{$ENDIF}
begin
  Clear;
  if SrcList.fCount > 0 then
  begin
    {$IFDEF TLIST_FAST}
    if SrcList.fUseBlocks and ( SrcList.fBlockList <> nil ) then
    begin
      fBlockList := NewList;
      fBlockList.Assign( SrcList.fBlockList );
      for i := 0 to fBlockList.Count div 2 - 1 do
      begin
        SrcBlock := SrcList.fBlockList.fItems[ i*2 ];
        CountCurrent := Integer( fBlockList.fItems[ i*2+1 ] );
        GetMem( DstBlock, 256 * Sizeof( Pointer ) );
        fBlockList.fItems[ i*2 ] := DstBlock;
        move( SrcBlock^, DstBlock^, CountCurrent );
      end;
    end else
    {$ENDIF}
    begin
        Capacity := SrcList.fCount;
        Move( SrcList.FItems[ 0 ], FItems[ 0 ], Sizeof( Pointer ) * SrcList.fCount );
    end;
  end;
  fCount := SrcList.fCount;
end;

{$IFDEF WIN_GDI}

{$UNDEF ASM_LOCAL}
{$IFDEF ASM_noVERSION}
  {$IFNDEF _D2orD3}
  {$DEFINE ASM_LOCAL}
  {$ENDIF}
{$ENDIF}

{$IFDEF ASM_LOCAL} //!!//!!
function CallCtlWndProc( Ctl: PControl; var Msg: TMsg ): Integer;
begin
  Result := Ctl.WndProc( Msg );
end;

{ -- Window procedure -- }
function WndFunc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer )
                                   : Integer; stdcall;
const   size_TMsg = sizeof( TMsg );
asm
        ADD       ESP, -size_TMsg
        MOV       EDX, ESP

        PUSH      ESI
        PUSH      EDI

        MOV       EDI, EDX
        LEA       ESI, [W]

        MOVSD
        MOVSD
        MOVSD
        MOVSD

        MOV       EDI, EDX
        MOV       EAX, [EDI]
        TEST      EAX, EAX
        JZ        @@self_is_nil

        MOV       ECX, [CreatingWindow]
        JECXZ     @@get_self_prop

        MOV       [ECX].TControl.fHandle, EAX

        PUSH      ECX
          PUSH      ECX
          {$IFDEF USE_PROP}
          PUSH      Offset[ID_SELF]
          PUSH      EAX
          CALL      SetProp
          {$ELSE}
          PUSH      GWL_USERDATA
          PUSH      EAX
          CALL      SetWindowLong
          {$ENDIF}

          XOR       EAX, EAX
          MOV       [CreatingWindow], EAX
        POP       EAX                 // EAX = self_
        JMP       @@self_got

@@get_self_prop:
        {$IFDEF USE_PROP}
        PUSH      Offset[ID_SELF]
        PUSH      EAX
        CALL      GetProp
        {$ELSE}
        PUSH      GWL_USERDATA
        PUSH      EAX
        CALL      GetWindowLong
        {$ENDIF}
        TEST      EAX, EAX
        JNZ       @@self_got

@@self_is_nil:
        OR        EAX, [ Applet ]
        JNZ       @@self_got

        POP       EDI
        POP       ESI
        MOV       ESP, EBP
        POP       EBP
        JMP       DefWindowProc

@@self_got:
        MOV       ESI, EAX
        INC       WORD PTR [ESI].TControl.fNestedMsgHandling
        MOV       EDX, EDI
        CALL      CallCtlWndProc
        DEC       WORD PTR [ESI].TControl.fNestedMsgHandling
        JA        @@1
        {$IFDEF   USE_FLAGS}
        TEST      [ESI].TControl.fFlagsG2, (1 shl G2_BeginDestroying)
        JZ        @@1
        {$ELSE}
        CMP       [ESI].TControl.fBeginDestroying, 0
        JZ        @@1
        {$ENDIF}
        CMP       [ESI].TObj.fRefCount, 0
        JNZ       @@1
        CMP       ESI, [Applet]
        JZ        @@1
        XCHG      EAX, ESI
        CALL      TObj.Free
        XCHG      ESI, EAX
@@1:

        POP       EDI
        POP       ESI

        MOV       ESP, EBP
end;
{$ELSE PAS_VERSION} //Pascal
function WndFunc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer )
                                   : Integer; stdcall;
var M: TMsg;
    self_: PControl;
begin
  {$IFDEF INPACKAGE}
  Log( '->WndFunc ' + Int2Hex( Msg, 4 ) + ' (' + Int2Str( Msg ) + ')' );
  TRY
  {$ENDIF INPACKAGE}

   M.hwnd := W;
   M.message := Msg;
   M.wParam := wParam;
   M.lParam := lParam;

  {$IFDEF DEBUG_MONITOR_MESSAGES}
  if  Assigned( OnMonitorMessage ) then
      OnMonitorMessage( M, TRUE );
  {$ENDIF}

   {$IFDEF DEBUG_ENDSESSION}
   if EndSession_Initiated then
   begin
     LogFileOutput( GetStartDir + 'es_debug.txt',
       'HWND:' + Int2Str( W ) + ' MSG:$' + Int2Hex( Msg, 4 ) +
       ' WParam: ' + Int2Str( wParam ) + '($' + Int2Hex( wParam, 8 ) + ')' +
       ' LParam: ' + Int2Str( lParam ) + '($' + Int2Hex( lParam, 8 ) + ')' );
   end;
   {$ENDIF}

   self_ := nil;
   if W <> 0 then
   begin
     if CreatingWindow <> nil then
     begin
       {$IFDEF INPACKAGE}
       Log( '//// CreatingWindow <> nil' );
       {$ENDIF INPACKAGE}
        {$IFDEF DEBUG_CREATEWINDOW}
        LogFileOutput( GetStartDir + 'Session.log',
                       'WndFunc: Creating window = ' + Int2Hex( Integer( CreatingWindow ), 4 ) +
                       ' hwnd=' + Int2Str( M.hwnd ) +
                       ' message=' + Int2Hex( M.message, 4 ) +
                       ' wParam=' + Int2Str( M.wParam ) + '=$' + Int2Hex( M.wParam, 4 ) +
                       ' lParam=' + Int2Str( M.lParam ) + '=$' + Int2Hex( M.lParam, 4 )
                     );
        {$ENDIF DEBUG_CREATEWINDOW}
        self_ := CreatingWindow;
        CreatingWindow.fHandle := W;
        {$IFDEF USE_PROP}
        {$IFDEF INPACKAGE}
        Log( '//// SetProp' );
        {$ENDIF INPACKAGE}
        SetProp( W, ID_SELF, THandle( CreatingWindow ) );
        {$ELSE}
        SetWindowLong( W, GWL_USERDATA, Integer( CreatingWindow ) );
        {$ENDIF}
        CreatingWindow := nil;
     end else
     {$IFDEF USE_PROP}
     self_ := Pointer( GetProp( W, ID_SELF ) );
     {$ELSE}
     self_ := Pointer( GetWindowLong( W, GWL_USERDATA ) );
     {$ENDIF}
   end;

   if  self_ <> nil then
   begin
       {$IFDEF INPACKAGE}
       Log( '//// self_ <> nil, calling self_.WndProc' );
       {$ENDIF INPACKAGE}
       //self_.RefInc;
       //TRY
           Result := self_.WndProc( M );
       //FINALLY
       //    self_.RefDec;
       //END;
   end else
   if   Applet <> nil then
        Result := Applet.WndProc( M )
   else Result := DefWindowProc( W, Msg, wParam, lParam );
   {$IFDEF DEBUG_ENDSESSION}
   if EndSession_Initiated then
   begin
     LogFileOutput( GetStartDir + 'es_debug.txt',
       'HWND:' + Int2Str( W ) + ' MSG:$' + Int2Hex( Msg, 4 ) +
       ' Result: ' + Int2Str( Result ) + '($' + Int2Hex( Result, 8 ) + ')' );
   end;
   {$ENDIF}
  {$IFDEF INPACKAGE}
    LogOK;
  FINALLY
    Log( '<-WndFunc' );
  END;
  {$ENDIF INPACKAGE}
  {$IFDEF DEBUG_MONITOR_MESSAGES}
  if  Assigned( OnMonitorMessage ) then
      OnMonitorMessage( M, FALSE );
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

procedure TList.OptimizeForRead;
{$IFDEF TLIST_FAST}
var i, j, N: Integer;
    NewBlocksList: PList;
    BlockStart: PPointer;
{$ENDIF}
begin
    {$IFDEF TLIST_FAST}
    if  fNotOptimized and fUseBlocks then
    begin
        NewBlocksList := NewList;
        NewBlocksList.UseBlocks := FALSE;
        i := 0;
        while i < Count do
        begin
            N := 256;
            if  N > Count-i then
                N := Count-i;
            GetMem( BlockStart, 256 * Sizeof(Pointer) );
            NewBlocksList.Add( BlockStart );
            NewBlocksList.Add( Pointer(N) );
            for j := i to i+N-1 do
            begin
                BlockStart^ := Items[j];
                inc( BlockStart );
            end;
            inc( i, 256 );
        end;
        N := Count;
        Clear;
        Free_And_Nil( fBlockList );
        fBlockList := NewBlocksList;
        fCount := N;
        fNotOptimized := FALSE;
    end;
    {$ENDIF}
end;

var
  IdleHandlers: PList;
  ProcessIdle: procedure ( Sender: PObj ) = DummyObjProc;

procedure ProcessIdleProc( Sender: PObj );
var
  i: integer;
  m: TMethod;
begin
  if AppletTerminated then exit;  // YS + >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  i := 0;
  with IdleHandlers^ do
    while i < Count do begin
      m.Code:=Items[i];
      Inc(i);
      m.Data:=Items[i];
      Inc(i);
      TOnEvent(m)(Sender);
    end;
end;

function FindIdleHandler( const OnIdle: TOnEvent ): integer;
var
  i: integer;
begin
  i := 0;
  if not AppletTerminated then //+ {Maxim Pushkar}
  with TMethod(OnIdle), IdleHandlers^ do
    while i < Count do begin
      if (Items[i] = Code) and (Items[i + 1] = Data) then
      begin
        Result := i;
        exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      Inc(i, 2);
    end;
  Result := -1;
end;

procedure RegisterIdleHandler( const OnIdle: TOnEvent );
begin
  if IdleHandlers = nil then begin
    IdleHandlers := NewList;
    if Applet <> nil then
      Applet.Add2AutoFree(IdleHandlers);
  end;
  with TMethod(OnIdle) do
  begin
    IdleHandlers.Add(Code);
    IdleHandlers.Add(Data);
  end;
  ProcessIdle := @ProcessIdleProc;
end;

procedure UnRegisterIdleHandler( const OnIdle: TOnEvent );
var
  i: integer;
begin
  i := FindIdleHandler(OnIdle);
  if i <> -1 then
  with IdleHandlers^ do
  begin
    Delete(i);
    Delete(i);
  end;
end;

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
procedure TerminateExecution( var AppletCtl: PControl );
var App: PControl;
    Appalreadyterminated: Boolean;
begin
  Appalreadyterminated := AppletTerminated;
  AppletTerminated := TRUE;
  AppletRunning := FALSE;
  App := Applet;
  Applet := nil;
  if (App <> nil) {and (App.RefCount >= 0)} then
  begin
    App.RefInc;
    if not Appalreadyterminated then
    begin
      App.ProcessMessages;
      App.Perform( WM_CLOSE, 0, 0 );
    end;
    AppletCtl := nil;
    App.Free;
    App.RefDec;
  end;
end;
{$ENDIF PAS_VERSION}

//22{$IFDEF ASM_VERSION}
function CallTControlCreateWindow( Ctl: PControl ): Boolean;
begin
  {$IFDEF SAFE_CODE}
  Result := FALSE;
  TRY
    if Ctl = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    Result := Ctl.CreateWindow;
  EXCEPT
  END;
  {$ELSE}
  Result := Ctl.CreateWindow;
  {$ENDIF}
end;
//22{$ENDIF}
{$ENDIF GDI}
{$ENDIF WIN_GDI}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure Run( var AppletCtl: PControl );
    {$IFDEF PSEUDO_THREADS}
var n: Integer;
    i: Integer;
    T: PThread;
    u: DWORD;
    M: TMsg;
    {$ENDIF}
begin
  if  AppletCtl = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  AppletRunning := True;
  Applet := AppletCtl;
  AppletCtl.CreateWindow; //virtual!!!
  //Applet_Wnd := AppletCtl.Handle;
  while not AppletTerminated do
  begin
    {$IFDEF PSEUDO_THREADS}
    if  MainThread <> nil then
    begin
        while not PeekMessage( M, 0, 0, 0, pm_noremove ) do
        begin
            u := GetTickCount;
            n := 0;
            for i := 1 to MainThread.AllThreads.Count-1 do
            begin
                T := MainThread.AllThreads.Items[ i ];
                if not T.Suspended and not T.Terminated and (T.DoNotWakeUntil < u) then
                begin
                    inc( n );
                    break;
                end;
            end;
            if n = 0 then WaitMessage
            else MainThread.NextThread;
        end;
    end else
        WaitMessage;
    {$ELSE}
    WaitMessage;
    {$ENDIF}
    AppletCtl.ProcessMessages;
    {$IFDEF USE_OnIdle}
    ProcessIdle( AppletCtl );
    {$ENDIF}
  end;
  if  Assigned( AppletCtl ) then
      TerminateExecution( AppletCtl );
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
  PROCEDURE Run( var AppletWnd: PControl );
  BEGIN
    AppletRunning := True;
    Applet := AppletWnd;
    AppletWnd.VisualizyWindow; // for GTK, show all windows having Visible = TRUE, recursively
    gtk_main( );
    IF  AppletWnd <> nil THEN
        //TerminateExecution( AppletWnd );
        Free_And_Nil( AppletWnd );
  END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}
{$IFDEF GDI}
procedure AppletMinimize;
begin
  if Applet = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Applet.Perform( WM_SYSCOMMAND, SC_MINIMIZE, 0 );
end;

procedure AppletHide;
begin
  if Applet = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  AppletMinimize;
  Applet.Hide;
end;

procedure AppletRestore;
begin
  if Applet = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Applet.Show;
  Applet.Perform( WM_SYSCOMMAND, SC_RESTORE, 0 );
end;

function ScreenWidth: Integer;
begin
  Result := GetSystemMetrics( SM_CXSCREEN );
end;

function ScreenHeight: Integer;
begin
  Result := GetSystemMetrics( SM_CYSCREEN );
end;
{$ENDIF GDI}

//22{$IFDEF ASM_VERSION}
//function WndProcAppAsm( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
//22{$ENDIF}
function WndProcAppPas( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function WndProcForm( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function WndProcPaint( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function WndProcGradient( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function WndProcGradientEx( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function WndProcLabelEffect( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function WndProcNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
function WndProcCommonNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;
var fGlobalProcKeybd: function( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean =
    WndProcDummy;

{ -- Graphics support -- }

{$ENDIF WIN_GDI}
function _NewGraphicTool: PGraphicTool;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TGraphicTool';
  {$ENDIF}
end;
{$IFDEF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION PAS_VERSION}
function SimpleGetCtlBrushHandle( Sender: PControl ): HBrush;
{$IFDEF STORE_fTmpBrushColorRGB}{$ELSE}
var tmpRGBColor: TColor;
{$ENDIF}
begin
  if (Sender.fParent <> nil) and (Sender.fColor = Sender.fParent.fColor) then
    Result := SimpleGetCtlBrushHandle( Sender.fParent )
  else
  begin
    {$IFDEF GDI}
    {$IFDEF STORE_fTmpBrushColorRGB}
    if (Sender.fTmpBrush <> 0) and
       (Color2RGB( Sender.fColor ) <> Sender.fTmpBrushColorRGB) then
    begin
      DeleteObject( Sender.fTmpBrush );
      Sender.fTmpBrush := 0;
    end;
    {$ENDIF}
    if Sender.fTmpBrush = 0 then
    begin
      {$IFDEF STORE_fTmpBrushColorRGB}
      Sender.fTmpBrushColorRGB := Color2RGB( Sender.fColor );
      Sender.fTmpBrush := CreateSolidBrush( Sender.fTmpBrushColorRGB );
      {$ELSE}
      tmpRGBColor := Color2RGB( Sender.fColor );
      Sender.fTmpBrush := CreateSolidBrush( tmpRGBColor );
      {$ENDIF}
    end;
    Result := Sender.fTmpBrush;
    {$ELSE} Result := 0;
    {$ENDIF GDI}
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE notASM_VERSION}
function NormalGetCtlBrushHandle( Sender: PControl ): HBrush;
var B: PGraphicTool;
    //P: PControl;
begin
  {$IFDEF GDI}
  B := Sender.Brush;
  //P := Sender.fParent;
  //if  P <> nil then
  if  Sender.fParent <> nil then
      B.fParentGDITool := Sender.fParent.Brush; //P.Brush;
  Result := B.Handle;
  {$ELSE} Result := 0;
  {$ENDIF GDI}
end;
{$ENDIF PAS_VERSION}

function MakeFontHandle( Self_: PGraphicTool ): THandle; forward;
function MakeBrushHandle( Self_: PGraphicTool ): THandle; forward;
function MakePenHandle( Self_: PGraphicTool ): THandle; forward;
function MakeGeometricPenHandle( Self_: PGraphicTool ): THandle; forward;

{$ENDIF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewBrush: PGraphicTool;
begin
  {$IFDEF GDI}
  Global_GetCtlBrushHandle := NormalGetCtlBrushHandle;
  {$ENDIF GDI}
  Result := _NewGraphicTool;
  with Result^ do
  begin
    fNewProc := @ NewBrush;
    fType := gttBrush;
    {$IFDEF GDI}
    fMakeHandleProc := @ MakeBrushHandle;
    {$ENDIF GDI}
    Result.fData.Color := clBtnFace;
    Result.fData.Brush.Style := bsSolid;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewPen: PGraphicTool;
begin
  Result := _NewGraphicTool;
  with Result^ do
  begin
    fNewProc := @ NewPen;
    fType := gttPen;
    {$IFDEF GDI}
    fMakeHandleProc := @ MakePenHandle;
    {$ENDIF GDI}
    fData.Pen.Mode := pmCopy;
  end;
end;
{$ENDIF PAS_VERSION}

var ApplyFont2Wnd_Proc: procedure( _Self: PObj ) = DummyObjProc;
procedure DoApplyFont2Wnd( _Self: PControl ); forward;

const size_FontData = sizeof( Integer {fFontHeight} ) + sizeof( Integer {fFontWidth} ) +
                      sizeof( TFontPitch ) +  sizeof( TFontStyle ) +
                      sizeof( Integer {fFontOrientation} ) +
                      sizeof( Integer {fFontWeight} ) + sizeof( TFontCharset ) +
                      sizeof( TFontQuality );

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewFont: PGraphicTool;
begin
  ApplyFont2Wnd_Proc := @ DoApplyFont2Wnd;
  Result := _NewGraphicTool;
  with Result^ do
  begin
    fNewProc := @ NewFont;
    fType := gttFont;
    {$IFDEF GDI}
    fMakeHandleProc := @ MakeFontHandle;
    fData.Color := DefFontColor;
    Move( DefFont, fData.Font, Sizeof( TGDIFont ) );
    {$ENDIF GDI}
    {$IFDEF GTK}
    fData.Font.Weight := 400;
    {$ENDIF GTK}
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
function Color2RGB( Color: TColor ): TColor;
begin
  if   Color < 0 then
       Result := GetSysColor(Color and $7F)
  else Result := Color;
end;
{$ENDIF PAS_VERSION}

function RGB2BGR( Color: TColor ): TColor;
begin
  Result := ((Color shr 16) or (Color shl 16) or Color and $00FF00)
            and $FFFFFF;
end;

function ColorsMix( Color1, Color2: TColor ): TColor;
{$IFDEF F_P}
begin
  Result := ((Color2RGB( Color1 ) and $FEFEFE) shr 1) +
            ((Color2RGB( Color2 ) and $FEFEFE) shr 1);
end;
{$ELSE DELPHI}
asm
   //PUSH EDX
   CALL Color2Rgb
   //POP  EDX
   XCHG EAX, EDX
   //PUSH EDX
   CALL Color2Rgb
   //POP EDX
   MOV ECX, $0FEFEFE
   AND EAX, ECX
   AND EDX, ECX
   ADD EAX, EDX
   ROR EAX, 1
end;
{$ENDIF F_P/DELPHI}

{$IFDEF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function Color2RGBQuad( Color: TColor ): TRGBQuad;
var C: Integer;
begin
  C := Color2RGB( Color );
  C := ((C shr 16) and $FF)
    or ((C shl 16) and $FF0000)
    or (C and $FF00);
  Result := TRGBQuad( C );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
function Color2Color16( Color: TColor ): WORD;
begin
  Color := Color2RGB( Color );
  Result := (Color shr 19) and $1F or
            (Color shr 5) and $7E0 or
            (Color shl 8) and $F800;
end;
{$ENDIF PAS_VERSION}

function Color2Color15( Color: TColor ): WORD;
begin
  Color := Color2RGB( Color );
  Result := (Color shr 19) and $1F or
            (Color shr 6) and $3E0 or
            (Color shl 7) and $7C00;
end;

{$ENDIF WIN_GDI}
{ TGraphicTool }

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
function TGraphicTool.Assign(Value: PGraphicTool): PGraphicTool;
var _Self: PGraphicTool;
begin
  Result := nil;
  if Value = nil then
  begin
    {$IFDEF OLD_REFCOUNT}
    if @Self <> nil then
       DoDestroy;
    {$ELSE}
    Free;
    {$ENDIF}
    Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  _Self := @Self;
  if _Self = nil then
    _Self := Value.fNewProc();
  Result := _Self;
  if _Self = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  // to avoid infinite loop when assigning to itself
  {$IFDEF GDI}
  if _Self.fHandle <> 0 then
     if Value.fHandle = _Self.fHandle then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$ENDIF GDI}
  _Self.Changed; // to destroy handle if allocated and release it from the canvas (if any uses it)
  {$IFDEF KOL_ASSERTIONS}
  Assert( Value.fType = _Self.fType, 'Attempt to assign to different GDI tool type' );
  {$ENDIF KOL_ASSERTIONS}
  Move( Value.fData, _Self.fData, Sizeof( fData ) );
  _Self.Changed; // to inform owner control, that its tool (font, brush) changed
end;
{$ENDIF PAS_VERSION}
{$IFDEF WIN_GDI}

procedure TGraphicTool.AssignHandle(NewHandle: THANDLE);
begin
  if fHandle <> 0 then                   //
    DeleteObject( fHandle );             //
  fHandle := NewHandle;
  GetObject( fHandle, Sizeof( TGDIFont ), @ fData.Font );
  Changed;
end;

{$ENDIF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TGraphicTool.Changed;
{$IFDEF GDI} var H: THandle; {$ENDIF GDI}
begin
   {$IFDEF GDI}
   H := 0;
   if fHandle <> 0 then
   begin
     H := fHandle;
     fHandle := 0;
   end;
   ////////////////////////////////
   if  Assigned( TMethod( fOnGTChange ).Data ) then
       fOnGTChange( @Self );
   ////////////////////////////////
   if H <> 0 then
   begin
     DeleteObject( H );
      {$IFDEF DEBUG_GDIOBJECTS}
      case fType of
      gttBrush:  Dec( BrushCount );
      gttFont:   Dec( FontCount );
      gttPen:    Dec( PenCount );
      end;
      {$ENDIF}
   end;
   {$ENDIF GDI}
   {$IFDEF GTK}
   IF  Assigned( fPangoFontDesc ) THEN
   BEGIN
       pango_font_description_free( fPangoFontDesc );
       fPangoFontDesc := nil;
   END;
   /////////////////////////////////
   IF  Assigned( fOnGTChange ) THEN
   /////////////////////////////////
       fOnGTChange( @Self );
   {$ENDIF GTK}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TGraphicTool.Destroy;
begin
  {$IFDEF GDI}
  case fType of
  gttBrush: if fData.Brush.Bitmap <> 0 then
               DeleteObject( fData.Brush.Bitmap );
  gttPen:   if fData.Pen.BrushBitmap <> 0 then
               DeleteObject( fData.Pen.BrushBitmap )
  end;
  if fHandle <> 0 then
  begin
     DeleteObject( fHandle );
     {$IFDEF DEBUG_GDIOBJECTS}
     case fType of
     gttPen:    Dec( PenCount );
     gttBrush:  Dec( BrushCount );
     gttFont:   Dec( FontCount );
     end;
     {$ENDIF}
     //fHandle := 0; Why to do this? It is now destroying!
  end;
  {$ENDIF GDI}
  inherited;
end;
{$ENDIF PAS_VERSION}

{$IFDEF WIN_GDI}
function TGraphicTool.HandleAllocated: Boolean;
begin
  Result := fHandle <> 0;
end;

{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION PAS_VERSION}
function TGraphicTool.ReleaseHandle: THANDLE;
begin
    Changed;
    Result := fHandle;
    fHandle := 0;
end;
{$ENDIF PAS_VERSION}

{$ENDIF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TGraphicTool.SetInt( const Index: Integer; Value: Integer );
var Where: PInteger;
begin
  Where := Pointer( Integer( @ fData ) + Index );
  if Where^ = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Where^ := Value;
  Changed;
end;
{$ENDIF PAS_VERSION}

function TGraphicTool.GetInt(const Index: Integer): Integer;
var Where: PInteger;
begin
  Where := Pointer( Integer( @ fData ) + Index );
  Result := Where^;
end;
{$IFDEF WIN_GDI}

{$ENDIF WIN_GDI}
procedure TGraphicTool.SetColor( Value: TColor );
begin
  SetInt( go_Color, Value );
  fColorRGB := Color2RGB( Value );
end;
{$IFDEF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TGraphicTool.IsFontTrueType: Boolean;
var OldFont: HFont;
    DC: HDC;
begin
  Result := False;
  if GetHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  DC := GetDC( 0 );
  OldFont := SelectObject( DC, fHandle );
  if GetFontData( DC, 0, 0, nil, 0 ) <> GDI_ERROR then
     Result := True;
  SelectObject( DC, OldFont );
  ReleaseDC( 0, DC );
end;
{$ENDIF PAS_VERSION}

function TGraphicTool.GetBrushBitmap: HBitmap;
begin
  Result := fData.Brush.Bitmap; // for BCB only
end;

procedure TGraphicTool.SetBrushBitmap(const Value: HBitmap);
begin
  if fData.Brush.Bitmap = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if fData.Brush.Bitmap <> 0 then
  begin
    Changed; // !!!
    DeleteObject( fData.Brush.Bitmap );
  end;
  fData.Brush.Bitmap := Value;
  Changed;
end;

function TGraphicTool.GetBrushStyle: TBrushStyle;
begin
  Result := fData.Brush.Style; // for BCB only
end;

{$ENDIF WIN_GDI}
procedure TGraphicTool.SetBrushStyle(const Value: TBrushStyle);
begin
  if fData.Brush.Style = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fData.Brush.Style := Value;
  Changed;
end;
{$IFDEF WIN_GDI}

function TGraphicTool.GetFontCharset: TFontCharset;
begin
  Result := fData.Font.CharSet; // for BCB only
end;

procedure TGraphicTool.SetFontCharset(const Value: TFontCharset);
begin
  if fData.Font.Charset = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fData.Font.Charset := Value;
  Changed;
end;

function TGraphicTool.GetFontQuality: TFontQuality;
begin
  Result := fData.Font.Quality; // for BCB only
end;

procedure TGraphicTool.SetFontQuality(const Value: TFontQuality);
begin
  if fData.Font.Quality = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fData.Font.Quality := Value;
  Changed;
end;
{$ENDIF WIN_GDI}

function TGraphicTool.GetFontName: KOLString;
begin
  Result := fData.Font.Name;
  {$IFDEF GTK}
  IF  Result = '' THEN
      Result := 'Sans Serif';
  {$ENDIF GTK}
end;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION}
procedure TGraphicTool.SetFontName(const Value: KOLString);
begin
  if KOLString(fData.Font.Name) = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  //FillChar( fData.Font.Name[ 0 ], LF_FACESIZE, #0 );
  //ZeroMemory( @fData.Font.Name[ 0 ], LF_FACESIZE );
  {$IFDEF UNICODE_CTRLS} WStrLCopy {$ELSE} StrLCopy {$ENDIF}
  ( PKOLChar(@fData.Font.Name[0]), PKOLChar( Value ), Length(Value) * SizeOf(KOLChar) {LF_FACESIZE} );
  Changed;
end;
{$ENDIF PAS_VERSION}

{$IFDEF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TextAreaEx( Sender: PCanvas; var Sz : TSize; var Pt : TPoint );
var Orient : Integer;
    Pts : array[ 1..4 ] of TPoint;
    MinX, MinY, I : Integer;
    A : Double;
begin
   if not Sender.Font.IsFontTrueType then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   Orient := Sender.Font.FontOrientation;
   Pt.x := 0; Pt.y := 0;
   if Orient = 0 then
      Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   A := Orient / 1800.0 * PI;
   Pts[ 1 ] := Pt;
   Pts[ 2 ].x := Round( Sz.cx * cos( A ) );
   Pts[ 2 ].y := - Round( Sz.cx * sin( A ) );
   Pts[ 4 ].x := - Round( Sz.cy * cos( A + PI / 2 ) );
   Pts[ 4 ].y := Round( Sz.cy * sin( A + PI / 2 ) );
   Pts[ 3 ].x := Pts[ 2 ].x + Pts[ 4 ].x;
   Pts[ 3 ].y := Pts[ 2 ].y + Pts[ 4 ].y;
   MinX := 0; MinY := 0;
   for I := 2 to 4 do
   begin
      if Pts[ I ].x < MinX then
         MinX := Pts[ I ].x;
      if Pts[ I ].y < MinY then
         MinY := Pts[ I ].y;
   end;
   Sz.cx := 0;
   Sz.cy := 0;
   for I := 1 to 4 do
   begin
      Pts[ I ].x := Pts[ I ].x - MinX;
      Pts[ I ].y := Pts[ I ].y - MinY;
      if Pts[ I ].x > Sz.cx then
         Sz.cx := Pts[ I ].x;
      if Pts[ I ].y > Sz.cy then
         Sz.cy := Pts[ I ].y;
   end;
   Pt := Pts[ 1 ];
end;
{$ENDIF PAS_VERSION}

function TGraphicTool.GetFontOrientation: Integer;
begin
  Result := fData.Font.Orientation; // for BCB only
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TGraphicTool.SetFontOrientation(Value: Integer);
begin
  GlobalGraphics_UseFontOrient := True;
  TOnTextArea( GlobalCanvas_OnTextArea ) := TextAreaEx;
  Value := Value mod 3600; // -3599..+3599
  SetInt( go_FontOrientation, Value );
  SetInt( go_FontEscapement, Value );
end;
{$ENDIF PAS_VERSION}

function TGraphicTool.GetFontPitch: TFontPitch;
begin
  Result := fData.Font.Pitch; // for BCB only
end;

procedure TGraphicTool.SetFontPitch(const Value: TFontPitch);
begin
  if fData.Font.Pitch = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fData.Font.Pitch := Value;
  Changed;
end;
{$ENDIF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TGraphicTool.GetFontStyle: TFontStyle;
type PFontStyle = ^TFontStyle;
begin
  Result := [ ];
  if fData.Font.Weight >= 700 then Result := [ fsBold ];
  if fData.Font.Italic        then include( Result, fsItalic );
  if fData.Font.Underline     then include( Result, fsUnderline );
  if fData.Font.StrikeOut     then include( Result, fsStrikeOut );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TGraphicTool.SetFontStyle(const Value: TFontStyle);
begin
  if FontStyle = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if  fsBold in Value then
  begin
      if fData.Font.Weight < 700 then
        fData.Font.Weight := 700;
  end else
  begin
      if fData.Font.Weight >= 700 then
        fData.Font.Weight := 0;
  end;
  fData.Font.Italic := fsItalic in Value;
  fData.Font.Underline := fsUnderline in Value;
  fData.Font.StrikeOut := fsStrikeOut in Value;
  Changed;
end;
{$ENDIF PAS_VERSION}

{$IFDEF WIN_GDI}
function TGraphicTool.GetPenMode: TPenMode;
begin
  Result := fData.Pen.Mode; // for BCB only
end;

procedure TGraphicTool.SetPenMode(const Value: TPenMode);
begin
  if fData.Pen.Mode = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fData.Pen.Mode := Value;
  Changed;
end;

function TGraphicTool.GetPenStyle: TPenStyle;
begin
  Result := fData.Pen.Style; // for BCB only
end;

procedure TGraphicTool.SetPenStyle(const Value: TPenStyle);
begin
  if fData.Pen.Style = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fData.Pen.Style := Value;
  Changed;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TGraphicTool.GetHandle: THandle;
begin
  Result := fHandle;
  if Result <> 0 then
  begin
    if Color2RGB( fData.Color ) <> fColorRGB then
    begin
      DeleteObject( ReleaseHandle );
      Result := 0;
    end;
  end;
  if Result = 0 then
  begin
    if  ( fParentGDITool <> nil ) then
    begin
      if CompareMem( @ fData, @ fParentGDITool.fData, Sizeof( fData ) ) then
      begin
        Result := fParentGDITool.Handle;
        Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
    end;
    fColorRGB := Color2RGB( fData.Color );
    fMakeHandleProc( @Self );
    Result := fHandle;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function MakeBrushHandle( Self_: PGraphicTool ): THandle;
var
  LogBrush: TLogBrush;
begin
  if Self_.fHandle = 0 then
  begin
     LogBrush.lbColor := Color2RGB( Self_.fData.Color );
     if  Self_.fData.Brush.Bitmap <> 0 then
     begin
         LogBrush.lbStyle := BS_PATTERN;
         LogBrush.lbHatch := Self_.fData.Brush.Bitmap;
     end else
     begin
         LogBrush.lbHatch := 0;
         case Self_.fData.Brush.Style of
           bsSolid: LogBrush.lbStyle := BS_SOLID;
           bsClear: LogBrush.lbStyle := BS_NULL;
         else LogBrush.lbStyle := BS_HATCHED;
              LogBrush.lbHatch := Ord(Self_.fData.Brush.Style)-Ord(bsHorizontal);
              LogBrush.lbColor := Color2RGB( Self_.fData.Brush.LineColor );
         end;
     end;
     Self_.fHandle := CreateBrushIndirect(LogBrush);
     {$IFDEF DEBUG_GDIOBJECTS}
     if   Self_.fHandle <> 0 then
          Inc( BrushCount )
     else ShowMessage( 'Could not create brush, error ' + Int2Str( GetLastError ) +
                    ': ' + SysErrorMessage( GetLastError ) );
     {$ENDIF}
  end;
  Result := Self_.fHandle;
end;
{$ENDIF PAS_VERSION}

{$UNDEF ASM_LOCAL}
{$IFNDEF UNICODE_CTRLS}
  {$IFDEF ASM_VERSION}
    {$IFNDEF AUTO_REPLACE_CLEARTYPE}
      {$DEFINE ASM_LOCAL}
    {$ENDIF  AUTO_REPLACE_CLEARTYPE}
  {$ENDIF PAS_VERSION}
{$ENDIF}

{$IFDEF ASM_LOCAL}
function MakeFontHandle( Self_: PGraphicTool ): THandle;
asm
         XCHG   EDX, EAX
         MOV    EAX, [EDX].TGraphicTool.fHandle
         TEST   EAX, EAX
         JNZ    @@exit
         PUSH   EDX
         LEA    ECX, [EDX].TGraphicTool.fData.Font
         PUSH   ECX
         CALL   CreateFontIndirect
         POP    EDX
         MOV    [EDX].TGraphicTool.fHandle, EAX
@@exit:
end;
{$ELSE PAS_VERSION} //Pascal
function MakeFontHandle( Self_: PGraphicTool ): THandle;
{$IFDEF AUTO_REPLACE_CLEARTYPE}
var LF: TLogFont;
{$ENDIF}
begin
  with Self_^ do
  begin
    if fHandle = 0 then
    begin
      {$IFDEF AUTO_REPLACE_CLEARTYPE}
      Move( fData.Font, LF, Sizeof( LF ) );
      if WinVer < wvXP then
      begin
        if LF.lfQuality > ANTIALIASED_QUALITY then
          LF.lfQuality := ANTIALIASED_QUALITY;
      end;
      fHandle := CreateFontIndirect( LF );
      {$ELSE}
      fHandle := CreateFontIndirect( PLogFont( @ fData.Font )^ );
      {$ENDIF}
      {$IFDEF DEBUG_GDIOBJECTS}
      Inc( FontCount );
      {$ENDIF}
    end;
    Result := fHandle;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function MakePenHandle( Self_: PGraphicTool ): THandle;
var
  LogPen: TLogPen;
begin
  with Self_^ do
  begin
    //GlobalGraphics_OnObjectCreating( @Self );
    if fHandle = 0 then
    with LogPen do
    begin
      lopnStyle := Byte( fData.Pen.Style );
      lopnWidth.X := fData.Pen.Width;
      lopnColor := Color2RGB( fData.Color );
      fHandle := CreatePenIndirect( LogPen );
      {$IFDEF DEBUG_GDIOBJECTS}
      Inc( PenCount );
      {$ENDIF}
    end;
    //GlobalGraphics_OnObjectCreated( @Self );
    Result := fHandle;
  end;
end;
{$ENDIF PAS_VERSION}

function TGraphicTool.GetGeometricPen: Boolean;
begin
  Result := fData.Pen.Geometric; // for BCB only
end;

procedure TGraphicTool.SetGeometricPen(const Value: Boolean);
begin
  if fData.Pen.Geometric = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fData.Pen.Geometric := Value;
  fMakeHandleProc := MakeGeometricPenHandle;
  Changed;
end;

function TGraphicTool.GetPenEndCap: TPenEndCap;
begin
  Result := fData.Pen.EndCap; // for BCB only
end;

procedure TGraphicTool.SetPenEndCap(const Value: TPenEndCap);
begin
  if fData.Pen.EndCap = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fData.Pen.EndCap := Value;
  Changed;
end;

function TGraphicTool.GetPenJoin: TPenJoin;
begin
  Result := fData.Pen.Join; // for BCB only
end;

procedure TGraphicTool.SetPenJoin(const Value: TPenJoin);
begin
  if fData.Pen.Join = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fData.Pen.Join := Value;
  Changed;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function MakeGeometricPenHandle( Self_: PGraphicTool ): THandle;
const
  PenStyles: array[ TPenStyle ] of Word =
    (PS_SOLID, PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT, PS_NULL,
     PS_INSIDEFRAME);
  PenEndCapStyles: array[ TPenEndCap ] of Word =
    (PS_ENDCAP_ROUND, PS_ENDCAP_SQUARE, PS_ENDCAP_FLAT);
  PenJoinStyles: array[ TPenJoin ] of Word =
    (PS_JOIN_ROUND, PS_JOIN_BEVEL, PS_JOIN_MITER );
var
  LogBrush: TLogBrush;
begin
  if Self_.fHandle = 0 then
  with Self_^, LogBrush do
  begin
      lbColor := Color2RGB( fData.Color );
      lbHatch := 0;
      if fData.Pen.BrushBitmap <> 0 then
      begin
        lbStyle := BS_PATTERN;
        lbHatch := fData.Pen.BrushBitmap;
      end else
      case fData.Pen.BrushStyle of
      bsSolid: lbStyle := BS_SOLID;
      bsClear: lbStyle := BS_NULL;
      else lbStyle := BS_HATCHED;
           case fData.Pen.BrushStyle of
           bsHorizontal: lbHatch := HS_HORIZONTAL;
           bsVertical:   lbHatch := HS_VERTICAL;
           bsFDiagonal:  lbHatch := HS_FDIAGONAL;
           bsBDiagonal:  lbHatch := HS_BDIAGONAL;
           bsCross:      lbHatch := HS_CROSS;
           bsDiagCross:  lbHatch := HS_DIAGCROSS;
           end;
      end;
  end;
  Self_.fHandle := ExtCreatePen( PS_GEOMETRIC or Byte( Self_.fData.Pen.Style ) or
                           PenEndCapStyles[ Self_.fData.Pen.EndCap ] or
                           PenJoinStyles[ Self_.fData.Pen.Join ],
             Self_.fData.Pen.Width, LogBrush, 0, nil );
  {Assert( Self_.fHandle <> 0, 'Error ' + Int2Str( GetLastError ) +
                              ': ' + SysErrorMessage( GetLastError ) );}
  {$IFDEF DEBUG_GDIOBJECTS}
  Inc( PenCount );
  {$ENDIF}
  Result := Self_.fHandle;
end;
{$ENDIF PAS_VERSION}

{$ENDIF WIN_GDI}
function TGraphicTool.GetFontWeight: Integer;
begin
  Result := fData.Font.Weight; // for BCB only
end;

procedure TGraphicTool.SetFontWeight(const Value: Integer);
begin
  if fData.Font.Weight = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fData.Font.Weight := Value;
  Changed;
end;
{$IFDEF WIN_GDI}

procedure TGraphicTool.SetLogFontStruct(const Value: TLogFont);
begin
  if  CompareMem(@fData.Font, @Value, SizeOf(TLogFont)) then Exit; {>>>>>>>>>>>}
  Move(Value, fData.Font, SizeOF(TLogFont));
  Changed;
end;

function TGraphicTool.GetLogFontStruct: TLogFont;
begin
  Move(fData.Font, Result, SizeOf(TLogFont));
end;
{$ENDIF WIN_GDI}

{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION TGraphicTool.GetPangoFontDesc: PPangoFontDescription;
VAR s: AnsiString;
    i: Integer;
    FUNCTION IfThen( cond: Boolean; CONST s: AnsiString ): AnsiString;
    BEGIN
      Result := '';
      IF cond THEN Result := s;
    END;
{const Weights: array[0..9] of String = ( 'Ultralight',
   'Ultralight', 'Ultralight',
   'Light', 'Normal', 'Normal', 'Normal',
   'Bold', 'Ultrabold', 'Heavy' );}
BEGIN
  IF  NOT Assigned( fPangoFontDesc ) THEN
  BEGIN
      s := FontName; { + ' ' +
        IfThen( FontWeight <> 400, Weights[ FontWeight div 100 ] + ' ' ) +
        IfThen( fsItalic in FontStyle, 'Italic ' ) {+
        Int2Str( FontHeight )};
      fPangoFontDesc := pango_font_description_from_string( PAnsiChar( s ) );
      i := FontHeight;
      IF  i > 0 THEN
          pango_font_description_set_absolute_size( fPangoFontDesc, i * PANGO_SCALE );
      //i := pango_font_description_get_size( fPangoFontDesc );
      i := PANGO_STYLE_NORMAL;
      IF  fsItalic IN FontStyle THEN i := PANGO_STYLE_ITALIC;
      pango_font_description_set_style( fPangoFontDesc, i );
      pango_font_description_set_weight( fPangoFontDesc, FontWeight );
  END;
  Result := fPangoFontDesc;
END;

FUNCTION Color2GDKColor( Color: TColor ): TGdkColor;
BEGIN
  Color := Color2RGB( Color );
  Result.pixel := 0;
  Result.red   := (Color and $FF) shl 8;
  Result.green := Color and $FF00;
  Result.blue  := (Color shr 8) and $FF00;
END;
{$ENDIF GTK}
{$ENDIF _X_}
{$IFDEF WIN_GDI}

{ TCanvas }

type
  TStock = Packed Record
    StockPen: HPEN;
    StockBrush: HBRUSH;
    StockFont: HFONT;
  end;

var
  Stock: TStock;

destructor TCanvas.Destroy;
begin
  Handle := 0;
  fPen.Free;
  fBrush.Free;
  fFont.Free;
  inherited;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TCanvas.Assign(SrcCanvas: PCanvas): Boolean;
begin
  fFont := fFont.Assign( SrcCanvas.fFont );
  fBrush := fBrush.Assign( SrcCanvas.fBrush );
  fPen := fPen.Assign( SrcCanvas.fPen );
  AssignChangeEvents;
  Result := (fFont <> nil) or (fBrush <> nil) or (fPen <> nil);
  if (SrcCanvas.PenPos.x <> PenPos.x) or (SrcCanvas.PenPos.y <> PenPos.y) then
  begin
     Result := True;
     PenPos := SrcCanvas.PenPos;
  end;
  if SrcCanvas.ModeCopy <> ModeCopy then
  begin
     Result := True;
     ModeCopy := SrcCanvas.ModeCopy;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.CreateBrush;
begin
  if assigned( fBrush ) then
  begin
    SelectObject( GetHandle, fBrush.Handle );
    AssignChangeEvents;
    if  fBrush.fData.Brush.Style = bsSolid then
    begin
        SetBkColor( fHandle, Color2RGB( fBrush.fData.Color ) );
        SetBkMode( fHandle, OPAQUE );
    end else
    begin
        { Win95 doesn't draw brush hatches if bkcolor = brush color }
        { Since bkmode is transparent, nothing should use bkcolor anyway }
        SetBkColor( fHandle, not Color2RGB( fBrush.fData.Color ) );
        SetBkMode( fHandle, TRANSPARENT );
    end;
  end else
  if  Assigned( fOwnerControl ) then
  begin
      SetBkColor( GetHandle, Color2RGB( PControl( fOwnerControl ).fColor ) );
      SetBkMode( fHandle, OPAQUE );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.CreateFont;
begin
  if  ( fFont <> nil ) then
  begin
      SelectObject( GetHandle, fFont.Handle );
      SetTextColor( fHandle, Color2RGB( fFont.fData.Color ) );
      AssignChangeEvents;
  end else
  if  ( fOwnerControl <> nil ) then
  begin
      SetTextColor( fHandle,
          Color2RGB( PControl( fOwnerControl ).fTextColor ) );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.CreatePen;
begin
  if  ( fPen <> nil ) then
  begin
      SelectObject( GetHandle, fPen.Handle );
      SetROP2( fHandle, Ord( fPen.fData.Pen.Mode ) + 1 );
      AssignChangeEvents;
  end;
end;
{$ENDIF PAS_VERSION}

function TCanvas.GetPixels(X, Y: Integer): TColor;
begin
  RequiredState( HandleValid );
  Result := Windows.GetPixel(FHandle, X, Y);
end;

procedure TCanvas.SetPixels(X, Y: Integer; const Value: TColor);
begin
  Changing;
  RequiredState( HandleValid );
  Windows.SetPixel(FHandle, X, Y, Color2RGB( Value ));
end;

procedure TCanvas.OffsetAndRotate(Xoff, Yoff: Integer; Angle: Double);
var F: TXForm;
begin
    SetGraphicsMode( fHandle, GM_ADVANCED );
    F.eM11 := cos( Angle );
    F.eM12 := sin( Angle );
    F.eM21 := -F.eM12;
    F.eM22 := F.eM11;
    F.eDx := Xoff;
    F.eDy := Yoff;
    SetWorldTransform( fHandle, F );
    if  (Angle = 0) and (Xoff = 0) and (Yoff = 0) then
        SetGraphicsMode( fHandle, GM_COMPATIBLE );
end;

{$ENDIF WIN_GDI}

{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TCanvas.SaveState;
BEGIN
  gdk_gc_get_values( fHandle, @ fSavedState );
END;

PROCEDURE TCanvas.RestoreState;
VAR mask: DWORD;
BEGIN
  mask := $1FFFF;
  if fSavedState.font = nil then mask := mask and not GDK_GC_FONT;
  if fSavedState.stipple = nil then mask := mask and not GDK_GC_STIPPLE;
  gdk_gc_set_values( fHandle, @ fSavedState, mask );
  DeselectHandles;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.DeselectHandles;
begin
   if  (fHandle <> 0) and
       LongBool(fState and (PenValid or BrushValid or FontValid)) then
   with Stock do
   begin
       if  StockPen = 0 then
       begin
           StockPen := GetStockObject(BLACK_PEN);
           StockBrush := GetStockObject(HOLLOW_BRUSH);
           StockFont := GetStockObject(SYSTEM_FONT);
       end;
       SelectObject( fHandle, StockPen );
       SelectObject( fHandle, StockBrush );
       SelectObject( fHandle, StockFont );
       fState := fState and not( PenValid or BrushValid or FontValid );
   end;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TCanvas.DeselectHandles;
BEGIN
  IF  ( fFont <> nil ) AND ( fFont.fPangoFontDesc <> nil ) THEN
  BEGIN
      pango_font_description_free( fFont.fPangoFontDesc );
      fFont.fPangoFontDesc := nil;
  END;
  fState := fState and not( PenValid or BrushValid or FontValid );
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TCanvas.RequiredState(ReqState: DWORD): HDC; stdcall;
var
  NeededState: Byte;
begin
  if Boolean(ReqState and ChangingCanvas) then
     Changing;
  ReqState := ReqState and 15;
  NeededState := Byte( ReqState ) and not fState;
  Result := 0;
    if Boolean(ReqState and HandleValid) then
    begin
      if GetHandle = 0 then Exit; // Important! {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  if NeededState <> 0 then
  begin
    if Boolean( NeededState and FontValid ) then
       CreateFont;
    if Boolean( NeededState and PenValid ) then
    begin
      CreatePen;
      if  ( fPen <> nil ) then
      if  fPen.fData.Pen.Style in [psDash, psDot, psDashDot, psDashDotDot] then
        NeededState := NeededState or BrushValid;
    end;
    if Boolean( NeededState and BrushValid ) then
       CreateBrush;
    fState := fState or NeededState;
  end;
  Result := fHandle;
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN_GDI}

{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TCanvas.ForeBack(fg_color, bk_color: TColor); // install colors just before drawing
BEGIN
  fg_color := RGB2BGR( Color2RGB( fg_color ) );
  bk_color := RGB2BGR( Color2RGB( bk_color ) );
  gdk_rgb_gc_set_foreground( fHandle, fg_color );
  gdk_rgb_gc_set_background( fHandle, bk_color );
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.SetHandle(Value: HDC);
{$IFDEF F_P}
var Ptr1: Pointer;
{$ENDIF F_P}
begin
  if  fHandle = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if  fHandle <> 0 then
  begin
      DeselectHandles;
      {$IFDEF GDI}
      if (fOwnerControl = nil) or
         (PControl(fOwnerControl).fPaintDC <> fHandle) then
      begin
            {$IFDEF F_P}
              Ptr1 := Self;
              asm
                  MOV  EAX, [Ptr1]
                  MOV  EAX, [EAX].TCanvas.fOnGetHandle
                  MOV  [Ptr1], EAX
              end [ 'EAX' ];
              if Ptr1 = @ TControl.DC2Canvas then
            {$ELSE DELPHI}
            //////////////////// SLAG
              if  TMethod(fOnGetHandle).Code =
                  @TControl.Dc2Canvas then
            {$ENDIF F_P/DELPHI}
                  ReleaseDC( PControl(fOwnerControl).Handle, fHandle )
              else
              if  not (fIsAlienDC or fIsPaintDC) then
                  DeleteDC( fHandle );
            ////////////////////
      end;
      {$ENDIF GDI}
      fHandle := 0;
      fIsPaintDC := False;
      fState := fState and not HandleValid;
  end;
  if Value <> 0 then
  begin
    fState := fState or HandleValid;
    fHandle := Value;
    SetPenPos( fPenPos );
  end;
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.SetPenPos(const Value: TPoint);
begin
  fPenPos := Value;
  {$IFDEF GDI}
  MoveTo( Value.x, Value.y );
  {$ENDIF GDI}
end;
{$ENDIF PAS_VERSION}
{$IFDEF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.Changing;
begin
  if  Assigned( fOnChangeCanvas ) then
      fOnChangeCanvas( @Self );
end;
{$ENDIF PAS_VERSION}

{$ENDIF WIN_GDI}
{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall;
begin
  RequiredState( HandleValid or PenValid or ChangingCanvas );
  Windows.Arc(FHandle, X1, Y1, X2, Y2, X3, Y3, X4, Y4);
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); STDCALL;
VAR C: TPoint;
    angle1, angle2: Integer;
    A1, A2: Double;
BEGIN
  ////RequiredState( {HandleValid or} PenValid or ChangingCanvas );
  C := MakePoint( (X1 + X2) div 2, (Y1 + Y2) div 2 );
  {$IFDEF NOT_USE_EXCEPTION}
    A1 := ArcTan2( Y3-C.Y, X3-C.X );
    A2 := ArcTan2( Y4-C.Y, X4-C.X );
  {$ELSE USE_EXCEPTION}
  TRY
    A1 := ArcTan2( Y3-C.Y, X3-C.X );
  EXCEPT
    A1 := 0;
  END;
  TRY
    A2 := ArcTan2( Y4-C.Y, X4-C.X );
  EXCEPT
    A2 := 0;
  END;
  {$ENDIF NOT_USE_EXCEPTION}
  angle1 := -Round(A1 * 180 * 64 / PI);
  angle2 := -Round(A2 * 180 * 64 / PI);
  IF  Brush.BrushStyle <> bsClear THEN
  BEGIN
      ForeBack( Brush.Color, Brush.Color );
      gdk_draw_arc( fDrawable, fHandle, 1, X1, Y1, X2-X1, Y2-Y1, angle1, angle2 );
  END;
  ForeBack( Pen.Color, Brush.Color );
  gdk_draw_arc( fDrawable, fHandle, 0, X1, Y1, X2-X1, Y2-Y1, angle1, angle2 );
END;
{$ENDIF GTK}
{$ENDIF _X_}
{$IFDEF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall;
begin
  RequiredState( HandleValid or PenValid or BrushValid or ChangingCanvas );
  Windows.Chord(FHandle, X1, Y1, X2, Y2, X3, Y3, X4, Y4);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.CopyRect(const DstRect: TRect; SrcCanvas: PCanvas;
  const SrcRect: TRect);
begin
  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
  SrcCanvas.RequiredState( HandleValid or BrushValid );
  StretchBlt( fHandle, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left,
    DstRect.Bottom - DstRect.Top, SrcCanvas.Handle, SrcRect.Left, SrcRect.Top,
    SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top, ModeCopy);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.DrawFocusRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);
begin
  RequiredState( HandleValid or BrushValid or FontValid or ChangingCanvas );
  Windows.DrawFocusRect(FHandle, Rect);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.Ellipse(X1, Y1, X2, Y2: Integer);
begin
  RequiredState( HandleValid or PenValid or BrushValid or ChangingCanvas );
  Windows.Ellipse(FHandle, X1, Y1, X2, Y2);
end;
{$ENDIF PAS_VERSION}

{$ENDIF WIN_GDI}
{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.FillRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);
var Br: HBrush;
begin
  RequiredState( HandleValid or BrushValid or ChangingCanvas );
  if  fBrush <> nil then
  begin
      Windows.FillRect(fHandle, Rect, fBrush.Handle);
  end else
  if ( fOwnerControl <> nil ) then
  begin
      {$IFDEF GDI}
      if  ( PControl( fOwnerControl ).fBrush <> nil ) then
          Windows.FillRect( fHandle, Rect, PControl( fOwnerControl ).fBrush.Handle )
      else
      begin
          Br := CreateSolidBrush( Color2RGB(PControl(fOwnerControl).fColor) );
          Windows.FillRect(fHandle, Rect, Br );
          DeleteObject( Br );
      end;
      {$ENDIF GDI}
  end else
      Windows.FillRect(fHandle, Rect, HBrush(COLOR_WINDOW + 1) );
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TCanvas.FillRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);
BEGIN
  if (fBrush <> nil) and (fBrush.BrushStyle = bsClear) then
     Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  ForeBack( Brush.Color, Brush.Color );
  gdk_draw_rectangle( fDrawable, fHandle, 1, Rect.Left, Rect.Top,
    Rect.Right-Rect.Left, Rect.Bottom-Rect.Top );
END;
{$ENDIF GTK}
{$ENDIF _X_}
{$IFDEF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.FillRgn(const Rgn: HRgn);
var Br : HBrush;
begin
  RequiredState( HandleValid or BrushValid or ChangingCanvas );
  if ( fBrush <> nil ) then
    Windows.FillRgn(FHandle, Rgn, fBrush.Handle )
  else if ( fOwnerControl <> nil ) then
  begin
      {$IFDEF GDI}
      if  ( PControl( fOwnerControl ).fBrush <> nil ) then
          Windows.FillRgn( FHandle, Rgn, PControl( fOwnerControl ).fBrush.Handle )
      else
      begin
          Br := CreateSolidBrush( Color2RGB(PControl(fOwnerControl).fColor) );
          Windows.FillRgn( fHandle, Rgn, Br );
          DeleteObject( Br );
      end;
      {$ENDIF GDI}
  end else
  begin
      Br := CreateSolidBrush( DWORD(clWindow) );
      Windows.FillRgn( fHandle, Rgn, Br );
      DeleteObject( Br );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.FloodFill(X, Y: Integer; Color: TColor;
  FillStyle: TFillStyle);
const
  FillStyles: array[TFillStyle] of Word =
    (FLOODFILLSURFACE, FLOODFILLBORDER);
begin
  RequiredState( HandleValid or BrushValid or ChangingCanvas );
  Windows.ExtFloodFill(FHandle, X, Y, Color, FillStyles[FillStyle]);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.FrameRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);
var SolidBr : HBrush;
begin
    RequiredState( HandleValid or ChangingCanvas );
    if   fBrush <> nil then
         SolidBr := CreateSolidBrush( Color2RGB( fBrush.fData.Color ) )
    else
    if   fOwnerControl <> nil then
         SolidBr := CreateSolidBrush( PControl(fOwnerControl).fColor )
    else SolidBr := CreateSolidBrush( clWhite );
    Windows.FrameRect(FHandle, Rect, SolidBr);
    DeleteObject( SolidBr );
end;
{$ENDIF PAS_VERSION}

{$ENDIF WIN_GDI}
{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.LineTo(X, Y: Integer);
begin
  RequiredState( HandleValid or PenValid or BrushValid or ChangingCanvas );
  Windows.LineTo( fHandle, X, Y );
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TCanvas.LineTo(X, Y: Integer);
BEGIN
  ForeBack( Pen.Color, Brush.Color );
  gdk_draw_line( fDrawable, fHandle, fPenPos.X, fPenPos.Y, X, Y );
  fPenPos := MakePoint( X, Y );
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.MoveTo(X, Y: Integer);
begin
  RequiredState( HandleValid );
  Windows.MoveToEx( fHandle, X, Y, nil );
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TCanvas.MoveTo(X, Y: Integer);
BEGIN
  fPenPos := MakePoint( X, Y );
END;
{$ENDIF GTK}
{$ENDIF _X_}

procedure TCanvas.ObjectChanged(Sender: PGraphicTool);
begin
  DeselectHandles;
end;

{$IFDEF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall;
begin
  RequiredState( HandleValid or PenValid or BrushValid or ChangingCanvas );
  Windows.Pie( fHandle, X1, Y1, X2, Y2, X3, Y3, X4, Y4);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.Polygon(const Points: array of TPoint);
type
  PPoints = ^TPoints;
  TPoints = array[0..0] of TPoint;
begin
  RequiredState( HandleValid or PenValid or BrushValid or ChangingCanvas );
  {$IFDEF F_P} Windows_Polygon
  {$ELSE DELPHI} Windows.Polygon
  {$ENDIF}( fHandle, PPoints(@Points)^, High(Points) + 1);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.Polyline(const Points: array of TPoint);
type
  PPoints = ^TPoints;
  TPoints = array[0..0] of TPoint;
begin
  RequiredState( HandleValid or PenValid or BrushValid or ChangingCanvas );
  {$IFDEF F_P}Windows_Polyline
  {$ELSE DELPHI}Windows.Polyline
  {$ENDIF}( fHandle, PPoints(@Points)^, High(Points) + 1);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.Rectangle(X1, Y1, X2, Y2: Integer);
begin
  RequiredState( HandleValid or BrushValid or PenValid or ChangingCanvas );
  Windows.Rectangle( fHandle, X1, Y1, X2, Y2);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
begin
  RequiredState( HandleValid or BrushValid or PenValid or ChangingCanvas );
  Windows.RoundRect( fHandle, X1, Y1, X2, Y2, X3, Y3);
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.TextArea(const Text: KOLString; var Sz: TSize;
  var P0: TPoint);
begin
  Sz := TextExtent( Text );
  P0.x := 0; P0.y := 0;
  TOnTextArea( GlobalCanvas_OnTextArea )( @Self, Sz, P0 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF _D3orHigher}
procedure TCanvas.WTextArea(const Text: KOLWideString; var Sz: TSize;
  var P0: TPoint);
begin
  Sz := WTextExtent( Text );
  P0.x := 0; P0.y := 0;
  TOnTextArea( GlobalCanvas_OnTextArea )( @Self, Sz, P0 );
end;
{$ENDIF _D3orHigher}

{$IFDEF GDI}
{$IFDEF TEXT_EXTENT_OLD}
{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TCanvas.TextExtent(const Text: KOLString): TSize;
var DC : HDC;
    ClearHandle : Boolean;
begin
  ClearHandle := False;
  RequiredState( HandleValid or FontValid );
  DC := fHandle;
  if DC = 0 then
  begin
     DC := CreateCompatibleDC( 0 );
     ClearHandle := True;
     SetHandle( DC );
     If Not (fIsAlienDC or fIsPaintDC) then
       ClearHandle := True; //************ // Added By Gerasimov
  end;
  RequiredState( HandleValid or FontValid );
  GetTextExtentPoint32( fHandle, PKOLChar(Text), Length(Text), Result);
  {$IFDEF FIX_ITALIC_TEXT_WIDTH}
  if  fsItalic in Font.FontStyle then
  begin
      inc( Result.cx, Result.cy div 4 );
  end;
  {$ENDIF}
  if ClearHandle then
    SetHandle( 0 );
    { DC must be freed here automatically (never leaks):
      if Canvas created on base of existing DC, no memDC created,
      if Canvas has fHandle:HDC = 0, it is not fIsPaintDC always. }
end;
{$ENDIF PAS_VERSION}
{$ELSE TEXT_EXTENT_NEW}
{$IFDEF ASM_UNICODE}{$ELSE  notASM_VERSION}
function TCanvas.TextExtent(const Text: KOLString): TSize;
begin
  RequiredState( HandleValid or FontValid );
  GetTextExtentPoint32( fHandle, PKOLChar(Text), Length(Text), Result);
  {$IFDEF FIX_ITALIC_TEXT_WIDTH}
  if  Font.fData.Font.Italic then
      inc( Result.cx, Result.cy div 4 );
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}
{$ENDIF TEXT_EXTENT_NEW}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION TCanvas.TextExtent(const Text: KOLString): TSize;
VAR layout: PPangoLayout;
    context: PPangoContext;
BEGIN
  //RequiredState( HandleValid or FontValid );
  IF  fOwnerControl <> nil THEN
  BEGIN
      context := nil;
      layout := gtk_widget_create_pango_layout(
          PControl( fOwnerControl ).fEventboxHandle, nil );
  END ELSE
  BEGIN //todo: seems not working in such way... What to do for memory bitmap?
    context := pango_context_new;
    //layout := gtk_widget_create_pango_layout( fHandle, PChar( Text ) );
    layout := pango_layout_new( context );
  END;
  pango_layout_set_font_description( layout, Font.FontHandle );
  pango_layout_set_text( layout, PAnsiChar( Text ), Length( Text ) );
  pango_layout_get_size( layout, @ Result.cx, @ Result.cy );
  g_object_unref( layout );
  IF context <> nil THEN g_object_unref( context );
END;
{$ENDIF GTK}
{$ENDIF _X_}

function TCanvas.TextHeight(const Text: KOLString): Integer;
begin
  Result := TextExtent(Text).cY;
end;

{$IFDEF GDI}
procedure TCanvas.TextOutA(X, Y: Integer; const Text: AnsiString); stdcall;
begin
  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
  Windows.TextOutA(FHandle, X, Y, PAnsiChar(Text), Length(Text));
end;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.TextOut(X, Y: Integer; const Text: KOLString); stdcall;
begin
  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
  {$IFDEF UNICODE_CTRLS}Windows.TextOutW
  {$ELSE}               Windows.TextOutA
  {$ENDIF}(FHandle, X, Y, PKOLChar(Text), Length(Text));
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TCanvas.TextOut(X, Y: Integer; CONST Text: AnsiString); STDCALL;
VAR Options: Integer;
BEGIN
  Options := 0;
  if Brush.BrushStyle <> bsClear then Options := ETO_OPAQUE;
  ExtTextOut( X, Y, Options, MakeRect( 0,0,0,0 ), Text, [ ] );
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.TextRect(const Rect: TRect; X, Y: Integer; const Text: Ansistring);
var
  Options: Integer;
begin
  //Changing;
  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
  Options := ETO_CLIPPED;
  if ( fBrush <> nil ) and (fBrush.fData.Brush.Style <> bsClear)
  or ( fBrush = nil ) then Inc(Options, ETO_OPAQUE);
  Windows.ExtTextOutA( fHandle, X, Y, Options,
                       @Rect, PAnsiChar(Text),
                       Length(Text), nil); // KOL_ANSI
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TCanvas.TextRect(CONST Rect: TRect; X, Y: Integer; CONST Text: Ansistring);
VAR Options: Integer;
BEGIN
    Options := ETO_CLIPPED;
    IF Brush.BrushStyle <> bsClear THEN Options := Options or ETO_OPAQUE;
    ExtTextOut( X, Y, Options, Rect, Text, [] ); // KOL_ANSI
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF GDI}
procedure TCanvas.ExtTextOut( X, Y: Integer; Options: DWORD; const Rect: TRect; const Text: AnsiString;
          const Spacing: array of Integer );
begin
  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
  windows.ExtTextOutA(FHandle, X, Y, Options, @Rect, PAnsiChar(Text), Length(Text), @Spacing[ 0 ]); // KOL_ANSI have not Ex
end;
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TCanvas.ExtTextOut( X, Y: Integer; Options: DWORD; CONST Rect: TRect;
          CONST Text: AnsiString; CONST Spacing: ARRAY of Integer );
VAR context: PPangoContext;
    layout: PPangoLayout;
    w, h: Integer;
    pixmap: PGdkPixmap;
BEGIN
  ////RequiredState( {HandleValid or} FontValid or BrushValid or ChangingCanvas );
  w := Rect.Right - Rect.Left;
  h := Rect.Bottom - Rect.Top;
  IF  fOwnerControl <> nil THEN
  BEGIN
      context := nil;
      layout := gtk_widget_create_pango_layout(
          PControl( fOwnerControl ).fEventboxHandle, nil );
  END ELSE
  BEGIN //todo: seems not working in such way... What to do for memory bitmap?
      context := pango_context_new;
      //layout := gtk_widget_create_pango_layout( fHandle, PChar( Text ) );
      layout := pango_layout_new( context );
  END;
  pango_layout_set_font_description( layout, Font.FontHandle );
  pango_layout_set_text( layout, PAnsiChar( Text ), Length( Text ) );
  IF  Options AND ETO_CLIPPED = 0 THEN
  BEGIN
    pango_layout_get_size( layout, @ w, @ h );
    w := w div PANGO_SCALE;
    h := h div PANGO_SCALE;
  END;
  pixmap := gdk_pixmap_new( PControl( fOwnerControl ).fEventboxHandle.window,
    w, h, -1 ); //todo: use MainForm
  IF  Options AND ETO_OPAQUE <> 0 THEN
  BEGIN
      ForeBack( Brush.Color, Brush.Color );
      gdk_draw_rectangle( GDK_DRAWABLE( pixmap ), fHandle, 1, 0, 0, w, h );
  END ELSE
  BEGIN
      gdk_draw_drawable( GDK_DRAWABLE( pixmap ), fHandle, fDrawable,
        Rect.Left, Rect.Top, 0, 0, w, h );
  END;
  ForeBack( Font.Color, Brush.Color );
  gdk_draw_layout( GDK_DRAWABLE( pixmap ), fHandle, X, Y, layout );
  g_object_unref( layout );
  gdk_draw_drawable( fDrawable, fHandle, GDK_DRAWABLE( pixmap ),
    0, 0, Rect.Left, Rect.Top, w, h );
  g_object_unref( pixmap );
  IF  context <> nil THEN
      g_object_unref( context );
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE}
procedure TCanvas.DrawText(Text: AnsiString; var Rect:TRect; Flags:DWord);
begin
  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
  Windows.DrawTextA(Handle, PAnsiChar(Text), -1, Rect, Flags); // KOL_ANSI
end;
{$ENDIF PAS_VERSION}

function TCanvas.ClipRect: TRect;
begin
  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
  GetClipBox(Handle, Result);
end;
{$ENDIF WIN_GDI}

function TCanvas.TextWidth(const Text: KOLString): Integer;
begin
  Result := TextExtent(Text).cX;
end;

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TCanvas.GetBrush: PGraphicTool;
begin
  if ( fBrush = nil ) then
  begin
    fBrush := NewBrush;
    if ( fOwnerControl <> nil ) then
    begin
      fBrush.fData.Color := PControl(fOwnerControl).fColor;
      if ( PControl(fOwnerControl).fBrush <> nil ) then
         fBrush.Assign( PControl(fOwnerControl).fBrush );
      // both statements above needed
    end;
    AssignChangeEvents;
  end;
  Result := fBrush;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION TCanvas.GetBrush: PGraphicTool;
BEGIN
  IF  ( fBrush = nil ) THEN
  BEGIN
      fBrush := NewBrush;
      IF ( fOwnerControl <> nil ) THEN
      BEGIN
          fBrush.fData.Color := PControl(fOwnerControl).fColor;
          IF  ( PControl(fOwnerControl).fBrush <> nil ) THEN
              fBrush.Assign( PControl(fOwnerControl).fBrush );
          // both statements above needed
      END;
      AssignChangeEvents;
  END;
  Result := fBrush;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TCanvas.GetFont: PGraphicTool;
begin
  if ( fFont = nil ) then
  begin
    fFont := NewFont;
    if ( fOwnerControl <> nil ) then
    begin
      fFont.Color := PControl(fOwnerControl).fTextColor;
      if ( PControl(fOwnerControl).fFont <> nil ) then
         fFont.Assign( PControl(fOwnerControl).fFont );
    end;
    AssignChangeEvents;
  end;
  Result := fFont;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TCanvas.GetPen: PGraphicTool;
begin
  if ( fPen = nil ) then
  begin
    fPen := NewPen;
    AssignChangeEvents;
  end;
  Result := fPen;
end;
{$ENDIF PAS_VERSION}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TCanvas.GetHandle: HDC;
begin
  /////////////////////////////////
  if  Assigned( fOnGetHandle ) then
  /////////////////////////////////
  begin
      Result := fOnGetHandle( @Self );
      SetHandle( Result );
  end else
      Result := fHandle;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION TCanvas.GetHandle: HDC;
BEGIN
  ////////////////////////////////
  IF  Assigned( fOnGetHandle ) THEN
  ////////////////////////////////
      fHandle := fOnGetHandle( @Self );
  Result := fHandle;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TCanvas.AssignChangeEvents;
begin
  if ( fBrush <> nil ) then
     fBrush.fOnGTChange := ObjectChanged;
  if ( fPen <> nil ) then
     fPen.fOnGTChange := ObjectChanged;
  if ( fFont <> nil ) then
     fFont.fOnGTChange := ObjectChanged;
end;
{$ENDIF PAS_VERSION}
{$IFDEF WIN_GDI}

{$IFNDEF _FPC}
{$IFNDEF _D2}
procedure TCanvas.WDrawText(WText: KOLWideString; var Rect: TRect;
  Flags: DWord);
begin
  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
  Windows.DrawTextW(Handle,PWideChar(WText),-1,Rect,Flags);
end;

procedure TCanvas.WExtTextOut(X, Y: Integer; Options: DWORD;
  const Rect: TRect; const WText: KOLWideString;
  const Spacing: array of Integer);
begin
  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
  Windows.ExtTextOutW(FHandle, X, Y, Options, @Rect, PWideChar(WText), Length(WText), @Spacing[ 0 ]);
end;

procedure TCanvas.WTextOut(X, Y: Integer; const WText: KOLWideString);
begin
  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
  Windows.TextOutW(FHandle, X, Y, PWideChar(WText), Length(WText));
  MoveTo(X + WTextWidth(WText), Y);
end;

procedure TCanvas.WTextRect(const Rect: TRect; X, Y: Integer;
  const WText: KOLWideString);
var
  Options: Integer;
begin
  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
  Options := ETO_CLIPPED;
  if ( fBrush <> nil ) and (fBrush.fData.Brush.Style <> bsClear)
  or ( fBrush = nil ) then Inc(Options, ETO_OPAQUE);
  Windows.ExtTextOutW( fHandle, X, Y, Options,
                      @Rect, PWideChar(WText),
                      Length(WText), nil);
end;

function TCanvas.WTextExtent(const WText: KOLWideString): TSize;
var DC : HDC;
    ClearHandle : Boolean;
begin
  ClearHandle := False;
  RequiredState( HandleValid or FontValid );
  DC := fHandle;
  if DC = 0 then
  begin
     DC := CreateCompatibleDC( 0 );
     ClearHandle := True;
     SetHandle( DC );
  end;
  RequiredState( HandleValid or FontValid );
  Windows.GetTextExtentPoint32W( fHandle, PWideChar(WText), Length(WText), Result);
  if ClearHandle then
    SetHandle( 0 );
end;

function TCanvas.WTextHeight(const WText: KOLWideString): Integer;
begin
  Result := WTextExtent( WText ).cy;
end;

function TCanvas.WTextWidth(const WText: KOLWideString): Integer;
begin
  Result := WTextExtent( WText ).cx;
end;
{$ENDIF _D2}
{$ENDIF _FPC}

{$ENDIF WIN_GDI}
function MakeInt64( Lo, Hi: DWORD ): I64;
begin
  Result.Lo := Lo;
  Result.Hi := Hi;
end;

{$IFDEF PAS_ONLY}
{$ELSE}
function Int2Int64( X: Integer ): I64;
asm
  MOV  [EDX], EAX
  MOV  ECX, EDX
  CDQ
  MOV  [ECX+4], EDX
end;

procedure IncInt64( var I64: I64; Delta: Integer );
asm
  ADD  [EAX], EDX
  ADC  dword ptr [EAX+4], 0
end;

procedure DecInt64( var I64: I64; Delta: Integer );
asm
  SUB  [EAX], EDX
  SBB  dword ptr [EDX], 0
end;

function Add64( const X, Y: I64 ): I64;
asm
  PUSH  ESI
  XCHG  ESI, EAX
  LODSD
  ADD   EAX, [EDX]
  MOV   [ECX], EAX
  LODSD
  ADC   EAX, [EDX+4]
  MOV   [ECX+4], EAX
  POP   ESI
end;

function Sub64( const X, Y: I64 ): I64;
asm
  PUSH  ESI
  XCHG  ESI, EAX
  LODSD
  SUB   EAX, [EDX]
  MOV   [ECX], EAX
  LODSD
  SBB   EAX, [EDX+4]
  MOV   [ECX+4], EAX
  POP   ESI
end;

function Neg64( const X: I64 ): I64;
asm
  MOV  ECX, [EAX]
  NEG  ECX
  MOV  [EDX], ECX
  MOV  ECX, 0
  SBB  ECX, [EAX+4]
  MOV  [EDX+4], ECX
end;

function Mul64EDX( const X: I64; M: Integer ): I64;
asm
  PUSH  ESI
  PUSH  EDI
  XCHG  ESI, EAX
  MOV   EDI, ECX
  MOV   ECX, EDX
  LODSD
  MUL   ECX
  STOSD
  XCHG  EDX, ECX
  LODSD
  MUL  EDX
  ADD   EAX, ECX
  STOSD
  POP   EDI
  POP   ESI
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function Mul64i( const X: I64; Mul: Integer ): I64;
var Minus: Boolean;
begin
  Minus := FALSE;
  if Mul < 0 then
  begin
    Minus := TRUE;
    Mul := -Mul;
  end;
  Result := Mul64EDX( X, Mul );
  if Minus then
    Result := Neg64( Result );
end;
{$ENDIF PAS_VERSION}

function Div64EDX( const X: I64; D: Integer ): I64;
asm
  PUSH  ESI
  PUSH  EDI
  XCHG  ESI, EAX
  MOV   EDI, ECX
  MOV   ECX, EDX
  MOV   EAX, [ESI+4]
  CDQ
  DIV  ECX
  MOV   [EDI+4], EAX
  LODSD
  DIV  ECX
  STOSD
  POP   EDI
  POP   ESI
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function Div64i( const X: I64; D: Integer ): I64;
var Minus: Boolean;
begin
  Minus := FALSE;
  if D < 0 then
  begin
    D := -D;
    Minus := TRUE;
  end;
  Result := X;
  if Sgn64( Result ) < 0 then
  begin
    Result := Neg64( Result );
    Minus := not Minus;
  end;
  Result := Div64EDX( Result, D );
  if Minus then
    Result := Neg64( Result );
end;
{$ENDIF PAS_VERSION}

function Mod64i( const X: I64; D: Integer ): Integer;
begin
  Result := Sub64( X, Mul64i( Div64i( X, D ), D ) ).Lo;
end;

function Sgn64( const X: I64 ): Integer;
asm
  XOR  EDX, EDX
  CMP  [EAX+4], EDX
  XCHG EAX, EDX
  JG   @@ret_1
  JL   @@ret_neg
  CMP  [EDX], EAX
  JZ   @@exit
@@ret_1:
  INC  EAX
  RET
@@ret_neg:
  DEC  EAX
@@exit:
end;

function Cmp64( const X, Y: I64 ): Integer;
begin
  Result := Sgn64( Sub64( X, Y ) );
end;

function Int64_2Str( X: I64 ): AnsiString;
var M: Boolean;
    Y: Integer;
    Buf: array[ 0..31 ] of AnsiChar;
    I: Integer;
begin
  M := FALSE;
  case Sgn64( X ) of
  -1: begin M := TRUE; X := Neg64( X ); end;
  0:  begin Result := '0'; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
  end;
  I := 31;
  Buf[ 31 ] := #0;
  while Sgn64( X ) > 0 do
  begin
    Dec( I );
    Y := Mod64i( X, 10 );
    Buf[ I ] := AnsiChar( Y + Integer( '0' ) );
    X := Div64i( X, 10 );
  end;
  if M then
  begin
    Dec( I );
    Buf[ I ] := '-';
  end;
  Result := PAnsiChar( @Buf[ I ] );
end;

function Int64_2Hex( X: I64; MinDigits: Integer ): KOLString;
begin
  if  (MinDigits <= 8) and (X.Hi <> 0) then
       Result := Int2Hex( X.Hi, 1 ) + Int2Hex( X.Lo, 8 )
  else if X.Hi <> 0 then
       Result := Int2Hex( X.Hi, MinDigits - 8 ) + Int2Hex( X.Lo, 8 )
  else Result := Int2Hex( X.Lo, MinDigits );
end;

function Str2Int64( const S: AnsiString ): I64;
var I: Integer;
    M: Boolean;
begin
  Result.Lo := 0;
  Result.Hi := 0;
  I := 1;
  if S = '' then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  M := FALSE;
  if  S[ 1 ] = '-' then
  begin
      M := TRUE;
      Inc( I );
  end else if S[ 1 ] = '+' then
      Inc( I );
  while I <= Length( S ) do
  begin
    if  (S[ I ] < '0') or (S[ I ] > '9') then
        break;
    Result := Mul64i( Result, 10 );
    IncInt64( Result, Integer( S[ I ] ) - Integer( '0' ) );
    Inc( I );
  end;
  if M then
    Result := Neg64( Result );
end;

function Int64_2Double( const X: I64 ): Double;
asm
  FILD qword ptr [EAX]
  FSTP @Result
end;

function Double2Int64( D: Double ): I64;
asm
  FLD   D
  FISTP qword ptr [EAX]
end;
{$ENDIF PAS_ONLY}

function IsNan(const AValue: Double): Boolean;
{$IFDEF _D2orD3}
type PI64 = ^I64;
{$ENDIF}
begin
  Result := (PI64(@AValue).Hi and $7FF00000 = $7FF00000) and
            ((PI64(@AValue).Hi and $000FFFFF <> 0) or (PI64(@AValue).Lo <> 0));
end;

function IsInfinity(const AValue: Double): Boolean;
{$IFDEF _D2orD3}
type PI64 = ^I64;
{$ENDIF}
begin
  Result := (PI64(@AValue).Hi and $7FF00000 = $7FF00000) and
            (PI64(@AValue).Hi and $000FFFFF = $00000000);
end;

{$IFDEF PAS_ONLY} {$DEFINE PAS_INTPOW} {$ENDIF}
{$IFDEF F_P}      {$DEFINE PAS_INTPOW} {$ENDIF}

function IntPower(Base: Extended; Exponent: Integer): Extended;
{$IFDEF PAS_ONLY}
begin
  Result := 1.0;
  if Exponent = 0 then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Exponent < 0 then begin
    Exponent := -Exponent;
    Base := 1.0 / Base;
  end;
  REPEAT
    Result := Result * Base;
    Dec( Exponent );
  UNTIL Exponent=0;
end;
{$ELSE DELPHI}
// This version of code by Galkov: Changes in comparison to Delphi standard:
//              no Overflow exception if Exponent is very big negative value
//              (just 0 in result in such case).
asm
        fld1             { Result := 1 }
        test    eax,eax  // check Exponent for 0, return 0 ** 0 = 1
        jz      @@3      // (though Mathematics says that this is not so...)
        fld     Base
        jg      @@2
        fdivr   ST,ST(1) { Base := 1 / Base }
        neg     eax
        jmp     @@2
@@1:    fmul    ST,ST    { X := Base * Base }
@@2:    shr     eax,1
        jnc     @@1
        fmul    ST(1),ST { Result := Result * X }
        jnz     @@1
        fstp    st       { pop X from FPU stack }
@@3:    fwait
end;
{$ENDIF PAS_ONLY}

function NextPowerOf2( n: DWORD ): DWORD;
begin
    Result := 1;
    while (Result < n) and (Result <> 0) do
        Result := Result shl 1;
end;

function Str2Double( const S: KOLString ): Double;
var I: Integer;
    M, Pt: Boolean;
    D: Double;
    Ex: Integer;
begin
  Result := 0.0;
  if S = '' then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  M := FALSE;
  I := 1;
  if S[ 1 ] = '-' then
  begin
    M := TRUE;
    Inc( I );
  end;
  Pt := FALSE;
  D := 1.0;
  while I <= Length( S ) do
  begin
    case S[ I ] of
    '.' {$IFNDEF SMALLEST_CODE}, ','{$ENDIF}:
        if not Pt then Pt := TRUE else break;
    '0'..'9': if  not Pt then
                  Result := Result * 10 + Integer( S[ I ] ) - Integer( '0' )
              else
              begin
                  D := D * 0.1;
                  Result := Result + (Integer( S[ I ] ) - Integer( '0' )) * D;
              end;
    'e', 'E': begin
                  Ex := Str2Int( CopyEnd( S, I + 1 ) );
                  Result := Result * IntPower( 10.0, Ex );
                  break;
              end;
    end;
    Inc( I );
  end;
  if  M then
      Result := -Result;
end;

function Str2Extended( const S: KOLString ): Extended;
var I: Integer;
    M, Pt: Boolean;
    D: Extended;
    Ex: Integer;
begin
  Result := 0.0;
  if S = '' then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  M := FALSE;
  I := 1;
  if S[ 1 ] = '-' then
  begin
      M := TRUE;
      Inc( I );
  end;
  Pt := FALSE;
  D := 1.0;
  while I <= Length( S ) do
  begin
    case S[ I ] of
    '.' {$IFNDEF SMALLEST_CODE}, ','{$ENDIF}:
        if not Pt then Pt := TRUE else break;
    '0'..'9': if  not Pt then
                  Result := Result * 10 + Integer( S[ I ] ) - Integer( '0' )
              else
              begin
                  D := D * 0.1;
                  Result := Result + (Integer( S[ I ] ) - Integer( '0' )) * D;
              end;
    'e', 'E': begin
                  Ex := Str2Int( CopyEnd( S, I + 1 ) );
                  Result := Result * IntPower( 10.0, Ex );
                  break;
              end;
    end;
    Inc( I );
  end;
  if M then
    Result := -Result;
end;

{$IFNDEF PAS_ONLY}
function TruncD( D: Double ): Double;
asm
  FLD    D
  PUSH   ECX
  FNSTCW [ESP]
  POP    ECX
  PUSH   ECX
  OR     byte ptr [ESP+1], $0C
  FLDCW  [ESP]
  PUSH   ECX
  FRNDINT
  FSTP   @Result
  FLDCW  [ESP]
  POP    ECX
  POP    ECX
end;
{$ENDIF}

function IfThenElseBool( t, e: Boolean; Cond: Boolean ): Boolean;
begin
  if cond then Result := t else Result := e;
end;
function IfThenElseInt( t, e: Integer; Cond: Boolean ): Integer;
begin
  if cond then Result := t else Result := e;
end;
function IfThenElseStr( const t, e: AnsiString; Cond: Boolean ): AnsiString;
begin
  if cond then Result := t else Result := e;
end;
{$IFDEF _D5orHigher}
function IfThenElse( t, e: Boolean; Cond: Boolean ): Boolean; overload;
begin
  if cond then Result := t else Result := e;
end;
function IfThenElse( t, e: Integer; Cond: Boolean ): Integer; overload;
begin
  if cond then Result := t else Result := e;
end;
function IfThenElse( t, e: AnsiString; Cond: Boolean ): AnsiString; overload;
begin
  if cond then Result := t else Result := e;
end;
function IfThenElse( t, e: Double; Cond: Boolean ): Double; overload;
begin
  if cond then Result := t else Result := e;
end;
{$ENDIF}

// Precision 15
function Extended2Str( E: Extended ): KOLString;
    function UnpackFromBuf( const Buf: array of Byte; N: Integer ): KOLString;
    var I, J, K, L: Integer;
    begin
      SetLength( Result, 16 );
      J := 1;
      for I := 7 downto 0 do
      begin
        K := Buf[ I ] shr 4;
        Result[ J ] := KOLChar( Ord('0') + K );
        Inc( J );
        K := Buf[ I ] and $F;
        Result[ J ] := KOLChar( Ord('0') + K );
        Inc( J );
      end;
      //Assert( Result[ 1 ] = '0', 'error!' );
      Delete( Result, 1, 1 );
      if  N <= 0 then
      begin
          while N < 0 do
          begin
              Result := '0' + Result;
              Inc( N );
          end;
          Result := '0.' + Result;
      end else
      if  N < Length( Result ) then
      begin
          Result := Copy( Result, 1, N ) + '.' + CopyEnd( Result, N + 1 );
      end else
      begin
          while N > Length( Result ) do
          begin
            Result := Result + '0';
          end;
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      L := Length( Result );
      while L > 1 do
      begin
        if  (Result[ L ] <> '0')
        and (Result[ L ] <> '.') then
            break;
        Dec( L );
        if Result[ L + 1 ] = '.' then break;
      end;
      if L < Length( Result ) then Delete( Result, L + 1, MaxInt );
    end;
var
  S: Boolean;
var F: Extended;
    N: Integer;
    Buf1: array[ 0..9 ] of Byte;
    I10: Integer;
begin
  Result := '0';
  if E = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  S := E < 0;
  if S then E := -E;

  N := 15;
  F := 5E12;
  I10 := 10;
  while E < F do
  begin
    Dec( N );
    E := E * I10;
  end;
  if N = 15 then
  while E >= 1E13 do
  begin
    Inc( N );
    E := E / I10;
  end;

  while TRUE do
  begin
    {$IFDEF PAS_ONLY}
    if TRUNC(Abs(E)) >= 10000000 then
       break;
    {$ELSE}
    asm
      FLD    [E]
      FBSTP  [Buf1]
    end;
    if Buf1[ 7 ] <> 0 then break;
    {$ENDIF}
    E := E * I10;
    Dec( N );
  end;
  Result := UnpackFromBuf( Buf1, N );
  if S then Result := '-' + Result;
end;

function Extended2StrDigits( D: Double; n: Integer ): KOLString;
var i, m: Integer;
label start;
begin
start:
    Result := Extended2Str( D );
    i := IndexOfChar( Result, '.' ); //pos( '.', Result );
    if  n <= 0 then
    begin
        if  i <= 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        delete( Result, i, MaxInt );
    end else
    begin
        if  i <= 0 then
        begin
            i := Length( Result ) + 1;
            Result := Result + '.';
        end;
        if  Length( Result ) - i < n then
            Result := Result + StrRepeat( '0', n + i - Length( Result ) )
        else
        begin
            m := i + n;
            if  Length( Result ) <= m then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
            if  (Result[m+1] > '5')
            or  (Length( Result ) > m+1)
            and (Result[m+2] > '0') then
            begin
                n := m;
                inc( Result[n] );
                while Result[n] > '9' do
                begin
                      Result[n] := '0';
                      dec( n );
                      if  n = 0 then
                      begin
                          Result := '1' + Result;
                          break;
                      end;
                      if  Result[n] = '.' then dec(n);
                      inc( Result[n] );
                end;
            end;
            delete( Result, m+1, MaxInt );
        end;
    end;
end;

function Double2Str( D: Double ): KOLString;
begin
  Result := Extended2Str( D );
end;

function Double2StrEx( D: Double ): KOLString;
var E, E1, E2: Double;
    S: KOLString;
begin
  Result := Double2Str( D );
  E := Str2Double( Result );
  E1 := E - D;
  if E1 < 0.0 then E1 := -E1;
  if E1 < 1e-307 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  while TRUE do
  begin
    E := D - (E - D) * 0.3;
    S := Double2Str( E );
    if S = Result then break;
    E := Str2Double( S );
    E2 := E - D;
    if E2 < 0.0 then E2 := -E2;
    if E2 > E1 * 0.75 then break;
    Result := S;
    if E2 < E1 * 0.1 then break;
  end;
end;

function GetBits( N: DWORD; first, last: Byte ): DWord;
{$IFDEF F_P}
begin
  Result := 0;
  if last > 31 then last := 31;
  if first > last then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := (N and not ($FFFFFFFF shl last)) shr first;
end;
{$ELSE DELPHI}
asm
   XCHG EAX, EDX  // (1) EDX=N, AL=first
   {$IFDEF PARANOIA} DB $3C, 31 {$ELSE} CMP AL, 31 {$ENDIF} // first(AL) > 31 ?
   JBE  @@1       // (2) åñëè äà, òî Result := 0;
@@0:
   XOR  EAX, EAX  // (2)
   RET            // (1)
@@1:

   XCHG EAX, ECX  // (1) AL = last CL = first
   SHR  EDX, CL   // (2) EDX = N shr first
   SUB  AL,  CL	  // (2) AL = last - first
   JL @@0         // (2) åñëè last < first òî Result := 0;

   {$IFDEF PARANOIA} DB $3C, 32 {$ELSE} CMP AL, 32 {$ENDIF} // (2) last - first >= 32 ?
   XCHG ECX, EAX  // (1) CL = last - first
   XCHG EAX, EDX  // (1) EAX = N shr first
   JAE  @@exit    // (2) åñëè last - first > 31, òî Result := EAX;
   SBB  EDX, EDX  // (2) EDX = -1
   DEC  EDX       // (1) EDX = 1111...10 = -2
   SHL  EDX, CL   // (2) EDX = 111...100..0 (ãäå n(0)=last-first+1)
   NOT  EDX       // (2) EDX = ìàñêà 000..0111...1 (ãäå n(1)=last-first+1)
   AND  EAX, EDX  // (2)
@@exit:
   // EAX = ðåçóëüòàò, (1 áàéò íà êîìàíäó RET)
end;
{$ENDIF F_P/DELPHI}

function GetBitsL( N: DWORD; from, len: Byte ): DWord;
{$IFDEF F_P}
begin
  Result := GetBits( N, from, from + len - 1 );
end;
{$ELSE DELPHI}
asm
   ADD  CL, DL
   DEC  CL
   JMP  GetBits
end;
{$ENDIF F_P/DELPHI}

{$IFNDEF FPC}
function MulDiv( A, B, C: Integer ): Integer;
asm
  IMUL EDX
  IDIV ECX
end;
{$ENDIF}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION}
function Int2Hex( Value : DWord; Digits : Integer ) : KOLString;
const
  HexDigitChr: array[ 0..15 ] of KOLChar = ( '0','1','2','3','4','5','6','7',
                                             '8','9','A','B','C','D','E','F' );
var Buf: array[ 0..8 ] of KOLChar;
    Dest : PKOLChar;
begin
  Dest := @Buf[ 8 ];
  Dest^ := #0;
  repeat
    Dec( Dest );
    Dest^ := '0';
    if Value <> 0 then
    begin
      Dest^ := HexDigitChr[ Value and $F ];
      Value := Value shr 4;
    end;
    Dec( Digits );
  until (Value = 0) and (Digits <= 0);
  Result := Dest;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function Hex2Int( const Value : KOLString) : Integer;
var I : Integer;
begin
  Result := 0;
  I := 1;
  if Value = '' then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Value[ 1 ] = '$' then Inc( I );
  while I <= Length( Value ) do
  begin
    if  (Value[ I ] >= '0')
    and (Value[ I ] <= '9') then
         Result := (Result shl 4) or (Ord(Value[I]) - Ord('0'))
    else if  (Value[ I ] >= 'A')
    and  (Value[ I ] <= 'F') then
         Result := (Result shl 4) or (Ord(Value[I]) - Ord('A') + 10)
    else if  (Value[ I ] >= 'a')
    and  (Value[ I ] <= 'f') then
         Result := (Result shl 4) or (Ord(Value[I]) - Ord('a') + 10)
    else break;
    Inc( I );
  end;
end;
{$ENDIF PAS_VERSION}

function Octal2Int( const Value: AnsiString ) : Integer;
var I: Integer;
begin
  Result := 0;
  for I := 1 to Length( Value ) do
  begin
    if   (Value[ I ] >= '0') and (Value[ I ] <= '7') then
         Result := Result * 8 + Ord( Value[ I ] ) - Ord( '0' )
    else break;
  end;
end;

function Binary2Int( const Value: AnsiString ) : Integer;
var I: Integer;
begin
  Result := 0;
  for I := 1 to Length( Value ) do
  begin
    if   (Value[ I ] = '0') or (Value[ I ] = '1') then
         Result := Result * 2 + Ord( Value[ I ] ) - Ord( '0' )
    else break;
  end;
end;

function ToRadix( number: Radix_Int; radix: Integer; min_digits: Integer ): KOLString;
var Buf: array[ 0..64 ] of KOLChar;
    p: PKOLChar;
    n: Integer;
    {$IFDEF _D5orHigher}
    numd: Extended;
    {$ENDIF}
begin
  {$IFDEF KOL_ASSERTIONS}
  Assert( (radix >= 2) and (radix <= 36), 'Radix base must be between 2 and 36' );
  Assert( min_digits <= 64, 'Maximum possible digits number is 64' );
  {$ENDIF KOL_ASSERTIONS}
    p := @ Buf[ 64 ];
    p^ := #0;
    while (number <> 0) do
    begin
        dec( p );
        {$IFDEF _D5orHigher}
        if number < 0 then
        begin
            numd := 1.0 * I64( number ).Hi * $10000 * $10000 + I64( number ).Lo;
            number := Round( numd / radix );
            n := Round( numd - 1.0 * number * radix );
            if n < 0 then
            begin
              n := radix + n;
              dec( number );
            end;
        end else
        {$ENDIF}
        begin
            n := number mod radix;
            number := number div radix;
        end;
        if n <= 9 then p^ := KOLChar( n + Ord( '0' ) )
        else p^ := KOLChar( n - 10 + Ord( 'A' ) );
        dec( min_digits );
    end;
    while (min_digits > 0) do
    begin
        dec( p );
        p^ := '0';
        dec( min_digits );
    end;
    Result := p;
end;

function FromRadixStr( var Rslt: Radix_int; s: PKOLChar; radix: Integer ): PKOLChar;
var n: Integer;
begin
  {$IFDEF KOL_ASSERTIONS}
  Assert( (radix >= 2) and (radix <= 36), 'Radix base must be between 2 and 36' );
  {$ENDIF KOL_ASSERTIONS}
    Rslt := 0;
    while s^ <> #0 do
    begin
        CASE s^ OF
        '0'..'9': n := Ord( s^ ) - Ord( '0' );
        'a'..'z': n := Ord( s^ ) - Ord( 'a' ) + 10;
        'A'..'Z': n := Ord( s^ ) - Ord( 'A' ) + 10;
        else n := 100;
        END;
        if n >= radix then break;
        Rslt := Rslt * radix + n;
        inc( s );
    end;
    Result := s;
end;

function FromRadix( const s: AnsiString; radix: Integer ): Radix_int;
begin
    Result := 0;
    if s = '' then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    FromRadixStr( Result, @ s[ 1 ], radix );
end;

function InsertSeparators( const s: KOLString; chars_between: Integer; Separator: KOLChar ): KOLString;
var L, from_L, n: Integer;
begin
  if (s = '') or (chars_between <= 0) then
  begin
      Result := s;
      Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
    From_L := Length( s );
    L := From_L + From_L div chars_between;
    SetLength( Result, L );
    while L >= 1 do
    begin
        for n := 1 to chars_between do
        begin
            Result[ L ] := s[ from_L ];
            dec( L );
            dec( from_L );
            if L < 1 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
        Result[ L ] := Separator;
        dec( L );
    end;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
function cHex2Int( const Value : KOLString) : Integer;
begin
  if   (Length(Value)>2) and (Value[1]='0')
  and  ((Value[2]='x') or (Value[2]='X')) then
       Result := Hex2Int( CopyEnd( Value, 3 ) )
  else Result := Hex2Int( Value );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function Int2Str( Value : Integer ) : KOLString;
var Buf : Array[ 0..15 ] of KOLChar;
    Dst : PKOLChar;
    Minus : Boolean;
    D: DWORD;
begin
  Dst := @Buf[ 15 ];
  Dst^ := #0;
  Minus := False;
  if Value < 0 then
  begin
    Value := -Value;
    Minus := True;
  end;
  D := Value;
  repeat
    Dec( Dst );
    Dst^ := KOLChar( (D mod 10) + Byte( '0' ) );
    D := D div 10;
  until D = 0;
  if Minus then
  begin
    Dec( Dst );
    Dst^ := '-';
  end;
  Result := Dst;
end;
{$ENDIF PAS_VERSION}

procedure Int2PChar( s: PAnsiChar; Value: Integer );
var Buf : array[ 0..15 ] of AnsiChar;
    Dst : PAnsiChar;
    Minus : Boolean;
    D: DWORD;
begin
  Dst := @Buf[ 15 ];
  Dst^ := #0;
  Minus := False;
  if Value < 0 then
  begin
    Value := -Value;
    Minus := True;
  end;
  D := Value;
  repeat
    Dec( Dst );
    Dst^ := AnsiChar( (D mod 10) + Byte( '0' ) );
    D := D div 10;
  until D = 0;
  if Minus then
  begin
    Dec( Dst );
    Dst^ := '-';
  end;
  StrCopy( s, Dst );
end;

function UInt2Str( Value: DWORD ): AnsiString;
var Buf : Array[ 0..15 ] of AnsiChar;
    Dst : PAnsiChar;
    D: DWORD;
begin
  Dst := @Buf[ 15 ];
  Dst^ := #0;
  D := Value;
  repeat
    Dec( Dst );
    Dst^ := AnsiChar( (D mod 10) + Byte( '0' ) );
    D := D div 10;
  until D = 0;
  Result := Dst;
end;

function Int2StrEx( Value, MinWidth: Integer ): KOLString;
begin
  Result := Int2Str( Value );
  while Length( Result ) < MinWidth do
    Result := ' ' + Result;
end;

function Int2Rome( Value: Integer ): KOLString;
const RomeDigs = KOLString('IVXLCDMT');
  function RomeNum( N, FromIdx: Integer ): KOLString;
  begin
    CASE N OF
    1, 2, 3:    Result := StrRepeat( RomeDigs[ FromIdx ], N );
    4:          Result := KOLString('') + KOLString(RomeDigs[ FromIdx ]) +
                          KOLString(RomeDigs[ FromIdx + 1 ]);
    5, 6, 7, 8: Result := KOLString(RomeDigs[ FromIdx + 1 ]) +
                          StrRepeat( RomeDigs[ FromIdx ], N - 5 );
    9:          Result := KOLString('') + KOLString(RomeDigs[ FromIdx ]) +
                          KOLString(RomeDigs[ FromIdx + 2 ]);
    else        Result := '';
    END;
  end;
var I, J: Integer;
begin
  Result := '';
  if Value < 1 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Value > 8999 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  // maximum possible is TMMMCMXCIX, i.e. 8999
  J := 1;
  for I := 1 to 3 do
  begin
    Result := RomeNum( Value mod 10, J ) + Result;
    Value := Value div 10;
    if Value = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    Inc( J, 2 );
  end;
end;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION}
function Int2Ths( I : Integer ): KOLString;
var S : KOLString;
begin
  S := Int2Str( I );
  Result := '';
  while S <> '' do
  begin
    if Result <> '' then
       Result := KOLString(ThsSeparator) + Result;
    Result := CopyTail( S, 3 ) + Result;
    S := Copy( S, 1, Length( S ) - 3 );
  end;
  if Copy( Result, 1, 2 ) = KOLString('-') + KOLString(ThsSeparator) then
     Result := '-' + CopyEnd( Result, 3 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function Int2Digs( Value, Digits : Integer ) : KOLString;
var M : KOLString;
begin
  Result := Int2Str( Value );
  M := '';
  if Value < 0 then
  begin
    M := '-';
    Result := CopyEnd( Result, 2 );
  end;
  if Digits >= 0 then
    while Length( M + Result ) < Digits do
          Result := '0' + Result
  else
    while Length( Result ) < -Digits do
          Result := '0' + Result;
  Result := M + Result;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
{$IFDEF _D2009orHigher}  const Suffix: AnsiString = 'KMGT';
{$ELSE}                  const Suffix = 'KMGT';    {$ENDIF}
function Num2Bytes( Value : Double ) : KOLString;
var V, I : Integer;
begin
  Result := '';
  I := 0;
  while (Value >= 1024) and (I < 4) do
  begin
    Inc( I );
    Value := Value / 1024.0;
  end;
  Result := Int2Str( Trunc( Value ) );
  V := Trunc( (Value - Trunc( Value )) * 100 );
  if V <> 0 then
  begin
    if (V mod 10) = 0 then
       V := V div 10;
    Result := Result + ',' + Int2Str( V );
  end;
  if I > 0 then
     Result := Result + KOLString( Suffix[ I ] );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function S2Int( S: PKOLChar ): Integer;
var M : Integer;
begin
   Result := 0;
   if S = '' then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   M := 1;
   if  S^ = '-' then
   begin
       M := -1;
       Inc( S );
   end else
   if  S^ = '+' then
       Inc( S );
   while (S^>='0') and (S^<='9') do
   begin
       Result := Result * 10 + Integer( S^ ) - Integer( '0' );
       Inc( S );
   end;
   if  M < 0 then Result := -Result;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function Str2Int(const Value : KOLString) : Integer;
begin
  Result := S2Int( PKOLChar( Value ) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF PAS_ONLY}
function StrCopy( Dest, Source: PAnsiChar ): PAnsiChar;
var L: Integer;
begin
    L := StrLen(Source);
    Move(Source^, Dest^, L+1);
    Result := Dest;
end;
{$ELSE}
function StrCopy( Dest, Source: PAnsiChar ): PAnsiChar; assembler;
asm
  {$IFDEF F_P}
        MOV     EAX, [Dest]
        MOV     EDX, [Source]
  {$ENDIF F_P}
        PUSH    EDI
        PUSH    ESI
        MOV     ESI,EAX
        MOV     EDI,EDX
        OR      ECX, -1
        XOR     AL,AL
        REPNE   SCASB
        NOT     ECX
        MOV     EDI,ESI
        MOV     ESI,EDX
        MOV     EDX,ECX
        MOV     EAX,EDI
        SHR     ECX,2
        REP     MOVSD
        MOV     ECX,EDX
        AND     ECX,3
        REP     MOVSB
        POP     ESI
        POP     EDI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ENDIF PAS_ONLY}

function StrCat( Dest, Source: PAnsiChar ): PAnsiChar;
begin
  StrCopy( StrScan( Dest, #0 ), Source );
  Result := Dest;
end;

{$IFDEF PAS_ONLY}
function StrScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
begin
    while Str^ <> Chr do
    begin
        if Str^ = #0 then break;
        inc(Str);
    end;
    Result := Str;
end;
{$ELSE}
function StrScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; assembler;
asm
  {$IFDEF F_P}
  MOV   EAX, [Str]
  MOVZX EDX, [Chr]
  {$ENDIF}
        PUSH    EDI
        PUSH    EAX
        MOV     EDI,Str
        OR      ECX, -1
        XOR     AL,AL
        REPNE   SCASB
        NOT     ECX
        POP     EDI
        XCHG    EAX, EDX
        REPNE   SCASB

        XCHG    EAX, EDI
        POP     EDI

        JE      @@1
        XOR     EAX, EAX
        RET

@@1:    DEC     EAX
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ENDIF PAS_ONLY}

{$IFDEF PAS_ONLY}
function StrRScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
begin
    Result := nil;
    while Str^ <> #0 do
    begin
        if Str^ = Chr then Result := Str;
        inc(Str);
    end;
    if Result = nil then
       Result := Str;
end;
{$ELSE}
function StrRScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; assembler;
asm
  {$IFDEF F_P}
        MOV     EAX, [Str]
        MOVZX   EDX, [Chr]
  {$ENDIF F_P}
        PUSH    EDI
        MOV     EDI,Str
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        NOT     ECX
        STD
        DEC     EDI
        MOV     AL,Chr
        REPNE   SCASB
        MOV     EAX,0
        JNE     @@1
        MOV     EAX,EDI
        INC     EAX
@@1:    CLD
        POP     EDI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ENDIF PAS_ONLY}

{$IFDEF PAS_ONLY}
function StrScanLen(Str: PAnsiChar; Chr: AnsiChar; Len: Integer): PAnsiChar;
begin
    while (Str^ <> #0) and (Len > 0) do
    begin
        if Str^ = Chr then break;
        inc(Str);
        dec(Len);
    end;
    Result := Str;
end;
{$ELSE}
function StrScanLen(Str: PAnsiChar; Chr: AnsiChar; Len: Integer): PAnsiChar; assembler;
asm
  {$IFDEF F_P}
        MOV     EAX, [Str]
        MOVZX   EDX, [Chr]
        MOV     ECX, [Len]
  {$ENDIF F_P}
        PUSH    EDI
        XCHG    EDI, EAX
        XCHG    EAX, EDX
        REPNE   SCASB
        XCHG    EAX, EDI
        POP     EDI
        { -> EAX => to next character after found or to the end of Str,
             ZF = 0 if character found. }
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ENDIF}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TrimLeft(const S: KOLString): KOLString;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= ' ') do Inc(I);
  Result := Copy(S, I, Maxint);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TrimRight(const S: KOLString): KOLString;
var
  I: Integer;
begin
  I := Length(S);
  while (I > 0) and (S[I] <= ' ') do Dec(I);
  Result := Copy(S, 1, I);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function Trim( const S : KOLString): KOLString;
begin
   Result := TrimLeft( TrimRight( S ) );
end;
{$ENDIF PAS_VERSION}

function RemoveSpaces( const S: KOLString ): KOLString;
var I: Integer;
begin
  Result := S;
  for I := Length( S ) downto 1 do
    if S[ I ] <= ' ' then Delete( Result, I, 1 );
end;

{$IFDEF PAS_ONLY}
procedure Str2LowerCase( S: PAnsiChar );
begin
    while S^ <> #0 do
    begin
        if (S^ >= 'A') and (S^ <= 'Z') then
            S^ := AnsiChar(Ord(S^)+32);
        inc(S);
    end;
end;
{$ELSE}
procedure Str2LowerCase( S: PAnsiChar );
asm
  {$IFDEF F_P}
        MOV      EAX, [S]
  {$ENDIF}
        XOR      ECX, ECX
@@1:
        MOV      CL, byte ptr [EAX]
        JECXZ    @@exit  {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        SUB      CL, 'A'
        CMP      CL, 'Z'-'A'
        JA       @@2
        ADD      byte ptr [EAX], 32
@@2:    INC      EAX
        JMP      @@1
@@exit:
end {$IFDEF F_P} [ 'EAX', 'ECX' ] {$ENDIF};
{$ENDIF PAS_ONLY}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function LowerCase(const S: Ansistring): Ansistring;
var I : Integer;
begin
  Result := S;
  for I := 1 to Length( S ) do
      if  (Result[ I ] >= 'A') and (Result[ I ] <= 'Z') then
          Inc( Result[ I ], 32 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function UpperCase(const S: Ansistring): Ansistring;
var I : Integer;
begin
  Result := S;
  for I := 1 to Length( S ) do
      if  (Result[ I ] >= 'a') and (Result[ I ] <= 'z') then
          Dec( Result[ I ], 32 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF F_P}
function DummyStrFun( const S: AnsiString ): AnsiString;
begin
  Result := S;
end;
{$ENDIF F_P}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function CopyEnd( const S : KOLString; Idx : Integer ) : KOLString;
begin
  Result := Copy( S, Idx, MaxInt );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function CopyTail( const S : KOLString; Len : Integer ) : KOLString;
var L : Integer;
begin
  L := Length( S );
  if L < Len then
     Len := L;
  Result := '';
  if Len = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := Copy( S, L - Len + 1, Len );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
procedure DeleteTail( var S : KOLString; Len : Integer );
var L : Integer;
begin
  L := Length( S );
  if Len > L then
     Len := L;
  Delete( S, L - Len + 1, Len );
end;
{$ENDIF PAS_VERSION}

{$IFNDEF TEST_INDEXOFCHARS_COMPAT}
{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function IndexOfChar( const S : KOLString; Chr : KOLChar ) : Integer;
var //P, F : PChar;
 i, l : integer;
begin
 Result := -1;
 if S = '' then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 l := Length(S);
 for I := 1 to l do
  begin
   if S[I] = Chr then
    begin
     Result := I;
     break;
    end;
  end;
end;
{$ENDIF PAS_VERSION}
{$ELSE TEST_INDEXOFCHARS_COMPAT}////////////////////////////////////////////////
function IndexOfChar_Old( const S : AnsiString; Chr : AnsiChar ) : Integer;
var P, F : PAnsiChar;
begin
   P := PAnsiChar( S );
   F := StrScan( P, Chr );
   Result := -1;
   if F = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   Result := Integer( F ) - Integer( P ) + 1;
end; ///////////////////////////////////////////////////////////////////////////
function IndexOfChar_New( const S : AnsiString; Chr : AnsiChar ) : Integer;
var P, F : PAnsiChar;
begin
   P := PAnsiChar( S );
   F := StrScanLen( P, Chr, Length( S ) );
   Result := -1;
   if F = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   Result := Integer( F ) - Integer( P );
   if {(Result > Length(S)) or} (S[ Result ] <> Chr) then
     Result := -1;
end; ///////////////////////////////////////////////////////////////////////////
function Replace0with_( const s: AnsiString ): AnsiString;
var i: Integer;
begin
  Result := s;
  for i := 1 to Length( s ) do
      if s[i] = #0 then Result[i] := '_';
end;
function IndexOfChar( const S : KOLString; Chr : KOLChar ) : Integer;
begin
   Result := IndexOfChar_Old( S, Chr );
   if Result <> IndexOfChar_New( S, Chr ) then
   begin
     LogFileOutput( 'c:\kol\TEST_INDEXOFCHARS_COMPAT.txt',
       'S=' + Replace0with_( S ) + #13#10 +
       'C=' + Replace0with_( Chr ) + ' Old=' + Int2Str( Result ) +
       ' New=' + Int2Str( IndexOfChar_New( S, Chr ) ) + #13#10 );
   end;
end;
{$ENDIF}

{$IFDEF _D3orHigher}
function WIndexOfChar( const S : KOLWideString; Chr : WideChar ) : Integer;
var i, l : integer;
begin
 Result := -1;
 if  S = '' then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 l := Length(S);
 for I := 1 to l do
 begin
     if  S[I] = Chr then
     begin
         Result := I;
         break;
     end;
 end;
end;
{$ENDIF}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function IndexOfCharsMin( const S, Chars : KOLString ) : Integer;
var I, J : Integer;
begin
  Result := -1;
  for I := 1 to Length( Chars ) do
  begin
    J := IndexOfChar( S, Chars[ I ] );
    if J > 0 then
    begin
      if (Result <= 0) or (J < Result) then
         Result := J;
    end;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF _D3orHigher}
function WIndexOfCharsMin( const S, Chars : KOLWideString ) : Integer;
var I, J : Integer;
begin
  Result := -1;
  for I := 1 to Length( Chars ) do
  begin
    J := WIndexOfChar( S, Chars[ I ] );
    if J > 0 then
    begin
      if (Result <= 0) or (J < Result) then
         Result := J;
    end;
  end;
end;
{$ENDIF}

{$IFNDEF _FPC}
{$IFNDEF _D2}
function IndexOfWideCharsMin( const S, Chars : KOLWideString ) : Integer;
var I, J : Integer;
begin
  Result := -1;
  for I := 1 to Length( Chars ) do
  begin
    J := pos( Chars[ I ], S );
    if J > 0 then
    begin
      if (Result < 0) or (J < Result) then
         Result := J;
    end;
  end;
end;
{$ENDIF _D2}
{$ENDIF _FPC}

        {$DEFINE ASM_LOCAL}
{$IFDEF PAS_VERSION}  {$UNDEF ASM_LOCAL}{$ENDIF}
{$IFDEF UNICODE_CTRLS}{$UNDEF ASM_LOCAL}{$ENDIF}
{$IFDEF _D2}          {$UNDEF ASM_LOCAL}{$ENDIF}
{$IFDEF _D3}          {$UNDEF ASM_LOCAL}{$ENDIF}

{$IFDEF ASM_LOCAL}
function IndexOfStr( const S, Sub : KOLString ) : Integer;
asm
        PUSH     EBX
        PUSH     ESI
        PUSH     EDI

        PUSH     EAX
        MOV      EAX, EDX
        PUSH     EDX
        CALL     System.@LStrLen
        MOV      EDI, EAX
        POP      EAX
        CALL     EAX2PChar
        MOV      BL, [EAX]
        XCHG     EAX, [ESP]
        CALL     EAX2PChar

        MOV      ESI, EAX

        DEC      EAX
@@1:    INC      EAX
        MOV      DL, BL
        MOV      ECX, [ESI-4]
        SUB      ECX, EAX
        ADD      ECX, ESI

        CMP      ECX, EDI
        JL       @@ret__1

        CALL     StrScanLen
        TEST     EAX, EAX
        JE       @@exit__1
        DEC      EAX

        POP      EDX
        PUSH     EDX

        MOV      ECX, EDI
        PUSH     EAX
        //CALL     StrLComp
        CALL     CompareMem
        TEST     AL, AL
        POP      EAX
        JZ       @@1

        SUB      EAX, ESI
        INC      EAX
        JMP      @@exit

@@ret__1:
        XOR      EAX, EAX
@@exit__1:
        DEC      EAX
@@exit:
        POP      EDX
        POP      EDI
        POP      ESI
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function IndexOfStr( const S, Sub : KOLString ) : Integer;
begin
  Result := pos( Sub, S );
  if  Result = 0 then Result := -1;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function Parse( var S : KOLString; const Separators : KOLString ) : KOLString;
var Pos : Integer;
begin
  Pos := IndexOfCharsMin( S, Separators );
  if Pos <= 0 then
     Pos := Length( S )+1;
  Result := Copy( S, 1, Pos-1 );
  Delete( S, 1, Pos );
end;
{$ENDIF PAS_VERSION}

{$IFDEF _D3orHigher}
function ParseW( var S : KOLWideString; const Separators : KOLWideString ) : KOLWideString;
var Pos : Integer;
begin
  Pos := WIndexOfCharsMin( S, Separators );
  if Pos <= 0 then
     Pos := Length( S )+1;
  Result := Copy( S, 1, Pos-1 );
  Delete( S, 1, Pos );
end;
{$ENDIF}

{$IFNDEF _FPC}
{$IFNDEF _D2}
function WParse( var S : KOLWideString; const Separators : KOLWideString ) : KOLWideString;
var Pos : Integer;
begin
  Pos := IndexOfWideCharsMin( S, Separators );
  if Pos <= 0 then
     Pos := Length( S ) + 1;
  Result := S;
  S := Copy( Result, Pos + 1, MaxInt );
  Result := Copy( Result, 1, Pos - 1 );
end;
{$ENDIF _D2}
{$ENDIF _FPC}

function ParsePascalString( var S : KOLString; const Separators : KOLString ) : KOLString;
var Pos, Idx : Integer;
    Hex, Spc : Boolean;
    procedure SkipSpaces;
    begin
      if not Spc then
        while (Length( S ) >= Pos) and (S[ Pos ] = ' ') do
          Inc( Pos );
    end;
var Buf : KOLString;
    Ou, Val : Integer;
begin
  Pos := 1;
  Spc := IndexOfChar( Separators, ' ' ) >= 0;
  SkipSpaces;
  if Length( S ) < Pos then
  begin
    Result := S;
    S := '';
    exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Buf := PKOLChar( S );
  Ou := 1;
  if (S[ Pos ] = '''') or (S[ Pos ] = '#') then
  begin
    // skip here string constant expression
    while Pos <= Length( S ) do
    begin
      if S[ Pos ] = '''' then
      begin
          Inc( Pos );
          while Pos <= Length( S ) do
          begin
              if  S[ Pos ] = '''' then
                  if (Pos = Length( S )) or (S[ Pos+1 ] <> '''') then
                  begin
                      Inc( Pos );
                      break;
                  end else Inc( Pos );
              Buf[ Ou ] := S[ Pos ];
              Inc( Ou );
              Inc( Pos );
          end;
      end else
      if S[ Pos ] = '#' then
      begin
          Inc( Pos ); Hex := False; Val := 0;
          if (Pos < Length( S )) and (S[ Pos ] = '$') then
          begin
             Inc( Pos ); Hex := True;
          end;
          Dec( Pos );
          while Pos < Length( S ) do
          begin
            Inc( Pos );
            if  (S[ Pos ] >= '0') and (S[ Pos ] <= '9') or
                Hex and ( (S[ Pos ] >= 'a') and (S[ Pos ] <= 'f') or
                          (S[ Pos ] >= 'A') and (S[ Pos ] <= 'F') ) then
            begin
                if   Hex then
                     Val := Val * 16
                else Val := Val * 10;
                if   S[ Pos ] <= '9' then
                     Val := Val + Integer( S[ Pos ] ) - Integer( '0' )
                else if S[ Pos ] <= 'F' then
                     Val := Val + 10 + Integer( S[ Pos ] ) - Integer( 'A' )
                else Val := Val + 10 + Integer( S[ Pos ] ) - Integer( 'a' );
                continue;
            end;
            Inc( Pos ); break;
          end;
          Buf[ Ou ] := KOLChar( Val );
          Inc( Ou );
      end else break;
      SkipSpaces;
      if S[ Pos ] <> '+' then break;
      SkipSpaces;
    end;
  end;
  Idx := IndexOfCharsMin( CopyEnd( S, Pos ), Separators );
  if  Idx <= 0 then
  begin
      Result := Copy( Buf, 1, Ou - 1 ) + CopyEnd( S, Pos );
      S := '';
  end else
  begin
      Result := Copy( Buf, 1, Ou - 1 ) + Copy( S, Pos, Idx - 1 );
      S := CopyEnd( S, Pos + Idx );
  end;
end;

function String2PascalStrExpr( const S : KOLString ) : KOLString;
var I, Strt : Integer;
  function String2DoubleQuotas( const S : KOLString ) : KOLString;
  var I, J : Integer;
  begin
    if IndexOfChar( S, '''' ) <= 0 then
       Result := S
    else
    begin
      J := 0;
      for I := 1 to Length( S ) do
        if S[ I ] = '''' then Inc( J );
      SetLength( Result, Length( S ) + J );
      J := 1;
      for I := 1 to Length( S ) do
      begin
        Result[ J ] := S[ I ];
        Inc( J );
        if S[ I ] = '''' then
        begin
          Result[ J ] := '''';
          Inc( J );
        end;
      end;
    end;
  end;
begin
  Result := '';
  if S = '' then
  begin
    Result := '''''';
    exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Strt := 1;
  for I := 1 to Length( S ) + 1 do
  begin
    if (I > Length( S )) or (S[ I ] < ' ') or (S[ I ] >= #$7F) then
    begin
      if (I > Strt) and (I > 1) then
      begin
        if Result <> '' then
           Result := Result + '+';
        Result := Result + '''' + String2DoubleQuotas( Copy( S, Strt, I - Strt ) ) + '''';
      end;
      if I > Length( S ) then break;
      if   Result <> '' then
           Result := Result + '+'
      else Result := Result + '''''+';
      Result := Result + '#' + Int2Str( Integer( S[ I ] ) );
      Strt := I + 1;
    end;
  end;
end;

{$IFDEF PAS_ONLY}
function CompareMem(P1, P2: Pointer; Length: Integer): Boolean;
var PP1, PP2: PByte;
begin
    Result := FALSE;
    PP1 := P1;
    PP2 := P2;
    while (Length > 0) do
    begin
        if  (PP1^ <> PP2^) then
            Exit; //>>>>>>>>>>>>>>>>>>>>>>>>
        inc(PP1);
        inc(PP2);
        dec(Length);
    end;
    Result := TRUE;
end;
{$ELSE}
function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; assembler;
asm
  {$IFDEF F_P}
        MOV     EAX, [P1]
        MOV     EDX, [P2]
        MOV     ECX, [Length]
  {$ENDIF}
        PUSH    ESI
        PUSH    EDI
        MOV     ESI,P1
        MOV     EDI,P2
        MOV     EDX,ECX
        XOR     EAX,EAX
        AND     EDX,3
        SHR     ECX,1
        SHR     ECX,1
        REPE    CMPSD
        JNE     @@2
        MOV     ECX,EDX
        REPE    CMPSB
        JNE     @@2
@@1:    INC     EAX
@@2:    POP     EDI
        POP     ESI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ENDIF}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function AllocMem( Size : Integer ) : Pointer;
begin
   Result := nil;
   if Size > 0 then
   begin
     GetMem( Result, Size );
     //FillChar( Result^, Size, 0 );
     ZeroMemory( Result, Size );
   end;
end;
{$ENDIF PAS_VERSION}

procedure DisposeMem( var Addr : Pointer );
begin
   if Addr <> nil then
      FreeMem( Addr );
   Addr := nil;
end;

{$IFDEF WIN}
function AnsiUpperCase(const S: AnsiString): AnsiString;
var Len: Integer;
begin
  Len := Length(S);
  SetString(Result, PAnsiChar(S), Len);
  if Len > 0 then CharUpperBuffA(Pointer(Result), Len);
end;

function AnsiLowerCase(const S: Ansistring): Ansistring;
var
  Len: Integer;
begin
  Len := Length(S);
  SetString(Result, PAnsiChar(S), Len);
  if Len > 0 then CharLowerBuffA(Pointer(Result), Len);
end;

function KOLUpperCase(const S: KOLString): KOLString;
var Len: Integer;
begin
  Len := Length(S);
  SetString(Result, PKOLChar( S ), Len);
  if Len > 0 then CharUpperBuff(PKOLChar(Result), Len);
end;

function KOLLowerCase(const S: KOLString): KOLString;
var
  Len: Integer;
begin
  Len := Length(S);
  SetString(Result, PKOLChar(S), Len);
  if Len > 0 then CharLowerBuff(PKOLChar(Result), Len);
end;

{$IFDEF _D3orHigher}
function WUpperCase(const S: KOLWideString): KOLWideString;
var Len: Integer;
begin
  Len := Length(S);
  SetString(Result, PWideChar( S ), Len);
  if Len > 0 then CharUpperBuffW(PWideChar(Result), Len);
end;

function WLowerCase(const S: KOLWideString): KOLWideString;
var
  Len: Integer;
begin
  Len := Length(S);
  SetString(Result, PWideChar(S), Len);
  if Len > 0 then CharLowerBuffW(PWideChar(Result), Len);
end;
{$ENDIF}
{$ENDIF WIN}

{$IFNDEF _D2}
{$IFNDEF _FPC}

{$IFDEF WIN}
function WAnsiUpperCase(const S: KOLWideString): KOLWideString;
var Len: Integer;
begin
  Result := S;
  Len := Length(S);
  if Len > 0 then CharUpperBuffW(Pointer(Result), Len);
end;
{$ENDIF WIN}

{$IFDEF WIN}
function WAnsiLowerCase(const S: KOLWideString): KOLWideString;
var Len: Integer;
begin
  Result := S;
  Len := Length(S);
  if Len > 0 then CharLowerBuffW(Pointer(Result), Len);
end;
{$ENDIF WIN}

{$IFDEF WIN}
function WStrComp(const S1, S2: KOLWideString): Integer;
var i: Integer;
begin
  for i := 1 to min( Length( S1 ), Length( S2 ) ) do
  begin
    Result := Ord( S1[ i ] ) - Ord( S2[ i ] );
    if Result <> 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Result := Length( S1 ) - Length( S2 );
end;

{$IFDEF ASM_VERSION}{$ELSE}
function _WStrComp(S1, S2: PWideChar): Integer;
var
  L, R : PWideChar;
begin
  L := S1;
  R := S2;
  Result := 0;
  repeat
    if L^ = R^ then
    begin
      if L^ = #0 then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      Inc(L);
      Inc(R);
    end else
    begin
      Result := (Word(L^) - Word(R^));
      exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  until (False);
end;
{$ENDIF}

{$IFDEF PAS_ONLY}
function _WStrLComp(S1, S2: PWideChar; Len: Integer): Integer;
begin
    while (Len > 0) and (S1^ <> #0) and (S2^ <> #0) do
    begin
        Result :=  Ord(S1^) - Ord(S2^);
        if Result <> 0 then Exit; // >>>>>>>>>>>>>>>>>>>>
        dec(Len);
    end;
    Result := 0;
end;
{$ELSE}
function _WStrLComp(S1, S2: PWideChar; Len: Integer): Integer;
asm
  {$IFDEF F_P}
        MOV     EAX, [S1]
        MOV     EDX, [S2]
        MOV     ECX, [Len]
  {$ENDIF F_P}
        PUSH    EDI
        PUSH    ESI
        MOV     EDI,EDX
        XCHG    ESI,EAX
        CMP     EAX, EAX
        REPE    CMPSW
        MOVZX   EAX, word ptr [ESI-2]
        MOVZX   EDX, word ptr [EDI-2]
        SUB     EAX,EDX
        POP     ESI
        POP     EDI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ENDIF}

function WStrScan(Str: PWideChar; Chr: WideChar): PWideChar;
begin
  while (Str^ <> Chr) and (Str^ <> #0) do inc( Str );
  Result := Str;
end;

function WStrRScan(const Str: PWideChar; Chr: WideChar): PWideChar;
begin
  Result := Str;
  while Result^ <> #0 do inc( Result );
  while (DWORD( Result ) >= DWORD( Str )) and
        (Result^ <> Chr) do dec( Result );
  if (DWORD( Result ) < DWORD( Str )) then
    Result := nil;
end;
{$ENDIF WIN}
{$ENDIF _FPC}
{$ENDIF _D2}

{$IFDEF WIN}
function AnsiCompareStr(const S1, S2: KOLString): Integer;
begin
  Result := CompareString(LOCALE_USER_DEFAULT, 0, PKOLChar(S1), -1, PKOLChar(S2), -1 ) - 2;
end;
{$ENDIF WIN}

{$IFDEF WIN}
function AnsiCompareStrA(const S1, S2: AnsiString): Integer;
begin
  Result := CompareStringA(LOCALE_USER_DEFAULT, 0, PAnsiChar(S1), -1, PAnsiChar(S2), -1 ) - 2;
end;
{$ENDIF WIN}

{$IFDEF WIN}
function _AnsiCompareStr(S1, S2: PKOLChar): Integer;
begin
  Result := CompareString( LOCALE_USER_DEFAULT, 0, S1, -1,
                           S2, -1) - 2;
end;
{$ENDIF WIN}

type
    TSortAnsiRec = record
        A: array[ AnsiChar ] of PAnsiChar;
    end;
    PSortAnsiRec = ^TSortAnsiRec;
var SortAnsiOrderNoCase: array[ AnsiChar ] of SmallInt;
    SortAnsiOrder: array[ AnsiChar ] of SmallInt;

{$IFDEF WIN}
function _AnsiCompareStrA_Slow(S1, S2: PAnsiChar): Integer;
begin
  Result := CompareStringA( LOCALE_USER_DEFAULT, 0, S1, -1,
                           S2, -1) - 2;
end;
{$ENDIF WIN}

function CompareAnsiRec( R: PSortAnsiRec; const e1, e2: Integer ): Integer;
begin
    Result := _AnsiCompareStrA_Slow(
        R.A[AnsiChar(e1)],
        R.A[AnsiChar(e2)]
    );
end;

procedure SwapAnsiRec( R: PSortAnsiRec; const e1, e2: Integer );
{$IFDEF PAS_ONLY}
var a: PAnsiChar;
{$ENDIF}
begin
    {$IFDEF PAS_ONLY}
    a := R.A[AnsiChar(e1)];
    R.A[AnsiChar(e1)] := R.A[AnsiChar(e2)];
    R.A[AnsiChar(e2)] := a;
    {$ELSE}
    Swap( Integer( R.A[AnsiChar(e1)] ),
          Integer( R.A[AnsiChar(e2)] ) );
    {$ENDIF}
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
function _AnsiCompareStrA_Fast2(S1, S2: PAnsiChar): Integer;
begin
    if  S1 = nil then
        S1 := '';
    if  S2 = nil then
        S2 := '';
    Result := 0;
    while TRUE do
    begin
        Result := SortAnsiOrder[ S1^ ] - SortAnsiOrder[ S2^ ];
        if  Result <> 0 then break;
        if  (S1^ = #0) or (S2^ = #0) then break;
        inc( S1 );
        inc( S2 );
    end;
end;
{$ENDIF PAS_VERSION}

function _AnsiCompareStrA_Fast(S1, S2: PAnsiChar): Integer;
var c: AnsiChar;
    R: TSortAnsiRec;
    Buf: array[ 0..511 ] of AnsiChar;
    P: PAnsiChar;
begin
    P := @Buf[0];
    for c := Low(c) to High(c) do
    begin
        P^ := c;
        R.A[c] := P;
        inc( P );
        P^ := #0;
        inc( P );
    end;
    SortData( @R, 256, @CompareAnsiRec, @SwapAnsiRec );
    for c := Low(c) to High(c) do
        SortAnsiOrder[AnsiChar(R.A[c][0])] := Ord(c);
    _AnsiCompareStrA := _AnsiCompareStrA_Fast2;
    Result := _AnsiCompareStrA_Fast2( S1, S2 );
end;

{$IFDEF WIN}
function AnsiCompareStrNoCase(const S1, S2: KOLString): Integer;
begin
  Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PKOLChar(S1), -1,
    PKOLChar(S2), -1 ) - 2;
end;
{$ENDIF WIN}

{$IFDEF WIN}
function AnsiCompareStrNoCaseA(const S1, S2: AnsiString): Integer;
begin
  Result := CompareStringA(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PAnsiChar(S1), -1,
    PAnsiChar(S2), -1 ) - 2;
end;
{$ENDIF WIN}

{$IFDEF WIN}
function _AnsiCompareStrNoCase(S1, S2: PKOLChar): Integer;
begin
  Result := CompareString( LOCALE_USER_DEFAULT, NORM_IGNORECASE, S1, -1,
                           S2, -1) - 2;
end;
{$ENDIF WIN}

{$IFDEF WIN}
function _AnsiCompareStrNoCaseA_Slow(S1, S2: PAnsiChar): Integer;
begin
  Result := CompareStringA( LOCALE_USER_DEFAULT, NORM_IGNORECASE, S1, -1,
                           S2, -1) - 2;
end;
{$ENDIF WIN}

function CompareAnsiRecNoCase( R: PSortAnsiRec; const e1, e2: Integer ): Integer;
begin
    Result := _AnsiCompareStrNoCaseA_Slow(
        R.A[AnsiChar(e1)] + 1,
        R.A[AnsiChar(e2)] + 1
    );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
//{$DEFINE DEBUG_SORTFAST}
{$IFDEF DEBUG_SORTFAST}
var DBSF: Integer;
{$ENDIF}
function _AnsiCompareStrNoCaseA_Fast2(S1, S2: PAnsiChar): Integer;
{$IFDEF DEBUG_SORTFAST}
var S01, S02: PChar;
{$ENDIF}
begin
    if  S1 = nil then
        S1 := '';
    if  S2 = nil then
        S2 := '';
    {$IFDEF DEBUG_SORTFAST}
    S01 := S1;
    S02 := S2;
    {$ENDIF}
    Result := 0;
    while TRUE do
    begin
        Result := SortAnsiOrderNoCase[ S1^ ] - SortAnsiOrderNoCase[ S2^ ];
        if  Result <> 0 then break;
        if  (S1^ = #0) or (S2^ = #0) then break;
        inc( S1 );
        inc( S2 );
    end;
    {$IFDEF DEBUG_SORTFAST}
    inc( DBSF );
    if   Result < 0 then
         LogFileOutput( GetStartDir + 'LT.txt', Int2Str( DBSF ) + ': ' +
             '"' + S01 + '" < "' + S02 + '"' )
    else if  Result > 0 then
         LogFileOutput( GetStartDir + 'GT.txt', Int2Str( DBSF ) + ': ' +
             '"' + S01 + '" > "' + S02 + '"' )
    else LogFileOutput( GetStartDir + 'EQ.txt', Int2Str( DBSF ) + ': ' +
            '"' + S01 + '" = "' + S02 + '"' )
    {$ENDIF}
end;
{$ENDIF PAS_VERSION}

function _AnsiCompareStrNoCaseA_Fast(S1, S2: PAnsiChar): Integer;
var c: AnsiChar;
    R: TSortAnsiRec;
    Buf: array[ 0..767 ] of AnsiChar;
    P: PAnsiChar;
    {$IFDEF PAS_ONLY}
    a: PAnsiChar;
    {$ENDIF}
begin
    P := @Buf[0];
    for c := Low(c) to High(c) do
    begin
        R.A[c] := P;
        P^ := c;
        inc( P );
        P^ := AnsiLowerCase( c )[1];
        inc( P );
        P^ := #0;
        inc( P );
        //R.X[c] := Ord(c);
    end;
    SortData( @R, 256, @CompareAnsiRecNoCase, @SwapAnsiRec );
    for c := Succ(Low(c)) to High(c) do
    begin
        //R.X[c] := Byte(c);
        if _AnsiCompareStrNoCaseA_Slow( R.A[Pred(c)] + 1, R.A[c] + 1 ) = 0 then
        begin
            if  _AnsiCompareStrA( R.A[Pred(c)], R.A[c] ) < 0 then
            begin
                {$IFDEF PAS_ONLY}
                a := R.A[Pred(c)];
                R.A[Pred(c)] := R.A[c];
                R.A[c] := a;
                {$ELSE}
                Swap( Integer( R.A[Pred(c)] ), Integer( R.A[c] ) );
                {$ENDIF}
            end;
        end;
        //   R.X[c] := R.X[Pred(c)];
    end;
    for c := Low(c) to High(c) do
        SortAnsiOrderNoCase[AnsiChar(R.A[c][0])] := Ord( R.A[c][1] ); // Ord(c); // R.X[c];
    _AnsiCompareStrNoCaseA := _AnsiCompareStrNoCaseA_Fast2;
    Result := _AnsiCompareStrNoCaseA_Fast2( S1, S2 );
end;

function AnsiCompareText( const S1, S2: KOLString ): Integer;
begin
  Result := AnsiCompareStrNoCase( S1, S2 );
end;

function AnsiCompareTextA( const S1, S2: AnsiString ): Integer;
begin
  Result := AnsiCompareStrNoCaseA( S1, S2 );
end;

{$IFDEF PAS_ONLY}
function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar;
var Src: PAnsiChar;
begin
    Src := Source;
    while MaxLen > 0 do
    begin
        Dest^ := Src^;
        if Src^ = #0 then break;
        inc(Dest);
        inc(Src);
        dec(MaxLen);
    end;
    Result := Dest;
end;
{$ELSE}
function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; assembler;
asm
  {$IFDEF F_P}
        MOV     EAX, [Dest]
        MOV     EDX, [Source]
        MOV     ECX, [MaxLen]
  {$ENDIF F_P}
        PUSH    EDI
        PUSH    ESI
        PUSH    EBX
        MOV     ESI,EAX
        MOV     EDI,EDX
        MOV     EBX,ECX
        XOR     AL,AL
        TEST    ECX,ECX
        JZ      @@1
        REPNE   SCASB
        JNE     @@1
        INC     ECX
@@1:    SUB     EBX,ECX
        MOV     EDI,ESI
        MOV     ESI,EDX
        MOV     EDX,EDI
        MOV     ECX,EBX
        SHR     ECX,2
        REP     MOVSD
        MOV     ECX,EBX
        AND     ECX,3
        REP     MOVSB
        STOSB
        MOV     EAX,EDX
        POP     EBX
        POP     ESI
        POP     EDI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ENDIF}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function StrPCopy(Dest: PAnsiChar; const Source: Ansistring): PAnsiChar;
begin
  Result := StrLCopy(Dest, PAnsiChar(Source), Length(Source));
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function StrEq( const S1, S2 : AnsiString ) : Boolean;
begin
  Result := (Length( S1 ) = Length( S2 )) and
            (LowerCase( S1 ) = LowerCase( S2 ));
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function AnsiEq( const S1, S2 : KOLString ) : Boolean;
begin
  Result := AnsiCompareStrNoCase( S1, S2 ) = 0;
end;
{$ENDIF PAS_VERSION}

{$IFNDEF _D2}
{$IFNDEF _FPC}
function WAnsiEq( const S1, S2 : KOLWideString ) : Boolean;
begin
  Result := WAnsiLowerCase( S1 )=WAnsiLowerCase( S2 );
end;
{$ENDIF _FPC}
{$ENDIF _D2}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function StrIn(const S: AnsiString; const A: array of AnsiString): Boolean;
var I : Integer;
begin
  for I := Low( A ) to High( A ) do
      if  StrEq( S, A[ I ] ) then
      begin
          Result := True; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
  Result := False;
end;
{$ENDIF PAS_VERSION}

{$IFNDEF _D2}
{$IFNDEF _FPC}
function WStrIn( const S : KOLWideString; const A : array of KOLWideString ) : Boolean;
var I : Integer;
begin
  for I := Low( A ) to High( A ) do
      if WAnsiEq( S, A[ I ] ) then
      begin
        Result := True; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
  Result := False;
end;
{$ENDIF _FPC}
{$ENDIF _D2}

function CharIn( C: KOLChar; const A: TSetofChar ): Boolean;
begin
  Result := (DWord( C ) <= 255) and (AnsiChar( C ) in A);
end;

function StrIs( const S : AnsiString; const A : Array of AnsiString; var Idx: Integer ) : Boolean;
var I : Integer;
begin
  Idx := -1;
  for I := Low( A ) to High( A ) do
      if StrEq( S, A[ I ] ) then
      begin
        Idx := I;
        Result := True; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
  Result := False;
end;

function IntIn( Value: Integer; const List: array of Integer ): Boolean;
var I: Integer;
begin
  Result := FALSE;
  for I := 0 to High( List ) do
  begin
    if Value = List[ I ] then
    begin
      Result := TRUE;
      break;
    end;
  end;
end;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function _StrSatisfy( S, Mask : PKOLChar ) : Boolean;
label next_char;
begin
next_char:
  Result := True;
  if (S^ = #0) and (Mask^ = #0) then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if (Mask^ = '*') and (Mask[1] = #0) then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if S^ = #0 then
  begin
    while Mask^ = '*' do
          Inc( Mask );
    Result := Mask^ = #0; exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Result := False;
  if Mask^ = #0 then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Mask^ = '?' then
  begin
    Inc( S ); Inc( Mask ); goto next_char;
  end;
  if Mask^ = '*' then
  begin
    Inc( Mask );
    while S^ <> #0 do
    begin
      Result := _StrSatisfy( S, Mask );
      if Result then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      Inc( S );
    end;
    exit; // (Result = False) {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Result := S^ = Mask^;
  Inc( S ); Inc( Mask );
  if Result then goto next_char;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function StrSatisfy( const S, Mask: KOLString ): Boolean;
begin
  Result := FALSE;
  if  (S = '') or (Mask = '') then Exit;
  Result := _StrSatisfy( PKOLChar( {$IFDEF UNICODE_CTRLS} WAnsiLowerCase
                                   {$ELSE} AnsiLowerCase {$ENDIF} ( S ) ),
                         PKOLChar( {$IFDEF UNICODE_CTRLS} WAnsiLowerCase
                                   {$ELSE} AnsiLowerCase {$ENDIF} ( Mask ) ) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} // Pascal
function _2StrSatisfy( S, Mask: PKOLChar ): Boolean;
begin
  Result := StrSatisfy( S, Mask );
end;
{$ENDIF PAS_VERSION}

function StrReplace( var S: KOLString; const From, ReplTo: KOLString ): Boolean;
var I: Integer;
begin
  I := pos( From, S );
  if  I > 0 then
  begin
      S := Copy( S, 1, I - 1 ) + ReplTo + CopyEnd( S, I + Length( From ) );
      Result := TRUE;
  end else Result := FALSE;
end;

function KOLStrReplace( var S: KOLString; const From, ReplTo: KOLString ): Boolean;
var I: Integer;
begin
  I := pos( From, S );
  if  I > 0 then
  begin
      S := Copy( S, 1, I - 1 ) + ReplTo + CopyEnd( S, I + Length( From ) );
      Result := TRUE;
  end else Result := FALSE;
end;

{$IFDEF _FPC}
procedure SetLengthW( var W: KOLWideString; NewLength: Integer );
begin
  while Length( W ) < NewLength do
    W := W + ' ' + W;
  if Length( W ) > NewLength then
    Delete( W, NewLength + 1, Length( W ) - NewLength );
end;

function CopyW( const W: KOLWideString; From, Count: Integer ): KOLWideString;
begin
  Result := '';
  if Count <= 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  SetLengthW( Result, Count );
  Move( W[ From ], Result[ 1 ], Count * Sizeof( WideChar ) );
end;

function posW( const S1, S2: AnsiString ): Integer;  // not used. When use, change AnsiString to WideString ?
var I, L1: Integer;
begin
  L1 := Length( S1 );
  for I := 1 to Length( S2 )-L1+1 do
  begin
    if Copy( S2, I, L1 ) = S1 then
    begin
      Result := I; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end;
  Result := 0;
end;
{$ENDIF _FPC}

{$IFDEF ASM_VERSION}
    procedure DoMove(const from; var to_; count: Integer);
    asm
        PUSH ESI
        PUSH EDI
        XCHG ESI, EAX
        MOV  EDI, EDX
        REP  MOVSB
        POP  EDI
        POP  ESI
    end;
{$ENDIF}

{$IFNDEF _FPC}
{$IFNDEF _D2}
function WStrReplace( var S: KOLWideString; const From, ReplTo: KOLWideString ): Boolean;
var I: Integer;
begin
  I := pos( From, S );
  if  I > 0 then
  begin
      S := Copy( S, 1, I - 1 ) + ReplTo + Copy( S, I + Length( From ), MaxInt );
      Result := TRUE;
  end else Result := FALSE;
end;

function WStrRepeat( const S: KOLWideString; Count: Integer ): KOLWideString;
var {$IFDEF ASM_VERSION} {$ELSE} I, {$ENDIF} L: Integer;
begin
  L := Length( S );
  SetLength( Result, L * Count );
  if  L = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$IFDEF ASM_VERSION}
  Move( S[1], Result[1], L * Sizeof(WideChar) );
  if  Count > 1 then
      DoMove( Result[1], Result[1+L], (Count-1)*L*Sizeof(WideChar) );
  {$ELSE}
  for I := 0 to Count-1 do
    Move( S[ 1 ], Result[ 1 + I * L ], L * Sizeof( WideChar ) );
  {$ENDIF PAS_VERSION}
end;
{$ENDIF _D2}
{$ENDIF _FPC}

{$IFDEF ASM_VERSION}
    {$IFDEF UNICODE_CTRLS}
    function StrRepeat( const S: KOLString; Count: Integer ): KOLString;
    var L: Integer;
    begin
        Result := '';
        L := Length(S);
        if  L = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        SetLength( Result, Count * Length( S ) );
        Move( S[1], Result[1], Length(S)*Sizeof(KOLChar) );
        if  Count > 1 then
            DoMove( Result[1], Result[1+Length(S)],
                    (Length(Result)-Length(S))*Sizeof(KOLChar) );
    end;
    {$ELSE notUNICODE}
function StrRepeat( const S: KOLString; Count: Integer ): KOLString;
asm
    PUSH EBX
    PUSH ESI
    PUSH EDI
    MOV  EBX, ECX
    MOV  EDI, EDX
    XCHG ESI, EAX

    MOV  EAX, ECX
    CALL System.@LStrClr
    TEST ESI, ESI
    JZ   @@exit
    MOV  EDX, [ESI-4]
    imul edx, EDI
    PUSH EDX
        MOV  EAX, EBX
        CALL System.@LStrSetLength
        PUSH ESI
        PUSH EDI
            MOV  ECX, [ESI-4]
            MOV  EDI, [EBX]
            REP  MOVSB
        POP  EAX
        POP  ESI
        DEC  EAX
    POP  ECX
    JLE  @@exit
    SUB  ECX, [ESI-4]
    MOV  ESI, [EBX]
    REP  MOVSB
@@exit:
    POP  EDI
    POP  ESI
    XCHG EAX, EBX
    POP  EBX
end;
{$ENDIF notUNICODE_CTRLS}
{$ELSE  ASM_VERSION}
function StrRepeat( const S: KOLString; Count: Integer ): KOLString;
var I, L: Integer;
begin
  L := Length( S );
  SetLength( Result, L * Count );
  for I := 0 to Count-1 do
      Move( S[ 1 ], Result[ 1 + I * L * Sizeof(KOLChar) ], L );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_noVERSION}
{$ELSE PAS_VERSION} //Pascal
procedure NormalizeUnixText( var S: AnsiString );
var I, J, N: Integer;
begin
  if S <> '' then
  begin
    N := 0;
    if S[ 1 ] = #10 then
    begin
      S[ 1 ] := #0;
      inc( N );
    end;
    for I := Length(S) downto 2 do
    begin
        if (S[I]=#10) and (S[I-1]<>#13) then
          S[I] := #0;
        if S[I] = #0 then inc( N );
    end;
    if N > 0 then
    begin
        SetLength( S, N+Length(S) );
        J := Length(S);
        for I := Length(S)-N downto 1 do
        begin
            if S[I] = #0 then
            begin
                S[J] := #10;
                S[J-1] := #13;
                dec( J );
            end else S[J] := S[I];
            dec(J);
        end;
    end;
  end;
end;
{$ENDIF PAS_VERSION}

var Koi8_to_Ansi: array[ Char ] of AnsiChar;
procedure Koi8ToAnsi( s: PAnsiChar );
var c: AnsiChar;
begin
  if Koi8_to_Ansi[ #1 ] = #0 then
  begin
    for c := #1 to #255 do
    begin
      Koi8_to_Ansi[ c ] := c;
      if (c >= #$C0) and (c <= #$FF) then
        Koi8_to_Ansi[ c ] := KOI8_Rus[ c ];
    end;
  end;
  while s^ <> #0 do
  begin
    s^ := Koi8_to_Ansi[ s^ ];
    inc( s );
  end;
end;

{$IFDEF PAS_ONLY}
function StrComp(const Str1, Str2: PAnsiChar): Integer;
var S1, S2: PAnsiChar;
begin
    S1 := Str1;
    S2 := Str2;
    while (S1^ <> #0) and (S2^ <> #0) do
    begin
        Result := Integer(Ord(S1^)) - Integer(Ord(S2^));
        if Result <> 0 then Exit;
        inc(S1);
        inc(S2);
    end;
    Result := 0;
end;
{$ELSE}
function StrComp(const Str1, Str2: PAnsiChar): Integer; assembler;
asm
  {$IFDEF F_P}
        MOV     EAX, [Str1]
        MOV     EDX, [Str2]
  {$ENDIF F_P}
        PUSH    EDI
        PUSH    ESI
        MOV     EDI,EDX
        XCHG    ESI,EAX
        OR      ECX, -1
        XOR     EAX,EAX
        REPNE   SCASB
        NOT     ECX
        MOV     EDI,EDX
        XOR     EDX,EDX
        REPE    CMPSB
        MOV     AL,[ESI-1]
        MOV     DL,[EDI-1]
        SUB     EAX,EDX
        POP     ESI
        POP     EDI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ENDIF PAS_ONLY}

var Upper: array[ AnsiChar ] of AnsiChar;
    Upper_initialized: Boolean;

procedure Init_Upper;
var c: AnsiChar;
    s: AnsiString;
begin
    if  not Upper_initialized then
    begin
        for c := Low(c) to High(c) do
        begin
            s := c + AnsiChar( ' ' );
            Upper[c] := AnsiUpperCase( s )[1];
        end;
        Upper_initialized := TRUE;
    end;
end;

{$IFDEF PAS_ONLY}
function StrLComp(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer;
var S1, S2: PAnsiChar;
    c1, c2: AnsiChar;
begin
    S1 := Str1;
    S2 := Str2;
    while (S1^ <> #0) and (S2^ <> #0) and (MaxLen > 0) do
    begin
        c1 := S1^;
        c2 := S2^;
        Result := Integer(c1) - Integer(c2);
        if Result <> 0 then Exit;
        inc(S1);
        inc(S2);
        dec(MaxLen);
    end;
    Result := 0;
end;

function StrLComp_NoCase(const Str1, Str2: PAnsiChar;  MaxLen: Cardinal): Integer;
var S1, S2: PAnsiChar;
    c1, c2: AnsiChar;
begin
    S1 := Str1;
    S2 := Str2;
    while (S1^ <> #0) and (S2^ <> #0) and (MaxLen > 0) do
    begin
        c1 := S1^;
        if (c1 >= 'a') and (c1 <= 'z') then
            c1 := AnsiChar(Ord(c1)-32);
        c2 := S2^;
        if (c2 >= 'a') and (c2 <= 'z') then
            c2 := AnsiChar(Ord(c2)-32);
        Result := Integer(c1) - Integer(c2);
        if Result <> 0 then Exit;
        inc(S1);
        inc(S2);
        dec(MaxLen);
    end;
    Result := 0;
end;

function StrComp_NoCase(const Str1, Str2: PAnsiChar): Integer;
var S1, S2: PAnsiChar;
    c1, c2: AnsiChar;
begin
    S1 := Str1;
    S2 := Str2;
    while (S1^ <> #0) and (S2^ <> #0) do
    begin
        c1 := S1^;
        if (c1 >= 'a') and (c1 <= 'z') then
            c1 := AnsiChar(Ord(c1)-32);
        c2 := S2^;
        if (c2 >= 'a') and (c2 <= 'z') then
            c2 := AnsiChar(Ord(c2)-32);
        Result := Integer(c1) - Integer(c2);
        if Result <> 0 then Exit;
        inc(S1);
        inc(S2);
    end;
    Result := 0;
end;
{$ELSE}

{$IFDEF SMALLER_CODE}
function StrComp_NoCase(const Str1, Str2: PAnsiChar): Integer;
asm
  {$IFDEF F_P}
        MOV     EAX, [Str1]
        MOV     EDX, [Str2]
  {$ENDIF F_P}
        PUSH    EDI
        PUSH    ESI
        MOV     EDI,EDX
        XCHG    ESI,EAX
        OR      ECX, -1
        XOR     EAX,EAX
        REPNE   SCASB

        NOT     ECX
        MOV     EDI,EDX
  @@0:
        XOR     EDX,EDX
        REPE    CMPSB
        MOV     AL,[ESI-1]
        MOV     AH, AL
        SUB     AH, 'a'
        CMP     AH, 25
        JA      @@1
        SUB     AL, $20
  @@1:
        MOV     DL,[EDI-1]
        MOV     AH, DL
        SUB     AH, 'a'
        CMP     AH, 25
        JA      @@2
        SUB     DL, $20
  @@2:
        MOV     AH, 0
        SUB     EAX,EDX
        JNZ     @@exit
        CMP     DL, 0
        JNZ     @@0

  @@exit:
        POP     ESI
        POP     EDI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};

function StrLComp_NoCase(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer;
asm
  {$IFDEF F_P}
        MOV     EAX, [Str1]
        MOV     EDX, [Str2]
        MOV     ECX, [MaxLen]
  {$ENDIF F_P}
        PUSH    EDI
        PUSH    ESI
        PUSH    EBX
        MOV     EDI,EDX
        MOV     ESI,EAX
        MOV     EBX,ECX
        XOR     EAX,EAX
        OR      ECX,ECX
        JE      @@exit
        REPNE   SCASB
        SUB     EBX,ECX
        MOV     ECX,EBX
        MOV     EDI,EDX
  @@0:
        XOR     EDX,EDX
        REPE    CMPSB
        MOV     AL,[ESI-1]
        MOV     AH, AL
        SUB     AH, 'a'
        CMP     AH, 25
        JA      @@1
        SUB     AL, $20
  @@1:
        MOV     DL,[EDI-1]
        MOV     AH, DL
        SUB     AH, 'a'
        CMP     AH, 25
        JA      @@2
        SUB     DL, $20
  @@2:
        MOV     AH, 0
        SUB     EAX,EDX
        JECXZ   @@exit
        JZ      @@0

  @@exit:
        POP     EBX
        POP     ESI
        POP     EDI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ELSE not SMALLER_CODE}
function StrComp_NoCase2(const Str1, Str2: PAnsiChar): Integer;
asm
  {$IFDEF F_P}
        MOV     EAX, [Str1]
        MOV     EDX, [Str2]
  {$ENDIF F_P}
        PUSH    ESI
        XCHG    ESI, EAX
  @@1:
        MOVZX   EAX, BYTE PTR [EDX]
        INC     EDX
        MOV     CL,  BYTE PTR [EAX+Upper]
        LODSB
        SUB     CL,  BYTE PTR [EAX+Upper]
        JNZ     @@fin
        CMP     AL,  CL
        JNZ     @@1
  @@fin:MOVSX   EAX, CL
        NEG     EAX
        POP     ESI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};

function StrComp_NoCase1(const Str1, Str2: PAnsiChar): Integer;
begin
    Init_Upper;
    StrComp_NoCase := @StrComp_NoCase2;
    Result := StrComp_NoCase2( Str1, Str2 );
end;

function StrLComp_NoCase2(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer;
asm
  {$IFDEF F_P}
        MOV     EAX, [Str1]
        MOV     EDX, [Str2]
        MOV     ECX, [MaxLen]
  {$ENDIF F_P}
        PUSH    EDI
        PUSH    ESI
        PUSH    EBX
        MOV     EDI,EDX
        XCHG    ESI,EAX
        XOR     EBX, EBX
        JECXZ   @@fin
  @@1:  MOVZX   EAX, BYTE PTR [EDI]
        INC     EDI
        MOV     BL, BYTE PTR [EAX+Upper]
        LODSB
        SUB     BL, BYTE PTR [EAX+Upper]
        JNZ     @@fin
        TEST    EAX, EAX
        JZ      @@fin
        LOOP    @@1
  @@fin:MOVSX   EAX, BL
        POP     EBX
        POP     ESI
        POP     EDI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};

function StrLComp_NoCase1(const Str1, Str2: PAnsiChar;  MaxLen: Cardinal): Integer;
begin
    Init_Upper;
    StrComp_NoCase := @StrComp_NoCase2;
    Result := StrLComp_NoCase2( Str1, Str2, MaxLen );
end;
{$ENDIF}

function StrLComp(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; assembler;
asm
  {$IFDEF F_P}
        MOV     EAX, [Str1]
        MOV     EDX, [Str2]
        MOV     ECX, [MaxLen]
  {$ENDIF F_P}
        PUSH    EDI
        PUSH    ESI
        PUSH    EBX
        MOV     EDI,EDX
        MOV     ESI,EAX
        MOV     EBX,ECX
        XOR     EAX,EAX
        OR      ECX,ECX
        JE      @@1
        REPNE   SCASB
        SUB     EBX,ECX
        MOV     ECX,EBX
        MOV     EDI,EDX
        XOR     EDX,EDX
        REPE    CMPSB
        MOV     AL,[ESI-1]
        MOV     DL,[EDI-1]
        SUB     EAX,EDX
@@1:    POP     EBX
        POP     ESI
        POP     EDI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ENDIF PAS_ONLY}

function StrLen(const Str: PAnsiChar): Cardinal; assembler;
asm
  {$IFDEF F_P}
        MOV     EAX, [Str]
  {$ENDIF F_P}
        XCHG    EAX, EDI
        XCHG    EDX, EAX
        OR      ECX, -1
        XOR     EAX, EAX
        CMP     EAX, EDI
        JE      @@exit0
        REPNE   SCASB
        DEC     EAX
        DEC     EAX
        SUB     EAX,ECX
@@exit0:
        MOV     EDI,EDX
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};

{$IFDEF ASM_UNICODE}
{$ELSE PAS_VERSION} //Pascal
function __DelimiterLast( Str, Delimiters: PKOLChar ): PKOLChar;
var
    P, F : PKOLChar;
begin
  P := Str;
  Result := P + {$IFDEF UNICODE_CTRLS} WStrLen {$ELSE} StrLen {$ENDIF}( Str );
  while Delimiters^ <> #0 do
  begin
    F := {$IFDEF UNICODE_CTRLS} WStrRScan {$ELSE} StrRScan {$ENDIF}
         ( P, Delimiters^ );
    if F <> nil then
    if (Result^ = #0) or (Integer(F) > Integer(Result)) then
       Result := F;
    Inc( Delimiters );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF _D3orHigher}
function W__DelimiterLast( Str, Delimiters: PWideChar ): PWideChar;
var
    P, F : PWideChar;
begin
  P := Str;
  Result := P + WStrLen( Str );
  while Delimiters^ <> #0 do
  begin
    F := WStrRScan( P, Delimiters^ );
    if F <> nil then
    if (Result^ = #0) or (Integer(F) > Integer(Result)) then
       Result := F;
    Inc( Delimiters );
  end;
end;
{$ENDIF _D3orHigher}

{$IFDEF WIN}
{$IFNDEF PARAMS_DEFAULT}
{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION}
function SkipSpaces( P: PKOLChar ): PKOLChar;
begin
  while (P[0] <> #0) and (P[0] <= ' ') do Inc(P);
  Result := P;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE}
function SkipParam(P: PKOLChar): PKOLChar;
begin
  P := SkipSpaces( P );
  while P[0] > ' ' do
    if P[0] = '"' then
    begin
        Inc(P);
        while (P[0] <> #0) and (P[0] <> '"') do
            Inc(P);
        if P[0] <> #0 then Inc(P);
    end else Inc(P);
  Result := P;
end;
{$ENDIF}

{$UNDEF ASM_LOCAL}
{$IFDEF _D3orHigher}
{$IFDEF ASM_UNICODE}
        {$DEFINE ASM_LOCAL}
{$ENDIF ASM_UNICODE}
{$ENDIF _D3orHigher}

{$IFDEF ASM_LOCAL}
function ParamStr( Idx: Integer ): KOLString;
asm
         PUSH EDI
         MOV  EDI, EDX
         TEST EAX, EAX
         JNE  @@1
         SUB  ESP, 260
         MOV  ECX, ESP
         PUSH 260
         PUSH ECX
         PUSH 0
         CALL GetModuleFileName
         XCHG ECX, EAX
         MOV  EDX, ESP
         MOV  EAX, EDI
         CALL System.@LStrFromPCharLen
         ADD  ESP, 260
         JMP  @@exit
@@1:
         PUSH EAX
         CALL GetCommandLine
         POP  ECX
         INC  ECX
@@loop:  CALL SkipSpaces
         MOV  EDX, EAX
         CALL SkipParam
         LOOP @@loop
         MOV  ECX, EAX
         SUB  ECX, EDX
         CMP  ECX, 2
         JL   @@ready
         CMP  byte ptr [EDX], '"'
         JNE  @@ready
         CMP  byte ptr [EAX-1], '"'
         JNE  @@ready
         INC  EDX
         DEC  EAX
@@ready: SUB  EAX, EDX
         XCHG ECX, EAX
         XCHG EAX, EDI
         CALL System.@LStrFromPCharLen
@@exit:  POP  EDI
end;
{$ELSE PAS_VERSION}
function ParamStr( Idx: Integer ): KOLString;
var P, P1: PKOLChar;
    Buffer: array[ 0..260 ] of KOLChar;
begin
  if Idx = 0 then
    SetString( Result, Buffer, GetModuleFileName( 0, Buffer, Sizeof( Buffer ) ) )
  else
  begin
    P := GetCommandLine;
    repeat
      P1 := SkipSpaces( P );
      P := SkipParam(P1);
      Dec(Idx);
    until (Idx < 0); // or (P = P1);
    if  Integer(P-P1) >= 2 then
    if (P1^ = '"') and ( (P-1)^ = '"') then
    begin
        inc( P1 );
        dec( P );
    end;
    SetString( Result, P1, P-P1 );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION}
function ParamCount: Integer;
var p: PKOLChar;
begin
    p := GetCommandLine;
    Result := -1;
    while p^ <> #0 do
    begin
        inc( Result );
        p := SkipParam( p );
        p := SkipSpaces( p );
    end;
end;
{$ENDIF PAS_VERSION}
{$ENDIF PARAMS_DEFAULT}
{$ENDIF WIN}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function DelimiterLast( const Str, Delimiters: KOLString ): Integer;
var PStr: PKOLChar;
begin
  PStr := PKOLChar( Str );
  Result := Integer( __DelimiterLast( PStr, PKOLChar( Delimiters ) ) )
          - Integer( PStr )
          + {$IFDEF UNICODE_CTRLS} 2 {$ELSE} 1 {$ENDIF}; // {Viman}
  {$IFDEF UNICODE_CTRLS} Result := Result div SizeOf( WideChar ) {$ENDIF};
end;
{$ENDIF PAS_VERSION}

// Thanks to Marco Bobba - Marisa Bo for this code
{$IFDEF ASM_UNICODE}{$ELSE}
function StrIsStartingFrom( Str, Pattern: PKOLChar ): Boolean;
begin
  Result := FALSE;
  if (Str = nil) or (Pattern = nil) then
  begin
    Result := (Integer(Str) = Integer(Pattern));
    Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;

  while Pattern^ <> #0 do
  begin
    if Str^ <> Pattern^ then Exit;
    inc( Str );
    inc( Pattern );
  end;
  Result := TRUE;
end;
{$ENDIF ASM_UNICODE}

{$IFDEF PAS_ONLY}
function StrIsStartingFromNoCase( Str, Pattern: PAnsiChar ): Boolean;
begin
    Result := FALSE;
    while (Str^ <> #0) and (Pattern^ <> #0) do
    begin
        if Str^ <> Pattern^ then Exit;
        inc(Str^);
        inc(Pattern^);
    end;
    Result := Pattern^ = #0;
end;
{$ELSE}
function StrIsStartingFromNoCase( Str, Pattern: PAnsiChar ): Boolean;
asm
  {$IFDEF F_P}
        MOV     EAX, [Str]
        MOV     EDX, [Pattern]
  {$ENDIF F_P}
        XOR     ECX, ECX
      @@1:
        MOV     CL, [EDX]   // pattern[ i ]
        INC     EDX
        MOV     CH, [EAX]   // str[ i ]
        INC     EAX
        JECXZ   @@2         // str = pattern; CL = #0, CH = #0
        CMP     CL, 'a'
        JB      @@cl_ok
        CMP     CL, 'z'
        JA      @@cl_ok
        SUB     CL, 32
      @@cl_ok:
        CMP     CH, 'a'
        JB      @@ch_ok
        CMP     CH, 'z'
        JA      @@ch_ok
        SUB     CH, 32
      @@ch_ok:
        CMP     CL, CH
        JE      @@1
      @@2:
        TEST    CL, CL
        SETZ    AL
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ENDIF PAS_ONLY}


{$IFNDEF _FPC}

{$IFDEF WIN}
{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function Format( const fmt: KOLString; params: Array of const ): KOLString;
var Buffer: array[ 0..1023 ] of KOLChar;
    ElsArray, El: PDWORD;
    I : Integer;
    P : PDWORD;
begin
  ElsArray := nil;
  if High( params ) >= 0 then
    GetMem( ElsArray, (High( params ) + 1) * sizeof( Pointer ) );
  El := ElsArray;
  for I := 0 to High( params ) do
  begin
    P := @params[ I ];
    P := Pointer( P^ );
    El^ := DWORD( P );
    Inc( El );
  end;
  wvsprintf( PKOLChar(@Buffer[0]), PKOLChar( fmt ), Pointer( ElsArray ) );
  Result := Buffer;
  if ElsArray <> nil then
     FreeMem( ElsArray );
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN}

function LStrFromPWCharLen(Source: PWideChar; Length: Integer): AnsiString;
var
  DestLen: Integer;
  Buffer: array[0..2047] of AnsiChar;
begin
  if Length <= 0 then
  begin
    Result := ''; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  if Length < SizeOf(Buffer) div 2 then
  begin
    DestLen := WideCharToMultiByte(0, 0, Source, Length,
      Buffer, SizeOf(Buffer), nil, nil);
    if DestLen > 0 then
    begin
      Result := Buffer; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end;
  DestLen := WideCharToMultiByte(0, 0, Source, Length, nil, 0, nil, nil);
  SetLength( Result, DestLen );
  WideCharToMultiByte(0, 0, Source, Length, Pointer(Result), DestLen, nil, nil);
end;

{$IFDEF PAS_ONLY}
function LStrFromPWChar(Source: PWideChar): AnsiString;
begin
    Result := AnsiString(WideString(Source));
end;
{$ELSE}
function LStrFromPWChar(Source: PWideChar): AnsiString;
{* from Delphi5 - because D2 does not contain it. }
asm
        PUSH    EDX
        XOR     EDX,EDX
        TEST    EAX,EAX
        JE      @@5
        PUSH    EAX
@@0:    CMP     DX,[EAX+0]
        JE      @@4
        CMP     DX,[EAX+2]
        JE      @@3
        CMP     DX,[EAX+4]
        JE      @@2
        CMP     DX,[EAX+6]
        JE      @@1
        ADD     EAX,8
        JMP     @@0
@@1:    ADD     EAX,2
@@2:    ADD     EAX,2
@@3:    ADD     EAX,2
@@4:    XCHG    EDX,EAX
        POP     EAX
        SUB     EDX,EAX
        SHR     EDX,1
@@5:    POP     ECX
        JMP     LStrFromPWCharLen
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ENDIF PAS_ONLY}

{$ENDIF not_FPC}

function WCharIn( C: KOLChar; const Chars: array of KOLChar ): Boolean;
var i: Integer;
begin
  Result := TRUE;
  for i := 0 to High( Chars ) do
    if Chars[i] = C then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := FALSE;
end;

/////////////////////////////////////////////////////////////////////////
//
//
//                          F   I   L   E   S
//
//
/////////////////////////////////////////////////////////////////////////
{
   This part of the unit modified by Tim Slusher and Vladimir Kladov.
}
{* Set of utility methods to work with files
   and reqistry.
   When programming KOL, which is Windows API-oriented, You should
   avoid alien (for Windows) embedded Pascal files handling, and
   use API-calls which implemented very well. This set of functions
   is intended to make this easier.
   Also TDirList object implementation present here and some registry
   access functions, which allow to make code more elegant.
}

{$UNDEF ASM_LOCAL}
{$IFDEF ASM_VERSION}
  {$DEFINE ASM_LOCAL}
{$ENDIF PAS_VERSION}

{$IFDEF WIN}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function FileCreate(const FileName: KOLString; OpenFlags: DWord): THandle;
var Attr: DWORD;
begin
  Attr := (OpenFlags shr 16) and $1FFF;
  if Attr = 0 then Attr := FILE_ATTRIBUTE_NORMAL;
  Result := CreateFile( PKOLChar(FileName), OpenFlags and $F0000000,
                        OpenFlags and $F, nil, (OpenFlags shr 8) and $F,
                        Attr, 0 );
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN}

{$IFDEF _D3orHigher}
function WFileCreate(const FileName: KOLWideString; OpenFlags: DWord): THandle;
var Attr: DWORD;
begin
  Attr := (OpenFlags shr 16) and $1FFF;
  if Attr = 0 then Attr := FILE_ATTRIBUTE_NORMAL;
  Result := CreateFileW( PWideChar(FileName), OpenFlags and $F0000000,
                        OpenFlags and $F, nil, (OpenFlags shr 8) and $F,
                        Attr, 0 );
end;
{$ENDIF _D3orHigher}

{$IFDEF WIN}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function FileClose(Handle: THandle): Boolean;
begin
     Result := CloseHandle(Handle);
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN}

{$IFDEF WIN}
{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function FileExists( const FileName : KOLString ) : Boolean;
{$IFDEF FILE_EXISTS_EX}
var FD: TFindFileData;
    LFT: TFileTime;
    Hi, Lo: Word;
    e: DWORD;
{$ELSE}
var Code: Integer;
{$ENDIF}
begin
  {$IFDEF FILE_EXISTS_EX}
  Result := FALSE;
  e := SetErrorMode( SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS );
  if Find_First( Filename, FD ) then
  begin
      if FD.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
      begin
          FileTimeToLocalFileTime( FD.ftLastWriteTime, LFT );
          if  FileTimeToDosDateTime( LFT, Hi, Lo ) then
              Result := TRUE;
      end;
      Find_Close( FD );
  end;
  SetErrorMode( e );
  {$ELSE}
  Code := GetFileAttributes(PKOLChar(FileName));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code = 0);
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN}

{$IFDEF _D3orHigher}
function WFileExists( const FileName: KOLWideString ) : Boolean;
{$IFDEF notimplemented_FILE_EXISTS_EX}
var FD: TFindFileData;
    //F: DWORD;
    LFT: TFileTime;
    Hi, Lo: Word;
{$ELSE}
var Code: Integer;
{$ENDIF}
begin
  {$IFDEF notimplemented_FILE_EXISTS_EX}
  Result := FALSE;
  if not WFind_First( Filename, FD ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if FD.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then Exit; {>>>>>>>>}
  FileTimeToLocalFileTime( FD.ftLastWriteTime, LFT );
  if FileTimeToDosDateTime( LFT, Hi, Lo ) then Result := TRUE;
  WFind_Close( FD );
  {$ELSE}
  Code := GetFileAttributesW(PWideChar(FileName));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code = 0);
  {$ENDIF}
end;
{$ENDIF _D3orHigher}

{$IFDEF WIN}
{$IFDEF ASM_STREAM}
function FileSeek(Handle: THandle; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveMethod: TMoveMethod): TStrmSize;
asm
        MOVZX    ECX, CL
        PUSH     ECX
        PUSH     0
        PUSH     EDX
        PUSH     EAX
        CALL     SetFilePointer
end;
{$ELSE PAS_VERSION} //Pascal
function FileSeek(Handle: THandle; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveMethod: TMoveMethod): TStrmSize;
{$IFDEF STREAM_LARGE64}
var HiPtr: DWORD;
{$ENDIF}
begin
  {$IFDEF STREAM_LARGE64}
  HiPtr := MoveTo shr 32;
  Result := SetFilePointer(Handle, DWORD( MoveTo ), @ HiPtr, Ord( MoveMethod ) );
  if (DWORD( Result ) = $FFFFFFFF {INVALID_SET_FILE_POINTER}) and
     (GetLastError <> NO_ERROR) then
     Result := -1; // Int64(-1)
  if Result >= 0 then
    Result := Result or (HiPtr shl 32);
  {$ELSE}
  Result := SetFilePointer(Handle, MoveTo, nil, Ord( MoveMethod ) );
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN}

{$IFDEF WIN}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function FileRead(Handle: THandle; var Buffer; Count: DWord): DWord;
begin
     if not ReadFile(Handle, Buffer, Count, Result, nil) then
       Result := 0;
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function File2Str(Handle: THandle): AnsiString;
var Pos, Size: DWORD;
begin
  Result := '';
  if Handle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Pos := FileSeek( Handle, 0, spCurrent );
  Size := GetFileSize( Handle, nil );
  SetString( Result, nil, Size - Pos + 1 );
  FileRead( Handle, Result[ 1 ], Size - Pos );
  Result[ Size - Pos + 1 ] := #0;
end;
{$ENDIF PAS_VERSION}

{$IFNDEF _D2}
function File2WStr(Handle: THandle): KOLWideString;
var Pos, Size: DWORD;
begin
  Result := '';
  if Handle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Pos := FileSeek( Handle, 0, spCurrent );
  Size := GetFileSize( Handle, nil );
  SetString( Result, nil, (Size - Pos + 1) div Sizeof( WideChar ) + 1 ); // fixed by zhoudi
  FileRead( Handle, Result[ 1 ], Size - Pos );
  Result[ Length(Result) ] := #0; // fixed by zhoudi
end;
{$ENDIF _D2}

{$IFDEF WIN}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function FileWrite(Handle: THandle; const Buffer; Count: DWord): DWord;
begin
     if not WriteFile(Handle, Buffer, Count, Result, nil) then
       Result := 0;
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function FileEOF( Handle: THandle ) : Boolean;
var Siz, Pos : DWord;
begin
  Siz := GetFileSize( Handle, nil );
  Pos := FileSeek( Handle, 0, spCurrent );
  Result := Pos >= Siz;
end;
{$ENDIF PAS_VERSION}

{$IFDEF WIN}
{$IFDEF ASM_noVERSION_UNICODE}
function FileFullPath( const FileName: AnsiString ) : AnsiString;
const
  BkSlash: AnsiString = '\';
  szTShFileInfo = sizeof( TShFileInfo );
asm
        PUSH     EBX
        PUSH     ESI
        MOV      EBX, EDX
        PUSH     EAX

        XCHG     EAX, EDX
        CALL     System.@LStrClr

        POP      EDX
        PUSH     0
        MOV      EAX, ESP
        CALL     System.@LStrAsg
        MOV      ESI, ESP

@@loo:  CMP      dword ptr [ESI], 0
        JZ       @@fin

        MOV      EAX, ESI
        MOV      EDX, [BkSlash]
        PUSH     0
        MOV      ECX, ESP
        CALL     Parse

        CMP      dword ptr [EBX], 0
        JE       @@1
        MOV      EAX, EBX
        MOV      EDX, [BkSlash]
        CALL     System.@LStrCat
        JMP      @@2
@@1:
        POP      EAX
        PUSH     EAX
        CALL     System.@LStrLen
        CMP      EAX, 2
        JNE      @@2
        POP      EAX
        PUSH     EAX
        CMP      byte ptr [EAX+1], ':'
        JNE      @@2

        MOV      EAX, EBX
        POP      EDX
        PUSH     EDX
        CALL     System.@LStrAsg
        JMP      @@3
@@2:
        PUSH     0
        MOV      EAX, ESP
        MOV      EDX, [EBX]
        CALL     System.@LStrAsg
        MOV      EAX, ESP
        MOV      EDX, [ESP+4]
        CALL     System.@LStrCat
        POP      EAX
        PUSH     EAX
        SUB      ESP, szTShFileInfo
        MOV      EDX, ESP
        PUSH     SHGFI_DISPLAYNAME
        PUSH     szTShFileInfo
        PUSH     EDX
        PUSH     0
        PUSH     EAX
        CALL     ShGetFileInfo
        LEA      EDX, [ESP].TShFileInfo.szDisplayName
        CMP      byte ptr [EDX], 0
        JE       @@clr_stk
        LEA      EAX, [ESP+szTShFileInfo+4]
        {$IFDEF _D2009orHigher}
        XOR      ECX, ECX
        {$ENDIF}
        CALL     System.@LStrFromPChar
@@clr_stk:
        ADD      ESP, szTShFileInfo
        CALL     RemoveStr
        POP      EDX
        PUSH     EDX
        MOV      EAX, EBX
        CALL     System.@LStrCat

@@3:    CALL     RemoveStr
        JMP      @@loo

@@fin:  CALL     RemoveStr
        POP      ESI
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function FileFullPath( const FileName: KOLString ) : KOLString;
var SFI: TShFileInfo;
    Src, S: KOLString;
begin
  Result := '';
  Src := FileName;
  while Src <> '' do
  begin
    S := Parse( Src, '\' );
    if Result <> '' then
      Result := Result + '\';
    if (Result = '') and (Length( S ) = 2) and (S[ 2 ] = ':') then
      Result := S
    else
    begin
      {$IFDEF UNICODE_CTRLS} ShGetFileInfoW {$ELSE} ShGetFileInfoA {$ENDIF}
        ( PKOLChar( Result + S ), 0, SFI, Sizeof( SFI ), SHGFI_DISPLAYNAME );
      if SFI.szDisplayName[ 0 ] <> #0 then
        S := SFI.szDisplayName;
      Result := Result + S;
    end;
  end;
  if ExtractFileExt( Result ) = '' then
  // case when flag 'Hide extensions for registered file types' is set on
  // in the Explorer:
    Result := Result + ExtractFileExt( FileName );
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN}

{$IFDEF WIN}
function FileShortPath( const FileName: KOLString ): KOLString;
var Buf: array[ 0..MAX_PATH ] of KOLChar;
begin
  GetShortPathName( PKOLChar( FileName ), Buf, Sizeof( Buf ) );
  Result := Buf;
end;

function FileIconSystemIdx( const Path: KOLString ): Integer;
var SFI: TShFileInfo;
begin
  SFI.iIcon := 0; // Bartov
  {$IFDEF UNICODE_CTRLS} ShGetFileInfoW {$ELSE} ShGetFileInfoA {$ENDIF}
    ( PKOLChar( Path ), 0, SFI, sizeof( SFI ), SHGFI_SMALLICON or SHGFI_SYSICONINDEX );
  Result := SFI.iIcon;
end;

function FileIconSysIdxOffline( const Path: KOLString ): Integer;
var SFI: TShFileInfo;
begin
  SFI.iIcon := 0; // Bartov
  {$IFDEF UNICODE_CTRLS} ShGetFileInfoW {$ELSE} ShGetFileInfoA {$ENDIF}
    ( PKOLChar( Path ), FILE_ATTRIBUTE_NORMAL, SFI, sizeof( SFI ),
    SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES );
  Result := SFI.iIcon;
end;
{$ENDIF WIN}

procedure LogFileOutput( const filepath, str: KOLString );
var F: THandle;
    Tmp: KOLString;
begin
  F := FileCreate( filepath, ofOpenWrite or ofOpenAlways or ofShareDenyWrite );
  if F = INVALID_HANDLE_VALUE then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FileSeek( F, 0, spEnd );
  Tmp := str + {$IFDEF LIN} #10 {$ELSE} #13#10 {$ENDIF};
  FileWrite( F, PKOLChar( Tmp )^, Length( Tmp ) * Sizeof(KOLChar) );
  FileClose( F );
end;

function StrLoadFromFile( const Filename: KOLString ): AnsiString;
var F: THandle;
begin
  {$IFDEF WIN}
  if  KOLLowerCase(Filename) = 'con' then
      Result := File2Str(GetStdHandle(STD_INPUT_HANDLE))
  else
  {$ENDIF WIN}
  begin
    Result := '';
    F := FileCreate( Filename, ofOpenRead or ofOpenExisting or ofShareDenyWrite );
    if F = INVALID_HANDLE_VALUE then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    Result := File2Str( F );
    FileClose( F ); {Dark Knight}
  end;
end;

function Str2File( Filename: PKOLChar; Str: PAnsiChar ): Boolean;
var L: Integer;
begin
  L := StrLen( Str );
  Result := Mem2File( Filename, Str, L ) = L;
end;

function WStr2File( Filename: PKOLChar; Str: PWideChar ): Boolean;
var L: Integer;
begin
  L := WStrLen( Str );
  Result := Mem2File( Filename, Str, L * Sizeof(WideChar) ) = L;
end;

function StrSaveToFile( const Filename: KOLString; const Str: AnsiString ): Boolean;
begin
  Result := Mem2File( PKOLChar( Filename ), PAnsiChar( Str ), Length( Str ) )
            = Length( Str );
end;

{$IFNDEF _D2}
function WStrLoadFromFile( const Filename: KOLString ): KOLWideString;
var F: THandle;
begin
  {$IFDEF WIN}
  //if StrEq( Filename, 'CON' ) then
  if  KOLLowerCase(Filename) = 'con' then
      Result := File2WStr(GetStdHandle(STD_INPUT_HANDLE))
  else
  {$ENDIF WIN}
  begin
      Result := '';
      F := FileCreate( Filename, ofOpenRead or ofOpenExisting or ofShareDenyWrite );
      if F = INVALID_HANDLE_VALUE then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      Result := File2WStr( F );
      FileClose( F ); {Dark Knight}
  end;
end;

function WStrSaveToFile( const Filename: KOLString; const Str: KOLWideString ): Boolean;
var BytesToSave: Integer;
begin
  BytesToSave := Length( Str ) * Sizeof(WideChar);
  Result := Mem2File( PKOLChar( Filename ), PWideChar( Str ), BytesToSave )
            = BytesToSave; // fixed by zhoudi
end;
{$ENDIF _D2}

function Mem2File( Filename: PKOLChar; Mem: Pointer; Len: Integer ): Integer;
var F: THandle;
begin
  Result := 0;
  F := //FileCreate( Filename, ofOpenWrite or ofCreateAlways );
       CreateFile( Filename, GENERIC_WRITE, 0, nil, CREATE_ALWAYS, 0, 0 );
  if F = INVALID_HANDLE_VALUE then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := FileWrite( F, Mem^, Len );
  CloseHandle( F );
end;

function File2Mem( Filename: PKOLChar; Mem: Pointer; MaxLen: Integer ): Integer;
var F: THandle;
begin
  Result := 0;
  F := //FileCreate( Filename, ofOpenRead or ofOpenExisting or ofShareDenyWrite );
       CreateFile( Filename, GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
  if F = INVALID_HANDLE_VALUE then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := FileRead( F, Mem^, MaxLen );
  CloseHandle( F );
end;

{$IFDEF WIN}
function Find_First( const FilePathName: KOLString; var F: TFindFileData ): Boolean;
begin
  {$IFDEF UNICODE_CTRLS}
  F.FindHandle := THandle( FindFirstFileExW( PKOLChar( FilePathName ),
               FindExInfoStandard, PWin32FindDataW( @ F ),
               FindExSearchNameMatch, nil, 0 ) );
  {$ELSE}
  F.FindHandle := FindFirstFile( PKOLChar( FilePathName ),
               PWin32FindData( @ F )^ );
  {$ENDIF}
  Result := F.FindHandle <> INVALID_HANDLE_VALUE;
end;
function Find_Next( var F: TFindFileData ): Boolean;
begin
  Result := FindNextFile( F.FindHandle,
      {$IFDEF UNICODE_CTRLS} PWin32FindDataW {$ELSE} PWin32FindData {$ENDIF}
      ( @ F )^ );
end;
procedure Find_Close( var F: TFindFileData );
begin
  Windows.FindClose( F.FindHandle );
end;
{$ENDIF WIN}

{$IFDEF WIN}
function FileSize( const Path: KOLString ) : {$IFDEF _D2orD3} Integer {$ELSE} Int64 {$ENDIF};
var FD : TFindFileData;
begin
  Result := 0;
  if not Find_First( Path, FD ) then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$IFDEF _D2orD3}
  Result := FD.nFileSizeLow;
  {$ELSE}
  I64( Result ).Lo := FD.nFileSizeLow;
  I64( Result ).Hi := FD.nFileSizeHigh;
  {$ENDIF}
  Find_Close( FD );
end;
{$ENDIF WIN}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
procedure FileTime( const Path: KOLString;
  CreateTime, LastAccessTime, LastModifyTime: PFileTime ); stdcall;
var FD : TFindFileData;
    procedure CopyTime( Dest, Src: PFileTime );
    begin
        if  Dest <> nil then
            Dest^ := Src^;
    end;
begin
  if not Find_First( Path, FD ) then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Find_Close( FD );
  CopyTime( CreateTime, @ FD.ftCreationTime );
  CopyTime( LastModifyTime, @ FD.ftLastWriteTime );
  CopyTime( LastAccessTime, @ FD.ftLastAccessTime );
end;
{$ENDIF PAS_VERSION}

function GetUniqueFilename( PathName: KOLString ) : KOLString;
var Path, Nam, Ext : KOLString;
    I, J, K : Integer;
begin
  Result := PathName;
  Path := ExtractFilePath( PathName );
  if not DirectoryExists( Path ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Nam := ExtractFileNameWOext( PathName );
  if Nam = '' then
  begin
    Path := ExcludeTrailingPathDelimiter( Path );
    PathName := Path;
    Result := Path;
  end;
  Nam := ExtractFileNameWOext( PathName );
  Ext := ExtractFileExt( PathName );
  I := Length( Nam );
  for J := I downto 1 do
  if not ((Nam[ J ] >= '0') and (Nam[ J ] <= '9')) then
  begin
    I := J;
    break;
  end;
  K := Str2Int( CopyEnd( Nam, I + 1 ) );
  while FileExists( Result ) do
  begin
    Inc( K );
    Result := Path + Copy( Nam, 1, I ) + Int2Str( K ) + Ext;
  end;
end;

{$IFDEF WIN}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function CompareSystemTime(const D1, D2 : TSystemTime) : Integer;
{$IFDEF DATE0_1601}
var ft1, ft2: TFileTime;
{$ELSE}
var R: Integer;
   procedure CompareFields(const F1, F2 : Integer);
   begin
      if   R <> 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      if   F1 = F2 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      if   F1 < F2 then
           R := -1
      else R := 1;
   end;
{$ENDIF DATE0_0001}
begin
   {$IFDEF DATE0_1601}
   SystemTimeToFileTime( D1, ft1 );
   SystemTimeToFileTime( D2, ft2 );
{$IFDEF FPC}
   Result := CompareFileTime( @ft1, @ft2 );
{$ELSE}
   Result := CompareFileTime( ft1, ft2 );
{$ENDIF}
   {$ELSE}
   R := 0;
   CompareFields( D1.wYear, D2.wYear );
   CompareFields( D1.wMonth, D2.wMonth );
   CompareFields( D1.wDay, D2.wDay );
   CompareFields( D1.wHour, D2.wHour );
   CompareFields( D1.wMinute, D2.wMinute );
   CompareFields( D1.wSecond, D2.wSecond );
   CompareFields( D1.wMilliseconds, D2.wMilliseconds );
   Result := R;
   {$ENDIF DATE0_0001}
end;
{$ENDIF PAS_VERSION}

function FileTimeCompare( const FT1, FT2 : TFileTime ) : Integer;
begin
{$IFDEF FPC}
  Result := CompareFileTime( @FT1, @FT2 );
{$ELSE}
  Result := CompareFileTime( FT1, FT2 );
{$ENDIF}
end;
{$ENDIF WIN}

{$IFDEF WIN}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function DirectoryExists(const Name: KOLString): Boolean;
var
  Code: Integer;
  e: DWORD;
begin
  e := SetErrorMode( SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS );
  Code := GetFileAttributes(PKOLChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
  SetErrorMode( e );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE  PAS_VERSION}
function DiskPresent( const DrivePath: KOLString ): Boolean;
var e: DWORD;
    restore: Boolean;
begin
  e := 0;
  Restore := FALSE;
  //if  Copy( DrivePath, 1, 2 ) <> '\\' then
  if  (DrivePath <> '') and (DrivePath[1] <> '\') then
      CASE GetDriveType( PKOLChar( DrivePath ) ) OF
      DRIVE_REMOVABLE, DRIVE_CDROM, DRIVE_RAMDISK:
          begin
              e := SetErrorMode( SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS );
              Restore := TRUE;
          end;
      END;
  Result := DirectoryExists( DrivePath );
  if Restore then SetErrorMode( e );
end;
{$ENDIF PAS_VERSION}

{$IFDEF _D3orHigher}
function WDirectoryExists(const Name: KOLWideString): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributesW(PWideChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;
{$ENDIF _D3orHigher}

{$ENDIF WIN}

function CheckDirectoryContent( const Name: KOLString; SubDirsOnly: Boolean;
         const Mask: KOLString ): Boolean;
var FD: TFindFileData;
begin
  Result := TRUE;
  if  DirectoryExists( Name ) then
  begin
    if  Find_First( IncludeTrailingPathDelimiter( Name ) + Mask, FD ) then
    begin
        repeat
          if not {$IFDEF UNICODE_CTRLS}WStrIn{$ELSE}StrIn{$ENDIF}( FD.cFileName, ['.','..'] ) then
          begin
              if SubDirsOnly and LongBool(FD.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)
                 or not SubDirsOnly then
              begin
                Result := FALSE;
                break;
              end;
          end;
        until not Find_Next( FD );
        Find_Close( FD );
    end;
  end;
end;

function DirectoryEmpty(const Name: KOLString): Boolean;
begin
  Result := CheckDirectoryContent( Name, FALSE, '*.*' );
end;

function DirectoryHasSubdirs( const Path: KOLString ): Boolean;
begin
  Result := not CheckDirectoryContent( Path, TRUE, '*.*' );
end;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
  {$IFDEF WIN}
    {$UNDEF LINUX_USE_HOME_STARTFDIR}
  {$ENDIF}
function GetStartDir : KOLString;
{$IFNDEF LINUX_USE_HOME_STARTFDIR}
var Buffer:array[0..MAX_PATH] of KOLChar;
    I : Integer;
{$ENDIF}
begin
  {$IFDEF LINUX_USE_HOME_STARTFDIR}
    Result := getenv( 'HOME' );
  {$ELSE}
    I := GetModuleFileName( 0, Buffer, MAX_PATH );
    for I := I downto 0 do
      if Buffer[ I ] = {$IFDEF LIN} '/' {$ELSE} '\' {$ENDIF} then
      begin
        Buffer[ I + 1 ] := #0;
        break;
      end;
    Result := Buffer;
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

function ExePath: KOLString;
var Buffer: array[ 0..MAX_PATH+1 ] of KOLChar;
begin
  Buffer[ MAX_PATH+1 ] := #0;
  GetModuleFileName( 0, Buffer, MAX_PATH+1 );
  Result := Buffer;
end;

function ModulePath: KOLString;
var Buffer: array[ 0..MAX_PATH+1 ] of KOLChar;
begin
  Buffer[ MAX_PATH+1 ] := #0;
  GetModuleFileName( hInstance, Buffer, MAX_PATH+1 );
  Result := Buffer;
end;

{$IFNDEF PAS_ONLY}
function DirectorySize( const Path: KOLString ): I64;
var DirList: PDirList;
    I: Integer;
begin
  Result := MakeInt64( 0, 0 );
  DirList := NewDirList( Path, {$IFDEF LIN} '*' {$ELSE} '*.*' {$ENDIF}, 0 );
  for I := 0 to DirList.Count-1 do
  begin
    if   LongBool( DirList.Items[ I ].dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY ) then
         Result := Add64( Result, DirectorySize( DirList.Path + DirList.Names[ I ] ) )
    else Result := Add64( Result, MakeInt64( DirList.Items[ I ].nFileSizeLow,
             DirList.Items[ I ].nFileSizeHigh ) );
  end;
  DirList.Free;
end;
{$ENDIF}

{$IFDEF WIN} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
function GetFileList(const dir: KOLString): PKOLStrList;
var
   Srch: TFindFileData;
   succ: Boolean;
begin
   result := nil;
   succ := Find_First(dir, Srch);
   while succ do begin
      if (not (Srch.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0))then begin
         if Result = nil then begin
            Result := NewKOLStrList;
         end;
         Result.Add(Srch.cFileName);
      end;
      succ := Find_Next(Srch);
   end;
   Find_Close(Srch);
end;

{$ENDIF WIN}
function ExcludeTrailingChar( const S: KOLString; C: KOLChar ): KOLString;
begin
  Result := S;
  if Result <> '' then
  if Result[ Length( Result ) ] = C then
    Delete( Result, Length( Result ), 1 );
end;

{$IFDEF ASM_UNICODE}{$ELSE PASCAL}
function IncludeTrailingChar( const S: KOLString; C: KOLChar ): KOLString;
begin
  Result := S;
  if (Result = '') or (Result[ Length( Result ) ] <> C) then
    Result := Result + KOLString(C);
end;
{$ENDIF PAS_VERSION}


//---------------------------------------------------------
// Following functions/procedures are created by Edward Aretino:
// IncludeTrailingPathDelimiter, ExcludeTrailingPathDelimiter,
// ForceDirectories, CreateDir, ChangeFileExt
//---------------------------------------------------------
function IncludeTrailingPathDelimiter(const S: KOLString): KOLString;
begin
   Result := IncludeTrailingChar( S, {$IFDEF UNIX} '/' {$ELSE} '\' {$ENDIF} );
end;

function ExcludeTrailingPathDelimiter(const S: KOLString): KOLString;
begin
   Result := ExcludeTrailingChar( S, {$IFDEF UNIX} '/' {$ELSE} '\' {$ENDIF} );
end;

function ExtractFileDrive( const Path: KOLString ) : KOLString;
var i, j: Integer;
begin
  Result := Path;
  if Result = '' then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if pos( KOLString(':'), Result ) > 1 then
    Result := Parse( Result, ':' ) + ':\'
  else if Length( Result ) > 2 then
  begin
      j := 0;
      for i := 3 to Length( Result ) do
          if  Result[ i ] = '\' then
          begin
              inc( j );
              if j = 2 then
              begin
                  Result := Copy( Result, 1, i );
                  break;
              end;
          end;
      Result := IncludeTrailingPathDelimiter( Result );
  end else if Length( Result ) = 1 then
      Result := Result + ':\';
end;

{$IFDEF ASM_LStrFromPCharLen} // LStrFromPCharLen - there are no in D2
function ExtractFilePath( const Path : AnsiString ) : AnsiString;
asm
        PUSH     EDX
        MOV      EDX, [DirDelimiters]
        CALL     EAX2PChar
        PUSH     EAX
        CALL     __DelimiterLast
        XCHG     EDX, EAX
        XOR      ECX, ECX  // ECX = 0
        POP      EAX
        CMP      byte ptr [EDX], CL
        JZ       @@ret_0
        SUB      EDX, EAX
        INC      EDX
        XCHG     EDX, EAX
        XCHG     ECX, EAX  // EAX = 0
@@ret_0:
        POP      EAX
        {$IFDEF _D2009orHigher}
        PUSH     0
        {$ENDIF}
        CALL     System.@LStrFromPCharLen
end;
{$ELSE} //Pascal
function ExtractFilePath( const Path : KOLString ) : KOLString;
//var I : Integer;
var P, P0: PKOLChar;
begin
  P0 := PKOLChar( Path );
  P := __DelimiterLast( P0, ':\/' );
  if   P^ = #0 then
       Result := ''
  else Result := Copy( Path, 1, P - P0 + 1 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF _D3orHigher}
function WExtractFilePath( const Path: KOLWideString ) : KOLWideString;
var P, P0: PWideChar;
begin
  P0 := PWideChar( Path );
  P := W__DelimiterLast( P0, ':\/' );
  if   P^ = #0 then
       Result := ''
  else Result := Copy( Path, 1, P - P0 + 1 );
end;
{$ENDIF}

{$IFDEF ASM_VERSION}{$IFNDEF _D2}
{$DEFINE ASM_LStrFromPCharLen}
{$ENDIF}
{$ENDIF PAS_VERSION}

function IsNetworkPath( const Path: KOLString ): Boolean;
begin
  Result := (Length( Path ) >= 2) and (Path[1] = '\') and (Path[2] = '\');
end;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function ExtractFileName( const Path : KOLString ) : KOLString;
var P: PKOLChar;
begin
  P := __DelimiterLast( PKOLChar( Path ), ':\/' );
  if   P^ = #0 then
       Result := Path
  else Result := P + 1;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PASCAL}
function ExtractFileNameWOext( const Path : KOLString ) : KOLString;
begin
  Result := ExtractFileName( Path );
  Result := Copy( Result, 1, Length( Result ) - Length( ExtractFileExt( Result ) ) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function ExtractFileExt( const Path : KOLString ) : KOLString;
var P: PKOLChar;
begin
  P := __DelimiterLast( PKOLChar( Path ), '.' );
  Result := P;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PASCAL}
function ReplaceExt( const Path, NewExt: KOLString ): KOLString;
begin
  Result := ExtractFilePath( Path ) + ExtractFileNameWOext( Path ) +
    NewExt;
end;
{$ENDIF}

function ForceDirectories(Dir: KOLString): Boolean;
begin
 Result := Length(Dir) > 0; {Centronix}
 If not Result then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 Dir := ExcludeTrailingPathDelimiter(Dir);
 If (Length(Dir) < 3) or DirectoryExists(Dir) or
   (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem. {>>>>>>>>>}
 Result := ForceDirectories(ExtractFilePath(Dir)) and CreateDir(Dir);
end;

function CreateDir(const Dir: KOLString): Boolean;
begin
   Result := {$IFDEF WIN} {Windows.}CreateDirectory(PKOLChar(Dir), nil)
             {$ELSE LIN} Libc.__mkdir(PAnsiChar(Dir), S_IRWXU or S_IRWXG or S_IRWXO) = 0
             {$ENDIF};
end;

function ChangeFileExt(FileName: KOLString; const Extension: KOLString): KOLString;
var
   FileExt: KOLString;
begin
   FileExt := ExtractFileExt(FileName);
   DeleteTail(FileName, Length(FileExt));
   Result := FileName+ Extension;
end;

function ReplaceFileExt( const Path, NewExt: KOLString ): KOLString;
begin
  Result := ExtractFilePath( Path ) +
            ExtractFileNameWOext( ExtractFileName( Path ) ) +
            NewExt;
end;

{$IFDEF WIN} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
function ExtractShortPathName( const Path: KOLString ): KOLString;
var
  Buffer: array[0..MAX_PATH - 1] of KOLChar;
begin
  SetString(Result, Buffer,
    GetShortPathName(PKOLChar(Path), Buffer, SizeOf(Buffer) div Sizeof(KOLChar)));
end;

{$IFDEF GDI}
function FilePathShortened( const Path: KOLString; MaxLen: Integer ): KOLString;
begin
  Result := FilePathShortenPixels( Path, 0, MaxLen );
end;

function PixelsLength( DC: HDC; const Text: KOLString ): Integer;
var Sz: TSize;
begin
  if  DC = 0 then
      Result := Length( Text )
  else
  begin
    {$IFDEF UNICODE_CTRLS}Windows.GetTextExtentPoint32W
    {$ELSE}               Windows.GetTextExtentPoint32A
    {$ENDIF}( DC, PKOLChar( Text ), Length( Text ), Sz );
    Result := Sz.cx;
  end;
end;

function FilePathShortenPixels( const Path: KOLString; DC: HDC; MaxPixels: Integer ): KOLString;
var L0, L1: Integer;
    Prev: KOLString;
begin
 Result := Path;
 L0 := PixelsLength( DC, Result );
 while L0 > MaxPixels do
 begin
     Prev := Result;
     L1 := pos( KOLString('\...\'), Result ); // ambiguous
     if   L1 <= 0 then
          Result := ExcludeTrailingPathDelimiter( ExtractFilePath( Result ) )
     else Result := Copy( Result, 1, L1 - 1 );
     if  Result <> '' then
         Result := IncludeTrailingPathDelimiter( ExtractFilePath( Result ) ) +
         '...\' + ExtractFileName( Path );
     if (Result = '') or (Result = Prev) then
     begin
         L1 := Length( ExtractFilePath( Result ) );
         while (PixelsLength( DC, Result ) > MaxPixels) and (L1 > 1) do
         begin
           Dec( L1 );
           Result := Copy( Result, 1, L1 ) + '...\' + ExtractFileName( Result );
         end;
         if PixelsLength( DC, Result ) > MaxPixels then
         begin
           L1 := MaxPixels + 1;
           while ((MaxPixels > 0) and (L1 > 1) or (MaxPixels = 0) and (L1 > 0)) and
                 (PixelsLength( DC, Result ) > MaxPixels) do
           begin
             Dec( L1 );
             Result := Copy( ExtractFileName( Path ), 1, L1 ) + '...';
           end;
         end;
         break;
     end;
     L0 := PixelsLength( DC, Result );
 end;
end;
{$ENDIF GDI}

procedure CutFirstDirectory(var S: KOLString);
var
  Root: Boolean;
  P: Integer;
begin
  if S = '\' then
    S := ''
  else
  begin
    if  S[1] = '\' then
    begin
        Root := True;
        Delete(S, 1, 1);
    end else
        Root := False;
    if  S[1] = '.' then
        Delete(S, 1, 4);
    P := Pos( KOLString('\'), S );
    if  P <> 0 then
    begin
        Delete(S, 1, P);
        S := '...\' + S;
    end else
        S := '';
    if  Root then
        S := '\' + S;
  end;
end;

{$IFDEF GDI}
function MinimizeName( const Path: KOLString; DC: HDC; MaxPixels: Integer ): KOLString;
var
  Drive, Dir, Name: KOLString;
begin
  Result := Path;
  Dir := ExtractFilePath(Result);
  Name := ExtractFileName(Result);

  if (Length(Dir) >= 2) and (Dir[2] = ':') then
  begin
    Drive := Copy(Dir, 1, 2);
    Delete(Dir, 1, 2);
  end else Drive := '';
  while ((Dir <> '') or (Drive <> '')) and (PixelsLength(DC, Result) > MaxPixels) do
  begin
      if  Dir = '\...\' then
      begin
          Drive := '';
          Dir := '...\';
      end  else if Dir = '' then
           Drive := ''
      else CutFirstDirectory(Dir);
      Result := Drive + Dir + Name;
  end;
end;
{$ENDIF GDI}

{$IFDEF ASM_UNICODE}{$ELSE  PAS_VERSION}
function GetSystemDir: KOLString;
var Buf: array[ 0..MAX_PATH-1 ] of KOLChar;
begin
  GetSystemDirectory( @ Buf[ 0 ], MAX_PATH );
  Result := IncludeTrailingPathDelimiter( PKOLChar( @ Buf[ 0 ] ) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE  PAS_VERSION}
function GetWindowsDir : KOLString;
var Buf : array[ 0..MAX_PATH-1 ] of KOLChar;
begin
  GetWindowsDirectory( @Buf[ 0 ], MAX_PATH );
  Result := IncludeTrailingPathDelimiter( PKOLChar( @ Buf[ 0 ] ) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE  PAS_VERSION}
function GetWorkDir : KOLString;
var Buf: array[ 0..MAX_PATH ] of KOLChar;
begin
  GetCurrentDirectory( MAX_PATH, @ Buf[ 0 ] );
  Result := IncludeTrailingPathDelimiter( PKOLChar( @ Buf[ 0 ] ) );
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN}

{$IFDEF ASM_UNICODE}{$ELSE PASCAL}
function GetTempDir : KOLString;
{$IFDEF WIN} var Buf : Array[ 0..MAX_PATH ] of KOLChar; {$ENDIF WIN}
begin
  {$IFDEF LIN} Result := '/tmp/'; {$ELSE WIN}
  GetTempPath( MAX_PATH + 1, @Buf[ 0 ] );
  Result := IncludeTrailingPathDelimiter( PKOLChar( @ Buf[ 0 ] ) );
  {$ENDIF WIN}
end;
{$ENDIF}

{$IFDEF WIN}
{$IFDEF ASM_UNICODE}{$ELSE PASCAL}
function CreateTempFile( const DirPath, Prefix: KOLString ): KOLString;
var Buf: array[ 0..MAX_PATH ] of KOLChar;
begin
  GetTempFileName( PKOLChar( DirPath ), PKOLChar( Prefix ), 0, Buf );
  Result := Buf;
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN}

function GetFileListStr(FPath{e.g.'c:\tmp\'}, FMask{e.g.'*.*'}: KOLString): KOLString;
{* List of files in string, separating each path from others with FileOpSeparator.
   E.g.: 'c:\tmp\unit1.dcu'#13'c:\tmp\unit1.~pa' (for use with DeleteFile2Recycle())}
var
   Srch: TFindFileData;
   succ: Boolean;
   dir:KOLString;
begin
   result := '';
   if (FPath<>'') then FPath := IncludeTrailingPathDelimiter( FPath );
   if (FMask<>'') and (FMask[1]={$IFDEF LIN} '/' {$ELSE} '\' {$ENDIF}) then
     FMask := CopyEnd(FMask,2);
   dir:=FPath+FMask;
   succ := Find_First(dir, Srch);
   while succ do begin
      if (not (Srch.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0))then begin
         if Result<>'' then Result := Result + KOLString(FileOpSeparator);
         Result := Result + FPath + KOLString(Srch.cFileName);
      end;
      succ := Find_Next(Srch);
   end;
   Find_Close(Srch);
end;

function DeleteFiles( const DirPath: KOLString ): Boolean;
var Files, Name: KOLString;
begin
  Files := GetFileListStr( ExtractFilePath( DirPath ), ExtractFileName( DirPath ) );
  Result := TRUE;
  while Files <> '' do
  begin
    Name := Parse( Files, FileOpSeparator );
    Result := Result and DeleteFile( PKOLChar( Name ) );
  end;
end;

{$IFDEF WIN_GDI} //>>>>>>>>>>>>
function DeleteFile2Recycle( const Filename : KOLString ) : Boolean;
begin
  Result := DoFileOp( Filename, '', FO_DELETE, FOF_ALLOWUNDO or
    FOF_NOCONFIRMATION or FOF_SIMPLEPROGRESS, 'Deleting...' );
end;

function CopyMoveFiles( const FromList, ToList: KOLString; Move: Boolean ): Boolean;
begin
  Result := DoFileOp(FromList, ToList, FO_COPY - Integer( Move ),
  FOF_ALLOWUNDO, nil);                   //|\\ FO_COPY = 2, FO_MOVE = 1

end;

{$IFNDEF PAS_ONLY}
function DiskFreeSpace( const Path: KOLString ): I64;
type TGetDFSEx = function( Path: PKOLChar; CallerFreeBytes, TotalBytes, FreeBytes: Pointer )
                 : Bool; stdcall;
var GetDFSEx: TGetDFSEx;
    Kern32: THandle;
    V: TOSVersionInfo;
    Ex: Boolean;
    SpC, BpS, NFC, TNC: DWORD;
    FBA, TNB: I64;
begin
  GetDFSEx := nil;
  V.dwOSVersionInfoSize := Sizeof( V );
  GetVersionEx( POSVersionInfo( @ V )^ ); // bug in Windows.pas !
  Ex := FALSE;
  if V.dwPlatformId = VER_PLATFORM_WIN32_NT then
      Ex := V.dwMajorVersion >= 4
  else if V.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
  begin
      Ex := V.dwMajorVersion > 4;
      if not Ex then
      if V.dwMajorVersion = 4 then
      begin
          Ex := V.dwMinorVersion > 0;
          if  not Ex then
              Ex := LoWord( V.dwBuildNumber ) >= $1111;
      end;
  end;
  if Ex then
  begin
    Kern32 := GetModuleHandle( 'kernel32' );
    GetDFSEx := GetProcAddress( Kern32, 'GetDiskFreeSpaceExA' );
  end;
  if Assigned( GetDFSEx ) then
     GetDFSEx( PKOLChar( Path ), @ FBA, @ TNB, @Result )
  else
  begin
     GetDiskFreeSpace( PKOLChar( Path ), SpC, BpS, NFC, TNC );
     Result := Mul64i( MakeInt64( SpC * BpS, 0 ), NFC );
  end;
end;
{$ENDIF}

function DoFileOp( const FromList, ToList: KOLString; FileOp: UINT; Flags: Word;
  Title: PKOLChar): Boolean;
var FOS : {$IFDEF UNICODE_CTRLS}TSHFileOpStructW{$ELSE}TSHFileOpStruct{$ENDIF};
    Buf : PKOLChar;
    L : Integer;
    ToList0: KOLString;
begin
  L := Length( FromList );
  Buf := AllocMem( (L+2) * Sizeof( KOLChar ) );
  Move( FromList[ 1 ], Buf^, L * Sizeof( KOLChar ) );
  for L := L downto 0 do
    if Buf[ L ] = FileOpSeparator then Buf[ L ] := #0;
  //FillChar( FOS, Sizeof( FOS ), #0 );
  ZeroMemory( @FOS, Sizeof( FOS ) );
  if Applet <> nil then
    FOS.Wnd := Applet.Handle;
  FOS.wFunc := FileOp;
  FOS.lpszProgressTitle := Title;
  FOS.pFrom := Buf;
  ToList0 := ToList + #0;
  FOS.pTo := PKOLChar( ToList0 );
  FOS.fFlags := Flags;
  FOS.fAnyOperationsAborted := True;
  Result := {$IFDEF UNICODE_CTRLS}SHFileOperationW{$ELSE}SHFileOperationA{$ENDIF}( FOS ) = 0;
  if Result then
    Result := not FOS.fAnyOperationsAborted;
  FreeMem( Buf );
end;
{$ENDIF WIN_GDI}

{$IFDEF WIN}
function DirIconSysIdxOffline( const Path: KOLString ): Integer;
var SFI: TShFileInfo;
begin
  SFI.iIcon := 0; // Bartov
  {$IFDEF UNICODE_CTRLS} ShGetFileInfoW {$ELSE} ShGetFileInfoA {$ENDIF}
    ( PKOLChar( Path ), FILE_ATTRIBUTE_DIRECTORY, SFI, sizeof( SFI ),
    SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES );
  Result := SFI.iIcon;
end;
{$ENDIF WIN}

{ TDirList }

{$IFDEF SPEED_FASTER}
        {$DEFINE DIRLIST_FASTER}
{$ENDIF}

function NewDirList( const DirPath, Filter: KOLString; Attr: DWORD ): PDirList;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TDirList';
  {$ENDIF}
  Result.ScanDirectory( DirPath, Filter, Attr );
end;

function NewDirListEx( const DirPath, Filters: KOLString; Attr: DWORD ): PDirList;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TDirListEx';
  {$ENDIF}
  Result.ScanDirectoryEx( DirPath, Filters, Attr );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TDirList.Clear;
begin
  Free_And_Nil( FListPositions );
  Free_And_Nil( fStoreFiles );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TDirList.Destroy;
begin
  Clear;
  FPath := '';
  inherited;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function FindFilter(const Filter: KOLString): KOLString;
begin
  Result := Filter;
  if Result = '' then Result := '*.*';
end;
{$ENDIF PAS_VERSION}

function TDirList.Get(Idx: Integer): PFindFileData;
begin
  {$IFDEF DIRLIST_FASTER}
  Result := FListPositions.Items[ Idx ];
  {$ELSE}
  Result := Pointer( Integer( fStoreFiles.fMemory )
      + Integer( FListPositions.Items[ Idx ] ) );
  {$ENDIF}
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TDirList.GetCount: Integer;
begin
  Result := 0;
  if FListPositions = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := FListPositions.Count;
end;
{$ENDIF PAS_VERSION}

function TDirList.GetNames(Idx: Integer): KOLString;
var FData: PFindFileData;
begin
  FData := Get( Idx );
  Result := FData.cFileName;
end;

function TDirList.GetIsDirectory(Idx: Integer): Boolean;
begin
  Result := LongBool( Items[ Idx ].dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY );
end;

{$IFDEF ASM_noVERSION}
function TDirList.SatisfyFilter(FileName: PAnsiChar; FileAttr,
  FindAttr: DWord): Boolean;
asm
        PUSH     EBX
        PUSH     ESI
        PUSH     EDI
        XCHG     EBX, EAX // EBX = @ Self
        MOV      EAX, [FindAttr]
        MOV      EDI, EDX // EDI = FileName
        MOV      EDX, EAX
        AND      EDX, ECX
        CMP      EDX, EAX
        JE       @@1

        TEST AL, FILE_ATTRIBUTE_NORMAL
        JZ      @@ret_false
@@1:
        CMP      word ptr [EDI], '.'
        JE       @@1_1
        CMP      word ptr [EDI], '..'
        JNE      @@1_1
        CMP      byte ptr [EDI+2], 0
        JNE      @@1_1
@@1_0:
        MOV      ECX, [FindAttr]
        TEST     CL, FILE_ATTRIBUTE_NORMAL
        JZ       @@1_1
        CMP      ECX, FILE_ATTRIBUTE_NORMAL
        JE       @@1_1
        TEST     AL, FILE_ATTRIBUTE_DIRECTORY
        JZ       @@1_1
        TEST     CL, FILE_ATTRIBUTE_DIRECTORY
        JNZ      @@ret_true

@@1_1:
        MOV      ECX, [EBX].fFilters
        JECXZ    @@ret_false //?

        MOV      ESI, [ECX].TStrList.fList
        MOV      ESI, [ESI].TList.fItems
        MOV      ECX, [ECX].TStrList.fCount
        JECXZ    @@ret_false

@@2:
        LODSD
        TEST     EAX, EAX
        JZ       @@nx_filter

        PUSHAD

        MOV      EDX, [EAX]
        CMP      DX, $002E
        JE       @@F_d_dd
        AND      EDX, $FFFFFF
        CMP      EDX, $002E2E
        JE       @@F_d_dd

        MOV      EDX, [EDI]
        CMP      DX, $002E
        JE       @@4
        AND      EDX, $FFFFFF
        CMP      EDX, $002E2E
        JE       @@4
        JMP      @@chk_anti

@@F_d_dd:
        MOV      EDX, EDI
        PUSH     EAX
        CALL     StrComp
        TEST     EAX, EAX
        POP      EAX
        JZ       @@popad_ret_true

@@chk_anti:
        XCHG     EDX, EAX // EDX = filter[ i ]
        MOV      EAX, EDI // EAX = FileName
        CMP      byte ptr [EDX], '^'
        JNE      @@3

        INC      EDX
        CALL     _2StrSatisfy
        TEST     AL, AL
        JZ       @@4
        POPAD
        JMP      @@ret_false

@@3:    CALL     _2StrSatisfy
        TEST     AL, AL
        JZ       @@4
@@popad_ret_true:
        POPAD
@@ret_true:
        MOV      AL, 1
        JMP      @@exit

@@4:    POPAD
@@nx_filter:
        LOOP     @@2

@@ret_false:
        XOR      EAX, EAX
@@exit:
        POP      EDI
        POP      ESI
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function TDirList.SatisfyFilter(FileName: PKOLChar; FileAttr,
  FindAttr: DWord): Boolean;
{$IFDEF F_P}
const Dot: AnsiString = '.';
{$ENDIF F_P}
var I: Integer;
    F: PKOLChar;
    HasOnlyNegFilters: Boolean;
    dots: Boolean;
begin
  Result := (((FileAttr and FindAttr) = FindAttr) or
            LongBool(FindAttr and FILE_ATTRIBUTE_NORMAL));
  if not Result then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

  dots := (FileName^ = {$IFDEF F_P}Dot{$ELSE}'.'{$ENDIF})
          and ( (FileName[1] = {$IFDEF F_P}Dot{$ELSE}'.'{$ENDIF})
                and (FileName[2] = #0)
                or (FileName[1] = #0) );

  if not dots then
  if LongBool( FindAttr and FILE_ATTRIBUTE_NORMAL ) and
     (FindAttr <> FILE_ATTRIBUTE_NORMAL) then
     if LongBool( FindAttr and FILE_ATTRIBUTE_DIRECTORY ) and
        LongBool( FileAttr and FILE_ATTRIBUTE_DIRECTORY ) then
        Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

  HasOnlyNegFilters := TRUE;
  for I := 0 to fFilters.Count - 1 do
  begin
    F := fFilters.ItemPtrs[ I ];
    if  F = '' then continue;
    if  FileName = F then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    if  dots then
        continue;
    if F[ 0 ] = '^' then
    begin
        if StrSatisfy( FileName, PKOLChar(@F[ 1 ]) ) then
        begin
           Result := False; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
    end else
    begin
        HasOnlyNegFilters := FALSE;
        if  StrSatisfy( FileName, F ) then
            Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end;

  Result := HasOnlyNegFilters and not dots;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_nononoVERSION}
procedure TDirList.ScanDirectory(const DirPath, Filter: KOLString;
  Attr: DWord);
const   sz_win32finddata = sizeof(TWin32FindData);
asm
        PUSH     EBX
        PUSH     EDI
        MOV      EBX, EAX

        PUSHAD
        CALL     Clear
        CALL     NewList
        MOV      [EBX].fList, EAX
        POPAD

        PUSHAD
        LEA      EAX, [EBX].fPath
        CALL     System.@LStrAsg
        POPAD

        MOV      EAX, [EBX].fPath
        TEST     EAX, EAX
        JE       @@exit

        PUSHAD
        LEA      EDX, [EBX].fPath
        MOV      EAX, [EDX]
        CALL     IncludeTrailingPathDelimiter

        MOV      EAX, [EBX].fFilters
        TEST     EAX, EAX
        JNZ      @@1
        CALL     NewStrList
        MOV      [EBX].fFilters, EAX
        POPAD

        PUSHAD
        PUSH     ECX
        XCHG     EAX, ECX
        MOV      EDX, offset[@@star_d_star]
        CALL     StrComp
        TEST     AL, AL
        POP      EDX
        JNZ      @@asg_Filter
        MOV      EDX, offset[@@star]
@@asg_Filter:
        MOV      EAX, [EBX].fFilters
        CALL     TStrList.Add
        JMP      @@1

@@star_d_star:
        DB       '*.*', 0 // PCHAR

        {$IFDEF _D2009orHigher}
        DW       0, 1
        {$ENDIF}
        DD       -1, 1
@@star: DB       '*', 0

@@1:
        POPAD

        ADD      ESP, -sz_win32finddata
        XOR      EDX, EDX
        PUSH     EDX
        PUSH     EDX
        XCHG     EAX, ECX
        MOV      EDX, ESP
        CALL     FindFilter

        LEA      EAX, [ESP+4]
        MOV      EDX, [EBX].fPath
        POP      ECX
        PUSH     ECX
        CALL     System.@LStrCat3
        CALL     RemoveStr

        POP      EAX
        MOV      EDX, ESP
        PUSH     EAX
        PUSH     EDX
        PUSH     EAX
        CALL     FindFirstFile
        MOV      EDI, EAX
        INC      EAX
        MOV      EAX, ESP

        PUSHFD
        CALL     System.@LStrClr
        POPFD
        POP      ECX

        JZ       @@fin

@@loop:
        MOV      ECX, [ESP].TWin32FindData.dwFileAttributes
        PUSH     [Attr]
        LEA      EDX, [ESP+4].TWin32FindData.cFileName
        MOV      EAX, EBX
        CALL     SatisfyFilter

        TEST     AL, AL
        JZ       @@next

        MOV      ECX, [EBX].fOnItem.TMethod.Code
        JECXZ    @@accept
        MOV      EAX, [EBX].fOnItem.TMethod.Data
        MOV      ECX, ESP
        PUSH     1
        MOV      EDX, ESP
        PUSH     EDX
        MOV      EDX, EBX
        CALL     dword ptr [EBX].fOnItem.TMethod.Code
        POP      ECX
        JECXZ    @@next
        LOOP     @@fin

@@accept:
        MOV      EAX, sz_win32finddata
        PUSH     EAX
          CALL     System.@GetMem
          PUSH     EAX
            XCHG     EDX, EAX
            MOV      EAX, [EBX].fList
            CALL     TList.Add
          POP      EDX
        POP      ECX
        MOV      EAX, ESP
        CALL     System.Move

@@next:
        PUSH     ESP
        PUSH     EDI
        CALL     FindNextFile
        TEST     EAX, EAX
        JNZ      @@loop

        PUSH     EDI
        CALL     FindClose

@@fin:
        ADD      ESP, sz_win32finddata
@@exit:
        XOR      EAX, EAX
        XCHG     EAX, [EBX].fFilters
        CALL     TObj.Free
        POP      EDI
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
procedure TDirList.ScanDirectory(const DirPath, Filter: KOLString;
  Attr: DWord);
var FindData : TFindFileData;
    Action: TDirItemAction;
    {$IFDEF FORCE_ALTERNATEFILENAME}
    IsUnicode: KOLString;
    {$ENDIF}
    {$IFDEF UNICODE_CTRLS}
            {$IFDEF SPEED_FASTER}
            {$IFDEF DIRLIST_OPTIMIZE_ASCII}
                    P: PKOLChar;
            {$ENDIF}
            {$ENDIF}
    {$ENDIF}
begin
  Clear;
  FPath := DirPath;
  if FPath = '' then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FPath := IncludeTrailingPathDelimiter( FPath );
  if (fFilters = nil) then
  begin
    fFilters := {$IFDEF UNICODE_CTRLS} NewWStrList {$ELSE} NewStrList {$ENDIF};
    if   Filter = '*.*' then
         fFilters.Add( '*' )
    else fFilters.Add( Filter );
  end;
  if  Find_First( PKOLChar( FPath + FindFilter( Filter ) ), FindData ) then
  begin // D[u]fa. fix mem leaks (FList, fFilters)
      FListPositions := NewList;
      while True do
      begin
        {$IFDEF FORCE_ALTERNATEFILENAME} //+MtsVN
                IsUnicode := FindData.cFileName;
                if (IsUnicode <> '.') and (IsUnicode <> '..') then
                begin
                 if pos('?', IsUnicode) > 0 then
                     CopyMemory( @FindData.cFileName, @FindData.cAlternateFileName,
                                 SizeOf(FindData.cAlternateFileName));
                end;
        {$ENDIF}
        if SatisfyFilter( PKOLChar(@FindData.cFileName[0]),
                          FindData.dwFileAttributes, Attr ) then
        begin
          Action := diAccept;
          if  Assigned( OnItem ) then
              OnItem( @Self, FindData, Action );
          CASE Action OF
          diSkip: ;
          diAccept:
            begin
              if  fStoreFiles = nil then
              begin
                  {$IFDEF DIRLIST_FASTER}
                  fStoreFiles := NewMemBlkStream_WriteOnly( 32 * Sizeof( FindData ) );
                  {$ELSE}
                  fStoreFiles := NewMemoryStream( );
                  fStoreFiles.Capacity := 64 * Sizeof( FindData );
                  {$ENDIF}
              end;
              {$IFDEF DIRLIST_FASTER}{$ELSE}
              FListPositions.Add( Pointer( fStoreFiles.Position ) );
              {$ENDIF}
              {$IFDEF UNICODE_CTRLS}
                      {$IFDEF SPEED_FASTER}
                              {$IFDEF DIRLIST_OPTIMIZE_ASCII}
                              FindData.dwReserved0 := 0;
                              P := @ FindData.cFileName[0];
                              while P^ <> #0 do
                              begin
                                  if  PWord( P )^ > 255 then
                                  begin
                                      inc( FindData.dwReserved0 );
                                      break;
                                  end;
                                  inc( P );
                              end;
                              {$ENDIF}
                      {$ENDIF}
              {$ENDIF}
              fStoreFiles.Write( FindData, Sizeof( FindData ) );
              {$IFDEF DIRLIST_FASTER}
              FListPositions.Add( fStoreFiles.fData.fJustWrittenBlkAddress );
              {$ENDIF}
            end;
          diCancel: break;
          END;
        end;
        if not Find_Next( FindData ) then break;
      end;
      Find_Close( FindData );
  end;
  Free_And_Nil(fFilters); //D[u]fa
  {$IFnDEF SPEED_FASTER}
  if  fStoreFiles <> nil then
  begin
      fStoreFiles.fData.fCapacity := 0;
      fStoreFiles.Size := fStoreFiles.Position;
  end;
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
procedure TDirList.ScanDirectoryEx(const DirPath, Filters: KOLString;
  Attr: DWord);
var F, FF: KOLString;
begin
  FF := Filters;
  Free_And_Nil( fFilters );
  fFilters := {$IFDEF UNICODE_CTRLS} NewWStrList {$ELSE} NewStrList {$ENDIF};
  repeat
    F := Trim( Parse( FF, ';' ) );
    if F <> '' then
      fFilters.Add( F );
  until FF = '';
  ScanDirectory( DirPath, '', Attr );
end;
{$ENDIF PAS_VERSION}

type
  PSortDirData = ^TSortDirData;
  TSortDirData = packed Record
    CountRules: Integer;
    FoldersFirst, CaseSensitive, InvertSortOrder : Boolean;
    Rules : array[ 0..10 ] of TSortDirRules;
    Dir : PDirList;
  end;

function CompareDirItems( const Data : PSortDirData; const e1, e2 : DWORD ) : Integer;
var I : Integer;
    Item1, Item2 : PFindFileData;
    S1, S2 : PKOLChar;
    {$IFDEF UNICODE_CTRLS}
    W1, W2: KOLWideString;
    {$ENDIF}
    IsDir1, IsDir2 : Boolean;
    {$IFDEF _D4orHigher}
    sz1, sz2: I64;
    {$ENDIF}
begin
  Item1 := Data.Dir.Get( e1 ); // fList.Items[ e1 ];
  Item2 := Data.Dir.Get( e2 ); // fList.Items[ e2 ];
  Result := 0;
  if Data.FoldersFirst then
  begin
      IsDir1 := (Item1.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0;
      IsDir2 := (Item2.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0;
      if  IsDir1 <> IsDir2 then
      begin
          if IsDir1 then Result := -1 else Result := 1;
          exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
  end;
  for I := 0 to High(Data.Rules){Data.CountRules} do
  begin
    case Data.Rules[ I ] of
    sdrByName:
      begin
        S1 := Item1.cFileName;
        S2 := Item2.cFileName;
        if not Data.CaseSensitive then
        begin
          {$IFDEF UNICODE_CTRLS}
          {$IFDEF SPEED_FASTER}
          {$IFDEF DIRLIST_OPTIMIZE_ASCII}
          if  Item1.dwReserved0 or Item2.dwReserved1 = 0 then
          begin
              //// ATTANTION: _AnsiCompareStrNoCaseA( '', '' ); must be called before sort!
              while TRUE do
              begin
                  Result := SortAnsiOrderNoCase[ Char( S1^ ) ]
                          - SortAnsiOrderNoCase[ Char( S2^ ) ];
                  if  Result <> 0 then break;
                  if  S1^ = #0 then break;
                  inc( S1 );
                  inc( S2 );
              end;
              if  Result = 0 then
                  Result := _AnsiCompareStr( Item1.cFileName, Item2.cFileName );
          end else
          {$ENDIF}
          {$ENDIF}
          begin
              W1 := S1;
              W2 := S2;
              CharUpperBuffW(Pointer(@W1[1]), Length(W1));
              CharUpperBuffW(Pointer(@W2[1]), Length(W2));
              Result := _WStrComp( @W1[1], @W2[1] );
          end;
          {$ELSE not UNICODE_CTRLS}
          Result := _AnsiCompareStrNoCaseA( S1, S2 );
          if  Result = 0 then
              Result := _AnsiCompareStr( S1, S2 );
          {$ENDIF}
        end else
            Result := {$IFDEF UNICODE_CTRLS}
                        _WStrComp( S1, S2 )
                      {$ELSE}
                        _AnsiCompareStrA( S1, S2 )
                      {$ENDIF};
      end;
    sdrByExt:
      begin
        S1 := Item1.cFileName;
        S2 := Item2.cFileName;
        S1 := {$IFDEF UNICODE_CTRLS} @ S1[ DelimiterLast( KOLWideString( S1 ), '.' ) - 1 ]
              {$ELSE} __DelimiterLast( S1, '.' ) {$ENDIF};
        S2 := {$IFDEF UNICODE_CTRLS} @ S2[ DelimiterLast( KOLWideString( S2 ), '.' ) - 1 ]
              {$ELSE} __DelimiterLast( S2, '.' ) {$ENDIF};
        if   not Data.CaseSensitive then
             Result := {$IFDEF UNICODE_CTRLS}
                         WStrComp( WAnsiUpperCase( S1 ), WAnsiUpperCase( S2 ) )
                       {$ELSE} _AnsiCompareStrNoCase( S1, S2 ) {$ENDIF}
        else Result := {$IFDEF UNICODE_CTRLS} WStrComp( S1, S2 )
                       {$ELSE} _AnsiCompareStr( S1, S2 ) {$ENDIF};
      end;
    sdrBySize, sdrBySizeDescending:
      begin
        {$IFDEF _D5orHigher}
        sz1 := MakeInt64( Item1.nFileSizeLow, Item1.nFileSizeHigh );
        sz2 := MakeInt64( Item2.nFileSizeLow, Item2.nFileSizeHigh );
        if Int64(sz1) < Int64(sz2) then
           Result := -1
        else if Int64(sz1) > Int64(sz2) then
           Result := 1
        else
           Result := 0;
        {$ELSE}
        {$IFDEF _D4orHigher}
        sz1 := MakeInt64( Item1.nFileSizeLow, Item1.nFileSizeHigh );
        sz2 := MakeInt64( Item2.nFileSizeLow, Item2.nFileSizeHigh );
        Result := Cmp64(sz1, sz2);
        {$ELSE}
        if   Item1.nFileSizeHigh < Item2.nFileSizeHigh then
             Result := -1
        else if Item1.nFileSizeHigh > Item2.nFileSizeHigh then
             Result := 1
        else if Item1.nFileSizeLow < Item2.nFileSizeLow then
             Result := -1
        else if Item1.nFileSizeLow > Item2.nFileSizeLow then
             Result := 1;
        {$ENDIF}
        {$ENDIF}
        if  Data.Rules[ I ] = sdrBySizeDescending then
            Result := -Result;
      end;
{$IFDEF FPC}
    sdrByDateCreate:
        Result := CompareFileTime( @Item1.ftCreationTime, @Item2.ftCreationTime );
    sdrByDateChanged:
        Result := CompareFileTime( @Item1.ftLastWriteTime, @Item2.ftLastWriteTime );
    sdrByDateAccessed:
        Result := CompareFileTime( @Item1.ftLastAccessTime, @Item2.ftLastAccessTime );
{$ELSE}
    sdrByDateCreate:
        Result := CompareFileTime( Item1.ftCreationTime, Item2.ftCreationTime );
    sdrByDateChanged:
        Result := CompareFileTime( Item1.ftLastWriteTime, Item2.ftLastWriteTime );
    sdrByDateAccessed:
        Result := CompareFileTime( Item1.ftLastAccessTime, Item2.ftLastAccessTime );
{$ENDIF}
    sdrNone: break;
    end; {case}
    if Result <> 0 then break;
  end;
  if  Data.InvertSortOrder then
      Result := -Result;
end;

procedure SwapDirItems( Data : PSortDirData; const e1, e2 : DWORD ); forward;
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
procedure SwapDirItems( Data : PSortDirData; const e1, e2 : DWORD );
begin
    Data.Dir.FListPositions.Swap( e1, e2 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF noASM_VERSION}
procedure TDirList.Sort(Rules: array of TSortDirRules);
const   high_DefSortDirRules = High( DefSortDirRules );
asm
        PUSH     EBX
        PUSH     ESI
        XOR      EBX,EBX
        CMP      [EAX].FListPositions, EBX
        JE       @@exit

        PUSH     EAX           // prepare Dir = @Self
        XOR      EAX, EAX
        PUSH     EAX
        PUSH     EAX
        PUSH     EAX
        PUSH     EAX
        MOV      ESI, ESP
        INC      ECX           // ECX = High(Rules)
        JZ       @@2
@@1:    MOV      AH, [EDX]     // AH = Rules[ I ]
        INC      EDX
        CALL     @@add_rule
        LOOP     @@1
@@2:    LEA      EDX, [DefSortDirRules]
        MOV      CL, high_DefSortDirRules + 1
@@21:   MOV      AH, [EDX]
        INC      EDX
        CALL     @@add_rule
        LOOP     @@21

        {$IFDEF  UNICODE_CTRLS}
        {$IFDEF  SPEED_FASTER}
        MOV      EAX, offset[@@emptyStr]
        MOV      EDX, EAX
        CALL     dword ptr [_AnsiCompareStrNoCaseA]
        {$ENDIF}
        {$ENDIF}

        PUSH     BX           // prepare FoldersFirst(BL), CaseSensitive(BH)
        MOV      EBX, [ESP].TSortDirData.Dir
        MOV      EAX, ESP
        PUSH     BX
        PUSH     offset[SwapDirItems]
        MOV      ECX, offset[CompareDirItems]
        MOV      EDX, [EBX].FListPositions
        MOV      EDX, [EDX].TList.fCount
        CALL     SortData

        ADD      ESP, 20
        JMP      @@exit

        {$IFDEF  UNICODE_CTRLS}
        {$IFDEF  SPEED_FASTER}
@@emptyStr:
        DW       0
        {$ENDIF}
        {$ENDIF}

@@add_rule:
        PUSH     ESI
        PUSH     ECX
        MOV      CL, 11
@@a1:   LODSB
        TEST     AL, AL
        JZ       @@a2
        CMP      AL, AH
        JE       @@a3
        LOOP     @@a1
@@a2:   DEC      ESI
        MOV      [ESI], AH
        CMP      AH, sdrFoldersFirst
        JNE      @@a4
        INC      BL
@@a4:   CMP      AH, sdrCaseSensitive
        JNE      @@a3
        INC      BH
@@a3:   POP      ECX
        POP      ESI
        RET

@@exit:
        POP      ESI
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
procedure TDirList.Sort(Rules: array of TSortDirRules);
var SortDirData : TSortDirData;
    I, J : Integer;

    function RulePresent( Rule : TSortDirRules ) : Boolean;
    var K : Integer;
    begin
      Result := True;
      for K := J - 1 downto 0 do
        if Rule = SortDirData.Rules[ K ] then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>}
      Result := False;
    end;

    procedure AddRule( Rule : TSortDirRules );
    begin
      if  Rule in [sdrFoldersFirst, sdrCaseSensitive, sdrInvertOrder] then
      begin
          if  Rule = sdrFoldersFirst then
              SortDirData.FoldersFirst := TRUE;
          if  Rule = sdrCaseSensitive then
              SortDirData.CaseSensitive := TRUE;
          if  Rule = sdrInvertOrder then
              SortDirData.InvertSortOrder := TRUE;
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      {$IFDEF SAFE_CODE}
      if J > High( SortDirData.Rules ) then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      {$ENDIF}
      if RulePresent( Rule ) then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      SortDirData.Rules[ J ] := Rule;
      Inc( J );
    end;
begin
  if FListPositions = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  ZeroMemory( @ SortDirData, Sizeof( SortDirData ) ); //.CaseSensitive := false; // MTsv DN
  J := 0;
  for I := 0 to High(Rules) do
      AddRule( Rules[ I ] );
  for I := 0 to High(DefSortDirRules) do
      AddRule( DefSortDirRules[ I ] );
  SortDirData.CountRules := J;
  SortDirData.Dir := @Self;
  {$IFDEF UNICODE_CTRLS}
          {$IFDEF SPEED_FASTER}
                  _AnsiCompareStrNoCaseA( '', '' );
          {$ENDIF}
  {$ENDIF}
  SortData( Pointer( @SortDirData ), FListPositions.fCount, @CompareDirItems, @SwapDirItems );
end;
{$ENDIF PAS_VERSION}

function TDirList.FileList(const Separator: KOLString; Dirs,
  FullPaths: Boolean): KOLString;
var I: Integer;
begin
  Result := '';
  for I := 0 to Count-1 do
  begin
    if not Dirs and IsDirectory[ I ] then Continue;
    if FullPaths then
      Result := Result + Path;
    Result := Result + Names[ I ] + Separator;
  end;
end;

procedure TDirList.DeleteItem(Idx: Integer);
begin
    FListPositions.Delete( Idx );
end;

procedure TDirList.AddItem(FindData: PFindFileData);
begin
    if  fStoreFiles = nil then
    begin
        {$IFDEF DIRLIST_FASTER}
        fStoreFiles := NewMemBlkStream_WriteOnly( 32 * Sizeof( FindData ) );
        {$ELSE}
        fStoreFiles := NewMemoryStream( );
        fStoreFiles.Capacity := 64 * Sizeof( FindData );
        {$ENDIF}
        FListPositions := NewList;
    end;
    {$IFDEF DIRLIST_FASTER}{$ELSE}
    FListPositions.Add( Pointer( fStoreFiles.Position ) );
    {$ENDIF}
    {$IFDEF UNICODE_CTRLS}
            {$IFDEF SPEED_FASTER}
                    {$IFDEF DIRLIST_OPTIMIZE_ASCII}
                    FindData.dwReserved0 := 0;
                    P := @ FindData.cFileName[0];
                    while P^ <> #0 do
                    begin
                        if  PWord( P )^ > 255 then
                        begin
                            inc( FindData.dwReserved0 );
                            break;
                        end;
                        inc( P );
                    end;
                    {$ENDIF}
            {$ENDIF}
    {$ENDIF}
    fStoreFiles.Write( FindData^, Sizeof( FindData^ ) );
    {$IFDEF DIRLIST_FASTER}
    FListPositions.Add( fStoreFiles.fData.fJustWrittenBlkAddress );
    {$ENDIF}
end;

procedure TDirList.InsertItem(idx: Integer; FindData: PFindFileData);
begin
    if  fStoreFiles = nil then
    begin
        {$IFDEF DIRLIST_FASTER}
        fStoreFiles := NewMemBlkStream_WriteOnly( 32 * Sizeof( FindData ) );
        {$ELSE}
        fStoreFiles := NewMemoryStream( );
        fStoreFiles.Capacity := 64 * Sizeof( FindData );
        {$ENDIF}
        FListPositions := NewList;
    end;
    {$IFDEF DIRLIST_FASTER}{$ELSE}
    FListPositions.Insert( idx, Pointer( fStoreFiles.Position ) );
    {$ENDIF}
    {$IFDEF UNICODE_CTRLS}
            {$IFDEF SPEED_FASTER}
                    {$IFDEF DIRLIST_OPTIMIZE_ASCII}
                    FindData.dwReserved0 := 0;
                    P := @ FindData.cFileName[0];
                    while P^ <> #0 do
                    begin
                        if  PWord( P )^ > 255 then
                        begin
                            inc( FindData.dwReserved0 );
                            break;
                        end;
                        inc( P );
                    end;
                    {$ENDIF}
            {$ENDIF}
    {$ENDIF}
    fStoreFiles.Write( FindData^, Sizeof( FindData^ ) );
    {$IFDEF DIRLIST_FASTER}
    FListPositions.Insert( idx, fStoreFiles.fData.fJustWrittenBlkAddress );
    {$ENDIF}
end;

{$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
////////////////////////////////////////////////////////////////////////
//                        R  E  G  I  S  T  R  Y                      //
////////////////////////////////////////////////////////////////////////

{ -- registry -- }

function RegKeyOpenRead( Key: HKey; const SubKey: KOLString ): HKey;
begin
  if RegOpenKeyEx( Key, PKOLChar( SubKey ), 0, KEY_READ, Result ) <> ERROR_SUCCESS then
     Result := 0;
end;

function RegKeyOpenWrite( Key: HKey; const SubKey: KOLString ): HKey;
begin
  if RegOpenKeyEx( Key, PKOLChar( SubKey ), 0, KEY_READ or KEY_WRITE, Result ) <> ERROR_SUCCESS then
     Result := 0;
end;

function RegKeyOpenCreate( Key: HKey; const SubKey: KOLString ): HKey;
var dwDisp: DWORD;
begin
  if RegCreateKeyEx( Key, PKOLChar( SubKey ), 0, nil, 0, KEY_ALL_ACCESS, nil, Result,
                     @dwDisp ) <> ERROR_SUCCESS then
    Result := 0;
end;

function RegKeyGetDw( Key: HKey; const ValueName: KOLString ): DWORD;
var dwType, dwSize: DWORD;
begin
  dwSize := sizeof( DWORD );
  Result := 0;
  if (Key = 0) or
     (RegQueryValueEx( Key, PKOLChar( ValueName ), nil, @dwType, PByte( @Result ), @dwSize ) <> ERROR_SUCCESS)
     or (dwType <> REG_DWORD) then Result := 0;
end;

{$IFDEF REGKEYGETSTREX_ALWAYS}
function RegKeyGetStr( Key: HKey; const ValueName: KOLString ): KOLString;
begin
    Result := RegKeyGetStrEx( Key, ValueName
           {$IFDEF OPTIONAL_REG_EXPAND_SZ}, FALSE {$ENDIF} );
end;
{$ELSE}
function RegKeyGetStr( Key: HKey; const ValueName: KOLString ): KOLString;
var dwType, dwSize: DWORD;
    Buffer: PKOLChar;

    function Query: Boolean;
    begin
      Result := RegQueryValueEx( Key, PKOLChar( ValueName ), nil, @dwType,
                Pointer( Buffer ), @dwSize ) = ERROR_SUCCESS;
    end;
begin
  Result := '';
  if Key = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  dwSize := 0;
  Buffer := nil;
  if not Query or (dwType <> REG_SZ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  GetMem( Buffer, dwSize * Sizeof( KOLChar ) );
  if Query then
    Result := Buffer;
  FreeMem( Buffer );
end;
{$ENDIF}

function RegKeyGetStrEx( Key: HKey; const ValueName: KOLString
  {$IFDEF OPTIONAL_REG_EXPAND_SZ} ; ExpandEnvVars: Boolean {$ENDIF} ):
KOLString;
var dwType, dwSize: DWORD;
    Buffer, Buffer2: PKOLChar;
    Sz: Integer;
    function Query: Boolean;
    begin
      Result := RegQueryValueEx( Key, PKOLChar( ValueName ), nil, @dwType,
                Pointer( Buffer ), @dwSize ) = ERROR_SUCCESS;
    end;
begin
  Result := '';
  if Key = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  dwSize := 0;
  Buffer := nil;
  if not Query or ((dwType <> REG_SZ) and (dwtype <> REG_EXPAND_SZ)) then
     Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  GetMem( Buffer, dwSize * Sizeof( KOLChar ) );
  if Query then
  begin
     if (dwtype = REG_EXPAND_SZ) {$IFDEF OPTIONAL_REG_EXPAND_SZ} and (ExpandEnvVars) {$ENDIF} then
     begin
        Sz := ExpandEnvironmentStrings(Buffer,nil,0);
        GetMem(Buffer2,Sz * Sizeof( KOLChar ));                            //
        ExpandEnvironmentStrings(Buffer, Buffer2, Sz); //
        Result:=Buffer2;                               //
        FreeMem(Buffer2);                              //
     end else Result := Buffer;
  end;
  FreeMem( Buffer );
end;

function RegKeySetDw( Key: HKey; const ValueName: KOLString; Value: DWORD ): Boolean;
begin
  Result := (Key <> 0) and (RegSetValueEx( Key, PKOLChar( ValueName ), 0,
    REG_DWORD, @Value, sizeof( DWORD ) ) = ERROR_SUCCESS);
end;

function RegKeySetStr( Key: HKey; const ValueName: KOLString; const Value: KOLString ): Boolean;
begin
  Result := (Key <> 0) and (RegSetValueEx( Key, PKOLChar( ValueName ), 0,
            REG_SZ, PKOLChar(Value),
             (Length( Value ) + 1)*Sizeof(KOLChar) ) = ERROR_SUCCESS);
end;

function RegKeySetStrEx( Key: HKey; const ValueName: KOLString; const Value: KOLString;
                         expand: Boolean): Boolean;
var dwType: DWORD;
begin
  dwType := REG_SZ;
  if expand then
    dwType := REG_EXPAND_SZ;
  Result := (Key <> 0) and (RegSetValueEx(Key, PKOLChar(ValueName), 0, dwType,
            PKOLChar(Value), (Length(Value) + 1)*Sizeof(KOLChar)) = ERROR_SUCCESS);
end;

procedure RegKeyClose( Key: HKey );
begin
  if Key <> 0 then
    RegCloseKey( Key );
end;

function RegKeyDelete( Key: HKey; const SubKey: KOLString ): Boolean;
begin
  Result := FALSE;
  if Key <> 0 then
    Result := RegDeleteKey( Key, PKOLChar( SubKey ) ) = ERROR_SUCCESS;
end;

function RegKeyDeleteValue( Key: HKey; const SubKey: KOLString ): Boolean;
begin
  Result := FALSE;
  if Key <> 0 then
    Result := RegDeleteValue( Key, PKOLChar( SubKey ) ) = ERROR_SUCCESS;
end;

function RegKeyExists( Key: HKey; const SubKey: KOLString ): Boolean;
var K: Integer;
begin
  if Key = 0 then
  begin
    Result := FALSE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  K := RegKeyOpenRead( Key, SubKey );
  Result := K <> 0;
  if K <> 0 then
    RegKeyClose( K );
end;

function RegKeyValExists( Key: HKey; const ValueName: KOLString ): Boolean;
var dwType, dwSize: DWORD;
begin
  Result := (Key <> 0) and
            (RegQueryValueEx( Key, PKOLChar( ValueName ), nil,
            @dwType, nil, @dwSize ) = ERROR_SUCCESS);
end;

function RegKeyValueSize( Key: HKey; const ValueName: KOLString ): Integer;
begin
  Result := 0;
  if Key = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  RegQueryValueEx( Key, PKOLChar( ValueName ), nil, nil, nil, @ DWORD( Result ) );
end;

function RegKeyGetBinary( Key: HKey; const ValueName: KOLString; var Buffer; Count: Integer ): Integer;
begin
  Result := 0;
  if Key = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := Count;
  RegQueryValueEx( Key, PKOLChar( ValueName ), nil, nil, @ Buffer, @ Result );
end;

function RegKeySetBinary( Key: HKey; const ValueName: KOLString; const Buffer; Count: Integer ): Boolean;
begin
  Result := (Key <> 0) and (RegSetValueEx( Key, PKOLChar( ValueName ), 0,
                    REG_BINARY, @ Buffer, Count ) = ERROR_SUCCESS);
end;

function RegKeyGetDateTime(Key: HKey; const ValueName: KOLString): TDateTime;
begin
  RegKeyGetBinary( Key, ValueName, Result, Sizeof( Result ) );
end;

function RegKeySetDateTime(Key: HKey; const ValueName: KOLString; DateTime: TDateTime): Boolean;
begin
  Result := RegKeySetBinary( Key, ValueName, DateTime, Sizeof( DateTime ) );
end;

{$IFDEF OLD_REGKEYGETSUBKEYS}
//-----------------------------------------------
// functions by Valerian Luft <luft@valerian.de>
//-----------------------------------------------
function RegKeyGetSubKeys( const Key: HKEY; List: PKOLStrList) : Boolean;
var
  I, Size, NumSubKeys, MaxSubKeyLen : DWORD;
  KeyName: KOLString;
begin
  Result := False;
  List.Clear ;
  if RegQueryInfoKey(Key, nil, nil, nil, @NumSubKeys, @MaxSubKeyLen, nil, nil, nil, nil,
nil, nil) = ERROR_SUCCESS then
    begin
      if NumSubKeys > 0 then begin
        for I := 0 to NumSubKeys-1 do
        begin
          Size := MaxSubKeyLen+1;
          SetLength(KeyName, Size);
          RegEnumKeyEx(Key, I, @KeyName[1], Size, nil, nil, nil, nil);
          KeyName := Trim(KeyName); // fixed by Jon
          List.Add(KeyName);
        end;
      end;
      Result:= True;
  end;
end;
{$ELSE} // new (faster) version by Alex Shyshko (Psychedelic)
function RegKeyGetSubKeys(const Key: HKEY; List: PKOLStrList) : Boolean;
var
  i, MaxSubKeyLen, Size: DWORD;
  Buf: PKOLChar;
begin
 Result:=false;
 List.Clear;

 if RegQueryInfoKey(Key, nil, nil, nil, nil, @MaxSubKeyLen, nil, nil, nil, nil,
     nil, nil) = ERROR_SUCCESS then
  begin
  if MaxSubKeyLen > 0 then
    begin
      Size:=MaxSubKeyLen + 1;              //
      GetMem(Buf,Size*Sizeof(KOLChar));    // fixed by Jon
      i:=0;

      while RegEnumKeyEx(Key,i,buf,Size,nil,nil,nil,nil) <> ERROR_NO_MORE_ITEMS do
      begin
       List.Add(KOLString(Buf));
       Size:=MaxSubKeyLen + 1;
       inc(i);
      end;

      FreeMem(Buf{,MaxSubKeyLen + 1});
    end; // if MaxSubKeyLen
   Result:=true;
  end; // if RegQueryInfoKey

end;
{$ENDIF}

{$IFDEF OLD_REGKEYGETVALUENAMES}
function RegKeyGetValueNames(const Key: HKEY; List: PKOLStrList): Boolean;
var
  I, Size, NumSubKeys, NumValueNames, MaxValueNameLen: DWORD;
  ValueName: KOLString;
begin
  List.Clear ;
  Result:=False;
  if RegQueryInfoKey(Key, nil, nil, nil, @NumSubKeys, nil, nil, @NumValueNames,
@MaxValueNameLen, nil, nil, nil) = ERROR_SUCCESS then
  begin
     if NumValueNames > 0 then
        for I := 0 to NumValueNames - 1 do begin
          Size := MaxValueNameLen + 1;
          SetLength(ValueName, Size);
          //FillChar(ValueName[1],Size,#0);
          RegEnumValue(Key, I, @ValueName[1], Size, nil, nil, nil, nil);
          ValueName := Trim(ValueName);
          List.Add(ValueName);
        end;
     Result := True;
  end ;
end;
{$ELSE} // new (faster) version by Alex Shyshko (Psychedelic)
function RegKeyGetValueNames(const Key: HKEY; List: PKOLStrList) : Boolean;
var
  i, MaxValueNameLen, Size: DWORD;
  Buf: PKOLchar;
begin
 Result:=false;
 List.Clear;

 if RegQueryInfoKey(Key, nil, nil, nil, nil, nil, nil, nil, @MaxValueNameLen, nil,
     nil, nil) = ERROR_SUCCESS then
  begin
  if MaxValueNameLen > 0 then
    begin
      Size:=MaxValueNameLen+1;
      GetMem(Buf,Size * SizeOf(KOLChar) );
      i:=0;
      while RegEnumValue(Key,i,buf,Size,nil,nil,nil,nil) <> ERROR_NO_MORE_ITEMS do
      begin
       List.Add(KOLString(Buf));
       Size:=MaxValueNameLen+1;
       inc(i);
      end;

      FreeMem(Buf {,MaxValueNameLen + ... system always knows how long buffer is});
    end; // if MaxValueNameLen
   Result:=true;
  end; // if RegQueryInfoKey

end;
{$ENDIF}

function RegKeyGetValueTyp (const Key:HKEY; const ValueName: KOLString) : DWORD;
begin
Result:= Key ;
if Key <> 0 then
   RegQueryValueEx (Key,@ValueName[1],NIL,@Result,NIL,NIL)
end;

//////////////////////////////////////////////////////////////////////
//                D  A  T  E     A  N  D     T  I  M  E
//////////////////////////////////////////////////////////////////////

{ -- date and time utilities -- }

{* This part of the unit contains date-time routines. It is not a simple compilation
   of Delphi VCL date-time. E.g., TDateTime type is not based on 31-Dec-1899,
   but it is based on 31-Dec-0000 instead, allowing easy manipulating of dates
   at all Christian era, and all other historical era too. }

{$UNDEF PAS_LOCAL}
{$IFDEF F_P} {$DEFINE PAS_LOCAL} {$ENDIF}
{$IFDEF PAS_ONLY} {$DEFINE PAS_LOCAL} {$ENDIF}

procedure DivMod(Dividend: Integer; Divisor: Word; var Result, Remainder: Word);
{$IFDEF PAS_ONLY}
begin
        Result    := Dividend div Divisor;
        Remainder := Dividend mod Divisor;
end;
{$ELSE DELPHI}
asm
        PUSH    EBX
        MOV     EBX,EDX
        MOV     EDX,EAX
        SHR     EDX,16
        DIV     BX
        MOV     EBX,Remainder
        MOV     [ECX],AX
        MOV     [EBX],DX
        POP     EBX
end;
{$ENDIF}

function Now : TDateTime;
var SystemTime : TSystemTime;
begin
   GetLocalTime( SystemTime );
   SystemTime2DateTime( SystemTime, Result );
end;

function Date: TDateTime;
begin
  Result := Trunc( Now );
end;

procedure DecodeDateFully( DateTime: TDateTime; var Year, Month, Day, DayOfWeek: WORD );
var ST: TSystemTime;
begin
  DateTime2SystemTime( DateTime, ST );
  Year := ST.wYear;
  Month := ST.wMonth;
  Day := ST.wDay;
  DayOfWeek := ST.wDayOfWeek;
end;

procedure DecodeDate( DateTime: TDateTime; var Year, Month, Day: WORD );
var Dummy: Word;
begin
  DecodeDateFully( DateTime, Year, Month, Day, Dummy );
end;

function EncodeDate( Year, Month, Day: WORD; var DateTime: TDateTime ): Boolean;
var ST: TSystemTime;
begin
  //FillChar( ST, Sizeof( ST ), #0 );
  ZeroMemory( @ST, Sizeof(ST) );
  ST.wYear := Year;
  ST.wMonth := Month;
  ST.wDay := Day;
  Result := SystemTime2DateTime( ST, DateTime );
end;

procedure IncDays( var SystemTime : TSystemTime; DaysNum : Integer );
var DateTime : TDateTime;
begin
   SystemTime2DateTime( SystemTime, DateTime );
   DateTime := DateTime + DaysNum;
   DateTime2SystemTime( DateTime, SystemTime );
end;

procedure IncMonths( var SystemTime : TSystemTime; MonthsNum : Integer );
var M : Integer;
    DateTime : TDateTime;
begin
   M := SystemTime.wMonth + MonthsNum - 1;
   Inc( SystemTime.wYear, M div 12 );
   SystemTime.wMonth := M mod 12 + 1;

   // Normalize wDayOfWeek field:
   SystemTime2DateTime( SystemTime, DateTime );
   DateTime2SystemTime( DateTime, SystemTime );
end;

function IsLeapYear(Year: Integer): Boolean;
begin
  Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;

function SystemTime2DateTime(const SystemTime : TSystemTime; var DateTime : TDateTime ) : Boolean;
{$IFDEF DATE0_1601}
type
    TTimeRec = record
    CASE Integer OF
    0: ( ft: TFileTime );
    1: ( it: I64 );
    END;
var TR: TTimeRec;
{$ELSE}
var I : Integer;
    _Day : Integer;
    DayTable: PDayTable;
{$ENDIF}
begin
  {$IFDEF DATE0_1601}
//Result := FALSE;
//if  (SystemTime.wYear < 1601) or (SystemTime.wYear > 30827) then Exit; {>>>>>}
  Result := SystemTimeToFileTime( SystemTime, TR.ft );
  if  Result then
      DateTime := Int64( TR.it ) / (10000000.0 * 24 * 3600 ) + Date1601;
  {$ELSE}
  Result := False;
  DateTime := 0.0;
  DayTable := @MonthDays[IsLeapYear(SystemTime.wYear)];
  with SystemTime do
  if {(wYear >= 0) !always true! and} (wYear <= 9999) and
    {(wMonth >= 1) and !otherwise can not convert time only!}
    (wMonth <= 12) and
    {(wDay >= 1) and !otherwise can not convert time only!}
    (wDay <= DayTable^[wMonth])
    {$IFDEF SAFEST_CODE}
    and (wHour < 24) and (wMinute < 60)
    and (wSecond < 60) and (wMilliSeconds < 1000)
    {$ENDIF} then   //
  begin
    _Day := wDay;
    for I := 1 to wMonth - 1 do
        Inc(_Day, DayTable^[I]);
    I := wYear - 1;
    //--------------- by Vadim Petrov ------++
    if I<0 then i := 0;                     //
    //--------------------------------------++
    DateTime := (((wHour * 60 + wMinute) * 60 + wSecond) * 1000 + wMilliSeconds)
             / MSecsPerDay;
    DateTime := DateTime + I * 365 + I div 4 - I div 100 + I div 400 + _Day;
    Result := True;
  end;
  {$ENDIF DATE0_0001}
end;

function DayOfWeek(Date: TDateTime): Integer;
begin
  Result := (Trunc( Date ) + 6) mod 7 + 1;
end;

{$IFDEF DATE0_1601}

{$UNDEF ASM_LOCAL}
{$IFDEF ASM_VERSION}
{$IFDEF _D6orHigher} {$DEFINE ASM_LOCAL}
{$ENDIF}
{$ENDIF PAS_VERSION}

{$IFDEF ASM_LOCAL}
function DateTime2SystemTime(const DateTime : TDateTime; var SystemTime : TSystemTime ) : Boolean;
asm
    PUSH  EDI
    XCHG  EDI, EAX
    FLD   qword ptr [DateTime]
    FSUB  dword ptr [@@date1601]
    FLD   tbyte ptr [@@nsecsperday]
    DB    $DE, $C9 //FMULP ST(1)
    JMP   @@truncD7
@@date1601: DB $50, $AC, $0E, $49
@@nsecsperday: DB 0,0,0,0,$C0,$69,$2A,$C9,$26,$40
@@truncD7:     CALL  System.@TRUNC
    PUSH  EDX
    PUSH  EAX
    MOV   EAX, ESP
    PUSH  EDI
    PUSH  EAX
    CALL  Windows.FileTimeToSystemTime
    POP   ECX
    POP   ECX
    CMP   EAX, 1
    SBB   EAX, EAX
    INC   EAX
    POP   EDI
end;
{$ELSE}
function DateTime2SystemTime(const DateTime : TDateTime; var SystemTime : TSystemTime ) : Boolean;
type
    TTimeRec = record
    CASE Integer OF
    0: ( ft: TFileTime );
    1: ( it: I64 );
    END;
var TR: TTimeRec;
    {$IFnDEF _D6orHigher}
    DD, DH, DL: Double;
    {$ENDIF}
begin
  {$IFDEF _D6orHigher}
  TR.it := I64(
      Trunc( (DateTime - Date1601) * (24.0 * 3600 * 10000000) ) );
  {$ELSE}
  DD := Trunc( (DateTime - Date1601) * (24.0 * 3600 * 10000000) );
  DH := DD / (4.0 * 1024.0 * 1024.0 * 1024.0);
  TR.it.Hi := Trunc( DH );
  DL := DD - TR.it.Hi * (4.0 * 1024.0 * 1024.0);
  TR.it.Lo := Trunc( DL );
  {$ENDIF}
  Result := FileTimeToSystemTime( TR.ft, SystemTime );
end;
{$ENDIF PAS_VERSION}
{$ELSE DATE0_0001}

{$UNDEF ASM_LOCAL}
{$IFDEF ASM_VERSION}
{$IFDEF DATE0_0001}
                   {$DEFINE ASM_LOCAL}
{$ENDIF DATE0_0001}
{$ENDIF PAS_VERSION}

{$IFDEF ASM_LOCAL}
var _MSecsPerDay: Double = MSecsPerDay;
//function DateTime2SystemTime_Asm(const DateTime : TDateTime; var SystemTime : TSystemTime ) : Boolean;
function DateTime2SystemTime(const DateTime : TDateTime; var SystemTime : TSystemTime ) : Boolean;
const
  D1 = 365;
  D4 = D1 * 4 + 1;
  D100 = D4 * 25 - 1;
  D400 = D100 * 4 + 1;
asm
         PUSH  EBX
         PUSH  ESI
         PUSH  EDI
         MOV   ESI, SystemTime
         FLD   QWORD PTR [DateTime]
         CALL  System.@TRUNC
         XCHG  EDI, EAX                // EDI = Days
         PUSH  EDI
         FILD  DWORD PTR [ESP]
         POP   ECX
         FSUBR QWORD PTR [DateTime]
         FMUL  QWORD PTR [_MSecsPerDay]
         CALL  System.@ROUND
         XCHG  EBX, EAX                // EBX = MSecs
         XOR   EAX, EAX
         CMP   EDI, EAX
         JLE   @@retFalse

         DEC   EDI
         INC   EAX // EAX = Y = 1
         MOV   ECX, D400
@@while1:CMP   EDI, ECX
         JL    @@1end
         SUB   EDI, ECX
         ADD   EAX, 400
         JMP   @@while1
@@1end:  PUSH  EAX

         MOV   EAX, EDI
         XOR   EDX, EDX
         MOV   ECX, D100
         DIV   ECX  // EAX = division = I, EDX = reminder = D
         CMP   EAX, 4
         JNZ   @@4
         DEC   EAX
         ADD   EDX, D100
@@4:
         XCHG  EDX, [ESP] // EDX = Y, [ESP] = D
         MOV   ECX, EDX
         XOR   EDX, EDX
         OR    DL, 100
         MUL   EDX        // EAX = I * 100
         ADD   ECX, EAX   // ECX = Y + I * 100
         XCHG  [ESP], ECX // ECX = D, [ESP] = Y

         XCHG  EAX, ECX
         XOR   EDX, EDX
         MOV   ECX, D4
         DIV   ECX     // EAX = [D/D4] = I, EDX = D mod D4 = D
         SHL   EAX, 2
         ADD   [ESP], EAX // Y := Y + I * 4;

         XCHG  EAX, EDX
         XOR   EDX, EDX
         XOR   ECX, ECX
         MOV   CX, D1
         DIV   ECX

         CMP   EAX, 4
         JNZ   @@4x
         DEC   EAX
         ADD   EDX, D1
@@4x:
         POP   ECX
         ADD   EAX, ECX // inc( Y, I )

         PUSH  EDX  // save D
         MOV   [ESI].TSystemTime.wYear, AX
         CALL  IsLeapYear
         SHR   EAX, 1
         SBB   EAX, EAX
         AND   EAX, 12
         LEA   ECX, [EAX+MonthDays]// ECX = DayTable
         POP   EAX  // restore D
         PUSH  ECX
@@whTrue:
         MOVZX EDX, byte ptr [ECX]
         CMP   EAX, EDX
         JL    @@brk
         SUB   EAX, EDX
         INC   ECX
         JMP   @@whTrue
@@brk:
         POP   EDX
         SUB   ECX, EDX
         INC   ECX
         MOV   [ESI].TSystemTime.wMonth, CX
         INC   EAX
         MOV   [ESI].TSystemTime.wDay, AX

         PUSH  dword ptr [DateTime+4]
         PUSH  dword ptr [DateTime]
         CALL  KOL.DayOfWeek
         MOV   [ESI].TSystemTime.wDayOfWeek, AX

         XCHG  EAX, EBX
         XOR   EDX, EDX
         MOV   ECX, 60000
         DIV   ECX  // EAX = MinCount, EDX = MSecCount
         PUSH  EDX
         XOR   EDX, EDX
         XOR   ECX, ECX
         MOV   CL, 60
         DIV   ECX  // EAX = hours, EDX = minutes
         MOV   [ESI].TSystemTime.wHour, AX
         MOV   [ESI].TSystemTime.wMinute, DX
         POP   EAX
         XOR   EDX, EDX
         MOV   CX, 1000
         DIV   ECX  // EAX = seconds, EDX = milliseconds
         MOV   [ESI].TSystemTime.wSecond, AX
         MOV   [ESI].TSystemTime.wMilliseconds, DX
         MOV   AL, 1
@@retFalse:
         POP   EDI
         POP   ESI
         POP   EBX
end;
{$ELSE  PAS_VERSION}
//function DateTime2SystemTime_Pas(const DateTime : TDateTime; var SystemTime : TSystemTime ) : Boolean;
function DateTime2SystemTime(const DateTime : TDateTime; var SystemTime : TSystemTime ) : Boolean;
const
  D1 = 365;
  D4 = D1 * 4 + 1;
  D100 = D4 * 25 - 1;
  D400 = D100 * 4 + 1;
var Days : Integer;
    Y, M, D, I: Word;
    MSec : Integer;
    DayTable: PDayTable;
    MinCount, MSecCount: Word;
begin
  Days := Trunc( DateTime );
  MSec := Round((DateTime - Days) * MSecsPerDay);
  Result := False;
  if  IsNAN( DateTime ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  with SystemTime do
  if Days > 0 then
  begin
      Dec(Days);
      Y := 1;
      while Days >= D400 do
      begin
          Dec(Days, D400);
          Inc(Y, 400);
      end;
      DivMod(Days, D100, I, D);
      if  I = 4 then
      begin
          Dec(I);
          Inc(D, D100);
      end;
      Inc(Y, I * 100);
      DivMod(D, D4, I, D);
      Inc(Y, I * 4);
      DivMod(D, D1, I, D);
      if  I = 4 then
      begin
          Dec(I);
          Inc(D, D1);
      end;
      Inc(Y, I);
      DayTable := @MonthDays[IsLeapYear(Y)];
      M := 1;
      while True do
      begin
          I := DayTable^[M];
          if D < I then Break;
          Dec(D, I);
          Inc(M);
      end;
      wYear := Y;
      wMonth := M;
      wDay := D + 1;
      wDayOfWeek := KOL.DayOfWeek( DateTime );
      DivMod(MSec, 60000, MinCount, MSecCount);
      DivMod(MinCount, 60, wHour, wMinute);
      DivMod(MSecCount, 1000, wSecond, wMilliSeconds);
      Result := True;
  end;
end;
{$ENDIF PAS_VERSION}

{$ENDIF DATE0_0001}

{function DateTime2SystemTime(const DateTime : TDateTime; var SystemTime : TSystemTime ) : Boolean;
var ST_Pas, ST_Asm: TSystemTime;
begin
    if  IsNAN( DateTime ) then
    asm
        nop
    end;
    Result := DateTime2SystemTime_Pas( DateTime, ST_Pas );
    DateTime2SystemTime_Asm( DateTime, ST_Asm );
    if  Result and not CompareMem( @ ST_Asm, @ST_Pas, Sizeof( TSystemTime ) ) then
    while TRUE do
    begin
        DateTime2SystemTime_Pas( DateTime, ST_Pas );
        DateTime2SystemTime_Asm( DateTime, ST_Asm );
    end;
    Result := DateTime2SystemTime_Pas( DateTime, SystemTime );
end;}

function DateTime_DiffSysLoc: TDateTime;
var ST, LT: TSystemTime;
    FT, FT1: TFileTime;
    D1, D2: TDateTime;
begin
  GetSystemTime( ST );
  SystemTimeToFileTime( ST, FT );
  FileTimeToLocalFileTime( FT, FT1 );
  FileTimeToSystemTime( FT1, LT );
  SystemTime2DateTime( ST, D1 );
  SystemTime2DateTime( LT, D2 );
  Result := D2 - D1;
end;

function DateTime_System2Local( DTSys: TDateTime ): TDateTime;
begin
  Result := DTSys + DateTime_DiffSysLoc;
end;

function DateTime_Local2System( DTLoc: TDateTime ): TDateTime;
begin
  Result := DTLoc - DateTime_DiffSysLoc;
end;

function FileTime2DateTime( const ft: TFileTime; var DT: TDateTime ): Boolean;
var ft1: TFileTime;
    st: TSystemTime;
begin
  Result := FileTimeToLocalFileTime( ft, ft1 ) and
            FileTimeToSystemTime( ft1, st ) and
            SystemTime2DateTime( st, dt );
end;

function DateTime2FileTime( DT: TDateTime; var ft: TFileTime ): Boolean;
var st: TSystemTime;
begin
  Result := DateTime2SystemTime( DT, ST ) and
            SystemTimeToFileTime( st, ft ) and
            LocalFileTimeToFileTime( ft, ft );
end;

function SystemDate2Str( const SystemTime : TSystemTime; const LocaleID : DWORD;
                         const DfltDateFormat : TDateFormat;
                         const DateFormat : PKOLChar ) : KOLString;
var Buf : PKOLChar;
    Sz : Integer;
    Flags : DWORD;
begin
   Sz := 100;
   Buf := nil;
   Result := '';
   Flags := 0;
   if DateFormat = nil then
   if   DfltDateFormat = dfShortDate then
        Flags := DATE_SHORTDATE
   else Flags := DATE_LONGDATE;
   while True do
   begin
      if Buf <> nil then
         FreeMem( Buf );
      GetMem( Buf, Sz * Sizeof( KOLChar ) );
      if Buf = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      if GetDateFormat( LocaleID, Flags, @SystemTime, DateFormat, Buf, Sz ) = 0 then
      begin
           if   GetLastError = ERROR_INSUFFICIENT_BUFFER then
                Sz := Sz * 2
           else break;
      end else
      begin
           Result := Buf;
           break;
      end;
   end;
   if Buf <> nil then
      FreeMem( Buf );
end;

function SystemTime2Str( const SystemTime : TSystemTime; const LocaleID : DWORD;
                         const Flags : TTimeFormatFlags;
                         const TimeFormat : PKOLChar ) : KOLString;
var Buf : PKOLChar;
    Sz : Integer;
    Flg : DWORD;
begin
   Sz := 100;
   Buf := nil;
   Result := '';
   Flg := 0;
   if tffNoMinutes in Flags then
      Flg := TIME_NOMINUTESORSECONDS
   else if tffNoSeconds in Flags then
      Flg := TIME_NOSECONDS;
   if tffNoMarker in Flags then
      Flg := Flg or TIME_NOTIMEMARKER;
   if tffForce24 in Flags then
      Flg := Flg or TIME_FORCE24HOURFORMAT;
   while True do
   begin
      if Buf <> nil then
         FreeMem( Buf );
      GetMem( Buf, Sz * Sizeof( KOLChar ) );
      if Buf = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      if GetTimeFormat( LocaleID, Flg, @SystemTime, TimeFormat, Buf, Sz )
         = 0 then
      begin
          if   GetLastError = ERROR_INSUFFICIENT_BUFFER then
               Sz := Sz * 2
          else break;
      end else
      begin
         Result := Buf;
         break;
      end;
   end;
   if Buf <> nil then
      FreeMem( Buf );
end;

function Date2StrFmt( const Fmt: KOLString; D: TDateTime ): KOLString;
var ST: TSystemTime;
    lpFmt: PKOLChar;
begin
  DateTime2SystemTime( D, ST );
  lpFmt := nil;
  if Fmt <> '' then lpFmt := PKOLChar( Fmt );
  Result := SystemDate2Str( ST, LOCALE_USER_DEFAULT, dfShortDate, lpFmt );
end;

function Time2StrFmt( const Fmt: KOLString; D: TDateTime ): KOLString;
var ST: TSystemTime;
    lpFmt: PKOLChar;
begin
  if D < 1 then D := D + 700000;
  DateTime2SystemTime( D, ST );
  lpFmt := nil;
  if Fmt <> '' then lpFmt := PKOLChar( Fmt );
  Result := SystemTime2Str( ST, LOCALE_USER_DEFAULT, [], lpFmt );
end;

function DateTime2StrShort( D: TDateTime ): KOLString;
var ST: TSystemTime;
begin
  //--------- by Vadim Petrov --------++
  if D < 1 then D := D + 1;           //
  //----------------------------------++
  DateTime2SystemTime( D, ST );
  Result := SystemDate2Str( ST, LOCALE_USER_DEFAULT {GetUserDefaultLCID}, dfShortDate, nil ) + ' ' +
            SystemTime2Str( ST, LOCALE_USER_DEFAULT {GetUserDefaultLCID}, [], nil );
end;

function Str2DateTimeFmt( const sFmtStr, sS: KOLString ): TDateTime;
var h12, hAM: Boolean;
    FmtStr, S: PKOLChar;

  function GetNum( var S: PKOLChar; NChars: Integer ): Integer;
  begin
      Result := 0;
      while (S^ <> #0) and (NChars <> 0) do
      begin
          Dec( NChars );
          if  (S^ >= '0') and (S^ <= '9') then
          begin
              Result := Result * 10 + Ord(S^) - Ord('0');
              Inc( S );
          end else break;
      end;
  end;

  function GetYear( var S: PKOLChar; NChars: Integer ): Integer;
  var STNow: TSystemTime;
      OldDate: Boolean;
  begin
    Result := GetNum( S, NChars );
    GetSystemTime( STNow );
    OldDate := (Result >= 50) and (Result < 100);
    Result := Result + STNow.wYear - STNow.wYear mod 100;
    if OldDate then Dec( Result, 100 );
  end;

  function GetMonth( const fmt: KOLString; var S: PKOLChar ): Integer;
  var SD: TSystemTime;
      M: Integer;
      MonthStr: KOLString;
  begin
    GetSystemTime( SD );
    SD.wDay := 1;
    for M := 1 to 12 do
    begin
      SD.wMonth := M;
      MonthStr := SystemDate2Str( SD, LOCALE_USER_DEFAULT, dfLongDate, PKOLChar( fmt {+ '/dd/yyyy/'} ) );
      //MonthStr := Parse( C, '/' ); //++ -- by GMax
      if AnsiCompareStrNoCase( MonthStr, Copy( S, 1, Length( MonthStr ) ) ) = 0 then
      begin
        Inc( S, Length( MonthStr ) );
        Result := M; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
    end;
    Result := 1;
  end;

  procedure SkipDayOfWeek( const fmt: KOLString; var S: PKOLChar );
  var SD: TSystemTime;
      Dt: TDateTime;
      D: Integer;
      C, DayWeekStr: KOLString;
  begin
    GetSystemTime( SD );
    SystemTime2DateTime( SD, Dt );
    Dt := Dt - SD.wDayOfWeek;
    for D := 0 to 6 do
    begin
      DateTime2SystemTime( Dt, SD );
      C := SystemDate2Str( SD, LOCALE_USER_DEFAULT, dfLongDate, PKOLChar( fmt + '/MM/yyyy/' ) );
      DayWeekStr := Parse( C, '/' );
      if AnsiCompareStrNoCase( DayWeekStr, Copy( S, 1, Length( DayWeekStr ) ) ) = 0 then
      begin
        Inc( S, Length( DayWeekStr ) );
        Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      Dt := Dt + 1.0;
    end;
  end;

  procedure GetTimeMark( const fmt: KOLString; var S: PKOLChar );
  var SD: TSystemTime;
      AM: Boolean;
      C, TimeMarkStr: KOLString;
  begin
    GetSystemTime( SD );
    SD.wHour := 0;
    for AM := FALSE to TRUE do
    begin
      C := SystemDate2Str( SD, LOCALE_USER_DEFAULT, dfLongDate, PKOLChar( fmt + '/HH/mm' ) );
      TimeMarkStr := Parse( C, '/' );
      if AnsiCompareStrNoCase( TimeMarkStr, Copy( S, 1, Length( TimeMarkStr ) ) ) = 0 then
      begin
        Inc( S, Length( TimeMarkStr ) );
        hAM := AM;
        Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      SD.wHour := 13;
    end;
    Result := 1;
  end;

  function FmtIs1( S: PKOLChar ): Boolean;
  begin
    if  StrIsStartingFrom( FmtStr, S ) then
    begin
        Inc( FmtStr, {$IFDEF UNICODE_CTRLS} WStrLen {$ELSE} StrLen {$ENDIF}( S ) );
        Result := TRUE;
    end else Result := FALSE;
  end;

  function FmtIs( S1, S2: PKOLChar ): Boolean;
  begin
    Result := FmtIs1( S1 ) or FmtIs1( S2 );
  end;

var ST: TSystemTime;
begin
  FmtStr := PKOLChar( sFmtStr);
  S := PKOLChar( sS );
  //FillChar( ST, Sizeof( ST ), #0 );
  ZeroMemory( @ST, Sizeof( ST ) );
  h12 := FALSE;
  hAM := FALSE;
  while (FmtStr^ <> #0) and (S^ <> #0) do
  begin
    if ((FmtStr^ >= 'a') and (FmtStr^ <= 'z') or
       (FmtStr^ >= 'A') and (FmtStr^ <= 'Z')) and
       (S^ >= '0') and (S^ <= '9') then
    begin
      if      FmtIs1( 'yyyy'   ) then ST.wYear := GetNum( S, 4 )
      else if FmtIs1( 'yy' )     then ST.wYear := GetYear( S, 2 )
      else if FmtIs1( 'y' )      then ST.wYear := GetYear( S, -1 )
      else if FmtIs( 'dd', 'd' ) then ST.wDay := GetNum( S, 2 )
      else if FmtIs( 'MM', 'M' ) then ST.wMonth := GetNum( S, 2 )
      else if FmtIs( 'HH', 'H' ) then ST.wHour := GetNum( S, 2 )
      else if FmtIs( 'hh', 'h' ) then begin ST.wHour := GetNum( S, 2 ); h12 := TRUE end
      else if FmtIs( 'mm', 'm' ) then ST.wMinute := GetNum( S, 2 )
      else if FmtIs( 'ss', 's' ) then ST.wSecond := GetNum( S, 2 )
      else break; // + ECM
    end
      else
    if (FmtStr^ = 'M') or (FmtStr^ = 'd') or (FmtStr^ = 'g') then
    begin
      if      FmtIs1( 'MMMM' ) then ST.wMonth := GetMonth( 'MMMM', S )
      else if FmtIs1( 'MMM'  ) then ST.wMonth := GetMonth( 'MMM', S )
      else if FmtIs1( 'dddd' ) then SkipDayOfWeek( 'dddd', S )
      else if FmtIs1( 'ddd'  ) then SkipDayOfWeek( 'ddd', S )
      else if FmtIs1( 'tt'   ) then GetTimeMark( 'tt', S )
      else if FmtIs1( 't'    ) then GetTimeMark( 't', S )
      else break; // + ECM
    end
      else
    begin
      if FmtStr^ = S^ then
        Inc( FmtStr );
      Inc( S );
    end;
  end;

  if h12 then
  if hAM then
    Inc( ST.wHour, 12 );

  SystemTime2DateTime( ST, Result );
end;

function Str2TimeFmt(const sFmtStr, sS: KOLString): TDateTime;
begin
    Result := Frac(Str2DateTimeFmt( 'y/M/d ' + sFmtStr, '2000/1/1 ' + sS ));
end;

var FmtBuf: PKOLChar;
    DateSeparator : KOLChar = #0; // + ECM

function Str2DateTimeShort( const S: KOLString ): TDateTime;
var FmtStr, FmtStr2: KOLString;

  function EnumDateFmt( lpstrFmt: PKOLChar ): Boolean; stdcall;
  begin
    GetMem( FmtBuf, ({$IFDEF UNICODE_CTRLS} WStrLen {$ELSE} StrLen {$ENDIF}
      ( lpstrFmt ) + 1) * Sizeof( KOLChar ) );
    {$IFDEF UNICODE_CTRLS} WStrCopy {$ELSE} StrCopy {$ENDIF}
      ( FmtBuf, lpstrFmt );
    Result := FALSE;
  end;

begin
  FmtStr := 'dd.MM.yyyy';
  FmtBuf := nil;
  EnumDateFormats( @ EnumDateFmt, LOCALE_USER_DEFAULT, DATE_SHORTDATE );
  if FmtBuf <> nil then
  begin
    FmtStr := FmtBuf;
    FreeMem( FmtBuf );
  end;

  FmtStr2 := 'H:mm:ss';
  FmtBuf := nil;
  EnumTimeFormats( @ EnumDateFmt, LOCALE_USER_DEFAULT, 0 );
  if FmtBuf <> nil then
  begin
    FmtStr2 := FmtBuf;
    FreeMem( FmtBuf );
  end;

  Result := Str2DateTimeFmt( FmtStr + ' ' + FmtStr2, S );
end;

function Str2TimeShort(const S: KOLString): TDateTime;
begin
   Result := Frac( Str2DateTimeShort( Date2StrFmt( '', Now ) + ' ' + S ) );
end;

// + ECM
function Str2DateTimeShortEx( const S: KOLString ): TDateTime;
var
  Buff: Array[0..1] of KOLChar;
begin
  if DateSeparator = #0 then
  begin
    if GetLocaleInfo(GetThreadLocale,LOCALE_SDATE,Buff,2) > 0 then
      DateSeparator := Buff[0];
  end;
  if Pos(DateSeparator,S) = 0 then
    //St := '0.0.0 '+S;
    Result := Str2TimeShort(S)
  else
    Result := Str2DateTimeShort(S);
end;

///////////////////////////////////////////////////////////////////////
//                          T  H  R  E  A  D  S
///////////////////////////////////////////////////////////////////////

{ -- Thread -- }

function ThreadFunc(Thread: PThread): integer; stdcall;
begin
  Result := Thread.Execute;
end;

{$IFDEF USE_CONSTRUCTORS}
function NewThread: PThread;
begin
  new( Result, ThreadCreate );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TThread';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

function NewThread: PThread;
begin
  {$IFNDEF FPC105ORBELOW}
  IsMultiThread := True;
  {$ENDIF}
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TThread';
  {$ENDIF}
  Result.FSuspended := True;
  {$IFDEF PSEUDO_THREADS}
  {$ELSE}
  Result.FHandle := CreateThread( nil, // no security
                                  0,   // the same stack size
                                  @ThreadFunc, // thread entry point
                                  Result,      // parameter to pass to ThreadFunc
                                  CREATE_SUSPENDED,   // always SUSPENDED
                                  Result.FThreadID ); // receive thread ID
  {$ENDIF}
end;
{$ENDIF USE_CONSTRUCTORS}

{$IFDEF USE_CONSTRUCTORS}
function NewThreadEx( const Proc: TOnThreadExecute ): PThread;
begin
  new( Result, ThreadCreateEx( Proc ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TThreadEx';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_!VERSION}
function NewThreadEx( const Proc: TOnThreadExecute ): PThread;
asm
        CALL     NewThread
        POP      EBP
        POP      ECX
        POP      EDX
        MOV      [EAX].TThread.fOnExecute.TMethod.Code, EDX
        POP      EDX
        MOV      [EAX].TThread.fOnExecute.TMethod.Data, EDX
        PUSH     ECX
        PUSH     EAX
        CALL     TThread.Resume
        POP      EAX
        RET
end;
{$ELSE PAS_VERSION} //Pascal
function NewThreadEx( const Proc: TOnThreadExecute ): PThread;
begin
  Result := NewThread;
  Result.OnExecute := Proc;
  Result.Resume;
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

function NewThreadAutoFree( const Proc: TOnThreadExecute ): PThread;
begin
  Result := NewThread;
  Result.OnExecute := Proc;
  Result.F_AutoFree := TRUE;
  {$IFDEF SAFE_CODE}
  if  Assigned( Proc ) then
  {$ENDIF}
      Result.Resume;
end;

{ TThread }

function WndProcCMExec( Sender: PControl; var Msg: TMsg; var Rslt: Integer )
                          : Boolean;
var Thread: PThread;
begin
  Result := FALSE;
  if Msg.message = CM_EXECPROC then
  begin
    Thread := PThread( Msg.lParam );
    if   Msg.wParam <> 0 then
         Thread.FMethodEx( Thread, Pointer( Msg.wParam ) )
    else Thread.FMethod( );
    Rslt := 0;
  end;
end;

{$IFDEF PSEUDO_THREADS}
function timeBeginPeriod(uPeriod: UINT): UINT; stdcall;
external 'winmm.dll' name 'timeBeginPeriod';
function timeEndPeriod(uPeriod: UINT): UINT; stdcall;
external 'winmm.dll' name 'timeEndPeriod';
{$ENDIF}

procedure TThread.Init;
begin
  {$IFDEF CALL_INHERITED}
  inherited;
  {$ENDIF}
  if Applet <> nil then
    Applet.AttachProc( WndProcCMExec );
  {$IFDEF PSEUDO_THREADS}
  if (MainThread = nil) and not CreatingMainThread then
  begin // creating main thread
    CreatingMainThread := TRUE;
    new( MainThread, Create );
    {$IFDEF DEBUG_OBJKIND}
    MainThread.fObjKind := 'MainThread';
    {$ENDIF}
    CreatingMainThread := FALSE;
  end;
  if CreatingMainThread then
  begin
    MainThread := @ Self;
    {MainThread.}AllThreads := NewList;
    {MainThread.}CurrentThread := MainThread;
    TimeBeginPeriod( 10 );
  end;
  if not CreatingMainThread and (MainThread <> @ Self) then
  begin // creating other threads
    GetMem( StackBottom, PseudoThreadStackSize );
    CurStackPos := Pointer( DWORD( StackBottom ) + PseudoThreadStackSize );
    Stack_Empty := TRUE;
  end;
  MainThread.AllThreads.Add( @ Self );
  {$ENDIF}
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TThread.Destroy;
begin
  RefInc;
  if not FTerminated then
  begin
    Terminate;
    WaitFor;
  end;
  if  (FHandle <> 0) then
      CloseHandle(FHandle);
  {$IFDEF PSEUDO_THREADS}
  if  StackBottom <> nil then
      FreeMem( StackBottom );
  if MainThread = @ Self then
  begin
      TimeEndPeriod( 10 );
      AllThreads.Free;
  end else
  if MainThread <> nil then
  begin
      MainThread.AllThreads.Remove( @ Self );
      if  MainThread.AllThreads.Count <= 1 then
          Free_And_Nil( MainThread );
  end;
  {$ENDIF}
  inherited;
end;
{$ENDIF PAS_VERSION}

function TThread.Execute: integer;
{$IFDEF TERMAUTOFREE_THREAD}
var H: THandle;
{$ENDIF}
begin
  {$IFDEF SAFE_CODE}
  Result := 0;
  if  Assigned( FOnExecute ) then
  {$ENDIF}
      Result := FOnExecute( @Self );
  FResult := Result;
  FTerminated := TRUE; // fake thread object (to prevent terminating while freeing)
  if F_AutoFree then
  begin
     {$IFDEF TERMAUTOFREE_THREAD}
     H := FHandle;
     {$ENDIF}
     CloseHandle( FHandle );
     FHandle := 0;
     Free;
     {$IFDEF TERMAUTOFREE_THREAD}
     TerminateThread( H, 0 );
     {$ENDIF}
  end;
end;

function TThread.GetPriorityCls: Integer;
begin
  {$IFDEF PSEUDO_THREADS}
  Result := FPrtyCls;
  {$ELSE}
  Result := GetPriorityClass(FHandle);
  {$ENDIF}
end;

function TThread.GetThrdPriority: Integer;
begin
  {$IFDEF PSEUDO_THREADS}
  Result := FPriority;
  {$ELSE}
  Result := GetThreadPriority(FHandle);
  {$ENDIF}
end;

procedure TThread.Resume;
begin
  {$IFDEF PSEUDO_THREADS}
      if MainThread.CurrentThread = @ Self then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>}
      MainThread.SwitchToThread( @ Self );
  {$ELSE}
      FSuspended := False;
      if  (ResumeThread(FHandle) > 1) then
          FSuspended := True
      else if  Assigned(FOnResume) then
          FOnResume(@Self);
  {$ENDIF}
end;

procedure TThread.SetPriorityCls(Value: Integer);
begin
  {$IFDEF DEBUG_ANY}
  if not SetPriorityClass(GetCurrentProcess, Value) then
  begin
    ShowMessage( SysErrorMessage( GetLastError ) );
  end;
  {$ELSE}
  {$IFDEF PSEUDO_THREADS}
  FPrtyCls := Value;
  {$ELSE}
  SetPriorityClass(GetCurrentProcess, Value);
  {$ENDIF}
  {$ENDIF DEBUG_ANY}
end;

procedure TThread.SetThrdPriority(Value: Integer);
begin
  FPriority := Value;
  {$IFDEF PSEUDO_THREADS}
  {$ELSE}
  SetThreadPriority(FHandle, Value);
  {$ENDIF}
end;

procedure TThread.Suspend;
begin
  {$IFDEF PSEUDO_THREADS}
      if MainThread <> @ Self then
        FSuspended := TRUE;
      if MainThread.CurrentThread = @ Self then
        MainThread.NextThread;
  {$ELSE}
      FSuspended := TRUE;
      if  Assigned(FOnSuspend) then
          Synchronize( FOnSuspend );
      SuspendThread(FHandle);
  {$ENDIF}
end;

{$IFDEF PSEUDO_THREADS}
procedure FinishThread;
begin
  MainThread.CurrentThread.fTerminated := TRUE;
  MainThread.CurrentThread.Stack_Empty := TRUE;
  MainThread.NextThread;
end;

procedure TThread.SwitchToThread(T: PThread);
begin
  {$IFDEF SAFE_CODE}
  if  (T <> MainThread)
  and not Assigned( T.OnExecute ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$ENDIF}
  if Assigned( MainThread.CurrentThread.OnSuspend ) then
  begin
    MainThread.CurrentThread.OnExecute( MainThread.CurrentThread );
  end;
  asm
    mov edx, [T]
    // 1. Suspending current thread
    mov ecx, [MainThread]
    mov eax, [ecx].CurrentThread
    push ebx
    push ebp
    push esi
    push edi
    mov  [eax].CurStackPos, esp
    mov  [eax].Stack_Empty, 0
    // 2. Switching to another thread

    mov  [ecx].CurrentThread, edx

    cmp  [edx].Stack_Empty, 0
    jz   @@1
    // the first call
    mov  [edx].Stack_Empty, 0
    cmp  [edx].FSuspended, 0
    jz   @@0
    mov  [edx].FSuspended, 0

    mov  esp, [edx].CurStackPos
    mov  ecx, [edx].fOnResume.TMethod.Code
    jecxz @@0
    mov  eax, [edx].fOnResume.TMethod.Data
    call ecx // calling OnResume for resuming thread
  @@0:
    mov  eax, [edx].fOnExecute.TMethod.Data
    mov  ecx, [edx].fOnExecute.TMethod.Code
    push offset [FinishThread] // if thread will be finished it will jump there
    jmp  ecx
  @@1:
    // other calls - resuming
    mov  esp, [edx].CurStackPos
    pop edi
    pop esi
    pop ebp
    pop ebx
    cmp  [edx].FSuspended, 0
    jz   @@2
    mov  [edx].FSuspended, 0

    mov  ecx, [edx].fOnResume.TMethod.Code
    jecxz @@2
    mov  eax, [edx].fOnResume.TMethod.Data
    call ecx // calling OnResume for resuming thread
  @@2:
  end;
  // At this point, thread is resumed
end;

procedure TThread.NextThread;
var i: Integer;
    T: PThread;
    C: DWORD;
begin
  i := MainThread.AllThreads.IndexOf( MainThread.CurrentThread );
  if i >= 0 then
  begin
    C := GetTickCount;
    while TRUE do
    begin
      inc( i );
      if i >= MainThread.AllThreads.Count then i := 0;
      T := MainThread.AllThreads.Items[ i ];
      if (T.DoNotWakeUntil > C) and (T <> MainThread) then continue;
      if (T = MainThread) and (MainThread.CurrentThread = T) then
         Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      if not T.Terminated and not ((T <> MainThread) and (T.Suspended)) then
      begin
         break;
      end;
    end;
    MainThread.SwitchToThread( MainThread.AllThreads.Items[ i ] );
  end;
end;

procedure Sleep( n: DWORD );
begin
  if Assigned( MainThread ) then
  begin
    MainThread.CurrentThread.DoNotWakeUntil := GetTickCount + n;
    MainThread.NextThread;
  end else
    if n > 0 then Windows.Sleep( n );
end;

function WaitForMultipleObjects( nCount: DWORD;
  lpHandles: PHandle; fWaitAll: BOOL; dwMilliseconds: DWORD ): DWORD; stdcall;
var i: Integer;
    w: DWORD;
    Ph: PHandle;
    Limit: DWORD;
begin
  if   dwMilliseconds = INFINITE then
       Limit := INFINITE
  else Limit := GetTickCount + dwMilliseconds;
  while TRUE do
  begin
    Ph := lpHandles;
    w := 0;
    for i := 0 to nCount-1 do
    begin
      if Windows.WaitForSingleObject( Ph^, 0 ) = WAIT_OBJECT_0 then
      begin
        inc( w );
        if not fWaitAll then
        begin
          Result := WAIT_OBJECT_0 + i; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
      end;
      inc( Ph );
    end;
    if w = nCount then
    begin
      Result := WAIT_OBJECT_0; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
    if (Limit <> INFINITE) and (GetTickCount > Limit) then
    begin
      Result := WAIT_TIMEOUT; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
    if Assigned( MainThread ) then
      MainThread.NextThread;
    {$IFDEF WAIT_SLEEP}
    Sleep( 10 );
    {$ENDIF}
  end;
end;

function WaitForSingleObject( hHandle: THandle; dwMilliseconds: DWORD ): DWORD; stdcall;
begin
  Result := WaitForMultipleObjects( 1, @ hHandle, TRUE, dwMilliseconds );
end;
{$ENDIF PSEUDO_THREADS}

procedure TThread.Synchronize(Method: TThreadMethod);
begin
  {$IFDEF PSEUDO_THREADS}
  Method;
  {$ELSE}
  FMethod := Method;
  if Applet <> nil then
    SendMessage( Applet.fHandle, CM_EXECPROC, 0, Integer( @Self ) );
  {$ENDIF}
end;

procedure TThread.SynchronizeEx( Method: TThreadMethodEx; Param: Pointer );
begin
  {$IFDEF KOL_ASSERTIONS}
  Assert( Param <> nil, 'Parameter must not be NIL' );
  {$ENDIF KOL_ASSERTIONS}
  {$IFDEF PSEUDO_THREADS}
  Method( TMethod( Method ).Data, Param );
  {$ELSE}
  FMethodEx := Method;
  SendMessage( Applet.fHandle, CM_EXECPROC, Integer( Param ), Integer( @Self ) );
  {$ENDIF}
end;

procedure TThread.Terminate;
begin
  {$IFDEF PSEUDO_THREADS}
      FTerminated := TRUE;
      if Assigned( MainThread ) then
      if MainThread.CurrentThread = @ Self then
        MainThread.NextThread;
  {$ELSE}
      TerminateThread(FHandle,0);
      FTerminated := True;
  {$ENDIF}
end;

function TThread.WaitFor: Integer;
begin
  RefInc;
  Result := -1;
  {$IFDEF PSEUDO_THREADS}
  while not Terminated do
    Resume;
  if Terminated then
    Result := FResult;
  {$ELSE}
  if FHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  WaitForSingleObject(FHandle, INFINITE);
  GetExitCodeThread(FHandle, DWORD(Result));
  {$ENDIF}
  RefDec;
end;

function TThread.WaitForTime(T: DWORD): Integer;
{$IFDEF PSEUDO_THREADS}
  var LimitTime: DWORD;
{$ENDIF}
begin
  {$IFDEF PSEUDO_THREADS}
  LimitTime := GetTickCount + T;
  RefInc;
  while not Terminated and (GetTickCount < LimitTime) do
    Resume;
  Result := -1;
  if Terminated then
    Result := FResult;
  RefDec;
  {$ELSE}
  Result := WAIT_OBJECT_0;
  RefInc;
  if FHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := WaitForSingleObject(FHandle, T);
  if Result = WAIT_OBJECT_0 then
    GetExitCodeThread(FHandle, T);
  RefDec;
  {$ENDIF}
end;

{$IFDEF _D2}
  {$DEFINE _D2orFPC}
{$ENDIF}
{$IFDEF _FPC}
  {$IFNDEF _D2orFPC}
    {$DEFINE _D2orFPC}
  {$ENDIF}
{$ENDIF}

function TThread.GetPriorityBoost: Boolean;
type TGetPriorityBoost = function(hThread: THandle;
         var DisablePriorityBoost: Bool): BOOL; stdcall;
var B: Bool;
    GPB: TGetPriorityBoost;
    M: THandle;
begin
  Result := TRUE;
  if fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if (WinVer >= WvNT) then // by TK: only evaluate if this is true, regardless of evaluation settings
  begin
    M := GetModuleHandle( 'kernel32' );
    GPB := GetProcAddress( M, 'GetThreadPriorityBoost' );
    {$IFDEF SAFE_CODE}
    if  Assigned( GPB ) then
    {$ENDIF}
        if  GPB( fHandle, B ) then
            Result := B;
  end;
end;

procedure TThread.SetPriorityBoost(const Value: Boolean);
type TSetPriorityBoost = function(hThread: THandle;
         DisablePriorityBoost: Bool): Bool; stdcall;
var M: THandle;
    SPB: TSetPriorityBoost;
begin
  if fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if WinVer >= WvNT then
  begin
    M := GetModuleHandle( 'kernel32' );
    SPB := GetProcAddress( M, 'SetThreadPriorityBoost' );
    {$IFDEF SAFE_CODE}
    if  Assigned( SPB ) then
    {$ENDIF}
        SPB( fHandle, not Value );
  end;
end;

{ TStream }

{* This part of the unit contains implementation of streams for KOL. Please note,
   that both stream types (file stream and memory stream) are incapsulated
   by a single object type TStream. To avoid including unnedeed code,
   use constructing functions NewReadFileStream and NewWriteFileStream
   to work with file streams, which do not require both types of operation. }

{* To create new type of stream, define your own methods, and in your
   constructing function, pass it to _NewStream function (through
   TStreamMethods record). In a field Custom, You can store a reference to
   your own data of any type (but do not forget to define correct releasing
   of such data in your fClose procedure). }

function TStream.GetPosition: TStrmSize;
begin
  Result := Seek( 0, spCurrent );
end;

procedure TStream.SetPosition(const Value: TStrmSize);
begin
  Seek( Value, spBegin );
end;

{$IFDEF ASM_STREAM}
function TStream.GetSize: TStrmSize;
asm
        CALL     [EAX].fMethods.fGetSiz
end;
{$ELSE PAS_VERSION} //Pascal
function TStream.GetSize: TStrmSize;
begin
  Result := fMethods.fGetSiz( @Self );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_STREAM}
procedure TStream.SetSize(const NewSize: TStrmSize);
asm
        CALL     [EAX].fMethods.fSetSiz
end;
{$ELSE PAS_VERSION} //Pascal
procedure TStream.SetSize(const NewSize: TStrmSize);
begin
  fMethods.fSetSiz( @Self, NewSize );
end;
{$ENDIF PAS_VERSION}

function TStream.GetFileStreamHandle: THandle;
begin
  Result := fData.fHandle;
end;

{$IFDEF ASM_STREAM}
function TStream.Read(var Buffer; const Count: TStrmSize): TStrmSize;
asm
        CALL     [EAX].fMethods.fRead
end;
{$ELSE PAS_VERSION} //Pascal
function TStream.Read(var Buffer; const Count: TStrmSize): TStrmSize;
begin
  Result := fMethods.fRead( @Self, Buffer, Count );
end;
{$ENDIF PAS_VERSION}

function TStream.GetCapacity: TStrmSize;
begin
  Result := fData.fCapacity;
end;

procedure TStream.SetCapacity(const Value: TStrmSize);
var OldSize: DWORD;
    V: TStrmSize;
begin
  V := Value;
  {$IFDEF OLD_STREAM_CAPACITY}
  if fData.fCapacity >= Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  OldSize := Size;
  Size := V;
  Size := OldSize;
  {$ELSE}
  if Value < fData.fSize then V := fData.fSize;
  if Value > fData.fCapacity then
  begin
    OldSize := Size;
    Size := V;
    Size := OldSize;
  end else
  if fMemory <> nil then
  begin
    {$IFDEF _D4orHigher}
    fMemory := ReallocMemory( fMemory, V );
    {$ELSE}
    ReallocMem( fMemory, V );
    {$ENDIF}
    fData.fCapacity := V;
  end;
  {$ENDIF}
end;

function TStream.Busy: Boolean;
begin
  Result := ( fData.fThread <> nil );
end;

function TStream.DoAsyncRead( Sender: PThread ): Integer;
begin
  Read( Pointer( fParam1 )^, fParam2 );
  fData.fThread := nil;
  Result := 0;
end;

procedure TStream.ReadAsync(var Buffer; Count: DWord);
begin
  if Busy then Wait;
  fData.fThread := NewThreadAutoFree( nil );
  fData.fThread.OnExecute := DoAsyncRead;
  fParam1 := DWORD( @ Buffer );
  fParam2 := Count;
  fData.fThread.Resume;
end;

function TStream.DoAsyncSeek( Sender: PThread ): Integer;
begin
  Seek( fParam1, TMoveMethod( fParam2 ) );
  fData.fThread := nil;
  Result := 0;
end;

procedure TStream.SeekAsync(MoveTo: TStrmMove; MoveMethod: TMoveMethod);
begin
  if Busy then Wait;
  fData.fThread := NewThreadAutoFree( nil );
  fData.fThread.OnExecute := DoAsyncSeek;
  fParam1 := MoveTo;
  fParam2 := Ord( MoveMethod );
  fData.fThread.Resume;
end;

function TStream.DoAsyncWrite( Sender: PThread ): Integer;
begin
  Write( Pointer( fParam1 )^, fParam2 );
  fData.fThread := nil;
  Result := 0;
end;

procedure TStream.WriteAsync(var Buffer; Count: DWord);
begin
  if Busy then Wait;
  fData.fThread := NewThreadAutoFree( nil );
  fData.fThread.OnExecute := DoAsyncWrite;
  fParam1 := DWORD( @ Buffer );
  fParam2 := Count;
  fData.fThread.Resume;
end;

procedure TStream.Wait;
begin
  if  ( fData.fThread = nil ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if   Assigned( fMethods.fWait ) then
       fMethods.fWait( @Self )
  else fData.fThread.WaitFor;
end;

{$IFDEF ASM_STREAM}
function TStream.Write(var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize): TStrmSize;
asm
        CALL     [EAX].fMethods.fWrite
end;
{$ELSE PAS_VERSION} //Pascal
function TStream.Write(var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize): TStrmSize;
begin
  Result := fMethods.fWrite( @Self, Buffer, Count );
end;
{$ENDIF PAS_VERSION}

function TStream.WriteVal(Value, Count: DWORD): DWORD;
begin
  Result := Write( Value, Count );
end;

function TStream.WriteStr(S: AnsiString): DWORD;
begin
  if   S <> '' then
       Result := fMethods.fWrite( @Self, S[1], Length( S ) )
  else Result := 0;
end;

function TStream.ReadStrZ: AnsiString;
var C: AnsiChar;
begin
  Result := '';
  REPEAT
    C := #0;
    Read( C, 1 );
    if C <> #0 then Result := Result + C;
  UNTIL C = #0;
end;

{$IFDEF _D3orHigher}
function TStream.ReadWStrZ: KOLWideString;
var C: WideChar;
begin
  Result := '';
  REPEAT
    C := #0;
    Read( C, 2 );
    if C <> #0 then
      Result := Result +
       {$IFDEF _D3}
       KOLWideString( C )
       {$ELSE}
       C
       {$ENDIF};
  UNTIL C = #0;
end;
{$ENDIF _D3orHigher}

function TStream.ReadStr: AnsiString;
var C: AnsiChar;
begin
  Result := '';
  REPEAT
    C := #0;
    Read( C, 1 );
    if C <> #0 then
    begin
      if C = #13 then
      begin
          C := #0;
          Read( C, 1 );
          if C <> #10 then Position := Position - 1;
          C := #13;
      end else if C = #10 then
          C := #13;
      if C <> #13 then
        Result := Result + C;
    end;
  UNTIL (C = #13) or (C = #0);
end;

function TStream.ReadStrLen(Len: Integer): AnsiString;
var i: Integer;
begin
  SetLength( Result, Len );
  i := Read( Result[1], Len );
  SetLength( Result, i );
end;

function TStream.WriteStrZ(S: AnsiString): DWORD;
var C: AnsiChar;
begin
  if S = '' then
    begin
      C := #0;
      Result := Write( C, 1 );
    end
  else Result := Write( S[ 1 ], Length( S ) + 1 );
end;

{$IFDEF _D3orHigher}
function TStream.WriteWStrZ(S: KOLWideString): DWORD;
var C: WideChar;
begin
  if S = '' then
    begin
      C := #0;
      Result := Write( C, 2 );
    end
  else Result := Write( S[ 1 ], (Length( S ) + 1) * 2 );
end;
{$ENDIF _D3orHigher}

function TStream.WriteStrEx(S: AnsiString): DWord;
var L: DWORD;
begin
  L := length(s);
  result:=fmethods.fwrite(@self,L,Sizeof(DWORD));
  if result = Sizeof(DWORD) then
    Inc( result, fmethods.fwrite(@self,s[1],L) );
end;

function TStream.ReadStrExVar(var S: AnsiString): DWord;
begin
  fmethods.fread(@self,result,Sizeof(DWORD));
  setlength(s,result);
  if result<>0 then result:=fmethods.fread(@self,s[1],result);
end;

function TStream.ReadStrEx: AnsiString;
begin
  readstrexvar(result);
end;

function TStream.WriteStrPas( S: AnsiString ): DWORD;
var L: Integer;
begin
  Result := 0;
  L := Length( S );
  if L > 255 then L := 255;
  if Write( L, 1 ) < 1 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := 1;
  if L > 0 then
    Result := Write( S[ 1 ], L ) + 1;
end;

function TStream.ReadStrPas: AnsiString;
var L: Byte;
begin
  Result := '';
  if Read( L, 1 ) < 1 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  SetLength( Result, L );
  L := Read( Result[ 1 ], L );
  Result := Copy( Result, 1, L );
end;

{$IFDEF ASM_STREAM}
function TStream.Seek({$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveMethod: TMoveMethod): TStrmSize;
//function TStream.Seek(MoveTo: TStrmMove; MoveMethod: TMoveMethod): TStrmSize;
asm
        CALL     [EAX].fMethods.fSeek
end;
{$ELSE PAS_VERSION} //Pascal
function TStream.Seek({$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveMethod: TMoveMethod): TStrmSize;
begin
  Result := fMethods.fSeek( @Self, MoveTo, MoveMethod );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TStream.Destroy;
begin
  fMethods.fClose( @Self );
  fData.fThread.Free;
  inherited;
end;
{$ENDIF PAS_VERSION}

procedure TStream.SaveToFile(const Filename: KOLString; const Start, CountSave: TStrmSize);
var F: PStream;
    SavePos: DWORD;
begin
  F := NewWriteFileStream( Filename );
  SavePos := Position;
  Position := Start;
  Stream2Stream( F, @ Self, CountSave );
  Position := SavePos;
  F.Free;
end;

function _NewStream( const StreamMethods: TStreamMethods ): PStream;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TStream';
  {$ENDIF}
  Move( StreamMethods, Result.fMethods, Sizeof( TStreamMethods ) );
  Result.fPMethods := @Result.fMethods;
  TMethod( Result.fOnChangePos ).Code := @DummyObjProc;
end;

function SeekFileStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
begin
  Result := FileSeek( Strm.fData.fHandle, MoveTo, MoveFrom );
  {$IFDEF FILESTREAM_POSITION}
  Strm.fData.fPosition := Result;
  {$ENDIF}
end;

function GetSizeFileStream( Strm: PStream ): TStrmSize;
{$IFDEF STREAM_LARGE64}
var SizeHigh: DWORD;
{$ENDIF}
begin
  {$IFDEF STREAM_LARGE64}
  Result := GetFileSize( Strm.fData.fHandle, @ SizeHigh );
  Result := Result or SizeHigh shl 32;
  {$ELSE}
  Result := GetFileSize( Strm.fData.fHandle, nil );
  if Result = DWORD( -1 ) then Result := 0;
  {$ENDIF}
end;

procedure DummySetSize( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Value: TStrmSize );
begin
end;

procedure DummyStreamProc(Strm: PStream);
begin
end;

function DummyReadWrite( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
asm
  XOR EAX, EAX
  {$IFDEF STREAM_LARGE64}
  XOR EDX, EDX
  {$ENDIF}
end;

function DummySeek( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveMethod: TMoveMethod ): TStrmSize;
asm
  XOR EAX, EAX
  {$IFDEF STREAM_LARGE64}
  XOR EDX, EDX
  {$ENDIF}
end;

function ReadFileStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
begin
  Result := FileRead( Strm.fData.fHandle, Buffer, Count );
  {$IFDEF FILESTREAM_POSITION}
  inc( Strm.fData.fPosition, Result );
  {$ENDIF}
end;

function ReadFileStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
begin
  Result := FileRead( Strm.fData.fHandle, Buffer, Count );
  inc( Strm.fData.fPosition, Result );
  if  (Result > 0)
      {$IFDEF SAFE_CODE} and Assigned( Strm.OnChangePos ) {$ENDIF} then
      Strm.OnChangePos( Strm );
end;

function WriteFileStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
begin
  Result := FileWrite( Strm.fData.fHandle, Buffer, Count );
  {$IFDEF FILESTREAM_POSITION}
  inc( Strm.fData.fPosition, Result );
  {$ENDIF}
end;

function WriteFileStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
begin
  Result := FileWrite( Strm.fData.fHandle, Buffer, Count );
  inc( Strm.fData.fPosition, Result );
  if (Result > 0)
     {$IFDEF SAFE_CODE} and Assigned( Strm.OnChangePos ) {$ENDIF} then
    Strm.OnChangePos( Strm );
end;

{$IFDEF ASM_STREAM}
function WriteFileStreamEOF( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
asm
        PUSH     EBX
        PUSH     [EAX].TStream.fData.fHandle
        CALL     WriteFileStream
        XCHG     EBX, EAX
        CALL     SetEndOfFile
        XCHG     EAX, EBX
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function WriteFileStreamEOF( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
begin
  Result := WriteFileStream( Strm, Buffer, Count );
  {$IFDEF FILESTREAM_POSITION}
  inc( Strm.fData.fPosition, Result );
  {$ENDIF}
  SetEndOfFile( Strm.fData.fHandle );
end;
{$ENDIF PAS_VERSION}

function WriteFileStreamEOFWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
begin
  Result := WriteFileStream( Strm, Buffer, Count );
  inc( Strm.fData.fPosition, Result );
  SetEndOfFile( Strm.fData.fHandle );
  if (Result > 0)
     {$IFDEF SAFE_CODE} and Assigned( Strm.OnChangePos ) {$ENDIF} then
     Strm.OnChangePos( Strm );
end;

procedure CloseFileStream( Strm: PStream );
begin
  if Strm.fData.fHandle <> INVALID_HANDLE_VALUE then
    FileClose( Strm.fData.fHandle );
  Strm.fData.fHandle := INVALID_HANDLE_VALUE;
end;

{$IFDEF ASM_STREAM}
function SeekMemStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF}
         MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
asm
        PUSH     EBX
        MOV      EBX, EDX
        AND      ECX, $FF
        LOOP     @@not_from_cur
        ADD      EBX, [EAX].TStream.fData.fPosition
@@not_from_cur:
        LOOP     @@not_from_end
        ADD      EBX, [EAX].TStream.fData.fSize
@@not_from_end:
        CMP      EBX, [EAX].TStream.fData.fSize
        JLE      @@space_ok
        PUSH     EAX
        MOV      EDX, EBX
        CALL     TStream.SetSize
        POP      EAX
@@space_ok:
        XCHG     EAX, EBX
        MOV      [EBX].TStream.fData.fPosition, EAX
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function SeekMemStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF}
         MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
var NewPos: DWORD;
begin
  case MoveFrom of
  spBegin: NewPos := MoveTo;
  spCurrent: NewPos := Strm.fData.fPosition + DWORD( MoveTo );
  else //spEnd:
       NewPos := Strm.fData.fSize + DWORD( MoveTo );
  end;
  if NewPos > Strm.fData.fSize then
    Strm.SetSize( NewPos );
  Strm.fData.fPosition := NewPos;
  Result := NewPos;
end;
{$ENDIF PAS_VERSION}

function SeekMemStreamWithEvent( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
var OldPos: DWORD;
begin
  OldPos := Strm.Position;
  Result := SeekMemStream( Strm, MoveTo, MoveFrom );
  if (OldPos <> Strm.Position)
     {$IFDEF SAFE_CODE} and Assigned( Strm.OnChangePos ) {$ENDIF} then
     Strm.OnChangePos( Strm );
end;

function GetSizeMemStream( Strm: PStream ): TStrmSize;
begin
  Result := Strm.fData.fSize;
end;

{$IFDEF ASM_STREAM}
procedure SetSizeMemStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
asm
        push     ebx
        push     edx
        xchg     ebx, eax
        cmp      [ebx].TStream.fData.fCapacity, edx
        jae      @@mem_ok
        {$IFDEF OLD_MEMSTREAMS_SETSIZE}
        or       edx, [CapacityMask]
        inc      edx
        {$ENDIF}
        mov      [ebx].TStream.fData.fCapacity, edx
        mov      ecx, [ebx].TStream.fMemory
        jecxz    @@getmem
        lea      eax, [ebx].TStream.fMemory
        call     System.@ReallocMem
        jmp      @@setmem

@@getmem:
        or       ecx, edx
        jz       @@mem_ok
        xchg     eax, ecx
        call     System.@GetMem
@@setmem:
        mov      [ebx].TStream.fMemory, eax

@@mem_ok:
        pop      ecx // NewSize
        inc      ecx
        loop     @@set_new_sz
        cmp      [ebx].TStream.fData.fSize, ecx
        jz       @@set_new_sz

        mov      [ebx].TStream.fData.fCapacity, ecx
        xchg     ecx, [ebx].TStream.fMemory
        jecxz    @@mem_freed
        xchg     eax, ecx
        call     System.@FreeMem
@@mem_freed:
        xor      ecx, ecx

@@set_new_sz:
        mov      [ebx].TStream.fData.fSize, ecx
        cmp      [ebx].TStream.fData.fPosition, ecx
        jb       @@exit
        mov      [ebx].TStream.fData.fPosition, ecx

@@exit:
        pop      ebx
end;
{$ELSE PAS_VERSION} //Pascal
procedure SetSizeMemStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
var S: PStream;
    NewCapacity: DWORD;
begin
  S := Strm;
  if S.fData.fCapacity < NewSize then
  begin
    {$IFDEF OLD_MEMSTREAMS_SETSIZE}
    NewCapacity := (NewSize or CapacityMask) + 1;
    {$ELSE}
    NewCapacity := NewSize;
    {$ENDIF}
    if S.fMemory = nil then
    begin
      if NewSize <> 0 then
         GetMem( S.fMemory, NewCapacity );
    end else ReallocMem( S.fMemory, NewCapacity );
    S.fData.fCapacity := NewCapacity;
  end else
  if (NewSize = 0) and (S.Size > 0) then
  begin
    if S.fMemory <> nil then
    begin
      FreeMem( S.fMemory );
      S.fMemory := nil;
      S.fData.fCapacity := 0;
    end;
  end;
  S.fData.fSize := NewSize;
  if S.fData.fPosition > S.fData.fSize then
     S.fData.fPosition := S.fData.fSize;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_STREAM}
function ReadMemStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
asm
        PUSH     EBX
        XCHG     EBX, EAX
        MOV      EAX, [EBX].TStream.fData.fPosition
        ADD      EAX, ECX
        CMP      EAX, [EBX].TStream.fData.fSize
        JLE      @@count_ok
        MOV      ECX, [EBX].TStream.fData.fSize
        SUB      ECX, [EBX].TStream.fData.fPosition
@@count_ok:
        PUSH     ECX
        MOV      EAX, [EBX].TStream.fMemory
        ADD      EAX, [EBX].TStream.fData.fPosition
        CALL     System.Move
        POP      EAX
        ADD      [EBX].TStream.fData.fPosition, EAX
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function ReadMemStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
var S: PStream;
    C: TStrmSize;
begin
  S := Strm;
  C := Count;
  if C + S.fData.fPosition > S.fData.fSize then
     C := S.fData.fSize - S.fData.fPosition;
  Result := C;
  Move( Pointer( DWORD(S.fMemory) + S.fData.fPosition )^, Buffer, Result );
  Inc( S.fData.fPosition, Result );
end;
{$ENDIF PAS_VERSION}

function ReadMemStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
begin
  Result := ReadMemStream( Strm, Buffer, Count );
  if (Result > 0)
     {$IFDEF SAFE_CODE} and Assigned( Strm.OnChangePos ) {$ENDIF} then
     Strm.OnChangePos( Strm );
end;

{$IFDEF ASM_STREAM}
function WriteMemStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
asm
        PUSH     EBX
        XCHG     EBX, EAX
        MOV      EAX, [EBX].TStream.fData.fPosition
        ADD      EAX, ECX
        CMP      EAX, [EBX].TStream.fData.fSize
        PUSH     EDX
        PUSH     ECX
        JLE      @@count_ok
        XCHG     EDX, EAX
        MOV      EAX, EBX
        CALL     TStream.SetSize
@@count_ok:
        POP      ECX
        POP      EAX
        MOV      EDX, [EBX].TStream.fMemory
        ADD      EDX, [EBX].TStream.fData.fPosition
        PUSH     ECX
        CALL     System.Move
        POP      EAX
        ADD      [EBX].TStream.fData.fPosition, EAX
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function WriteMemStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
var S: PStream;
begin
  S := Strm;
  if Count + S.fData.fPosition > S.fData.fSize then
     S.SetSize( S.fData.fPosition + Count );
  Result := Count;
  Move( Buffer, Pointer( DWORD(S.fMemory) + S.fData.fPosition )^, Result );
  Inc( S.fData.fPosition, Result );
end;
{$ENDIF PAS_VERSION}

function WriteMemStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
begin
  Result := WriteMemStream( Strm, Buffer, Count );
  if (Result > 0)
     {$IFDEF SAFE_CODE} and Assigned( Strm.OnChangePos ) {$ENDIF} then
     Strm.OnChangePos( Strm );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure CloseMemStream( Strm: PStream );
var S: PStream;
begin
  S := Strm;
  if S.fMemory <> nil then
  begin
    FreeMem( S.fMemory );
    S.fMemory := nil;
  end;
end;
{$ENDIF PAS_VERSION}

procedure DummyCloseStream( Strm: PStream );
begin
  // nothing here
end;

// by Roman Vorobets:
procedure SetSizeFileStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
var P: DWORD;
begin
  P:=Strm.Position;
  Strm.Position:=NewSize;
  SetEndOfFile(Strm.Handle);
  if P < NewSize then
    Strm.Position:=P;
end;

function ReadMemBlkStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
var P, bStart, bLen, C: DWORD;
    bAddr: PByte;
    i: Integer;
begin
    P := Strm.Position;
    i := 0;
    bStart := 0;
    bLen := 0;
    bAddr := nil;
    while i < Strm.fData.fBlocks.Count do
    begin
        bAddr := Strm.fData.fBlocks.fItems[i];
        bLen := Integer( Strm.fData.fBlocks.fItems[i+1] );
        if  bStart + bLen > P then
            break;
        inc( i, 2 );
        inc( bStart, bLen );
    end;
    if  bStart + bLen < P then
    begin
        Result := 0; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
    inc( bAddr, P - bStart );
    C := Count;
    if  C > bLen - (P - bStart) then
        C := bLen - (P - bStart);
    if  C > 0 then
        Move( bAddr^, Buffer, C );
    Result := C;
    inc( Strm.fData.fPosition, C );
end;

function SeekMemBlkStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
var P: Integer;
begin
    P := MoveTo;
    CASE MoveFrom OF
    spCurrent: P := P + Integer( Strm.fData.fPosition );
    spEnd:     P := P + Integer( Strm.fData.fSize );
    END;
    if  P < 0 then P := 0;
    if  P > Integer( Strm.fData.fSize ) then
        P := Strm.fData.fSize;
    Strm.fData.fPosition := P;
    Result := P;
end;

function WriteMemBlkStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
var LastBlkAddr: PByte;
    LastBlkUsed, C: Integer;
    NewBlkSz: Integer;
begin
    C := Strm.fData.fBlocks.Count;
    LastBlkUsed := Strm.fData.fBlkSize;
    LastBlkAddr := nil;
    if  C > 1 then
    begin
        LastBlkAddr := Strm.fData.fBlocks.Items[C-2];
        LastBlkUsed := Integer( Strm.fData.fBlocks.Items[C-1] );
    end;
    if  Strm.fData.fBlkSize - LastBlkUsed < Integer( Count ) then
    begin
        NewBlkSz := Strm.fData.fBlkSize;
        if  NewBlkSz < Integer( Count ) then
            NewBlkSz := Count;
        GetMem( LastBlkAddr, NewBlkSz );
        LastBlkUsed := 0;
        Strm.fData.fBlocks.Add( LastBlkAddr );
        Strm.fData.fBlocks.Add( nil );
        inc( C, 2 );
    end;
    inc( LastBlkAddr, LastBlkUsed );
    Strm.fData.fJustWrittenBlkAddress := LastBlkAddr;
    Move( Buffer, LastBlkAddr^, Count );
    inc( LastBlkUsed, Count );
    Strm.fData.fBlocks.fItems[ C-1 ] := Pointer( LastBlkUsed );
    inc( Strm.fData.fSize, Count );
    Strm.fData.fPosition := Strm.fData.fSize;
    Result := Count;
end;

procedure ResizeMemBlkStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
var i, del: Integer;
    LastBlkAddr: PByte;
    LastBlkUsed: Integer;
begin
    while Strm.fData.fSize > NewSize do
    begin
        i := Strm.fData.fBlocks.Count-2;
        LastBlkAddr := Strm.fData.fBlocks.fItems[i];
        LastBlkUsed := Integer( Strm.fData.fBlocks.fItems[i+1] );
        del := Strm.fData.fSize - NewSize;
        if  del >= LastBlkUsed then
        begin
            FreeMem( LastBlkAddr );
            Strm.fData.fBlocks.DeleteRange( i, 2 );
            dec( Strm.fData.fSize, LastBlkUsed );
        end else
        begin
            Strm.fData.fBlocks.fItems[ i+1 ] := Pointer( LastBlkUsed - del );
            dec( Strm.fData.fSize, del );
        end;
    end;
    if  Strm.fData.fSize > Strm.fData.fPosition then
        Strm.fData.fPosition := Strm.fData.fSize;
end;

procedure FreeMemBlkStream( Strm: PStream );
var i: Integer;
begin
    i := 0;
    while i < Strm.fData.fBlocks.Count do
    begin
        FreeMem( Strm.fData.fBlocks.fItems[i] );
        inc( i, 2 );
    end;
    {$IFDEF SAFE_CODE}
    Free_And_Nil( Strm.fData.fBlocks );
    Strm.fData.fPosition := 0;
    Strm.fData.fSize := 0;
    {$ELSE}
    Strm.fData.fBlocks.Free;
    {$ENDIF}
end;

function SeekConcatStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
var NewPos: TStrmSize;
begin
  NewPos := MoveTo;
  CASE MoveFrom OF
  spCurrent: NewPos := TStrmMove( Strm.fData.fPosition ) + MoveTo;
  spEnd    : NewPos := TStrmMove( Strm.Size ) + MoveTo;
  END;
  if Strm.fData.fStream1.Size > NewPos then
  begin
    Strm.fData.fStream1.Position := NewPos;
    Strm.fData.fStream2.Position := 0;
  end else
  begin
    Strm.fData.fStream1.Position := Strm.fData.fStream1.Size;
    Strm.fData.fStream2.Position := NewPos - Strm.fData.fStream1.Size;
  end;
  Strm.fData.fPosition := Strm.fData.fStream1.Position + Strm.fData.fStream2.Position;
  Result := Strm.fData.fPosition;
end;

function GetSizeConcatStream( Strm: PStream ): TStrmSize;
begin
  Result := Strm.fData.fStream1.Size + Strm.fData.fStream2.Size;
end;

procedure SetSizeConcatStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
var New_Sz, Sz1: TStrmSize;
begin
  New_Sz := NewSize;
  Sz1 := Strm.fData.fStream1.Size;
  if New_Sz < Sz1 then
    New_Sz := Sz1;
  Strm.fData.fStream2.Size := New_Sz - Sz1;
end;

function ReadConcatStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
var C, Sz1, ToRead: TStrmSize;
    ToAddr: PByte;
begin
  C := Count;
  Sz1 := Strm.fData.fStream1.Size;
  ToAddr := @ Buffer;
  Result := 0;
  if Strm.Position < Sz1 then
  begin
    ToRead := C;
    if Strm.Position + C > Sz1 then
      ToRead := Sz1 - Strm.Position;
    Result := Strm.fData.fStream1.Read( ToAddr^, ToRead );
    Strm.fData.fPosition := Strm.fData.fStream1.Position;
    dec( C, Result );
    inc( ToAddr, Result );
    if Result < ToRead then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    Strm.fData.fStream2.Position := 0;
  end;
  if C <= 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := Result + Strm.fData.fStream2.Read( ToAddr^, C );
  Strm.fData.fPosition := Strm.fData.fStream1.Size +
                          Strm.fData.fStream2.Position;
end;

function WriteConcatStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
var C, Sz1, ToWrite: TStrmSize;
    FromAddr: PByte;
begin
  C := Count;
  Sz1 := Strm.fData.fStream1.Size;
  FromAddr := @ Buffer;
  Result := 0;
  if Strm.Position < Sz1 then
  begin
    ToWrite := C;
    if Strm.Position + C > Sz1 then
      ToWrite := Sz1 - Strm.Position;
    Result := Strm.fData.fStream1.Write( FromAddr^, ToWrite );
    Strm.fData.fPosition := Strm.fData.fStream1.Position;
    dec( C, Result );
    inc( FromAddr, Result );
    if Result < ToWrite then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    Strm.fData.fStream2.Position := 0;
  end;
  if C <= 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := Result + Strm.fData.fStream2.Write( FromAddr^, C );
  Strm.fData.fPosition := Strm.fData.fStream1.Size +
                          Strm.fData.fStream2.Position;
end;

procedure CloseConcatStream( Strm: PStream );
begin
  Strm.fData.fStream1.fMethods.fClose( Strm.fData.fStream1 );
  Strm.fData.fStream2.fMethods.fClose( Strm.fData.fStream2 );
end;

function SeekSubStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize;
var NewPos, OldPos: TStrmMove;
begin
  OldPos := Strm.fData.fBaseStream.Position - Strm.fData.fFromPos;
  {$IFDEF STREAM_LARGE64}
  if OldPos < 0 then OldPos := 0;
  {$ENDIF}
  CASE MoveFrom OF
  spCurrent: NewPos := OldPos + MoveTo;
  spEnd    : NewPos := TStrmMove( Strm.Size ) + MoveTo;
  else       NewPos := MoveTo;
  END;
  {$IFDEF STREAM_LARGE64}
  if NewPos < 0 then NewPos := 0;
  {$ENDIF}
  Strm.fData.fBaseStream.Position := Strm.fData.fFromPos + TStrmSize( NewPos );
  Result := Strm.fData.fBaseStream.Position - Strm.fData.fFromPos;
  if Result > Strm.fData.fSize then
    Strm.fData.fSize := Result;
end;

function GetSizeSubStream( Strm: PStream ): TStrmSize;
begin
  Result := Strm.fData.fSize;
end;

procedure SetSizeSubStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize );
begin
  {$IFDEF STREAM_LARGE64}
  if NewSize >= 0 then
  {$ENDIF}
    Strm.fData.fSize := NewSize;
end;

function ReadSubStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
var C: TStrmSize;
begin
  C := Count;
  if Strm.Position + C > Strm.Size then
    C := Strm.Size - Strm.Position;
  Result := Strm.fData.fBaseStream.Read( Buffer, C );
end;

function WriteSubStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
begin
  Result := Strm.fData.fBaseStream.Write( Buffer, Count );
end;

procedure CloseSubStream( Strm: PStream );
begin
  Strm.fData.fBaseStream.fMethods.fClose( Strm.fData.fBaseStream );
end;


function NewFileStream( const FileName: KOLString; Options: DWORD ): PStream;
begin
  Result := _NewStream( BaseFileMethods );
  Result.fMethods.fRead := ReadFileStreamProc;
  Result.fMethods.fWrite := WriteFileStream; // not WriteStreamEOF, Àëåêñåé Øóâàëîâ
  Result.fMethods.fSetSiz := SetSizeFileStream;
  Result.fData.fHandle := FileCreate( FileName, Options );
end;

function NewFileStreamWithEvent( const FileName: KOLString; Options: DWORD ): PStream;
begin
  Result := _NewStream( BaseFileMethods );
  Result.fMethods.fRead := ReadFileStreamWithEvent;
  Result.fMethods.fWrite := WriteFileStreamWithEvent; // not WriteStreamEOF, Àëåêñåé Øóâàëîâ
  Result.fMethods.fSetSiz := SetSizeFileStream;
  Result.fData.fHandle := FileCreate( FileName, Options );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewReadFileStream( const FileName: KOLString ): PStream;
begin
  Result := _NewStream( BaseFileMethods );
  Result.fMethods.fRead := ReadFileStreamProc;
  Result.fData.fHandle := FileCreate( FileName,
                                      ofOpenRead or ofShareDenyWrite or ofOpenExisting );
end;
{$ENDIF PAS_VERSION}

function NewReadFileStreamWithEvent( const FileName: KOLString ): PStream;
begin
  Result := _NewStream( BaseFileMethods );
  Result.fMethods.fRead := ReadFileStreamWithEvent;
  Result.fData.fHandle := FileCreate( FileName,
                                      ofOpenRead or ofShareDenyWrite or ofOpenExisting );
end;

function NewExFileStream( F: HFile ): PStream;
begin
  Result := _NewStream( BaseFileMethods );
  Result.fMethods.fRead := ReadFileStreamProc;
  Result.fMethods.fWrite := WriteFileStream;
  Result.fData.fHandle := F;
  Result.fMethods.fClose := DummyCloseStream;
end;

{$IFDEF _D3orHigher}
function NewReadFileStreamW( const FileName: KOLWideString ): PStream;
begin
  Result := _NewStream( BaseFileMethods );
  Result.fMethods.fRead := ReadFileStreamProc;
  Result.fData.fHandle := WFileCreate( FileName,
                                      ofOpenRead or ofShareDenyWrite or ofOpenExisting );
end;
{$ENDIF _D3orHigher}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewWriteFileStream( const FileName: KOLString ): PStream;
begin
  Result := _NewStream( BaseFileMethods );
  Result.fMethods.fWrite := WriteFileStreamEOF;
  Result.fMethods.fSetSiz := SetSizeFileStream;
  Result.fData.fHandle := FileCreate( FileName,
                                      ofOpenWrite or ofCreateAlways or ofShareDenyWrite );
end;
{$ENDIF PAS_VERSION}

function NewWriteFileStreamWithEvent( const FileName: KOLString ): PStream;
begin
  Result := _NewStream( BaseFileMethods );
  Result.fMethods.fWrite := WriteFileStreamEOFWithEvent;
  Result.fMethods.fSetSiz := SetSizeFileStream;
  Result.fData.fHandle := FileCreate( FileName,
                                      ofOpenWrite or ofCreateAlways or ofShareDenyWrite );
end;

{$IFDEF _D3orHigher}
function NewWriteFileStreamW( const FileName: KOLWideString ): PStream;
begin
  Result := _NewStream( BaseFileMethods );
  Result.fMethods.fWrite := WriteFileStreamEOF;
  Result.fMethods.fSetSiz := SetSizeFileStream;
  Result.fData.fHandle := WFileCreate( FileName,
                                      ofOpenWrite or ofCreateAlways or ofShareDenyWrite );
end;
{$ENDIF _D3orHigher}

{$IFDEF ASM_noVERSION}
function NewReadWriteFileStream( const FileName: AnsiString ): PStream;
asm
        PUSH     EBX
        XCHG     EBX, EAX
        MOV      EAX, offset[BaseFileMethods]
        CALL     _NewStream
        MOV      EDX, [ReadFileStreamProc]
        MOV      [EAX].TStream.fMethods.fRead, EDX
        MOV      [EAX].TStream.fMethods.fWrite, offset[WriteFileStream]
        MOV      [EAX].TStream.fMethods.fSetSiz, offset[SetSizeFileStream]
        XCHG     EBX, EAX

        PUSH     EAX
        CALL     FileExists
        MOV      EDX, ofOpenReadWrite or ofCreateAlways or ofShareDenyWrite
        ADD      DH, AL // $200 (ofCreateAlways) -> $300 (ofCreateExisting)
        POP      EAX

        CALL     FileCreate
        MOV      [EBX].TStream.fData.fHandle, EAX
        XCHG     EAX, EBX
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function NewReadWriteFileStream( const FileName: KOLString ): PStream;
var Creation: DWORD;
begin
  Result := _NewStream( BaseFileMethods );
  Result.fMethods.fRead := ReadFileStreamProc;
  Result.fMethods.fWrite := WriteFileStream;
  Result.fMethods.fSetSiz := SetSizeFileStream;
  Creation := ofCreateAlways;
  if FileExists( FileName ) then Creation := ofOpenExisting;
  Result.fData.fHandle := FileCreate( FileName,
                          ofOpenReadWrite or Creation or ofShareDenyWrite );
end;
{$ENDIF PAS_VERSION}

{$IFDEF _D3orHigher}
function NewReadWriteFileStreamW( const FileName: KOLWideString ): PStream;
var Creation: DWORD;
begin
  Result := _NewStream( BaseFileMethods );
  Result.fMethods.fRead := ReadFileStreamProc;
  Result.fMethods.fWrite := WriteFileStream;
  Result.fMethods.fSetSiz := SetSizeFileStream;
  Creation := ofCreateAlways;
  if WFileExists( FileName ) then Creation := ofOpenExisting;
  Result.fData.fHandle := WFileCreate( FileName,
                          ofOpenReadWrite or Creation or ofShareDenyWrite );
end;
{$ENDIF _D3orHigher}

function NewMemoryStream: PStream;
begin
  Result := _NewStream( MemoryMethods );
end;

function NewMemoryStreamWithEvent: PStream;
begin
  Result := _NewStream( MemoryMethods );
  Result.fMethods.fRead := ReadMemStreamWithEvent;
  Result.fMethods.fWrite := WriteMemStreamWithEvent;
end;

{$IFDEF ASM_STREAM}
function WriteExMemoryStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
asm
        PUSH     EBX
        XCHG     EBX, EAX
        MOV      EAX, [EBX].TStream.fData.fSize
        SUB      EAX, [EBX].TStream.fData.fPosition
        CMP      EAX, ECX
        JGE      @@1
        XCHG     ECX, EAX
@@1:
        PUSH     EDX
        PUSH     ECX
        JLE      @@count_ok
        XCHG     EDX, EAX
        MOV      EAX, EBX
        CALL     TStream.SetSize
@@count_ok:
        POP      ECX
        POP      EAX
        MOV      EDX, [EBX].TStream.fMemory
        ADD      EDX, [EBX].TStream.fData.fPosition
        PUSH     ECX
        CALL     System.Move
        POP      EAX
        ADD      [EBX].TStream.fData.fPosition, EAX
        POP      EBX
end;
{$ELSE PAS_VERSION}
function WriteExMemoryStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
var S: PStream;
    C: TStrmSize;
begin
  S := Strm;
  C := Count;
  if C + S.fData.fPosition > S.fData.fSize then
    C := S.fData.fSize - S.fData.fPosition;
  Result := C;
  Move( Buffer, Pointer( DWORD(S.fMemory) + S.fData.fPosition )^, Result );
  Inc( S.fData.fPosition, Result );
end;
{$ENDIF PAS_VERSION}

procedure DummyClose_ExMemStream( Strm: PStream );
begin
  // nothing to do - ignore call (memory is not released by any way)
end;

function NewExMemoryStream( ExistingMem: Pointer; Size: DWORD ): PStream;
begin
  Result := NewMemoryStream;
  Result.fMemory := ExistingMem;
  Result.fData.fCapacity := Size;
  Result.fData.fSize := Size;
  Result.fMethods.fWrite := WriteExMemoryStream;
  Result.fMethods.fSetSiz := DummySetSize;
  Result.fMethods.fClose := DummyClose_ExMemStream;
end;

function NewMemBlkStream( BlkSize: Integer ): PStream;
begin
  Result := NewMemoryStream;
  Result.fData.fBlkSize := BlkSize;
  Result.fData.fBlocks := NewList;
  Result.fMethods.fWrite := WriteMemBlkStream;
  Result.fMethods.fSetSiz := DummySetSize;
  Result.fMethods.fClose := DummyClose_ExMemStream;
  Result.fMethods.fRead := ReadMemBlkStream;
  Result.fMethods.fSeek := SeekMemBlkStream;
  Result.fMethods.fSetSiz := ResizeMemBlkStream;
  Result.Add2AutoFreeEx( TObjectMethod( MakeMethod( Result, @FreeMemBlkStream ) ) );
end;

function NewMemBlkStream_WriteOnly( BlkSize: Integer ): PStream;
begin
  Result := NewMemoryStream;
  Result.fData.fBlkSize := BlkSize;
  Result.fData.fBlocks := NewList;
  Result.fMethods.fWrite := WriteMemBlkStream;
  Result.fMethods.fSetSiz := DummySetSize;
  Result.fMethods.fClose := DummyClose_ExMemStream;
  Result.fMethods.fRead := DummyReadWrite;
  Result.fMethods.fSeek := DummySeek;
  Result.fMethods.fSetSiz := ResizeMemBlkStream;
  Result.Add2AutoFreeEx( TObjectMethod( MakeMethod( Result, @FreeMemBlkStream ) ) );
end;

function NewConcatStream( Stream1, Stream2: PStream ): PStream;
begin
  Result := _NewStream( ConcatStreamMethods );
  Result.fData.fStream1 := Stream1;
  Result.fData.fStream2 := Stream2;
  Result.Add2AutoFree( Stream1 );
  Result.Add2AutoFree( Stream2 );
end;

function NewSubStream( BaseStream: PStream; const FromPos, Size: TStrmSize ): PStream;
begin
  Result := _NewStream( SubStreamMethods );
  Result.fData.fBaseStream := BaseStream;
  Result.fData.fFromPos := FromPos;
  Result.fData.fSize := Size;
  Result.Position := 0;
  Result.Add2AutoFree( BaseStream );
end;

function Stream2Stream( Dst, Src: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
var Buf: Pointer;
    C: TStrmSize;
begin
  C := Count;
  if Src.fMemory <> nil then
  begin
     if Src.fData.fPosition + C > Src.fData.fSize then
        C := Src.fData.fSize - Src.fData.fPosition;
     Result := Dst.Write( Pointer(DWORD(Src.fMemory)+Src.fData.fPosition)^,
                   C );
     Inc( Src.fData.fPosition, Result );
  end else
  if Dst.fMemory <> nil then
  begin
    if Dst.fData.fPosition + C > Dst.fData.fSize then
       Dst.SetSize( Dst.fData.fPosition + C );
    Result := Src.Read( Pointer( DWORD( Dst.fMemory ) + Dst.fData.fPosition )^,
                        C );
    Inc( Dst.fData.fPosition, Result );
  end else
  begin
    GetMem( Buf, C );
    C := Src.Read( Buf^, C );
    Result := Dst.Write( Buf^, C );
    FreeMem( Buf );
  end;
end;

function Stream2StreamEx( Dst, Src: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize;
begin
  Result := Stream2StreamExBufSz( Dst, Src, Count, 65536 );
end;

function Stream2StreamExBufSz( Dst, Src: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize; BufSz: DWORD ): TStrmSize;
var
  buf:pointer;
  rd, wr:dword;
  C: TStrmSize;
begin
  C := Count;
  if C=0 then result:=0
  else  begin
            result:=0;
            BufSz := Min( BufSz, C );
            if BufSz = 0 then BufSz := C;
            getmem(buf,BufSz);
            repeat
                if C<BufSz then rd:=c else rd:=BufSz;
                rd:=src.read(buf^,rd);
                wr := dst.write(buf^,rd);
                inc(result,wr);
                dec(C, rd);
            until (rd<>BufSz) or (C=0);
            freemem(buf);
        end;
end;

{$IFDEF ASM_UNICODE}
  {$IFNDEF STREAM_LARGE64}
    {$DEFINE ASM_Resource2Stream}
  {$ENDIF}
{$ENDIF}

{$IFDEF ASM_Resource2Stream}
function Resource2Stream( DestStrm : PStream; Inst : HInst;
                          ResName : PAnsiChar; ResType : PAnsiChar ): Integer;
asm
        PUSH     EBX
        PUSH     ESI
        MOV      EBX, EDX // EBX = Inst
        PUSH     EAX      // DestStrm
        PUSH     ResType
        PUSH     ECX
        PUSH     EDX
        CALL     FindResource
        TEST     EAX, EAX
        JZ       @@exit0

        PUSH     EAX
        PUSH     EBX
        PUSH     EAX
        PUSH     EBX
        CALL     SizeofResource
        XCHG     EBX, EAX
        CALL     LoadResource
        TEST     EAX, EAX
        JZ       @@exit0
        XCHG     ESI, EAX

        PUSH     ESI
        CALL     GlobalLock
        TEST     EAX, EAX
        JNZ      @@P_ok

        CALL     GetLastError
        CMP      EAX, ERROR_INVALID_HANDLE
        JNZ      @@exit_00
        MOV      EAX, ESI

@@P_ok:
        XCHG     EDX, EAX
        POP      EAX // DestStrm
        PUSH     EDX
        MOV      ECX, EBX
        CALL     TStream.Write

        //EAX = Result (length of written data)
        XCHG     EBX, EAX
        POP      EAX
        CMP      ESI, EAX
        JE       @@not_unlock

        PUSH     ESI
        CALL     GlobalUnlock
@@not_unlock:
        XCHG     EAX, EBX
        JMP      @@exit

@@exit_00:
        XOR      EAX, EAX
@@exit0:
        POP      ECX
@@exit:
        POP      ESI
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function Resource2Stream( DestStrm : PStream; Inst : HInst;
                          ResName : PKOLChar; ResType : PKOLChar ): Integer;
var R : HRSRC;
    G : HGlobal;
    P : PAnsiChar;
    Sz : DWORD;
    E : Integer;
begin
  Result := 0;
  R := FindResource( Inst, ResName, ResType );
  if R <> 0 then
  begin
    Sz := SizeofResource( Inst, R );
    G := LoadResource( Inst, R );
    if G <> 0 then
    begin
      P := GlobalLock( G );
      if P = nil then
      begin
        E := GetLastError;
        if  E = ERROR_INVALID_HANDLE then
            P := Pointer( G )
        else Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      Result := DestStrm.Write( P^, Sz );
      if P <> Pointer( G ) then
        GlobalUnlock( G );
      //FreeResource( G ); -- not necessary for resource loaded by LoadResource
    end;
  end;
end;
{$ENDIF PAS_VERSION}

///////////////////////////////////////////////////////////////////////////
//                        I  N  I  -  F  I  L  E  S
///////////////////////////////////////////////////////////////////////////

{ TIniFile }

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TIniFile.Destroy;
begin
  fFileName := '';
  fSection := '';
  inherited;
end;
{$ENDIF PAS_VERSION}

procedure TIniFile.ClearAll;
begin
  WritePrivateProfileString( nil, nil, nil,
                             PKOLChar( fFileName ) );
end;

procedure TIniFile.ClearKey(const Key: KOLString);
begin
  WritePrivateProfileString( PKOLChar( fSection ), PKOLChar( Key ), nil,
                             PKOLChar( fFileName ) );
end;

procedure TIniFile.ClearSection;
begin
  WritePrivateProfileString( PKOLChar( fSection ), nil, nil,
                             PKOLChar( fFileName ) );
end;

function TIniFile.ValueBoolean(const Key: KOLString; Value: Boolean): Boolean;
var sec: PKOLChar;
begin
  sec := PKOLChar( fSection );
  if  fSection = '' then
      sec := nil;
  if fMode = ifmRead then
     Result := GetPrivateProfileInt( sec, PKOLChar( Key ),
               Integer( Value ), PKOLChar( fFileName ) ) <> 0
  else
  begin
    WritePrivateProfileString( sec, PKOLChar( Key ),
              PKOLChar( KOLString( Int2Str( Integer( Value ) ) ) ),
              PKOLChar( fFileName ) );
    Result := Value;
  end;
end;

function TIniFile.ValueData(const Key: KOLString; Value: Pointer;
  Count: Integer): Boolean;
begin
  if fMode = ifmRead then
       Result := GetPrivateProfileStruct( PKOLChar( fSection ), PKOLChar( Key ),
               Value, Count, PKOLChar( fFileName ) )
  else Result := WritePrivateProfileStruct( PKOLChar( fSection ), PKOLChar( Key ),
               Value, Count, PKOLChar( fFileName ) );
end;

function TIniFile.ValueInteger(const Key: KOLString; Value: Integer): Integer;
begin
  if fMode = ifmRead then
     Result := GetPrivateProfileInt( PKOLChar( fSection ), PKOLChar( Key ),
               Integer( Value ), PKOLChar( fFileName ) )
  else
  begin
     Result := Value;
     WritePrivateProfileString( PKOLChar( fSection ), PKOLChar( Key ),
               PKOLChar( KOLString( Int2Str( Value ) ) ), PKOLChar( fFileName ) );
  end;
end;

function TIniFile.ValueString(const Key, Value: KOLString): KOLString;
var
  Buffer: array[0..4095] of KOLChar;
begin
  if fMode = ifmRead then
  begin
      Buffer[ 0 ] := #0;
      if   GetPrivateProfileString(PKOLChar(fSection),
           PKOLChar(Key), PKOLChar(Value), Buffer, SizeOf(Buffer) div Sizeof(KOLChar),
           PKOLChar(fFileName)) <> 0 then
           Result := Buffer
      else Result := ''; //: FPC âûäàåò îøèáêó ïðè îòñóòñòâèè Key â INI-ôàéëå // MTsv DN
  end else
  begin
       Result := Value;
       WritePrivateProfileString( PKOLChar( fSection ), PKOLChar( Key ),
                 PKOLChar( Value ), PKOLChar( fFileName ) );
  end;
end;

function TIniFile.ValueDouble(const Key: KOLString; const Value: Double): Double;
begin
  Result := Str2Double( ValueString( Key, Double2Str( Value ) ) );
end;

function OpenIniFile( const FileName: KOLString ): PIniFile;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TIniFile';
  {$ENDIF}
  Result.fFileName := FileName;
end;

/////////////////////////////////////////////////// GetSectionNames, SectionData
// - by Vyacheslav A. Gavrik :

const
  IniBufferSize = 32767;
  IniBufferStrSize = IniBufferSize+4;         /// äëÿ ìàõèíàöèé :)

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
procedure TIniFile.GetSectionNames(Names:PKOLStrList);
var
  i:integer;
  Pc:PKOLChar;
  PcEnd:PKOLChar;
  Buffer:Pointer;
begin
  GetMem(Buffer,IniBufferSize * Sizeof( KOLChar ));
  Pc:=Buffer;
  i := GetPrivateProfileSectionNames(Buffer, IniBufferSize, PKOLChar(fFileName));
  PcEnd:=Pc+i;
  repeat
    Names.Add(Pc);
    Pc:=PC+Length(PC)+1;
  until PC>=PcEnd;
  FreeMem(Buffer);
end;

procedure TIniFile.SectionData(Names: PKOLStrList);
var
  i:integer;
  Pc:PKOLChar;
  PcEnd:PKOLChar;
  Buffer:Pointer;
begin
  GetMem(Buffer,IniBufferSize * Sizeof(KOLChar));
  Pc:=Buffer;
  if fMode = ifmRead then
  begin
    i:=GetPrivateProfileSection(PKOLChar(fSection), Buffer, IniBufferSize, PKOLChar(fFileName));
    PcEnd:=Pc+i;
    while PC < PcEnd do // Chg by ECM from REPEAT-UNTIL: i=0 (empty section) => Names.Count=1
    begin
      Names.Add(Pc);
      Pc:=PC+Length(PC)+1;
    end;
  end else
  begin
    for i:= 0 to Names.Count-1 do
    begin
      {$IFDEF UNICODE_CTRLS} WStrCopy {$ELSE} StrCopy {$ENDIF}
        (Pc,Names.ItemPtrs[i]);
      Pc:=PC+Length(PC)+1;
    end;
    Pc[0]:=#0;
    ClearSection;
    WritePrivateProfileSection(PKOLChar(fSection), Buffer, PKOLChar(fFileName));

  end;
  FreeMem(Buffer);
end;
{$ENDIF PAS_VERSION}

/////////////////////////////////////////////////////////////////////////
//                                M  E  N  U
/////////////////////////////////////////////////////////////////////////

{ -- Menu implementation -- }

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function MakeAccelerator( fVirt: Byte; Key: Word ): TMenuAccelerator;
begin
  Result.fVirt := fVirt;
  Result.Key := Key;
end;
{$ENDIF PAS_VERSION}

function GetAcceleratorText( const Accelerator: TMenuAccelerator ): KOLString;
var
  KeyName: array[0..255] of KOLChar;

  procedure AddKeyName( Code: Integer );
  begin
    Code := MapVirtualKey(Code, 0);
    if Code = 0 then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    if GetKeyNameText(Code shl 16, KeyName, 256) > 0 then begin
      if Result <> '' then
        Result := Result + '+';
      Result := Result + KOLString(KeyName);
    end;
  end;

begin
  Result := '';
  with Accelerator do begin
    if fVirt and FCONTROL <> 0 then
      AddKeyName(VK_CONTROL);
    if fVirt and FSHIFT <> 0 then
      AddKeyName(VK_SHIFT);
    if fVirt and FALT <> 0 then
      AddKeyName(VK_ALT);
    if fVirt and $20 <> 0 then
      AddKeyName(VK_LWIN);
    if fVirt and $40 <> 0 then
      AddKeyName(VK_RWIN);

    AddKeyName(Key);
  end;
end;

const
  MIDATA_CHECKITEM = $40000000;
  MIDATA_RADIOITEM = $80000000;


{$IFNDEF NEW_MENU_ACCELL}
function WndProcMenu( Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
var M, M1: PMenu;
    Idx: Integer;
    Id: Integer;
begin
  Result := False;
  if Msg.message = WM_COMMAND then
  begin
     if (Msg.lParam = 0) and (HIWORD( Msg.wParam ) <= 1) then
     begin
         M := PMenu( Sender.fMenuObj );
         while (M = nil) and (Sender.Parent <> nil) do
         begin
           Sender := Sender.Parent;
           M := PMenu( Sender.fMenuObj );
         end;
         while M <> nil do
         begin
             Id := LoWord( Msg.wParam );
             M1 := M.Items[ Id ];
             if  M1 <> nil then
             begin
                 Result := True;
                 Rslt := 0;
                 Idx := M.IndexOf( M1 );
                 M.fByAccel := HiWord( Msg.wParam ) <> 0;
                 if  M1.FRadioGroup <> 0 then
                     M1.RadioCheckItem
                 else if  M1.FIsCheckItem then
                     M1.Checked := not M1.Checked;
                 if  Assigned(M1.FOnMenuItem) then
                     M1.FOnMenuItem( M, Idx )
                 else if Assigned( M.FOnMenuItem ) then
                     M.FOnMenuItem( M, Idx );
                 break;
             end;
             M := M.fNextMenu;
         end;
     end;
  end;
end;

{$ELSE}

function WndProcMenu( Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;

  function ProcessMenuItem(M: PMenu; Id: Integer): Boolean;
  var
    M1: PMenu;
    Idx: Integer;
  begin
    M1 := M.Items[ Id ];
    Result := (M1 <> nil);
    if Result then
    begin
      Idx := M.IndexOf( M1 );
      M.fByAccel := HiWord( Msg.wParam ) <> 0;
      if  M1.FRadioGroup <> 0 then
          M1.RadioCheckItem
      else if  M1.FIsCheckItem then
          M1.Checked := not M1.Checked;
      if  Assigned(M1.FOnMenuItem) then
      begin
          {$IFDEF USE_MENU_CURCTL}
              M.fCurCtl := Sender;   // fixed
          {$ENDIF}
          M1.FOnMenuItem( M, Idx )
      end else if Assigned( M.FOnMenuItem ) then
          M.FOnMenuItem( M, Idx );
    end;
  end;

var
  M: PMenu;
  Id: Integer;
begin
  Result := False;
  if Msg.message = WM_COMMAND then
    if (Msg.lParam = 0) and (HIWORD( Msg.wParam ) <= 1) then begin
      Id := LoWord(Msg.wParam);
      M := PMenu(Sender.fAutoPopupMenu);
      if (M <> nil) and ProcessMenuItem(M, Id) then begin
        Result := True;
        Rslt := 0;
      end else
      begin
        M := PMenu(Sender.fMenuObj);
        while M <> nil do begin
          if ProcessMenuItem(M, Id) then begin
            Result := True;
            Rslt := 0;
            Break;
          end;
          M := M.fNextMenu;
        end;
      end;
    end;
end;
{$ENDIF}

{$ENDIF WIN_GDI}

{$IFDEF GDI}
function NewMenu( AParent : PControl; MaxCmdReserve : DWORD;
  const Template : array of PKOLChar; aOnMenuItem: TOnMenuItem ): PMenu;
var M: PMenu;
    {$IFDEF INITIALFORMSIZE_FIXMENU}
    R: TRect;
    {$ENDIF}
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TMenu';
  {$ENDIF}
  Result.FVisible := TRUE;
  Result.FPopupFlags := TPM_LEFTALIGN or TPM_LEFTBUTTON;
  Result.FMenuItems := NewList;
  Result.FOnMenuItem := aOnMenuItem;
  if (High(Template)>=0) and (Template[0] <> nil) then
  begin
    if  (AParent <> nil) and (AParent.fMenuObj = nil) and
        {$IFDEF USE_FLAGS} not (G3_IsControl in AParent.fFlagsG3)
        {$ELSE} not AParent.fIsControl {$ENDIF} then
         Result.FHandle := CreateMenu
    else Result.FHandle := CreatePopupMenu;
    Result.FillMenuItems( Result.FHandle, 0, Template );
  end;
  if ( AParent <> nil ) then
  begin
    Result.FControl := AParent;
    if AParent.fMenuObj <> nil then
    begin
      // add popup menu to the end of menu chain
      M := PMenu( AParent.fMenuObj );
      while M.fNextMenu <> nil do
        M := M.fNextMenu;
      M.fNextMenu := Result;
    end else
    begin
        if {$IFDEF USE_FLAGS} not(G3_IsControl in AParent.fFlagsG3)
           {$ELSE} not AParent.fIsControl {$ENDIF} then
        begin
            {$IFDEF INITIALFORMSIZE_FIXMENU}
            R := AParent.ClientRect;
            {$ENDIF}
            AParent.Menu := Result.FHandle;
            {$IFDEF INITIALFORMSIZE_FIXMENU}
            AParent.SetClientSize( R.Right, R.Bottom );
            {$ENDIF}
        end;
        AParent.fMenuObj := Result;
        AParent.AttachProc( WndProcMenu );
        {$IFDEF USE_AUTOFREE4CONTROLS}
        AParent.Add2AutoFree( Result );
        {$ENDIF}
    end;
  end;
end;
{$ENDIF GDI}

{$IFDEF _X_}
{$IFDEF GTK}
//--- some code from samples - may be useful to see "how to"
FUNCTION AddSeparatorToMenu( Menu : PGtkMenu ) : PgtkMenuItem ;
BEGIN
  Result := PGtkMenuitem( gtk_menu_item_new ) ;
  gtk_menu_append( GTK_WIDGET( Menu ), PGtkWidget( Result ) ) ;
  gtk_widget_show( PGtkWidget ( Result ) ) ;
END;

FUNCTION AddItemToMenu( Menu : PGtkMenu;
                        ShortCuts : PGtkAccelGroup;
                        const Caption : AnsiString;
                        const ShortCut : AnsiString;
                        CallBack : TGtkSignalFunc;
                        CallBackdata : Pointer ) : PGtkMenuItem;
VAR
  Key, Modifiers : DWORD;
  //LocalAccelGroup : PGtkAccelGroup; -- not used since gtk_menu_ensure_uline_accel_group not defined anywhere...
  TheLabel : PGtkLabel;
BEGIN
  Result := PGtkMenuItem ( gtk_menu_item_new_with_label( '' ) ) ;
  TheLabel := GTK_LABEL(GTK_BIN( Result )^.child ) ;
  Key:= gtk_label_parse_uline( TheLabel , Pchar ( Caption ) ) ;
  //----------------
  {If Key<>0 then // gtk_menu_ensure_uline_accel_group -- not defined anywhere...
  begin
    LocalAccelGroup := gtk_menu_ensure_uline_accel_group( Menu );
    gtk_widget_add_accelerator( PGtkWidget ( Result ), 'activateitem',
                                LocalAccelGroup , Key ,
                                0 , TGtkAccelFlags ( 0 ) ) ;
  end;}
  //-----------------
  gtk_menu_append( GTK_WIDGET( Menu ), PGtkWidget( Result ) ) ;
  //-----------------
  IF  ( ShortCut<>'' ) AND ( ShortCuts<> Nil ) THEN
  BEGIN
      gtk_accelerator_parse ( pchar( ShortCut ) , @key , @modifiers ) ;
      gtk_widget_add_accelerator ( PGtkWidget ( Result ) , ' activateitem' ,
        ShortCuts, Key, modifiers, GTK_ACCEL_VISIBLE );
  END;
  //------------------
  IF  Assigned( CallBack ) THEN
  BEGIN
    gtk_signal_connect( PGtkObject ( Result ) , 'activate' ,
                        CallBack , CallBackdata ) ;
    gtk_widget_show( PgtkWidget ( Result ) ) ;
  END;
END;

FUNCTION AddMenuToMenuBar( MenuBar : PGtkMenuBar;
                           ShortCuts : PGtkAccelGroup;
                           Caption : AnsiString;
                           CallBack : TGtkSignalFunc;
                           CallBackdata : Pointer;
                           AlignRight : Boolean;
                           Var MenuItem : PgtkMenuItem ) : PGtkMenu;
VAR Key : DWORD;
    TheLabel : PGtkLabel;
BEGIN
  MenuItem := PGtkMenuItem( gtk_menu_item_new_with_label( '' ) ) ;
  IF AlignRight THEN
    gtk_menu_item_right_justify( MenuItem );
  TheLabel := GTK_LABEL( GTK_BIN( MenuItem )^ .child ) ;
  Key := gtk_label_parse_uline( TheLabel, Pchar ( Caption ) ) ;
  IF  Key<>0 THEN
      gtk_widget_add_accelerator( PGtkWidget( MenuItem ), 'activateitem',
          Shortcuts, Key, GDK_MOD1_MASK, GTK_ACCEL_LOCKED );
  Result := PGtkMenu( gtk_menu_new );
  If Assigned( CallBack ) then
    gtk_signal_connect( PGtkObject ( Result ), 'activate',
      CallBack, CallBackdata ) ;
  gtk_widget_show( PgtkWidget ( MenuItem ) ) ;
  gtk_menu_item_set_submenu( MenuItem, PGtkWidget( Result ) ) ;
  gtk_menu_bar_append( GTK_WIDGET( MenuBar ), PgtkWidget( MenuItem ) ) ;
END;

FUNCTION NewMenu( AParent : PControl; MaxCmdReserve : DWORD;
  CONST Template : ARRAY of PKOLChar; aOnMenuItem: TOnMenuItem ): PMenu;
  PROCEDURE CreateMenuItems( ParentMenu: PMenu; var i: Integer );
  VAR Item, PrevItem: PMenu;
      s: AnsiString;
      j: Integer;
  BEGIN
    PrevItem := nil;
    WHILE i <= High( Template )-1 DO
    BEGIN
      inc( i );
      s := Template[ i ];
      IF  s = '' THEN BREAK; // end of template

      IF  s = ')' THEN
          inc( i ); break; // end of submenu

      new( Item, Create );
      {$IFDEF DEBUG_OBJKIND}
      Item.fObjKind := 'MenuItem';
      {$ENDIF}
      Item.FCaption := s;
      Item.FVisible := TRUE;
      Item.FParentMenu := ParentMenu;
      if ParentMenu.FItems = nil then
        ParentMenu.FItems := NewList;
      ParentMenu.FItems.Add( Item );

      IF  (s <> '') AND ((s[ 1 ] = '+') or (s[ 1 ] = '-')) THEN
      BEGIN
          Item.fIsCheckItem := TRUE;
          Item.fChecked := S[ 1 ] = '+';
          s := CopyEnd( s, 2 );
          IF  (s <> '') and (s[ 1 ] = '!') THEN
          BEGIN
              IF  PrevItem <> nil THEN
              BEGIN
                  if  PrevItem.fRadioGroup <> 0 THEN
                      Item.fRadioGroup := PrevItem.fRadioGroup;
              END
              ELSE inc( Item.fRadioGroup );
              s := CopyEnd( s, 2 );
          END;
      END;

      IF  s = '-' THEN
          Item.fIsSeparator := TRUE
      ELSE
      BEGIN
          FOR j := Length( s )-1 DOWNTO 1 DO // extract mnemonic
          BEGIN
              IF  (s[ j ] = '&') and (s[ j+1 ] <> '&') then // mnemonic
              BEGIN
                  Item.fMnemonics := Item.fMnemonics + s[ j+1 ];
                  Delete( s, j, 1 );//?  <U>m</U> ?
              END;
          END;
      END;

      //---------------------------- now call gtk for create item's widget
      IF   Item.FIsSeparator THEN
           Item.fGtkMenuItem := gtk_menu_item_new
      ELSE Item.fGtkMenuItem := gtk_menu_item_new_with_label( PAnsiChar( s ) );
      IF   ParentMenu.fGtkMenuBar <> nil THEN
           gtk_menu_bar_append( ParentMenu.fGtkMenuBar, Item.fGtkMenuItem )
      ELSE gtk_menu_shell_append(
               GTK_MENU_SHELL( ParentMenu.fGtkMenuShell ), Item.fGtkMenuItem );

      IF s = '(' THEN
      BEGIN
          inc( i );
          IF  PrevItem <> nil THEN
          BEGIN
              PrevItem.fGtkMenuShell := gtk_menu_new;
              gtk_menu_item_set_submenu(
                GTK_MENU_ITEM( PrevItem.fGtkMenuItem ),
                PrevItem.fGtkMenuShell );
              CreateMenuItems( PrevItem, i );
          END;
      END;

      PrevItem := Item;
    END;
  END;
VAR i: Integer;
BEGIN
  new( Result, Create );
  i := -1;
  IF  AParent.fMenuObj = nil THEN
  BEGIN // ñîçäàåòñÿ ãëàâíîå ìåíþ ñ ëèíåéêîé ìåíþ (íàâåðõó ôîðìû? ëþáîãî êîíòðîëà?)
      AParent.fMenuObj := Result;
      Result.fGtkMenuBar := gtk_menu_bar_new;
      //AParent.fMenuBar  := Result.fGtkMenuBar;
      gtk_container_add( GTK_CONTAINER( AParent.fClient ), Result.fGtkMenuBar );
      gtk_widget_show( Result.fGtkMenuBar );
  END else
  BEGIN
      PMenu( AParent.fMenuObj ).fNextMenu := Result;
      Result.fGtkMenuShell := gtk_menu_new;
  END;
  CreateMenuItems( Result, i );
END;
{$ENDIF GTK}
{$ENDIF _X_}

function NewMenuEx( AParent : PControl; FirstCmd : Integer;
  const Template : array of PKOLChar; aOnMenuItems: array of TOnMenuItem ): PMenu;
begin
  Result := NewMenu( AParent, FirstCmd, Template, nil );
  {$IFDEF GDI}
  Result.AssignEvents( 0, aOnMenuItems );
  {$ENDIF GDI}
end;

{$IFDEF WIN_GDI}
{ TMenu }

const
  Breaks: array[ TMenuBreak ] of DWORD = ( 0, MFT_MENUBREAK, MFT_MENUBARBREAK );

{ + by AK - Andrzej Kubaszek }
function MenuStructSize: Integer;
begin
  Result := 44;
  if not( WinVer in [wv31, wv95, wvNT] ) then
    Result := {48=} Sizeof( TMenuItemInfo );
end;
{$ENDIF WIN_GDI}

{$IFDEF GDI}
destructor TMenu.Destroy;
var Next, Prnt: PMenu;
begin
  {$IFDEF DEBUG_MENU_DESTROY}
  LogFileOutput( GetStartDir + 'TMenu.Destroy.txt',
    Int2Hex( DWORD( @ Self ), 6 ) + ' ' + Int2Str( RefCount ) );
  {$ENDIF}
  if Count > 0 then
  begin
    FMenuItems.ReleaseObjects;
    FMenuItems := NewList;
  end;
  if FParentMenu <> nil then
  begin
    Prnt := FParentMenu;
    Next := Prnt.RemoveSubMenu( FId );
    FParentMenu := nil;
    Prnt.FMenuItems.Remove( @ Self );
    if Next = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
   if (FControl <> nil) and (FControl.fMenu = FHandle) and (FHandle <> 0) then
   begin
     if  {$IFDEF USE_FLAGS} not (G2_Destroying in FControl.fFlagsG2)
         {$ELSE} not FControl.fDestroying {$ENDIF} then //!!!fix by Galkov
     begin
       Windows.SetMenu( FControl.fHandle, 0 );
       // this removes main menu from window, but does not destroy it
     end;
     FControl.fMenu := 0;
     Next := PMenu( FControl.fMenuObj );
     while Next <> nil  do
     begin
       if Next.fNextMenu = @Self then
       begin
         Next.fNextMenu := fNextMenu;
         break;
       end;
       Next := Next.fNextMenu;
     end;
   end;
   Next := fNextMenu;
   if FBitmap <> 0 then
     Bitmap := 0;
   if FHandle <> 0 then
   begin
     //if not
     DestroyMenu( FHandle )
     // then LogFileOutput( GetStartDir + 'err.log.txt', SysErrorMessage( GetLastError ) )
     ;
   end;
   FCaption := '';
   FMenuItems.Free;
   Next.Free;
   inherited;
   // all later created (popup) menus (of the same control)
   // are destroyed too
end;
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
DESTRUCTOR TMenu.Destroy;
//var Next, Prnt: PMenu;
BEGIN
    {$IFDEF DEBUG_MENU_DESTROY}
    LogFileOutput( GetStartDir + 'TMenu.Destroy.txt',
      Int2Hex( DWORD( @ Self ), 6 ) + ' ' + Int2Str( RefCount ) );
    {$ENDIF}
    //if Count > 0 then
    IF ( fMenuItems <> nil ) THEN
    BEGIN
        FMenuItems.ReleaseObjects;
        FMenuItems := NewList;
    END;
    FCaption := '';
    fMnemonics := '';
    FMenuItems.Free;
    INHERITED;
    // all later created (popup) menus (of the same control)
    // are destroyed too
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}
function TMenu.GetInfo( var MII: TMenuItemInfo ): Boolean;
begin
  MII.cbSize := MenuStructSize;
  Result := GetMenuItemInfo( Parent.FHandle, FId, FALSE,
            Windows.PMenuitemInfo( @ MII )^ );
end;

procedure TMenu.RedrawFormMenuBar;
var C: PControl;
begin
  C := TopParent.FControl;
  if not AppletTerminated then
  if (C <> nil) and (Pointer( C.fMenuObj ) = Pointer( TopParent )) then
    DrawMenuBar( C.FHandle );
end;

function TMenu.SetInfo( var MII: TMenuItemInfo ): Boolean;
var H: THandle;
begin
  MII.cbSize := MenuStructSize;
  H := FHandle;
  if FParentMenu <> nil then
    H := FParentMenu.FHandle;
  {$IFNDEF UNICODE_CTRLS}
  Result := SetMenuItemInfo( H, FId, FALSE, Windows.PMenuitemInfo( @ MII )^ );
  {$ELSE}
	Result := SetMenuItemInfoW( H, FId, FALSE, Windows.PMenuitemInfoW( @ MII )^ );
  {$ENDIF}
  if Result and ((FParentMenu = nil) or (FParentMenu.FParentMenu = nil)) then {YS}
    RedrawFormMenuBar;
end;

function TMenu.SetTypeInfo( var MII: TMenuItemInfo ): Boolean;
begin
  if not FIsSeparator then
  begin
    if   FBmpItem = 0 then
	       MII.dwTypeData := PKOLChar( FCaption )
    else MII.dwTypeData := Pointer( FBmpItem );
    MII.cch := Length( FCaption )*SizeOfKOLChar;
  end;
  Result := SetInfo( MII );
end;

function TMenu.GetTopParent: PMenu;
begin
  Result := @ Self;
  while Result.FParentMenu <> nil do
    Result := Result.FParentMenu;
end;

function TMenu.GetControl: PControl;
begin
  Result := TopParent.FControl;
end;

function TMenu.GetItems( Id: HMenu ): PMenu;
  function SearchItems( ParentMenu: PMenu; var FromIdx: Integer ): PMenu;
  var I: Integer;
  begin
    Result := ParentMenu;
    if Id = HMenu( FromIdx ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    if (Id >= 4096) and (DWORD( ParentMenu.FId ) = Id) then Exit; {>>>>>>>>>>>>}
    if ParentMenu.FMenuItems = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    for I := 0 to ParentMenu.FMenuItems.FCount-1 do
    begin
        Inc( FromIdx );
        Result := SearchItems( ParentMenu.FMenuItems.Items[ I ], FromIdx );
        if Result <> nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
    Result := nil;
  end;
var I: Integer;
begin
  I := -1;
  Result := SearchItems( @ Self, I );
end;

function TMenu.GetCount: Integer;
var I: Integer;
    SubM: PMenu;
begin
  Result := FMenuItems.FCount;
  for I := 0 to Result-1 do
  begin
    SubM := FMenuItems.Items[ I ];
    Result := Result + SubM.Count;
  end;
end;

function TMenu.IndexOf( Item: PMenu ): Integer;
  function SearchMenu( ParentMenu: PMenu; var FromIdx: Integer ): PMenu;
  var I: Integer;
  begin
    Result := ParentMenu;
    if Result = Item then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    for I := 0 to ParentMenu.FMenuItems.FCount-1 do
    begin
      Inc( FromIdx );
      Result := SearchMenu( ParentMenu.FMenuItems.Items[ I ], FromIdx );
      if Result <> nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
    Result := nil;
  end;
begin
  Result := -1;
  if SearchMenu( @ Self, Result ) = nil then
    Result := -2;
end;

function TMenu.GetState( const Index: Integer ): Boolean;
var MII: TMenuItemInfo;
begin
  if FVisible then
  begin
    MII.fMask := MIIM_STATE;
    if GetInfo( MII ) then
      FSavedState := MII.fState;
  end;
  Result := LongBool( FSavedState and Index );
  if Index < 0 then
    Result := not Result;
end;

procedure TMenu.SetState( const Index: Integer; Value: Boolean );
var MII: TMenuItemInfo;
begin
  GetState( 0 );
  if   Value xor (Index < 0) then
       FSavedState := FSavedState or DWORD( Index and $7FFFFFFF )
  else FSavedState := FSavedState and not DWORD( Index );
  if FVisible then
  begin
      MII.fMask := MIIM_STATE;
      if GetInfo( MII ) then
      begin
        MII.fState := FSavedState;
        SetInfo( MII );
      end;
  end;
end;

procedure TMenu.SetData( Value: Pointer );
var MII: TMenuItemInfo;
begin
  MII.fMask := MIIM_DATA;
  MII.dwItemData := DWORD( Value );
  SetInfo( MII );
  FData := Value;
end;

procedure TMenu.ClearBitmaps;
begin
  if FBitmap <> 0 then
    DeleteObject( FBitmap );
  if FBmpChecked <> 0 then
    DeleteObject( FBmpChecked );
  if FBmpItem <> 0 then
    DeleteObject( FBmpItem );
end;

procedure TMenu.SetBitmap( Value: HBitmap );
var MII: TMenuItemInfo;
begin
  if not FClearBitmaps then
  begin
    FClearBitmaps := TRUE;
    Add2AutoFreeEx( ClearBitmaps );
  end;
  if Value = FBitmap then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if FBitmap <> 0 then
    DeleteObject( FBitmap ); // seems not necessary.
  FBitmap := Value;
  MII.fMask := MIIM_CHECKMARKS;
  MII.hbmpChecked := FBmpChecked;
  MII.hbmpUnchecked := FBitmap;
  SetInfo( MII );
end;

procedure TMenu.SetBmpChecked( Value: HBitmap );
var MII: TMenuItemInfo;
begin
  if not FClearBitmaps then
  begin
    FClearBitmaps := TRUE;
    Add2AutoFreeEx( ClearBitmaps );
  end;
  if Value = FBmpChecked then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if FBmpChecked <> 0 then
    DeleteObject( FBmpChecked );
  FBmpChecked := Value;
  MII.fMask := MIIM_CHECKMARKS;
  MII.hbmpChecked := FBmpChecked;
  MII.hbmpUnchecked := FBitmap;
  SetInfo( MII );
end;

procedure TMenu.SetBmpItem( Value: HBitmap );
var MII: TMenuItemInfo;
begin
  if not FClearBitmaps then
  begin
    FClearBitmaps := TRUE;
    Add2AutoFreeEx( ClearBitmaps );
  end;
  if Value = FBmpItem then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if FBmpItem <> 0 then
    DeleteObject( FBmpItem );
  FBmpItem := Value;
  if WinVer >= wv98 then {AK}
  begin                                            {AK}
    MII.fMask := $80 {MIIM_BITMAP} ;               {AK}
    MII.hbmpItem:=Value;                           {AK}
  end else                                         {AK}
  begin//I haven't possibility to test it in Win95 {AK}
    MII.fType := MFT_BITMAP;
    MII.dwItemData := Value;
  end;                                             {AK}
  SetInfo( MII );
end;

{$IFNDEF NEW_MENU_ACCELL}
procedure TMenu.SetAccelerator(const Value: TMenuAccelerator);
const MaxAccel = 1000;
type TAccTab = array[0..10000] of TAccel;
     PAccTab = ^TAccTab;
var AccTab: PAccTab;
    I, N : Integer;
    M, SubM: PMenu;
    C: PControl;
    Main: Boolean;
begin
  if (FAccelerator.fVirt = Value.fVirt) and (FAccelerator.Key = Value.Key) then
     Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FAccelerator := Value;
  C := TopParent.FControl;
  if C = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if C.fAccelTable <> 0 then
     DestroyAcceleratorTable( C.fAccelTable );
  C.fAccelTable := 0;
  GetMem( AccTab, sizeof( TAccel ) * MaxAccel );
  N := 0;
  M := PMenu( C.fMenuObj );
  Main := TRUE;
  while M <> nil do
  begin
    if Main or M.Visible then
    begin
      for I := 0 to MaxInt-1 do
      begin
        SubM := M.Items[ I ];
        if SubM = nil then break;
        if SubM.FVisible then
        if (SubM.FAccelerator.Key <> 0) or (SubM.FAccelerator.fVirt <> 0) then
        begin
          AccTab[ N ].fVirt := SubM.FAccelerator.fVirt;
          AccTab[ N ].key := SubM.FAccelerator.Key;
          AccTab[ N ].cmd := WORD( SubM.FId );
          Inc( N );
          if N > MaxAccel then break;
        end;
      end;
    end;
    if N > MaxAccel then break;
    M := M.fNextMenu;
  end;
  if N > 0 then
  begin
    C.fAccelTable := CreateAcceleratorTable( AccTab[ 0 ], N );
    {$IFDEF USE_AUTOFREE4CONTROLS}
    C.Add2AutoFreeEx( C.DoDestroyAccelTable );
    {$ENDIF}
    C := C.ParentForm;
    if C <> nil then
      C.SupportMnemonics;
  end;
  FreeMem( AccTab );
end;

{$ELSE NEW_MENU_ACCELL}

procedure TMenu.SetAccelerator(const Value: TMenuAccelerator);
var C: PControl;
    M: PMenu;
begin
  if (FAccelerator.fVirt = Value.fVirt) and (FAccelerator.Key = Value.Key) then
     Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FAccelerator := Value;
  C := FControl;
  M := @Self;
  while (C = nil) and (M <> nil) do begin
      M := M.Parent;
      if  (M <> nil) then C := M.FControl;
  end;
  if  C <> nil then C.SupportMnemonics;
end;

{$ENDIF NEW_MENU_ACCELL}

procedure TMenu.SetMenuItemCaption( const Value: KOLString );
var MII: TMenuItemInfo;
begin
  FCaption := Value;
  if FParentMenu = nil then Exit; {+ecm} {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{AK}if not (WinVer in [wv95,wvNT]) then
{AK}  MII.fMask := $40 {MIIM_STRING}
{AK}else begin
  MII.fMask := MIIM_TYPE;
  MII.fType := MFT_STRING;
{AK}end;
  MII.cch := 0;   // to fix turning radio mark to check mark in NT4
  GetInfo( MII ); //-----------------------------------------------
  MII.dwTypeData := PKOLChar( Value );
  MII.cch := Length( Value )*SizeOfKOLChar;
  SetInfo( MII );
end;

procedure TMenu.SetMenuBreak( Value: TMenuBreak );
var MII: TMenuItemInfo;
begin
  if FId = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if FMenuBreak = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FMenuBreak := Value;
  //FillChar( MII, Sizeof( MII ), #0 );
  ZeroMemory( @MII, Sizeof( MII ) );
  MII.fMask := MIIM_TYPE;
  MII.dwTypeData := nil;
  if GetInfo( MII ) then
  begin
    MII.fType := MII.fType and not( MFT_MENUBREAK or MFT_MENUBARBREAK ) or
                 Breaks[ Value ];
    SetTypeInfo( MII );
  end;
end;

procedure TMenu.SetMenuVisible( Value: Boolean );
var I, J: Integer;
    M: PMenu;
    Before: Integer;
    ByPosition: Boolean;
    MII: TMenuItemInfo;
begin
  if Value then
    if FParentMenu <> nil then
      FParentMenu.Visible := TRUE;
  if Value = FVisible then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FVisible := Value;
  if (FControl <> nil) and (FControl.fMenuObj = @ Self) then
  begin
    FControl.GetWindowHandle;
    if  Value then
        SetMenu( FControl.fHandle, FHandle )
    else
        SetMenu( FControl.fHandle, 0 );
    Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  if FId = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if FParentMenu = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Value then
  begin // show menu item inserting it again into appropriate position
    Before := -1;
    ByPosition := TRUE;
    I := FParentMenu.FMenuItems.IndexOf( @ Self );
    for J := I + 1 to FParentMenu.FMenuItems.FCount-1 do
    begin
        M := FParentMenu.FMenuItems.Items[ J ];
        if  M.FVisible then
        begin
            Before := M.FId;
            ByPosition := FALSE;
            break;
        end;
    end;
    ZeroMemory( @MII, Sizeof( MII ) );
    MII.cbSize := MenuStructSize;
    MII.fMask := MII.fMask or
              (MIIM_CHECKMARKS or MIIM_ID or MIIM_STATE or MIIM_TYPE);
    MII.fType := Breaks[ FMenuBreak ];
    MII.fState := FSavedState;
    MII.wID := FId;
    MII.dwItemData := DWORD( FData );
    if  not FIsSeparator then
    begin
        //MII.fType := MII.fType or MFT_STRING { = 0 };
        MII.dwTypeData := PKOLChar( FCaption );
        MII.cch := Length( FCaption )*SizeOfKOLChar;
    end else
        MII.fType := MII.fType or MFT_SEPARATOR;
    if  FRadioGroup <> 0 then
        MII.fType := MII.fType or MFT_RADIOCHECK;
    if  FOwnerDraw then
        MII.fType := MII.fType or MFT_OWNERDRAW;
    if  FBitmap <> 0 then
    begin
        MII.fMask := MII.fMask or MIIM_CHECKMARKS;
        MII.hbmpUnchecked := FBitmap;
    end;
    if  FHandle <> 0 then
    begin
        MII.fMask := MII.fMask or MIIM_SUBMENU;
        MII.hSubMenu := FHandle;
    end;
	{$IFNDEF UNICODE_CTRLS}
        InsertMenuItem( FParentMenu.FHandle, Before, ByPosition,
                    Windows.PMenuitemInfo( @ MII )^ );
	{$ELSE}
	      InsertMenuItemW( FParentMenu.FHandle, Before, ByPosition,
                    Windows.PMenuitemInfoW( @ MII )^ );
	{$ENDIF}
  end else
  begin // hide menu item removing it
      GetState( 0 ); // store menu item state in FSavedState to allow
                     // changing its state while it is not attached to
                     // a menu
      RemoveMenu( TopParent.FHandle, FId, MF_BYCOMMAND );
  end;
  if (FControl <> nil) or (FParentMenu <> nil) and (FParentMenu.FControl <> nil) then
    RedrawFormMenuBar;
end;

procedure TMenu.RadioCheckItem;
var I, J: Integer;
    M, First, Last: PMenu;
begin
  if (FParentMenu <> nil) and (FRadioGroup <> 0) then
  begin
    I := FParentMenu.FMenuItems.IndexOf( @ Self );
    if I >= 0 then
    begin
      First := @ Self;
      Last := @ Self;
      for J := I-1 downto 0 do
      begin
        M := FParentMenu.FMenuItems.Items[ J ];
        if M.FRadioGroup <> FRadioGroup then break;
        if M.FVisible then
          First := M;
      end;
      for J := I+1 to FParentMenu.FMenuItems.FCount-1 do
      begin
        M := FParentMenu.FMenuItems.Items[ J ];
        if M.FRadioGroup <> FRadioGroup then break;
        if M.FVisible then
          Last := M;
      end;
      if First <> Last then
      begin
        CheckMenuRadioItem( FParentMenu.FHandle, First.FId, Last.FId,
                            FId, MF_BYCOMMAND );
        Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
    end;
  end;
  Checked := TRUE;
end;

function TMenu.FillMenuItems(AHandle: HMenu; StartIdx: Integer;
  const Template: array of PKOLChar): Integer;
var S, S1: PKOLChar;
    I: Integer;
    MII: TMenuItemInfo;
    Item, PrevItem: PMenu;
begin
  PrevItem := nil;
  I := StartIdx;
  while I <= High( Template ) do
  begin
    S := Template[ I ];
    if  (S = nil) or (S^ = #0) then break;
    {$IFDEF UNICODE_CTRLS}
    if KOLString( S ) = {$IFDEF F_P}'' +{$ENDIF} ')' then
    {$ELSE}
    if  PWORD(S)^ = WORD(')') then
    {$ENDIF}
    begin
       Result := I + 1; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;

    new( Item, Create );
    {$IFDEF DEBUG_OBJKIND}
    Item.fObjKind := 'MenuItem';
    {$ENDIF}
    Item.FVisible := TRUE;
    Item.FParentMenu := @ Self;
    Item.FMenuItems := NewList;
    FMenuItems.Add( Item );

    ZeroMemory( @MII, Sizeof( MII ) );
    MII.cbSize := MenuStructSize;
    MII.fMask := MIIM_DATA or MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;
    {$IFDEF UNICODE_CTRLS}
    if  KOLString( S ) <> {$IFDEF F_P}'' +{$ENDIF} '-' then
    {$ELSE}
    if  PWORD(S)^ <> WORD('-') then
    {$ENDIF}
    begin
      if (S^ = {$IFDEF F_P}'' +{$ENDIF} '-') or
         (S^ = {$IFDEF F_P}'' +{$ENDIF} '+') then
      begin
        Item.FIsCheckItem := TRUE;
        MII.dwItemData := MIDATA_CHECKITEM;
        if S^ <> {$IFDEF F_P}'' +{$ENDIF} '-' then
          MII.fState := MII.fState or MFS_CHECKED;
        Inc( S );
        if S^ = {$IFDEF F_P}'' +{$ENDIF} '!' then
        begin
          MII.fType := MII.fType or MFT_RADIOCHECK;
          MII.dwItemData := MII.dwItemData or MIDATA_RADIOITEM;
          Inc( S );
          if PrevItem <> nil then
          begin
            if PrevItem.FRadioGroup <> 0 then
              Item.FRadioGroup := PrevItem.FRadioGroup;
          end;
          if Item.FRadioGroup = 0 then
            Inc( Item.FRadioGroup );
          if S^ = {$IFDEF F_P}'' +{$ENDIF} '!' then
          begin
            Inc( S );
            Inc( Item.FRadioGroup );
          end;
        end;
      end;
      Item.FCaption := S;
    end
      else
    begin
      Item.FIsSeparator := TRUE;
      MII.fType := MFT_SEPARATOR;
      MII.fState := MFS_GRAYED;
      //MII.wID := 0;
    end;
    Item.FId := FDynamicMenuID;
    Inc( FDynamicMenuID );
    MII.wID := Item.FId;
    if I <> High( Template ) then            //YS
    begin                                    //YS
        S1 := Template[ I + 1 ];
        {$IFDEF UNICODE_CTRLS}
        if  KOLString( S1 ) = {$IFDEF F_P}'' +{$ENDIF} '(' then
        {$ELSE}
        if  (S1 <> nil) and (PWORD(S1)^ = WORD('(')) then
        {$ENDIF}
            Item.FHandle := CreatePopupMenu;
    end;                                     //YS
    MII.hSubMenu := Item.FHandle;
    MII.dwTypeData := PKOLChar( S );
    MII.cch := {$IFDEF UNICODE_CTRLS} WStrLen( S ) {$ELSE} StrLen( S ) {$ENDIF};
    InsertMenuItem( AHandle, DWORD(-1), True, PMenuitemInfo( @ MII )^ );
    if Item.FHandle <> 0 then
      I := Item.FillMenuItems( Item.FHandle, I + 2, Template )
    else
      Inc( I );
    PrevItem := Item;
  end;
  Result := I;
end;

procedure TMenu.AssignEvents(StartIdx: Integer;
  const Events: array of TOnMenuItem);
var I: Integer;
    M: PMenu;
begin
  for I := 0 to High(Events) do
  begin
    M := Items[ StartIdx ];
    if M = nil then break;
    M.FOnMenuItem := Events[ I ];
    Inc( StartIdx );
  end;
end;

function TMenu.Popup(X, Y: Integer): Integer;
begin
  {$IFDEF GDI}
  if  Assigned( fOnPopup ) then fOnPopup( @Self );
  if   not FNotPopup then
       Result := Integer( TrackPopupMenu( FHandle, FPopupFlags, {*ecm}
                          X, Y, 0, FControl.Handle, nil ) )     {*ecm}
  else Result := 0;                                             {*ecm}
  {$ENDIF GDI}
end;

function TMenu.PopupEx( X, Y: Integer ): Integer;
{$IFDEF GDI}
var OldBounds: TRect;
    WasVisible: Boolean;
{$ENDIF GDI}
begin
  {$IFDEF GDI}
  WasVisible := TRUE;
  if FControl <> nil then
  begin
    OldBounds := FControl.BoundsRect;
    if  {$IFDEF USE_FLAGS} not(G3_IsControl in FControl.fFlagsG3)
        {$ELSE} not FControl.fIsControl {$ENDIF} then
    begin
        WasVisible := FControl.Visible;
        if not WasVisible then
          FControl.Top := ScreenHeight + 50;
        FControl.Show;
    end;
  end;
  // -- by Martin Larsen: -----------------------
  FControl.ProcessMessage; // specific for Win9x!
  Result := Popup( X, Y );  {*ecm}
  if FControl <> nil then
  begin
    if FControl.Top = ScreenHeight + 50 then
    begin
      if not WasVisible then
        FControl.Visible := FALSE;
      FControl.BoundsRect := OldBounds;
    end;
  end;
  {$ENDIF GDI}
end;

function TMenu.GetItemChecked( Item : Integer ) : Boolean;
begin
  Result := Items[ Item ].Checked;
end;

procedure TMenu.SetItemChecked( Item : Integer; Value : Boolean );
begin
  Items[ Item ].Checked := Value;
end;

function TMenu.GetMenuItemHandle( Idx : Integer ): DWORD;
begin
  Result := Items[ Idx ].FId;
end;

procedure TMenu.RadioCheck( Idx : Integer );
begin
  Items[ Idx ].RadioCheckItem;
end;

function TMenu.GetItemBitmap(Idx: Integer): HBitmap;
begin
  Result := Items[ Idx ].Bitmap;
end;

procedure TMenu.SetItemBitmap(Idx: Integer; const Value: HBitmap);
begin
  Items[ Idx ].Bitmap := Value;
end;

procedure TMenu.AssignBitmaps(StartIdx: Integer; Bitmaps: array of HBitmap);
var I: Integer;
begin
  for I := 0 to High(Bitmaps) do
    ItemBitmap[ I + StartIdx ] := Bitmaps[ I ];
end;

function TMenu.GetItemText(Idx: Integer): KOLString;
begin
  Result := Items[ Idx ].FCaption;
end;

procedure TMenu.SetItemText(Idx: Integer; const Value: KOLString);
begin
  Items[ Idx ].Caption := Value;
end;

function TMenu.GetItemEnabled(Idx: Integer): Boolean;
begin
  Result := Items[ Idx ].Enabled;
end;

procedure TMenu.SetItemEnabled(Idx: Integer; const Value: Boolean);
begin
  Items[ Idx ].Enabled := Value;
end;

function TMenu.GetItemVisible(Idx: Integer): Boolean;
begin
  Result := Items[ Idx ].Visible;
end;

procedure TMenu.SetItemVisible(Idx: Integer; const Value: Boolean);
begin
  Items[ Idx ].Visible := Value;
end;

function TMenu.ParentItem( Idx: Integer ): Integer;
begin
  Result := TopParent.IndexOf( Items[ Idx ].FParentMenu );
end;

function TMenu.GetItemAccelerator(Idx: Integer): TMenuAccelerator;
begin
  Result := Items[ Idx ].Accelerator;
end;

procedure TMenu.SetItemAccelerator(Idx: Integer; const Value: TMenuAccelerator);
begin
  Items[ Idx ].Accelerator := Value;
end;

function TMenu.GetItemSubMenu( Idx: Integer ): HMenu;
begin
  Result := Items[ Idx ].SubMenu;
end;

function WndProcHelp( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
forward;

{$IFDEF GDI}
procedure TMenu.SetHelpContext( Value: Integer );
var Form, C: PControl;
begin
  if TopParent <> @ Self then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  // Help context can not be associated with individual menu items
  FHelpContext := Value;
  C := FControl;
  if C = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Form := C.ParentForm;
  Form.AttachProc( WndProcHelp );
  SetMenuContextHelpID( FHandle, Value );
end;
{$ENDIF GDI}

procedure TMenu.SetSubmenu( Value: HMenu );
var MII: TMenuItemInfo;
begin
  MII.fMask := MIIM_SUBMENU;
  MII.hSubMenu := Value;
  SetInfo( MII );
  FHandle := Value;
end;

function WndProcMeasureItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var MIS: PMeasureItemStruct;
    M, SM: PMenu;
    H, I: Integer;
begin
  Result := FALSE;
  if (Msg.message = WM_MEASUREITEM) and (Msg.wParam = 0) then
  begin
    MIS := Pointer( Msg.lParam );
    if MIS.CtlType = ODT_MENU then
    begin
      M := Pointer( Sender.fMenuObj );
      while M <> nil do
      begin
        SM := M.Items[ MIS.itemID ];
        if SM <> nil then
        begin
          Sender.CallDefWndProc( Msg );
          I := M.IndexOf( SM );
          if  Assigned( SM.OnMeasureItem ) then
              M := SM;
          if  not Assigned( M.OnMeasureItem ) then
              Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          H := M.OnMeasureItem( M, I );
          if  HiWord( H ) <> 0 then
              MIS.itemWidth := HiWord( H );
          if  LoWord( H ) <> 0 then
              MIS.itemHeight := LoWord( H );
          Rslt := 1;
          Result := TRUE;
          break;
        end;
        M := M.fNextMenu;
      end;
    end;
  end;
end;

procedure TMenu.SetOnMeasureItem( const Value: TOnMeasureItem );
var C: PControl;
begin
  FOnMeasureItem := Value;
  C := TopParent.FControl;
  if C <> nil then
    C.AttachProc( WndProcMeasureItem );
end;

function WndProcDrawItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
type PDrawAction = ^TDrawAction;
     PDrawState = ^TDrawState;
var DIS: PDrawItemStruct;
    M, SM: PMenu;
    I: Integer;
begin
  Result := FALSE;
  if (Msg.message = WM_DRAWITEM) and (Msg.wParam = 0) then
  begin
    DIS := Pointer( Msg.lParam );
    if DIS.CtlType = ODT_MENU then
    begin
      M := Pointer( Sender.fMenuObj );
      while M <> nil do
      begin
        SM := M.Items[ DIS.itemID ];
        if SM <> nil then
        begin
          I := M.IndexOf( SM );
          if  Assigned( SM.OnDrawItem ) then
              M := SM;
          if  Assigned( M.OnDrawItem ) then
          begin
              if not M.OnDrawItem( M, DIS.hDC, DIS.rcItem, I,
                          PDrawAction( @ DIS.itemAction )^,
                          PDrawState( @ DIS.itemState )^ ) then Exit; {>>>>>>>>}
          end else Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          Rslt := 1;
          Result := TRUE;
          break;
        end;
        M := M.fNextMenu;
      end;
    end;
  end;
end;

procedure TMenu.SetOnDrawItem( const Value: TOnDrawItem );
var C: PControl;
begin
  FOnDrawItem := Value;
  C := TopParent.FControl;
  if C <> nil then
    C.AttachProc( WndProcDrawItem );
end;

procedure TMenu.SetOwnerDraw( Value: Boolean );
const Masks: array[ Boolean ] of DWORD = ( 0, $FFFFFFFF );
var MII: TMenuItemInfo;
begin
  FOwnerDraw := Value;
  //FillChar( MII, Sizeof( MII ), #0 );
  ZeroMemory( @MII, Sizeof( MII ) );
  MII.fMask := MIIM_TYPE;
  MII.dwTypeData := nil;
  if GetInfo( MII ) then
  begin
    MII.fType := MII.fType and not MFT_OWNERDRAW or
              (MFT_OWNERDRAW and Masks[ Value ]);
    SetTypeInfo( MII );
  end;
end;

function TMenu.Insert(InsertBefore: Integer; ACaption: PKOLChar; Event: TOnMenuItem;
             Options: TMenuOptions): PMenu;
const
  MenuStateFlags: array[TMenuOption] of Integer = (MFS_DEFAULT, MFS_DISABLED, MFS_CHECKED, 0, 0,
                  MFS_DISABLED, 0, 0, 0, 0);
  MenuTypeFlags: array[TMenuOption] of Integer =  (0, 0, 0, 0, MFT_RADIOCHECK, MFT_SEPARATOR, MFT_BITMAP, 0,
                 MFT_MENUBREAK, MFT_MENUBARBREAK);
var M: PMenu;
    MII: TMenuItemInfo;
begin
  new( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TMenuItem';
  {$ENDIF}
  Result.FVisible := TRUE;
  Result.FParentMenu := @ Self;
  Result.FMenuItems := NewList;
  Result.FIsSeparator := moSeparator in Options;
  Result.FIsCheckItem := moCheckMark in Options; //+ by shilou, 12/2009
  if FHandle = 0 then
    SetSubMenu( CreatePopupMenu );
  M := nil;
  if (InsertBefore >= 0) and (InsertBefore < 4096) then
  begin
    M := Items[ InsertBefore ];
    if M <> nil then
    begin
      InsertBefore := M.FId;
      M.Parent.FMenuItems.Insert( M.Parent.FMenuItems.IndexOf( M ), Result );
    end;
  end;
  if M = nil then
  begin
    InsertBefore := -1;
    FMenuItems.Add( Result );
  end;
  Result.FOnMenuItem := Event;

  //FillChar( MII, Sizeof( MII ), #0 );
  ZeroMemory( @MII, Sizeof( MII ) );
  MII.cbSize := MenuStructSize;
  MII.fMask := MIIM_DATA or MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;

  MII.fState := MakeFlags( Pointer( @Options ), MenuStateFlags);
  MII.fType := MakeFlags( Pointer( @Options ), MenuTypeFlags);
  Result.FId := FDynamicMenuID;
  Inc( FDynamicMenuID );
  MII.wID := Result.FId;
  if moSubMenu in Options
  then begin
    Result.FHandle := CreatePopupMenu;
    MII.hSubMenu := Result.FHandle;
  end;
  MII.dwTypeData := PKOLChar(ACaption);
  {$IFNDEF UNICODE_CTRLS}
  if not (moBitmap in Options) then MII.cch := StrLen( ACaption );
  {$ELSE}
  if not (moBitmap in Options) then MII.cch := WStrLen( ACaption );
  {$ENDIF}
  InsertMenuItem( FHandle, InsertBefore, InsertBefore = -1,
                  PMenuItemInfo( @ MII )^ );
  if moBitmap in Options then
  begin
    Result.BitmapItem := DWORD( ACaption );
  end
  else
    Result.FCaption := ACaption;
  RedrawFormMenuBar;
end;

function TMenu.AddItem(ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions): Integer;
begin
  Result := InsertItem( -1, ACaption, Event, Options );
end;

function TMenu.InsertItem( InsertBefore: Integer; ACaption: PKOLChar; Event: TOnMenuItem;
  Options: TMenuOptions): Integer;
begin
  Result := InsertItemEx( InsertBefore, ACaption, Event, Options, FALSE );
end;

function TMenu.InsertItemEx(InsertBefore: Integer; ACaption: PKOLChar;
  Event: TOnMenuItem; Options: TMenuOptions; ByPosition: Boolean): Integer;
var M: PMenu;
begin
  M := Insert( InsertBefore, ACaption, Event, Options );
  Result := M.FId;
end;

procedure TMenu.InsertSubMenu( SubMenuToInsert: PMenu; InsertBefore: Integer );
var AFlags: DWORD;
    M: PMenu;
    MII: TMenuItemInfo;
begin
  if SubMenuToInsert.FParentMenu <> nil then
    SubMenuToInsert := SubMenuToInsert.FParentMenu.RemoveSubMenu( SubMenuToInsert.FId );
  if SubMenuToInsert = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

  AFlags := MF_BYPOSITION;
  M := nil;
  if (InsertBefore >= 0) and (InsertBefore < 4096) then
  begin
    M := Items[ InsertBefore ];
    if M = nil then
      InsertBefore := -1
    else
      InsertBefore := M.FId;
  end;
  if M = nil then
  begin
    FMenuItems.Add( SubMenuToInsert );
    SubMenuToInsert.FParentMenu := @ Self;
  end
    else
  begin
    M.FParentMenu.FMenuItems.Insert( M.FParentMenu.FMenuItems.IndexOf( M ), SubMenuToInsert );
    SubMenuToInsert.FParentMenu := M.FParentMenu;
  end;

  if InsertBefore > 0 then
    AFlags := MF_BYCOMMAND;
  if SubMenuToInsert.FBmpItem <> 0 then
    InsertMenu( FHandle, InsertBefore, AFlags or MF_BITMAP or MF_POPUP,
      SubMenuToInsert.FHandle, PKOLChar( SubMenuToInsert.FBmpItem ) )
  else
    InsertMenu( FHandle, InsertBefore, AFlags or MF_STRING or MF_POPUP,
      SubMenuToInsert.FHandle, PKOLChar( SubMenuToInsert.Caption ) );
  if SubMenuToInsert.FId = 0 then
  begin
    SubMenuToInsert.FId := FDynamicMenuID;
    Inc( FDynamicMenuID );
    MII.cbSize := MenuStructSize;
    MII.fMask := MIIM_ID;
    MII.wID := SubMenuToInsert.FId;
	{$IFNDEF UNICODE_CTRLS}
    SetMenuItemInfo( SubMenuToInsert.FParentMenu.FHandle,
      SubMenuToInsert.FParentMenu.FMenuItems.IndexOf( SubMenuToInsert ),
                     TRUE, Windows.PMenuItemInfo( @ MII )^ );
	{$ELSE}
    SetMenuItemInfoW( SubMenuToInsert.FParentMenu.FHandle,
      SubMenuToInsert.FParentMenu.FMenuItems.IndexOf( SubMenuToInsert ),
                     TRUE, Windows.PMenuItemInfoW( @ MII )^ );
	{$ENDIF}
  end;
  RedrawFormMenuBar;
end;

function TMenu.RemoveSubMenu( ItemToRemove: Integer ): PMenu;
{$IFDEF DEBUG_MENU}var OK: Boolean; {$ENDIF}
var M: PMenu;
begin
  Result := Items[ ItemToRemove ];
  if Result = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  M := Result.FParentMenu;
  if M = nil then M := @Self;
  {$IFDEF DEBUG_MENU} OK := {$ENDIF}
  RemoveMenu( M.FHandle, Result.FId, MF_BYCOMMAND );
  M.FMenuItems.Remove( Result );
  {$IFDEF DEBUG_MENU}
  if not OK then
    ShowMessage( 'Error removing menu: ' + Int2Str( GetLastError ) + ' - ' +
                 SysErrorMessage( GetLastError ) );
  {$ENDIF}
  if Count = 0 then
  begin
    Result.Free;
    Result := nil;
  end;
  RedrawFormMenuBar;
end;

function TMenu.GetItemHelpContext(Idx: Integer): Integer;
begin
  Result := Items[ Idx ].HelpContext;
end;

procedure TMenu.SetItemHelpContext(Idx: Integer; const Value: Integer);
begin
  Items[ Idx ].HelpContext := Value;
end;

procedure ClearText( Sender: PControl );
begin
  Sender.Caption := '';
end;

procedure ClearListbox( Sender: PControl );
begin
  Sender.Perform( LB_RESETCONTENT, 0, 0 );
end;

procedure ClearCombobox( Sender: PControl );
begin
  Sender.Perform( CB_RESETCONTENT, 0, 0 );
end;

procedure ClearListView( Sender: PControl );
begin
  Sender.Perform( LVM_DELETEALLITEMS, 0, 0 );
end;

procedure ClearToolbar( Sender: PControl );
begin
  while Sender.TBButtonCount > 0 do
    Sender.TBDeleteButton( Sender.TBIndex2Item( 0 ) );
  Sender.Perform( TB_SETBITMAPSIZE, 0, 0 );
end;

{$ENDIF WIN_GDI}
{ -- Constructor of canvas -- }
function NewCanvas( DC: HDC ): PCanvas;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TCanvas';
  {$ENDIF}
  {$IFDEF GDI}
  Result.ModeCopy := cmSrcCopy;
  if DC <> 0 then
  begin
    Result.SetHandle( DC );
    {//} Result.fIsAlienDC := True;
    // When the Canvas will be destroyed, the DC will not be deleted
  end;
  {$ENDIF GDI}
end;

{ -- Contructors of controls -- }

{$IFDEF GDI}
{$IFDEF COMMANDACTIONS_OBJ}
function NewCommandActionsObj: PCommandActionsObj;
begin
    new( Result, Create );
    {$IFDEF DEBUG_OBJKIND}
    Result.fObjKind := 'TCommandActionsObj';
    {$ENDIF}
end;

{$IFDEF ASM_VERSION}{$ELSE PASCAL}
function NewCommandActionsObj_Packed( fromPack: PAnsiChar ): PCommandActionsObj;
var Dest: PWord;
    N, i: Integer;
begin
    new( Result, Create );
    {$IFDEF DEBUG_OBJKIND}
    Result.fObjKind := 'TCommandActionsObj';
    {$ENDIF}
    if  Integer( fromPack ) < 120 then
    begin
        Result.fIndexInActions := Integer( fromPack ); Exit; {>>>>>>>>>>>>>>>>>}
    end;
    Result.fIndexInActions := Byte( fromPack^ );
    inc( fromPack );
    Dest := Pointer( @Result.aClick );
    N := 38;
    while N > 0 do
    begin
        if  Byte( fromPack^ ) < 200 then
        begin
            Dest^ := PWord( fromPack )^;
            inc( Dest );
            inc( fromPack, 2 );
            dec( N );
        end
          else
        if  Byte( fromPack^ ) = 200 then
        begin
            inc( fromPack );
            Dest^ := PWord( fromPack )^;
            inc( Dest );
            inc( fromPack, 2 );
            dec( N );
        end
          else
        begin
            i := Byte( fromPack^ ) - 200;
            while i > 0 do
            begin
                Dest^ := 0;
                inc( Dest );
                dec( i );
                dec( N );
            end;
            inc( fromPack );
        end;
    end;
end;
{$ENDIF PAS_VERSION}
{$ENDIF COMMANDACTIONS_OBJ}

function DumpWindowed( c: PControl ): PControl;
var P: PByte;
    i, j: Integer;
    s, ss: KOLString;
begin
    P := Pointer( c );
    ss := '';
    i := 0;
    while i < Sizeof( TControl ) do
    begin
        s := Int2Hex( i, 3 ) + ':';
        for j := 0 to 15 do
        begin
            s := s + ' ' + Int2Hex( P^, 2 );
            inc( P );
            inc( i );
            if  i >= Sizeof( TControl ) then break;
        end;
        ss := ss + s + #13#10;
    end;
    LogFileOutput( GetStartDir + 'DumpWindowed.txt', Int2Hex( Integer( c ), 8 ) +
    #13#10 + ss );
    Result := c;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
function _NewWindowed( AParent: PControl; ControlClassName: PKOLChar;
         Ctl3D: Boolean; ACommandActions: TCommandActionsParam ): PControl;
{$IFDEF COMMANDACTIONS_OBJ}
var IdxActions: Integer;
{$ENDIF}
begin
  New( Result, CreateParented( AParent ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl';
  {$ENDIF}
  {$IFDEF COMMANDACTIONS_OBJ}
      if  Integer( ACommandActions ) < 120 then
          IdxActions := Integer( ACommandActions )
      else
          IdxActions := PByte( ACommandActions )^;
      if  AllActions_Objs[IdxActions] <> nil then
      begin
          Result.fCommandActions := AllActions_Objs[IdxActions];
          Result.fCommandActions.RefInc;
      end
        else
      begin
          {$IFDEF PACK_COMMANDACTIONS}
              Result.fCommandActions := NewCommandActionsObj_Packed( ACommandActions );
              AllActions_Objs[IdxActions] := Result.fCommandActions;
              Result.fCommandActions.aClear  := ClearText;
          {$ELSE}
              new( Result.fCommandActions, Create );
              {$IFDEF DEBUG_OBJKIND}
              Result.fCommandActions.fObjKind := 'TCommandActionsObj';
              {$ENDIF}
              AllActions_Objs[IdxActions] := Result.fCommandActions;
              if  ACommandActions <> nil then
                  Move( ACommandActions^, Result.fCommandActions.aClear,
                        Sizeof( TCommandActions ) )
              else
                  Result.fCommandActions.aClear  := ClearText;
          {$ENDIF}
      end;
      Result.Add2AutoFree( Result.fCommandActions );
  {$ELSE}
      if  ACommandActions <> nil then
          Result.fCommandActions := ACommandActions^
      else
          Result.fCommandActions.aClear  := ClearText;
  {$ENDIF}
  //Result.fWindowed := TRUE; // is set in TControl.Init
  Result.fControlClassName := ControlClassName;
  if AParent <> nil then
  begin
     {$IFDEF WIN_GDI}
     //{-2.95}Result.PP.fWndProcResizeFlicks := AParent.PP.fWndProcResizeFlicks;
     {$ENDIF WIN_GDI}
     Result.PP.fGotoControl := AParent.PP.fGotoControl;
     Result.fCtl3D_child := AParent.fCtl3D_child and 2;
     if  AParent.fCtl3D_child and 2 <> 0 then
         Result.fCtl3D_child := Result.fCtl3D_child or Integer( Ctl3D ) and 1
     {else
         Result.fCtl3D := False}; //
     Result.fMargin := AParent.fMargin;
     Result.fTextColor := AParent.fTextColor;
     {$IFDEF SMALLEST_CODE}
     {$ELSE}
     {$IFDEF WIN_GDI} // for now Font is complicated a bit, implement it later
     Result.fFont := Result.fFont.Assign( AParent.fFont );
     if Result.fFont <> nil then
     begin
       {$IFDEF USE_AUTOFREE4CONTROLS}
       Result.Add2AutoFree( Result.fFont );
       {$ENDIF USE_AUTOFREE4CONTROLS}
       Result.fFont.fParentGDITool := AParent.fFont;
       Result.fFont.fOnGTChange := Result.FontChanged;
       Result.FontChanged( Result.fFont );
     end;
     {$ENDIF WIN_GDI}
     {$ENDIF SMALLEST_CODE}
     Result.fColor := AParent.fColor;
     {$IFDEF WIN_GDI}
     Result.fBrush := Result.fBrush.Assign( AParent.fBrush );
     if Result.fBrush <> nil then
     begin
       {$IFDEF USE_AUTOFREE4CONTROLS}
       Result.Add2AutoFree( Result.fBrush );
       {$ENDIF USE_AUTOFREE4CONTROLS}
       Result.fBrush.fParentGDITool := AParent.fBrush;
       Result.fBrush.fOnGTChange := Result.BrushChanged;
       Result.BrushChanged( Result.fBrush );
     end;
     {$ENDIF WIN_GDI}
  end;
  {$IFDEF DUMP_WINDOWED}
  DumpWindowed( Result );
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}

{$IFDEF _X_}
{$IFDEF GTK}
VAR GTK_initialized: Boolean;
    argc: Integer = 0;

PROCEDURE FixedChildSetPos( Ctl, Chld: PControl; x, y: Integer );
BEGIN
  gtk_fixed_move( GTK_FIXED( Ctl.fClient ), Chld.fEventboxHandle, x, y );
END;

PROCEDURE LayoutChildSetPos( Ctl, Chld: PControl; x, y: Integer );
BEGIN
  gtk_layout_move( GTK_LAYOUT( Ctl.fClient ), Chld.fEventboxHandle, x, y );
END;

PROCEDURE FixedChildPut( Ctl, Chld: PControl; x, y: Integer );
BEGIN
  gtk_fixed_put( GTK_FIXED( Ctl.fClient ), Chld.fEventboxHandle, x, y );
END;

PROCEDURE LayoutChildPut( Ctl, Chld: PControl; x, y: Integer );
BEGIN
  gtk_layout_put( GTK_LAYOUT( Ctl.fClient ), Chld.fEventboxHandle, x, y );
END;

FUNCTION FixedClientArea( Ctl: PControl ): PGtkWidget;
BEGIN
  IF  Ctl.fClient = nil THEN
  BEGIN
      Ctl.fClient := gtk_fixed_new;
      gtk_container_set_border_width(GTK_CONTAINER(Ctl.fHandle), 0);
      gtk_container_add( GTK_CONTAINER( Ctl.fHandle ), Ctl.fClient );
      gtk_container_set_border_width(GTK_CONTAINER(Ctl.fClient), 0);
      gtk_widget_show( Ctl.fClient );
      Ctl.fChildPut := FixedChildPut;
      Ctl.fChildSetPos := FixedChildSetPos;
  END;
  Result := Ctl.fClient;
END;

FUNCTION ClientAreaLayout( Ctl: PControl ): PGtkWidget;
BEGIN
  IF  Ctl.fClient = nil THEN
  BEGIN
      Ctl.fClient := gtk_layout_new( {hadjustment} nil, {vadjustment} nil );
      Ctl.fChildPut := LayoutChildPut;
      Ctl.fChildSetPos := LayoutChildSetPos;
  END;
  Result := Ctl.fClient;
END;

FUNCTION _NewWindowed( AParent: PControl; ControlClassName: PAnsiChar;
  widget: PGtkWidget; need_eventbox: Boolean ): PControl;
//var GVal: TGValue;
BEGIN
  (*if not GTK_initialized then
  begin
    GTK_initialized := TRUE;
    gtk_init( @ argc, {@ argv} nil );
  end;*)
  New( Result, CreateParented( AParent, widget, need_eventbox ) );
  //Result.fWindowed := TRUE; // is set in TControl.Init
  //???//Result.fControlClassName := ControlClassName;
  IF AParent <> nil THEN
  BEGIN
     Result.fGotoControl := AParent.fGotoControl;
     Result.fMargin := AParent.fMargin;
     Result.fTextColor := AParent.fTextColor;
     {$IFDEF SMALLEST_CODE}
     {$ELSE}
     {$IFDEF WIN_GDI} // for now Font is complicated a bit, implement it later
     Result.fFont := Result.fFont.Assign( AParent.fFont );
     IF  Result.fFont <> nil THEN
     begin
         {$IFDEF USE_AUTOFREE4CONTROLS}
         Result.Add2AutoFree( Result.fFont );
         {$ENDIF USE_AUTOFREE4CONTROLS}
         Result.fFont.fParentGDITool := AParent.fFont;
         Result.fFont.fOnGTChange := Result.FontChanged;
         Result.FontChanged( Result.fFont );
     END;
     {$ENDIF WIN_GDI}
     {$ENDIF SMALLEST_CODE}
     Result.fColor := AParent.fColor;
     {$IFDEF WIN_GDI}
     Result.fBrush := Result.fBrush.Assign( AParent.fBrush );
     IF  Result.fBrush <> nil THEN
     BEGIN
         {$IFDEF USE_AUTOFREE4CONTROLS}
         Result.Add2AutoFree( Result.fBrush );
         {$ENDIF USE_AUTOFREE4CONTROLS}
         Result.fBrush.fParentGDITool := AParent.fBrush;
         Result.fBrush.fOnGTChange := Result.BrushChanged;
         Result.BrushChanged( Result.fBrush );
     END;
     {$ENDIF WIN_GDI}
  END;
  Result.fGetClientArea := FixedClientArea;
END;
{$ENDIF GTK}
{$ENDIF _X_}

//===================== Form ========================//

{$IFDEF USE_CONSTRUCTORS}
function NewForm( AParent: PControl; const Caption: AnsiString ): PControl;
begin
  new( Result, CreateForm( AParent, Caption ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Form';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewForm( AParent: PControl; const Caption: KOLString ): PControl;
begin
  Result := _NewWindowed( AParent, 'Form', True,
         {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS )
         {$ELSE} nil {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Form';
  {$ENDIF}
  Result.fClsStyle := Result.fClsStyle or CS_DBLCLKS;
  Result.AttachProc( WndProcForm );
  Result.AttachProc( WndProcDoEraseBkgnd );
  Result.Caption := Caption;
  {$IFDEF USE_FLAGS} Result.fFlagsG3 := Result.fFlagsG3 + [G3_SizeGrip, G3_IsForm];
  {$ELSE}
          {$IFNDEF SMALLEST_CODE}
          Result.fSizeGrip := TRUE;
          {$ENDIF}
          Result.fIsForm := TRUE;
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

const Edgestyles: array[ TEdgeStyle ] of DWORD = ( WS_DLGFRAME, SS_SUNKEN, 0, 0, 0);

function NewAlienPanel( AParentWnd: HWnd; EdgeStyle: TEdgeStyle ): PControl;
begin
    Result := _NewWindowed( nil, 'KOL', TRUE,
           {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS )
           {$ELSE} nil {$ENDIF} );
    Result.fClsStyle := Result.fClsStyle or CS_DBLCLKS;
    Result.FParentWnd := AParentWnd;
    Result.AttachProc( WndProcForm );
    Result.AttachProc( WndProcDoEraseBkgnd );
    {$IFDEF USE_FLAGS} Result.fFlagsG3 := Result.fFlagsG3 + [G3_IsForm, G3_IsControl];
    {$ELSE} Result.fIsForm := TRUE;
            Result.fIsControl := TRUE;
    {$ENDIF}
    Result.fStyle.Value := WS_VISIBLE or WS_CHILD or WS_TABSTOP or
        WS_CLIPSIBLINGS or WS_CLIPCHILDREN or Edgestyles[ EdgeStyle ];
    Result.fExStyle := Result.fExStyle //or WS_EX_CLIENTEDGE
        or WS_EX_CONTROLPARENT;
    Result.SetSize( 100, 64 );
end;

{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION getFormCaption(F: PControl): KOLString;
BEGIN
  F.fCaption := gtk_window_get_title( GTK_WINDOW( F.fHandle ) );
  Result := F.fCaption;
END;

PROCEDURE setFormCaption(F: PControl; const Value: KOLString);
BEGIN
  F.fCaption := Value;
  gtk_window_set_title( GTK_WINDOW( F.fCaptionHandle ), PAnsiChar( String( Value ) ) );
END;

PROCEDURE DestroyForm( Widget: PGtkWidget; Sender: PControl ); CDECL;
VAR Quit: Boolean;
BEGIN
  Quit := Sender.IsMainWindow;
  Sender.Free;
  IF  Quit THEN
      gtk_main_quit();
END;

FUNCTION NewForm( AParent: PControl; const Caption: KOLString ): PControl;
VAR widget: PGtkWidget;
BEGIN
  IF not GTK_initialized THEN
  BEGIN
    GTK_initialized := TRUE;
    gtk_init( @ argc, {@ argv} nil );
  END;
  widget := gtk_window_new( GTK_WINDOW_TOPLEVEL );
  Result := _NewWindowed( AParent, 'Form', widget, FALSE );
  Result.fGetCaption := getFormCaption;
  Result.fSetCaption := setFormCaption;
  Result.Caption := Caption;
  {$IFDEF USE_FLAGS} include( Result.fFlagsG3, G3_IsForm );
  {$ELSE} Result.fIsForm := TRUE; {$ENDIF}
  gtk_signal_connect( Pointer( Result.fHandle ), 'destroy',
      @ DestroyForm, Result );
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$ENDIF USE_CONSTRUCTORS}

{$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
//===================== Applet button ========================//

//22{$IFDEF ASM_VERSION}
{$IFNDEF PAS_ONLY}
  function WndProcAppAsm(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
  asm
          CMP      word ptr [EDX].TMsg.message, WM_SETFOCUS
          JNZ      @@chk_CLOSE
          MOV      ECX, [EAX].TControl.DF.FCurrentControl
          JECXZ    @@ret_false
          XCHG     EAX, ECX
          PUSH     EAX
          CALL     CallTControlCreateWindow
          TEST     AL, AL
          POP      EAX
          JZ       @@1
          PUSH     [EAX].TControl.fHandle
          CALL     SetFocus
  @@1:    MOV      AL, 1
          RET
  @@chk_CLOSE:
          CMP      word ptr [EDX].TMsg.message, WM_SYSCOMMAND
          JNZ      @@ret_false
          MOV      EDX, dword ptr [EDX].TMsg.wParam
          AND      DX, $FFF0
          CMP      DX, SC_CLOSE
          JNZ      @@ret_false
          PUSH     ECX
          MOV      ECX, [EAX].TControl.fChildren
          JECXZ    @@ret_false1
          XCHG     EAX, ECX
          MOV      ECX, [EAX].TList.fCount
          JECXZ    @@ret_false1
          MOV      EAX, [EAX].TList.fItems
          MOV      ECX, dword ptr [EAX]
          JECXZ    @@ret_false1
          XCHG     EAX, ECX
          PUSH     EAX
          CALL     TControl.IsMainWindow
          TEST     EAX, EAX
          POP      EAX
          JZ       @@ret_false1
          CALL     TControl.Close
          POP      ECX
          XOR      EAX, EAX
          MOV      dword ptr [ECX], EAX
          INC      EAX
          JMP      @@exit
  @@ret_false1:
          POP      ECX
  @@ret_false:
          XOR      EAX, EAX
  @@exit:
  end;
{$ENDIF not PAS_ONLY}
//22{$ENDIF}

function WndProcAppPas(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
begin
  Result := False;
  case Msg.message of
  WM_SETFOCUS:
    {$IFDEF NEW_MODAL}
    if Self_.DF.fModalForm <> nil then
      SetFocus( Self_.DF.fModalForm.fHandle )
    else if ( Self_.DF.FCurrentControl <> nil ) and not
            ( {$IFDEF USE_FLAGS} (G3_IsForm in Self_.DF.fCurrentControl.fFlagsG3)
              {$ELSE} Self_.DF.fCurrentControl.fIsForm {$ENDIF}
              xor
              {$IFDEF USE_FLAGS} (G3_IsApplet in Self_.fFlagsG3)
              {$ELSE} Self_.fIsApplet {$ENDIF} ) then
    {$ELSE not_NEW_MODAL}
    if Self_.DF.fCurrentControl <> nil then
    {$ENDIF NEW_MODAL}
    begin
      if Self_.DF.FCurrentControl.CreateWindow then
        SetFocus( Self_.DF.FCurrentControl.fHandle );
      Result := True;
    end;
  WM_SYSCOMMAND:
    CASE Msg.wParam and $FFF0 OF
    SC_CLOSE:
      if (Self_.fChildren <> nil) and (Self_.fChildren.fCount > 0) and
         PControl( Self_.fChildren.fItems[ 0 ] ).IsMainWindow then
      begin
        PControl( Self_.fChildren.fItems[ 0 ] ).Close;
        Rslt := 0;
        Result := TRUE;
      end;
    END;
  end;
end;

{$IFDEF USE_CONSTRUCTORS}
{$DEFINE CREATEAPPBUTTON_USED}
function NewApplet( const Caption: AnsiString ): PControl;
begin
  new( Result, CreateApplet( Caption ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Applet';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_TLIST}
function NewApplet( const Caption: KOLString ): PControl;
const AppClass: array[ 0..3 ] of KOLChar = ( 'A', 'p', 'p', #0 );
asm
        XOR      ECX, ECX
        INC      ECX
        MOV      [AppButtonUsed], CL
        PUSH     EAX
        MOV      EDX, offset[AppClass]
        XOR      EAX, EAX
        PUSH     EAX
        CALL     _NewWindowed
        {$IFDEF  USE_FLAGS}
        OR       [EAX].TControl.fFlagsG3, (1 shl G3_IsApplet)
        {$ELSE}
        INC      [EAX].TControl.FIsApplet
        {$ENDIF}
        MOV      word ptr [EAX].TControl.fStyle + 2, $90CA //WS_VISIBLE or WS_SYSMENU or WS_POPUP or WS_MINIMIZEBOX or WS_CAPTION
        MOV      byte ptr [EAX].TControl.fExStyle + 2, WS_EX_APPWINDOW shr 16 // WS_EX_APPWINDOW = $40000
        CALL     @@newapp1

        PUSH     ESI // BODY of CreateAppButton here
        PUSH     0
        PUSH     [EAX].TControl.fHandle
        CALL     GetSystemMenu
        MOV      ESI, offset[DeleteMenu]

        XCHG     ECX, EAX
        MOV      EAX, SC_MAXIMIZE
        CDQ

        PUSH     EDX
        PUSH     EAX
        PUSH     ECX

        PUSH     EDX
        {$IFDEF PARANOIA} DB $2C, $20 {$ELSE} SUB AL, $20 {$ENDIF} // SC_MOVE
        PUSH     EAX
        PUSH     ECX

        PUSH     EDX
        {$IFDEF PARANOIA} DB $2C, $10 {$ELSE} SUB AL, $10 {$ENDIF} // SC_SIZE
        PUSH     EAX
        PUSH     ECX

        PUSH     1    // MF_GRAYED or MF_BYCOMMAND
        MOV      AX, SC_RESTORE
        PUSH     EAX
        PUSH     ECX

        CALL     EnableMenuItem
        CALL     ESI
        CALL     ESI
        CALL     ESI
        POP      ESI
@@ret_false:
        XOR      EAX, EAX
        RET

@@chk_CLOSE:
          CMP      word ptr [EDX].TMsg.message, WM_SYSCOMMAND
          JNZ      @@ret_false
          MOV      EDX, dword ptr [EDX].TMsg.wParam
          AND      DX, $FFF0
          CMP      DX, SC_CLOSE
          JNZ      @@ret_false
          PUSH     ECX
          MOV      ECX, [EAX].TControl.fChildren
          JECXZ    @@ret_false1
          XCHG     EAX, ECX
          MOV      ECX, [EAX].TList.fCount
          JECXZ    @@ret_false1
          MOV      EAX, [EAX].TList.fItems
          MOV      ECX, dword ptr [EAX]
          JECXZ    @@ret_false1
          XCHG     EAX, ECX
          PUSH     EAX
          CALL     TControl.IsMainWindow
          TEST     EAX, EAX
          POP      EAX
          JZ       @@ret_false1
          CALL     TControl.Close
          POP      ECX
          XOR      EAX, EAX
          MOV      dword ptr [ECX], EAX
          INC      EAX
          RET
  @@ret_false1:
          POP      ECX
          JMP      @@ret_false

@@newapp1:
        POP      [EAX].TControl.PP.FCreateWndExt
        PUSH     EAX
        CALL     @@newapp2

        // BODY of WndProcApp here:
        CMP      word ptr [EDX].TMsg.message, WM_SETFOCUS
        JNZ      @@chk_CLOSE
        MOV      ECX, [EAX].TControl.DF.fCurrentControl
        JECXZ    @@ret_false
        XCHG     EAX, ECX

        PUSH     EAX
        CALL     CallTControlCreateWindow
        POP      EAX
        PUSH     [EAX].TControl.fHandle

        CALL     SetFocus
        MOV      AL, 1
        RET

@@newapp2:
        POP      EDX
        CALL     TControl.AttachProc
        POP      EAX
        POP      EDX
        PUSH     EAX
        CALL     TControl.SetCaption
        POP      EAX
end;
{$ELSE PAS_VERSION} //Pascal

procedure CreateAppButton( App: PControl );
var M: HMenu;
begin
  M := GetSystemMenu( App.fHandle, False );
  DeleteMenu( M, SC_MAXIMIZE, MF_BYCOMMAND );
  DeleteMenu( M, SC_MOVE, MF_BYCOMMAND );
  DeleteMenu( M, SC_SIZE, MF_BYCOMMAND );
  EnableMenuItem( M, SC_RESTORE, MF_GRAYED or MF_BYCOMMAND );
end;

function NewApplet( const Caption: KOLString ): PControl;
begin
  AppButtonUsed := True;
  Result := _NewWindowed( nil, 'App', True,
         {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS )
         {$ELSE} nil {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Applet';
  {$ENDIF}
  {$IFDEF USE_FLAGS} include( Result.fFlagsG3, G3_IsApplet );
  {$ELSE}            Result.FIsApplet := TRUE; {$ENDIF}
  Result.fStyle.Value := WS_VISIBLE or WS_SYSMENU or WS_POPUP or WS_MINIMIZEBOX or WS_CAPTION;
  Result.fExStyle := WS_EX_APPWINDOW;
  Result.PP.FCreateWndExt := CreateAppButton;
  {$IFDEF ASM_VERSION}
  Result.AttachProc( WndProcAppAsm );
  {$ELSE}
  Result.AttachProc( WndProcAppPas );
  {$ENDIF}
  Result.Caption := Caption;
end;
{$ENDIF PAS_VERSION}
{$ENDIF USE_CONSTRUCTORS}

{$IFDEF CREATEAPPBUTTON_USED}
procedure CreateAppButton( App: PControl );
asm
  {$IFDEF F_P}
        MOV      EAX, [App]
  {$ENDIF F_P}
        PUSH     ESI
        PUSH     0
        PUSH     [EAX].TControl.fHandle
        CALL     GetSystemMenu
        MOV      ESI, offset[DeleteMenu]

        XCHG     ECX, EAX
        MOV      EAX, SC_MAXIMIZE
        CDQ

        PUSH     EDX
        PUSH     EAX
        PUSH     ECX

        PUSH     EDX
        {$IFDEF PARANOIA} DB $2C, $20 {$ELSE} SUB AL, $20 {$ENDIF} // SC_MOVE
        PUSH     EAX
        PUSH     ECX

        PUSH     EDX
        {$IFDEF PARANOIA} DB $2C, $10 {$ELSE} SUB AL, $10 {$ENDIF} // SC_SIZE
        PUSH     EAX
        PUSH     ECX

        PUSH     1    // MF_GRAYED or MF_BYCOMMAND
        MOV      AX, SC_RESTORE
        PUSH     EAX
        PUSH     ECX

        CALL     EnableMenuItem
        CALL     ESI
        CALL     ESI
        CALL     ESI
        POP      ESI
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
{$ENDIF CREATEAPPBUTTON_USED}

var CtlIdCount: WORD = $8000;

{$ENDIF WIN_GDI}

{$IFDEF GDI}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function _NewControl( AParent: PControl; ControlClassName: PKOLChar;
  Style: DWORD; Ctl3D: Boolean; Actions: TCommandActionsParam ): PControl;
var Form: PControl;
begin
  Result := _NewWindowed( AParent, ControlClassName, Ctl3D, Actions );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl';
  {$ENDIF}
  {$IFDEF USE_FLAGS} include( Result.fFlagsG3, G3_IsControl );
  {$ELSE} Result.fIsControl := True; {$ENDIF}
  Result.fStyle.Value := Style or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
  Result.fVerticalAlign := vaTop;
  Result.fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ];
  if Result.fCtl3D_child and 1 <> 0 then
  begin
    Result.fStyle.Value := Result.fStyle.Value and not WS_BORDER;
    Result.fExStyle := Result.fExStyle or WS_EX_CLIENTEDGE;
  end;
  {$IFDEF USE_FLAGS}
  {$ELSE}
  Result.fVisible := (Style and WS_VISIBLE) <> 0;
  Result.fTabstop := (Style and WS_TABSTOP) <> 0;
  {$ENDIF}
  if (AParent <> nil) then
  begin
    with Result.fBoundsRect do
    begin
        Left := AParent.fMargin + AParent.fClientLeft;
        Top  := AParent.fMargin + AParent.fClientTop;
        Right := Left + 64;
        Bottom := Top + 64;
    end;
    Form := AParent.ParentForm;
    if  Form <> nil then
    begin
        Inc( Form.fTabOrder );
        Result.fTabOrder := Form.fTabOrder;
        if  F2_Tabstop in Result.fStyle.f2_Style then
        begin
            if  Form.DF.FCurrentControl = nil then
                Form.DF.FCurrentControl := Result;
        end;
    end;
    Result.fCursor := AParent.fCursor;
  end;
  Result.fMenu := CtlIdCount;
  Inc( CtlIdCount );
  Result.AttachProc( WndProcCtrl );
  {$IFDEF DEBUG_ALTSPC}
  DumpWindowed(Result);
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}

{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION getLabelCaption( L: PControl ): KOLString;
BEGIN
  L.fCaption := gtk_label_get_text( Pointer( L.fCaptionHandle ) );
  Result := L.fCaption;
END;

PROCEDURE setLabelCaption( L: PControl; const Value: KOLString );
BEGIN
  L.fCaption := Value;
  gtk_label_set_text( Pointer( L.fCaptionHandle ), PAnsiChar( String( Value ) ) );
END;

FUNCTION _NewControl( AParent: PControl; ControlClassName: PAnsiChar;
  Style: DWORD; Ctl3D: Boolean; widget: PGtkWidget; need_eventbox: Boolean ): PControl;
VAR Rect: TRect;
BEGIN
  Result := _NewWindowed( AParent, ControlClassName, widget, need_eventbox );
  Result.fIsControl := True;
  Result.fVerticalAlign := vaTop;
  Result.fVisible := (Style and WS_VISIBLE) <> 0;
  Result.fTabstop := (Style and WS_TABSTOP) <> 0;
  IF (AParent <> nil) THEN
  BEGIN
    WITH Rect DO
    BEGIN
     Left := AParent.fMargin + AParent.fClientLeft;
     Top  := AParent.fMargin + AParent.fClientTop;
    END;
    Inc( AParent.ParentForm.fTabOrder );
    Result.fTabOrder := AParent.ParentForm.fTabOrder;
    {$IFDEF GDI}
    Result.fCursor := AParent.fCursor;
    {$ENDIF GDI}
    //gtk_container_add( GTK_CONTAINER( AParent.fHandle ), Result.fHandle );
  END;
  {with Rect do
  begin
   Right := Left + 64;
   Bottom := Top + 64;
  end;
  Result.fBoundsRect := Result.BoundsRect;
  Result.BoundsRect := Rect;}
  Result.fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ];
  {$IFDEF GDI}
  IF Result.fCtl3D THEN
  BEGIN
    Result.fStyle := Result.fStyle and not WS_BORDER;
    Result.fExStyle := Result.fExStyle or WS_EX_CLIENTEDGE;
  END;
  IF (Style and WS_TABSTOP) <> 0 THEN
  BEGIN
    Form := Result.ParentForm;
    IF Form <> nil THEN
    IF Form.FCurrentControl = nil THEN
       Form.FCurrentControl := Result;
  END;
  Result.fMenu := CtlIdCount;
  Inc( CtlIdCount );
  Result.AttachProc( WndProcCtrl );
  {$ENDIF GDI}
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}

//===================== Button ========================//

function TControl.SetButtonIcon(aIcon: HIcon): PControl;
var PrevImg: THandle;
begin
  Style := Style or BS_ICON;
  DF.fButtonIcon := aIcon;
  PrevImg := Perform( BM_SETIMAGE, IMAGE_ICON, aIcon );
  if PrevImg <> 0 then
    DeleteObject( PrevImg );
  Result := @ Self;
end;

function TControl.SetButtonBitmap(aBmp: HBitmap): PControl;
var PrevImg: THandle;
begin
  Style := Style or BS_BITMAP;
  PrevImg := Perform( BM_SETIMAGE, IMAGE_BITMAP, aBmp );
  if PrevImg <> 0 then
    DeleteObject( PrevImg );
  Result := @ Self;
end;

{$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER}
function WndProcBtnReturnClick( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := FALSE;
  if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP) or
      (Msg.message = WM_CHAR)) and (Msg.wParam = 13) then
    Msg.wParam := 32;
end;
{$ENDIF}

{$IFNDEF BUTTON_DBLCLICK}
function WndProcBtnDblClkAsClk( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := FALSE;
  if Msg.message = WM_LBUTTONDBLCLK then
    Msg.message := WM_LBUTTONDOWN;
end;
{$ENDIF}

function AutoMinimizeApplet(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
begin
  if (msg.Message=WM_SYSCOMMAND) and ((msg.wParam and not 15)=SC_MINIMIZE) then begin
    AppletMinimize;
    Result := True;
  end else
    Result := False;
end;

{$IFDEF USE_CONSTRUCTORS}
function NewButton( AParent: PControl; const Caption: KOLString ): PControl;
begin
  new( Result, CreateButton( AParent, Caption ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Button';
  {$ENDIF}
end;
{$ELSE USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewButton( AParent: PControl; const Caption: KOLString ): PControl;
begin
  Result := _NewControl( AParent, 'BUTTON',
            WS_VISIBLE or WS_CHILD or BS_NOTIFY or
            BS_PUSHLIKE or WS_TABSTOP, False,
            {$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed
            {$ELSE}                      @ButtonActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Button';
  {$ENDIF}
  Result.aAutoSzX := 14;
  Result.aAutoSzY := 6;
  {$IFDEF BUTTON_DBLCLICK}
  Result.ClsStyle := Result.ClsStyle - CS_DBLCLKS;
  {$ENDIF}
  //Result.fCtl3D := TRUE;
  with Result.fBoundsRect do
    Bottom := Top + 22;
  Result.fTextAlign := taCenter;
  Result.Caption := Caption;
  {$IFDEF USE_FLAGS}
          Result.fFlagsG5 := Result.fFlagsG5 + [G5_IsButton, G5_IgnoreDefault];
  {$ELSE} Result.fIsButton := TRUE;
          Result.fIgnoreDefault := TRUE;
  {$ENDIF}
  {$IFNDEF SMALLEST_CODE}
  {$IFNDEF BUTTON_DBLCLICK}
  Result.AttachProc( WndProcBtnDblClkAsClk );
  {$ENDIF}
  {$ENDIF}
  {$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER}
  Result.AttachProc( WndProcBtnReturnClick );
  {$ENDIF}
{$IFDEF GRAPHCTL_XPSTYLES}
  Attach_WM_THEMECHANGED( Result, XP_Themes_For_BitBtn );
{$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}
{$ENDIF WIN_GDI}

{$IFDEF _X_}
{$IFDEF GTK}
CONST
  HorAlignments: ARRAY[ TTextAlign ] of Single = ( {taLeft} 0, {taRight} 1, {taCenter} 0.5 );
  VerAlignments: ARRAY[ TVerticalAlign ] of Single = ( {vaTop} 0, {vaCenter} 0.5, {vaBottom} 1 );

PROCEDURE ButtonSetTextAlign( Self_: PControl );
BEGIN
  gtk_button_set_alignment( GTK_BUTTON( Self_.fHandle ), HorAlignments[ Self_.fTextAlign ],
    VerAlignments[ Self_.fVerticalAlign ] );
END;

FUNCTION NewButton( AParent: PControl; const Caption: KOLString ): PControl;
BEGIN
  Result := _NewControl( AParent, 'BUTTON',
            WS_VISIBLE or WS_CHILD or BS_NOTIFY or
            BS_PUSHLIKE or WS_TABSTOP, False,
            gtk_button_new{_with_label}( {PChar( String( Caption ) )} ), FALSE );
  //Result.Height := 22;
  gtk_container_set_border_width( GTK_CONTAINER( Result.fHandle ), 0 );
  Result.fCaptionHandle := gtk_label_new( PAnsiChar( String( Caption ) ) );
  gtk_container_add( GTK_CONTAINER( Result.fHandle ), Result.fCaptionHandle );
  //gtk_container_set_border_width( GTK_CONTAINER( Result.fCaptionHandle ), 0 );
  gtk_widget_show( Result.fCaptionHandle );
  Result.fGetCaption := getLabelCaption;
  Result.fSetCaption := setLabelCaption;
  //Result.fIgnoreDefault := TRUE;
  //Result.fCtl3D := TRUE;
  //with Result.fBoundsRect do
  //  Bottom := Top + 22;
  Result.fTextAlign := taCenter;
  Result.fCaption := Caption;
  Result.fIsButton := TRUE;
  Result.fSetTextAlign := ButtonSetTextAlign;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}
//----------------- BitBtn -----------------------

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function WndProc_DrawItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer )
                          : Boolean;
var DI: PDrawItemStruct;
    Control: PControl;
begin
  Result := FALSE;
  if Msg.message = WM_DRAWITEM then
  begin
    DI := Pointer( Msg.lParam );
    {$IFDEF USE_PROP}
    Control := Pointer( GetProp( DI.hwndItem, ID_SELF ) );
    {$ELSE}
    Control := Pointer( GetWindowLong( DI.hwndItem, GWL_USERDATA ) );
    {$ENDIF}
    if Control <> nil then
    begin
      Rslt := Control.Perform( CN_DRAWITEM, Msg.wParam, Msg.lParam );
      Result := TRUE;
    end;
  end;
end;
{$ENDIF PAS_VERSION}

function ExcludeAmpersands( Self_: PControl; const S: KOLString ): KOLString;
var I: Integer;
begin
  Result := S;
  if not Self_.DF.fBitBtnDrawMnemonic then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  for I := Length( Result ) downto 1 do
  begin
      if  Result[ I ] = '&' then
          Delete( Result, I, 1 );
  end;
end;

procedure BitBtnExtDraw( Self_: PControl; DC: HDC; X, Y: Integer; const R: TRect;
          const CapText, CapTxtOrig: KOLString; Color: TColor );
var I, J, W, H: Integer;
    Sz: TSize;
    Pen, OldPen: HPen;
begin
  if not Self_.DF.fBitBtnDrawMnemonic then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  J := 0;
  for I := 1 to Length( CapTxtOrig ) do
  begin
    if CapTxtOrig[ I ] <> '&' then
      Inc( J )
    else
    begin
      GetTextExtentPoint32( DC, PKOLChar( CapText ), J, Sz );
      W := Sz.cx;
      Windows.GetTextExtentPoint32( DC, '_', 1, Sz ); // A/W KOL_ANSI
      H := Sz.cy - 1;
      Windows.GetTextExtentPoint32( DC, @ CapTxtOrig[ I + 1 ], 1, Sz );
      Windows.MoveToEx( DC, X + W, Y + H, nil );

      Pen := CreatePen( PS_SOLID, 0, Color2RGB( Color ) );
      OldPen := SelectObject( DC, Pen );

      Windows.LineTo( DC, X + W + Sz.cx, Y + H );

      SelectObject( DC, OldPen );
      DeleteObject( Pen );
    end;
  end;
end;

procedure TControl.SetBitBtnDrawMnemonic(const Value: Boolean);
begin
  DF.fBitBtnDrawMnemonic := Value;
  DF.FBitBtnGetCaption := ExcludeAmpersands;
  DF.FBitBtnExtDraw := BitBtnExtDraw;
  Invalidate;
end;

function TControl.GetBitBtnImgIdx: Integer;
begin
  Result := LoWord( DF.fGlyphCount );
end;

procedure TControl.SetBitBtnImgIdx(const Value: Integer);
begin
  if not( bboImageList in DF.fBitBtnOptions ) then Exit; {>>>>>>>>>>>>>>>>>>>>>}
  DF.fGlyphCount := HiWord( DF.fGlyphCount ) or (Value and $FFFF);
  Invalidate;
end;

function TControl.GetBitBtnImageList: THandle;
begin
  Result := 0;
  if  bboImageList in DF.fBitBtnOptions then
      Result := DF.fGlyphBitmap;
end;

procedure TControl.SetBitBtnImageList(const Value: THandle);
begin
  DF.fGlyphBitmap := Value;
  if  Value <> 0 then
  begin
      include( DF.fBitBtnOptions, bboImageList );
      ImageList_GetIconSize( Value, DF.fGlyphWidth, DF.fGlyphHeight );
  end else
      exclude( DF.fBitBtnOptions, bboImageList );
  Invalidate;
end;

{$IFDEF ASM_noVERSION} // remove &-s from view //+ TextShift & if Y < 0 then Y := 0; // + glyph + TextShift if not glyphOver
                       // timer when RepeatInterval set
function WndProcBitBtn( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
const szBitmapInfo = sizeof(TBitmapInfo);
asm
        CMP      word ptr [EDX].TMsg.message, WM_LBUTTONDBLCLK
        JNZ      @@noWM_LBUTTONDBLCLK
        PUSH     ECX
        PUSH     [EDX].TMsg.wParam
        PUSH     [EDX].TMsg.lParam
        PUSH     WM_LBUTTONDOWN
        PUSH     EAX
        CALL     TControl.Perform
        POP      ECX
        MOV      [ECX], EAX
        MOV      AL, 1
        RET
@@noWM_LBUTTONDBLCLK:
        PUSH     EBX
        CMP      [EDX].TMsg.message, CN_DRAWITEM
        JNZ      @@noCN_DRAWITEM
        PUSH     EDI
        PUSH     ESI
        XCHG     EDI, EAX // EDI = @Self
        MOV      dword ptr [ECX], 1
        MOV      ESI, [EDX].TMsg.lParam // ESI = DIS
        XOR      EBX, EBX // G = 0
        MOV      EAX, [ESI].TDrawItemStruct.itemState
        TEST     byte ptr [EDI].TControl.fBitBtnOptions, 8 //1 shl Ord(bboFixed)
        JNZ      @@fixed_in_options
        {$IFDEF PARANOIA} DB $A8, ODS_SELECTED {$ELSE} TEST AL, ODS_SELECTED {$ENDIF}
        JZ       @@not1
        JMP      @@1
@@fixed_in_options:
        {$IFDEF  USE_FLAGS}
        TEST     [EDI].TControl.fFlagsG4, 1 shl G4_Checked
        {$ELSE}
        TEST     byte ptr [EDI].TControl.fChecked, 1
        {$ENDIF}
        JZ       @@not1
@@1:    INC      EBX
@@not1:
        {$IFDEF PARANOIA} DB $A8, ODS_DISABLED {$ELSE} TEST AL, ODS_DISABLED {$ENDIF}
        JZ       @@not2
        MOV      BL, 2
@@not2: TEST     EBX, EBX
        JNZ      @@not3
        {$IFDEF PARANOIA} DB $A8, ODS_FOCUS {$ELSE} TEST AL, ODS_FOCUS {$ENDIF}
        JZ       @@not3
        MOV      BL, 3
@@not3: {$IFDEF  USE_FLAGS}
        TEST     [EDI].TControl.fFlagsG3, 1 shl G3_MouseInCtl
        {$ELSE}
        CMP      [EDI].TControl.fMouseInControl, BH
        {$ENDIF}
        JZ       @@not4
        TEST     EBX, EBX
        JZ       @@4
        CMP      BL, 3
        JNZ      @@not4
@@4:    MOV      BL, 4
@@not4: MOV      ECX, [EDI].TControl.fOnBitBtnDraw.TMethod.Code
        {$IFDEF  NIL_EVENTS}
        TEST     ECX, ECX
        JZ       @@noOnBitBtnDraw
        {$ENDIF}
        MOV      EAX, [EDI].TControl.fCanvas
          PUSH     EAX
        TEST     EAX, EAX
        JZ       @@noCanvas
        MOV      EDX, [ESI].TDrawItemStruct.hDC
        CALL     TCanvas.SetHandle
@@noCanvas:
        MOV      EAX, [EDI].TControl.fOnBitBtnDraw.TMethod.Data
        MOV      EDX, EDI
        PUSH     EBX
        XCHG     ECX, EBX
        CALL     EBX
        POP      EBX
          POP      ECX // Canvas
        PUSH     EAX
        JECXZ    @@noCanvas2
        XCHG     EAX, ECX
        XOR      EDX, EDX
        CALL     TCanvas.SetHandle
@@noCanvas2:
        POP      EAX
        TEST     AL, AL
        JNZ      @@exit_draw
@@noOnBitBtnDraw:
        TEST     byte ptr [EDI].TControl.fBitBtnOptions, 2 //1 shl Ord(bboNoBorder)
        JNZ      @@noborder
        TEST     byte ptr [ESI].TDrawItemStruct.itemState, ODS_FOCUS
        JZ       @@noDefaultBorder
        PUSH     {BLACK_BRUSH} DKGRAY_BRUSH
        CALL     GetStockObject
        LEA      EDX, [ESI].TDrawItemStruct.rcItem
        OR       ECX, -1
        PUSH     ECX
        PUSH     ECX
        PUSH     EDX
        PUSH     EAX
        PUSH     EDX
        PUSH     [ESI].TDrawItemStruct.hDC
        CALL     Windows.FrameRect
        CALL     InflateRect
        XOR      ECX, ECX
        JMP      @@noFlat
@@noDefaultBorder:
        {$IFDEF  USE_FLAGS}
            TEST     [EDI].TControl.fFlagsG3, 1 shl G3_Flat
            JZ       @@noFlat
            TEST     [EDI].TControl.fFlagsG3, 1 shl G3_MouseInCtl
            JZ       @@noborder
        {$ELSE}
            MOVZX    ECX, [EDI].TControl.fFlat
            JECXZ    @@noFlat
            AND      CL, [EDI].TControl.fMouseInControl
            JZ       @@noborder
        {$ENDIF}
@@noFlat:
        TEST     byte ptr [ESI].TDrawItemStruct.itemState, ODS_SELECTED
        MOV      CL, {BDR_SUNKENOUTER or} BDR_SUNKENINNER
        JNZ      @@border_sunken
        MOV      CL, {BDR_RAISEDOUTER or} BDR_RAISEDINNER
@@border_sunken:
        LEA      EDX, [ESI].TDrawItemStruct.rcItem
        OR       EAX, -1
        PUSH     EAX
        PUSH     EAX
        PUSH     EDX
        PUSH     BF_ADJUST or BF_RECT
        PUSH     ECX
        PUSH     EDX
        PUSH     [ESI].TDrawItemStruct.hDC
        CALL     DrawEdge
        CALL     InflateRect
@@noborder:
        PUSH     [ESI].TDrawItemStruct.rcItem.Bottom
        PUSH     [ESI].TDrawItemStruct.rcItem.Right
        PUSH     [ESI].TDrawItemStruct.rcItem.Top
        PUSH     [ESI].TDrawItemStruct.rcItem.Left
        MOV      EAX, [EDI].TControl.fGlyphWidth
        MOV      EDX, [EDI].TControl.fGlyphHeight
        TEST     EAX, EAX
        JLE      @@noglyph
        TEST     EDX, EDX
        JLE      @@noglyph
        PUSH     EBP
        MOV      EBP, ESP

        PUSH     EDX // ImgH -> [EBP-4]
        PUSH     EAX // ImgW -> [EBP-8]
        PUSH     EDX // OutH -> [EBP-12]
        PUSH     EAX // OutW -> [EBP-16]
        MOV      EAX, [ESI].TDrawItemStruct.rcItem.Left // X = DIS.rcItem.Left
        MOV      EDX, [ESI].TDrawItemStruct.rcItem.Top  // Y = DIS.rcItem.Top
        MOV      ECX, [ESI].TDrawItemStruct.rcItem.Bottom
        SUB      ECX, EDX
        PUSH     ECX // H -> [EBP-20]
        MOV      ECX, [ESI].TDrawItemStruct.rcItem.Right
        SUB      ECX, EAX
        PUSH     ECX // W -> [EBP-24]
        MOVZX    ECX, [EDI].TControl.fGlyphLayout
        PUSH     EBX
        INC      ECX
        LOOP     @@noGlyphLeft
        MOV      EBX, EAX      // X
        ADD      EBX, [EBP-16] // +OutW
        MOV      [EBP+4].TRect.Left, EBX // TxRect.Left = X+OutW
        JMP      @@centerY
@@noGlyphLeft:
        LOOP     @@noGlyphTop
        MOV      EBX, EDX      // Y
        ADD      EBX, [EBP-12] // +OutH
        MOV      [EBP+4].TRect.Top, EBX // TxRect.Top = Y+OutH
        LOOP     @@centerX // always JMP, ECX := -1
@@noGlyphTop:
        LOOP     @@noGlyphRight
        MOV      EAX, [ESI].TDrawItemStruct.rcItem.Right
        SUB      EAX, [EBP-16] // -OutW -> X
        MOV      [EBP+4].TRect.Right, EAX
@@centerY:
        MOV      EBX, [EBP-20] // H
        SUB      EBX, [EBP-12] // -OutH
        JLE      @@noGlyphRight
        SAR      EBX, 1
        ADD      EDX, EBX      // Y = Y + (H-OutH)/2
@@noGlyphRight:
        LOOP     @@noGlyphBottom
        MOV      EDX, [ESI].TDrawItemStruct.rcItem.Bottom
        SUB      EDX, [EBP-12] // -OutH -> Y
        MOV      [EBP+4].TRect.Bottom, EDX
        LOOP     @@centerX // always JMP, ECX := -1
@@noGlyphBottom:
        LOOP     @@noGlyphOver
@@centerX:
        MOV      EBX, [EBP-24] // W
        SUB      EBX, [EBP-16] // -OutW
        SHR      EBX, 1        // /2
        ADD      EAX, EBX      // +EAX, X = X + (W-OutW)/2
        JECXZ    @@centerY
@@noGlyphOver:
        MOV      ECX, [ESI].TDrawItemStruct.rcItem.Left
        CMP      EAX, ECX
        JGE      @@ok1
        XCHG     EAX, ECX
@@ok1:  CMP      EDX, [ESI].TDrawItemStruct.rcItem.Top
        {$IFDEF USE_CMOV}
        CMOVL    EDX, [ESI].TDrawItemStruct.rcItem.Top
        {$ELSE}
        JGE      @@ok2
        MOV      EDX, [ESI].TDrawItemStruct.rcItem.Top
@@ok2:  {$ENDIF}

        MOV      ECX, [ESI].TDrawItemStruct.rcItem.Right
        SUB      ECX, EAX
        CMP      [EBP-16], ECX
        JLE      @@ok3
        MOV      [EBP-16], ECX // OutW := rcItem.Right - X;
@@ok3:  MOV      ECX, [ESI].TDrawItemStruct.rcItem.Bottom
        SUB      ECX, EDX
        CMP      ECX, [EBP-12]
        JGE      @@ok4
        MOV      [EBP-12], ECX // OutH := rcItem.Bottom - Y;
@@ok4:
        POP      EBX // EBX = G
        TEST     byte ptr [EDI].TControl.fBitBtnOptions, 1 //1 shl Ord(bboImageList)
        JZ       @@draw_bitmap
        MOVZX    ECX, word ptr [EDI].TControl.fGlyphCount
        CMP      word ptr [EDI].TControl.fGlyphCount + 2, BX
        JLE      @@no_add_glyphIdx
        ADD      ECX, EBX
@@no_add_glyphIdx:
        XOR      EBX, EBX
        PUSH     ILD_TRANSPARENT // Flags = 1 (ILD_TRANSPARENT)
        PUSH     EBX // Blend = 0
        PUSH     -1  // Bk = CLR_NONE
        PUSH     EBX // 0
        PUSH     EBX // 0
        PUSH     EDX
        PUSH     EAX
        PUSH     [ESI].TDrawItemStruct.hDC
        PUSH     ECX
        PUSH     [EDI].TControl.fGlyphBitmap
        CMP      [EDI].TControl.fTransparent, BL
        JNZ      @@imgl_transp
        MOV      EAX, [EDI].TControl.fColor
        CALL     Color2RGB
        MOV      [ESP+32], EAX // Bk = Color2RGB(fColor)
        MOV      [ESP+40], EBX // Flags = 0
@@imgl_transp:
        INC      EBX
        CMP      word ptr [EDI].TControl.fGlyphCount + 2, BX
        JNZ      @@draw_imagelist
        DEC      byte ptr [ESP+36+3] // $FF, CLR_DEFAULT = $FF000000
        TEST     byte ptr [ESI].TDrawItemStruct.itemState, ODS_FOCUS
        JZ       @@draw_imagelist
        OR       byte ptr [ESP+40], ILD_BLEND25 // Flags != 2
@@draw_imagelist:
        CALL     ImageList_DrawEx
        JMP      @@glyph_drawn

@@draw_bitmap:
        PUSH     EAX // PlaceHold for DC
        PUSH     EAX // PlaceHold for OldBmp
        PUSH     SRCCOPY
        PUSH     dword ptr [EBP-4] // ImgH
        PUSH     dword ptr [EBP-8] // ImgW
        PUSH     0
        PUSH     EAX // PlaceHold for I
        PUSH     EAX // PlaceHold for DC
        PUSH     dword ptr [EBP-12] // OutH
        PUSH     dword ptr [EBP-16] // OutW
        PUSH     EDX // Y
        PUSH     EAX // X
        PUSH     [ESI].TDrawItemStruct.hDC

        PUSH     0
        CALL     CreateCompatibleDC
        MOV      [ESP+48], EAX // save DC
        MOV      [ESP+20], EAX // place DC
        PUSH     [EDI].TControl.fGlyphBitmap
        PUSH     EAX
        CALL     SelectObject
        MOV      [ESP+44], EAX // save OldBitmap
        XOR      EAX, EAX
        CMP      [EDI].TControl.fGlyphCount, EBX
        JLE      @@no_incGlyIdx
        MOV      EAX, [EBP-8] // ImgW
        IMUL     EBX
@@no_incGlyIdx:
        MOV      [ESP+24], EAX // place I
        CALL     StretchBlt
        CALL     FinishDC

@@glyph_drawn:
        MOV      ESP, EBP
        POP      EBP

@@noglyph:
        TEST     byte ptr[EDI].TControl.fBitBtnOptions, 4 //1 shl Ord(bboNoCaption)
        JNZ      @@noCaption

        POP      EAX
        PUSH     EAX
        MOV      EDX, [ESP].TRect.Right
        CMP      EDX, EAX
        JLE      @@noCaption
        MOV      EDX, [ESP].TRect.Bottom
        CMP      EDX, [ESP].TRect.Top
        JLE      @@noCaption

        XOR      EBX, EBX
        PUSH     EBX                      // > CapText
        MOV      EDX, ESP
        MOV      EAX, EDI
        CALL     TControl.GetCaption
        PUSH     EBX                      // > Bk
        PUSH     EBX                      // > Blend
        CMP      [EDI].TControl.fTransparent, BL
        MOV      BL, ETO_CLIPPED
        JNZ      @@drwTxTransparent
        CMP      [EDI].TControl.fGlyphLayout, glyphOver
        JNZ      @@drwTxOpaque
@@drwTxTransparent:
        PUSH     TRANSPARENT
        PUSH     [ESI].TDrawItemStruct.hDC
        CALL     SetBkMode
        MOV      [ESP+4], EAX // Bk := SetBkMode( DIS.hDC, TRANSPARENT )
        JMP      @@drwTx1
@@drwTxOpaque:
        MOV      BL, ETO_CLIPPED or ETO_OPAQUE
        MOV      EAX, [EDI].TControl.fColor
        CALL     Color2RGB
        PUSH     EAX
        PUSH     [ESI].TDrawItemStruct.hDC
        CALL     SetBkColor
        POP      ECX
        PUSH     EAX // Blend := SetBkColor(DIS.hDC,fColor)
@@drwTx1:
        PUSH     0   // > OldFont
        PUSH     0   // > OldTextColor

        PUSH     0                 // push <nil>
        MOV      EDX, [ESP+20] // CapText
        CALL     EDX2PChar
        PUSH     dword ptr [EDX-4] // push Length(CapText)
        PUSH     EDX               // push PChar(CapText)
        LEA      EAX, [ESP+32]
        PUSH     EAX               // push @TxRect
        PUSH     EBX               // push Flags

        MOV      EBX, [ESI].TDrawItemStruct.hDC

        MOV      ECX, [EDI].TControl.fFont
        JECXZ    @@drwTx_noFont
        XCHG     EAX, ECX
        CALL     TGraphicTool.GetHandle
        PUSH     EAX
        PUSH     EBX
        CALL     SelectObject
        MOV      [ESP+24], EAX // OldFont := SelectObject...
@@drwTx_noFont:
        MOV      EAX, [EDI].TControl.fTextColor
        CALL     Color2RGB
        PUSH     EAX
        PUSH     EBX
        CALL     SetTextColor
        MOV      [ESP+20], EAX // OldTextColor := SetTextColor...

        PUSH     EAX
        PUSH     EAX
        PUSH     ESP
        MOV      ECX, [ESP+48] // ECX = CapText
        XOR      EAX, EAX
        JECXZ    @@drwTx0
        MOV      EAX, [ECX-4]  // EAX = Length(CapText)
@@drwTx0:
        PUSH     EAX
        PUSH     ECX
        PUSH     EBX
        CALL     GetTextExtentPoint32
        POP      ECX // ECX = TextSz.cx
        POP      EDX // EDX = TextSz.cy
        MOV      EAX, [ESP+40].TRect.Bottom
        SUB      EAX, [ESP+40].TRect.Top
        SUB      EAX, EDX
        JGE      @@yOk
        XOR      EAX, EAX
@@yOk:  SHR      EAX, 1
        ADD      EAX, [ESP+40].TRect.Top
        PUSH     EAX                      // push Y
        MOV      EDX, [ESP+44].TRect.Right
        MOV      EAX, [ESP+44].TRect.Left // EAX = TxRect.Left
        SUB      EDX, EAX // EDX = W
        PUSH     EAX
        CMP      [EDI].TControl.fTextAlign, taRight
        JL       @@chk_X
        JE       @@alignR
        SUB      ECX, EDX
        SAR      ECX, 1
        JMP      @@alignC
@@alignR:
        ADD      EAX, EDX
@@alignC:
        SUB      EAX, ECX
@@chk_X:POP      EDX
        CMP      EAX, EDX
        JGE      @@xOk
        XCHG     EAX, EDX
@@xOk:  PUSH     EAX                      // push X
        PUSH     EBX                      // push hDC
        CALL     ExtTextOut

        PUSH     EBX
        CALL     SetTextColor
        POP      ECX
        JECXZ    @@noRestoreFont
        PUSH     ECX
        PUSH     EBX
        CALL     SelectObject
@@noRestoreFont:
        POP      ECX // Blend
        JECXZ    @@restoreBk
        PUSH     ECX
        PUSH     EBX
        CALL     SetBkColor
        POP      ECX
        JMP      @@delCaption
@@restoreBk:
        PUSH     EBX
        CALL     SetBkMode
@@delCaption:
        CALL     RemoveStr

@@noCaption:
        ADD      ESP, 16

@@exit_draw:
        POP      ESI
        POP      EDI
        POP      EBX
        MOV      AL, 1
        RET

@@noCN_DRAWITEM:
        CMP      word ptr [EDX].TMsg.message, WM_LBUTTONDOWN
        JZ       @@doDown
        CMP      word ptr [EDX].TMsg.message, WM_KEYDOWN
        JNZ      @@noWM_LBUTTONDOWN
        CMP      [EDX].TMsg.wParam, 32
        JNZ      @@noWM_LBUTTONDOWN
@@doDown:
        PUSH     EDX
        XCHG     EBX, EAX

        CALL     @@fixed_proc
        MOV      ECX, [EBX].TControl.fRepeatInterval
        JECXZ    @@exit_LBUTTONDOWN
        POP      EDX
        PUSH     EDX
        CMP      word ptr [EDX].TMsg.message, WM_KEYDOWN
        JZ       @@not_SetTimer
        PUSH     0
        PUSH     [EBX].TControl.fRepeatInterval
        PUSH     1
        PUSH     [EBX].TControl.fHandle
        CALL     SetTimer
@@exit_LBUTTONDOWN:
@@not_SetTimer:
        POP      EDX
        JMP      @@invalidate

@@noWM_LBUTTONDOWN:
        CMP      word ptr [EDX].TMsg.message, WM_LBUTTONUP
        JE       @@doKill1
        CMP      word ptr [EDX].TMsg.message, WM_KEYUP
        JNE      @@noWM_LBUTTONUP
        PUSH     1
        PUSH     [EBX].TControl.fHandle
        CALL     KillTimer

@@noWM_LBUTTONUP:
        CMP      word ptr [EDX].TMsg.message, WM_TIMER
        JNZ      @@noWM_TIMER

        XCHG      EBX, EAX
        PUSH     0
        PUSH     0
        PUSH     BM_GETSTATE
        PUSH     EBX
        CALL     TControl.Perform
        {$IFDEF PARANOIA} DB $A8, 4 {$ELSE} TEST AL, BST_PUSHED {$ENDIF}
        JNZ      @@pushed
        PUSH     1
        PUSH     [EBX].TControl.fHandle
        CALL     KillTimer
        CALL     ReleaseCapture
        JMP      @@noWM_TIMER
@@fixed_proc:
        TEST     byte ptr [EBX].TControl.fBitBtnOptions, 8 // bboFixed
        JZ       @@not_fixed
        {$IFDEF  USE_FLAGS}
        XOR      [EBX].TControl.fFlagsG4, 1 shl G4_Checked
        {$ELSE}
        XOR      [EBX].TControl.fChecked, 1
        {$ENDIF}
        MOV      ECX, [EBX].TControl.fOnChangeCtl.TMethod.Code
        {$IFDEF  NIL_EVENTS}
        JECXZ    @@not_fixed
        {$ENDIF}
        MOV      EAX, [EBX].TControl.fOnChangeCtl.TMethod.Data
        MOV      EDX, EBX
        JMP      ECX
@@pushed:
        CALL     @@fixed_proc
        MOV      EAX, EBX
        CALL     TControl.DoClick
@@invalidate:
        XCHG     EAX, EBX
        CALL     TControl.Invalidate
@@noWM_TIMER:
        XOR      EAX, EAX
        POP      EBX
@@not_fixed:
end;
{$ELSE PAS_VERSION} //Pascal
function WndProcBitBtn( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var DIS: PDrawItemStruct;
    IsDown, IsDefault, IsDisabled: Boolean;
    Flags: Integer;
    X, Y, W, H, ImgW, ImgH, OutW, OutH, I, G, Bk, Blend: Integer;
    TxRect, FocusRect: TRect;
    OldFont: HFont;
    OldTextColor: TColor;
    CapText, CapTxtOrig: KOLString;
    TextSz: TSize;
    DC: HDC;
    OldBmp: HBitmap;
    Handled: Boolean;
begin
  Result := False;
  if (Msg.message = WM_LBUTTONDBLCLK) then
  begin
    Rslt := Self_.Perform( WM_LBUTTONDOWN, Msg.wParam, Msg.lParam );
    Result := True; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  if (Msg.message = CN_DRAWITEM) then
  begin
    Result := True;
    Rslt := 1;
    DIS := Pointer( Msg.lParam );
    IsDown := (DIS.itemState and ODS_SELECTED <> 0) or
              {$IFDEF USE_FLAGS} (G4_Checked in Self_.fFlagsG4)
              {$ELSE} Self_.fChecked {$ENDIF};
    IsDefault := DIS.itemState and ODS_FOCUS <> 0;
    IsDisabled := DIS.itemState and ODS_DISABLED <> 0;
    G := 0;
    if IsDown     then G := {$IFDEF BITBTN_DISABLEDGLYPH2} 1 {$ELSE} 2 {$ENDIF};
    if IsDisabled then G := {$IFDEF BITBTN_DISABLEDGLYPH2} 2 {$ELSE} 1 {$ENDIF};
    if (G = 0) and IsDefault then G := 3;
    if ((G = 0) or (G = 3)) and Self_.MouseInControl then G := 4;
    {$IFDEF NIL_EVENTS}
    if Assigned( Self_.EV.fOnBitBtnDraw ) then
    {$ENDIF}
    begin
      if  ( Self_.fCanvas <> nil ) then
          Self_.fCanvas.SetHandle( DIS.hDC );
      Handled := Self_.EV.fOnBitBtnDraw( Self_, G );
      if  ( Self_.fCanvas <> nil ) then
          Self_.fCanvas.SetHandle( 0 );
      if  Handled then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
    if  not ( bboNoBorder in Self_.DF.fBitBtnOptions ) then
    begin
        if  IsDefault and not( bboFocusRect in Self_.DF.fBitBtnOptions ) then
        begin
            Windows.FrameRect( DIS.hDC, DIS.rcItem, GetStockObject( {BLACK_BRUSH} DKGRAY_BRUSH ) );
            InflateRect( DIS.rcItem, -1, -1 );
        end;
        if  {$IFDEF USE_FLAGS} G3_Flat in Self_.fFlagsG3
            {$ELSE} Self_.fFlat {$ENDIF} then
        begin
            if  IsDown then
                Flags := BDR_RAISEDINNER
            else
                Flags := 0; //EDGE_ETCHED;
            DrawEdge( DIS.hDC, DIS.rcItem, Flags, BF_FLAT or BF_RECT );
            //InflateRect( DIS.rcItem, -1, -1 );
        end;
        if  {$IFDEF USE_FLAGS} not(G3_Flat in Self_.fFlagsG3)
            {$ELSE} not Self_.fFlat {$ENDIF}
        or  {$IFDEF USE_FLAGS} (G3_MouseInCtl in Self_.fFlagsG3)
            {$ELSE} Self_.fMouseInControl {$ENDIF} or IsDefault then
        begin
            if  IsDown then
                Flags := BDR_SUNKENOUTER or BDR_SUNKENINNER
            else
                Flags := BDR_RAISEDOUTER or BDR_RAISEDINNER;
            DrawEdge( DIS.hDC, DIS.rcItem, Flags, BF_ADJUST or BF_RECT );
            InflateRect( DIS.rcItem, -1, -1 );
        end;
    end;
    TxRect := DIS.rcItem;
    if  Self_.DF.fGlyphBitmap <> 0 then
    begin
        ImgW := Self_.DF.fGlyphWidth;
        ImgH := Self_.DF.fGlyphHeight;
        if (ImgW > 0) and (ImgH > 0) then
        begin
          OutW := ImgW;
          OutH := ImgH;
          W := DIS.rcItem.Right - DIS.rcItem.Left;
          H := DIS.rcItem.Bottom - DIS.rcItem.Top;
          X := DIS.rcItem.Left;
          Y := DIS.rcItem.Top;
          if isDown and (Self_.DF.fGlyphLayout <> glyphOver) then
          begin
            Inc( X, Self_.TextShiftX );
            Inc( Y, Self_.TextShiftY );
          end;
          case Self_.DF.fGlyphLayout of
          glyphLeft:
            begin
              Y := Y + (H - OutH) div 2;
              TxRect.Left := X + OutW;
            end;
          glyphTop:
            begin
              X := X + (W - OutW) div 2;
              TxRect.Top := Y + OutH;
            end;
          glyphRight:
            begin
              X := DIS.rcItem.Right - OutW;
              TxRect.Right := X;
              Y := Y + (H - OutH) div 2;
            end;
          glyphBottom:
            begin
              Y := DIS.rcItem.Bottom - OutH;
              TxRect.Bottom := Y;
              X := X + (W - OutW) div 2;
            end;
          glyphOver:
            begin
              X := X + (W - OutW) div 2;
              Y := Y + (H - OutH) div 2;
            end;
          end;
          if X < DIS.rcItem.Left then
            X := DIS.rcItem.Left;
          if Y < DIS.rcItem.Top then
            Y := DIS.rcItem.Top;
          if X + OutW > DIS.rcItem.Right then
            OutW := DIS.rcItem.Right - X;
          if Y + OutH > DIS.rcItem.Bottom then
            OutH := DIS.rcItem.Bottom - Y;

          if bboImageList in Self_.DF.fBitBtnOptions then
            begin
              I := LoWord( Self_.DF.fGlyphCount );
              if (HiWord( Self_.DF.fGlyphCount ) > G) then
                 I := I + G;
              Flags := 0; // ILD_NORMAL
              Blend := 0;
              if  {$IFDEF USE_FLAGS} not( G2_Transparent in Self_.fFlagsG2 )
                  {$ELSE} not Self_.fTransparent {$ENDIF} then
                  Bk := Color2RGB( Self_.fColor )
              else
              begin
                  Bk := Integer(CLR_NONE);
                  Flags := ILD_TRANSPARENT;
              end;
              if HiWord( Self_.DF.fGlyphCount ) = 1 then
              begin
                Blend := Integer(CLR_DEFAULT);
                if IsDefault then
                  Flags := Flags or ILD_BLEND25;
              end;
              ImageList_DrawEx( Self_.DF.fGlyphBitmap, I, DIS.hDC, X, Y, 0, 0,
                Bk, Blend, Flags );
            end
          else
            begin
              DC := CreateCompatibleDC( 0 );
              OldBmp := SelectObject( DC, Self_.DF.fGlyphBitmap );

              I := 0;
              if Self_.DF.fGlyphCount > G then
                I := I + G * ImgW;
              StretchBlt( DIS.hDC, X, Y, OutW, OutH, DC, I, 0, ImgW, ImgH, SRCCOPY );

              SelectObject( DC, OldBmp );
              DeleteDC( DC );
            end;
        end;
    end;
    if not (bboNoCaption in Self_.DF.fBitBtnOptions) then
    if (TxRect.Right > TxRect.Left) and (TxRect.Bottom > TxRect.Top) then
    begin
      CapText := Self_.Caption;
      CapTxtOrig := CapText; /////////////////////////// added 19 Nov 2001
      if  Assigned( Self_.DF.FBitBtnGetCaption ) then
          CapText := Self_.DF.FBitBtnGetCaption( Self_, CapText ); ////////////
      Bk := 0;
      Blend := 0;
      Flags := ETO_CLIPPED;
      if  {$IFDEF USE_FLAGS} (G2_Transparent in Self_.fFlagsG2)
          {$ELSE} Self_.fTransparent {$ENDIF}
      or (Self_.DF.fGlyphLayout = glyphOver) then
          Bk := SetBkMode( DIS.hDC, TRANSPARENT )
      else
      begin
          Flags := Flags or ETO_OPAQUE;
          Blend := SetBkColor( DIS.hDC, Color2RGB( Self_.fColor ) );
      end; // Returned previous BkMode is either OPAQUE=1 or TRANSPARENT=2

      OldFont := 0;
      if  ( Self_.fFont <> nil ) then
          OldFont := SelectObject( DIS.hDC, Self_.fFont.Handle );
      OldTextColor := SetTextColor( DIS.hDC, Color2RGB( Self_.fTextColor ) );

      {$IFDEF UNICODE_CTRLS}Windows.GetTextExtentPoint32W
      {$ELSE}               Windows.GetTextExtentPoint32A
      {$ENDIF}( DIS.hDC, PKOLChar( CapText ), Length( CapText ),
        TextSz );
      W := TxRect.Right - TxRect.Left;
      H := TxRect.Bottom - TxRect.Top;
      Y := TxRect.Top + (H - TextSz.cy) div 2;
      case Self_.fTextAlign of
        taLeft: X := TxRect.Left;
        taCenter: X := TxRect.Left + (W - TextSz.cx) div 2;
        else {taRight:} X := TxRect.Right - TextSz.cx;
      end;
      if isDown then
      begin
        Inc( X, Self_.TextShiftX );
        Inc( Y, Self_.TextShiftY );
      end;
      if Y < 0 then
        Y := 0;
      if X < TxRect.Left then
        X := TxRect.Left;

      {$IFDEF UNICODE_CTRLS}
      Windows.ExtTextOutW( DIS.hDC, X, Y, Flags, @TxRect,
        PWideChar( CapText ), Length( CapText ), nil );
      {$ELSE}
      Windows.ExtTextOutA( DIS.hDC, X, Y, Flags, @TxRect,
        PAnsiChar( CapText ), Length( CapText ), nil );
      {$ENDIF}

      if bboFocusRect in Self_.DF.fBitBtnOptions then
      if IsDefault then
      begin
        FocusRect := TxRect;
        //InflateRect( FocusRect, 1, 1 );
        Windows.DrawFocusRect( DIS.hDC, FocusRect );
      end;

      //{$IFDEF NIL_EVENTS}
      if  Assigned( Self_.DF.FBitBtnExtDraw ) then // to provide underlying mnemonic characters
      //{$ENDIF}
          Self_.DF.FBitBtnExtDraw( Self_, DIS.hDC, X, Y, TxRect, CapText, CapTxtOrig,
                                   OldTextColor );  /////////////////////////////////

      SetTextColor( DIS.hDC, OldTextColor );
      if OldFont <> 0 then
        SelectObject( DIS.hDC, OldFont );

      if Blend = 0 then
        SetBkMode( DIS.hDC, Bk )
      else
        SetBkColor( DIS.hDC, Blend );
    end;
  end;
  if (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_KEYDOWN) and (Msg.wParam = 32) then
  begin
    if bboFixed in Self_.DF.fBitBtnOptions then
    begin
        {$IFDEF USE_FLAGS}
                if   G4_Checked in Self_.fFlagsG4 then
                     exclude( Self_.fFlagsG4, G4_Checked )
                else include( Self_.fFlagsG4, G4_Checked );
        {$ELSE} Self_.fChecked := not Self_.fChecked; {$ENDIF}
        {$IFDEF NIL_EVENTS}
        if  Assigned( Self_.EV.fOnChangeCtl ) then
        {$ENDIF}
            Self_.EV.fOnChangeCtl( Self_ );
    end;
    if Self_.DF.fRepeatInterval > 0 then
    begin
      if Msg.message <> WM_KEYDOWN then
        SetTimer( Self_.fHandle, 1, 400, nil );
      Self_.Invalidate;
    end;
  end;

  if Msg.message = WM_LBUTTONUP then
  begin
    if Self_.DF.fRepeatInterval > 0 then
      KillTimer( Self_.fHandle, 1 );
  end;

  if Msg.message = WM_KILLFOCUS then // to repaint when focus lost
    Self_.Invalidate;

  if Msg.message = WM_TIMER then
  begin
    KillTimer( Self_.fHandle, 1 );
    if bboFixed in Self_.DF.fBitBtnOptions then
    begin
        {$IFDEF USE_FLAGS}
                if   G4_Checked in Self_.fFlagsG4 then
                     exclude( Self_.fFlagsG4, G4_Checked )
                else include( Self_.fFlagsG4, G4_Checked );
        {$ELSE} Self_.fChecked := not Self_.fChecked; {$ENDIF}
        {$IFDEF NIL_EVENTS}
        if  Assigned( Self_.EV.fOnChangeCtl ) then
        {$ENDIF}
            Self_.EV.fOnChangeCtl( Self_ );
    end;
    Self_.DoClick;
    SetTimer( Self_.fHandle, 1, Self_.DF.fRepeatInterval, nil );
    Self_.Invalidate;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF USE_CONSTRUCTORS}
function NewBitBtn( AParent: PControl; const Caption: AnsiString;
         Options: TBitBtnOptions; Layout: TGlyphLayout; GlyphBitmap: HBitmap;
         GlyphCount: Integer ): PControl;
begin
  new( Result, CreateBitBtn( AParent, Caption, Options, Layout, GlyphBitmap, GlyphCount ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:BitBtn';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_noVERSION} // todo: first correct asm version, then remove <no>
{$ELSE PAS_VERSION} //Pascal
function NewBitBtn( AParent: PControl; const Caption: KOLString;
         Options: TBitBtnOptions; Layout: TGlyphLayout; GlyphBitmap: HBitmap;
         GlyphCount: Integer ): PControl;
var
    B: TBitmapInfo;
    W, H: Integer;
    f: DWORD;
begin
  f := WS_VISIBLE or WS_CHILD or BS_OWNERDRAW or WS_TABSTOP or BS_NOTIFY;
  Result := _NewControl( AParent, 'BUTTON', f, False,
         {$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed
         {$ELSE}                      @ButtonActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:BitBtn';
  {$ENDIF}
  {$IFDEF USE_FLAGS}
          Result.fFlagsG5 := Result.fFlagsG5 +
                          [G5_IsButton, G5_IsBitBtn, G5_IgnoreDefault];
  {$ELSE} Result.fIsButton := TRUE;
          Result.fIsBitBtn := TRUE;
          Result.fIgnoreDefault := TRUE;
  {$ENDIF}
  Result.aAutoSzX := 8;
  Result.aAutoSzY := 8;
  Result.DF.fBitBtnOptions := Options;
  Result.DF.fGlyphLayout := Layout;
  Result.DF.fGlyphBitmap := GlyphBitmap;
  with Result.fBoundsRect do
  begin
      Bottom := Top + 22;
      W := 0; H := 0;
      if  GlyphBitmap <> 0 then
      begin
          if  bboImageList in Options then
              ImageList_GetIconSize( GlyphBitmap, W, H )
          else
          begin
              if  GetObject( GlyphBitmap, Sizeof(B), @B ) > 0 then
              begin
                  W := B.bmiHeader.biWidth;
                  H := B.bmiHeader.biHeight;
                  if  GlyphCount = 0 then
                      GlyphCount := W div H;
                  if  GlyphCount > 1 then
                      W := W div GlyphCount;
              end;
          end;
          if  W > 0 then
          begin
              if  (Caption = '') or (Layout = glyphOver) then
              begin
                  Right := Left + W;
                  Result.aAutoSzX := 0;
              end
                else
              if  Layout in [ glyphLeft, glyphRight ] then
              begin
                  Right := Right + W;
                  Inc( Result.aAutoSzX, W );
              end;
          end;
          if H > 0 then
          begin
              if  Layout in [ glyphTop, glyphBottom ] then
              begin
                  Bottom := Bottom + H;
                  Inc( Result.aAutoSzY, H );
              end
                else
              begin
                  Bottom := Top + H;
                  Result.aAutoSzY := 0;
              end;
          end;
          if  not ( bboNoBorder in Options ) then
          begin
              if W > 0 then
              begin
                Inc( Right, 4 );
                if  Result.aAutoSzX > 0 then
                    Inc( Result.aAutoSzX, 4 );
              end;
              if  H > 0 then
              begin
                  Inc( Bottom, 4 );
                  if  Result.aAutoSzY > 0 then
                      Inc( Result.aAutoSzY, 4 );
              end;
          end;
      end;
      Result.DF.fGlyphWidth := W;
      Result.DF.fGlyphHeight := H;
  end;
  Result.DF.fGlyphCount := GlyphCount;
  if  AParent <> nil then
      AParent.AttachProc( WndProc_DrawItem );
  Result.AttachProc( WndProcBitBtn );
  Result.fTextAlign := taCenter;
  Result.Caption := Caption;
  {$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER}
  Result.AttachProc( WndProcBtnReturnClick );
  {$ENDIF}

 {$IFDEF GRAPHCTL_XPSTYLES}
  Attach_WM_THEMECHANGED(Result, XP_Themes_For_BitBtn);
 {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//===================== Check box ========================//

{$IFDEF USE_CONSTRUCTORS}
function NewCheckbox( AParent: PControl; const Caption: AnsiString ): PControl;
begin
  new( Result, CreateCheckbox( AParent, Caption ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:CheckBox';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewCheckbox( AParent: PControl; const Caption: KOLString ): PControl;
begin
  Result := NewButton( AParent, Caption );
  with Result.fBoundsRect do
  begin
    Right := Left + 72;
  end;
  Result.fStyle.Value := WS_VISIBLE or WS_CHILD or
            BS_AUTOCHECKBOX or WS_TABSTOP or BS_NOTIFY;
  Result.aAutoSzX := 24;

{$IFDEF GRAPHCTL_XPSTYLES}
  Attach_WM_THEMECHANGED(Result, XP_Themes_For_CheckBox );
{$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

function NewCheckBox3State( AParent: PControl; const Caption: KOLString ): PControl;
begin
  Result := NewCheckbox( AParent, Caption );
  Result.fStyle.Value := Result.fStyle.Value and not BS_AUTOCHECKBOX or BS_AUTO3STATE;
end;

//===================== Radiobox ========================//

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure ClickRadio( Sender:PObj );
var Self_:PControl;
    {$IFDEF USE_FLAGS}
    i: Integer;
    C: PControl;
    NewState: Boolean;
    {$ENDIF}
begin
  Self_ := PControl( Sender );
  if Self_.FParent <> nil then
  {$IFDEF USE_FLAGS}
  begin
      for i := 0 to Self_.FParent.ChildCount-1 do
      begin
          C := Self_.FParent.Children[i];
          if  G5_IsButton in C.fFlagsG5 then
          if  C.fStyle.f0_Style and BS_RADIOBUTTON <> 0 then
          begin
              NewState := C = Self_;
              if  NewState <> C.Checked then
                  C.Checked := NewState;
          end;
      end;
  end;
  {$ELSE}
    CheckRadioButton( Self_.fParent.fHandle,
                      Self_.fParent.PropInt[ @RADIO_1ST ],
                      Self_.fParent.PropInt[ @RADIO_LAST ],
                      Self_.fMenu );
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$IFDEF USE_CONSTRUCTORS}
function NewRadiobox( AParent: PControl; const Caption: AnsiString ): PControl;
begin
  new( Result, CreateRadiobox( AParent, Caption ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Radiobox';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewRadiobox( AParent: PControl; const Caption: KOLString ): PControl;
begin
  Result := NewCheckbox( AParent, Caption );
  Result.fStyle.Value := WS_VISIBLE or WS_CHILD or
            BS_RADIOBUTTON or WS_TABSTOP or WS_GROUP or BS_NOTIFY;
  Result.PP.fControlClick := ClickRadio;
  if AParent <> nil then
  begin
    {$IFDEF USE_FLAGS}
    if  not(G1_HasRadio in AParent.fFlagsG1) then
    begin
        include( AParent.fFlagsG1, G1_HasRadio );
        Result.SetRadioChecked;
    end;
    {$ELSE}
    AParent.PropInt[ @RADIO_LAST ] := Result.fMenu;
    if AParent.PropInt[ @RADIO_1ST ] = 0 then
    begin
       AParent.PropInt[ @RADIO_1ST ] := Result.fMenu;
       Result.SetRadioChecked;
    end;
    {$ENDIF}
  end;
{$IFDEF GRAPHCTL_XPSTYLES}
  Attach_WM_THEMECHANGED(Result, XP_Themes_For_RadioBox);
{$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//===================== Label ========================//

{$ENDIF WIN_GDI}
{$IFNDEF USE_CONSTRUCTORS}
{$ENDIF not USE_CONSTRUCTORS}
{$IFDEF USE_CONSTRUCTORS}
function NewLabel( AParent: PControl; const Caption: AnsiString ): PControl;
begin
  new( Result, CreateLabel( AParent, Caption ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Label';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF GDI}
{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function NewLabel( AParent: PControl; const Caption: KOLString ): PControl;
begin
  Result := _NewControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD or
                         SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY,
                         False, {$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed
                                {$ELSE} @LabelActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Label';
  {$ENDIF}
  Result.aAutoSzX := 1;
  Result.aAutoSzY := 1;
  {$IFDEF USE_FLAGS}
          Result.fFlagsG1 := Result.fFlagsG1 + [G1_SizeRedraw, G1_IsStaticControl];
  {$ELSE} Result.fSizeRedraw := True;
          Inc( Result.fIsStaticControl );
  {$ENDIF}
  with Result.fBoundsRect do
      Bottom := Top + 22; //Right := Left + 64 {done in _NewControl};
  Result.Caption := Caption;
{$IFDEF GRAPHCTL_XPSTYLES}
  Attach_WM_THEMECHANGED(Result, XP_Themes_For_Label);
{$ENDIF}
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}

{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE LabelSetTextAlign( Self_: PControl );
BEGIN
  gtk_misc_set_alignment( GTK_MISC( Self_.fCaptionHandle ), HorAlignments[ Self_.fTextAlign ],
    VerAlignments[ Self_.fVerticalAlign ] );
END;

FUNCTION NewLabel( AParent: PControl; const Caption: KOLString ): PControl;
BEGIN
  Result := _NewControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD or
                         SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY,
                         False, gtk_label_new( PAnsiChar( String( Caption ) ) ),
                         TRUE );
  Result.fGetCaption := getLabelCaption;
  Result.fSetCaption := setLabelCaption;
  {$IFDEF USE_FLAGS} include( Result.fFlagsG1, G1_IsStaticControl );
  {$ELSE}            Inc( Result.fIsStaticControl ); {$ENDIF}
  Result.fSetTextAlign := LabelSetTextAlign;
  Result.fTextAlign := taCenter;
  Result.TextAlign := taLeft;
END;
{$ENDIF GTK}
{$ENDIF _X_}
{$ENDIF USE_CONSTRUCTORS}

{$IFDEF WIN_GDI}
//===================== word wrap Label ========================//

{$IFDEF USE_CONSTRUCTORS}
function NewWordWrapLabel( AParent: PControl; const Caption: AnsiString ): PControl;
begin
  new( Result, CreateWordWrapLabel( AParent, Caption ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:WordWrapLabel';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewWordWrapLabel( AParent: PControl; const Caption: KOLString ): PControl;
begin
  Result := NewLabel( AParent, Caption );
  {$IFDEF USE_FLAGS} include( Result.fFlagsG1, G1_WordWrap );
  {$ELSE} Result.fWordWrap := TRUE; {$ENDIF}
  with Result.fBoundsRect do
  begin
      Bottom := Top + 44;
  end;
  Result.fStyle.Value := Result.fStyle.Value and not SS_LEFTNOWORDWRAP;
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//===================== Label Effect ========================//

{$IFDEF USE_CONSTRUCTORS}
function NewLabelEffect( AParent: PControl; const Caption: AnsiString; ShadowDeep: Integer ): PControl;
begin
  new( Result, CreateLabelEffect( AParent, Caption, ShadowDeep ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:LabelEffect';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewLabelEffect( AParent: PControl; const Caption: KOLString; ShadowDeep: Integer ): PControl;
begin
  Result := NewLabel( AParent, '' );
  {$IFDEF USE_FLAGS} exclude( Result.fFlagsG1, G1_IsStaticControl );
  {$ELSE} Dec( Result.fIsStaticControl ); { ñíîâà 0 ! } {$ENDIF}
  Result.AttachProc( WndProcLabelEffect );
  Result.Caption := Caption;
  Result.AttachProc( WndProcDoEraseBkgnd );
  Result.fTextAlign := taCenter;
  Result.fTextColor := clWindowText;
  Result.DF.fShadowDeep := ShadowDeep;
  {$IFDEF USE_FLAGS} include( Result.fFlagsG1, G1_IgnoreWndCaption );
  {$ELSE}  Result.fIgnoreWndCaption := True; {$ENDIF}
  with Result.fBoundsRect do
  begin
    Bottom := Top + 40;
  end;
  Result.DF.fColor2 := clNone;
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//===================== Paint box ========================//
{$ENDIF WIN_GDI}
{$IFDEF USE_CONSTRUCTORS}
function NewPaintbox( AParent: PControl ): PControl;
begin
  new( Result, CreatePaintBox( AParent ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Paintbox';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF GDI}

{$UNDEF ASM_LOCAL}
{$IFNDEF GRAPHCTL_XPSTYLES}
  {$IFDEF ASM_VERSION}
    {$DEFINE ASM_LOCAL}
  {$ENDIF PAS_VERSION}
{$ENDIF  GRAPHCTL_XPSTYLES}

{$IFDEF ASM_LOCAL}
function NewPaintbox( AParent: PControl ): PControl;
asm
        XOR      EDX, EDX
        CALL     NewLabel
        ADD      [EAX].TControl.fBoundsRect.Bottom, 64-22
end;
{$ELSE ASM_LOCAL} //Pascal
function NewPaintbox( AParent: PControl ): PControl;
begin
{$IFDEF GRAPHCTL_XPSTYLES}
  Result := _NewControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD {or
                         SS_LEFTNOWORDWRAP or SS_NOPREFIX }or SS_NOTIFY,
                         False, {$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed
                                {$ELSE} @LabelActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:PaintBox';
  {$ENDIF}
  {$IFDEF USE_FLAGS}
          include( Result.fFlagsG1, G1_SizeRedraw );
          if   G2_Transparent in Result.fFlagsG2 then
               include( Result.fFlagsG2, G2_ClassicTransparent )
          else exclude( Result.fFlagsG2, G2_ClassicTransparent );
  {$ELSE} Result.fSizeRedraw := True;
          Result.fClassicTransparent := Result.fTransparent;
  {$ENDIF}
  Result.fControlClassName := 'obj_PAINT';
{$ELSE}
  Result := NewLabel( AParent, '' );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Paintbox';
  {$ENDIF}
  with Result.fBoundsRect do
  begin
    Bottom := Top + 64; //Right := Left + 64 {done in NewLabel};
  end;
{$ENDIF}
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}

{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION NewPaintbox( AParent: PControl ): PControl;
BEGIN
  Result := NewLabel( AParent, '' );
  Result.Height := 64;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$ENDIF USE_CONSTRUCTORS}
{$IFDEF WIN_GDI}

{$IFDEF _D2}
function SetBrushOrgEx(DC: HDC; X, Y: Integer; PrevPt: PPoint): BOOL; stdcall;
external gdi32 name 'SetBrushOrgEx';
{$ENDIF}

{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION PAS_VERSION}
function WndProcDoEraseBkgnd( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var DC: HDC;
    R: TRect;
begin
  Result := FALSE;
  if Msg.message = WM_ERASEBKGND then
  begin
    Self_.CreateChildWindows;
    if Self_.Transparent then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    DC := Msg.wParam;
    SetBkMode( DC, OPAQUE );
    SetBkColor( DC, Color2RGB( Self_.fColor ) );
    SetBrushOrgEx( DC, 0, 0, nil );
    GetClientRect( Self_.fHandle, R );
    Windows.FillRect( DC, R, Global_GetCtlBrushHandle( Self_ ) );
    Rslt := 1;
  end;
end;
{$ENDIF PAS_VERSION}

function WndProcImageShow( Sender: PControl; var Msg: TMsg;
         var Rslt: Integer ): Boolean;
var PaintStruct: TPaintStruct;
    IL: PImageList;
    OldPaintDC: HDC;
    {$IFDEF TEST_IL}
    B: PBitmap;
    {$ENDIF TEST_IL}
begin
  Result := FALSE;
  if (Msg.message = WM_PAINT) or (Msg.message = WM_PRINT) then
  begin
      OldPaintDC := Sender.fPaintDC;
      Sender.fPaintDC := Msg.wParam;
      if Sender.fPaintDC = 0 then
        Sender.fPaintDC := BeginPaint( Sender.fHandle, PaintStruct );
      IL := Sender.ImageListNormal;
      if IL <> nil then
      begin
          IL.DrawingStyle := [ dsTransparent ];
          {$IFDEF TEST_IL}
          B := NewBitmap( 0, 0 );
          B.Handle := IL.GetBitmap;
          B.SaveToFile( GetStartDir + 'test_IL_show.bmp' );
          B.ReleaseHandle;
          B.Free;
          {$ENDIF TEST_IL}
          IL.Draw( Sender.fCurIndex, Sender.fPaintDC, Sender.fClientLeft, Sender.fClientTop );
          Result := TRUE;
      end;
      if  Msg.wParam = 0 then
          EndPaint( Sender.fHandle, PaintStruct );
      Sender.fPaintDC := OldPaintDC;
      Rslt := 0; {Result := True;} Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
end;

function NewImageShow( AParent: PControl; AImgList: PImageList;
         ImgIdx: Integer ): PControl;
var W, H: Integer;
begin
  Result := NewLabel( AParent, '' );
  Result.ImageListNormal := AImgList;
  Result.AttachProc( WndProcImageShow );
  Result.AttachProc( WndProcDoEraseBkgnd );
  W := 32; H := 32;
  if AImgList <> nil then
  begin
    W := AImgList.ImgWidth;
    H := AImgList.ImgHeight;
  end;
  with Result.fBoundsRect do
  begin
    Right := Left + W;
    Bottom := Top + H;
  end;
  Result.CurIndex := ImgIdx;
end;

//===================== Scrollbar ========================//
const
  KSB_INITIALIZE = WM_USER + 10000;
  KSB_KEY = $3232;

function WndProcScrollBarParent( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var
  Bar: PControl;
  SI: TScrollInfo;
  NewPos: Integer;
  AllowChange: Boolean;
  Cmd: Word;

begin
  Result := False;
  case Msg.message of
    WM_HSCROLL, WM_VSCROLL:
    if (Msg.lParam <> 0) then begin
      {$IFDEF USE_PROP}
      Bar := Pointer(GetProp(Msg.lParam, ID_SELF));
      {$ELSE}
      Bar := Pointer( GetWindowLong( Msg.lParam, GWL_USERDATA ) );
      {$ENDIF}
      if (Bar <> nil) then begin
        ZeroMemory(@SI, SizeOf(SI));
        SI.cbSize := SizeOf(SI);
        SI.fMask := SIF_RANGE or SIF_POS or SIF_TRACKPOS or SIF_PAGE;
        Bar.SBGetScrollInfo(SI);

       Cmd := Msg.wParam and $0000FFFF;
       case Cmd of
         SB_BOTTOM: NewPos := SI.nMax;
         SB_TOP: NewPos := SI.nMin;
         SB_LINEDOWN: NewPos := SI.nPos + 1;
         SB_LINEUP: NewPos := SI.nPos - 1;
         SB_PAGEDOWN: NewPos := SI.nPos + Integer(SI.nPage);
         SB_PAGEUP: NewPos := SI.nPos - Integer(SI.nPage);
         {!ecm}
         SB_THUMBPOSITION,SB_THUMBTRACK: NewPos := SI.nTrackPos;
         SB_ENDSCROLL: NewPos := SI.nPos;
         {/!ecm}
         else Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
       end;

        if (NewPos > SI.nMax - Integer(SI.nPage) + 1) then
          NewPos := SI.nMax - Integer(SI.nPage) + 1;
        if (NewPos < SI.nMin) then
          NewPos := SI.nMin;

        AllowChange := True;
        {$IFDEF NIL_EVENTS}
        if  Assigned(Bar.EV.fOnSBBeforeScroll) then
        {$ENDIF}
            Bar.EV.fOnSBBeforeScroll(Bar, SI.nPos, NewPos, Cmd, AllowChange);
        if  AllowChange then
            SI.nPos := NewPos
        else
            SI.nTrackPos := SI.nPos;
        Bar.DF.fSBPosition := SI.nPos;
        Bar.DF.fSBPosition := Bar.SBSetScrollInfo(SI);
        if  AllowChange
        {$IFDEF NIL_EVENTS} and Assigned(Bar.EV.fOnSBScroll) {$ENDIF} then
            Bar.EV.fOnSBScroll(Bar, Cmd);
      end;
    end;
  end;
end;

function NewScrollBar( AParent: PControl; BarSide: TScrollerBar ): PControl;
const SBS_Directions: array[ TScrollerBar ] of DWORD = ( SBS_HORZ or SBS_BOTTOMALIGN,
     SBS_VERT or SBS_RIGHTALIGN );
begin
   Result := _NewCommonControl( AParent, 'SCROLLBAR',
   WS_VISIBLE or WS_CHILD or SBS_Directions[ BarSide ],
   False, {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS )
          {$ELSE} nil {$ENDIF} );
   {$IFDEF DEBUG_OBJKIND}
   Result.fObjKind := 'TControl:ScrollBar';
   {$ENDIF}
   {!ecm} Result.GetWindowHandle; {/!ecm}
   Result.DetachProc(WndProcCtrl);
   Result.fLookTabKeys := [tkTab];

   //#ecm  Result.AttachProc(WndProcScrollBar);
   AParent.AttachProc(WndProcScrollBarParent);
end;

//===================== Scrollbox ========================//
function WndProcScrollBox( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Bar: DWORD;
    SI: TScrollInfo;
    OldNotifyProc: pointer;
begin

  case Msg.message of
  WM_HSCROLL: Bar := SB_HORZ;
  WM_VSCROLL: Bar := SB_VERT;
  WM_SIZE: begin
              {$IFDEF NIL_EVENTS}
              if  Assigned( Sender.PP.fNotifyChild ) then
              {$ENDIF}
                  Sender.PP.fNotifyChild( Sender, nil );
              Result := FALSE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
           end;
  else Result := FALSE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;

  SI.cbSize := Sizeof( SI );
  SI.fMask := SIF_RANGE or SIF_POS or SIF_PAGE or
              {$IFDEF F_P}$10{$ELSE}SIF_TRACKPOS{$ENDIF};
  GetScrollInfo( Sender.fHandle, Bar, SI );
  SI.fMask := SIF_POS;
  case LoWord( Msg.wParam ) of
  SB_BOTTOM:    SI.nPos := SI.nMax;
  SB_TOP:       SI.nPos := SI.nMin;
  SB_LINEDOWN:  Inc( SI.nPos, Sender.DF.fScrollLineDist[ Bar ] );
  SB_LINEUP:    Dec( SI.nPos, Sender.DF.fScrollLineDist[ Bar ] );
  SB_PAGEDOWN:  Inc( SI.nPos, Max( SI.nPage, 1 ) );
  SB_PAGEUP:    Dec( SI.nPos, Max( SI.nPage, 1 ) );
  SB_THUMBTRACK:SI.nPos := SI.nTrackPos;
  end;
  if SI.nPos > SI.nMax { - Integer( SI.nPage ) } then
    SI.nPos := SI.nMax { - Integer( SI.nPage ) };
  if SI.nPos < SI.nMin then
    SI.nPos := SI.nMin;
  SetScrollInfo( Sender.fHandle, Bar, SI, TRUE );

  {$IFDEF NIL_EVENTS}
  if Assigned( Sender.PP.fScrollChildren ) then
  {$ENDIF}
  begin
      OldNotifyProc := @ Sender.PP.fNotifyChild;
      Sender.PP.fNotifyChild := @DummyObjProc;
      Sender.PP.fScrollChildren( Sender );
      Sender.PP.fNotifyChild := OldNotifyProc;
  end;

  SetScrollInfo( Sender.fHandle, Bar, SI, TRUE );
  Result := FALSE;
end;

function NewScrollBox( AParent: PControl; EdgeStyle: TEdgeStyle;
         Bars: TScrollerBars ): PControl;
var SBFlag: Integer;
begin
  SBFlag := EdgeStyles[ EdgeStyle ];
  if sbHorizontal in Bars then
    SBFlag := SBFlag or WS_HSCROLL;
  if sbVertical in Bars then
    SBFlag := SBFlag or WS_VSCROLL;

  Result := _NewControl( AParent, 'ScrollBox', WS_VISIBLE or WS_CHILD or
         SBFlag, EdgeStyle = esLowered,
         {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS )
         {$ELSE} nil {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:ScrollBox';
  {$ENDIF}
  Result.AttachProc( WndProcForm ); //!!!
  Result.AttachProc( WndProcScrollBox );
  Result.AttachProc( WndProcDoEraseBkgnd );
  {$IFDEF USE_FLAGS} include( Result.fFlagsG3, G3_IsControl );
  {$ELSE} Result.fIsControl := TRUE; {$ENDIF}
end;

function  Scrollbar_GetMinPos( sb: PControl ): Integer;
begin
  Result := sb.SBMax;
end;
procedure Scrollbar_SetMinPos( sb: PControl; m: Integer );
begin
  sb.SBMin := m;
end;
procedure Scrollbar_SetAll( sb: PControl; min, max, pg, cur: Integer );
begin
  sb.SBMin := min;
  sb.SBMax := max;
  sb.SBPageSize := pg;
  sb.SBPosition := cur;
end;
function  Scrollbar_GetMaxPos( sb: PControl ): Integer;
begin
  Result := sb.SBMax;
end;
procedure Scrollbar_SetMaxPos( sb: PControl; m: Integer );
begin
  sb.SBMax := m;
end;
function  Scrollbar_GetCurPos( sb: PControl ): Integer;
begin
  Result := sb.SBPosition;
end;
procedure Scrollbar_SetCurPos( sb: PControl; newp: Integer );
begin
  sb.SBPosition := newp;
end;
procedure Scrollbar_SetPageSz( sb: PControl; psz: Integer );
begin
  sb.SBPageSize := psz;
end;
function  Scrollbar_GetPageSz( sb: PControl ): Integer;
begin
  Result := sb.SBPageSize;
end;
procedure Scrollbar_SetLineSz( sb: PControl; lnz: Integer );
begin
  //
end;
function  Scrollbar_GetLineSz( sb: PControl ): Integer;
begin
  Result := 1;
end;

function WndProcNotifyParentAboutResize( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var P: PControl;
begin
  if (Msg.message = WM_SIZE) or (Msg.message = WM_MOVE) or (Msg.message = CM_SHOW) then
  begin
    P := Sender.Parent;
    if  P <> nil then
        {$IFDEF NIL_EVENTS}
        if  Assigned( P.PP.fNotifyChild ) then
        {$ENDIF}
            P.PP.fNotifyChild( P, nil );
  end
    else
  if Msg.message = WM_SHOWWINDOW then
    PostMessage( Sender.fHandle, CM_SHOW, 0, 0 );
  Result := FALSE;
end;

procedure CalcMinMaxChildren( Self_: PControl; var SzR: TRect );
var I: Integer;
    C: PControl;
    R: TRect;
begin
  Szr := MakeRect( 0, 0, 0, 0 );
  for I := 0 to Self_.fChildren.fCount - 1 do
  begin
    C := Self_.fChildren.Items[ I ];
    if C.ToBeVisible then
    begin
      R := C.BoundsRect;
      if (SzR.Left = SzR.Right) or (R.Left < SzR.Left) or (R.Right > SzR.Right) then
      begin
        if SzR.Left = SzR.Right then
        begin
          SzR.Left := R.Left;
          SzR.Right := R.Right;
        end
          else
        begin
          if R.Left < SzR.Left then SzR.Left := R.Left;
          if R.Right > SzR.Right then SzR.Right := R.Right;
        end;
      end;
      if (SzR.Top = SzR.Bottom) or (R.Top < SzR.Top) or (R.Bottom > SzR.Bottom) then
      begin
        if SzR.Top = SzR.Bottom then
        begin
          SzR.Top := R.Top;
          SzR.Bottom := R.Bottom;
        end
          else
        begin
          if R.Top < SzR.Top then SzR.Top := R.Top;
          if R.Bottom > SzR.Bottom then SzR.Bottom := R.Bottom;
        end;
      end;
    end;
  end;
  Dec( SzR.Left, Self_.Border );
  Inc( SzR.Right, Self_.Border - 1 );
  Dec( SzR.Top, Self_.Border );
  Inc( SzR.Bottom, Self_.Border - 1 );
end;

procedure NotifyScrollBox( Self_, Child: PControl );
var SI: TScrollInfo;

    procedure GetSetScrollInfo( SBar: DWORD; WH, R_RightBottom, SzR_LeftTop, SzR_RightBottom: Integer );
    {$IFDEF SBOX_OLDPOS} var OldPos: Double; {$ENDIF}
    begin
      {$IFDEF SBOX_OLDPOS} OldPos := 0; {$ENDIF}
      if not GetScrollInfo( Self_.fHandle, SBar, SI ) then
      begin
        SI.nMin := 0;
        SI.nMax := Max( R_RightBottom - 1, SzR_RightBottom - 1 );
      end
        else
      begin
        {$IFDEF SBOX_OLDPOS}
        if SI.nMax > SI.nMin then
        begin
          OldPos := (SI.nPos - SI.nMin) / (SI.nMax - SI.nMin);
          SI.nMin := 0;
          SI.nMax := Max( R_RightBottom - 1, SzR_RightBottom - 1 );
          if SzR_LeftTop < 0 then
            SI.nMax := Max( R_RightBottom - SzR_LeftTop - 1, WH - 1 );
        end
          else
        begin
          SI.nMin := 0;
          SI.nMax := Max( R_RightBottom - 1, SzR_RightBottom - 1 );
        end;
        {$ENDIF}
        SI.nMin := 0; {!ecm}
        SI.nMax := SzR_RightBottom - SzR_LeftTop; {!ecm}
      end;
      {$IFDEF SBOX_OLDPOS}
      SI.nPos := SI.nMin + Round( (SI.nMax - SI.nMin) * OldPos );
      {$ELSE}
      SI.nPos := - SzR_LeftTop;
      {$ENDIF}
      SI.nPage := R_RightBottom;
      SetScrollInfo( Self_.fHandle, SBar, SI, TRUE );
    end;

var W, H: Integer;
    SzR: TRect;
    R: TRect;
begin
  if  ( Child <> nil ) then
  begin
      Child.AttachProc( WndProcNotifyParentAboutResize ); Exit; {>>>>>>>>>>>>>>}
  end;
  CalcMinMaxChildren( Self_, SzR );
  W := SzR.Right - SzR.Left;
  H := SzR.Bottom - SzR.Top;

  R := Self_.ClientRect;
  if (R.Right = 0) or (R.Bottom = 0) then
     Exit; // for case when form is minimized {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  SI.cbSize := sizeof( SI );
  SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS;

 SI.cbSize := sizeof( SI );
 SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS;

 GetSetScrollInfo( SB_HORZ, W, R.Right, SzR.Left, SzR.Right );
{+ecm}R := Self_.ClientRect;{/+ecm}
 GetSetScrollInfo( SB_VERT, H, R.Bottom, SzR.Top, SzR.Bottom );
{+ecm}  {$IFDEF NIL_EVENTS}
        if  Assigned( Self_.PP.fScrollChildren ) then
        {$ENDIF}
            Self_.PP.fScrollChildren(Self_); {/+ecm}
end;

procedure ScrollChildren( _Self_: PControl );
var SzR, R: TRect;
    I, Xpos, Ypos: Integer;
    OldNotifyProc: Pointer;
    C: PControl;
    DeltaX, DeltaY: Integer;

begin

  CalcMinMaxChildren( _Self_, SzR );
  Xpos := GetScrollPos( _Self_.fHandle, SB_HORZ );
  Ypos := GetScrollPos( _Self_.fHandle, SB_VERT );

  DeltaX := -Xpos - SzR.Left;
  DeltaY := -Ypos - SzR.Top;

  if (DeltaX <> 0) or (DeltaY <> 0) then
  begin

    OldNotifyProc := @ _Self_.PP.fNotifyChild;
    _Self_.PP.fNotifyChild := @DummyObjProc;

    for I := 0 to _Self_.fChildren.fCount - 1 do
    begin
      C := _Self_.fChildren.Items[ I ];
      R := C.BoundsRect;
      OffsetRect( R, DeltaX, DeltaY  );
      C.BoundsRect := R;
    end;

    _Self_.PP.fNotifyChild := OldNotifyProc;
    CalcMinMaxChildren( _Self_, R );
    if //(SzR.Left <> R.Left) or (SzR.Top <> R.Top) or
       //(Szr.Right <> R.Right) or (SzR.Bottom <> R.Bottom)
       ((SzR.Right - SzR.Left) <> (R.Right - R.Left)) or
       ((SzR.Bottom - SzR.Top) <> (R.Bottom - R.Top))
       then
    {$IFDEF NIL_EVENTS}
    if  Assigned( _Self_.PP.fNotifyChild ) then
    {$ENDIF}
       _Self_.PP.fNotifyChild( _Self_, nil );

  end;

end;

function NewScrollBoxEx( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl;
begin
  Result := NewScrollBox( AParent, EdgeStyle, [ ] );
  Result.PP.fNotifyChild := NotifyScrollBox;
  Result.PP.fScrollChildren := ScrollChildren;
  Result.DF.fScrollLineDist[ 0 ] := 16;
  Result.DF.fScrollLineDist[ 1 ] := 16;
end;

function WndProcOnScroll( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Bar: TScrollerBar;
begin
  Bar := sbHorizontal; //0
  if  Msg.message = WM_VSCROLL then
      Bar := sbVertical
  else
  if  Msg.message <> WM_HSCROLL then
  begin
      Result := FALSE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  {$IFDEF NIL_EVENTS}
  if  Assigned( Sender.EV.fOnScroll ) then
  {$ENDIF}
      Sender.EV.fOnScroll( Sender, Bar, LoWord( Msg.wParam ),
                           HiWord( Msg.wParam ) );
  Result := FALSE;
end;

procedure TControl.SetOnScroll(const Value: TOnScroll);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .FOnScroll := Value;
  AttachProc( @ WndProcOnScroll );
end;

//===================== Groupbox ========================//

{$IFDEF USE_CONSTRUCTORS}
function NewGroupbox( AParent: PControl; const Caption: AnsiString ): PControl;
begin
  new( Result, CreateGroupbox( AParent, Caption ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Groupbox';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function NewGroupbox( AParent: PControl; const Caption: KOLString ): PControl;
begin
  Result := _NewControl( AParent, 'BUTTON',
                   WS_CHILD
                   or WS_CLIPSIBLINGS
                   or WS_CLIPCHILDREN
                   or WS_VISIBLE
                   or BS_GROUPBOX,
                   FALSE, {$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed
                          {$ELSE} @ButtonActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Groupbox';
  {$ENDIF}
  Result.fExStyle := Result.fExStyle or WS_EX_CONTROLPARENT;
  Result.Caption := Caption;
  with Result.fBoundsRect do
  begin
    Right := Left + 100;
    Bottom := Top + 100;
  end;
  Result.fClientTop := 22;
  Result.fClientBottom := 2;
  Result.fClientLeft := 2;
  Result.fClientRight := 2;
  {$IFDEF USE_FLAGS}
          exclude( Result.fStyle.f2_Style, F2_Tabstop );
          include( Result.fFlagsG5, G5_IsGroupbox );
  {$ELSE} Result.fTabstop := False;
          Result.fIsGroupBox := TRUE;
  {$ENDIF}
  Result.AttachProc( WndProcDoEraseBkgnd );
{$IFDEF GRAPHCTL_XPSTYLES}
  Attach_WM_THEMECHANGED(Result, XP_Themes_For_GroupBox);
{$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//===================== Panel ========================//

{$IFDEF USE_CONSTRUCTORS}
function NewPanel( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl;
begin
  new( Result, CreatePanel( AParent, EdgeStyle ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Panel';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function NewPanel( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl;
begin
  Result := _NewControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD or SS_NOTIFY or
                         SS_LEFTNOWORDWRAP or SS_NOPREFIX, False,
                         {$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed
                         {$ELSE}                      @LabelActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Panel';
  {$ENDIF}
  Result.aAutoSzX := 1;
  Result.aAutoSzY := 1;
  with Result.fBoundsRect do
  begin
    Right := Left + 100;
    Bottom := Top + 100;
  end;
  Result.fStyle.Value := Result.fStyle.Value or Edgestyles[ EdgeStyle ];
  Result.fExStyle := Result.fExStyle or WS_EX_CONTROLPARENT;
  Result.fVerticalAlign := vaTop;
{$IFDEF GRAPHCTL_XPSTYLES}
  if AppTheming then
   Result.fStyle.Value := Result.fStyle.Value and (not Edgestyles[ EdgeStyle ]);
  Result.SetEdgeStyle(EdgeStyle);
  Attach_WM_THEMECHANGED(Result, XP_Themes_For_Panel);
{$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//===================== Splitter ==============================//

//{$DEFINE USE_ASM_DODRAG}

       {$IFNDEF USE_ASM_DODRAG}
         {$DEFINE USE_PAS_DODRAG}
       {$ENDIF}
       {$IFNDEF ASM_VERSION}
         {$DEFINE USE_PAS_DODRAG}
       {$ENDIF}
{$IFDEF USE_PAS_DODRAG}
procedure DoDrag( Self_: PControl; Cancel: Boolean );
var NewSize1, NewSize2: Integer;
    MousePos: TPoint;
    R: TRect;
    Prev: PControl;
    I, M : Integer;
begin
  if  {$IFDEF USE_FLAGS} G6_Dragging in Self_.fFlagsG6
      {$ELSE} Self_.fDragging {$ENDIF} then
  begin
      I := Self_.fParent.fChildren.IndexOf( Self_ );
      Prev := Self_;
      if  I > 0 then
          Prev := Self_.FParent.fChildren.Items[ I - 1 ];
      GetCursorPos( MousePos );
      {$IFDEF SPEED_FASTER}
          if  (MousePos.X = Self_.DF.fSplitLastPos.X)
          and (MousePos.Y = Self_.DF.fSplitLastPos.Y) then Exit; {>>>>>>>>>>>>>}
          Self_.DF.fSplitLastPos := MousePos;
      {$ENDIF SPEED_FASTER}
      if  Cancel then
          MousePos := Self_.DF.fSplitStartPos;
      M := 1;
      if  Self_.FAlign in [ caRight, caBottom ] then
          M := -1;
      if  Self_.FAlign in [ caTop, caBottom ] then
      begin
          NewSize1 := (MousePos.y - Self_.DF.fSplitStartPos.y)* M
                    + Self_.DF.fSplitStartSize;
          NewSize2 := Self_.fParent.ClientHeight - NewSize1
                    - Self_.fBoundsRect.Bottom + Self_.fBoundsRect.Top
                    - Self_.fParent.fMargin * 4;
          if Self_.DF.fSecondControl <> nil then
          begin
            NewSize2 := Self_.DF.fSecondControl.fBoundsRect.Bottom
                      - Self_.DF.fSecondControl.fBoundsRect.Top;
            if Self_.DF.fSecondControl.FAlign = caClient then
              NewSize2 := Self_.DF.fSplitStartPos2.y
                        - (MousePos.y - Self_.DF.fSplitStartPos.y)* M
                        - Self_.fParent.fMargin * 4;
          end;
      end else
      begin
          NewSize1 := (MousePos.x - Self_.DF.fSplitStartPos.x)* M
                    + Self_.DF.fSplitStartSize;
          NewSize2 := Self_.fParent.ClientWidth - NewSize1
                    - Self_.fBoundsRect.Right + Self_.fBoundsRect.Left
                    - Self_.fParent.fMargin * 4;
          if Self_.DF.fSecondControl <> nil then
          begin
            NewSize2 := Self_.DF.fSecondControl.fBoundsRect.Right
                      - Self_.DF.fSecondControl.fBoundsRect.Left;
            if Self_.DF.fSecondControl.FAlign = caClient then
              NewSize2 := Self_.DF.fSplitStartPos2.x
                        - (MousePos.x - Self_.DF.fSplitStartPos.x)* M
                        - Self_.fParent.Margin * 4;
          end;
      end;
      if  (NewSize1 < Self_.DF.fSplitMinSize1) then
      begin
          Dec( NewSize2, Self_.DF.fSplitMinSize1 - NewSize1 );
          NewSize1 := Self_.DF.fSplitMinSize1;
      end;
      if  (NewSize2 < Self_.DF.fSplitMinSize2) then
      begin
          Dec( NewSize1, Self_.DF.fSplitMinSize2 - NewSize2 );
          NewSize2 := Self_.DF.fSplitMinSize2;
      end;
      if  NewSize1 < Self_.DF.fSplitMinSize1 then Exit; {>>>>>>>>>>>>>>>>>>>>>>}
      if  NewSize2 < Self_.DF.fSplitMinSize2 then Exit; {>>>>>>>>>>>>>>>>>>>>>>}
      {$IFDEF NIL_EVENTS}
      if  assigned( Self_.EV.fOnSplit ) then
      {$ENDIF}
          if  not Self_.EV.fOnSplit( Self_, NewSize1, NewSize2 ) then Exit; {>>}
      R := Prev.BoundsRect;
      case Self_.FAlign of
      caTop: R.Bottom := R.Top + NewSize1;
      caBottom: R.Top := R.Bottom - NewSize1;
      caRight: R.Left := R.Right - NewSize1;
      else R.Right := R.Left + NewSize1;
      end;
      Prev.BoundsRect := R;
      {$IFDEF OLD_ALIGN}
      Global_Align( Self_.fParent );
      {$ELSE NEW_ALIGN}
      Global_Align( Self_ );
      {$ENDIF}
  end;
end;
{$ENDIF}

const
  chkLeft=2;
  chkTop=4;
  chkRight=8;
  chkBott=16;

{$DEFINE USE!_ASM_DODRAG}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function WndProcSplitter( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var I: Integer;
    Prev: PControl;

    procedure FinDrag;
    begin
      KillTimer( Self_.fHandle, $7B );
      {$IFDEF USE_FLAGS} exclude( Self_.fFlagsG6, G6_Dragging );
      {$ELSE} Self_.fDragging := False; {$ENDIF}
      ReleaseCapture;
    end;
begin
  case Msg.message of
  WM_NCHITTEST:
    begin
        Rslt := DefWindowProc( Self_.fHandle, Msg.message, Msg.wParam, Msg.lParam );
        if Rslt > 0 then
          Rslt := HTCLIENT;
        Result := True; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  WM_MOUSEMOVE:
    begin
      Windows.SetCursor( Self_.fCursor );
      DoDrag( Self_, False );
    end;
  WM_LBUTTONDOWN:
    begin
      if Self_.fParent <> nil then
      begin
        I := Self_.fParent.fChildren.IndexOf( Self_ );
        Prev := Self_;
        if I > 0 then
          Prev := Self_.FParent.fChildren.Items[ I - 1 ];
        if Self_.fAlign in [ caTop, caBottom ] then
          Self_.DF.fSplitStartSize := Prev.Height
        else
          Self_.DF.fSplitStartSize := Prev.Width;
        if Self_.DF.fSecondControl <> nil then
          Self_.DF.fSplitStartPos2 :=
            MakePoint( Self_.DF.fSecondControl.Width, Self_.DF.fSecondControl.Height );
        SetCapture( Self_.fHandle );
        {$IFDEF SPEED_FASTER}
                Self_.DF.fSplitLastPos := MakePoint( -1, -1 );
        {$ENDIF}
        {$IFDEF USE_FLAGS} Include( Self_.fFlagsG6, G6_Dragging );
        {$ELSE} Self_.fDragging := True; {$ENDIF}
        SetTimer( Self_.fHandle, $7B, 100, nil );
        GetCursorPos( Self_.DF.fSplitStartPos );
      end;
    end;
  WM_LBUTTONUP:
    begin
      DoDrag( Self_, False );
      FinDrag;
    end;
  WM_TIMER:
    if  {$IFDEF USE_FLAGS} (G6_Dragging in Self_.fFlagsG6)
        {$ELSE} Self_.fDragging {$ENDIF}
    and (GetAsyncKeyState( VK_ESCAPE ) < 0) then
    begin
      DoDrag( Self_, True );
      FinDrag;
    end;
  end;
  Result := False;
end;
{$ENDIF PAS_VERSION}

function NewSplitter( AParent: PControl; MinSizePrev, MinSizeNext: Integer ): PControl;
begin
  Result := NewSplitterEx( AParent, MinSizePrev, MinSizeNext, esLowered );
end;

{$IFDEF USE_CONSTRUCTORS}
function NewSplitterEx( AParent: PControl; MinSizePrev, MinSizeNext: Integer;
         EdgeStyle: TEdgeStyle ): PControl;
begin
  new( Result, CreateSplitter( AParent, MinSizePrev, MinSizeNext, EdgeStyle ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:SplitterEx';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewSplitterEx( AParent: PControl; MinSizePrev, MinSizeNext: Integer;
         EdgeStyle: TEdgeStyle ): PControl;
var PrevCtrl: PControl;
    Sz0: Integer;
begin
  Result := NewPanel( AParent, EdgeStyle );
  Result.DF.fSplitMinSize1 := MinSizePrev;
  Result.DF.fSplitMinSize2 := MinSizeNext;
  {$IFDEF USE_FLAGS} include( Result.fFlagsG5, G5_IsSplitter );
  {$ELSE} Result.fIsSplitter := TRUE; {$ENDIF}
  Sz0 := 4;
  with Result.fBoundsRect do
  begin
    Right := Left + Sz0;
    Bottom := Top + Sz0;
  end;
  if AParent <> nil then
  begin
    if AParent.fChildren.fCount > 1 then
    begin
      PrevCtrl := AParent.fChildren.Items[ AParent.fChildren.fCount - 2 ];
      case PrevCtrl.FAlign of
      caLeft, caRight:
        begin
          Result.fCursor := LoadCursor( 0, IDC_SIZEWE );
        end;
      caTop, caBottom:
        begin
          Result.fCursor := LoadCursor( 0, IDC_SIZENS );
        end;
      end;
      Result.Align := PrevCtrl.FAlign;
    end;
  end;
  Result.AttachProc( WndProcSplitter );
{$IFDEF GRAPHCTL_XPSTYLES}
  Attach_WM_THEMECHANGED(Result, XP_Themes_For_Splitter);
{$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

{$IFDEF USE_MDI}
//===================== MDI client window control =============//

procedure DestroyMDIChildren( Form: PControl );
var MDIClient: PControl;
    I: Integer;
    Ch: PControl;
    MDIChildren: PList;
begin
  //MDIClient := Form.MDIClient;
  MDIClient := nil;
  for I := 0 to Form.ChildCount-1 do
  begin
      Ch := Form.Children[I];
      if  Ch.PropInt[ MDI_CHLDRN ] <> 0 then
      begin
          MDIClient := Ch;
          break;
      end;
  end;
  if  MDIClient = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  MDIClient.fAnchors := MDIClient.fAnchors or MDI_DESTROYING;
  MDIChildren := Pointer( MDIClient.PropInt[ MDI_CHLDRN ] );
  if  MDIChildren <> nil then
  for I := MDIChildren.Count - 1 downto 0 do
  begin
      Ch := MDIChildren.Items[ I ];
      if  Ch.fHandle <> 0 then
          MDIClient.Perform( WM_MDIDESTROY, Ch.fHandle, 0 );
  end;
  MDIChildren.Free;
  MDIClient.PropInt[ MDI_CHLDRN ] := 0;
  if Form.fMenu <> 0 then
  begin
    MDIClient.Perform( WM_MDISETMENU, 0, 0 );
    MDIClient.Perform( WM_MDIREFRESHMENU, 0, 0 );
    DrawMenuBar( Form.fHandle );
    Form.fMenuObj.Free;
    Form.fMenuObj := nil;
  end;
  MDIClient.Free;
end;

function ProcMDIAccel( Applet: PControl; var Msg: TMsg ): Boolean;
var Form: PControl;
begin
  Result := FALSE;
  if (Msg.message >= WM_KEYFIRST) and (Msg.message <= WM_KEYLAST) then
  begin
    Form := Applet.ActiveControl;
    if Form <> nil then
    begin
      if Form.IsMDIChild then
        Form := Form.Parent;
      Form := Form.ParentForm;
      if (Form <> nil) and (Form.MDIClient <> nil) then
        Result := TranslateMDISysAccel( Form.MDIClient.fHandle,
            Windows.TMsg(Msg) );
    end;
  end;
end;

function CallDefFrameProc( Wnd: HWnd; Msg: Integer; wParam, lParam: Integer ): Integer;
stdcall;
var Form, MDIClient: PControl;
begin
  {$IFDEF USE_PROP}
  Form := Pointer( GetProp( Wnd, ID_SELF ) );
  {$ELSE}
  Form := Pointer( GetWindowLong( Wnd, GWL_USERDATA ) );
  {$ENDIF}
  if  Form <> nil then
      Form := Form.ParentForm;
  MDIClient := Form.MDIClient;
  if  (Form <> nil) and (MDIClient <> nil) then
      Result := DefFrameProc( Wnd, MDIClient.fHandle, Msg, wParam, lParam )
  else
      Result := DefWindowProc( Wnd, Msg, wParam, lParam );
end;

function WndFuncMDIClient( Wnd: HWnd; Msg, wParam, lParam: Integer ): Integer;
stdcall;
var C: PControl;
    M: TMsg;
begin
  {$IFDEF USE_PROP}
  C := Pointer( GetProp( Wnd, ID_SELF ) );
  {$ELSE}
  C := Pointer( GetWindowLong( Wnd, GWL_USERDATA ) );
  {$ENDIF}
  if C <> nil then
  begin
    M.hwnd := Wnd;
    M.message := Msg;
    M.wParam := wParam;
    M.lParam := lParam;
    Result := C.WndProc( M );
  end
    else
    Result := DefWindowProc( Wnd, Msg, wParam, lParam );
end;

function ShowMDIClientEdge( MDIClient: PControl ): Boolean;
var ShowEdge: Boolean;
    I: Integer;
    Ch: PControl;
    ExStyle: Integer;
    MDIChildren: PList;
begin
  Result := FALSE;
  ShowEdge := TRUE;
  MDIChildren := Pointer( MDIClient.PropInt[ MDI_CHLDRN ] );
  if  MDIChildren.Count > 0 then
      for I := 0 to MDIChildren.Count-1 do
      begin
        Ch := MDIChildren.Items[ I ];
        if  IsZoomed( Ch.fHandle ) then
        begin
            ShowEdge := FALSE;
            break;
        end;
      end;
  ExStyle := MDIClient.ExStyle;
  if  ShowEdge then
      if  ExStyle and WS_EX_CLIENTEDGE = 0 then
          ExStyle := ExStyle or WS_EX_CLIENTEDGE
      else Exit {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  else if ExStyle and WS_EX_CLIENTEDGE <> 0 then
       ExStyle := ExStyle and not WS_EX_CLIENTEDGE
  else Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  MDIClient.ExStyle := ExStyle;
  Result := TRUE;
end;

function WndProcMDIClient( MDIClient: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := FALSE;
  if  MDIClient.fAnchors and MDI_DESTROYING = 0 then
  case Msg.message of
  $3f:
      begin
        PostMessage( MDIClient.fHandle, CM_MDIClientShowEdge, 0, 0 );
      end;
  CM_MDIClientShowEdge:
      begin
        ShowMDIClientEdge( MDIClient );
      end;
  WM_NCHITTEST: // not necessary though
      begin
        Rslt := DefWindowProc( MDIClient.fHandle, WM_NCHITTEST, Msg.wParam, Msg.lParam );
        if Rslt = HTCLIENT then Rslt := HTTRANSPARENT;
      end;
  WM_WINDOWPOSCHANGING:
      begin
        MDIClient.Perform( WM_SETREDRAW, 0, 0 );
      end;
  WM_WINDOWPOSCHANGED:
      begin
        Global_Align( {$IFDEF OLD_ALIGN}MDIClient.Parent{$ELSE}MDIClient{$ENDIF} );
        MDIClient.Invalidate;
        MDIClient.Parent.Invalidate;
        MDIClient.Perform( WM_SETREDRAW, 1, 0 );
        PostMessage( MDIClient.fHandle, CM_INVALIDATE, 0, 0 );
      end;
  CM_INVALIDATE:
      begin
        MDIClient.InvalidateNC( TRUE );
        MDIClient.InvalidateEx;
      end;
  WM_DESTROY:
      begin
        MDIClient.FParent.fMDIClient := nil;
      end;
  end;
end;

// function added by Thaddy de Koning to fix MDI behaviour
function WndProcParentNotifyMouseLDown( Sender: PControl; var Msg: TMsg;
var Rslt: Integer ): Boolean;
begin
  Result := FALSE;
  if (Sender.IsMDIChild) and (Msg.message = WM_PARENTNOTIFY) and
     (LOWORD(msg.wparam)=WM_LBUTTONDOWN) then
     BringWindowToTop( Sender.Handle );
end;

function NewMDIClient( AParent: PControl; WindowMenu: THandle ): PControl;
var F: PControl;
    CCS: TClientCreateStruct;
    PrntWin: HWnd;
begin
  PrntWin := 0;
  if AParent <> nil then
  begin
    F := AParent.ParentForm;
    if F <> nil then
    begin
      F.Add2AutoFreeEx( TObjectMethod( MakeMethod( F, @ DestroyMDIChildren ) ) );
      F.GetWindowHandle; // must be created before MDI client creation
      F.fDefWndProc := @CallDefFrameProc;
    end;
    PrntWin := AParent.GetWindowHandle;
  end;
  Applet.PP.fExMsgProc := ProcMDIAccel;
  Result := _NewControl( AParent, 'MDICLIENT',
         WS_CHILD or WS_CLIPCHILDREN or WS_VSCROLL or WS_HSCROLL or
         WS_VISIBLE or WS_TABSTOP or MDIS_ALLCHILDSTYLES, TRUE,
         {$IFDEF PACK_COMMANDACTIONS} PAnsiChar(OTHER_ACTIONS)
         {$ELSE} nil {$ENDIF} );
  AParent.fMDIClient := Result;
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:MDIClient';
  {$ENDIF}
  Result.fExStyle := WS_EX_CLIENTEDGE;

  CCS.hWindowMenu := WindowMenu;
  CCS.idFirstChild := $FF00;
  Result.fHandle := CreateWindowEx( WS_EX_CLIENTEDGE, 'MDICLIENT', nil,
                 WS_CHILD or WS_CLIPCHILDREN or WS_VSCROLL or WS_HSCROLL or
                 WS_VISIBLE or WS_TABSTOP,
                 0, 0, 0, 0, PrntWin, 0, hInstance, @ CCS );
  Result.fDefWndProc := Pointer( GetWindowLong( Result.fHandle, GWL_WNDPROC ) );
  SetWindowLong( Result.fHandle, GWL_WNDPROC, Integer( @WndFuncMDIClient ) );
  Result.PropInt[ MDI_CHLDRN ] := Integer( NewList );
  {$IFDEF USE_PROP}
  SetProp( Result.fHandle, ID_SELF, Integer( Result ) );
  {$ELSE}
  SetWindowLong( Result.fHandle, GWL_USERDATA, Integer( Result ) );
  {$ENDIF}
  Result.AttachProc( WndProcMDIClient );
  Result.GetWindowHandle;

  Applet.AttachProc( WndProcParentNotifyMouseLDown );
end;

//===================== MDI child window object ==============//
function MDIChildFunc( Wnd: HWnd; Msg: DWord; wParam, lParam: Integer ): Integer;
stdcall;
var C: PControl;
    M: TMsg;
begin
  {$IFDEF USE_PROP}
  C := Pointer( GetProp( Wnd, ID_SELF ) );
  {$ELSE}
  C := Pointer( GetWindowLong( Wnd, GWL_USERDATA ) );
  {$ENDIF}
  if C <> nil then
  begin
    M.hwnd := Wnd;
    M.message := Msg;
    M.wParam := wParam;
    M.lParam := lParam;
    Result := C.WndProc( M );
  end
    else
    Result := DefMDIChildProc( Wnd, Msg, wParam, lParam );
end;

function Pass2DefMDIChildProc( Sender_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := FALSE;
  if Sender_ = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Sender_.fParent = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if  {$IFDEF USE_FLAGS} G2_Destroying in Sender_.fParent.fFlagsG2
      {$ELSE} Sender_.fParent.fDestroying {$ENDIF} then Exit; {>>>>>>>>>>>>>>>>}
  if (Msg.message = WM_SYSCOMMAND) or (Msg.message = WM_CHILDACTIVATE) or
     (Msg.message = WM_SETFOCUS) or (Msg.message = WM_SIZE) or
     (Msg.message = WM_MOVE) or (Msg.message = WM_MENUCHAR) or
     (Msg.message = WM_GETMINMAXINFO) {and IsZoomed( Sender_.fHandle ) {and (Msg.hwnd = Sender_.fHandle) { -- doesn't work -- }
     or (Msg.message = WM_PAINT)
     then
  begin
    Rslt := DefMDIChildProc( Msg.hwnd, Msg.message, Msg.lParam, Msg.wParam );
    Result := TRUE;
  end;
end;

function WndProcMDIChild( MDIChild: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var ClientWnd: HWnd;
    MDIClient: PControl;
    MDIForm: PControl;
    MDIChildren: PList;
begin
  Result := FALSE;
  MDIClient := MDIChild.Parent;
  if MDIClient = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  ClientWnd := MDIClient.fHandle;
  if ClientWnd = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  case Msg.message of
  WM_DESTROY:
    begin
      MDIChildren := Pointer( MDIClient.PropInt[ MDI_CHLDRN ] );
      MDIChildren.Remove( MDIChild );
      MDIForm := MDIClient.ParentForm;
      if  MDIForm <> nil then
      if  MDIForm.fHandle <> 0 then
          DrawMenuBar( MDIForm.fHandle );
      MDIChild.Free;
      Result := TRUE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end;
  if  MDIChild.fAnchors and MDI_NOT_AVAILABLE <> 0 then
  begin
      MDIChild.fAnchors := MDIChild.fAnchors and not MDI_NOT_AVAILABLE;
      MDIChild.Invalidate;
  end;
end;

procedure CreateMDIChildExt( Sender: PControl );
var F: PControl;
begin
  F := Sender.Parent;
  if F <> nil then
    F := F.ParentForm;
  if F <> nil then
    DrawMenuBar( F.fHandle );
end;

var mdi_child_id: Integer = $FF00;

function NewMDIChild( AParent: PControl; const ACaption: KOLString ): PControl;
var MDIClient: PControl;
    MDIChildren: PList;
    i: Integer;
begin
  {$IFDEF KOL_ASSERTIONS}
  Assert( (AParent <> nil) and (AParent.ParentForm <> nil) and
          (AParent.ParentForm.MDIClient <> nil), 'Error creating MDI child' );
  {$ENDIF KOL_ASSERTIONS}
  MDIClient := AParent.ParentForm.MDIClient;
  MDIChildren := Pointer( MDIClient.PropInt[ MDI_CHLDRN ] );

  for i := 0 to MDIChildren.Count-1 do
  begin
      Result := MDIChildren.Items[i];
      //if  Result.DF.fWindowState = wsMaximized then
      if  IsZoomed( Result.fHandle ) then
      begin
          MDIClient.Perform( WM_MDIRESTORE, Result.fHandle, 0 );
      end;
  end;

  Result := NewForm( MDIClient, ACaption );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:MDIChild';
  {$ENDIF}
  {$IFDEF USE_FLAGS} include( Result.fFlagsG3, G3_IsMDIChild );
  {$ELSE} Result.fIsMDIChild := TRUE; {$ENDIF}
  Result.fMenu := mdi_child_id; // CtlIdCount;
  Inc( mdi_child_id );

  MDIChildren.Add( Result );
  Result.fExStyle := Result.fExStyle or WS_EX_MDICHILD;
  Result.PP.fWndFunc := @ MDIChildFunc;
  Result.fDefWndProc := @DefMDIChildProc;
  Result.PP.fPass2DefProc := Pass2DefMDIChildProc;
  Result.AttachProc( WndProcMDIChild );

  Result.SubClassName := 'MDI_chld';
  Result.fAnchors := Result.fAnchors or MDI_NOT_AVAILABLE;
  Result.PP.fCreateWndExt := CreateMDIChildExt;
  Result.fCreateWindowProc := CreateMDIWindow;
end;
{$ENDIF USE_MDI}

//===================== Gradient panel ========================//

{$IFDEF USE_CONSTRUCTORS}
function NewGradientPanel( AParent: PControl; Color1, Color2: TColor ): PControl;
begin
  new( Result, CreateGradientPanel( AParent, Color1, Color2 ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:GradientPanel';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewGradientPanel( AParent: PControl; Color1, Color2: TColor ): PControl;
begin
  Result := NewLabel( AParent, '' );
  Result.AttachProc( WndProcGradient );
  Result.DF.fColor2 := Color2;
  Result.DF.fColor1 := Color1;
  with Result.fBoundsRect do
  begin
    Right := Left + 40;
    Bottom := Top + 40;
  end;
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

{$IFDEF USE_CONSTRUCTORS}
function NewGradientPanelEx( AParent: PControl; Color1, Color2: TColor;
                             Style: TGradientStyle; Layout: TGradientLayout ): PControl;
begin
  new( Result, CreateGradientPanelEx( AParent, Color1, Color2,
                             Style, Layout ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:GradientPanelEx';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewGradientPanelEx( AParent: PControl; Color1, Color2: TColor;
                             Style: TGradientStyle; Layout: TGradientLayout ): PControl;
begin
  Result := NewLabel( AParent, '' );
  Result.AttachProc( WndProcGradientEx );
  Result.DF.fColor2 := Color2;
  Result.DF.fColor1 := Color1;
  Result.DF.fGradientStyle := Style;
  Result.DF.fGradientLayout := Layout;
  with Result.fBoundsRect do
  begin
    Right := Left + 40;
    Bottom := Top + 40;
  end;
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//===================== Edit box ========================//

const Editflags: array [ TEditOption ] of Integer = (
                  not (ES_AUTOHSCROLL or WS_HSCROLL),
                  not (es_AutoVScroll or WS_VSCROLL),
                  es_Lowercase, es_Multiline,
                  es_NoHideSel, es_OemConvert, es_Password, es_Readonly,
                  es_UpperCase, es_WantReturn, 0, es_Number );

{$IFDEF USE_CONSTRUCTORS}
function NewEditbox( AParent: PControl; Options: TEditOptions ) : PControl;
begin
  new( Result, CreateEditbox( AParent, Options ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Editbox';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF _D3orHigher}
function WndProcUnicodeChars( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var WStr, WW: KOLWideString;
    RepeatCount: Integer;
    C: KOLChar;
begin
    Result := FALSE;
    if  (Msg.message = WM_CHAR)
        and (Msg.wParam >= 32)
        {$IFDEF UNICODE_CHAR_EXTCTL}
        and (GetKeyState(VK_CONTROL) >= 0)
        and (GetKeyState(VK_ALT) >= 0)
        and (GetKeyState(VK_LWIN) >= 0)
        and (GetKeyState(VK_RWIN) >= 0)
        {$ENDIF} then
    begin
        Result := TRUE;

        {$IFDEF NIL_EVENTS}
        if assigned( Sender.EV.fOnChar ) then
        {$ENDIF}
        begin
           C := KOLChar( Msg.wParam );
           Sender.EV.fOnChar( Sender, C, GetShiftState );
           Msg.wParam := Integer( C );
        end;

        WStr := WideChar(Msg.wParam);
        if  WStr <> '' then
        begin
            RepeatCount := Msg.lParam and $FFFF;
            if  RepeatCount > 1 then
            begin
                WW := WStr[1];
                for RepeatCount := 2 to RepeatCount do
                    WStr := WStr + WW;
            end;
            Sender.ReplaceSelection( KOLString( WStr ), TRUE );
        end;
        Rslt := 0;
    end;
end;
{$ENDIF _D3orHigher}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewEditbox( AParent: PControl; Options: TEditOptions ) : PControl;
var Flags: Integer;
begin
  Flags := MakeFlags( @Options, EditFlags );
  if not(eoMultiline in Options) then
     Flags := Flags and not(WS_HSCROLL or WS_VSCROLL);
  Result := _NewControl( AParent, 'EDIT', WS_VISIBLE or WS_CHILD or WS_TABSTOP
                         or WS_BORDER or Flags, True,
                         {$IFDEF PACK_COMMANDACTIONS} EditActions_Packed
                         {$ELSE}                      @EditActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Editbox';
  {$ENDIF}
  Result.aAutoSzY := 6;
  with Result.fBoundsRect do
  begin
    Right := Left + 100;
    Bottom := Top + 22;
    if eoMultiline in Options then
    begin
       Right := Right + 100;
       Bottom := Top + 200;
       {$IFDEF USE_FLAGS} include( Result.fFlagsG5, G5_IgnoreDefault );
       {$ELSE} Result.fIgnoreDefault := TRUE; {$ENDIF}
    end;
  end;
  Result.fLookTabKeys := [ tkTab, tkUpDown, tkPageUpPageDn ];
  if  eoMultiline in Options then
      Result.fLookTabKeys := [ tkTab ];
  if  eoWantTab in Options then
      exclude( Result.fLookTabKeys, tkTab );
  {$IFDEF UNICODE_CTRLS}
  {$IFDEF _D3orHigher}
  Result.AttachProc( WndProcUnicodeChars );
  {$ENDIF}
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//===================== List box ========================//

const ListFlags: array[TListOption] of Integer = (
                  LBS_DISABLENOScroll, not LBS_ExtendedSel,
                  LBS_MultiColumn or WS_HSCROLL,
                  LBS_MultiPLESel,
                  LBS_NoIntegralHeight, LBS_NoSel, LBS_Sort, LBS_USETabstops,
                  not LBS_HASSTRINGS, LBS_NODATA, LBS_OWNERDRAWFIXED,
                  LBS_OWNERDRAWVARIABLE, WS_HSCROLL );

{$IFDEF USE_CONSTRUCTORS}
function NewListbox( AParent: PControl; Options: TListOptions ): PControl;
begin
  new( Result, CreateListbox( AParent, Options ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Listbox';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function NewListbox( AParent: PControl; Options: TListOptions ): PControl;
var Flags: Integer;
begin
  Flags := MakeFlags( @Options, ListFlags );
  Result := _NewControl( AParent, 'LISTBOX', WS_VISIBLE or WS_CHILD or WS_TABSTOP
                         or WS_BORDER or WS_VSCROLL
                         or LBS_NOTIFY or Flags, True,
                         {$IFDEF PACK_COMMANDACTIONS} ListActions_Packed
                         {$ELSE}                      @ListActions {$ENDIF} );
  {$IFDEF PACK_COMMANDACTIONS}
          Result.fCommandActions.aClear := ClearListbox;
  {$ENDIF}
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Listbox';
  {$ENDIF}
  with Result.fBoundsRect do
  begin
    Right := Right + 100;
    Bottom := Top + 200;
  end;
  Result.fColor := clWindow;
  Result.fLookTabKeys := [ tkTab, tkLeftRight ];
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//===================== Combo box ========================//

{$IFNDEF USE_DROPDOWNCOUNT}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure ComboboxDropDown( Sender: PObj );
var
  CB: PControl;
  IC: Integer;
begin
  CB := PControl( Sender );
  IC := CB.Count;
  if IC > 8 then IC := 8;
  if IC < 1 then IC := 1;

  SetWindowPos( CB.Handle, 0, 0, 0, CB.Width, CB.Height * (IC + 1) + 2,
                SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_NOREDRAW +
                SWP_HIDEWINDOW);

  SetWindowPos( CB.Handle, 0, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
                + SWP_NOZORDER + SWP_NOACTIVATE
                + SWP_NOREDRAW + SWP_SHOWWINDOW);
  {$IFDEF NIL_EVENTS}
  if  assigned( CB.EV.fOnDropDown ) then
  {$ENDIF}
      CB.EV.fOnDropDown( CB );
end;
{$ENDIF PAS_VERSION}
{$ELSE newcode}
procedure ComboboxDropDown( Sender: PObj );
var
  CB: PControl;
  Count: Integer;
  DropDownCount: Integer;
  ItemHeight: Integer;
begin
  CB := PControl(Sender);
  Count := CB.Count;
  DropDownCount := CB.DropDownCount; // 8;
  if  (Count > DropDownCount) then
      Count := DropDownCount;
  if  (Count < 1) then
      Count := 1;
  ItemHeight := CB.Perform(CB_GETITEMHEIGHT, 0, 0);
  SetWindowPos(
      CB.Handle, 0, 0, 0, CB.Width, ItemHeight * Count + CB.Height + 2,
      SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOREDRAW or SWP_HIDEWINDOW);
  SetWindowPos(
      CB.Handle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or
      SWP_NOACTIVATE or SWP_NOREDRAW or SWP_SHOWWINDOW);
  {$IFDEF NIL_EVENTS}
  if  Assigned(CB.EV.fOnDropDown) then
  {$ENDIF}
      CB.EV.fOnDropDown(CB);
end;
{$ENDIF USE_DROPDOWNCOUNT}

function WndFuncCombo( W: HWnd; Msg: Cardinal; wParam, lParam: Integer )
                                   : Integer; stdcall;
var Combo, Form: PControl;
    ParentWnd : HWnd;
    MsgStruct: TMsg;
    PrevProc:Pointer; //********************************** Added By M.Gerasimov
begin
   Combo := nil;

   ParentWnd := GetParent( W );
   if ParentWnd <> 0 then
     {$IFDEF USE_PROP}
     Combo := Pointer( GetProp( ParentWnd, ID_SELF ) );
     {$ELSE}
     Combo := Pointer( GetWindowLong( ParentWnd, GWL_USERDATA ) );
     {$ENDIF}

   if (Combo <> nil) then
   begin
      MsgStruct.hwnd := Combo.fHandle;
      MsgStruct.message := Msg;
      MsgStruct.wParam := wParam;
      MsgStruct.lParam := lParam;
      Form := Combo.ParentForm;
      if fGlobalProcKeybd( Combo, MsgStruct, Result ) then Exit; {>>>>>>>>>>>>>}
      if W <> Combo.FHandle then
      begin
        if  ( Applet <> nil )
        {$IFDEF NIL_EVENTS} and Assigned( Applet.EV.fOnMessage ) {$ENDIF} then
            if  Applet.EV.fOnMessage( MsgStruct, Result ) then
                Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        if (Applet <> Form) and (Form <> nil) then
        {$IFDEF NIL_EVENTS}
        if  Assigned( Form.EV.fOnMessage ) then
        {$ENDIF}
            if  Form.EV.fOnMessage( MsgStruct, Result ) then
                Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      if (Combo.ToBeVisible) and
         ((Msg = WM_KEYDOWN) or (Msg = WM_KEYUP) or (Msg = WM_CHAR)) then
      begin
        Result := 0;
        if (wParam = VK_TAB) then
        begin
          case Msg of
          WM_KEYDOWN:
            if {$IFDEF NIL_EVENTS} Assigned( Combo.PP.fGotoControl ) and {$ENDIF}
               Combo.PP.fGotoControl( Combo, wParam, FALSE ) then Exit; {>>>>>>}
          else Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          end;
        end
          else
        if (Msg = WM_CHAR) and ((wParam = VK_ESCAPE) or (wParam = VK_RETURN)) then
        begin
          if Combo.Perform( CB_GETDROPPEDSTATE, 0, 0 ) <> 0 then
          begin
            Combo.Perform( CB_SHOWDROPDOWN, 0, 0 );
            if wParam = VK_ESCAPE then
              Combo.Perform( CB_SETCURSEL, Combo.DF.fCurIdxAtDrop, 0 );
            Combo.PP.fWndProcKeybd( Combo, MsgStruct, Result );
            Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          end
          {$IFDEF ESC_CLOSE_DIALOGS}
              //---------------------------------Babenko Alexey--------------------------
              else
              if (wparam = VK_ESCAPE)  then
                if (combo.ParentForm.ExStyle and WS_EX_DLGMODALFRAME) <> 0 then begin
                SendMessage(combo.ParentForm.Handle, WM_CLOSE, 0, 0);
                exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
              end;
          {$ENDIF}
        end;
        {$IFDEF KEY_PREVIEW}
        if  {$IFDEF USE_FLAGS} not(G4_Pushed in Form.fFlagsG4)
            {$ELSE} not Form.fKeyPreviewing {$ENDIF} then
        begin
            if  {$IFDEF USE_FLAGS} G6_KeyPreview in Form.fFlagsG6
                {$ELSE} Form.fKeyPreview {$ENDIF} then
            begin
                {$IFDEF USE_FLAGS} include( Form.fFlagsG4, G4_Pushed );
                {$ELSE} Form.fKeyPreviewing := TRUE; {$ENDIF}
                inc( Form.DF.FKeyPreviewCount );
                //Form.Perform(Msg, wParam, lParam);
                Form.PP.fWndProcKeybd( Form, MsgStruct, Result );
                dec( Form.DF.fKeyPreviewCount );
                if  MsgStruct.wParam = 0 then
                begin
                    Result := 0;
                    Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                end;
            end;
        end;
        {$ENDIF}
        Combo.PP.fWndProcKeybd( Combo, MsgStruct, Result );
      end
        else
      if Msg = WM_SETFOCUS then
      begin
        if Form <> nil then Form.DF.fCurrentControl := Combo;
      end;
      MsgStruct.hwnd := W;
//********************************************************* Added By M.Gerasimov
      PrevProc:=Pointer(GetProp( W, ID_PREVPROC ));
      if PrevProc <> Nil then
       Result := CallWindowProc( PrevProc , W, MsgStruct.message,
         MsgStruct.wParam, MsgStruct.lParam )
      else
       Result:=0;
//*********************************************************
   end
      else
      Result := DefWindowProc( W, Msg, wParam, lParam );
end;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
procedure CreateComboboxWnd( Combo: PControl );
var W : HWND;
    PrevProc: DWORD;
begin
   W := GetWindow( Combo.fHandle, GW_CHILD );
   {if W <> 0 then
     W := GetWindow( W, GW_HWNDNEXT );}
   while W <> 0 do
   begin
     PrevProc :=
       SetWindowLong( W, GWL_WNDPROC, Longint( @WndFuncCombo ) );
     SetProp( W, ID_PREVPROC, PrevProc );                   //
     W := GetWindow( W, GW_HWNDNEXT );
   end;
end;
{$ENDIF PAS_VERSION}

procedure RemoveChldPrevProc( fHandle: HWnd );
var Chld: HWnd;
begin
  Chld := GetWindow( fHandle, GW_CHILD );
  while Chld <> 0 do
  begin
    if GetProp( Chld, ID_PREVPROC ) <> 0 then
      RemoveProp(Chld, ID_PREVPROC);
    Chld := GetWindow( Chld, GW_HWNDNEXT );
  end;
end;

function WndProcCombo( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
{$IFDEF UNICODE_CTRLS}
var s: KOLString;
    w: PWideChar;
    L: Integer;
{$ENDIF}
begin
  Result := FALSE;
  if (Msg.message >= WM_CTLCOLORMSGBOX) and (Msg.message <= WM_CTLCOLORSTATIC) then
  begin
    Rslt := Sender.Perform( Msg.message + CN_BASE, Msg.wParam, Msg.lParam );
    Result := TRUE;
  end
    else
  if (Msg.message >= CN_CTLCOLORMSGBOX) and (Msg.message <= CN_CTLCOLORSTATIC) then
  begin
    if  {$IFDEF USE_FLAGS} G2_Transparent in Sender.fFlagsG2
        {$ELSE} Sender.fTransparent {$ENDIF} then
    case Msg.message of
    CN_CTLCOLORLISTBOX:
      begin
        SetBkMode( Msg.wParam, Windows.OPAQUE );
        SetBkColor(Msg.WParam, Color2RGB( Sender.fColor ) );
        Rslt := Global_GetCtlBrushHandle( Sender );
        Result := TRUE;
      end;
    end;
  end
    else
  if (Msg.message = CM_COMMAND) and Sender.ToBeVisible then
  begin
    case HiWord( Msg.wParam ) of
    CBN_DROPDOWN:
         begin
           Sender.DF.fCurIdxAtDrop := Sender.CurIndex;
           //Sender.fDropDownProc( Sender );
           ComboboxDropDown( Sender );
         end;
    CBN_CLOSEUP:
         begin
           {$IFDEF NIL_EVENTS}
           if  Assigned( Sender.EV.fOnCloseUp ) then
           {$ENDIF}
               Sender.EV.fOnCloseUp( Sender );
         end;
    CBN_SELCHANGE:
         begin
           PostMessage( Sender.fHandle, CM_COMMAND, CM_CBN_SELCHANGE shl 16, 0 );
         end;
    end;
  end
    else
  if Msg.message = WM_DESTROY then
    RemoveChldPrevProc( Sender.Handle )
  {$IFDEF UNICODE_CTRLS}
    else
  if  (Msg.message = CB_INSERTSTRING)
  or  (Msg.message = CB_ADDSTRING) then
  begin
      if  {$IFDEF USE_FLAGS} not(G5_IsButton in Sender.fFlagsG5)
          {$ELSE} not Sender.fIsButton {$ENDIF} then
      begin
          {$IFDEF USE_FLAGS} Include( Sender.fFlagsG5, G5_IsButton );
          {$ELSE} Sender.fIsButton := TRUE; {$ENDIF}
          w := Pointer( Msg.lParam );
          L := WStrLen( w );
          SetLength( s, L );
          move( w^, s[1], L * SizeOf(KOLChar) );
          Rslt := SendMessageW( Msg.hwnd, Msg.message, Msg.wParam,
               Integer( @s[1] ) );
          Result := TRUE;
          {$IFDEF USE_FLAGS} Exclude( Sender.fFlagsG5, G5_IsButton );
          {$ELSE} Sender.fIsButton := FALSE; {$ENDIF}
      end;
  end;
  {$ENDIF}
end;

const ComboFlags: array[ TComboOption ] of Integer = (
      CBS_DROPDOWNLIST, not CBS_AUTOHScroll,
      CBS_DISABLENOSCROLL, CBS_LowerCase, CBS_NoIntegralHeight,
      CBS_OemConvert, CBS_Sort, CBS_UpperCase,
      CBS_OWNERDRAWFIXED, CBS_OWNERDRAWVARIABLE, CBS_SIMPLE );

{$IFDEF USE_CONSTRUCTORS}
function NewCombobox( AParent: PControl; Options: TComboOptions ): PControl;
begin
  new( Result, CreateCombobox( AParent, Options ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Combobox';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewCombobox( AParent: PControl; Options: TComboOptions ): PControl;
var Flags: Integer;
begin
  {$IFDEF GRAPHCTL_XPSTYLES}
  {$IFDEF UNICODE_CTRLS}
  InitCommonControls;
  {$ENDIF}
  {$ENDIF}
  Flags := MakeFlags( @Options, ComboFlags );
  if not LongBool( Flags and CBS_SIMPLE ) then
    Flags := Flags or CBS_DROPDOWN;
  Result := _NewControl( AParent, 'COMBOBOX',
                         WS_VISIBLE
                         or WS_CHILD
                         or WS_VSCROLL
                         or CBS_HASSTRINGS or WS_TABSTOP
                         or Flags
                         ,True,
                         {$IFDEF PACK_COMMANDACTIONS} ComboActions_Packed
                         {$ELSE}                      @ComboActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Combobox';
  {$ENDIF}
  {$IFDEF PACK_COMMANDACTIONS}
  Result.fCommandActions.aClear := @ClearCombobox;
  {$ENDIF}
  Result.aAutoSzY := 6;
  Result.PP.fCreateWndExt := CreateComboboxWnd;
  Result.fClsStyle := Result.fClsStyle or CS_DBLCLKS;
  with Result.fBoundsRect do
  begin
    Right := Left + 100;
    Bottom := Top + 22;
  end;
  Result.fLookTabKeys := [ tkTab ];
  if coReadOnly in Options then
    Result.fLookTabKeys := [ tkTab, tkLeftRight ];
  Result.AttachProc( @ WndProcCombo );
  {$IFDEF USE_DROPDOWNCOUNT}
  Result.DropDownCount := 8;
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

{$IFDEF ASM_TLIST}
function WndProcResize(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
asm
        PUSH     ESI
        CMP      word ptr [EDX].TMsg.message, WM_SIZE
        JNZ      @@exit

        MOV      ESI, [EAX].TControl.fChildren
        MOV      ECX, [ESI].TList.fCount
        JECXZ    @@exit
        MOV      ESI, [ESI].TList.fItems
@@loo:  PUSH     ECX
        LODSD
        PUSH     EAX
        PUSH     EAX
        PUSH     CM_SIZE
        PUSH     EAX
        CALL     TControl.Perform
        POP      ECX
        LOOP     @@loo

@@exit: XOR      EAX, EAX
        POP      ESI
end;
{$ELSE PAS_VERSION} //Pascal
function WndProcResize(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var I: Integer;
    C: PControl;
begin
  if Msg.message = WM_SIZE then
  begin
    for I:= 0 to Self_.fChildren.fCount - 1 do
    begin
      C := Self_.fChildren.Items[ I ];
      C.Perform( CM_SIZE, 0, 0 );
    end;
  end;
  Result := False; // don't stop further processing
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function WndProcParentResize(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := False;
  case Msg.message of
  CM_SIZE:
    begin
      Self_.Perform( WM_SIZE, 0, 0 );
      Self_.Invalidate;
    end;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure InitCommonControlCommonNotify( Ctrl: PControl );
var AParent: PControl;
begin
  {$IFDEF USE_FLAGS} include( Ctrl.fFlagsG5, G5_IsCommonCtl );
  {$ELSE} Ctrl.fIsCommonControl := True; {$ENDIF}
  AParent := Ctrl.Parent;
  if  AParent <> nil then
  begin
      Ctrl.AttachProc( WndProcCommonNotify );
      AParent.AttachProc( WndProcNotify );
  end;
end;
{$ENDIF PAS_VERSION}

procedure InitCommonControlSizeNotify( Ctrl: PControl );
var AParent: PControl;
begin
  AParent := Ctrl.Parent;
  if AParent <> nil then
  begin
    Ctrl.AttachProc( WndProcParentResize );
    AParent.AttachProc( WndProcResize );
  end;
end;

function _NewCommonControl( AParent: PControl; ClassName: PKOLChar; Style: DWORD;
                            Ctl3D: Boolean; Actions: TCommandActionsParam ): PControl;
begin
  {*************} DoInitCommonControls( ICC_WIN95_CLASSES );
  Result := _NewControl( AParent, ClassName, Style, Ctl3D, Actions );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:CommonControl';
  {$ENDIF}
  InitCommonControlCommonNotify( Result );
end;

//==================== Progress bar ======================//

{$IFDEF USE_CONSTRUCTORS}
function NewProgressbar( AParent: PControl ): PControl;
begin
  new( Result, CreateProgressbar( AParent ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Progressbar';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewProgressbar( AParent: PControl ): PControl;
begin
  Result := _NewCommonControl( AParent, PROGRESS_CLASS,
            WS_CHILD or WS_VISIBLE, True,
            {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( PROGRESS_ACTIONS )
            {$ELSE} nil {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:ProgressBar';
  {$ENDIF}
  with Result.fBoundsRect do
  begin
    Right := Left + 300;
    Bottom := Top + 20;
  end;
  Result.fMenu := 0;
  Result.fTextColor := clHighlight;
  Result.fCommandActions.aSetBkColor := PBM_SETBKCOLOR;
  //Result.fNCDestroyed := TRUE; // do not call DestroyWindow!
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

{$IFDEF USE_CONSTRUCTORS}
function NewProgressbarEx( AParent: PControl; Options: TProgressbarOptions ): PControl;
begin
  new( Result, CreateProgressbarEx( AParent, Options ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:ProgressBarEx';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewProgressbarEx( AParent: PControl; Options: TProgressbarOptions ): PControl;
const ProgressBarFlags: array[ TProgressbarOption ] of Integer =
      (PBS_VERTICAL, PBS_SMOOTH );
begin
  Result := NewProgressbar( AParent );
  Result.fStyle.Value := Result.fStyle.Value or
      DWORD( MakeFlags( @Options, ProgressBarFlags ) );
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//===================== List view ========================//

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function WndProcNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var NMhdr: PNMHdr;
    Child: PControl;
begin
  Result := False;
  if Msg.message = WM_NOTIFY then
  begin
    NMhdr := Pointer( Msg.lParam );
    {$IFDEF USE_PROP}
    Child := Pointer( GetProp( NMhdr.hwndFrom, ID_SELF ) );
    {$ELSE}
    Child := Pointer( GetWindowLong( NMhdr.hwndFrom, GWL_USERDATA ) );
    {$ENDIF}
    if (Child <> nil)
       and (Child <> Self_) //+ by Galkov, Jun-2009
    then
    begin
      Msg.hwnd := Child.fHandle;
      Result := EnumDynHandlers( Child, Msg, Rslt );
    end;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function WndProcCommonNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var NMhdr: PNMHdr;
begin
  Result := False;
  if Msg.message = WM_NOTIFY then
  begin
    NMHdr := Pointer( Msg.lParam );
    case NMHdr.code of
      NM_RCLICK,
      NM_CLICK:  {$IFDEF NIL_EVENTS}
                 if assigned( Self_.EV.fOnClick ) then
                 {$ENDIF}
                 begin
                    {$IFDEF USE_FLAGS}
                        if   NMHdr.code = NM_RCLICK then
                             include( Self_.fFlagsG6, G6_RightClick )
                        else exclude( Self_.fFlagsG6, G6_RightClick );
                    {$ELSE} Self_.fRightClick := NMHdr.code=NM_RCLICK; {$ENDIF}
                    Self_.EV.fOnClick( Self_ );
                 end;
      NM_KILLFOCUS: {$IFDEF NIL_EVENTS}
                    if  assigned( Self_.EV.fOnLeave ) then
                    {$ENDIF}
                        Self_.EV.fOnLeave( Self_ );
      NM_RETURN,
      NM_SETFOCUS: {$IFDEF NIL_EVENTS}
                   if  assigned( Self_.EV.fOnEnter ) then
                   {$ENDIF}
                       Self_.EV.fOnEnter( Self_ );
    end;
  end;
end;
{$ENDIF PAS_VERSION}

const ListViewStyles: array[ TListViewStyle ] of DWORD = ( LVS_ICON, LVS_SMALLICON,
                      LVS_LIST, LVS_REPORT, LVS_REPORT or LVS_NOCOLUMNHEADER );
      ListViewFlags: array[ TListViewOption ] of Integer = ( LVS_ALIGNLEFT, LVS_AUTOARRANGE,
                      $400 {LVS_BUTTON}, LVS_EDITLABELS, LVS_NOLABELWRAP,
                      LVS_NOSCROLL, LVS_NOSORTHEADER,
                      not LVS_SHOWSELALWAYS, not LVS_SINGLESEL, LVS_SORTASCENDING,
                      LVS_SORTDESCENDING, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                      LVS_OWNERDATA, LVS_OWNERDRAWFIXED );

      ListViewExFlags: array[ TListViewOption ] of Integer = ( 0, 0,
                      0, 0, 0, 0, 0, 0, 0, 0, 0, LVS_EX_GRIDLINES,
                      LVS_EX_SUBITEMIMAGES, LVS_EX_CHECKBOXES, LVS_EX_TRACKSELECT,
                      LVS_EX_HEADERDRAGDROP, LVS_EX_FULLROWSELECT, LVS_EX_ONECLICKACTIVATE,
                      LVS_EX_TWOCLICKACTIVATE, LVS_EX_FLATSB, LVS_EX_REGIONAL,
                      LVS_EX_INFOTIP, LVS_EX_UNDERLINEHOT, LVS_EX_MULTIWORKAREAS, 0, 0 );

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure ApplyImageLists2Control( Sender: PControl );
var IL: PImageList;
begin
  if Sender.fCommandActions.aSetImgList = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>}
  IL := Sender.ImageListNormal;
  if IL <> nil then
    Sender.Perform( Sender.fCommandActions.aSetImgList, LVSIL_NORMAL, IL.Handle );
  IL := Sender.ImageListSmall;
  if IL <> nil then
    Sender.Perform( Sender.fCommandActions.aSetImgList, LVSIL_SMALL, IL.Handle );
  IL := Sender.ImageListState;
  if IL <> nil then
    Sender.Perform( Sender.fCommandActions.aSetImgList, LVSIL_STATE, IL.Handle );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure ApplyImageLists2ListView( Sender: PControl );
var Flags: DWORD;
begin
  Flags := MakeFlags( @Sender.DF.fLVOptions, ListViewFlags );
  Sender.Style := Sender.Style and not $403F//$4FFC
                  or Flags or ListViewStyles[ Sender.DF.fLVStyle ];
  Flags := MakeFlags( @Sender.DF.fLVOptions, ListViewExFlags );
  Sender.Perform( LVM_SETEXTENDEDLISTVIEWSTYLE, $3FFF, Flags );
  ApplyImageLists2Control( Sender );
end;
{$ENDIF PAS_VERSION}

{$IFDEF USE_CONSTRUCTORS}
function NewListView( AParent: PControl; Style: TListViewStyle; Options: TListViewOptions;
                      ImageListSmall, ImageListNormal, ImageListState: PImageList ): PControl;
begin
  new( Result, CreateListView( AParent, Style, Options, ImageListSmall,
               ImageListNormal, ImageListState ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:ListView';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewListView( AParent: PControl; Style: TListViewStyle; Options: TListViewOptions;
                      ImageListSmall, ImageListNormal, ImageListState: PImageList ): PControl;
begin
  Result := _NewCommonControl( AParent, WC_LISTVIEW, ListViewStyles[ Style ] or
                               LVS_SHAREIMAGELISTS or WS_CHILD or WS_VISIBLE or WS_TABSTOP or WS_CLIPCHILDREN,
                               True, {$IFDEF PACK_COMMANDACTIONS} ListViewActions_Packed
                                     {$ELSE} @ListViewActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:ListView';
  {$ENDIF}
  {$IFDEF PACK_COMMANDACTIONS}
  Result.fCommandActions.aClear := @ClearListView;
  {$ENDIF}
  Result.DF.fLVOptions := Options;
  Result.DF.fLVStyle := Style;
  Result.fStyle.Value := Result.fStyle.Value and not LVS_TYPESTYLEMASK
                  or DWORD( MakeFlags( @Options, ListViewFlags ) );
  Result.PP.fCreateWndExt := ApplyImageLists2ListView;
  with Result.fBoundsRect do
  begin
    Right := Left + 200;
    Bottom := Top + 150;
  end;
  Result.ImageListSmall := ImageListSmall;
  Result.ImageListNormal := ImageListNormal;
  Result.ImageListState := ImageListState;
  Result.DF.fLVTextBkColor := clWindow;
  Result.fLookTabKeys := [ tkTab ];
  //Result.fMargin := 0;
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//=====================  Tree view  ========================//
{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function WndProcTreeView( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var NM: PNMTreeView;
    DI: PTVDispInfo;
    P: TPoint;
    S: KOL_String;
begin
  if Msg.message = WM_NOTIFY then
  begin
      NM := Pointer( Msg.lParam );
      case NM.hdr.code of
      NM_RCLICK:
          begin
            GetCursorPos( P );
            P := Self_.Screen2Client( P );
            Self_.PostMsg( WM_RBUTTONUP, MK_RBUTTON or GetShiftState,
                         (P.x and $FFFF) or (P.y shl 16) );
          end;
      TVN_BEGINDRAG {$IFDEF TV_DRAG_RBUTTON}, TVN_BEGINRDRAG{$ENDIF}:
          {$IFDEF NIL_EVENTS}
          if  Assigned( Self_.EV.fOnTVBeginDrag ) then
          {$ENDIF}
              Self_.EV.fOnTVBeginDrag( Self_, NM.itemNew.hItem );
      TVN_BEGINLABELEDIT:
          begin
              if  {$IFDEF USE_FLAGS} G6_Dragging in Self_.fFlagsG6
                  {$ELSE} Self_.fDragging {$ENDIF} then
              begin
                  Rslt := 1; // do not allow edit while dragging
                  Result := TRUE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
              end;
              DI := Pointer( NM );
              {$IFDEF NIL_EVENTS}
              if  Assigned( Self_.EV.fOnTVBeginEdit ) then
              {$ENDIF}
              begin
                  Rslt := Integer( not Self_.EV.fOnTVBeginEdit( Self_, DI.item.hItem ) );
                  Result := TRUE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
              end;
          end;
      TVN_ENDLABELEDIT:
          begin
              DI := Pointer( NM );
              if  Assigned( Self_.EV.fOnTVEndEdit ) then
              begin
                  S := DI.item.pszText;
                  if  (DI.item.pszText = nil) then
                  begin
                      Result := True; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                  end;
                  Rslt := Integer(
                       Self_.EV.fOnTVEndEdit( Self_, DI.item.hItem, S ) );
              end
              else
                  Rslt := 1;
              Result := True; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          end;
      TVN_ITEMEXPANDING:
          begin
            {$IFDEF NIL_EVENTS}
            if  Assigned( Self_.EV.fOnTVExpanding ) then
            {$ENDIF}
            begin
                Rslt := Integer( Self_.EV.fOnTVExpanding( Self_, NM.itemNew.hItem,
                                 NM.action = TVE_EXPAND ) );
                //Result := TRUE; //Exit;
            end;
          end;
      TVN_ITEMEXPANDED:
          {$IFDEF NIL_EVENTS}
          if  Assigned( Self_.EV.fOnTVExpanded ) then
          {$ENDIF}
              Self_.EV.fOnTVExpanded( Self_, NM.itemNew.hItem, NM.action=TVE_EXPAND );
      TVN_SELCHANGING:
          begin //------------------ TVN_SELCHANGING by Sergey Shisminzev
            {$IFDEF NIL_EVENTS}
            if  Assigned( Self_.EV.fOnTVSelChanging ) then
            {$ENDIF}
            begin
                Rslt := Integer( not Self_.EV.fOnTVSelChanging( Self_, NM.itemOld.hItem, NM.itemNew.hItem ) );
                //Result := TRUE; //Exit;
            end;
          end;  //----------------------------------------
      TVN_SELCHANGED:
          Self_.DoSelChange;
      end;
  end;
  Result := False;
end;
{$ENDIF PAS_VERSION}

function ProcTVDeleteItem( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var NM: PNMTreeView;
begin
  if Msg.message = WM_NOTIFY then
  begin
    NM := Pointer( Msg.lParam );
    case NM.hdr.code of
    TVN_DELETEITEM:
        {$IFDEF NIL_EVENTS}
        if  Assigned( Self_.EV.fOnTVDelete ) then
        {$ENDIF}
            Self_.EV.fOnTVDelete( Self_, NM.itemOld.hItem );
    end;
  end;
  Result := FALSE;
end;

procedure ClearTreeView( TV: PControl );
begin
  TV.TVDelete( TVI_ROOT );
end;

const
  TreeViewFlags: array[ TTreeViewOption ] of Integer = ( not TVS_HASLINES, TVS_LINESATROOT,
                 not TVS_HASBUTTONS, TVS_EDITLABELS, not TVS_SHOWSELALWAYS,
                 not TVS_DISABLEDRAGDROP, TVS_NOTOOLTIPS, TVS_CHECKBOXES,
                 TVS_TRACKSELECT, TVS_SINGLEEXPAND, TVS_INFOTIP,
                 TVS_FULLROWSELECT, TVS_NOSCROLL, TVS_NONEVENHEIGHT );

{$IFDEF USE_CONSTRUCTORS}
function NewTreeView( AParent: PControl; Options: TTreeViewOptions;
                      ImgListNormal, ImgListState: PImageList ): PControl;
begin
  new( Result, CreateTreeView( AParent, Options, ImgListNormal, ImgListState ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:TreeView';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewTreeView( AParent: PControl; Options: TTreeViewOptions;
                      ImgListNormal, ImgListState: PImageList ): PControl;
var Flags: Integer;
begin
  Flags := MakeFlags( @Options, TreeViewFlags );
  Result := _NewCommonControl( AParent, WC_TREEVIEW, Flags or WS_VISIBLE or
            WS_CHILD or WS_TABSTOP, True, {$IFDEF PACK_COMMANDACTIONS} TreeViewActions_Packed
                                          {$ELSE} @TreeViewActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:TreeView';
  {$ENDIF}
  {$IFDEF PACK_COMMANDACTIONS}
  Result.fCommandActions.aClear := @ClearTreeView;
  {$ENDIF}
  Result.PP.fCreateWndExt := ApplyImageLists2Control;
  Result.fColor := clWindow;
  Result.AttachProc( WndProcTreeView );
  with Result.fBoundsRect do
  begin
    Right := Left + 150;
    Bottom := Top + 200;
  end;
  Result.ImageListNormal := ImgListNormal;
  Result.ImageListState := ImgListState;
  Result.fLookTabKeys := [ tkTab ];
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//===================== Tab Control ========================//

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function WndProcTabControl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Hdr: PNMHdr;
    A: Integer;
    R: TRect;
    WasActive: Boolean;
{$IFDEF OLD_ALIGN}
    Page: PControl;
    I: Integer;
begin
  case Msg.message of
    WM_NOTIFY:
      begin
        Hdr := Pointer( Msg.lParam );
        case Hdr.code of
        TCN_SELCHANGING:
          Self_.fCurIndex := Self_.GetCurIndex;
        TCN_SELCHANGE:
          begin
            A := {Self_.????}Self_.GetCurIndex;
            WasActive := Self_.fCurIndex = A;
            Self_.fCurIndex := A;
            for I := 0 to Self_.Count - 1 do
            begin
              Page := Self_.Pages[ I ];
              Page.Visible := A = I;
              if A = I then
                Page.BringToFront;
            end;
            if  not WasActive then
            {$IFDEF NIL_EVENTS}
            if  Assigned( Self_.EV.fOnSelChange ) then
            {$ENDIF}
                Self_.EV.fOnSelChange( Self_ );
          end;
        end;
      end;
    WM_SIZE:
      begin
        GetClientRect( Self_.fHandle, R );
        Self_.Perform( TCM_ADJUSTRECT, 0, Integer( @R ) );
        for I := 0 to Self_.Count - 1 do
        begin
          Page := Self_.Pages[ I ];
          Page.BoundsRect := R;
        end;
{$ELSE NEW_ALIGN}
begin
  case Msg.message of
    WM_NOTIFY:
      begin
        Hdr := Pointer( Msg.lParam );
        case Hdr.code of
        TCN_SELCHANGING:
          Self_.fCurIndex := Self_.GetCurIndex;
        TCN_SELCHANGE:
          begin
            A := Self_.GetCurIndex;
            WasActive := Self_.fCurIndex = A;
            if (not WasActive)and(Self_.fCurIndex>=0) then
              Self_.Pages[Self_.fCurIndex].Visible := false;
            Self_.fCurIndex := A;
            Self_.Pages[Self_.fCurIndex].Visible := true;
            Self_.Pages[Self_.fCurIndex].BringToFront;
            if  not WasActive then
            {$IFDEF NIL_EVENTS}
            if  Assigned( Self_.EV.fOnSelChange ) then
            {$ENDIF}
                Self_.EV.fOnSelChange( Self_ );
          end;
        end;
      end;
    WM_SIZE:
      begin
        GetClientRect( Self_.fHandle, R );
        Self_.fClientRight := R.Right;
        Self_.fClientBottom := R.Bottom;
        Self_.Perform( TCM_ADJUSTRECT, 0, Integer( @R ) );
        Self_.fClientLeft := R.Left;
        Self_.fClientTop := R.Top;
        Dec(Self_.fClientRight,R.Right);
        Dec(Self_.fClientBottom,R.Bottom);
{$ENDIF}
      end;
  end;
  Result := False;
end;
{$ENDIF PAS_VERSION}

{$IFDEF GRAPHCTL_XPSTYLES}
  {$DEFINE RICHEDIT_XPBORDER}
{$ENDIF}

{$IFDEF RICHEDIT_XPBORDER}
function WndProc_RichEditXPBorder( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var ExStyle: DWORD;
    DrawRect, EmptyRect: TRect;
    DC: HDC;
    Details: TThemedElementDetails;
begin
  Result := FALSE;
  if Msg.message = WM_NCPAINT then
  begin
    ExStyle := GetWindowLong(Self_.Handle, GWL_EXSTYLE);
    if (ExStyle and WS_EX_CLIENTEDGE) <> 0 then
    begin
      GetWindowRect(Self_.Handle, DrawRect);
      OffsetRect(DrawRect, -DrawRect.Left, -DrawRect.Top);
      DC := GetWindowDC(Self_.Handle);
      //try
        EmptyRect := DrawRect;
        with DrawRect do
          ExcludeClipRect(DC, Left + 2, Top + 2, Right - 2, Bottom - 2);
        Details.Element := teEdit;
        Details.Part := 1 {EP_EDITTEXT};
        Details.State := Ord(teEditTextNormal) - Ord(teEditTextNormal) + 1;
        if not Assigned( DrawThemeBackground ) then
        begin
          ThemeLibrary := LoadLibrary(themelib);
          DrawThemeBackground := GetProcAddress(ThemeLibrary, 'DrawThemeBackground');
          OpenThemeData := GetProcAddress(ThemeLibrary, 'OpenThemeData');
        end;
        if Assigned( DrawThemeBackground ) then
        begin
          Result := TRUE;
          Rslt := Self_.CallDefWndProc( Msg );
          with Details do
            DrawThemeBackground(OpenThemeData(0, 'edit'),
              DC, Part, State, DrawRect, nil);
        end;
      //finally
        ReleaseDC(Self_.Handle, DC);
      //end;
    end;
  end;
end;
{$ENDIF RICHEDIT_XPBORDER}

const TabControlFlags: array[ TTabControlOption ] of Integer = ( TCS_BUTTONS,
           TCS_FIXEDWIDTH, not TCS_FOCUSNEVER,
           TCS_FIXEDWIDTH or TCS_FORCEICONLEFT, TCS_FIXEDWIDTH or TCS_FORCELABELLEFT,
           TCS_MULTILINE, TCS_MULTISELECT, TCS_RIGHTJUSTIFY, TCS_SCROLLOPPOSITE,
           TCS_BOTTOM, TCS_VERTICAL, TCS_FLATBUTTONS, TCS_HOTTRACK, 0, TCS_OWNERDRAWFIXED );

{$IFDEF USE_CONSTRUCTORS}
function NewTabControl( AParent: PControl; Tabs: array of String; Options: TTabControlOptions;
         ImgList: PImageList; ImgList1stIdx: Integer ): PControl;
begin
  new( Result, CreateTabControl( AParent, Tabs, Options, ImgList, ImgList1stIdx ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:TabControl';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function NewTabControl( AParent: PControl; const Tabs: array of PKOLChar; Options: TTabControlOptions;
         ImgList: PImageList; ImgList1stIdx: Integer ): PControl;
var I, II : Integer;
    Flags: Integer;
begin
  Flags := MakeFlags( @Options, TabControlFlags );
  if tcoFocusTabs in Options then
    Flags := Flags or (WS_TABSTOP or TCS_FOCUSONBUTTONDOWN);
  Result := _NewCommonControl( AParent, WC_TABCONTROL,
            Flags or (WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_VISIBLE),
            True, {$IFDEF PACK_COMMANDACTIONS} TabControlActions_Packed
                  {$ELSE} @TabControlActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:TabControl';
  {$ENDIF}
  if not( tcoBorder in Options ) then
  begin
    Result.fExStyle := Result.fExStyle and not WS_EX_CLIENTEDGE;
  end;
  Result.AttachProc( WndProcTabControl );
  with Result.fBoundsRect do
  begin
    Right := Left + 100;
    Bottom := Top + 100;
  end;
  if ImgList <> nil then
    Result.Perform( TCM_SETIMAGELIST, 0, ImgList.Handle );
  II := ImgList1stIdx;
  for I := 0 to High( Tabs ) do
  begin
    Result.TC_Insert( I, Tabs[ I ], II );
    Inc( II );
  end;
  Result.fLookTabKeys := [ tkTab ];
end;
{$ENDIF PAS_VERSION}

{$IFNDEF OLD_ALIGN}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewTabEmpty( AParent: PControl; Options: TTabControlOptions;
         ImgList: PImageList ): PControl;
var Flags: Integer;
begin
  Flags := MakeFlags( @Options, TabControlFlags );
  if tcoFocusTabs in Options then
    Flags := Flags or (WS_TABSTOP or TCS_FOCUSONBUTTONDOWN);
  Result := _NewCommonControl( AParent, WC_TABCONTROL,
            Flags or (WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_VISIBLE),
            True, {$IFDEF PACK_COMMANDACTIONS} TabControlActions_Packed
                  {$ELSE} @TabControlActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:TabControl(TabEmpty)';
  {$ENDIF}
  if not( tcoBorder in Options ) then
    Result.fExStyle := Result.fExStyle and not WS_EX_CLIENTEDGE;
  Result.AttachProc( WndProcTabControl );
  with Result.fBoundsRect do begin
    Right := Left + 100;
    Bottom := Top + 100;
  end;
  if ImgList <> nil then
    Result.Perform( TCM_SETIMAGELIST, 0, ImgList.Handle );
  Result.fLookTabKeys := [ tkTab ];
end;
{$ENDIF PAS_VERSION}
{$ENDIF}

{$ENDIF USE_CONSTRUCTORS}

//===================== Tool bar ========================//

{$IFDEF ASM_TLIST} //TTN_NEEDTEXTW  ASM_TLIST!
{$IFDEF _D3orHigher}
{$IFDEF ASM_VERSION}
procedure CopyPChar2WideChars( dest: PWideChar; src: PChar; Len: Integer );
asm
          PUSH  ESI
          PUSH  EDI
          XCHG  EDI, EAX
          MOV   ESI, ECX
          PUSH  0
          MOV   EAX, ESP
          CALL  System.@LStrFromPChar
          MOV   EAX, [ESP]
          CALL  System.@LStrLen
          TEST  EAX, EAX
          JZ    @@exit_copy
          CMP   ESI, EAX
          JL    @@1_len
          XCHG  EAX, ESI
@@1_len:
          POP   EDX
          PUSH  EDX
          PUSH  0
          MOV   EAX, ESP
          CALL  System.@WStrFromLStr

          MOV   ECX, ESI
          INC   ECX
          POP   ESI
          PUSH  ESI
          REP   MOVSW
          MOV   EAX, ESP
          CALL  System.@WStrClr
          POP   EAX
@@exit_copy:
          MOV   EAX, ESP
          CALL  System.@LStrClr
          POP   EAX
          POP   EDI
          POP   ESI
end;
{$ELSE  PAS_VERSION}
procedure CopyPChar2WideChars( dest: PWideChar; src: PChar; Len: Integer );
var W: WideString;
    s: String;
begin
    s := src;
    if  Len > Length(s) then
        Len := Length(s);
    W := s;
    Move( W[1], dest^, (Len+1) * Sizeof( WideChar ) );
end;
{$ENDIF PAS_VERSION}
{$ENDIF _D3orHigher}

function WndProcToolbarCtrl(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
asm
        PUSH     EBX
        XOR      EBX, EBX
        CMP      word ptr [EDX].TMsg.message, WM_WINDOWPOSCHANGED
        JNE      @@chk_CM_COMMAND
        MOV      dword ptr [ECX], 0 // Rslt := 0
        XCHG     EDX, EAX
        {$IFDEF  EVENTS_DYNAMIC}
        MOV      EDX, [EDX].TControl.EV
        MOV      ECX, [EDX].TEvents.fOnResize.TMethod.Code
        MOV      EAX, [EDX].TEvents.fOnResize.TMethod.Data
        {$ELSE}
        MOV      ECX, [EDX].TControl.EV.fOnResize.TMethod.Code
        MOV      EAX, [EDX].TControl.EV.fOnResize.TMethod.Data
        {$ENDIF}
        {$IFDEF  NIL_EVENTS}
        JECXZ    @@ret_true1
        {$ENDIF}
        CALL     ECX                // Self_.fOnResize
@@ret_true1:
        MOV      AL, 1              // Result := TRUE
        POP      EBX
        RET
@@chk_CM_COMMAND: //////////////////////////////////////////////////////////////
        CMP      word ptr [EDX].TMsg.message, CM_COMMAND
        JNE      @@chk_WM_NOTIFY
        MOVZX    ECX, word ptr [EDX].TMsg.wParam
        MOV      [EAX].TControl.DF.fTBCurItem, ECX
        XCHG     EBX, EAX
            PUSH     0
            PUSH     ECX
            PUSH     TB_COMMANDTOINDEX
            PUSH     EBX
            CALL     TControl.Perform
            PUSH     EAX
                PUSH     VK_RETURN
                CALL     GetKeyState
                TEST     EAX, EAX
            POP      ECX
        MOV      [EBX].TControl.fCurIndex, ECX
        {$IFDEF  USE_FLAGS}
        SETL     DL
        SHL      DL, G6_RightClick
        AND      [EBX].TControl.fFlagsG6, not(1 shl G6_RightClick)
        OR       [EBX].TControl.fFlagsG6, DL
        {$ELSE}
        SETL     DL
        MOV      [EBX].TControl.fRightClick, DL
        {$ENDIF}
@@ret_false1:
        XOR      EAX, EAX
        POP      EBX
        RET
@@chk_WM_NOTIFY: ///////////////////////////////////////////////////////////////
        CMP      word ptr [EDX].TMsg.message, WM_NOTIFY
        JNE      @@ret_false1
        MOV      EDX, [EDX].TMsg.lParam
        MOV      ECX, [EDX].TTooltipText.hdr.code
        CMP      ECX, TTN_NEEDTEXT
        JE       @@TTN_NEEDTEXT
        CMP      ECX, TTN_NEEDTEXTW
        JNE      @@chk_NM_RCLICK
        MOV      BL, 1
@@TTN_NEEDTEXT:
        PUSH     EAX  // ###>
        PUSH     EDX  // ***>
        MOV      EDX, [EDX].TTooltipText.hdr.idFrom
        MOV      ECX, [EAX].TControl.DF.fTBttCmd
        OR       EAX, -1
        JECXZ    @@idxReady
        XCHG     EAX, ECX
        CALL     TList.IndexOf
@@idxReady: // EAX = -1 or index of button tooltip
        POP      EDX  //<***
        LEA      EDX, [EDX].TTooltipText.szText
        AND      word ptr [EDX], 0
        POP      ECX  //<###
        TEST     EAX, EAX
        JL       @@ret_true1
        MOV      ECX, [ECX].TControl.DF.fTBttTxt
        MOV      ECX, [ECX].TStrList.fList
        MOV      ECX, [ECX].TList.fItems
        MOV      EAX, [ECX+EAX*4]
        XCHG     EAX, EDX
        XOR      ECX, ECX
        MOV      CL, 79
        {$IFDEF  _D3orHigher}
        CMP      BL, 0
        JZ       @@strlcopy
        {$IFDEF  UNICODE_CTRLS}
        CALL     WStrLCopy
        {$ELSE}
        //CALL     CopyPChar2WideChars (inlined here)
          PUSH  ESI
          PUSH  EDI
          XCHG  EDI, EAX
          MOV   ESI, ECX
          PUSH  0
          MOV   EAX, ESP
          CALL  System.@LStrFromPChar
          MOV   EAX, [ESP]
          CALL  System.@LStrLen
          TEST  EAX, EAX
          JZ    @@exit_copy
          CMP   ESI, EAX
          JL    @@1_len
          XCHG  EAX, ESI
@@1_len:
          POP   EDX
          PUSH  EDX
          PUSH  0
          MOV   EAX, ESP
          CALL  System.@WStrFromLStr

          MOV   ECX, ESI
          INC   ECX
          POP   ESI
          PUSH  ESI
          REP   MOVSW
          MOV   EAX, ESP
          CALL  System.@WStrClr
          POP   EAX
@@exit_copy:
          MOV   EAX, ESP
          CALL  System.@LStrClr
          POP   EAX
          POP   EDI
          POP   ESI
        {$ENDIF}
        JMP      @@ret_true1
        {$ENDIF _D3orHigher}
@@strlcopy:
        CALL     StrLCopy
        JMP      @@ret_true1
@@chk_NM_RCLICK: ///////////////////////////////////////////////////////////////
        CMP      ECX, NM_RCLICK
        JNE      @@chk_NM_CLICK
        {$IFDEF  USE_FLAGS}
        OR       [EAX].TControl.fFlagsG6, 1 shl G6_RightClick
        {$ELSE}
        OR       [EAX].TControl.fRightClick, 1
        {$ENDIF}
        MOV      ECX, [EDX].TNMMouse.dwItemSpec
        OR       [EAX].TControl.fCurIndex, -1
        XCHG     EBX, EAX
        PUSH     0
        PUSH     ECX
        PUSH     TB_COMMANDTOINDEX
        PUSH     EBX
        CALL     TControl.Perform
        MOV      [EBX].TControl.fCurIndex, EAX
        JMP      @@ret_false1
@@chk_NM_CLICK:  ///////////////////////////////////////////////////////////////
        CMP      ECX, NM_CLICK
        JNE      @@chk_TBN_DROPDOWN
        {$IFDEF  USE_FLAGS}
        AND      [EAX].TControl.fFlagsG6, not(1 shl G6_RightClick)
        {$ELSE}
        MOV      [EAX].TControl.fRightClick, 0
        {$ENDIF}
        OR       [EAX].TControl.DF.fTBCurItem, -1
        OR       [EAX].TControl.fCurIndex, -1
        CMP      [EDX].TTBNotify.iItem, -1
        SETNZ    AL
        POP      EBX
        RET
@@chk_TBN_DROPDOWN: ////////////////////////////////////////////////////////////
        CMP      ECX, TBN_DROPDOWN
        JNE      @@ret_false1
        MOV      EDX, [EDX].TTBNotify.iItem
        MOV      [EAX].TControl.DF.fTBCurItem, EDX
        PUSH     EAX
        CALL     TControl.TBItem2Index
        POP      EDX
        MOV      [EDX].TControl.fCurIndex, EAX
        {$IFDEF  EVENTS_DYNAMIC}
        MOV      EAX, [EDX].TControl.EV
        MOV      ECX, [EAX].TEvents.fOnDropDown.TMethod.Code
        {$ELSE}
        MOV      ECX, [EDX].TControl.EV.fOnDropDown.TMethod.Code
        {$ENDIF}
        {$IFDEF  NIL_EVENTS}
        JECXZ    @@ret_z
        {$ENDIF}
        {$IFDEF  EVENTS_DYNAMIC}
        MOV      EAX, [EAX].TEvents.fOnDropDown.TMethod.Data
        {$ELSE}
        MOV      EAX, [EDX].TControl.EV.fOnDropDown.TMethod.Data
        {$ENDIF}
        CALL     ECX
@@ret_z:
        XOR      EAX, EAX
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function WndProcToolbarCtrl(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
var lpttt: PTooltipText;
    idBtn, Idx: Integer;
var Notify: PTBNotify;
    Mouse: PNMMouse;
{$IFNDEF _FPC}
{$IFNDEF _D2}
var WStr: KOLWideString;
{$ENDIF _D2}
{$ENDIF _FPC}
begin
  Result := False;
  if  Msg.message = WM_WINDOWPOSCHANGED then
  begin
      {$IFDEF NIL_EVENTS}
      if  Assigned( Self_.EV.fOnResize ) then
      {$ENDIF}
          Self_.EV.fOnResize( Self_ );
      {$IFNDEF TOOLBAR_FORCE_CHILDALIGN}
      //-- removed by MTsv DN (v.290), crash in Win 98:
      //-- if WinVer >= wvNT then // todo: check it.
        Result := TRUE; // this provides (prevents?) the Align working for child controls of Toolbar !
                        // but removing this line makes it impossible to correct the Align property for
                        // the neighbour controls on form!!!
      {$ENDIF}
      Rslt := 0;
  end
  else if Msg.message = CM_COMMAND then
  begin
    Self_.DF.fTBCurItem := Loword( Msg.wParam );
    Self_.fCurIndex := Self_.Perform( TB_COMMANDTOINDEX, Loword( Msg.wParam ), 0 );
    {$IFDEF USE_FLAGS}
        if   GetKeyState( VK_RBUTTON ) < 0 then
             include( Self_.fFlagsG6, G6_RightClick )
        else exclude( Self_.fFlagsG6, G6_RightClick );
    {$ELSE}  Self_.fRightClick := GetKeyState( VK_RBUTTON ) < 0; {$ENDIF}
  end
  else if Msg.message = WM_NOTIFY then
  begin
    lpttt := Pointer( Msg.lParam );
    Notify := Pointer( Msg.lParam );
    case lpttt.hdr.code of
    TTN_NEEDTEXT:
        begin
          Result := True;
          idBtn := lpttt.hdr.idFrom;
          Idx := -1;
          if Self_.DF.fTBttCmd <> nil then
            Idx := Self_.DF.fTBttCmd.IndexOf( Pointer( idBtn ) );
          lpttt.szText[ 0 ] := #0;
          if Idx >= 0 then
            {$IFDEF UNICODE_CTRLS} WStrLCopy {$ELSE} StrLCopy {$ENDIF}
              ( lpttt.szText, Self_.DF.fTBttTxt.fList.Items[ Idx ], 79 );
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
      {$IFNDEF _FPC}
      {$IFNDEF _D2}
      TTN_NEEDTEXTW: // for Windows XP
          begin
            Result := True;
            idBtn := lpttt.hdr.idFrom;
            Idx := -1;
            if Self_.DF.fTBttCmd <> nil then
              Idx := Self_.DF.fTBttCmd.IndexOf( Pointer( idBtn ) );
            ZeroMemory( @lpttt.szText[ 0 ], 160 );
            if Idx >= 0 then
            begin
              WStr := KOLWideString(Self_.DF.fTBttTxt.Items[ Idx ]);
              if WStr <> '' then
                Move( Wstr[ 1 ], lpttt.szText, Min( 158,
                      (Length( WStr ) + 1) * Sizeof(WideChar) ) );
            end;
            Exit;{>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          end;
    {$ENDIF _D2}
    {$ENDIF _FPC}
    NM_RCLICK:
        begin
          Mouse := Pointer( Msg.lParam );
          Self_.DF.fTBCurItem := Mouse.dwItemSpec;
          Self_.fCurIndex := Self_.Perform( TB_COMMANDTOINDEX, Mouse.dwItemSpec, 0 );
          {$IFDEF USE_FLAGS} include( Self_.fFlagsG6, G6_RightClick );
          {$ELSE}            Self_.fRightClick := True;       {$ENDIF}
        end;
    NM_CLICK:
        begin
          Self_.DF.fTBCurItem := -1; // return CurItem = -1
          Self_.fCurIndex := -1;
          {$IFDEF USE_FLAGS}
              exclude( Self_.fFlagsG6, G6_RightClick );
          {$ELSE}
              Self_.fRightClick := False;
          {$ENDIF}
          Result := Notify.iItem <> -1; // do not handle - will be handled in WM_COMMAND
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
    TBN_DROPDOWN:
        begin
          Self_.DF.fTBCurItem := Notify.iItem;
          Self_.fCurIndex := Self_.TBItem2Index( Self_.DF.fTBCurItem );
          {$IFDEF NIL_EVENTS}
          if  assigned( Self_.EV.fOnDropDown ) then
          {$ENDIF}
              Self_.EV.fOnDropDown( Self_ );
        end;
    end;
  end;
end;
{$ENDIF PAS_VERSION}

const ToolbarAligns: array[ TControlAlign ] of DWORD =
      ( CCS_NOPARENTALIGN {or CCS_NOMOVEY} {or CCS_NORESIZE} or CCS_NODIVIDER, CCS_TOP or CCS_VERT, CCS_TOP, CCS_BOTTOM or CCS_VERT, CCS_BOTTOM,
        CCS_TOP );
      ToolbarOptions: array[ TToolbarOption ] of Integer = ( TBSTYLE_LIST, not TBSTYLE_LIST,
                     TBSTYLE_FLAT, TBSTYLE_TRANSPARENT, TBSTYLE_WRAPABLE, CCS_NODIVIDER, 0,
                     TBSTYLE_CUSTOMERASE );

{$IFDEF USE_CONSTRUCTORS}
function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarOptions;
                     Bitmap: HBitmap; Buttons: array of PAnsiChar;
                     BtnImgIdxArray: array of Integer ) : PControl;
begin
  new( Result, CreateToolbar( AParent, Align, Options, Bitmap, Buttons, BtnImgIdxArray ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Toolbar';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarOptions;
                     Bitmap: HBitmap; const Buttons: array of PKOLChar;
                     const BtnImgIdxArray: array of Integer ) : PControl;
var Flags: DWORD;
begin
  if  Options <> [] then
  begin
      if  not( tboTextBottom in Options ) then
          include( Options, tboTextRight );
      if  tboTextRight in Options then
          exclude( Options, tboTextBottom );
  end;
  Flags := MakeFlags( @Options, ToolbarOptions )
        //or TBSTYLE_AUTOSIZE
        //or CCS_NOPARENTALIGN or CCS_NOMOVEY //or CCS_NORESIZE
        or CCS_NODIVIDER or TBSTYLE_TRANSPARENT
  ;
  DoInitCommonControls( ICC_BAR_CLASSES );
  Result := _NewCommonControl( AParent, TOOLBARCLASSNAME,
        (ToolbarAligns[ Align ] or WS_CHILD or WS_VISIBLE or TBSTYLE_TOOLTIPS
        or Flags  and not (TBSTYLE_FLAT or TBSTYLE_TRANSPARENT)), {!ecm}
        tbo3DBorder in Options,
        {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( TOOLBAR_ACTIONS )
        {$ELSE} nil {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:Toolbar';
  {$ENDIF}
  Result.fCommandActions.aClear := ClearToolbar; ///+++ anyway +++///
  Result.fCommandActions.aGetCount := TB_BUTTONCOUNT;
  {$IFDEF USE_FLAGS} include( Result.fFlagsG5, G5_IsButton );
  {$ELSE} Result.fIsButton := TRUE; {$ENDIF}
  with Result.fBoundsRect do
  begin
    if Align in [ caNone ] then
    begin
      Bottom := Top + 26;
      Right := Left + 1000;
    end
       else
    begin
      Left := 0; Right := 0;
      Top := 0; Bottom := 0;
    end;
  end;
  Result.AttachProc( WndProcToolbarCtrl );
  Result.AttachProc( WndProcDoEraseBkgnd );
  Result.Perform(TB_SETEXTENDEDSTYLE, 0, Result.Perform(TB_GETEXTENDEDSTYLE, 0, 0) or
      TBSTYLE_EX_DRAWDDARROWS);

  Result.Perform( TB_BUTTONSTRUCTSIZE, Sizeof( TTBButton ), 0 );
  Result.Perform( TB_SETINDENT, Result.fMargin, 0 );
  with Result.fBoundsRect do
  begin
    if Align in [ caLeft, caRight ] then
      Right := Left + 24
    else if not (Align in [caNone]) then
      Bottom := Top + 22;
  end;
  {$IFnDEF TBBUTTONS_DFLT_NOAUTOSIZE}
  Result.DF.fDefaultTBBtnStyle := TBSTYLE_AUTOSIZE;
  {$ENDIF}
  if Bitmap <> 0 then
    Result.TBAddBitmap( Bitmap );
  Result.TBAddButtons( Buttons, BtnImgIdxArray );
  Result.Perform( WM_SIZE, 0, 0 );
  Result.Style := Result.Style or Flags; {+ecm}
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}

//================== DateTimePicker =====================//

{$IFDEF ASM_UNICODE}{$ELSE  PAS_VERSION}
function WndProcDateTimePickerNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var NMhdr: PNMHdr;
    D: TDateTime;
    AllowChg: Boolean;
    NMDTString: PNMDateTimeString;
begin
  Result := False;
  if Msg.message = WM_NOTIFY then
  begin
    NMHdr := Pointer( Msg.lParam );
    CASE NMHdr.code OF
    DTN_DROPDOWN:{$IFDEF NIL_EVENTS}
                 if  Assigned( Self_.EV.fOnDropDown ) then
                 {$ENDIF}
                     Self_.EV.fOnDropDown( Self_ );
    DTN_CLOSEUP: {$IFDEF NIL_EVENTS}
                 if  Assigned( Self_.EV.fOnCloseUp ) then
                 {$ENDIF}
                     Self_.EV.fOnCloseUp( Self_ );
    DTN_DATETIMECHANGE:
      {$IFDEF NIL_EVENTS}
      if  Assigned( Self_.EV.fOnChangeCtl ) then
      {$ENDIF}
          Self_.EV.fOnChangeCtl( Self_ );
    DTN_USERSTRING:
      {$IFDEF NIL_EVENTS}
      if  Assigned( Self_.EV.fOnDTPUserString ) then
      {$ENDIF}
      begin
          NMDTString := Pointer( NMHdr );
          D := Self_.DateTime;
          AllowChg := TRUE;
          Self_.EV.fOnDTPUserString( Self_, KOLString(NMDTString.pszUserString), D, AllowChg );
          NMDTString.dwFlags := Integer( not AllowChg );
      end;
    END;
  end;
end;
{$ENDIF PAS_VERSION}

const
  DateTimePickerOptions: array[ TDateTimePickerOption ] of Integer = (
    DTS_TIMEFORMAT, DTS_LONGDATEFORMAT, DTS_UPDOWN, DTS_RIGHTALIGN,
    DTS_SHOWNONE, DTS_APPCANPARSE );

function NewDateTimePicker( AParent: PControl; Options: TDateTimePickerOptions )
         : PControl;
var Flags: DWORD;
const
  CS_OFF = CS_OWNDC or CS_CLASSDC or CS_PARENTDC or CS_GLOBALCLASS or
           CS_VREDRAW or CS_HREDRAW;
begin
  DoInitCommonControls( ICC_DATE_CLASSES );
  Flags := MakeFlags( @Options, DateTimePickerOptions );
  Result := _NewCommonControl( AParent, DATETIMEPICK_CLASS,
         (WS_CHILD or WS_VISIBLE or WS_TABSTOP or Flags {or DTS_APPCANPARSE}),
         TRUE, {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS )
               {$ELSE} nil {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:DateTimePicker';
  {$ENDIF}
  Result.SetSize( 110, 24 );
  Result.AttachProc( WndProcDateTimePickerNotify );
end;

procedure TControl.SetDateTime(Value: TDateTime);
var ST: TSystemTime;
    D0: TDateTime;
begin
  if  not IsNAN( Value ) then
  begin
      EncodeDate( 1899, 12, 31, D0 );
      if  Trunc( Value ) < D0 then
          Value := Frac( Value ) + D0;
      DateTime2SystemTime( Value, ST );
  end;
  Perform( DTM_SETSYSTEMTIME, Integer( IsNAN( Value ) ) , Integer( @ ST ) );
end;

function TControl.GetDateTime: TDateTime;
var ST: TSystemTime;
begin
  if Perform( DTM_GETSYSTEMTIME, 0, Integer( @ ST ) ) = GDT_VALID then
    SystemTime2DateTime( ST, Result )
  else
    Result := NAN;
end;

function TControl.Get_SystemTime: TSystemTime;
begin
    //FillChar( Result, Sizeof( Result ), #0 );
    ZeroMemory( @Result, Sizeof( Result ) );
    Perform( DTM_GETSYSTEMTIME, 0, Integer( @ Result ) ); // <> GDT_VALID then
end;

procedure TControl.Set_SystemTime(const Value: TSystemTime);
begin
  Perform( DTM_SETSYSTEMTIME, Integer( Value.wYear = 0 ) , Integer( @ Value ) );
end;

function TControl.GetDate: TDateTime;
begin
  Result := DateTime;
  if not IsNAN( Result ) then
    Result := Trunc( DateTime );
end;

function TControl.GetTime: TDateTime;
begin
  Result := DateTime;
  if not IsNAN( Result ) then
    Result := Frac( Result );
end;

procedure TControl.SetDate(const Value: TDateTime);
begin
  if IsNAN( Value ) then
    DateTime := Value
  else
  if not IsNAN( DateTime ) then
    DateTime := Trunc( Value ) + Frac( DateTime )
  else
    DateTime := Trunc( Value );
end;

procedure TControl.SetTime(const Value: TDateTime);
begin
  if IsNAN( Value ) then
    DateTime := Value
  else
  if not IsNAN( DateTime ) then
    DateTime := Trunc( DateTime ) + Frac( Value )
  else
    DateTime := 1.0 + Frac( Value );
end;

function TControl.GetDateTimeRange: TDateTimeRange;
var ST_R: array[ 0..1 ] of TSystemTime;
begin
  Perform( DTM_GETRANGE, 0, Integer( @ ST_R[ 0 ] ) );
  SystemTime2DateTime( ST_R[ 0 ], Result.FromDate );
  SystemTime2DateTime( ST_R[ 1 ], Result.ToDate );
end;

procedure TControl.SetDateTimeRange(Value: TDateTimeRange);
var ST_R: array[ 0..1 ] of TSystemTime;
begin
  DateTime2SystemTime( Value.FromDate, ST_R[ 0 ] );
  DateTime2SystemTime( Value.ToDate  , ST_R[ 1 ] );
  Perform( DTM_SETRANGE,
           Integer( IsNAN( Value.FromDate ) ) or
           (Integer( IsNAN( Value.ToDate ) ) shl 1),
           Integer( @ ST_R[ 0 ] ) );
end;

function TControl.GetDateTimePickerColor( Index: TDateTimePickerColor): TColor;
begin
  Result := Perform( DTM_GETMCCOLOR, Integer( Index ), 0 );
end;

procedure TControl.SetDateTimePickerColor(
  Index: TDateTimePickerColor; Value: TColor);
begin
  Perform( DTM_SETMCCOLOR, Integer( Index ), Color2RGB( Value ) );
end;

procedure TControl.SetDateTimeFormat(const Value: KOLString);
begin
  Perform( DTM_SETFORMAT, 0, Integer( PKOLChar( Value ) ) );
end;

function TControl.GetTBAutoSizeButtons: Boolean;
begin
    Result := DF.fDefaultTBBtnStyle and TBSTYLE_AUTOSIZE <> 0;
end;

function TControl.GetTVEditing: Boolean;
begin
    Result := Perform( TVM_GETEDITCONTROL, 0, 0 ) <> 0;
end;

procedure TControl.SetTBAutoSizeButtons(const Value: Boolean);
begin
    DF.fDefaultTBBtnStyle := Integer( Value ) shl 4;
end;

{$IFDEF USE_FLAGS}
function TControl.GetTabStop: Boolean;
begin
    Result := F2_Tabstop in fStyle.f2_Style;
end;

procedure TControl.SetTabStop(const Value: Boolean);
begin
    if  Value then include( fStyle.f2_Style, F2_Tabstop )
              else exclude( fStyle.f2_Style, F2_Tabstop );
end;

function TControl.GetWordWrap: Boolean;
begin
    Result := G1_WordWrap in fFlagsG1;
end;

procedure TControl.SetWordWrap(const Value: Boolean);
begin
    if  Value then include( fFlagsG1, G1_WordWrap )
              else exclude( fFlagsG1, G1_WordWrap );
end;

function TControl.GetCannotDoubleBuf: Boolean;
begin
    Result := G1_CanNotDoublebuf in fFlagsG1;
end;

procedure TControl.SetCannotDoubleBuf(const Value: Boolean);
begin
    if  Value then include( fFlagsG1, G1_CanNotDoublebuf )
              else exclude( fFlagsG1, G1_CanNotDoublebuf );
end;

function TControl.GetDoubleBuffered: Boolean;
begin
    Result := G2_DoubleBuffered in fFlagsG2;
end;

function TControl.GetTransparent: Boolean;
begin
    Result := G2_Transparent in fFlagsG2;
end;

function TControl.GetIsForm: Boolean;
begin
    Result := G3_IsForm in fFlagsG3;
end;

function TControl.GetSizeGrip: Boolean;
begin
    Result := G3_SizeGrip in fFlagsG3;
end;

procedure TControl.SetSizeGrip(const Value: Boolean);
begin
    if  Value then include( fFlagsG3, G3_SizeGrip )
              else exclude( fFlagsG3, G3_SizeGrip );
end;

function TControl.GetIsApplet: Boolean;
begin
    Result := G3_IsApplet in fFlagsG3;
end;

function TControl.GetIsControl: Boolean;
begin
    Result := G3_IsControl in fFlagsG3;
end;

function TControl.GetIsMDIChild: Boolean;
begin
    Result := G3_IsMDIChild in fFlagsG3;
end;

function TControl.GetCreateVisible: Boolean;
begin
    Result := G4_CreateVisible in fFlagsG4;
end;

procedure TControl.SetCreateVisible(const Value: Boolean);
begin
    if  Value then include( fFlagsG4, G4_CreateVisible )
              else exclude( fFlagsG4, G4_CreateVisible );
end;

function TControl.GetIsButton: Boolean;
begin
    Result := G5_IsButton in fFlagsG5;
end;

function TControl.GetFlat: Boolean;
begin
    Result := G3_Flat in fFlagsG3;
end;

function TControl.GetMouseInCtl: Boolean;
begin
    Result := G3_MouseInCtl in fFlagsG3;
end;

function TControl.GetEraseBackground: Boolean;
begin
    Result := G5_EraseBkgnd in fFlagsG5;
end;

procedure TControl.SetEraseBackground(const Value: Boolean);
begin
    if  Value then include( fFlagsG5, G5_EraseBkgnd )
              else exclude( fFlagsG5, G5_EraseBkgnd );
end;

function TControl.Get3ButtonPress: Boolean;
begin
    Result := G5_3ButtonPress in fFlagsG5;
end;

function TControl.GetKeyPreview: Boolean;
begin
    Result := G6_KeyPreview in fFlagsG6;
end;

procedure TControl.SetKeyPreview(const Value: Boolean);
begin
    if  Value then include( fFlagsG6, G6_KeyPreview )
              else exclude( fFlagsG6, G6_KeyPreview );
end;

function TControl.GetIgnoreDefault: Boolean;
begin
    Result := G5_IgnoreDefault in fFlagsG5;
end;

procedure TControl.SetIgnoreDefault(const Value: Boolean);
begin
    if  Value then include( fFlagsG5, G5_IgnoreDefault )
              else exclude( fFlagsG5, G5_IgnoreDefault );
end;

function TControl.GetWindowed: Boolean;
begin
    Result := not(G6_GraphicCtl in fFlagsG6);
end;

procedure TControl.SetWindowed(const Value: Boolean);
begin
    if  Value then exclude( fFlagsG6, G6_GraphicCtl )
              else include( fFlagsG6, G6_GraphicCtl );
end;

function TControl.Get_RightClick: Boolean;
begin
    Result := G6_RightClick in fFlagsG6;
end;

function TControl.Get_Dragging: Boolean;
begin
    Result := G6_Dragging in fFlagsG6;
end;

function TControl.Get_SizeRedraw: Boolean;
begin
    Result := G1_SizeRedraw in fFlagsG1;
end;

procedure TControl.Set_SizeRedraw(const Value: Boolean);
begin
    if Value then include( fFlagsG1, G1_SizeRedraw )
             else exclude( fFlagsG1, G1_SizeRedraw );
end;

{$ENDIF USE_FLAGS}

function TControl.GetDroppedDown: Boolean;
begin
    Result := DF.fTBDropped
           or (Perform( CB_GetDroppedState, 0, 0 ) <> 0);
end;

//===================== RichEdit ========================//
{$IFNDEF NOT_USE_RICHEDIT}
type PENLink = ^TENLink;
     TENLink = packed record
       hdr: TNMHDR;
       msg: DWORD;
       wParam: Integer;
       lParam: Integer;
       chrg: TCHARRANGE;
     end;
  TEXTRANGEA = packed record
    chrg: TCharRange;
    lpstrText: PAnsiChar;
  end;

{$IFDEF not_ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function WndProc_RE_LinkNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Link: PENLink;
    Range: TextRangeA;
    Buffer: Array[ 0..1023 ] of AnsiChar; // KOL_ANSI
    Buf_W : array[ 0..511 ] of WideChar absolute Buffer;
    s: KOLString;
begin
  Result := False;
  if (Msg.message = WM_NOTIFY) and (PNMHdr( Msg.lParam ).code = EN_LINK) then
  begin
    Link := Pointer( Msg.lParam );
    Range.chrg := Link.chrg;
    Range.lpstrText := @Buffer[ 0 ];
    Buffer[ 0 ] := #0;
    Self_.Perform( EM_GETTEXTRANGE, 0, Integer( @Range ) );
    {$IFDEF UNICODE_CTRLS}
    s := Buf_W; //todo: check it!
    {$ELSE}
        {$IFDEF _D3orHigher}
        if  (Buffer[ 1 ] = #0) and (Range.chrg.cpMax - Range.chrg.cpMin > 1) then
            begin
            {$WARNINGS OFF}
            s := Buf_W;
            {$WARNINGS ON}
            end
        else
        {$ENDIF}
            s := Buffer;
    {$ENDIF}
    if  Self_.DF.fREUrl <> nil then
        FreeMem( Self_.DF.fREUrl );
    if  s <> '' then
    begin
        GetMem( Self_.DF.fREUrl, (Length(s)+1) * Sizeof(KOLChar) );
        Move( s[1], Self_.DF.fREUrl^, (Length(s)+1)*Sizeof(KOLChar) );
    end;
    case Link.msg of
    WM_MOUSEMOVE:
      {$IFDEF NIL_EVENTS}
      if  assigned( Self_.EV.fOnREOverURL ) then
      {$ENDIF}
          Self_.EV.fOnREOverURL( Self_ );
    WM_LBUTTONDOWN, WM_RBUTTONDOWN:
      {$IFDEF NIL_EVENTS}
      if  assigned( Self_.EV.fOnREUrlClick ) then
      {$ENDIF}
          Self_.EV.fOnREUrlClick( Self_ );
    end;
    Rslt := 0;
    Result := TRUE;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_noVERSION}
function WndProcRichEditNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
const int_IDC_ARROW = integer( IDC_ARROW );
asm
        CMP      word ptr [EDX].TMsg.message, WM_NOTIFY
        JNE      @@chk_WM_DESTROY
        MOV      EDX, [EDX].TMsg.lParam
        CMP      [EDX].TNMHdr.code, EN_SELCHANGE
        JNE      @@ret_false
        CALL     TControl.DoSelChange
        JMP      @@ret_false
@@chk_WM_DESTROY:
        CMP      word ptr [EDX].TMsg.message, WM_DESTROY
        JNZ      @@ret_false
        LEA      EAX, [EAX].TControl.fREUrl
        CALL     @LStrClr
@@ret_false:
        XOR      EAX, EAX
        RET
end;
{$ELSE PAS_VERSION} //Pascal
function WndProcRichEditNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var NMhdr: PNMHdr;
begin
  Result := False;
  if Msg.message = WM_NOTIFY then
  begin
    NMHdr := Pointer( Msg.lParam );
    case NMHdr.code of
    EN_SELCHANGE:
      begin
        Self_.DoSelChange;
        if  {$IFDEF USE_FLAGS} G2_Transparent in Self_.fFlagsG2
            {$ELSE} Self_.fTransparent {$ENDIF} then
            Self_.Invalidate;
      end;
    end;
  end
    else
  if Msg.message = WM_DESTROY then
  begin
    if  Self_.DF.fREUrl <> nil then
        FreeMem( Self_.DF.fREUrl );
    Self_.DF.fREURL := nil;
  end;
end;
{$ENDIF PAS_VERSION}

const RichEditflags: array [ TEditOption ] of Integer = (
                  not (es_AutoHScroll or WS_HSCROLL),
                  not (es_AutoVScroll or WS_VSCROLL),
                  0 {es_Lowercase - not supported},
                  0 {es_Multiline - RichEdit always multiline},
                  es_NoHideSel,
                  0 {es_OemConvert - not suppoted},
                  0 {es_Password - not supported},
                  es_Readonly,
                  0 {es_UpperCase - not supported},
                  es_WantReturn, 0, es_Number );

{$IFDEF USE_CONSTRUCTORS}
function NewRichEdit1( AParent: PControl; Options: TEditOptions ): PControl;
begin
  new( Result, CreateRichEdit1( AParent, Options ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:RichEdit';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF noASM_UNICODE}
function NewRichEdit1( AParent: PControl; Options: TEditOptions ): PControl;
const
  RichNamesCount = High( RichEditLibnames ) + 1;
asm
        PUSH     EDX

        MOV      ECX, [FRichEditModule]
        INC      ECX
        LOOP     @@loaded
        PUSHAD
        {$IFNDEF SMALLEST_CODE}
        {$IFNDEF SMALLER_CODE}
        PUSH     SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS
        CALL     SetErrorMode
        PUSH     EAX
        {$ENDIF}
        {$ENDIF}
@@search_richedit:
        MOV      BX, RichNamesCount + $400
        LEA      ESI, [RichEditLibNames]
        LEA      EDI, [RichEditClasses]
        CMP      [RichEditIdx], 0
        JZ       @@loo
        LEA      ESI, [ESI+(RichNamesCount-1)*4]
        LEA      EDI, [EDI+(RichNamesCount-1)*4]
        NEG      BH
@@loo:
        MOV      ECX, [EDI]
        MOV      [RichEditClass], ECX
        MOVSX    ECX, BH
        ADD      EDI, ECX
        MOV      EAX, [ESI]
        ADD      ESI, ECX
        PUSH     EAX
        CALL     LoadLibrary
        CMP      EAX, HINSTANCE_ERROR
        JG       @@break
        DEC      BL
        JNZ      @@loo
        JMP      @@fault
@@break:
        MOV      [FRichEditModule], EAX
@@fault:
        {$IFNDEF SMALLEST_CODE}
        {$IFNDEF SMALLER_CODE}
        CALL     SetErrorMode
        {$ENDIF}
        {$ENDIF}
        POPAD
@@loaded:
        PUSH     EAX
        PUSH     EDX
        MOV      EAX, ESP
        MOV      EDX, offset[RichEditFlags]
        XOR      ECX, ECX
        MOV      CL, 10
        CALL     MakeFlags
        XCHG     ECX, EAX
        POP      EDX
        POP      EAX
        PUSH     1
        {$IFDEF  PACK_COMMANDACTIONS}
        PUSH     [RichEditActions_Packed]
        {$ELSE}
        PUSH     offset[RichEditActions]
        {$ENDIF}
        MOV      EDX, [RichEditClass]
        OR       ECX, WS_VISIBLE or WS_CHILD or WS_TABSTOP or WS_BORDER or ES_MULTILINE
        CALL     _NewCommonControl
        {$IFDEF  USE_FLAGS}
        OR       [EAX].TControl.fFlagsG5, 1 shl G5_IgnoreDefault
        {$ELSE}
        INC      [EAX].TControl.fIgnoreDefault
        {$ENDIF}
        POP      EDX
        TEST     DH, 4 // is eoWantTab in Options ?
        SETZ     DL
        MOV      [EAX].TControl.fLookTabKeys, DL
        PUSH     EBX
        MOV      EBX, EAX
        MOV      EDX, offset[WndProcRichEditNotify]
        CALL     TControl.AttachProc
        {$IFDEF  USE_FLAGS}
        OR       [EBX].TControl.fFlagsG1, (1 shl G1_CanNotDoublebuf)
        AND      [EBX].TControl.fFlagsG2, not (1 shl G2_DoubleBuffered)
        {$ELSE}
        INC      [EBX].TControl.fCannotDoubleBuf
        MOV      [EBX].TControl.fDoubleBuffered, 0
        {$ENDIF  USE_FLAGS}
        ADD      [EBX].TControl.fBoundsRect.Right, 100-64
        ADD      [EBX].TControl.fBoundsRect.Bottom, 200-64
        PUSH     ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or ENM_PROTECTED or $04000000
        PUSH     0
        PUSH     EM_SETEVENTMASK
        PUSH     EBX
        CALL     TControl.Perform
        MOV      EAX, clWindow
        MOV      [EBX].TControl.fColor, EAX
        CALL     Color2RGB
        PUSH     EAX
        PUSH     0
        PUSH     EM_SETBKGNDCOLOR
        PUSH     EBX
        CALL     TControl.Perform
        {$IFDEF RICHEDIT_XPBORDER}
        MOV      EDX, offset[WndProc_RichEditXPBorder]
        MOV      EAX, EBX
        CALL     TControl.AttachProc
        {$ENDIF RICHEDIT_XPBORDER}
        XCHG     EAX, EBX
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function NewRichEdit1( AParent: PControl; Options: TEditOptions ): PControl;
var Flags, I, d, Last, SaveErrMode: Integer;
label search_richedit;
begin
  {$IFDEF INPACKAGE}
  Log( '->NewRichEdit1' );
  TRY
  {$ENDIF INPACKAGE}
  if  FRichEditModule = 0 then
  begin
  search_richedit:
      I := RichEditIdx;
      Last := High( RichEditLibnames );
      d := 1;
      if RichEditIdx > 1 then // 50W, 20A
      begin
        I := Last;
        Last := 0;
        d := -1;
      end;
      SaveErrMode := SetErrorMode( SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS );
      while I <> Last + d do
      begin
        FRichEditModule := LoadLibrary( RichEditLibnames[ I ] );
        RichEditClass := RichEditClasses[ I ];
        if FRichEditModule > HINSTANCE_ERROR then break;
        inc( I, d );
      end;
      if FRichEditModule <= HINSTANCE_ERROR then
        FRichEditModule := 0;
      SetErrorMode( SaveErrMode );
  end;
  Flags := MakeFlags( @Options, RichEditFlags );
  {$IFDEF INPACKAGE}
  Log( '//// calling _NewCommonControl' );
  {$ENDIF INPACKAGE}
  Result := _NewCommonControl( AParent, RichEditClass, WS_VISIBLE or WS_CHILD
                         or WS_TABSTOP or WS_BORDER or ES_MULTILINE or Flags,
                         True, {$IFDEF PACK_COMMANDACTIONS} RichEditActions_Packed
                               {$ELSE} @RichEditActions {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:RichEdit';
  {$ENDIF}
  {$IFDEF STATIC_RICHEDIT_DATA}{$ELSE}
  Result.DF.fRECharFormatRec := AllocMem( Sizeof( TCharFormat ) + Sizeof( TParaFormat2 ) );
  Result.DF.fREParaFmtRec := Pointer( Integer( @ Result.DF.fRECharFormatRec )
                          + Sizeof( TCharFormat ) );
  Result.Add2AutoFreeEx( Result.FreeCharFormatRec );
  {$ENDIF}
  {$IFDEF INPACKAGE}
  Log( '//// after _NewCommonControl called' );
  {$ENDIF INPACKAGE}
  Result.fLookTabKeys := [ tkTab ];
  if eoWantTab in Options then
     Result.fLookTabKeys := [ ];

  Result.AttachProc( WndProcRichEditNotify );
  {$IFDEF USE_FLAGS}
          include( Result.fFlagsG1, G1_CanNotDoublebuf );
          exclude( Result.fFlagsG2, G2_DoubleBuffered );
          include( Result.fFlagsG5, G5_IgnoreDefault );
  {$ELSE} Result.fCannotDoubleBuf := True;
          Result.fDoubleBuffered := False;
          Result.fIgnoreDefault := TRUE;
  {$ENDIF}
  with Result.fBoundsRect do
  begin
    Right := Right + 100;
    Bottom := Top + 200;
  end;
  {$IFDEF INPACKAGE}
  Log( '//// before Perform' );
  {$ENDIF INPACKAGE}
  Result.Perform( EM_SETEVENTMASK, 0,
    ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or
    ENM_PROTECTED or $04000000 {ENM_LINK} or ENM_KEYEVENTS );
  {$IFDEF INPACKAGE}
  Log( '//// after Perform' );
  {$ENDIF INPACKAGE}
  Result.fColor := clWindow;
  Result.Perform( EM_SETBKGNDCOLOR, 0, Color2RGB(Result.fColor));
  {$IFDEF RICHEDIT_XPBORDER}
  Result.AttachProc( WndProc_RichEditXPBorder );
  {$ENDIF}
  {$IFDEF INPACKAGE}
    LogOK;
  FINALLY
    Log( '<-NewRichEdit1' );
  END;
  {$ENDIF INPACKAGE}
end;
{$ENDIF PAS_VERSION}
{$ENDIF NOT_USE_RICHEDIT}

{$ENDIF USE_CONSTRUCTORS}

function OleInitialize(pwReserved: Pointer): HResult; stdcall;
  external 'ole32.dll' name 'OleInitialize';
procedure OleUninitialize; stdcall;
  external 'ole32.dll' name 'OleUninitialize';

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function OleInit: Boolean;
begin
  if OleInitCount = 0 then
  begin
    Result := False;
    if OleInitialize( nil ) <> 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Inc( OleInitCount );
  Result := True;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure OleUnInit;
begin
  if OleInitCount > 0 then
  begin
    Dec( OleInitCount );
    if OleInitCount = 0 then
      OleUninitialize;
  end;
end;
{$ENDIF PAS_VERSION}

function SysAllocStringLen;
         external 'oleaut32.dll' name 'SysAllocStringLen';
procedure SysFreeString( psz: PWideChar ); stdcall;
         external 'oleaut32.dll' name 'SysFreeString';

function StringToOleStr(const Source: Ansistring): PWideChar;
var
  SourceLen, ResultLen: Integer;
  Buffer: array[0..1023] of WideChar;
begin
  SourceLen := Length(Source);
  if Length(Source) < SizeOf(Buffer) div 2 then
    Result := SysAllocStringLen(Buffer, MultiByteToWideChar(0, 0,
      PAnsiChar(Source), SourceLen, Buffer, SizeOf(Buffer) div 2))
  else
  begin
    ResultLen := MultiByteToWideChar(0, 0,
      Pointer(Source), SourceLen, nil, 0);
    Result := SysAllocStringLen(nil, ResultLen);
    MultiByteToWideChar(0, 0, Pointer(Source), SourceLen,
      Result, ResultLen);
  end;
end;

{$IFNDEF NOT_USE_RICHEDIT}
{$IFDEF USE_CONSTRUCTORS}
function NewRichEdit( AParent: PControl; Options: TEditOptions ): PControl;
begin
  new( Result, CreateRichEdit( AParent, Options ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:RichEdit';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewRichEdit( AParent: PControl; Options: TEditOptions ): PControl;
begin
  {$IFDEF INPACKAGE}
  Log( '->NewRichEdit' );
  TRY
  {$ENDIF INPACKAGE}
  if OleInit then
  begin
    {$IFDEF INPACKAGE}
    Log( '//// OleInit OK: call NewRichEdit1' );
    {$ENDIF INPACKAGE}
    {$IFDEF UNICODE_CTRLS}
    RichEditIdx := 0;
    {$ELSE}
    RichEditIdx := 0; // Richedit20A / RichEdit
    {$ENDIF}
    Result := NewRichEdit1( AParent, Options );
    Result.DF.fCharFmtDeltaSz := 24; //sizeof( TCharFormat2 ) - sizeof( RichEdit.TCharFormat );
                           // sizeof( TCharFormat2 ) is calculated incorrectly
    Result.DF.fParaFmtDeltaSz := sizeof( TParaFormat2 ) - sizeof( RichEdit.TParaFormat );
  end
     else
     begin
       {$IFDEF INPACKAGE}
       Log( '//// OleInit failed: call NewRichEdit1' );
       {$ENDIF INPACKAGE}
    Result := NewRichEdit1( AParent, Options );
     end;
  {$IFDEF INPACKAGE}
    LogOK;
  FINALLY
    Log( '<-NewRichEdit' );
  END;
  {$ENDIF INPACKAGE}
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_CONSTRUCTORS}
{$ENDIF NOT_USE_RICHEDIT}

//=====================================================================//
{$ENDIF WIN_GDI}

{ TControl }

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.Init;
{$IFNDEF OLD_EVENTS_MODEL}
var i: Integer;
{$ENDIF}
begin
  {$IFDEF CALL_INHERITED}
  inherited; // nothing here for Delphi 4 and higher
  {$ENDIF}
  {$IFDEF GDI}
  {$IFDEF OLD_EVENTS_MODEL}
      {$IFDEF USE_GRAPHCTLS}
      PP.fDoInvalidate        := InvalidateWindowed;
      {$ENDIF}
      PP.fOnDynHandlers       := WndProcDummy;
      PP.fWndProcKeybd        := WndProcDummy;
      //{-2.95}PP.fWndProcResizeFlicks := WndProcDummy;
      PP.fPass2DefProc        := WndProcDummy;
      PP.fControlClick        := DummyObjProc;
      PP.fAutoSize            := DummyObjProc;
      PP.fWndFunc             := @ WndFunc;
  {$ELSE}
      {$IFDEF EVENTS_DYNAMIC}
          if  not Assigned( EmptyEvents.fOnMessage ) then
              for i := 0 to idx_LastEvent do
                  EmptyEvents.MethodEvents[i].Code := DummyProcTable[InitEventsTable[i] and $F];
          EV := @ EmptyEvents;
          for i := 0 to High(PP.Procedures) do
              PP.Procedures[i] := DummyProcTable[InitEventsTable[i] shr 4];
      {$ELSE}
          for i := 0 to idx_LastEvent do
          begin
              EV.MethodEvents[i].Code := DummyProcTable[InitEventsTable[i] and $F];
              //EV.MethodEvents[i].Data := @Self;
              if  i < idx_LastProc - idx_LastEvent then
                  PP.Procedures[i] := DummyProcTable[InitEventsTable[i] shr 4];
          end;
      {$ENDIF}
  {$ENDIF NEW_EVENTS_MODEL}
  fAlphaBlend := 255;
  //---- fCommandActions.aClear  := ClearText; //--- moved to _NewWindowed
  fColor := clBtnFace;
  fTextColor := clWindowText;
  {$ENDIF GDI}
  fMargin := 2;
  {$IFDEF GDI}
  //fCtl3D := True; fCtl3Dchild := True;
  fCtl3D_child := 3;
  {$ENDIF GDI}
  fChildren := NewList;
  {$IFDEF GDI}
  fClsStyle := CS_OWNDC;
  fStyle.Value := WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or
            WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or
            WS_BORDER or WS_THICKFRAME;
  fExStyle := WS_EX_CONTROLPARENT;
  {$ENDIF GDI}
  {$IFDEF USE_FLAGS}
  {$ELSE} fWindowed := True;
          fVisible := True;
          fEnabled := True;
  {$ENDIF}
  fDynHandlers := NewList;
end;
{$ENDIF PAS_VERSION}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.InitParented( AParent: PControl );
begin
  Init;
  if AParent <> nil then
     fColor := AParent.fColor;
  Parent := AParent;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TControl.InitParented( AParent: PControl; widget: PGtkWidget;
  need_eventbox: Boolean );
BEGIN
  Init;
  fHandle := widget;
  fCaptionHandle := fHandle;
  fEventboxHandle := fHandle;
  IF  need_eventbox THEN
  BEGIN
      fEventboxHandle := gtk_event_box_new();
      gtk_widget_set_events( fEventboxHandle, GDK_ALL_EVENTS_MASK );
      //gtk_container_add( GTK_CONTAINER( AParent.fHandle ), fEventboxHandle );
      gtk_widget_show( fEventboxHandle );
      gtk_container_add( GTK_CONTAINER( fEventboxHandle ), fHandle );
  END;
  g_object_set_data( G_OBJECT( fEventboxHandle ), ID_SELF, @ Self );
  if AParent <> nil then
     fColor := AParent.fColor;
  Parent := AParent;
END;
{$ENDIF GTK}
{$ENDIF _X_}
{$IFDEF WIN_GDI}

procedure TControl.InitOrthaned( AParentWnd: HWnd );
begin
    Init;
    FParentWnd := AParentWnd;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TControl.Destroy;
var I: Integer;
    F: PControl;
    Ico: HIcon;
begin
  {$IFDEF USE_CUSTOMEXTENSIONS}
    {$I CUSTOM_TCONTROL_DESTROY.INC}
  {$ENDIF}
   {$IFDEF USE_MHTOOLTIP}
   {$DEFINE destroy}
   /////fHint.Free;
   {$UNDEF destroy}
   {$ENDIF USE_MHTOOLTIP}
   {$IFDEF DEBUG_ANY}
   F := nil;
   TRY
     F := ParentForm; // or Applet - for form ???
   EXCEPT
     asm
       nop
     end;
   END;
   {$ELSE}
   F := ParentForm; // or Applet - for form ???
   {$ENDIF DEBUG_ANY}
   if F <> nil then
   if F.DF.FCurrentControl = @Self then
      F.DF.FCurrentControl := nil;

   if fHandle <> 0 then
      ShowWindow( fHandle, SW_HIDE );

   Final;
   {$IFDEF USE_AUTOFREE4CHILDREN}
   {$ELSE}
   DestroyChildren;
   {$ENDIF}

   if  {$IFDEF USE_FLAGS} not(G2_Destroying in fFlagsG2)
       {$ELSE} not fDestroying {$ENDIF} then
   begin
       {$IFDEF USE_FLAGS} include( fFlagsG2, G2_Destroying );
       {$ELSE}            fDestroying := True; {$ENDIF}

       if  {$IFDEF USE_FLAGS} G6_CtlClassNameChg in fFlagsG6
           {$ELSE} fCtlClsNameChg {$ENDIF} then
       begin
           FreeMem( fControlClassName );
           {$IFDEF USE_FLAGS} exclude( fFlagsG6, G6_CtlClassNameChg );
           {$ELSE} fCtlClsNameChg := FALSE; {$ENDIF}
       end;

       {$IFDEF USE_AUTOFREE4CONTROLS}
       {$ELSE}
       fFont.Free;
       fFont := nil;
       fBrush.Free;
       fBrush := nil;
       {$ENDIF}
       fCanvas.Free;
       fCanvas := nil;

       if fHandle <> 0 then
       begin
         {$IFNDEF NEW_MENU_ACCELL}
         {$IFDEF USE_AUTOFREE4CONTROLS}
         {$ELSE}
         if fAccelTable <> 0 then
         begin
           DestroyAcceleratorTable( fAccelTable );
           fAccelTable := 0;
         end;
         {$ENDIF}
         {$ENDIF}
         {$IFDEF USE_AUTOFREE4CONTROLS}
         {$ELSE}
         fMenuObj.Free;
         while fImageList <> nil do
           fImageList.Free;
         {$ENDIF}
         I := fHandle;
           Ico := DF.fIcon;
           if (Ico <> 0) and (Ico <> HIcon(-1)) then
           if  {$IFDEF USE_FLAGS} not(G1_IconShared in fFlagsG1)
               {$ELSE} not fIconShared {$ENDIF} then
               DestroyIcon( Ico );
         if IsWindow( I ) then
         begin
  //       RemoveProp( I, ID_SELF );  //************** Remarked By M.Gerasimov
           {$IFDEF USE_fNCDestroyed}
           if not fNCDestroyed then
           {$ENDIF}
           begin
             {$IFDEF DEBUG_ENDSESSION}
             if EndSession_Initiated then
               LogFileOutput( GetStartDir + 'es_debug.txt',
                              'DESTROYING HWND:' + Int2Str( I ) );
             {$ENDIF}
             (* -- moved to WM_NCDESTROY -- VK + Alexey Kirov, 23.02.2012
             {$IFnDEF SMALLER_CODE}
                 {$IFDEF USE_PROP}
                 SetProp( I, ID_SELF, 0 );
                 {$ELSE}
                 SetWindowLong( I, GWL_USERDATA, 0 );
                 {$ENDIF}
             {$ENDIF}
             *)
               DestroyWindow( I );
           end;
         end;
         fHandle := 0;
       end;

       if fCustomData <> nil then
         FreeMem( fCustomData );
       fCustomData := nil;
       fCustomObj.Free;
       fCustomObj := nil;

       if  fTmpBrush <> 0 then
           DeleteObject( fTmpBrush );
       fTmpBrush := 0;

       //if FCaption <> nil then FreeMem( FCaption );
       fCaption := '';
       //if fStatusTxt <> nil then
       //   FreeMem( fStatusTxt );

       if fParent <> nil then
       begin
          fParent.fChildren.Remove( @Self );
          {$IFDEF USE_AUTOFREE4CHILDREN}
          fParent.RemoveFromAutoFree( @ Self );
          {$ENDIF}
          if  fParent.DF.fCurrentControl = @Self then
              fParent.DF.fCurrentControl := nil;
       end;

       fChildren.Free;
       {$IFDEF USE_AUTOFREE4CONTROLS}
       {$ELSE}
       DF.fTBttCmd.Free;
       DF.fTBttTxt.Free;
       fTmpFont.Free;
       {$ENDIF}
       fDynHandlers.Free;
       inherited;
   end;
end;
{$ENDIF PAS_VERSION}

   {$IFDEF USE_MHTOOLTIP}
   {$DEFINE code}
    function TControl.GetHint: PMHHint;
    begin
      if fHint = nil then
        fHint := NewHint(@Self);
      Result := fHint;
    end;
   {$UNDEF code}
   {$ENDIF}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetEnabled( Value: Boolean );
begin
   if GetEnabled = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   {$IFDEF USE_FLAGS}
   {$ELSE}
   fEnabled := Value;
   {$ENDIF USE_FLAGS}
   if   Value then
        exclude( fStyle.f3_Style, F3_Disabled )
   else include( fStyle.f3_Style, F3_Disabled );
   if  fHandle <> 0 then
   begin
       {$IFDEF USE_FLAGS}
       EnableWindow( fHandle, not(F3_Disabled in fStyle.f3_Style));
       {$ELSE}
       EnableWindow( fHandle, fEnabled );
       {$ENDIF}
   end;
   Invalidate; // necessary for Graphic controls
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_noVERSION}
{$ELSE PAS_VERSION} //Pascal
function TControl.GetParentWindow: HWnd;
begin
  Result := GetParentWnd( TRUE );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TControl.GetWindowHandle: HWnd;
begin
  {$IFDEF INPACKAGE}
  Log( '->TControl.GetWindowHandle' );
  TRY
  {$ENDIF INPACKAGE}
   if fHandle = 0 then
   begin
     {$IFDEF CREATE_HIDDEN}
     if  {$IFDEF USE_FLAGS} not(G4_CreateVisible in fFlagsG4)
         {$ELSE} not fCreateVisible {$ENDIF} then
     begin
         Set_Visible( False );
         CreateWindow; //virtual!!!
         {$IFDEF USE_FLAGS} include( fFlagsG4, G4_CreateHidden );
         {$ELSE} fCreateHidden := True; {$ENDIF}
     end else
     {$ENDIF CREATE_HIDDEN}
         CreateWindow; //virtual!!!
   end;
   Result := fHandle;
  {$IFDEF INPACKAGE}
    LogOK;
  FINALLY
    Log( '<-TControl.GetWindowHandle' );
  END;
  {$ENDIF INPACKAGE}
end;
{$ENDIF PAS_VERSION}

{$IFDEF DEBUG_CREATEWINDOW}
procedure Debug_CreateWindow1( _Self: PControl );
begin
   {LogFileOutput( GetStartDir + 'Session.log', 'TControl.CreateWindow, ' +
                  ' Self = ' + Int2Str( Integer( _Self ) ) +
                  ' Caption = ' + _Self.fCaption +
                  ' fChildren = ' + Int2Hex( Integer( _Self.fChildren ), 4 ) +
                  ' ChildCount = ' + Int2Str( _Self.ChildCount ) );}
end;

procedure Debug_CreateWindow2( _Self: PControl; const Params: TCreateWndParams );
begin
   LogFileOutput( GetStartDir + 'Session.log',
                  ' ExStyle=' + Int2Hex( Params.ExStyle, 4 ) +
                  ' WinClassName=' + Params.WinClassName +
                  ' Caption=' + Params.Caption +
                  ' Style=' + Int2Hex( Params.Style, 4 ) +
                  ' X=' + Int2Str( Params.X ) +
                  ' Y=' + Int2Str( Params.Y ) +
                  ' Width=' + Int2Str( Params.Width ) +
                  ' Height=' + Int2Str( Params.Height ) +
                  //' WndParent=' + Int2Str( Params.WndParent ) +
                  ' Parent=' + Int2Hex( DWORD( _Self.Parent ), 6 ) +
                  ' Menu=' + Int2Str( Params.Menu ) +
                  ' hInstance=' + Int2Str( Params.WindowClass.hInstance ) +
                  ' Param=' + Int2Str( Integer( Params.Param ) ) +
                  ' WindowClass.style:' + Int2Str( Params.WindowClass.style ) +
                  ' WindowClass.lpfnWndProc:' + Int2Str( DWORD( Pointer( Params.WindowClass.lpfnWndProc ) ) ) +
                  ' WindowClass.cbClsExtra:' + Int2Str( DWORD( Params.WindowClass.cbClsExtra ) ) +
                  ' WindowClass.cbWndExtra:' + Int2Str( DWORD( Params.WindowClass.cbWndExtra ) ) +
                  ' WindowClass.hInstance:' + Int2Str( Params.WindowClass.hInstance ) +
                  ' WindowClass.hIcon:' + Int2Str( Params.WindowClass.hIcon ) +
                  ' WindowClass.hCursor:' + Int2Str( Params.WindowClass.hCursor ) +
                  ' WindowClass.hbrBackground:' + Int2Str( Params.WindowClass.hbrBackground ) +
                  ' WindowClass.lpszMenuName:' + Params.WindowClass.lpszMenuName +
                  ' WindowClass.lpszClassName:' + Params.WindowClass.lpszClassName
                   );
end;
{$ENDIF DEBUG_CREATEWINDOW}

//var LockedWindow: HWnd;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TControl.CreateWindow: Boolean;
const
  CS_OFF = CS_OWNDC or CS_CLASSDC or CS_PARENTDC or CS_GLOBALCLASS;
  CS_ON = 0; //CS_VREDRAW or CS_HREDRAW;
var TempClass: TWndClass;
    Params: TCreateWndParams;
    ClassRegistered: Boolean;
    {$IFDEF _FPC}
    SClassName: AnsiString;
    {$ENDIF PAS_VERSION}
    {$IFDEF UNICODE_CTRLS}
    TempOleStr : PWideChar;
    {$ENDIF}
    {$IFDEF CREATE_HIDDEN}
    {$ELSE}
    lock: Boolean;
    {$ENDIF}
begin
  {$IFDEF INPACKAGE}
  Log( '->TControl.CreateWindow' );
  TRY
  {$ENDIF INPACKAGE}
   {$IFDEF DEBUG_CREATEWINDOW}
   Debug_CreateWindow1( @ Self );
   {$ENDIF DEBUG_CREATEWINDOW}
   Result := False;
   if fParent <> nil then
     if fParent.GetWindowHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   if fHandle <> 0 then
   begin
     {$IFDEF CREATE_HIDDEN}
     if  {$IFDEF USE_FLAGS} G4_CreateHidden in fFlagsG4
         {$ELSE} fCreateHidden {$ENDIF} then
     begin
         CreateChildWindows;
         Set_Visible( True );
         {$IFDEF USE_FLAGS} exclude( fFlagsG4, G4_CreateHidden );
         {$ELSE} fCreateHidden := False; {$ENDIF}
     end else
     begin
         CreateChildWindows;
     end;
     {$ELSE}
     begin
         lock := LockedWindow <> 0;
         if  lock then
         begin
             LockWindowUpdate( fHandle );
             LockedWindow := fHandle;
         end;
         CreateChildWindows;
         if  lock then
         begin
             LockWindowUpdate( 0 );
             LockedWindow := 0;
         end;
     end;
     {$ENDIF CREATE_HIDDEN}
     Result := True;
     {$IFDEF INPACKAGE}
     LogOK;
     {$ENDIF INPACKAGE}
     Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   end;

   {$IFDEF USE_GRAPHCTLS}
   if {$IFDEF USE_FLAGS} (G6_GraphicCtl in fFlagsG6)
      {$ELSE} not fWindowed {$ENDIF} then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   {$ENDIF}

   {$IFDEF INPACKAGE}
   Log( '/// Filling Params' );
   {$ENDIF INPACKAGE}

   //FillChar( Params, Sizeof( Params ), 0 );
   ZeroMemory( @Params, Sizeof( Params ) );
   Params.WindowClass.hCursor := LoadCursor( 0, IDC_ARROW );
   Params.WindowClass.hInstance := hInstance;
   Params.WindowClass.lpfnWndProc := fDefWndProc;
   Params.WindowClass.style := fClsStyle;
   {$IFDEF _FPC}
   SClassName := SubClassName;
   StrCopy( Params.WinClsNamBuf, @ SClassName[ 1 ] );
   {$ELSE}
   {$IFNDEF UNICODE_CTRLS}
   StrCopy( Params.WinClsNamBuf, @ SubClassName[ 1 ] );
   {$ELSE}
   TempOleStr := StringToOleStr(AnsiString(SubClassName));
   lstrcpyW(Params.WinClsNamBuf, TempOleStr); // vampir_infernal 15.10.2008
   SysFreeString( TempOleStr );
   {$ENDIF}
   {$ENDIF}
   Params.Param := nil;
   Params.Inst := hInstance;
   Params.Menu := fMenu;
   Params.WndParent := GetParentWnd( TRUE );
   Params.Height := fBoundsRect.Bottom - fBoundsRect.Top;
   if  Params.Height = 0 then
       Params.Height := CW_UseDefault;
   Params.Width := fBoundsRect.Right - fBoundsRect.Left;
   if  Params.Width = 0 then
       Params.Width := CW_UseDefault;
   Params.Y := fBoundsRect.Top;
   Params.X := fBoundsRect.Left;
   if  {$IFDEF USE_FLAGS} not(G3_IsControl in fFlagsG3)
       {$ELSE} not fIsControl {$ENDIF}
   and {$IFDEF USE_FLAGS} not(G2_ChangedPos in fFlagsG2)
       {$ELSE} (fChangedPosSz and 3 = 0) {$ENDIF} then
   begin
       Params.Y := CW_UseDefault;
       Params.X := CW_UseDefault;
   end;
   Params.Style := fStyle.Value;
   Params.Caption := PKOLChar( fCaption );
   Params.WinClassName := @ Params.WinClsNamBuf[ 0 ];
   Params.ExStyle := fExStyle;

   {$IFDEF INPACKAGE}
   Log( '/// Getting class info' );
   {$ENDIF INPACKAGE}
   if fControlClassName <> nil then
   begin
       GetClassInfo( hInstance,fControlClassName,Params.WindowClass );
       Params.WindowClass.hInstance := Params.Inst;
       Params.WindowClass.style := Params.WindowClass.style and
	   not CS_OFF or CS_ON;
   end;
   if  fDefWndProc = nil then
       fDefWndProc := {$ifdef FPC}@{$endif}Params.WindowClass.lpfnWndProc;
   if  Params.WndParent = 0 then
       if Params.Style and WS_CHILD <> 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>}

	 {$IFNDEF UNICODE_CTRLS}
	 ClassRegistered := GetClassInfo( Params.WindowClass.hInstance,Params.WinClassName, TempClass );
	 {$ELSE}
	 ClassRegistered := GetClassInfoW( Params.WindowClass.hInstance,Params.WinClassName, TempClass );
	 {$ENDIF}

   {$IFDEF INPACKAGE}
   Log( '/// Registering window class' );
   {$ENDIF INPACKAGE}
   if not ClassRegistered then
   begin
     Params.WindowClass.lpszClassName := Params.WinClassName;
     Params.WindowClass.lpfnWndProc := @ WndFunc;
	 {$IFNDEF UNICODE_CTRLS}
     if RegisterClass( Params.WindowClass ) = 0 then Exit; {>>>>>>>>>>>>>>>>>>>}
	 {$ELSE}
	 if RegisterClassW(Params.WindowClass ) = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>}
	 {$ENDIF}
   end;

   {$IFDEF DEBUG_CREATEWINDOW}
   Debug_CreateWindow2( @ Self, Params );
   {$ENDIF}
   CreatingWindow := @Self;
   {$IFDEF INPACKAGE}
   Log( '/// Calling CreateWindowEx' );
   {$ENDIF INPACKAGE}
   {$IFDEF USE_MDI}
   if  Assigned( fCreateWindowProc ) then
       fHandle := fCreateWindowProc(
          Params.WinClassName, Params.Caption, Params.Style,
          Params.X, Params.Y, Params.Width, Params.Height,
          Params.WndParent, Params.WindowClass.hInstance,
          Integer( Params.Param ) )
   else
   {$ENDIF}
   begin
       {$IFNDEF UNICODE_CTRLS}
       fHandle := CreateWindowEx(
           Params.ExStyle, Params.WinClassName,
           Params.Caption, Params.Style, Params.X, Params.Y,
           Params.Width, Params.Height, Params.WndParent,
           Params.Menu, Params.WindowClass.hInstance,
           Params.Param );
       {$ELSE}
       fHandle := CreateWindowExW(
           Params.ExStyle{ or WS_EX_RTLREADING}, Params.WinClassName,
           Params.Caption, Params.Style, Params.X, Params.Y,
           Params.Width, Params.Height, Params.WndParent,
           Params.Menu, Params.WindowClass.hInstance,
           Params.Param );
       {$ENDIF}
   end;
   {$IFDEF INPACKAGE}
   Log( '/// CreateWindowEx called' );
   {$ENDIF INPACKAGE}


   {$IFDEF DEBUG_CREATEWINDOW}
	 if fHandle = 0 then
         begin
		MessageBox(0,
                  PKOLChar(SysErrorMessage(GetLastError)),
                  'Error creating window',mb_iconhand);
		Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
	 end;
   {$ENDIF}
   {$IFDEF INPACKAGE}
   Log( '/// SendMessage WM_UPDATEUISTATE' );
   {$ENDIF INPACKAGE}
   SendMessage( fHandle, $0128 {WM_UPDATEUISTATE},
     2 {UIS_CLEAR} or (1 {UISF_HIDEFOCUS} shl 16),0);
   {$IFDEF USE_PROP}
   if GetProp(FHandle,ID_SELF) = 0 then
   begin
      CreatingWindow := nil;
      SetProp(FHandle, ID_SELF, THandle(@Self));
   end;
   {$ELSE}
   CreatingWindow := nil;
   SetWindowLong( FHandle, GWL_USERDATA, Integer(@Self) );
   {$ENDIF}
   //***
   {$IFDEF INPACKAGE}
   Log( '/// Perform WM_SETICON' );
   {$ENDIF INPACKAGE}
   {$IFDEF SMALLEST_CODE}
   {$ELSE}
   if  {$IFDEF USE_FLAGS} not(G3_IsControl in fFlagsG3)
       {$ELSE} not fIsControl {$ENDIF} then
       Perform( WM_SETICON, 1 {ICON_BIG}, GetIcon );
   {$ENDIF}
   {$IFDEF NIL_EVENTS}
   if  Assigned( PP.FCreateWndExt ) then
   {$ENDIF}
       PP.FCreateWndExt( @Self );
   {$IFDEF INPACKAGE}
   Log( '/// ApplyFont2Wnd' );
   {$ENDIF INPACKAGE}

   ApplyFont2Wnd_Proc( @Self );
   ApplyFont2Wnd_Proc( @Self );

   {$IFDEF INPACKAGE}
   Log( '/// CreateChildWindows' );
   {$ENDIF INPACKAGE}

   CreateChildWindows;

   {$IFDEF INPACKAGE}
   Log( '/// CreateChildWindows called OK' );
   {$ENDIF INPACKAGE}

   Result := True;
  {$IFDEF INPACKAGE}
    LogOK;
  FINALLY
    Log( '<-TControl.CreateWindow' );
  END;
  {$ENDIF INPACKAGE}
end;
{$ENDIF}
{$ENDIF WIN_GDI}

{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TControl.VisualizyWindow;
VAR i: Integer;
    C: PControl;
BEGIN
  IF  fHandle = nil THEN Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  IF  {$IFDEF USE_FLAGS} not(G3_IsApplet in fFlagsG3)
      {$ELSE} not fIsApplet {$ENDIF}
  AND {$IFDEF USE_FLAGS} (F3_Visible in fStyle.f3_Style)
      {$ELSE} FVisible {$ENDIF} then
  BEGIN
      FOR i := 0 to ChildCount-1 do
      BEGIN
          C := Children[ i ];
          if  {$IFDEF USE_FLAGS} F3_Visible in fStyle.f3_Style
              {$ELSE} C.fVisible {$ENDIF} then
              C.VisualizyWindow;
      END;
      gtk_widget_show( fHandle );
  END;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}
//-
procedure TControl.CreateSubclass(var Params: TCreateParams;
  ControlClassName: PKOLChar);
const
  CS_OFF = CS_OWNDC or CS_CLASSDC or CS_PARENTDC or CS_GLOBALCLASS;
  CS_ON = 0; //CS_VREDRAW or CS_HREDRAW;
var
  SaveInstance: THandle;
begin
  if fControlClassName <> nil then
    with Params do
    begin
      SaveInstance := WindowClass.hInstance;
	  {$IFNDEF UNICODE_CTRLS}
      if not GetClassInfo(HInstance, fControlClassName, WindowClass) and
        not GetClassInfo(0, fControlClassName, WindowClass)
      then
        GetClassInfo(WindowClass.hInstance, fControlClassName, WindowClass);
	  {$ELSE}
			if not GetClassInfoW(HInstance, pWideChar(fControlClassName), WindowClass) and
				not GetClassInfoW(0, pWidechar(fControlClassName), WindowClass)
			then
				GetClassInfoW(WindowClass.hInstance, pWideChar(fControlClassName), WindowClass);
	  {$ENDIF}
      WindowClass.hInstance := SaveInstance;
      WindowClass.style := WindowClass.style and not CS_OFF or CS_ON;
    end;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function WndProcMouse(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
var MouseData: TMouseEventData;
begin
  Result := False;
  if (Msg.message >= WM_MOUSEFIRST) and (Msg.message <= $20A {WM_MOUSELAST}) then
  with MouseData do
  begin
    Shift := Msg.wParam;
    if GetKeyState( VK_MENU ) < 0 then
       Shift := Shift or MK_ALT;
    X := LoWord( Msg.lParam );
    Y := HiWord( Msg.lParam );
    //Button := TMouseButton(Msg.wParam);
    // not possible: wParam can contain a combination of flags
    // MK_CONTROL, MK_LBUTTON, MK_RBUTTON, MK_MBUTTON, MK_SHIFT, MK_XBUTTON1, MK_XBUTTON2
    // So, Shift must be tested.
    Button := mbNone;

    StopHandling := FALSE;
    Rslt := 0; // needed ?
    case Msg.message of
    WM_LBUTTONDOWN:
      {$IFDEF NIL_EVENTS}
      if Assigned( Self_.EV.fOnMouseDown ) then
      {$ENDIF}
      begin
         Button := mbLeft;
         Self_.EV.fOnMouseDown( Self_, MouseData );
      end;
    WM_RBUTTONDOWN:
      {$IFDEF NIL_EVENTS}
      if Assigned( Self_.EV.fOnMouseDown ) then
      {$ENDIF}
      begin
         Button := mbRight;
         Self_.EV.fOnMouseDown( Self_, MouseData );
      end;
    WM_MBUTTONDOWN:
      {$IFDEF NIL_EVENTS}
      if Assigned( Self_.EV.fOnMouseDown ) then
      {$ENDIF}
      begin
         Button := mbMiddle;
         Self_.EV.fOnMouseDown( Self_, MouseData );
      end;
    WM_LBUTTONUP:
      {$IFDEF NIL_EVENTS}
      if Assigned( Self_.EV.fOnMouseUp ) then
      {$ENDIF}
      begin
         Button := mbLeft;
         Self_.EV.fOnMouseUp( Self_, MouseData );
      end;
    WM_RBUTTONUP:
      {$IFDEF NIL_EVENTS}
      if Assigned( Self_.EV.fOnMouseUp ) then
      {$ENDIF}
      begin
         Button := mbRight;
         Self_.EV.fOnMouseUp( Self_, MouseData );
      end;
    WM_MBUTTONUP:
      {$IFDEF NIL_EVENTS}
      if Assigned( Self_.EV.fOnMouseUp ) then
      {$ENDIF}
      begin
         Button := mbMiddle;
         Self_.EV.fOnMouseUp( Self_, MouseData );
      end;
    WM_MOUSEMOVE:
      {$IFDEF NIL_EVENTS}
      if Assigned( Self_.EV.fOnMouseMove ) then
      {$ENDIF}
         Self_.EV.fOnMouseMove( Self_, MouseData );
    WM_LBUTTONDBLCLK:
      {$IFDEF NIL_EVENTS}
      if Assigned( Self_.EV.fOnMouseDblClk ) then
      {$ENDIF}
      begin
         Button := mbLeft;
         Self_.EV.fOnMouseDblClk( Self_, MouseData );
      end;
    WM_RBUTTONDBLCLK:
      {$IFDEF NIL_EVENTS}
      if Assigned( Self_.EV.fOnMouseDblClk ) then
      {$ENDIF}
      begin
         Button := mbRight;
         Self_.EV.fOnMouseDblClk( Self_, MouseData );
      end;
    WM_MBUTTONDBLCLK:
      {$IFDEF NIL_EVENTS}
      if Assigned( Self_.EV.fOnMouseDblClk ) then
      {$ENDIF}
      begin
         Button := mbMiddle;
         Self_.EV.fOnMouseDblClk( Self_, MouseData );
      end;
    $020A {WM_MOUSEWHEEL}:
      {$IFDEF NIL_EVENTS}
      if Assigned( Self_.EV.fOnMouseWheel ) then
      {$ENDIF}
         Self_.EV.fOnMouseWheel( Self_, MouseData );
    else
      Exit; //Result := False; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
    Result := StopHandling;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function WndProcKeybd(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
var C : KOLChar;
    Key: Integer;
begin
  Result := True;
  case Msg.message of
    WM_KEYDOWN, WM_SYSKEYDOWN:
      begin
      {$IFDEF NIL_EVENTS}
      if assigned( Self_.EV.fOnKeyDown ) then
      {$ENDIF}
         Key := Msg.wParam;
         Self_.EV.fOnKeyDown( Self_, Key, GetShiftState );
         Msg.wParam := Key;
      end;
    WM_KEYUP, WM_SYSKEYUP:
      begin
      {$IFDEF NIL_EVENTS}
      if assigned( Self_.EV.fOnKeyUp ) then
      {$ENDIF}
         Key := Msg.wParam;
         Self_.EV.fOnKeyUp( Self_, Key, GetShiftState );
         Msg.wParam := Key;
      end;
    WM_CHAR, WM_SYSCHAR:
      {$IFDEF NIL_EVENTS}
      if assigned( Self_.EV.fOnChar ) then
      {$ENDIF}
      begin
         C := KOLChar( Msg.wParam );
         Self_.EV.fOnChar( Self_, C, GetShiftState );
         Msg.wParam := Integer( C );
      end;
    {$IFDEF SUPPORT_ONDEADCHAR}
    WM_DEADCHAR, WM_SYSDEADCHAR:
      {$IFDEF NIL_EVENTS}
      if assigned( Self_.EV.fOnDeadChar ) then
      {$ENDIF}
      begin
         C := KOLChar( Msg.wParam );
         Self_.EV.fOnDeadChar( Self_, C, GetShiftState );
         Msg.wParam := Integer( C );
      end;
    {$ENDIF SUPPORT_ONDEADCHAR}
    else begin
           Result := False; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
         end;
  end;
  if Msg.wParam <> 0 then
    Result := False;
end;
{$ENDIF PAS_VERSION}

function WndProcDummy(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
begin
  Result := False;
end;

const
  MM_MCINOTIFY        = $3B9;

function WndProcOnClose( Sender: PControl; var Msg: TMsg; var Rslt: Integer )
                          : Boolean;
var Accept: Boolean;
begin
  Result := FALSE;
  if Msg.message = WM_CLOSE then
  begin
     {$IFDEF NEW_MODAL}
       // version of code by Alexander Pravdin
       begin
            Accept := True;
            if  Assigned( Sender.EV.fOnClose ) then
            begin
                Sender.EV.fOnClose( Sender, Accept );
                if  AppletRunning then
                    if  Accept then
                        if  Sender.DF.fModal > 0 then
                        begin
                            if  Sender.DF.fModalResult = 0 then
                                Sender.DF.fModalResult := Integer($80000000);
                            Msg.message := 0;
                            Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                        end
                        else
                            TMethod( Sender.EV.fOnClose ).Code :=
                                {$IFDEF NIL_EVENTS} nil
                                {$ELSE} @DummyObjProc {$ENDIF}
                    else
                    begin
                        Rslt := 0;
                        Sender.DF.fModalResult := 0;
                        Result := TRUE;
                    end
                else TMethod( Sender.EV.fOnClose ).Code :=
                     {$IFDEF NIL_EVENTS} nil
                     {$ELSE} @DummyObjProc {$ENDIF};
            end else
            begin
                if  Sender.DF.fModal > 0 then begin
                    if  Sender.DF.fModalResult = 0 then
                        Sender.DF.fModalResult := Integer($80000000);
                    Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                end;
            end;

            if Accept then begin
              if Sender.IsMainWindow or ( Applet = Sender ) then
              begin
                PostQuitMessage( 0 );
                AppletTerminated := TRUE;
                Rslt := 0;
              end
              else Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
            end;
       end;
    {$ELSE}
       begin
            Accept := True;
            {$IFDEF NIL_EVENTS}
            if  Assigned( Sender.EV.fOnClose ) then
            {$ENDIF}
            begin
                Sender.EV.fOnClose( Sender, Accept );
                if (not Accept) and (AppletRunning) then
                begin
                    Rslt := 0;
                    Result := TRUE;
                end else
                    Sender.EV.fOnClose := nil;
            end;
            if  Accept then
            begin
                if  Sender.IsMainWindow or (Applet = Sender) then
                begin
                    PostQuitMessage( 0 );
                    AppletTerminated := TRUE;
                    Rslt := 0;
                end else
                    Exit; //Default; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
            end;
       end;
     {$ENDIF}
  end;
end;

procedure TControl.SetOnClose(const AOnClose: TOnEventAccept);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnClose := AOnClose;
  AttachProc( WndProcOnClose );
end;

function WndProcFormOnClick( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := FALSE;
  if  (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_LBUTTONDBLCLK) or
      (Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_RBUTTONDBLCLK) or
      (Msg.message = WM_MBUTTONDOWN) or (Msg.message = WM_MBUTTONDBLCLK)
      then
  begin
      {$IFDEF USE_FLAGS}
          if   (Msg.message = WM_RBUTTONDOWN) or
               (Msg.message = WM_RBUTTONDBLCLK) then
               include( Sender.fFlagsG6, G6_RightClick )
          else exclude( Sender.fFlagsG6, G6_RightClick );
      {$ELSE}
          Sender.fRightClick := (Msg.message = WM_RBUTTONDOWN) or
                                (Msg.message = WM_RBUTTONDBLCLK);
      {$ENDIF}
      {$IFDEF NIL_EVENTS}
      if  Assigned( Sender.EV.fOnClick ) then
      {$ENDIF}
          Sender.EV.fOnClick( Sender );
  end;
end;

procedure TControl.SetFormOnClick(const AOnClick: TOnEvent);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnClick := AOnClick;
  AttachProc( WndProcFormOnClick );
end;

{$IFDEF ASM_VERSION}//------------------

{$DEFINE ASM_LOCAL}
{$IFDEF NEW_MODAL}
  {$UNDEF ASM_LOCAL}
{$ENDIF}
{$IFDEF USE_MDI}
  {$UNDEF ASM_LOCAL}
{$ENDIF}

{$ELSE}//-------------------------------

{$IFDEF ASM_LOCAL}
  {$UNDEF ASM_LOCAL}
{$ENDIF}

{$ENDIF}//------------------------------

{$IFDEF USE_GRAPHCTLS}
  {$UNDEF ASM_LOCAL}
{$ENDIF}

{$IFDEF ASM_LOCAL}
{$ELSE ASM_LOCAL} //Pascal

  {$IFDEF DEBUG_CREATEWINDOW}
  var DbgCWCount: Integer = 0;
  {$ENDIF DEBUG_CREATEWINDOW}
function TControl.WndProc( var Msg: TMsg ): Integer;
var C : PControl;
    F: HWnd;
    PassFun: function( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;

    procedure Default;
    begin
      Result := CallDefWndProc( Msg );
    end;

begin
  //RefInc;
  {$IFDEF INPACKAGE}
  Log( '->TControl.WndProc' );
  TRY
  {$ENDIF INPACKAGE}
   {$IFDEF DEBUG_CREATEWINDOW}
   Inc( DbgCWCount );
   if DbgCWCount < 10 then
     LogFileOutput( GetStartDir + 'Session.log', 'TControl.WndProc: ' +
     ' Msg.hwnd=' + Int2Str( Msg.hwnd ) +
     ' Msg.message=' + Int2Hex( Msg.message, 2 ) +
     ' Msg.wParam=' + Int2Str( Msg.wParam ) + '=$' + Int2Hex( Msg.wParam, 4 ) +
     ' Msg.lParam=' + Int2Str( Msg.lParam ) + '=$' + Int2Hex( Msg.lParam, 4 ) );
   {$ENDIF DEBUG_CREATEWINDOW}
   if (Msg.hwnd <> 0) and (fHandle = 0)
      {$IFDEF USE_GRAPHCTLS} and
          {$IFDEF USE_FLAGS} not(G6_GraphicCtl in fFlagsG6)
          {$ELSE} fWindowed {$ENDIF} {$ENDIF} then
      fHandle := Msg.hwnd;

   {$IFDEF DEBUG_MCK} mck_Log( '01' ); {$ENDIF}
   PassFun := PP.fPass2DefProc;
   {$IFDEF DEBUG_MCK} mck_Log( '01' ); {$ENDIF}
   if  not (AppletRunning and (Applet <> @Self) and ( Applet <> nil ) and
       {$IFDEF NIL_EVENTS} Assigned( Applet.EV.fOnMessage ) and {$ENDIF}
       Applet.EV.fOnMessage( Msg, Result )) then
   begin {$IFDEF DEBUG_MCK} mck_Log( '02' ); {$ENDIF}
       if  not ({$IFDEF NIL_EVENTS} Assigned( EV.fOnMessage ) and {$ENDIF}
           EV.fOnMessage( Msg, Result )) then
       begin {$IFDEF DEBUG_MCK} mck_Log( '03' ); {$ENDIF}
           if  not PP.fOnDynHandlers( @Self, Msg, Result ) then
           begin {$IFDEF DEBUG_MCK} mck_Log( '04' ); {$ENDIF}
               //{-2.95}//if not PP.fWndProcResizeFlicks( @Self, Msg, Result ) then
               begin {$IFDEF DEBUG_MCK} mck_Log( '05' ); {$ENDIF}
                   case Msg.message of
                   WM_CLOSE:
                     begin // handler by default - simple:
                       if (Applet = @ Self) or IsMainWindow then
                       begin
                         PostQuitMessage( 0 );
                         AppletTerminated := TRUE;
                       end;
                       Default;
                     end;
                   (*
                   {$IFDEF USE_PROP}
                   WM_NCDESTROY:
                             begin
                               RemoveProp( fHandle, ID_SELF ); //********* Added By M.Gerasimov
                               //RefDec;
                             end;
                   {$ENDIF}
                   *)
                   WM_NCDESTROY:
                       {$IFnDEF SMALLER_CODE}
                       if  fHandle = Msg.hwnd then
                       {$ENDIF}
                       begin
                           {$IFnDEF SMALLER_CODE}
                               {$IFDEF USE_PROP}
                               RemoveProp( fHandle, ID_SELF ); //********* Added By M.Gerasimov
                               {$ELSE}
                               SetWindowLong( fHandle, GWL_USERDATA, 0 ); // VK + Alexey Kirov, 23.02.2012
                               {$ENDIF}
                           {$ENDIF} //-------------------------------------------
                           Default;
                           Exit;
                       end;
                   WM_DESTROY:
                       {$IFnDEF SMALLER_CODE}
                       if  fHandle = Msg.hwnd then
                       {$ENDIF}
                       begin
                           {$IFDEF USE_FLAGS} include( fFlagsG2, G2_BeginDestroying );
                           {$ELSE} fBeginDestroying := TRUE; {$ENDIF}
                           Default;
                           {$IFDEF INPACKAGE} LogOK; {$ENDIF INPACKAGE}
                           Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                       end;
                   WM_SIZE:  begin
                                {$IFDEF INPACKAGE}
                                Log( 'WM_SIZE >>> Default' );
                                {$ENDIF INPACKAGE}
                                Default;
                                {$IFDEF INPACKAGE}
                                Log( '//// Default called' );
                                {$ENDIF INPACKAGE}
                               {$IFDEF OLD_ALIGN}
                                if  {$IFDEF USE_FLAGS} not(G3_IsForm in fFlagsG3)
                                    {$ELSE} not fIsForm {$ENDIF} then
                                    Global_Align( fParent );
                               {$ENDIF}
                               {$IFDEF INPACKAGE}
                               Log( '//// Before Global_Align' );
                               {$ENDIF INPACKAGE}
                                Global_Align( @Self );
                               {$IFDEF INPACKAGE}
                               LogOK;
                               {$ENDIF INPACKAGE}
                                Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                             end;
                   WM_SysCommand:
                             begin
                                if ((Msg.wParam and $FFF0) = SC_MINIMIZE) and
                                   IsMainWindow and (@Self <> Applet) then
                                begin
                                   PostMessage( Applet.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0 );
                                   Result := 0;
                                end
                                else Default;
                             end;
                   WM_SETFOCUS:
                             begin
                               if not DoSetFocus then
                               begin
                                 Result := 0;
                               end
                                 else
                               begin
                                 Inc( fClickDisabled );
                                 Default;
                                 Dec( fClickDisabled );
                                 {$IFDEF INPACKAGE}
                                 LogOK;
                                 {$ENDIF INPACKAGE}
                                 Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                               end;
                             end;
                   WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
                   begin
                     Result := SendMessage(Msg.LParam, CN_BASE + Msg.message, Msg.WParam, Msg.LParam);
                   end;
                   WM_COMMAND:
                             begin
                               {$IFDEF USE_PROP}
                               C := Pointer( GetProp( Msg.lParam, ID_SELF ) );
                               {$ELSE}
                               C := Pointer( GetWindowLong( Msg.lParam, GWL_USERDATA ) );
                               {$ENDIF}
                               if C <> nil then
                               begin
                                 Result := SendMessage( Msg.lParam, CM_COMMAND, Msg.wParam, Msg.lParam );
                               end
                               else Default;
                             end;
                   WM_KEYFIRST..WM_KEYLAST:
                             begin
                               F := GetFocus;
                               if {(F <> fFocusHandle) and} (F <> fHandle)
                                  {$IFDEF USE_GRAPHCTLS} and
                                      {$IFDEF USE_FLAGS} not(G6_GraphicCtl in fFlagsG6)
                                      {$ELSE} fWindowed {$ENDIF} {$ENDIF}
                               {$IFDEF KEY_PREVIEW}
                                and {$IFDEF USE_FLAGS} not(G4_Pushed in fFlagsG4)
                                    {$ELSE}  not fKeyPreviewing {$ENDIF}
                               {$ENDIF}
                               then
                               begin
                                 Result := 0;
                                 // Jump to PassFun here. Prevents beep in case when WM_KEYDOWN
                                 // called another form and focus is changed, so WM_KEYUP failed
                                 // to handle.
                               end
                                 else
                               begin
                                 {$IFDEF KEY_PREVIEW} //ADDITION JUST FOR CORRECT KEYPREVIEWING
                                 {$IFDEF USE_FLAGS} exclude( fFlagsG4, G4_Pushed );
                                 {$ELSE} fKeyPreviewing:=false; {$ENDIF}
                                 {$ENDIF}
                                 if  fGlobalProcKeybd( @Self, Msg, Result ) then
                                 begin
                                     {$IFDEF INPACKAGE}
                                     LogOK;
                                     {$ENDIF INPACKAGE}
                                     Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                                 end;
                                 if  PP.fWndProcKeybd( @Self, Msg, Result ) then
                                 begin
                                     {$IFDEF INPACKAGE}
                                     LogOK;
                                     {$ENDIF INPACKAGE}
                                     Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                                 end;
                                 if ((GetKeystate( VK_CONTROL ) or GetKeyState( VK_MENU )) >= 0) then
                                 begin
                                   //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
                                   if (Msg.message <> WM_CHAR) // v1.02 Tabulate AND " in EditBox fix
                                   //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
                                   then
                                   begin
                                       C := ParentForm;
                                       if  (C <> nil)
                                       {$IFDEF NIL_EVENTS}
                                       and Assigned(C.PP.fGotoControl)
                                       {$ENDIF}
                                       and C.PP.fGotoControl( @Self, Msg.wParam,
                                           (Msg.message <> WM_KEYDOWN) and
                                           (Msg.message <> WM_SYSKEYDOWN) ) then
                                       begin
                                            Msg.wParam := 0;
                                            Result := 0;
                                       end
                                       else Default;
                                   end else
                                   //+++++++++++++++++++++++++++++++++++++++++++++//
                                   if Msg.wParam = 9 then // prevent system beep  //
                                   begin                                          //
                                          Msg.wParam := 0;                        //
                                          Result := 0;                            //
                                   end                                            //
                                   //+++++++++++++++++++++++++++++++++++++++++++++//
                                   else Default;
                                 end
                                 else Default;
                               end;
                             end;
                   else  begin
                           {$IFDEF DEBUG_MCK} mck_Log( 'else' ); {$ENDIF}
                           Default;
                           {$IFDEF INPACKAGE}
                           LogOK;
                           {$ENDIF INPACKAGE}
                           Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                         end;
                   end;
               end;
           end;
       end;
   end;
   {$IFDEF DEBUG_MCK} mck_Log( '06' ); {$ENDIF}
   if not AppletTerminated
      {$IFDEF USE_fNCDestroyed} and not fNCDestroyed {$ENDIF} then
   begin {$IFDEF DEBUG_MCK} mck_Log( '07' ); {$ENDIF}
     PassFun( @Self, Msg, Result ); //+-+
     {$IFDEF DEBUG_MCK} mck_Log( '08' ); {$ENDIF}
   end;
  {$IFDEF INPACKAGE}
    LogOK;
  FINALLY
    Log( '<-TControl.WndProc' );
    //RefDec;
  END;
  {$ELSE}
      //RefDec;
  {$ENDIF INPACKAGE}
end;
{$ENDIF ASM_LOCAL}

{$UNDEF ASM_LOCAL}

{$ENDIF WIN_GDI}
{$IFDEF GDI}
procedure SetMouseEvent( Self_: PControl );
begin
  Self_.AttachProc( WndProcMouse );
end;
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION mouse_events_handler( Obj: PGtkWidget; VAR Event: TGdkEventAny ): Boolean;
         CDECL;
VAR Sender: PControl;
    M: TMouseEventData;
    PROCEDURE PrepareMouseEvent( const Evt: TGdkEventMotion );
    BEGIN
      M.Button := mbNone;
      if Evt.state and GDK_BUTTON1_MASK <> 0 then M.Button := mbLeft
      else
      if Evt.state and GDK_BUTTON2_MASK <> 0 then M.Button := mbRight
      else
      if Evt.state and GDK_BUTTON3_MASK <> 0 then M.Button := mbMiddle;
      M.Shift := 0;
      if Evt.state and GDK_SHIFT_MASK   <> 0 then M.Shift := MK_SHIFT;
      if Evt.state and GDK_CONTROL_MASK <> 0 then M.Shift := M.Shift or MK_CONTROL;
      if Evt.state and GDK_LOCK_MASK    <> 0 then M.Shift := M.Shift or MK_LOCK;
      if Evt.state and GDK_BUTTON1_MASK <> 0 then M.Shift := M.Shift or MK_LBUTTON;
      if Evt.state and GDK_BUTTON2_MASK <> 0 then M.Shift := M.Shift or MK_RBUTTON;
      if Evt.state and GDK_BUTTON3_MASK <> 0 then M.Shift := M.Shift or MK_MBUTTON;
      if Evt.state and GDK_LOCK_MASK    <> 0 then M.Shift := M.Shift or MK_LOCK;
      M.X := Round( Evt.x );
      M.Y := Round( Evt.y );
    END;
VAR scrl: PGdkEventScroll;
    z: SmallInt;
BEGIN
  Result := FALSE;
  //Sender := Pointer( Event.window );
  Sender := g_object_get_data( G_OBJECT( Obj ), ID_SELF );
  CASE Event._type OF
  GDK_MOTION_NOTIFY,
  GDK_BUTTON_PRESS,
  GDK_2BUTTON_PRESS,
  GDK_3BUTTON_PRESS, // òðîéíîé êëèê ìûøè - ñ÷èòàòü êàê äâîéíîé?
  GDK_BUTTON_RELEASE,
  GDK_SCROLL: ;
  else Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  END;
  PrepareMouseEvent( PGdkEventMotion( @ Event )^ );
  CASE Event._type OF
  GDK_MOTION_NOTIFY	:
    BEGIN
      IF  Assigned( Sender.fOnMouseMove ) THEN
      BEGIN
          Sender.fOnMouseMove( Sender, M );
          Result := TRUE;
      END;
    END;
  GDK_BUTTON_PRESS	:
    BEGIN
      IF  Assigned( Sender.fOnMouseDown ) THEN
      BEGIN
          Sender.fOnMouseDown( Sender, M );
          Result := TRUE;
      END;
    END;
  GDK_2BUTTON_PRESS,
  GDK_3BUTTON_PRESS	:
    BEGIN
      IF  Assigned( Sender.fOnMouseDblClk ) THEN
      BEGIN
        {$IFDEF USE_FLAGS}
        IF   Event._type = GDK_3BUTTON_PRESS THEN
             include( Sender.fFlagsG5, G5_3ButtonPress )
        ELSE exclude( Sender.fFlagsG5, G5_3ButtonPress );
        {$ELSE}
        Sender.f3ButtonPress := Event._type = GDK_3BUTTON_PRESS;
        {$ENDIF}
        Sender.fOnMouseDblClk( Sender, M );
        Result := TRUE;
      END;
    END;
  GDK_BUTTON_RELEASE	:
    BEGIN
      IF  Assigned( Sender.fOnMouseUp ) THEN
      BEGIN
        Sender.fOnMouseUp( Sender, M );
        Result := TRUE;
      END;
      if Assigned( Sender.fOnClick ) then
        Sender.fOnClick( Sender );
    END;
  GDK_SCROLL    	:
    BEGIN
        IF Assigned( Sender.fOnMouseWheel ) THEN
        BEGIN
          scrl := @ Event;
          IF scrl.direction = GDK_SCROLL_UP THEN
            z := 120
          ELSE IF scrl.direction = GDK_SCROLL_DOWN THEN
            z := -120 //todo: direction and value?
          ELSE
            z := 0;
          M.Shift := M.Shift or DWord(z shl 16);
          Sender.fOnMouseWheel( Sender, M );
          Result := TRUE;
        END;
    END;
  END;
END;

PROCEDURE SetMouseEvent( Self_: PControl; event_name: PAnsiChar );
BEGIN
  gtk_signal_connect( GTK_OBJECT( Self_.fEventboxHandle ), event_name,
    @mouse_events_handler, Self_ );
END;
{$ENDIF GTK}
{$ENDIF _X_}

function TControl.Get_OnMouseEvent(const Index: Integer): TOnMouse;
begin
    Result := TOnMouse( EV.MethodEvents[Index] );
end;

procedure TControl.SetOnMouseEvent(const Index: Integer;
  const Value: TOnMouse);
begin
    {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
    .MethodEvents[Index] := TMethod( Value );
    AttachProc( WndProcMouse );
end;

{$IFDEF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetClsStyle( Value: DWord );
begin
   if fClsStyle = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   fClsStyle := Value;
   if fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   SetClassLong( fHandle, GCL_STYLE, Value );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetStyle( Value: DWord );
begin
   if fStyle.Value = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   fStyle.Value := Value;
   if fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   SetWindowLong( fHandle, GWL_STYLE, Value );

   SetWindowPos( fHandle, 0, 0, 0, 0, 0,
                 SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or
                 SWP_NOZORDER or SWP_FRAMECHANGED );
   Invalidate;
end;
{$ENDIF PAS_VERSION}

{$IFDEF GRAPHCTL_XPSTYLES}
function TControl.GetEdgeStyle: TEdgeStyle;
begin
    Result := esRaised;
    if  Style and WS_DLGFRAME = 0 then
    begin
        if  Style and SS_SUNKEN <> 0 then
            Result := esLowered
        else
            Result := esNone;
    end;
end;

procedure TControl.SetEdgeStyle( Value: TEdgeStyle );
begin
   {$IFDEF STORE_EDGESTYLE}
   if fedgeStyle = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   fedgeStyle := Value;
   {$ENDIF}
   if fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   case Value of
   esRaised:
     begin
      Style := Style and (not SS_SUNKEN);
      ExStyle := ExStyle and (not WS_EX_STATICEDGE);
      ExStyle := ExStyle or WS_EX_WINDOWEDGE;
      Style := Style or WS_DLGFRAME;
     end;
   esLowered:
     begin
      Style := Style and (not WS_DLGFRAME);
      ExStyle := ExStyle or WS_EX_WINDOWEDGE;
      ExStyle := ExStyle or WS_EX_STATICEDGE;
      Style := Style or SS_SUNKEN;
     end;
   else
      Style := Style and (not SS_SUNKEN) and (not WS_DLGFRAME);
      ExStyle := ExStyle and (not WS_EX_STATICEDGE) or WS_EX_WINDOWEDGE;
   end;

   Invalidate;
end;
{$ENDIF}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetExStyle( Value: DWord );
begin
   if fExStyle = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   fExStyle := Value;
   if fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   SetWindowLong( fHandle, GWL_EXSTYLE, Value );

   SetWindowPos( fHandle, 0, 0, 0, 0, 0,
                 SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or
                 SWP_NOZORDER or SWP_FRAMECHANGED );
   Invalidate;
end;
{$ENDIF PAS_VERSION}

function WndProcSetCursor( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Cur: HCursor;
begin
  Result := FALSE;
  if Msg.message = WM_SETCURSOR then
  begin
    if (GetCapture = 0) and
       (LOWORD( Msg.lParam ) = HTCLIENT) then
    begin
      if   ScreenCursor <> 0 then                //YS
           Cur := ScreenCursor                   //YS
      else Cur := Self_.fCursor;                 //YS
      if Cur <> 0 then                           //YS
      begin                                      //YS
        Windows.SetCursor( Cur );                //YS
        Rslt := 1;                               //YS
        Result := TRUE;
      end;
    end;
  end;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetCursor( Value: HCursor );
var P: TPoint;
begin
   AttachProc( WndProcSetCursor );
   if fCursor = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   fCursor := Value;
   if (fHandle = 0) or (fCursor = 0) then Exit; //YS {>>>>>>>>>>>>>>>>>>>>>>>>>}
   if ScreenCursor <> 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   GetCursorPos( P );
   P := Screen2Client( P );
   if PointInRect( P, ClientRect ) then
   Windows.SetCursor( Value );
end;
{$ENDIF PAS_VERSION}

procedure TControl.CursorLoad(Inst: Integer; ResName: PKOLChar);
begin
  Cursor := LoadCursor( Inst, ResName );
  //{$IFDEF USE_FLAGS} include( fFlagsG1, G1_CursorShared );
  //{$ELSE}            fCursorShared := TRUE; {$ENDIF}
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetIcon( Value: HIcon );
var OldIco: HIcon;
begin
   if DF.fIcon = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   DF.fIcon := Value;
   if  Value = THandle(-1) then
       Value := 0;
   OldIco := Perform( WM_SETICON, 1 {ICON_BIG}, Value );
   if  OldIco <> 0 then
       DestroyIcon( OldIco );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetMenu( Value: HMenu );
begin
  if fMenu = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if fMenuObj <> nil then
  begin
    {$IFDEF USE_AUTOFREE4CONTROLS}
    RemoveFromAutoFree( fMenuObj );
    {$ENDIF}
    fMenuObj.Free;
  end;
  if fMenu <> 0 then
     DestroyMenu( fMenu );
  fMenu := Value;
  if fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Windows.SetMenu( fHandle, Value );
end;
{$ENDIF PAS_VERSION}

procedure CallWinHelp( Context: Integer; CtxCtl: PControl );
var Cmd: Integer;
    Form: PControl;
    Popup: Boolean;
begin
  Cmd := HELP_CONTEXT;
  if CtxCtl <> nil then
  begin
    Form := CtxCtl.ParentForm;
    if Form <> nil then
    if Assigned( Form.EV.fOnHelp ) then
    begin
      Popup := FALSE;
      Form.EV.fOnHelp( CtxCtl, Context, Popup );
      if Popup then
        Cmd := HELP_CONTEXTPOPUP;
      if CtxCtl = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end
    else
  if Context = 0 then
    Cmd := HELP_CONTENTS;
  WinHelp( Applet.Handle, PKOLChar( Applet.GetHelpPath ), Cmd, Context );
end;

var HHCtrl: THandle;
    HtmlHelp: procedure( Wnd: HWnd; Path: PKOLChar; Cmd, Data: Integer ); stdcall;

procedure HtmlHelpCommand( Wnd: HWnd; const HelpFilePath: KOLString; Cmd, Data: Integer );
begin
  if  HHCtrl = 0 then
      HHCtrl := LoadLibrary( 'HHCTRL.OCX' );
  if  HHCtrl = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if  not Assigned( HtmlHelp ) then
      HtmlHelp := GetProcAddress( HHCtrl,
          {$IFDEF UNICODE_CTRLS} 'HtmlHelpW' {$ELSE} 'HtmlHelpA' {$ENDIF} );
  if  not Assigned( HtmlHelp ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  HtmlHelp( Wnd, PKOLChar( HelpFilePath ), Cmd, Data );
end;

procedure CallHtmlHelp( Context: Integer; CtxCtl: PControl );
var Cmd: Integer;
    Form: PControl;
    Popup: Boolean;
    Ids: array[ 0..2 ] of DWORD;
begin

  Cmd := $F; // HH_HELP_CONTEXT;
  if CtxCtl <> nil then
  begin
    Form := CtxCtl.ParentForm;
    if Form <> nil then
    if Assigned( Form.EV.fOnHelp ) then
    begin
      Popup := FALSE;
      Form.EV.fOnHelp( CtxCtl, Context, Popup );
      if Popup then
      begin
        Cmd := $10; //HH_TP_HELPCONTEXTMENU;
        Ids[ 0 ] := CtxCtl.fMenu;
        Ids[ 1 ] := Context;
        Ids[ 2 ] := 0;
        Context := Integer( @ Ids );
      end;
      if CtxCtl = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end
    else
  if Context = 0 then
    Cmd := 1; // HH_DISPLAY_TOC;
  HtmlHelpCommand( {$IFDEF HTMLHELP_NOTOP} 0 {$ELSE} Applet.Handle {$ENDIF},
                   HelpFilePath, Cmd, Context );
end;

var
  Global_HelpProc: procedure( Context: Integer; CtxCtl: PControl ) = CallWinHelp;

function WndProcHelp( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var HI: PHelpInfo;
    Ctx: Integer;
    Ctl: PControl;
begin
  Result := FALSE;
  if Msg.message = WM_HELP then
  begin
    Ctx := 0;
    Ctl := nil;
    HI := Pointer( Msg.lParam );
    if HI.iContextType = HELPINFO_WINDOW then
    begin
      {$IFDEF USE_PROP}
      Ctl := Pointer( GetProp( HI.hItemHandle, ID_SELF ) );
      {$ELSE}
      Ctl := Pointer( GetWindowLong( HI.hItemHandle, GWL_USERDATA ) );
      {$ENDIF}
      while Ctl <> nil do
      begin
        Ctx := Ctl.HelpContext;
        if Ctx <> 0 then break;
        Ctl := Ctl.Parent;
      end;
    end
      else
      Ctx := GetMenuContextHelpID( HI.hItemHandle );
    Applet.CallHelp( Ctx, Ctl );
    Rslt := 1;
    Result := TRUE;
  end
  {$IFDEF AUTO_CONTEXT_HELP}
    else
  if (Msg.message = WM_CONTEXTMENU) then
  begin
    {$IFDEF USE_PROP}
    Ctl := Pointer( GetProp( Msg.wParam, ID_SELF ) );
    {$ELSE}
    Ctl := Pointer( GetWindowLong( Msg.wParam, GWL_USERDATA ) );
    {$ENDIF}
    if (Ctl <> nil) and (Ctl.HelpContext <> 0) then
    begin
      Applet.CallHelp( Ctl.HelpContext, Ctl );
      Rslt := 1;
      Result := TRUE;
    end;
  end
  {$ENDIF};
end;

procedure TControl.SetHelpContext(Value: Integer);
var F: PControl;
begin
  F := ParentForm;
  if F = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  F.AttachProc( WndProcHelp );
  SetWindowContextHelpId( GetWindowHandle, Value );
end;

function TControl.AssignHelpContext(Context: Integer): PControl;
begin
  SetHelpContext( Context );
  Result := @ Self;
end;

procedure AssignHtmlHelp( const HtmlHelpPath: KOLString );
var Lbytes: Integer;
begin
  {$IFDEF KOL_ASSERTIONS}
  Assert( (HtmlHelpPath <> '') and (Applet <> nil), 'Error parameters' );
  {$ENDIF KOL_ASSERTIONS}
  if HelpFilePath <> '' then
    FreeMem( HelpFilePath );
  Lbytes := (Length( HtmlHelpPath ) + 1) * Sizeof( KOLChar );
  GetMem( HelpFilePath, Lbytes );
  Move( HtmlHelpPath[ 1 ], HelpFilePath^, Lbytes );
  Global_HelpProc := CallHtmlHelp;
  Applet.AttachProc( WndProcHelp );
end;

procedure TControl.CallHelp(Context: Integer; CtxCtl: PControl {; CtlID: Integer} );
begin
  Global_HelpProc( Context, CtxCtl {, CtlID} );
end;

function TControl.GetHelpPath: KOLString;
begin
  Result := KOLString(HelpFilePath);
  if Result = '' then
  begin
    Result := ParamStr( 0 );
    Result := ReplaceFileExt( Result, '.hlp' );
  end;
end;

procedure TControl.SetHelpPath(const Value: KOLString);
var Lbytes: Integer;
begin
  {$IFDEF KOL_ASSERTIONS}
  Assert( Value <> '', 'Error parameter' );
  {$ENDIF KOL_ASSERTIONS}
  if  HelpFilePath <> '' then
      FreeMem( HelpFilePath );
  Lbytes := (Length( Value ) + 1)*Sizeof( KOLChar );
  GetMem( HelpFilePath, Lbytes );
  Move( Value[ 1 ], HelpFilePath^, Lbytes );
end;
{$ENDIF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE}
procedure TControl.DoAutoSize;
begin
  {$IFDEF NIL_EVENTS}
  if  Assigned( PP.fAutoSize ) then
  {$ENDIF}
      PP.fAutoSize( @Self );
end;
{$ENDIF}

{$IFDEF GDI}
{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TControl.GetCaption: KOLString;
var Sz: Integer;
begin
   if  {$IFDEF USE_FLAGS} not(G1_IgnoreWndCaption in fFlagsG1)
       {$ELSE} not fIgnoreWndCaption {$ENDIF}
   and (FHandle <> 0) then
   begin
       Sz := GetWindowTextLength( FHandle );
       SetLength( fCaption, Sz );
       if Sz > 0 then
       begin
         {$IFNDEF UNICODE_CTRLS}
           GetWindowText( FHandle, @ fCaption[ 1 ], Sz + 1 );
         {$ELSE}
           GetWindowTextW( FHandle, @ fCaption[ 1 ], Sz + 1 );
         {$ENDIF}
       end;
   end;
   Result := FCaption;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION TControl.GetCaption: KOLString;
BEGIN
   if  {$IFDEF USE_FLAGS} not (G1_IgnoreWndCaption in fFlagsG1)
       {$ELSE} fIgnoreWndCaption {$ENDIF} then
       FCaption := fGetCaption(@Self);
   Result := FCaption;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetCaption( const Value: KOLString );
begin
  fCaption := Value;
  if fHandle <> 0 then
    SendMessage( fHandle, WM_SETTEXT,
      0, Integer( PKOLChar( Value ) ) );
  if  {$IFDEF USE_FLAGS} (G1_IsStaticControl in fFlagsG1)
      {$ELSE} fIsStaticControl <> 1 {$ENDIF} then
      Invalidate;
  DoAutoSize;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TControl.SetCaption( CONST Value: KOLString );
BEGIN
  fCaption := Value;
  if  Assigned( fSetCaption ) THEN
      fSetCaption( @Self, Value );
  DoAutoSize;
END;
{$ENDIF GTK}
{$ENDIF _X_}
{$IFDEF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
function TControl.GetVisible: Boolean;
begin
   //UpdateWndStyles;
   {$IFDEF USE_FLAGS}
   {if (fHandle <> 0) then
       Result := //IsWindowVisible( fHandle ) -- incorrectly is false in OnShow !
                 GetWindowLong( fHandle, GWL_STYLE ) and WS_VISIBLE <> 0
   else}
       Result := F3_Visible in fStyle.f3_Style;
   {$ELSE}
   {if (fHandle <> 0) then
      fVisible := IsWindowVisible( fHandle )
   else}
      fVisible := (FStyle.Value and WS_VISIBLE) <> 0;
   Result := fVisible;
   {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} // Pascal
function TControl.Get_Visible: Boolean;
begin
   {$IFDEF USE_FLAGS}
   Result := GetVisible;
   {$ELSE}
   if (fHandle <> 0) and not fIsControl then
      fVisible := IsWindowVisible( fHandle );
   Result := fVisible;
   {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} // Pascal
procedure TControl.Set_Visible( Value: Boolean );
{$IFDEF OLD_ALIGN}
var CmdShow: DWORD;
{$ENDIF}
begin
   {$IFDEF OLD_ALIGN}
   //if Get_Visible <> Value then // commented to allow to set up controls visibility
   begin                          // on invisible form (Vladimir Piven)
     if  Value then
     begin
         {$IFDEF USE_FLAGS} include( fStyle.f3_Style, F3_Visible );
         {$ELSE} fStyle.Value := fStyle.Value or WS_VISIBLE; {$ENDIF}
         CmdShow := SW_SHOW;
     end else
     begin
         {$IFDEF USE_FLAGS} exclude( fStyle.f3_Style, F3_Visible );
         {$ELSE} fStyle.Value := fStyle.Value and not WS_VISIBLE; {$ENDIF}
         CmdShow := SW_HIDE;
     end;
     {$IFDEF USE_FLAGS}{$ELSE}
     fVisible := Value;
     {$ENDIF}
     if fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
     ShowWindow( fHandle, CmdShow );
     Global_Align( fParent );
     if  Value then
         Global_Align( @Self );
   end;
   {$IFDEF CREATE_HIDDEN}
   if  not Value and (fHandle <> 0) then
       {$IFDEF USE_FLAGS} exclude( fFlagsG4, G4_CreateHidden );
       {$ELSE} fCreateHidden := FALSE; {$ENDIF} // { +++ }
   {$ENDIF CREATE_HIDDEN}
{$ELSE NEW_ALIGN}
  fStyle.Value := fStyle.Value and not WS_VISIBLE;
  if  Value then
      fStyle.Value := fStyle.Value or WS_VISIBLE;
  {$IFDEF USE_FLAGS}
  {$ELSE}
  fVisible := Value;
  {$ENDIF}
  if  fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if  Value then
  begin
      Global_Align( @Self );
      ShowWindow( fHandle, SW_SHOW );
  end else
  begin
      {$IFDEF CREATE_HIDDEN}
      {$IFDEF USE_FLAGS} exclude( fFlagsG4, G4_CreateHidden );
      {$ELSE} fCreateHidden := FALSE; {$ENDIF} // { +++ }
      {$ENDIF CREATE_HIDDEN}
      ShowWindow( fHandle, SW_HIDE );
      Global_Align( @Self );
  end;
{$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure TControl.SetVisible( Value: Boolean );
begin
    {$IFDEF USE_FLAGS} include( fFlagsG4, G4_CreateVisible );
    {$ELSE} fCreateVisible := TRUE; {$ENDIF}
    Set_Visible( Value );
end;
{$ENDIF PAS_VERSION}

{$ENDIF WIN_GDI}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetBoundsRect: TRect;
var W: HWnd;
    P: TPoint;
begin
   Result := fBoundsRect;
   if fHandle <> 0 then
   begin
      GetWindowRect( fHandle, Result );
      if  {$IFDEF USE_FLAGS} ([G3_IsControl, G3_IsMDIChild] * fFlagsG3 <> [])
          {$ELSE} fIsControl or fIsMDIChild {$ENDIF}
      then
      begin
        W := ParentWindow;
        if W <> 0 then
        begin
          P.x := 0; P.y := 0;
          Windows.ClientToScreen( W, P );
          OffsetRect( Result, -P.x, -P.y );
        end;
      end;
      {$IFDEF TEST_BOUNDSRECT}
      if not CompareMem( @ fBoundsRect, @ Result, Sizeof( TRect ) ) then
      {$ENDIF}
      fBoundsRect := Result;
   end;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}

{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION TControl.GetBoundsRect: TRect;
VAR R: TRect;
    window: PGtkWindow;
    requisition: TGtkRequisition;
BEGIN
   //if fHandle <> nil then
   BEGIN
     IF  fIsControl THEN
     BEGIN
         R.Left := fBoundsRect.Left;
         R.Top := fBoundsRect.Top;
         gtk_widget_get_size_request( fEventboxHandle, @ R.Right, @ R.Bottom );
         gtk_widget_size_request( fHandle, @ requisition );
         IF R.Right  < 0 THEN R.Right := requisition.width;
         IF R.Bottom < 0 THEN R.Bottom := requisition.height;
     END ELSE
     BEGIN
         window := GTK_WINDOW( fHandle );
         gtk_window_get_position(window, @ R.Left, @ R.Top);
         gtk_window_get_size(window, @ R.Right, @ R.Bottom);
     END;
     inc( R.Right, R.Left );
     inc( R.Bottom, R.Top );
     fBoundsRect := R;
   END;
   Result := fBoundsRect;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetBoundsRect( const Value: TRect );
var Rect: TRect;
begin
   Rect := GetBoundsRect;
   if RectsEqual( Value, Rect ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   {$IFDEF USE_FLAGS}
   if  (Value.Left <> fBoundsRect.Left) or (Value.Top <> fBoundsRect.Top) then
       include( fFlagsG2, G2_ChangedPos );
   {$ELSE}
   if Value.Left <> fBoundsRect.Left then fChangedPosSz := fChangedPosSz or 1;
   if Value.Top  <> fBoundsRect.Top  then fChangedPosSz := fChangedPosSz or 2;
   {$ENDIF}
   {$IFDEF USE_GRAPHCTLS}
   if  {$IFDEF USE_FLAGS} (G6_GraphicCtl in fFlagsG6)
       {$ELSE} not fWindowed {$ENDIF} then
       Invalidate;
   {$ENDIF}

   fBoundsRect := Value;
   Rect := Value;

   if fHandle <> 0 then
   begin
     SetWindowPos( fHandle, 0, Rect.Left, Rect.Top, Rect.Right - Rect.Left,
                   Rect.Bottom - Rect.Top, SWP_NOZORDER or SWP_NOACTIVATE );
   end;
   if  {$IFDEF USE_FLAGS} (G1_SizeRedraw in fFlagsG1)
       {$ELSE} fSizeRedraw {$ENDIF} then
       Invalidate;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}

{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TControl.SetBoundsRect( const Value: TRect );
VAR Rect: TRect;
    window: PGtkWindow;
BEGIN
   Rect := GetBoundsRect;
   if RectsEqual( Value, Rect ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   {$IFDEF USE_FLAGS}
   if  (Value.Left <> fBoundsRect.Left) or (Value.Top <> fBoundsRect.Top) then
       include( fFlagsG2, G2_ChangedPos );
   {$ELSE}
   if Value.Left <> fBoundsRect.Left then fChangedPosSz := fChangedPosSz or 1;
   if Value.Top  <> fBoundsRect.Top  then fChangedPosSz := fChangedPosSz or 2;
   {$ENDIF}
   fBoundsRect := Value;
   Rect := Value;

   IF  fIsControl then
   BEGIN
       //gtk_widget_set_uposition( fHandle, Rect.Left, Rect.Top );
       IF  fParent <> nil then
           fParent.fChildSetPos( fParent, @ Self, Rect.Left, Rect.Top );
       IF  (Rect.Right > Rect.Left) and (Rect.Bottom > Rect.Top) then
           gtk_widget_set_size_request( fEventboxHandle,
               Rect.Right - Rect.Left, Rect.Bottom - Rect.Top );
   END ELSE
   BEGIN
       window := GTK_WINDOW( fHandle );
       gtk_window_move( window, Rect.Left, Rect.Top );
       gtk_window_resize( window, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top );
   END;
   //if fSizeRedraw then
   //  Invalidate;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}
const
  WindowStateShowCommands: array[TWindowState] of Byte =
    (SW_SHOWNOACTIVATE, SW_SHOWMINNOACTIVE, SW_SHOWMAXIMIZED);
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetWindowState( Value: TWindowState );
begin
   if WindowState <> Value then
   begin
      DF.fWindowState := Value;
      if  fHandle <> 0 then
      ShowWindow(fHandle, WindowStateShowCommands[Value]);
   end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.Show;
begin
   CreateWindow;
   SetVisible( True );
   SetForegroundWindow( Handle );
   DoSetFocus;
end;
{$ENDIF PAS_VERSION}

procedure TControl.Hide;
begin
   SetVisible( False );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.Client2Screen( const P: TPoint ): TPoint;
begin
   Result := P;
   if fHandle <> 0 then
      Windows.ClientToScreen( fHandle, Result );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.Screen2Client( const P: TPoint ): TPoint;
begin
   Result := P;
   if Handle <> 0 then
      Windows.ScreenToClient( Handle, Result );
end;
{$ENDIF PAS_VERSION}

{$ENDIF WIN_GDI}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.ClientRect: TRect;
const BorderParams: array[ 0..5 ] of DWORD =
      ( SM_CXBORDER, SM_CXFRAME, SM_CXSIZEFRAME, SM_CYBORDER, SM_CYFRAME, SM_CYSIZEFRAME );
begin
   Result := fBoundsRect;
   GetWindowHandle;
   if (fHandle <> 0) then
      GetClientRect( fHandle, Result );
   Inc( Result.Top, fClientTop );
   Dec( Result.Bottom, fClientBottom );
   Inc( Result.Left, fClientLeft );
   Dec( Result.Right, fClientRight );
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION TControl.ClientRect: TRect; //todo: implement exact, now for PaintBox only
BEGIN
   Result := fBoundsRect;
   OffsetRect( Result, -Result.Left, -Result.Top );
   Inc( Result.Top, fClientTop );
   Dec( Result.Bottom, fClientBottom );
   Inc( Result.Left, fClientLeft );
   Dec( Result.Right, fClientRight );
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
procedure TControl.Invalidate;
begin
  {$IFDEF USE_GRAPHCTLS}
  PP.fDoInvalidate( @Self );
  {$ELSE}
   if fHandle <> 0 then
     InvalidateRect( fHandle, nil, TRUE );
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TControl.Invalidate;
BEGIN
  gtk_widget_queue_draw_area( fHandle, 0, 0, Width, Height );
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}
{$IFDEF USE_GRAPHCTLS}
procedure InvalidateNonWindowed( Sender: PObj );
var R: TRect;
begin
  R := PControl( Sender ).BoundsRect;
  if  PControl( Sender ).fParent.fHandle <> 0 then
      InvalidateRect( PControl( Sender ).fParent.fHandle, @ R, TRUE );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
procedure InvalidateWindowed( Sender: PObj );
begin
   if  PControl( Sender ).fHandle <> 0 then
       InvalidateRect( PControl( Sender ).fHandle, nil, TRUE );
end;
{$ENDIF PAS_VERSION}

{$ENDIF USE_GRAPHCTLS}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetIcon: HIcon;
begin
   Result := DF.fIcon;
   if  Result = THandle( -1 ) then
   begin
       Result := 0; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   end;
   if  Result = 0 then
       if  (Applet <> nil) and (@Self <> Applet) then
       begin
            Result := Applet.Icon;
            if  Result <> 0 then
                Result := CopyImage( Result, IMAGE_ICON, 0, 0, 0 );
       end
         else
       begin
           {$IFDEF NUMERIC_APPICON} {$DEFINE CUSTOM_APPICON} {$ENDIF}
           Result := LoadIcon( hInstance,
           {$IFDEF CUSTOM_APPICON} {$IFDEF NUMERIC_APPICON} PKOLChar( {$ENDIF} // avoid A/W casting
           {$I CustomAppIconRsrcName_PAS.inc} // create such file with 'your icon rsrc name' or yourIconID
           {$IFDEF NUMERIC_APPICON} ) {$ENDIF}
           {$ELSE} 'MAINICON' {$ENDIF} );
       end;
   DF.fIcon := Result;
end;
{$ENDIF PAS_VERSION}

procedure TControl.IconLoad(Inst: Integer; ResName: PKOLChar);
begin
  Icon := LoadIcon( Inst, ResName );
  {$IFDEF USE_FLAGS} include( fFlagsG1, G1_IconShared );
  {$ELSE}            fIconShared := TRUE; {$ENDIF}
end;

procedure TControl.IconLoadCursor(Inst: Integer; ResName: PKOLChar);
begin
  Icon := LoadCursor( Inst, ResName );
  {$IFDEF USE_FLAGS} include( fFlagsG1, G1_IconShared );
  {$ELSE}            fIconShared := TRUE; {$ENDIF}
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.CallDefWndProc(var Msg: TMsg): Integer;
begin
  {$IFDEF INPACKAGE}
  Result := 0;
  Log( '->TControl.CallDefWndProc FHandle = ' + Int2Str( FHandle ) +
    ', Msg.hwd = ' + Int2Str( Msg.hwnd ) );
  TRY
  {$ENDIF INPACKAGE}
    if FDefWndProc <> nil then
    begin
      {$IFDEF INPACKAGE}
      Log( '//// CallWindowProc, FDefWndProc = ' + Int2Hex( DWORD( FDefWndProc ), 6 ) );
      TRY
      TRY
      {$ENDIF INPACKAGE}
       Result := CallWindowProc(
           FDefWndProc, FHandle, Msg.message, Msg.wParam, Msg.lParam );
      {$IFDEF INPACKAGE}
      EXCEPT on E: Exception do
        Log( '*** Exception in CallWindowProc, msg = ' + E.Message );
      END;
      EXCEPT
        Log( '*** Exception handled' );
      END;
      {$ENDIF INPACKAGE}
    end
    else
    begin
      {$IFDEF INPACKAGE}
      Log( '//// DefWindowProc' );
      {$ENDIF INPACKAGE}
       Result := DefWindowProc( Msg.hwnd, Msg.message, Msg.wParam, Msg.lParam );
    end;
  {$IFDEF INPACKAGE}
    LogOK;
  FINALLY
    Log( '<-TControl.CallDefWndProc' );
  END;
  {$ENDIF INPACKAGE}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetWindowState: TWindowState;
begin
   Result := DF.fWindowState;
   if Handle <> 0 then
   begin
      if IsIconic( Handle ) then
         Result := wsMinimized
      else
      if IsZoomed( Handle ) then
         Result := wsMaximized
      else
         Result := wsNormal;
      //DF.fWindowState := Result;
   end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.DoSetFocus: Boolean;
begin
  Result := False;
  //if Enabled and (
  //   {$IFDEF USE_FLAGS}{$ELSE} fTabstop or {$ENDIF}
  //   (F2_Tabstop in fStyle.f2_Style)) then
  if  Enabled then
  begin
    Inc( fClickDisabled );
    SetFocus( fHandle );
    Dec( fClickDisabled );
    Result := True;
  end;
end;
{$ENDIF PAS_VERSION}

function TControl.HandleAllocated: Boolean;
begin
  Result := FHandle <> 0;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetEnabled: Boolean;
begin
  if   FHandle = 0 then
       Result := (Style and WS_DISABLED) = 0
  else Result := IsWindowEnabled( FHandle );
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.IsMainWindow: Boolean;
begin
  if Applet = nil then
    Result := not IsControl
  else if not AppButtonUsed then
    Result := @ Self = Applet
  else
    Result := Applet.Children[ 0 ] = @ Self;
end;
{$ENDIF PAS_VERSION}

{$IFDEF WIN_GDI}
{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TControl.get_ClassName: KOLString;
begin
  Result := fControlClassName;
  if  {$IFDEF USE_FLAGS} not(G6_CtlClassNameChg in fFlagsG6)
      {$ELSE} not fCtlClsNameChg {$ENDIF} then
      Result := KOLString('obj_') + Result;
end;
{$ENDIF PAS_VERSION}

procedure TControl.set_ClassName(const Value: KOLString);
begin
  if  {$IFDEF USE_FLAGS} G6_CtlClassNameChg in fFlagsG6
      {$ELSE} fCtlClsNameChg {$ENDIF} then
      FreeMem( fControlClassName );
  GetMem( fControlClassName, (Length( Value ) + 1) * Sizeof( KOLChar ) );
  {$IFDEF UNICODE_CTRLS} WStrCopy {$ELSE} StrCopy {$ENDIF}
    ( fControlClassName, @ Value[ 1 ] );
  {$IFDEF USE_FLAGS} include( fFlagsG6, G6_CtlClassNameChg );
  {$ELSE} fCtlClsNameChg := TRUE; {$ENDIF}
end;

function WndProcQueryEndSession( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Accept: Boolean;
begin
  Result := FALSE;
  if Msg.message = WM_QUERYENDSESSION then
  begin
    {$IFDEF DEBUG_ENDSESSION}
    LogFileOutput( GetStartDir + 'end_session.txt', '!' );
    {$ENDIF}
    {$IFDEF NIL_EVENTS}
    if Assigned( Sender.EV.fOnQueryEndSession ) then
    {$ENDIF}
    begin
      Accept := TRUE;
      Sender.DF.fCloseQueryReason := qShutdown;
      if  LongBool(Msg.lParam and {ENDSESSION_LOGOFF} DWORD($80000000)) then
          Sender.DF.fCloseQueryReason := qLogoff;
      Sender.EV.fOnQueryEndSession( Sender, Accept );
      Sender.DF.fCloseQueryReason := qClose;
      Rslt := Integer( Accept );
      // Äîáàâèòü. Íóæíî äëÿ òîãî, ÷òîáû îòìåíèëîñü çàâåðøåíèå ñåàíñà,
      // åñëè Accept óñòàíîâëåí â False è ñåàíñ çàâåðøèëñÿ ïðè Accept = True
      // Add (YS). To cancel ending session if Accept=FALSE but allow ending
      // session if Accept=TRUE.
      Result := True;  // {YS}: no further processing
    end;
  end;
end;

procedure TControl.SetOnQueryEndSession(const Value: TOnEventAccept);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnQueryEndSession := Value;
  AttachProc( WndProcQueryEndSession );
end;

function WndProcMinMaxRestore( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := FALSE;
  if Msg.message = WM_SYSCOMMAND then
  begin
    case Msg.wParam and not 15 of
    SC_MINIMIZE: {$IFDEF NIL_EVENTS}
                 if  Assigned( Sender.EV.fOnMinimize ) then
                 {$ENDIF}
                     Sender.EV.fOnMinimize( Sender );
    SC_MAXIMIZE: {$IFDEF NIL_EVENTS}
                 if  Assigned( Sender.EV.fOnMaximize ) then
                 {$ENDIF}
                     Sender.EV.fOnMaximize( Sender );
    SC_RESTORE:  {$IFDEF NIL_EVENTS}
                 if  Assigned( Sender.EV.fOnRestore ) then
                 {$ENDIF}
                     Sender.EV.fOnRestore( Sender );
    end;
  end;
end;

procedure TControl.SetOnMinMaxRestore(const Index: Integer;
  const Value: TOnEvent);
type POnEvent = ^TOnEvent;
{$IFDEF F_P}
var Ptr1: Pointer;
{$ELSE DELPHI}
var Evt: POnEvent;
{$ENDIF F_P/DELPHI}
begin
  {$IFDEF F_P}
  Ptr1 := @Self;
  asm
    MOV  EAX, [Ptr1]
    LEA  EAX, [EAX].TControl.fOnMinimize
    ADD  EAX, [Index]
    MOV  EDX, [Value]
    MOV  [EAX], EDX
    MOV  EDX, [Value+4]
    MOV  [EAX+4], EDX
  end [ 'EAX', 'EDX' ];
  {$ELSE DELPHI}
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents; {$ENDIF}
  Evt := Pointer( Integer( @ TMethod( EV.fOnMinimize ).Code ) + Index );
  Evt^ := Value;
  {$ENDIF}
  AttachProc( WndProcMinMaxRestore );
end;

procedure TControl.SetOnMinimize(const Value: TOnEvent);
begin
  SetOnMinMaxRestore( 0, Value );
end;

procedure TControl.SetOnMaximize(const Value: TOnEvent);
begin
  SetOnMinMaxRestore( 8, Value );
end;

procedure TControl.SetOnRestore(const Value: TOnEvent);
begin
  SetOnMinMaxRestore( 16, Value );
end;

function TControl.GetOnMinMaxRestore(const Index: Integer): TOnEvent;
begin
  CASE Index OF
  0: Result := EV.fOnMinimize;
  8: Result := EV.fOnMaximize;
  16: Result := EV.fOnRestore;
  END;
end;

{$IFDEF INPACKAGE}
  {$IFDEF ASM_LOCAL}
    {$UNDEF ASM_LOCAL}
  {$ENDIF}
{$ELSE}
  {$IFDEF ASM_VERSION}
    {$DEFINE ASM_LOCAL}
  {$ENDIF}
{$ENDIF}

{$ENDIF WIN_GDI}

{$IFDEF GDI}
{$IFDEF ASM_LOCAL}
{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetParent( Value: PControl );
begin
   if Value = fParent then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   if fParent <> nil then
   begin
     {$IFDEF USE_GRAPHCTLS}
     Invalidate; // necessary for graphic controls
     {$ENDIF}
     {$IFDEF DEBUG_MCK}
     if ( fParent.fChildren <> nil ) then
     begin
       mck_Log( 'remove from old parent children 1st' );
       fParent.fChildren.Remove( @Self );
       mck_Log( 'removed ok' );
     end;
     {$ELSE not DEBUG_MCK}
     fParent.fChildren.Remove( @Self );
     {$IFDEF NOT_USE_AUTOFREE4CONTROLS}
     {$ELSE}
     fParent.RemoveFromAutoFree( @Self );
     {$ENDIF}

     {$IFDEF NIL_EVENTS}
     if  Assigned( fParent.PP.fNotifyChild ) then
     {$ENDIF}
         fParent.PP.fNotifyChild( fParent, nil );
     {$ENDIF not DEBUG_MCK}
   end;
   fParent := Value;
   if fParent <> nil then
   begin
     fParent.fChildren.Add( @Self );
     {$IFDEF USE_AUTOFREE4CHILDREN}
     fParent.Add2AutoFree( @ Self );
     {$ENDIF}
     {$IFNDEF INPACKAGE} //-----------------------------------------------------
     if FHandle <> 0 then
       Windows.SetParent( FHandle, Value.GetWindowHandle );
     {$ENDIF not INPACKAGE} //--------------------------------------------------
     {$IFDEF NIL_EVENTS}
     if  Assigned( fParent.PP.fNotifyChild ) then
     {$ENDIF}
         fParent.PP.fNotifyChild( fParent, @ Self );
     {$IFDEF NIL_EVENTS}
     if  Assigned( PP.fNotifyChild ) then
     {$ENDIF}
         PP.fNotifyChild( fParent, @ Self );
     {$IFDEF USE_GRAPHCTLS}
     Invalidate; // necessary for graphic controls
     {$ENDIF}
   end;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TControl.SetParent( Value: PControl );
BEGIN
   IF Value = fParent THEN Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   IF fParent <> nil THEN
   begin
       fParent.fChildren.Remove( @Self );

       {$IFDEF NOT_USE_AUTOFREE4CONTROLS}
       {$ELSE}
       fParent.RemoveFromAutoFree( @Self );
       {$ENDIF}
   END;
   fParent := Value;
   IF  fParent <> nil THEN
   BEGIN
     fParent.fChildren.Add( @Self );
     {$IFDEF USE_AUTOFREE4CHILDREN}
     fParent.Add2AutoFree( @ Self );
     {$ENDIF}
   END;
   fParent.fGetClientArea( fParent );
   fParent.fChildPut( fParent, @ Self, fBoundsRect.Left, fBoundsRect.Top );
END;
{$ENDIF GTK}
{$ENDIF _X_}

function TControl.ChildIndex(Child: PControl): Integer;
begin
  Result := fChildren.IndexOf( Child );
end;

procedure TControl.MoveChild(Child: PControl; NewIdx: Integer);
var I: Integer;
begin
  I := ChildIndex( Child );
  {$IFDEF KOL_ASSERTIONS}
  Assert( I>=0, 'TControl.MoveChild: index out of bounds' );
  {$ENDIF KOL_ASSERTIONS}
  fChildren.MoveItem( I, NewIdx );
end;

{$IFDEF WIN_GDI}
procedure TControl.EnableChildren(Enable, Recursive: Boolean);
var I: Integer;
    C: PControl;
begin
  for I := 0 to ChildCount-1 do
  begin
    C := Children[ I ];
    C.Enabled := Enable;
    if Recursive then
      C.EnableChildren( Enable, TRUE );
  end;
end;

{$ENDIF WIN_GDI}
{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
constructor TControl.CreateParented(AParent: PControl);
begin
  InitParented( AParent ); // because InitParented is virtual, but CreateParented
end;                       // can not be virtual (as an _object_ - not a class - constructor)
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
CONSTRUCTOR TControl.CreateParented(AParent: PControl; widget: PGtkWidget;
  need_eventbox: Boolean);
BEGIN
  InitParented( AParent, widget, need_eventbox );
                           // because InitParented is virtual, but CreateParented
END;                       // can not be virtual (as an _object_ - not a class - constructor)
{$ENDIF GTK}
{$ENDIF _X_}

constructor TControl.CreateOrthaned( AParentWnd: HWnd );
begin
    InitOrthaned( AParentWnd );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetLeft: Integer;
begin
   Result := BoundsRect.Left;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetLeft( Value: Integer );
var R: TRect;
begin
   R := BoundsRect;
   R.Left := Value;
   R.Right := Value + Width;
   SetBoundsRect( R );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetTop: Integer;
begin
   Result := BoundsRect.Top;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetTop( Value: Integer );
var R: TRect;
begin
   R := BoundsRect;
   R.Top := Value;
   R.Bottom := Value + Height;
   SetBoundsRect( R );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetWidth: Integer;
begin
  with BoundsRect do
    Result := Right - Left;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetWidth( Value: Integer );
var R: TRect;
begin
  R := BoundsRect;
  with R do
    Right := Left + Value;
  SetBoundsRect( R );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetHeight: Integer;
begin
  with BoundsRect do
   Result := Bottom - Top;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetHeight( Value: Integer );
var R: TRect;
begin
   R := BoundsRect;
   with R do
     Bottom := Top + Value;
   SetBoundsRect( R );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetPosition: TPoint;
begin
  Result.x := BoundsRect.Left;
  Result.y := BoundsRect.Top;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.Set_Position( Value: TPoint );
var R: TRect;
begin
   R.Top := Value.y;
   R.Left := Value.x;
   R.Right := R.Left + Width;
   R.Bottom := R.Top + Height;
   BoundsRect := R;
end;
{$ENDIF PAS_VERSION}

{$IFDEF WIN_GDI}
function WndProcConstraints( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var MMI: PMinMaxInfo;
begin
  Result := FALSE;
  if Msg.message = WM_GETMINMAXINFO then
  begin
    Rslt := Sender.CallDefWndProc( Msg );
    MMI := Pointer( Msg.lParam );
    if Sender.FMaxWidth > 0 then
    begin
      MMI.ptMaxSize.x := Sender.FMaxWidth;
      MMI.ptMaxTrackSize.x := Sender.FMaxWidth;
    end;
    if Sender.FMaxHeight > 0 then
    begin
      MMI.ptMaxSize.y := Sender.FMaxHeight;
      MMI.ptMaxTrackSize.y := Sender.FMaxHeight;
    end;
    MMI.ptMinTrackSize := MakePoint( Sender.FMinWidth, Sender.FMinHeight );
    Rslt := 0;
    Result := TRUE;
  end;
end;

{$IFDEF USE_MHTOOLTIP}
{$DEFINE implementation_part}
{$I KOLMHToolTip_implem.inc}
{$UNDEF implementation_part}
{$ENDIF}

procedure TControl.SetConstraint(const Index: Integer; Value: SmallInt);
begin
  AttachProc( WndProcConstraints );
  case Index of
  0: FMinWidth := Value;
  1: FMinHeight := Value;
  2: FMaxWidth := Value;
  3: FMaxHeight := Value;
  end;
end;

function TControl.GetConstraint(const Index: Integer): SmallInt;
begin
  CASE Index OF
  0:   Result := FMinWidth;
  1:   Result := FMinHeight;
  2:   Result := FMaxWidth;
  else Result := FMaxHeight;
  END;
end;

function TControl.ControlRect: TRect;
var C: PControl;
    R: TRect;
begin
   Result := BoundsRect;
   C := Parent;
   if C <> nil then
   begin
      if  {$IFDEF USE_FLAGS} not(G3_IsControl in C.fFlagsG3)
          {$ELSE} not C.fIsControl {$ENDIF} then Exit; {>>>>>>>>>>>>>>>>>>>>>>>}

      R := C.ControlRect;
      OffsetRect( Result, R.Left, R.Top );

      if C.fChildren <> nil then
      if C.FChildren.IndexOf( @Self ) >= 0 then
      begin
         R := C.ClientRect;
         Dec( R.Top, C.fClientTop );
         Dec( R.Left, C.fClientLeft );
         OffsetRect( Result, R.Left, R.Top );
      end;
   end;
end;

function TControl.ControlAtPos( X, Y: Integer; IgnoreDisabled: Boolean ): PControl;
var I: Integer;
    C: PControl;
    CR, VR: TRect;
begin
   Result := nil;
   CR := ControlRect; // îòíîñèòåëüíûå êîîðäèíàòû â ñèñòåìå ÐÎÄÈÒÅËÜÑÊÎÃÎ ÊÎÍÒÐÎËÀ
   if  {$IFDEF USE_FLAGS} not(G6_GraphicCtl in fFlagsG6)
       {$ELSE} fWindowed {$ENDIF} then CR := MakeRect( 0, 0, 0, 0 );
   X := X + CR.Left; // - R.Left;
   Y := Y + CR.Top; // - R.Top;
   for I := ChildCount - 1 downto 0 do
   begin
      C := Children[ I ]; //Members[ I ];
      if C.Visible then
      if (not IgnoreDisabled) or IgnoreDisabled and C.Enabled then
      begin
         VR := C.ControlRect;
         if (X >= VR.Left) and (X < VR.Right) and
            (Y >= VR.Top) and (Y < VR.Bottom) then
         begin
            Result := C; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
         end;
      end;
   end;
end;
{$ENDIF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure DefaultPaintBackground( Sender: PControl; DC: HDC; Rect: PRect );
{$IFDEF GDI} var B: HBrush; {$ENDIF GDI}
begin
  {$IFDEF GDI}
  B := CreateSolidBrush( Color2Rgb( Sender.Color ) );
  Windows.FillRect( DC, Rect^, B );
  DeleteObject( B );
  {$ENDIF GDI}
end;
{$ENDIF PAS_VERSION}

{$IFDEF WIN_GDI}
procedure TControl.PaintBackground( DC: HDC; Rect: PRect );
begin
  Global_OnPaintBkgnd( @Self, DC, Rect );
end;
{$ENDIF WIN_GDI}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetCtlColor( Value: TColor );
begin
  {$IFNDEF INPACKAGE}
  if GetWindowHandle <> 0 then
  {$ELSE}
  if fHandle <> 0 then
  {$ENDIF}
  if fCommandActions.aSetBkColor <> 0 then
    Perform( fCommandActions.aSetBkColor, 0, Color2RGB( Value ) );
  if fColor = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fColor := Value;
  if  fTmpBrush <> 0 then
  begin
      DeleteObject( fTmpBrush );
      fTmpBrush := 0;
  end;
  if fBrush <> nil then
    fBrush.Color := Value;
  Invalidate;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TControl.SetCtlColor( Value: TColor );
VAR gcolor: TGdkColor;
    i: Integer;
BEGIN
  if fColor = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fColor := Value;
  gcolor := Color2GdkColor( Value );
  FOR i := 0 to 4 do
  BEGIN
    gtk_widget_modify_bg( fEventboxHandle, {GTK_STATE_NORMAL} i, @ gcolor );
    gtk_widget_modify_base( fEventboxHandle, {GTK_STATE_NORMAL} i, @ gcolor );
  END;
  //if Assigned( _Self.fFont ) then
  {begin
    _Self.fHandle.style.font_desc :=
      pango_font_description_copy( _Self.fFont.GetPangoFontDesc );
    if oldfontdesc <> nil then
      pango_font_description_free( oldfontdesc );
  end;}

  //Invalidate;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetParentWnd( NeedHandle: Boolean ): HWnd;
var C: PControl;
begin
   Result := FParentWnd;
   C := fParent; // WindowedParent;
   if C <> nil then
   begin
     if NeedHandle then
        C.GetWindowHandle;
     Result := C.fHandle;
   end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
procedure TControl.CreateChildWindows;
asm
        PUSH      ESI
        MOV       ESI, [EAX].TControl.fChildren
        MOV       ECX, [ESI].TList.fCount
        MOV       ESI, [ESI].TList.fItems
        JECXZ     @@exit

@@loop: PUSH      ECX
        LODSD
        CALL      CallTControlCreateWindow
        POP       ECX
        LOOP      @@loop

@@exit: POP       ESI
end;
{$ELSE PAS_VERSION} //Pascal
procedure TControl.CreateChildWindows;
var I: Integer;
    C: PControl;
begin
  {$IFDEF INPACKAGE}
  Log( '->TControl.CreateChildWindows' );
  TRY
  {$ENDIF INPACKAGE}
  for I := 0 to fChildren.Count - 1 do
  begin
     {$IFDEF INPACKAGE}
             Log( Int2Str( I ) );
     {$ENDIF INPACKAGE}
     C := fChildren.Items[ I ];
     C.CreateWindow; //virtual!!!
  end;
  {$IFDEF INPACKAGE}
    LogOK;
  FINALLY
    Log( '<-TControl.CreateChildWindows' );
  END;
  {$ENDIF INPACKAGE}
end;
{$ENDIF PAS_VERSION}

{$ENDIF WIN_GDI}
function TControl.GetMembers(Idx: Integer): PControl;
begin
   Result := fChildren.Items[ Idx ];
   // Important: .Items but not .fItems - when fChildren.Count=0, nil is returned
end;
{$IFDEF WIN_GDI}

{$IFDEF ASM_TLIST}
procedure TControl.DestroyChildren;
asm
        PUSH      ESI

        MOV       EAX, [EAX].fChildren
        PUSH      EAX
        MOV       ECX, [EAX].TList.fCount
        JECXZ     @@clear
        MOV       ESI, [EAX].TList.fItems
        LEA       ESI, [ESI + ECX*4 - 4]  // is order really important ?

@@loop: STD                               //
        LODSD
        CLD                               //

        PUSH      ECX
        CALL      TObj.RefDec
        POP       ECX

        LOOP      @@loop

@@clear:
        POP       EAX
        CALL      TList.Clear

        POP       ESI
end;
{$ELSE PAS_VERSION} //Pascal
procedure TControl.DestroyChildren;
var I: Integer;
    W: PControl;
begin
   for I := fChildren.fCount - 1 downto 0 do
   begin
      W := fChildren.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ];
      W.Free;
   end;
   fChildren.Clear;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.ProcessMessage: Boolean;
var Msg: TMsg;
    P: Windows.PMsg;
begin
   Result := False;
   if PeekMessage( Msg, 0, 0, 0, PM_REMOVE ) then
   begin
      Result := Msg.message <> 0;
      if (Msg.message = WM_QUIT) then
      begin
        AppletTerminated := True;
        {$IFDEF PROVIDE_EXITCODE}
        ExitCode := Msg.wParam;
        {$ENDIF PROVIDE_EXITCODE}
      end
      else
      begin
        if not(
           {$IFDEF NIL_EVENTS} Assigned( PP.fExMsgProc ) and {$ENDIF}
           PP.fExMsgProc( @Self, Msg )) then
        begin
          P := Pointer( @Msg );
          TranslateMessage( P^ );
          DispatchMessage( Msg );
          {$IFDEF PSEUDO_THREADS}
          if Assigned( MainThread ) then
            MainThread.NextThread;
          {$ENDIF}
        end;
      end;
   end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.ProcessMessages;
begin
  while ProcessMessage do ;
end;
{$ENDIF PAS_VERSION}

procedure TControl.ProcessMessagesEx;
begin
  PostMessage( GetWindowHandle, CM_PROCESS, 0, 0 );
  ProcessMessages;
end;

procedure TControl.ProcessPendingMessages;
var Msg: TMsg;
begin
  if LOWORD( GetQueueStatus( QS_ALLINPUT ) ) <> 0 then
  if PeekMessage( Msg, 0, 0, 0, PM_NOREMOVE {or PM_NOYIELD} )
  or PeekMessage( Msg, HWnd(-1), 0, 0, PM_NOREMOVE {or PM_NOYIELD} )
  then
    Applet.ProcessMessages;
end;

procedure TControl.ProcessPaintMessages;
var Msg: TMsg;
begin
  while PeekMessage( Msg, Handle, 15, 15, PM_NOREMOVE ) do
    Applet.ProcessMessage;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function WndProcForm(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
{$IFDEF ENDSESSION_HALT}
var App: PControl;
{$ENDIF}
begin
  Result := True;
  case Msg.message of
  {$IFDEF ENDSESSION_HALT}
  WM_ENDSESSION:
    begin
      if Msg.wParam <> 0 then
      begin
        Self_.RefDec;
        { Normally, WM_ENDSESSION is sent to a main form, not to Applet.
          Since we do not plan further working after handling this message,
          we decrease RefCount for the form (in was increased in EnumDynHandlers
          to prevent object destroying while its message processing is not
          finished). }
        App := Applet;
        //Rslt := 0; { We will not return any result at all. }
        {$IFDEF DEBUG_ENDSESSION}
        EndSession_Initiated := TRUE;
        LogFileOutput( GetStartDir + 'es_debug.txt',
                       'Self_=' + Int2Hex( DWORD( Self_ ), 8 ) +
                       ' Self_.Handle=' + Int2Str( Self_.FHandle ) );
        {$ENDIF}
        AppletTerminated := TRUE;
        AppletRunning := FALSE;
        Applet := nil;
        App.Free; { We provide OnDestroy handlers to be called for any objects here }
        Halt; { Stop further executing. }
      end else Result := FALSE;
    end;
  {$ENDIF ENDSESSION_HALT}
  WM_SETFOCUS:
      begin
          {$IFDEF NEW_MODAL}
          if Self_.DF.fModalForm <> nil then
            SetFocus( Self_.DF.fModalForm.fHandle )
          else if ( Self_.DF.FCurrentControl <> nil ) and
                  {$IFDEF USE_FLAGS} not( (G3_IsForm in Self_.DF.fCurrentControl.fFlagsG3)
                                       xor(G3_IsApplet in Self_.fFlagsG3) )
                  {$ELSE} not(Self_.DF.FCurrentControl.fIsForm xor Self_.fIsApplet)
                  {$ENDIF} then
          {$ELSE not NEW_MODAL}
          if Self_.DF.FCurrentControl <> nil then
          {$ENDIF}
          begin
            if Self_.DF.FCurrentControl.CreateWindow then
              SetFocus( Self_.DF.FCurrentControl.fHandle );
          end
          else
            Result := False;
          if assigned( Applet ) and (Applet <> Self_) then
             Applet.DF.FCurrentControl := Self_;
      end;
  //WM_NCDESTROY:
  //    Self_.RefDec;
  else Result := False;
  end;
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function GetPrevCtrlBoundsRect( P: PControl; var R: TRect ): Boolean;
var Idx: Integer;
begin
  Result := False;
  if P.FParent = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Idx := P.FParent.ChildIndex( P ) - 1;
  if Idx < 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := True;
  R := P.FParent.Children[ Idx ].BoundsRect;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.PlaceUnder: PControl;
var R: TRect;
begin
  Result := @Self;
  if not GetPrevCtrlBoundsRect( @Self, R ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>}
  Top := R.Bottom + fParent.fMargin;
  Left := R.Left;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.PlaceDown: PControl;
var R: TRect;
begin
  Result := @Self;
  if not GetPrevCtrlBoundsRect( @Self, R ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>}
  Top := R.Bottom + fParent.fMargin;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.PlaceRight: PControl;
var R: TRect;
begin
  Result := @Self;
  if not GetPrevCtrlBoundsRect( @Self, R ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>}
  Top := R.Top;
  Left := R.Right + fParent.fMargin;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.SetSize(W, H: Integer): PControl;
var R: TRect;
begin
  R := BoundsRect;
  if W > 0 then R.Right := R.Left + W;
  if H > 0 then R.Bottom := R.Top + H;
  SetBoundsRect( R );
  Result := @Self;
end;
{$ENDIF PAS_VERSION}
{$IFDEF WIN_GDI}

function TControl.SetClientSize(W, H: Integer): PControl;
begin
  if W > 0 then ClientWidth := W;
  if H > 0 then ClientHeight := H;
  Result := @Self;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.AlignLeft(P: PControl): PControl;
begin
  Result := @Self;
  Left := P.Left;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.AlignTop(P: PControl): PControl;
begin
  Result := @Self;
  Top := P.Top;
end;
{$ENDIF PAS_VERSION}

{$IFDEF KEY_PREVIEW}
  {$DEFINE KEY_PREVIEW_OR_ESC_CLOSE_DIALOGS}
{$ENDIF}
{$IFDEF ESC_CLOSE_DIALOGS}
  {$IFNDEF KEY_PREVIEW_OR_ESC_CLOSE_DIALOGS}
    {$DEFINE KEY_PREVIEW_OR_ESC_CLOSE_DIALOGS}
  {$ENDIF}
{$ENDIF}

{$IFDEF ASM_VERSION} // see addition for combobox in pas version
{$ELSE PAS_VERSION} //Pascal
function WndProcCtrl(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
var F: PControl;
    Cmd : DWORD;
begin
  Result := FALSE;
  with Self_^ do
  case Msg.message of
  CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
       begin
         SetTextColor(Msg.WParam, Color2RGB(fTextColor));
         if  {$IFDEF USE_FLAGS} G2_Transparent in fFlagsG2
             {$ELSE} fTransparent {$ENDIF} then
         begin
              SetBkMode( Msg.wParam, Windows.TRANSPARENT );
              Rslt := GetStockObject( NULL_BRUSH );
         end  else
         begin
              SetBkMode( Msg.wParam, Windows.OPAQUE );
              SetBkColor(Msg.WParam, Color2RGB( fColor ) );
              Rslt := Global_GetCtlBrushHandle( Self_ );
         end;
         Result := TRUE;
       end;
  CM_COMMAND:
       begin
         Result := True;
         Cmd := HiWord( Msg.wParam );
         if Cmd = fCommandActions.aClick then
         begin
            if Integer( fClickDisabled ) <= 0 then
            begin
              Focused := TRUE;
              DoClick;
            end;
         end else
         if Cmd = fCommandActions.aEnter then
         begin
            if Assigned( EV.fOnEnter ) then EV.fOnEnter( Self_ );
         end else
         if Cmd = fCommandActions.aLeave then
         begin
            if Assigned( EV.fOnLeave ) then EV.fOnLeave( Self_ );
         end else
         if Integer(Cmd) = fCommandActions.aChange then
         begin
            if Assigned( EV.fOnChangeCtl ) then EV.fOnChangeCtl( Self_ );
         end else
         if Integer(Cmd) = fCommandActions.aSelChange then
         begin
           DoSelChange;
         end
         else Result := False;

         if Result then
           Rslt := CallDefWndProc( Msg );

       end;

  WM_SETFOCUS:
       begin
         Rslt := 0;
         Result := TRUE;
         F := ParentForm;
         if F <> nil then
         begin
           if (F.DF.fCurrentControl <> nil) and (F.DF.fCurrentControl <> Self_)
           {$IFDEF NIL_EVENTS}
           and Assigned( F.DF.fCurrentControl.EV.fLeave )
           {$ENDIF}
           then
               F.DF.fCurrentControl.EV.fLeave( F.DF.fCurrentControl );
           F.DF.fCurrentControl := Self_;
           Result := False; // go further handling
         end;
       end;
  {$IFDEF KEY_PREVIEW_OR_ESC_CLOSE_DIALOGS}
  WM_KEYDOWN:
       begin
  {$IFDEF KEY_PREVIEW}
  //--------------------------------Truf-------------------------------------
         F := ParentForm;
         if F <> Self_ then
            begin
              if  {$IFDEF USE_FLAGS} G6_KeyPreview in F.fFlagsG6
                  {$ELSE} F.fKeyPreview {$ENDIF} then
              begin
                  {$IFDEF USE_FLAGS}
                          include( F.fFlagsG4, G4_Pushed );
                  {$ELSE} F.fKeyPreviewing := TRUE; {$ENDIF}
                  inc( F.DF.fKeyPreviewCount );
                  F.Perform(WM_KEYDOWN,msg.wParam,msg.lParam);
                  dec( F.DF.fKeyPreviewCount );
              end;
            end;
  //--------------------------------Truf-------------------------------------
  {$ENDIF KEY_PREVIEW}
  {$IFDEF ESC_CLOSE_DIALOGS}
  //---------------------------------Babenko Alexey--------------------------
         begin
           F := ParentForm;
           if  (F.fExStyle and WS_EX_DLGMODALFRAME) <> 0 then
           if  Msg.wParam = 27 then
               F.Perform(WM_CLOSE, 0, 0);
         end;
  //---------------------------------Babenko Alexey--------------------------
  {$ENDIF ESC_CLOSE_DIALOGS}
       end;
  {$IFDEF KEY_PREVIEW}
  WM_KEYUP..WM_SYSDEADCHAR:
       begin
           F := ParentForm;
           if F <> Self_ then
           begin
              if  {$IFDEF USE_FLAGS} G6_KeyPreview in F.fFlagsG6
                  {$ELSE} F.fKeyPreview {$ENDIF} then
              begin
                  {$IFDEF USE_FLAGS}
                          include( F.fFlagsG4, G4_Pushed );
                  {$ELSE} F.fKeyPreviewing := TRUE; {$ENDIF}
                  inc( F.DF.fKeyPreviewCount );
                  F.Perform(Msg.message,msg.wParam,msg.lParam);
                  dec( F.DF.fKeyPreviewCount );
              end;
           end;
       end;
  {$ENDIF KEY_PREVIEW}
  {$ENDIF KEY_PREVIEW_OR_ESC_CLOSE_DIALOGS}
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF OLD_TRANSPARENT}
function WndProcTransparent( Sender: PControl; var Msg: TMsg;
     var Rslt: Integer ): Boolean;
var      DC, PDC, BLTDC: HDC;
          Save: integer;
          OLDp: THANDLE;
          L, T: SmallInt;
          TP, ParentClient: TPoint;
          TR, Margins: TRect;
          Wnd: HWND;
          tRgn: HRgn;
          C: PControl;
begin
     Result := FALSE;
     {$IFDEF STOP_WNDPROCTRANSPARENT_AFTER_APPLETTERMINATED}
     if AppletTerminated or not Sender.ToBeVisible then
        Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
     {$ENDIF}
     case Msg.message of
         WM_HSCROLL, WM_VSCROLL:
             begin
                 Sender.Invalidate; exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
             end;
         WM_SETTEXT:
             begin
                 if  {$IFDEF USE_FLAGS} not(G1_IsStaticControl in Sender.fFlagsG1)
                     {$ELSE} Sender.fIsStaticControl = 0 {$ENDIF} then
                     exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                 Sender.Invalidate;
                 Rslt := DefWindowProc
                   ( Sender.fHandle, WM_SETTEXT, Msg.wParam, Msg.lParam );
                 Result := TRUE; exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
             end;
         WM_NCPAINT:
             begin
                 if Sender.fTransparent then
                     Result := TRUE;
                 exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
             end;
     end;
     if  Sender.fTransparent and (
         {$IFDEF USE_FLAGS} not(G2_DoubleBuffered in Sender.FParent.fFlagsG2)
         {$ELSE} not Sender.fParent.fDoubleBuffered {$ENDIF} ) then
         Sender.fTransparent := FALSE;
     if  {$IFDEF USE_FLAGS} [G2_DoubleBuffered, G2_Transparent] * Sender.fFlagsG2 = []
         {$ELSE} not (Sender.fTransparent or Sender.fDoubleBuffered) {$ENDIF} then
         exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
     if  Sender.fAnchors and SELF_REQ_PAINT <> 0 then exit; {>>>>>>>>>>>>>>>>>>}

     case Msg.message of
         WM_ERASEBKGND:
             begin
                 Result := TRUE;
             end;
         WM_PAINT:
             begin
                 ValidateRect(Sender.fHandle, nil);  //???--brandys???
                 if (Sender.fTransparent)
                 and (Sender.fAnchors and PARENT_REQ_PAINT = 0) then
                 begin
                     InvalidateRect(Sender.fParent.Handle, nil, FALSE);
                     Result := TRUE; exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                 end;
                 GetClientRect(Msg.hwnd, Margins);
                 OLDp := 0;
                 if  Sender.fAnchors and PARENT_REQ_PAINT = 0 then
                 begin
                     Sender.fDblExcludeRgn := CreateRectRgn(0, 0, Margins.Right, Margins.Bottom);
                     DC := GetDC(0);
                     PDC := CreateCompatibleDC( DC );
                     OLDp := SelectObject(PDC,
                         CreateCompatibleBitmap(DC, Margins.Right, Margins.Bottom) );
                     ReleaseDC(0, DC);
                     Sender.fParentCoordX := 0;
                     Sender.fParentCoordy := 0;
                 end else begin
                     PDC := Msg.wParam;
                     Sender.fDblExcludeRgn := Sender.fParent.fDblExcludeRgn;
                 end;

                 Sender.fAnchors := Sender.fAnchors or SELF_REQ_PAINT;
                 Sender.fPaintDC := PDC;
                 if  (Sender.fAnchors and PARENT_REQ_PAINT = 0) or
                     {$IFDEF USE_FLAGS} G2_DoubleBuffered in Sender.fFlagsG2
                     {$ELSE} Sender.fDoubleBuffered {$ENDIF} then
                     Sender.Perform(WM_ERASEBKGND, PDC, 0);
                 Sender.Perform(WM_PAINT, PDC, 0);

                 Wnd := GetWindow( Sender.fHandle, GW_CHILD );
                 Wnd := GetWindow( Wnd, GW_HWNDLAST);
                 while Wnd <> 0 do begin
                     if IsWindowVisible(Wnd) then begin
                         {$IFDEF USE_PROP}
                         C := Pointer( GetProp( Wnd, ID_SELF ) );
                         {$ELSE}
                         C := Pointer( GetWindowLong( Wnd, GWL_USERDATA ) );
                         {$ENDIF}
                         with C^ do begin
                             if  (C <> nil) and
                                 {$IFDEF USE_FLAGS} ( [G2_DoubleBuffered, G2_Transparent]
                                         * fFlagsG2 <> [] )
                                 {$ELSE} (fTransparent or fDoubleBuffered) {$ENDIF} then
                             begin
                                 Save := SaveDC( PDC );
                                 Include( fAnchors, PARENT_REQ_PAINT );
                                 L := Sender.fParentCoordX + Left;
                                 T := Sender.fParentCoordY + Top;
                                 SetWindowOrgEx(PDC, -L, -T, nil);
                                 SendMessage(Wnd, WM_PRINT, PDC, PRF_NONCLIENT);
                                 TP.x := 0; TP.Y := 0;
                                 ClientToScreen(fHandle, TP);
                                 GetWindowRect(fHandle, TR);
                                 fParentCoordX := L + TP.X - TR.Left;
                                 fParentCoordY := T + TP.Y - TR.Top;
                                 SetWindowOrgEx(PDC, -fParentCoordX, -fParentCoordY, nil);
                                 GetClientRect(Wnd, TR);
                                 IntersectClipRect(PDC, 0, 0, TR.Right, TR.Bottom);
                                 SendMessage(Wnd, WM_PAINT, PDC, 0);
                                 Exclude( fAnchors, PARENT_REQ_PAINT );
                                 RestoreDC( PDC, Save );
                             end else
                             begin
                                 GetWindowRect(Wnd, TR);
                                 TP.X := 0; TP.Y := 0;
                                 ClientToScreen(Sender.fHandle, TP);
                                 TP.X := TR.Left - TP.X + Sender.fParentCoordX;
                                 TP.Y := TR.Top - TP.Y + Sender.fParentCoordY;
                                 TR.Left := TR.Right - TR.Left;
                                 TR.Top := TR.Bottom - TR.Top;

                                 tRgn := CreateRectRgn(TP.X, TP.Y, TP.X+TR.Left, TP.Y+TR.Top);
                                 CombineRgn(Sender.fDblExcludeRgn, Sender.fDblExcludeRgn, tRgn, RGN_DIFF);
                                 DeleteObject(tRgn);
                             end;
                         end;
                     end;
                     Wnd := GetWindow( Wnd, GW_HWNDPREV );
                 end;
                 Sender.fPaintDC := 0;
                 Sender.fAnchors := Sender.fAnchors and not SELF_REQ_PAINT;

                 if  Sender.fAnchors and PARENT_REQ_PAINT = 0 then
                 begin
                     BLTDC := GetWindowDC(Sender.fHandle);
                     GetWindowRect( Sender.fHandle, TR );
                     ParentClient.x := 0; ParentClient.y := 0;
                     ClientToScreen( Sender.fHandle, ParentClient );
                     SetWindowOrgEx(BLTDC, TR.Left - ParentClient.x, TR.Top - ParentClient.y, nil);
                     OffsetRgn(Sender.fDblExcludeRgn, ParentClient.x - TR.Left, ParentClient.y - TR.Top);
                     ExtSelectClipRgn(BLTDC, Sender.fDblExcludeRgn, RGN_AND);

                     BitBlt( BLTDC, 0, 0, Margins.Right, Margins.Bottom, PDC, 0, 0, SRCCOPY );
                     ReleaseDC(Sender.fHandle, BLTDC);
                     DeleteObject(SelectObject( PDC, OLDp ));
                     DeleteObject(Sender.fDblExcludeRgn);
                     DeleteDC( PDC );
                 end;

                 //ValidateRect(Sender.fHandle, nil); //???++brandys???//
                 Result := TRUE;
             end;
     end;
end;
{$ELSE NEW_TRANSPARENT} // by Alexander Karpinsky a.k.a. homm
function WndProcTransparent( Sender: PControl; var Msg: TMsg;
     var Rslt: Integer ): Boolean;

  function SetRectRgnInderect(tRgn: HRGN; const TR: TRect): BOOL;
  begin
    Result := SetRectRgn(tRgn, TR.Left, TR.Top, TR.Right, TR.Bottom);
  end;

var
  DC, PDC, BLTDC: HDC;
  Save: integer;
  OLDp: THANDLE;
  L, T: SmallInt;
  TP: TPoint;
  TR, Margins: TRect;
  Wnd: HWND;
  C: PControl;
  ChildRgn: HRGN;
  PS: TPaintStruct;

begin
  Result := FALSE;

  {$IFDEF STOP_WNDPROCTRANSPARENT_AFTER_APPLETTERMINATED}
  if AppletTerminated or not Sender.ToBeVisible then
     Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$ENDIF}

  if  {$IFDEF USE_FLAGS} (G2_Transparent in Sender.fFlagsG2)
      {$ELSE} Sender.fTransparent {$ENDIF} and (
      {$IFDEF USE_FLAGS} not(G2_DoubleBuffered in Sender.FParent.fFlagsG2)
      {$ELSE} not Sender.fParent.fDoubleBuffered {$ENDIF} ) then
      {$IFDEF USE_FLAGS} exclude( Sender.fFlagsG2, G2_Transparent );
      {$ELSE}  Sender.fTransparent := FALSE; {$ENDIF}
  if  {$IFDEF USE_FLAGS} [G2_DoubleBuffered, G2_Transparent] * Sender.fFlagsG2 = []
      {$ELSE} not (Sender.fTransparent or Sender.fDoubleBuffered) {$ENDIF} then
      exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

  case Msg.message of
    WM_HSCROLL, WM_VSCROLL:
      begin
        Sender.Invalidate; exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
    WM_SETTEXT:
      begin
        if  {$IFDEF USE_FLAGS} not(G1_IsStaticControl in Sender.fFlagsG1)
            {$ELSE} Sender.fIsStaticControl = 0 {$ENDIF} then exit; {>>>>>>>>>>}
        Sender.Invalidate;
        Rslt := DefWindowProc ( Sender.fHandle, WM_SETTEXT, Msg.wParam, Msg.lParam );
        Result := TRUE; exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
    WM_PAINT,
    WM_ERASEBKGND:;
    WM_NCPAINT:
      if  {$IFDEF USE_FLAGS} not(G2_Transparent in Sender.fFlagsG2)
          {$ELSE} not Sender.fTransparent {$ENDIF} then
          exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    else exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  if  Sender.fAnchors and SELF_REQ_PAINT <> 0 then exit; {>>>>>>>>>>>>>>>>>>>>>}
  Result := TRUE;
  if  Assigned(Sender.fParent)
  and {$IFDEF USE_FLAGS} not(G3_IsForm in Sender.fFlagsG3)
      {$ELSE} (not Sender.fIsForm) {$ENDIF}
  and {$IFDEF USE_FLAGS} (G2_DoubleBuffered in Sender.FParent.fFlagsG2)
      {$ELSE} Sender.FParent.fDoubleBuffered {$ENDIF}
  and (Sender.fAnchors and PARENT_REQ_PAINT = 0) then
  begin
    TR := Sender.BoundsRect;
    InvalidateRect(Sender.fParent.fHandle, @TR, true);
    ValidateRect(Sender.fHandle, nil);  //???--brandys???+
    exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;

  if Msg.message = WM_PAINT then begin
    OLDp := 0;
    if  Sender.fAnchors and PARENT_REQ_PAINT = 0 then
    begin
        Sender.fDblExcludeRgn := CreateRectRgn(0, 0, 0, 0);
        if Integer( GetUpdateRgn(Sender.fHandle, Sender.fDblExcludeRgn, TRUE) ) <= NULLREGION then
        begin
          DeleteObject(Sender.fDblExcludeRgn);
          exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;

        DC := BeginPaint(Sender.fHandle, PS);
        PDC := CreateCompatibleDC( DC );
        GetClientRect(Msg.hwnd, Margins);
        OLDp := SelectObject(PDC, CreateCompatibleBitmap(DC, Margins.Right, Margins.Bottom) );
        Sender.fParentCoordX := 0;
        Sender.fParentCoordy := 0;
    end else
    begin
        PDC := Msg.wParam;
        Sender.fDblExcludeRgn := Sender.fParent.fDblExcludeRgn;
    end;

    Sender.fAnchors := Sender.fAnchors or SELF_REQ_PAINT;
    Sender.fPaintDC := PDC;
    if  (Sender.fAnchors and PARENT_REQ_PAINT = 0) or
        {$IFDEF USE_FLAGS} (G2_DoubleBuffered in Sender.fFlagsG2)
        {$ELSE} Sender.fDoubleBuffered {$ENDIF} then
        Sender.Perform(WM_ERASEBKGND, PDC, 0);
    Sender.Perform(WM_PAINT, PDC, 0);


    Wnd := GetWindow( Sender.fHandle, GW_CHILD );
    Wnd := GetWindow( Wnd, GW_HWNDLAST);
    while Wnd <> 0 do begin
      if IsWindowVisible(Wnd) then begin
        ChildRgn := CreateRectRgn(0, 0, 0, 0);
        if Integer( GetWindowRgn(WND, ChildRgn) ) <= NULLREGION then begin
          GetWindowRect(WND, TR);
          TP.X := 0; TP.Y := 0;
          ClientToScreen(Sender.fHandle, TP);
          OffsetRect(TR, -TP.X , -TP.Y);
          SetRectRgnInderect(ChildRgn, TR);
        end;
        OffsetRgn(ChildRgn, Sender.fParentCoordX, Sender.fParentCoordY);

        {$IFDEF USE_PROP}
        C := Pointer( GetProp( Wnd, ID_SELF ) );
        {$ELSE}
        C := Pointer( GetWindowLong( Wnd, GWL_USERDATA ) );
        {$ENDIF}
        if CombineRgn(ChildRgn, ChildRgn, Sender.fDblExcludeRgn, RGN_AND) >= SIMPLEREGION then begin
          with C^ do begin
           if  (C <> nil) and
               {$IFDEF USE_FLAGS} ( [G2_DoubleBuffered, G2_Transparent] * fFlagsG2 <> [] )
               {$ELSE} (fTransparent or fDoubleBuffered) {$ENDIF} then
           begin
              Save := SaveDC( PDC );
              fAnchors := fAnchors or PARENT_REQ_PAINT;

              L := Sender.fParentCoordX + Left;
              T := Sender.fParentCoordY + Top;
              SetWindowOrgEx(PDC, -L, -T, nil);
              SendMessage(Wnd, WM_PRINT, PDC, PRF_NONCLIENT);
              TP.x := 0; TP.Y := 0;
              ClientToScreen(fHandle, TP);
              GetWindowRect(fHandle, TR);
              fParentCoordX := L + TP.X - TR.Left;
              fParentCoordY := T + TP.Y - TR.Top;
              SetWindowOrgEx(PDC, -fParentCoordX, -fParentCoordY, nil);
              GetClientRect(Wnd, TR);
              IntersectClipRect(PDC, 0, 0, TR.Right, TR.Bottom);
              SendMessage(Wnd, WM_PAINT, PDC, 0);
              fAnchors := fAnchors and not PARENT_REQ_PAINT;
              RestoreDC( PDC, Save );
            end else begin
              CombineRgn(Sender.fDblExcludeRgn, Sender.fDblExcludeRgn, ChildRgn, RGN_DIFF);
            end;
          end;
        end; // if Save >= SIMPLEREGION then begin
        DeleteObject(ChildRgn);
      end;
      Wnd := GetWindow( Wnd, GW_HWNDPREV );
    end;
    Sender.fPaintDC := 0;
    Sender.fAnchors := Sender.fAnchors and not SELF_REQ_PAINT;

    if  Sender.fAnchors and PARENT_REQ_PAINT = 0 then
    begin
        BLTDC := GetDCEx(Sender.fHandle, 0, DCX_CACHE or DCX_CLIPSIBLINGS);
        ExtSelectClipRgn(BLTDC, Sender.fDblExcludeRgn, RGN_AND);

        BitBlt(BLTDC, 0, 0, Margins.Right, Margins.Bottom, PDC, 0, 0, SRCCOPY );

        ReleaseDC(Sender.fHandle, BLTDC);
        DeleteObject(SelectObject( PDC, OLDp ));
        DeleteObject(Sender.fDblExcludeRgn);
        DeleteDC( PDC );
        EndPaint(Sender.fHandle, PS);
    end;
  end;
end;
{$ENDIF}

{$IFDEF ASM_noVERSION}
function WndProcPaint( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
const szPaintStruct = sizeof(TPaintStruct);
asm
        CMP      word ptr [EDX].TMsg.message, WM_PRINT
        JE       @@print
        CMP      word ptr [EDX].TMsg.message, WM_PAINT
        JNE      @@ret_false
@@print:
        CMP      word ptr [EAX].TControl.fOnPaint.TMethod.Code+2, 0
        JE       @@ret_false
        PUSH     EBX
        PUSH     ESI

        XCHG     EBX, EAX
        MOV      ESI, EDX
        XOR      EAX, EAX
        PUSH     ECX
        PUSH     EAX
        PUSH     EAX
        PUSH     EAX
        PUSH     EAX
        CALL     CreateRectRgn
        MOV      [EBX].TControl.fUpdRgn, EAX

        MOVSX    EDX, [EBX].TControl.fEraseUpdRgn
        PUSH     EDX
        PUSH     EAX
        PUSH     [EBX].TControl.fHandle
        CALL     GetUpdateRgn

        CMP      EAX, 1
        JA       @@collectUpdRgn

        XOR      EAX, EAX
        XCHG     EAX, [EBX].TControl.fUpdRgn
        PUSH     EAX
        CALL     DeleteObject

@@collectUpdRgn:
        MOV      ECX, [EBX].TControl.fCollectUpdRgn
        JECXZ    @@asg_fPaintDC
        XCHG     EAX, ECX
        MOV      ECX, [EBX].TControl.fUpdRgn
        JECXZ    @@asg_fPaintDC

        PUSH     RGN_OR
        PUSH     ECX
        PUSH     EAX
        PUSH     EAX
        CALL     CombineRgn

        DEC      EAX
        JNZ      @@invalidateRgn

        ADD      ESP, -16
        PUSH     ESP
        PUSH     [EBX].TControl.fHandle
        CALL     Windows.GetClientRect

        PUSH     [EBX].TControl.fCollectUpdRgn
        CALL     DeleteObject
        CALL     CreateRectRgn
        MOV      [EBX].TControl.fCollectUpdRgn, EAX

@@invalidateRgn:
        MOVSX    EDX, [EBX].TControl.fEraseUpdRgn
        PUSH     EDX
        PUSH     [EBX].TControl.fCollectUpdRgn
        PUSH     [EBX].TControl.fHandle
        CALL     InvalidateRgn

@@asg_fPaintDC:
        MOV      ECX, [ESI].TMsg.wParam
        INC      ECX
        LOOP     @@storePaintDC

        ADD      ESP, -szPaintStruct
        PUSH     ESP
        PUSH     [EBX].TControl.fHandle
        CALL     BeginPaint
        XCHG     ECX, EAX
@@storePaintDC:
        MOV      [EBX].TControl.fPaintDC, ECX
        XCHG     EAX, ECX

        MOV      ECX, [EBX].TControl.fCollectUpdRgn
        JECXZ    @@doOnPaint

        PUSH     ECX
        PUSH     EAX
        CALL     SelectClipRgn

@@doOnPaint:
        MOV      ECX, [EBX].TControl.fPaintDC
        MOV      EDX, EBX

        MOV      EAX, [EBX].TControl.fOnPaint.TMethod.Data
        CALL     dword ptr [EBX].TControl.fOnPaint.TMethod.Code

        MOV      ECX, [EBX].TControl.fCanvas
        JECXZ    @@e_paint

        XCHG     EAX, ECX
        XOR      EDX, EDX
        CALL     TCanvas.SetHandle

@@e_paint:
        MOV      ECX, [ESI].TMsg.wParam
        INC      ECX
        LOOP     @@zero_fPaintDC

        PUSH     ESP
        PUSH     [EBX].TControl.fHandle
        CALL     EndPaint
        ADD      ESP, szPaintStruct

@@zero_fPaintDC:
        XOR      ECX, ECX
        MOV      [EBX].TControl.fPaintDC, ECX

        POP      EAX
        MOV      [EAX], ECX

        XCHG     ECX, [EBX].TControl.fUpdRgn
        JECXZ    @@exit_True

        PUSH     ECX
        CALL     DeleteObject

@@exit_True:
        POP      ESI
        POP      EBX
        MOV      AL, 1
        RET

@@ret_false:
        XOR      EAX, EAX
end;
{$ELSE PAS_VERSION} //Pascal
function WndProcPaint( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var PaintStruct: TPaintStruct;
    Cplxity: Integer;
    OldPaintDC: HDC;
begin
  with Self_^ do
  case Msg.message of
  //WM_PRINT,
  WM_PAINT: if assigned( EV.fOnPaint ) then
            begin
               fUpdRgn := CreateRectRgn( 0, 0, 0, 0 );
               Cplxity := Integer( GetUpdateRgn( fHandle, fUpdRgn,
                       {$IFDEF USE_FLAGS} G5_EraseBkgnd in fFlagsG5
                       {$ELSE} fEraseUpdRgn {$ENDIF} ) );
               if (Cplxity = NULLREGION) or (Cplxity = ERROR) then
               begin
                 DeleteObject( fUpdRgn );
                 fUpdRgn := 0;
               end;

               OldPaintDC := fPaintDC;
               fPaintDC := Msg.wParam;
               if fPaintDC = 0 then
                 fPaintDC := BeginPaint( fHandle, PaintStruct );

               EV.fOnPaint( Self_, fPaintDC );

               if assigned( Self_.fCanvas ) then
                 Self_.fCanvas.SetHandle( 0 );

               if Msg.wParam = 0 then
                 EndPaint( fHandle, PaintStruct );
               fPaintDC := OldPaintDC;

               Rslt := 0;

               Result := True;
               if fUpdRgn <> 0 then
                 DeleteObject( fUpdRgn );
               fUpdRgn := 0;
               Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
            end;
  end;
  Result := FALSE;
end;
{$ENDIF PAS_VERSION}

{$ENDIF WIN_GDI}
{$IFDEF GDI}
procedure TControl.SetOnPaint( const Value: TOnPaint );
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnPaint := Value;
  AttachProc( WndProcPaint );
end;
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION expose_widget( Widget: PGtkWidget; Event: PGdkEventExpose;
  Sender: PControl ): Boolean; cdecl;
BEGIN
  IF not Assigned( Sender.fOnPaint ) THEN Result := FALSE
  ELSE
  BEGIN
    Sender.Canvas.SaveState;
    Sender.fOnPaint( Sender, Sender.Canvas.Handle );
    Sender.Canvas.RestoreState;
    Result := TRUE;
  END;
END;

PROCEDURE TControl.SetOnPaint( const Value: TOnPaint );
BEGIN
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnPaint := Value;
  {$IFNDEF SMALLER_CODE} // it is actually not necessary to disconnect, event
                          // still will be fired but fOnPaint is not assigned
                          // so FALSE will be returned to GTK.
  IF  NOT Assigned( Value ) THEN
      gtk_signal_disconnect( fHandle, fExposeEvent )
  ELSE
  {$ENDIF}
      fExposeEvent := gtk_signal_connect( GTK_OBJECT( fHandle ), 'expose_event',
                   @ expose_widget, @ Self );
END;
{$ENDIF GTK}
{$ENDIF _X_}
{$IFDEF WIN_GDI}

function WndProcEraseBkgnd( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var PaintStruct: TPaintStruct;
    OldPaintDC: HDC;
begin
  Result := FALSE;
  if Msg.message = WM_ERASEBKGND then
  begin
    if Assigned( Sender.OnEraseBkgnd ) then
    begin
      OldPaintDC := Sender.fPaintDC;
      Sender.fPaintDC := Msg.wParam;
      if Sender.fPaintDC = 0 then
        Sender.fPaintDC := BeginPaint( Sender.fHandle, PaintStruct );
      Sender.OnEraseBkgnd( Sender, Msg.wParam );
      if Msg.wParam = 0 then
        EndPaint( Sender.fHandle, PaintStruct );
      if Assigned( Sender.fCanvas ) then
        Sender.fCanvas.SetHandle( 0 );
      Sender.fPaintDC := OldPaintDC;
      Rslt := 0;
      Result := TRUE;
    end
      else
      Rslt := 0;
  end;
end;

procedure TControl.SetOnEraseBkgnd(const Value: TOnPaint);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnEraseBkgnd := Value;
  AttachProc( WndProcEraseBkgnd );
end;

procedure DummyPaintClear( Self_: PControl; Sender: PControl; DC: HDC );
begin
  Sender.Canvas.FillRect( Sender.ClientRect );
end;

{$IFDEF NEW_GRADIENT}
function WndProcGradient( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var PaintStruct: TPaintStruct;
   Bmp: PBitmap;
   CR: TRect;
   I: Integer;
   R, G, B: Integer;
   R1, G1, B1: Integer;
   C: TColor;
   W, H, WH: Integer;
   OldPaintDC: HDC;
   Pattern: PBitmap;
   pdc: HDC;
   pw: integer;

begin
 case Msg.message of
 WM_PAINT, WM_PRINTCLIENT:
           begin
              result := false;
              CR := Self_.ClientRect;
              case Self_.DF.fGradientStyle of
                gsHorizontal: begin
                                W := CR.Right;
                                H := 1;
                                WH := W;
                                pw := 32;
                              end;
                gsVertical: begin
                              W := 1;
                              H := CR.Bottom;
                              WH := H;
                              pw := 32
                            end;
                gsTopToBottom,
                gsBottomToTop: begin
                                 W := CR.Bottom + CR.Right;
                                 H := 1;
                                 WH := W;
                                 pw := 1 + (CR.Bottom div 16);
                                 if pw > 6 then
                                   pw := 6;
                               end;
                else exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                // <-- impartant if user change GradientStyle to not supported by this object
              end;
              OldPaintDC := Self_.fPaintDC;
              Self_.fPaintDC := Msg.wParam;
              if Self_.fPaintDC = 0 then
                 Self_.fPaintDC := BeginPaint( Self_.fHandle, PaintStruct );
              Bmp := NewDIBBitmap( W, H, pf24bit );
              C := Color2RGB( Self_.DF.fColor1 );
              R := C shr 16;
              G := (C shr 8) and $FF;
              B := C and $FF;
              C := Color2RGB( Self_.DF.fColor2 );
              R1 := C shr 16;
              G1 := (C shr 8) and $FF;
              B1 := C and $FF;
              for I := 0 to WH-1 do begin
                C := (( R + (R1 - R) * I div WH ) shl 16) or
                     (( G + (G1 - G) * I div WH ) shl 8) or
                     ( B + (B1 - B) * I div WH );
                if Self_.DF.fGradientStyle = gsVertical then
                  Bmp.DIBPixels[ 0, I ] := C
                else
                  Bmp.DIBPixels[ I, 0 ] := C;
              end;
              if Self_.DF.fGradientStyle = gsVertical then
                Pattern := NewBitMap(pw, H)
              else
                Pattern := NewBitMap(W, pw);
              pdc := Pattern.Canvas.Handle;
              SetStretchBltMode( pdc, HALFTONE);
              SetBrushOrgEx( pdc, 0, 0, nil );
              StretchBlt( pdc, 0, 0, Pattern.Width, Pattern.Height, Bmp.Canvas.Handle,
                          0, 0, W, H, SRCCOPY );

              case Self_.DF.fGradientStyle of
                gsHorizontal: for i := 0 to (CR.Bottom div pw) do
                                Pattern.Draw(Self_.fPaintDC, 0, i*pw);
                gsVertical: for i := 0 to (CR.Right div pw) do
                              Pattern.Draw(Self_.fPaintDC, i*pw, 0);
                gsTopToBottom: for i := 0 to ((CR.Bottom + pw -1) div pw)-1 do
                                 Pattern.Draw(Self_.fPaintDC, -i*pw, i*pw);
                gsBottomToTop: for i := 0 to ((CR.Bottom + pw -1) div pw)-1 do
                                 Pattern.Draw(Self_.fPaintDC, -CR.Bottom + i*pw, i*pw);
              end;
              Bmp.Free;
              Pattern.Free;

               if  TMethod( Self_.EV.fOnPaint2 ).Code = @ DummyPaintClear then
                   {$IFDEF MAKE_METHOD}
                   Self_.EV.fOnPaint2 := TOnPaint( MakeMethod( nil, @ DummyObjProc ) );
                   {$ELSE}
                   TMethod( Self_.EV.fOnPaint2 ).Code := @DummyObjProc;
                   {$ENDIF}
              if Assigned( Self_.EV.fOnPaint ) then
                Self_.EV.fOnPaint( Self_, Self_.fPaintDC );

              if Msg.wParam = 0 then
                EndPaint( Self_.fHandle, PaintStruct );
              Self_.fPaintDC := OldPaintDC;
              Rslt := 0;
              Result := True;
              Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
           end;
 end;
 Result := False;
end;
{$ELSE OLD_GRADIENT}
function WndProcGradient( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var PaintStruct: TPaintStruct;
    Bmp: PBitmap;
    CR: TRect;
    I, R, G, B, R1, G1, B1, W, H, WH: Integer;
    C: TColor;
    W9x: Boolean;
    Br: HBrush;
    OldPaintDC: HDC;
begin
  case Msg.message of
  WM_PAINT, WM_PRINTCLIENT:
            begin
               OldPaintDC := Self_.fPaintDC;
               Self_.fPaintDC := Msg.wParam;
               if Self_.fPaintDC = 0 then
                  Self_.fPaintDC := BeginPaint( Self_.fHandle, PaintStruct );
               CR := Self_.ClientRect;
               W9x := WinVer < wvNT;
               W := 1;
               H := CR.Bottom;
               WH := H;
               Bmp := nil;
               if Self_.DF.fGradientStyle = gsHorizontal then
               begin
                 W := CR.Right;
                 H := 1;
                 WH := W;
               end;
               if not W9x then
                 Bmp := NewDIBBitmap( W, H, pf32bit );
               C := Color2RGB( Self_.DF.fColor1 );
               R := C shr 16;
               G := (C shr 8) and $FF;
               B := C and $FF;
               C := Color2RGB( Self_.DF.fColor2 );
               R1 := C shr 16;
               G1 := (C shr 8) and $FF;
               B1 := C and $FF;
               for I := 0 to WH-1 do
               begin
                 C := ((( R + (R1 - R) * I div WH ) and $FF) shl 16) or
                      ((( G + (G1 - G) * I div WH ) and $FF) shl 8) or
                      ( B + (B1 - B) * I div WH ) and $FF;
                 if W9x then
                 begin
                   if Self_.DF.fGradientStyle <> gsHorizontal then
                     CR.Bottom := CR.Top + 1
                   else
                     CR.Right := CR.Left + 1;
                   Br := CreateSolidBrush( C );
                   Windows.FillRect( Self_.fPaintDC, CR, Br );
                   DeleteObject( Br );
                   if Self_.DF.fGradientStyle <> gsHorizontal then
                     Inc( CR.Top )
                   else
                     Inc( CR.Left );
                 end
                   else
                 begin
                   if Self_.DF.fGradientStyle <> gsHorizontal then
                     Bmp.DIBPixels[ 0, I ] := C
                   else
                     Bmp.DIBPixels[ I, 0 ] := C;
                 end;
               end;
               if not W9x then
               begin
                 SetStretchBltMode( Self_.fPaintDC, HALFTONE );
                 SetBrushOrgEx( Self_.fPaintDC, 0, 0, nil );
                 StretchBlt( Self_.fPaintDC, 0, 0, CR.Right, CR.Bottom, Bmp.Canvas.Handle,
                             0, 0, W, H, SRCCOPY );
                 Bmp.Free;
               end;

               if TMethod( Self_.EV.fOnPaint2 ).Code = @ DummyPaintClear then
                   {$IFDEF MAKE_METHOD}
                   Self_.EV.fOnPaint2 := TOnPaint( MakeMethod( nil, @ DummyObjProc ) );
                   {$ELSE}
                   TMethod( Self_.EV.fOnPaint2 ).Code := @DummyObjProc;
                   {$ENDIF}
               if Assigned( Self_.EV.fOnPaint ) then
                 Self_.EV.fOnPaint( Self_, Self_.fPaintDC );

               if Msg.wParam = 0 then
                 EndPaint( Self_.fHandle, PaintStruct );
               Self_.fPaintDC := OldPaintDC;
               Rslt := 0;
               Result := True;
               Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
            end;
  end;
  Result := False;
end;
{$ENDIF OLD_GRADIENT}

function WndProcGradientEx( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
  function Ceil( X: Double ): Integer;
  begin
    Result := Round( X ) {+ 1};
    //if X > 0 then dec( Result ) else inc( Result );
  end;
const
  SQRT2 = 1.4142135623730950488016887242097;
var
  RC, R0: TRect;
  C, C2: TColor;
  R1, G1, B1: Integer;
  R2, G2, B2: Integer;
  DX1, DX2, DY1, DY2, DR, DG, DB, K: Double;
  PaintStruct: TPaintStruct;
  I: Integer;
  Br: HBrush;
  Rgn: HRgn;
  Poly: array[ 0..3 ] of TPoint;
  OldPaintDC: HDC;
  fX1, fX2, fY1, fY2: Double;

  procedure OffsetF( DX, DY: Double );
  begin
    fX1 := fX1 + DX;
    fX2 := fX2 + DX;
    fY1 := fY1 + DY;
    fY2 := fY2 + DY;
  end;
begin
  Result := FALSE;
  if (Msg.message <> WM_PAINT) and (Msg.message <> WM_PRINTCLIENT) then
     Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Self_.DF.fGradientStyle in [ gsHorizontal, gsVertical ] then
  begin
    Result := WndProcGradient( Self_, Msg, Rslt );
    Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  C := Color2RGB( Self_.DF.fColor2 );
  R2 := C and $FF;
  G2 := (C shr 8) and $FF;
  B2 := (C shr 16) and $FF;
  C := Color2RGB( Self_.DF.fColor1 );
  R1 := C and $FF;
  G1 := (C shr 8) and $FF;
  B1 := (C shr 16) and $FF;
  DR := (R2 - R1) / 256;
  DG := (G2 - G1) / 256;
  DB := (B2 - B1) / 256;
  OldPaintDC := Self_.fPaintDC;
  Self_.fPaintDC := Msg.wParam;
  if Self_.fPaintDC = 0 then
    Self_.fPaintDC := BeginPaint( Self_.fHandle, PaintStruct );
  RC := Self_.ClientRect;
  fX1 := 0;
  fY1 := 0;
  case Self_.DF.fGradientStyle of
  gsRombic:
    begin
      fX2 := RC.Right / 128;
      fY2 := RC.Bottom / 128;
    end;
  gsElliptic:
    begin
      fX2 := RC.Right / 256 * SQRT2;
      fY2 := RC.Bottom / 256 * SQRT2;
    end;
  else
    begin
      fX2 := RC.Right / 256;
      fY2 := RC.Bottom / 256;
    end;
  end;
  case Self_.DF.fGradientStyle of
  gsRectangle, gsRombic, gsElliptic:
    begin
      case Self_.DF.fGradientLayout of
      glCenter, glTop, glBottom:
        OffsetF( (RC.Right - fX2) / 2, 0 );
      glTopRight, glBottomRight, glRight:
        OffsetF( RC.Right - fX2 / 2, 0 );
      glTopLeft, glBottomLeft, glLeft:
        OffsetF( -fX2 / 2, 0 );
      end;
      case Self_.DF.fGradientLayout of
      glCenter, glLeft, glRight:
        OffsetF( 0, (RC.Bottom - fY2) / 2 );
      glBottom, glBottomLeft, glBottomRight:
        OffsetF( 0, RC.Bottom - fY2 / 2 );
      glTop, glTopLeft, glTopRight:
        OffsetF( 0, -fY2 / 2 )
      end;
    end;
  end;
  DX1 := -fX1 / 255; //(-RF.Left) / 255;
  DY1 := -fY1 / 255; // (-RF.Top) / 255;
  DX2 := (RC.Right - fX2) / 255; //(RC.Right - RF.Right) / 255;
  DY2 := (RC.Bottom - fY2) / 255;
  case Self_.DF.fGradientStyle of
  gsRombic, gsElliptic:
    begin
      if DX2 < -DX1 then DX2 := -DX1;
      if DY2 < -DY1 then DY2 := -DY1;
      K := 2;
      if Self_.DF.fGradientStyle = gsElliptic then K := SQRT2;
      DX2 := DX2 * K;
      DY2 := DY2 * K;
      DX1 := -DX2;
      DY1 := -DY2;
    end;
  end;
  C2 := C;
  for I := 0 to 255 do
  begin
    if (I < 255) then
    begin
      C2 := TColor( (( Ceil( B1 + DB * (I+1) ) and $FF) shl 16) or
          (( Ceil( G1 + DG * (I+1) ) and $FF) shl 8) or
           Ceil( R1 + DR * (I+1) ) and $FF );
      if (Self_.DF.fGradientStyle in [gsRombic,gsElliptic,gsRectangle]) and
         (C2 = C) then continue;
    end;
    Br := CreateSolidBrush( C );
    R0 := MakeRect( Ceil( fX1 + DX1 * I ),
                    Ceil( fY1 + DY1 * I ),
                    Ceil( fX2 + DX2 * I ) + 1,
                    Ceil( fY2 + DY2 * I ) + 1 );
    Rgn := 0;
    case Self_.DF.fGradientStyle of
    gsRectangle:
      Rgn := CreateRectRgnIndirect( R0 );
    gsRombic:
      begin
        Poly[ 0 ].x := R0.Left;
        Poly[ 0 ].y := R0.Top + (R0.Bottom - R0.Top) div 2;
        Poly[ 1 ].x := R0.Left + (R0.Right - R0.Left) div 2;
        Poly[ 1 ].y := R0.Top;
        Poly[ 2 ].x := R0.Right;
        Poly[ 2 ].y := Poly[ 0 ].y;
        Poly[ 3 ].x := Poly[ 1 ].x;
        Poly[ 3 ].y := R0.Bottom;
        Rgn := CreatePolygonRgn( Poly[ 0 ].x, 4, ALTERNATE );
      end;
    gsElliptic:
      Rgn := CreateEllipticRgnIndirect( R0 );
    end;
    if Rgn <> 0 then
    begin
      if Rgn <> NULLREGION then
      begin
        Windows.FillRgn( Self_.fPaintDC, Rgn, Br );
        ExtSelectClipRgn( Self_.fPaintDC, Rgn, RGN_DIFF );
      end;
      DeleteObject( Rgn );
    end;
    DeleteObject( Br );
    C := C2;
  end;
  if  TMethod( Self_.EV.fOnPaint2 ).Code = @ DummyPaintClear then
      {$IFDEF MAKE_METHOD}
      Self_.EV.fOnPaint2 := TOnPaint( MakeMethod( nil, @ DummyObjProc ) );
      {$ELSE}
      TMethod( Self_.EV.fOnPaint2 ).Code := @DummyObjProc;
      {$ENDIF}
  {$IFDEF NIL_EVENTS}
  if  Assigned( Self_.EV.fOnPaint ) then
  {$ENDIF}
      Self_.EV.fOnPaint( Self_, Self_.fPaintDC );
  if  Self_.fPaintDC <> HDC( Msg.wParam ) then
      EndPaint( Self_.fHandle, PaintStruct );
  Self_.fPaintDC := OldPaintDC;
  Rslt := 0;
  Result := True;
end;

function WndProcLabelEffect( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var
    Sz: TSize;
    P0: TPoint;
    CR: TRect;
    B : Boolean;
    CShadow: TColor;
    Target: PCanvas;
    Txt: KOLString;
	//LCaption: PKOLChar;
    OldPaintDC: HDC;

    procedure doTextOut( shfx, shfy: Integer; col: TColor );
    begin
        SetTextColor( Target.fHandle, col );
        {$IFDEF UNICODE_CTRLS}
        Windows.ExtTextOutW( Target.fHandle, P0.x + shfx, P0.y + shfy,
                            ETO_CLIPPED, @CR,
                            PWideChar(Txt), Length(Txt), nil ); // KOL_ANSI
        {$ELSE}
        Windows.ExtTextOutA( Target.fHandle, P0.x + shfx, P0.y + shfy,
                            ETO_CLIPPED, @CR,
                            PAnsiChar(Txt), Length(Txt), nil ); // KOL_ANSI
        {$ENDIF}
        //GDIFlush; // for test only
    end;

var I, J, Istp : Integer;
    PS: TPaintStruct;
    //DoEndPaint: Boolean;
begin
  Result := False;
  case Msg.message of
  WM_SETTEXT:
    begin
      Self_.fCaption := PKOLChar( Msg.lParam );
      Result := True;
      Rslt := 1;
      Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  WM_PRINTCLIENT, WM_PAINT:
  begin
    OldPaintDC := Self_.fPaintDC;
    Self_.fPaintDC := Msg.wParam;
    if Self_.fPaintDC = 0 then
      Self_.fPaintDC := BeginPaint( Self_.fHandle, PS );
    begin
       Target := Self_.Canvas;
       Txt := Self_.fCaption;
       Target.{$IFDEF UNICODE_CTRLS}WTextArea{$ELSE}TextArea{$ENDIF}( Txt, Sz, P0 );
       if Self_.DF.fShadowDeep <> 0 then
       begin
         for B := False to Self_.fCtl3D_child and 1 <> 0 do
         begin
           Inc( Sz.cx, Abs( Self_.DF.fShadowDeep ) );
           Inc( Sz.cy, Abs( Self_.DF.fShadowDeep ) );
         end;
       end;
       CR := Self_.ClientRect;
       case Self_.fTextAlign of
       taCenter: P0.x := P0.x + (CR.Right - Sz.cx) div 2;
       taRight:  P0.x := P0.x + (CR.Right - Sz.cx);
       end;
       case Self_.fVerticalAlign of
       vaCenter: P0.y := P0.y + (CR.Bottom - Sz.cy) div 2;
       vaBottom: P0.y := P0.y + (CR.Bottom - Sz.cy);
       end;
       if Self_.DF.fShadowDeep <> 0 then
       begin
         if Self_.DF.fColor2 = clNone then
           CShadow := ColorsMix(Color2RGB(Self_.fTextColor),Color2RGB(Self_.DF.fColor2))
         else
           CShadow := Color2RGB( Self_.DF.fColor2 );
         if  {$IFDEF USE_FLAGS} not(G2_Transparent in Self_.fFlagsG2)
             {$ELSE} not Self_.fTransparent {$ENDIF} then
             Target.FillRect( CR ); // GDIFlush; for test only
         Target.RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
         SetBkMode( Target.fHandle, Windows.TRANSPARENT );
         if  Self_.fCtl3D_child and 1 <> 0 then
         begin
             I := - Self_.DF.fShadowDeep;
             Istp := 1;
             if Self_.DF.fShadowDeep > 0 then Istp := -1;
             repeat
                 J := - Self_.DF.fShadowDeep;
                 repeat
                     if  not ( (I=0) and (J=0) ) then
                     begin
                         if  (I * Istp < 0) and (J * Istp < 0) then
                             doTextOut( I, J, CShadow );
                     end;
                     J := J - Istp;
                 until J = Self_.DF.fShadowDeep - IStp;
                 I := I - Istp;
             until I = Self_.DF.fShadowDeep - IStp;
         end
            else
         doTextout( Self_.DF.fShadowDeep, Self_.DF.fShadowdeep, CShadow );
         doTextout( 0, 0, Color2RGB(Self_.fTextColor) );
       end
          else
       begin
         Target.RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );
         SetBkMode( Target.fHandle, Windows.TRANSPARENT );
         doTextout( 0, 0, Color2RGB(Self_.fTextColor) );
       end;
    end;
    if  Self_.fCanvas <> nil then
        Self_.fCanvas.SetHandle( 0 );
    if  Msg.wParam = 0 then
        EndPaint( Self_.fHandle, PS );
    Self_.fPaintDC := OldPaintDC;
    Rslt := 0;
    Result := True; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.DoClick;
begin
  PP.fControlClick( @Self );
  {$IFDEF NIL_EVENTS}
  if  Assigned( EV.fOnClick ) then
  {$ENDIF}
      EV.fOnClick( @Self );
end;
{$ENDIF PAS_VERSION}

{$ENDIF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.ParentForm: PControl;
begin
  Result := @Self;
  if  {$IFDEF USE_FLAGS} G3_IsControl in Result.fFlagsG3
      {$ELSE} Result.fIsControl {$ENDIF} then
  repeat
      Result := Result.fParent;
  until (Result = nil) or
        {$IFDEF USE_FLAGS} not(G3_IsControl in Result.fFlagsG3)
        {$ELSE} not Result.fIsControl {$ENDIF};
end;
{$ENDIF PAS_VERSION}
{$IFDEF WIN_GDI}

function TControl.FormParentForm: PControl;
begin
  Result := @Self;
  while ( {$IFDEF USE_FLAGS} G3_IsControl in Result.fFlagsG3
          {$ELSE} Result.fIsControl {$ENDIF} )
        and not( {$IFDEF USE_FLAGS}
                 [G5_IsButton, G5_IsBitBtn] * Result.fFlagsG5 = [G5_IsBitBtn]
                 {$ELSE}
                 Result.fIsBitBtn and not Result.fIsButton
                 {$ENDIF} ) do
      Result := Result.fParent;
end;

function TControl.MarkPanelAsForm: PControl;
begin
    Result := @ Self;
    {$IFDEF USE_FLAGS}
    Include( fFlagsG5, G5_IsBitBtn );
    {$ELSE}
    fIsBitBtn := TRUE;
    {$ENDIF}
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetProgressColor(const Value: TColor);
begin
  if Perform( PBM_SETBARCOLOR, 0, Color2RGB(Value) ) <> 0 then
    fTextColor := Value;
end;
{$ENDIF PAS_VERSION}

procedure TControl.SetShadowDeep(const Value: Integer);
begin
  DF.fShadowDeep := Value;
  Invalidate;
end;
{$ENDIF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetFont: PGraphicTool;
begin
  if FFont = nil then
  begin
     FFont := NewFont;
     {$IFDEF USE_AUTOFREE4CONTROLS}
     Add2AutoFree( FFont );
     {$ENDIF}
     FFont.fData.Color := fTextColor;
     FFont.OnChange := FontChanged;
  end;
  Result := FFont;
end;
{$ENDIF PAS_VERSION}

{$IFDEF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetBrush: PGraphicTool;
begin
  if FBrush = nil then
  begin
    FBrush := NewBrush;
    FBrush.fData.Color := fColor;
    FBrush.OnChange := BrushChanged;
    {$IFDEF USE_AUTOFREE4CONTROLS}
    Add2AutoFree( FBrush );
    {$ENDIF}
  end;
  Result := FBrush;
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN_GDI}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.FontChanged(Sender: PGraphicTool);
begin
  fTextColor := Sender.fData.Color;
  ApplyFont2Wnd_Proc(@Self);
  Invalidate;
end;
{$ENDIF PAS_VERSION}

{$IFDEF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.BrushChanged(Sender: PGraphicTool);
begin
  fColor := Sender.fData.Color;
  if  fTmpBrush <> 0 then
  begin
      DeleteObject( fTmpBrush );
      fTmpBrush := 0;
  end;
  if fPaintDC = 0 then
  // only if not in painting already :
    Invalidate;
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN_GDI}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure DoApplyFont2Wnd( _Self: PControl );
begin
  if _Self.fFont <> nil then
  begin
    if _Self.fHandle <> 0 then
    begin
      _Self.fTextColor := _Self.fFont.fData.Color;
      _Self.Perform( WM_SETFONT, _Self.FFont.Handle, 1 );
    end;

    if _Self.fCanvas <> nil then
    begin
      _Self.fCanvas.Free;
      _Self.fCanvas := nil;
    end;

    _Self.DoAutoSize;
  end;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE DoApplyFont2Wnd( _Self: PControl );
VAR oldfontdesc: PPangoFontDescription;
    rcstyle: PGtkRcStyle;
    gcolor: TGdkColor;
    i: Integer;
BEGIN
  IF ( _Self.fFont <> nil ) THEN
  BEGIN
      gcolor := Color2GdkColor( _Self.fFont.Color );

      rcstyle := gtk_widget_get_modifier_style( _Self.fHandle );
      oldfontdesc := rcstyle.font_desc;
      rcstyle.font_desc :=
        pango_font_description_copy( _Self.fFont.GetPangoFontDesc );
      gtk_widget_modify_style( _Self.fHandle, rcstyle );

      IF oldfontdesc <> nil THEN
        pango_font_description_free( oldfontdesc );

      FOR i := 0 TO 4 DO
        gtk_widget_modify_fg( _Self.fCaptionHandle, {GTK_STATE_NORMAL} i, @ gcolor );
  END;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.ResizeParent: PControl;
begin
            ResizeParentBottom;
            ResizeParentRight;
            // Once again, to fix Windows (or my???) bug with
            // incorrect calculating of GetClientRect after
            // SetWindowLong( GWL_[EX}STYLE,... )
  Result := ResizeParentBottom;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.ResizeParentBottom: PControl;
var NewCH: Integer;
begin
  Result := @Self;
  if fParent <> nil then
  begin
    NewCH := BoundsRect.Bottom + fParent.fMargin;
    if  {$IFDEF USE_FLAGS} G2_ChangedH in fParent.fFlagsG2
        {$ELSE} (fParent.fChangedPosSz and $20) <> 0 {$ENDIF} then
        if NewCH <> fParent.ClientHeight then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>}
    fParent.ClientHeight := NewCH;
    {$IFDEF USE_FLAGS} include( fParent.fFlagsG2, G2_ChangedH );
    {$ELSE} fParent.fChangedPosSz := fParent.fChangedPosSz or $20; {$ENDIF}
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.ResizeParentRight: PControl;
var NewCW: Integer;
begin
  Result := @Self;
  if fParent <> nil then
  begin
    NewCW := fBoundsRect.Right + fParent.fMargin;
    if  {$IFDEF USE_FLAGS} G2_ChangedW in fParent.fFlagsG2
        {$ELSE} (fParent.fChangedPosSz and $10) <> 0 {$ENDIF} then
        if NewCW < fParent.ClientWidth then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    fParent.ClientWidth := NewCW;
    {$IFDEF USE_FLAGS} include( fParent.fFlagsG2, G2_ChangedW );
    {$ELSE} fParent.fChangedPosSz := fParent.fChangedPosSz or $10; {$ENDIF}
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetClientHeight: Integer;
begin
  with ClientRect do
    Result := Bottom - Top;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetClientWidth: Integer;
begin
  with ClientRect do
    Result := Right - Left;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetClientHeight(const Value: Integer);
var Delta: Integer;
begin
  Delta := ClientHeight;
  Delta := Height - Delta;
  Height := Value + Delta;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetClientWidth(const Value: Integer);
var Delta: Integer;
begin
  Delta := ClientWidth;
  Delta := Width - Delta;
  Width := Value + Delta;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.CenterOnParent: PControl;
var PCR: TRect;
begin
  Result := @Self;
  if  (fParent = nil) or
      {$IFDEF USE_FLAGS} not(G3_IsControl in fFlagsG3)
      {$ELSE} not fIsControl {$ENDIF} then
      PCR := MakeRect( 0, 0, GetSystemMetrics( SM_CXSCREEN ), GetSystemMetrics( SM_CYSCREEN ) )
  else
      PCR := fParent.ClientRect;
  GetWindowHandle;
  Left := (PCR.Right - PCR.Left - Width) div 2;
  Top := (PCR.Bottom - PCR.Top - Height) div 2;
end;
{$ENDIF PAS_VERSION}

function TControl.CenterOnForm( Form1: PControl ): PControl;
var PCR, DR: TRect;
begin
  Result := @Self;
  if  (Form1 = nil) then
      PCR := MakeRect( 0, 0, GetSystemMetrics( SM_CXSCREEN ), GetSystemMetrics( SM_CYSCREEN ) )
  else
      PCR := Form1.BoundsRect;
  GetWindowHandle;
  Left := PCR.Left + (PCR.Right - PCR.Left - Width) div 2;
  Top := PCR.Top + (PCR.Bottom - PCR.Top - Height) div 2;
  PCR := BoundsRect;
  DR := GetDesktopRect;
  if  PCR.Right > DR.Right then
      OffsetRect( PCR, DR.Right - PCR.Right, 0 );
  if  PCR.Bottom > DR.Bottom then
      OffsetRect( PCR, 0, DR.Bottom - PCR.Bottom );
  if  PCR.Left < DR.Left then
      OffsetRect( PCR, DR.Left - PCR.Left, 0 );
  if  PCR.Top < DR.Top then
      OffsetRect( PCR, 0, DR.Top - PCR.Top );
  BoundsRect := PCR;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetHasBorder: Boolean;
begin
  UpdateWndStyles;
  Result := LongBool( fStyle.Value and (WS_BORDER or WS_THICKFRAME or WS_DLGFRAME))
         or LongBool( fExStyle and WS_EX_CLIENTEDGE );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_noVERSION} // YS
procedure TControl.SetHasBorder(const Value: Boolean);
const style_mask = WS_BORDER or WS_THICKFRAME or WS_DLGFRAME or WS_CAPTION
                             or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SYSMENU;
      exstyle_mask = not (WS_EX_CONTROLPARENT or WS_EX_DLGMODALFRAME
                                or WS_EX_WINDOWEDGE or WS_EX_CLIENTEDGE);
asm

        PUSH     EAX
          PUSH     EDX

            CALL     GetHasBorder
          POP      ECX
          CMP      AL, CL

        POP      EAX
        JZ       @@exit

        MOV      EDX, [EAX].fStyle
        DEC      CL
        MOVZX    ECX, [EAX].fIsControl
        JNZ      @@1

        OR       EDX, WS_THICKFRAME
        INC      ECX
        LOOP     @@set_style
        OR       EDX, style_mask
        JMP      @@set_style

@@1:    AND      EDX, not style_mask
        INC      ECX
        LOOP     @@2
        OR       EDX, WS_POPUP

@@2:    PUSH     EDX

        MOV      EDX, [EAX].fExStyle
        AND      EDX, exstyle_mask

        PUSH     EAX
        CALL     SetExStyle
        POP      EAX

        POP      EDX
@@set_style:
        TEST     [EAX].fTabStop, 1
        JZ       @@no_tabstop
        OR       DX, WS_TABSTOP
        JMP      @@set_style_1
@@no_tabstop:
        AND      DX, not WS_TABSTOP
@@set_style_1:
        CALL     SetStyle
@@exit:
end;
{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetHasBorder(const Value: Boolean);
var NewStyle: DWORD;
begin
  if Value = GetHasBorder then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Value then
  begin
    if  {$IFDEF USE_FLAGS} not(G3_IsControl in fFlagsG3)
        {$ELSE} not fIsControl {$ENDIF} then
        Style := fStyle.Value or WS_THICKFRAME or WS_BORDER or
               WS_DLGFRAME or WS_CAPTION or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or
               WS_SYSMENU
    else
    if  fCtl3D_child and 1 <> 0 then
        ExStyle := fExStyle or WS_EX_CLIENTEDGE
    else
        Style := fStyle.Value or WS_BORDER;
  end
    else
  begin
    NewStyle := fStyle.Value and not (WS_BORDER or WS_THICKFRAME or WS_DLGFRAME or WS_CAPTION
                             or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SYSMENU);
    if  {$IFDEF USE_FLAGS} not(G3_IsControl in fFlagsG3)
        {$ELSE} not fIsControl {$ENDIF} then
        NewStyle := NewStyle or WS_POPUP;
    Style := NewStyle;
    ExStyle := fExStyle and not (WS_EX_CONTROLPARENT or WS_EX_DLGMODALFRAME
                                or WS_EX_WINDOWEDGE or WS_EX_CLIENTEDGE);
  end;
  {$IFDEF USE_FLAGS}
  {$ELSE} //+MTsv DN
  if  fIsControl then
  if   fTabStop then
       Style := fStyle.Value or WS_TABSTOP
  else Style := fStyle.Value {xor} and not WS_TABSTOP;
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetHasCaption: Boolean;
begin
  UpdateWndStyles;
  Result := not LongBool( fStyle.Value and (WS_POPUP or WS_DLGFRAME))
            or  LongBool( fStyle.Value and WS_CAPTION);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetHasCaption(const Value: Boolean);
begin
  if Value = GetHasCaption then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Value then
  begin
     Style := fStyle.Value and not (WS_POPUP or WS_DLGFRAME) or WS_CAPTION;
  end
    else
  begin
    if  {$IFDEF USE_FLAGS} G3_IsControl in fFlagsG3
        {$ELSE} fIsControl {$ENDIF} then
        Style := fStyle.Value and not WS_CAPTION or WS_DLGFRAME
    else
        Style := fStyle.Value and not (WS_CAPTION or WS_SYSMENU) or WS_POPUP;
    ExStyle := fExStyle or WS_EX_DLGMODALFRAME;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetCanResize: Boolean;
begin
    {$IFDEF USE_FLAGS}
    Result := not(G1_PreventResize in fFlagsG1);
    {$ELSE}
    Result := not fPreventResize;
    {$ENDIF}
end;
{$ENDIF PAS_VERSION}

function WndProcCanResize( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean;
var W, H: Integer;
    P: PMinMaxInfo;
begin
  if not Sender.CanResize then
  if M.message = WM_GETMINMAXINFO then
  begin
    Rslt := Sender.CallDefWndProc( M );
    {$IFDEF FIX_WIDTH_HEIGHT}
    W := Sender.FFixWidth;
    H := Sender.FFixHeight;
    {$ELSE}
    W := Sender.fBoundsRect.Right - Sender.fBoundsRect.Left;
    H := Sender.fBoundsRect.Bottom - Sender.fBoundsRect.Top;
    {$ENDIF}
    P := Pointer( M.lParam );
    P.ptMinTrackSize.x := W;
    P.ptMinTrackSize.y := H;
    P.ptMaxTrackSize := P.ptMinTrackSize;
    Result := True; // stop further processing (prevent resizing)
    Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end
    else
  if M.message = WM_NCHITTEST then
  begin
    Rslt := Sender.CallDefWndProc( M );
    if (Rslt >= 10) and (Rslt <= 17) then
    begin
      {$IFDEF CANRESIZE_THICKFRAME}
      Rslt := HTBORDER;
      {$ELSE}
      Rslt := HTNOWHERE;
      {$ENDIF}
      Result := True;
      exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end else
  if M.message = WM_INITMENU then
  begin
    if not Sender.CanResize then
      EnableMenuItem( GetSystemMenu( Sender.fHandle, FALSE ),
                  SC_SIZE, MF_GRAYED );
  end;
  Result := False; // continue message processing
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetCanResize( const Value: Boolean );
begin
  if Value = CanResize then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$IFDEF USE_FLAGS}
  if Value then exclude( fFlagsG1, G1_PreventResize )
           else include( fFlagsG1, G1_PreventResize );
  {$ELSE}
  fPreventResize := not Value;
  {$ENDIF}
  {$IFDEF CANRESIZE_THICKFRAME}
  if  Value then
      Style := Style or WS_THICKFRAME
  else
      Style := Style and not WS_THICKFRAME;
  {$ENDIF}
  {$IFDEF FIX_WIDTH_HEIGHT}
  GetWindowHandle;
  FFixWidth := Width;
  FFixHeight := Height;
  {$ENDIF FIX_WIDTH_HEIGHT}
  AttachProc( WndProcCanResize );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetStayOnTop: Boolean;
begin
  UpdateWndStyles;
  Result := LongBool( fExStyle and WS_EX_TOPMOST);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetStayOnTop(const Value: Boolean);
begin
  if Value = GetStayOnTop then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if fHandle <> 0 then
  if Value then
     SetWindowPos( fHandle, HWND_TOPMOST, 0,0,0,0,
                   SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE )
  else
     SetWindowPos( fHandle, HWND_NOTOPMOST, 0,0,0,0,
                   SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE )
           else
  if Value then fExStyle := fExStyle or WS_EX_TOPMOST
           else fExStyle := fExStyle and not WS_EX_TOPMOST;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.UpdateWndStyles: PControl;
begin
  Result := @Self;
  if fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fStyle.Value := GetWindowLong( fHandle, GWL_STYLE );
  fExStyle := GetWindowLong( fHandle, GWL_EXSTYLE );
  fClsStyle := GetClassLong( fHandle, GCL_STYLE );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetChecked: Boolean;
begin
  if bboFixed in DF.fBitBtnOptions then
    Result := {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4
              {$ELSE} fChecked {$ENDIF}
  else
    Result := LongBool( Perform( BM_GETCHECK, 0, 0 ) ) ; //= BST_CHECKED;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.Set_Checked(const Value: Boolean);
begin
  if  bboFixed in DF.fBitBtnOptions then
  begin
      {$IFDEF USE_FLAGS} include( fFlagsG4, G4_Checked );
      {$ELSE} fChecked := Value; {$ENDIF}
      Invalidate;
  end
  else
      Perform( BM_SETCHECK, Integer( Value ), 0 );
end;
{$ENDIF PAS_VERSION}

function TControl.SetChecked(const Value: Boolean): PControl;
begin
  Perform( BM_SETCHECK, Integer( Value ), 0 );
  Result := @Self;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
function TControl.SetRadioChecked: PControl;
{$IFDEF USE_FLAGS}
var WasStyle: DWORD;
{$ELSE}
var WasTabStop: Boolean;
{$ENDIF}
begin
  {$IFDEF USE_FLAGS}
  WasStyle := fStyle.Value;
  exclude( fStyle.f2_Style, F2_Tabstop );
  DoClick;
  fStyle.Value := WasStyle;
  {$ELSE}
  WasTabStop := fTabStop;
  fTabStop := FALSE;
  DoClick;
  fTabStop := WasTabStop;
  {$ENDIF}
  Result := @Self;
end;
{$ENDIF PAS_VERSION}

function TControl.GetCheck3: TTriStateCheck;
begin
  Result := TTriStateCheck(Perform(BM_GETCHECK, 0, 0) and 3);
end;

procedure TControl.SetCheck3(value: TTriStateCheck);
var
  wp: WPARAM;
begin
  wp := Perform(BM_GETCHECK, 0, 0) and not 3;
  wp := wp or byte(value);
  Perform(BM_SETCHECK, wp, 0);
end;

procedure TControl.Click;
begin
  if (fCommandActions.aClick <> 0) or
     (fCommandActions.aEnter = BN_SETFOCUS) then
    Perform( WM_COMMAND, (fCommandActions.aClick shl 16) or fMenu,
             GetWindowHandle )
  else
  begin
    Perform( WM_LBUTTONDOWN, MK_LBUTTON, 0 );
    Perform( WM_LBUTTONUP, MK_LBUTTON, 0 );
  end;
end;

type
  TCharRange = record
    cpMin: Longint;
    cpMax: LongInt;
  end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetSelStart: Integer;
begin
  Result := 0;
  if fCommandActions.aGetSelRange <> 0 then
    Perform( fCommandActions.aGetSelRange, Integer( @ Result ), 0 );
end;
{$ENDIF PAS_VERSION}

procedure TControl.SetSelStart(const Value: Integer);
begin
  ItemSelected[ Value ] := True;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetSelLength: Integer;
var Start, Finish: Integer;
begin
  Result := 0;
  if fCommandActions.aGetSelCount <> 0 then
  begin
    if fCommandActions.aGetSelCount = EM_GETSEL then
    begin
      Perform( fCommandActions.aGetSelCount, Integer( @ Start ), Integer( @ Finish ) );
      Result := Finish - Start;
    end
      else
    begin
      Result := Perform( fCommandActions.aGetSelCount {and $7FFF}, 0, 0 );
    end;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetSelLength(const Value: Integer);
var SR: TCharRange;
begin
  SR.cpMin := GetSelStart;
  SR.cpMax := SR.cpMin + Value;
  if Value < 0 then
    SR.cpMax := -1;
  if fCommandActions.aSetSelRange <> 0 then
     Perform( fCommandActions.aSetSelRange, SR.cpMin, SR.cpMax )
  else
  if fCommandActions.aExSetSelRange <> 0 then
     Perform( fCommandActions.aExSetSelRange, 0, Integer( @SR ) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TControl.GetItems(Idx: Integer): KOLString;
var L, Pos: Integer;
    Buf: PKOLChar;
begin
  Result := '';
  Pos := Item2Pos( Idx );
  Idx := Pos2Item( Pos );
  if fCommandActions.aGetItemLength <> 0 then
    L := Perform( fCommandActions.aGetItemLength, Pos, 0 )
  else Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if L = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  GetMem( Buf, (L + 4) * SizeOf( KOLChar ) );
  PDWORD( Buf )^ := L + 1;
  if fCommandActions.aGetItemText <> 0 then
    Perform( fCommandActions.aGetItemText, Idx, Integer( Buf ) );
  Buf[ L ] := #0;
  Result := Buf;
  FreeMem( Buf );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetItems(Idx: Integer; const Value: KOLString);
var Strt, L : DWORD;
    {$IFNDEF NOT_FIX_CURINDEX}
    TmpCurIdx: Integer; // AK - Andrzey Kubasek
    TmpData: DWORD;
    {$ENDIF NOT_FIX_CURINDEX}
begin
  if fCommandActions.aSetItemText <> 0 then
  begin
    Strt := Item2Pos( Idx );
    L := Item2Pos( Idx + 1 ) - Strt;
    SelStart := Strt;
    SelLength := L;
    Perform( fCommandActions.aSetItemText, 0, Integer( PKOLChar( Value ) ) );
  end
     else
  if fCommandActions.aDeleteItem <> 0 then
  begin
    {$IFNDEF NOT_FIX_CURINDEX}
    TmpCurIdx := CurIndex; // +AK
    TmpData := ItemData[ Idx ];
    {$ENDIF}
    Delete( Idx );
    Insert( Idx, Value );
    {$IFNDEF NOT_FIX_CURINDEX}
    CurIndex := TmpCurIdx; //+AK
    ItemData[ Idx ] := TmpData;
    {$ENDIF}
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetItemsCount: Integer;
begin
  Result := 0;
  {$IFDEF DEBUG_ANY}
  try
  if fCommandActions.aGetCount = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := Perform( fCommandActions.aGetCount, 0, 0 );
  except
    asm
      int 3
    end;
  end;
  {$ELSE}
  if fCommandActions.aGetCount = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := Perform( fCommandActions.aGetCount, 0, 0 );
  {$ENDIF DEBUG_ANY}
end;
{$ENDIF PAS_VERSION}

procedure TControl.SetItemsCount(const Value: Integer);
begin
  if fCommandActions.aSetCount = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Perform( fCommandActions.aSetCount, Value, 0 );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.Item2Pos(ItemIdx: Integer): DWORD;
begin
  Result := ItemIdx;
  if  Byte( fCommandActions.bItem2Pos ) <> 0 then
      Result := Perform( fCommandActions.bItem2Pos, ItemIdx, 0 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.Pos2Item(Pos: Integer): DWORD;
begin
  Result := Pos;
  if  Byte( fCommandActions.bPos2Item ) <> 0 then
      Result := Perform( fCommandActions.bPos2Item, Pos, 0 );
end;
{$ENDIF PAS_VERSION}

function TControl.SavePosition: TEditPositions;
var {$IFNDEF NOT_USE_RICHEDIT}
    p: TPoint;
    {$ENDIF USE_RICHEDIT}
    i: Integer;
begin
  Result.SelStart := SelStart;
  Result.SelLength := SelLength;
  {$IFNDEF NOT_USE_RICHEDIT}
  if {$IFDEF USE_FLAGS} (G1_CanNotDoublebuf in fFlagsG1)
     {$ELSE} fCannotDoubleBuf {$ENDIF}
     { TRUE for rich edit, FALSE for edit } then
  begin
    P.X := 0;
    P.Y := 0;
    i := Perform( EM_CHARFROMPOS, 0, Integer( @ P ) );
    Result.TopLine := Pos2Item( i );
    Result.TopColumn := i - Integer( Item2Pos( Result.TopLine ) );
    Perform( EM_GETSCROLLPOS, 0, Integer( @ Result.ScrollPos ) );
  end
    else
  {$ENDIF USE_RICHEDIT}
  begin
    i := 0;
    i := Perform( EM_CHARFROMPOS, 0, i );
    Result.TopLine := HiWord( i );
    Result.TopColumn := LoWord( i ) - Item2Pos( Result.TopLine );
    Result.ScrollPos.Y := GetScrollPos( Handle, SB_VERT );
    Result.ScrollPos.X := GetScrollPos( Handle, SB_HORZ );
  end;
  Result.RestoreScroll := TRUE;
end;

procedure TControl.RestorePosition( const P: TEditPositions );
var Cur: TEditPositions;
begin
  SelStart := P.SelStart;
  SelLength := P.SelLength;
  if P.RestoreScroll then
  begin
    Perform( EM_SCROLLCARET, 0, 0 );
    Cur := SavePosition;
    {$IFNDEF NOT_USE_RICHEDIT}
    if  {$IFDEF USE_FLAGS} (G1_CanNotDoublebuf in fFlagsG1)
        {$ELSE} fCannotDoubleBuf {$ENDIF} then
    begin   // RichEdit
        if  P.TopLine <> Cur.TopLine then
            Perform( EM_LINESCROLL, 0, P.TopLine - Cur.TopLine );
        Perform( EM_SETSCROLLPOS, 0, Integer( @ P.ScrollPos ) );
    end else // Edit
    {$ENDIF USE_RICHEDIT}
    begin
      if (P.TopLine <> Cur.TopLine) or
         (P.TopColumn <> Cur.TopColumn) then
         Perform( EM_LINESCROLL, P.TopColumn - Cur.TopColumn,
                                 P.TopLine - Cur.TopLine );
      SetScrollPos( Handle, SB_VERT, P.ScrollPos.Y, TRUE );
      SetScrollPos( Handle, SB_HORZ, P.ScrollPos.X, TRUE );
    end;
  end;
end;

procedure TControl.UpdatePosition( var p: TEditPositions; FromPos,
          CountInsertDelChars, CountInsertDelLines: Integer );
var d: Integer;
begin
  if (FromPos <= p.SelStart) and (CountInsertDelChars >= 0) or
     (CountInsertDelChars < 0) and
       ((FromPos + Abs( CountInsertDelChars ) <= p.SelStart)
     ) then
  begin
    p.SelStart := p.SelStart + CountInsertDelChars;
  end else
  if FromPos >= p.SelStart + p.SelLength then
  begin
    // nothing to do
  end else
  if CountInsertDelChars < 0 then // deleting
  begin
    if FromPos - CountInsertDelChars > p.SelStart + p.SelLength then
      CountInsertDelChars := -( p.SelStart + p.SelLength - FromPos );
    if FromPos - CountInsertDelChars >= p.SelStart then
    begin
      d := FromPos - CountInsertDelChars - p.SelStart;
      p.SelLength := p.SelLength - d;
      //inc( CountInsertDelChars, d );
    end;
    inc( p.SelStart, CountInsertDelChars );
  end else // inserting
  begin
    if (FromPos > p.SelStart) and (FromPos < p.SelStart + p.SelLength) then
      inc( p.SelLength, CountInsertDelChars )
    else
    if FromPos <= p.SelStart then
      inc( p.SelStart, CountInsertDelChars );
  end;
  p.TopLine := p.TopLine + CountInsertDelLines;
end;

function WndProcTabChar( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean;
begin
  if M.message = WM_CHAR then
  begin
    if M.wParam = 9 then
      Sender.ReplaceSelection( #9, TRUE );
  end;
  Result := FALSE;
end;

function TControl.EditTabChar: PControl;
begin
  AttachProc( WndProcTabChar );
  Result := @Self;
end;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TControl.Add(const S: KOLString): Integer;
begin
  if fCommandActions.aAddItem <> 0 then
  begin
    Result := Perform( fCommandActions.aAddItem, 0, Integer( PKOLChar( S ) ) );
    if Count = 1 then
      ItemSelected[ 0 ] := True;
  end
    else
  begin
    if  Assigned( fCommandActions.aAddText ) then
        fCommandActions.aAddText( @Self, S )
    else
        Text := Text + S;
    Result := 0;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.Delete(Idx: Integer);
begin
  if fCommandActions.aDeleteItem <> 0 then
    Perform( fCommandActions.aDeleteItem, Idx, 0 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TControl.Insert(Idx: Integer; const S: KOLString): Integer;
begin
  if fCommandActions.aInsertItem <> 0 then
    Result := Perform( fCommandActions.aInsertItem, Idx, Integer( PKOLChar( S ) ) )
  else
    Result := -1;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetItemSelected(ItemIdx: Integer): Boolean;
var SS: Integer;
begin
  if fCommandActions.aGetSelected <> 0 then
  begin
    SS := Perform( fCommandActions.aGetSelected, ItemIdx, LVIS_SELECTED );
    { Though it is written in docs that for combobox lParam for CB_GETCURSEL
      is not used and _must_ be 0, therefore this code is working for
      combobox too. }
    if fCommandActions.aGetSelected <> CB_GETCURSEL then
      ItemIdx := 1;
    Result := SS = ItemIdx;
  end
  else
  begin
    SS := SelStart;
    Result := (ItemIdx >= SS) and (ItemIdx < SS + SelLength);
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetItemSelected(ItemIdx: Integer; const Value: Boolean);
var SR: TCharRange;
begin
  if fCommandActions.aSetSelected <> 0 then
    Perform( fCommandActions.aSetSelected, Integer( Value ), ItemIdx )
  else
  if fCommandActions.aSetCurrent <> 0 then
    Perform( fCommandActions.aSetCurrent, ItemIdx, 0 )
  else
  if fCommandActions.aSetSelRange <> 0 then
    Perform( fCommandActions.aSetSelRange, ItemIdx, ItemIdx )
  else
  if fCommandActions.aExSetSelRange <> 0 then
  begin
    SR.cpMin := ItemIdx;
    SR.cpMax := ItemIdx;
    Perform( fCommandActions.aExSetSelRange, 0, Integer( @SR ) );
  end
    else
  begin // for ImageShow: set the index and invalidate the control
    FCurIndex := ItemIdx;
    Invalidate;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetCtl3D(const Value: Boolean);
begin
  fCtl3D_child := fCtl3D_child and not 1 or Integer( Value ) and 1;
  UpdateWndStyles;
  if  Value then
  begin
      Style := fStyle.Value and not WS_BORDER;
      ExStyle := fExStyle or WS_EX_CLIENTEDGE;
  end else
  begin
      Style := fStyle.Value or WS_BORDER;
      ExStyle := fExStyle and not WS_EX_CLIENTEDGE;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.Shift(dX, dY: Integer): PControl;
begin
  Left := fBoundsRect.Left + dX;
  Top := fBoundsRect.Top + dY;
  Result := @Self;
end;
{$ENDIF PAS_VERSION}

procedure SetKeyEvent( Self_: PControl );
begin
  Self_.PP.fWndProcKeybd := WndProcKeybd;
end;

procedure TControl.SetOnChar(const Value: TOnChar);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnChar := Value;
  SetKeyEvent( @Self );
end;

{$IFDEF SUPPORT_ONDEADCHAR}
procedure TControl.SetOnDeadChar(const Value: TOnChar);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnDeadChar := Value;
  SetKeyEvent( @Self );
end;
{$ENDIF SUPPORT_ONDEADCHAR}

procedure TControl.SetOnKeyDown(const Value: TOnKey);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnKeyDown := Value;
  SetKeyEvent( @Self );
end;

procedure TControl.SetOnKeyUp(const Value: TOnKey);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnKeyUp := Value;
  SetKeyEvent( @Self );
end;

{$IFDEF ASM_TLIST}
function CollectTabControls( Form: PControl ): PList;
asm
        PUSH     EDI
        PUSH     EAX
        CALL     NewList
        XCHG     EDI, EAX
        POP      EAX
        CALL     @@collecttab
        XCHG     EAX, EDI
        POP      EDI
        RET
@@collecttab:
        { <- EDI = Result:PList
             EAX = Form (or Control)
        }
        PUSH     EBP
        XOR      EBP, EBP // Result := FALSE;
        PUSH     ESI
        PUSH     EBX
        MOV      EDX, [EAX].TControl.fChildren
        MOV      ECX, [EDX].TList.fCount
        MOV      ESI, [EDX].TList.fItems
        JECXZ    @@e_loop
@@loo:  PUSH     ECX
        LODSD

          PUSH     EAX

        TEST     byte ptr [EAX].TControl.fStyle+2, WS_TABSTOP shr 16
        JZ       @@call_recur

        {$IFDEF USE_FLAGS}
        MOV      EDX, dword ptr [EAX].TControl.fStyle.f2_Style
        OR       DL, DH
        AND      DL, (1 shl F3_Disabled) or (1 shl F2_Tabstop)
        CMP      DL, (1 shl F2_Tabstop)
        JNZ      @@call_recur
        {$ELSE}
        MOV      DL, [EAX].TControl.fTabStop
        AND      DL, [EAX].TControl.fEnabled
        JZ       @@call_recur
        {$ENDIF}

        CALL     TControl.GetToBeVisible
        TEST     AL, AL
        POP      EAX
        JZ       @@next
        PUSH     EAX

          XCHG     EDX, EAX
          PUSH     ESI
          MOV      ECX, [EDI].TList.fCount
          MOV      ESI, [EDI].TList.fItems
          XOR      EBX, EBX
          JECXZ    @@e_loo2
@@loo2:   LODSD
          MOV      AX, [EAX].TControl.fTabOrder
          CMP      AX, [EDX].TControl.fTabOrder
          JLE      @@next2
          POP      ESI
          MOV      ECX, EDX
          MOV      EDX, EBX
          MOV      EAX, EDI
          CALL     TList.Insert
          JMP      @@call_recur

@@next2:  INC      EBX
          LOOP     @@loo2
@@e_loo2:
          POP      ESI
          MOV      EAX, EDI
          CALL     TList.Add

@@call_recur:
          //OR       EBP, 1 // Result := TRUE;
          INC      EBP
          POP      EAX
          {$IFDEF USE_FLAGS}
          TEST    [EAX].TControl.fStyle.f3_Style, (1 shl F3_Disabled)
          JNZ     @@next
          {$ELSE}
          MOVZX    ECX, [EAX].TControl.fEnabled
          JECXZ    @@next
          {$ENDIF USE_FLAGS}
          PUSH     EAX
          CALL     @@collecttab
          POP      EDX
          JZ       @@next

          MOV      EAX, EDI
          CALL     TList.Remove

@@next: POP      ECX
        LOOP     @@loo

@@e_loop:
        POP      EBX
        POP      ESI
        TEST     EBP, EBP
        POP      EBP
end;
{$ELSE PAS_VERSION} //Pascal
function CollectTabControls( Form: PControl ): PList;
var R: PList;
  function CollectTab( P: PControl ): Boolean;
  var I, J: Integer;
      C, D: PControl;
  begin
    Result := FALSE;
    for I := 0 to P.fChildren.fCount - 1 do
    begin
      C := P.fChildren.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ];
      if  {$IFDEF USE_FLAGS} (TRUE)
          {$ELSE}            C.fTabstop {$ENDIF}
      and {$IFDEF USE_FLAGS} not(F3_Disabled in C.fStyle.f3_Style)
          {$ELSE}            C.fEnabled {$ENDIF}
      and C.ToBeVisible and
         (F2_Tabstop in C.fStyle.f2_Style) then
      begin
        D := nil;
        for J := 0 to R.fCount - 1 do
        begin
          D := R.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ J ];
          if D.fTabOrder > C.fTabOrder then
          begin
            Result := TRUE;
            R.Insert( J, C );
            break;
          end
             else
            D := nil;
        end;
        if D = nil then
        begin
           R.Add( C );
           Result := TRUE;
        end;
      end;
      if  {$IFDEF USE_FLAGS} not (F3_Disabled in C.fStyle.f3_Style)
          {$ELSE}            C.fEnabled {$ENDIF} then
      begin
          if  CollectTab( C ) then
              R.Remove( C );
      end;
    end;
  end;
  {$IFDEF DEBUG_COLLECTTABCONTROLS}
  var SL: PStrList;
      i: Integer;
      C: PControl;
  {$ENDIF}
begin
  R := NewList;
  CollectTab( Form );
  {$IFDEF DEBUG_COLLECTTABCONTROLS}
  SL := NewStrList;
  for i := 0 to R.Count-1 do
  begin
    C := R.Items[ i ];
    SL.Add( Int2Str( C.fTabOrder ) + ' ' + Int2Str( C.fTag ) + ' ' + C.fCaption );
  end;
  SL.SaveToFile( GetStartDir + 'debug_collecttabcontrols.txt' );
  SL.Free;
  {$ENDIF}

  Result := R;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
procedure Tabulate2Next( Form: PControl; Dir: Integer );
asm
        PUSHAD
        PUSH     EAX      // save Form
        MOV      EBX, EAX
        MOV      EBP, EDX // EBP = Dir (direction <0 or >0)
        CALL     CollectTabControls
        XCHG     EDI, EAX // EDI = CL (list of controls)

        MOV      ECX, [EBX].TControl.DF.fCurrentControl // C := Form.fCurrentControl
        XOR      EBX, EBX // I = 0
        JECXZ    @@1
        MOV      BX, [ECX].TControl.fTabOrder // I = C.fTabOrder
@@1:
        MOV      ECX, [EDI].TList.fCount
        MOV      ESI, [EDI].TList.fItems
        XOR      EDX, EDX
        PUSH     EDX      // Ctrl1 = nil
        PUSH     EDX      // Ctrl2 = nil
        TEST     ECX, ECX
        JZ       @@e_loop

@@loop: PUSH     ECX
        LODSD
        CMP      [EAX].TControl.fTabOrder, BX
        JZ       @@next

        MOV      ECX, [ESP+8] // ECX = Ctrl1
        JECXZ    @@c1nil
        MOV      CX, [ECX].TControl.fTabOrder // ECX = Ctrl1.fTabOrder
        TEST     EBP, EBP
        JGE      @@c1ge

        CMP      [EAX].TControl.fTabOrder, BX
        JGE      @@2
        CMP      [EAX].TControl.fTabOrder, CX
        JLE      @@2

@@c1new:
        MOV      [ESP+8], EAX // Ctrl1 := C
        JMP      @@2

@@c1ge: CMP      [EAX].TControl.fTabOrder, BX
        JLE      @@2
        CMP      [EAX].TControl.fTabOrder, CX
        JL       @@c1new
        JMP      @@2

@@c1nil:
        TEST     EBP, EBP
        JL       @@c1nil_dirL
        CMP      [EAX].TControl.fTabOrder, BX
        JG       @@c1new
        JMP      @@2

@@c1nil_dirL:
        CMP      [EAX].TControl.fTabOrder, BX
        JL       @@c1new

@@2:
        MOV      ECX, [ESP+4] // ECX = Ctrl2
        JECXZ    @@c2new
        MOV      CX, [ECX].TControl.fTabOrder

        TEST     EBP, EBP
        JL       @@c2dirL
        CMP      [EAX].TControl.fTabOrder, CX
        JGE      @@next
        JMP      @@c2new

@@c2dirL:
        CMP      [EAX].TControl.fTabOrder, CX
        JLE      @@next
@@c2new:
        MOV      [ESP+4], EAX

@@next: POP      ECX
        DEC      ECX
        JNZ      @@loop
        //LOOP     @@loop
@@e_loop:

        POP      EDX // Ctrl2
        POP      ECX // Ctrl1
        INC      ECX
        LOOP     @@3
        MOV      ECX, EDX
@@3:
        POP      EBX // EBX = Form
        JECXZ    @@exit

        XCHG     EAX, ECX
        {$IFDEF USE_GRAPHCTLS}
        {$IFDEF USE_FLAGS}
        TEST    [EAX].TControl.fFlagsG6, 1 shl G6_GraphicCtl
        JNZ      @@4
        {$ELSE}
        CMP      [EAX].TControl.fWindowed, 0
        JZ       @@4
        {$ENDIF}
        {$ENDIF}
        MOV      ECX, [EAX].TControl.fHandle
        JECXZ    @@no_handle
@@4:
        INC      [EAX].TControl.fClickDisabled

        PUSH     EAX
        MOV      DL, 1
        CALL     TControl.SetFocused
        POP      EAX

        DEC      [EAX].TControl.fClickDisabled

@@no_handle:
        MOV      [EBX].TControl.DF.fCurrentControl, EAX

@@exit:
        XCHG     EAX, EDI
        CALL     TObj.RefDec
        POPAD
end;
{$ELSE PAS_VERSION} //Pascal
procedure Tabulate2Next( Form: PControl; Dir: Integer );
var CL : PList;
    I, J : Integer;
    Ctrl1, Ctrl2, C : PControl;
begin
  CL := CollectTabControls( Form );

  I := 0;
  C := Form.DF.fCurrentControl;
  if  C <> nil then
      I := C.fTabOrder;
  Ctrl2 := nil;
  Ctrl1 := nil;
  for J := 0 to CL.fCount - 1 do
  begin
      C := CL.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ J ];
      if C.fTabOrder = I then continue;
      if (Ctrl1 = nil)
         and (    (Dir >= 0) and (C.fTabOrder > I)
               or (Dir < 0) and (C.fTabOrder < I)  )
      or (Dir >= 0)
         and (C.fTabOrder > I) and (C.fTabOrder < Ctrl1.fTabOrder)
      or (Dir < 0)
         and (C.fTabOrder < I) and (C.fTabOrder > Ctrl1.fTabOrder)
      then Ctrl1 := C;
      if (Ctrl2 = nil)
      or (Dir >= 0) and (C.fTabOrder < Ctrl2.fTabOrder)
      or (Dir < 0) and (C.fTabOrder > Ctrl2.fTabOrder)
      then Ctrl2 := C;
  end;
  if  Ctrl1 = nil then
      Ctrl1 := Ctrl2;
  if  Ctrl1 <> nil then
  begin
      if (Ctrl1.fHandle <> 0) {$IFDEF USE_GRAPHCTLS} or
         {$IFDEF USE_FLAGS} (G6_GraphicCtl in Ctrl1.fFlagsG6)
         {$ELSE} not Ctrl1.fWindowed {$ENDIF} {$ENDIF} then
      begin
          Inc( Ctrl1.fClickDisabled );
          Ctrl1.Focused := TRUE;
          Dec( Ctrl1.fClickDisabled );
      end;
      Form.DF.fCurrentControl := Ctrl1;
  end;
  CL.Free;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function Tabulate2Control( Self_: PControl; Key: DWORD; checkOnly: Boolean ): Boolean;
var Form: PControl;
begin
  Result := False;
  case Key of
  VK_TAB: if not (tkTab in Self_.fLookTabKeys) then exit; {>>>>>>>>>>>>>>>>>>>>}
  VK_LEFT, VK_RIGHT: if not (tkLeftRight in Self_.fLookTabKeys) then exit; {>>>}
  VK_UP, VK_DOWN: if not (tkUpDown in Self_.fLookTabKeys) then exit; {>>>>>>>>>}
  VK_NEXT, VK_PRIOR: if not (tkPageUpPageDn in Self_.fLookTabKeys) then
           exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  else Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Result := True;
  if checkOnly then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Form := Self_.ParentForm;
  case Key of
  VK_TAB:
    if GetKeyState( VK_SHIFT ) < 0 then
      Tabulate2Next( Form, -1 )
    else
      Tabulate2Next( Form, 1 );
  VK_RIGHT, VK_DOWN, VK_NEXT: Tabulate2Next( Form, 1 );
  VK_LEFT, VK_UP, VK_PRIOR:   Tabulate2Next( Form, -1 );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
function Tabulate2ControlEx( Self_: PControl; Key: DWORD; checkOnly: Boolean ): Boolean;
asm
        PUSH     EDI
        MOVZX    EDI, CL
        TEST     byte ptr [EAX].TControl.fLookTabKeys, 1
        JZ       @@1
@@0:
        MOV      ECX, EDX
        AND      CL, 7Fh
        CMP      CL, VK_TAB
        JNE      @@1

        PUSH     EDX
        CALL     TControl.ParentForm
        POP      EDX
        MOVSX    EDX, DL
        TEST     EDX, EDX
        JS       @@tab

        PUSH     EAX

        PUSH     VK_SHIFT
        CALL     GetAsyncKeyState
        SAR      EAX, 31
        {$IFDEF PARANOIA} DB $0C, $01 {$ELSE} OR AL, 1 {$ENDIF}
        MOV      EDX, EAX

        POP      EAX
@@tab:
        TEST     EDI, EDI
        POP      EDI
        JNZ      @@no_tab
        CALL     Tabulate2Next
@@no_tab:
        MOV      AL, 1
        RET

@@data: DB VK_LEFT, VK_LEFT
        DD offset[@@left]
        DB VK_UP, 2
        DB VK_RIGHT, VK_RIGHT
        DD offset[@@right]
        DB VK_DOWN, 2
        DB VK_UP, VK_PRIOR
        DD offset[@@up]
        DB VK_TAB or 80h, $C
        DB VK_DOWN, VK_NEXT
        DD offset[@@down]
        DB VK_TAB, $C

@@1:
        // EAX <- Self_:PControl
        //  DL <- Key
        PUSH     ESI
        MOV      ESI, offset[@@data]-6
        MOV      DH, 9
        PUSH     EAX
@@loop:
        ADD      DH, DH
        JNB      @@l1
        JMP      @@abort
@@fault1:
        POP      EDI
        POPAD
        PUSH     EAX
@@abort:
        POP      EAX
@@abort1:
        POP      ESI
        POP      EDI
        XOR      EAX, EAX
        RET

@@right:
        MOV      EAX, [ESP].TRect.Left
        SUB      EAX, [ESP+16].TRect.Left
@@left_right:
        JL       @@next1
        MOV      EDX, [ESP].TRect.Bottom
        SUB      EDX, [ESP+16].TRect.Top
        JL       @@next1
        MOV      EDX, [ESP].TRect.Top
        SUB      EDX, [ESP+16].TRect.Bottom
        JGE      @@next1
@@chk_dist:
        CMP      EAX, EDI
        JA       @@next1
        MOV      EDI, EAX
        MOV      EAX, [EBX+ECX*4-4]
        MOV      [ESP+36], EAX     // Found = Ctrl
        JMP      @@next1

@@l1:
        LODSD
        LODSW
        LODSW
        CMP      AL, DL
        JE       @@2
        CMP      AH, DL
        JNE      @@loop

@@2:
        PUSH     ESI
        LODSD
        LODSW
        POP      ESI
        XCHG     EDX, EAX
        POP      EAX
        TEST     [EAX].TControl.fLookTabKeys, DH
        JZ       @@abort1

        PUSHAD
        PUSH     EDI
        CALL     TControl.ParentForm
        MOV      ECX, [EAX].TControl.DF.fCurrentControl
        JECXZ    @@fault1
        MOV      EBP, ECX           // EBP = CurCtrl

        PUSH     EAX                // save Form
        MOV      EBX, EAX
        CALL     CollectTabControls
        PUSH     0                  // save Found = nil
        PUSH     EAX                // save CollectedList
        MOV      EDI, EAX

        MOV      EBX, [EDI].TList.fItems
        ADD      ESP, -16
        PUSH     ESP
        PUSH     [EBP].TControl.fHandle
        CALL     GetWindowRect

        MOV      ECX, [EDI].TList.fCount
        OR       EDI, -1            // EDI = minDist
@@loop1:
        MOV      EAX, [EBX+ECX*4-4]
        CMP      EAX, EBP
        JE       @@next
        {}
        {$IFDEF USE_FLAGS}
        MOV      DX, word ptr [EAX].TControl.fStyle.f2_Style
        AND      DX, ($100 shl F3_Disabled) or (1 shl F2_Tabstop)
        XOR      DH, (1 shl F3_Disabled)
        {$ELSE}
        MOV      DL, [EAX].TControl.fEnabled
        AND      DL, [EAX].TControl.fTabstop
        {$ENDIF USE_FLAGS}
        JZ       @@next
        {}
        ADD      ESP, -16
        MOV      EDX, ESP
        PUSH     ECX
        PUSH     EDX
        PUSH     [EAX].TControl.fHandle
        CALL     GetWindowRect
        POP      ECX
        JMP      dword ptr [ESI]

@@left:
        MOV      EAX, [ESP+16].TRect.Left
        SUB      EAX, [ESP].TRect.Left
        JMP      @@left_right

@@not_found:
        POP      EDI
        POPAD
        MOV      DL, [ESI+4]
        POP      ESI
        JMP      @@0

@@up:
        MOV      EAX, [ESP+16].TRect.Top
        SUB      EAX, [ESP].TRect.Top
        JMP      @@up_down
@@down:
        MOV      EAX, [ESP].TRect.Top
        SUB      EAX, [ESP+16].TRect.Top
@@up_down:
        JL       @@next1
        MOV      EDX, [ESP].TRect.Right
        SUB      EDX, [ESP+16].TRect.Left
        JL       @@next1
        MOV      EDX, [ESP].TRect.Left
        SUB      EDX, [ESP+16].TRect.Right
        JL       @@chk_dist

@@next1:
        ADD      ESP, 16
@@next:
        LOOP     @@loop1
        ADD      ESP, 16
        POP      EAX       // pop CollectedList
        CALL     TObj.RefDec
        POP      ECX       // pop Found
        POP      EAX       // pop Form
        JECXZ    @@not_found

        POP      EDI
        TEST     EDI, EDI
        JNZ      @@no_go

        MOV      [EAX].TControl.DF.fCurrentControl, ECX
        INC      [ECX].TControl.fClickDisabled
        PUSH     ECX
        MOV      ECX, [ECX].TControl.fHandle
        JECXZ    @@4
        PUSH     ECX
        CALL     Windows.SetFocus
@@4:    POP      ECX
        DEC      [ECX].TControl.fClickDisabled
@@no_go:
        POPAD
        POP      ESI
        POP      EDI
        MOV      AL, 1      // Result = True
end;
{$ELSE PAS_VERSION} //Pascal
function Tabulate2ControlEx( Self_: PControl; Key: DWORD; checkOnly: Boolean ): Boolean;
label search_tabcontrol;
var Form: PControl;
    CL : PList;
    I : Integer;
    CurCtrl, Ctrl, Found : PControl;
    MinDist, Dist: Integer;
    R, R1 : TRect;
begin
  Result := False;
  case Key of
  VK_TAB: if not (tkTab in Self_.fLookTabKeys) then exit; {>>>>>>>>>>>>>>>>>>>>}
  VK_LEFT, VK_RIGHT: if not (tkLeftRight in Self_.fLookTabKeys) then exit; {>>>}
  VK_UP, VK_DOWN: if not (tkUpDown in Self_.fLookTabKeys) then exit; {>>>>>>>>>}
  VK_NEXT, VK_PRIOR: if not (tkPageUpPageDn in Self_.fLookTabKeys) then
       exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  else exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Result := True;
  if checkOnly then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Form := Self_.ParentForm;
  if Key = VK_TAB then
    if GetKeyState( VK_SHIFT ) < 0 then
      Tabulate2Next( Form, -1 )
    else
      Tabulate2Next( Form, 1 )
  else
  begin
    CL := CollectTabControls( Form );
    I := CL.IndexOf( Form.DF.fCurrentControl );
    Found := nil;
    if I >= 0 then
    begin
      CurCtrl := CL.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ];
      GetWindowRect( CurCtrl.Handle, R );
    search_tabcontrol:
      MinDist := MaxInt;
      for I := CL.fCount - 1 downto 0 do
      begin
        Ctrl := CL.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ];
        if Ctrl = CurCtrl then continue;
        if  not ({$IFDEF USE_FLAGS} not(F3_Disabled in Ctrl.fStyle.f3_Style)
                 {$ELSE}            Ctrl.fEnabled {$ENDIF}
                 and
                 {$IFDEF USE_FLAGS} (F2_Tabstop in Ctrl.fStyle.f2_Style)
                 {$ELSE}            Ctrl.fTabstop {$ENDIF}
                 ) then continue;
        GetWindowRect( Ctrl.Handle, R1 );
        Dist := MaxInt;
        case Key of
          VK_LEFT:
            begin
              if (R1.Bottom < R.Top)
              or (R1.Top >= R.Bottom)
              or (R1.Left > R.Left) then continue;
              Dist := R.Left - R1.Left;
            end;
          VK_RIGHT:
            begin
              if (R1.Bottom < R.Top)
              or (R1.Top >= R.Bottom)
              or (R1.Left < R.Left) then continue;
              Dist := R1.Left - R.Left;
            end;
          VK_UP, VK_PRIOR:
            begin
              if (R1.Right < R.Left)
              or (R1.Left >= R.Right)
              or (R1.Top > R.Top) then continue;
              Dist := R.Top - R1.Top;
            end;
          VK_DOWN, VK_NEXT:
            begin
              if (R1.Right < R.Left)
              or (R1.Left >= R.Right)
              or (R1.Top < R.Bottom) then continue;
              Dist := R1.Top - R.Top;
            end;
        end;
        if Dist < MinDist then
        begin
          Found := Ctrl;
          MinDist := Dist;
        end;
      end;
      if Found = nil then
      begin
        case Key of
          VK_LEFT:
            begin
              Key := VK_UP; goto search_tabcontrol;
            end;
          VK_RIGHT:
            begin
              Key := VK_DOWN; goto search_tabcontrol;
            end;
          VK_UP, VK_PRIOR:
            Tabulate2Next( Form, -1 );
          VK_DOWN, VK_NEXT:
            Tabulate2Next( Form, 1 );
        end;
      end
         else
      begin
        if Found.fHandle <> 0 then
        begin
          Inc( Found.fClickDisabled );
          SetFocus( Found.fHandle );
          Dec( Found.fClickDisabled );
        end;
        Form.DF.fCurrentControl := Found;
      end;
    end;
    CL.Free;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.Tabulate: PControl;
var F : PControl;
begin
  Result := @Self;
  F := ParentForm;
  if F = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  F.PP.fGotoControl := Tabulate2Control;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.TabulateEx: PControl;
var F : PControl;
begin
  Result := @Self;
  F := ParentForm;
  if F = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  F.PP.fGotoControl := Tabulate2ControlEx;
end;
{$ENDIF PAS_VERSION}

function WndProcMouseTransparent( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := FALSE;
  if Msg.message = WM_NCHITTEST then
  begin
    Rslt := HTTRANSPARENT;
    Result := TRUE;
  end;
end;

function TControl.MouseTransparent: PControl;
begin
  AttachProc( WndProcMouseTransparent );
  Result := @ Self;
end;

procedure TControl.GotoControl(Key: DWORD);
var Form: PControl;
begin
  Form := ParentForm;
  if Form <> nil then
  {$IFDEF NIL_EVENTS}
  if  Assigned( Form.PP.fGotoControl ) then
  {$ENDIF}
      Form.PP.fGotoControl( Form.DF.fCurrentControl, Key, false );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetCurIndex: Integer;
var I, J: Integer;
begin
  Result := fCurIndex;
  if fCommandActions.aGetCurrent = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  I := 0;
  if fCommandActions.aGetCurrent = EM_LINEINDEX then
     Dec( I );
  J := 0;
  if fCommandActions.aGetCurrent = LVM_GETNEXTITEM then
  begin
     J := 2 {LVNI_SELECTED};
     Dec( I );
  end;
  Result := Perform( fCommandActions.aGetCurrent, I, J );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetCurIndex(const Value: Integer);
var NMHdr: TNMHdr; idx: Integer;
begin
  if fCommandActions.aSetCurrent <> 0 then
  begin
     idx := Perform( fCommandActions.aSetCurrent, Value, 0 );          // fix AV
     if fCommandActions.aSetCurrent = TCM_SETCURSEL then
     begin
       fCurIndex := idx;                                               // fix AV
       NMHdr.code := TCN_SELCHANGE;
       NMHdr.hwndFrom := fHandle;
       Perform( WM_NOTIFY, 0, Integer( @NMHdr ) );
     end;
  end
  else
     ItemSelected[ Value ] := True;
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN_GDI}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetTextAlign: TTextAlign;
begin
  UpdateWndStyles;
  if (fStyle.Value and fCommandActions.aTextAlignRight) = fCommandActions.aTextAlignRight then
     Result := taRight
  else
  if (fStyle.Value and fCommandActions.aTextAlignCenter) = fCommandActions.aTextAlignCenter then
     Result := taCenter
  else
     Result := fTextAlign;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION TControl.GetTextAlign: TTextAlign;
BEGIN
  Result := fTextAlign;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetTextAlign(const Value: TTextAlign);
var NewStyle: DWORD;
begin
  fTextAlign := Value;
  NewStyle := 0;
  with fCommandActions{$IFDEF COMMANDACTIONS_OBJ}^{$ENDIF}  do
  case Value of
  taLeft: NewStyle := fStyle.Value and not DWORD(aTextAlignCenter or aTextAlignRight)
                          or aTextAlignLeft;
  taRight: NewStyle := fStyle.Value and not DWORD(aTextAlignLeft or aTextAlignCenter)
                          or aTextAlignRight;
  taCenter: NewStyle := fStyle.Value and not DWORD(aTextAlignLeft or aTextAlignRight)
                          or aTextAlignCenter;
  end;
  NewStyle := NewStyle and not DWORD(fCommandActions.bTextAlignMask);
  Style := NewStyle;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TControl.SetTextAlign(const Value: TTextAlign);
BEGIN
  IF  fTextAlign = Value THEN Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fTextAlign := Value;
  IF  Assigned( fSetTextAlign ) THEN
      fSetTextAlign( @ Self );
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetVerticalAlign: TVerticalAlign;
begin
  UpdateWndStyles;
  if  (fStyle.Value and (Byte( fCommandActions.bVertAlignCenter ) shl 8))
      = (Byte( fCommandActions.bVertAlignCenter ) shl 8) then
      Result := vaCenter
  else
  if  (fStyle.Value and (fCommandActions.bVertAlignBottom shl 8))
      = (fCommandActions.bVertAlignBottom shl 8) then
      Result := vaBottom
  else
      Result := fVerticalAlign;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION TControl.GetVerticalAlign: TVerticalAlign;
BEGIN
  Result := fVerticalAlign;
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetVerticalAlign(const Value: TVerticalAlign);
var NewStyle: DWORD;
begin
  fVerticalAlign := Value;
  with fCommandActions{$IFDEF COMMANDACTIONS_OBJ}^{$ENDIF} do
  begin
    NewStyle := fStyle.Value and
        not DWORD((bVertAlignTop or bVertAlignCenter or bVertAlignBottom) shl 8);
    case Value of
    vaCenter: NewStyle := NewStyle or (bVertAlignCenter shl 8);
    vaTop:    NewStyle := NewStyle or (bVertAlignTop shl 8);
    vaBottom: NewStyle := NewStyle or (bVertAlignBottom shl 8);
    end;
  end;
  Style := NewStyle;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE TControl.SetVerticalAlign(const Value: TVerticalAlign);
BEGIN
  if fVerticalAlign = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fVerticalAlign := Value;
  if Assigned( fSetTextAlign ) then
    fSetTextAlign( @ Self );
END;
{$ENDIF GTK}
{$ENDIF _X_}

{$IFDEF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.Dc2Canvas( Sender: PCanvas ): HDC;
begin
  if fPaintDC <> 0 then
  begin
     Result := fPaintDC;
     Sender.SetHandle( Result );
     Sender.fIsPaintDC := True;
  end
    else
  begin
    if Sender.fHandle <> 0 then
       Result := Sender.fHandle
    else
       Result := GetDC( GetWindowHandle );
  end;
end;
{$ENDIF PAS_VERSION}

{$ENDIF WIN_GDI}

{$IFDEF GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetCanvas: PCanvas;
begin
  {$IFDEF SAFE_CODE}
  CreateWindow;
  {$ENDIF}
  if ( fCanvas = nil ) then
  begin
    fCanvas := NewCanvas( 0 );
    fCanvas.fOnGetHandle := Dc2Canvas;
    fCanvas.fOwnerControl := @Self;
    if  ( fFont <> nil ) then
        fCanvas.fFont := fCanvas.fFont.Assign( fFont );
    if  ( fBrush <> nil ) then
        fCanvas.fBrush := fCanvas.fBrush.Assign( fBrush );
  end;
  Result := fCanvas;
end;
{$ENDIF PAS_VERSION}
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION TControl.ProvideCanvasHandle( Sender: PCanvas ): HDC;
TYPE PPGdkGC = ^PGdkGC;
VAR Array_gc: PPGdkGC;
BEGIN
  IF   fInBkPaint THEN Array_gc := @ fEventboxHandle.style.bg_gc[ 0 ]
  ELSE Array_gc := @ fEventboxHandle.style.fg_gc[ 0 ];
  CASE fEventboxHandle.state OF
  GTK_STATE_NORMAL,
  GTK_STATE_ACTIVE,
  GTK_STATE_PRELIGHT,
  GTK_STATE_SELECTED,
  GTK_STATE_INSENSITIVE: Result := PPGdkGC( Integer( Array_gc ) + fEventboxHandle.state * sizeof( Pointer ) )^;
  ELSE                   Result := Array_gc^;
  END;
END;

FUNCTION TControl.GetCanvas: PCanvas;
BEGIN
  {$IFDEF SAFE_CODE}
  CreateWindow;
  {$ENDIF}
  IF  ( fCanvas = nil ) then
  BEGIN
      fCanvas := NewCanvas( nil );
      fCanvas.fOnGetHandle := ProvideCanvasHandle;
      fCanvas.fOwnerControl := @Self;
      fCanvas.fDrawable := Pointer( fEventboxHandle.window );
  END;
  fCanvas.GetHandle; // ïîëó÷èì çäåñü òîò êîíòåêñò, êîòîðûé ñîîòâåòñòâóåò
                     // òåêóùåìó ñîñòîÿíèþ êîíòðîëà (åñëè ýòî êîíòðîë) è òåêóùåé
                     // ñòàäèè ðèñîâàíèÿ
  Result := fCanvas;
END;
{$ENDIF GTK}
{$ENDIF _X_}
{$IFDEF WIN_GDI}

function TControl.DblBufTopParent: PControl;
var Ctl: PControl;
begin
  Result := nil;
  Ctl := @ Self;
  while Ctl <> nil do
  begin
    if  {$IFDEF USE_FLAGS} ( [G2_DoubleBuffered, G2_Transparent] * Ctl.fFlagsG2 <> [] )
        {$ELSE} (Ctl.fDoubleBuffered) or (Ctl.fTransparent) {$ENDIF} then
        Result := Ctl;
    Ctl := Ctl.fParent;
  end;
end;

{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure TControl.SetDoubleBuffered(const Value: Boolean);
begin
    if  {$IFDEF USE_FLAGS} (G1_CanNotDoublebuf in fFlagsG1)
        {$ELSE} CannotDoubleBuf {$ENDIF} then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>}
    {$IFDEF USE_FLAGS}
            if   Value then
                 include( fFlagsG2, G2_DoubleBuffered )
            else exclude( fFlagsG2, G2_DoubleBuffered );
    {$ELSE} fDoubleBuffered := Value; {$ENDIF}
    AttachProc(WndProcTransparent);
    {$IFNDEF SMALLEST_CODE}
    Global_AttachProcExtension := @TransparentAttachProcExtension;
    {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetTransparent(const Value: Boolean);
begin
    if fParent = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    {$IFDEF USE_FLAGS}
            if   Value then
                 include( fFlagsG2, G2_Transparent )
            else exclude( fFlagsG2, G2_Transparent );
    {$ELSE} fTransparent := Value; {$ENDIF}

{$IFDEF GRAPHCTL_XPSTYLES}
    if  not AppTheming then
    begin
        {$IFDEF USE_FLAGS}
                if   Value then
                     include( fFlagsG3, G3_ClassicTransparent )
                else exclude( fFlagsG3, G3_ClassicTransparent );
        {$ELSE} fClassicTransparent := Value; {$ENDIF}
    end;
{$ENDIF}

    if Value then begin
        AttachProc(WndProcTransparent);
        fParent.DoubleBuffered := TRUE;
    end;
end;
{$ENDIF PAS_VERSION}

function TControl.SetBorder( Value: Integer ): PControl;
begin
  fMargin := Value;
  Result := @ Self;
end;

{ TTrayIcon }

var FTrayItems: PList;

{$IFDEF ASM_noVERSION} // ASM_TLIST!
function WndProcTray( Control: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean;
asm
        PUSH     ECX
        MOV      ECX, [EDX].TMsg.message
        CMP      CX, CM_TRAYICON
        JNE      @@1

          MOV      ECX, [EDX].TMsg.lParam
          MOV      EDX, [EDX].TMsg.wParam
          MOV      EAX, [EDX].TTrayIcon.fOnMouse.TMethod.Data
          CMP      word ptr [EDX].TTrayIcon.fOnMouse.TMethod.Code+2, 0
          JE       @@no_on

          CALL     [EDX].TTrayIcon.fOnMouse.TMethod.Code
@@no_on:
          POP      ECX
          XOR      EAX, EAX
          MOV      [ECX], EAX
          INC      EAX
          RET

@@1:
        SUB      ECX, WM_CLOSE
        JNE      @@exit_0
@@2:

          POP      ECX
          PUSH     EBX
          XCHG     EBX, EAX

          MOV      EAX, [EBX].TControl.fHandle
          CMP      EAX, [EDX].TMsg.hwnd
          JNE      @@otherwin

          MOV      EDX, [FTrayItems]
          MOV      ECX, [EDX].TList.fCount
          MOV      EDX, [EDX].TList.fItems
@@loop:
          MOV      EAX, [EDX + ECX*4 - 4]
          CMP      [EAX].TTray.FNoAutoDeactivate, 0
          JNZ      @@3
          CMP      [EAX].TTrayIcon.fControl, EBX
          JNE      @@3
          PUSHAD
          XOR      EDX, EDX
          CALL     TTrayIcon.SetActive
          POPAD
@@3:      LOOP     @@loop

@@otherwin:
          POP      EBX
          PUSH     ECX
@@exit_0:
        XOR      EAX, EAX
        POP      ECX
end;
{$ELSE PAS_VERSION} //Pascal
function WndProcTray( Control: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean;
var Self_: PTrayIcon;
    I : Integer;
begin
  Result := False;
  case Msg.message of
  CM_TRAYICON:
    begin
      Self_ := Pointer( Msg.wParam );
      if  Assigned( Self_.FOnMouse ) then
          Self_.FOnMouse( @Self_, Msg.lParam );
      Rslt := 0;
      Result := True;
    end;
  WM_CLOSE:
    if Msg.hwnd = Control.fHandle then
    begin
      if FTrayItems <> nil then // ?????????????????
      for I := FTrayItems.Count - 1 downto 0 do
      begin
        Self_ := FTrayItems.Items[ I ];
        if not Self_.FNoAutoDeactivate then
        if Self_.FControl = Control then
           Self_.Active := False;
      end;
    end;
  end;
end;
{$ENDIF PAS_VERSION}

function WndProcTrayIconWnd( Wnd: HWnd; Msg: DWORD; wParam, lParam: Integer ): Integer;
         stdcall;
var PrevProc: function ( Wnd: HWnd; Msg: DWORD;
                         wParam, lParam: Integer ): Integer; stdcall;
var Tr: PTrayIcon;
begin
  PrevProc := Pointer( GetProp( Wnd, 'TRAYSAVEPROC' ) );
  if Msg = CM_TRAYICON then
  begin
    Tr := Pointer( wParam );
    if  Assigned( Tr.FOnMouse ) then
        Tr.FOnMouse( Tr, lParam );
    Result := 0; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end
    else
  if Msg = WM_CLOSE then
  begin
    if  Assigned( PrevProc ) then
    begin
        SetWindowLong( Wnd, GWL_WNDPROC, Integer( @ PrevProc ) );
        RemoveProp( Wnd, 'TRAYSAVEPROC' );
        PostMessage( Wnd, WM_CLOSE, wParam, lParam );
        Result := 0; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end;
  if   (Wnd <> 0) and IsWindow( Wnd ) and Assigned( PrevProc ) then
       Result := PrevProc( Wnd, Msg, wParam, lParam )
  else Result := DefWindowProc( Wnd, Msg, wParam, lParam );
end;

procedure TTrayIcon.AttachProc2Wnd;
begin
  if FWnd = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if GetProp( FWnd, 'TRAYSAVEPROC' ) <> 0 then Exit; // already attached {>>>>>}
  SetProp( FWnd, 'TRAYSAVEPROC', GetWindowLong( FWnd, GWL_WNDPROC ) );
  SetWindowLong( FWnd, GWL_WNDPROC, Integer( @ WndProcTrayIconWnd ) );
end;
// [END TTrayIcon.AttachProc2Wnd]

// [PROCEDURE TTrayIcon.DetachProc2Wnd]
procedure TTrayIcon.DetachProc2Wnd;
var OldProc: function ( Wnd: HWnd; Msg: DWORD;
             wParam, lParam: Integer ): Integer; stdcall;
begin
    if FWnd = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    OldProc := Pointer( GetProp( FWnd, 'TRAYSAVEPROC' ) );
    if not Assigned( OldProc ) then Exit; // not attached {>>>>>>>>>>>>>>>>>>>>}
    SetWindowLong( FWnd, GWL_WNDPROC, Integer( @ OldProc ) );
    RemoveProp( FWnd, 'TRAYSAVEPROC' );
end;
// [END TTrayIcon.DetachProc2Wnd]

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewTrayIcon( Wnd: PControl; Icon: HIcon ): PTrayIcon;
begin
  if FTrayItems = nil then
     FTrayItems := NewList;
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TTrayIcon';
  {$ENDIF}
  FTrayItems.Add( Result );
  if Wnd <> nil then
    Wnd.AttachProc( WndProcTray );
  Result.FControl := Wnd;
  Result.FIcon := Icon;
  Result.Active := True;
end;
{$ENDIF PAS_VERSION}

var fRecreateMsg: DWORD;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function WndProcRecreateTrayIcons( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var I: Integer;
    TI: PTrayIcon;
begin
  if Msg.message = fRecreateMsg then
  begin
    for I := 0 to FTrayItems.fCount - 1 do
    begin
      TI := FTrayItems.Items[ I ];
      if TI.fAutoRecreate then
      if TI.fActive then
      begin
        TI.fActive := False;
        TI.Active := True;
      end;
    end;
  end;
  Result := False;
end;
{$ENDIF PAS_VERSION}

const
  TaskbarCreatedMsg: array[ 0..14 ] of KOLChar = ('T','a','s','k','b','a','r',
                     'C','r','e','a','t','e','d',#0);
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TTrayIcon.SetAutoRecreate(const Value: Boolean);
begin
  fAutoRecreate := Value;
  FControl.ParentForm.AttachProc( WndProcRecreateTrayIcons );
  fRecreateMsg := RegisterWindowMessage( TaskbarCreatedMsg );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TTrayIcon.Destroy;
begin
  Active := False;

  if fIcon <> 0 then
    DestroyIcon( fIcon );

  FTrayItems.Remove( @ Self );
  if FTrayItems.Count = 0 then
    Free_And_Nil( FTrayItems );
  FTooltip := '';
  inherited;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TTrayIcon.SetActive(const Value: Boolean);
begin
  if FActive = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if FIcon = 0 then Exit;
  if (Wnd = 0) and ((FControl = nil) or (FControl.GetWindowHandle = 0)) then
     Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FActive := Value;
  if Value then
     SetTrayIcon( NIM_ADD )
  else
     SetTrayIcon( NIM_DELETE );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TTrayIcon.SetIcon(const Value: HIcon);
var Cmd : DWORD;
begin
  if FIcon = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  // Previous icon is not destroying. This is normal for icons, loaded from
  // resources using LoadIcon. For icons, created using CreateIconIndirect, You
  // have to call DestroyIcon manually.
  Cmd := NIM_MODIFY;
  if FIcon = 0 then
     Cmd := NIM_ADD;
  FIcon := Value;
  if FActive then
     SetTrayIcon( Cmd );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
procedure TTrayIcon.SetTooltip(const Value: KOLString);
begin
  if FTooltip = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FTooltip := Value;
  if Active then
     SetTrayIcon( NIM_MODIFY );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
procedure TTrayIcon.SetTrayIcon(const Value: DWORD);
var NID : {$IFDEF UNICODE_CTRLS} TNotifyIconDataW {$ELSE} TNotifyIconData {$ENDIF};
    L : Integer;
    V : DWORD;
begin
  V := Value;
  if AppletTerminated then
    V := NIM_DELETE;
  if Wnd <> 0 then
    NID.Wnd := Wnd
  else
    NID.Wnd := FControl.fHandle;

  NID.cbSize := Sizeof( NID );
  NID.uID := DWORD( @Self );
  NID.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  if V = NIM_DELETE then
     NID.uFlags := 0;
  NID.uCallbackMessage := CM_TRAYICON;
  NID.hIcon := FIcon;
  L := Length( FToolTip );
  if L > 63 then L := 63;
  Move( FTooltip[1], NID.szTip[0], Min( 63, L )*SizeOf(KOLChar) );
  NID.szTip[ L ] := #0;

  Shell_NotifyIcon( V, @NID );
end;
{$ENDIF PAS_VERSION}

{ -- JustOne -- }

var JustOneMutex: THandle;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function WndProcJustOne( Control: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean;
begin
  Result := False;
  case Msg.message of
  WM_CLOSE, WM_NCDESTROY:
      if LongBool( JustOneMutex ) and (Control.Handle = Msg.hwnd) then
      begin
        CloseHandle( JustOneMutex );
        JustOneMutex := 0;
      end;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_noUNICODE}
function JustOne( Wnd: PControl; const Identifier : KOLString ) : Boolean;
asm
        PUSH     EBX
        PUSH     ESI
        XOR      ESI, ESI
        PUSH     EDI
        XCHG     EBX, EAX

        CALL     EDX2PChar
        PUSH     EDX

        PUSH     0
        PUSH     1
        PUSH     ESI
        MOV      EDI, offset[CreateMutex]
        CALL     EDI

        POP      EDX
        TEST     EAX, EAX
        JZ       @@exit     //
        PUSH     EAX
        PUSH     EAX

        PUSH     EDX
        PUSH     ESI
        PUSH     ESI
        CALL     EDI
        MOV      [JustOneMutex], EAX
        TEST     EAX, EAX
        JE       @@1        //

        PUSH     ESI
        PUSH     EAX
        CALL     WaitForSingleObject
        SUB      EAX, WAIT_TIMEOUT
        JE       @@1

        INC      ESI
@@1:
        XCHG     EAX, EBX
        MOV      EDX, offset[WndProcJustOne]
        CALL     TControl.AttachProc

        CALL     ReleaseMutex
        CALL     CloseHandle

@@exit:
        XCHG     EAX, ESI
        POP      EDI
        POP      ESI
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function JustOne( Wnd: PControl; const Identifier : KOLString ) : Boolean;
var CritSecMutex : THandle;
    DW : Longint;
begin
   Result := False;
   CritSecMutex := CreateMutex( nil, True, nil );
   if CritSecMutex = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

   JustOneMutex := CreateMutex( nil, False, PKOLChar( Identifier ) );
   if JustOneMutex <> 0 then
   begin
     DW := WaitForSingleObject( JustOneMutex, 0 );
     Result := (DW <> WAIT_TIMEOUT);
   end;
   Wnd.AttachProc( WndProcJustOne );
   CloseHandle( CritSecMutex );
end;
{$ENDIF PAS_VERSION}

{ JustOneNotify }

var
  OnAnotherInstance: TOnAnotherInstance;
  JustOneMsg: DWORD;

{$IFDEF ASM_UNICODE}{$ELSE ASM_UNICODE} //Pascal
function WndProcJustOneNotify( Control: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean;
var Buf : array[0..MAX_PATH] of KOLChar;
begin
  WndProcJustOne( Control, Msg, Rslt );
  Result := False;
  if  Msg.message = JustOneMsg then
  begin
      Result := True;
      if assigned( OnAnotherInstance ) then
      begin
        GetWindowText( Msg.lParam, Buf, MAX_PATH );
        OnAnotherInstance( Buf );
      end;
      Rslt := 0;
  end;
end;
{$ENDIF PAS_VERSION}

// Redefine here incorrectly declared BroadcastSystemMessage API function.
// It should not refer to BroadcastSystemMessageA, which is not present in
// earlier versions of Windows95, but to BroadcastSystemMessage, which is
// present in all Windows95/98/Me and NT/2K/XP.
function BroadcastSystemMessage(Flags: DWORD; Recipients: PDWORD;
  uiMessage: UINT; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;
external user32 name 'BroadcastSystemMessage';

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function JustOneNotify( Wnd: PControl; const Identifier : KOLString;
                        const aOnAnotherInstance: TOnAnotherInstance ) : Boolean;
var Recipients : DWord;
    OldCap: KOLString;
begin
   Result := False;
   JustOneMsg := RegisterWindowMessage( PKOLChar( 'Message.' + Identifier ) );
   if JustOneMsg = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

   Result := JustOne( Wnd, Identifier );
   if not Result then
   begin
      // Send a message to the first instance of applet
      OldCap := Wnd.Caption;
      Wnd.Caption := GetCommandLine;
      if Wnd.GetWindowHandle <> 0 then
      begin
         Recipients := BSM_APPLICATIONS;
         BroadcastSystemMessage( BSF_QUERY or BSF_IGNORECURRENTTASK, @Recipients,
                                 JustOneMsg, 0, Wnd.fHandle );
      end;
      Wnd.Caption := OldCap;
   end
      else
   begin
      // Store event handler to notify this instance about another
      // instance staring:
      OnAnotherInstance := aOnAnotherInstance;
      Wnd.AttachProc( WndProcJustOneNotify );
   end;
end;
{$ENDIF PAS_VERSION}

///////////////////////////////////////// STRING LIST OBJECT /////////////////

{$ENDIF WIN}
{ TStrList }

function NewStrList: PStrList;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TStrList';
  {$ENDIF}
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TStrList.Destroy;
begin
  Clear;
  inherited;
end;
{$ENDIF PAS_VERSION}

procedure TStrList.Init;
begin
  {$IFDEF CALL_INHERITED}
  inherited;
  {$ENDIF}
  fNameDelim := DefaultNameDelimiter;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TStrList.Add(const S: Ansistring): integer;
begin
  Result := fCount;
  Insert( Result, S );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TStrList.AddStrings(Strings: PStrList);
begin
  SetText( Strings.Text, True );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TStrList.Assign(Strings: PStrList);
begin
  Clear;
  AddStrings( Strings );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TStrList.Clear;
var I: Integer;
begin
  if fCount > 0 then
  for I := fList.Count - 1 downto 0 do
    Delete( I );
  fList.Free;
  fList := nil;
  fCount := 0;
  if fTextBuf <> nil then
  begin
    FreeMem( fTextBuf );
    fTextBuf := nil;
    fTextSiz := 0;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION} {$DEFINE TStrList_Delete_ASM} {$ENDIF}
{$IFDEF TLIST_FAST}  {$UNDEF  TStrList_Delete_ASM} {$ENDIF}

{$IFDEF TStrList_Delete_ASM}
{$ELSE PAS_VERSION} //Pascal
procedure TStrList.Delete(Idx: integer);
var P: DWORD;
    El:Pointer;
begin
  P := DWORD( fList.Items[ Idx ] );
  if (fTextBuf <> nil) and ( P >= DWORD( fTextBuf )) and
     ( P < DWORD( fTextBuf ) + fTextSiz ) then
  else
  begin
    El := FList.Items[ Idx ];
    FreeMem( El );
  end;
  fList.Delete( Idx );
  Dec( fCount );
end;
{$ENDIF PAS_VERSION}

procedure TStrList.DeleteLast;
begin
  Delete( Count-1 );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TStrList.Get(Idx: integer): Ansistring;
begin
  if fList <> nil then
    Result := PAnsiChar( fList.Items[ Idx ] )
  else Result := '';
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
function TStrList.GetPChars(Idx: Integer): PAnsiChar;
asm
        MOV      EAX, [EAX].fList
        MOV      EAX, [EAX].TList.fItems
        MOV      EAX, [EAX+EDX*4]
end;
{$ELSE PAS_VERSION} //Pascal
function TStrList.GetPChars(Idx: Integer): PAnsiChar;
begin
  Result := PAnsiChar( fList.{$IFDEF TLIST_FAST}Items{$ELSE}fItems{$ENDIF}[ Idx ] )
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
function TStrList.GetTextStr: Ansistring;
asm
        PUSH     ESI
        PUSH     EDI
        MOV      ECX, [EAX].fCount
        MOV      EAX, [EAX].fList
        PUSH     ECX
        JECXZ    @@1
        MOV      ESI, [EAX].TList.fItems
@@1:    PUSH     ESI
        XCHG     EAX, EDX
        XOR      EDX, EDX
        JECXZ    @@10
        PUSH     EAX
@@loo1: PUSH     ECX
        PUSH     EDX
        LODSD
        CALL     StrLen
        POP      EDX
        LEA      EDX, [EDX+EAX+2]
        POP      ECX
        LOOP     @@loo1
          POP      EAX
          POP      ESI
          XCHG     ECX, EDX
          PUSH     EAX
@@10:   {$IFDEF _D2}
        CALL     _LStrFromPCharLen
        {$ELSE}
        {$IFDEF _D2009orHigher}
        XOR      ECX, ECX
        {$ENDIF}
        CALL     System.@LStrFromPCharLen
        {$ENDIF}
          POP      EDI
          POP      ECX
          JECXZ    @@exit
          MOV      EDI, [EDI]
@@loo2: PUSH     ECX
        LODSD
        PUSH     EAX
        CALL     StrLen
        XCHG     ECX, EAX
        POP      EAX
        XCHG     EAX, ESI
        REP      MOVSB
        XCHG     ESI, EAX
        MOV      AX, $0A0D
        STOSW
        POP      ECX
        LOOP     @@loo2
          XCHG     EAX, ECX
          STOSB
@@exit: POP      EDI
        POP      ESI
end;
{$ELSE PAS_VERSION} //Pascal
function TStrList.GetTextStr: Ansistring;
var
   I, Len, Size: integer;
   P: PAnsiChar;
begin
     Size := 0;

     for I := 0 to fCount - 1 do
       Inc(Size, StrLen( PAnsiChar(fList.
         {$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF} [I]) ) +
                 {$IFDEF LIN} 1 {$ELSE} 2 {$ENDIF});

     SetString(Result, nil, Size);

     P := Pointer(Result);
     for I := 0 to Count - 1 do
     begin
       Len := StrLen(PAnsiChar(fList.
         {$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF} [I]));
       if (Len > 0) then
       begin
         System.Move(PAnsiChar(fList.
           {$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[I])^,
           P^, Len);
         Inc(P, Len);
       end;
       P^ := #13;
       Inc(P);
       {$IFDEF WIN}
       P^ := #10;
       Inc(P);
       {$ENDIF WIN}
     end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
function TStrList.IndexOf(const S: Ansistring): integer;
asm
        PUSH     EDI
        PUSH     ESI
        PUSH     EBX
        OR       EDI, -1
        MOV      ECX, [EAX].fCount
        JECXZ    @@exit
        MOV      ESI, [EAX].fList
        MOV      ESI, [ESI].TList.fItems
        CALL     EDX2PChar
        MOVZX    EBX, BYTE[EDX]
@@loo:  LODSD
        INC      EDI
        CMP      BL, BYTE[EAX]
        JNE      @@1
        PUSH     EDX
        PUSH     ECX
        CALL     StrComp
        POP      ECX
        POP      EDX
        JE       @@exit
@@1:    LOOP     @@loo
        OR       EDI, -1
@@exit: XCHG     EAX, EDI
        POP      EBX
        POP      ESI
        POP      EDI
end;
{$ELSE PAS_VERSION} //Pascal
function TStrList.IndexOf(const S: AnsiString): integer;
var Word1: Word;
begin
  if  S = '' then
  begin
      for Result := 0 to fCount - 1 do
        if  PAnsiChar(fList.Items[Result])^ = #0 then Exit; {>>>>>>>>>>>>>>>>>>}
  end else
  begin
      Word1 := PWord(PAnsiChar( S ))^;
  	  for Result := 0 to fCount - 1 do
          if  (PWord(fList.Items[Result])^ = Word1)
          and (StrComp( fList.Items[Result], PAnsiChar( S ) ) = 0) then
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Result := -1;
end;
{$ENDIF PAS_VERSION}

function TStrList.IndexOf_NoCase(const S: AnsiString): integer;
var tmp: PAnsiChar;
    c: AnsiChar;
begin
  if  S = '' then
  begin
      for Result := 0 to fCount - 1 do
              if  PAnsiChar( fList.Items[Result] )^ = #0 then Exit; {>>>>>>>>>>}
  end else
  begin
      if  not Upper_initialized then
          Init_Upper;
      for Result := 0 to fCount - 1 do
      begin
        tmp := fList.Items[Result];
        c := Upper[S[1]];
        if  (c = Upper[tmp^]) and
            (_AnsiCompareStrNoCaseA( PAnsiChar( S ), tmp ) = 0) then Exit; {>>>}
      end;
  end;
  Result := -1;
end;

function TStrList.IndexOfStrL_NoCase( Str: PAnsiChar; L: Integer ): integer;
begin
  if  L = 0 then
      Result := 0
  else
  begin
      for Result := 0 to fCount - 1 do
        if (StrLen( PAnsiChar( fList.
          {$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ Result ]
          ) ) = DWORD( L )) and
           (StrLComp_NoCase( Str, PAnsiChar(
           fList.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ Result ]
           ), L ) = 0) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      Result := -1;
  end;
end;

function CompareAnsiCase( const S1, S2: PAnsiChar ): Integer;
begin
    Result := _AnsiCompareStrA( S1, S2 );
end;

function CompareAnsiNoCase( const S1, S2: PAnsiChar ): Integer;
begin
    Result := _AnsiCompareStrNoCaseA( S1, S2 );
end;

function TStrList.Find(const S: AnsiString; var Index: Integer): Boolean;
var
  L, H, C: Integer;
begin
  Result := FALSE;
  Index := 0;
  L := 0;
  H := FCount - 1;
  if  H < 0 then Exit; // === if FCount = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>}
  if  fAnsiSort then
  begin
      if  fCaseSensitiveSort then
          fCompareStrListFun := CompareAnsiCase
      else
          fCompareStrListFun := CompareAnsiNoCase;
  end else
  begin
      if  fCaseSensitiveSort then
          fCompareStrListFun := StrComp
      else
          fCompareStrListFun := StrComp_NoCase;
  end;
  C := 0;
  while L <= H do
  begin
    Index := (L + H) shr 1;
    C := fCompareStrListFun( PAnsiChar( fList.Items[ Index ] ),
                             PAnsiChar( S ) );
    if C < 0 then L := Index + 1 else
    begin
      H := Index - 1;
      if C = 0 then
      begin
        Result := TRUE; {Index := I;} Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
    end;
  end;
  if  C < 0 then Index := -L;
end;

function TStrList.FindFirst(const S: AnsiString; var Index: Integer): Boolean;
begin
  Result := Find( S, Index );
  if  Result then
  begin
      while (Index > 0)
      and   (fCompareStrListFun( PAnsiChar( fList.Items[ Index-1 ] ),
                                 PAnsiChar( S )) = 0) do
            dec( Index );
  end;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TStrList.Insert(Idx: integer; const S: Ansistring);
var Mem: PAnsiChar;
    L: Integer;
begin
  if fList = nil then
     fList := NewList;
  L := Length( S ) + 1;
  GetMem( Mem, L );
  Mem[0] := #0;
  if L > 1 then
     System.Move( S[1], Mem[0], L );
  fList.Insert( Idx, Mem );
  Inc( fCount );
end;
{$ENDIF PAS_VERSION}

procedure TStrList.Move(CurIndex, NewIndex: integer);
begin
  fList.MoveItem( CurIndex, NewIndex );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TStrList.Put(Idx: integer; const Value: Ansistring);
begin
  Delete( Idx );
  Insert( Idx, Value );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
procedure TStrList.SetText(const S: Ansistring; Append2List: boolean);
asm
        DEC      CL
        JZ       @@1
        PUSHAD
        CALL     Clear
        POPAD
@@1:    CALL     EDX2PChar
        JZ       @@exit
          PUSH     EBX
          PUSH     EDI
          MOV      EBX, EAX
          MOV      EDI, [EBX].fTextSiz
        MOV      EAX, [EDX-4] // EAX = Length(S)
        INC      EAX
        PUSH     EAX
        // add S to text buffer
        PUSH     EDX
        PUSH     [EBX].fTextBuf
        ADD      EAX, [EBX].fTextSiz
        CALL     System.@GetMem
        MOV      [EBX].fTextBuf, EAX
          MOV      ECX, EDI
          XCHG     EDX, EAX
          POP      EAX
          JECXZ    @@atb_fin
          PUSH     EAX
          CALL     System.Move
        POP      EDX
        PUSH     EDX
          PUSH     ESI
          MOV      ESI, [EBX].fList
          MOV      ESI, [ESI].TList.fItems
          MOV      ECX, [EBX].fCount
@@atb_loo:
        LODSD
        SUB      EAX, EDX
        CMP      EAX, [EBX].fTextSiz
        JAE      @@atb_nxt
          ADD      EAX, [EBX].fTextBuf
          MOV      [ESI-4], EAX
@@atb_nxt: LOOP  @@atb_loo
        POP      ESI
        POP      EAX
        CALL     System.@FreeMem
@@atb_fin:
        POP      EAX
          MOV      EDX, EDI
          ADD      EDX, [EBX].fTextBuf
          POP      ECX
          PUSH     ECX
          ADD      [EBX].fTextSiz, ECX
        CALL     System.Move
@@eatb:
        ADD      EDI, [EBX].fTextBuf // EDI ~ P
          MOV      ECX, [EBX].fList
          INC      ECX
          LOOP     @@2
          CALL     NewList
          MOV      [EBX].fList, EAX
@@2:
        POP      ECX
        MOV      EDX, [EBX].fCount
          PUSH     EDI
          PUSH     ECX
          MOV      AL, $0D
@@loo1: CMP      byte ptr [EDI], 0
        JZ       @@eloo1
          INC      EDX
          REPNZ    SCASB
          JNZ      @@eloo1
        CMP      byte ptr [EDI], $0A
        JNZ      @@loo1
        INC      EDI
        LOOP     @@loo1
@@eloo1:
          MOV      [EBX].fCount, EDX
        MOV      EAX, [EBX].fList
        {$IFNDEF TLIST_FAST}
        PUSH     EDX
        PUSH     EAX
        CMP      EDX, [EAX].TList.fCapacity
        JLE      @@3
        CALL     TList.SetCapacity
@@3:    POP      EAX
        POP      ECX
        {$ENDIF TLIST_FAST}
          XCHG     ECX, [EAX].TList.fCount
          MOV      EDX, [EAX].TList.fItems
          LEA      EDX, [EDX+ECX*4]
        POP      ECX
        POP      EDI
          MOV      EAX, $0D
@@loo2:   CMP      byte ptr [EDI], AH
          JZ       @@eloo2
        MOV      [EDX], EDI
        ADD      EDX, 4
          REPNZ    SCASB
          JNZ      @@eloo2
        MOV      [EDI-1], AH
          CMP      byte ptr [EDI], $0A
          JNZ      @@loo2
          INC      EDI
          LOOP     @@loo2
@@eloo2:
        POP      EDI
        POP      EBX
@@exit:
end;
{$ELSE PAS_VERSION} //Pascal
procedure TStrList.SetText(const S: Ansistring; Append2List: Boolean);
var
  P, TheLast : PAnsiChar;
  L, I : Integer;

  procedure AddTextBuf(Src: PAnsiChar; Len: DWORD);
  var OldTextBuf, P: PAnsiChar;
      I : Integer;
  begin
    if Src <> nil then
    begin
      OldTextBuf := fTextBuf;
      GetMem( fTextBuf, fTextSiz + Len );
      if fTextSiz <> 0 then
      begin
        System.Move( OldTextBuf^, fTextBuf^, fTextSiz );
        for I := 0 to fCount - 1 do
        begin
          P := fList.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ];
          if (DWORD( P ) >= DWORD( OldTextBuf )) and
             (DWORD( P ) < DWORD( OldTextBuf ) + fTextSiz) then
            fList.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ] :=
                Pointer( DWORD( P ) - DWORD( OldTextBuf ) + DWORD( fTextBuf ) );
        end;
        FreeMem( OldTextBuf );
      end;
      System.Move( Src^, fTextBuf[ fTextSiz ], Len );
      Inc( fTextSiz, Len );
    end;
  end;
begin
     if not Append2List then Clear;
     if S = '' then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
     L := fTextSiz;
     AddTextBuf( PAnsiChar( S ), Length( S ) + 1 );
     P := PAnsiChar( DWORD( fTextBuf ) + DWORD( L ) );
     if  fList = nil then fList := NewList;
     I := 0;
     TheLast := P + Length( S );
     while P^ <> #0 do
     begin
         Inc( I );
         {$IFDEF WIN}
         P := StrScanLen( P, #13, TheLast - P );
         if P^ = #10 then
           Inc( P );
         {$ELSE LIN}
         P := StrScanLen( P, #10, TheLast - P );
         {$ENDIF}
     end;
     Inc( fCount, I );
     {$IFNDEF TLIST_FAST}
     if fList.fCapacity < fCount  then
        fList.Capacity := fCount;
     {$ENDIF}
     P := PAnsiChar( DWORD( fTextBuf ) + DWORD( L ) );
     while P^ <> #0 do
     begin
       fList.Add( P );
       {$IFDEF WIN}
       P := StrScanLen( P, #13, TheLast - P );
       if PAnsiChar( P - 1 )^ = #13 then
         PAnsiChar( P - 1 )^ := #0;
       if P^ = #10 then Inc(P);
       {$ELSE LIN}
       P := StrScanLen( P, #10, TheLast - P );
       {$ENDIF}
     end;
end;
{$ENDIF PAS_VERSION}

procedure TStrList.SetUnixText(const S: AnsiString; Append2List: Boolean);
var S1: AnsiString;
begin
  S1 := S;
  NormalizeUnixText( S1 );
  SetText( S1, Append2List );
end;

procedure TStrList.SetTextStr(const Value: Ansistring);
begin
  SetText( Value, False );
end;

{$IFDEF ASM_TLIST}
function CompareStrListItems_NoCase( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
asm
        MOV      EAX, [EAX].TStrList.fList
        MOV      EAX, [EAX].TList.fItems
        MOV      EDX, [EAX+EDX*4]
        MOV      EAX, [EAX+ECX*4]
        XCHG     EAX, EDX
        JMP      StrComp_NoCase
end;
{$ELSE PAS_VERSION} //Pascal
function CompareStrListItems_NoCase( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
var S1, S2 : PAnsiChar;
begin
  S1 := PStrList( Sender ).fList.Items[ e1 ];
  S2 := PStrList( Sender ).fList.Items[ e2 ];
  Result := StrComp_NoCase( S1, S2 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
function CompareStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
asm
        MOV      EAX, [EAX].TStrList.fList
        MOV      EAX, [EAX].TList.fItems
        MOV      EDX, [EAX+EDX*4]
        MOV      EAX, [EAX+ECX*4]
        XCHG     EAX, EDX
        JMP      StrComp
end;
{$ELSE PAS_VERSION} //Pascal
function CompareStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
var S1, S2 : PAnsiChar;
begin
  S1 := PStrList( Sender ).fList.Items[ e1 ];
  S2 := PStrList( Sender ).fList.Items[ e2 ];
  Result := StrComp( S1, S2 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
function CompareAnsiStrListItems( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
asm
        MOV      EAX, [EAX].TStrList.fList
        MOV      EAX, [EAX].TList.fItems
        MOV      EDX, [EAX+EDX*4]
        MOV      EAX, [EAX+ECX*4]
        XCHG     EAX, EDX
        JMP      _AnsiCompareStrNoCase
end;
{$ELSE PAS_VERSION} //Pascal
function CompareAnsiStrListItems( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
var S1, S2 : PAnsiChar;
begin
  S1 := PStrList( Sender ).fList.Items[ e1 ];
  S2 := PStrList( Sender ).fList.Items[ e2 ];
  Result := _AnsiCompareStrNoCaseA( S1, S2 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_TLIST}
function CompareAnsiStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
asm
        MOV      EAX, [EAX].TStrList.fList
        MOV      EAX, [EAX].TList.fItems
        MOV      EDX, [EAX+EDX*4]
        MOV      EAX, [EAX+ECX*4]
        XCHG     EAX, EDX
        JMP      _AnsiCompareStr
end;
{$ELSE PAS_VERSION} //Pascal
function CompareAnsiStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
var S1, S2 : PAnsiChar;
begin
  S1 := PStrList( Sender ).fList.Items[ e1 ];
  S2 := PStrList( Sender ).fList.Items[ e2 ];
  Result := _AnsiCompareStrA( S1, S2 )
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TStrList.Sort(CaseSensitive: Boolean);
begin
  fCaseSensitiveSort := CaseSensitive;
  fAnsiSort := FALSE;
  {$IFDEF SPEED_FASTER}
          {$DEFINE SORT_STRLIST_ARRAY}
  {$ENDIF}
  {$IFDEF TLIST_FAST}
          {$UNDEF SORT_STRLIST_ARRAY}
  {$ENDIF}
  {$IFDEF _D2}
          {$UNDEF SORT_STRLIST_ARRAY}
  {$ENDIF}
  {$IFDEF SORT_STRLIST_ARRAY}
  if  Count > 1 then
  if  CaseSensitive then
      SortArray( fList.fItems, fCount, @StrComp )
  else
      SortArray( fList.fItems, fCount, @StrComp_NoCase );
  {$ELSE}
  if  CaseSensitive then
      SortData( @Self, fCount, @CompareStrListItems_Case, @TStrList.Swap )
  else
      SortData( @Self, fCount, @CompareStrListItems_NoCase, @TStrList.Swap )
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$IFDEF noASM_VERSION}
procedure TStrList.AnsiSort(CaseSensitive: Boolean);
asm
        MOV      [EAX].fCaseSensitiveSort, DL
        MOV      [EAX].fAnsiSort, 1
        {$IFDEF  SORT_STRLIST_ARRAY}
        MOV      ECX, Offset[_AnsiCompareStrA]
        CMP      DL, 0
        JNZ      @@01
        MOV      ECX, [_AnsiCompareStrNoCaseA]
@@01:
        MOV      EAX, [EAX].fList
        MOV      EDX, [EAX].TList.fCount
        CMP      EDX, 1
        JLE      @@02
        MOV      EAX, [EAX].TList.fItems
        CALL     SortArray
@@02:
        {$ELSE}
        PUSH     Offset[TStrList.Swap]
        MOV      ECX, Offset[CompareAnsiStrListItems]
        CMP      DL, 0
        JNZ      @1
        MOV      ECX, Offset[CompareAnsiStrListItems_Case]
@1:     MOV      EDX, [EAX].fCount
        CALL     SortData
        {$ENDIF}
end;
{$ELSE PAS_VERSION} //Pascal
procedure TStrList.AnsiSort(CaseSensitive: Boolean);
begin
  fCaseSensitiveSort := CaseSensitive;
  fAnsiSort := TRUE;
  {$IFDEF SPEED_FASTER}
          {$DEFINE SORT_STRLIST_ARRAY}
  {$ENDIF}
  {$IFDEF TLIST_FAST}
          {$UNDEF SORT_STRLIST_ARRAY}
  {$ENDIF}
  {$IFDEF _D2}
          {$UNDEF SORT_STRLIST_ARRAY}
  {$ENDIF}
  if  Count > 1 then
  begin
      {$IFDEF SPEED_FASTER}
      if   CaseSensitive then // to prepare !!!
           _AnsiCompareStrA( ItemPtrs[0], ItemPtrs[1] )
      else _AnsiCompareStrNoCaseA( ItemPtrs[0], ItemPtrs[1] );
      {$ENDIF}
      {$IFDEF SORT_STRLIST_ARRAY}
      if  CaseSensitive then
          SortArray( fList.fItems, fCount, @_AnsiCompareStrA )
      else
          SortArray( fList.fItems, fCount, @_AnsiCompareStrNoCaseA );
      {$ELSE}
      if  CaseSensitive then
          SortData( @Self, fCount, @CompareAnsiStrListItems_Case, @TStrList.Swap )
      else
          SortData( @Self, fCount, @CompareAnsiStrListItems, @TStrList.Swap );
      {$ENDIF}
  end;
end;
{$ENDIF PAS_VERSION}

procedure TStrList.SortEx(const CompareFun: TCompareEvent);
begin
    SortData( @Self, Count, CompareFun, @TStrList.Swap );
end;

procedure TStrList.Swap(Idx1, Idx2: Integer);
begin
  fList.Swap( Idx1, Idx2 );
end;

function TStrList.Last: AnsiString;
begin
  if Count = 0 then
    Result := ''
  else
    Result := Items[ Count - 1 ];
end;

//-- code by Dod:
function TStrList.IndexOfName(AName: Ansistring): Integer;
var i: Integer;
    L: Integer;
begin
    Result:=-1;
    // Do not start search if empty string
    L := Length( AName );
    if L > 0 then
    begin
      AName := LowerCase( AName ) + fNameDelim;
      Inc( L );
      for i := 0 to fCount - 1 do
      begin
        // For optimization, check only list entry that begin with same letter as searched name
        if StrLComp( PAnsiChar( LowerCase( ItemPtrs[ i ] ) ), PAnsiChar( AName ), L ) = 0 then
        begin
          Result:=i; exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
      end;
    end;
end;

function TStrList.IndexOfName_NoCase(AName: Ansistring): Integer;
var i: Integer;
    L: Integer;
    s, p: PAnsiChar;
begin
    Result:=-1;
    L := Length( AName );
    if L > 0 then
    begin
      s := PAnsiChar( AName );
      for i := 0 to fCount - 1 do
      begin
        if StrLComp_NoCase( ItemPtrs[ i ], s, L ) = 0 then
        begin
            p := ItemPtrs[ i ];
            inc( p, L );
            while (p^ <> #0) and (p^ <= ' ') do inc( p );
            if  p^ = fNameDelim then
            begin
                Result := i; exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
            end;
        end;
      end;
    end;
end;

//-- code by Dod:
function TStrList.GetValue(const AName: Ansistring): Ansistring;
var
  i: Integer;
begin
  I := IndexOfName(AName);
  if I >= 0
  then Result := Copy(Items[i], Length(AName) + 2, Length(Items[i])-Length(AName)-1)
  else Result := '';
end;

//-- code by Dod:
procedure TStrList.SetValue(const AName, Value: Ansistring);
var
  I: Integer;
begin
  I := IndexOfName(AName);
  if i=-1
  then Add( AName + fNameDelim + Value )
  else Items[i] := AName + fNameDelim + Value;
end;

function TStrList.GetLineName(Idx: Integer): AnsiString;
var s: AnsiString;
    Q: PAnsiChar;
begin
  s := ItemPtrs[ Idx ];
  Q := StrScan( PAnsiChar(s), fNameDelim );
  if  Assigned(Q) {by Dufa} then Q^ := #0;
  Result := PAnsiChar(s);
end;

procedure TStrList.SetLineName(Idx: Integer; const NV: AnsiString);
begin
  Items[ Idx ] := NV + fNameDelim + LineValue[ Idx ];
end;

function TStrList.GetLineValue(Idx: Integer): AnsiString;
var Q: PAnsiChar;
begin
  Q := ItemPtrs[ Idx ];
  Q := StrScan( Q, fNameDelim );
  if  Q <> nil then
      inc( Q );
  Result := Q;
end;

procedure TStrList.SetLineValue(Idx: Integer; const Value: Ansistring);
begin
  Items[ Idx ] := LineName[ Idx ] + fNameDelim + Value;
end;

function TStrList.Join( const sep: AnsiString ): AnsiString;
var
   I, Len, Size: integer;
   P: PAnsiChar;
begin
  Size := 0;

  for I := 0 to Count - 1 do
    Inc(Size, Integer( StrLen( ItemPtrs[I] ) ) + Length(Sep));

  SetString(Result, nil, Size);

  P := @ Result[ 1 ];
  for I := 0 to Count - 1 do
  begin
    Len := StrLen( ItemPtrs[I] );
    if (Len > 0) then
    begin
      System.Move( ItemPtrs[I]^, P^, Len);
      Inc(P, Len);
    end;
    P := StrPCopy(P, Sep);
    inc( P, Length( Sep ) ); // + by Korneev Ivan
  end;
end;

{$IFDEF WIN_GDI}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TStrList.AppendToFile(const FileName: KOLString): Boolean;
var F: HFile;
    Buf: AnsiString;
    L: Integer;
begin
  F := FileCreate( FileName, ofOpenWrite or ofOpenAlways );
  Result := F <> INVALID_HANDLE_VALUE;
  if Result then
  begin
    FileSeek( F, 0, spEnd );
    Buf := Text;
    L := Length( Buf );
    FileWrite( F, Buf[ 1 ], L );
    FileClose( F );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TStrList.LoadFromFile(const FileName: KOLString): Boolean;
var Buf: AnsiString;
    F: HFile;
    Sz: Integer;
begin
  F := FileCreate( FileName, ofOpenRead or ofShareDenyWrite or ofOpenExisting );
  Result := F <> INVALID_HANDLE_VALUE;
  if Result then
  begin
    Sz := GetFileSize( F, nil );
    SetString( Buf, nil, Sz );
    FileRead( F, Buf[1], Sz );
    FileClose( F );

    SetText( Buf, False );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_STREAM}
procedure TStrList.LoadFromStream(Stream: PStream; Append2List: boolean);
asm
        PUSH     EAX
        PUSH     ECX
        PUSH     EBX
        XCHG     EAX, EDX
        MOV      EBX, EAX
        CALL     TStream.GetSize
        PUSH     EAX
        MOV      EAX, EBX
        CALL     TStream.GetPosition
        POP      ECX
        SUB      ECX, EAX
        XOR      EDX, EDX
        PUSH     EDX
        MOV      EAX, ESP
        PUSH     ECX
        {$IFDEF _D2}
        CALL     _LStrFromPCharLen
        {$ELSE}
        {$IFDEF _D2009orHigher}
        push     0
        {$ENDIF}
        CALL     System.@LStrFromPCharLen
        {$ENDIF}
        POP      ECX
        POP      EDX
        XCHG     EAX, EBX
        PUSH     EDX
        CALL     TStream.Read
        POP      EDX
        POP      EBX
        POP      ECX
        POP      EAX
        PUSH     EDX
        CALL     SetText
        CALL     RemoveStr
end;
{$ELSE PAS_VERSION} //Pascal
procedure TStrList.LoadFromStream(Stream: PStream; Append2List: Boolean);
var Buf: AnsiString;
    Sz: Integer;
begin
  Sz := Stream.Size - Stream.Position;
  SetString( Buf, nil, Sz );
  Stream.Read( Buf[1], Sz );
  SetText( Buf, Append2List );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TStrList.MergeFromFile(const FileName: KOLString);
var TmpStream: PStream;
begin
  TmpStream := NewReadFileStream( FileName );
  LoadFromStream( TmpStream, True );
  TmpStream.Free;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TStrList.SaveToFile(const FileName: KOLString): Boolean;
var F: HFile;
    Buf: AnsiString;
begin
  F := FileCreate( FileName, ofOpenWrite or ofCreateAlways );
  Result := F <> INVALID_HANDLE_VALUE;
  if Result then
  begin
    Buf := Text;
    FileWrite( F, Buf[ 1 ], Length( Buf ) );
    SetEndOfFile( F ); // necessary! - V.K.
    FileClose( F );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TStrList.SaveToStream(Stream: PStream);
var S: Ansistring;
    L: Integer;
begin
   S := GetTextStr;
   L := Length( S );
   if L <> 0 then
   Stream.Write( S[1], L );
end;
{$ENDIF PAS_VERSION}

procedure TStrList.OptimizeForRead;
begin
    {$IFDEF TLIST_FAST}
    if  fList <> nil then
        fList.OptimizeForRead;
    {$ENDIF}
end;

{$ENDIF WIN_GDI}
////////////////////////////////// EXTENDED STRING LIST OBJECT ////////////////

{$IFDEF PAS_ONLY}
procedure WStrCopy( Dest, Src: PWideChar );
begin
    while Src^ <> #0 do
    begin
        Dest^ := Src^;
        inc(Src);
        inc(Dest);
    end;
end;
{$ELSE}
procedure WStrCopy( Dest, Src: PWideChar );
asm
        PUSH    EDI
        PUSH    ESI
        MOV     ESI,EAX
        MOV     EDI,EDX
        OR      ECX, -1
        XOR     EAX, EAX
        REPNE   SCASW
        NOT     ECX
        MOV     EDI,ESI
        MOV     ESI,EDX
        REP     MOVSW
        POP     ESI
        POP     EDI
end;
{$ENDIF}

procedure WStrLCopy( Dest, Src: PWideChar; MaxLen: Integer );
begin
  while MaxLen > 0 do
  begin
    Dest^ := Src^;
    if Src^ = #0 then break;
    inc( Dest );
    inc( Src );
    dec( MaxLen );
    if MaxLen = 0 then
      Dest^ := Src^;
  end;
end;

{$IFDEF PAS_ONLY}
function WStrCmp( W1, W2: PWideChar ): Integer;
begin
    while (W1^ <> #0) and (w2^ <> #0) do
    begin
        Result := Integer(Ord(w1^)) - Integer(Ord(w2^));
        if Result <> 0 then Exit;
        inc(w1);
        inc(w2);
    end;
    Result := 0;
end;
{$ELSE}
function WStrCmp( W1, W2: PWideChar ): Integer;
asm
         PUSH     ESI
         PUSH     EDI
         XCHG     ESI, EAX
         MOV      EDI, EDX
         XOR      EAX, EAX
@@loop:  LODSW
         MOVZX    EDX, word ptr [EDI]
         INC      EDI
         INC      EDI
         CMP      EAX, EDX
         JNE      @@exit
         TEST     EAX, EAX
         JNZ      @@loop
@@exit:  SUB      EAX, EDX
         POP      EDI
         POP      ESI
end;
{$ENDIF}

{$IFDEF _D3orHigher}
function WStrCmp_NoCase( W1, W2: PWideChar ): Integer;
begin
    Result := 0;
    while (WUpperCase( '' + W1^ ) = WUpperCase( '' + W2^ )) do
    begin
        if  W1^ = #0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        inc( W1 );
        inc( W2 );
    end;
    Result := Integer(W1^) - Integer(W2^);
end;
{$ENDIF}

{ TStrListEx }

function NewStrListEx: PStrListEx;
begin
  new( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TStrListEx';
  {$ENDIF}
end;

destructor TStrListEx.Destroy;
var Obj: PList;
begin
  Obj := FObjects;
  inherited;
  Obj.Free;
end;

function TStrListEx.GetObjects(Idx: Integer): DWORD;
begin
  Result := 0;
  if FObjects.fCount > Idx then
    Result := DWORD( FObjects.Items[ Idx ] );
end;

function TStrListEx.GetObjectCount: Integer;
begin
  Result := FObjects.Count;
end;

procedure TStrListEx.SetObjects(Idx: Integer; const Value: DWORD);
begin
  ProvideObjCapacity( Idx + 1 );
  FObjects.Items[ Idx ] := Pointer( Value );
end;

procedure TStrListEx.Init;
begin
  inherited;
  FObjects := NewList;
end;

procedure SwapStrListExItems( const Sender: Pointer; const e1, e2: DWORD );
begin
  PStrListEx( Sender ).Swap( e1, e2 );
end;

procedure TStrListEx.AnsiSort(CaseSensitive: Boolean);
begin
  fCaseSensitiveSort := CaseSensitive;
  fAnsiSort := TRUE;
  if  CaseSensitive then
      SortData( @Self, fCount, @CompareAnsiStrListItems_Case, @SwapStrListExItems )
  else
      SortData( @Self, fCount, @CompareAnsiStrListItems, @SwapStrListExItems )
end;

procedure TStrListEx.Sort(CaseSensitive: Boolean);
begin
  fCaseSensitiveSort := CaseSensitive;
  fAnsiSort := FALSE;
  if   CaseSensitive then
       SortData( @Self, fCount, @CompareStrListItems_Case, @SwapStrListExItems )
  else SortData( @Self, fCount, @CompareStrListItems_NoCase, @SwapStrListExItems );
end;

procedure TStrListEx.Move(CurIndex, NewIndex: integer);
begin
  // move string
  fList.MoveItem( CurIndex, NewIndex );
  // move object
  if FObjects.fCount >= Min( CurIndex, NewIndex ) then
  begin
    ProvideObjCapacity( max( CurIndex, NewIndex ) + 1 );
    FObjects.MoveItem( CurIndex, NewIndex );
  end;
end;

procedure TStrListEx.Swap(Idx1, Idx2: Integer);
begin
  // swap strings
  fList.Swap( Idx1, Idx2 );
  // swap objects
  if FObjects.fCount >= Min( Idx1, Idx2 ) then
  begin
    ProvideObjCapacity( max( Idx1, Idx2 ) + 1 );
    FObjects.Swap( Idx1, Idx2 );
  end;
end;

procedure TStrListEx.ProvideObjCapacity(NewCap: Integer);
begin
  if FObjects.FCount < NewCap then
  begin
    {$IFDEF TLIST_FAST}
    while FObjects.FCount < NewCap do
      FObjects.Add( nil );
    {$ELSE}
    FObjects.Capacity := NewCap;
    ZeroMemory( @FObjects.{$IFDEF TLIST_FAST} Items {$ELSE} FItems {$ENDIF}[ FObjects.FCount ],
              (FObjects.Capacity - FObjects.Count) * sizeof( Pointer ) );
    FObjects.FCount := NewCap;
    {$ENDIF}
  end;
end;

procedure TStrListEx.AddStrings(Strings: PStrListEx);
var I: Integer;
begin
  I := Count;
  if Strings.FObjects.fCount > 0 then
    ProvideObjCapacity( I );
  inherited AddStrings( Strings );
  if Strings.FObjects.fCount > 0 then
  begin
    {$IFDEF TLIST_FAST}
    for I := 0 to Strings.FObjects.fCount-1 do
      FObjects.Add( Strings.FObjects.Items[ I ] );
    {$ELSE}
    ProvideObjCapacity( I + Strings.FObjects.fCount );
    System.Move( Strings.FObjects.fItems[ 0 ],
                 FObjects.FItems[ I ],
                 Sizeof( Pointer ) * Strings.FObjects.fCount );
    {$ENDIF}
  end;
end;

procedure TStrListEx.Assign(Strings: PStrListEx);
begin
  inherited Assign( Strings );
  FObjects.Assign( Strings.FObjects );
end;

procedure TStrListEx.Clear;
begin
  inherited;
  FObjects.Clear;
end;

procedure TStrListEx.Delete(Idx: integer);
begin
  inherited;
  if FObjects.fCount > Idx then // mdw: '>=' -> '>'
    FObjects.Delete( Idx );
end;

procedure TStrListEx.DeleteLast;
var C: Integer;
begin
  C := fCount;
  if C <= 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  inherited;
  if  FObjects.fCount >= C then FObjects.Delete( C );
end;


function TStrListEx.LastObj: DWORD;
begin
  if Count = 0 then
    Result := 0
  else
    Result := Objects[ Count - 1 ];
end;

function TStrListEx.AddObject(const S: AnsiString; Obj: DWORD): Integer;
begin
  Result := Count;
  InsertObject( Count, S, Obj );
end;

procedure TStrListEx.InsertObject(Before: Integer; const S: AnsiString; Obj: DWORD);
begin
  Insert( Before, S );
  ProvideObjCapacity( Before );
  FObjects.Insert( Before, Pointer( Obj ) );
end;

function TStrListEx.IndexOfObj( Obj: Pointer ): Integer;
begin
  Result := FObjects.IndexOf( Obj );
end;

function WStrLen( W: PWideChar ): Integer;
asm
         XCHG     EDI, EAX
         XCHG     EDX, EAX
         OR       ECX, -1
         XOR      EAX, EAX
         CMP      EAX, EDI
         JE       @@exit0
         REPNE    SCASW
         DEC      EAX
         DEC      EAX
         SUB      EAX, ECX
@@exit0:
         MOV      EDI, EDX
end;

procedure TStrListEx.OptimizeForRead;
begin
    {$IFDEF TLIST_FAST}
    if  fList <> nil then
        fList.OptimizeForRead;
    if  FObjects <> nil then
        FObjects.OptimizeForRead;
    {$ENDIF}
end;

{$IFDEF _D3orHigher}
function UTF8_2KOLWideString( const s: AnsiString ): KOLWideString;
var Buffer: PWideChar;
    L: Integer;
begin
  L := Length( s ) + 1;
  GetMem( Buffer, L * 2 );
  MultiByteToWideChar( CP_UTF8, 0, PAnsiChar( s ), L-1,
    Buffer, L );
  Result := Buffer;
  FreeMem( Buffer );
end;
{$ENDIF _D3orHigher}

{------------------------------------------------------------------------------)
|                                                                              |
|                         T W S t r L i s t                                    |
|                                                                              |
(------------------------------------------------------------------------------}

{$IFDEF WIN_GDI}
{$IFNDEF _D2}

function NewWStrList: PWStrList;
begin
  new( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TWStrList';
  {$ENDIF}
end;

{ TWStrList }

function TWStrList.Add(const W: KOLWideString): Integer;
begin
  Result := Count;
  Insert( Result, W );
end;

procedure TWStrList.AddWStrings(WL: PWStrList);
begin
  Text := Text + WL.Text;
end;

function TWStrList.AppendToFile(const Filename: KOLString): Boolean;
var Strm: PStream;
begin
  Strm := NewReadWriteFileStream( Filename );
  Result := Strm.Handle <> INVALID_HANDLE_VALUE;
  if Result then
  begin
    Strm.Position := Strm.Size;
    SaveToStream( Strm );
  end;
  Strm.Free;
end;

procedure TWStrList.Assign(WL: PWStrList);
begin
  Text := WL.Text;
end;

procedure TWStrList.Clear;
var I: Integer;
    P: Pointer;
begin
  for I := 0 to Count-1 do
  begin
    P := fList.Items[ I ];
    if P <> nil then
    if not( (P >= fText) and (P <= fText + fTextBufSz) ) then
      FreeMem( P );
  end;
  if fText <> nil then
    FreeMem( fText );
  fText := nil;
  fTextBufSz := 0;
  fList.Clear;
end;

procedure TWStrList.Delete(Idx: Integer);
var P: Pointer;
begin
  P := fList.Items[ Idx ];
  if P <> nil then
  if not( (P >= fText) and (P <= fText + fTextBufSz) ) then
    FreeMem( P );
  fList.Delete( Idx );
end;

destructor TWStrList.Destroy;
begin
  Clear;
  fList.Free;
  inherited;
end;

function TWStrList.GetCount: Integer;
begin
  Result := fList.Count;
end;

function TWStrList.GetItems(Idx: Integer): KOLWideString;
begin
  Result := PWideChar( fList.Items[ Idx ] );
end;

function TWStrList.GetPtrs(Idx: Integer): PWideChar;
begin
  Result := fList.Items[ Idx ];
end;

function TWStrList.GetText: KOLWideString;
const
  EoL: Array[ 0..5 ] of AnsiChar = ( #13, #0, #10, #0, #0, #0 ); // KOL_ANSI
var
  L, I: Integer;
  P, Dest: Pointer;
begin
  L := 0;
  for I := 0 to Count-1 do
  begin
    P := fList.Items[ I ];
    if P <> nil then
      L := L + WStrLen( P ) + 2
    else
      L := L + 2;
  end;
  SetLength( Result, L );
  Dest := PWideChar( Result );
  for I := 0 to Count-1 do
  begin
    P := fList.Items[ I ];
    if P <> nil then
    begin
      WStrCopy( Dest, P );
      Dest := Pointer( Integer( Dest ) + WStrLen( P ) * 2 );
    end;
    WStrCopy( Dest, Pointer( @ EoL[ 0 ] ) );
    Dest := Pointer( Integer( Dest ) + 4 );
  end;
end;

procedure TWStrList.Init;
begin
  fList := NewList;
  fNameDelim := WideChar( DefaultNameDelimiter );
end;

procedure TWStrList.Insert(Idx: Integer; const W: KOLWideString);
var P: Pointer;
begin
  while Idx > Count do // by Misha Shar. a.k.a. kreit
    fList.Add( nil );
  GetMem( P, (Length( W ) + 1) * Sizeof(WideChar) );
  fList.Insert( Idx, P );
  WStrCopy( P, PWideChar( W ) );
end;

function TWStrList.LoadFromFile(const Filename: KOLString): Boolean;
begin
  Clear;
  Result := MergeFromFile( Filename );
end;

procedure TWStrList.LoadFromStream(Strm: PStream; AppendToList: Boolean);
begin
  if  not AppendToList then Clear;
  MergeFromStream( Strm );
end;

const
  BOM : WideChar = #$FEFF;

function TWStrList.MergeFromFile(const Filename: KOLString): Boolean;
var Strm: PStream;
    DBOM: WideChar;
begin
  Strm := NewReadFileStream( Filename );
  Result := Strm.Handle <> INVALID_HANDLE_VALUE;
  if Result then
  begin
    Strm.Read(DBOM, SizeOf(DBOM));
    if DBOM<>BOM then Strm.Position := 0;
    MergeFromStream( Strm );
  end;
  Strm.Free;
end;

procedure TWStrList.MergeFromStream(Strm: PStream);
var Buf: KOLWideString;
    L: Integer;
begin
  L := Strm.Size - Strm.Position;
  {$IFDEF KOL_ASSERTIONS}
  Assert( L mod 1 = 0, 'Wide strings streams must be of even length in bytes.' );
  {$ENDIF KOL_ASSERTIONS}
  if L = 0 then Exit;
  SetLength( Buf, L div 2 );
  Strm.Read( Buf[ 1 ], L );
  Text := Text + Buf;
end;

procedure TWStrList.Move(IdxOld, IdxNew: Integer);
begin
  fList.MoveItem( IdxOld, IdxNew );
end;

procedure TWStrList.Put(Idx: integer; const Value: KOLWideString);
begin
  Delete( Idx );
  Insert( Idx, Value );
end;

function TWStrList.SaveToFile(const Filename: KOLString): Boolean;
var Strm: PStream;
    DBOM: WideChar;
begin
  Strm := NewWriteFileStream( Filename );
  Result := Strm.Handle <> INVALID_HANDLE_VALUE;
  if Result then
  begin
    DBOM := BOM;
    Strm.Write(DBOM, SizeOf(DBOM));
    SaveToStream( Strm );
  end;
  Strm.Free;
end;

procedure TWStrList.SaveToStream(Strm: PStream);
var Buf, Dest: PWideChar;
    I, L, Sz: Integer;
    P: Pointer;
begin
  Sz := 0;
  for I := 0 to Count-1 do
  begin
    P := fList.Items[ I ];
    if P <> nil then
      Sz := Sz + WStrLen( P ) * 2 + 4
    else
      Sz := Sz + 4;
  end;
  GetMem( Buf, Sz );
  Dest := Buf;
  for I := 0 to Count-1 do
  begin
    P := fList.Items[ I ];
    if P <> nil then
    begin
      L := WStrLen( P );
      System.Move( P^, Dest^, L * 2 );
      Inc( Dest, L );
    end;
    Dest^ := #13;
    Inc( Dest );
    Dest^ := #10;
    Inc( Dest );
  end;
  Strm.Write( Buf^, Sz );
  FreeMem( Buf );
end;

procedure TWStrList.SetItems(Idx: Integer; const Value: KOLWideString);
var P: Pointer;
begin
  while Idx > Count-1 do
    fList.Add( nil );
  if WStrLen( ItemPtrs[ Idx ] ) > Length( Value ) then // fixed by kreit
    WStrCopy( ItemPtrs[ Idx ], PWideChar( Value ) )
  else
  begin
    P := fList.Items[ Idx ];
    if P <> nil then
    if not ((P >= fText) and (P <= fText + fTextBufSz)) then
      FreeMem( P );
    GetMem( P, (Length( Value ) + 1) * Sizeof(WideChar) );
    fList.Items[ Idx ] := P;
    WStrCopy( P, PWideChar( Value ) );
  end;
end;

procedure TWStrList.SetText(const Value: KOLWideString);
var L, N: Integer;
    P: PWideChar;
begin
  Clear;
  if Value = '' then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  L := (Length( Value ) + 1) * Sizeof( WideChar );
  GetMem( fText, L );
  System.Move( Value[ 1 ], fText^, L );
  fTextBufSz := Length( Value );
  fText[ fTextBufSz ] := #0;
  N := 0;
  P := fText;
  while Word( P^ ) <> 0 do
  begin
    if (Word( P^ ) = 13) then
    begin
      Inc( N );
      PWord( P )^ := 0;
      if Word( P[ 1 ] ) = 10 then
      begin
        Inc( P );
        //PWord( P )^ := 0;
      end;
    end
      else
    if (Word( P^ ) = 10) and ((P = fText) or (Word( P[ -1 ] ) <> 0)) then
    begin
      Inc( N );
      PWord( P )^ := 0;
    end;
    Inc( P );
  end;
  fList.Capacity := N;
  P := fText;
  while P < fText + fTextBufSz do
  begin
    fList.Add( P );
    while Word( P^ ) <> 0 do Inc( P );
    Inc( P );
    if Word( P^ ) = 10 then Inc( P );
  end;
end;

function CompareWStrListItems( const Sender: Pointer; const Idx1, Idx2: DWORD ): Integer;
var WL: PWStrList;
begin
  WL := Sender;
  Result := WStrCmp( WL.fList.Items[ Idx1 ], WL.fList.Items[ Idx2 ] );
end;

function CompareWStrListItems_UpperCase( const Sender: Pointer; const Idx1, Idx2: DWORD ): Integer;
var WL: PWStrList;
    L1, L2, tL1, tL2: Integer;
begin
  WL := Sender;
  L1 := WStrLen( WL.fList.Items[ Idx1 ] );
  L2 := WStrLen( WL.fList.Items[ Idx2 ] );
  tL1 := Length( WL.fTmp1 );
  if tL1 <= L1 then
    SetLength( WL.fTmp1, L1 + 1 );
  tL2 := Length( WL.fTmp2 );
  if tL2 <= L2 then
    SetLength( WL.fTmp2, L2 + 1 );
  if L1 > 0 then
    Move( WL.fList.Items[ Idx1 ]^, WL.fTmp1[ 1 ], (L1 + 1) * 2 )
  else
    WL.fTmp1[ 1 ] := #0;
  if L2 > 0 then
    Move( WL.fList.Items[ Idx2 ]^, WL.fTmp2[ 1 ], (L2 + 1) * 2 )
  else
    WL.fTmp2[ 1 ] := #0;
  CharUpperBuffW( PWideChar( WL.fTmp1 ), L1 );
  CharUpperBuffW( PWideChar( WL.fTmp2 ), L2 );
  Result := WStrCmp( PWideChar( WL.fTmp1 ), PWideChar( WL.fTmp2 ) );
end;

procedure SwapWStrListItems( const Sender: Pointer; const Idx1, Idx2: DWORD );
var WL: PWStrList;
begin
  WL := Sender;
  WL.Swap( Idx1, Idx2 );
end;

procedure TWStrList.Sort( CaseSensitive: Boolean );
begin
  if CaseSensitive then
    SortData( @ Self, Count, @CompareWStrListItems, @SwapWStrListItems )
  else
  begin
    SortData( @ Self, Count, @CompareWStrListItems_UpperCase, @SwapWStrListItems );
    fTmp1 := '';
    fTmp2 := '';
  end;
end;

procedure TWStrList.Swap(Idx1, Idx2: Integer);
begin
  fList.Swap( Idx1, Idx2 );
end;

function TWStrList.IndexOf( const s: KOLWideString ): Integer;
var i: Integer;
    p: PWideChar;
begin
  if  s = '' then
  begin
      for i := 0 to fList.fCount-1 do
      begin
          p := ItemPtrs[ i ];
          if (p = nil) or
             (p^ = #0) then
          begin
              Result := i; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          end;
      end;
  end
    else
  begin
      for i := 0 to Count-1 do
      begin
        p := ItemPtrs[ i ];
        if (p <> nil) and
           (WStrCmp( PWideChar( s ), p ) = 0) then
        begin
          Result := i; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
      end;
  end;
  Result := -1;
end;

function TWStrList.IndexOf_NoCase( const s: KOLWideString ): Integer;
var i: Integer;
    p: PWideChar;
begin
  if  s = '' then
  begin
      for i := 0 to fList.fCount-1 do
      begin
          p := ItemPtrs[ i ];
          if (p = nil) or
             (p^ = #0) then
          begin
              Result := i; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          end;
      end;
  end
    else
  begin
      for i := 0 to Count-1 do
      begin
        p := ItemPtrs[ i ];
        if (p <> nil) and
           (WStrCmp_NoCase( PWideChar( s ), p ) = 0) then
        begin
          Result := i; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
      end;
  end;
  Result := -1;
end;

function TWStrList.Last: KOLWideString;
begin
  if Count <= 0 then Result := ''
  else Result := Items[ Count-1 ];
end;

function NewWStrListEx: PWStrListEx;
begin
  new( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TWStrListEx';
  {$ENDIF}
end;

function TWStrList.GetLineName(Idx: Integer): KOLWideString;
var s: KOLWideString;
    Q: PWideChar;
begin
  s := ItemPtrs[ Idx ];
  Q := WStrScan( PWideChar(s), fNameDelim );
  Q^ := #0;
  Result := PWideChar(s);
end;

function TWStrList.GetLineValue(Idx: Integer): KOLWideString;
var Q: PWideChar;
begin
  Q := ItemPtrs[ Idx ];
  Q := WStrScan( Q, fNameDelim );
  if  Q <> nil then
      inc( Q );
  Result := Q;
end;

procedure TWStrList.SetLineName(Idx: Integer; const NV: KOLWideString);
var del: KOLWideString;
begin
  del := fNameDelim;
  Items[ Idx ] := NV + del + LineValue[ Idx ];
end;

procedure TWStrList.SetLineValue(Idx: Integer; const Value: KOLWideString);
var del: KOLWideString;
begin
  del := fNameDelim;
  Items[ Idx ] := LineName[ Idx ] + del + Value;
end;

procedure TWStrList.OptimizeForRead;
begin
    {$IFDEF TLIST_FAST}
    if  fList <> nil then
        fList.OptimizeForRead;
    {$ENDIF}
end;

function TWStrList.IndexOfName(AName: KOLWideString): Integer;
var i: Integer;
   L: Integer;
   fCount: integer;
begin
   Result:=-1;
   L := Length( AName );
   if L > 0 then
   begin
     AName := WLowerCase( AName ) + fNameDelim;
     Inc( L );
     fCount := GetCount - 1;
     for i := 0 to fCount do
     begin
       if _WStrLComp( PWideChar( WLowerCase( ItemPtrs[ i ] ) ), PWideChar( AName ), L ) = 0 then
       begin
         Result:=i; exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
       end;
     end;
   end;
end;

procedure TWStrList.SetValue(const AName, Value: KOLWideString);
var
 I: Integer;
begin
 I := IndexOfName(AName);
 if i=-1
 then Add( AName + fNameDelim + Value )
 else Items[i] := AName + fNameDelim + Value;
end;

function TWStrList.GetValue(const AName: KOLWideString): KOLWideString;
var
 i: Integer;
begin
 I := IndexOfName(AName);
 if I >= 0
 then Result := Copy(Items[i], Length(AName) + 2, Length(Items[i])-Length(AName)-1)
 else Result := '';
end;

{ TWStrListEx }

function TWStrListEx.AddObject(const S: KOLWideString; Obj: DWORD): Integer;
begin
  Result := Count;
  InsertObject( Count, S, Obj );
end;

procedure TWStrListEx.AddWStrings(WL: PWStrListEx);
var I: Integer;
begin
  {$IFDEF TLIST_FAST}
  {$ELSE}
  I := Count;
  {$ENDIF}
  if WL.FObjects.Count > 0 then
    ProvideObjectsCapacity( Count );
  inherited AddWStrings( WL );
  if WL.FObjects.Count > 0 then
  begin
    {$IFDEF TLIST_FAST}
    for I := 0 to WL.FObjects.Count-1 do
      FObjects.Add(  WL.fObjects.Items[ I ] );
    {$ELSE}
    ProvideObjectsCapacity( I + WL.FObjects.Count );
    System.Move( WL.FObjects.FItems[ 0 ],
                 FObjects.FItems[ I ],
                 Sizeof( Pointer ) * WL.FObjects.Count );
    {$ENDIF}
  end;
end;

procedure TWStrListEx.Assign(WL: PWStrListEx);
begin
  inherited Assign( WL );
  FObjects.Assign( WL.FObjects );
end;

procedure TWStrListEx.Clear;
begin
  inherited Clear;
  FObjects.Clear;
end;

procedure TWStrListEx.Delete(Idx: Integer);
begin
  inherited Delete( Idx );
  if FObjects.FCount >= Idx then
    FObjects.Delete( Idx );
end;

destructor TWStrListEx.Destroy;
begin
  fObjects.Free;
  inherited;
end;

function TWStrListEx.GetObjects(Idx: Integer): DWORD;
begin
  Result := DWORD( fObjects.Items[ Idx ] );
end;

function TWStrListEx.IndexOfObj(Obj: Pointer): Integer;
begin
  Result := FObjects.IndexOf( Obj );
end;

procedure TWStrListEx.Init;
begin
  inherited;
  fObjects := NewList;
end;

procedure TWStrListEx.InsertObject(Before: Integer; const S: KOLWideString;
  Obj: DWORD);
begin
  Insert( Before, S );
  FObjects.Insert( Before, Pointer( Obj ) );
end;

procedure TWStrListEx.Move(IdxOld, IdxNew: Integer);
begin
  fList.MoveItem( IdxOld, IdxNew );
  if FObjects.FCount >= Min( IdxOld, IdxNew ) then
  begin
    ProvideObjectsCapacity( Max( IdxOld, IdxNew ) + 1 );
    FObjects.MoveItem( IdxOld, IdxNew );
  end;
end;

procedure SwapWStrListExItems( const Sender: Pointer; const Idx1, Idx2: DWORD );
var WL: PWStrListEx;
begin
  WL := Sender;
  WL.Swap( Idx1, Idx2 );
end;

procedure TWStrListEx.Sort(CaseSensitive: Boolean);
begin
  if CaseSensitive then
    SortData( @ Self, Count, @CompareWStrListItems, @SwapWStrListExItems )
  else
  begin
    SortData( @ Self, Count, @CompareWStrListItems_UpperCase, @SwapWStrListExItems );
    fTmp1 := '';
    fTmp2 := '';
  end;
end;

procedure TWStrListEx.Swap(Idx1, Idx2: Integer);
begin
  inherited Swap( Idx1, Idx2 );
  if FObjects.fCount >= Min( Idx1, Idx2 ) then
  begin
    ProvideObjectsCapacity( max( Idx1, Idx2 ) + 1 );
    FObjects.Swap( Idx1, Idx2 );
  end;
end;

procedure TWStrListEx.OptimizeForRead;
begin
    {$IFDEF TLIST_FAST}
    if  fList <> nil then
        fList.OptimizeForRead;
    if  FObjects <> nil then
        FObjects.OptimizeForRead;
    {$ENDIF}
end;

procedure TWStrListEx.ProvideObjectsCapacity(NewCap: Integer);
begin
  if fObjects.Capacity >= NewCap then Exit;
  fObjects.Capacity := NewCap;
  {$IFDEF TLIST_FAST}
  {$ELSE}
  ZeroMemory( @FObjects.FItems[ FObjects.Count ],
              (FObjects.Capacity - FObjects.Count) * Sizeof( Pointer ) );
  FObjects.FCount := NewCap;
  {$ENDIF}
end;

procedure TWStrListEx.SetObjects(Idx: Integer; const Value: DWORD);
begin
  ProvideObjectsCapacity( Idx + 1 );
  fObjects.Items[ Idx ] := Pointer( Value );
end;

{$ENDIF}
{$ENDIF WIN_GDI}

function NewKOLStrList: PKOLStrList;
begin
  new( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TKOLStrList';
  {$ENDIF}
end;

function NewKOLStrListEx: PKOLStrListEx;
begin
  new( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TKOLStrListEx';
  {$ENDIF}
end;

//////////////////////////////////////////////////////////////////////////
//                            S  O  R  T  I  N  G
//////////////////////////////////////////////////////////////////////////

{ -- qsort -- }
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure SortData( const Data: Pointer; const uNElem: Dword;
                    const CompareFun: TCompareEvent;
                    const SwapProc: TSwapEvent );
{ uNElem - number of elements to sort }

  function Compare( const e1, e2 : DWord ) : Integer;
  begin
    Result := CompareFun( Data, e1 - 1, e2 - 1 );
  end;

  procedure Swap( const e1, e2 : DWord );
  begin
    SwapProc( Data, e1 - 1, e2 - 1 );
  end;

  procedure qSortHelp(pivotP: Dword; nElem: Dword);
  label
    TailRecursion,
    qBreak;
  var
    leftP, rightP, pivotEnd, pivotTemp, leftTemp: Dword;
    lNum: Dword;
    retval: integer;
  begin
    TailRecursion:
      if (nElem <= 2) then
      begin
        if (nElem = 2) then
          begin
            rightP := pivotP +1;
            retval := Compare(pivotP,rightP);
            if (retval > 0) then Swap(pivotP,rightP);
          end;
        exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      rightP := (nElem -1) + pivotP;
      leftP :=  (nElem shr 1) + pivotP;
      { sort pivot, left, and right elements for "median of 3" }
      retval := Compare(leftP,rightP);
      if (retval > 0) then Swap(leftP, rightP);
      retval := Compare(leftP,pivotP);

      if (retval > 0) then
        Swap(leftP, pivotP)
      else
      begin
        retval := Compare(pivotP,rightP);
        if retval > 0 then Swap(pivotP, rightP);
      end;
      if (nElem = 3) then
      begin
        Swap(pivotP, leftP); exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      { now for the classic Horae algorithm }
      pivotEnd := pivotP + 1;
      leftP := pivotEnd;
      repeat

        retval := Compare(leftP, pivotP);
        while (retval <= 0) do
          begin

            if (retval = 0) then
              begin
                Swap(leftP, pivotEnd);
                Inc(pivotEnd);
              end;
            if (leftP < rightP) then
              Inc(leftP)
            else
              goto qBreak;
            retval := Compare(leftP, pivotP);
          end; {while}
        while (leftP < rightP) do
          begin
            retval := Compare(pivotP, rightP);
            if (retval < 0) then
              Dec(rightP)

            else
              begin
                Swap(leftP, rightP);
                if (retval <> 0) then
                  begin
                    Inc(leftP);
                    Dec(rightP);
                  end;
                break;
              end;
          end; {while}

      until (leftP >= rightP);
    qBreak:
      retval := Compare(leftP,pivotP);
      if (retval <= 0) then Inc(leftP);

      leftTemp := leftP -1;
      pivotTemp := pivotP;
      while ((pivotTemp < pivotEnd) and (leftTemp >= pivotEnd)) do
      begin
        Swap(pivotTemp, leftTemp);
        Inc(pivotTemp);
        Dec(leftTemp);
      end; {while}
      lNum := (leftP - pivotEnd);
      nElem := ((nElem + pivotP) -leftP);

      if (nElem < lNum) then
      begin
        qSortHelp(leftP, nElem);
        nElem := lNum;
      end
        else
      begin
        qSortHelp(pivotP, lNum);
        pivotP := leftP;
      end;
      goto TailRecursion;
    end; {qSortHelp }

begin
  if (uNElem < 2) then  exit; { nothing to sort } {>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  qSortHelp(1, uNElem);
end;
{$ENDIF PAS_VERSION}

{$IFDEF _D3orHigher}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
procedure SortArray( const Data: Pointer; const uNElem: Dword;
                     const CompareFun: TCompareArrayEvent );
{ uNElem - number of elements to sort }
type TDWORDArray = array[0..0] of Integer;
     PDWORDArray = ^TDWORDArray;
var DataArray: PDWORDArray;

  procedure SwapIdx( const e1, e2 : DWord );
  begin
    Swap( DataArray[e1], DataArray[e2] );
  end;

  procedure qSortArrayHelp(pivotP: Dword; nElem: Dword);
  label
    TailRecursion,
    qBreak;
  var
    leftP, rightP, pivotEnd, pivotTemp, leftTemp: Dword;
    lNum: Dword;
    retval: integer;
  begin
    TailRecursion:
      if (nElem <= 2) then
      begin
        if (nElem = 2) then
          begin
            rightP := pivotP +1;
            retval := CompareFun(DataArray[pivotP],DataArray[rightP]);
            if (retval > 0) then SwapIdx(pivotP,rightP);
          end;
        exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      rightP := (nElem -1) + pivotP;
      leftP :=  (nElem shr 1) + pivotP;
      { sort pivot, left, and right elements for "median of 3" }
      retval := CompareFun(DataArray[leftP],DataArray[rightP]);
      if (retval > 0) then SwapIdx(leftP, rightP);
      retval := CompareFun(DataArray[leftP],DataArray[pivotP]);

      if (retval > 0) then
        SwapIdx(leftP, pivotP)
      else
      begin
        retval := CompareFun(DataArray[pivotP],DataArray[rightP]);
        if retval > 0 then SwapIdx(pivotP, rightP);
      end;
      if (nElem = 3) then
      begin
        SwapIdx(pivotP, leftP); exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      { now for the classic Horae algorithm }
      pivotEnd := pivotP + 1;
      leftP := pivotEnd;
      repeat

        retval := CompareFun(DataArray[leftP], DataArray[pivotP]);
        while (retval <= 0) do
          begin

            if (retval = 0) then
              begin
                SwapIdx(leftP, pivotEnd);
                Inc(pivotEnd);
              end;
            if (leftP < rightP) then
              Inc(leftP)
            else
              goto qBreak;
            retval := CompareFun(DataArray[leftP], DataArray[pivotP]);
          end; {while}
        while (leftP < rightP) do
          begin
            retval := CompareFun(DataArray[pivotP], DataArray[rightP]);
            if (retval < 0) then
              Dec(rightP)

            else
              begin
                SwapIdx(leftP, rightP);
                if (retval <> 0) then
                  begin
                    Inc(leftP);
                    Dec(rightP);
                  end;
                break;
              end;
          end; {while}

      until (leftP >= rightP);
    qBreak:
      retval := CompareFun( DataArray[leftP], DataArray[pivotP] );
      if (retval <= 0) then Inc(leftP);

      leftTemp := leftP -1;
      pivotTemp := pivotP;
      while ((pivotTemp < pivotEnd) and (leftTemp >= pivotEnd)) do
      begin
        SwapIdx(pivotTemp, leftTemp);
        Inc(pivotTemp);
        Dec(leftTemp);
      end; {while}
      lNum := (leftP - pivotEnd);
      nElem := ((nElem + pivotP) -leftP);

      if (nElem < lNum) then
      begin
        qSortArrayHelp(leftP, nElem);
        nElem := lNum;
      end
        else
      begin
        qSortArrayHelp(pivotP, lNum);
        pivotP := leftP;
      end;
      goto TailRecursion;
    end; {qSortHelp }

begin
  DataArray := Pointer( Integer( Data ) - Sizeof( DWORD ) );
  if (uNElem < 2) then  exit; { nothing to sort } {>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  qSortArrayHelp(1, uNElem);
end;
{$ENDIF PAS_VERSION}
{$ENDIF _D3orHigher}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function CompareIntegers( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
var I1, I2 : Integer;
begin
  I1 := PInteger( DWORD( Sender ) + e1 * Sizeof( Integer ) )^;
  I2 := PInteger( DWORD( Sender ) + e2 * Sizeof( Integer ) )^;
  Result := 0;
  if I1 < I2 then Result := -1
  else
  if I1 > I2 then Result := 1;
end;
{$ENDIF PAS_VERSION}

function Compare2Integers( e1, e2: Integer ) : Integer;
begin
    Result := e1-e2;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function CompareDwords( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
var I1, I2 : DWord;
begin
  I1 := PDWORD( DWORD( Sender ) + e1 * Sizeof( Integer ) )^;
  I2 := PDWORD( DWORD( Sender ) + e2 * Sizeof( Integer ) )^;
  Result := 0;
  if I1 < I2 then Result := -1
  else
  if I1 > I2 then Result := 1;
end;
{$ENDIF PAS_VERSION}

function Compare2Dwords( e1, e2 : DWORD ) : Integer; forward;
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
function Compare2Dwords( e1, e2 : DWORD ) : Integer;
begin
    if  e1 < e2 then
        Result := -1
    else
    if  e1 > e2 then
        Result := 1
    else
        Result := 0;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure SwapIntegers( const Sender : Pointer; const e1, e2 : DWORD );
var Tmp : Integer;
begin
  Tmp := PInteger( DWORD( Sender ) + e1 * SizeOf( Integer ) )^;
  PInteger( DWORD( Sender ) + e1 * Sizeof( Integer ) )^ :=
  PInteger( DWORD( Sender ) + e2 * Sizeof( Integer ) )^;
  PInteger( DWORD( Sender ) + e2 * Sizeof( Integer ) )^ := Tmp;
end;
{$ENDIF PAS_VERSION}

procedure SortIntegerArray( var A : array of Integer );
begin
  {$IFDEF SPEED_FASTER}
  SortArray( @A[ 0 ], High(A)-Low(A)+1, @Compare2Integers );
  {$ELSE}
  SortData( @A[ 0 ], High(A)-Low(A)+1, @CompareIntegers, @SwapIntegers );
  {$ENDIF}
end;

procedure SwapListItems( const L: Pointer; const e1, e2: DWORD );
begin
  PList( L ).Swap( e1, e2 );
end;

procedure SortDwordArray( var A : array of DWORD );
begin
  {$IFDEF SPEED_FASTER}
  SortArray( @A[ 0 ], High(A)-Low(A)+1, @Compare2DWORDS );
  {$ELSE}
  SortData( @A[ 0 ], High(A)-Low(A)+1, @CompareDwords, @SwapIntegers );
  {$ENDIF}
end;
{$IFDEF WIN_GDI}

{ -- status bar implementation -- }

function _NewStatusbar( AParent: PControl ): PControl; forward;
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function _NewStatusbar( AParent: PControl ): PControl;
var Style: DWORD;
begin
  Style := WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or 3 or WS_VISIBLE;
  if  {$IFDEF USE_FLAGS} G3_SizeGrip in AParent.fFlagsG3
      {$ELSE} AParent.fSizeGrip {$ENDIF} then
      Style := (Style or SBARS_SIZEGRIP) and not 3;
  Result := _NewCommonControl( AParent, STATUSCLASSNAME,
            Style, FALSE,
            {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS )
            {$ELSE} nil {$ENDIF} );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:StatusBar';
  {$ENDIF}
  with Result.fBoundsRect do
  begin
    Left := 0;
    Right := 0;
    Top := 0;
    Bottom := 0;
  end;
  Result.fAlign := caBottom;
  {$IFDEF USE_FLAGS} include( Result.fFlagsG4, G4_NotUseAlign );
  {$ELSE} Result.fNotUseAlign := True; {$ENDIF}
  {$IFDEF TEST_VERSION}
  Result.fTag := DWORD( PAnsiChar( 'Status bar' ) );
  {$ENDIF}
  InitCommonControlSizeNotify( Result );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetStatusText(Index: Integer; const Value: KOLString);
var ch: Integer;
    R : TRect;
    N, I, L, W : Integer;
    WidthsBuf: array[ 0..254 ] of Integer;
    Val: Integer;
begin
  if fStatusCtl = nil then
  begin
    ch := GetClientHeight;
    fStatusCtl := _NewStatusBar( @Self );
    fStatusCtl.Perform( SB_SIMPLE, Integer( LongBool( Index = 255 ) ), 0 );
    GetWindowRect( {fStatusWnd}fStatusCtl.fHandle, R );
    fClientBottom := R.Bottom - R.Top;
    SetClientHeight( ch );
    fStatusCtl.Perform( WM_SIZE, 0, 0 );
  end;
  if Index < 255 then
  begin
    N := fStatusCtl.Perform( SB_GETPARTS, 0, 0 );
    if N <= Index then
    begin
      W := Width;
      L := W div (Index + 1);
      W := L;
      for I := 0 to Index - 1 do
      begin
        WidthsBuf[ I ] := W;
        Inc( W, L );
      end;
      WidthsBuf[ Index ] := -1;
      fStatusCtl.Perform( SB_SETPARTS, Index + 1, Integer( @WidthsBuf[ 0 ] ) );
    end;
    fStatusCtl.Perform( SB_SIMPLE, 0, 0 );
  end;
  Val := 0;
  if  Value <> '' then
      Val := Integer( @ Value[1] );
  fStatusCtl.Perform(
    {$IFDEF UNICODE_CTRLS} SB_SETTEXTW {$ELSE} SB_SETTEXT {$ENDIF}, Index, Val );
end;
{$ENDIF PAS_VERSION}

{$IFDEF noASM_UNICODE}
function TControl.GetStatusText( Index: Integer ): KOLString;
asm
        MOV      ECX, [EAX].fStatusCtl
        JECXZ    @@exit
          PUSH     EBX
          PUSH     ESI
          XCHG     ESI, EAX // ESI = @Self
          MOV      EBX, EDX // EBX = Index
        XOR      EAX, EAX
        XCHG     EAX, [ESI].fStatusTxt
        TEST     EAX, EAX
        JZ       @@1
        CALL     System.@FreeMem
@@1:
        XOR      EAX, EAX
        CDQ
        MOV      DL, WM_GETTEXTLENGTH
          PUSH     WM_GETTEXT
        CMP      EBX, 255
        JZ       @@2
          POP      EAX
        MOV      EAX, EBX
        MOV      DX, SB_GETTEXTLENGTH
          PUSH     SB_GETTEXT
@@2:
        MOV      EBX, EAX
          PUSH     0
          PUSH     EAX
          PUSH     EDX
          PUSH     [ESI].fStatusCtl
          CALL     Perform
          TEST     AX, AX
          JZ       @@get_rslt
        PUSH     EAX
        INC      EAX
        CALL     System.@GetMem
        POP      EDX
        MOV      [ESI].fStatusTxt, EAX
        MOV      byte ptr [EAX+EDX], 0
            POP      EDX // Msg
            PUSH     EAX
            PUSH     EBX
            PUSH     EDX
            PUSH     [ESI].fStatusCtl
            CALL     Perform
          PUSH     EDX
@@get_rslt:
          POP      EDX
        MOV      ECX, [ESI].fStatusTxt
        POP      ESI
        POP      EBX
@@exit: XCHG     EAX, ECX
end;
{$ELSE PAS_VERSION} //Pascal
function TControl.GetStatusText( Index: Integer ): KOLString;
var L, I: Integer;
    Msg: DWORD;
begin
  Result := '';
  if fStatusCtl = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Msg := SB_GETTEXTLENGTH;
  I := Index;
  if Index = 255 then
  begin
     Msg := WM_GETTEXTLENGTH;
     I := 0;
  end;
  L := fStatusCtl.Perform( Msg, I, 0 ) and $FFFF;
  if L > 0 then
  begin
    SetLength( Result, L );
    Msg := {$IFDEF UNICODE_CTRLS} SB_GETTEXTW {$ELSE} SB_GETTEXT {$ENDIF};
    if  Index = 255 then
        Msg := WM_GETTEXT;
    fStatusCtl.Perform( Msg, I, Integer( @ Result[1] ) );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.RemoveStatus;
var ch: Integer;
begin
  if fStatusCtl = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  ch := ClientHeight;
  fStatusCtl.Free;
  fStatusCtl := nil;
  fClientBottom := 0;
  ClientHeight := ch;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.StatusPanelCount: Integer;
begin
  Result := 0;
  if fStatusCtl = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := fStatusCtl.Perform( SB_GETPARTS, 0, 0 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetStatusPanelX(Idx: Integer): Integer;
var Buf: array[0..254] of Integer;
    N : Integer;
begin
  Result := 0;
  if fStatusCtl = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  N := fStatusCtl.Perform( SB_GETPARTS, 255, Integer( @Buf[ 0 ] ) );
  if N <= Idx then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := Buf[ Idx ];
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetStatusPanelX(Idx: Integer; const Value: Integer);
var Buf: array[0..254] of Integer;
    N : Integer;
begin
  if fStatusCtl = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  N := fStatusCtl.Perform( SB_GETPARTS, 255, Integer( @Buf[ 0 ] ) );
  if N <= Idx then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Buf[ Idx ] := Value;
  fStatusCtl.Perform( SB_SETPARTS, N, Integer( @Buf[ 0 ] ) );
end;
{$ENDIF PAS_VERSION}

procedure TControl.SetColor1(const Value: TColor);
begin
  DF.fColor1 := Value;
  Invalidate;
end;

procedure TControl.SetColor2(const Value: TColor);
begin
  DF.fColor2 := Value;
  Invalidate;
end;

procedure TControl.SetGradientLayout(const Value: TGradientLayout);
begin
  DF.fGradientLayout := Value;
  Invalidate;
end;

procedure TControl.SetGradientStyle(const Value: TGradientStyle);
begin
  DF.fGradientStyle := Value;
  Invalidate;
end;

{ -- Image List -- }

{$IFDEF USE_CONSTRUCTORS}
function NewImageList( AOwner: PControl ): PImageList;
begin
  new( Result, CreateImageList( AOwner ) );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TImageList';
  {$ENDIF}
end;
{$ELSE not_USE_CONSTRUCTORS}
function NewImageList( AOwner: PControl ): PImageList;
begin
  {*************} DoInitCommonControls( ICC_WIN95_CLASSES );
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TImageList';
  {$ENDIF}
  Result.FAllocBy := 1;
  Result.FMasked := True;
  Result.fBkColor := clNone;
  //ImageList_SetBkColor( Result.FHandle, CLR_NONE );
  Result.FImgWidth := 32;
  Result.FImgHeight := 32;
  Result.FColors := ilcDefault;

  if AOwner = nil then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result.fNext := PImageList( AOwner.fImageList );
  if AOwner.fImageList <> nil then
     PImageList( AOwner.fImageList ).fPrev := Result;
  Result.FControl := AOwner;
  {$IFDEF USE_AUTOFREE4CONTROLS}
  AOwner.Add2AutoFree( Result );
  {$ENDIF}
  AOwner.fImageList := Result;
end;
{$ENDIF USE_CONSTRUCTORS}

function ImageList_Create; stdcall; external cctrl name 'ImageList_Create';
function ImageList_Destroy; external cctrl name 'ImageList_Destroy';
function ImageList_GetImageCount; external cctrl name 'ImageList_GetImageCount';
function ImageList_SetImageCount; external cctrl name 'ImageList_SetImageCount';
function ImageList_Add; external cctrl name 'ImageList_Add';
function ImageList_ReplaceIcon; external cctrl name 'ImageList_ReplaceIcon';
function ImageList_SetBkColor; external cctrl name 'ImageList_SetBkColor';
function ImageList_GetBkColor; external cctrl name 'ImageList_GetBkColor';
function ImageList_SetOverlayImage; external cctrl name 'ImageList_SetOverlayImage';
function ImageList_Draw; external cctrl name 'ImageList_Draw';
function ImageList_Replace; external cctrl name 'ImageList_Replace';
function ImageList_AddMasked; external cctrl name 'ImageList_AddMasked';
function ImageList_DrawEx; external cctrl name 'ImageList_DrawEx';
function ImageList_Remove; external cctrl name 'ImageList_Remove';
function ImageList_GetIcon; external cctrl name 'ImageList_GetIcon';
{$IFDEF UNICODE_CTRLS}
function ImageList_LoadImage; external cctrl name 'ImageList_LoadImageW';
{$ELSE}
function ImageList_LoadImage; external cctrl name 'ImageList_LoadImageA';
{$ENDIF}
function ImageList_BeginDrag; external cctrl name 'ImageList_BeginDrag';
function ImageList_EndDrag; external cctrl name 'ImageList_EndDrag';
function ImageList_DragEnter; external cctrl name 'ImageList_DragEnter';
function ImageList_DragLeave; external cctrl name 'ImageList_DragLeave';
function ImageList_DragMove; external cctrl name 'ImageList_DragMove';
function ImageList_SetDragCursorImage; external cctrl name 'ImageList_SetDragCursorImage';
function ImageList_DragShowNolock; external cctrl name 'ImageList_DragShowNolock';
function ImageList_GetDragImage; external cctrl name 'ImageList_GetDragImage';
function ImageList_GetIconSize; external cctrl name 'ImageList_GetIconSize';
function ImageList_SetIconSize; external cctrl name 'ImageList_SetIconSize';
function ImageList_GetImageInfo; external cctrl name 'ImageList_GetImageInfo';
function ImageList_Merge; external cctrl name 'ImageList_Merge';

function ImageList_AddIcon(ImageList: HImageList; Icon: HIcon): Integer;
begin
  Result := ImageList_ReplaceIcon(ImageList, -1, Icon);
end;

function Index2OverlayMask(Index: Integer): Integer;
begin
  Result := Index shl 8;
end;

{ macros }
procedure ImageList_RemoveAll(ImageList: HImageList); stdcall;
begin
  ImageList_Remove(ImageList, -1);
end;

function ImageList_ExtractIcon(Instance: THandle; ImageList: HImageList;
  Image: Integer): HIcon; stdcall;
begin
  Result := ImageList_GetIcon(ImageList, Image, 0);
end;

function ImageList_LoadBitmap(Instance: THandle; Bmp: PKOLChar;
  CX, Grow: Integer; Mask: TColorRef): HImageList; stdcall;
begin
  Result := ImageList_LoadImage(Instance, Bmp, CX, Grow, Mask, IMAGE_BITMAP, 0);
end;

procedure FreeBmp( Bmp: HBitmap );
begin
  DeleteObject( Bmp );
end;

function LoadBmp( Instance: Integer; Rsrc: PKOLChar; MasterObj: PObj ): HBitmap;
{$IFDEF LOAD_RLE_BMP_RSRCES}
var B: PBitmap;
    R: PStream;
{$ENDIF}
begin
  {$IFDEF LOAD_RLE_BMP_RSRCES}
  R := NewMemoryStream;
  Resource2Stream( R, hInstance, Rsrc, RT_BITMAP );
  B := NewBitmap( 0, 0 );
  R.Position := 0;
  B.LoadFromStreamEx( R );
  R.Free;
  //B.SaveToFile( GetStartDir + 'test_loadbmp.bmp' );
  Result := B.ReleaseHandle;
  B.Free;
  {$ELSE}
  Result := LoadBitmap( Instance, Rsrc );
  {$ENDIF}
  MasterObj.Add2AutoFreeEx( TObjectMethod( MakeMethod( Pointer( Result ), @ FreeBmp ) ) );
end;

function LoadBmp32( Instance: Integer; Rsrc: PKOLChar; MasterObj: PObj ): HBitmap;
var B: PBitmap;
begin
    B := NewBitmap( 0, 0 );
    B.Handle := LoadBmp( Instance, Rsrc, MasterObj );
    B.PixelFormat := pf32bit;
    Result := B.ReleaseHandle;
    B.Free;
end;

{ TImageList }

function TImageList.Add(Bmp, Msk: HBitmap): Integer;
begin
  Result := -1;
  if not HandleNeeded then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := ImageList_Add( FHandle, Bmp, Msk );
end;

function TImageList.AddIcon(Ico: HIcon): Integer;
{var Bmp : HBitmap;
    DC : HDC;}
begin
  Result := -1;
  if ImgWidth = 0 then
    ImgWidth := 32;
  if ImgHeight = 0 then
    ImgHeight := 32;
  if not HandleNeeded then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := ImageList_AddIcon( fHandle, Ico );
end;

function TImageList.AddMasked(Bmp: HBitmap; Color: TColor): Integer;
{$IFDEF TEST_IL}
var B: PBitmap;
{$ENDIF}
begin
  Result := -1;
  if not HandleNeeded then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$IFDEF TEST_IL}
  B := NewBitmap( 0, 0 );
  B.Handle := Bmp;
  B.PixelFormat := pf32bit;
  B.SaveToFile( GetStartDir + 'test_Add_masked1.bmp' );
  Bmp := B.ReleaseHandle;
  B.Free;
  {$ENDIF}
  Result := ImageList_AddMasked( FHandle, Bmp, Color2RGB( Color ) );
  {$IFDEF TEST_IL}
  B := NewBitmap( 0, 0 );
  B.Handle := GetBitmap;
  B.SaveToFile( GetStartDir + 'test_Add_masked2.bmp' );
  B.ReleaseHandle;
  B.Free;
  B := NewBitmap( 0, 0 );
  B.Handle := GetMask;
  B.SaveToFile( GetStartDir + 'test_Add_masked3.bmp' );
  B.ReleaseHandle;
  B.Free;
  {$ENDIF}
end;

procedure TImageList.Clear;
begin
  Handle := 0;
end;

procedure TImageList.Delete(Idx: Integer);
begin
   if FHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   ImageList_Remove( FHandle, Idx );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TImageList.Destroy;
begin
  Clear;
  if fNext <> nil then
    fNext.fPrev := fPrev;
  if fPrev <> nil then
    fPrev.fNext := fNext;
  if fControl <> nil then
  begin
    if PControl( fControl ).fImageList = @Self then
      PControl( fControl ).fImageList := fNext;
    {$IFDEF USE_AUTOFREE4CONTROLS}
    PControl(fControl).RemoveFromAutoFree( @ Self );
    {$ENDIF}
  end;
  inherited;
end;
{$ENDIF PAS_VERSION}

procedure TImageList.Draw(Idx: Integer; DC: HDC; X, Y: Integer);
begin
  if FHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  ImageList_Draw( FHandle, Idx, DC, X, Y, GetDrawStyle );
end;

function TImageList.ExtractIcon(Idx: Integer): HIcon;
begin
  Result := ImageList_ExtractIcon( 0, FHandle, Idx );
end;

function TImageList.ExtractIconEx(Idx: Integer): HIcon;
begin
  Result := ImageList_GetIcon( FHandle, Idx, GetDrawStyle );
end;

function TImageList.GetBitmap: HBitmap;
var II : TImageInfo;
begin
  Result := 0;
  if FHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if ImageList_GetImageInfo( FHandle, 0, II ) then
     Result := II.hbmImage;
end;

function TImageList.GetBkColor: TColor;
begin
  Result := fBkColor;
  if FHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := ImageList_GetBkColor( FHandle );
end;

function TImageList.GetCount: Integer;
begin
  Result := 0;
  if FHandle <> 0 then
     Result := ImageList_GetImageCount( FHandle );
end;

function TImageList.GetDrawStyle: DWord;
begin
  Result := 0;
  if dsBlend25 in DrawingStyle then
     Result := Result or ILD_BLEND25;
  if dsBlend50 in DrawingStyle then
     Result := Result or ILD_BLEND50;
  if dsTransparent in DrawingStyle then
     Result := Result or ILD_TRANSPARENT
  else
  if dsMask in DrawingStyle then
     Result := Result or ILD_MASK
  {else Result := Result or ILD_NORMAL}; // ILD_NORMAL = 0
  Result := Result or WORD(FOverlayIdx shl 8);
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TImageList.GetHandle: THandle;
begin
  HandleNeeded;
  Result := FHandle;
end;
{$ENDIF PAS_VERSION}

function TImageList.GetMask: HBitmap;
var II : TImageInfo;
begin
  Result := 0;
  if FHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if ImageList_GetImageInfo( FHandle, 0, II ) then
     Result := II.hbmMask;
end;

{$IFDEF ASM_noVERSION}
function TImageList.HandleNeeded: Boolean;
const ColorFlags : array[ TImageListColors ] of Byte = ( ILC_COLOR,
                 ILC_COLOR4, ILC_COLOR8, ILC_COLOR16, ILC_COLOR24,
                 ILC_COLOR32, ILC_COLORDDB );
asm
        MOV      ECX, [EAX].FHandle
        JECXZ    @@make_handle
        MOV      AL, 1
        RET
@@make_handle:
        MOV      ECX, [EAX].fImgWidth
        JECXZ    @@ret_ECX
        MOV      EDX, ECX
        MOV      ECX, [EAX].fImgHeight
        JECXZ    @@ret_ECX
        PUSH     EBX
        XCHG     EBX, EAX

        PUSH     [EBX].FAllocBy
        PUSH     0
        MOVZX    EAX, [EBX].FColors
        MOVZX    EAX, byte ptr [ColorFlags+EAX]
        CMP      [EBX].FMasked, 0
        JZ       @@flags_ready
        {$IFDEF PARANOIA} DB $0C, $01 {$ELSE} OR AL, 1 {$ENDIF}
@@flags_ready:
        PUSH     EAX
        PUSH     ECX
        PUSH     EDX
        CALL     ImageList_Create
        MOV      [EBX].FHandle, EAX
        XCHG     ECX, EAX
        POP      EBX
@@ret_ECX:
        TEST     ECX, ECX
        SETNZ    AL
end;
{$ELSE PAS_VERSION} //Pascal
function TImageList.HandleNeeded: Boolean;
const ColorFlags : array[ TImageListColors ] of Byte = ( ILC_COLOR,
                 ILC_COLOR4, ILC_COLOR8, ILC_COLOR16, ILC_COLOR24,
                 ILC_COLOR32, ILC_COLORDDB, 0 );
var Flags : DWord;
begin
  Result := True;
  if FHandle <> 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := False;
  if ImgWidth = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if ImgHeight = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Flags := ColorFlags[ FColors ];
  if Masked then
     Flags := Flags or ILC_MASK;
  FHandle := ImageList_Create( ImgWidth, ImgHeight, Flags, 0, FAllocBy );
  if fBkColor <> clNone then
    SetBkColor( fBkColor );
  Result := FHandle <> 0;
end;
{$ENDIF PAS_VERSION}

function TImageList.ImgRect(Idx: Integer): TRect;
var II : TImageInfo;
begin
  Result := MakeRect( 0, 0, 0, 0 );
  if FHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if ImageList_GetImageInfo( FHandle, Idx, II ) then
     Result := II.rcImage;
end;

{$IFDEF ASM_noVERSION_UNICODE}
function TImageList.LoadBitmap(ResourceName: PAnsiChar;
  TranspColor: TColor): Boolean;
asm
        PUSH     EBX
        XCHG     EBX, EAX
        XCHG     EAX, ECX //TranspColor
        PUSH     EDX
        CMP      EAX, clNone
        JNE      @@2rgb
        OR       EAX, -1
        JMP      @@tranColorReady
@@2rgb:
        CALL     Color2RGB
@@tranColorReady:
        POP      EDX
        PUSH     EAX
        PUSH     [EBX].fAllocBy
        PUSH     [EBX].fImgWidth
        PUSH     EDX
        PUSH     [hInstance]
        CALL     ImageList_LoadBitmap
        TEST     EAX, EAX
        JZ       @@exit
        XCHG     EDX, EAX
        XCHG     EAX, EBX
        CALL     SetHandle
        MOV      AL, 1
@@exit: POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function TImageList.LoadBitmap(ResourceName: PKOLChar;
  TranspColor: TColor): Boolean;
var NewHandle : THandle;
    TranColr: TColor;
begin
  TranColr := TranspColor;
  if TranColr = clNone then TranColr := TColor( CLR_NONE )
  else TranColr := Color2RGB( TranColr );
  NewHandle := ImageList_LoadBitmap( hInstance, ResourceName,
            ImgWidth, AllocBy, TranColr );
  //ImageList_GetIconSize( NewHandle, fImgWidth, fImgHeight );
  Result := NewHandle <> 0;
  if Result then
     Handle := NewHandle;
  ImageList_GetIconSize( fHandle, FImgWidth, FImgHeight );
end;
{$ENDIF PAS_VERSION}

function TImageList.LoadFromFile(FileName: PKOLChar; TranspColor: TColor;
  ImgType: TImageType): Boolean;
const ImgTypes:array[ TImageType ] of DWord = ( IMAGE_BITMAP, IMAGE_ICON, IMAGE_CURSOR );
var NewHandle : THandle;
    TranspFlag : DWord;
begin
  TranspFlag := 0;
  if TranspColor <> clNone then
     TranspFlag := LR_LOADTRANSPARENT;
  NewHandle := ImageList_LoadImage( hInstance, FileName, ImgWidth, AllocBy,
               Color2RGB( TranspColor ), ImgTypes[ ImgType ],
               LR_LOADFROMFILE or LR_CREATEDIBSECTION or TranspFlag );
  Result := NewHandle <> 0;
  if Result then
     Handle := NewHandle;
end;

function TImageList.LoadSystemIcons(SmallIcons: Boolean): Boolean;
var NewHandle : THandle;
    FileInfo : TSHFileInfo;
    Flags : DWord;
begin
  OleInit;
  Flags := SHGFI_SYSICONINDEX;
  if SmallIcons then
     Flags := Flags or SHGFI_SMALLICON;
  NewHandle := {$IFDEF UNICODE_CTRLS} SHGetFileInfoW {$ELSE} SHGetFileInfoA {$ENDIF}
    ( '', 0, FileInfo, Sizeof( FileInfo ), Flags );
  Result := NewHandle <> 0;
  if Result then
  begin
     Handle := NewHandle;
     FShareImages := True;
  end;
end;

function TImageList.Merge(Idx: Integer; ImgList2: PImageList; Idx2, X,
  Y: Integer): PImageList;
var L : THandle;
begin
  Result := nil;
  L := ImageList_Merge( FHandle, Idx, ImgList2.Handle, Idx2, X, Y );
  if L <> 0 then
  begin
     Result := NewImageList( fControl );
     Result.Handle := L;
  end;
end;

function TImageList.Replace(Idx: Integer; Bmp, Msk: HBitmap): Boolean;
begin
  Result := False;
  if FHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := ImageList_Replace( FHandle, Idx, Bmp, Msk );
end;

function TImageList.ReplaceIcon(Idx: Integer; Ico: HIcon): Boolean;
begin
  Result := False;
  if FHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := ImageList_ReplaceIcon( FHandle, Idx, Ico ) >= 0;
end;

procedure TImageList.SetAllocBy(const Value: Integer);
begin
  if FHandle <> 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  // AllocBy can be changed only before adding images and creating handle
  FAllocBy := Value;
end;

procedure TImageList.SetBkColor(const Value: TColor);
begin
  fBkColor := Value;
  if fHandle <> 0 then
    ImageList_SetBkColor( FHandle, Color2RGB( Value ) );
end;

procedure TImageList.SetColors(const Value: TImageListColors);
begin
  if FHandle <> 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FColors := Value;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TImageList.SetHandle(const Value: THandle);
begin
  if FHandle = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if (FHandle <> 0) and not FShareImages then
     ImageList_Destroy( FHandle );
  FHandle := Value;
  if FHandle <> 0 then
     ImageList_GetIconSize( FHandle, FImgWidth, FImgHeight )
  else
  begin
    FImgWidth := 0;
    FImgHeight := 0;
  end;
end;
{$ENDIF PAS_VERSION}

procedure TImageList.SetImgHeight(const Value: Integer);
begin
  if FHandle <> 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FImgHeight := Value;
end;

procedure TImageList.SetImgWidth(const Value: Integer);
begin
  if FHandle <> 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FImgWidth := Value;
end;

procedure TImageList.SetMasked(const Value: Boolean);
begin
  if FHandle <> 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FMasked := Value;
end;

function TImageList.GetOverlay(Idx: TImgLOVrlayIdx): Integer;
begin
  Result := fOverlay[ Idx ];
end;

procedure TImageList.SetOverlay(Idx: TImgLOVrlayIdx; const Value: Integer);
begin
  if ImageList_SetOverlayImage( fHandle, Value, Idx shl 8 ) then
    fOverlay[ Idx ] := Value;
end;

procedure TImageList.StretchDraw(Idx: Integer; DC: HDC; const Rect: TRect);
begin
  if FHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  ImageList_DrawEx( FHandle, Idx, DC, Rect.Left, Rect.Top,
                    Rect.Right- Rect.Left, Rect.Bottom-Rect.Top,
                    BkColor, BlendColor, GetDrawStyle );
end;

function GetImgListSize( Sender: PControl; Size: Integer ): PImageList;
begin
  if  Size > 16 then
      Result := Sender.DF.fCtlImageListNormal
  else
      Result := Sender.DF.fCtlImageListSml;
  if  Result <> nil then
  begin
    if  Result.fImgWidth = 0 then
        Result.ImgWidth := Size;
    if  Result.fImgHeight = 0 then
        Result.ImgHeight := Size;
  end;
  if  Result = nil then
  begin
      Result := Sender.fImageList;
      while Result <> nil do
      begin
          if  (Result.FImgWidth = Size) and (Result.FImgHeight = Size) then
              break;
          Result := Result.fNext;
      end;
  end;
end;

function TControl.GetImgListIdx(const Index: Integer): PImageList;
begin
  if  Index <> 0 then
      Result := GetImgListSize( @Self, Index )
  else
  begin
      Result := DF.fCtlImgListState;
      if  Result = nil then
      begin
          Result := fImageList;
          while Result <> nil do
          begin
              if  (Result <> GetImgListIdx( 16 )) and (Result <> GetImgListIdx( 32 )) then
                  break;
              Result := Result.fNext;
          end;
      end;
  end;
end;

procedure TControl.SetImgListIdx(const Index: Integer;
  const Value: PImageList);
begin

  if Value <> nil then
  begin
    if Index <> 0 then
    if (Value.ImgWidth = 0) or (Value.ImgHeight = 0) then
    begin
      Value.ImgWidth := Index;
      Value.ImgHeight := Index;
    end;
  end;

  case Index of
  32:  DF.fCtlImageListNormal := Value;
  16:  DF.fCtlImageListSml := Value;
  else DF.fCtlImgListState := Value;
  end;
  ApplyImageLists2Control( @Self );
end;

{ -- list view -- }

function WndProcEndLabelEdit( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var NMhdr: PNMHdr;
    LVDisp: PLVDispInfo;
    Flag: Boolean;
begin
  Result := False;
  if Msg.message = WM_NOTIFY then
  begin
    NMHdr := Pointer( Msg.lParam );
    case NMHdr.code of
      LVN_ENDLABELEDIT:
        begin
          LVDisp := Pointer( Msg.lParam );
          Result := True;
          if LVDisp.item.pszText = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          Rslt := 1;
          {$IFDEF NIL_EVENTS}
          if  assigned( Self_.EV.fOnEndEditLVItem ) then
          {$ENDIF}
          begin
              Flag := Self_.EV.fOnEndEditLVItem( Self_, LVDisp.item.iItem,
                               LVDisp.item.iSubItem, LVDisp.item.pszText );
              if Flag then Rslt := 1
                      else Rslt := 0;
          end;
        end;
    end;
  end;
end;

procedure TControl.SetOnEndEditLVItem(const Value: TOnEditLVItem);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnEndEditLVITem := Value;
  AttachProc( WndProcEndLabelEdit );
end;

procedure TControl.LVColAdd(const aText: KOLString; aalign: TTextAlign;
  aWidth: Integer);
begin
  LVColInsert( DF.fLVColCount, aText, aalign, aWidth );// 21.10.2001
end;

//****************** changed by Mike Gerasimov
procedure TControl.LVColInsert(ColIdx: Integer; const aText: KOLString;
  aAlign: TTextAlign; aWidth: Integer);
var LVColData: TLVColumn;
begin
  LVColData.mask := LVCF_FMT or LVCF_TEXT;
  if  ImageListSmall <> nil then
      LVColData.mask := LVColData.mask; // or LVCF_IMAGE ;
  LVColData.iImage := -1;
  LVColData.fmt := Ord( aAlign );
  if  aWidth < 0 then
  begin
      aWidth := -aWidth;
      LVColData.fmt := LVColData.fmt or LVCFMT_BITMAP_ON_RIGHT;
  end;
  LVColData.cx := aWidth;
  if  aWidth > 0 then
      LVColData.mask := LVColData.mask or LVCF_WIDTH;
  LVColData.pszText := PKOL_Char( aText );
  if  Perform( LVM_INSERTCOLUMN, ColIdx, Integer( @LVColData ) ) >= 0 then
      Inc( DF.fLVColCount );
end;

function TControl.GetLVColText(Idx: Integer): KOLString;
var Buf: array[ 0..4095 ] of KOLChar;
    LC: TLVColumn;
begin
  LC.mask := LVCF_TEXT;
  LC.pszText := @ Buf[ 0 ];
  LC.cchTextMax := 4096;
  Buf[ 0 ] := #0;
  Perform( LVM_GETCOLUMN, Idx, Integer( @ LC ) );
  Result := Buf;
end;

procedure TControl.SetLVColText(Idx: Integer; const Value: KOLString);
var LC: TLVColumn;
begin
  ZeroMemory( @LC, Sizeof( LC ) ); {Alexey (Lecha2002)}
  LC.mask := LVCF_TEXT;
  LC.pszText := '';
  if Value <> '' then
    LC.pszText := @ Value[ 1 ];
  Perform( LVM_SETCOLUMN, Idx, Integer( @ LC ) );
end;

function TControl.GetLVColalign(Idx: Integer): TTextAlign;
const Formats: array[ 0..2 ] of TTextAlign = ( taLeft, taRight, taCenter );
var LC: TLVColumn;
begin
  ZeroMemory( @LC, Sizeof( LC ) ); {Alexey (Lecha2002)}
  LC.mask := LVCF_FMT;
  Perform( LVM_GETCOLUMN, Idx, Integer( @ LC ) );
  Result := Formats[ LC.fmt and LVCFMT_JUSTIFYMASK ];
end;

procedure TControl.SetLVColalign(Idx: Integer; const Value: TTextAlign);
const FormatFlags: array[ TTextAlign ] of BYTE = ( LVCFMT_LEFT, LVCFMT_RIGHT,
      LVCFMT_CENTER );
var LC: TLVColumn;
begin
  ZeroMemory( @LC, Sizeof( LC ) ); {Alexey (Lecha2002)}
  LC.mask := LVCF_FMT;
  Perform( LVM_GETCOLUMN, Idx, Integer( @ LC ) );
  LC.fmt := LC.fmt and not LVCFMT_JUSTIFYMASK or FormatFlags[ Value ];
  Perform( LVM_SETCOLUMN, Idx, Integer( @ LC ) );
end;

function TControl.GetLVColEx(Idx: Integer; const Index: Integer): Integer;
var LC: TLVColumn;
begin
  ZeroMemory( @LC, Sizeof( LC ) ); {Alexey (Lecha2002)}
  LC.mask := LoWord( Index );
  Perform( LVM_GETCOLUMN, Idx, Integer( @ LC ) );
  Result := PDWORD( Integer( @ LC ) + HiWord( Index ) )^;
end;

//********************** changed by Mike Gerasimov
procedure TControl.SetLVColEx(Idx: Integer; const Index: Integer;
  const Value: Integer);
var LC: TLVColumn;
begin
  ZeroMemory(@LC,SizeOf(LC));                                    // Added Line
  LC.mask := LoWord( Index );
  if HiWord( Index ) = 24 then                                  // Added Line
   begin                                                        // Added Line
    LC.mask := LC.mask or LVCF_FMT;                             // Added Line
    if Value <>-1 then                                          // Added Line
      LC.fmt := LC.fmt or LVCFMT_IMAGE or LVCFMT_COL_HAS_IMAGES // Added Line
    else LC.mask := LC.mask and not LVCF_IMAGE; // + by non
   end;
  if (value<>-1)or(HiWord( Index )<>24) then    // + by non
    PDWORD( Integer( @ LC ) + HiWord( Index ) )^ := Value;
  Perform( LVM_SETCOLUMN, Idx, Integer( @ LC ) );
end;

function TControl.LVAdd(const aText: KOLString; ImgIdx: Integer;
  State: TListViewItemState; StateImgIdx, OverlayImgIdx: Integer;
  Data: DWORD): Integer;
begin
  Result := LVInsert( MaxInt {Count}, aText, ImgIdx, State, StateImgIdx, OverlayImgIdx, Data );
end;

function TControl.LVInsert(Idx: Integer; const aText: KOLString;
  ImgIdx: Integer; State: TListViewItemState;  StateImgIdx, OverlayImgIdx: Integer;
  Data: DWORD): Integer;
const
  LVM_REDRAWITEMS         = LVM_FIRST + 21;
var LVI: TLVItem;
begin
  LVI.mask := LVIF_TEXT or LVIF_IMAGE or LVIF_PARAM or LVIF_STATE
              or LVIF_DI_SETITEM;
  LVI.iItem := Idx;
  LVI.iSubItem := 0;
  LVI.state := 0;
  if lvisBlend in State then
     LVI.state := LVIS_CUT;
  if lvisHighlight in State then
     LVI.state := LVI.state or LVIS_DROPHILITED;
  if lvisFocus in State then
     LVI.state := LVI.state or LVIS_FOCUSED;
  if lvisSelect in State then
     LVI.state := LVI.state or LVIS_SELECTED;
  LVI.stateMask := $FFFF;
  if StateImgIdx <> 0 then
     LVI.state := LVI.state or ((StateImgIdx and $F) shl 12);
  if OverlayImgIdx <> 0 then
     LVI.state := LVI.state or ((OverlayImgIdx and $F) shl 8);
  LVI.pszText := PKOL_Char( aText );
  LVI.iImage := ImgIdx;
  LVI.lParam := Data;
  Result := Perform( LVM_INSERTITEM, 0, Integer( @LVI ) );
end;

procedure TControl.LVSetItem(Idx, Col: Integer; const aText: KOLString;
  ImgIdx: Integer; State: TListViewItemState; StateImgIdx,
  OverlayImgIdx: Integer; Data: DWORD);
var LVI: TLVItem;
    {$IFDEF KOL_ASSERTIONS} I: Integer; {$ENDIF}
begin
  LVI.mask := LVIF_TEXT or {LVIF_STATE or} LVIF_DI_SETITEM;
  if Col = 0 then
  begin
    LVI.mask := LVIF_TEXT or LVIF_STATE or LVIF_PARAM
              or LVIF_DI_SETITEM;
  end;
  if ImgIdx <> I_SKIP then
     LVI.mask := LVI.mask or LVIF_IMAGE;
  if ImgIdx < I_SKIP then
    LVI.mask := LVIF_TEXT or LVIF_DI_SETITEM;
  LVI.iItem := Idx;
  LVI.iSubItem := Col;
  LVI.state := 0;
  if lvisBlend in State then
     LVI.state := LVIS_CUT;
  if lvisHighlight in State then
     LVI.state := LVI.state or LVIS_DROPHILITED;
  if lvisFocus in State then
     LVI.state := LVI.state or LVIS_FOCUSED;
  if lvisSelect in State then
     LVI.state := LVI.state or LVIS_SELECTED;
  LVI.stateMask := $FFFF;
  if StateImgIdx <> 0 then
     LVI.state := LVI.state or ((StateImgIdx and $F) shl 12);
  if StateImgIdx < 0 {= I_SKIP} then
     LVI.stateMask := $F0FF;
  if OverlayImgIdx <> 0 then
     LVI.state := LVI.state or ((OverlayImgIdx and $F) shl 8);
  if OverlayImgIdx < 0 {=I_SKIP} then
     LVI.stateMask := LVI.stateMask and $FFF;
  LVI.pszText := PKOL_Char( aText );
  LVI.iImage := ImgIdx;
  LVI.lParam := Data;
  {$IFDEF KOL_ASSERTIONS} I := {$ENDIF}
          Perform( LVM_SETITEM, 0, Integer( @LVI ) );
  {$IFDEF KOL_ASSERTIONS}
  if (I = 0) and (Col = 0) then
    Assert( False, 'Can not set item ' );
  {$ENDIF KOL_ASSERTIONS}
end;

procedure LVGetItem( Sender: PControl; Idx, Col: Integer; var LVI: TLVItem;
          TextBuf: PKOL_Char; TextBufSize: Integer );
begin
  LVI.mask := LVIF_STATE or LVIF_PARAM or LVIF_IMAGE;
  if  Col > 0 then
  if  not (lvoSubItemImages in Sender.DF.fLVOptions) then
      LVI.mask := LVIF_STATE or LVIF_PARAM;
  LVI.iItem := Idx;
  LVI.iSubItem := Col;
  LVI.pszText := TextBuf;
  LVI.cchTextMax := TextBufSize;
  if  TextBufSize <> 0 then
      LVI.mask := LVI.mask or LVIF_TEXT;
  Sender.Perform( LVM_GETITEM, 0, Integer( @LVI ) );
end;

function TControl.LVGetItemImgIdx(Idx: Integer): Integer;
var LVI: TLVItem;
begin
  LVI.iImage := -1;//= Result if image is not assigned {Andrzej Kubaszek}
  LVGetItem( @Self, Idx, 0, LVI, nil, 0 );
  Result := LVI.iImage;
end;

procedure TControl.LVSetItemImgIdx(Idx: Integer; const Value: Integer);
var LVI: TLVItem;
begin
  LVGetItem( @Self, Idx, 0, LVI, nil, 0 );
  LVI.iImage := Value;
  Perform( LVM_SETITEM, 0, Integer( @LVI ) );
end;

function TControl.LVGetItemText(Idx, Col: Integer): KOLString;
var LVI: TLVItem;
    TextBuf: PKOL_Char;
    BufSize: Integer;
begin
  BufSize := 0;
  TextBuf := nil;
  repeat
    if TextBuf <> nil then
       FreeMem( TextBuf );
    BufSize := BufSize * 2 + 100; // to vary in asm version
    GetMem( TextBuf, BufSize * Sizeof( KOLChar ) );
    TextBuf[ 0 ] := #0;
    LVGetItem( @Self, Idx, Col, LVI, TextBuf, BufSize );
  until Integer({$IFDEF UNICODE_CTRLS} WStrLen {$ELSE} StrLen {$ENDIF}
        ( PKOLChar( TextBuf ) )) < BufSize - 1;
  Result := TextBuf;
  FreeMem( TextBuf );
end;

procedure TControl.LVSetItemText(Idx, Col: Integer; const Value: KOLString);
var LVI: TLVItem;
begin
  LVI.iSubItem := Col;
  LVI.pszText := PKOL_Char( Value );
  Perform( LVM_SETITEMTEXT, Idx, Integer( @LVI ) );
end;

procedure TControl.LVColDelete(ColIdx: Integer);
begin
  Perform( LVM_DELETECOLUMN, ColIdx, 0 );
  if  DF.fLVColCount > 0 then
      Dec( DF.fLVColCount );
end;

procedure TControl.SetLVOptions(const Value: TListViewOptions);
begin
  if  DF.fLVOptions = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  DF.fLVOptions := Value;
  ApplyImageLists2ListView( @Self );
  PostMessage( fHandle, WM_SIZE, 0, 0 ); // to restore scrollers (otherwise its are lost)
end;

procedure TControl.SetLVStyle(const Value: TListViewStyle);
begin
  if  DF.fLVStyle = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  DF.fLVStyle := Value;
  ApplyImageLists2ListView( @Self );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.Perform(msgcode: DWORD; wParam, lParam: Integer): Integer; stdcall;
begin
  {$IFDEF INPACKAGE}
  Log( '->TControl.Perform' );
  TRY
  {$ENDIF INPACKAGE}
  Result := SendMessage( GetWindowHandle, msgcode, wParam, lParam );
  {$IFDEF INPACKAGE}
    LogOK;
  FINALLY
    Log( '<-TControl.Perform' );
  END;
  {$ENDIF INPACKAGE}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.Postmsg(msgcode: DWORD; wParam, lParam: Integer): Boolean; stdcall;
begin
  Result := PostMessage( GetWindowHandle, msgcode, wParam, lParam );
end;
{$ENDIF PAS_VERSION}

{$ENDIF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.GetChildCount: Integer;
begin
  Result := fChildren.Count;
end;
{$ENDIF PAS_VERSION}
{$IFDEF WIN_GDI}

procedure TControl.LVDelete(Idx: Integer);
begin
  Perform( LVM_DELETEITEM, Idx, 0 );
end;

procedure TControl.LVEditItemLabel(Idx: Integer);
begin
  Perform( LVM_EDITLABEL, Idx, 0 );
end;

function TControl.LVItemRect(Idx: Integer; Part: TGetLVItemPart): TRect;
const Parts: array[ TGetLVItemPart ] of Byte = (
             LVIR_BOUNDS, LVIR_ICON, LVIR_LABEL, LVIR_SELECTBOUNDS );
begin
  Result := MakeRect( Parts[ Part ], 0, 0, 0 );
  if  Perform( LVM_GETITEMRECT, Idx, Integer( @Result ) ) = 0 then
      Result := MakeRect( 0, 0, 0, 0 );
end;

function TControl.LVSubItemRect(Idx, ColIdx: Integer): TRect;
var Hdr: HWnd;
    R, R1: TRect;
    ClassNameBuf: array[ 0..31 ] of KOLChar;
    HdItem: THDItem;
begin
  Result.Top := ColIdx; // + 1; error in MSDN ?
  Result.Left := LVIR_BOUNDS;
  if Perform( LVM_GETSUBITEMRECT, Idx, Integer( @Result ) ) <> 0 then
    Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Result := MakeRect( 0, 0, 0, 0 );
  if ColIdx > 0 then R := LVSubItemRect( Idx, ColIdx - 1 )
                else R := LVItemRect( Idx, lvipBounds );
  if (R.Left = 0) and (R.Right = 0) and
     (R.Top = 0) and (R.Bottom = 0) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Hdr := GetWindow( GetWindowHandle, GW_CHILD );
  if Hdr <> 0 then
  begin
    if GetClassName( Hdr, ClassNameBuf, 32 ) > 0 then
    if ClassNameBuf = 'SysHeader32' then
    begin
      if ColIdx > 0 then R.Left := R.Right
                    else R.Left := 0;
      R1.Top := 0; R1.Left := 0;
      Windows.ClientToScreen( Hdr,{$IFDEF FPC} PPoint( @ R1.Left )^ {$ELSE} R1.TopLeft {$ENDIF} );
      Windows.ScreenToClient( fHandle, {$IFDEF FPC} PPoint( @ R1.Left )^ {$ELSE} R1.TopLeft {$ENDIF} );
      R1 := R;
      HdItem.Mask := HDI_WIDTH;
      if  SendMessage( Hdr, HDM_GETITEM, ColIdx, Integer( @HdItem ) ) = 0 then
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      R1.Right := R1.Left + HdItem.cxy;
      Result := R1;
    end;
  end;
end;

function TControl.LVGetItemPos(Idx: Integer): TPoint;
begin
  Perform( LVM_GETITEMPOSITION, Idx, Integer( @Result ) );
end;

procedure TControl.LVSetItemPos(Idx: Integer; const Value: TPoint);
begin
  Perform( LVM_SETITEMPOSITION32, Idx, Integer( @Value ) );
end;

function TControl.LVItemAtPos(X, Y: Integer): Integer;
var Dummy: TWherePosLVItem;
begin
  Result := LVItemAtPosEx( X, Y, Dummy );
end;

function TControl.LVItemAtPosEx(X, Y: Integer;
  var Where: TWherePosLVItem): Integer;
var HTI: TLVHitTestInfo;
begin
  HTI.pt.x := X;
  HTI.pt.y := Y;
  Perform( LVM_HITTEST, 0, Integer( @HTI ) );
  Result := HTI.iItem;
  Where := lvwpOnColumn;
  if HTI.flags = LVHT_ONITEMICON then
     Where := lvwpOnIcon
  else
  if HTI.flags = LVHT_ONITEMLABEL then
     Where := lvwpOnLabel
  else
  if HTI.flags = LVHT_ONITEMSTATEICON then
     Where := lvwpOnStateIcon
  else
  if HTI.flags = LVHT_ONITEM then
     Where := lvwpOnItem;
end;

procedure TControl.LVMakeVisible(Item: Integer; PartiallyOK: Boolean);
begin
  if Item < 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Perform( LVM_ENSUREVISIBLE, Item, Integer( PartiallyOK ) );
end;

procedure TControl.LVSetColorByIdx(const Index: Integer;
  const Value: TColor);
var MsgCode: Integer;
    ColorValue: TColor;
begin
  MsgCode := Index + 1;
  case MsgCode of
  LVM_SETTEXTCOLOR:  fTextColor := Value;
  LVM_SETTEXTBKCOLOR: DF.fLVTextBkColor := Value;
  LVM_SETBKCOLOR: fColor := Value;
  end;
  ColorValue := Color2RGB( Value );
  Perform( MsgCode, 0, ColorValue );
end;

{$IFDEF F_P}
function TControl.LVGetColorByIdx(const Index: Integer): TColor;
begin
  CASE Index OF
  LVM_SETTEXTCOLOR:   Result := fTextColor;
  LVM_SETTEXTBKCOLOR: Result := fLVTextBkColor;
  LVM_SETBKCOLOR:     Result := fColor;
  END;
end;
{$ENDIF F_P}

function TControl.GetIntVal(const Index: Integer): Integer;
begin
  Result := GetItemVal( 0, Index );
end;

procedure TControl.SetIntVal(const Index, Value: Integer);
begin
  SetItemVal( Value, Index, 0 );
end;

function TControl.GetItemVal(Item: Integer; const Index: Integer): Integer;
begin
  Result := Perform( LoWord(Index), Item, 0 );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.SetItemVal(Item: Integer; const Index: Integer; const Value: Integer);
var MsgCode: Integer;
begin
  MsgCode := HiWord( Index );
  if MsgCode = 0 then
    MsgCode := Index + 1;
  Perform( MsgCode and $7FFF, Item, Value );
  if (MsgCode and $8000) <> 0 then
    Invalidate;
end;
{$ENDIF PAS_VERSION}

function TControl.GetSBMinMax: TPoint;
{$IFDEF _D2}
var X, Y: Integer;
{$ENDIF}
begin
  if (Handle <> 0) then begin
    {$IFDEF _D2}
    GetScrollRange(Handle, SB_CTL, X, Y);
    Result.X := X;
    Result.Y := Y;
    {$ELSE}
    GetScrollRange(Handle, SB_CTL, Result.X, Result.Y);
    {$ENDIF}
    Dec(Result.Y, SBPageSize - 1);
  end
  else
    Result := DF.fSBMinMax;
end;

function TControl.GetSBPageSize: Integer;
var
  SI: TScrollInfo;
begin
  ZeroMemory(@SI, SizeOf(SI));
  SI.cbSize := SizeOf(SI);
  SI.fMask := SIF_PAGE;
  SBGetScrollInfo(SI);
  Result := SI.nPage;
end;

function TControl.GetSBPosition: Integer;
begin
  Result := GetScrollPos(Handle, SB_CTL);
end;

procedure TControl.SetSBMax(Value: Longint);
var
  P: TPoint;
begin
  DF.fSBMinMax.Y := Value;
  if  (Handle <> 0) then
  begin
      P := SBMinMax;
      P.Y := Value;
      SBMinMax := P;
  end;
end;

procedure TControl.SetSBMin(Value: Longint);
var
  P: TPoint;
begin
  DF.fSBMinMax.X := Value;
  if  (Handle <> 0) then
  begin
      P := SBMinMax;
      P.X := Value;
      SBMinMax := P;
  end;
end;

procedure TControl.SetSBPageSize(Value: Integer);
var
  SI: TScrollInfo;
begin
  DF.fSBPageSize := Value;
  if  fHandle <> 0 then
  begin
      ZeroMemory(@SI, SizeOf(SI));
      SI.cbSize := SizeOf(SI);
      SI.fMask := SIF_PAGE or SIF_RANGE;
      SBGetScrollInfo(SI);
      {$IFDEF SCROLL_OLD} // by QAZ
          {$IFDEF SCROLL_OLD_MAX1}
          if (SI.nMax = 0) and (SI.nMin = 0) then
            SI.nMax := 1;
          {$ENDIF}
          SI.nMax := SI.nMax - Integer(SI.nPage) + Value;
      {$ENDIF}
      SI.nPage := Value;
      SBSetScrollInfo(SI);
  end;
end;

procedure TControl.SetSBPosition(Value: Integer);
begin
  DF.fSBPosition := Value;
  if  (Handle <> 0) then
      SetScrollPos(Handle, SB_CTL, Value, True);
end;

procedure TControl.SetSBMinMax(const Value: TPoint);
begin
  GetSBMinMax;
  if  (Handle <> 0) then
      SetScrollRange(Handle, SB_CTL, Value.X,
          Value.Y {$IFDEF SCROLL_OLD} + SBPageSize - 1{$ENDIF (by QAZ)} , True)
  else
      DF.fSBMinMax := Value;
end;

function TControl.SBSetScrollInfo(const SI: TScrollInfo): Integer;
begin
  Result := SetScrollInfo(Handle, SB_CTL, SI, True)
end;

function TControl.SBGetScrollInfo(var SI: TScrollInfo): Boolean;
begin
  Result := Cardinal(GetScrollInfo(Handle, SB_CTL, SI)) <> 0;
end;

{ -- OpenSaveDialog -- }

function NewOpenSaveDialog( const Title, StrtDir: KOLString;
         Options: TOpenSaveOptions ): POpenSaveDialog;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TOpenSaveDialog';
  {$ENDIF}
  Result.FOptions := Options;
  if Options = [] then
    Result.FOptions := DefOpenSaveDlgOptions;
  Result.fOpenDialog := True;
  Result.FTitle := Title;
  Result.FInitialDir := StrtDir;
end;

{ TOpenSaveDialog }

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TOpenSaveDialog.Destroy;
begin
  FFilter := '';
  FInitialDir := '';
  FDefExtension := '';
  FFileName := '';
  FTitle := '';
  {$IFDEF OpenSaveDialog_Extended}
  TemplateName := '';
  {$ENDIF}
  inherited;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TOpenSaveDialog.Execute: Boolean;
const OpenSaveFlags: array[ TOpenSaveOption ] of Integer = (
      OFN_CREATEPROMPT,
      OFN_EXTENSIONDIFFERENT,
      OFN_FILEMUSTEXIST,
      OFN_HIDEREADONLY,
      OFN_NOCHANGEDIR,
      OFN_NODEREFERENCELINKS,
      OFN_ALLOWMULTISELECT,
      OFN_NONETWORKBUTTON,
      OFN_NOREADONLYRETURN,
      OFN_OVERWRITEPROMPT,
      OFN_PATHMUSTEXIST,
      OFN_READONLY,
      OFN_NOVALIDATE,
      OFN_ENABLETEMPLATE,
      OFN_ENABLEHOOK );
var
  Ofn : TOpenFilename;
  Fltr : KOLString;
  TempFilename : KOLString;
  Function MakeFilter(s : KOLString) : KOLString;
  {  format of filter for API call is following:
    'text files'#0'*.txt'#0
    'bitmap files'#0'*.bmp'#0#0 }
  var Str: PKOLChar;
  begin
    Result := s;
    if Result='' then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    Result:=Result+#0; {Delphi string always end on #0 is this is #0#0}
    Str := PKOLChar( Result );
    while Str^ <> #0 do
    begin
      if Str^ = '|' then
        Str^ := #0;
      Inc( Str );
    end;
  end;

var m: Integer;
begin
  ZeroMemory( @ofn, sizeof( ofn ) );

  {$IFDEF OpenSaveDialog_Extended}
  if (WinVer <= wvNT) and (WinVer <> wvME) then
    ofn.lStructSize := 76
  else
  begin
    ofn.lStructSize := Sizeof( ofn );
    ofn.FlagsEx := Integer( NoPlaceBar );
  end;
  {$ELSE}
  ofn.lStructSize:= 76; //to provide correct work in Win9x
  {$ENDIF}
  if fWnd <> 0 then
    ofn.hWndOwner := fWnd
  else
  if  Applet <> nil then
      ofn.hwndOwner := applet.Handle;

  ofn.hInstance:=HInstance;

  Fltr := MakeFilter(FFilter);
  if Fltr <> '' then
    ofn.lpstrFilter := PKOLchar(Fltr);
  ofn.nFilterIndex := FFilterIndex;

  if OSAllowMultiSelect in FOptions then
    ofn.nMaxFile := High(word)-14    // by V.K. (exchanged condition)
  else
    ofn.nMaxFile := MAX_PATH+2;

  SetLength( TempFileName, ofn.nMaxFile );
  ZeroMemory( @TempFileName[ 1 ], ofn.nMaxFile * sizeof( KOLChar ) );
  m := Min( ofn.nMaxFile, Length(fFileName) );
  {$IFDEF UNICODE_CTRLS}
  ofn.lpstrFile := PKOLchar( TempFileName );
  WStrLCopy(PWideChar(TempFileName), PWideChar(fFileName), m );
  {$ELSE}
  ofn.lpstrFile := StrLCopy(PKOLChar(TempFileName), PKOLchar(fFileName), m );
  {$ENDIF}

  ofn.lpstrInitialDir:=Pointer(FInitialDir);
  ofn.lpstrTitle := Pointer(FTitle);
  ofn.Flags := MakeFlags( @FOptions, OpenSaveFlags )
            or OFN_EXPLORER or OFN_LONGNAMES or OFN_ENABLESIZING;

  ofn.lpstrDefExt := PKOLChar(FDefExtension);
  ofn.lCustData := integer(@self);
  {$IFDEF OpenSaveDialog_Extended}
  ofn.lpTemplateName := PKOLChar( TemplateName );
  ofn.lpfnHook := HookProc;
  {$ELSE}
  ofn.lpTemplateName := nil;
  ofn.lpfnHook := nil;
  {$ENDIF}
  if fOpenDialog then
    result := GetOpenFileName(POpenFileName( @ofn )^)
  else
    result := GetSaveFileName(POpenFileName( @ofn )^);
  if result then begin
    fFilterIndex := ofn.nFilterIndex; // by Vadim
    fOpenReadOnly := OFN_READONLY and ofn.Flags <> 0; // by ECM (in my redaction)
    if OSAllowMultiSelect in foptions then begin
      FFileName := copy(TempFileName, 1, pos(KOLString(#0#0), tempfilename)-1);
      while pos(KOLString(#0), ffilename) > 0 do begin
        FFilename[pos(KOLString(#0), ffilename)]:=#13;
      end;
    end else
      FFileName := copy(tempFileName, 1, pos(KOLString(#0), TempFilename)
      -1 // by X.Y.B.
      );
  end else
    FFilename:='';
end;
{$ENDIF PAS_VERSION}

{ -- OpenDirDialog -- }

function NewOpenDirDialog( const Title: KOLString; Options: TOpenDirOptions ):
         POpenDirDialog;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TOpenDirDialog';
  {$ENDIF}
  Result.FOptions := [ odOnlySystemDirs ];
  if Options <> [] then
    Result.FOptions := Options;
  Result.FTitle := Title;
end;

{ TOpenDirDialog }

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TOpenDirDialog.Destroy;
begin
  FTitle := '';
  FInitialPath := '';
  FStatusText := '';
  inherited;
end;
{$ENDIF PAS_VERSION}

type
  PSHItemID = ^TSHItemID;
  TSHItemID = packed record
    cb: Word;                         { Size of the ID (including cb itself) }
    abID: array[0..0] of Byte;        { The item ID (variable length) }
  end;

  PItemIDList = ^TItemIDList;
  TItemIDList = record
     mkid: TSHItemID;
  end;

  PBrowseInfo = ^TBrowseInfo;
  TBrowseInfoA = record
    hwndOwner: HWND;
    pidlRoot: PItemIDList;
    pszDisplayName: PAnsiChar;  { Return display name of item selected. }
    lpszTitle: PAnsiChar;      { text to go in the banner over the tree. }
    ulFlags: UINT;           { Flags that control the return stuff }
    lpfn: Pointer; //TFNBFFCallBack;
    lParam: LPARAM;          { extra info that's passed back in callbacks }
    iImage: Integer;         { output var: where to return the Image index. }
  end;
  TBrowseInfoW = record
    hwndOwner: HWND;
    pidlRoot: PItemIDList;
    pszDisplayName: PWideChar;  { Return display name of item selected. }
    lpszTitle: PWideChar;      { text to go in the banner over the tree. }
    ulFlags: UINT;           { Flags that control the return stuff }
    lpfn: Pointer; //TFNBFFCallBack;
    lParam: LPARAM;          { extra info that's passed back in callbacks }
    iImage: Integer;         { output var: where to return the Image index. }
  end;
  TBrowseInfo = {$IFDEF UNICODE_CTRLS} TBrowseInfoW {$ELSE} TBrowseInfoA {$ENDIF};

function SHBrowseForFolderA(var lpbi: TBrowseInfoA): PItemIDList; stdcall;
  external 'shell32.dll' name 'SHBrowseForFolderA';
{$IFDEF UNICODE_CTRLS}
function SHBrowseForFolderW(var lpbi: TBrowseInfoW): PItemIDList; stdcall;
  external 'shell32.dll' name 'SHBrowseForFolderW';
{$ENDIF UNICODE_CTRLS}
function SHGetPathFromIDListA(pidl: PItemIDList; pszPath: PAnsiChar): BOOL; stdcall;
  external 'shell32.dll' name 'SHGetPathFromIDListA';
{$IFDEF UNICODE_CTRLS}
function SHGetPathFromIDListW(pidl: PItemIDList; pszPath: PKOLChar): BOOL; stdcall;
  external 'shell32.dll' name 'SHGetPathFromIDListW';
{$ENDIF UNICODE_CTRLS}
procedure CoTaskMemFree(pv: Pointer); stdcall; external 'ole32.dll'
  name 'CoTaskMemFree';

const
  BIF_RETURNONLYFSDIRS   = $0001;  { For finding a folder to start document searching }
  BIF_DONTGOBELOWDOMAIN  = $0002;  { For starting the Find Computer }
  BIF_STATUSTEXT         = $0004;
  BIF_RETURNFSANCESTORS  = $0008;
  BIF_EDITBOX            = $0010;
  BIF_VALIDATE           = $0020;  { insist on valid result (or CANCEL) }
  BIF_NEWDIALOGSTYLE     = $0040;  { Use the new dialog layout with the ability to resize }
                                   { Caller needs to call OleInitialize() before using this API (c) JVCL }
  BIF_BROWSEFORCOMPUTER  = $1000;  { Browsing for Computers. }
  BIF_BROWSEFORPRINTER   = $2000;  { Browsing for Printers }
  BIF_BROWSEINCLUDEFILES = $4000;  { Browsing for Everything }

  BFFM_INITIALIZED       = 1;
  BFFM_SELCHANGED        = 2;

  BFFM_SETSTATUSTEXT     = WM_USER + 100;
  BFFM_ENABLEOK          = WM_USER + 101;
  BFFM_SETSELECTION      = WM_USER + 102;
  BFFM_SETSELECTIONW     = WM_USER + 103;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TOpenDirDialog.Execute: Boolean;
const FlagsArray: array[ TOpenDirOption ] of Integer =
      ( BIF_BROWSEFORCOMPUTER, BIF_BROWSEFORPRINTER, BIF_DONTGOBELOWDOMAIN,
        BIF_RETURNFSANCESTORS, BIF_RETURNONLYFSDIRS, BIF_STATUSTEXT,
        BIF_BROWSEINCLUDEFILES, BIF_EDITBOX, BIF_NEWDIALOGSTYLE );
var BI : TBrowseInfo;
    Browse : PItemIdList;
begin
  Result := False;
  if WndOwner <> 0 then
    BI.hwndOwner := WndOwner
  else
  if  Applet <> nil then
      BI.hwndOwner := Applet.Handle
  else
      BI.hwndOwner := 0;
  BI.pidlRoot  := nil;
  BI.pszDisplayName := @FBuf[ 0 ];
  BI.lpszTitle := PKOLChar( Title );
  BI.ulFlags   := MakeFlags( @FOptions, FlagsArray );
  BI.lpfn := FCallBack;
  BI.lParam := Integer( @Self );
  Browse := {$IFDEF UNICODE_CTRLS} SHBrowseForFolderW {$ELSE} SHBrowseForFolderA {$ENDIF}
    ( BI );
  if Browse <> nil then
  begin
    {$IFDEF UNICODE_CTRLS}SHGetPathFromIDListW{$ELSE} SHGetPathFromIDListA{$ENDIF}( Browse, @FBuf[ 0 ] );
    CoTaskMemFree( Browse );
    Result := True;
  end;
end;
{$ENDIF PAS_VERSION}

function TOpenDirDialog.GetInitialPath: KOLString;
begin
  Result := IncludeTrailingPathDelimiter( fInitialPath );
end;

function TOpenDirDialog.GetPath: KOLString;
begin
  Result := FBuf;
end;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function OpenDirSelChangeCallBack( Wnd: HWnd; Msg: DWORD; lParam, lpData: LParam ):
         Integer; stdcall;
var _Self_: POpenDirDialog;
    EnableOK: Integer;
begin
  _Self_ := Pointer( lpData );
  if Assigned( _Self_.FOnSelChanged ) then
  begin
    {$IFDEF UNICODE_CTRLS} SHGetPathFromIDListW {$ELSE} SHGetPathFromIDListA {$ENDIF}( PItemIDList( lParam ), @ _Self_.FBuf[ 0 ] );
    EnableOK := 0;
    _Self_.FOnSelChanged( _Self_, _Self_.FBuf, EnableOK,
      KOL_String( KOLString( _Self_.FStatusText ) ) );
    SendMessage( Wnd, BFFM_ENABLEOK, 0, EnableOK );
    if _Self_.FStatusText <> '' then
       SendMessage( Wnd, BFFM_SETSTATUSTEXT, 0, Integer( PKOLChar( _Self_.FStatusText ) ) );
  end;
  Result := 0;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_LOCAL} {$UNDEF ASM_LOCAL} {$ENDIF}
{$IFNDEF NEW_OPEN_DIR_STYLE_EX}
  {$IFDEF ASM_VERSION} {$DEFINE ASM_LOCAL} {$ENDIF}
{$ENDIF}

{$IFDEF ASM_LOCAL}
{$ELSE PAS_VERSION} //Pascal
function OpenDirCallBack( Wnd: HWnd; Msg: DWORD; lParam, lpData: LParam ): Integer;
         stdcall;
const
  Shel: array[ 0..3 ] of AnsiChar = 'SHBr'; // KOL_ANSI used as DWORD
var Self_ : POpenDirDialog;
    {$IFDEF NEW_OPEN_DIR_STYLE_EX}
    WList: HWnd;
    ClassBuf: array[ 0..127 ] of KOLChar;
    {$ENDIF}
begin
  Self_ := Pointer( lpData );
  Self_.FDialogWnd := Wnd;
  if Msg = BFFM_INITIALIZED then
  begin
    if Assigned( Self_.FCenterProc ) then
       Self_.FCenterProc( Wnd );
    if Self_.FInitialPath <> '' then
    begin
      {$IFDEF NEW_OPEN_DIR_STYLE_EX}
      WList := GetWindow( Wnd, GW_CHILD );
      while WList <> 0 do
      begin
        WList := GetWindow( WList, GW_HWNDNEXT );
        GetClassName( WList, @ ClassBuf[ 0 ], Sizeof( ClassBuf ) );
        if PDWord( @ ClassBuf[ 0 ] )^ = DWORD( Shel ) then
        begin
          PostMessage( Wnd, WM_NEXTDLGCTL, WList, 1 );
          break;
        end;
      end;
      PostMessage( Wnd, {$IFDEF UNICODE_CTRLS} BFFM_SETSELECTIONW
                        {$ELSE} BFFM_SETSELECTION {$ENDIF}, 1, Integer( PKOLChar(
        ExtractFilePath( Self_.FInitialPath ) ) ) );
      PostMessage( WND, WM_KEYDOWN, VK_ADD, 0 );
      PostMessage( WND, WM_KEYUP, VK_ADD, 0 );
      PostMessage( Wnd, {$IFDEF UNICODE_CTRLS} BFFM_SETSELECTIONW
                        {$ELSE} BFFM_SETSELECTION {$ENDIF}, 1, Integer( PKOLChar( Self_.FInitialPath ) ) );
      {$ELSE}
      SendMessage( Wnd, {$IFDEF UNICODE_CTRLS} BFFM_SETSELECTIONW
                        {$ELSE} BFFM_SETSELECTION {$ENDIF}, 1, Integer( PKOLChar( Self_.FInitialPath ) ) );
      {$ENDIF}
      SendMessage( Wnd, BFFM_ENABLEOK, 0, 1 );
    end;
  end
     else
  if Msg = BFFM_SELCHANGED then
  begin
    if Assigned( Self_.FDoSelChanged ) then
      Self_.FDoSelChanged( Wnd, Msg, lParam, lpData )
    else
      SendMessage( Wnd, BFFM_ENABLEOK, 0, 1 );
  end;
  Result := 0;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure OpenDirDlgCenter( Wnd: HWnd );
var R: TRect;
    W, H: Integer;
begin
  GetWindowRect( Wnd, R );
  W := R.Right - R.Left;
  H := R.Bottom - R.Top;
  R.Left := (GetSystemMetrics( SM_CXSCREEN ) - W) div 2;
  R.Top := (GetSystemMetrics( SM_CYSCREEN ) - H) div 2;
  MoveWindow( Wnd, R.Left, R.Top, W, H, True );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TOpenDirDialog.SetCenterOnScreen(const Value: Boolean);
var P: procedure( Wnd: HWnd );
begin
  FCenterOnScreen := Value;
  P := nil;
  if Value then
    P := @OpenDirDlgCenter;
  FCenterProc := P;
end;
{$ENDIF PAS_VERSION}

procedure TOpenDirDialog.SetInitialPath(const Value: KOLString);
begin
  FCallBack := @OpenDirCallBack;
  FInitialPath := ExcludeTrailingPathDelimiter( Value );
  if (FInitialPath <> '') and
     (FInitialPath[ Length( FInitialPath ) ] = ':') then
    FInitialPath := IncludeTrailingPathDelimiter( Value );
end;

procedure TOpenDirDialog.SetOnSelChanged(const Value: TOnODSelChange);
begin
  FOnSelChanged := Value;
  FCallBack := @OpenDirCallBack;
  FDoSelChanged := @OpenDirSelChangeCallBack;
end;

type
  PByteArray    =^TByteArray;
  TByteArray    = array[Word]of Byte;

function CreateMappedBitmap(Instance: THandle; Bitmap: Integer;
  Flags: UINT; ColorMap: PColorMap; NumMaps: Integer): HBitmap; stdcall;
  external cctrl name 'CreateMappedBitmap';

function CreateMappedBitmapEx(Instance: THandle; BmpRsrcName: PKOLChar; Flags:
Cardinal; ColorMap: PColorMap; NumMaps: Integer): HBitmap;
var bi: TBITMAPINFO;
    DC, tmcl: Cardinal;
    Bits: PByteArray;
    i, j, k, CO, bps: Integer;
    tm: array [1..4] of byte absolute tmcl;
    bm: Windows.TBITMAP;
    CM: PColorMap;
    DW: HWnd;
begin
  Result := LoadBitmap( Instance, BmpRsrcName );
  if Result = 0 then
  begin
    {$IFDEF DEBUG_ANY}
    ShowMessage( AnsiString('Can not load bitmap ') + BmpRsrcName + ', error ' +
                 Int2Str( GetLastError ) + ': ' + SysErrorMessage( GetLastError ) );
    {$ENDIF DEBUG_ANY}
    Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  DW := GetDesktopWindow;
  DC := GetDC(DW);
  ZeroMemory( @bm, SizeOf(bm) );
  GetObject( Result, SizeOf( bm ), @bm );

  ZeroMemory( @bi, SizeOf( bi ) );
  bi.bmiHeader.biSize := SizeOf( bi.bmiHeader );
  bi.bmiHeader.biWidth := bm.bmWidth;
  bi.bmiHeader.biHeight := -bm.bmHeight;
  bi.bmiHeader.biPlanes := 1;
  bi.bmiHeader.biBitCount := 24;
// BitCout - always 24 for easy algorythm
  bi.bmiHeader.biCompression:=BI_RGB;
  bps := CalcScanLineSize( @bi.bmiHeader );

  GetMem( Bits, bps * bm.bmHeight );
  GetDIBits( DC, Result, 0, bm.bmHeight, @Bits[0], bi, DIB_RGB_COLORS );
  DeleteObject( Result );

  for i := 0 to bm.bmHeight - 1 do begin
      for j := 0 to bm.bmWidth - 1 do begin
          CO := bps * i + 3 * j;
          for k := 0 to NumMaps - 1 do begin
              CM := Pointer( Integer( ColorMap ) + SizeOf( TColorMap ) * k );
              if RGB( Bits[CO+2], Bits[CO+1], Bits[CO] ) = CM.cFrom then
              begin
                  tmcl := CM.cTo;
                  tm[4]:=tm[1];
                  tm[1]:=tm[3];
                  tm[3]:=tm[4];
                  Move( tmcl, Bits[CO], 3);
              end;
          end;
      end;
  end;
  Result := CreateDIBitmap( DC, bi.bmiHeader, CBM_INIT, @Bits[0], bi,
    DIB_RGB_COLORS );
  ReleaseDC( DW, DC );
  FreeMem( Bits );
end;

function LoadMappedBitmap( hInst: THandle; BmpResID: Integer; const Map: array of TColor )
         : HBitmap;
var Map2Pass: Pointer;
begin
  Map2Pass := nil;
  if High( Map ) > 0 then
    Map2Pass := PColorMap( @Map[ 0 ] );
  Result := CreateMappedBitmap( hInst, BmpResID, 0, Map2Pass, (High( Map ) + 1) div 2 );
end;

function LoadMappedBitmapEx( MasterObj: PObj; hInst: THandle; BmpResName: PKOLChar; const Map: array of TColor )
         : HBitmap;
var Map2Pass: Pointer;
begin
  Map2Pass := nil;
  if High( Map ) > 0 then
    Map2Pass := PColorMap( @Map[ 0 ] );
  Result := CreateMappedBitmapEx( hInst, BmpResName, 0, Map2Pass, (High( Map ) + 1) div 2 );
  if MasterObj <> nil then
    MasterObj.Add2AutoFreeEx( TObjectMethod( MakeMethod( Pointer( Result ), @ FreeBmp ) ) );
end;

{ -- Toolbar -- }

{$IFDEF ASM_noVERSION} // width
procedure TControl.TBAddBitmap(Bitmap: HBitmap);
const szBI = sizeof(TBitmapInfo);
asm
        TEST     EDX, EDX
        JZ       @@exit
        JGE      @@1
        CMP      EDX, -6
        JL       @@1
          NEG      EDX
          DEC      EDX
          PUSH     EDX
          PUSH     -1
          XOR      EDX, EDX
          JMP      @@2
@@1:    PUSH     EDX    // AB.hInst = Bitmap
        PUSH     0      // AB.nID = 0
          PUSH     EAX    // > @Self
          ADD      ESP, -szBI
          PUSH     ESP
          PUSH     szBI
          PUSH     EDX
          CALL     GetObject
          TEST     EAX, EAX
          JG       @@11
            ADD      ESP, szBI
            JMP      @@exit
@@11:   MOV      EAX, [ESP].TBitmapInfo.bmiHeader.biWidth
        MOV      ECX, [ESP].TBitmapInfo.bmiHeader.biHeight
        TEST     ECX, ECX
        JGE      @@12
        NEG      ECX
@@12:   ADD      ESP, szBI
        CDQ                  // EDX = 0
        DIV      ECX         // EAX = N
        XCHG     EAX, [ESP]  // > N
        PUSH     EAX         // > @Self
          MOV      EDX, ECX
          SHL      EDX, 16
          OR       ECX, EDX
          CDQ
          PUSH     EDX
          PUSH     EDX
          PUSH     TB_AUTOSIZE
          PUSH     EAX
            PUSH     ECX
            PUSH     EDX
            PUSH     TB_SETBITMAPSIZE
            PUSH     EAX
            CALL     Perform
            CALL     Perform
            POP      EAX
            POP      EDX
@@2:    PUSH     ESP
        PUSH     EDX
        PUSH     TB_ADDBITMAP
        PUSH     EAX
        CALL     Perform
        POP      ECX
        POP      ECX
@@exit:
end;
{$ELSE PAS_VERSION} //Pascal
procedure TControl.TBAddBitmap(Bitmap: HBitmap);
const NstdBitmaps: array[ 0..5 ] of DWORD = ( 15, 15, 0, 0, 13, 13 );
var BI: TBitmapInfo;
    AB: TTBAddBitmap;
    N, W: Integer;
begin
  if Bitmap = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if (Integer( Bitmap ) >= -10) and (Integer( Bitmap ) <= -1) then
  begin
    AB.hInst := THandle(-1);
    AB.nID := -Integer(Bitmap) - 1;
    N := 0; //NstdBitmaps[ AB.nID ]; // (this value is ignored)
  end
     else
  if GetObject( Bitmap, sizeof( TBitmapInfo ), @BI ) > 0 then
  begin
    AB.hInst := 0;
    AB.nID := Bitmap;
    W := DF.fTBBtnImgWidth;
    if W = 0 then
      W := Abs( BI.bmiHeader.biHeight );
    N := BI.bmiHeader.biWidth div W;
    Perform( TB_SETBITMAPSIZE, 0, MAKELONG( W, Abs(BI.bmiHeader.biHeight )) );
    Perform( TB_AUTOSIZE, 0, 0 );
  end else Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Perform( TB_ADDBITMAP, N, Integer( @AB ) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TControl.TBAddInsButtons(Idx: Integer; const Buttons: array of PKOLChar;
  const BtnImgIdxArray: array of Integer): Integer; stdcall;

      function AddInsButtons: Integer;
      type TTBBtnArray = array[ 0..100000 ] of TTBButton;
           PTBBtnArray = ^TTBBtnArray;
      var AB: PTBBtnArray;
          I, N, nBmp: Integer;
          PAB: PTBButton;
          Str: PKOLChar;
          Str0: KOLString;
      begin
        Result := -1;
        AB := nil;
        if High( Buttons ) >= 0 then
          GetMem( AB, Sizeof( TTBButton ) * (High(Buttons) + 1) );
        N := 0;
        PAB := @AB[ 0 ];
        nBmp := -2;
        if High(BtnImgIdxArray) >= 0 then
          nBmp := BtnImgIdxArray[ 0 ] - 1;
        for I:= 0 to High( Buttons ) do
        begin
          if Buttons[ I ] = nil then break;
          if {$IFDEF UNICODE_CTRLS} WStrComp {$ELSE} StrComp {$ENDIF}
            ( Buttons[ I ], {$IFDEF F_P}''+{$ENDIF} '-' ) = 0 then
          begin
            PAB.iBitmap := -1;
            //PAB.idCommand := 0;
            PAB.fsState := 0;
            PAB.fsStyle := TBSTYLE_SEP;
            PAB.iString := -1;
          end
             else
          begin
            Str := Buttons[ I ];
            Inc( nBmp );
            PAB.iBitmap := nBmp;
            if nBmp < 0 then
              Dec( nBmp );
            if High( BtnImgIdxArray ) >= N then
              PAB.iBitmap := BtnImgIdxArray[ N ];
            PAB.fsState := TBSTATE_ENABLED;
            PAB.fsStyle := TBSTYLE_BUTTON or DF.fDefaultTBBtnStyle;
            if Str^ = '^' then
            begin
              PAB.fsStyle := TBSTYLE_DROPDOWN or DF.fDefaultTBBtnStyle;
              Inc( Str );
            end;
            if CharIn( Str^, [ '-', '+' ] ) then
            begin
              PAB.fsStyle := PAB.fsStyle or TBSTYLE_CHECK;
              if Str^ = '+' then
                PAB.fsState := PAB.fsState or TBSTATE_CHECKED;
              Inc( Str );
              if Str^ = '!' then
              begin
                PAB.fsStyle := PAB.fsStyle or TBSTYLE_GROUP;
                Inc( Str );
              end;
            end;
            {$IFDEF TOOLBAR_DOT_NOAUTOSIZE_BUTTON}
            if Str^ = '.' then
            begin
              PAB.fsStyle := PAB.fsStyle and not TBSTYLE_AUTOSIZE;
              inc( Str );
            end;
            {$ENDIF TOOLBAR_DOT_NOAUTOSIZE_BUTTON}
            if  (KOLString(Str) = KOLString( {$IFDEF F_P}''+{$ENDIF} KOLChar( ' ' ) )) or (Str^ = #0) then
                PAB.iString := -1
            else
            begin
                Str0 := KOLString('') + KOLString(Str) + #0;
                PAB.iString := Perform( TB_ADDSTRING, 0, Integer(PKOLChar(Str0)) );
            end;
          end;

          PAB.idCommand := ToolbarsIDcmd;
          if Result < 0 then Result := PAB.idCommand;
          Inc( ToolbarsIDcmd );

          PAB.dwData := Integer( @Self );
          Inc( N );
          Inc( PAB );
        end;
        if N > 0 then
        begin
          if Idx < 0 then
            Perform( TB_ADDBUTTONS, N, Integer( @AB[ 0 ] ) )
          else
            Perform( TB_INSERTBUTTON, Idx, Integer( @AB[ 0 ] ) );
        end;
        if AB <> nil then
          FreeMem( AB );
      end;
begin
  if High( Buttons ) < 0 then
    Result := -1
  else
    Result := AddInsButtons;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.TBAddButtons(const Buttons: array of PKOLChar;
         const BtnImgIdxArray: array of Integer): Integer;
begin
  Result := TBAddInsButtons( -1, Buttons, BtnImgIdxArray );
end;
{$ENDIF PAS_VERSION}

function TControl.TBInsertButtons(BeforeIdx: Integer;
  Buttons: array of PKOLChar; const BtnImgIdxArray: array of Integer): Integer;
var I, J, K: Integer;
begin
  J := -1;
  Result := -1;
  for I := 0 to High( Buttons ) do
  begin
    if I <= High( BtnImgIdxArray ) then
      J := BtnImgIdxArray[ I ]
    else
      if J >= 0 then Inc( J );
    K := TBAddInsButtons( BeforeIdx, [ Buttons[ I ], '' ], [ J ] );
    if Result < 0 then Result := K;
  end;
end;

function GetTBBtnGoodID( Toolbar: PControl; BtnIDorIdx: Integer ): Integer;
// change by Alexander Pravdin (to fix toolbar with separator first):
var Btn1st, i: Integer; btn: TTBButton;
begin
  Result := BtnIDorIdx;
  Btn1st := 0;
  for i := 0 to Toolbar.TBButtonCount - 1 do begin
    Toolbar.Perform( TB_GETBUTTON, i, Integer( @btn ) );
    if btn.fsStyle <> TBSTYLE_SEP then begin
        Btn1st := i;
        Break;
    end;
  end;
  if Result < Toolbar.TBIndex2Item( Btn1st ) then
    Result := Toolbar.TBIndex2Item( Result );
end;

type
  TTBButtonEvent = packed Record
    BtnID: DWORD;
    Event: TOnToolbarButtonClick;
  end;
  PTBButtonEvent = ^TTBButtonEvent;

procedure TControl.TBFreeTBevents;
begin
    DF.fTBevents.Release;
end;

function WndProcToolbarButtonsClicks( TB: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Notify: PTBNotify;
    I: Integer;
    Event: PTBButtonEvent;
begin
  Result := FALSE;
  if Msg.message = WM_NOTIFY then
  begin
    Notify := Pointer( Msg.lParam );
    if Notify.hdr.code = NM_CLICK then
    begin
      for I := TB.DF.fTBevents.fCount-1 downto 0 do
      begin
        Event := TB.DF.fTBevents.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ];
        if Integer( Event.BtnID ) = Notify.iItem then
        begin
          if Assigned( Event.Event ) then
          begin
            TB.RefInc;
            Rslt := DefWindowProc( Msg.hwnd, Msg.message, Msg.wParam, Msg.lParam );
            Event.Event( TB, Event.BtnID );
            TB.RefDec;
            Result := TRUE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          end;
          break;
        end;
      end;
    end;
  end;
end;

procedure TControl.TBAssignEvents(BtnID: Integer;
  Events: array of TOnToolbarButtonClick);
var I: Integer;
    EventRec: PTBButtonEvent;
begin
  if  DF.fTBevents = nil then
  begin
      DF.fTBevents := NewList;
      Add2AutoFreeEx( TBFreeTBevents );
      AttachProc( WndProcToolbarButtonsClicks );
  end;
  BtnID := GetTBBtnGoodID( @Self, BtnID );
  for I := 0 to High( Events ) do
  begin
      GetMem( EventRec, Sizeof( TTBButtonEvent ) );
      DF.fTBevents.Add( EventRec );
      EventRec.Event := Events[ I ];
      EventRec.BtnID := BtnID;
      Inc( BtnID );
  end;
end;

function TControl.TBBtnEvent( Idx: Integer ): TOnToolbarButtonClick;
var EventRec: PTBButtonEvent;
begin
  Result := nil;
  if  DF.fTBevents = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if  Idx < DF.fTBevents.Count then
  begin
      EventRec := DF.fTBevents.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}
                  [ Idx ];
      Result := EventRec.Event;
  end;
end;

procedure TControl.TBResetImgIdx( BtnID, BtnCount: Integer );
begin
  while BtnCount > 0 do
  begin
    TBButtonImage[ BtnID ] := -2;
    Inc( BtnID );
    Dec( BtnCount );
  end;
end;

function TControl.TBGetButtonVisible(BtnID: Integer): Boolean;
begin
  Result := Perform( TB_ISBUTTONHIDDEN, GetTBBtnGoodID( @ Self, BtnID ), 0 ) = 0;
end;

function TControl.TBItem2Index(BtnID: Integer): Integer;
begin
  Result := Perform( TB_COMMANDTOINDEX, BtnID, 0 );
end;

procedure TControl.TBSetButtonVisible(BtnID: Integer;
  const Value: Boolean);
begin
  BtnID := GetTBBtnGoodID( @Self, BtnID );
  Perform( TB_HIDEBUTTON, BtnID, Integer( not Value ) );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.TBGetBtnStt(BtnID: Integer; const Index: Integer): Boolean;
begin
  BtnID := GetTBBtnGoodID( @Self, BtnID );
  Result := Perform( Index + 8, BtnID, 0 ) <> 0;
end;
{$ENDIF PAS_VERSION}

procedure TControl.TBSetBtnStt(BtnID: Integer; const Index: Integer; const Value: Boolean);
begin
  BtnID := GetTBBtnGoodID( @Self, BtnID );
  Perform( Index, BtnID, Integer( Value ) );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.TBIndex2Item(Idx: Integer): Integer;
var ButtonInfo: TTBButton;
begin
  Result := -1;
  if Perform( TB_GETBUTTON, Idx, Integer( @ButtonInfo ) ) <> 0 then
    Result := ButtonInfo.idCommand;
end;
{$ENDIF PAS_VERSION}

procedure TControl.TBConvertIdxArray2ID(const IdxVars: array of PDWORD);
var i: Integer;
begin
  for i := 0 to High( IdxVars ) do
    IdxVars[ i ]^ := TBIndex2Item( IdxVars[ I ]^ );
end;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
function TControl.TBGetButtonText( BtnID: Integer ): KOLString;
var Buffer: array[ 0..1023 ] of KOLChar;
begin
  BtnID := GetTBBtnGoodID( @Self, BtnID );
  if Perform( TB_GETBUTTONTEXT, BtnID, Integer( @Buffer[ 0 ] ) ) > 0 then
    Result := Buffer
  else
  Result := '';
end;
{$ENDIF PAS_VERSION}

function TControl.TBGetButtonRect(BtnID: Integer): TRect;
begin
  BtnID := GetTBBtnGoodID( @Self, BtnID );
  Perform( TB_GETITEMRECT, TBItem2Index( BtnID ), Integer( @Result ) );
end;

function ToolbarButtonRect( Toolbar: PControl; BtnID: Integer ): TRect;
begin
  Result := Toolbar.TBGetButtonRect(BtnID);
end;

function TControl.TBGetRows: Integer;
begin
    Result := 1;
    UpdateWndStyles;
    if  (TBSTYLE_WRAPABLE and fStyle.Value) <> 0 then
        Result := Perform( TB_GETROWS, 0, 0 );
end;

procedure TControl.TBSetRows(const Value: Integer);
begin
  Perform( TB_SETROWS, Value, 0 );
end;

function TControl.TBMoveBtn(FromIdx, ToIdx: Integer): Boolean;
var btn: TTBButton;
begin
  Perform(TB_GETBUTTON,FromIdx,integer(@btn));
  Result := Perform(TB_DELETEBUTTON,FromIdx,0) <> 0;
   if Result then
  Perform(TB_INSERTBUTTON,ToIdx,integer(@btn));
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.TBSetTooltips(BtnID1st: Integer;
  const Tooltips: array of PKOLChar);
var I, J: Integer;
begin
  if ( DF.fTBttCmd = nil ) then
  begin
    DF.fTBttCmd := NewList;
    DF.fTBttTxt := {$IFDEF UNICODE_CTRLS} NewWStrList {$ELSE} NewStrList {$ENDIF};
    {$IFDEF USE_AUTOFREE4CONTROLS}
    Add2AutoFree( DF.fTBttCmd );
    Add2AutoFree( DF.fTBttTxt );
    {$ENDIF}
  end;
  for I:= 0 to High( Tooltips ) do
  begin
    J := DF.fTBttCmd.IndexOf( Pointer( BtnID1st ) );
    if J < 0 then
    begin
      DF.fTBttCmd.Add( Pointer( BtnID1st ) );
      DF.fTBttTxt.Add( Tooltips[ I ] );
    end
      else
      DF.fTBttTxt.Items[ J ] := Tooltips[ I ];
    Inc( BtnID1st );
  end;
end;
{$ENDIF PAS_VERSION}

function TControl.TBBtnTooltip( BtnID: Integer ): KOLString;
var J: Integer;
begin
    Result := '';
    if  DF.fTBttCmd = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    J := DF.fTBttCmd.IndexOf( Pointer( BtnID ) );
    if  J < 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    Result := DF.fTBttTxt.Items[ J ];
end;

procedure ToolbarSetTooltips( Toolbar: PControl; BtnID1st: Integer;
  const Tooltips: array of PKOLChar );
begin
  Toolbar.TBSetTooltips( BtnID1st, Tooltips );
end;

function ToolbarButtonEnabled( Toolbar: PControl; BtnID: Integer ): Boolean;
begin
  Result := Toolbar.TBButtonEnabled[ BtnID ];
end;

procedure EnableToolbarButton( Toolbar: PControl; BtnID: Integer; Enable: Boolean );
begin
  Toolbar.TBButtonEnabled[ BtnID ] := Enable;
end;

function ToolbarButtonVisible( Toolbar: PControl; BtnID: Integer ): Boolean;
begin
  Result := Toolbar.TBButtonVisible[ BtnID ];
end;

procedure ShowHideToolbarButton( Toolbar: PControl; BtnID: Integer; Show: Boolean );
begin
  Toolbar.TBButtonVisible[ BtnID ] := Show;
end;

function ToolbarButtonChecked( Toolbar: PControl; BtnID: Integer): Boolean;
begin
  Result := Toolbar.TBButtonChecked[ BtnID ];
end;

procedure ToolbarButtonSetChecked( Toolbar: PControl; BtnID: Integer; Checked: Boolean );
begin
  Toolbar.TBButtonChecked[ BtnID ] := Checked;
end;

procedure ToolbarAddButtons( Toolbar: PControl; const Buttons: array of PKOLChar;
   const BtnImgIdxArray: array of Integer; Bitmap: HBitmap );
begin
    Toolbar.TBAddButtons( Buttons, BtnImgIdxArray );
    if  Bitmap <> 0 then
        Toolbar.TBAddBitmap( Bitmap );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.TBButtonAtPos(X, Y: Integer): Integer;
var I: Integer;
begin
  I := TBBtnIdxAtPos( X, Y );
  if I >= 0 then
     I := TBIndex2Item( I );
  Result := I;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.TBBtnIdxAtPos(X, Y: Integer): Integer;
var I: Integer;
    R: TRect;
    P: TPoint;
begin
  P := MakePoint( X, Y );
  for I := TBButtonCount - 1 downto 0 do
  begin
    Perform( TB_GETITEMRECT, I, Integer( @R ) );
    if PointInRect( P, R ) then
    begin
      Result := I; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end;
  Result := -1;
end;
{$ENDIF PAS_VERSION}

function TControl.TBButtonSeparator(BtnID: Integer): Boolean;
var B: TTBButton;
begin
  Perform( TB_GETBUTTON, TBItem2Index( GetTBBtnGoodID( @Self, BtnID )
), Integer( @B ) ) ;
  Result := B.fsStyle =  TBSTYLE_SEP;
end;

procedure TControl.TBDeleteButton(BtnID: Integer);
begin
  BtnID := GetTBBtnGoodID( @Self, BtnID );
  Perform( TB_DELETEBUTTON, TBItem2Index( BtnID ), 0 );
end;

procedure TControl.TBDeleteBtnByIdx(Idx: Integer);
begin
  Perform( TB_DELETEBUTTON, Idx, 0 );
end;

procedure TControl.TBClear;
var
  i: Integer;
begin
  for i := 0 to Pred(TBButtonCount) do
    TBDeleteBtnByIdx(0);
end;

procedure TControl.Clear;
begin
  fCommandActions.aClear( @Self );
end;

{$IFDEF ASM_noVERSION}
function TControl.TBGetBtnImgIdx(BtnID: Integer): Integer;
const szTBButton = sizeof( TTBButton );
asm
        ADD      ESP, -szTBButton
        PUSH     ESP
        PUSH     EAX
        CALL     TBItem2Index
        POP      EDX
        PUSH     EAX
        PUSH     TB_GETBUTTON
        PUSH     EDX
        CALL     Perform
        POP      EAX
        ADD      ESP, szTBButton-4
end;
{$ELSE PAS_VERSION} //Pascal
function TControl.TBGetBtnImgIdx(BtnID: Integer): Integer;
var B: TTBButton;
begin
  Perform( TB_GETBUTTON, TBItem2Index( GetTBBtnGoodID( @Self, BtnID ) ), Integer( @B ) );
  Result := B.iBitmap;
end;
{$ENDIF PAS_VERSION}

procedure TControl.TBSetBtnImgIdx(BtnID: Integer; const Value: Integer);
begin
  Perform( TB_CHANGEBITMAP, GetTBBtnGoodID( @Self, BtnID ), Value );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.TBSetButtonText(BtnID: Integer; const Value: KOLString);
var BI: TTBButtonInfo;
begin
  BtnID := GetTBBtnGoodID( @Self, BtnID );
  BI.cbSize := Sizeof( BI );
  BI.dwMask := TBIF_TEXT;
  BI.pszText := PKOLChar( Value );
  Perform( TB_SETBUTTONINFO, BtnID, Integer( @BI ) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.TBGetBtnWidth(BtnID: Integer): Integer;
var R: TRect;
begin
  R := TBButtonRect[ BtnID ];
  Result := R.Right - R.Left;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.TBSetBtnWidth(BtnID: Integer; const Value: Integer);
var BI: TTBButtonInfo;
begin
  BI.cbSize := Sizeof( BI );
  BI.dwMask := TBIF_SIZE or TBIF_STYLE;
  BtnID := GetTBBtnGoodID( @Self, BtnID );
  Perform( TB_GETBUTTONINFO, BtnID, Integer( @BI ) );
  BI.cx := Value;
  BI.fsStyle := BI.fsStyle and not TBSTYLE_AUTOSIZE;
  Perform( TB_SETBUTTONINFO, BtnID, Integer( @BI ) );
end;
{$ENDIF PAS_VERSION}

procedure TControl.TBSetBtMinMaxWidth(const Idx: Integer; const Value: Integer);
begin
  case Idx of
  0: DF.fTBBtMinWidth := Value;
  1: DF.fTBBtMaxWidth := Value;
  end;
  Perform( TB_SETBUTTONWIDTH, 0, DF.fTBBtMaxWidth or (DF.fTBBtMinWidth shl 16) );
end;

{$IFDEF F_P}
function TControl.TBGetBtMinMaxWidth(const Idx: Integer): Integer;
begin
  CASE Idx OF
  0: Result := FTBBtMinWidth;
  1: Result := FTBBtMaxWidth;
  END;
end;
{$ENDIF F_P}

function TControl.TBGetButtonLParam(const Idx: Integer): DWORD;
var
  tb: TTBButtonInfo;
begin
  tb.cbSize := sizeof(tb);
  tb.dwMask := TBIF_BYINDEX or TBIF_LPARAM;
  Perform(TB_GETBUTTONINFO, Idx, Integer(@tb));
  Result := tb.lParam;
end;

procedure TControl.TBSetButtonLParam(const Idx: Integer; const Value: DWORD);
var
  tb: TTBButtonInfo;
begin
  tb.cbSize := sizeof(tb);
  tb.dwMask := TBIF_BYINDEX or TBIF_LPARAM;
  tb.lParam := Value;
  Perform(TB_SETBUTTONINFO, Idx, Integer(@tb));
end;

function WndProcTBCustomDraw( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var CD: PNMTBCustomDraw;
    Br: HBrush;
begin
  Result := FALSE;
  if Msg.message = WM_NOTIFY then
  begin
    CD := Pointer( Msg.lParam );
    if CD.nmcd.hdr.code = NM_CUSTOMDRAW then
    begin
      if  Assigned( Sender.DF.fOnTBCustomDraw ) then
          Rslt := Sender.DF.fOnTBCustomDraw( Sender, CD^ )
      else
      begin
          if  Sender.fBrush  <> nil then
              Windows.FillRect( CD.nmcd.hdc, Sender.ClientRect, Sender.fBrush.Handle )
          else
          begin
              Br := CreateSolidBrush( Color2RGB( Sender.Color ) );
              Windows.FillRect( CD.nmcd.hdc, Sender.ClientRect, Br );
              DeleteObject( Br );
          end;
        Rslt := CDRF_SKIPDEFAULT;
      end;
    end;
  end;
end;

procedure TControl.SetOnTBCustomDraw( const Value: TOnTBCustomDraw );
begin
  DF.fOnTBCustomDraw := Value;
  AttachProc( WndProcTBCustomDraw );
end;


procedure TControl.SetDroppedDown(const Value: Boolean);
begin
  Perform( CB_SHOWDROPDOWN, Integer( Value ), 0 );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.AddDirList(const Filemask: KOLString; Attrs: DWORD);
begin
  if fCommandActions.aDir <> 0 then
  Perform( fCommandActions.aDir, Attrs, Integer( PKOLChar( Filemask ) ) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_noVERSION}
{$ELSE PAS_VERSION} //Pascal
function WndProcShowModal( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
//var Accept: Boolean; // {Alexander Pravdin, AP}
begin
  Result := FALSE;
  if Msg.message = WM_CLOSE then
  begin
    if  Self_.DF.fModalResult = 0 then { (Sergey Shishmintzev) }
        Self_.DF.fModalResult := -1;
    Rslt := 0;
    Result := True; // Do not process !
  end
  ;
end;
{$ENDIF PAS_VERSION}

// by TR"]F
function WndProcFixModal( Self_: PControl; var Msg: TMsg; var Rslt:
Integer ): Boolean;
const HTERROR = $FFFE;
       LBtnDown = $201;
       LBtnUp = $202;
       RBtnDown = $204;
       RBtnUp = $205;
       WeelDown = $207;
       WeelUp = $208;
{$IFDEF MODAL_ACTIVATE_FIX}
var i: Integer;
    C: PControl;
{$ENDIF MODAL_ACTIVATE_FIX}
begin
   Result := false;
   if (Msg.message = WM_SETCURSOR) then
   if (LoWord(Msg.lParam) = HTERROR) then
   if (HiWord(Msg.lParam) >= LBtnDown) and
      (HiWord(Msg.lParam) <= RBtnUp) then
   begin
   if  Applet.DF.fModalForm <> nil then
       SetForegroundWindow(Applet.DF.fModalForm.Handle);
   Rslt := 1;
   Result := TRUE;
   end;

   {$IFDEF MODAL_ACTIVATE_FIX}
   if (Msg.message = WM_ACTIVATEAPP) then
   begin
      if not Applet.DF.fActivating then
      begin
          Applet.DF.fActivating := TRUE;
          if Msg.wParam <> 0 then
          begin
            for i := Applet.ChildCount-1 downto 0 do
            begin
              C := Applet.Children[ i ];
              if C.Visible and not C.Enabled then
                SetForegroundWindow( C.Handle );
            end;
            if  Applet.DF.fModalForm <> nil then
                SetForegroundWindow( Applet.DF.fModalForm.Handle );
          end;
          Applet.DF.fActivating := FALSE;
      end;
   end;
   {$ENDIF MODAL_ACTIVATE_FIX}
end;

{$IFDEF ASM_noVERSION} // ASM_TLIST!
function TControl.ShowModal: Integer;
asm
        MOV      ECX, [EAX].fParent
        JECXZ    @@show
        MOVZX    ECX, [EAX].fIsControl
        JECXZ    @@show_modal
@@show:
        CALL     Show
        XOR      EAX, EAX
        RET
@@show_modal:
        PUSHAD
          MOV      EBX, EAX
          MOV      EDI, [Applet]
        XOR      EBP, EBP  // CurCtl = nil
          MOV      EAX, [EDI].fCurrentControl
          {$IFDEF  USE_FLAGS}
          TEST     [EDI].TControl.fFlagsG3, (1 shl G3_IsApplet)
          {$ELSE}
          CMP      [EDI].TControl.FIsApplet, 0
          {$ENDIF}
          {$IFDEF USE_CMOV}
          CMOVZ    EAX, EDI
          {$ELSE}
          JNZ      @@curctrl_save
          MOV      EAX, EDI
@@curctrl_save:
        {$ENDIF}
        PUSH     EAX
          MOV      EDX, offset[WndProcShowModal]
          PUSH     EDX
        MOV      EAX, EBX
        CALL     TControl.AttachProc
        XOR      EDX, EDX
        MOV      [EBX].fModalResult, EDX
          CALL     NewList
          XCHG     EAX, EBP
        XOR      ECX, ECX
        INC      ECX
        MOV      ESI, EDI
          {$IFDEF  USE_FLAGS}
          TEST     [EDI].TControl.fFlagsG3, (1 shl G3_IsApplet)
          {$ELSE}
          CMP      [EDI].TControl.FIsApplet, 0
          {$ENDIF}
          JZ       @@isapplet
        MOV      EBP, [EDI].fCurrentControl // CurCtl = Applet.fCurrentControl
          MOV      ESI, [EDI].fChildren
          MOV      ECX, [ESI].TList.fCount
          MOV      ESI, [ESI].TList.fItems
@@1loo: LODSD
@@isapplet:
        PUSH     ECX
        CMP      EAX, EBX
        JE       @@1nx
        PUSH     EAX
        CALL     GetEnabled
        TEST     AL, AL
        POP      EAX
        JZ       @@1nx
        PUSH     EAX
        MOV      DL, 0
        CALL     SetEnabled
        POP      EDX
        MOV      EAX, EBP
        CALL     TList.Add
@@1nx:  POP      ECX
        LOOP     @@1loo
            INC      [EBX].fModal
            MOV      EAX, [Applet]
            MOV      [EAX].fModalForm, EBX
          MOV      EAX, EBX
          CALL     Show
@@msgloo:
        MOVZX    ECX, [AppletTerminated]
        OR       ECX, [EBX].fModalResult
        JNZ      @@e_msgloo
        CALL     WaitMessage
        MOV      EAX, EDI
        CALL     ProcessMessages
        {$IFDEF USE_OnIdle}
        MOV      EAX, EBX
        CALL     [ProcessIdle]
        {$ENDIF}
        JMP      @@msgloo
@@e_msgloo:
        POP      EDX
        MOV      EAX, EBX
        CALL     TControl.DetachProc
            DEC      [EBX].fModal
            MOV      EAX, [Applet]
            XOR      ECX, ECX
            MOV      [EAX].fModalForm, ECX
          MOV      ECX, [EBP].TList.fCount
          JECXZ    @@2end
          MOV      ESI, [EBP].TList.fItems
@@2loo: LODSD
        PUSH     ECX
        MOV      DL, 1
        CALL     TControl.SetEnabled
        POP      ECX
        LOOP     @@2loo
@@2end:
          MOV      EAX, EBP
          CALL     TObj.Free
        POP      ECX
        JECXZ    @@exit
        PUSH     0
        PUSH     WA_ACTIVE
        PUSH     WM_ACTIVATE
        PUSH     [ECX].fHandle
        CALL     PostMessage
          TEST     EBP, EBP  // CurCtl = nil ?
          JZ       @@exit
          MOV      EAX, EBP
          MOV      DL, 1
          CALL     TControl.SetFocused
@@exit:
        POPAD
        MOV      EAX, [EAX].fModalResult
end;
{$ELSE PAS_VERSION} //Pascal
{$IFDEF USE_SHOWMODALPARENTED_ALWAYS}
function TControl.ShowModal: Integer;
begin
  Result := ShowModalParented(Applet);
end;
{$ELSE not USE_SHOWMODALPARENTED_ALWAYS}
function TControl.ShowModal: Integer;
var FL: PList;
var CurForm: PControl;
    I: Integer;
    F: PControl;
    CurCtl: PControl; // { Alexander Pravdin }
begin
  Result := 0;
  if  {$IFDEF USE_FLAGS} (G3_IsControl in fFlagsG3)
      {$ELSE} (fIsControl) {$ENDIF}
  or  (fParent = nil) then
  begin
    Show; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  AttachProc( WndProcShowModal );
  CurForm := Applet.DF.fCurrentControl;
  FL := NewList;
  CurCtl := nil; // { Alexander Pravdin }

  if Applet.IsApplet then
  begin
    for I := 0 to Applet.ChildCount - 1 do
    begin
        F := Applet.fChildren.Items[ I ];
        if F <> @Self then
        if F.Enabled then
        begin
           FL.Add( F );
           F.Enabled := FALSE;
           {$IFNDEF NOT_FIX_MODAL}
           Inc( F.DF.fFixingModal );
           F.AttachProc(WndProcFixModal);     {**************}
           {$ENDIF}
        end;
    end
  end
    else
      begin
        CurForm := Applet;
        if  Applet.Enabled then
        begin
            FL.Add( Applet );
            CurCtl := Applet.DF.fCurrentControl; { Alexander Pravdin }
            Applet.Enabled := FALSE;
            {$IFNDEF NOT_FIX_MODAL}
            Inc( Applet.DF.fFixingModal );
            Applet.AttachProc(WndProcFixModal);  {**************}
            {$ENDIF}
        end;
      end;

  Inc( DF.fModal );
  Applet.DF.fModalForm := @ Self;
  Enabled := TRUE;

  ModalResult := 0;
  Show;
  while not AppletTerminated and (ModalResult = 0) do
  begin
    WaitMessage;
    Applet.ProcessMessages;
    {$IFDEF USE_OnIdle}
    ProcessIdle( @Self );
    {$ENDIF}
  end;

  Dec( DF.fModal );
  Applet.DF.fModalForm := nil;

  DetachProc( WndProcShowModal );
  for I := 0 to FL.Count - 1 do
  begin
    F := FL.Items[ I ];
    {$IFNDEF NOT_FIX_MODAL}
    Dec( F.DF.fFixingModal );
    if  F.DF.fFixingModal <= 0 then
        F.DetachProc(WndProcFixModal);  {**************}
    {$ENDIF}
    F.Enabled := TRUE;
  end;
  FL.Free;

  if CurForm <> nil then
    PostMessage( CurForm.Handle, WM_ACTIVATE, WA_ACTIVE, 0 );
  if CurCtl <> nil then CurCtl.SetFocused( TRUE ); { Alexander Pravdin }

  Result := ModalResult;
end;
{$ENDIF USE_SHOWMODALPARENTED_ALWAYS}
{$ENDIF PAS_VERSION}

{$IFNDEF NEW_MODAL}
function TControl.ShowModalParented( const AParent: PControl ): Integer;
begin
  Result := 0;
end;
{$ELSE NEW_MODAL defined}
function TControl.ShowModalParented( const AParent: PControl ): Integer;
var
  FL: PList;
  OldMF, F: PControl;
  I: Integer;
begin
  Result := 0;
  if ( AParent = nil ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Inc( DF.fModal );
  FL := NewList;
  OldMF := AParent.DF.fModalForm;
  AParent.DF.fModalForm := @Self;
  if  {$IFDEF USE_FLAGS} (G3_IsApplet in AParent.fFlagsG3)
      {$ELSE} AParent.fIsApplet {$ENDIF}
  or  ( AParent.IsMainWindow and
       {$IFDEF USE_FLAGS} (G3_IsForm in AParent.fFlagsG3)
       {$ELSE} AParent.fIsForm {$ENDIF} ) then
  begin
    for I := 0 to AParent.ChildCount - 1 do
    begin
      F := AParent.fChildren.Items[ I ];
      if ( F <> @Self )
      and {$IFDEF USE_FLAGS} (G3_IsForm in F.fFlagsG3)
          {$ELSE}  F.fIsForm {$ENDIF}
      and {$IFDEF USE_FLAGS}
                  not(F3_Disabled in F.fStyle.f3_Style) and
                  (F3_Visible in F.fStyle.f3_Style)
          {$ELSE} F.fEnabled and F.fVisible {$ENDIF} then
      begin
        FL.Add( F );
        F.Enabled := FALSE;
        {$IFNDEF NOT_FIX_MODAL}
        F.AttachProc(WndProcFixModal);     {**************}
        {$ENDIF}
      end;
    end;
  end;

  if  {$IFDEF USE_FLAGS} (G3_IsForm in AParent.fFlagsG3)
      {$ELSE} AParent.fIsForm {$ENDIF}
  and {$IFDEF USE_FLAGS} not(F3_Disabled in AParent.fStyle.f3_Style)
      {$ELSE} AParent.Enabled {$ENDIF} then
  begin
      FL.Add( AParent );
      AParent.Enabled := FALSE;
  end;

  ModalResult := 0;
  Show;
  while not AppletTerminated and ( ModalResult = 0 ) do
  begin
    WaitMessage;
    AParent.ProcessMessages;
{$IFDEF USE_OnIdle}
    ProcessIdle( @Self );
{$ENDIF}
  end;

  AParent.DF.fModalForm := OldMF;
  Dec( DF.fModal );
  for I := 0 to FL.Count - 1 do
  begin
    F := PControl( FL.Items[ I ] );
    F.Enabled := True;
    {$IFNDEF NOT_FIX_MODAL}
    F.DetachProc(WndProcFixModal);  {**************}
    {$ENDIF}
  end;
  FL.Free;
  Hide;
  Result := ModalResult;
end;
{$ENDIF NEW_MODAL}

function DisableWindows( W: hwnd; LPARAM: Integer ): Bool; stdcall;
var FL: PList;
    Buf: Array[ 0..127 ] of AnsiChar;
begin
  FL := Pointer( LPARAM );
  if IsWindowEnabled( W ) and (W <> FL.Tag) then
  begin
    GetClassName( W, @ Buf[ 0 ], Sizeof( Buf ) );
    if Buf <> 'ComboLBox' then
    begin
      FL.Add( Pointer( W ) );
      EnableWindow( W, FALSE );
    end;
  end;
  Result := TRUE;
end;

function TControl.ShowModalEx: Integer;
var FL: PList;
var CurForm: PControl;
    I: Integer;
    W: HWnd;
    CurCtl: PControl; { Alexander Pravdin }
begin
  Result := 0;
  if  {$IFDEF USE_FLAGS} (G3_IsControl in fFlagsG3)
      {$ELSE} (fIsControl) {$ENDIF}
  or  (fParent = nil) then
  begin
    Show; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  AttachProc( WndProcShowModal );
  CurForm := Applet.DF.fCurrentControl;
  FL := NewList;
  FL.Tag := fHandle;
  // ++++ { Alexander Pravdin }
  if   {$IFDEF USE_FLAGS} not(G3_IsApplet in Applet.fFlagsG3)
       {$ELSE} not Applet.fIsApplet {$ENDIF} then
       CurCtl := Applet.DF.fCurrentControl
  else CurCtl := nil;
  // ----
  CreateWindow;

  EnumThreadWindows( GetCurrentThreadID, @ DisableWindows, Integer( FL ) );
  Enabled := TRUE;

  Inc( DF.fModal );
  Applet.DF.fModalForm := @ Self;
  Show;
  DF.fModalResult := 0;
  while not AppletTerminated and (DF.fModalResult = 0) do
  begin
    WaitMessage;
    Applet.ProcessMessages;
    {$IFDEF USE_OnIdle}
    ProcessIdle( @Self );
    {$ENDIF}
  end;

  Dec( DF.fModal );
  Applet.DF.fModalForm := @ Self;

  DetachProc( WndProcShowModal );

  for I := 0 to FL.Count - 1 do
  begin
    W := THandle( FL.Items[ I ] );
    EnableWindow( W, TRUE );
  end;
  FL.Free;

  if CurForm <> nil then
    PostMessage( CurForm.Handle, WM_ACTIVATE, WA_ACTIVE, 0 );
  if CurCtl <> nil then CurCtl.SetFocused( True ); { Alexander Pravdin }
  Result := ModalResult;
end;

function TControl.GetModal: Boolean;
begin
  Result := DF.fModal > 0;
end;

{$IFDEF USE_SETMODALRESULT}
procedure TControl.SetModalResult( const Value: Integer );
begin
  DF.fModalResult := Value;
  if  Value <> 0 then
      PostMessage( GetWindowHandle, 0, 0, 0 );
end;
{$ENDIF}

{$IFNDEF NEW_MENU_ACCELL}
procedure TControl.DoDestroyAccelTable;
begin
   if fAccelTable <> 0 then
   begin
     DestroyAcceleratorTable( fAccelTable );
     fAccelTable := 0;
   end;
end;
{$ENDIF}

{$ENDIF WIN_GDI} //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION control_clicked( Obj: PGtkWidget; Sender: PControl ): Boolean; cdecl;
BEGIN
  IF  Assigned( Sender.fOnClick ) THEN
      Sender.fOnClick( Sender );
  Result := FALSE;
END;
{$ENDIF GTK}
{$ENDIF _X_}

procedure TControl.SetOnClick( const Value: TOnEvent );
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnClick := Value;
  {$IFDEF GTK}
  IF fEventboxHandle = fHandle THEN
  BEGIN
    {$IFNDEF SMALLER_CODE}
    IF NOT Assigned( Value ) THEN
      gtk_signal_disconnect( GTK_OBJECT( fEventboxHandle ), fClickedEvent )
    ELSE
    {$ENDIF SMALLEST_CODE}
    fClickedEvent := gtk_signal_connect( GTK_OBJECT( fEventboxHandle ),  'clicked',
      @ control_clicked, @ Self )
  END ELSE SetMouseEvent( @ Self, 'button_release_event' );
  {$ENDIF GTK}
end;
//////////////////////////////////////////////////////////////////
//                          T  I  M  E  R
//////////////////////////////////////////////////////////////////

var {$IFDEF WIN} TimerOwnerWnd: PControl; {$ENDIF} // in Linux, timer not need in a window
    TimerCount: Integer = 0;

{ -- Constructor of timer -- }

function NewTimer( Interval: Integer ): PTimer;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TTimer';
  {$ENDIF}
  if Interval <= 0 then Interval := 1000;
  Result.fInterval := Interval;
  Inc( TimerCount );
end;

{ -- Timer procedure -- }

{$IFDEF WIN}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TimerProc( Wnd : HWnd; Msg : Integer; T : PTimer; CurrentTime : DWord ): Integer;
          stdcall;
begin
  {$IFDEF STOPTIMER_AFTER_APPLETTERMINATED}
  if not AppletTerminated then
  {$ENDIF}
  if  Assigned( T.fOnTimer ) then
      T.fOnTimer( T );
   Result := 0;
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN}

{ TTimer }

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TTimer.Destroy;
begin
  Enabled := False;
  inherited;
  Dec( TimerCount );
  {$IFDEF WIN}
  if TimerCount = 0 then
  begin
    TimerOwnerWnd.Free;
    TimerOwnerWnd := nil;
  end;
  {$ENDIF WIN}
end;
{$ENDIF PAS_VERSION}

{$IFDEF WIN_GDI}
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TTimer.SetEnabled(const Value: Boolean);
var WasEnabled: Boolean;
begin
  WasEnabled := fEnabled;
  fEnabled := Value;
  if WasEnabled = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$IFDEF TIMER_APPLETWND}
  if Applet = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$ENDIF}

  if Value then
  begin
    {$IFDEF TIMER_APPLETWND}
    fHandle := SetTimer( Applet.GetWindowHandle, Integer( @Self ),
                         fInterval, @TimerProc );
    {$ELSE}
    if TimerOwnerWnd = nil then
    begin
        TimerOwnerWnd := _NewWindowed( nil, '', TRUE,
            {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS )
            {$ELSE} nil {$ENDIF} );
        TimerOwnerWnd.fStyle.Value := 0;
        {$IFDEF USE_FLAGS} include( TimerOwnerWnd.fFlagsG3, G3_IsControl );
        {$ELSE} TimerOwnerWnd.fIsControl := TRUE; {$ENDIF}
    end;
    fHandle := SetTimer( TimerOwnerWnd.GetWindowHandle, Integer( @Self ),
                         fInterval, @TimerProc );
    {$ENDIF}
  end
     else
  begin
    if fHandle <> 0 then
    begin
      KillTimer( {$IFDEF TIMER_APPLETWND} Applet.fHandle
                 {$ELSE} TimerOwnerWnd.fHandle {$ENDIF}, fHandle );
      fHandle := 0;
    end;
  end;
end;
{$ENDIF PAS_VERSION}
{$ENDIF WIN_GDI}

{$IFDEF _X_}
{$IFDEF GTK}
FUNCTION TimerGTKTick( Sender: Pointer ): LONGBOOL; cdecl;
BEGIN
  IF NOT PTimer( Sender ).fEnabled THEN Result := FALSE
  ELSE
  BEGIN
    IF  Assigned( PTimer( Sender ).fOnTimer ) THEN
        Ptimer( Sender ).fOnTimer( Sender );
    Result := PTimer( Sender ).fEnabled;
  END;
  IF  Result THEN
      PTimer( Sender ).RefDec;
END;

PROCEDURE TTimer.SetEnabled(const Value: Boolean);
BEGIN
  IF FEnabled = Value THEN Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fEnabled := Value;
  IF  Value THEN
  BEGIN
      RefInc;
      fHandle := gtk_timeout_add( fInterval, TimerGTKTick, @ Self );
  END ELSE
  BEGIN
    IF  AppletTerminated THEN
    BEGIN
        gtk_timeout_remove( fHandle );
        RefDec;
    END;
  END;
END;
{$ELSE not GTK}
VAR fActiveTimerList: PTimer;
    fClockPerSecond: Integer;
    fAlarmHandling: Boolean;

PROCEDURE SetAlarm; FORWARD;

PROCEDURE AlarmHandler(SigNum: Integer); CDECL;
VAR T, NT: PTimer;
    c: Integer;
    count_handled: Integer;
BEGIN
  c := clock;
  fAlarmHandling := TRUE; // to prevent SetAlarm working while timers are handling
  TRY
    //--- 1. Clear fTimerHandled flag for all active timers
    T := fActiveTimerList;
    WHILE T <> nil DO
    BEGIN
      T.fTimerHandled := FALSE;
      T := T.fNext;
    END;
    //--- 2. Handle all expired timers
    count_handled := 0;
    WHILE not AppletTerminated DO // until all timers expired are handled or
    BEGIN                         // until the application is terminated
      //--- 2.A. Search a timer which was expired before all others
      T := fActiveTimerList;
      NT := nil;
      WHILE T <> nil do
      BEGIN
        IF not T.fTimerHandled and (
            (NT = nil) or ((T.fExpireNext - c) < (NT.fExpireNext - c))
           ) THEN
           NT := T;
        T := T.fNext;
      END;
      IF NT = nil then break; // there are no more timers expired
      IF (count_handled > 0) and
         ((NT.fExpireNext - c > 0) or (NT.fExpireNext < 0) and (c > 0)) then break;
      //--- 2.B. Handle found timer (NT)
      inc( count_handled ); // count handled timer to ensure that at least 1 timer
                            // was handled in result of alarm call
      {$IFDEF SUPPORT_LONG_TIMER}
      NT.fExpireTotal := NT.fExpireTotal - (c - NT.fTimeStart);
      IF NT.fExpireTotal > 30 * 60 * fClockPerSecond then
        NT.fExpireNext := c + 30 * 60 * fClockPerSecond
      ELSE
        NT.fExpireNext := c + NT.fExpireTotal;
      {$ELSE not SUPPORT_LONG_TIMER}
      NT.fExpireNext := // next time to expire this timer
        NT.fExpireNext + fClockPerSecond * NT.fInterval;
      {$ENDIF SUPPORT_LONG_TIMER}
      NT.fTimerHandled := TRUE; // do not handle that timer again in that loop
      {$IFDEF SUPPORT_LONG_TIMER}
      IF NT.fExpireTotal <= 0 then
      {$ENDIF SUPPORT_LONG_TIMER}
      BEGIN IF  NT.fMultimedia and not NT.fPeriodic then
                NT.Enabled := FALSE; // one-shot timer, disable it now
            IF  Assigned( NT.fOnTimer ) then
                NT.fOnTimer( NT ); // in result of this action, timer NT or any
                // other active timer can be disabled and dropped from
                // fActiveTimerList and any amount of previously disabled timers
                // can be added
      END;
    END;
  FINALLY
    fAlarmHandling := FALSE;
  END;
  // 3. finally, install the next alarm to the nearest expirating timer if any
  SetAlarm;
END;

PROCEDURE SetAlarm;
VAR i: Integer;
    T, NT: PTimer;
    TV: itimerval;
    c: clock_t;
BEGIN
  IF  AppletTerminated then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      // if the application is terminated we do not install alarms
  IF  fAlarmHandling then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      // while alarm is handling do not reinstall alarms
  c := clock;
  T := fActiveTimerList;
  NT := T;
  WHILE T <> nil do
  BEGIN
    if (T.fExpireNext - c) < (NT.fExpireNext - c) then
      NT := T;
    T := T.fNext;
  END;
  IF NT = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  i := (NT.fExpireNext - c) * 1000 div fClockPerSecond;
  IF i < 0 then i := 10; // 10 milliseconds as minimum time to alarm
  TV.it_interval.tv_sec := 0; // set interval to alarm once
  TV.it_interval.tv_usec := 0;
  TV.it_value.tv_sec := i div 1000; // set time to alarm next time
  TV.it_value.tv_usec := (i mod 1000) * 1000;
  signal( SIGALRM, AlarmHandler );
  setitimer( ITIMER_REAL, TV, nil );
END;

PROCEDURE TTimer.SetEnabled(const Value: Boolean);
BEGIN
  IF FEnabled = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fEnabled := Value;
  IF Value then
  BEGIN
    IF fClockPerSecond = 0 then
      fClockPerSecond := CLK_TCK;
    fExpireTotal := Int64( fClockPerSecond ) * fInterval;
    {$IFDEF SUPPORT_LONG_TIMER}
    IF fExpireTotal > 30 * 60 * fClockPerSecond then
      fExpireNext := clock + 30 * 60 * fClockPerSecond
    ELSE
      fExpireNext := clock + fExpireTotal;
    {$ELSE}
    fExpireNext := clock + fExpireTotal;
    {$ENDIF SUPPORT_LONG_TIMER}
    IF fActiveTimerList <> nil then
    BEGIN
      fNext := fActiveTimerList;
      fActiveTimerList.fPrev := @ Self;
    END;
    fActiveTimerList := @ Self;
  END ELSE
  BEGIN
    IF fPrev <> nil then fPrev.fNext := fNext;
    IF fNext <> nil then fNext.fPrev := fPrev;
    IF fActiveTimerList = @ Self then
       fActiveTimerList := fNext;
    fPrev := nil;
    fNext := nil;
  end;
  if fActiveTimerList <> nil then
     SetAlarm; // set alarm to the nearest expiring timer
END;
{$ENDIF not GTK}
{$ENDIF _X_}

procedure TTimer.SetInterval(const Value: Integer);
var WasEnabled : Boolean;
begin
  if fInterval = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fInterval := Value;
  WasEnabled := Enabled;
  Enabled := False;
  Enabled := WasEnabled {$IFDEF STOPTIMER_AFTER_APPLETTERMINATED}
                        and not AppletTerminated
                        {$ENDIF};
end;

{$IFDEF WIN}
{ TMMTimer }

{ ------------ declarations moved here from MMSystem -------------------- }
const
  TIME_ONESHOT    = 0;   { program timer for single event }
  TIME_PERIODIC   = 1;   { program for continuous periodic event }
  TIME_CALLBACK_FUNCTION    = $0000;  { callback is function }
  TIME_CALLBACK_EVENT_SET   = $0010;  { callback is event - use SetEvent }
  TIME_CALLBACK_EVENT_PULSE = $0020;  { callback is event - use PulseEvent }

type
  TFNTimeCallBack = procedure(uTimerID, uMessage: UINT;
    dwUser, dw1, dw2: DWORD) stdcall;
function timeSetEvent(uDelay, uResolution: UINT;
  lpFunction: TFNTimeCallBack; dwUser: DWORD; uFlags: UINT): THandle; stdcall;
  external 'winmm.dll' name 'timeSetEvent';
function timeKillEvent(uTimerID: UINT): Integer; stdcall;
  external 'winmm.dll' name 'timeKillEvent';
{ ----------------------------------------------------------------------- }

procedure MMTimerCallback(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD);
          stdcall;
var MMTimer: PMMTimer;
begin
  MMTimer := Pointer( dwUser );
  if Assigned( MMTimer.FOnTimer ) then
    MMTimer.fOnTimer( MMTimer );
end;

function NewMMTimer( Interval: Integer ): PMMTimer;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TMMTimer';
  {$ENDIF}
  Result.fInterval := Interval;
  Result.FPeriodic := TRUE;
end;

destructor TMMTimer.Destroy;
begin
  Enabled := FALSE;
  Inc( TimerCount );
  inherited;
end;

procedure TMMTimer.SetEnabled(const Value: Boolean);
begin
  if Value xor (fHandle <> 0) then
  begin
    if fHandle = 0 then
      fHandle := timeSetEvent( Interval, Resolution, MMTimerCallback, DWORD( @ Self ),
              Integer( Periodic ) or TIME_CALLBACK_FUNCTION )
    else
    begin
      timeKillEvent( fHandle );
      fHandle := 0;
    end;
  end;
  fEnabled := Value;
end;
{$ENDIF WIN}
{$IFDEF LIN}
function NewMMTimer( Interval: Integer ): PTimer;
begin
  Result := NewTimer( Interval );
    {$IFNDEF GTK}
    {$IFNDEF QT}
  Result.fMultimedia := TRUE;
  Result.fPeriodic := TRUE;
  Result.fResolution := 1;
    {$ENDIF  QT}
    {$ENDIF  GTK}
end;
{$ENDIF LIN}

{$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
////////////////////////////////////////////////////////////////////////
//                         t  B  I  T  M  A  P
///////////////////////////////////////////////////////////////////////

{ -- bitmap -- }

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function PrepareBitmapHeader( W, H, BitsPerPixel: Integer ): PBitmapInfo;
begin
  {$IFDEF KOL_ASSERTIONS}
  Assert( W > 0, 'Width must be >0' );
  Assert( H > 0, 'Height must be >0' );
  {$ENDIF KOL_ASSERTIONS}
  Result := AllocMem( 256*Sizeof(TRGBQuad)+Sizeof(TBitmapInfoHeader) );
  {$IFDEF KOL_ASSERTIONS}
  Assert( Result <> nil, 'No memory' );
  {$ENDIF KOL_ASSERTIONS}
  Result.bmiHeader.biSize := Sizeof( TBitmapInfoHeader );
  Result.bmiHeader.biWidth := W;
  Result.bmiHeader.biHeight := H; // may be, -H ?
  Result.bmiHeader.biPlanes := 1;
  Result.bmiHeader.biBitCount := BitsPerPixel;
end;
{$ENDIF PAS_VERSION}

const
  BitsPerPixel_By_PixelFormat: array[ TPixelFormat ] of Byte =
                               ( 0, 1, 4, 8, 16, 16, 24, 32, 0 );

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function Bits2PixelFormat( BitsPerPixel: Integer ): TPixelFormat;
var I: TPixelFormat;
begin
  for I := High(I) downto Low(I) do
    if BitsPerPixel = BitsPerPixel_By_PixelFormat[ I ] then
    begin
      Result := I; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  Result := pfDevice;
end;
{$ENDIF PAS_VERSION}

procedure DummyDetachCanvas( Sender: PBitmap );
begin
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewBitmap( W, H: Integer ): PBitmap;
var DC: HDC;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TBitmap';
  {$ENDIF}
  Result.fHandleType := bmDDB;
  Result.fDetachCanvas := DummyDetachCanvas;
  Result.fWidth := W;
  Result.fHeight := H;
  if (W <> 0) and (H <> 0) then
  begin
    DC := GetDC( 0 );
    Result.fHandle := CreateCompatibleBitmap( DC, W, H );
    {$IFDEF KOL_ASSERTIONS}
    Assert( Result.fHandle <> 0, 'Can not create bitmap handle' );
    {$ENDIF KOL_ASSERTIONS}
    ReleaseDC( 0, DC );
  end;
end;
{$ENDIF PAS_VERSION}

const InitColors: array[ 0..17 ] of DWORD = ( $F800, $7E0, $1F, 0, $800000, $8000,
      $808000, $80, $800080, $8080, $808080, $C0C0C0, $FF0000, $FF00, $FFFF00, $FF,
      $FF00FF, $FFFF );
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure PreparePF16bit( DIBHeader: PBitmapInfo );
begin
        DIBHeader.bmiHeader.biCompression := BI_BITFIELDS;
        Move( InitColors[ 0 ], DIBHeader.bmiColors[ 0 ], 19*Sizeof(TRGBQUAD) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function NewDIBBitmap( W, H: Integer; PixelFormat: TPixelFormat ): PBitmap;
const BitsPerPixel: array[ TPixelFormat ] of Byte = ( 0, 1, 4, 8, 16, 16, 24, 32, 0 );
var BitsPixel: Integer;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TBitmap:DIBBitmap';
  {$ENDIF}
  Result.fDetachCanvas := DummyDetachCanvas;
  Result.fWidth := W;
  Result.fHeight := H;
  if (W <> 0) and (H <> 0) then
  begin
    BitsPixel := BitsPerPixel[ PixelFormat ];
    if BitsPixel = 0 then
    begin
       Result.fNewPixelFormat := DefaultPixelFormat;
       BitsPixel := BitsPerPixel[DefaultPixelFormat];
    end
       else
       Result.fNewPixelFormat := PixelFormat;
    {$IFDEF KOL_ASSERTIONS}
    ASSERT( Result.fNewPixelFormat in [ pf1bit..pf32bit ], 'Strange pixel format' );
    {$ENDIF KOL_ASSERTIONS}
    Result.fDIBHeader := PrepareBitmapHeader( W, H, BitsPixel );
    if PixelFormat = pf16bit then
    begin
      PreparePF16bit( Result.fDIBHeader );
    end;

    Result.fDIBSize := Result.ScanLineSize * H;
    Result.fDIBBits :=
      Pointer( GlobalAlloc( GMEM_FIXED or GMEM_ZEROINIT, Result.fDIBSize + 16 ) );
    {$IFDEF KOL_ASSERTIONS}
    ASSERT( Result.fDIBBits <> nil, 'No memory' );
    {$ENDIF KOL_ASSERTIONS}
  end;
end;
{$ENDIF PAS_VERSION}

{ TBitmap }

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.ClearData;
begin
  fDetachCanvas( @Self );
  if fHandle <> 0 then
  begin
    DeleteObject( fHandle );
    fHandle := 0;
    fDIBBits := nil;
  end;
  if fDIBBits <> nil then
  begin
    if not fDIBAutoFree then
      GlobalFree( THandle( fDIBBits ) );
    fDIBBits := nil;
  end;
  if fDIBHeader <> nil then
  begin
    FreeMem( fDIBHeader );
    fDIBHeader := nil;
  end;
  fScanLineSize := 0;
  fGetDIBPixels := nil;
  fSetDIBPixels := nil;
  ClearTransImage;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.Clear;
begin
  RemoveCanvas;
  ClearData;
  fWidth := 0;
  fHeight := 0;
  fDIBAutoFree := FALSE;
end;
{$ENDIF PAS_VERSION}

function TBitmap.GetBoundsRect: TRect;
begin
  Result := MakeRect( 0, 0, Width, Height );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TBitmap.Destroy;
begin
  Clear;
  inherited;
end;
{$ENDIF PAS_VERSION}

function TBitmap.BitsPerPixel: Integer;
var B: tagBitmap;
begin
  CASE PixelFormat OF
  pf1bit: Result := 1;
  pf4bit: Result := 4;
  pf8bit: Result := 8;
  pf15bit: Result := 15;
  pf16bit: Result := 16;
  pf24bit: Result := 24;
  pf32bit: Result := 32;
  else begin
         Result := 0;
         if fHandle <> 0 then
         if GetObject( fHandle, Sizeof( B ), @B ) > 0 then
           Result := B.bmBitsPixel * B.bmPlanes;
       end;
  END;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.Draw(DC: HDC; X, Y: Integer);
var
    DCfrom, DC0: HDC;
    oldBmp: HBitmap;
    oldHeight: Integer;
    B: tagBitmap;
label
    TRYAgain;
begin
TRYAgain:
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if fHandle <> 0 then
  begin
    fDetachCanvas( @Self );
    oldHeight := fHeight;
    if GetObject( fHandle, sizeof( B ), @B ) <> 0 then
       oldHeight := B.bmHeight;
    {$IFDEF KOL_ASSERTIONS}
    ASSERT( oldHeight > 0, 'oldHeight must be > 0' );
    {$ENDIF KOL_ASSERTIONS}

    DC0 := GetDC( 0 );
    DCfrom := CreateCompatibleDC( DC0 );
    ReleaseDC( 0, DC0 );

    oldBmp := SelectObject( DCfrom, fHandle );
    {$IFDEF KOL_ASSERTIONS}
    ASSERT( oldBmp <> 0, 'Can not select bitmap to DC' );
    {$ENDIF KOL_ASSERTIONS}

    BitBlt( DC, X, Y, fWidth, oldHeight, DCfrom, 0, 0, SRCCOPY );
    {$IFDEF CHK_BITBLT} Chk_BitBlt; {$ENDIF}

    SelectObject( DCfrom, oldBmp );
    DeleteDC( DCfrom );
  end
     else
  if fDIBBits <> nil then
  begin
    oldHeight := Abs(fDIBHeader.bmiHeader.biHeight);
    {$IFDEF KOL_ASSERTIONS}
    ASSERT( oldHeight > 0, 'oldHeight must be > 0' );
    ASSERT( fWidth > 0, 'Width must be > 0' );
    {$ENDIF KOL_ASSERTIONS}
    if StretchDIBits( DC, X, Y, fWidth, oldHeight, 0, 0, fWidth, oldHeight,
                   fDIBBits, fDIBHeader^, DIB_RGB_COLORS, SRCCOPY ) = 0 then
    begin
      if GetHandle <> 0 then
        goto TRYAgain;
    end;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.StretchDraw(DC: HDC; const Rect: TRect);
var DCfrom: HDC;
    oldBmp: HBitmap;
label DrawHandle;
begin
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
DrawHandle:
  if fHandle <> 0 then
  begin
    fDetachCanvas( @Self );
    DCfrom := CreateCompatibleDC( 0 );
    oldBmp := SelectObject( DCfrom, fHandle );
    {$IFDEF KOL_ASSERTIONS}
    ASSERT( oldBmp <> 0, 'Can not select bitmap to DC' );
    {$ENDIF KOL_ASSERTIONS}
    StretchBlt( DC, Rect.Left, Rect.Top, Rect.Right - Rect.Left,
                Rect.Bottom - Rect.Top, DCfrom, 0, 0, fWidth, fHeight,
                SRCCOPY );
    SelectObject( DCfrom, oldBmp );
    DeleteDC( DCfrom );
  end
     else
  if fDIBBits <> nil then
  begin
    if StretchDIBits( DC, Rect.Left, Rect.Top, Rect.Right - Rect.Left,
                Rect.Bottom - Rect.Top, 0, 0, fWidth, fHeight,
                fDIBBits, fDIBHeader^, DIB_RGB_COLORS, SRCCOPY )<=0 then
    begin
      if GetHandle <> 0 then
        goto DrawHandle;
    end;
  end;
end;
{$ENDIF PAS_VERSION}

procedure TBitmap.DrawMasked(DC: HDC; X, Y: Integer; Mask: HBitmap);
begin
  StretchDrawMasked( DC, MakeRect( X, Y, X + fWidth, Y + fHeight ), Mask );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.DrawTransparent(DC: HDC; X, Y: Integer; TranspColor: TColor);
begin
  if TranspColor = clNone then
    Draw( DC, X, Y )
  else
    StretchDrawTransparent( DC, MakeRect( X, Y, X + fWidth, Y + fHeight ),
                            TranspColor );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.StretchDrawTransparent(DC: HDC; const Rect: TRect; TranspColor: TColor);
begin
  if TranspColor = clNone then
     StretchDraw( DC, Rect )
  else
  begin
    if GetHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    TranspColor := Color2RGB( TranspColor );
    if (fTransMaskBmp = nil) or (fTransColor <> TranspColor) then
    begin
      if fTransMaskBmp = nil then
        fTransMaskBmp := NewBitmap( 0, 0 {fWidth, fHeight} );
      fTransColor := TranspColor;
      // Create here mask bitmap:
      fTransMaskBmp.Assign( @Self );
      fTransMaskBmp.Convert2Mask( TranspColor );
    end;
    StretchDrawMasked( DC, Rect, fTransMaskBmp.Handle );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF DEBUG_DRAWTRANSPARENT}
procedure DebugDrawTransparent( DC: HDC; X, Y, W, H: Integer; PF: TPixelFormat;
  const Note: AnsiString );
const PixelFormatAsStr: array[ TPixelFormat ] of String = ( 'pfDevice', 'pf1bit',
      'pf4bit', 'pf8bit', 'pf15bit', 'pf16bit', 'pf24bit', 'pf32bit', 'pfCustom' );
var Bmp: PBitmap;
begin
  Bmp := NewDibBitmap( W, H, pf32bit );
  BitBlt( Bmp.Canvas.Handle, 0, 0, W, H, DC, X, Y, SrcCopy );
  Bmp.SaveToFile( GetStartDir + PixelFormatAsStr[ PF ] + Note );
  Bmp.Free;
end;
{$ENDIF DEBUG_DRAWTRANSPARENT}

const
  ROP_DstCopy = $00AA0029;
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.StretchDrawMasked(DC: HDC; const Rect: TRect; Mask: HBitmap);
var
  DCfrom, MemDC, MaskDC: HDC;
  MemBmp: HBITMAP;
  //Save4From,
  Save4Mem, Save4Mask: THandle;
  crText, crBack: TColorRef;
  {$IFDEF FIX_TRANSPBMPPALETTE}
  FixBmp: PBitmap;
  {$ENDIF FIX_TRANSPBMPPALETTE}
begin
  {$IFDEF FIX_TRANSPBMPPALETTE}
  if PixelFormat in [ pf4bit, pf8bit ] then
  begin
    FixBmp := NewBitmap( 0, 0 );
    FixBmp.Assign( @ Self );
    FixBmp.PixelFormat := pf32bit;
    FixBmp.StretchDrawMasked( DC, Rect, Mask );
    FixBmp.Free; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  {$ENDIF FIX_TRANSPBMPPALETTE}
  if GetHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  DCFrom := Canvas.Handle;
  MaskDC := CreateCompatibleDC( 0 );
  Save4Mask := SelectObject( MaskDC, Mask );
  {$IFDEF KOL_ASSERTIONS}
  ASSERT( Save4Mask <> 0, 'Can not select mask bitmap to DC' );
  {$ENDIF KOL_ASSERTIONS}
  MemDC := CreateCompatibleDC( 0 );
  MemBmp := CreateCompatibleBitmap( DCfrom, fWidth, fHeight );
  Save4Mem := SelectObject( MemDC, MemBmp ); if Save4Mem <> 0 then;
  {$IFDEF KOL_ASSERTIONS}
  ASSERT( Save4Mem <> 0, 'Can not select memory bitmap to DC' );
  {$ENDIF KOL_ASSERTIONS}
  StretchBlt( MemDC, 0, 0, fWidth, fHeight, MaskDC, 0, 0, fWidth, fHeight, SrcCopy);
  {$IFDEF DEBUG_DRAWTRANSPARENT}
  DebugDrawTransparent( MemDC, 0, 0, fWidth, fWidth, PixelFormat, '1SrcCopy.bmp' );
  {$ENDIF}
  StretchBlt( MemDC, 0, 0, fWidth, fHeight, DCfrom, 0, 0, fWidth, fHeight, SrcErase);
  {$IFDEF DEBUG_DRAWTRANSPARENT}
  DebugDrawTransparent( MemDC, 0, 0, fWidth, fWidth, PixelFormat, '2SrcErase.bmp' );
  {$ENDIF}
  crText := SetTextColor(DC, $0);
  crBack := Windows.SetBkColor(DC, $FFFFFF);
  StretchBlt( DC, Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top,
              MaskDC, 0, 0, fWidth, fHeight, SrcAnd);
  {$IFDEF DEBUG_DRAWTRANSPARENT}
  DebugDrawTransparent( DC, Rect.Left, Rect.Top, fWidth, fHeight, PixelFormat, '3SrcAnd.bmp' );
  {$ENDIF}
  StretchBlt( DC, Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top,
              MemDC, 0, 0, fWidth, fHeight, SrcInvert);
  {$IFDEF DEBUG_DRAWTRANSPARENT}
  DebugDrawTransparent( DC, Rect.Left, Rect.Top, fWidth, fHeight, PixelFormat, '4SrcInvert.bmp' );
  {$ENDIF}
  Windows.SetBkColor( DC, crBack);
  SetTextColor( DC, crText);
  DeleteObject(MemBmp);
  DeleteDC(MemDC);
  SelectObject( MaskDC, Save4Mask );
  DeleteDC( MaskDC );
end;
{$ENDIF PAS_VERSION}

procedure ApplyBitmapBkColor2Canvas( Sender: PBitmap );
begin
  if Sender.fCanvas = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Sender.fCanvas.Brush.Color := Sender.BkColor;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure DetachBitmapFromCanvas( Sender: PBitmap );
begin
  if Sender.fCanvasAttached = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  SelectObject( Sender.fCanvas.fHandle, Sender.fCanvasAttached );
  Sender.fCanvasAttached := 0;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TBitmap.GetCanvas: PCanvas;
var DC: HDC;
begin
  Result := nil;
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if GetHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if fCanvas = nil then
  begin
    fApplyBkColor2Canvas := ApplyBitmapBkColor2Canvas;
    fCanvas := NewCanvas( 0 );
    fCanvas.OnChange := CanvasChanged;
    if fBkColor <> 0 then
      fCanvas.Brush.Color := fBkColor;
  end;
  Result := fCanvas;

  if fCanvas.fHandle = 0 then
  begin
    DC := CreateCompatibleDC( 0 );
    fCanvas.Handle := DC;
    fCanvasAttached := 0;
  end;

  if fCanvasAttached = 0 then
  begin
    fCanvasAttached := SelectObject( fCanvas.Handle, fHandle );
    {$IFDEF KOL_ASSERTIONS}
    ASSERT( fCanvasAttached <> 0, 'Can not select bitmap to DC of Canvas' );
    {$ENDIF KOL_ASSERTIONS}
  end;
  fDetachCanvas := DetachBitmapFromCanvas;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TBitmap.GetEmpty: Boolean;
begin
  Result := (fWidth = 0) or (fHeight = 0);
  {$IFDEF KOL_ASSERTIONS}
  ASSERT( (fWidth >= 0) and (fHeight >= 0), 'Bitmap dimensions can be negative' );
  {$ENDIF KOL_ASSERTIONS}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_noVERSION}
function TBitmap.GetHandle: HBitmap;
asm
        PUSH     EBX
        MOV      EBX, EAX
        CALL     GetEmpty
        JZ       @@exit
          MOV      EAX, EBX
          CALL     [EAX].fDetachCanvas
        MOV      ECX, [EBX].fHandle
        INC      ECX
        LOOP     @@exit
          MOV      ECX, [EBX].fDIBBits
          JECXZ    @@exit
        PUSH     ECX
        PUSH     0
        CALL     GetDC
        PUSH     EAX
        PUSH     0
        PUSH     0
        LEA      EDX, [EBX].fDIBBits
        PUSH     EDX
        PUSH     DIB_RGB_COLORS
        PUSH     [EBX].fDIBHeader
        PUSH     EAX
        CALL     CreateDIBSection
        MOV      [EBX].fHandle, EAX
        PUSH     0
        CALL     ReleaseDC
        POP      EAX
        PUSH     EAX
        MOV      EDX, [EBX].fDIBBits
        MOV      ECX, [EBX].fDIBSize
        CALL     System.Move
        POP      EAX
        CMP      [EBX].fDIBAutoFree, 0
        JNZ      @@freed
        PUSH     EAX
        CALL     GlobalFree
@@freed:MOV      [EBX].fDIBAutoFree, 1
        XOR      EAX, EAX
        MOV      [EBX].fGetDIBPixels, EAX
        MOV      [EBX].fSetDIBPixels, EAX
@@exit:   MOV      EAX, [EBX].fHandle
          POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
function TBitmap.GetHandle: HBitmap;
var OldBits: Pointer;
    DC0: HDC;
begin
  Result := 0;
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fDetachCanvas( @ Self );
  if fHandle = 0 then
  begin
    if fDIBBits <> nil then
    begin
      OldBits := fDIBBits;
      DC0 := GetDC( 0 );
      fDIBBits := nil;
      fHandle := CreateDIBSection( DC0, fDIBHeader^, DIB_RGB_COLORS,
                    fDIBBits, 0, 0 );
      {$IFDEF DEBUG_ANY}
      if fHandle = 0 then
        ShowMessage( 'Can not create DIB section, error: ' + Int2Str( GetLastError ) +
        ', ' + SysErrorMessage( GetLastError ) );
      {$ELSE}
      {$IFDEF KOL_ASSERTIONS}
      ASSERT( fHandle <> 0, 'Can not create DIB section, error: ' + Int2Str( GetLastError ) +
      ', ' + SysErrorMessage( GetLastError ) );
      {$ENDIF KOL_ASSERTIONS}
      {$ENDIF DEBUG_ANY}
      ReleaseDC( 0, DC0 );
      if fHandle <> 0 then
      begin
        Move( OldBits^, fDIBBits^, fDIBSize );
        if not fDIBAutoFree then
          GlobalFree( THandle( OldBits ) );
        fDIBAutoFree := TRUE;

        fGetDIBPixels := nil;
        fSetDIBPixels := nil;
      end
        else
        fDIBBits := OldBits;
    end;
  end;
  Result := fHandle;
end;
{$ENDIF PAS_VERSION}

function TBitmap.GetHandleAllocated: Boolean;
begin
  Result := fHandle <> 0;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.LoadFromFile(const Filename: KOLString);
var Strm: PStream;
begin
  Strm := NewReadFileStream( Filename );
  LoadFromStream( Strm );
  Strm.Free;
end;
{$ENDIF PAS_VERSION}

procedure TBitmap.LoadFromResourceID(Inst: DWORD; ResID: Integer);
begin
  LoadFromResourceName( Inst, MAKEINTRESOURCE( ResID ) );
end;

{$IFDEF ASM_UNICODE}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.LoadFromResourceName(Inst: DWORD; ResName: PKOLChar);
var ResHandle: HBitmap;
    Flg: DWORD;
begin
  Clear;
  Flg := 0;
  if fHandleType = bmDIB then
    Flg := LR_CREATEDIBSECTION;
  ResHandle := LoadImage( Inst, ResName, IMAGE_BITMAP, 0, 0, LR_DEFAULTSIZE or Flg );
  if ResHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Handle := ResHandle;
end;
{$ENDIF PAS_VERSION}

{$IFDEF F_P}
type
  TBITMAPFILEHEADER = packed record
    bfType: Word;
    bfSize: DWORD;
    bfReserved1: Word;
    bfReserved2: Word;
    bfOffBits: DWORD;
  end;
{$ENDIF}

{$IFDEF ASM_noVERSION} // error + 16Colors->swap(Gray,Silver) + Core
procedure TBitmap.LoadFromStream(Strm: PStream);
type  tBFH = TBitmapFileHeader;
      tBIH = TBitmapInfoHeader;
const szBIH = Sizeof( tBIH );
      szBFH = Sizeof( tBFH );
asm
        PUSH     EBX
        PUSH     ESI
        MOV      EBX, EAX
        PUSH     EDX
        CALL     Clear
        POP      ESI
        MOV      EAX, ESI
        CALL     TStream.GetPosition
        PUSH     EAX     // [EBP+4] = Strm.Pos (starting pos)
        PUSH     EBP
        MOV      EBP, ESP
        ADD      ESP, -(szBIH + szBFH)
          // reading bitmap
          XOR      ECX, ECX
          MOV      [EBX].fHandleType, CL
          MOV      CL, szBFH
          MOV      EDX, ESP
          PUSH     ECX
          MOV      EAX, ESI
          CALL     TStream.Read
          POP      ECX
          SUB      ECX, EAX
          JNZ      @@eread1
        CMP      [ESP].tBFH.bfType, $4D42
        JE       @@1
        MOV      EDX, [EBP+4]
        MOV      EAX, ESI
        CALL     TStream.Seek
        XOR      EAX, EAX
        XOR      EDX, EDX
        JMP      @@2
@@1:
        MOV      EDX, [ESP].tBFH.bfSize
        MOV      EAX, [ESP].tBFH.bfOffBits
@@2:
          PUSH     EDX        // Push Size
          PUSH     EAX        // Push Off
          XOR      ECX, ECX
          MOV      CL, szBIH
          LEA      EDX, [EBP-szBIH]
          MOV      EAX, ESI
          PUSH     ECX
          CALL     TStream.Read   // read BIH
          POP      ECX
@@eread1:
        XOR      ECX, EAX
        JNZ      @@eread
          MOVZX    EAX, [EBP-szBIH].tBIH.biBitCount
          MOVZX    EDX, [EBP-szBIH].tBIH.biPlanes
          MUL      EDX
          CALL     Bits2PixelFormat
          {$IFDEF PARANOIA} DB $3C, pf15bit {$ELSE} CMP AL, pf15bit {$ENDIF}
          JNZ      @@no15bit
          CMP      [EBP-szBIH].tBIH.biCompression, 0
          JZ       @@no15bit
          INC      AL // AL = pf16bit
@@no15bit:
        MOV      [EBX].fNewPixelFormat, AL
          MOV      EAX, szBIH + 1024
          CALL     System.@GetMem
          MOV      [EBX].fDIBHeader, EAX
          XCHG     EDX, EAX
          LEA      EAX, [EBP-szBIH]
          XOR      ECX, ECX
          MOV      CL, szBIH
          CALL     System.Move
        MOV      EAX, [EBP-szBIH].tBIH.biWidth
        MOV      [EBX].fWidth, EAX
        MOV      EAX, [EBP-szBIH].tBIH.biHeight
        TEST     EAX, EAX
        JGE      @@20
        NEG      EAX
@@20:   MOV      [EBX].fHeight, EAX
          MOV      EAX, EBX
          CALL     GetScanLineSize
          MOV      EDX, [EBX].fHeight
          MUL      EDX
          MOV      [EBX].fDIBSize, EAX
          PUSH     EAX
          PUSH     GMEM_FIXED or GMEM_ZEROINIT
          CALL     GlobalAlloc
          MOV      [EBX].fDIBBits, EAX
        MOVZX    EAX, [EBP-szBIH].tBIH.biBitCount
        {$IFDEF PARANOIA} DB $3C, 8 {$ELSE} CMP AL, 8 {$ENDIF}
        JA       @@3
        MOV      AL, 4
        MOVZX    ECX, [EBP-szBIH].tBIH.biBitCount
        SAL      EAX, CL
        XCHG     ECX, EAX
@@3:
        CMP      [EBX].TBitmap.fNewPixelFormat, pf16bit
        JNE      @@30
        XOR      ECX, ECX
        MOV      CL, 12 // ColorCount = 12
@@30:
        POP      EAX  // EAX = off
        TEST     EAX, EAX
        JLE      @@4
        SUB      EAX, szBFH + szBIH
        CMP      EAX, ECX
        JZ       @@4
        XCHG     ECX, EAX
@@4:
        JECXZ    @@5
        PUSH     ECX
        MOV      EDX, [EBX].fDIBHeader
        ADD      EDX, szBIH
        MOV      EAX, ESI
        CALL     TStream.Read
        POP      ECX
        XOR      EAX, ECX
        JNZ      @@eread
@@5:
        MOV      ECX, [EBX].fDIBSize
@@7:
        PUSH     ECX
        MOV      EAX, ESI
        CALL     TStream.GetPosition
        PUSH     EAX
        MOV      EAX, ESI
        CALL     TStream.GetSize
        POP      EDX
        SUB      EAX, EDX
        POP      ECX      // Size = fDIBSize
        CMP      EAX, ECX // Strm.Size - Strm.Position > Size ?
        JL       @@8
        XCHG     ECX, EAX
@@8:    // ++++++++++++++ 26-Oct-2003 VK see comment in Pascal
        MOV      EAX, [EBX].fDIBSize
        CMP      ECX, EAX
        JGE      @@9
        SUB      EAX, ECX
        PUSH     EAX
        MOV      EAX, ESI
        PUSH     ECX
        CALL     TStream.GetPosition
        POP      ECX
        POP      EDX
        CMP      EDX, EAX
        JG       @@9
          MOV      EAX, ESI
          NEG      EDX
          XOR      ECX, ECX
          INC      ECX
          CALL     TStream.Seek
        MOV      ECX, [EBX].fDIBSize
@@9:    // ++++++++++++++
        PUSH     ECX
        MOV      EDX, [EBX].fDIBBits
        MOV      EAX, ESI
        CALL     TStream.Read
        POP      ECX
        XOR      EAX, ECX
        POP      EAX // Strm.Size - Position
        POP      ECX // fDIBSize
        // end of reading bitmap
@@eread:
        MOV      ESP, EBP
        POP      EBP
        POP      EDX
        JZ       @@exit
        // not success:
        XCHG     EAX, ESI
        XOR      ECX, ECX // ECX = spBegin
        CALL     TStream.Seek
        XCHG     EAX, EBX
        CALL     Clear
@@exit: POP      ESI
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.LoadFromStream(Strm: PStream);
type
  TColorsArray = array[ 0..15 ] of TColor;
  PColorsArray = ^TColorsArray;
  PColor = ^TColor;
var Pos : DWORD;
    BFH : TBitmapFileHeader;

    function ReadBitmap : Boolean;
    var Size, Size1: Integer;
        BCH: TBitmapCoreHeader;
        RGBSize: DWORD;
        C: PColor;
        Off, HdSz, ColorCount: DWORD;
    begin
      fHandleType := bmDIB;
      Result := False;
      if Strm.Read( BFH, Sizeof( BFH ) ) <> Sizeof( BFH ) then Exit; {>>>>>>>>>}
      Off := 0; Size := 0;
      if BFH.bfType <> $4D42 then
         Strm.Seek( Pos, spBegin )
      else
      begin
         Off := BFH.bfOffBits - Sizeof( BFH );
         Size := BFH.bfSize; // don't matter, just <> 0 is good
      end;
      RGBSize := 4;
      HdSz := Sizeof( TBitmapInfoHeader );
      fDIBHeader := AllocMem( 256*sizeof(TRGBQuad) + HdSz );
      if Strm.Read( fDIBHeader.bmiHeader.biSize, Sizeof( DWORD ) ) <> Sizeof( DWORD ) then
         Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      if fDIBHeader.bmiHeader.biSize = HdSz then
      begin
        if Strm.Read( fDIBHeader.bmiHeader.biWidth, HdSz - Sizeof( DWORD ) ) <>
           HdSz - Sizeof( DWORD ) then
           Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end
        else
      if fDIBHeader.bmiHeader.biSize = Sizeof( TBitmapCoreHeader ) then
      begin
        RGBSize := 3;
        HdSz := Sizeof( TBitmapCoreHeader );
        if Strm.Read( BCH.bcWidth, HdSz - Sizeof( DWORD ) ) <>
           HdSz - Sizeof( DWORD ) then
           Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        fDIBHeader.bmiHeader.biSize := Sizeof( TBitmapInfoHeader );
        fDIBHeader.bmiHeader.biWidth := BCH.bcWidth;
        fDIBHeader.bmiHeader.biHeight := BCH.bcHeight;
        fDIBHeader.bmiHeader.biPlanes := BCH.bcPlanes;
        fDIBHeader.bmiHeader.biBitCount := BCH.bcBitCount;
      end else Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      fNewPixelFormat := Bits2PixelFormat( fDIBHeader.bmiHeader.biBitCount
                         * fDIBHeader.bmiHeader.biPlanes );
      {$IFDEF KOL_ASSERTIONS}
      if (fNewPixelFormat = pf15bit) and (fDIBHeader.bmiHeader.biCompression <> BI_RGB) then
      begin
        ASSERT( fDIBHeader.bmiHeader.biCompression = BI_BITFIELDS, 'Unsupported bitmap format' );
      end;
      {$ENDIF KOL_ASSERTIONS}
      fWidth := fDIBHeader.bmiHeader.biWidth;
      {$IFDEF KOL_ASSERTIONS}
      ASSERT( fWidth > 0, 'Bitmap width must be > 0' );
      {$ENDIF KOL_ASSERTIONS}
      fHeight := Abs(fDIBHeader.bmiHeader.biHeight);
      {$IFDEF KOL_ASSERTIONS}
      ASSERT( fHeight > 0, 'Bitmap height must be > 0' );
      {$ENDIF KOL_ASSERTIONS}

      fDIBSize := ScanLineSize * fHeight;
      fDIBBits :=
        Pointer( GlobalAlloc( GMEM_FIXED or GMEM_ZEROINIT, fDIBSize ) );
      {$IFDEF KOL_ASSERTIONS}
      ASSERT( fDIBBits <> nil, 'No memory' );
      {$ENDIF KOL_ASSERTIONS}

      ColorCount := 0;
      if fDIBHeader.bmiHeader.biBitCount <= 8 then
      begin
        if fDIBHeader.bmiHeader.biClrUsed > 0 then
        ColorCount := fDIBHeader.bmiHeader.biClrUsed * Sizeof( TRGBQuad )
        else
        ColorCount := (1 shl fDIBHeader.bmiHeader.biBitCount) * Sizeof( TRGBQuad )
      end
      else if (fNewPixelFormat in [ pf16bit ]) or
              (fDIBHeader.bmiHeader.biCompression = BI_BITFIELDS) then
             ColorCount := 12;

      if Off > 0 then
      begin
         Off := Off - HdSz;
         if (Off <> ColorCount) then
         if not(fNewPixelFormat in [pf15bit,pf16bit])
         or (Off = 0) //+++ to fix loading 15- and 16-bit bmps with mask omitted
         then
            ColorCount := Min( 1024, Off );
      end;
      if ColorCount <> 0 then
      begin
         if Off >= ColorCount then
           Off := Off - ColorCount;
         if RGBSize = 4 then
         begin
           if Strm.Read( fDIBheader.bmiColors[ 0 ], ColorCount )
              <> DWORD( ColorCount ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
         end
           else
         begin
           C := @ fDIBHeader.bmiColors[ 0 ];
           while ColorCount > 0 do
           begin
             if Strm.Read( C^, RGBSize ) <> RGBSize then Exit; {>>>>>>>>>>>>>>>}
             Dec( ColorCount, RGBSize );
             Inc( C );
           end;
         end;
      end;
      if Off > 0 then
        Strm.Seek( Off, spCurrent );
      if (Size = 0) or (Strm.Size <= 0) then
         Size := fDIBSize
      else
         Size := Min( fDIBSize, Strm.Size - Strm.Position );
      Size1 := Min( Size, fDIBSize );

      if (Size1 < fDIBSize)
         and (DWORD( fDIBSize - Size1 ) <= Strm.Position) then
      begin
        Strm.Seek( Size1 - fDIBSize, spCurrent );
        Size1 := fDIBSize;
      end;
      if Size1 > fDIBSize then Size1 := fDIBSize;
      // +++++++++++++++++++ to fix some "incorrect" bitmaps while loading
      if Strm.Read( fDIBBits^, Size1 ) <> DWORD( Size1 ) then Exit; {>>>>>>>>>>}
      if Size > Size1 then
        Strm.Seek( Size - Size1, spCurrent );
      Result := True;
    end;
begin
  Clear;
  Pos := Strm.Position;
  if not ReadBitmap then
  begin
     Strm.Seek( Pos, spBegin );
     Clear;
  end;
end;
{$ENDIF PAS_VERSION}

////////////////// bitmap RLE-decoding and loading - by Vyacheslav A. Gavrik

// by Vyacheslav A. Gavrik
procedure DecodeRLE4(Bmp:PBitmap;Data:Pointer; MaxSize: DWORD);
  procedure OddMove(Src,Dst:PByte;Size:Integer);
  begin
    if Size=0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    repeat
      Dst^:=(Dst^ and $F0)or(Src^ shr 4);
      Inc(Dst);
      Dst^:=(Dst^ and $0F)or(Src^ shl 4);
      Inc(Src);
      Dec(Size);
    until Size=0;
  end;
  procedure OddFill(Mem:PByte;Size,Value:Integer);
  begin
    Value:=(Value shr 4)or(Value shl 4);
    Mem^:=(Mem^ and $F0)or(Value and $0F);
    Inc(Mem);
    if Size>1 then FillChar(Mem^,Size,Char( Value ))
    else Mem^:=(Mem^ and $0F)or(Value and $F0);
  end;
var
  pb: PByte;
  x,y,z,i: Integer;
begin
  pb:=Data; x:=0; y:=0;
  if Bmp.fScanLineSize = 0 then
     Bmp.ScanLineSize;
  while (y<Bmp.Height) and (DWORD(pb) - DWORD(Data) < MaxSize) do
  begin
    if pb^=0 then
    begin
      Inc(pb);
      z:=pb^;
      case pb^ of
        0: begin
             Inc(y);
             x:=0;
           end;
        1: Break;
        2: begin
             Inc(pb); Inc(x,pb^);
             Inc(pb); Inc(y,pb^);
           end;
        else
        begin
          Inc(pb);
          i:=(z+1)shr 1;
          if i and 1 = 1 then Inc( i );
          if x + z <= bmp.Width then
          if x and 1 =1 then
            OddMove(pb,@PByteArray(Integer( Bmp.fDIBBits ) + Bmp.fScanLineSize * y)[x shr 1],(z+1)shr 1)
          else
            Move(pb^,PByteArray(Integer( Bmp.fDIBBits ) + Bmp.fScanLineSize * y)[x shr 1],(z+1)shr 1);
          Inc(pb,i-1);
          Inc(x,z);
        end;
      end;
    end else
    begin
      z:=pb^;
      Inc(pb);
      if x + z <= Bmp.Width then
        if x and 1 = 1 then
          OddFill(@PByteArray(Integer( Bmp.fDIBBits ) + Bmp.fScanLineSize * y)[x shr 1],(z+1) shr 1,pb^)
        else
          FillChar( PByteArray(Integer( Bmp.fDIBBits ) + Bmp.fScanLineSize * y)[x shr 1],
                    (z+1) shr 1, AnsiChar( pb^ ));
      Inc(x,z);
    end;
    Inc(pb);
  end;
end;

// by Vyacheslav A. Gavrik
procedure DecodeRLE8(Bmp:PBitmap;Data:Pointer; MaxSize: DWORD);
var
  pb: PByte;
  x,y,z,i: Integer;
begin
  pb:=Data; y:=0; x:=0;
  if Bmp.fScanLineSize = 0 then
     Bmp.ScanLineSize;

  while (y<Bmp.Height) and (DWORD(pb) - DWORD(Data) < MaxSize) do
  begin
    if pb^=0 then
    begin
      Inc(pb);
      case pb^ of
        0: begin
             Inc(y);
             x:=0;
           end;
        1: Break;
        2: begin
             Inc(pb); Inc(x,pb^);
             Inc(pb); Inc(y,pb^);
           end;
        else
        begin
          i:=pb^;
          z:=(i+1)and(not 1);
          Inc(pb);
          Move(pb^,PByteArray(Integer( Bmp.fDIBBits ) + Bmp.fScanLineSize * y)[x],i);
          Inc(pb,z-1);
          Inc(x,i);
        end;
      end;
    end else
    begin
      i:=pb^; Inc(pb);
      if x + i <= Bmp.Width then
        FillChar( PByteArray(Integer( Bmp.fDIBBits ) + Bmp.fScanLineSize * y)[x],
                  i, AnsiChar( pb^ ));
      Inc(x,i);
    end;
    Inc(pb);
  end;
end;

function TBitmap.LoadFromFileEx(const Filename: KOLString): Boolean; // by Vyacheslav A. Gavrik
var Strm: PStream;
begin
  Strm := NewReadFileStream( Filename );
  Result := LoadFromStreamEx(Strm);
  Strm.Free;
end;

function TBitmap.LoadFromStreamEx(Strm: PStream): Boolean; // by Vyacheslav A. Gavrik
var Pos : DWORD;
    i: Integer;

    function ReadBitmap : Boolean;
    var Off, Size, ColorCount: Integer;
        BFH : TBitmapFileHeader;
        BCH: TBITMAPCOREHEADER;
        BFHValid: Boolean;
        Buffer: Pointer;
        L: DWORD;
        ColorTriples: Boolean;
        PColr: PDWORD;
        FinalPos: DWORD;
        ZI: DWORD;
    begin
      fHandleType := bmDIB;
      Result := False;
      BFHValid := FALSE;
      if Strm.Read( BFH, Sizeof( BFH ) ) <> Sizeof( BFH ) then Exit; {>>>>>>>>>}
      Off := 0; Size := 0;
      ColorTriples := FALSE;
      if BFH.bfType <> $4D42 then
      begin
         Strm.Seek( Pos, spBegin );
         BFH.bfOffBits := 0;
         BFH.bfSize := 0;
      end
      else
      begin
         BFHValid := TRUE;
         Off := BFH.bfOffBits;
         Size := BFH.bfSize;
      end;
      fDIBHeader := AllocMem( 256*sizeof(TRGBQuad) + sizeof(TBitmapInfoHeader) );
      if Strm.Read( fDIBHeader.bmiHeader.biSize, Sizeof( fDIBHeader.bmiHeader.biSize ) ) <>
        Sizeof( fDIBHeader.bmiHeader.biSize ) then Exit; {>>>>>>>>>>>>>>>>>>>>>}
      if (fDIBHeader.bmiHeader.biSize <> Sizeof( TBITMAPCOREHEADER )) and
         (fDIBHeader.bmiHeader.biSize <> Sizeof( TBitmapInfoHeader )) then
         Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      L := fDIBHeader.bmiHeader.biSize - Sizeof( fDIBHeader.bmiHeader.biSize );
      if (fDIBHeader.bmiHeader.biSize = Sizeof( TBITMAPCOREHEADER )) then
      begin
        if Strm.Read( BCH.bcWidth, L ) <> L then Exit; {>>>>>>>>>>>>>>>>>>>>>>>}
        fDIBHeader.bmiHeader.biSize := Sizeof( TBitmapInfoHeader );
        fDIBHeader.bmiHeader.biWidth := BCH.bcWidth;
        fDIBHeader.bmiHeader.biHeight := BCH.bcHeight;
        fDIBHeader.bmiHeader.biPlanes := BCH.bcPlanes;
        fDIBHeader.bmiHeader.biBitCount := BCH.bcBitCount;
        ColorTriples := TRUE;
      end
        else
      begin
        if Strm.Read( fDIBHeader.bmiHeader.biWidth, L) <> L then
           Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      fNewPixelFormat := Bits2PixelFormat( fDIBHeader.bmiHeader.biBitCount
                         * fDIBHeader.bmiHeader.biPlanes );
      fWidth := fDIBHeader.bmiHeader.biWidth;
      {$IFDEF KOL_ASSERTIONS}
      ASSERT( fWidth > 0, 'Bitmap width must be > 0' );
      {$ENDIF KOL_ASSERTIONS}
      fHeight := Abs(fDIBHeader.bmiHeader.biHeight);
      {$IFDEF KOL_ASSERTIONS}
      ASSERT( fHeight > 0, 'Bitmap height must be > 0' );
      {$ENDIF KOL_ASSERTIONS}

      fDIBSize := ScanLineSize * fHeight;
      ZI := 0;
      if (fDIBHeader.bmiHeader.biCompression = BI_RLE8) or
         (fDIBHeader.bmiHeader.biCompression = BI_RLE4) then
         ZI := GMEM_ZEROINIT;
      fDIBBits := Pointer( GlobalAlloc( GMEM_FIXED or ZI, fDIBSize + 4 ) );
      {$IFDEF KOL_ASSERTIONS}
      ASSERT( fDIBBits <> nil, 'No memory' );
      ASSERT( (fDIBHeader.bmiHeader.biCompression and
              (BI_RLE8 or BI_RLE4 or BI_RLE8 or BI_BITFIELDS) <> 0) or
              (fDIBHeader.bmiHeader.biCompression = BI_RGB),
              'Unknown compression algorithm');
      {$ENDIF KOL_ASSERTIONS}

      ColorCount := 0;
      if fDIBHeader.bmiHeader.biBitCount <= 8 then
      begin
        if fDIBHeader.bmiHeader.biClrUsed > 0 then
        ColorCount := fDIBHeader.bmiHeader.biClrUsed * Sizeof( TRGBQuad )
        else
        ColorCount := (1 shl fDIBHeader.bmiHeader.biBitCount) * Sizeof( TRGBQuad )
      end
      else if (fNewPixelFormat in [ pf15bit, pf16bit ]) or
              (fDIBHeader.bmiHeader.biCompression = BI_BITFIELDS) then
      begin
        if (Strm.Size = 0) or (Strm.Size - Strm.Position - DWORD( Size ) >= 12) then
          ColorCount := 12;
      end;

      if ColorTriples then
        ColorCount := ColorCount div 4 * 3;

      if Off > 0 then
      begin
         if   ColorTriples then
              Off := Off - SizeOf( TBitmapFileHeader ) - Sizeof( TBitmapCoreHeader )
         else Off := Off - SizeOf( TBitmapFileHeader ) - Sizeof( TBitmapInfoHeader );
         if  (Off <> ColorCount) and (fNewPixelFormat <= pf8bit) then
             if ColorTriples then
                ColorCount := min( Off, 3 * 256 )
             else
                ColorCount := min( Off, 4 * 256 );
      end;
      if  (fNewPixelFormat in [ pf15bit, pf16bit ]) then
      if  (fDIBHeader.bmiHeader.biCompression = BI_BITFIELDS) then
      begin
          PDWORD( DWORD( @ fDIBHeader.bmiColors[ 0 ] ) + 8 )^ := ( $00001F );
          PDWORD( DWORD( @ fDIBHeader.bmiColors[ 0 ] ) + 4 )^ := ( $0007E0 );
          TColor( fDIBHeader.bmiColors[ 0 ] ) := ( $00F800 );
      end else
          ColorCount := 0;

      if ColorCount <> 0 then
        if ColorTriples then
        begin
          PColr := @ fDIBheader.bmiColors[ 0 ];
          while ColorCount >= 3 do
          begin
            if strm.Read( PColr^, 3 ) <> 3 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>}
            Inc( PColr );
            Dec( ColorCount, 3 );
          end;
        end else
        begin
          if (Integer( Strm.Size - Strm.Position ) > fDIBSize) or
             (fDIBHeader.bmiHeader.biCompression = BI_RLE8) or
             (fDIBHeader.bmiHeader.biCompression = BI_RLE4) then
          begin
            if Strm.Read( fDIBheader.bmiColors[ 0 ], ColorCount )
               <> DWORD( ColorCount ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
            if Off - ColorCount > 0 then
              Strm.Position := Integer( Strm.Position ) + Off - ColorCount;
          end;
        end;

      if not BFHValid then
        Size := fDIBSize
      else
      if (fDIBHeader.bmiHeader.biCompression = BI_RLE8) or
         (fDIBHeader.bmiHeader.biCompression = BI_RLE4) then
         begin
           //if BFHValid then //-- already TRUE here
              Size := BFH.bfSize - BFH.bfOffBits;
         end
         else
         begin
           if (Strm.Size = 0) or
              (Integer( Strm.Size - BFH.bfOffBits - Pos ) > Integer(Size)) then
             Size := fDIBSize
           else
             Size := Strm.Size - BFH.bfOffBits - DWORD( Pos );
           if Size > fDIBSize then Size := fDIBSize
           else if (Size < fDIBSize) and (fDIBheader.bmiHeader.biClrUsed <> 0) then
           begin
             BFHValid := FALSE;
             Strm.Position := Strm.Position + fDIBheader.bmiHeader.biClrUsed * 4;
             Size := Strm.Size - Strm.Position;
           end;
         end;

      if (fDIBHeader.bmiHeader.biCompression = BI_RGB) or
         (fDIBHeader.bmiHeader.biCompression = BI_BITFIELDS) then
      begin
        if BFHValid and
           ( (Strm.Size > 0) and
             (Integer( Strm.Size - BFH.bfOffBits - Pos) > Integer(Size))
             or
             (Strm.Size = 0) and
             (Off > 0)
            ) then
        if Integer( Strm.Position - Pos ) <= Integer( BFH.bfOffbits ) then
          Strm.Position := Pos + BFH.bfOffbits;
        i := Strm.Read( fDIBBits^, Size );
        if i <> Size then
        begin
          {$IFDEF FILL_BROKEN_BITMAP}
          ZeroMemory( Pointer( Integer( fDIBBits ) + i ), Size - i );
          {$ENDIF FILL_BROKEN_BITMAP}
        end;
      end
        else
      begin
          if (Integer( fDIBHeader.bmiHeader.biSizeImage ) > 0) and
             (Integer( fDIBHeader.bmiHeader.biSizeImage ) < Size) then
             Size := Integer( fDIBHeader.bmiHeader.biSizeImage ); // - ColorCount;
          // it is possible that bitmap "compressed" with RLE has size
          // greater then non-compressed one:
          FinalPos := Strm.Position + DWORD( Size );
          L := Strm.Size - Strm.Position;
          if  L > DWORD( Size ) then
              L := Size;
          Buffer := AllocMem( Size * 3 );
          if Strm.Read(Buffer^,L) <> DWORD( L ) then ;
          if fDIBHeader.bmiHeader.biCompression=BI_RLE8 then
             DecodeRLE8(@Self,Buffer,Size * 3)
          else
             DecodeRLE4(@Self,Buffer,Size * 3);
          Strm.Position := FinalPos;
          fDIBHeader.bmiHeader.biCompression := BI_RGB;
          FreeMem(Buffer);
      end;

      Result := True;
    end;
begin
  Clear;
  Pos := Strm.Position;
  result := ReadBitmap;
  if not result then
  begin
     Strm.Seek( Pos, spBegin );
     Clear;
  end;
end;

///////////////////////////

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TBitmap.ReleaseHandle: HBitmap;
var OldBits: Pointer;
begin
  HandleType := bmDIB;
  Result := GetHandle;
  if Result = 0 then Exit; // only when bitmap is empty {>>>>>>>>>>>>>>>>>>>>>>}
  if fDIBAutoFree then
  begin
    OldBits := fDIBBits;
    fDIBBits := Pointer( GlobalAlloc( GMEM_FIXED {or GMEM_ZEROINIT}, fDIBSize ) );
    Move( OldBits^, fDIBBits^, fDIBSize );
    fDIBAutoFree := FALSE;
  end;
  fHandle := 0;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.SaveToFile(const Filename: KOLString);
var Strm: PStream;
begin
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Strm := NewWritefileStream( Filename );
  SaveToStream( Strm );
  Strm.Free;
end;
{$ENDIF PAS_VERSION}

procedure TBitmap.CoreSaveToFile(const Filename: KOLString);
var Strm: PStream;
begin
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Strm := NewWritefileStream( Filename );
  CoreSaveToStream( Strm );
  Strm.Free;
end;

procedure TBitmap.RLESaveToFile(const Filename: KOLString);
var Strm: PStream;
begin
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Strm := NewWritefileStream( Filename );
  RLESaveToStream( Strm );
  Strm.Free;
end;

{$IFDEF ASM_STREAM}
procedure TBitmap.SaveToStream(Strm: PStream);
type  tBFH = TBitmapFileHeader;
      tBIH = TBitmapInfoHeader;
const szBIH = Sizeof( tBIH );
      szBFH = Sizeof( tBFH );
asm
        PUSH     EBX
        PUSH     ESI
        MOV      EBX, EAX
        MOV      ESI, EDX
        CALL     GetEmpty
        JZ       @@exit
        MOV      EAX, ESI
        CALL     TStream.GetPosition
        PUSH     EAX

        MOV      EAX, EBX
        XOR      EDX, EDX // EDX = bmDIB
        CALL     SetHandleType
        XOR      EAX, EAX
        MOV      EDX, [EBX].fDIBHeader
        MOVZX    ECX, [EDX].TBitmapInfoHeader.biBitCount
        CMP      CL, 8
        JG       @@1
        MOV      AL, 4
        SHL      EAX, CL
@@1:
          PUSH     EAX                        // ColorsSize
        LEA      ECX, [EAX + szBFH + szBIH]
        CMP      [EDX].TBitmapInfoHeader.biCompression, 0
        JZ       @@10
        ADD      ECX, 74
@@10:
        PUSH     ECX                        // BFH.bfOffBits
        PUSH     0
        ADD      ECX, [EBX].fDIBSize
        PUSH     ECX
        MOV      CX, $4D42
        PUSH     CX
        XOR      ECX, ECX
        MOV      EDX, ESP
        MOV      CL, szBFH
          PUSH     ECX
        MOV      EAX, ESI
        CALL     TStream.Write
          POP      ECX
        ADD      ESP, szBFH
        XOR      EAX, ECX
          POP      ECX  // ColorsSize
        JNZ      @@ewrite
          MOV      EDX, [EBX].fDIBHeader
          CMP      [EDX].TBitmapInfoHeader.biCompression, 0
          JZ       @@11
          ADD      ECX, 74
@@11:
        ADD      ECX, szBIH
        PUSH     ECX
        MOV      EAX, ESI
        CALL     TStream.Write
        POP      ECX
        XOR      EAX, ECX
        JNZ      @@ewrite

        MOV      ECX, [EBX].fDIBSize
        MOV      EDX, [EBX].fDIBBits
        MOV      EAX, ESI
        PUSH     ECX
        CALL     TStream.Write
        POP      ECX
        XOR      EAX, ECX
@@ewrite:
        POP      EDX
        JZ       @@exit
        XCHG     EAX, ESI
        XOR      ECX, ECX
        CALL     TStream.Seek
@@exit:
        POP      ESI
        POP      EBX
end;
{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.SaveToStream(Strm: PStream);
var BFH : TBitmapFileHeader;
    Pos : Integer;
   function WriteBitmap : Boolean;
   var ColorsSize, BitsSize, Size : Integer;
   begin
      Result := False;
      if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      HandleType := bmDIB; // convert to DIB if DDB
      ZeroMemory( @BFH, Sizeof( BFH ) );
      ColorsSize := 0;
      with fDIBHeader.bmiHeader do
           if biBitCount <= 8 then
              ColorsSize := (1 shl biBitCount) * Sizeof( TRGBQuad );
      BFH.bfOffBits := Sizeof( BFH ) + Sizeof( TBitmapInfoHeader ) + ColorsSize;
      BitsSize := fDIBSize; //ScanLineSize * fHeight;
      BFH.bfSize := BFH.bfOffBits + DWord( BitsSize );
      BFH.bfType := $4D42; // 'BM';
      if fDIBHeader.bmiHeader.biCompression <> 0 then
      begin
         ColorsSize := 12 + 16*sizeof(TRGBQuad);
         Inc( BFH.bfOffBits, ColorsSize );
      end;
      if Strm.Write( BFH, Sizeof( BFH ) ) <> Sizeof( BFH ) then Exit; {>>>>>>>>}
      Size := Sizeof( TBitmapInfoHeader ) + ColorsSize;
      if Strm.Write( fDIBHeader^, Size ) <> DWORD(Size) then Exit; {>>>>>>>>>>>}
      if Strm.Write( fDIBBits^, BitsSize ) <> DWord( BitsSize ) then Exit; {>>>}
      Result := True;
   end;
begin
  Pos := Strm.Position;
  if not WriteBitmap then
     Strm.Seek( Pos, spBegin );
end;
{$ENDIF PAS_VERSION}

procedure TBitmap.CoreSaveToStream(Strm: PStream);
type TRGBTriple = packed record
         bRed, bGreen, bBlue: Byte;
     end;
var BFH : TBitmapFileHeader;
    Pos : Integer;
   function WriteCoreBitmap : Boolean;
   var ColorsSize, ColorsCount, BitsSize, i: Integer;
       CH: TBitmapCoreHeader;
   begin
      Result := False;
      if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      HandleType := bmDIB; // convert to DIB if DDB
      ZeroMemory( @BFH, Sizeof( BFH ) );
      ColorsSize := 0;
      ColorsCount := 1 shl fDIBHeader.bmiHeader.biBitCount;
      with fDIBHeader.bmiHeader do
           if biBitCount <= 8 then
              ColorsSize := ColorsCount * Sizeof( TRGBTriple );
      BFH.bfOffBits := Sizeof( BFH ) + Sizeof( CH ) + ColorsSize;
      BitsSize := fDIBSize; //ScanLineSize * fHeight;
      BFH.bfSize := BFH.bfOffBits + DWord( BitsSize );
      BFH.bfType := $4D42; // 'BM';

      if Strm.Write( BFH, Sizeof( BFH ) ) <> Sizeof( BFH ) then Exit; {>>>>>>>>}
      CH.bcSize := Sizeof( CH );
      CH.bcWidth := Width;
      CH.bcHeight := Height;
      CH.bcPlanes := 1;
      CH.bcBitCount := fDIBHeader.bmiHeader.biBitCount;
      if Strm.Write( CH, Sizeof( CH ) ) <> Sizeof(CH) then Exit; {>>>>>>>>>>>>>}
      for i := 0 to ColorsCount-1 do
      begin
          if  Strm.Write( fDIBHeader.bmiColors[i], 3 ) <> 3 then Exit; {>>>>>>>}
      end;
      if Strm.Write( fDIBBits^, BitsSize ) <> DWord( BitsSize ) then Exit; {>>>}
      Result := True;
   end;
begin
  if  (fDIBHeader.bmiHeader.biBitCount > 8)
  or  (fDIBHeader.bmiHeader.biCompression <> 0) then
  begin
      SaveToStream( Strm ); Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Pos := Strm.Position;
  if not WriteCoreBitmap then
     Strm.Seek( Pos, spBegin );
end;

procedure TBitmap.RLESaveToStream(Strm: PStream);
var BFH : TBitmapFileHeader;
    Pos : Integer;
    MS: PStream;
   function CountZeroes( P: PByte; maxBytes: Integer ): Integer;
   begin
       Result := 0;
       while (P^ = 0) and (Result < maxBytes) do
       begin
           inc( P );
           inc( Result );
       end;
   end;
   function CountSame( P: PByte; maxBytes: Integer ): Integer;
   var B: Byte;
   begin
       Result := 1;
       B := P^;
       while maxBytes > 1 do
       begin
           inc(P);
           if  P^ <> B then break;
           inc(Result);
           dec(maxBytes);
       end;
   end;
   function CountSame2( P: PByteArray; maxPixels: Integer ): Integer;
   var B1, B2: Byte;
       i: Integer;
   begin
       Result := 2;
       B1 := P[0];
       B2 := P[1];
       i := 0;
       dec( maxPixels, 2 );
       while maxPixels > 0 do
       begin
           inc(i, 2);
           if  P[i] <> B1 then break;
           inc(Result);
           dec(maxPixels);
           if  maxPixels = 0 then break;
           if  P[i+1] <> B2 then break;
           inc(Result);
           dec(maxPixels);
       end;
   end;
   function CountDiff( P: PByte; maxBytes: Integer; minSame: Integer ): Integer;
   var Cnt: Integer;
   begin
       Result := 1;
       while (maxBytes > 1) do
       begin
           inc(P);
           dec(maxBytes);
           Cnt := CountSame( P, maxBytes );
           if  Cnt >= minSame then
               break;
           inc( Result );
       end;
   end;
   function CountDiff2( P: PByte; maxPixels: Integer; minSame: Integer ): Integer;
   var Cnt: Integer;
   begin
       Result := 1;
       while (maxPixels > 1) do
       begin
           inc(P);
           dec(maxPixels);
           Cnt := CountSame2( Pointer( P ), maxPixels );
           if  Cnt >= minSame then
               break;
           inc( Result );
       end;
   end;
   procedure WriteOffset( dx, dy: Integer );
   var b: Byte;
   begin
       while (dx > 0) or (dy > 0) do
       begin
           Strm.WriteVal( 0, 1 );
           Strm.WriteVal( 2, 1 );
           b := min( dx, 255 );
           Strm.WriteVal( b, 1 );
           dec( dx, b );
           b := min( dy, 255 );
           Strm.WriteVal( b, 1 );
           dec( dy, b );
       end;
   end;
   procedure WriteRep( cnt: Integer; Value: Byte );
   var n: Integer;
   begin
       while cnt > 0 do
       begin
           n := min( cnt, 255 );
           dec( cnt, n );
           while (cnt > 0) and (cnt < 3) do
           begin
               inc( cnt );
               dec( n );
           end;
           Strm.WriteVal( n, 1 );
           Strm.WriteVal( Value, 1 );
       end;
   end;
   procedure WriteRun( P: PByte; cnt: Integer );
   var n: Integer;
   begin
       while cnt > 0 do
       begin
           n := min( cnt, 255 );
           dec( cnt, n );
           if  (cnt < 3) and (n = 255) then
           begin
               inc( cnt, 2 );
               dec( n, 2 );
           end;
           if  n > 2 then
           begin
               Strm.WriteVal( 00, 1 );
               Strm.WriteVal( n, 1 );
               Strm.Write( P^, n );
               inc( P, n );
               if  n and 1 <> 0 then
                   Strm.WriteVal( 00, 1 );
           end else
           while n > 0 do
           begin
               Strm.WriteVal( 01, 1 );
               Strm.Write( P^, 1 );
               inc( P );
               dec( n );
           end;
       end;
   end;
   procedure WriteRun2( P: PByteArray; cnt: Integer );
   var n, i, L: Integer;
   begin
       i := 0;
       while cnt > 0 do
       begin
           n := min( cnt, 252 );
           dec( cnt, n );
           if  (cnt < 3) and (n = 252) then
           begin
               inc( n, cnt );
               cnt := 0;
           end;
           if  n > 2 then
           begin
               Strm.WriteVal( 00, 1 );
               Strm.WriteVal( n, 1 );
               L := 0;
               while n > 0 do
               begin
                   Strm.WriteVal( P[i] shl 4 or P[i+1], 1 );
                   inc( i, 2 );
                   dec( n, 2 );
                   inc( L );
               end;
               if  L and 1 <> 0 then
                   Strm.WriteVal( 0, 1 );
           end else
           while n > 0 do
           begin
               if  n = 1 then
                   Strm.WriteVal( 01, 1 )
               else
                   Strm.WriteVal( 02, 1 );
               Strm.WriteVal( P[i] shl 4 or P[i+1], 1 );
               inc( i, 2 );
               dec( n, 2 );
           end;
       end;
   end;
   function WriteRLE4: Boolean;
   var line_len_left, y, cnt: Integer;
       P, Pnext: PByte;
       PnextLine: PByte;
       offX, offY: Integer;
   begin
       y := 0;
       P := MS.Memory;
       while y < Height do
       begin
           line_len_left := Width;
           PnextLine := P; inc( PnextLine, line_len_left );
           while line_len_left > 0 do
           begin
               if  P^ = 0 then
               begin
                   cnt := CountZeroes( P, line_len_left + (Height-y-1)*Width );
                   if  cnt > 3 then
                   begin // generate offset
                       offY := cnt div Width;
                       offX := cnt - offY * Width;
                       if  (offX < 0)
                       or (offY = 0) and (offX >= line_len_left)
                       or (line_len_left < offX) then
                       begin
                           inc( P, line_len_left );
                           break;
                       end;
                       if  offY > 0 then
                       begin
                           WriteOffset( offX, offY );
                           inc( P, cnt );
                           dec( line_len_left, offX );
                           inc( Y, offY );
                           continue;
                       end;
                   end;
               end;
               cnt := CountSame2( Pointer( P ), line_len_left );
               if  cnt >= 3 then
               begin
                   Pnext := P; inc( Pnext );
                   WriteRep( cnt, (P^ shl 4) or (Pnext^) );
                   inc( P, cnt );
                   dec( line_len_left, cnt );
               end else
               begin
                   cnt := CountDiff2( P, line_len_left, 3 );
                   WriteRun2( Pointer( P ), cnt );
                   inc( P, cnt );
                   dec( line_len_left, cnt );
               end;
           end;
           Strm.WriteVal( 0, 1 );
           if   y < Height-1 then
                Strm.WriteVal( 0, 1 )  // EOL
           else Strm.WriteVal( 1, 1 ); // EOB
           inc(y);
           if  ( Integer( P ) - Integer( PnextLine ) ) mod Width <> 0 then
           begin {$IFNDEF PAS_ONLY}
             asm
               nop
             end;{$ENDIF}
           end;
       end;
       Result := TRUE;
   end;
   function WriteRLE8: Boolean;
   var line_len_left, y, cnt: Integer;
       P: PByte;
       //Pnext: PByte;
       offX, offY: Integer;
   begin
       y := 0;
       P := MS.Memory;
       while y < Height do
       begin
           line_len_left := Width;
           //Pnext := P; inc( Pnext, line_len_left );
           while line_len_left > 0 do
           begin
               if  P^ = 0 then
               begin
                   cnt := CountZeroes( P, line_len_left + (Height-y-1)*Width );
                   if  cnt > 3 then
                   begin // generate offset
                       offY := cnt div Width;
                       offX := cnt - offY * Width;
                       if  (offX < 0)
                       or (offY = 0) and (offX >= line_len_left)
                       or (line_len_left < offX) then
                       begin
                           inc( P, line_len_left );
                           break;
                       end;
                       if  offY > 0 then
                       begin
                           WriteOffset( offX, offY );
                           inc( P, cnt );
                           dec( line_len_left, offX );
                           inc( Y, offY );
                           continue;
                       end;
                   end;
               end;
               cnt := CountSame( P, line_len_left );
               if  cnt >= 2 then
               begin
                   WriteRep( cnt, P^ );
                   inc( P, cnt );
                   dec( line_len_left, cnt );
               end else
               begin
                   cnt := CountDiff( P, line_len_left, 2 );
                   WriteRun( P, cnt );
                   inc( P, cnt );
                   dec( line_len_left, cnt );
               end;
           end;
           Strm.WriteVal( 00, 1 );
           if   y < Height-1 then
                Strm.WriteVal( 00, 1 )  // EOL
           else Strm.WriteVal( 01, 1 ); // EOB
           inc(y);
           {if  P <> Pnext then
           asm
             nop
           end;}
       end;
       Result := TRUE;
   end;
   function WriteBitmap : Boolean;
   var ColorsSize, BitsSize : Integer;
       BIH: TBitmapInfoHeader;
       x, y: Integer;
       Line: PByte;
       Buffer: PByteArray;
   begin
      Result := False;
      if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      HandleType := bmDIB; // convert to DIB if DDB
      ZeroMemory( @BFH, Sizeof( BFH ) );
      ColorsSize := 0;
      with fDIBHeader.bmiHeader do
           if biBitCount <= 8 then
              ColorsSize := (1 shl biBitCount) * Sizeof( TRGBQuad );
      BFH.bfOffBits := Sizeof( BFH ) + Sizeof( TBitmapInfoHeader ) + ColorsSize;
      BitsSize := fDIBSize; //ScanLineSize * fHeight;
      BFH.bfSize := BFH.bfOffBits + DWord( BitsSize );
      BFH.bfType := $4D42; // 'BM';
      if fDIBHeader.bmiHeader.biCompression <> 0 then
      begin
         ColorsSize := 12 + 16*sizeof(TRGBQuad);
         Inc( BFH.bfOffBits, ColorsSize );
      end;
      if Strm.Write( BFH, Sizeof( BFH ) ) <> Sizeof( BFH ) then Exit; {>>>>>>>>}
      BIH := fDIBHeader.bmiHeader;
      MS := NewMemoryStream;
      if  fDIBHeader.bmiHeader.biBitCount = 8 then
      begin
          for y := Height-1 downto 0 do
          begin
              Line := ScanLine[y];
              MS.Write( Line^, Width );
          end;
      end else
      begin
          Buffer := AllocMem( Width );
          for y := Height-1 downto 0 do
          begin
              Line := ScanLine[y];
              x := 0;
              while x < Width do
              begin
                  Buffer[x] := Line^ shr 4;
                  inc( x );
                  if  x >= Width then break;
                  Buffer[x] := Line^ and 15;
                  inc( x );
                  inc( Line );
              end;
              MS.Write( Buffer^, Width );
          end;
          MS.WriteVal( 0, 2 );
      end;
      if   fDIBHeader.bmiHeader.biBitCount = 8 then
           BIH.biCompression := BI_RLE8
      else BIH.biCompression := BI_RLE4;
      if  Strm.Write( BIH, Sizeof( BIH ) ) <> Sizeof( BIH ) then Exit; {>>>>>>>}
      if  Strm.Write( fDIBHeader.bmiColors, ColorsSize ) <> DWORD(ColorsSize) then
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      if   fDIBHeader.bmiHeader.biBitCount = 8 then
           Result := WriteRLE8
      else Result := WriteRLE4;
      MS.Free;
   end;
begin
  Pos := Strm.Position;
  if  (fDIBHeader.bmiHeader.biBitCount <> 4)
  and (fDIBHeader.bmiHeader.biBitCount <> 8) then
  begin
      SaveToStream( Strm ); Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  if not WriteBitmap then
     Strm.Seek( Pos, spBegin );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.SetHandle(const Value: HBitmap);
var B: tagBitmap;
    Dib: TDIBSection;
begin
  Clear;
  if Value = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if (WinVer >= wvNT) and
     (GetObject( Value, Sizeof( Dib ), @ Dib ) = Sizeof( Dib ))
     and (Dib.dsBmih.biBitCount > 8) then
  begin
    fHandle := Value;
    fHandleType := bmDIB;
    fDIBHeader := PrepareBitmapHeader( Dib.dsBm.bmWidth, Dib.dsBm.bmHeight,
    Dib.dsBm.bmBitsPixel );
    Move( Dib.dsBitfields, fDIBHeader.bmiColors, 3 * 4 );
    fWidth := Dib.dsBm.bmWidth;
    fHeight := Dib.dsBm.bmHeight;
    fDIBBits := Dib.dsBm.bmBits;
    fDIBSize := Dib.dsBmih.biSizeImage;
    fDIBAutoFree := true;
  end
  else
  begin
    if GetObject( Value, Sizeof( B ), @B ) = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>}
    fHandle := Value;
    fWidth := B.bmWidth;
    fHeight := B.bmHeight;
    fHandleType := bmDDB;
  end;
end;
{$ENDIF PAS_VERSION}

procedure TBitmap.SetWidth(const Value: Integer);
begin
  if fWidth = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fWidth := Value;
  FormatChanged;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.SetHeight(const Value: Integer);
{$IFNDEF SMALLER_CODE}
var
 pf : TPixelFormat;
{$ENDIF SMALLER_CODE}
begin
  if fHeight = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{$IFNDEF SMALLER_CODE}
  pf := PixelFormat;
{$ENDIF SMALLER_CODE}
  HandleType := bmDDB;
  // Not too good, but provides correct changing of height
  // preserving previous image
  fHeight := Value;
  FormatChanged;
{$IFNDEF SMALLER_CODE}
  PixelFormat := pf;
{$ENDIF SMALLER_CODE}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.SetPixelFormat(Value: TPixelFormat);
begin
  if PixelFormat = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if Value = pfDevice then
    HandleType := bmDDB
  else
  begin
    fNewPixelFormat := Value;
    HandleType := bmDIB;
    FormatChanged;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function CalcScanLineSize( Header: PBitmapInfoHeader ): Integer;
begin
  Result := ((Header.biBitCount * Header.biWidth + 31) shr 3) and $FFFFFFFC;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure FillBmpWithBkColor( Bmp: PBitmap; DC2: HDC; oldWidth, oldHeight: Integer );
var oldBmp: HBitmap;
    R: TRect;
    Br: HBrush;
begin
  with Bmp^ do
  if Color2RGB( fBkColor ) <> 0 then
  if (oldWidth < fWidth) or (oldHeight < fHeight) then
    if GetHandle <> 0 then
    begin
      oldBmp := SelectObject( DC2, fHandle );
      {$IFDEF KOL_ASSERTIONS}
      ASSERT( oldBmp <> 0, 'Can not select bitmap to DC' );
      {$ENDIF KOL_ASSERTIONS}
      Br := CreateSolidBrush( Color2RGB( fBkColor ) );
      R := MakeRect( oldWidth, oldHeight, fWidth, fHeight );
      if  oldWidth = fWidth then
          R.Left := 0;
      if  oldHeight = fHeight then
          R.Top := 0;
      Windows.FillRect( DC2, R, Br );
      DeleteObject( Br );
      SelectObject( DC2, oldBmp );
    end;
end;
{$ENDIF PAS_VERSION}

const BitCounts: array[ TPixelFormat ] of Byte = ( 0, 1, 4, 8, 16, 16, 24, 32, 0 );
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.FormatChanged;
// This method is used whenever Width, Height, PixelFormat or HandleType
// properties are changed.
// Old image will be drawn here to a new one (excluding cases when
// old width or height was 0, and / or new width or height is 0).
// To avoid inserting this code into executable, try not to change
// properties Width / Height of bitmat after it is created using
// NewBitmap( W, H ) function or after it is loaded from file, stream or resource.
var B: tagBitmap;
    oldBmp, NewHandle: HBitmap;
    DC0, DC2: HDC;
    NewHeader: PBitmapInfo;
    NewBits: Pointer;
    oldHeight, oldWidth, sizeBits, bitsPixel: Integer;
    Br: HBrush;
    N: Integer;
    NewDIBAutoFree: Boolean;
    Hndl: THandle;
begin
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  NewDIBAutoFree := FALSE;
  fDetachCanvas( @Self );
  fScanLineSize := 0;
  fGetDIBPixels := nil;
  fSetDIBPixels := nil;

    oldWidth := fWidth;
    oldHeight := fHeight;
    if fDIBBits <> nil then
    begin
      oldWidth := fDIBHeader.bmiHeader.biWidth;
      oldHeight := Abs(fDIBHeader.bmiHeader.biHeight);
    end
      else
    if fHandle <> 0 then
    begin
      if GetObject( fHandle, Sizeof( B ), @ B ) <> 0 then
      begin
        oldWidth := B.bmWidth;
        oldHeight := B.bmHeight;
      end;
    end;

  DC2 := CreateCompatibleDC( 0 );

  if fHandleType = bmDDB then
  begin
    // New HandleType is bmDDB: old bitmap can be copied using Draw method
    DC0 := GetDC( 0 );
    NewHandle := CreateCompatibleBitmap( DC0, fWidth, fHeight );
    {$IFDEF KOL_ASSERTIONS}
    ASSERT( NewHandle <> 0, 'Can not create DDB' );
    {$ENDIF KOL_ASSERTIONS}
    ReleaseDC( 0, DC0 );

    oldBmp := SelectObject( DC2, NewHandle );
    {$IFDEF KOL_ASSERTIONS}
    ASSERT( oldBmp <> 0, 'Can not select bitmap to DC' );
    {$ENDIF KOL_ASSERTIONS}

    Br := CreateSolidBrush( Color2RGB( fBkColor ) );
    FillRect( DC2, MakeRect( 0, 0, fWidth, fHeight ), Br );
    DeleteObject( Br );

    if fDIBBits <> nil then
    begin
      SelectObject( DC2, oldBmp );
      SetDIBits( DC2, NewHandle, 0, fHeight, fDIBBits, fDIBHeader^, DIB_RGB_COLORS );
    end
       else
    begin
      Draw( DC2, 0, 0 );
      SelectObject( DC2, oldBmp );
    end;

    ClearData; // Image is cleared but fWidth and fHeight are preserved
    fHandle := NewHandle;
  end
     else
  begin
    // New format is DIB. GetDIBits applied to transform old data to new one.
    bitsPixel := BitCounts[ fNewPixelFormat ];
    if bitsPixel = 0 then
    begin
      bitsPixel := BitCounts[DefaultPixelFormat];
    end;

    NewHandle := 0;
    NewHeader := PrepareBitmapHeader( fWidth, fHeight, bitsPixel );
    if fNewPixelFormat = pf16bit then
      PreparePF16bit( NewHeader );

    sizeBits := CalcScanLineSize( @NewHeader.bmiHeader ) * fHeight;

      NewBits := Pointer( GlobalAlloc( GMEM_FIXED, sizeBits ) );
      {$IFDEF KOL_ASSERTIONS}
      ASSERT( NewBits <> nil, 'No memory' );
      {$ENDIF KOL_ASSERTIONS}

      Hndl := GetHandle;
      if Hndl = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      N :=
      GetDIBits( DC2, Hndl, 0, Min( fHeight, oldHeight ),
                 NewBits, NewHeader^, DIB_RGB_COLORS );
      if N <> Min( fHeight, oldHeight ) then
      begin
        GlobalFree( DWORD( NewBits ) );
        NewBits := nil;
        NewHandle := CreateDIBSection( DC2, NewHeader^, DIB_RGB_COLORS, NewBits, 0, 0 );
        NewDIBAutoFree := TRUE;
        {$IFDEF KOL_ASSERTIONS}
        ASSERT( NewHandle <> 0, 'Can not create DIB secion for pf16bit bitmap' );
        {$ENDIF KOL_ASSERTIONS}
        oldBmp := SelectObject( DC2, NewHandle );
        {$IFDEF KOL_ASSERTIONS}
        ASSERT( oldBmp <> 0, 'Can not select pf16bit to DC' );
        {$ENDIF KOL_ASSERTIONS}
        Draw( DC2, 0, 0 );
        SelectObject( DC2, oldBmp );
      end;

    ClearData;
    fDIBSize := sizeBits;
    fDIBBits := NewBits;
    fDIBHeader := NewHeader;
    fHandle := NewHandle;
    fDIBAutoFree := NewDIBAutoFree;

  end;

  if Assigned( fFillWithBkColor ) then
     fFillWithBkColor( @Self, DC2, oldWidth, oldHeight );

  DeleteDC( DC2 );

end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TBitmap.GetScanLine(Y: Integer): Pointer;
begin
  {$IFDEF KOL_ASSERTIONS}
  ASSERT( (Y >= 0) {and (Y < fHeight)}, 'ScanLine index out of bounds' );
  ASSERT( fDIBBits <> nil, 'No bits available' );
  {$ENDIF KOL_ASSERTIONS}
  Result := nil;
  if fDIBHeader = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if fDIBHeader.bmiHeader.biHeight > 0 then
     Y := fHeight - 1 - Y;
  if fScanLineSize = 0 then
     ScanLineSize;

  Result := Pointer( Integer( fDIBBits ) + fScanLineSize * Y );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TBitmap.GetScanLineSize: Integer;
begin
  Result := 0;
  if fDIBHeader = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FScanLineSize := CalcScanLineSize( @fDIBHeader.bmiHeader );
  Result := FScanLineSize;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.CanvasChanged( Sender : PObj );
begin
  fBkColor := PCanvas( Sender ).Brush.Color;
  ClearTransImage;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.Dormant;
begin
  RemoveCanvas;
  if fHandle <> 0 then
    DeleteObject( ReleaseHandle );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.SetBkColor(const Value: TColor);
begin
  if fBkColor = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fBkColor := Value;
  fFillWithBkColor := FillBmpWithBkColor;
  if  Assigned( fApplyBkColor2Canvas ) then
      fApplyBkColor2Canvas( @Self );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TBitmap.Assign(SrcBmp: PBitmap): Boolean;
begin
  Clear;
  Result := False;
  if SrcBmp = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if SrcBmp.Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fWidth := SrcBmp.fWidth;
  fHeight := SrcBmp.fHeight;
  fHandleType := SrcBmp.fHandleType;
  //fNewPixelFormat := SrcBmp.PixelFormat;
  if SrcBmp.fHandleType = bmDDB then
  begin
    fHandle := CopyImage( SrcBmp.fHandle, IMAGE_BITMAP, 0, 0, 0 {LR_COPYRETURNORG} );
    {$IFDEF KOL_ASSERTIONS}
    ASSERT( fHandle <> 0, 'Can not copy bitmap image' );
    {$ENDIF KOL_ASSERTIONS}
    Result := fHandle <> 0;
    if not Result then Clear;
  end
     else
  begin
    GetMem( fDIBHeader, Sizeof(TBitmapInfoHeader) + 256*sizeof(TRGBQuad) );
    {$IFDEF KOL_ASSERTIONS}
    ASSERT( fDIBHeader <> nil, 'No memory' );
    {$ENDIF KOL_ASSERTIONS}
    Move( SrcBmp.fDIBHeader^, fDIBHeader^, Sizeof(TBitmapInfoHeader) + 256*sizeof(TRGBQuad) );
    fDIBSize := SrcBmp.fDIBSize;
    fDIBBits := Pointer( GlobalAlloc( GMEM_FIXED {or GMEM_ZEROINIT}, fDIBSize ) );
    {$IFDEF KOL_ASSERTIONS}
    ASSERT( fDIBBits <> nil, 'No memory' );
    {$ENDIF KOL_ASSERTIONS}
    Move( SrcBmp.fDIBBits^, fDIBBits^, fDIBSize );
    Result := True;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.RemoveCanvas;
begin
  fDetachCanvas( @Self );
  fCanvas.Free;
  fCanvas := nil;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TBitmap.DIBPalNearestEntry(Color: TColor): Integer;
var I, Diff, D: Integer;
    C : Integer;
begin
  Color := TColor( Color2RGBQuad( Color ) );
  Result := 0;
  Diff := MaxInt;
  for I := 0 to DIBPalEntryCount - 1 do
  begin
    C := Color xor PInteger( Integer( @fDIBHeader.bmiColors[ 0 ] )
                    + I * Sizeof( TRGBQuad ) )^;
    D := TRGBQuad( C ).rgbBlue + TRGBQuad( C ).rgbGreen + TRGBQuad( C ).rgbRed;
    if D < Diff then
    begin
      Diff := D;
      Result := I;
    end;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TBitmap.GetDIBPalEntries(Idx: Integer): TColor;
begin
  Result := TColor(-1);
  if fDIBBits = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$IFDEF KOL_ASSERTIONS}
  ASSERT( PixelFormat in [pf1bit..pf8bit], 'Format has no DIB palette entries available' );
  ASSERT( (Idx >= 0) and (Idx < (1 shl fDIBHeader.bmiHeader.biBitCount)),
          'DIB palette index out of bounds' );
  {$ENDIF KOL_ASSERTIONS}
  Result := PDWORD( Integer( @fDIBHeader.bmiColors[ 0 ] )
          + Idx * Sizeof( TRGBQuad ) )^;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TBitmap.GetDIBPalEntryCount: Integer;
begin
  Result := 0;
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  case PixelFormat of
  pf1bit: Result := 2;
  pf4bit: Result := 16;
  pf8bit: Result := 256;
  else;
  end;
end;
{$ENDIF PAS_VERSION}

procedure TBitmap.SetDIBPalEntries(Idx: Integer; const Value: TColor);
begin
  if fDIBBits = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Dormant;
  PDWORD( Integer( @fDIBHeader.bmiColors[ 0 ] )
                    + Idx * Sizeof( TRGBQuad ) )^ := Color2RGB( Value );
end;

procedure TBitmap.SetHandleType(const Value: TBitmapHandleType);
begin
  if fHandleType = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fHandleType := Value;
  FormatChanged;
end;

function TBitmap.GetPixelFormat: TPixelFormat;
begin
  if (HandleType = bmDDB) or (fDIBBits = nil) then
    Result := pfDevice
  else
  begin
    Result := Bits2PixelFormat( fDIBHeader.bmiHeader.biBitCount );
    if fDIBHeader.bmiHeader.biCompression <> 0 then
    begin
      {$IFDEF KOL_ASSERTIONS}
      Assert( fDIBHeader.bmiHeader.biCompression = BI_BITFIELDS, 'Unsupported bitmap format' );
      {$ENDIF KOL_ASSERTIONS}
      if (TColor( fDIBHeader.bmiColors[ 0 ] ) = $F800) and
         (PInteger( DWORD(@ fDIBHeader.bmiColors[ 0 ])+4 )^ =  $7E0) and
         (PInteger( DWORD(@ fDIBHeader.bmiColors[ 0 ])+8 )^ =   $1F) then
        Result := pf16bit
      else
      if (TColor( fDIBHeader.bmiColors[ 0 ] ) = $7C00) and
         (PInteger( DWORD(@ fDIBHeader.bmiColors[ 0 ])+4 )^ =  $3E0) and
         (PInteger( DWORD(@ fDIBHeader.bmiColors[ 0 ])+8 )^ =   $1F) then
        Result := pf15bit
      else
        Result := pfCustom;
    end;
  end;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.ClearTransImage;
begin
  fTransColor := clNone;
  fTransMaskBmp.Free;
  fTransMaskBmp := nil;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
{$IFDEF USE_OLDCONVERT2MASK}
procedure TBitmap.Convert2Mask(TranspColor: TColor);
var MonoHandle: HBitmap;
    SaveMono, SaveFrom: THandle;
    MonoDC, DCfrom: HDC;
    SaveBkColor: TColorRef;
begin
  if GetHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fDetachCanvas( @Self );
  MonoHandle := CreateBitmap( fWidth, fHeight, 1, 1, nil );
  {$IFDEF KOL_ASSERTIONS}
  ASSERT( MonoHandle <> 0, 'Can not create monochrome bitmap' );
  {$ENDIF KOL_ASSERTIONS}
  MonoDC := CreateCompatibleDC( 0 );
  SaveMono := SelectObject( MonoDC, MonoHandle );
  {$IFDEF KOL_ASSERTIONS}
  ASSERT( SaveMono <> 0, 'Can not select bitmap to DC' );
  {$ENDIF KOL_ASSERTIONS}
  DCfrom := CreateCompatibleDC( 0 );
  SaveFrom := SelectObject( DCfrom, fHandle );
  {$IFDEF KOL_ASSERTIONS}
  ASSERT( SaveFrom <> 0, 'Can not select source bitmap to DC' );
  {$ENDIF KOL_ASSERTIONS}
  TranspColor := Color2RGB( TranspColor );
  SaveBkColor := Windows.SetBkColor( DCfrom, TranspColor );
  BitBlt( MonoDC, 0, 0, fWidth, fHeight, DCfrom, 0, 0, SRCCOPY );
  {$IFDEF CHK_BITBLT} Chk_BitBlt; {$ENDIF}
  Windows.SetBkColor( DCfrom, SaveBkColor );
  SelectObject( DCfrom, SaveFrom );
  DeleteDC( DCfrom );
  SelectObject( MonoDC, SaveMono );
  DeleteDC( MonoDC );
  ///ReleaseDC( 0, DC0 );
  ClearData;
  fHandle := MonoHandle;
  fHandleType := bmDDB;
end;
{$ELSE NOT USE_OLDCONVERT2MASK} //Pascal
procedure TBitmap.Convert2Mask(TranspColor: TColor);
var Y, X, i: Integer;
    Src, Dst: PByte;
    W: Word;
    TmpMsk: PBitmap;
    B, C: Byte;
    TranspColor32: TColor;
begin
  HandleType := bmDIB;
  if PixelFormat < pf4bit then
    PixelFormat := pf4bit;
  if PixelFormat > pf32bit then
    PixelFormat := pf32bit;
  TranspColor := Color2RGB( TranspColor ) and $FFFFFF;
  TranspColor32 := TColor( Color2RGBQuad( TranspColor ) );
  TmpMsk := NewDIBBitmap( fWidth, fHeight, pf1bit );
  TmpMsk.DIBPalEntries[ 1 ] := $FFFFFF;
  for Y := 0 to fHeight-1 do
  begin
    Src := ScanLine[ Y ];
    Dst := TmpMsk.ScanLine[ Y ];
    B := 0; C := 8;
    CASE PixelFormat OF
    pf4bit:
      begin
        W := 16;
        for i := 0 to 15 do
          if DIBPalEntries[ i ] = TranspColor32 then
          begin
            W := i; break;
          end;
        for X := 0 to (fWidth div 2)-1 do
        begin
          B := B shl 1;
          if Src^ shr 4 = W then inc( B );
          B := B shl 1;
          if Src^ and $0F = W then inc( B );
          Inc( Src );
          Dec( C, 2 );
          if C = 0 then
          begin
            Dst^ := B;
            Inc( Dst );
            C := 8;
          end;
        end;
      end;
    pf8bit:
      begin
        W := 256;
        for i := 0 to 255 do
          if DIBPalEntries[ i ] = TranspColor32 then
          begin
            W := i; break;
          end;
        for X := 0 to fWidth-1 do
        begin
          B := B shl 1;
          if Src^ = W then inc( B );
          Inc( Src );
          Dec( C );
          if C = 0 then
          begin
            Dst^ := B;
            Inc( Dst );
            C := 8;
          end;
        end;
      end;
    pf15bit:
      begin
        W := Color2Color15( TranspColor );
        for X := 0 to fWidth-1 do
        begin
          B := B shl 1;
          if PWord( Src )^ = W then inc( B );
          Inc( Src, 2 );
          Dec( C );
          if C = 0 then
          begin
            Dst^ := B;
            Inc( Dst );
            C := 8;
          end;
        end;
      end;
    pf16bit:
      begin
        W := Color2Color16( TranspColor );
        for X := 0 to fWidth-1 do
        begin
          B := B shl 1;
          if PWord( Src )^ = W then inc( B );
          Inc( Src, 2 );
          Dec( C );
          if C = 0 then
          begin
            Dst^ := B;
            Inc( Dst );
            C := 8;
          end;
        end;
      end;
    pf24bit:
      begin
        for X := 0 to fWidth-1 do
        begin
          B := B shl 1;
          if PInteger( Src )^ and $FFFFFF = TranspColor32 then inc( B );
          Inc( Src, 3 );
          Dec( C );
          if C = 0 then
          begin
            Dst^ := B;
            Inc( Dst );
            C := 8;
          end;
        end;
      end;
    pf32bit:
      begin
        for X := 0 to fWidth-1 do
        begin
          B := B shl 1;
          if PInteger( Src )^ and $FFFFFF = TranspColor32 then inc( B );
          Inc( Src, 4 );
          Dec( C );
          if C = 0 then
          begin
            Dst^ := B;
            Inc( Dst );
            C := 8;
          end;
        end;
      end;
    END;
    if (C > 0) and (C < 8) then
    begin
      while C > 0 do
      begin
        B := B shl 1;
        dec( C );
      end;
      Dst^ := B;
    end;
  end;
  Assign( TmpMsk );
  TmpMsk.Free;
end;
{$ENDIF USE_OLDCONVERT2MASK} //Pascal
{$ENDIF PAS_VERSION}

procedure TBitmap.Invert;
var R: TRect;
begin
  //BitBlt( Canvas.Handle, 0, 0, Width, Height, Canvas.Handle, 0, 0, DSTINVERT  )
  R := BoundsRect;
  InvertRect(Canvas.Handle, R);
end;

procedure TBitmap.DIBDrawRect( DC: HDC; X, Y: Integer; const R: TRect );
begin
  if fDIBBits = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  StretchDIBits( DC, X, Y, R.Right - R.Left, R.Bottom - R.Top,
                 R.Left, fHeight - R.Bottom, R.Right - R.Left, R.Bottom - R.Top,
                 fDIBBits, fDIBHeader^, DIB_RGB_COLORS, SRCCOPY );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure _RotateBitmapMono( var DstBmp: PBitmap; SrcBmp: PBitmap );
var X, Y, Z, Shf, Wbytes, BytesPerDstLine: Integer;
    Src, Dst, Dst1: PByte;
    Tmp: Byte;
begin

  DstBmp := NewDIBBitmap( SrcBmp.fHeight, (SrcBmp.fWidth + 7) and not 7, pf1bit );
  Move( SrcBmp.fDIBHeader.bmiColors[ 0 ], DstBmp.fDIBHeader.bmiColors[ 0 ], 2 * Sizeof( TRGBQuad ) );

  // Calculate ones:
  Dst := DstBmp.ScanLine[ 0 ];
  BytesPerDstLine := Integer( DstBmp.ScanLine[ 1 ]) - Integer( Dst );
  Wbytes := (SrcBmp.fWidth + 7) shr 3;

  Inc( Dst, (DstBmp.fWidth - 1) shr 3 );
  Shf := (DstBmp.fWidth - 1) and 7;

  // Rotating bits:
  for Y := 0 to SrcBmp.fHeight - 1 do
  begin
    Src := SrcBmp.ScanLine[ Y ];
    Dst1 := Dst;
    for X := Wbytes downto 1 do
    begin
      Tmp := Src^;
      Inc( Src );
      for Z := 8 downto 1 do
      begin
        Dst1^ := Dst1^ or ( (Tmp and $80) shr Shf );
        Tmp := Tmp shl 1;
        Inc( Dst1, BytesPerDstLine );
      end;
    end;
    Dec( Shf );
    if Shf < 0 then
    begin
      Shf := 7;
      Dec( Dst );
    end;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure _RotateBitmap4bit( var DstBmp: PBitmap; SrcBmp: PBitmap );
var X, Y, Shf, Wbytes, BytesPerDstLine: Integer;
    Src, Dst, Dst1: PByte;
    Tmp: Byte;
begin
  DstBmp := NewDIBBitmap( SrcBmp.fHeight, (SrcBmp.fWidth + 1) and not 1, pf4bit );
  Move( SrcBmp.fDIBHeader.bmiColors[ 0 ], DstBmp.fDIBHeader.bmiColors[ 0 ], 16 * Sizeof( TRGBQuad ) );

  // Calculate ones:
  Dst := DstBmp.ScanLine[ 0 ];
  BytesPerDstLine := Integer( DstBmp.ScanLine[ 1 ]) - Integer( Dst );
  Wbytes := (SrcBmp.fWidth + 1) shr 1;
  Inc( Dst, (DstBmp.fWidth - 1) shr 1 );
  Shf := ((DstBmp.fWidth - 1) and 1) shl 2;

  // Rotating bits:
  for Y := 0 to SrcBmp.fHeight - 1 do
  begin
    Src := SrcBmp.ScanLine[ Y ];
    Dst1 := Dst;
    for X := Wbytes downto 1 do
    begin
      Tmp := Src^;
      Inc( Src );
      Dst1^ := Dst1^ or ( (Tmp and $F0) shr Shf );
      Inc( Dst1, BytesPerDstLine );
      Dst1^ := Dst1^ or ( ((Tmp shl 4) and $F0) shr Shf );
      Inc( Dst1, BytesPerDstLine );
    end;
    Dec( Shf, 4 );
    if Shf < 0 then
    begin
      Shf := 4;
      Dec( Dst );
    end;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure _RotateBitmap8bit( var DstBmp: PBitmap; SrcBmp: PBitmap );
var X, Y, Wbytes, BytesPerDstLine: Integer;
    Src, Dst, Dst1: PByte;
    Tmp: Byte;
begin

  DstBmp := NewDIBBitmap( SrcBmp.fHeight, SrcBmp.fWidth, SrcBmp.PixelFormat );
  Move( SrcBmp.fDIBHeader.bmiColors[ 0 ], DstBmp.fDIBHeader.bmiColors[ 0 ], 256 * Sizeof( TRGBQuad ) );

  // Calculate ones:
  Wbytes := SrcBmp.fWidth;
  Dst := DstBmp.ScanLine[ 0 ];
  BytesPerDstLine := Integer( DstBmp.ScanLine[ 1 ]) - Integer( Dst );

  Inc( Dst, DstBmp.fWidth - 1 );

  // Rotating bits:
  for Y := 0 to SrcBmp.fHeight - 1 do
  begin
    Src := SrcBmp.ScanLine[ Y ];
    Dst1 := Dst;
    for X := Wbytes downto 1 do
    begin
      Tmp := Src^;
      Inc( Src );
      Dst1^ := Tmp;
      Inc( Dst1, BytesPerDstLine );
    end;
    Dec( Dst );
  end;

end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure _RotateBitmap16bit( var DstBmp: PBitmap; SrcBmp: PBitmap );
var X, Y, Wwords, BytesPerDstLine: Integer;
    Src, Dst, Dst1: PWord;
    Tmp: Word;
begin
  DstBmp := NewDIBBitmap( SrcBmp.fHeight, SrcBmp.fWidth, SrcBmp.PixelFormat );
  Wwords := SrcBmp.fWidth;
  Dst := DstBmp.ScanLine[ 0 ];
  BytesPerDstLine := Integer( DstBmp.ScanLine[ 1 ]) - Integer( Dst );
  Inc( Dst, DstBmp.fWidth - 1 );

  // Rotating bits:
  for Y := 0 to SrcBmp.fHeight - 1 do
  begin
    Src := SrcBmp.ScanLine[ Y ];
    Dst1 := Dst;
    for X := Wwords downto 1 do
    begin
      Tmp := Src^;
      Inc( Src );
      Dst1^ := Tmp;
      Inc( PByte(Dst1), BytesPerDstLine );
    end;
    Dec( Dst );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure _RotateBitmap2432bit( var DstBmp: PBitmap; SrcBmp: PBitmap );
var X, Y, Wwords, BytesPerDstLine, IncW: Integer;
    Src, Dst, Dst1: PDWord;
    Tmp: DWord;
begin

  DstBmp := NewDIBBitmap( SrcBmp.fHeight, SrcBmp.fWidth, SrcBmp.PixelFormat );

  // Calculate ones:
  IncW := 4;
  if DstBmp.PixelFormat = pf24bit then
     IncW := 3;
  Wwords := SrcBmp.fWidth;
  Dst := DstBmp.ScanLine[ 0 ];
  BytesPerDstLine := Integer( DstBmp.ScanLine[ 1 ]) - Integer( Dst );

  Inc( PByte(Dst), (DstBmp.fWidth - 1) * IncW );

  // Rotating bits:
  for Y := 0 to SrcBmp.fHeight - 1 do
  begin
    Src := SrcBmp.ScanLine[ Y ];
    Dst1 := Dst;
    for X := Wwords downto 1 do
    begin
      Tmp := Src^ and $FFFFFF;
      Inc( PByte(Src), IncW );
      Dst1^ := Dst1^ or Tmp;
      Inc( PByte(Dst1), BytesPerDstLine );
    end;
    Dec( PByte(Dst), IncW );
  end;

end;
{$ENDIF PAS_VERSION}

type
  TRotateBmpRefs = packed record
    proc_RotateBitmapMono: procedure( var Dst: PBitmap; Src: PBitmap );
    proc_RotateBitmap4bit: procedure( var Dst: PBitmap; Src: PBitmap );
    proc_RotateBitmap8bit: procedure( var Dst: PBitmap; Src: PBitmap );
    proc_RotateBitmap16bit: procedure( var Dst: PBitmap; Src: PBitmap );
    proc_RotateBitmap2432bit: procedure( var Dst: PBitmap; Src: PBitmap );
  end;

var
  RotateProcs: TRotateBmpRefs;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure _RotateBitmapRight( SrcBmp: PBitmap );
var DstBmp: PBitmap;
    RotateProc: procedure( var DstBmp: PBitmap; SrcBmp: PBitmap );
begin
  if SrcBmp.fHandleType <> bmDIB then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  case SrcBmp.PixelFormat of
  pf1bit: RotateProc := RotateProcs.proc_RotateBitmapMono;
  pf4bit: RotateProc := RotateProcs.proc_RotateBitmap4bit;
  pf8bit: RotateProc := RotateProcs.proc_RotateBitmap8bit;
  pf15bit, pf16bit: RotateProc := RotateProcs.proc_RotateBitmap16bit;
  else RotateProc := RotateProcs.proc_RotateBitmap2432bit;
  end;
  if not Assigned( RotateProc ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  RotateProc( DstBmp, SrcBmp );
  if DstBmp.fHeight > SrcBmp.fWidth then
  begin
      DstBmp.fDIBSize := DstBmp.fScanLineSize * SrcBmp.fWidth;
      if DstBmp.fDIBHeader.bmiHeader.biHeight > 0 then
        Move( DstBmp.ScanLine[ SrcBmp.fWidth - 1 ]^, DstBmp.ScanLine[ DstBmp.fHeight - 1 ]^,
              DstBmp.fDIBSize );
      DstBmp.fHeight := SrcBmp.fWidth;
      DstBmp.fDIBHeader.bmiHeader.biHeight := DstBmp.fHeight;
  end;

  SrcBmp.ClearData;

  SrcBmp.fDIBHeader := DstBmp.fDIBHeader;
  DstBmp.fDIBHeader := nil;

  SrcBmp.fDIBBits := DstBmp.fDIBBits;
  DstBmp.fDIBBits := nil;
  SrcBmp.fDIBAutoFree := DstBmp.fDIBAutoFree;

  SrcBmp.fDIBSize := DstBmp.fDIBSize;

  SrcBmp.fWidth := DstBmp.fWidth;
  SrcBmp.fHeight := DstBmp.fHeight;
  DstBmp.Free;
end;
{$ENDIF PAS_VERSION}

procedure TBitmap.RotateRight;
const AllRotators: TRotateBmpRefs = (
        proc_RotateBitmapMono: _RotateBitmapMono;
        proc_RotateBitmap4bit: _RotateBitmap4bit;
        proc_RotateBitmap8bit: _RotateBitmap8bit;
        proc_RotateBitmap16bit: _RotateBitmap16bit;
        proc_RotateBitmap2432bit: _RotateBitmap2432bit );
begin
  RotateProcs := AllRotators;
  _RotateBitmapRight( @Self );
end;

procedure _RotateBitmapLeft( Src: PBitmap );
begin
  _RotateBitmapRight( Src );
  _RotateBitmapRight( Src );
  _RotateBitmapRight( Src );
end;

procedure TBitmap.RotateLeft;
begin
  RotateRight;
  _RotateBitmapRight( @Self );
  _RotateBitmapRight( @Self );
end;

procedure TBitmap.RotateLeftMono;
begin
  if PixelFormat <> pf1bit then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  RotateProcs.proc_RotateBitmapMono := _RotateBitmapMono;
  _RotateBitmapRight( @Self );
end;

procedure TBitmap.RotateRightMono;
begin
  if PixelFormat <> pf1bit then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  RotateProcs.proc_RotateBitmapMono := _RotateBitmapMono;
  _RotateBitmapLeft( @Self );
end;

procedure TBitmap.RotateLeft16bit;
begin
  if PixelFormat <> pf16bit then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  RotateProcs.proc_RotateBitmap16bit := _RotateBitmap16bit;
  _RotateBitmapLeft( @Self );
end;

procedure TBitmap.RotateLeft4bit;
begin
  if PixelFormat <> pf4bit then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  RotateProcs.proc_RotateBitmap4bit := _RotateBitmap4bit;
  _RotateBitmapLeft( @Self );
end;

procedure TBitmap.RotateLeft8bit;
begin
  if PixelFormat <> pf8bit then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  RotateProcs.proc_RotateBitmap8bit := _RotateBitmap8bit;
  _RotateBitmapLeft( @Self );
end;

procedure TBitmap.RotateLeftTrueColor;
begin
  if not (PixelFormat in [ pf24bit, pf32bit ]) then Exit; {>>>>>>>>>>>>>>>>>>>>}
  RotateProcs.proc_RotateBitmap2432bit := _RotateBitmap2432bit;
  _RotateBitmapLeft( @Self );
end;

procedure TBitmap.RotateRight16bit;
begin
  if PixelFormat <> pf16bit then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  RotateProcs.proc_RotateBitmap16bit := _RotateBitmap16bit;
  _RotateBitmapRight( @Self );
end;

procedure TBitmap.RotateRight4bit;
begin
  if PixelFormat <> pf4bit then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  RotateProcs.proc_RotateBitmap4bit := _RotateBitmap4bit;
  _RotateBitmapRight( @Self );
end;

procedure TBitmap.RotateRight8bit;
begin
  if PixelFormat <> pf8bit then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  RotateProcs.proc_RotateBitmap8bit := _RotateBitmap8bit;
  _RotateBitmapRight( @Self );
end;

procedure TBitmap.RotateRightTrueColor;
begin
  if not (PixelFormat in [ pf24bit, pf32bit ]) then Exit; {>>>>>>>>>>>>>>>>>>>>}
  RotateProcs.proc_RotateBitmap2432bit := _RotateBitmap2432bit;
  _RotateBitmapRight( @Self );
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TBitmap.GetPixels(X, Y: Integer): TColor;
var DC: HDC;
    Save: THandle;
begin
  Result := clNone;
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fDetachCanvas( @Self );
  DC := CreateCompatibleDC( 0 );
  Save := SelectObject( DC, GetHandle );
  {$IFDEF KOL_ASSERTIONS}
  ASSERT( Save <> 0, 'Can not select bitmap to DC' );
  {$ENDIF KOL_ASSERTIONS}
  Result := Windows.GetPixel( DC, X, Y );
  SelectObject( DC, Save );
  DeleteDC( DC );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.SetPixels(X, Y: Integer; const Value: TColor);
var DC: HDC;
    Save: THandle;
begin
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fDetachCanvas( @Self );
  DC := CreateCompatibleDC( 0 );
  Save := SelectObject( DC, GetHandle );
  {$IFDEF KOL_ASSERTIONS}
  ASSERT( Save <> 0, 'Can not select bitmap to DC' );
  {$ENDIF KOL_ASSERTIONS}
  Windows.SetPixel( DC, X, Y, Color2RGB( Value ) );
  SelectObject( DC, Save );
  DeleteDC( DC );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function _GetDIBPixelsPalIdx( Bmp: PBitmap; X, Y: Integer ): TColor;
var Pixel: Byte;
begin
  Pixel := PByte( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta
             + (X div (Bmp.fPixelsPerByteMask + 1)) )^;
  Pixel := ( Pixel shr ( (Bmp.fPixelsPerByteMask - (X and Bmp.fPixelsPerByteMask))
                       * Bmp.fDIBHeader.bmiHeader.biBitCount ) )
           and Bmp.fPixelMask;
  Result := TColor( Color2RGBQuad( TColor( PRGBQuad( DWORD(@Bmp.fDIBHeader.bmiColors[ 0 ])
                           + Pixel * Sizeof( TRGBQuad ) )^ ) ) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function _GetDIBPixels16bit( Bmp: PBitmap; X, Y: Integer ): TColor;
var Pixel: Word;
begin
  Pixel := PWord( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta + X * 2 )^;
  if Bmp.fPixelMask = 15 then
    Result := (Pixel shr 7) and $F8 or (Pixel shl 6) and $F800
           or (Pixel shl 19) and $F80000
  else
    Result := (Pixel shr 8) and $F8 or (Pixel shl 5) and $FC00
           or (Pixel shl 19) and $F80000;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function _GetDIBPixelsTrueColor( Bmp: PBitmap; X, Y: Integer ): TColor;
var Pixel: DWORD;
begin
  Pixel := PDWORD( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta +
                   X * Bmp.fBytesPerPixel )^ and $FFFFFF;
  Result := TColor( Color2RGBQuad( TColor( Pixel ) ) );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
function _GetDIBPixelsTrueColorAlpha( Bmp: PBitmap; X, Y: Integer ): TColor;
var Pixel: DWORD;
    RGB:   TRGBQuad;
    blue, red: Byte;
begin
  Pixel := PDWORD( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta +
                   X * Bmp.fBytesPerPixel )^;
  RGB := TRGBQuad(Pixel);
  blue := RGB.rgbRed;
  red  := RGB.rgbBlue;
  RGB.rgbBlue := blue;
  RGB.rgbRed  := red;
  Result := TColor( RGB );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TBitmap.GetDIBPixels(X, Y: Integer): TColor;
begin
  if not Assigned( fGetDIBPixels ) then
  begin
    if fHandleType = bmDIB then
    begin
      fScanLine0 := ScanLine[ 0 ];
      fScanLineDelta := Integer(ScanLine[ 1 ]) - Integer(fScanLine0);
      case PixelFormat of
      pf1bit:
        begin
          fPixelMask := $01;
          fPixelsPerByteMask := 7;
          fGetDIBPixels := _GetDIBPixelsPalIdx;
        end;
      pf4bit:
        begin
          fPixelMask := $0F;
          fPixelsPerByteMask := 1;
          fGetDIBPixels := _GetDIBPixelsPalIdx;
        end;
      pf8bit:
        begin
          fPixelMask := $FF;
          fPixelsPerByteMask := 0;
          fGetDIBPixels := _GetDIBPixelsPalIdx;
        end;
      pf15bit:
        begin
          fPixelMask := 15;
          fGetDIBPixels := _GetDIBPixels16bit;
        end;
      pf16bit:
        begin
          fPixelMask := 16;
          fGetDIBPixels := _GetDIBPixels16bit;
        end;
      pf24bit:
        begin
          fPixelsPerByteMask := 0;
          fBytesPerPixel := 3;
          fGetDIBPixels := _GetDIBPixelsTrueColor;
        end;
      pf32bit:
        begin
          fPixelsPerByteMask := 1;
          fBytesPerPixel := 4;
          fGetDIBPixels := {$IFDEF DIBPixels32bitWithAlpha} _GetDIBPixelsTrueColorAlpha
                           {$ELSE} _GetDIBPixelsTrueColor {$ENDIF};
        end;
      else;
      end;
    end;
    if not Assigned( fGetDIBPixels ) then
    begin
      Result := Pixels[ X, Y ]; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end;
  Result := fGetDIBPixels( @Self, X, Y );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure _SetDIBPixels1bit( Bmp: PBitmap; X, Y: Integer; Value: TColor );
var Pixel: Byte;
    Pos: PByte;
    Shf: Integer;
begin
  Value := Color2RGB( Value );
  if ((Value shr 16) and $FF) + ((Value shr 8) and $FF) + (Value and $FF)
     < 255 * 3 div 2 then Pixel := 0 else Pixel := $80;
  Pos := PByte( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta + X div 8 );
  Shf := X and 7;
  Pos^ := Pos^ and ($FF7F shr Shf) or (Pixel shr Shf);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure _SetDIBPixelsPalIdx( Bmp: PBitmap; X, Y: Integer; Value: TColor );
var Pixel: Byte;
    Pos: PByte;
    Shf: Integer;
begin
  Pixel := Bmp.DIBPalNearestEntry( Value );
  Pos := PByte( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta
                + X div (Bmp.fPixelsPerByteMask + 1) );
  Shf := (Bmp.fPixelsPerByteMask - (X and Bmp.fPixelsPerByteMask))
         * Bmp.fDIBHeader.bmiHeader.biBitCount;
  Pos^ := Pos^ and not (Bmp.fPixelMask shl Shf) or (Pixel shl Shf);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure _SetDIBPixels16bit( Bmp: PBitmap; X, Y: Integer; Value: TColor );
var RGB16: Word;
    Pos: PWord;
begin
  Value := Color2RGB( Value );
  if Bmp.fPixelMask = 15 then
    RGB16 := (Value shr 19) and $001F or (Value shr 6) and $03E0
          or (Value shl 7) and $7C00
  else
    RGB16 := (Value shr 19) and $001F or (Value shr 5) and $07E0
          or (Value shl 8) and $F800;
  Pos := PWord( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta + X * 2 );
  Pos^ := RGB16;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure _SetDIBPixelsTrueColor( Bmp: PBitmap; X, Y: Integer; Value: TColor );
var RGB: TRGBQuad;
    Pos: PDWord;
begin
  RGB := Color2RGBQuad( Value );
  Pos := PDWORD( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta
                 + X * Bmp.fBytesPerPixel );
  Pos^ := Pos^ and $FF000000 or DWORD(RGB);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION}
procedure _SetDIBPixelsTrueColorAlpha( Bmp: PBitmap; X, Y: Integer; Value: TColor );
var RGB: TRGBQuad;
    Pos: PDWord;
    blue, red: Byte;
begin
  RGB := TRGBQuad(Value);
  blue := RGB.rgbRed;
  red  := RGB.rgbBlue;
  RGB.rgbBlue := blue;
  RGB.rgbRed  := red;
  Pos := PDWORD( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta
                 + X * Bmp.fBytesPerPixel );
  Pos^ := Pos^ or DWORD(RGB);
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.SetDIBPixels(X, Y: Integer; const Value: TColor);
begin
  if not Assigned( fSetDIBPixels ) then
  begin
    if fHandleType = bmDIB then
    begin
      fScanLine0 := ScanLine[ 0 ];
      fScanLineDelta := Integer(ScanLine[ 1 ]) - Integer(fScanLine0);
      case PixelFormat of
      pf1bit:
        begin
          //fPixelMask := $01;
          //fPixelsPerByteMask := 7;
          fSetDIBPixels := _SetDIBPixels1bit;
        end;
      pf4bit:
        begin
          fPixelMask := $0F;
          fPixelsPerByteMask := 1;
          fSetDIBPixels := _SetDIBPixelsPalIdx;
        end;
      pf8bit:
        begin
          fPixelMask := $FF;
          fPixelsPerByteMask := 0;
          fSetDIBPixels := _SetDIBPixelsPalIdx;
        end;
      pf15bit:
        begin
          fPixelMask := 15;
          fSetDIBPixels := _SetDIBPixels16bit;
        end;
      pf16bit:
        begin
          fPixelMask := 16;
          fSetDIBPixels := _SetDIBPixels16bit;
        end;
      pf24bit:
        begin
          fPixelsPerByteMask := 0;
          fBytesPerPixel := 3;
          fSetDIBPixels := _SetDIBPixelsTrueColor;
        end;
      pf32bit:
        begin
          fPixelsPerByteMask := 1;
          fBytesPerPixel := 4;
          fSetDIBPixels := {$IFDEF DIBPixels32bitWithAlpha} _SetDIBPixelsTrueColorAlpha
                           {$ELSE} _SetDIBPixelsTrueColor {$ENDIF};
        end;
      else;
      end;
    end;
    if not Assigned( fSetDIBPixels ) then
    begin
      Pixels[ X, Y ] := Value; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end;
  fSetDIBPixels( @Self, X, Y, Value );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.FlipVertical;
var DC: HDC;
    Save: THandle;
    TmpScan: PByte;
    Y: Integer;
begin
  if fHandle <> 0 then
  begin
    fDetachCanvas( @Self );
    DC := CreateCompatibleDC( 0 );
    Save := SelectObject( DC, fHandle );
    StretchBlt( DC, 0, fHeight - 1, fWidth, -fHeight, DC, 0, 0, fWidth, fHeight, SRCCOPY );
    SelectObject( DC, Save );
    DeleteDC( DC );
  end
     else
  if fDIBBits <> nil then
  begin
    GetMem( TmpScan, ScanLineSize );
    for Y := 0 to fHeight div 2-1 do
    begin
      Move( ScanLine[ Y ]^, TmpScan^, fScanLineSize );
      Move( ScanLine[ fHeight - Y - 1 ]^, ScanLine[ Y ]^, fScanLineSize );
      Move( TmpScan^, ScanLine[ fHeight - Y - 1 ]^, fScanLineSize );
    end;
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.FlipHorizontal;
var DC: HDC;
    Save: THandle;
begin
  if GetHandle <> 0 then
  begin
    fDetachCanvas( @Self );
    DC := CreateCompatibleDC( 0 );
    Save := SelectObject( DC, fHandle );
    StretchBlt( DC, fWidth - 1, 0, -fWidth, fHeight, DC, 0, 0, fWidth, fHeight, SRCCOPY );
    SelectObject( DC, Save );
    DeleteDC( DC );
  end;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TBitmap.CopyRect(const DstRect: TRect; SrcBmp: PBitmap;
  const SrcRect: TRect);
var DCsrc, DCdst: HDC;
    SaveSrc, SaveDst: THandle;
begin
  if (GetHandle = 0) or (SrcBmp.GetHandle = 0) then Exit; {>>>>>>>>>>>>>>>>>>>>}
  fDetachCanvas( @Self );
  SrcBmp.fDetachCanvas( SrcBmp );
  DCsrc := CreateCompatibleDC( 0 );
  SaveSrc := SelectObject( DCsrc, SrcBmp.fHandle );
  DCdst := DCsrc;
  SaveDst := 0;
  if SrcBmp <> @Self then
  begin
    DCdst := CreateCompatibleDC( 0 );
    SaveDst := SelectObject( DCdst, fHandle );
  end;
  StretchBlt( DCdst, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left,
              DstRect.Bottom - DstRect.Top, DCsrc, SrcRect.Left, SrcRect.Top,
              SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top,
              SRCCOPY );
  if SrcBmp <> @Self then
  begin
    SelectObject( DCdst, SaveDst );
    DeleteDC( DCdst );
  end;
  SelectObject( DCsrc, SaveSrc );
  DeleteDC( DCsrc );
end;
{$ENDIF PAS_VERSION}

function TBitmap.CopyToClipboard: Boolean;
var DibMem: PAnsiChar;
    HdrSize: Integer;
    Gbl: HGlobal;
    //Mem: PStream;
    //Sz: Integer;
    //Pt: Pointer;
    Restore_Compression: Integer;
begin
  Result := FALSE;
  if Applet = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if not OpenClipboard( Applet.GetWindowHandle ) then Exit; {>>>>>>>>>>>>>>>>>>}
  if EmptyClipboard then
  begin
    HandleType := bmDIB;
    HdrSize := sizeof( TBitmapInfoHeader );
    Restore_Compression := -1;
    TRY
      if fDIBHeader.bmiHeader.biBitCount <= 8 then
         Inc( HdrSize,
         (1 shl fDIBHeader.bmiHeader.biBitCount) * Sizeof( TRGBQuad ) )
      else
      begin
        if fDIBHeader.bmiHeader.biCompression = BI_RGB then
        begin
          CASE fDIBHeader.bmiHeader.biBitCount OF
          {24,} 32:
            begin
              Restore_Compression := fDIBHeader.bmiHeader.biCompression;
              fDIBHeader.bmiHeader.biCompression := BI_BITFIELDS;
              PDWORD( @ fDIBHeader.bmiColors[ 0 ] )^ := $FF0000;
              PDWORD( Integer( @ fDIBHeader.bmiColors[ 0 ] ) + 4 )^ := $FF00;
              PDWORD( Integer( @ fDIBHeader.bmiColors[ 0 ] ) + 8 )^ := $FF;
              Inc( HdrSize, 12 );
            end;
          END;
        end;
      end;
      Gbl := GlobalAlloc( GMEM_MOVEABLE, HdrSize + fDIBSize );
      DibMem := GlobalLock( Gbl );
      if DibMem <> nil then
      begin
        Move( fDIBHeader^, DibMem^, HdrSize );
        Move( fDIBBits^, Pointer( Integer( DibMem ) + HdrSize )^, fDIBSize );
        if not GlobalUnlock( Gbl ) and (GetLastError = NO_ERROR) then
        begin
          Result := SetClipboardData( CF_DIB, Gbl ) <> 0;
        end;
      end;
    FINALLY
      if Restore_Compression >= 0 then
        fDIBHeader.bmiHeader.biCompression := Restore_Compression;
    END;

  end;
  CloseClipboard;
end;

function TBitmap.PasteFromClipboard: Boolean;
var Gbl: HGlobal;
    Size {, HdrSize}: Integer;
    Mem: PAnsiChar;
    Strm: PStream;
begin
  Result := FALSE;
  if Applet = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if not OpenClipboard( Applet.GetWindowHandle ) then Exit; {>>>>>>>>>>>>>>>>>>}
  TRY
  if IsClipboardFormatAvailable( CF_DIB ) then
  begin
    Gbl := GetClipboardData( CF_DIB );
    if Gbl <> 0 then
    begin
      Size := GlobalSize( Gbl );
      Mem := GlobalLock( Gbl );
      TRY
      if (Size > 0) and (Mem <> nil) then
      begin
        Strm := NewMemoryStream;
        Strm.Write( Mem^, Size );
        Strm.Position := 0;
        LoadFromStreamEx( Strm );
        Strm.Free;
        Result := not Empty;
      end;
      FINALLY
      GlobalUnlock( Gbl );
      END;
    end;
  end;
  FINALLY
  CloseClipboard;
  END;
end;

///////////////////////////////////////////////////////////////////////
//                             I  C  O  N
///////////////////////////////////////////////////////////////////////

{ -- icon -- }

function NewIcon: PIcon;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TIcon';
  {$ENDIF}
  {$IFDEF ICON_DIFF_WH}
  Result.FWidth := 32;
  Result.FHeight := 32;
  {$ELSE}
  Result.FSize := 32;
  {$ENDIF}
end;

{ TIcon }

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TIcon.Clear;
begin
  if fHandle <> 0 then
  begin
    if not FShareIcon then
      DestroyIcon( fHandle );
    fHandle := 0;
  end;
  fShareIcon := False;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_LOCAL}
  {$UNDEF ASM_LOCAL}
{$ENDIF}

{$IFNDEF ICON_DIFF_WH}
  {$IFDEF ASM_VERSION} {$DEFINE ASM_LOCAL} {$ENDIF}
{$ENDIF}

{$IFDEF ASM_LOCAL}
{$ELSE PAS_VERSION} //Pascal
function TIcon.Convert2Bitmap(TranColor: TColor): HBitmap;
var DC0, DC2: HDC;
    Save: THandle;
    Br: HBrush;
begin
  Result := 0;
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  DC0 := GetDC( 0 );
  DC2 := CreateCompatibleDC( DC0 );
  {$IFDEF ICON_DIFF_WH}
  Result := CreateCompatibleBitmap( DC0, fWidth, fHeight );
  {$ELSE}
  Result := CreateCompatibleBitmap( DC0, fSize, fSize );
  {$ENDIF}
  Save := SelectObject( DC2, Result );
  Br := CreateSolidBrush( Color2RGB( TranColor ) );
  {$IFDEF ICON_DIFF_WH}
  FillRect( DC2, MakeRect( 0, 0, fWidth, fHeight ), Br );
  {$ELSE}
  FillRect( DC2, MakeRect( 0, 0, fSize, fSize ), Br );
  {$ENDIF}
  DeleteObject( Br );
  Draw( DC2, 0, 0 );
  SelectObject( DC2, Save );
  DeleteDC( DC2 );
  ReleaseDC( 0, DC0 );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
destructor TIcon.Destroy;
begin
  Clear;
  inherited;
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TIcon.Draw(DC: HDC; X, Y: Integer);
begin
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$IFDEF ICON_DIFF_WH}
  DrawIconEx( DC, X, Y, fHandle, fWidth, fHeight, 0, 0, DI_NORMAL );
  {$ELSE}
  DrawIconEx( DC, X, Y, fHandle, fSize, fSize, 0, 0, DI_NORMAL );
  {$ENDIF}
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TIcon.StretchDraw(DC: HDC; Dest: TRect);
begin
  if Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  DrawIconEx( DC, Dest.Left, Dest.Top, FHandle, Dest.Right - Dest.Left,
              Dest.Bottom - Dest.Top, 0, 0, DI_NORMAL );
end;
{$ENDIF PAS_VERSION}

function TIcon.GetEmpty: Boolean;
begin
  Result := (fHandle = 0)
  {$IFDEF ICONLOAD_PRESERVEBMPS}
          and ((ImgBmp = nil) or ImgBmp.Empty)
  {$ENDIF ICONLOAD_PRESERVEBMPS}
  ;
end;

function TIcon.GetHotSpot: TPoint;
var II : TIconInfo;
begin
  Result := MakePoint( 0, 0 );
  if FHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  GetIconInfo( FHandle, II );
  Result.x := II.xHotspot;
  Result.y := II.yHotspot;
  if II.hbmMask <> 0 then
    DeleteObject( II.hbmMask );
  if II.hbmColor <> 0 then
    DeleteObject( II.hbmColor );
end;

procedure TIcon.LoadFromFile(const FileName: KOLString);
var Strm : PStream;
begin
  Strm := NewReadFileStream( Filename );
  LoadFromStream( Strm );
  Strm.Free;
end;

procedure TIcon.LoadFromStream(Strm: PStream);
var DesiredSize : Integer;
    Pos : DWord;
    Mem : PStream;
    {$IFNDEF ICONLOAD_PRESERVEBMPS}
    ImgBmp, MskBmp : PBitmap;
    {$ENDIF ICONLOAD_PRESERVEBMPS}
    TmpBmp: PBitmap;
  function ReadIcon : Boolean;
  var IH : TIconHeader;
      IDI, FoundIDI : TIconDirEntry;
      I, J, SumSz, FoundSz, D : Integer;
      II : TIconInfo;
      BIH : TBitmapInfoheader;
      SzImg: DWORD;
  begin
     Result := False;
     if Strm.Read( IH, Sizeof( IH ) ) <> Sizeof( IH ) then Exit; {>>>>>>>>>>>>>}
     if (IH.idReserved = Sizeof( TBitmapInfoHeader )) then
     begin
       Strm.Position := Strm.Position - Sizeof( IH );
       {$IFDEF ICON_DIFF_WH} fWidth := 0;
                             fHeight := 0;
       {$ELSE}               fSize := 0;
       {$ENDIF}
       SumSz := 0;
     end
       else
     if (IH.idReserved = 0) and ((IH.idType = 1) or (IH.idType = 2)) and
        (IH.idCount >= 1) then
     begin
       if (IH.idReserved <> 0) or ((IH.idType <> 1) and (IH.idType <> 2)) or
          (IH.idCount < 1) or (IH.idCount >= 1024) then Exit; {>>>>>>>>>>>>>>>>}
       SumSz := Sizeof( IH );
       FoundSz := 1000000;
       for I := 1 to IH.idCount do
       begin
          if Strm.Read( IDI, Sizeof( IDI ) ) <> Sizeof( IDI ) then Exit; {>>>>>}
          Inc( SumSz, IDI.dwBytesInRes + Sizeof( IDI ) );
          D := IDI.bWidth - DesiredSize;
          if D < 0 then D := -D;
          if D < FoundSz then
          begin
             FoundSz := D;
             FoundIDI := IDI;
          end;
       end;
       if FoundSz = 1000000 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
       Strm.Position := Integer( Pos ) + FoundIDI.dwImageOffset;
       {$IFDEF ICON_DIFF_WH} fWidth := FoundIDI.bWidth;
                             fHeight := FoundIDI.bHeight;
       {$ELSE} fSize := FoundIDI.bWidth;
       {$ENDIF}
     end else Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
     if Strm.Read( BIH, Sizeof( BIH ) ) <> Sizeof( BIH ) then Exit; {>>>>>>>>>>}
     {$IFDEF ICON_DIFF_WH}
     fWidth := BIH.biWidth;
     BIH.biHeight := BIH.biHeight div 2; // fSize;
     fHeight := BIH.biHeight;
     {$ELSE}
     fSize := BIH.biWidth;
     BIH.biHeight := BIH.biHeight div 2; // fSize;
     {$ENDIF}
     Mem := NewMemoryStream;
     if (FoundIDI.bColorCount >= 2) or (FoundIDI.bReserved = 1) or
        (FoundIDI.bColorCount = 0) then
     begin
       I := 0;
       SzImg := ((BIH.biBitCount * BIH.biWidth + 31) div 32) * 4 * BIH.biHeight;
       if (BIH.biSizeImage > 0) and (SzImg > BIH.biSizeImage) then
         SzImg := BIH.biSizeImage;
       if BIH.biBitCount <= 8 then
       begin
          I := (1 shl BIH.biBitCount) * Sizeof( TRGBQuad );
       end;
       Mem.Write( BIH, Sizeof( BIH ) );
       if I > 0 then
       begin
          if Stream2Stream( Mem, Strm, I ) <> DWORD(I) then Exit; {>>>>>>>>>>>>}
       end
       else
         if BIH.biBitCount = 16 then
         begin
             if  BIH.biCompression = BI_BITFIELDS then  // + by mdw - fix for
                 Stream2Stream(Mem, Strm, 12)           // 16 bit per pixels
             else
                 for I := 0 to 2 do
                 begin
                   J := InitColors[ I ];
                   Mem.Write( J, 4 );
                 end;
         end;
       I := Stream2Stream( Mem, Strm, SzImg );
       if I <> Integer( SzImg ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
       {$IFDEF ICON_DIFF_WH}
       ImgBmp := NewBitmap( fWidth, fHeight );
       {$ELSE}
       ImgBmp := NewBitmap( fSize, fSize );
       {$ENDIF}
       {$IFDEF ICONLOAD_PRESERVEBMPS}
       Add2AutoFree( ImgBmp );
       {$ENDIF ICONLOAD_PRESERVEBMPS}
       Mem.Seek( 0, spBegin );
       {$IFDEF LOADEX}
       ImgBmp.LoadFromStreamEx( Mem );
       {$ELSE}
       ImgBmp.LoadFromStream( Mem );
       {$ENDIF}
       if ImgBmp.Empty then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
     end
       else
     begin
       Mem.Write( BIH, Sizeof( BIH ) );
     end;

     BIH.biBitCount := 1;
     BIH.biPlanes := 1;
     BIH.biClrUsed := 0;
     BIH.biCompression := 0;
     Mem.Seek( 0, spBegin );
     BIH.biSizeImage := ((BIH.biWidth + 31) div 32) * 4 * BIH.biHeight;
     Mem.Write( BIH, Sizeof( BIH ) );
     I := 0;
     Mem.Write( I, Sizeof( I ) );
     I := $FFFFFF;
     Mem.Write( I, Sizeof( I ) );
     I := BIH.biSizeImage;
     J := Stream2Stream( Mem, Strm, I );
     while J < I do
     begin
       D := 0;
       Mem.Write( D, 4 );
       Inc( J, 4 );
     end;

       {$IFDEF ICON_DIFF_WH}
       MskBmp := NewBitmap( fWidth, fHeight );
       {$ELSE}
       MskBmp := NewBitmap( fSize, fSize );
       {$ENDIF}
       {$IFDEF ICONLOAD_PRESERVEBMPS}
       Add2AutoFree( MskBmp );
       {$ENDIF ICONLOAD_PRESERVEBMPS}
       Mem.Seek( 0, spBegin );
       {$IFDEF LOADEX}
       MskBmp.LoadFromStreamEx( Mem );
       {$ELSE}
       MskBmp.LoadFromStream( Mem );
       {$ENDIF}

    {$IFDEF ICONLOAD_PRESERVEBMPS}
    Result := TRUE;
    if not Only_Bmp then
    {$ENDIF ICONLOAD_PRESERVEBMPS}
    begin
     II.fIcon := True;
     II.xHotspot := 0;
     II.yHotspot := 0;
     II.hbmMask := 0;
     if Assigned( MskBmp ) and not MskBmp.Empty then
       II.hbmMask := MskBmp.Handle;
     II.hbmColor := 0;
     if ImgBmp <> nil then
        II.hbmColor := ImgBmp.Handle;
     fHandle := CreateIconIndirect( II );
     if SumSz > 0 then
       Strm.Seek( Integer( Pos ) + SumSz, spBegin );
     Result := fHandle <> 0;
  end;

  end;
begin
  DesiredSize := Size;
  if DesiredSize = 0 then
     DesiredSize := GetSystemMetrics( SM_CXICON );
  Clear;
  Pos := Strm.Position;

  Mem := nil;
  {$IFDEF ICONLOAD_PRESERVEBMPS}
  if ImgBmp <> nil then
  begin
    RemoveFromAutoFree( ImgBmp );
    RemoveFromAutoFree( MskBmp );
    Free_And_Nil( ImgBmp );
    Free_And_Nil( MskBmp );
  end;
  {$ELSE}
  ImgBmp := nil;
  MskBmp := nil;
  {$ENDIF ICONLOAD_PRESERVEBMPS}
  TmpBmp := nil;

  if not ReadIcon then
  begin
     Clear;
     Strm.Seek( Pos, spBegin );
  end;

  Mem.Free;
  {$IFNDEF ICONLOAD_PRESERVEBMPS}
  ImgBmp.Free;
  MskBmp.Free;
  {$ENDIF ICONLOAD_PRESERVEBMPS}
  TmpBmp.Free;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TIcon.SaveToFile(const FileName: KOLString);
begin
  SaveIcons2File( [ @Self ], FileName );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TIcon.SaveToStream(Strm: PStream);
begin
  SaveIcons2Stream( [ @Self ], Strm );
end;
{$ENDIF PAS_VERSION}

{$IFDEF ASM_noVERSION}
procedure TIcon.SetHandle(const Value: HIcon);
const szII = sizeof( TIconInfo );
      szBIH = sizeof(TBitmapInfoHeader);
asm     //cmd    //opd
        CMP      EDX, [EAX].fHandle
        JE       @@exit
        PUSHAD
        PUSH     EDX
        MOV      EBX, EAX
        CALL     Clear
        POP      ECX
        MOV      [EBX].fHandle, ECX
        JECXZ    @@fin
        ADD      ESP, -szBIH
        PUSH     ESP
        PUSH     ECX
        CALL     GetIconInfo
        MOV      ESI, [ESP].TIconInfo.hbmMask
        MOV      EDI, [ESP].TIconInfo.hbmColor
        PUSH     ESP
        PUSH     szBIH
        PUSH     ESI
        CALL     GetObject
        POP      EAX
        POP      [EBX].fSize
        ADD      ESP, szBIH-8
        TEST     ESI, ESI
        JZ       @@1
        PUSH     ESI
        CALL     DeleteObject
@@1:    TEST     EDI, EDI
        JZ       @@fin
        PUSH     EDI
        CALL     DeleteObject
@@fin:  POPAD
@@exit:
end;
{$ELSE PAS_VERSION} //Pascal
procedure TIcon.SetHandle(const Value: HIcon);
var II : TIconInfo;
    B: TagBitmap;
begin
  if FHandle = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Clear;
  FHandle := Value;
  if Value <> 0 then
  begin
     GetIconInfo( FHandle, II );
     GetObject( II.hbmMask, Sizeof( B ), @B );
     {$IFDEF ICON_DIFF_WH}
     fWidth := B.bmWidth;
     fHeight := B.bmHeight;
     {$ELSE}
     fSize := B.bmWidth;
     {$ENDIF}
     if II.hbmMask <> 0 then
       DeleteObject( II.hbmMask );
     if II.hbmColor <> 0 then
       DeleteObject( II.hbmColor );
  end;
end;
{$ENDIF PAS_VERSION}

procedure TIcon.SetHandleEx(NewHandle: HIcon);
begin
  if FHandle = NewHandle then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Clear;
  FHandle := NewHandle;
end;

procedure TIcon.SetSize(const Value: Integer);
begin
  {$IFDEF ICON_DIFF_WH}
  if (fWidth = Value) and (fHeight = Value) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>}
  {$ELSE}
  if FSize = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$ENDIF}
  Clear;
  {$IFDEF ICON_DIFF_WH}
  fWidth := Value;
  fHeight := Value;
  {$ELSE}
  FSize := Value;
  {$ENDIF}
end;

{$IFDEF ICON_DIFF_WH}
function TIcon.GetIconSize: Integer;
begin
  Result := Max( fWidth, fHeight );
end;
{$ENDIF}

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function ColorBits( ColorsCount : Integer ) : Integer;
var I : Integer;
begin
   for I := 1 to 6 do
   begin
      Result := PossibleColorBits[ I ];
      if (1 shl Result) >= ColorsCount then break;
   end;
end;
{$ENDIF PAS_VERSION}

function SaveIcons2StreamEx( const BmpHandles: array of HBitmap; Strm: PStream ): Boolean;
var I, Off : Integer;
   IDI : TIconDirEntry;
   BIH : TBitmapInfoHeader;
   B: TagBitmap;
  function RGBArraySize : Integer;
  begin
     Result := 0;
     if (IDI.bColorCount >= 2) or (IDI.bReserved = 1) then
        Result := (IDI.bColorCount + (IDI.bReserved shl 8)) * Sizeof( TRGBQuad );
  end;
  function ColorDataSize( W, H: Integer ) : Integer;
  var N: Integer;
  begin
     if (IDI.bColorCount >= 2) or (IDI.bReserved = 1) then
       N := (ColorBits( IDI.bColorCount + (IDI.bReserved shl 8) ) )
     else
     begin
       N := IDI.wBitCount;
     end;
     Result := ((N * W + 31) div 32) * 4
                   * H;
  end;
  function MaskDataSize( W, H: Integer ) : Integer;
  begin
     Result := ((W + 31) div 32) * 4 * H;
  end;
var BColor, BMask: HBitmap;
    W, H: Integer;
    ImgBmp, MskBmp: PBitmap;
    IH : TIconHeader;
    Colors : PList;
begin
  {$IFDEF KOL_ASSERTIONS}
  Assert( (High(BmpHandles) >= 0) and (High(BmpHandles) and 1 <> 0),
          'Incorrect parameters count in call to SaveIcons2StreamEx' );
  {$ENDIF KOL_ASSERTIONS}
  Result := False;
  IH.idReserved := 0;
  IH.idType := 1;
  IH.idCount := (High( BmpHandles )+1) div 2;
  if Strm.Write( IH, Sizeof( IH ) ) <> Sizeof( IH ) then Exit; {>>>>>>>>>>>>>>>}
  Off := Sizeof( IH ) + IH.idCount * Sizeof( IDI );
  Colors := NewList;
  ImgBmp := NewBitmap( 0, 0 );
  MskBmp := NewBitmap( 0, 0 );
  TRY

    for I := 0 to High( BmpHandles ) div 2 do
    begin
      BColor := BmpHandles[ I * 2 ];
      BMask  := BmpHandles[ I * 2 + 1 ];
      if (BColor = 0) and (BMask = 0) then break;
      {$IFDEF KOL_ASSERTIONS}
      Assert( BMask <> 0, 'Mask bitmap not provided for saving icons in SaveIcons2StreamEx' );
      {$ENDIF KOL_ASSERTIONS}
      GetObject( BMask, Sizeof( B ), @ B );
      W := B.bmWidth;
      H := B.bmHeight;
      if BColor <> 0 then
      begin
        GetObject( BColor, Sizeof( B ), @B );
        {$IFDEF KOL_ASSERTIONS}
        Assert( (B.bmWidth = W) and (B.bmHeight = H),
                'Mask bitmap size must much color bitmap size in SaveIcons2StreamEx' );
        {$ENDIF KOL_ASSERTIONS}
      end;
      ZeroMemory( @IDI, Sizeof( IDI ) );

      IDI.bWidth := W;
      IDI.bHeight := H;
      if BColor = 0 then
        IDI.bColorCount := 2
      else
      begin
        ImgBmp.Handle := CopyImage( BColor, IMAGE_BITMAP, W, H,
                         LR_CREATEDIBSECTION );
        ZeroMemory( @BIH, Sizeof( BIH ) );
        BIH.biSize := Sizeof( BIH );
        GetObject( ImgBmp.Handle, Sizeof( B ), @B );
        if (B.bmPlanes = 1) and (B.bmBitsPixel >= 15) then
        begin
          IDI.bColorCount := 0;
          IDI.bReserved := 0;
          IDI.wBitCount := B.bmBitsPixel;
        end
          else
        if B.bmPlanes * (1 shl B.bmBitsPixel) < 16 then
        begin
           ImgBmp.PixelFormat := pf1bit;
           IDI.bColorCount := 2;
        end
           else
        if B.bmPlanes * (1 shl B.bmBitsPixel) < 256 then
        begin
           ImgBmp.PixelFormat := pf4bit;
           IDI.bColorCount := 16;
        end
           else
        begin
           ImgBmp.PixelFormat := pf8bit;
           IDI.bColorCount := 0;
           IDI.bReserved := 1;
        end;
      end;
      Colors.Add( Pointer(IDI.bColorCount + (IDI.bReserved shl 8)) );
      IDI.dwBytesInRes := Sizeof( BIH ) +  RGBArraySize +
                          ColorDataSize( W, H ) + MaskDataSize( W, H );
      IDI.dwImageOffset := Off;
      if Strm.Write( IDI, Sizeof( IDI ) ) <> Sizeof( IDI ) then Exit; {>>>>>>>>}
      Inc( Off, IDI.dwBytesInRes );
    end;
    for I := 0 to High( BmpHandles ) div 2 do
    begin
      BColor := BmpHandles[ I * 2 ];
      BMask  := BmpHandles[ I * 2 + 1 ];
      if (BColor = 0) and (BMask = 0) then break;
      GetObject( BMask, Sizeof( B ), @ B );
      W := B.bmWidth;
      H := B.bmHeight;

      ZeroMemory( @BIH, Sizeof( BIH ) );
      BIH.biSize := Sizeof( BIH );
      BIH.biWidth := W;
      BIH.biHeight := H;
      if BColor <> 0 then
        BIH.biHeight := W * 2;
      BIH.biPlanes := 1;
      PWord( @ IDI.bColorCount )^ := DWord( Colors.Items[ I ] );
      if IDI.wBitCount = 0 then
        IDI.wBitCount := ColorBits( PWord( @ IDI.bColorCount )^ );
      BIH.biBitCount := IDI.wBitCount;
      BIH.biSizeImage := Sizeof( BIH ) + ColorDataSize( W, H ) + MaskDataSize( W, H );
      if Strm.Write( BIH, Sizeof( BIH ) ) <> Sizeof( BIH ) then Exit; {>>>>>>>>}
      if BColor <> 0 then
      begin

        ImgBmp.Handle := CopyImage( BColor, IMAGE_BITMAP, W, H, 0 );
        case BIH.biBitCount of
        1 : ImgBmp.PixelFormat := pf1bit;
        4 : ImgBmp.PixelFormat := pf4bit;
        8 : ImgBmp.PixelFormat := pf8bit;
        16: ImgBmp.PixelFormat := pf16bit;
        24: ImgBmp.PixelFormat := pf24bit;
        32: ImgBmp.PixelFormat := pf32bit;
        end;
      end
        else
      begin
        ImgBmp.Handle := CopyImage( BMask, IMAGE_BITMAP, W, H, 0 );
        ImgBmp.PixelFormat := pf1bit;
      end;
      if ImgBmp.FDIBBits <> nil then
      begin
        if Strm.Write( Pointer(Integer(ImgBmp.FDIBHeader) + Sizeof(TBitmapInfoHeader))^,
           PWord( @ IDI.bColorCount )^ * Sizeof( TRGBQuad ) ) <>
           PWord( @ IDI.bColorCount )^ * Sizeof( TRGBQuad ) then Exit; {>>>>>>>}
        if Strm.Write( ImgBmp.FDIBBits^, ColorDataSize( W, H ) ) <>
           DWord( ColorDataSize( W, H ) ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
    MskBmp.Handle := CopyImage( BMask, IMAGE_BITMAP, W, H, 0 );

    MskBmp.PixelFormat := pf1bit;
    if Strm.Write( MskBmp.FDIBBits^, MaskDataSize( W, H ) ) <>
      DWord( MaskDataSize( W, H ) ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;

  FINALLY
    Colors.Free;
    ImgBmp.Free;
    MskBmp.Free;
  END;
  Result := True;
end;

{$IFDEF FPC}
  {$DEFINE _D3orFPC}
{$ENDIF}
{$IFDEF _D2orD3}
  {$DEFINE _D3orFPC}
{$ENDIF}
procedure SaveIcons2Stream( const Icons : array of PIcon; Strm : PStream );
var I, J, Pos : Integer;
    {$IFDEF _D3orFPC}
    Bitmaps: array[ 0..63 ] of HBitmap;
    {$ELSE DELPHI}
    Bitmaps: array of HBitmap;
    {$ENDIF FPC/DELPHI}
    II: TIconInfo;
    Bmp: HBitmap;
begin
  for I := 0 to High( Icons ) do
  begin
     if Icons[ I ].Handle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
     for J := I + 1 to High( Icons ) do
        if Icons[ I ].Size = Icons[ J ].Size then Exit; {>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Pos := Strm.Position;

  {$IFDEF _D3orFPC}
  for I := 0 to High( Bitmaps ) do
    Bitmaps[ I ] := 0;
  {$ELSE DELPHI}
  SetLength( Bitmaps, Length( Icons ) * 2 );
  {$ENDIF FPC/DELPHI}
  for I := 0 to High( Icons ) do
  begin
    GetIconInfo( Icons[ I ].Handle, II );
    Bitmaps[ I * 2 ] := II.hbmColor;
    Bitmaps[ I * 2 + 1 ] := II.hbmMask;
  end;

  if not SaveIcons2StreamEx( Bitmaps, Strm ) then
     Strm.Seek( Pos, spBegin );

  for I := 0 to High( Bitmaps ) do
  begin
    Bmp := Bitmaps[ I ];
    if Bmp <> 0 then
      DeleteObject( Bmp );
  end;
end;

procedure SaveIcons2File( const Icons : array of PIcon; const FileName : KOLString );
var Strm: PStream;
begin
  Strm := NewWriteFileStream( FileName );
  SaveIcons2Stream( Icons, Strm );
  Strm.Free;
end;

procedure TIcon.LoadFromExecutable(const FileName: KOLString; IconIdx: Integer);
var I: Integer;
begin
  Clear;
  I := ExtractIcon( hInstance, PKOLChar( FileName ), IconIdx );
  if I > 1 then
    Handle := I;
end;

function GetFileIconCount( const FileName: KOLString ): Integer;
begin
  Result := ExtractIcon( hInstance, PKOLChar( FileName ), DWORD(-1) );
end;

procedure TIcon.LoadFromResourceID(Inst, ResID, DesiredSize: Integer);
begin
  LoadFromResourceName( Inst, MAKEINTRESOURCE( ResID ), DesiredSize );
end;

procedure TIcon.LoadFromResourceName(Inst: Integer; ResName: PKOLChar; DesiredSize: Integer);
begin
  Handle := LoadImage( Inst, ResName, IMAGE_ICON, DesiredSize, DesiredSize, $8000 {LR_SHARED} );
  if fHandle <> 0 then FShareIcon := True;
end;

function LoadImgIcon( RsrcName: PKOLChar; Size: Integer ): HIcon;
begin
  Result := LoadImage( hInstance, RsrcName, IMAGE_ICON, Size, Size, $8000 {LR_SHARED} );
end;

{$IFDEF OLD_ALIGN}
procedure AlignChildrenProc( Sender: PObj );
type
  TAligns = set of TControlAlign;
var P: PControl;
    CR: TRect;
  procedure DoAlign( Allowed: TAligns );
  var I: Integer;
      C: PControl;
      R, R1: TRect;
      W, H: Integer;
      ChgPos, ChgSiz: Boolean;
  begin
    for I := 0 to P.fChildren.fCount - 1 do
    begin
      C := P.fChildren.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ];
      if not C.ToBeVisible then continue;
      // important: not fVisible, and even not Visible, but ToBeVisible!
      if  {$IFDEF USE_FLAGS} G4_NotUseAlign in C.fFlagsG4
          {$ELSE} C.fNotUseAlign {$ENDIF} then continue;
      if C.FAlign in Allowed then
      begin
        R := C.BoundsRect;
        R1 := R;
        W := R.Right - R.Left;
        H := R.Bottom - R.Top;
        case C.FAlign of
        caTop:
          begin
            OffsetRect( R, 0, -R.Top + CR.Top + P.Margin );
            Inc( CR.Top, H + P.Margin );
            R.Left := CR.Left + P.Margin;
            R.Right := CR.Right - P.Margin;
          end;
        caBottom:
          begin
            OffsetRect( R, 0, -R.Bottom + CR.Bottom - P.Margin );
            Dec( CR.Bottom, H + P.Margin );
            R.Left := CR.Left + P.Margin;
            R.Right := CR.Right - P.Margin;
          end;
        caLeft:
          begin
            OffsetRect( R, -R.Left + CR.Left + P.Margin, 0 );
            Inc( CR.Left, W + P.Margin );
            R.Top := CR.Top + P.Margin;
            R.Bottom := CR.Bottom - P.Margin;
          end;
        caRight:
          begin
            OffsetRect( R, -R.Right + CR.Right - P.Margin, 0 );
            Dec( CR.Right, W + P.Margin );
            R.Top := CR.Top + P.Margin;
            R.Bottom := CR.Bottom - P.Margin;
          end;
        caClient:
          begin
            R := CR;
            InflateRect( R, -P.Margin, -P.Margin );
          end;
        end;
        if R.Right < R.Left then R.Right := R.Left;
        if R.Bottom < R.Top then R.Bottom := R.Top;
        ChgPos := (R.Left <> R1.Left) or (R.Top <> R1.Top);
        ChgSiz := (R.Right - R.Left <> W) or (R.Bottom - R.Top <> H);
        if ChgPos or ChgSiz then
        begin
          C.BoundsRect := R;
          if ChgSiz then
            AlignChildrenProc( C );
        end;
      end;
    end;
  end;
begin
  P := Pointer( Sender );
  if P = nil then Exit; // Called for form - ignore. {>>>>>>>>>>>>>>>>>>>>>>>>>}
  CR := P.ClientRect;
  if CR.Right <= CR.Left then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  DoAlign( [ caTop, caBottom ] );
  DoAlign( [ caLeft, caRight ] );
  DoAlign( [ caClient ] );
end;
{$ELSE NEW_ALIGN}

procedure AlignChildrenProc_(P:PControl);
type TAligns = set of TControlAlign;
var CR: TRect;
  procedure DoAlign( Allowed: TAligns );
  var I, W, H: Integer;
     C: PControl;
     R, R1: TRect;
     ChgPos, ChgSiz: Boolean;
  begin
    for I := 0 to P.fChildren.fCount - 1 do
    begin
      if not (oaAligning in P.fAligning) then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>}
      C := P.fChildren.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ];
      with C^ do
      begin
        {$IFDEF SAFE_CODE}
        C.RefInc;
        TRY
        {$ENDIF}
          if (not(
                  {$IFDEF USE_FLAGS} (F3_Visible in fStyle.f3_Style)
                  {$ELSE}            fVisible {$ENDIF}
                  {$IFDEF CREATE_HIDDEN}
                  or
                  {$IFDEF USE_FLAGS} (G4_CreateHidden in fFlagsG4)
                  {$ELSE} fCreateHidden {$ENDIF}
                  {$ENDIF CREATE_HIDDEN}
                  ))
             or(not(fAlign in Allowed)) then continue;
          if  {$IFDEF USE_FLAGS} not(G4_NotUseAlign in fFlagsG4)
              {$ELSE} not fNotUseAlign {$ENDIF} then
          begin
            R := BoundsRect;
            R1 := R;
            W := R.Right - R.Left;
            H := R.Bottom - R.Top;
            case FAlign of
             caTop:
               begin
                 OffsetRect( R, 0, -R.Top + CR.Top + P.Margin );
                 Inc( CR.Top, H + P.Margin );
                 R.Left := CR.Left + P.Margin;
                 R.Right := CR.Right - P.Margin;
               end;
             caBottom:
               begin
                 OffsetRect( R, 0, -R.Bottom + CR.Bottom - P.Margin );
                 Dec( CR.Bottom, H + P.Margin );
                 R.Left := CR.Left + P.Margin;
                 R.Right := CR.Right - P.Margin;
               end;
             caLeft:
               begin
                 OffsetRect( R, -R.Left + CR.Left + P.Margin, 0 );
                 Inc( CR.Left, W + P.Margin );
                 R.Top := CR.Top + P.Margin;
                 R.Bottom := CR.Bottom - P.Margin;
               end;
             caRight:
               begin
                 OffsetRect( R, -R.Right + CR.Right - P.Margin, 0 );
                 Dec( CR.Right, W + P.Margin );
                 R.Top := CR.Top + P.Margin;
                 R.Bottom := CR.Bottom - P.Margin;
               end;
             caClient:
               begin
                 R := CR;
                 InflateRect( R, -P.Margin, -P.Margin );
               end;
            end;
            if R.Right < R.Left then R.Right := R.Left;
            if R.Bottom < R.Top then R.Bottom := R.Top;
            ChgPos := (R.Left <> R1.Left) or (R.Top <> R1.Top);
            ChgSiz := (R.Right - R.Left <> W) or (R.Bottom - R.Top <> H);
            if ChgSiz then
            begin
              exclude(fAligning,oaWaitAlign);
              include(fAligning,oaFromSelf);
            end;
            if ChgPos or ChgSiz then BoundsRect := R;
          end;
        {$IFDEF SAFE_CODE}
        FINALLY
          C.RefDec;
        END;
        {$ENDIF SAFE_CODE}
        if oaWaitAlign in fAligning then AlignChildrenProc_(C);
      end;
    end;
  end;

begin
  exclude(P.fAligning,oaWaitAlign);
  include(P.fAligning,oaAligning);
 CR := P.ClientRect;
 DoAlign( [ caTop, caBottom ] );
 DoAlign( [ caLeft, caRight ] );
 DoAlign( [ caClient,caNone ] );
  exclude(P.fAligning,oaAligning);
end;

{$IFDEF ASM_TLIST}
procedure AlignChildrenProc(Sender: PObj);
const AlignModes = (1 shl byte(caBottom))+(1 shl byte(caTop))+
                 (((1 shl byte(caRight)) +(1 shl byte(caLeft)))shl 8)+
                 (((1 shl byte(caClient))+(1 shl byte(caNone)))shl 16);
asm     //cmd    //opd
        TEST     EAX,EAX
        JZ       @@21
        CMP      [EAX].TControl.fParent,0
        SETZ     DL
        {$IFDEF  USE_FLAGS}
        TEST     [EAX].TControl.fFlagsG3, (1 shl G3_IsForm)
        SETNZ    DH
        OR       DL, DH
        {$ELSE}
        OR       DL,[EAX].TControl.fIsForm
        {$ENDIF}
        BTR      dword ptr[EAX].TControl.fAligning,oaFromSelf
        JA       @@20
        OR       byte ptr[EAX].TControl.fAligning,(1 shl oaWaitAlign)
        MOV      EAX,[EAX].TControl.fParent
@@20:   TEST     EAX, EAX
        JZ       @@21
        CALL     @@ToBeAlign
        JNZ      @@DoAlign
@@21:   RETN

@@ToBeAlign:
        {$IFDEF  USE_FLAGS}
        TEST     [EAX].TControl.fStyle.f3_Style, 1 shl F3_Visible
        SETNZ    DL
        {$ELSE}
        MOV      DL,[EAX].TControl.fVisible
        {$ENDIF}
        {$IFDEF  USE_FLAGS}
        TEST     [EAX].TControl.fFlagsG3, 1 shl G3_IsForm
        SETNZ    DH
        OR       DL, DH
        TEST     [EAX].TControl.fFlagsG4, (1 shl G4_CreateHidden)
        SETNZ    DH
        OR       DL, DH
        {$ELSE}
        OR       DL,[EAX].TControl.fCreateHidden
        {$ENDIF}
        JE       @@10
        {$IFDEF  USE_FLAGS}
        TEST     [EAX].TControl.fFlagsG3, 1 shl G3_IsForm
        SETNZ    DH
        AND      DL, DH
        {$ELSE}
        AND      DL,[EAX].TControl.fIsForm
        {$ENDIF}
        JNE      @@12
        CMP      dword ptr[EAX].TControl.fParent,0
        JE       @@11
        PUSH     EAX
        MOV      EAX,[EAX].TControl.fParent
        CALL     @@ToBeAlign
        POP      EAX
@@10:   XOR      DL,1
//!!! Important: oaWaitAlign=0
        OR       [EAX].TControl.fAligning,DL
@@11:   XOR      DL,1
@@12:   RETN

@@DoAlign:
        //CALL     AlignChildrenProc_
        //RET
        PUSH     EBP
        PUSH     EBX
        PUSH     ESI
        PUSH     EDI
        PUSH     AlignModes //00210A14h
        SUB      ESP,030h
        MOV      EBX,EAX
        AND      byte ptr[EBX].TControl.fAligning,not(1 shl oaWaitAlign)
        OR       byte ptr[EBX].TControl.fAligning,(1 shl oaAligning)
        LEA      EDX,[ESP+20h] //@CR
        CALL     TControl.ClientRect
@@Main:
        MOV      EAX,[EBX].TControl.fChildren
        MOV      EDI,[EAX].TList.fCount
        MOV      EBP,[EAX].TList.fItems
        JMP      @@entry
@@loop:
        MOV      ESI,[EBP]
        {$IFDEF  USE_FLAGS}
        MOV      AL,[ESI].TControl.fStyle.f3_Style
        SHR      AL, F3_Visible
        OR       AL,[ESI].TControl.fFlagsG4
        AND      AL, 1 shl G4_CreateHidden // G4_CreateHidden = 0 !!!
        {$ELSE}
        MOV      AL,[ESI].TControl.fVisible
        OR       AL,[ESI].TControl.fCreateHidden
        {$ENDIF}
        JZ       @@continue
        MOVZX    EAX,[ESI].TControl.fAlign
        BT       [ESP+30h],EAX //Allowed
        JNC      @@continue
        {$IFDEF  USE_FLAGS}
        TEST     [ESI].TControl.fFlagsG4, 1 shl G4_NotUseAlign
        {$ELSE}
        CMP      byte ptr[ESI].TControl.fNotUseAlign,0
        {$ENDIF}
        JNE      @@align
        MOV      EDX,ESP       //@R
        MOV      EAX,ESI       //C
        CALL     TControl.GetBoundsRect
        MOV      EAX,[ESP+0Ch] //R.Bottom
        MOV      [ESP+1Ch],EAX //H
        MOV      EAX,[ESP+08h] //R.Right
        MOV      [ESP+18h],EAX //W
        MOV      EAX,[ESP+04h] //R.Top
        MOV      [ESP+14h],EAX //R1.Top
        SUB      [ESP+1Ch],EAX //H
        MOV      EAX,[ESP]     //R.Left
        MOV      [ESP+10h],EAX //R1.Left
        SUB      [ESP+18h],EAX //W
        MOVSX    EDX,[EBX].TControl.fMargin
        MOVZX    ECX,byte ptr[ESI].TControl.fAlign
//!!! Order of caXXX-constants is important
        LOOP     @@caTop
        MOV      EAX,[ESP+20h] //CR.Left
        SUB      EAX,[ESP]     //R.Left
        ADD      EAX,EDX       //+Margin
        MOV      ECX,[ESP+18h] //W
        ADD      ECX,EDX       //+Margin
        ADD      [ESP+20h],ECX //CR.Left
        JMP      @@00
@@caTop:
        LOOP     @@caRight
        MOV      EAX,[ESP+24h] //CR.Top
        SUB      EAX,[ESP+04h] //R.Top
        ADD      EAX,EDX       //+Margin
        MOV      ECX,[ESP+1Ch] //H
        ADD      ECX,EDX       //+Margin
        ADD      [ESP+24h],ECX //CR.Top
        JMP      @@01
@@caRight:
        LOOP     @@caBottom
        MOV      EAX,[ESP+28h] //CR.Right
        SUB      EAX,[ESP+08h] //R.Right
        SUB      EAX,EDX       //-Margin
        MOV      ECX,[ESP+18h] //W
        ADD      ECX,EDX       //+Margin
        SUB      [ESP+28h],ECX //CR.Right
@@00:   ADD      [ESP],EAX     //R.Left
        ADD      [ESP+08h],EAX //R.Right
        MOV      EAX,[ESP+2Ch] //CR.Bottom
        SUB      EAX,EDX       //+Margin
        MOV      [ESP+0Ch],EAX //R.Bottom
        ADD      EDX,[esp+24h] //Margin+CR.Top
        MOV      [ESP+04h],edx //R.Top
        JMP      @@caNone
@@caBottom:
        LOOP     @@caClient
        MOV      EAX,[ESP+2Ch] //CR.Bottom
        SUB      EAX,[ESP+0Ch] //R.Bottom
        SUB      EAX,EDX       //-Margin
        MOV      ECX,[ESP+1Ch] //H
        ADD      ECX,EDX       //+Margin
        SUB      [ESP+2Ch],ECX //CR.Bottom
@@01:   ADD      [ESP+04h],EAX //R.Top
        ADD      [ESP+0Ch],EAX //R.Bottom
        MOV      EAX,[ESP+28h] //CR.Right
        SUB      EAX,EDX       //-Margin
        MOV      [esp+08h],EAX //R.Right
        ADD      EDX,[ESP+20h] //Margin+CR.Left
        MOV      [ESP],EDX     //R.Left
        JMP      @@caNone
@@caClient:
        LOOP     @@caNone
        MOV      EAX,[ESP+2Ch] //CR.Bottom
        SUB      EAX,EDX       //-Margin
        MOV      [ESP+0Ch],EAX //R.Bottom
        MOV      EAX,[ESP+28h] //CR.Right
        SUB      EAX,EDX       //-Margin
        MOV      [ESP+08h],EAX //R.Right
        MOV      EAX,[ESP+24h] //CR.Top
        ADD      EAX,EDX       //+Margin
        MOV      [ESP+04h],EAX //R.Top
        ADD      EDX,[ESP+20h] //Margin+CR.Left
        MOV      [ESP],EDX     //R.Left
@@caNone:
        MOV      EAX,[ESP]     //R.Left
        CMP      EAX,[ESP+08h] //R.Right
        JLE      @@02  //CMOVG ???
        MOV      [ESP+08h],EAX //R.Right
@@02:   MOV      EAX,[ESP+04h] //R.Top
        CMP      EAX,[ESP+0Ch] //R.Bottom
        JLE      @@03  //CMOVG ???
        MOV      [ESP+0Ch],EAX //R.Bottom
@@03:   MOV      EDX,[ESP]     //R.Left
        SUB      EDX,[ESP+10h] //R1.Left
        MOV      EAX,[ESP+04h] //R.Top
        SUB      EAX,[ESP+14h] //R1.Top
        OR       EDX,EAX       //ChgPos
        MOV      ECX,[ESP+08h] //R.Right
        SUB      ECX,[ESP]     //R.Left
        SUB      ECX,[ESP+18h] //W
        MOV      EAX,[ESP+0Ch] //R.Bottom
        SUB      EAX,[ESP+04h] //R.Top
        SUB      EAX,[ESP+1Ch] //H
        OR       EAX,ECX
        JZ       @@04
        AND      byte ptr[ESI].TControl.fAligning,not(1 shl oaWaitAlign)
        OR       byte ptr[ESI].TControl.fAligning,(1 shl oaFromSelf)
@@04:   OR       EAX,EDX
        JZ       @@align
        MOV      EDX,ESP       //@R
        MOV      EAX,ESI       //C
        CALL     TControl.SetBoundsRect
@@align:
        TEST     byte ptr[ESI].TControl.fAligning,(1 shl oaWaitAlign)
        JZ       @@continue
        MOV      EAX,ESI       //C
        CALL     @@DoAlign
@@continue:
        TEST     byte ptr[EBX].TControl.fAligning,(1 shl oaAligning)
        JZ       @@exit
        ADD      EBP,4
@@entry:
        DEC      EDI
        JGE      @@loop
        SHR      dword ptr[ESP+30h],8 //Allowed
        JNZ      @@Main
        AND      byte ptr[EBX].TControl.fAligning,not(1 shl oaAligning)
@@exit:
        ADD      ESP,34h
        POP      EDI
        POP      ESI
        POP      EBX
        POP      EBP
end;
{$ELSE PAS_VERSION} // Pascal
procedure AlignChildrenProc(Sender: PObj);
  function ToBeAlign( S: PControl ):Boolean;
  begin
    {$IFDEF USE_FLAGS}
    Result := (
              (F3_Visible in S.fStyle.f3_Style)
              or (
              (G3_IsForm in S.fFlagsG3) // òàê íàäî!
              {$IFDEF CREATE_HIDDEN}
              or (G4_CreateHidden in S.fFlagsG4)
              {$ENDIF CREATE_HIDDEN}
              ) )
      and     (  (G3_IsForm in S.fFlagsG3)
              or (S.fParent=nil) or ToBeAlign(S.fParent)
              );
    {$ELSE}
    Result := (
              S.fVisible
              {$IFDEF CREATE_HIDDEN}
              or (
              S.fCreateHidden
                 )
              {$ENDIF CREATE_HIDDEN}
              )
      and     (  S.fIsForm
              or (S.fParent=nil) or ToBeAlign(S.fParent)
              );
    {$ENDIF}
    if not Result then include(S.fAligning,oaWaitAlign);
  end;
var fromSelf: Boolean;
    S: PControl;
begin
  if Sender = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  S := Pointer( Sender );
  fromSelf := oaFromSelf in S.fAligning;
  Exclude( S.fAligning, oaFromSelf );
  if  ( (S.fParent = nil)
  or  {$IFDEF USE_FLAGS} (G3_IsForm in S.fFlagsG3)
      {$ELSE} (S.fIsForm) {$ENDIF} ) and (not fromSelf) then
  else
  begin
    include(S.fAligning, oaWaitAlign);
    S := S.Parent;
  end;
  if (S <> nil) and ToBeAlign(S) then
    AlignChildrenProc_(S);
end;
{$ENDIF PAS_VERSION}
{$ENDIF OLD_ALIGN}

procedure TControl.Set_Align(const Value: TControlAlign);
begin
  Global_Align := AlignChildrenProc;
  if  {$IFDEF USE_FLAGS} G4_NotUseAlign in fFlagsG4
      {$ELSE} fNotUseAlign {$ENDIF} then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if FAlign = Value then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FAlign := Value;
  {$IFDEF OLD_ALIGN}
  AlignChildrenProc( Parent );
  {$ELSE NEW_ALIGN}
  AlignChildrenProc(@Self);
  {$ENDIF}
end;

function TControl.SetAlign(AAlign: TControlAlign): PControl;
begin
  Set_Align( AAlign );
  Result := @Self;
end;

{$IFDEF LOG_ANTIFLICK}
procedure LogFlick( const s: AnsiString; const rects: array of TRect );
var s1: AnsiString;
    i: Integer;
begin
  s1 := s + ' ';
  for i := 0 to High( rects ) do
  begin
    s1 := s1 + '[' + Int2Str( rects[i].Left ) + ',' + Int2Str( rects[i].top ) +
      ',' + Int2Str( rects[i].Right ) + ',' + Int2Str( rects[i].Bottom ) +
      '=' + Int2Str( rects[i].Right - rects[i].Left ) + 'x' +
      Int2Str( rects[i].Bottom - rects[i].Top ) + ']';
  end;
  LogFileOutput( GetStartDir + 'log_antiflick', s1 );
end;
{$ENDIF}

procedure TControl.Update;
var I: Integer;
    C: PControl;
begin
  if fUpdateCount > 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  UpdateWindow( fHandle );
  for I := 0 to fChildren.fCount - 1 do
  begin
    C := fChildren.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ];
    C.Update;
  end;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function WndProcUpdate( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  if Sender.fUpdateCount <> 0 then
  begin
    case Msg.message of
    WM_PAINT:
      begin
        ValidateRect( Sender.Handle, nil );
        Rslt := 0;
      end;
    WM_ERASEBKGND: Rslt := 1;
    else begin
           Result := FALSE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
         end;
    end;
    Result := TRUE;
  end
    else Result := FALSE;
end;
{$ENDIF PAS_VERSION}

procedure TControl.BeginUpdate;
begin
  Inc( fUpdateCount );
  AttachProc( @WndProcUpdate );
end;

procedure TControl.EndUpdate;
begin
  Dec( fUpdateCount );
  if fUpdateCount <= 0 then
  begin
    Invalidate;
    //Update;
  end;
end;

function TControl.GetSelection: KOLString;
var L: Integer;
begin
  if fCommandActions.aGetSelection <> 0 then
  begin
    L := SelLength;
    SetString( Result, nil, L + 1 );
    Perform( fCommandActions.aGetSelection, 0, Integer( @Result[ 1 ] ) );
  end
     else
  Result := Copy( Text, SelStart + 1, SelLength );
end;

procedure TControl.SetSelection(const Value: KOLString);
begin
  ReplaceSelection( Value, True );
end;

procedure TControl.ReplaceSelection(const Value: KOLString; aCanUndo: Boolean);
begin
  if fCommandActions.aReplaceSel <> 0 then
  begin
    Perform( fCommandActions.aReplaceSel, Integer( aCanUndo ), Integer( PKOLchar( Value ) ) );
  end;
end;

procedure TControl.DeleteLines(FromLine, ToLine: Integer);
var I1, I2: DWORD;
    SStart, SLength: DWORD;
begin
  if FromLine > ToLine then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$IFDEF KOL_ASSERTIONS}
  Assert( FromLine >= 0, 'Incorrect line index' );
  {$ENDIF KOL_ASSERTIONS}
  I1 := Item2Pos( FromLine );
  I2 := Item2Pos( ToLine+1 ) - I1;
  SStart := SelStart;
  SLength := SelLength;
  SelStart := I1;
  {if ToLine >= Count-1 then
    I2 := MaxInt;}
  SelLength := I2;
  ReplaceSelection( '', TRUE );
  if SStart >= I2 then
  begin
    SStart := SStart - (I2 - I1);
  end
    else
  if SStart >= I1 then
  begin
    SLength := SLength - (I2 - SStart);
    SStart := I1;
  end
    else
  if SStart + SLength >= I2 then
  begin
    SLength := SLength - (I2 - I1);
  end
    else
  if SStart + SLength >= I1 then
  begin
    SLength := I1 - SLength;
  end;
  SelStart := SStart;
  SelLength := Max( 0, SLength );
end;

procedure TControl.SetTabOrder(const Value: SmallInt);
var CL: PList;
    I : Integer;
    C: PControl;
begin
  if Value = fTabOrder then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  CL := CollectTabControls( ParentForm );
  for I := 0 to CL.fCount - 1 do
  begin
    C := CL.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ];
    if C.fTabOrder >= Value then
      Inc( C.fTabOrder );
  end;
  fTabOrder := Value;
  CL.Free;
end;

function TControl.GetFocused: Boolean;
begin
  if  {$IFDEF USE_FLAGS} G3_IsControl in fFlagsG3
      {$ELSE} fIsControl {$ENDIF} then
      Result := ParentForm.DF.fCurrentControl = @Self
  else
      Result := GetForegroundWindow = fHandle;
end;

{$IFDEF ASM_VERSION}{$ELSE  PAS_VERSION}
procedure TControl.SetFocused(const Value: Boolean);
var PF: PControl;
begin
  if  not Value or
      {$IFDEF USE_FLAGS} not( F2_Tabstop in fStyle.f2_Style )
      {$ELSE}            not fTabStop {$ENDIF} then Exit; {>>>>>>>>>>>>>>>>>>>>}
  if  {$IFDEF USE_FLAGS} G3_IsControl in fFlagsG3
      {$ELSE} fIsControl {$ENDIF} then
  begin
    PF := ParentForm;
    if  ( PF.DF.fCurrentControl <> nil ) and (PF.DF.fCurrentControl <> @ Self) then
        if  Assigned( PF.DF.fCurrentControl.EV.fLeave ) then
            PF.DF.fCurrentControl.EV.fLeave( PF.DF.fCurrentControl )
        else
            Windows.SetFocus( 0 );
    PF.DF.fCurrentControl := @Self;
    {$IFDEF USE_GRAPHCTLS}
    if  Assigned( fSetFocus ) then
        fSetFocus(@Self)
    else
    {$ENDIF}
        SetFocus( GetWindowHandle );
  end
    else
    SetForegroundWindow( GetWindowHandle );
end;
{$ENDIF PAS_VERSION}

{$IFNDEF NOT_USE_RICHEDIT}

//////////////////////////////////////////////////////////////////////
//                  R  I  C  H     E  D  I  T
//////////////////////////////////////////////////////////////////////

{ -- rich edit -- }

function TControl.REGetFont: PGraphicTool;
var
  CF: PCharFormat;
  //CFA: PCharFormat2A;
  //CFW: PCharFormat2W;
  FS: TFontStyle;
begin
  {$IFDEF STATIC_RICHEDIT_DATA}
  CF := @ DF.fRECharFormatRec;
  {$ELSE}
  CF := DF.fRECharFormatRec;
  {$ENDIF}
  ZeroMemory( CF, Sizeof( CF^ ) );
  {$IFDEF UNICODE_CTRLS}
  CF.cbSize := Sizeof( CF^ );
  {$ELSE}
  CF.cbSize := sizeof( RichEdit.TCharFormat ) + DF.fCharFmtDeltaSz;
  {$ENDIF}
  if  DF.fTmpFont = nil then
  begin
      DF.fTmpFont := NewFont;
      {$IFDEF USE_AUTOFREE4CONTROLS}
      Add2AutoFree( DF.fTmpFont );
      {$ENDIF}
  end;
  Result := DF.fTmpFont;
  Result.OnChange := nil;
  Perform( EM_GETCHARFORMAT, 1, Integer( CF ) );
  Result.FontHeight := CF.yHeight;
  FS := [ ];
  if  LongBool(CF.dwEffects and CFE_BOLD) then
      FS := [ fsBold ];
  if  LongBool(CF.dwEffects and CFE_ITALIC) then
      include( FS, fsItalic );
  if  LongBool(CF.dwEffects and CFE_STRIKEOUT) then
      include( FS, fsStrikeOut );
  if  LongBool(CF.dwEffects and CFE_UNDERLINE) then
      include( FS, fsUnderline );
  Result.FontStyle := FS;
  if not LongBool(CF.dwEffects and CFE_AUTOCOLOR) then
    Result.Color := CF.crTextColor;
  Result.FontPitch := TFontPitch( CF.bPitchAndFamily and 3 );
  Result.FontCharset := CF.bCharSet;
  {$IFDEF UNICODE_CTRLS}
  {$ELSE}
  if  (PWord( @CF.szFaceName[0] )^ shr 8) <> 0 then
      Result.FontName := PAnsiChar(@CF.szFaceName[0]) // real T,0 works fine.
  else
  {$ENDIF}
      Result.FontName := KOLString(PWideChar(@CF.szFaceName[0]));
  Result.OnChange := RESetFont;
end;

const RichAreas: array[ TRichFmtArea ] of Integer = ( SCF_SELECTION,
      3 {SCF_WORD}, 4 {SCF_ALL} );

procedure TControl.RESetFontEx(const Index: Integer);
var CF: PCharFormat;
    FS: TFontStyle;
begin
  {$IFDEF STATIC_RICHEDIT_DATA}
  CF := @ DF.fRECharFormatRec;
  {$ELSE}
  CF := DF.fRECharFormatRec;
  {$ENDIF}
  ZeroMemory( CF, {82} sizeof( CF^ ) );
  {$IFDEF UNICODE_CTRLS}
  CF.cbSize := Sizeof( CF^ );
  {$ELSE}
  CF.cbSize := 60 { sizeof( TCharFormat ) } + DF.fCharFmtDeltaSz;
  {$ENDIF}
  CF.dwMask := CFM_BOLD or CFM_COLOR or CFM_FACE or CFM_ITALIC
            or CFM_SIZE or CFM_STRIKEOUT or CFM_UNDERLINE;
  CF.yHeight := DF.fTmpFont.FontHeight;
  FS := DF.fTmpFont.FontStyle;
  if fsBold in FS then CF.dwEffects := CFE_BOLD;
  if fsItalic in FS then CF.dwEffects := CF.dwEffects or CFE_ITALIC;
  if fsStrikeOut in FS then CF.dwEffects := CF.dwEffects or CFE_STRIKEOUT;
  if fsUnderline in FS then CF.dwEffects := CF.dwEffects or CFE_UNDERLINE;
  CF.crTextColor := Color2RGB(DF.fTmpFont.Color);
  CF.bCharSet := DF.fTmpFont.FontCharset;
  CF.bPitchAndFamily := Ord( DF.fTmpFont.FontPitch );
  {$IFDEF UNICODE_CTRLS} WStrLCopy {$ELSE} StrLCopy {$ENDIF}
    ( CF.szFaceName, PKOLChar( DF.fTmpFont.FontName ), 31 );
  Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ], Integer( CF ) );
end;

procedure TControl.RESetFont(Value: PGraphicTool);
var H: Integer;
begin
  if  Value <> DF.fTmpFont then
      REGetFont;
  H := DF.fTmpFont.fData.Font.Height;
  DF.fTmpFont := DF.fTmpFont.Assign( Value );
  if  DF.fTmpFont.fData.Font.Height = 0 then
      DF.fTmpFont.fData.Font.Height := H;
  RESetFontEx( Integer( CFM_BOLD or CFM_COLOR or CFM_FACE or CFM_ITALIC
            or CFM_SIZE or CFM_STRIKEOUT or CFM_UNDERLINE ) );
end;

function TControl.REGetFontMask( const Index: Integer ): Boolean;
begin
  REGetFont;
  Result := LongBool( DF.fRECharFormatRec.dwMask and Index );
end;

function TControl.REGetFontEffects(const Index: Integer): Boolean;
begin
  REGetFont;
  Result := LongBool( DF.fRECharFormatRec.dwEffects and Index );
end;

procedure TControl.RESetFontEffect(const Index: Integer;
  const Value: Boolean);
var
  CF: PCharFormat;
begin
  ReGetFont;
  {$IFDEF STATIC_RICHEDIT_DATA}
  CF := @ DF.fRECharFormatRec;
  {$ELSE}
  CF := DF.fRECharFormatRec;
  {$ENDIF}
  {
  CF.dwEffects := $FFFFFFFF and Index;
  if not Value then CF.dwEffects := 0;
  }
  CF.dwEffects := CF.dwEffects or DWORD( Index );
  if not Value then CF.dwEffects := CF.dwEffects and not Index;
  CF.dwMask := Index;
  Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ], Integer( CF ) );
end;

function TControl.REGetFontAttr(const Index: Integer): Integer;
var CF: PDWORD;
    Mask: DWORD;
begin
  REGetFont;
  CF := Pointer( Integer( @DF.fRECharFormatRec ) + (HiWord(Index) and $7E) );
  Mask := $FFFFFFFF;
  if LongBool( HiWord(Index) and $1 ) then
    Mask := $FF;
  Result := CF^ and Mask;
end;

procedure TControl.RESetFontAttr(const Index, Value: Integer);
var CF: PDWORD;
    Mask: DWORD;
begin
  REGetFont;
  {$IFDEF STATIC_RICHEDIT_DATA}
  CF := Pointer( Integer( @ DF.fRECharFormatRec ) + (HiWord(Index) and $7E) );
  {$ELSE}
  CF := Pointer( Integer( DF.fRECharFormatRec ) + (HiWord(Index) and $7E) );
  {$ENDIF}
  Mask := 0;
  if LongBool( HiWord(Index) and $1 ) then
    Mask := $FFFFFF00;
  CF^ := CF^ and Mask or DWORD(Value);
  DF.fRECharFormatRec.dwMask := Index and $FF81FFFF;
  if LongBool( DF.fRECharFormatRec.dwMask and (CFM_COLOR or CFM_BACKCOLOR) ) then
    DF.fRECharFormatRec.dwEffects := DF.fRECharFormatRec.dwEffects and
                               not (CFE_AUTOCOLOR or CFE_AUTOBACKCOLOR);
  Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ],
      Integer( {$IFDEF STATIC_RICHEDIT_DATA} @ {$ENDIF} DF.fRECharFormatRec ) );
end;

procedure TControl.RESetFontAttr1(const Index, Value: Integer);
begin
  RESetFontAttr( Index, Color2RGB( Value ) );
end;

function TControl.REGetFontSizeValid: Boolean;
begin
  Result := REGetFontMask( Integer( CFM_SIZE ) );
end;

function TControl.REGetFontName: KOLString;
begin
  ReGetFont;
  Result := DF.fRECharFormatRec.szFaceName;
end;

procedure TControl.RESetFontName(const Value: KOLString);
begin
  ReGetFont;
  {$IFDEF UNICODE_CTRLS} WStrLCopy {$ELSE} StrLCopy {$ENDIF}
    ( DF.fRECharFormatRec.szFaceName, PKOLChar( Value ), Sizeof( DF.fRECharFormatRec.szFaceName ) - 1 );
  DF.fRECharFormatRec.dwMask := CFM_FACE;
  Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ], Integer( @DF.fRECharFormatRec ) );
end;

function TControl.REGetCharformat: TCharFormat;
begin
  REGetFont;
  Result := {$IFDEF STATIC_RICHEDIT_DATA} DF.fRECharFormatRec
            {$ELSE} DF.fRECharFormatRec^ {$ENDIF};
end;

procedure TControl.RESetCharFormat(const Value: TCharFormat);
begin
  Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ], Integer( @Value ) );
end;

function REOut2Stream( Sender: PControl; Buf: PByte; Sz: DWORD; pSz: PInteger )
  :DWORD; stdcall;
begin
  if  Sz + Sender.DF.fREStream.Position > Sender.DF.fREStream.Size then
      Sender.DF.fREStream.Size := Sender.DF.fREStream.Size + DWORD( {Min(} Sz {, 8192 )} );
  pSz^ := Sender.DF.fREStream.Write( Buf^, Sz );
  {$IFDEF NIL_EVENTS}
  if  Assigned( Sender.EV.fOnProgress ) then
  {$ENDIF}
      Sender.EV.fOnProgress( Sender );
  Result := 0;
end;

const TextTypes: array[ TRETextFormat ] of WORD = ( SF_RTF, SF_TEXT,
      SF_RTF or SFF_PLAINRTF, SF_RTFNOOBJS, SF_RTFNOOBJS or SFF_PLAINRTF,
      SF_TEXTIZED, {SF_UNICODE} $0010, $0010 or SF_TEXT );

function TControl.RE_SaveToStream(Stream: PStream; Format: TRETextFormat;
  SelectionOnly: Boolean): Boolean;
var ES: TEditStream;
    SelFlag: Integer;
begin
  DF.fREStream := Stream;
  ES.dwCookie := Integer( @Self );
  ES.dwError := 0;
  ES.pfnCallback := @REOut2Stream;
  SelFlag := 0;
  if SelectionOnly then
    SelFlag := SFF_SELECTION;
  Perform( EM_STREAMOUT, TextTypes[ Format ] or SelFlag, Integer( @ES ) );
  DF.fREStream := nil;
  DF.fREError := ES.dwError;
  Result := DF.fREError = 0;
end;

procedure RE_AddText( Self_: PControl; const S: KOLString );
begin
  Self_.SelStart := Self_.TextSize;
  Self_.RE_Text[ reText, True ] := S;
end;

function TControl.REReadText(Format: TRETextFormat;
  SelectionOnly: Boolean): KOLString;
var B0: Integer;
    MS: PStream;
begin
  fCommandActions.aAddText := RE_AddText;
  MS := NewMemoryStream;
  RE_SaveToStream( MS, Format, SelectionOnly );
  B0 := 0;
  MS.Write( B0, Sizeof( KOLChar ) );
  {$IFDEF UNICODE_CTRLS}
  {$ELSE}
  if  not (Format in [reUnicode,reTextUnicode]) then
      Result := AnsiString(PAnsiChar( MS.fMemory )) // must be PAnsiChar, not PKOLChar!
  else
  {$ENDIF}
      Result := PKOLChar( MS.fMemory );
  MS.Free;
end;

function REInFromStream( Sender: PControl; Buf: PByte; Sz: DWORD; pSz: PInteger )
  :DWORD; stdcall;
begin
  {$IFDEF _D3} if Sender.DF.fREStrLoadLen >= 0 then {$ENDIF}
  if Sz > Sender.DF.fREStrLoadLen then
    Sz := Sender.DF.fREStrLoadLen;
  pSz^ := Sender.DF.fREStream.Read( Buf^, Sz );
  Dec( Sender.DF.fREStrLoadLen, pSz^ );
  {$IFDEF NIL_EVENTS}
  if  Assigned( Sender.EV.fOnProgress ) then
  {$ENDIF}
      Sender.EV.fOnProgress( Sender );
  Result := 0;
end;

function TControl.RE_LoadFromStream(Stream: PStream; Length: Integer;
  Format: TRETextFormat; SelectionOnly: Boolean): Boolean;
var ES: TEditStream;
    SelFlag: Integer;
begin
  DF.fREStream := Stream;
  DF.fREStrLoadLen := DWORD( Length );
  ES.dwCookie := Integer( @Self );
  ES.dwError := 0;
  ES.pfnCallback := @REInFromStream;
  SelFlag := 0;
  if SelectionOnly then
    SelFlag := SFF_SELECTION;
  Perform( EM_STREAMIN, TextTypes[ Format ] or SelFlag, Integer( @ES ) );
  DF.fREStream := nil;
  DF.fREError := ES.dwError;
  Result := DF.fREError = 0;
end;

procedure TControl.REWriteText(Format: TRETextFormat;
  SelectionOnly: Boolean; const Value: KOLString);
var MS: PStream;
    {$IFDEF UNICODE_CTRLS}
    {$ELSE}
    s: AnsiString; // not KOLString!
    {$ENDIF}
begin
  fCommandActions.aAddText := RE_AddText;
  {$IFDEF UNICODE_CTRLS}
  {$ELSE}
  if not (Format in [reUnicode,reTextUnicode]) then
  begin
    s := Value;
    MS := NewExMemoryStream( @ s[ 1 ], Length( s ) );
  end
    else
  {$ENDIF}
    MS := NewExMemoryStream( @ Value[ 1 ], Length( Value ) * Sizeof( KOLChar ) );
  RE_LoadFromStream( MS, MS.fData.fSize, Format, SelectionOnly );
  MS.Free;
end;

function TControl.RE_LoadFromFile(const Filename: KOLString;
  Format: TRETextFormat; SelectionOnly: Boolean): Boolean;
var Strm: PStream;
begin
  Strm := NewReadFileStream( Filename );
  Result := RE_LoadFromStream( Strm, -1, Format, SelectionOnly );
  Strm.Free;
end;

function TControl.RE_SaveToFile(const Filename: KOLString;
  Format: TRETextFormat; SelectionOnly: Boolean): Boolean;
var Strm: PStream;
begin
  Strm := NewWriteFileStream( Filename );
  Result := RE_SaveToStream( Strm, Format, SelectionOnly );
  Strm.Free;
end;

function TControl.REGetParaFmt: TParaFormat;
begin
  ZeroMemory( @Result, sizeof( TParaFormat2 ) );
  Result.cbSize := sizeof( RichEdit.TParaFormat ) + DF.fParaFmtDeltaSz;
  Perform( EM_GETPARAFORMAT, 0, Integer( @Result ) );
end;

procedure TControl.RESetParaFmt(const Value: TParaFormat);
begin
  Perform( EM_SETPARAFORMAT, 0, Integer( @Value ) );
end;

function TControl.REGetNumbering: Boolean;
begin
  Result := LongBool( ReGetParaAttr( 9 shl 16 ) );
end;

function TControl.REGetParaAttr( const Index: Integer ): Integer;
var pDw : PDWORD;
begin
  {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec
  {$ELSE}                       DF.fREParaFmtRec^ {$ENDIF}
      := REGetParaFmt;
  pDw := Pointer( Integer( @DF.fREParaFmtRec ) + ( HiWord( Index ) and $7E ) );
  Result := pDw^;
  if LongBool( HiWord( Index ) and 1 ) then
    Result := Result and $FFFF;
end;

function TControl.REGetParaAttrValid( const Index: Integer ): Boolean;
begin
  Result := LongBool( ReGetParaAttr( 4 shl 16 ) and Index );
end;

function TControl.REGetTabCount: Integer;
begin
  Result := ReGetParaAttr( 27 shl 16 );
end;

function TControl.REGetTabs(Idx: Integer): Integer;
begin
  Result := ReGetParaAttr( (28 + 4 * Idx) shl 16 );
end;

function TControl.REGetTextAlign: TRichTextAlign;
begin
  Result := TRichTextAlign( ReGetParaAttr( 25 shl 16 ) - 1 );
end;

procedure TControl.RESetNumbering(const Value: Boolean);
begin
  RESetParaAttr( (9 shl 16) or PFM_NUMBERING, Integer( Value ) );
end;

procedure TControl.RESetParaAttr(const Index, Value: Integer);
var pDw: PDWORD;
    Mask: Integer;
begin
  REGetParaAttr( 0 );
  pDw := Pointer( Integer( @DF.fREParaFmtRec ) + ( HiWord( Index ) and $7E ) );
  Mask := 0;
  if LongBool( HiWord( Index ) and 1 ) then
    Mask := Integer( $FFFF0000 );
  pDw^ := pDw^ and Mask or DWORD(Value);
    DF.fREParaFmtRec.dwMask := Index and $8000FFFF;
  RESetParaFmt( {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec
                {$ELSE} DF.fREParaFmtRec^ {$ENDIF} );
end;

procedure TControl.RESetTabCount(const Value: Integer);
begin
  REGetParaAttr( 0 );
  RESetParaAttr( (27 shl 16) or PFM_TABSTOPS, Value );
end;

procedure TControl.RESetTabs(Idx: Integer; const Value: Integer);
begin
  REGetParaAttr( 0 );
  RESetParaAttr( (28 + 4 * Idx) or PFM_TABSTOPS, Value );
end;

procedure TControl.RESetTextAlign(const Value: TRichTextAlign);
begin
  RESetParaAttr( (25 shl 16) or PFM_ALIGNMENT, Ord( Value ) + 1 );
end;

function TControl.REGetStartIndentValid: Boolean;
begin
  Result := REGetParaAttrValid( Integer( PFM_STARTINDENT ) );
end;

procedure TControl.RE_HideSelection(aHide: Boolean);
begin
  Perform( EM_HIDESELECTION, Integer( aHide ), 1 );
end;

function TControl.RE_SearchText(const Value: KOLString; MatchCase,
  WholeWord, ScanForward: Boolean; SearchFrom, SearchTo: Integer): Integer;
var Flags: Integer;
    FT: {$IFDEF UNICODE_CTRLS} TFindTextW {$ELSE}
        {$IFDEF _D2} TFindText {$ELSE} TFindTextA {$ENDIF} {$ENDIF};
begin
  Flags := Integer( ScanForward );
{$IFDEF _D2009orHigher}
{$WARN SYMBOL_DEPRECATED OFF} // check deprecate state
{$ENDIF}
  if WholeWord then Flags := Flags or FT_WHOLEWORD;
  if MatchCase then Flags := Flags or FT_MATCHCASE;
{$IFDEF _D2009orHigher}
{$WARN SYMBOL_DEPRECATED ON}
{$ENDIF}
  FT.chrg.cpMin := SearchFrom;
  FT.chrg.cpMax := SearchTo;
  FT.lpstrText := PKOLChar( Value );
  Result := Perform( EM_FINDTEXT, Flags, Integer( @FT ) );
end;

    {$IFNDEF _FPC}
    {$IFNDEF _D2} //------- KOLWideString not supported in D2
function TControl.RE_WSearchText(const Value: KOLWideString; MatchCase,
  WholeWord, ScanForward: Boolean; SearchFrom, SearchTo: Integer): Integer;
var Flags: Integer;
   FT: TFindTextW;
begin
 Flags := Integer( ScanForward );
{$IFDEF _D2009orHigher}
{$WARN SYMBOL_DEPRECATED OFF} // check deprecate state
{$ENDIF}
 if WholeWord then Flags := Flags or FT_WHOLEWORD;
 if MatchCase then Flags := Flags or FT_MATCHCASE;
{$IFDEF _D2009orHigher}
{$WARN SYMBOL_DEPRECATED ON} // switch on!
{$ENDIF}
 FT.chrg.cpMin := SearchFrom;
 FT.chrg.cpMax := SearchTo;
 FT.lpstrText := PWideChar( Value );
 Result := Perform( WM_USER+123 {EM_FINDTEXTW}, Flags, Integer( @FT ) );
end;
    {$ENDIF}{$ENDIF}

{$ENDIF NOT_USE_RICHEDIT}

function TControl.CanUndo: Boolean;
begin
  Result := LongBool( Perform( EM_CANUNDO, 0, 0 ) );
end;

procedure TControl.EmptyUndoBuffer;
begin
  Perform( EM_EMPTYUNDOBUFFER, 0, 0 );
end;

function TControl.Undo: Boolean;
begin
  Result := LongBool( Perform( EM_UNDO, 0, 0 ) );
end;

{$IFNDEF NOT_USE_RICHEDIT}
function TControl.RE_Redo: Boolean;
begin
  Result := LongBool( Perform( EM_REDO, 0, 0 ) );
end;

function TControl.REGetAutoURLDetect: Boolean;
begin
  Result := LongBool( Perform( EM_GETAUTOURLDETECT, 0, 0 ) );
end;

procedure TControl.RESetAutoURLDetect(const Value: Boolean);
begin
  AttachProc( WndProc_RE_LinkNotify );
  Perform( EM_AUTOURLDETECT, Integer( Value ), 0 );
end;

procedure TControl.RESetZoom( const Value: TSmallPoint );
begin
  Perform( EM_SETZOOM, Value.x, Value.y );
end;

function TControl.REGetZoom: TSmallPoint;
var P: TPoint;
begin
  Perform( EM_GETZOOM, Integer( @ P.X ), Integer( @ P.Y ) );
  Result := Point2SmallPoint( P );
end;

function TControl.GetMaxTextSize: DWORD;
begin
  Result := Perform( EM_GETLIMITTEXT, 0, 0 );
end;

procedure TControl.SetMaxTextSize(const Value: DWORD);
var V1, V2: Integer;
begin
  if fCommandActions.aSetLimit <> 0 then
  begin
    V1 := 0; V2 := Value;
    if fCommandActions.aSetLimit = EM_SETLIMITTEXT then
    begin
      V1 := Value; V2 := 0;
    end;
    Perform( fCommandActions.aSetLimit, V1, V2 );
  end;
end;

function WndProc_REFmt( _Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Mask: Integer;
    Shft, Alt, Ctrl, Flg: Boolean;
    Delta: Integer;
    TA: TRichTextAlign;
    ChgTA: Boolean;
    US: TRichUnderline;
    NS: TRichNumbering;
    NB: TRichNumBrackets;
    Side: TBorderEdge;
    Param: DWORD;
begin
  Result := False;
  if Msg.message = WM_CHAR then
  if _Self_.DF.FSupressTab then
  begin
    _Self_.DF.FSupressTab := FALSE;
    if Msg.wParam = 9 then
    begin
      Result := TRUE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    end;
  end;
  if (Msg.message = WM_KEYDOWN) or (Msg.message = WM_SYSKEYDOWN) then
  begin
    Ctrl := GetKeyState( VK_CONTROL ) < 0;
    Alt  := GetKeyState( VK_MENU ) < 0;
    Param := Msg.wParam;
  if Ctrl or
     Alt and IntIn(Param, [ VK_ADD, VK_SUBTRACT, Integer( '-' ), Integer( '=' ),
       Integer( '+' ), 189 , 187 ]) then
  begin
    Shft := GetKeyState( VK_SHIFT ) < 0;
    Rslt := 0;
    Result := True;
    Mask := 0;
    ChgTA := False; TA := raLeft;
    case Param of
    Integer('Z'):
      begin
        if Shft then
        begin
          _Self_.RE_Redo; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
        Result := False;
      end;

    Integer('L'): begin ChgTA := True; TA := raLeft; end;
    Integer('R'): begin ChgTA := True; TA := raRight; end;
    Integer('E'): begin ChgTA := True; TA := raCenter; end;
    Integer('J'): begin ChgTA := True; TA := raJustify; end;
    Integer('N'): begin
                    if Shft then
                    begin
                      NS := _Self_.RE_NumStyle;
                      NB := _Self_.RE_NumBrackets;
                      if NS = rnBullets then
                      begin
                        _Self_.RE_NumStyle := rnNone; Exit; {>>>>>>>>>>>>>>>>>>}
                      end;
                      if NS = rnNone then
                      begin
                        _Self_.RE_NumStyle := rnBullets; Exit; {>>>>>>>>>>>>>>>}
                      end
                         else
                      if Ord( NB ) = 0  then
                        NB := High(NB)  else
                        NB := Pred(NB);
                      _Self_.RE_NumBrackets := NB;
                    end
                       else
                    begin
                      NS := _Self_.RE_NumStyle;
                      if Ord( NS ) = 0 then
                      begin
                        NS := rnURoman; //rnULetter; //High( NS );
                        { because rnLRoman, rnURoman, rnNoNumber are not shown
                          in RichEdit. }
                        _Self_.RE_NumBrackets := rnbPeriod;
                      end              else
                        NS := Pred(NS);
                      _Self_.RE_NumStyle := NS;
                      if NS in [ rnLRoman, rnURoman, rnArabic ] then
                        _Self_.RE_NumStart := 1;
                    end;
                    Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                  end;
    Integer('W'): begin
                    Delta := _Self_.RE_BorderWidth[ beLeft ] + 4;
                    if Shft then Delta := -1;
                    for Side := Low(Side) to High(Side) do
                    begin
                      if Delta < 0 then
                        _Self_.RE_BorderStyle[ Side ] := _Self_.RE_BorderStyle[ Side ] + 1
                      else
                      begin
                        _Self_.RE_BorderWidth[ Side ] := Delta;
                        _Self_.RE_BorderSpace[ Side ] := Delta;
                      end;
                    end;
                    Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                  end;
    (* TABLES STUFF -- to try, uncomment it and press CTRL+T in RichEdit.
       (and uncomment declaration for Tmp above).

       Not finished, and seems no way to figure it out - even RichEdit20.dll
       (i.e. Rich Edit v3.0) can not display tables properly formatted. :(((

    Integer('T'): begin
                    if _Self_.RE_Table then
                    begin
                      //MsgOK( 'table' );
                    end;
                    Tmp := _Self_.REReadText( reRTF, True );
                    if StrIsStartingFrom( PAnsiChar(Tmp), '{\rtf' )
                    and (CopyTail( Tmp, 3 ) = '}'#$D#$A) then
                    begin
                      //Tmp := Copy( Tmp, 1, Length(Tmp) - 3 );
                      _Self_.RE_Text[ reRTF, True ] :=  '{\rtf1' + //Copy( Tmp, 1, 6 ) +
    '\trowd' +
    //'\lytcalctblwd' +
    //'\oldlinewrap' +
    //'\alntblind' +
    //'\trgaph108' +
    '\trleft-108' +
    {'\trbrdrt\brdrs\brdrw10' +
    '\trbrdrl\brdrs\brdrw10' +
    '\trbrdrb\brdrs\brdrw10' +
    '\trbrdrr\brdrs\brdrw10' +
    '\trbrdrh\brdrs\brdrw10' +
    '\trbrdrv\brdrs\brdrw10' +}
    //'\clvertalt' +
    {'\clbrdrt\brdrs\brdrw10' +
    '\clbrdrl\brdrs\brdrw10' +
    '\clbrdrb\brdrs\brdrw10' +
    '\clbrdrr\brdrs\brdrw10' +}
    //'\cltxlrtb' +
    '\cellx1414' +
    //'\pard' +
    //'\plain' +
    //'\widctlpar' +
    '\trautofit1' +
    '\intbl' +
    //'\adjustright' +
    //'\fs20\lang1049' +
    //'\cgrid' +
    '\trrh0' +
    '{\clFitText{{\box\brdrs\brdrw20\brsp20}'+
    '\par}\cell\row}' +
    //'\pard\widctlpar' +
    //'\intbl'+
    //'\adjustright'+
    //'{\row}' +
    '\pard\widctlpar' +
                             '}'#$D#$A;
                      _Self_.Perform( WM_KEYDOWN, VK_UP, 0 );
                      _Self_.Perform( WM_KEYUP, VK_UP, 0 );
                    end; Exit;
                  end;
    *)
    Integer('B'): Mask := CFM_BOLD;
    Integer('I'):
      begin
        Mask := CFM_ITALIC;
        _Self_.DF.FSupressTab := TRUE;
      end;
    Integer('U'):
      begin
        if Shft then
        begin
          US := _Self_.RE_FmtUnderlineStyle;
          if Ord(US) = 0 then US := High(TRichUnderLine)
          else US := Pred( US );
          _Self_.RE_FmtUnderlineStyle := US;
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
        Mask := CFM_UNDERLINE;
      end;
    Integer('O'): Mask := CFM_STRIKEOUT;
    VK_SUBTRACT, VK_ADD, Integer( '+' ), 187, Integer( '-' ), 189:
      ;
    else
      begin
        Result := False;
        Msg.wParam := Param;
      end;
    end;
    if not Result then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    if ChgTA then
      begin
        if Shft then Result := False
        else _Self_.RE_TextAlign := TA;
        Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
    _Self_.REGetFont;
    if Mask > 0 then
    begin
      if Shft then Result := False
      else begin
             Flg := _Self_.REGetFontEffects( Mask );
             if not Flg then
               _Self_.DF.fRECharFormatRec.dwEffects := _Self_.DF.fRECharFormatRec.dwEffects and not Mask;
             _Self_.DF.fRECharFormatRec.dwEffects := _Self_.DF.fRECharFormatRec.dwEffects xor DWORD(Mask);
           end;
    end
       else
    if IntIn( Param, [ VK_ADD, VK_SUBTRACT, Integer( '+' ),
      Integer( '-' ), 189, 187 ] ) then
    begin
      if (Param = VK_SUBTRACT) or (Param = DWORD( '-' )) or (Param = 189) then
        Delta := -1
      else
        Delta := 1;
      if Alt and Ctrl then
      begin
        Mask := Integer( CFM_SIZE ) or Integer( CFM_OFFSET );
        Delta := 0;
        _Self_.DF.fRECharFormatRec.yOffset := 0;
        _Self_.DF.fRECharFormatRec.yHeight := 200;
      end
      else
      if Alt then Mask := Integer( CFM_SIZE )
      else        Mask := Integer( CFM_OFFSET );
      Inc( _Self_.DF.fRECharFormatRec.yOffset, Delta * _Self_.DF.fRECharFormatRec.yHeight div 3 );
      Inc( _Self_.DF.fRECharFormatRec.yHeight, Delta * _Self_.DF.fRECharFormatRec.yHeight div 8 );
      Flg := LongBool( _Self_.DF.fRECharFormatRec.dwMask and Mask );
      if not Flg then
        _Self_.DF.fRECharFormatRec.yOffset := 0;
    end;
    _Self_.DF.fRECharFormatRec.dwMask := Mask;
    if _Self_.SelLength = 0 then
      _Self_.SelLength := 1;
    _Self_.Perform( EM_SETCHARFORMAT, SCF_SELECTION { RichAreas[ _Self_.fRECharArea ] },
                    Integer( {$IFDEF STATIC_RICHEDIT_DATA} @_Self_.DF.fRECharFormatRec
                             {$ELSE} _Self_.DF.fRECharFormatRec {$ENDIF} ) );
  end;
  end;
end;

function TControl.RE_FmtStandard: PControl;
begin
  AttachProc( WndProc_REFmt );
  Result := @Self;
end;

procedure TControl.RE_CancelFmtStandard;
begin
  DetachProc( WndProc_REFmt );
end;
{$ENDIF NOT_USE_RICHEDIT}

{$IFDEF ASM_TLIST}
function EnumDynHandlers( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
asm     //cmd    //opd
        CMP      [EAX].TControl.fRefCount, 0
        JL       @@fin_false
        PUSHAD
        MOV      EBX, EAX
        MOV      EBP, ECX
        MOV      ECX, [EBX].TControl.fDynHandlers
        JECXZ    @@ret_false
        MOV      ESI, ECX
        MOV      ECX, [ESI].TList.fCount
        JECXZ    @@ret_false
        MOV      EDI, ECX
        SHR      EDI, 1
        CALL     TControl.RefInc
@@loo:  DEC      EDI
        JS       @@e_loo
        PUSH     EDX
        PUSH     EBX
{$IFNDEF SMALLEST_CODE}
{$IFNDEF ENUM_DYN_HANDLERS_AFTER_RUN}
        XOR      EAX, EAX
        CMP      [AppletTerminated], AL
        JZ       @@do_call
        MOV      ECX, [ESI].TList.fItems
        MOV      ECX, [ECX+EDI*8+4]
        JECXZ    @@skip_call
{$ENDIF}
{$ENDIF}
@@do_call:
        MOV      EAX, [ESI].TList.fItems
        MOV      EAX, [EAX+EDI*8]
        XCHG     EAX, EBX
        MOV      ECX, EBP
        CALL     EBX
@@skip_call:
        POP      EBX
        POP      EDX
        TEST     AL, AL
        JZ       @@loo
@@ret_true:
        MOV      EAX, EBX
        CALL     TControl.RefDec
        POPAD
        MOV      AL, 1
        RET
@@e_loo:
        XOR      EAX, EAX
        INC      EAX
        CMP      [EBX].TControl.fRefCount, EAX
        JE       @@ret_true
        MOV      EAX, EBX
        CALL     TControl.RefDec
@@ret_false:
        POPAD
@@fin_false:
        XOR      EAX, EAX
end;
{$ELSE PAS_VERSION} //Pascal
function EnumDynHandlers( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var I: Integer;
    Proc: TWindowFunc;
begin
  Result := False;
  if Self_.fRefCount < 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if (Self_.fDynHandlers = nil) or (Self_.fDynHandlers.fCount = 0) then
     Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Self_.RefInc; // Prevent destroying Self_
  for I := Self_.fDynHandlers.fCount div 2 - 1 downto 0 do
  begin
    Proc := Self_.fDynHandlers.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I * 2 ];
{$IFNDEF SMALLEST_CODE}
{$IFNDEF ENUM_DYN_HANDLERS_AFTER_RUN}
    if not AppletTerminated or (
      Self_.fDynHandlers.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}
      [ I * 2 + 1 ] <> nil) then
{$ENDIF}
{$ENDIF}
    if Proc( Self_, Msg, Rslt ) then
    begin
      Result := True;
      break;
    end;
  end;
  {$IFDEF DEBUG_ENDSESSION}
  if EndSession_Initiated then
  begin
    LogFileOutput( GetStartDir + 'es_debug.txt',
                   'ENUM_DYN_HANDLERS: Self_:' + Int2Hex( DWORD( Self_ ), 8 ) );
    LogFileOutput( GetStartDir + 'es_debug.txt',
                   'ENUM_DYN_HANDLERS: Self_.fRefCount:' + Int2Str( Self_.fRefCount ) );
  end;
  {$ENDIF}
  if LongBool(Self_.fRefCount and 1) then
    Result := True; // If Self_ will be destroyed now, stop further processing
  Self_.RefDec; // Destroy Self_, if Free was called for it while processing attached procedures
end;
{$ENDIF PAS_VERSION}

procedure TransparentAttachProcExtension ( DynHandlers: PList );
var i: integer;
begin
    I := DynHandlers.IndexOf( @WndProcTransparent );
    if I >=0 then begin
        DynHandlers.Delete( I );
        DynHandlers.Delete( I );
        DynHandlers.Add( @WndProcTransparent );
        DynHandlers.Add( nil );
    end;
end;

procedure DummyAttachProcExtension ( DynHandlers: PList );
begin
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
procedure TControl.AttachProcEx( Proc: TWindowFunc; ExecuteAfterAppletTerminated: Boolean );
begin
  //if fDynHandlers = nil then
  //  fDynHandlers := NewList;
  if not IsProcAttached( Proc ) then
  begin
    fDynHandlers.Add( @Proc );
    fDynHandlers.Add( Pointer( Integer( ExecuteAfterAppletTerminated ) ) );
  end;
  {$IFNDEF SMALLEST_CODE}
  Global_AttachProcExtension(fDynHandlers);
  {$ENDIF}
  PP.fOnDynHandlers := EnumDynHandlers;
end;
{$ENDIF PAS_VERSION}

procedure TControl.AttachProc(Proc: TWindowFunc);
begin
  AttachProcEx( Proc, FALSE );
end;

procedure TControl.DetachProc(Proc: TWindowFunc);
var I: Integer;
begin
  if fDynHandlers = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  I := fDynHandlers.IndexOf( @Proc );
  if I >=0 then
  begin
    fDynHandlers.Delete( I );
    fDynHandlers.Delete( I );
  end;
end;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
function TControl.IsProcAttached(Proc: TWindowFunc): Boolean;
var I: Integer;
begin
  I := fDynHandlers.IndexOf( @Proc );
  Result := I >=0;
end;
{$ENDIF PAS_VERSION}

{$IFDEF nASM_VERSION}{$ELSE PAS_VERSION}
function WndProcAutoPopupMenu( Control: PControl; var Msg: TMsg; var MsgRslt: Integer ): Boolean;
var {$IFNDEF SMALLEST_CODE}
    R: TRect;
    M: Word;
    I: Integer;
    {$ENDIF SMALLEST_CODE}
    P: TPoint;
begin
  if (Msg.message = WM_CONTEXTMENU) and
     (Control.fAutoPopupMenu <> nil) then
  begin
    {$IFDEF USE_MENU_CURCTL}
    PMenu( Control.fAutoPopupMenu ).fCurCtl := Control;
    {$ENDIF USE_MENU_CURCTL}
    P.X := SmallInt( LoWord( Msg.lParam ) );
    P.Y := SmallInt( HiWord( Msg.lParam ) );
    {$IFNDEF SMALLEST_CODE}
    if (Msg.lParam = -1) then
    begin
      I := Control.CurIndex;
      M := Control.fCommandActions.aItem2XY;
      if (I >= 0) and (M <> 0) then
      begin
        CASE M OF
        EM_POSFROMCHAR:
          begin
            I := Control.SelStart + Control.SelLength;
            // Edit or Rich Edit 2:
            I := Control.Perform( M, I, 1 );
            P.X := SmallInt( LoWord( I ) );
            P.Y := SmallInt( HiWord( I ) );
          end;
        LB_GETITEMRECT, LVM_GETITEMRECT, TCM_GETITEMRECT:
          begin
            R.Left := LVIR_BOUNDS;
            Control.Perform( M, I, Integer( @ R ) );
            P.X := R.Left;
            P.Y := R.Bottom;
          end;
        TVM_GETITEMRECT:
          begin
            I := Control.TVSelected;
            R.Left := I;
            Control.Perform( M, 1, Integer( @ R ) );
            P.X := R.Left;
            P.Y := R.Bottom;
          end;
        END;
        R := Control.ClientRect;
        if P.X < R.Left then P.X := R.Left;
        if P.X > R.Right then P.X := R.Right;
        if P.Y < R.Top then P.Y := R.Top;
        if P.Y > R.Bottom then P.Y := R.Bottom;
      end;
      P := Control.Client2Screen( P );
    end;
    {$ENDIF SMALLEST_CODE}
    PMenu( Control.fAutoPopupMenu ).Popup( P.X, P.Y );
    Result := TRUE;
  end
    else
  Result := FALSE;
end;
{$ENDIF PAS_VERSION}

procedure TControl.SetAutoPopupMenu(PopupMenu: PObj);
{ new version - by Alexander Pravdin. Allows to attach a submenu (e.g. of the
  main menu) as a popup menu to a control, to avoid duplicating menu object,
  if it is the same already as desired. }
var pm: PMenu;
begin
  if PopupMenu <> nil then
  {$IFDEF USE_MENU_CURCTL}
  begin
    pm := PMenu( PopupMenu );
    if ( pm.FParentMenu <> nil ) then
    begin
      while pm.FControl = nil do
        pm := pm.FParentMenu;
      PMenu( PopupMenu ).FControl := pm.FControl;
    end
    else
    begin
      PMenu( PopupMenu ).FControl := @Self;
    end;
    AttachProc(WndProcAutoPopupMenu);
    AttachProc(WndProcMenu)
  end
  else begin
    DetachProc(WndProcAutoPopupMenu);
    DetachProc(WndProcMenu);
  end;
  {$ELSE}
  begin
    pm := PMenu( PopupMenu );
    while pm.FControl = nil do pm := pm.Parent;
    PMenu( PopupMenu ).FControl := pm.FControl;
  end;
  {$ENDIF}
  fAutoPopupMenu := PopupMenu;
  {$IFNDEF USE_MENU_CURCTL}
  AttachProc( WndProcAutoPopupMenu );
  {$ENDIF}
end;

function SearchAnsiMnemonics( const S: KOLString ): KOLString;
var I: Integer;
    Sh: ShortInt;
begin
  Result := S;
  for I := 1 to Length( Result ) do
  begin
    Sh := VkKeyScanEx( Result[ I ], MnemonicsLocale );
    if Sh <> -1 then
      Result[ I ] := KOLChar( Sh );
  end;
end;

procedure SupportAnsiMnemonics( LocaleID: Integer );
begin
  MnemonicsLocale := LocaleID;
  SearchMnemonics := SearchAnsiMnemonics;
end;

function WndProcMnemonics( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Form: PControl;

  function HandleMnemonic( Prnt: PControl ): Boolean;
  var C: PControl;
      XY: Integer;
      procedure DoPressMnemonic;
      begin
        if Msg.message = WM_SYSKEYDOWN then
        begin
          //Form.DF.fPressedMnemonic := Msg.wParam;
          C.Perform( WM_LBUTTONDOWN, MK_LBUTTON, XY );
        end
          else
        begin
          //Form.DF.fPressedMnemonic := 0;
          C.Perform( WM_LBUTTONUP, MK_LBUTTON, XY );
        end;
      end;
  var I, J: Integer;
      R: TRect;
  begin
    for I := 0 to Prnt.ChildCount-1 do
    begin
      C := Prnt.Children[ I ];
      if  {$IFDEF USE_FLAGS} G5_IsButton in C.fFlagsG5
          {$ELSE} C.IsButton {$ENDIF} then
      if  C.Enabled then
      begin
        if C.fCommandActions.aGetCount = TB_BUTTONCOUNT then
        for J := 0 to C.Count-1 do
        begin
          if C.TBButtonEnabled[ J ] then
          if pos( KOLString('&') + AnsiChar( Msg.wParam ), SearchMnemonics( C.TBButtonText[ J ] ) ) > 0 then
          begin
            C.fCurIndex := J;
            C.DF.fTBCurItem := C.TBIndex2Item( J );
            R := C.TBButtonRect[ J ];
            XY := R.Left or (R.Top shl 16);
            DoPressMnemonic;
            Result := TRUE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          end;
        end;
        if pos( KOLString('&') + AnsiChar( Msg.wParam ), SearchMnemonics( C.Caption ) ) > 0 then
        begin
          XY := 0;
          DoPressMnemonic;
          Result := TRUE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
      end;
      if HandleMnemonic( C ) then
      begin
        Result := TRUE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
    end;
    Result := FALSE;
  end;

{$IFDEF NEW_MENU_ACCELL}
  function FindByCtlRef(C: PControl; Accell: TMenuAccelerator): Boolean;

    function FindInMenu(M: PMenu): PMenu;
    var
      I: Integer;
      SM: PMenu;
    begin
      for I := 0 to M.FMenuItems.Count - 1 do begin
        Result := M.FMenuItems.Items[I];
        if (Cardinal(Result.Accelerator) = Cardinal(Accell)) and Result.Enabled then
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      Result := nil;
      for I := 0 to M.FMenuItems.Count - 1 do begin
        SM := PMenu(M.FMenuItems.Items[I]);
        if (SM.FMenuItems.Count > 0) then
          Result := FindInMenu(SM);
        if (Result <> nil) then
          Break;
      end;
    end;

    function FindInMenu2(M: PMenu): Boolean;
    var
      MI: PMenu;
    begin
      if (M <> nil) then begin
        MI := FindInMenu(M);
        if (MI <> nil) then begin
          //M.FControl.Perform(WM_COMMAND, MI.FId, 0);
          C.Perform(WM_COMMAND, MI.FId, 0); // fixed
          Result := True; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
      end;
      Result := False;
    end;

  var
    Parent: PControl;
  begin
    Result := False;
    if not FindInMenu2(PMenu(C.fAutoPopupMenu)) then
      if not FindInMenu2(PMenu(C.fMenuObj)) then begin
        Parent := C.Parent;
        if (Parent <> nil) then
          Result := FindByCtlRef(Parent, Accell);
      end;
  end;

var
  Ac: TMenuAccelerator;
{$ENDIF}
begin
  Result := FALSE;
  if (Msg.message >= WM_KEYFIRST) and (Msg.message <= WM_KEYLAST) then
  begin
{$IFDEF NEW_MENU_ACCELL}
    Ac := MakeAccelerator(FVIRTKEY or GetShiftState, Msg.wParam);
    Result := FindByCtlRef(Sender, Ac);
{$ELSE}
    if (Sender.fAccelTable <> 0)
       {$IFDEF KEY_PREVIEW}
       and (Sender.DF.fKeyPreviewCount = 0)
       {$ENDIF}
    then
      Result := LongBool( TranslateAccelerator( Sender.fHandle, Sender.fAccelTable, Msg ) );
    if not Result then
    begin
      if  Sender.DF.fCurrentControl <> nil then
      if  Sender.DF.fCurrentControl.fAccelTable <> 0 then
          Result := LongBool( TranslateAccelerator( Sender.DF.fCurrentControl.fHandle,
                              Sender.DF.fCurrentControl.fAccelTable, Msg ) );
    end;
    if  not Result then
    begin
        Form := Sender.ParentForm;
        if  (Form <> nil) and (Form <> Sender)
            {$IFDEF KEY_PREVIEW}
            and (Form.DF.fKeyPreviewCount = 0)
            {$ENDIF KEY_PREVIEW}
        then
            if  Form.fAccelTable <> 0 then
                Result := LongBool( TranslateAccelerator( Form.fHandle,
                                    Form.fAccelTable, Msg ) );
    end;
{$ENDIF}
  end;
  if Result then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  if (Msg.message = WM_SYSKEYUP) or
     (Msg.message = WM_SYSKEYDOWN) and (GetKeyState( VK_MENU ) < 0) then
  begin
    Rslt := 0;
    Form := Sender.ParentForm;
    if Form <> nil then
    begin
        if AnsiChar( Msg.wParam ) in [ 'A'..'Z', '0'..'9' ] then
        begin
          if HandleMnemonic( Form ) then
          begin
            Result := TRUE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          end;
        end;
    end;
  end else
  if Msg.message = WM_KEYUP then
  begin
    Rslt := 0;
    Form := Sender.ParentForm;
    if Form <> nil then
    begin
        if Msg.wParam = VK_MENU then
            //  if Form.DF.fPressedMnemonic <> 0 then
            //    Form.DF.fPressedMnemonic := Form.DF.fPressedMnemonic or $80000000;
        else if AnsiChar( Msg.wParam ) in [ 'A'..'Z', '0'..'9' ] then
        begin
            if HandleMnemonic( Form ) then
            begin
                Result := TRUE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
            end;
        end;
    end;
  end;
  Result := FALSE;
end;

function TControl.SupportMnemonics: PControl;
begin
  fGlobalProcKeybd := WndProcMnemonics;
  Result := @Self;
end;

procedure TControl.SelectAll;
begin
  SelStart := 0;
  SelLength := -1; // this can be not working for some controls... //*//*
end;

{$IFnDEF NOT_USE_RICHEDIT}
function RevokeDragDrop(wnd: HWnd): HResult; stdcall;
  external 'ole32.dll' name 'RevokeDragDrop';

function TControl.RE_NoOLEDragDrop: PControl;
begin
  RevokeDragDrop( Handle );
  Result := @Self;
end;
{$ENDIF NOT_USE_RICHEDIT}

function WndProcOnResize( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  if Msg.message = WM_SIZE then
  begin
    {$IFDEF NIL_EVENTS}
    if  Assigned( Self_.EV.fOnResize ) then
    {$ENDIF}
        Self_.EV.fOnResize( Self_ );
  end;
  Result := False;
end;

procedure TControl.SetOnResize(const Value: TOnEvent);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .FOnResize := Value;
  AttachProc( WndProcOnResize );
end;

function WndProcMove( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  if Msg.message = WM_MOVE then
  begin
    {$IFDEF NIL_EVENTS}
    if  Assigned( Self_.EV.FOnMove ) then
    {$ENDIF}
        Self_.EV.FOnMove( Self_ );
  end;
  Result := False;
end;

procedure TControl.SetOnMove(const Value: TOnEvent);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .FOnMove := Value;
  AttachProc( WndProcMove );
end;

function WndProcMoving( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := False;
  if Msg.message = WM_MOVING then
  begin
    {$IFDEF NIL_EVENTS}
    if  Assigned( Self_.EV.FOnMoving ) then
    {$ENDIF}
        Self_.EV.FOnMoving( Self_, Pointer( Msg.lParam ) );
    Rslt := 1;
    Result := TRUE;
  end;
end;

procedure TControl.SetOnMoving(const Value: TOnEventMoving);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .FOnMoving := Value;
  AttachProc( WndProcMoving );
end;

{$IFNDEF NOT_USE_RICHEDIT}
function WndProc_REBottomless( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  if Msg.message = WM_SIZE then
    Self_.Perform( EM_REQUESTRESIZE, 0, 0 );
  Result := False;
end;

function TControl.RE_Bottomless: PControl;
begin
  AttachProc( WndProc_REBottomless );
  Result := @Self;
end;

procedure TControl.RE_Append(const S: KOLString; ACanUndo: Boolean);
begin
  SelStart := TextSize;
  if S <> '' then
  begin
    ReplaceSelection( S, ACanUndo );
    SelStart := TextSize;
  end;
end;

procedure TControl.RE_InsertRTF(const S: KOLString);
var MS: PStream;
begin
  MS := NewMemoryStream;
  MS.Size := (Length( S ) + 1) * Sizeof(KOLChar);
  Move( S[ 1 ], MS.Memory^, ( Length( S ) + 1 ) * Sizeof( KOLChar ) );
  RE_LoadFromStream( MS, Length( S ), reRTF, TRUE );
  MS.Free;
end;
{$ENDIF NOT_USE_RICHEDIT}

procedure TControl.DoSelChange;
begin
  {$IFDEF NIL_EVENTS}
  if  Assigned( EV.fOnSelChange ) then
  {$ELSE}
  if  TMethod( EV.fOnSelChange ).Code <> @DummyObjProc then
  {$ENDIF}
      EV.fOnSelChange( @Self )
  else
  {$IFDEF NIL_EVENTS}
  if  Assigned( EV.fOnChangeCtl ) then
  {$ENDIF}
      EV.fOnChangeCtl( @Self );
end;

{$IFNDEF NOT_USE_RICHEDIT}
function TControl.REGetUnderlineEx: TRichUnderline;
begin
  Result := TRichUnderline( REGetFontAttr( ((81
    {$IFDEF UNICODE_CTRLS} + 32 {$ENDIF})
     shl 16) or CFM_UNDERLINETYPE ) - 1 );
end;

procedure TControl.RESetUnderlineEx(const Value: TRichUnderline);
begin
  RESetFontAttr( ((81
    {$IFDEF UNICODE_CTRLS} + 32 {$ENDIF})
    shl 16) or CFM_UNDERLINETYPE, Ord( Value ) + 1 );
  RESetFontEffect( CFM_UNDERLINE, True );
end;

function TControl.GetTextSize: Integer;
begin
  Result := 0;
  if fHandle <> 0 then
    Result := GetWindowTextLength( fHandle );
end;

function TControl.REGetTextSize(Units: TRichTextSize): Integer;
const TextLengthFlags: array[ TRichTextSizes ] of Integer =
      ( not GTL_UseCRLF, not GTL_Precise, GTL_Close, GTL_NUMBytes );
var GTL: TGetTextLengthEx;
begin
  GTL.flags := MakeFlags( @Units, TextLengthFlags );
  if not(rtsBytes in Units) then
    GTL.flags := GTL.flags or GTL_NUMCHARS;
  GTL.codepage := CP_ACP;
  Result := Perform( EM_GETTEXTLENGTHEX, Integer( @GTL ), 0 );
end;

function TControl.RE_TextSizePrecise: Integer;
var gtlex : TGetTextLengthEx;
begin
  gtlex.flags := GTL_PRECISE;
  gtlex.codepage := CP_ACP;
  Result := Perform(EM_GETTEXTLENGTHEX,WPARAM(@gtlex), 0 );
end;

function TControl.REGetNumStyle: TRichNumbering;
begin
  Result := TRichNumbering( ReGetParaAttr( 9 shl 16 ) );
end;

procedure TControl.RESetNumStyle(const Value: TRichNumbering);
begin
  RESetParaAttr( (9 shl 16) or PFM_NUMBERING, Ord( Value ) );
end;

function TControl.REGetNumBrackets: TRichNumBrackets;
begin
  REGetParaAttr( 0 );
  Result := TRichNumBrackets( (DF.fREParaFmtRec.wNumberingStyle shr 8) );
end;

procedure TControl.RESetNumBrackets(const Value: TRichNumBrackets);
begin
  REGetParaAttr( 0 );
  DF.fREParaFmtRec.wNumberingStyle := DF.fREParaFmtRec.wNumberingStyle and $F8FF
                                or Word( Ord( Value ) shl 8 );
  DF.fREParaFmtRec.dwMask := PFM_NUMBERINGSTYLE;
  RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec
                {$ELSE} DF.fREParaFmtRec^ {$ENDIF};
end;

function TControl.REGetNumTab: Integer;
begin
  REGetParaAttr( 0 );
  Result := DF.fREParaFmtRec.wNumberingTab;
end;

procedure TControl.RESetNumTab(const Value: Integer);
begin
  REGetParaAttr( 0 );
  DF.fREParaFmtRec.wNumberingTab := Value;
  DF.fREParaFmtRec.dwMask := PFM_NUMBERINGTAB;
  RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec
                {$ELSE} DF.fREParaFmtRec^ {$ENDIF};
end;

function TControl.REGetNumStart: Integer;
begin
  REGetParaAttr( 0 );
  Result := DF.fREParaFmtRec.wNumberingStart;
end;

procedure TControl.RESetNumStart(const Value: Integer);
begin
  REGetParaAttr( 0 );
  DF.fREParaFmtRec.wNumberingStart := Value;
  DF.fREParaFmtRec.dwMask := PFM_NUMBERINGSTART;
  RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec
                {$ELSE} DF.fREParaFmtRec^ {$ENDIF};
end;

function TControl.REGetSpacing( const Index: Integer ): Integer;
begin
  REGetParaAttr( 0 );
  Result := PInteger( Integer(@DF.fREParaFmtRec.dySpaceBefore) + (Index and $F) )^;
end;

procedure TControl.RESetSpacing(const Index, Value: Integer);
begin
  REGetParaAttr( 0 );
  PInteger( Integer(@DF.fREParaFmtRec.dySpaceBefore) + (Index and $F) )^ := Value;
  DF.fREParaFmtRec.dwMask := Index and not $F;
  RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec
                {$ELSE} DF.fREParaFmtRec^ {$ENDIF};
end;

function TControl.REGetSpacingRule: Integer;
begin
  REGetParaAttr( 0 );
  Result := DF.fREParaFmtRec.bLineSpacingRule;
end;

procedure TControl.RESetSpacingRule(const Value: Integer);
begin
  REGetParaAttr( 0 );
  DF.fREParaFmtRec.bLineSpacingRule := Value;
  DF.fREParaFmtRec.dwMask := PFM_LINESPACING;
  RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec
                {$ELSE} DF.fREParaFmtRec^ {$ENDIF};
end;

function TControl.REGetLevel: Integer;
begin
  REGetParaAttr( 0 );
  Result := DF.fREParaFmtRec.bCRC;
end;

function TControl.REGetBorder(Side: TBorderEdge; const Index: Integer): Integer;
begin
  REGetParaAttr( 0 );
  Result := PWORD( Integer(@DF.fREParaFmtRec.wBorderSpace) + Index )^ shr (Ord(Side) * 4);
end;

procedure TControl.RESetBorder(Side: TBorderEdge; const Index: Integer;
  const Value: Integer);
var Mask: Word;
    pW : PWord;
begin
  REGetParaAttr( 0 );
  pw := PWORD( Integer(@DF.fREParaFmtRec.wBorderSpace) + Index );
  Mask := $F shl (Ord(Side) * 4);
  pw^ := pw^ and not Mask or (Value shl (4 * Ord(Side)) );
  DF.fREParaFmtRec.dwMask := PFM_BORDER;
  RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec
                {$ELSE} DF.fREParaFmtRec^ {$ENDIF};
end;

function TControl.REGetParaEffect(const Index: Integer): Boolean;
begin
  Result := LongBool( HiWord( REGetParaAttr( 8 shl 16 ) ) and Index );
end;

procedure TControl.RESetParaEffect(const Index: Integer;
  const Value: Boolean);
var Idx: Integer;
begin
  REGetParaAttr( 0 );
  DF.fREParaFmtRec.wReserved := Index;
  Idx := Index;
  DF.fREParaFmtRec.dwMask := Idx shl 16;
  RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec
                {$ELSE} DF.fREParaFmtRec^ {$ENDIF};
end;

function WndProc_REMonitorIns( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := False;
  if (Msg.message = WM_KEYDOWN) and (Msg.wParam = VK_INSERT) and
     ((GetKeyState(VK_CONTROL) or GetKeyState(VK_SHIFT) or GetKeyState(VK_MENU)) >= 0) then
  begin
    if  not Self_.DF.fReOvrDisable then
        Self_.DF.fREOvr := not Self_.DF.fREOvr
    else
        Result := True;
    {$IFDEF NIL_EVENTS}
    if  assigned( Self_.EV.fOnREInsModeChg ) then
    {$ENDIF}
        Self_.EV.fOnREInsModeChg( Self_ );
  end;
end;

function TControl.REGetOverwite: Boolean;
begin
  AttachProc( WndProc_REMonitorIns );
  Result := DF.fREOvr;
end;

procedure TControl.RESetOverwrite(const Value: Boolean);
begin
  if REGetOverwite = Value then // do not replace with fREOvr here!
    Exit; // this installs monitor WndProc_REMonitorIns. {>>>>>>>>>>>>>>>>>>>>>}
  Perform( WM_KEYDOWN, VK_INSERT, 0 );
  Perform( WM_KEYUP, VK_INSERT, 0 );
end;

procedure TControl.RESetOvrDisable(const Value: Boolean);
begin
  REGetOverwite;
  DF.fReOvrDisable := Value;
end;

function WndProc_RichEdTransp_ParentPaint( Self_:PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var I: Integer;
    C: PControl;
begin
  if (Msg.message = WM_PAINT) and (Msg.wParam = 0) then
  begin
    for I := 0 to Self_.fChildren.fCount - 1 do
    begin
      C := Self_.fChildren.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ];
      if  {$IFDEF USE_FLAGS} G5_IsCommonCtl in C.fFlagsG5
          {$ELSE} C.fIsCommonControl {$ENDIF} then
      begin
          Inc( C.DF.fREUpdCount );
          PostMessage( C.fHandle, CM_NCUPDATE, C.DF.fREUpdCount, WM_PAINT );
          InvalidateRect( C.fHandle, nil, False );
      end;
    end;
  end;
  Result := False;
end;

function WndProc_RichEdTransp_Update( Self_:PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Rgn, Rgn1: HRgn;
    R, CR: TRect;
    Pt: TPoint;
    VW, HH, VH, HW: Integer;
begin
  if Self_.DF.fRETransparent then
  case Msg.message of
  WM_CHAR, WM_KILLFOCUS, WM_SETFOCUS, WM_KEYDOWN, WM_LBUTTONDOWN:
    begin
        PostMessage( Self_.fHandle, CM_INVALIDATE, 0, 0 );
    end;
  WM_PAINT:
    if  Msg.wParam = 0 then
    begin
        Inc( Self_.DF.fREUpdCount );
        PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.DF.fREUpdCount, Msg.message );
    end;
  WM_SIZE:
    begin
        Inc( Self_.DF.fREUpdCount );
        PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.DF.fREUpdCount, Msg.message );
        PostMessage( Self_.fHandle, CM_INVALIDATE, 0, 0 );
    end;
  WM_ERASEBKGND:
    if  Msg.wParam = 0 then
    begin
        Inc( Self_.DF.fREUpdCount );
        PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.DF.fREUpdCount, Msg.message );
    end;
  WM_HSCROLL, WM_VSCROLL:
    begin
        Self_.DF.fREScrolling := LoWord( Msg.wParam ) <> SB_ENDSCROLL;
        Inc( Self_.DF.fREUpdCount );
        PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.DF.fREUpdCount, Msg.message );
        if  Self_.DF.fREScrolling then
            Self_.Invalidate;
    end;
  CM_INVALIDATE:
    begin
        Self_.Parent.Invalidate;
        Self_.Invalidate;
    end;
  CM_NCUPDATE:
    if  DWORD(Msg.wParam) = DWORD(Self_.DF.fREUpdCount) then
    begin
        GetWindowRect( Self_.fHandle, R );
        Windows.GetClientRect( Self_.fHandle, CR );
        Pt.x := 0; Pt.y := 0;
        Pt := Self_.Client2Screen( Pt );
        OffsetRect( CR, Pt.x, Pt.y );
        Rgn := CreateRectRgn( R.Left, R.Top, R.Right, R.Bottom );
        if  Self_.DF.fREScrolling then
        begin
            VW := GetSystemMetrics( SM_CXVSCROLL );
            HH := GetSystemMetrics( SM_CYHSCROLL );
            VH := GetSystemMetrics( SM_CYVSCROLL );
            HW := GetSystemMetrics( SM_CXHSCROLL );
            if  CR.Right + VW <= R.Right then
            begin
                Rgn1 := CreateRectRgn( CR.Right, CR.Top + VH, CR.Right + VW, CR.Bottom - VH );
                CombineRgn( Rgn, Rgn, Rgn1, RGN_DIFF );
                DeleteObject( Rgn1 );
            end;
            if  CR.Bottom + HH <= R.Bottom then
            begin
                Rgn1 := CreateRectRgn( CR.Left + HW, CR.Bottom, CR.Right - HW, CR.Bottom + HH );
                CombineRgn( Rgn, Rgn, Rgn1, RGN_DIFF );
                DeleteObject( Rgn1 );
            end;
        end;
        Self_.Perform( WM_NCPAINT, Rgn, 0 );
        DeleteObject( Rgn ); // Unremarked By M.Gerasimov
    end;
  end;
  Result := False;
end;

function TControl.REGetTransparent: Boolean;
begin
  Result := Longbool(ExStyle and WS_EX_TRANSPARENT);
end;

procedure TControl.RESetTransparent(const Value: Boolean);
begin
  if Value then
    ExStyle := ExStyle or WS_EX_TRANSPARENT
  else
    ExStyle := ExStyle and not WS_EX_TRANSPARENT;
  DF.fRETransparent := Value;
  fParent.AttachProc( WndProc_RichEdTransp_ParentPaint );
  AttachProc( WndProc_RichEdTransp_Update );
  {$IFDEF USE_FLAGS}
          if   Value then
               include( fFlagsG2, G2_Transparent )
          else exclude( fFlagsG2, G2_Transparent );
  {$ELSE} fTransparent := Value; {$ENDIF}
end;

procedure TControl.RESetOnURL(const Index: Integer; const Value: TOnEvent);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents; {$ENDIF}
  if  Index = 0 then
      EV.fOnREOverURL := Value
  else
      EV.fOnREURLClick := Value;
  RE_AutoURLDetect :=
      assigned(EV.fOnREOverURL) or assigned(EV.fOnREURLClick);
end;

procedure TControl.SetOnRE_URLClick(const Value: TOnEvent);
begin
  RESetOnURL( 1, Value );
end;

procedure TControl.SetOnRE_OverURL(const Value: TOnEvent);
begin
  RESetOnURL( 0, Value );
end;

function TControl.REGetOnURL(const Index: Integer): TOnEvent;
begin
  CASE Index OF
  0:   Result := EV.fOnREOverURL;
  else Result := EV.fOnREURLClick;
  END;
end;

function TControl.REGetLangOptions(const Index: Integer): Boolean;
begin
  Result := LongBool( Perform( EM_GETLANGOPTIONS, 0, 0 ) and Index);
end;

procedure TControl.RESetLangOptions(const Index: Integer;
  const Value: Boolean);
var Mask: Integer;
begin
  Mask := -1;
  if not Value then Inc( Mask );
  Perform( EM_SETLANGOPTIONS, 0, Perform( EM_GETLANGOPTIONS, 0, 0 ) and
           not Index or (Mask and Index) );
end;
{$ENDIF NOT_USE_RICHEDIT}

function DoTrackMouseEvent(lpEventTrack: PTrackMouseEvent): BOOL;
var FunTrack: function(lpEventTrack: PTrackMouseEvent): BOOL; stdcall;
    ComCtlModule: THandle;
begin
  Result := FALSE;
  ComCtlModule := GetModuleHandle( cctrl );
  if ComCtlModule = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  FunTrack := GetProcAddress( ComCtlModule, '_TrackMouseEvent' );
  if not Assigned( FunTrack ) then Exit; // is necessary for Win95! {>>>>>>>>>>}
  Result := FunTrack( lpEventTrack );
end;

function WndProcMouseEnterLeave( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
         forward;
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
function WndProcMouseEnterLeave( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var P: TPoint;
    MouseWasInControl: Boolean;
    Yes: Boolean;
    Track: TTrackMouseEvent;
begin
  case Msg.message of
    WM_MOUSEFIRST..WM_MOUSELAST:
      begin
        MouseWasInControl := {$IFDEF USE_FLAGS} G3_MouseInCtl in Self_.fFlagsG3;
                             {$ELSE} Self_.fMouseInControl; {$ENDIF}
        if  Assigned( Self_.EV.fOnTestMouseOver ) then
            Yes := Self_.EV.fOnTestMouseOver( Self_ )
        else
        begin
            GetCursorPos( P );
            P := Self_.Screen2Client( P );
            Yes := PointInRect( P, Self_.ClientRect );
        end;
        if  MouseWasInControl <> Yes then
        begin
            Self_.Invalidate;
            if  Yes then
            begin
                {$IFDEF USE_FLAGS} include( Self_.fFlagsG3, G3_MouseInCtl );
                {$ELSE} Self_.fMouseInControl := TRUE; {$ENDIF}
                {$IFDEF NIL_EVENTS}
                if  Assigned( Self_.EV.fOnMouseEnter ) then
                {$ENDIF}
                    Self_.EV.fOnMouseEnter( Self_ );
                Track.cbSize := Sizeof( Track );
                Track.dwFlags := TME_LEAVE;
                Track.hwndTrack := Self_.Handle;
                DoTrackMouseEvent( @ Track );
                Self_.Invalidate;
            end
               else
            begin
                {$IFDEF USE_FLAGS} exclude( Self_.fFlagsG3, G3_MouseInCtl );
                {$ELSE} Self_.fMouseInControl := FALSE; {$ENDIF}
                Track.cbSize := Sizeof( Track );
                Track.dwFlags := TME_LEAVE or TME_CANCEL;
                Track.hwndTrack := Self_.Handle;
                DoTrackMouseEvent( @ Track );
                {$IFDEF NIL_EVENTS}
                if  Assigned( Self_.EV.fOnMouseLeave ) then
                {$ENDIF}
                    Self_.EV.fOnMouseLeave( Self_ );
                Self_.Invalidate;
            end;
        end;
      end;
    WM_MOUSELEAVE:
      begin
          if  {$IFDEF USE_FLAGS} G3_MouseInCtl in Self_.fFlagsG3
              {$ELSE} Self_.fMouseInControl {$ENDIF} then
          begin
              {$IFDEF USE_FLAGS} exclude( Self_.fFlagsG3, G3_MouseInCtl);
              {$ELSE} Self_.fMouseInControl := FALSE; {$ENDIF}
              {$IFDEF GRAPHCTL_HOTTRACK}
                  {$IFDEF NIL_EVENTS}
                  if  Assigned( Self_.EV.fMouseLeaveProc ) then
                  {$ENDIF}
                      Self_.EV.fMouseLeaveProc( Self_ );
                  {$ENDIF}
              {$IFDEF NIL_EVENTS}
              if  Assigned( Self_.EV.fOnMouseLeave ) then
              {$ENDIF}
                  Self_.EV.fOnMouseLeave( Self_ );
              Self_.Invalidate;
          end;
      end;
  end;
  Result := False;
end;
{$ENDIF PAS_VERSION}

procedure ProvideMouseEnterLeave( Self_: PControl );
begin
  InitCommonControls;
  Self_.AttachProc( WndProcMouseEnterLeave );
end;

procedure TControl.SetFlat(const Value: Boolean);
begin
  {$IFDEF USE_FLAGS}
  if   Value then
       include( fFlagsG3, G3_Flat )
  else exclude( fFlagsG3, G3_Flat );
  exclude( fFlagsG3, G3_MouseInCtl );
  {$ELSE}
  fFlat := Value;
  fMouseInControl := FALSE;
  {$ENDIF}
  ProvideMouseEnterLeave( @Self );
  Invalidate;
end;

procedure TControl.SetOnMouseEnter(const Value: TOnEvent);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnMouseEnter := Value;
  ProvideMouseEnterLeave( @Self );
end;

procedure TControl.SetOnMouseLeave(const Value: TOnEvent);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnMouseLeave := Value;
  ProvideMouseEnterLeave( @Self );
end;

procedure TControl.SetOnTestMouseOver(const Value: TOnTestMouseOver);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnTestMouseOver := Value;
  ProvideMouseEnterLeave( @Self );
end;

function WndProcEdTransparent( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  if  (Msg.message = WM_KEYDOWN) or
      (Msg.message = WM_MOUSEMOVE) and (GetKeyState( VK_LBUTTON ) < 0) or
      (Msg.message = WM_LBUTTONUP) or (Msg.message = WM_LBUTTONDOWN) then
      Self_.Invalidate;
  Result := False; // continue handling of a message anyway
end;

procedure TControl.EdSetTransparent(const Value: Boolean);
begin
  Transparent := Value;
  AttachProc( WndProcEdTransparent );
end;

var LastHWnd: HWnd; // + Don
function WndProcSpeedButton( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := False;
  if  Msg.message = WM_SETFOCUS then
  begin
      Result := TRUE;
      Rslt := 0;
      LastHWnd := Msg.wParam; // + don
  end else // + Don
  if  (Msg.message = WM_CAPTURECHANGED) and
      (Msg.lParam = 0) and
      (LastHwnd <> 0) then
  begin
      SetFocus(LastHwnd);
      LastHwnd := 0;
  end;
end;

function TControl.LikeSpeedButton: PControl;
var Form: PControl;
begin
  AttachProc( WndProcSpeedButton );
  {$IFDEF USE_FLAGS}
  {$ELSE} fTabstop := False; {$ENDIF}
  Style := Style and not WS_TABSTOP;
  Form := ParentForm;
  if Form <> nil then
    if Form.DF.fCurrentControl = @Self then
    begin
      Form.GotoControl( VK_TAB );
      if Form.DF.fCurrentControl = @Self then
        Form.DF.fCurrentControl := nil;
    end;
  Result := @Self;
end;

{ -- Unicode -- }
function TControl.SetUnicode(Unicode: Boolean): PControl;
begin
  Perform( CCM_SETUNICODEFORMAT, Integer( Unicode ), 0 );
  Result := @ Self;
end;

{ -- TabControl -- }

function TControl.GetPages(Idx: Integer): PControl;
var Item: TTCItem;
begin
  Item.mask := TCIF_PARAM;
  if Perform( TCM_GETITEM, Idx, Integer( @Item ) ) = 0 then
    Result := nil
  else
    Result := Pointer( Item.lParam );
end;

function TControl.TCGetItemText(Idx: Integer): KOLString;
var TI: TTCItem;
    Buffer: array[ 0..1023 ] of KOLChar;
begin
  TI.mask := TCIF_TEXT;
  TI.pszText := @Buffer[ 0 ];
  TI.cchTextMax := sizeof( Buffer );
  Buffer[ 0 ] := #0;
  Perform( TCM_GETITEM, Idx, Integer( @TI ) );
  Result := PKOLChar( @ Buffer[ 0 ] );
end;

procedure TControl.TCSetItemText(Idx: Integer; const Value: KOLString);
var TI: TTCItem;
begin
  TI.mask := TCIF_TEXT;
  TI.pszText := PKOLChar( Value );
  Perform( TCM_SETITEM, Idx, Integer( @TI ) );
end;

function TControl.TCGetItemImgIDx(Idx: Integer): Integer;
var TI: TTCItem;
begin
  TI.mask := TCIF_IMAGE;
  if   Perform( TCM_GETITEM, Idx, Integer( @TI ) ) = 0 then
       Result := -1
  else Result := TI.iImage;
end;

procedure TControl.TCSetItemImgIdx(Idx: Integer; const Value: Integer);
var TI: TTCItem;
begin
  TI.mask := TCIF_IMAGE;
  TI.iImage := Value;
  Perform( TCM_SETITEM, Idx, Integer( @TI ) );
end;

function TControl.TCGetItemRect(Idx: Integer): TRect;
begin
  if Perform( TCM_GETITEMRECT, Idx, Integer( @Result ) ) = 0 then
  begin
    Result.Left := 0;
    Result.Right := 0;
    Result.Top := 0;
    Result.Bottom := 0;
  end;
end;

procedure TControl.TC_SetPadding(cx, cy: Integer);
begin
  Perform( TCM_SETPADDING, 0, cx or (cy shl 16) );
end;

function TControl.TC_TabAtPos(x, y: Integer): Integer;
type TTCHittestInfo = packed record
       Pt: TPoint;
       Fl: DWORD;
     end;
var HTI: TTCHitTestInfo;
begin
  HTI.Pt.x := x;
  HTI.Pt.y := y;
  Result := Perform( TCM_HITTEST, 0, Integer( @HTI ) );
end;

function TControl.TC_DisplayRect: TRect;
begin
  Windows.GetClientRect( fHandle, Result );
  Perform( TCM_ADJUSTRECT, 0, Integer( @Result ) );
end;

function TControl.TC_IndexOf(const S: KOLString): Integer;
begin
  Result := TC_SearchFor( S, -1, FALSE );
end;

function TControl.TC_SearchFor(const S: KOLString; StartAfter: Integer;
  Partial: Boolean): Integer;
var I: Integer;
begin
  Result := -1;
  for I := StartAfter+1 to Count-1 do
  begin
    if Partial and ( Copy( TC_Items[ I ], 1, Length( S ) ) = S ) or
       ( TC_Items[ I ] = S ) then
    begin
      Result := I;
      break;
    end;
  end;
end;

function TControl.TC_Insert(Idx: Integer; const TabText: KOLString;
  TabImgIdx: Integer): PControl;
var TI: TTCItem;
begin
  Result := NewPanel( @Self, esNone );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TControl:TabPage';
  {$ENDIF}
  {$IFDEF OLD_ALIGN}
  Result.FAlign := caClient;          //+ Galkov
  {$IFDEF USE_FLAGS} Result.fFlagsG4 := Result.fFlagsG4 +
          [G4_VisibleWOParent, G4_NotUseAlign];
  {$ELSE} Result.fVisibleWoParent := TRUE;
          Result.fNotUseAlign := True;
  {$ENDIF}
  {$ELSE NEW_ALIGN}
  Result.Align := caClient;           //+ Galkov
  {$ENDIF}
  Result.Visible := CurIndex<0;
  TI.mask := TCIF_TEXT or TCIF_IMAGE or TCIF_PARAM;
  TI.iImage := TabImgIdx;
  TI.pszText := PKOLChar( TabText );
  TI.lParam := Integer( Result );
  Perform( TCM_INSERTITEM, Idx, Integer( @TI ) );
  {$IFDEF OLD_ALIGN}
  Result.BoundsRect := TC_DisplayRect;//+ Galkov
  {$ENDIF}
  Perform(WM_SIZE,0,0); //May be changes of margins for TabControl
  {$IFDEF GRAPHCTL_XPSTYLES}
  Attach_WM_THEMECHANGED(Result, XP_Themes_For_TabPanel);
  {$ENDIF}
end;

procedure TControl.TC_Delete(Idx: Integer);
var Page: PControl;
begin
  Page := TC_Pages[ Idx ];
  if Page = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Perform( TCM_DELETEITEM, Idx, 0 );
  Page.Free;
  Perform(WM_SIZE,0,0); //May be changes of margins for TabControl
end;

{$IFNDEF OLD_ALIGN}
procedure TControl.TC_InsertControl( Idx: Integer; const TabText: KOLString;
  TabImgIdx: Integer; Page: PControl);
var TI: TTCItem;
begin
  Page.Visible := CurIndex<0;
  TI.mask := TCIF_TEXT or TCIF_IMAGE or TCIF_PARAM;
  TI.iImage := TabImgIdx;
  TI.pszText := PKOLChar( TabText );
  TI.lParam := Integer( Page );
  Perform( TCM_INSERTITEM, Idx, Integer( @TI ) );
  Perform(WM_SIZE,0,0); //May be changes of margins for TabControl
end;

function TControl.TC_Remove( Idx: Integer ):PControl;
begin
  Result := TC_Pages[ Idx ];
  if Result = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Perform( TCM_DELETEITEM, Idx, 0 );
  Perform(WM_SIZE,0,0); //May be changes of margins for TabControl
end;
{$ENDIF}

{ -- TreeView -- }

function TControl.TVGetItemIdx(const Index: Integer): THandle;
begin
  Result := Perform( TVM_GETNEXTITEM, Index, 0 );
end;

procedure TControl.TVSetItemIdx(const Index: Integer;
  const Value: THandle);
begin
  Perform( TVM_SELECTITEM, Index, Value );
end;

function TControl.TVGetItemNext(Item: THandle; const Index: Integer): THandle;
begin
  Result := Perform( TVM_GETNEXTITEM, Index, Item );
end;

function TControl.TVGetItemRect(Item: THandle; TextOnly: Boolean): TRect;
begin
  Result.Left := Item;
  if Perform( TVM_GETITEMRECT, Integer( TextOnly ), Integer( @Result ) ) = 0 then
  begin
    Result.Left := 0;
    Result.Right := 0;
    Result.Top := 0;
    Result.Bottom := 0;
  end;
end;

function TControl.TVGetItemVisible(Item: THandle): Boolean;
var R: TRect;
begin
  R := TVItemRect[ Item, False ];
  Result := R.Bottom > R.Top;
end;

procedure TControl.TVSetItemVisible(Item: THandle; const Value: Boolean);
begin
  if Value then
    Perform( TVM_ENSUREVISIBLE, 0, Item );
end;

function TControl.TVGetItemStateFlg(Item: THandle; const Index: Integer): Boolean;
var TVI: TTVItem;
begin
  TVI.mask := TVIF_HANDLE or TVIF_STATE;
  TVI.hItem := Item;
  TVI.stateMask := Index;
  Result := False;
  if Perform( TVM_GETITEM, 0, Integer( @TVI ) ) <> 0 then
    Result := (TVI.state and Index) <> 0;
end;

procedure TControl.TVSetItemStateFlg(Item: THandle; const Index: Integer;
  const Value: Boolean);
var TVI: TTVItem;
begin
  TVI.mask := TVIF_HANDLE or TVIF_STATE;
  TVI.hItem := Item;
  TVI.stateMask := Index;
  TVI.state := $FFFFFFFF and Index;
  if not Value then
    TVI.state := 0;
  Perform( TVM_SETITEM, 0, Integer( @TVI ) );
end;

function TControl.TVGetItemImage(Item: THandle; const Index: Integer): Integer;
var TVI: TTVItem;
begin
  TVI.mask := TVIF_HANDLE or Loword( Index );
  TVI.hItem := Item;
  if Hiword( Index ) <> 0 then
  begin
    TVI.mask := TVIF_STATE or TVIF_HANDLE;
    TVI.stateMask := Loword( Index );
  end;
  Result := -1;
  if Perform( TVM_GETITEM, 0, Integer( @TVI ) ) <> 0 then
  begin
    if   Hiword( Index ) <> 0 then
         Result := (TVI.state shr Hiword( Index )) and $F
    else if Loword( Index ) = TVIF_IMAGE then
         Result := TVI.iImage
    else Result := TVI.iSelectedImage;
  end;
end;

procedure TControl.TVSetItemImage(Item: THandle; const Index: Integer;
  const Value: Integer);
var TVI: TTVItem;
begin
  TVI.mask := TVIF_HANDLE or Loword( Index );
  TVI.hItem := Item;
  TVI.iImage := Value;
  TVI.iSelectedImage := Value;
  if Hiword( Index ) <> 0 then
  begin
    TVI.mask := TVIF_STATE or TVIF_HANDLE;
    TVI.stateMask := Loword( Index );
    TVI.state := Value shl Hiword( Index );
  end;
  Perform( TVM_SETITEM, 0, Integer( @TVI ) );
end;

function TControl.TVGetItemText(Item: THandle): KOLString;
var TVI: TTVItem;
    Buffer: array[ 0..4095 ] of KOLChar;
begin
  TVI.mask := TVIF_HANDLE or TVIF_TEXT;
  TVI.hItem := Item;
  TVI.pszText := @Buffer[ 0 ];
  Buffer[ 0 ] := #0;
  TVI.cchTextMax := Sizeof( Buffer ) {$IFDEF UNICODE_CTRLS} div Sizeof( KOLChar ) {$ENDIF};
  Perform( TVM_GETITEM, 0, Integer( @TVI ) );
  Result := PKOLChar( @ Buffer[ 0 ] );
end;

procedure TControl.TVSetItemText(Item: THandle; const Value: KOLString);
var TVI: TTVItem;
begin
  TVI.mask := TVIF_HANDLE or TVIF_TEXT;
  TVI.hItem := Item;
  TVI.pszText := PKOLChar( Value );
  Perform( TVM_SETITEM, 0, Integer( @TVI ) );
end;

function TControl.TVItemPath(Item: THandle; Delimiter: KOLChar): KOLString;
begin
  if Item = 0 then
    Item := TVSelected;
  Result := '';
  while Item <> 0 do
  begin
    if Result <> '' then
      Result := KOLString(Delimiter) + Result;
    Result := TVItemText[ Item ] + Result;
    Item := TVItemParent[ Item ];
  end;
end;

function TControl.TV_GetItemHasChildren(Item: THandle): Boolean;
var TVI: TTVItem;
begin
  TVI.mask := TVIF_HANDLE or TVIF_CHILDREN;
  TVI.hItem := Item;
  Perform( TVM_GETITEM, 0, Integer( @TVI ) );
  Result := TVI.cChildren = 1;
end;

function TControl.TV_GetItemChildCount(Item: THandle): Integer;
var Node: THandle;
begin
  Result := 0;
  Node := TVItemChild[ Item ];
  while Node <> 0 do
  begin
    Inc( Result );
    Node := TVItemNext[ Node ];
  end;
end;

procedure TControl.TV_SetItemHasChildren(Item: THandle;
  const Value: Boolean);
var TVI: TTVItem;
begin
  TVI.mask := TVIF_HANDLE or TVIF_CHILDREN;
  TVI.hItem := Item;
  TVI.cChildren := 1 and Integer( Value );
  Perform( TVM_SETITEM, 0, Integer( @TVI ) );
end;

function TControl.TVItemAtPos(x, y: Integer; var Where: DWORD): THandle;
var HTI: TTVHitTestInfo;
begin
  HTI.pt.x := x;
  HTI.pt.y := y;
  Result := Perform( TVM_HITTEST, 0, Integer( @HTI ) );
  Where := HTI.fl;
end;

type
  TTVInsertStruct = packed Record
    hParent: THandle;
    hAfter : THandle;
    item: TTVItem;
  end;
  TTVInsertStructEx = packed Record
    hParent: THandle;
    hAfter : THandle;
    item: TTVItemEx;
  end;

function TControl.TVInsert(nParent, nAfter: THandle;
  const Txt: KOLString): THandle;
var TVIns: TTVInsertStruct;
begin
  TVIns.hParent := nParent;
  TVIns.hAfter := nAfter;
  TVIns.item.mask := TVIF_TEXT;
  TVIns.item.pszText := PKOLChar( Txt );
  Result := Perform( TVM_INSERTITEM, 0, Integer( @TVIns ) );
  if fUpdateCount <= 0 then
     Invalidate;
end;

procedure TControl.TVExpand(Item: THandle; Flags: DWORD);
begin
  Perform( TVM_EXPAND, Flags, Item );
end;

procedure TControl.TVSort( N: THandle );
var a: Cardinal;
    b: Boolean;
begin
  b := N = 0;
  if  b then
      N := TVRoot;
  while N <> 0 do
  begin
      a := TVItemChild[N];
      if  a > 0 then TVSort(a);
      Perform(TVM_SORTCHILDREN, 0, N);
      N := TVItemNext[N];
  end;
  if  b then //moved by Tr"]f
      Perform(TVM_SORTCHILDREN, 0, 0);  //+ by YS
end;

procedure TControl.TVDelete(Item: THandle);
begin
  Perform( TVM_DELETEITEM, 0, Item );
  Invalidate;
end;

function TControl.TVGetItemData(Item: THandle): Pointer;
var TVI: TTVItem;
begin
  TVI.mask := TVIF_HANDLE or TVIF_PARAM;
  TVI.hItem := Item;
  Result := nil;
  if Perform( TVM_GETITEM, 0, Integer( @TVI ) ) <> 0 then
    Result := Pointer( TVI.lParam );
end;

procedure TControl.TVSetItemData(Item: THandle; const Value: Pointer);
var TVI: TTVItem;
begin
  TVI.mask := TVIF_HANDLE or TVIF_PARAM;
  TVI.hItem := Item;
  TVI.lParam := Integer( Value );
  Perform( TVM_SETITEM, 0, Integer( @TVI ) );
end;

procedure TControl.TVEditItem(Item: THandle);
begin
  Perform( TVM_EDITLABEL, 0, Item );
end;

procedure TControl.TVStopEdit(Cancel: Boolean);
begin
  Perform( TVM_ENDEDITLABELNOW, Integer( Cancel ), 0 );
end;

function WndProcTVRightClickSelect( Sender: PControl; var Msg: TMsg; var R: Integer ): Boolean;
var I: Integer;
    Where: DWORD;
begin
  if Msg.message = WM_RBUTTONDOWN then
  begin
    I := Sender.TVItemAtPos( SmallInt( Msg.lParam and $FFFF ),
         SmallInt( Msg.lParam shr 16 ), Where  );
    if I <> 0 then
      Sender.TVSelected := I;
  end;
  Result := FALSE;
end;

procedure TControl.SetTVRightClickSelect(const Value: Boolean);
begin
  DF.fTVRightClickSelect := Value;
  if Value then
    AttachProc( @WndProcTVRightClickSelect );
end;

procedure TControl.SetOnTVDelete( const Value: TOnTVDelete );
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnTVDelete := Value;
  if fParent <> nil then
  begin
    fParent.Add2AutoFreeEx( Clear );
    fParent.DetachProc( WndProcNotify );
    fParent.AttachProcEx( WndProcNotify, TRUE );
  end;
  AttachProcEx( ProcTVDeleteItem, TRUE );
end;

function ClipboardHasText: Boolean;
begin
  Result := false;
  if OpenClipboard( 0 ) then
  begin
    if IsClipboardFormatAvailable( CF_TEXT ) then
      Result := TRUE;
    CloseClipboard;
  end;
end;

function Clipboard2Text: AnsiString;
var gbl: THandle;
    str: PAnsiChar;
begin
  Result := '';
  if OpenClipboard( 0 ) then
  begin
    if IsClipboardFormatAvailable( CF_TEXT ) then
    begin
      gbl := GetClipboardData( CF_TEXT );
      if gbl <> 0 then
      begin
        str := GlobalLock( gbl );
        if str <> nil then
        begin
          Result := str;
          GlobalUnlock( gbl );
        end;
      end;
    end;
    CloseClipboard;
  end;
end;

{$IFNDEF _D2}
function Clipboard2WText: KOLWideString;
var gbl: THandle;
    str: PWideChar;
begin
  Result := '';
  if OpenClipboard( 0 ) then
  begin
    if IsClipboardFormatAvailable( CF_UNICODETEXT ) then
    begin
      gbl := GetClipboardData( CF_UNICODETEXT );
      if gbl <> 0 then
      begin
        str := GlobalLock( gbl );
        if str <> nil then
        begin
          Result := str;
          GlobalUnlock( gbl );
        end;
      end;
    end;
    CloseClipboard;
  end;
end;
{$ENDIF}

function Text2Clipboard( const S: AnsiString ): Boolean;
var gbl: THandle;
    str: PAnsiChar;
begin
  Result := False;
  if not OpenClipboard( 0 ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  EmptyClipboard;
  if S <> '' then
  begin
    gbl := GlobalAlloc( GMEM_DDESHARE, Length( S ) + 1 );
    if gbl <> 0 then
    begin
      str := GlobalLock( gbl );
      Move( S[ 1 ], str^, Length( S ) + 1 );
      GlobalUnlock( gbl );
      Result := SetClipboardData( CF_TEXT, gbl ) <> 0;
    end;
  end
    else
      Result := True;
  CloseClipboard;
end;

{$IFNDEF _D2}
function WText2Clipboard( const WS: KOLWideString ): Boolean;
var gbl: THandle;
    str: PAnsiChar;
begin
  Result := False;
  if not OpenClipboard( 0 ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  EmptyClipboard;
  if WS <> '' then
  begin
    gbl := GlobalAlloc( GMEM_DDESHARE, (Length( WS ) + 1) * 2 );
    if gbl <> 0 then
    begin
      str := GlobalLock( gbl );
      Move( WS[ 1 ], str^, (Length( WS ) + 1) * 2 );
      GlobalUnlock( gbl );
      Result := SetClipboardData( CF_UNICODETEXT, gbl ) <> 0;
    end;
  end
    else
      Result := True;
  CloseClipboard;
end;
{$ENDIF}

function TControl.Size(W, H: Integer): PControl;
var C, P: PControl;
    dW, dH: Integer;
begin
  C := @Self;
  while True do
  begin
    dW := 0; dH := 0;
    P := C.FParent;
    if C.ToBeVisible then
    begin
      if C.fAlign in [caLeft, caRight, caClient] then
      begin
        if H > 0 then
        begin
          dH := H - C.Height; H := 0;
        end;
      end;
      if C.fAlign in [caTop, caBottom, caClient] then
      begin
        if W > 0 then
        begin
          dW := W - C.Width; W := 0;
        end;
      end;
    end;
    if (W > 0) or (H > 0) then
    begin
      C.SetSize( W, H );
      if (P <> nil) // {Ralf Junker}
         and not P.IsApplet then
        C.ResizeParent;
    end;
    if (dW = 0) and (dH = 0) then break;
    C := P; //C.FParent;
    if C = nil then break;
    //if not C.fIsControl then break;
    if C.IsApplet then break;
    W := C.Width + dW;
    H := C.Height + dH;
  end;
  Result := @Self;
end;
{$ENDIF WIN_GDI}

{$IFDEF GDI}
procedure AutoSzProc( Self_: PObj );
var DeltaX, DeltaY: Integer;
    SZ: TSize; PT: TPoint;
    Txt: KOLString;
    Chg: Boolean;
    R: TRect;
    Flags: DWORD;
{+ecm}
    OldFont: HFONT;
    CtlHavingFont: PControl;
{/+ecm}
begin
  Txt := PControl( Self_ ).fCaption;
  SZ.cx := 0;
  SZ.cy := 0;
  if Txt <> '' then
  begin
    if ( PControl( Self_ ).fFont <> nil ) then
    if PControl( Self_ ).fFont.fData.Font.Italic then
       Txt := Txt + ' ';
    PControl( Self_ ).GetWindowHandle; // this line must be here.
    //-- otherwise, when handle is not yet allocated,
    // it is requested in TCanvas.GetHandle, and in result
    // of unpredictable recursion some memory can be currupted.
    PControl( Self_ ).Canvas.TextArea( Txt, SZ, PT );
    if  {$IFDEF USE_FLAGS} (G1_WordWrap in PControl(Self_).fFlagsG1)
        {$ELSE} PControl( Self_ ).fWordWrap {$ENDIF}
    and (PControl( Self_ ).fAlign <> caClient) then
    begin
      R := PControl( Self_ ).ClientRect;
      Flags := DT_CALCRECT or DT_EXPANDTABS or DT_WORDBREAK;
      CASE PControl( Self_ ).fTextAlign OF
      taCenter: Flags := Flags or DT_CENTER;
      taRight : Flags := Flags or DT_RIGHT;
      END;
      {-ecm}
//      CASE Self_.fVerticalAlign OF
//      vaCenter: Flags := Flags or DT_VCENTER;
//      vaBottom: Flags := Flags or DT_BOTTOM;
//      END;
      {/-ecm}
      {+ecm}
      CtlHavingFont := PControl( Self_ );
      while (CtlHavingFont <> nil)
      and   ( CtlHavingFont.FFont = nil ) do
            CtlHavingFont := CtlHavingFont.Parent;
      OldFont := 0;
      if  ( CtlHavingFont ) <> nil then
          OldFont := SelectObject( PControl( Self_ ).Canvas.Handle, CtlHavingFont.Font.Handle );
      {/+ecm}
      // DrawText return the height of the text !
      SZ.cy := DrawText( PControl( Self_ ).fCanvas.Handle, PKOLChar( Txt ), Length( Txt ), R, Flags );
      {+ecm}
      if  ( CtlHavingFont <> nil ) then
          SelectObject(PControl( Self_ ).Canvas.fHandle,OldFont);
      {/+ecm}
      SZ.cx := R.Right - R.Left;
      //SZ.cy := R.Bottom - R.Top;
    end;
  end;
  Chg := FALSE;
  if PControl( Self_ ).FAlign in [ caNone, caLeft, caRight ] then
  begin
    DeltaX := PControl( Self_ ).aAutoSzX;
    if PControl( Self_ ).Width <> SZ.cx + DeltaX then
    begin
      PControl( Self_ ).Width := SZ.cx + DeltaX;
      Chg := TRUE;
    end;
    if PControl( Self_ ).fMinWidth > PControl( Self_ ).Width then
    begin
      PControl( Self_ ).Width := PControl( Self_ ).fMinWidth;
      Chg := TRUE;
    end;
  end;
  if PControl( Self_ ).FAlign in [ caNone, caTop, caBottom ] then
  begin
    DeltaY := PControl( Self_ ).aAutoSzY;
    if PControl( Self_ ).Height <> SZ.cy + DeltaY then
    begin
      PControl( Self_ ).Height := SZ.cy + DeltaY;
      Chg := TRUE;
    end;
    if PControl( Self_ ).FMinHeight > PControl( Self_ ).Height then
    begin
      PControl( Self_ ).Height := PControl( Self_ ).FMinHeight;
      Chg := TRUE;
    end;
  end;
  if Chg then
  begin
    {$IFDEF OLD_ALIGN}
    if PControl( Self_ ).fParent <> nil then
      Global_Align( PControl( Self_ ).fParent );
    {$ENDIF}
    Global_Align( Self_ );
  end;
end;
{$ENDIF GDI}
{$IFDEF _X_}
{$IFDEF GTK}
PROCEDURE AutoSzProc( Self_: PObj );
VAR SZ: TSize;
    //Txt: KOLString;
    Chg: Boolean;
    req_captn, req_evbox: TGtkRequisition;
BEGIN
  //Txt := PControl( Self_ ).fCaption;
  SZ.cx := 0;
  SZ.cy := 0;
  //if Txt <> '' then
  BEGIN
    gtk_widget_size_request( PControl( Self_ ).fCaptionHandle, @ req_captn );
    IF  (PControl( Self_ ).fDeltaX = 0) AND
        (PControl( Self_ ).fDeltaY = 0) THEN
    BEGIN
        gtk_widget_size_request( PControl( Self_ ).fEventboxHandle, @ req_evbox );
        PControl( Self_ ).fDeltaX := Max( 0, req_evbox.width - req_captn.width );
        PControl( Self_ ).fDeltaY := Max( 0, req_evbox.height - req_captn.height );
    END;
    Sz.cx := req_captn.width + PControl( Self_ ).fDeltaX;
    Sz.cy := req_captn.height + PControl( Self_ ).fDeltaY;
    //gtk_widget_get_size_request( PControl( Self_ ).fHandle, @ Sz.cx, @ Sz.cy );
  END;
  Chg := FALSE;
  IF  PControl( Self_ ).FAlign in [ caNone, caLeft, caRight ] THEN
  BEGIN
      //DeltaX := PControl( Self_ ).fCommandActions.aAutoSzX;
      if PControl( Self_ ).Width <> SZ.cx {+ DeltaX} then
      BEGIN
        PControl( Self_ ).Width := SZ.cx {+ DeltaX};
        Chg := TRUE;
      END;
      IF PControl( Self_ ).fMinWidth > PControl( Self_ ).Width THEN
      BEGIN
        PControl( Self_ ).Width := PControl( Self_ ).fMinWidth;
        Chg := TRUE;
      END;
  END;
  IF  PControl( Self_ ).FAlign in [ caNone, caTop, caBottom ] THEN
  begin
      //DeltaY := PControl( Self_ ).fCommandActions.aAutoSzY;
      IF PControl( Self_ ).Height <> SZ.cy {+ DeltaY} THEN
      BEGIN
        PControl( Self_ ).Height := SZ.cy {+ DeltaY};
        Chg := TRUE;
      END;
      IF PControl( Self_ ).FMinHeight > PControl( Self_ ).Height THEN
      BEGIN
        PControl( Self_ ).Height := PControl( Self_ ).FMinHeight;
        Chg := TRUE;
      END;
  END;
  IF  Chg THEN
  BEGIN
      {$IFDEF OLD_ALIGN}
      if PControl( Self_ ).fParent <> nil then
        Global_Align( PControl( Self_ ).fParent );
      {$ENDIF}
      Global_Align( Self_ );
  END;
END;
{$ENDIF GTK}
{$ENDIF _X_}

function TControl.AutoSize(AutoSzOn: Boolean): PControl;
begin
  if AutoSzOn then
  begin
    PP.fAutoSize := AutoSzProc;
    DoAutoSize;
  end
  else
    PP.fAutoSize := DummyObjProc;
  Result := @Self;
end;

{$IFDEF WIN_GDI}
function TControl.IsAutoSize: Boolean;
begin
  Result := Assigned( PP.fAutoSize );
end;

{$IFDEF ASM_VERSION}{$ELSE PASCAL}
function TControl.GetToBeVisible: Boolean;
begin
  Result := {$IFDEF USE_FLAGS} (F3_Visible in fStyle.f3_Style)
            {$ELSE}            fVisible {$ENDIF}
         or {$IFDEF USE_FLAGS} ([G4_CreateHidden, G4_VisibleWOParent]
                    * fFlagsG4 <> [])
                    or (G3_IsForm in fFlagsG3)
            {$ELSE} fCreateHidden or fVisibleWoParent or IsForm {$ENDIF};
  if  {$IFDEF USE_FLAGS} G3_IsControl in fFlagsG3
      {$ELSE} fIsControl {$ENDIF} then
  if  Parent <> nil then
  begin
      {$IFDEF OLD_ALIGN}
      if  {$IFDEF USE_FLAGS} G4_VisibleWOParent in fFlagsG4
          {$ELSE} fVisibleWoParent {$ENDIF} then
          Result := {$IFDEF USE_FLAGS} F3_Visible in fStyle.f3_Style
                    {$ELSE}            fVisible {$ENDIF}
      else
      {$ENDIF}
      begin
          if  Result then
          begin
              Parent.Visible; // needed to provide correct fVisible for a form!
              //todo: check if  necessary for USE_FLAGS ???
              Result := Parent.ToBeVisible;
          end;
      end;
  end;
end;
{$ENDIF PAS_VERSION}

///////////////////////////////////////////////////////////////////////
//                         W  I  N  D  O  W  S
///////////////////////////////////////////////////////////////////////

{ -- Set of window-related utility functions. -- }
type
  PGUIThreadInfo = ^TGUIThreadInfo;
  tagGUITHREADINFO = packed record
    cbSize: DWORD;
    flags: DWORD;
    hwndActive: HWND;
    hwndFocus: HWND;
    hwndCapture: HWND;
    hwndMenuOwner: HWND;
    hwndMoveSize: HWND;
    hwndCaret: HWND;
    rcCaret: TRect;
  end;
  TGUIThreadInfo = tagGUITHREADINFO;

const
  GUI_CARETBLINKING  = $00000001;
  GUI_INMOVESIZE     = $00000002;
  GUI_INMENUMODE     = $00000004;
  GUI_SYSTEMMENUMODE = $00000008;
  GUI_POPUPMENUMODE  = $00000010;

{function GetGUIThreadInfo (idThread: DWORD; var pgui: TGUIThreadinfo): BOOL; stdcall;
         external user32 name 'GetGUIThreadInfo';}

type TGUIThreadInfo_Proc = function( ThreadID: THandle; var GTI: TGUIThreadInfo )
                          : Boolean; stdcall;

var Proc_GetGUIThreadInfo: TGuiThreadInfo_Proc;

function GetWindowChild( Wnd: HWnd; Kind: TWindowChildKind ): HWnd;
var GTI: TGuiThreadInfo;
    ThreadID: THandle;
    Module: THandle;
begin
  if not Assigned( Proc_GetGUIThreadInfo ) then
  begin
    Module := GetModuleHandle( 'User32' );
    Proc_GetGUIThreadInfo := GetProcAddress( Module, 'GetGUIThreadInfoA' );
    if not Assigned( Proc_GetGUIThreadInfo ) then
      Proc_GetGUIThreadInfo := Pointer( -1 );
  end;
  Result := Wnd;
  if Integer( @Proc_GetGUIThreadInfo ) = -1 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>}
  Result := 0;
  if Wnd = 0 then
    ThreadID := GetCurrentThreadID
  else
    ThreadID := GetWindowThreadProcessID( Wnd, nil );
  if ThreadID = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  GTI.cbSize := Sizeof( GTI );
  if Proc_GetGUIThreadInfo( ThreadId, GTI ) then
  begin
    case Kind of
    wcActive:  Result := GTI.hwndActive;
    wcFocus:   Result := GTI.hwndFocus;
    wcCapture: Result := GTI.hwndCapture;
    wcMenuOwner: Result := GTI.hwndMenuOwner;
    wcMoveSize:  Result := GTI.hwndMoveSize;
    wcCaret:     Result := GTI.hwndCaret;
    end;
  end;
end;

function GetFocusedChild( Wnd: HWnd ): HWnd;
var Tr1, Tr2: THandle;
begin
  Result := 0;
  Tr1 := GetCurrentThreadId;
  Tr2 := GetWindowThreadProcessId( Wnd, nil );
  if Tr1 = Tr2 then
    Result := GetFocus
  else
  if AttachThreadInput( Tr2, Tr1, True ) then
  begin
    Result := GetFocus;
    AttachThreadInput( Tr2, Tr1, False );
  end;
end;

function WaitFocusedWndChild( Wnd: HWnd ): HWnd;
var T1, T2: Integer;
    W: HWnd;
begin
  Sleep( 50 );
  T1 := GetTickCount;
  while True do
  begin
    W := GetTopWindow( Wnd );
    if W = 0 then W := Wnd;
    W := GetFocusedChild( W );
    if W <> 0 then
    begin
      Wnd := W;
      break;
    end;
    T2 := GetTickCount;
    if Abs( T1 - T2 ) > 100 then break;
  end;
  Result := Wnd;
end;

function Stroke2Window( Wnd: HWnd; const S: AnsiString ): Boolean;
var P: PAnsiChar;
begin
  Result := False;
  Wnd := WaitFocusedWndChild( Wnd );
  if Wnd = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  P := PAnsiChar( S );
  while P^ <> #0 do
  begin
    PostMessage( Wnd, WM_CHAR, Integer( P^ ), 1 );
    Inc( P );
  end;
  Result := True;
end;

function Stroke2WindowEx( Wnd: HWnd; const S: AnsiString; Wait: Boolean ): Boolean;
var P: PAnsiChar;
    EndChar: AnsiChar;
    MsgDn, MsgUp, SCA: Integer;

    function Compare( Pattern: PAnsiChar ): Boolean;
    var Pos: PAnsiChar;
        C1, C2: AnsiChar;
    begin
      Pos := P;
      while Pattern^ <> #0 do
      begin
        C1 := Pattern^;
        C2 := Pos^;
        if  (C1 >= 'a') and (C1 <= 'z') then
            C1 := AnsiChar( Ord( C1 ) - $20 );
        if  (C2 >= 'a') and (C2 <= 'z') then
            C2 := AnsiChar( Ord( C2 ) - $20 );
        if C1 <> C2 then
        begin
          Result := False; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        end;
        Inc( Pos );
        Inc( Pattern );
      end;
      while Pos^ = ' ' do Inc( Pos );
      P := Pos;
      Result := True;
    end;

    procedure Send( Msg, KeyCode: Integer );
    var lParam: Integer;
    begin
      Wnd := WaitFocusedWndChild( Wnd );
      if Wnd = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      lParam := 1;
      if longBool( SCA and 4 ) then
        lParam := $20000001;
      if Msg = MsgUp then
        lParam := lParam or Integer($D0000000);
      PostMessage( Wnd, Msg, KeyCode, lParam );
      Applet.ProcessMessages;
      if Wait then
        Sleep( 50 );
    end;

    function CompareSend( Pattern: PAnsiChar; Value2Send: Integer ): Boolean;
    begin
      if Compare( Pattern ) then
      begin
        Send( MsgDn, Value2Send );
        Send( MsgUp, Value2Send );
        Result := True;
      end
         else
        Result := False;
    end;

    function ParseKeys( EndChar: AnsiChar ): PAnsiChar;
    var FN: Integer;
    begin
      SCA := 0;
      while not (P^ in [ #0, EndChar ]) do
      begin
        if Compare( 'Shift' ) then SCA := SCA or 1
        else
        if Compare( 'Ctrl' ) then SCA := SCA or 2
        else
        if Compare( 'Alt' ) then SCA := SCA or 4
        else
          break;
      end;
      MsgDn := WM_KEYDOWN;
      MsgUp := WM_KEYUP;
      if LongBool( SCA and 4 ) then
      begin
        MsgDn := WM_SYSKEYDOWN;
        MsgUp := WM_SYSKEYUP;
        keybd_event( VK_MENU, 0, 0, 0 );
        Send( WM_SYSKEYDOWN, VK_MENU );
      end;
      if LongBool( SCA and 2 ) then
      begin
        keybd_event( VK_CONTROL, 0, 0, 0 );
        Send( WM_KEYDOWN, VK_CONTROL );
      end;
      if Longbool( SCA and 1 ) then
      begin
        keybd_event( VK_SHIFT, 0, 0, 0 );
        Send( WM_KEYDOWN, VK_SHIFT );
      end;
      while not (P^ in [ #0, EndChar ]) do
      begin
        if (P^ = 'F') and (P[ 1 ] in [ '1'..'9' ]) then
        begin
          Inc( P );
          FN := Ord( P^ ) - Ord( '0' );
          if (FN = 1) and (P[ 1 ] in [ '0'..'2' ]) then
          begin
            Inc( P );
            FN := 10 + Ord( P^ ) - Ord( '0' );
          end;
          repeat Inc( P ) until P^ <> ' ';
          FN := FN + $6F;
          Send( MsgDn, FN );
          Send( MsgUp, FN );
        end
           else
        if Compare( 'Numpad' ) then
        begin
          if P^ in [ '0'..'9' ] then
          begin
            FN := Ord( P^ ) - Ord( '0' ) + $60;
            repeat Inc( P^ ) until P^ <> ' ';
            Send( MsgDn, FN );
            Send( MsgUp, FN );
          end;
        end
           else
        if not (CompareSend( 'Add', $6B ) or
                CompareSend( 'Gray+', $6B ) or
                CompareSend( 'Apps', $5D ) or
                CompareSend( 'BackSpace', $08 ) or
                CompareSend( 'BkSp', $08 ) or
                CompareSend( 'BS', $08 ) or
                CompareSend( 'Break', $13 ) or
                CompareSend( 'CapsLock', $14 ) or
                CompareSend( 'Clear', $0C ) or
                CompareSend( 'Decimal', $6E ) or
                CompareSend( 'Del', $2E ) or
                CompareSend( 'Delete', $2E ) or
                CompareSend( 'Divide', $6F ) or
                CompareSend( 'Gray/', $6F ) or
                CompareSend( 'Down', $28 ) or
                CompareSend( 'End', $23 ) or
                CompareSend( 'Enter', $0D ) or
                CompareSend( 'Return', $0D ) or
                CompareSend( 'CR', $0D ) or
                CompareSend( 'Esc', $1B ) or
                CompareSend( 'Escape', $1B ) or
                CompareSend( 'Help', $2F ) or
                CompareSend( 'Home', $24 ) or
                CompareSend( 'Ins', $2D ) or
                CompareSend( 'Insert', $2D ) or
                CompareSend( 'Left', $25 ) or
                CompareSend( 'LWin', $5B ) or
                CompareSend( 'Multiply', $6A ) or
                CompareSend( 'Gray*', $6A ) or
                CompareSend( 'NumLock', $90 ) or
                CompareSend( 'PgDn', $22 ) or
                CompareSend( 'PgUp', $21 ) or
                CompareSend( 'PrintScrn', $2C ) or
                CompareSend( 'Right', $27 ) or
                CompareSend( 'RWin', $5C ) or
                CompareSend( 'Separator', $6C ) or
                CompareSend( 'ScrollLock', $91 ) or
                CompareSend( 'Subtract', $6D ) or
                CompareSend( 'Tab', $09 ) or
                CompareSend( 'Gray-', $6D ) or
                CompareSend( 'Up', $26 )) then break;
      end;
      while not (P^ in [ #0, EndChar ]) do
      begin
        if P^ in [ 'A'..'Z', '0'..'9' ] then
        begin
          Send( MsgDn, Integer( P^ ) );
          Send( MsgUp, Integer( P^ ) );
        end
        else
        if P^ in [ #1..#255 ] then
          Stroke2Window( Wnd, AnsiString('') + P^ );
        repeat Inc( P ) until (P^ <> AnsiString(' '));
      end;
      if P^ = EndChar then
        Inc( P );
      if Longbool( SCA and 1 ) then
      begin
        Send( WM_KEYUP, VK_SHIFT );
        keybd_event( VK_SHIFT, 0, KEYEVENTF_KEYUP, 0 );
      end;
      if LongBool( SCA and 2 ) then
      begin
        Send( WM_KEYUP, VK_CONTROL );
        keybd_event( VK_CONTROL, 0, KEYEVENTF_KEYUP, 0 );
      end;
      if LongBool( SCA and 4 ) then
      begin
        Send( WM_SYSKEYUP, VK_MENU );
        keybd_event( VK_MENU, 0, KEYEVENTF_KEYUP, 0 );
      end;
      Result := P;
    end;

begin
  Result := False;
  Wnd := GetTopWindow( Wnd );
  Wnd := GetFocusedChild( Wnd );
  if Wnd = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  P := PAnsiChar( S );
  while P^ <> #0 do
  begin
    if not (P^ in [ '[', '{' ]) then
    begin
      Stroke2Window( Wnd, AnsiString('') + P^ ); // TODO: adjust compile options?
      Inc( P );
    end
      else
    begin
      if P^ = '[' then
        EndChar := ']'
      else
        EndChar := '}';
      Inc( P );
      P := ParseKeys( EndChar );
    end;
  end;
  Result := True;
end;

type
  PHWnd = ^HWnd;

  TFindWndRec = packed Record
    ThreadID : DWord;
    WndFound : HWnd;
  end;
  PFindWndRec = ^TFindWndRec;

function EnumWindowsProc( Wnd : HWnd; Find : PFindWndRec ) : Boolean;
stdcall;
var Id : DWord;
begin
  Result := True;
  Id := GetWindowThreadProcessId( Wnd, @Id );
  if Id = Find.ThreadID then
  begin
    Find.WndFound := Wnd;
    Result := False;
  end;
end;

function FindWindowByThreadID( ThreadID : DWORD ) : HWnd;
var Find : TFindWndRec;
begin
  Find.ThreadID := ThreadID;
  Find.WndFound := 0;
  EnumWindows( @EnumWindowsProc, Integer( @Find ) );
  Result := Find.WndFound;
end;

function DesktopPixelFormat: TPixelFormat;
var DC: HDC;
    Nbits_per_pixel, Nplanes: Integer;
begin
  DC := GetDC( 0 );
  Nbits_per_pixel := GetDeviceCaps( DC, BITSPIXEL );
  Nplanes := GetDeviceCaps( DC, PLANES );
  ReleaseDC( 0, DC );
  CASE Nplanes * Nbits_per_pixel OF
  1: Result := pf1bit;
  4: Result := pf4bit;
  8: Result := pf8bit;
  16: Result := pf16bit;
  24, 32: Result := pf32bit;
  else Result := pfDevice;
  END;
end;

function GetDesktopRect : TRect;
var W1, W2 : HWnd;
begin
  if  WinVer >= wvVista then
  begin
      Result := GetWorkArea; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Result := MakeRect( 0, 0, GetSystemMetrics( SM_CXSCREEN ), GetSystemMetrics( SM_CYSCREEN ) );
  W2 := findwindow('Progman',nil);
  W1 := findwindowex(W2,0,'SHELLDLL_DefView',nil);
  if  W1 = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  GetWindowRect( W1, Result );
end;

function GetWorkArea: TRect;
begin
  SystemParametersInfo( SPI_GETWORKAREA, 0, @ Result, 0 );
end;

function ExecuteWait( const AppPath, CmdLine, DfltDirectory: KOLString;
         Show: DWORD; TimeOut: DWORD; ProcID: PDWORD ): Boolean;
var Flags: DWORD;
    Startup: TStartupInfo;
    ProcInf: TProcessInformation;
    DfltDir: PKOLChar;
    App: KOLString;
begin
  Result := FALSE;
  Flags := CREATE_NEW_CONSOLE;
  if Show = SW_HIDE then
    Flags := Flags or {$IFDEF F_P}$08000000{$ELSE}CREATE_NO_WINDOW{$ENDIF};
  ZeroMemory( @Startup, SizeOf( Startup ) );
  Startup.cb := Sizeof( Startup );
  Startup.wShowWindow := Show;
  Startup.dwFlags := STARTF_USESHOWWINDOW;
  if ProcID <> nil then
    ProcID^ := 0;
  DfltDir := nil;
  if DfltDirectory <> '' then
    DfltDir := PKOLChar( DfltDirectory );
  App := AppPath;
  //if (pos( KOLString(' '), App ) > 0) and (pos( KOLString('"'), App ) <= 0) then
  if (App <> '') and (App[1] <> '"') and (pos( KOLString(' '), App ) > 0) then
    App := '"' + App + '"';
  if (App <> '') and (CmdLine <> '') then
    App := App + ' ';
  if CreateProcess( nil, PKOLChar( App + CmdLine ), nil,
     nil, FALSE, Flags, nil, DfltDir, Startup,
     ProcInf ) then
  begin
    if WaitForSingleObject( ProcInf.hProcess, TimeOut ) = WAIT_OBJECT_0 then
    begin
      CloseHandle( ProcInf.hProcess );
      Result := TRUE;
    end
      else
    begin
      if ProcID <> nil then
        ProcID^ := ProcInf.hProcess;
    end;
    CloseHandle( ProcInf.hThread );
  end;
end;

function ExecuteIORedirect( const AppPath, CmdLine, DfltDirectory: KOLString;
         Show: DWORD; ProcID: PDWORD; InPipe, OutPipeWr, OutPipeRd: PHandle ): Boolean;
var Flags: DWORD;
    Startup: TStartupInfo;
    ProcInf: TProcessInformation;
    DfltDir: PKOLChar;
    SecurityAttributes: TSecurityAttributes;
    SaveStdOut, SaveStdIn: THandle;
    ChildStdOutRd, ChildStdOutWr: THandle;
    ChildStdInRd, ChildStdInWr: THandle;
    ChildStdOutRdDup: THandle;
    ChildStdInWrDup: THandle;

    procedure Do_CloseHandle( var Handle: THandle );
    begin
      if Handle <> 0 then
      begin
        CloseHandle( Handle );
        Handle := 0;
      end;
    end;

    procedure Close_Handles;
    begin
      Do_CloseHandle( ChildStdOutRd );
      Do_CloseHandle( ChildStdOutWr );
      Do_CloseHandle( ChildStdInRd );
      Do_CloseHandle( ChildStdInWr );
    end;

    function RedirectInputOutput: Boolean;
    begin
      Result := FALSE;
      if (OutPipeRd <> nil) or (OutPipeWr <> nil) then
      begin
        // redirect output
        SaveStdOut := GetStdHandle(STD_OUTPUT_HANDLE);
        if not CreatePipe( ChildStdOutRd, ChildStdOutWr, @ SecurityAttributes, 0 ) then
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        if not SetStdHandle( STD_OUTPUT_HANDLE, ChildStdOutWr ) then
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        if not DuplicateHandle( GetCurrentProcess, ChildStdOutRd,
           GetCurrentProcess, @ ChildStdOutRdDup, 0, FALSE,
           2 {DUPLICATE_SAME_ACCESS} ) then
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        Do_CloseHandle( ChildStdOutRd );
        if OutPipeRd <> nil then
          OutPipeRd^ := ChildStdOutRdDup;
        if OutPipeWr <> nil then
          OutPipeWr^ := ChildStdOutWr;
      end;
      if InPipe <> nil then
      begin
        // redirect input
        SaveStdIn := GetStdHandle(STD_INPUT_HANDLE);
        if not CreatePipe( ChildStdInRd, ChildStdInWr, @ SecurityAttributes, 0 ) then
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        if not SetStdHandle( STD_INPUT_HANDLE, ChildStdInRd ) then
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        if not DuplicateHandle( GetCurrentProcess, ChildStdInWr,
           GetCurrentProcess, @ ChildStdInWrDup, 0, FALSE,
           2 {DUPLICATE_SAME_ACCESS} ) then
          Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
        Do_CloseHandle( ChildStdInWr );
        if InPipe <> nil then
          InPipe^ := ChildStdInWrDup;
        Do_CloseHandle( ChildStdInRd );
      end;
      Result := TRUE;
    end;

    procedure Restore_Saved_StdInOut;
    begin
      SetStdHandle( STD_OUTPUT_HANDLE, SaveStdOut );
      SetStdHandle( STD_INPUT_HANDLE, SaveStdIn );
    end;

var Cmd: KOLString;
begin
  Result := FALSE;
  Flags := 0;
  if Show = SW_HIDE then
    Flags := Flags or {$IFDEF F_P}$08000000{$ELSE}CREATE_NO_WINDOW{$ENDIF};
  ZeroMemory( @Startup, SizeOf( Startup ) );
  Startup.cb := Sizeof( Startup );
  if ProcID <> nil then
    ProcID^ := 0;
  DfltDir := nil;
  SecurityAttributes.nLength := Sizeof( SecurityAttributes );
  SecurityAttributes.lpSecurityDescriptor := nil;
  SecurityAttributes.bInheritHandle := TRUE;
  SaveStdOut := 0;
  SaveStdIn := 0;
  ChildStdOutRd := 0;
  ChildStdOutWr := 0;
  ChildStdInRd := 0;
  ChildStdInWr := 0;
  if not RedirectInputOutput then
  begin
    Close_Handles; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  if DfltDirectory <> '' then
    DfltDir := PKOLChar( DfltDirectory );
  Cmd := '"' + AppPath + '" ' + CmdLine;
  if  CreateProcess( nil, PKOLChar( Cmd ), nil, nil, TRUE, Flags, nil,
      DfltDir, Startup, ProcInf ) then
  begin
      if ProcID <> nil then
        ProcID^ := ProcInf.hProcess
      else
        CloseHandle( ProcInf.hProcess );
      CloseHandle( ProcInf.hThread );
      Restore_Saved_StdInOut;
      Result := TRUE;
  end else
  begin
    Restore_Saved_StdInOut;
    Close_Handles;
  end;
end;

function ExecuteConsoleAppIORedirect( const AppPath, CmdLine, DfltDirectory: KOLString;
         Show: DWORD; const InStr: KOLString; var OutStr: KOLString; WaitTimeout: DWORD ): Boolean;
var PipeIn, PipeOutRd, PipeOutWr: THandle;
    ProcID: DWORD;
    BytesCount: DWORD;
    Buffer: Array[ 0..4096 ] of KOLChar; // KOL_ANSI
    BufStr: KOLString;
    PPipeIn: PHandle;
begin
  Result := FALSE;
  PPipeIn := @ PipeIn;
  if InStr = '' then
    PPipeIn := nil;
  PipeOutRd := 0;
  PipeOutWr := 0;
  if not ExecuteIORedirect( AppPath, CmdLine, DfltDirectory, Show, @ ProcID,
                     PPipeIn, @ PipeOutWr, @ PipeOutRd ) then Exit; {>>>>>>>>>>}
  if PPipeIn <> nil then
  begin
    if InStr <> '' then
      WriteFile( PipeIn, InStr[ 1 ], Length( InStr ), BytesCount, nil );
    CloseHandle( PipeIn );
  end;
  OutStr := '';
  if WaitForSingleObject( ProcID, WaitTimeOut ) = WAIT_OBJECT_0 then
  begin
    CloseHandle( ProcID );
    CloseHandle( PipeOutWr );
    while ReadFile( PipeOutRd, Buffer, Sizeof( Buffer ), BytesCount, nil ) do
    begin
      SetLength( BufStr, BytesCount );
      Move( Buffer[ 0 ], BufStr[ 1 ], BytesCount );
      OutStr := OutStr + BufStr;
    end;
  end
    else
    CloseHandle( PipeOutWr );
  CloseHandle( PipeOutRd );
  Result := TRUE;
end;

{$IFDEF _D2}
function OpenProcessToken(ProcessHandle: THandle; DesiredAccess: DWORD;
  var TokenHandle: THandle): BOOL; stdcall;
  external advapi32 name 'OpenProcessToken';
{$ENDIF}

function WindowsShutdown( const Machine : KOLString; Force, Reboot : Boolean ) : Boolean;
var
  hToken: THandle;
  tkp, tkp_prev: TTokenPrivileges;
  dwRetLen :DWORD;
  Flags: Integer;
begin
  Result := False;
  if Integer( GetVersion ) < 0 then // Windows95/98/Me
  begin
    if Machine <> '' then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
    Flags := EWX_SHUTDOWN;
    if Reboot then
      Flags := Flags or EWX_REBOOT;
    if Force then
      Flags := Flags or EWX_FORCE;
    Result := ExitWindowsEx( Flags, 0 ); Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  OpenProcessToken(GetCurrentProcess(),
                   TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
                   hToken);
  if not LookupPrivilegeValue(PKOLChar(Machine), 'SeShutdownPrivilege',
                              tkp.Privileges[0].Luid) then Exit; {>>>>>>>>>>>>>}
  tkp_prev:=tkp;
  tkp.PrivilegeCount:=1;
  tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
  AdjustTokenPrivileges(hToken, FALSE, tkp, sizeof(tkp), tkp_prev,
dwRetLen);
  if  not LookupPrivilegeValue(PKOLChar(Machine),
                               'SeRemoteShutdownPrivilege',
                               tkp.Privileges[0].Luid) then Exit; {>>>>>>>>>>>>}
  tkp.PrivilegeCount:=1;
  tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
  AdjustTokenPrivileges(hToken, FALSE, tkp, sizeof(tkp), tkp_prev, dwRetLen);
  Result := InitiateSystemShutdown(PKOLChar(Machine),nil, 0, Force, Reboot);
end;

function WindowsLogoff( Force : Boolean ) : Boolean;
var Flags: Integer;
begin
  Flags := 0;
  if Force then
    Flags := EWX_FORCE;
  Result := ExitWindowsEx( Flags, 0 );
end;

var SaveWinVer: Byte = $FF;

{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} // asm version by MTsv DN  (v 2.90)
function WinVer : TWindowsVersion;
var MajorVersion, MinorVersion: Byte;
    dwVersion: Integer;
begin
  if SaveWinVer <> $FF then Result := TWindowsVersion( SaveWinVer )
  else
  begin
    dwVersion := GetVersion;
    MajorVersion := LoByte( dwVersion );
    MinorVersion := HiByte( LoWord( dwVersion ) );
    if dwVersion >= 0 then
    begin
      Result := wvNT;
      if (MajorVersion >= 6) then begin
        if (MinorVersion >= 1) then
          Result := wvSeven
        else
          Result := wvVista;
      end else begin
             if MajorVersion >= 5 then
                if MinorVersion >= 1 then
                begin
                     Result := wvXP;
                     if MinorVersion >= 2 then
                       Result := wvServer2003;
                end
                else Result := wvY2K;
           end;
    end
      else
    begin
      Result := wv95;
      if (MajorVersion > 4) or
         (MajorVersion = 4) and (MinorVersion >= 10)  then
      begin
        Result := wv98;
        if (MajorVersion = 4) and (MinorVersion >= $5A) then
          Result := wvME;
      end
        else
      if MajorVersion <= 3 then
        Result := wv31;
    end;
    SaveWinVer := Ord( Result );
  end;
end;
{$ENDIF PAS_VERSION}

function IsWinVer( Ver : TWindowsVersions ) : Boolean;
{* Returns True if Windows version is in given range of values. }
begin
  Result := WinVer in Ver;
end;

procedure TControl.SetAlphaBlend(const Value: Byte);
const
  LWA_COLORKEY=$00000001;
  LWA_ALPHA=$00000002;
  ULW_COLORKEY=$00000001;
  ULW_ALPHA=$00000002;
  ULW_OPAQUE=$00000004;
  WS_EX_LAYERED=$00080000;
type
  TSetLayeredWindowAttributes=
    function( hwnd: Integer; crKey: TColor; bAlpha: Byte; dwFlags: DWORD )
    : Boolean; stdcall;
var
  SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
  User32: THandle;
  dw: DWORD;
begin
  if Value = fAlphaBlend then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  fAlphaBlend := Value;
  User32 := GetModuleHandle( 'User32' );
  SetLayeredWindowAttributes := GetProcAddress( User32,
                             'SetLayeredWindowAttributes' );
  if Assigned( SetLayeredWindowAttributes ) then
  begin
      dw := GetWindowLong( GetWindowHandle, GWL_EXSTYLE );
      if Value < 255 then
      begin
          SetWindowLong( fHandle, GWL_EXSTYLE, dw or WS_EX_LAYERED );
          SetLayeredWindowAttributes( fHandle, 0, Value {and $FF}, LWA_ALPHA);
      end else
          SetWindowLong( fHandle, GWL_EXSTYLE, dw and not WS_EX_LAYERED );
  end;
end;

{$ENDIF WIN_GDI}
function TControl.SetPosition( X, Y: Integer ): PControl;
begin
  Left := X;
  Top := Y;
  Result := @Self;
end;
{$IFDEF WIN_GDI}

function NewColorDialog( FullOpen: TColorCustomOption ): PColorDialog;
var I: Integer;
begin
  New( Result, Create );
  {$IFDEF DEBUG_OBJKIND}
  Result.fObjKind := 'TColorDialog';
  {$ENDIF}
  Result.ColorCustomOption := FullOpen;
  for I := 1 to 16 do
    Result.CustomColors[ I ] := clWhite;
end;

{ TColorDialog }

function TColorDialog.Execute: Boolean;
var CD: TChooseColor;
begin
  CD.lStructSize := Sizeof( CD );
  CD.hWndOwner := OwnerWindow;
  //CD.hInstance := 0;
  CD.rgbResult := Color2RGB( Color );
  CD.lpCustColors := @CustomColors[ 1 ];
  CD.Flags := CC_RGBINIT;
  case ColorCustomOption of
  ccoFullOpen: CD.Flags := CD.Flags or CC_FULLOPEN;
  ccoPreventFullOpen: CD.Flags := CD.Flags or CC_PREVENTFULLOPEN;
  end;
  Result := ChooseColor( CD );
  if Result then
    Color := CD.rgbResult;
end;

procedure TControl.SetMaxProgress(const Index, Value: Integer);
begin
  // ignore index, and set Value via PBM_SETRANGE32:     ()
  Perform( PBM_SETRANGE32, 0, Value );
end;

procedure TControl.SetDroppedWidth(const Value: Integer);
begin
  DF.fDroppedWidth := Value;
  Perform( CB_SETDROPPEDWIDTH, Value, 0 );
end;

function TControl.LVGetItemState(Idx: Integer): TListViewItemState;
type
  PListViewItemState = ^TListViewItemState;
var I: Byte;
begin
  I := Perform( LVM_GETITEMSTATE, Idx,
                LVIS_CUT or LVIS_DROPHILITED or LVIS_FOCUSED or LVIS_SELECTED );
  Result := PListViewItemState( @ I )^;
end;

procedure TControl.LVSetItemState(Idx: Integer; const Value: TListViewItemState);
var Data: TLVItem;
begin
  Data.stateMask := LVIS_FOCUSED or LVIS_SELECTED or LVIS_CUT or LVIS_DROPHILITED;
  Data.state     := PByte( @ Value )^;
  Perform( LVM_SETITEMSTATE, Idx, Integer( @Data ) );
end;

procedure TControl.LVSelectAll;
begin
  LVSetItemState( -1, [ lvisSelect ] );
end;

function TControl.LVItemInsert(Idx: Integer; const aText: KOLString): Integer;
var LVI: TLVItem;
begin
  LVI.mask := LVIF_TEXT or LVIF_DI_SETITEM;
  LVI.iItem := Idx;
  LVI.iSubItem := 0;
  LVI.pszText := PKOL_Char( aText );
  Result := Perform( LVM_INSERTITEM, 0, Integer( @LVI ) );
end;

function TControl.LVItemAdd(const aText: KOLString): Integer;
begin
  Result := LVItemInsert( Count, aText );
end;

function TControl.LVGetSttImgIdx(Idx: Integer): Integer;
begin
  Result := Perform( LVM_GETITEMSTATE, Idx, LVIS_STATEIMAGEMASK ) shr 12;
end;

procedure TControl.LVSetSttImgIdx(Idx: Integer; const Value: Integer);
var LVI: TLVItem;
begin
  LVI.stateMask := LVIS_STATEIMAGEMASK;
  LVI.state := Value shl 12;
  Perform( LVM_SETITEMSTATE, Idx, Integer( @LVI ) );
end;

function TControl.LVGetOvlImgIdx(Idx: Integer): Integer;
begin
  Result := Perform( LVM_GETITEMSTATE, Idx, LVIS_OVERLAYMASK ) shr 8;
end;

procedure TControl.LVSetOvlImgIdx(Idx: Integer; const Value: Integer);
var LVI: TLVItem;
begin
  LVI.stateMask := LVIS_OVERLAYMASK;
  LVI.state := Value shl 8;
  Perform( LVM_SETITEMSTATE, Idx, Integer( @LVI ) );
end;

function TControl.LVGetItemData(Idx: Integer): DWORD;
var LVI: TLVItem;
begin
  LVI.mask := LVIF_PARAM;
  LVI.iItem := Idx;
  LVI.iSubItem := 0;
  Perform( LVM_GETITEM, 0, Integer( @LVI ) );
  Result := LVI.lParam;
end;

procedure TControl.LVSetItemData(Idx: Integer; const Value: DWORD);
var LVI: TLVItem;
begin
  LVI.mask := LVIF_PARAM;
  LVI.iItem := Idx;
  LVI.iSubItem := 0;
  LVI.lParam := Value;
  Perform( LVM_SETITEM, 0, Integer( @LVI ) );
end;

function TControl.LVGetItemIndent(Idx: Integer): Integer;
var LI: TLVItem;
begin
  LI.mask := LVIF_INDENT;
  LI.iItem := Idx;
  LI.iSubItem := 0;
  Perform( LVM_GETITEM, 0, Integer( @LI ) );
  Result := LI.iIndent;
end;

procedure TControl.LVSetItemIndent(Idx: Integer; const Value: Integer);
var LI: TLVItem;
begin
  LI.mask := LVIF_INDENT or LVIF_DI_SETITEM;
  LI.iItem := Idx;
  LI.iSubItem := 0;
  LI.iIndent := Value;
  Perform( LVM_SETITEM, 0, Integer( @LI ) );
end;

type
  TNMLISTVIEW = packed Record
    hdr: TNMHDR;
    iItem: Integer;
    iSubItem: Integer;
    uNewState: Integer;
    uOldState: Integer;
    uChanged: Integer;
    ptAction: Integer;
    lParam: DWORD;
  end;
  PNMLISTVIEW = ^TNMLISTVIEW;

function WndProc_LVDeleteItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer )
                          : Boolean;
var Hdr: PNMHDR;
    LV: PNMListView;
begin
  Result := FALSE;
  if Msg.message = WM_NOTIFY then
  begin
    Hdr := Pointer(Msg.lParam);
    if Hdr.hwndFrom = Sender.Handle then
    begin
      LV := Pointer( Hdr );
      if Hdr.code = LVN_DELETEITEM then
      begin
        {$IFDEF NIL_EVENTS}
        if  Assigned( Sender.EV.fOnDeleteLVItem ) then
        {$ENDIF}
            Sender.EV.fOnDeleteLVItem( Sender, LV.iItem );
        Result := TRUE;
      end
        else
      if Hdr.code = LVN_DELETEALLITEMS then
      begin
          if Assigned( Sender.DF.fOnDeleteAllLVItems ) then
          begin
              Sender.DF.fOnDeleteAllLVItems( Sender );
              Rslt := 0;
              if  Assigned( Sender.EV.fOnDeleteLVItem ) then
                  Rslt := 1;
          end;
          Result := TRUE;
      end;
    end;
  end;
end;

procedure TControl.SetOnDeleteAllLVItems(const Value: TOnEvent);
begin
  DF.fOnDeleteAllLVItems := Value;
  AttachProc( @WndProc_LVDeleteItem );
end;

procedure TControl.SetOnDeleteLVItem(const Value: TOnDeleteLVItem);
begin
    {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
    .fOnDeleteLVItem := Value;
    AttachProc( @WndProc_LVDeleteItem );
end;

function WndProc_LVData( Sender: PControl; var Msg: TMsg; var Rslt: Integer )
                          : Boolean;
var Hdr: PNMHDR;
    DI: PLVDispInfo;
    Store: Boolean;
    Txt: KOL_String;
    LV: PControl;
begin
  Result := FALSE;
  if Msg.message = WM_NOTIFY then
  begin
    Hdr := Pointer(Msg.lParam);
    if Hdr.hwndFrom = Sender.Handle then
    begin
      if (Hdr.code = LVN_GETDISPINFO)
         {$IFDEF UNICODE_CTRLS}
         or (Hdr.code = LVN_GETDISPINFOW)
         {$ENDIF UNICODE_CTRLS}
      then
      begin
        DI := Pointer( Hdr );
        LV := Sender;
        if LV <> nil then
        begin
          Txt := '';
          DI.item.iImage := -1;
          DI.item.state := 0;
          if  {$IFDEF NIL_EVENTS} Assigned( LV.EV.fOnLVData ) and {$ENDIF}
              (DI.item.iItem >= 0) then
          begin
              Store := FALSE;
              LV.EV.fOnLVData( LV, DI.item.iItem, DI.item.iSubItem, Txt,
                               DI.item.iImage, DWORD( DI.item.state ), Store );
              LV.fCaption := Txt;
              DI.item.pszText := PKOL_Char( PKOLChar( LV.fCaption ) );
              if  Store then
                  DI.item.mask := DI.item.mask or LVIF_DI_SETITEM;
            end;
            Result := TRUE;
        end;
      end;
    end;
  end;
end;

procedure TControl.SetOnLVData(const Value: TOnLVData);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnLVData := Value;
  AttachProc( @WndProc_LVData );
  Perform( LVM_SETCALLBACKMASK, LVIS_OVERLAYMASK or LVIS_STATEIMAGEMASK, 0 );
end;

{$IFDEF ENABLE_DEPRECATED}
{$DEFINE implementation} {$I KOL_deprecated.inc} {$UNDEF implementation}
{$ENDIF DISABLE_DEPRECATED}

function WndProc_LVCustomDraw( Sender: PControl; var Msg: TMsg;
                               var Rslt: Integer ): Boolean;
var NMCustDraw: PNMLVCustomDraw;
    NMHdr: PNMHdr;
    ItemIdx, SubItemIdx: Integer;
    S: TListViewItemState;
    ItemState: TDrawState;
begin
  Result := FALSE;
  if Msg.message = WM_NOTIFY then
  begin
    NMHdr := Pointer( Msg.lParam );
    if (NMHdr.code = NM_CUSTOMDRAW)
    {$IFDEF NIL_EVENTS} and Assigned( Sender.EV.fOnLVCustomDraw ) {$ENDIF}
    then
    begin
      NMCustDraw := Pointer( Msg.lParam );
      ItemIdx := -1;
      SubItemIdx := -1;
      if  LongBool( NMCustDraw.nmcd.dwDrawStage and CDDS_ITEM ) then
          ItemIdx := NMCustDraw.nmcd.dwItemSpec;
      if  LongBool( NMCustDraw.nmcd.dwDrawStage and CDDS_SUBITEM ) then
          SubItemIdx := NMCustDraw.iSubItem;
      ItemState := [ ];
      if  ItemIdx >= 0 then
      begin
          S := Sender.LVItemState[ ItemIdx ];
          if  lvisFocus in S then
              include( ItemState, odsFocused );
          if  lvisSelect in S then
              include( ItemState, odsSelected );
          if  lvisBlend in S then
              include( ItemState, odsGrayed );
          if  lvisHighlight in S then
              include( ItemState, odsMarked );
      end;
      Rslt := Sender.EV.FOnLVCustomDraw( Sender, {Sender.fPaintDC} NMCustDraw.nmcd.hdc,
           NMCustDraw.nmcd.dwDrawStage, ItemIdx, SubItemIdx, NMCustDraw.nmcd.rc,
           ItemState, TColor( NMCustDraw.clrText ), TColor( NMCustDraw.clrTextBk ) );

      Result := TRUE;
    end;
  end;
end;

procedure TControl.SetOnLVCustomDraw(const Value: TOnLVCustomDraw);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnLVCustomDraw := Value;
  AttachProc( @WndProc_LVCustomDraw );
end;

function CompareLVItems( Idx1, Idx2: Integer; ListView: PControl ): Integer; stdcall;
begin
  {$IFDEF NIL_EVENTS}
  if  Assigned( ListView.EV.fOnCompareLVItems ) then
  {$ENDIF}
      Result := ListView.EV.fOnCompareLVItems( ListView, Idx1, Idx2 )
  {$IFDEF NIL_EVENTS}
  else
      Result := 0
  {$ENDIF} ;
end;

procedure TControl.LVSort;
begin
  Perform( LVM_SORTITEMSEX, Integer(@Self), Integer(@CompareLVItems) );
end;

function CompareLVItemsData( D1, D2: DWORD; ListView: PControl ): Integer; stdcall;
begin
  {$IFDEF NIL_EVENTS}
  if  Assigned( ListView.EV.fOnCompareLVItems ) then
  {$ENDIF}
      Result := ListView.EV.fOnCompareLVItems( ListView, D1, D2 )
  {$IFDEF NIL_EVENTS}
  else
      Result := 0
  {$ENDIF} ;
end;

procedure TControl.LVSortData;
begin
  Perform( LVM_SORTITEMS, Integer( @Self ), Integer( @CompareLVItemsData ) );
end;

function WndProc_LVColumnClick( Sender: PControl; var Msg: TMsg; var Rslt: Integer )
                          : Boolean;
var Hdr: PNMHDR;
    LV: PNMListView;
begin
  Result := FALSE;
  if Msg.message = WM_NOTIFY then
  begin
    Hdr := Pointer(Msg.lParam);
    if Hdr.hwndFrom = Sender.Handle then
    begin
      LV := Pointer( Hdr );
      if Hdr.code = LVN_COLUMNCLICK then
      begin
        {$IFDEF NIL_EVENTS}
        if  Assigned( Sender.EV.fOnColumnClick ) then
        {$ENDIF}
            Sender.EV.fOnColumnClick( Sender, LV.iSubItem );
        Result := TRUE;
      end;
    end;
  end;
end;

procedure TControl.SetOnColumnClick(const Value: TOnLVColumnClick);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnColumnClick := Value;
  AttachProc( @WndProc_LVColumnClick );
end;

function WndProc_LVStateChange( Sender: PControl; var Msg: TMsg; var R: Integer ): Boolean;
var NMOD: PNMLVODStateChange;
    NMLV: PNMLISTVIEW;
begin
  if Msg.message = WM_NOTIFY then
  begin
    NMOD := Pointer( Msg.lParam );
    NMLV := Pointer( Msg.lParam );
    if NMOD.hdr.code = LVN_ODSTATECHANGED then
    begin
      {$IFDEF NIL_EVENTS}
      if  Assigned( Sender.EV.fOnLVStateChange ) then
      {$ENDIF}
          Sender.EV.fOnLVStateChange( Sender, NMOD.iFrom, NMOD.iTo,
                                      NMOD.uOldState, NMOD.uNewState );
    end
      else
    if NMLV.hdr.code = LVN_ITEMCHANGED then
    begin
      {$IFDEF NIL_EVENTS}
      if  Assigned( Sender.EV.fOnLVStateChange ) then
      {$ENDIF}
          Sender.EV.fOnLVStateChange( Sender, NMLV.iItem, NMLV.iItem,
                                      NMLV.uOldState, NMLV.uNewState );
    end;
  end;
  Result := FALSE;
end;

procedure TControl.SetOnLVStateChange(const Value: TOnLVStateChange);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .FOnLVStateChange := Value;
  AttachProc( WndProc_LVStateChange );
end;

function CompareLVColumns( Idx1, Idx2: Integer; Sender: PControl ): Integer; stdcall;
var S1, S2: KOLString;
begin
  //--- changed by Mike Gerasimov:
  S1 := Sender.LVItems[ Idx1, Sender.DF.fColumn ];
  S2 := Sender.LVItems[ Idx2, Sender.DF.fColumn ];
  If  lvoSortAscending in Sender.DF.fLVOptions Then
      Result := AnsiCompareStrNoCase( S1, S2 )
  Else
      If  lvoSortDescending in Sender.DF.fLVOptions Then
          Result := AnsiCompareStrNoCase( S2, S1 )
      Else
          Result:=0;
end;

procedure TControl.LVSortColumn(Idx: Integer);
begin
  DF.fColumn := Idx;
  Perform( LVM_SORTITEMSEX, Integer(@Self), Integer(@CompareLVColumns) );
end;

function TControl.LVIndexOf(const S: KOLString): Integer;
begin
  Result := LVSearchFor( S, -1, FALSE );
end;

function TControl.LVSearchFor(const S: KOLString; StartAfter: Integer;
  Partial: Boolean): Integer;
var f: TLVFindInfo;
begin
    f.lParam := 0;
    f.flags  := LVFI_STRING;
    if Partial then
      f.flags := LVFI_STRING or LVFI_PARTIAL;
    f.psz    := @s[1];
    result := Perform(LVM_FINDITEM,StartAfter,integer(@f));
end;

function WndProcLVMeasureItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var
  pMI: PMeasureItemStruct;
  P: PControl;
  H: Integer;
  wId: DWORD;
  i: Integer;
begin
  Result := FALSE;
  if Msg.message = WM_MEASUREITEM then begin
    pMI := Pointer(Msg.lParam);
    with pMI^ do begin
      for i:=0 to Sender.ChildCount-1 do begin
        P := Sender.Children[i];
        if P <> nil then begin
          wId := GetWindowLong(P.Handle,GWL_ID);
          if CtlID = wId then begin
            H := P.Perform(WM_MEASUREITEM,0,0);
            if H > 0 then begin
              itemHeight := H;
              Rslt:=1;
              Result := TRUE;
            end;
            break;
          end;
        end;
      end;
    end;
  end;
end;

function WndProcLVMeasureItem2( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := FALSE;
  if (Msg.message = WM_MEASUREITEM) and (Msg.wParam = 0) then begin
    Rslt := Sender.DF.fLVItemHeight;
    Result := TRUE;
  end;

end;

function TControl.SetLVItemHeight(Value: Integer): PControl;
begin
  Set_LVItemHeight( Value );
  Result := @ Self;
end;

procedure TControl.Set_LVItemHeight(Value: Integer);
begin
  if  DF.fLVItemHeight <> Value then
  begin
      if  DF.fLVItemHeight = 0 then
      begin
          Parent.AttachProc(WndProcLVMeasureItem);
          AttachProc(WndProcLVMeasureItem2);
      end;
      DF.fLVItemHeight := Value;
  end;
end;

function TControl.IndexOf(const S: KOLString): Integer;
begin
  Result := SearchFor( S, -1, FALSE );
end;

function TControl.SearchFor(const S: KOLString; StartAfter: Integer;
  Partial: Boolean): Integer;
var Cmd: Integer;
    I: Integer;
begin
  Cmd := fCommandActions.aFindItem;
  if Partial then
    Cmd := fCommandActions.aFindPartial;
  if Cmd <> 0 then
    Result := Perform( Cmd, StartAfter, Integer( PKOLChar( S ) ) )
  else
  begin
    Result := -1;
    for I := StartAfter+1 to Count-1 do
    begin
      if Partial and ( Copy( Items[ I ], 1, Length( S ) ) = S ) or
         ( Items[ I ] = S ) then
      begin
        Result := I;
        break;
      end;
    end;
  end;
end;

{$UNDEF ASM_LOCAL}
{$IFDEF ASM_VERSION}
        {$IFDEF USE_FLAGS}
        {$IFDEF EVENTS_DYNAMIC}
        //{$IFNDEF NIL_EVENTS}
        {$IFNDEF CLICK_DEFAULT_CANCEL_BTN_DIRECTLY}
                                                   {$DEFINE ASM_LOCAL}
        {$ENDIF CLICK_DEFAULT_CANCEL_BTN_DIRECTLY}
        //{$ENDIF NIL_EVENTS}
        {$ENDIF EVENTS_DYNAMIC}
        {$ENDIF USE_FLAGS}
{$ENDIF PAS_VERSION}

{$IFDEF ASM_LOCAL}
function TControl.DefaultBtnProc(var Msg: TMsg; var Rslt: Integer): Boolean;
asm
         PUSH  EBX
         PUSH  ESI
         PUSH  EDI
         PUSH  ECX  // save @Rslt
         PUSH  EDX  // save Msg
         MOV   EBX, EDX // EBX = @ Msg
         XCHG  ESI, EAX // ESI = @ Self
         MOV   EAX, [ESI].TControl.EV
         MOV   EDI, [EAX].TEvents.fOldOnMessage.TMethod.Code
         MOV   EAX, [EAX].TEvents.fOldOnMessage.TMethod.Data
         {$IFDEF NIL_EVENTS}
         TEST  EDI, EDI
         JZ    @@cont
         {$ELSE}
         {$ENDIF}
         CALL  EDI
         TEST  AL, AL
         JNZ   @@exit1
@@cont:
         CMP   [AppletTerminated], AL
         JNZ   @@exit
         MOV   AX, word ptr [EBX].TMsg.message
         //SUB   AX, WM_KEYDOWN
         DEC   AH
         CMP   AX, WM_CHAR - WM_KEYDOWN
         JA    @@exit
         XCHG  EAX, EBX
         MOV   EBX, [EAX].TMsg.message
         SHL   EBX, 16
         MOV   BL, byte ptr [EAX].TMsg.wParam
         CMP   BL, 13
         JE    @@ok1327
         CMP   BL, 27
         JNE   @@exit
@@ok1327:
         MOV   EDI, [Applet]
         TEST  [EDI].TControl.fFlagsG3, 1 shl G3_IsForm
         JNZ   @@1
         MOV   EDI, [EDI].DF.fCurrentControl
@@1:
         TEST  EDI, EDI
         JZ    @@exit

         PUSH  EBP
         XOR   EBP, EBP // Btn := nil;

         MOV   BH, 13
         MOV   EDX, offset[DFLT_BTN]
@@findButton:
         MOV   EAX, EDI
         CALL  TControl.Get_Prop_Int
         TEST  EAX, EAX
         JZ    @@notFromProp
         CMP   BL, BH
         JNZ   @@notFromProp
         MOV   EBP, EAX
         CALL  TControl.GetToBeVisible
         TEST  AL, AL
         JZ    @@notFromProp
         MOV   EAX, EBP
         CALL  TControl.GetEnabled
         TEST  AL, AL
         JZ    @@notFromProp
         CMP   BL, 13
         JNZ   @@yesFound
         MOV   ECX, [EDI].TControl.DF.fCurrentControl
         JECXZ @@yesFound
         TEST  word ptr [ECX].TControl.fFlagsG5, (1 shl G6_CancelBtn) shl 8 or(1 shl G5_IgnoreDefault)
         JZ    @@yesFound
         CMP   EBP, ECX
         JZ    @@yesFound
@@notFromProp:
         XOR   EBP, EBP
         CMP   BL, 13
         JNZ   @@notFound
         MOV   AL, [EDI].TControl.DF.fAllBtnReturnClick
         OR    AL, [ESI].TControl.DF.fAllBtnReturnClick
         JZ    @@notFound
         MOV   ECX, [EDI].DF.fCurrentControl
         JECXZ @@notFound
         MOV   AL, [ECX].TControl.fFlagsG5
         AND   AL, (1 shl G5_IsButton) or (1 shl G5_IsGroupbox)
         CMP   AL, (1 shl G5_IsButton)
         JNZ   @@notFound
         MOV   EBP, EAX
         CALL  TControl.GetToBeVisible
         TEST  AL, AL
         JNZ   @@yesFound
@@notFound:
         XOR   EBP, EBP
@@yesFound:
         CMP   BH, 13
         MOV   BH, 27
         MOV   EDX, offset[CNCL_BTN]
         JNZ   @@check_Found
         TEST  EBP, EBP
         JZ    @@findButton
@@check_Found:
         MOV   ECX, EBP
         POP   EBP
         JECXZ @@exit

         MOV   ESI, ECX
         XCHG  EAX, ECX

         SHR   EBX, 16
         CMP   BX, WM_KEYDOWN
         JNZ   @@doclick

         MOV   DL, 1
         CALL  TControl.SetFocused

@@doclick:
         POP   EDI
         POP   EBX

         PUSH  [EDI].TMsg.lParam
         PUSH  32
         PUSH  [EDI].TMsg.message
         PUSH  ESI
         CALL  TControl.Perform

         XOR   EAX, EAX
         AND   [EDI].TMsg.wParam, EAX
         AND   [EBX], EAX
         INC   EAX
         PUSH  EAX
         PUSH  EAX
         JMP   @@exit1

@@exit:  XOR   EAX, EAX
@@exit1:
         POP   EDX
         POP   ECX
         POP   EDI
         POP   ESI
         POP   EBX
end;
{$ELSE PAS_VERSION}
function TControl.DefaultBtnProc(var Msg: TMsg;
  var Rslt: Integer): Boolean;
var Btn: PControl;
    F: PControl;

    procedure FindBtn( key: Word; s: PKOLChar; for_dflt: Boolean );
    var Ctl: PControl;
    begin
      Ctl := Pointer( F.PropInt[ s ] );
      if  (Msg.wParam = key) and
          (Ctl <> nil) and
          Ctl.ToBeVisible and
          Ctl.Enabled and
          ( not for_dflt or
            for_dflt and
          ( (F.DF.fCurrentControl=nil) or
            ({$IFDEF USE_FLAGS} not(G6_CancelBtn in F.DF.fCurrentControl.fFlagsG6)
            {$ELSE} not F.DF.fCurrentControl.fCancelBtn {$ENDIF} and
            {$IFDEF USE_FLAGS} not(G5_IgnoreDefault in F.DF.fCurrentControl.fFlagsG5)
            {$ELSE} not F.DF.fCurrentControl.fIgnoreDefault {$ENDIF})
            or (F.DF.fCurrentControl = Ctl)
          ) ) then
          Btn := Ctl
      else
      if  for_dflt
      AND (Msg.wParam = VK_RETURN) and
          (F.DF.fAllBtnReturnClick or DF.fAllBtnReturnClick)
      and (F.ActiveControl <> nil) and
          (F.ActiveControl.ToBeVisible) and
          {$IFDEF USE_FLAGS} (G5_IsButton in F.ActiveControl.fFlagsG5)
                             and not(G5_IsGroupbox in F.ActiveControl.fFlagsG5)
          {$ELSE} (F.ActiveControl.IsButton and not F.ActiveControl.fIsGroupbox) {$ENDIF}
      {and (F.ActiveControl.Count = 0)} then
          Btn := F.ActiveControl;
    end;
begin
  {$IFDEF NIL_EVENTS}
  if  Assigned( EV.fOldOnMessage ) then
  {$ENDIF}
  begin
      Result := EV.fOldOnMessage( Msg, Rslt );
      if Result then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Result := FALSE;
  if AppletTerminated then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  F := Applet;
  if  {$IFDEF USE_FLAGS} not(G3_IsForm in F.fFlagsG3)
      {$ELSE} not F.fIsForm {$ENDIF} then
      F := F.DF.fCurrentControl;
  if  F = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  Btn := nil;
  if  //((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP) or (Msg.message = WM_CHAR)) and
      ((Msg.message >= WM_KEYDOWN) and (Msg.message <= WM_CHAR)) and
      ((Msg.wParam = VK_RETURN) or (Msg.wParam = VK_ESCAPE)) then
  begin
      FindBtn( VK_RETURN, @DFLT_BTN, TRUE );
      FindBtn( VK_ESCAPE, @CNCL_BTN, FALSE );
      if Btn <> nil then
      begin
        if Msg.message = WM_KEYDOWN then
        begin
          {$IFDEF CLICK_DEFAULT_CANCEL_BTN_DIRECTLY}
          {$IFDEF NIL_EVENTS}
          if  Assigned( Btn.EV.fOnClick ) then
          {$ENDIF}
              Btn.EV.fOnClick( Btn );
          {$ELSE}
          Btn.Focused := TRUE;
          {$ENDIF}
        end;
        {$IFDEF CLICK_DEFAULT_CANCEL_BTN_DIRECTLY}
        {$ELSE}
        Btn.Perform( Msg.message, DWORD( ' ' ), Msg.lParam );
        {$ENDIF}
        Msg.wParam := 0;
        Result := TRUE;
        Rslt := 0; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end
  end;
  Result := FALSE;
end;
{$ENDIF PAS_VERSION}

{$UNDEF ASM_LOCAL}
{$IFDEF ASM_VERSION}
        {$IFDEF USE_FLAGS}
        {$IFNDEF DEFAULT_CANCEL_BTN_EXCLUSIVE}
        {$IFDEF EVENTS_DYNAMIC}
                {$DEFINE ASM_LOCAL}
        {$ENDIF EVENTS_DYNAMIC}
        {$ENDIF  DEFAULT_CANCEL_BTN_EXCLUSIVE}
        {$ENDIF USE_FLAGS}
{$ENDIF PAS_VERSION}

{$IFDEF ASM_LOCAL}
procedure TControl.SetDefaultBtn(const Index: Integer;
  const Value: Boolean);
asm
        PUSH  EBX
        PUSH  EDI
        PUSH  ESI
        MOV   BL, DL // index
        MOV   BH, CL // value
        MOV   ESI, EAX // @Self
        ADD   ECX, ECX // DL = 2
        CMP   BL, 13
        JZ    @@1
        CMP   BL, 27
        JNZ   @@2
        ADD   ECX, ECX // DL := Index = 13 ? 2 : 4
@@1:    CMP   BH, 0
        JNZ   @@set_flag
        NOT   CL
        AND   [ESI].fFlagsG6, CL
        MOV   CL, 0
@@set_flag:
        OR    [ESI].fFlagsG6, CL
@@2:
        CMP   [Applet], 0
        JZ    @@exit
        CALL  TControl.ParentForm
        TEST  EAX, EAX
        JZ    @@exit

        XCHG  EDI, EAX // EDI = ParentForm
        MOV   AL, BH
        SHR   EAX, 1
        SBB   ECX, ECX
        AND   ECX, ESI // ECX = Value ? @ Self : 0
        MOV   EDX, offset[DFLT_BTN]
        CMP   BL, 13
        JZ    @@3
        MOV   EDX, offset[CNCL_BTN]
@@3:
        XCHG  EAX, EDI
        CALL  TControl.Set_Prop_Int

        {$IFnDEF NO_DEFAULT_BUTTON_BOLD}
        XCHG  EAX, ESI //---- áîëüøå @Self íå íóæåí
        MOV   EDX, [EAX].TControl.fStyle
        AND   DL, not BS_DEFPUSHBUTTON //---- BS_DEFPUSHBUTTON = 1, BH = Value = 1 : 0
        OR    DL, BH
        CALL  TControl.SetStyle
        {$ENDIF}

        TEST  BH, BH
        MOV   ESI, [Applet] // ESI = Applet
        MOV   EBX, [ESI].TControl.EV
        JZ    @@notValue

        MOV   EDX, [EBX].TEvents.fOnMessage.TMethod.Code
        CMP   EDX, offset[TControl.DefaultBtnProc]
        JZ    @@setDefaultBtnProc

        MOV   [EBX].TEvents.fOldOnMessage.TMethod.Code, EDX
        MOV   EDX, [EBX].TEvents.fOnMessage.TMethod.Data
        MOV   [EBX].TEvents.fOldOnMessage.TMethod.Data, EDX

@@setDefaultBtnProc:
        MOV   [EBX].TEvents.fOnMessage.TMethod.Code, offset[TControl.DefaultBtnProc]
        MOV   [EBX].TEvents.fOnMessage.TMethod.Data, ESI
        JMP   @@exit

@@notValue:
        LEA   ESI, [EBX].TEvents.fOldOnMessage
        LEA   EDI, [EBX].TEvents.fOnMessage
        MOVSD
        MOVSD
        MOV   [EBX].TEvents.fOldOnMessage.TMethod.Code, offset[DummyProc123_0]

@@exit: POP   ESI
        POP   EDI
        POP   EBX
end;
{$ELSE  notASM_VERSION}
procedure TControl.SetDefaultBtn(const Index: Integer;
  const Value: Boolean);
var F, C: PControl;
begin
  if Index = 13 then
  begin
      {$IFDEF USE_FLAGS} if Value
              then include( fFlagsG6, G6_DefaultBtn )
              else exclude( fFlagsG6, G6_DefaultBtn );
      {$ELSE} fDefaultBtn := Value; {$ENDIF}
      {$IFDEF DEFAULT_CANCEL_BTN_EXCLUSIVE}
          {$IFDEF USE_FLAGS} Exclude( fFlagsG6, G6_CancelBtn );
          {$ELSE} fCancelBtn := FALSE; {$ENDIF}
      {$ENDIF}
  end else
  if  Index = 27 then // this check is necessary still could be Index = 0 to reset both !
  begin
      {$IFDEF USE_FLAGS} if Value
              then include( fFlagsG6, G6_CancelBtn )
              else exclude( fFlagsG6, G6_CancelBtn );
      {$ELSE} fCancelBtn := Value; {$ENDIF}

      {$IFDEF DEFAULT_CANCEL_BTN_EXCLUSIVE}
          {$IFDEF USE_FLAGS} Exclude( fFlagsG6, G6_DefaultBtn );
          {$ELSE} fDefaultBtn := FALSE; {$ENDIF}
      {$ENDIF}
  end;
  if Applet = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  F := ParentForm;
  if F <> nil then
  begin
      C := nil;
      if  Value then C := @ Self;
      if  Index = 13 then
      begin
          F.PropInt[ @DFLT_BTN ] := Integer( C );
          {$IFDEF NO_DEFAULT_BUTTON_BOLD}
          {$ELSE}
          if  Value then
              Style := fStyle.Value or BS_DEFPUSHBUTTON
          else
              Style := fStyle.Value and not BS_DEFPUSHBUTTON;
          {$ENDIF}
      end
      else if Index = 27 then
          F.PropInt[ @CNCL_BTN ] := Integer( C );

      if  Value then
      begin
          if  @ Applet.EV.fOnMessage <> @ TControl.DefaultBtnProc  then
              Applet.EV.fOldOnMessage := Applet.EV.fOnMessage; // fixed by YS
          Applet.EV.fOnMessage := Applet.DefaultBtnProc;
      end else
      begin
          Applet.EV.fOnMessage := Applet.EV.fOldOnMessage;
          Applet.EV.fOldOnMessage :=
              {$IFDEF SAFEST_CODE} TOnMessage( MakeMethod( nil, @ DummyProc123_0 ) )
              {$ELSE}              nil {$ENDIF};
      end;
  end;
end;
{$ENDIF PAS_VERSION}

function TControl.GetDefaultBtn(const Index: Integer): Boolean;
begin
  CASE Index OF
  13 : Result := {$IFDEF USE_FLAGS} G6_DefaultBtn in fFlagsG6
                 {$ELSE} fDefaultBtn {$ENDIF};
  else Result := {$IFDEF USE_FLAGS} G6_CancelBtn in fFlagsG6
                 {$ELSE} fCancelBtn {$ENDIF};
  END;
end;

function TControl.AllBtnReturnClick: PControl;
{$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER}
begin
  // nothing: already implemented in WndProcBtnReturnClick
  Result := @ Self;
end;
{$ELSE}
var F: PControl;
begin
  {$IFDEF SAFE_CODE}
  if  {$IFDEF USE_FLAGS} [G3_IsForm, G3_IsApplet] * fFlagsG3 <> []
      {$ELSE} fIsForm or fIsApplet {$ENDIF} then
  {$ENDIF}
  begin
      SetDefaultBtn( 0, TRUE );
      F := ParentForm;
      if  F <> nil then
          F.DF.fAllBtnReturnClick := TRUE;
  end;
  Result := @ Self;
end;
{$ENDIF}

function WndProc_CNDrawItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer )
                          : Boolean;
type PDrawAction = ^TDrawAction;
     PDrawState = ^TDrawState;
var DI: PDrawItemStruct;
begin
  Result := FALSE;
  if Msg.message = CN_DRAWITEM then
  begin
    DI := Pointer( Msg.lParam );
    {$IFDEF NIL_EVENTS}
    if  Assigned( Sender.EV.fOnDrawItem ) then
    {$ENDIF}
    begin
        if Sender.EV.fOnDrawItem( Sender, DI.hDC, DI.rcItem, DI.itemID,
                           PDrawAction( @ DI.itemAction )^,
                           PDrawState( @ DI.itemState )^ )
        then Rslt := 1
        else Rslt := 0;
        Result := TRUE;
    end
    {$IFDEF NIL_EVENTS}
    else Rslt := 0
    {$ENDIF}
    ;
  end;
end;

procedure TControl.SetOnDrawItem(const Value: TOnDrawItem);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnDrawItem := Value;
  if  Parent <> nil then
      Parent.AttachProc( @WndProc_DrawItem );
  AttachProc( @WndProc_CNDrawItem );
end;

function WndProc_MeasureItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer )
                          : Boolean;
var MI: PMeasureItemStruct;
    Control: PControl;
    I: Integer;
begin
  Result := FALSE;
  if Msg.message = WM_MEASUREITEM then
  begin
    MI := Pointer( Msg.lParam );
    for I := 0 to Sender.ChildCount - 1 do
    begin
      Control := Sender.Children[ I ];
      if Control.Menu = MI.CtlID then
      begin
        {$IFDEF NIL_EVENTS}
        if  Assigned( Control.EV.fOnMeasureItem ) then
        {$ENDIF}
        begin
            MI.itemHeight := Control.EV.fOnMeasureItem( Control, MI.itemID );
            if  MI.itemHeight > 0 then
            begin
                Rslt := 1;
                Result := TRUE;
            end;
        end;
        break;
      end;
    end;
  end;
end;

procedure TControl.SetOnMeasureItem(const Value: TOnMeasureItem);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .fOnMeasureItem := Value;
  if Parent <> nil then
    Parent.AttachProc( @WndProc_MeasureItem );
end;

function TControl.GetItemData(Idx: Integer): DWORD;
begin
  Result := 0;
  if fCommandActions.aGetItemData <> 0 then
    Result := Perform( fCommandActions.aGetItemData, Idx, 0 );
end;

procedure TControl.SetItemData(Idx: Integer; const Value: DWORD);
begin
  if fCommandActions.aSetItemData <> 0 then
    Perform( fCommandActions.aSetItemData, Idx, Value );
end;

function TControl.GetLVCurItem: Integer;
begin
  Result := Perform( LVM_GETNEXTITEM, -1, LVNI_SELECTED );
end;

procedure TControl.SetLVCurItem(const Value: Integer);
begin
  if (lvoMultiselect in LVOptions) or (Value <> LVCurItem ) then
    LVItemState[ -1 ] := [ ];
  if Value >= 0 then
    LVItemState[ Value ] := [ lvisSelect, lvisFocus ];
end;

function TControl.LVNextItem(IdxPrev: Integer; Attrs: DWORD): Integer;
begin
  Result := Perform( LVM_GETNEXTITEM, IdxPrev, Attrs );
end;

function TControl.LVNextSelected(IdxPrev: Integer): Integer;
begin
  Result := Perform( LVM_GETNEXTITEM, IdxPrev, LVNI_SELECTED );
end;

function TControl.GetLVFocusItem: Integer;
begin
  Result := Perform( LVM_GETNEXTITEM, -1, LVNI_FOCUSED );
end;

procedure TControl.Close;
begin
  PostMessage( Handle, WM_CLOSE, 0, 0 );
end;

function WndProcMinimize( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Wnd: PControl;
begin
  Result := FALSE;
  if  (Msg.message = WM_SYSCOMMAND) and ((Msg.wParam and $FFF0) = SC_MINIMIZE)then
  begin
      if Applet <> nil then
      begin
        Wnd := Pointer( Applet.PropInt[ @MIN_WND ] ); // fMinimizeWnd;
        if  Wnd <> nil then
            SetWindowPos( Applet.Handle, 0, Wnd.Left, Wnd.Top, Wnd.Width, 0,
                          SWP_NOZORDER or SWP_NOREDRAW);
      end;
  end;
end;

function WndProcRestore( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
  Result := FALSE;
  CASE Msg.message OF
     WM_SHOWWINDOW:
               begin
                  case Msg.lParam of
                    SW_PARENTCLOSING:
                       begin
                          if IsIconic( Self_.fHandle ) then
                             Self_.DF.fShowAction := SW_SHOWMINNOACTIVE
                          else
                          if IsZoomed( Self_.fHandle ) then
                             Self_.DF.fShowAction := SW_SHOWMAXIMIZED
                          else
                             Self_.DF.fShowAction := SW_SHOWNOACTIVATE;
                       end;
                    SW_PARENTOPENING:
                       begin
                          if Self_.DF.fShowAction <> 0 then
                          begin
                             ShowWindow( Self_.fHandle, Self_.DF.fShowAction );
                             Self_.DF.fShowAction := 0;
                          end;
                          Rslt := 0;
                       end;
                  end;
               end;
  END;
end;

procedure TControl.MinimizeNormalAnimated;
var App: PControl;
begin
  App := Applet;
  if  App = nil then
      App := @Self;
  App.PropInt[ @MIN_WND ] // fMinimizeWnd
               := Integer( @Self );
  App.AttachProc( @WndProcMinimize );
  AttachProc( @WndProcRestore );
end;

procedure TControl.RestoreNormalMaximized;
begin
  AttachProc( @WndProcRestore );
end;

function WndProcDropFiles( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var hDrop: THandle;
    Pt: TPoint;
    FList: KOLString;
    I, N: Integer;
    Buf: array[ 0..MAX_PATH ] of KOLChar;
begin
  if  Msg.message = WM_DROPFILES then
  if  TMethod(Sender.EV.fOnDropFiles).Code <> nil then
  begin
      hDrop := Msg.wParam;
      DragQueryPoint( hDrop, Pt );
      N := DragQueryFile( hDrop, $FFFFffff, nil, 0 );
      FList := '';
      for I := 0 to N-1 do
      begin
        if FList <> '' then
          FList := FList + #13;
        DragQueryFile( hDrop, I, Buf, Sizeof( Buf ) );
        FList := FList + KOLString(Buf);
      end;
      DragFinish( hDrop );
      Sender.EV.FOnDropFiles( Sender, FList, Pt );
      Rslt := 0;
      Result := TRUE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  end;
  Result := FALSE;
end;

procedure TControl.SetOnDropFiles(const Value: TOnDropFiles);
begin
    {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
    .FOnDropFiles := Value;
    AttachProc( @WndProcDropFiles );
    DragAcceptFiles( GetWindowHandle, Assigned( Value ) );
end;

function WndProcShowHide( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var IsVisible: Boolean;
begin
  if Msg.message = WM_SHOWWINDOW then
  if Msg.hwnd = Sender.Handle then
  begin
    IsVisible := IsWindowVisible( Sender.Handle );
    if LongBool( Msg.wParam ) then
    begin
      {$IFDEF USE_FLAGS} include( Sender.fStyle.f3_Style, F3_Visible );
      {$ELSE}            Sender.fVisible := TRUE; {$ENDIF}
      if  not IsVisible then
      {$IFDEF NIL_EVENTS}
      if  Assigned( Sender.EV.FOnShow ) then
      {$ENDIF}
          Sender.EV.FOnShow( Sender );
    end else
    begin
      {$IFDEF USE_FLAGS} exclude( Sender.fStyle.f3_Style, F3_Visible );
      {$ELSE}            Sender.fVisible := FALSE; {$ENDIF}
      if  IsVisible then
      {$IFDEF NIL_EVENTS}
      if  Assigned( Sender.EV.FOnHide ) then
      {$ENDIF}
          Sender.EV.FOnHide( Sender );
    end;
  end;
  Sender.UpdateWndStyles;
  Result := FALSE;
end;

procedure TControl.SetOnHide(const Value: TOnEvent);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .FOnHide := Value;
  AttachProc( WndProcShowHide );
end;

procedure TControl.SetOnShow(const Value: TOnEvent);
begin
  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
  .FOnShow := Value;
  AttachProc( WndProcShowHide );
end;

function TControl.BringToFront: PControl;
begin
  SetWindowPos( GetWindowHandle, HWND_TOP, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or
                SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_SHOWWINDOW );
  Result := @Self;
end;

function TControl.SendToBack: PControl;
begin
  SetWindowPos( GetWindowHandle, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or
                SWP_NOACTIVATE or SWP_NOOWNERZORDER );
  Result := @Self;
end;

procedure TControl.DragStart;
begin
  PostMessage( GetWindowHandle, WM_SYSCOMMAND, $F012, 0 );
end;

function WndProcDragWindow( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var P: TPoint;
    Delta: DWORD;
    dX, dY: Integer;
begin
  if  Msg.message = WM_MOUSEMOVE then
  begin
      if  {$IFDEF USE_FLAGS} G6_Dragging in Sender.fFlagsG6
          {$ELSE} Sender.FDragging {$ENDIF} then
      begin
          GetCursorPos( P );
          Delta := Sender.PropInt[ @DRAG_XY ];
          dX := SmallInt( LoWord( Delta ) );
          dY := SmallInt( HiWord( Delta ) );
          P.x := P.x + dX; // - Sender.fMouseStartPos.x + Sender.fDragStartPos.x;
          P.y := P.y + dY; // - Sender.fMouseStartPos.y + Sender.fDragStartPos.y;
          Sender.Position := P;
      end;
  end;
  Result := FALSE;
end;

procedure TControl.DragStartEx;
var StartBounds: TRect;
    MSP: TPoint;
    dX, dY: Integer;
    Delta: Integer;
begin
  {$IFNDEF SMALLEST_CODE}
  if  {$IFDEF USE_FLAGS} G6_Dragging in fFlagsG6
      {$ELSE} fDragging {$ENDIF} then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  {$ENDIF}
  GetCursorPos( MSP );
  StartBounds := BoundsRect;
  dX := StartBounds.Left - MSP.X;
  dY := StartBounds.Top  - MSP.Y;
  Delta := (dX and $FFFF) or (dY shl 16);
  PropInt[ @DRAG_XY ] := Delta;
  SetCapture( GetWindowHandle );
  {$IFDEF USE_FLAGS} include( fFlagsG6, G6_Dragging );
  {$ELSE} fDragging := TRUE; {$ENDIF}
  AttachProc( WndProcDragWindow );
end;

procedure TControl.DragStopEx;
begin
  if  {$IFDEF USE_FLAGS} G6_Dragging in fFlagsG6
      {$ELSE} FDragging {$ENDIF} then
  begin
      ReleaseCapture;
      {$IFDEF USE_FLAGS} exclude( fFlagsG6, G6_Dragging );
      {$ELSE} FDragging := FALSE; {$ENDIF}
  end;
end;

function CallDragCallBack( Sender: PControl; var Stop: Boolean ): Boolean;
var P: TPoint;
    Shape, ShapeWas: Integer;
begin
  Sender.AttachProc( WndProcSetCursor );
  GetCursorPos( P );
  Shape := LoadCursor( 0, PKOLChar(IDC_HAND) );
  ShapeWas := Shape;
  Result := Sender.EV.fDragCallback( Sender, P.x, P.y, Shape, Stop );
  if not Stop then
  begin
    if not Result then
      if Shape = ShapeWas then
        Shape := LoadCursor( 0, IDC_NO );
    ScreenCursor := Shape;
  end
    else
  begin
    ScreenCursor := 0;
    Shape := Sender.fCursor;
  end;
  Windows.SetCursor( Shape );
end;

function WndProcDrag( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Stop: Boolean;
begin
  if  {$IFDEF USE_FLAGS} G6_Dragging in Sender.fFlagsG6
      {$ELSE} Sender.fDragging {$ENDIF} then
  begin
      Stop := FALSE;
      case Msg.message of
      WM_MOUSEMOVE:
        CallDragCallBack( Sender, Stop );
      WM_LBUTTONUP, WM_RBUTTONUP:
        begin
          Stop := TRUE;
          CallDragCallBack( Sender, Stop );
        end;
      else Result := FALSE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      if Stop then
      begin
        ReleaseCapture;
        {$IFDEF USE_FLAGS} exclude( Sender.fFlagsG6, G6_Dragging );
        {$ELSE} Sender.fDragging := FALSE; {$ENDIF}
      end else
      begin
        Result := TRUE; exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
  end;
  Result := FALSE;
end;

procedure TControl.DragItem(OnDrag: TOnDrag);
begin
  EV.fDragCallback := OnDrag;
  {$IFDEF USE_FLAGS} include( fFlagsG6, G6_Dragging );
  {$ELSE} fDragging := TRUE; {$ENDIF}
  SetCapture( GetWindowHandle );
  AttachProc( WndProcDrag );
end;

{$IFDEF USE_CONSTRUCTORS} //****************************************************//
                                                                                //
constructor TControl.CreateWindowed(AParent: PControl; AClassName: PKOLChar;       //
  ACtl3D: Boolean);                                                             //
begin                                                                           //
  CreateParented( AParent );                                                    //
  fOnDynHandlers := WndProcDummy;                                               //
  fWndProcKeybd := WndProcDummy;                                                //
  //{-2.95}//fWndProcResizeFlicks := WndProcDummy;                                         //
  fCommandActions.aClear := ClearText;                                          //
  //fWindowed := True; // is set in TControl.Init
  fControlClassName := AClassName;                                              //
                                                                                //
  fControlClick := DummyObjProc;                                                //
                                                                                //
  fColor := clBtnFace;                                                          //
  fTextColor := clWindowText;                                                   //
  fMargin := 2;                                                                 //
  fCtl3D := True;                                                               //
  fCtl3Dchild := True;                                                          //
  if AParent <> nil then                                                        //
  begin                                                                         //
     //{-2.95}//fWndProcResizeFlicks := AParent.fWndProcResizeFlicks;                      //
     fGotoControl := AParent.fGotoControl;                                      //
     {$IFDEF USE_FLAGS}
             exc fFlagsG2 := fFlagsG2 - [G2_DoubleBuffered, G2_Transparent] +
             (AParent.fFlagsG2 * [G2_DoubleBuffered, G2_Transparent]);
     {$ELSE} fDoubleBuffered := AParent.fDoubleBuffered;
             fTransparent := AParent.fTransparent;                                      //
     {$ENDIF}
     fCtl3Dchild := AParent.fCtl3Dchild;                                        //
     if   AParent.fCtl3Dchild then                                                //
          fCtl3D := ACtl3D                                                         //
     else fCtl3D := False;                                                         //
     fMargin := AParent.fMargin;                                                //
     with fBoundsRect do                                                        //
     begin                                                                      //
       Left := AParent.fMargin + AParent.fClientLeft;                           //
       Top  := AParent.fMargin + AParent.fClientTop;                            //
       Right := Left + 64;                                                      //
       Bottom := Top + 64;                                                      //
     end;                                                                       //
     fTextColor := AParent.fTextColor;                                          //
     fFont := fFont.Assign( AParent.fFont );                                    //
     if fFont <> nil then                                                       //
     begin                                                                      //
       fFont.fOnGTChange := FontChanged;                                          //
       FontChanged( fFont );                                                    //
     end;                                                                       //
     fColor := AParent.fColor;                                                  //
     fBrush := fBrush.Assign( AParent.fBrush );                                 //
     if fBrush <> nil then                                                      //
     begin                                                                      //
       fBrush.fOnGTChange := BrushChanged;                                        //
       BrushChanged( fBrush );                                                  //
     end;                                                                       //
  end;                                                                          //
end;                                                                            //
                                                                                //
constructor TControl.CreateApplet(const ACaption: AnsiString);                      //
begin                                                                           //
  AppButtonUsed := True;                                                        //
  CreateWindowed( nil, 'App', TRUE );                                           //
  {$IFDEF USE_FLAGS} include( fFlagsG3, G3_IsApplet );
  {$ELSE}            FIsApplet := TRUE; {$ENDIF}
  fStyle := WS_VISIBLE or WS_SYSMENU or WS_POPUP or WS_MINIMIZEBOX              //
    or WS_CAPTION;                                                              //
  fExStyle := WS_EX_APPWINDOW;                                                  //
  FCreateWndExt := CreateAppButton;                                             //
  AttachProc( WndProcApp );                                                     //
  Caption := ACaption;                                                          //
end;                                                                            //
                                                                                //
constructor TControl.CreateForm(AParent: PControl; const ACaption: AnsiString);     //
begin                                                                           //
  CreateWindowed( AParent, 'Form', TRUE );                                      //
  AttachProc( WndProcForm );                                                    //
  AttachProc( WndProcDoEraseBkgnd );                                            //
  Caption := ACaption;                                                          //
end;                                                                            //
                                                                                //
constructor TControl.CreateControl(AParent: PControl; AClassName: PAnsiChar;        //
  AStyle: DWORD; ACtl3D: Boolean; Actions: PCommandActions);                    //
var Form: PControl;                                                             //
begin                                                                           //
  CreateWindowed( AParent, AClassName, ACtl3D );                                //
  if Actions <> nil then                                                        //
    fCommandActions := Actions^;                                                //
  fIsControl := True;                                                           //
  fStyle := AStyle or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;                       //
  fVisible := (Style and WS_VISIBLE) <> 0;                                      //
  fTabstop := (Style and WS_TABSTOP) <> 0;                                      //
  if (AParent <> nil) then                                                      //
  begin                                                                         //
    Inc( AParent.ParentForm.fTabOrder );                                        //
    fTabOrder := AParent.ParentForm.fTabOrder;                                  //
  end;                                                                          //
  fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ];             //
  if fCtl3D then                                                                //
  begin                                                                         //
    fStyle := fStyle and not WS_BORDER;                                         //
    fExStyle := fExStyle or WS_EX_CLIENTEDGE;                                   //
  end;                                                                          //
  if (Style and WS_TABSTOP) <> 0 then                                           //
  begin                                                                         //
    Form := ParentForm;                                                         //
    if Form <> nil then                                                         //
    if Form.FCurrentControl = nil then                                          //
       Form.FCurrentControl := @Self;                                           //
  end;                                                                          //
  //fCreateParamsExt := CreateParams2;                                          //
  fMenu := CtlIdCount;                                                          //
  Inc( CtlIdCount );                                                            //
  AttachProc( WndProcCtrl );                                                    //
end;                                                                            //
                                                                                //
constructor TControl.CreateButton(AParent: PControl;                            //
  const ACaption: AnsiString);                                                      //
begin                                                                           //
  CreateControl( AParent, 'BUTTON',                                             //
            WS_VISIBLE or WS_CHILD or                                           //
            BS_PUSHLIKE or WS_TABSTOP, False, @ButtonActions );                 //
  with fBoundsRect do                                                           //
    Bottom := Top + 22;                                                         //
  fTextAlign := taCenter;                                                       //
  Caption := ACaption;                                                          //
end;                                                                            //
                                                                                //
constructor TControl.CreateBitBtn(AParent: PControl;                            //
  const ACaption: AnsiString; AOptions: TBitBtnOptions; ALayout: TGlyphLayout;      //
  AGlyphBitmap: HBitmap; AGlyphCount: Integer);                                 //
var                                                                             //
    B: TBitmapInfo;                                                             //
    W, H: Integer;                                                              //
begin                                                                           //
  CreateControl( AParent, 'BUTTON', WS_VISIBLE or WS_CHILD or                   //
            WS_TABSTOP or BS_OWNERDRAW, False, @ButtonActions );                //
  fBitBtnOptions := AOptions;                                                   //
  fGlyphLayout := ALayout;                                                      //
  fGlyphBitmap := AGlyphBitmap;                                                 //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Bottom := Top + 22;                                                         //
    W := 0; H := 0;                                                             //
    if AGlyphBitmap <> 0 then                                                   //
    begin                                                                       //
      if bboImageList in AOptions then                                          //
        ImageList_GetIconSize( AGlyphBitmap, W, H )                             //
      else                                                                      //
        begin                                                                   //
          if GetObject( AGlyphBitmap, Sizeof(B), @B ) > 0 then                  //
          begin                                                                 //
            W := B.bmiHeader.biWidth;                                           //
            H := B.bmiHeader.biHeight;                                          //
            if AGlyphCount = 0 then                                             //
              AGlyphCount := W div H;                                           //
            if AGlyphCount > 1 then                                             //
              W := W div AGlyphCount;                                           //
          end;                                                                  //
        end;                                                                    //
      if  W > 0 then                                                             //
          if   ACaption = '' then                                                   //
               Right := Left + W                                                     //
          else Right := Right + W;                                                   //
      if  H > 0 then                                                             //
          Bottom := Top + H;                                                      //
      if  not ( bboNoBorder in AOptions ) then                                   //
      begin                                                                     //
          if W > 0 then Inc( Right, 2 );                                                      //
          if H > 0 then Inc( Bottom, 2 );                                                     //
      end;                                                                      //
    end;                                                                        //
    fGlyphWidth := W;                                                           //
    fGlyphHeight := H;                                                          //
  end;                                                                          //
  fGlyphCount := AGlyphCount;                                                   //
  if AParent <> nil then                                                        //
    AParent.AttachProc( WndProc_DrawItem );                                     //
  AttachProc( WndProcBitBtn );                                                  //
  fTextAlign := taCenter;                                                       //
  Caption := ACaption;                                                          //
end;                                                                            //
                                                                                //
constructor TControl.CreateLabel(AParent: PControl;                             //
  const ACaption: AnsiString);                                                      //
begin                                                                           //
  CreateControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD or                   //
                         SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY,         //
                         False, @LabelActions );
  aAutoSzX := 1;
  aAutoSzY := 1;
  {$IFDEF USE_FLAGS} fFlagsG1 := fFlagsG1 + [G1_SizeRedraw, G1_IsStaticControl];
  {$ELSE} fSizeRedraw := True;
          fIsStaticControl := 1;                                                     //
  {$ENDIF}                                         //
  fBoundsRect.Bottom := fBoundsRect.Top + 22;                                   //
  Caption := ACaption;                                                          //
end;                                                                            //
                                                                                //
constructor TControl.CreateWordWrapLabel(AParent: PControl;                     //
  const ACaption: AnsiString);                                                      //
begin                                                                           //
  CreateLabel( AParent, ACaption );                                             //
  fBoundsRect.Bottom := fBoundsRect.Top + 44;                                   //
  fStyle := fStyle and not SS_LEFTNOWORDWRAP;                                   //
end;                                                                            //
                                                                                //
constructor TControl.CreateLabelEffect(AParent: PControl; ACaption: AnsiString;     //
  AShadowDeep: Integer);                                                        //
begin                                                                           //
  CreateLabel( AParent, ACaption );                                             //
  {$IFDEF USE_FLAGS} exclude( fFlagsG1, G1_IsStaticControl );
  {$ELSE} fIsStaticControl := 0; {$ENDIF}
  AttachProc( WndProcLabelEffect );                                             //
  fTextAlign := taCenter;                                                       //
  fTextColor := clBtnShadow;                                                    //
  fShadowDeep := AShadowDeep;                                                   //
  {$IFDEF USE_FLAGS} include( fFlagsG1, G1_IgnoreWndCaption );
  {$ELSE} fIgnoreWndCaption := True; {$ENDIF}                                   //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Bottom := Top + 40;                                                         //
  end;                                                                          //
end;                                                                            //
                                                                                //
constructor TControl.CreatePaintBox(AParent: PControl);                         //
begin                                                                           //
  CreateLabel( AParent, '' );                                                   //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Left + 40;                                                         //
    Bottom := Top + 40;                                                         //
  end;                                                                          //
end;                                                                            //
                                                                                //
{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal                                                                //
constructor TControl.CreateGradientPanel(AParent: PControl; AColor1,            //
  AColor2: TColor);                                                             //
begin                                                                           //
  CreateLabel( AParent, '' );                                                   //
  AttachProc( WndProcGradient );                                                //
  fColor2 := AColor2;                                                           //
  fColor1 := AColor1;                                                           //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Left + 40;                                                         //
    Bottom := Top + 40;                                                         //
  end;                                                                          //
end;                                                                            //
{$ENDIF PAS_VERSION}                                                                        //
                                                                                //
constructor TControl.CreateGradientPanelEx(AParent: PControl; AColor1,          //
  AColor2: TColor; AStyle: TGradientStyle; ALayout: TGradientLayout);           //
begin                                                                           //
  CreateLabel( AParent, '' );                                                   //
  AttachProc( WndProcGradientEx );                                              //
  fColor2 := AColor2;                                                           //
  fColor1 := AColor1;                                                           //
  fGradientStyle := AStyle;                                                     //
  fGradientLayout := ALayout;                                                   //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Left + 40;                                                         //
    Bottom := Top + 40;                                                         //
  end;                                                                          //
end;                                                                            //
                                                                                //
constructor TControl.CreateGroupbox(AParent: PControl;                          //
  const ACaption: AnsiString);                                                      //
begin                                                                           //
  CreateButton( AParent, ACaption );                                            //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Left + 100;                                                        //
    Bottom := Top + 100;                                                        //
  end;                                                                          //
  fStyle := WS_VISIBLE or WS_CHILD or BS_GROUPBOX or WS_TABSTOP;                //
  fClientTop := 22;                                                             //
  fClientLeft := 2;                                                             //
  fClientBottom := 2;                                                           //
  fClientRight := 2;                                                            //
  fTabstop := False;                                                            //
end;                                                                            //
                                                                                //
constructor TControl.CreateCheckbox(AParent: PControl;                          //
  const ACaption: AnsiString);                                                      //
begin                                                                           //
  CreateButton( AParent, ACaption );                                            //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Left + 72;                                                         //
  end;                                                                          //
  fStyle := WS_VISIBLE or WS_CHILD or                                           //
            BS_AUTOCHECKBOX or WS_TABSTOP;                                      //
end;                                                                            //
                                                                                //
constructor TControl.CreateRadiobox(AParent: PControl;                          //
  const ACaption: AnsiString);                                                      //
begin                                                                           //
  CreateCheckbox( AParent, ACaption );                                          //
  fStyle := WS_VISIBLE or WS_CHILD or                                           //
            BS_RADIOBUTTON or WS_TABSTOP or WS_GROUP;                           //
  fControlClick := ClickRadio;                                                  //
  if AParent <> nil then                                                        //
  begin                                                                         //
    AParent.fRadioLast := fMenu;                                                //
    if AParent.fRadio1st = 0 then                                               //
    begin                                                                       //
       AParent.fRadio1st := fMenu;                                              //
       SetRadioChecked;                                                         //
    end;                                                                        //
  end;                                                                          //
end;                                                                            //
                                                                                //
constructor TControl.CreateEditbox(AParent: PControl;                           //
  AOptions: TEditOptions);                                                      //
var Flags: Integer;                                                             //
begin                                                                           //
  Flags := MakeFlags( @AOptions, EditFlags );                                   //
  if not(eoMultiline in AOptions) then                                          //
     Flags := Flags and not(WS_HSCROLL or WS_VSCROLL);                          //
  CreateControl( AParent, 'EDIT', WS_VISIBLE or WS_CHILD or WS_TABSTOP          //
                         or WS_BORDER or Flags, True, @EditActions );           //
  aAutoSzY := 6;
//YS  fCursor := LoadCursor( 0, IDC_IBEAM );                                      // //YS
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Left + 100;                                                        //
    Bottom := Top + 22;                                                         //
    if eoMultiline in AOptions then                                             //
    begin                                                                       //
       Right := Right + 100;                                                    //
       Bottom := Top + 200;                                                     //
    end;                                                                        //
  end;                                                                          //
  fColor := clWindow;                                                           //
  fLookTabKeys := [ tkTab, tkUpDown, tkPageUpPageDn ];                          //
  if  eoMultiline in AOptions then                                               //
      fLookTabKeys := [ tkTab ];                                                 //
  if  eoWantTab in AOptions then                                                 //
      exclude( fLookTabKeys, tkTab );
end;                                                                            //
                                                                                //
constructor TControl.CreatePanel(AParent: PControl; AStyle: TEdgeStyle);        //
begin                                                                           //
  CreateControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD or                   //
                         SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY, False,  //
                         @LabelActions );
  aAutoSzX := 1;
  aAutoSzY := 1;
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Left + 100;                                                        //
    Bottom := Top + 100;                                                        //
  end;                                                                          //
  Style := Style or Edgestyles[ AStyle ];                                       //
  ExStyle := ExStyle or WS_EX_CONTROLPARENT;                                    //
end;                                                                            //
                                                                                //
constructor TControl.CreateSplitter(AParent: PControl; AMinSizePrev,            //
  AMinSizeNext: Integer; EdgeStyle: TEdgeStyle);                                //
var PrevCtrl: PControl;                                                         //
    Sz0: Integer;                                                               //
begin                                                                           //
  CreatePanel( AParent, EdgeStyle );                                            //
  fSplitMinSize1 := AMinSizePrev;                                               //
  fSplitMinSize2 := AMinSizeNext;                                               //
  Sz0 := 4;                                                                     //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Left + Sz0;                                                        //
    Bottom := Top + Sz0;                                                        //
  end;                                                                          //
  if AParent <> nil then                                                        //
  begin                                                                         //
    if AParent.fChildren.fCount > 1 then                                        //
    begin                                                                       //
      PrevCtrl := AParent.fChildren.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ AParent.fChildren.fCount - 2 ];     //
      case PrevCtrl.FAlign of                                                   //
      caLeft, caRight:                                                          //
        begin                                                                   //
          fCursor := LoadCursor( 0, IDC_SIZEWE );                               //
        end;                                                                    //
      caTop, caBottom:                                                          //
        begin                                                                   //
          fCursor := LoadCursor( 0, IDC_SIZENS );                               //
        end;                                                                    //
      end;                                                                      //
      Align := PrevCtrl.FAlign;                                                 //
    end;                                                                        //
  end;                                                                          //
  AttachProc( WndProcSplitter );                                                //
end;                                                                            //
                                                                                //
constructor TControl.CreateListbox(AParent: PControl;                           //
  AOptions: TListOptions);                                                      //
var Flags: Integer;                                                             //
begin                                                                           //
  Flags := MakeFlags( @AOptions, ListFlags );                                   //
  CreateControl( AParent, 'LISTBOX', WS_VISIBLE or WS_CHILD or WS_TABSTOP       //
                 or WS_BORDER or WS_VSCROLL                                     //
                 or LBS_NOTIFY or Flags, True, @ListActions );                  //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Right + 100;                                                       //
    Bottom := Top + 200;                                                        //
  end;                                                                          //
  fColor := clWindow;                                                           //
  fLookTabKeys := [ tkTab, tkLeftRight ];                                       //
end;                                                                            //
                                                                                //
constructor TControl.CreateCombobox(AParent: PControl;                          //
  AOptions: TComboOptions);                                                     //
var Flags: Integer;                                                             //
begin                                                                           //
  Flags := MakeFlags( @AOptions, ComboFlags );                                  //
  CreateControl( AParent, 'COMBOBOX',                                           //
                 WS_VISIBLE or WS_CHILD or WS_VSCROLL or                        //
                 CBS_DROPDOWN or CBS_HASSTRINGS or WS_TABSTOP or Flags,         //
                 True, @ComboActions );                                         //
  aAutoSzY := 6;
  fCreateWndExt := CreateComboboxWnd;                                           //
  //fDropDownProc := ComboboxDropDown;                                            //
  fClsStyle := fClsStyle or CS_DBLCLKS;                                         //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Left + 100;                                                        //
    Bottom := Top + 22;                                                         //
  end;                                                                          //
  fColor := clWindow;                                                           //
  fLookTabKeys := [ tkTab ];                                                    //
  if coReadOnly in AOptions then                                                //
    fLookTabKeys := [ tkTab, tkLeftRight ];                                     //
end;                                                                            //
                                                                                //
constructor TControl.CreateCommonControl(AParent: PControl;                     //
  AClassName: PAnsiChar; AStyle: DWORD; ACtl3D: Boolean;                            //
  Actions: PCommandActions);                                                    //
begin                                                                           //
  {*************} DoInitCommonControls( ICC_WIN95_CLASSES );                      //
  CreateControl( AParent, AClassName, AStyle, ACtl3D, Actions );                //
  {$IFDEF USE_FLAGS} include( fFlagsG2, G2_IsCommonCtl );
  {$ELSE} fIsCommonControl := True; {$ENDIF}
  if AParent <> nil then                                                        //
  begin                                                                         //
    AttachProc( WndProcParentResize );                                          //
    AParent.AttachProc( WndProcResize );                                        //
    AttachProc( WndProcCommonNotify );                                          //
    AParent.AttachProc( WndProcNotify );                                        //
  end;                                                                          //
end;                                                                            //
                                                                                //
constructor TControl.CreateRichEdit1(AParent: PControl;                         //
  AOptions: TEditOptions);                                                      //
var Flags, I: Integer;                                                          //
begin                                                                           //
  if FRichEditModule = 0 then                                                   //
  begin                                                                         //
    for I := 0 to High( RichEditLibnames ) do                                                          //
    begin                                                                       //
      FRichEditModule := LoadLibrary( RichEditLibnames[ I ] );                  //
      if FRichEditModule > HINSTANCE_ERROR then break;                          //
      RichEditClass := RichEditClasses[ I ];                                              //
    end;                                                                        //
    if FRichEditModule <= HINSTANCE_ERROR then                                  //
      FRichEditModule := 0;                                                     //
  end;                                                                          //
  Flags := MakeFlags( @AOptions, RichEditFlags );                               //
  CreateCommonControl( AParent, RichEditClass, WS_VISIBLE or WS_CHILD           //
                       or WS_TABSTOP or WS_BORDER or ES_MULTILINE or Flags,     //
                       True, @RichEditActions );                                //
                                                                                //
  AttachProc( WndProcRichEditNotify );                                          //
  {$IFDEF USE_FLAGS} exclude( fFlagsG2, G2_DoubleBuffered );
  {$ELSE} fDoubleBuffered := False; {$ENDIF}
  {$IFDEF USE_FLAGS} include( fFlagsG1, G1_CanNotDoublebuf );
  {$ELSE} fCannotDoubleBuf := True; {$ENDIF}                                    //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Right + 100;                                                       //
    Bottom := Top + 200;                                                        //
  end;                                                                          //
  fColor := clWindow;                                                           //
  fLookTabKeys := [ tkTab ];                                                    //
  if eoWantTab in AOptions then                                                 //
     fLookTabKeys := [ ];                                                       //
  Perform( EM_SETEVENTMASK, 0,                                                  //
    ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or                         //
    ENM_PROTECTED or $04000000 {ENM_LINK} );                                    //
  Perform( EM_SETBKGNDCOLOR, 0, Color2RGB(fColor));                             //
end;                                                                            //
                                                                                //
constructor TControl.CreateRichEdit(AParent: PControl;                          //
  AOptions: TEditOptions);                                                      //
var OldRichEditClass, OldRichEditLib: PAnsiChar;                                    //
begin                                                                           //
  if  OleInit then                                                               //
  begin                                                                         //
      OldRichEditClass := RichEditClass;                                          //
      OldRichEditLib := RichEditLib;                                              //
      CreateRichEdit1( AParent, AOptions );                                       //
      fCharFmtDeltaSz := 24;                                                      //
      fParaFmtDeltaSz := sizeof( TParaFormat2 ) - sizeof( RichEdit.TParaFormat ); //
      RichEditClass := OldRichEditClass;                                          //
      RichEditLib := OldRichEditLib;                                              //
  end else                                                                       //
      CreateRichEdit1( AParent, AOptions );                                       //
end;                                                                            //
                                                                                //
constructor TControl.CreateProgressbar(AParent: PControl);                      //
const ProgressBarFlags: array[ TProgressbarOption ] of Integer =                //
      (PBS_VERTICAL, PBS_SMOOTH );                                              //
begin                                                                           //
  CreateCommonControl( AParent, PROGRESS_CLASS,                                 //
            WS_CHILD or WS_VISIBLE, True, nil );                                //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Left + 300;                                                        //
    Bottom := Top + 20;                                                         //
  end;                                                                          //
  fMenu := 0;                                                                   //
  fTextColor := clHighlight;                                                    //
end;                                                                            //
                                                                                //
constructor TControl.CreateProgressbarEx(AParent: PControl;                     //
  AOptions: TProgressbarOptions);                                               //
const ProgressBarFlags: array[ TProgressbarOption ] of Integer =                //
      (PBS_VERTICAL, PBS_SMOOTH );                                              //
begin                                                                           //
  CreateProgressbar( AParent );                                                 //
  fStyle := fStyle or DWORD( MakeFlags( @AOptions, ProgressBarFlags ) );        //
end;                                                                            //
                                                                                //
constructor TControl.CreateListView(AParent: PControl;                          //
  AStyle: TListViewStyle; AOptions: TListViewOptions; AImageListSmall,          //
  AImageListNormal, AImageListState: PImageList);                               //
begin                                                                           //
  CreateCommonControl( AParent, WC_LISTVIEW, ListViewStyles[ AStyle ] or        //
                 LVS_SHAREIMAGELISTS or WS_CHILD or WS_VISIBLE or WS_TABSTOP,   //
                 True, @ListViewActions );                                      //
  fLVOptions := AOptions;                                                       //
  fLVStyle := AStyle;                                                           //
  fCreateWndExt := ApplyImageLists2ListView;                                    //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Left + 200;                                                        //
    Bottom := Top + 150;                                                        //
  end;                                                                          //
  ImageListSmall := AImageListSmall;                                            //
  ImageListNormal := AImageListNormal;                                          //
  ImageListState := AImageListState;                                            //
  fLVTextBkColor := clWindow;                                                   //
  fLookTabKeys := [ tkTab ];                                                    //
end;                                                                            //
                                                                                //
constructor TControl.CreateTreeView(AParent: PControl;                          //
  AOptions: TTreeViewOptions; AImgListNormal, AImgListState: PImageList);       //
var Flags: Integer;                                                             //
begin                                                                           //
  Flags := MakeFlags( @AOptions, TreeViewFlags );                               //
  CreateCommonControl( AParent, WC_TREEVIEW, Flags or WS_VISIBLE or             //
            WS_CHILD or WS_TABSTOP, True, @TreeViewActions );                   //
  fCreateWndExt := ApplyImageLists2Control;                                     //
  fColor := clWindow;                                                           //
  AttachProc( WndProcTreeView );                                                //
  with fBoundsRect do                                                           //
  begin                                                                         //
    Right := Left + 150;                                                        //
    Bottom := Top + 200;                                                        //
  end;                                                                          //
  ImageListNormal := AImgListNormal;                                            //
  ImageListState := AImgListState;                                              //
  fLookTabKeys := [ tkTab ];                                                    //
end; ///////////////////////////////////////////////////////////////////////////
constructor TControl.CreateTabControl(AParent: PControl; ATabs: array of String;//
         AOptions: TTabControlOptions;                                          //
         AImgList: PImageList; AImgList1stIdx: Integer);                        //
var I, II : Integer;                                                            //
    Flags: Integer;                                                             //
begin Flags := MakeFlags( @AOptions, TabControlFlags );                             //
      if tcoFocusTabs in AOptions then                                              //
        Flags := Flags or (WS_TABSTOP or TCS_FOCUSONBUTTONDOWN);                    //
      CreateCommonControl( AParent, WC_TABCONTROL,                                  //
                Flags or (WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or         //
                WS_VISIBLE), True, @TabControlActions );                            //
      if not( tcoBorder in AOptions ) then                                           //
        fExStyle := fExStyle and not WS_EX_CLIENTEDGE;                              //
      AttachProc( WndProcTabControl );                                              //
      with fBoundsRect do                                                           //
      begin                                                                         //
        Right := Left + 100;                                                        //
        Bottom := Top + 100;                                                        //
      end;                                                                          //
      if AImgList <> nil then                                                       //
        Perform( TCM_SETIMAGELIST, 0, AImgList.Handle );                            //
      II := AImgList1stIdx;                                                         //
      for I := 0 to High( ATabs ) do                                                //
      begin                                                                         //
        TC_Insert( I, ATabs[ I ], II );                                             //
        Inc( II );                                                                  //
      end;                                                                          //
      fLookTabKeys := [ tkTab ];                                                    //
end; ///////////////////////////////////////////////////////////////////////////
constructor TControl.CreateToolbar(AParent: PControl;                           //
  AAlign: TControlAlign; AOptions: TToolbarOptions; ABitmap: HBitmap;           //
  AButtons: array of PAnsiChar; ABtnImgIdxArray: array of Integer);             //
var Flags: DWORD;                                                               //
begin                                                                           //
  if  not( tboTextBottom in AOptions ) then                                      //
      include( AOptions, tboTextRight );
  if  tboTextRight in AOptions then                                              //
      exclude( AOptions, tboTextBottom );
  Flags := MakeFlags( @AOptions, ToolbarOptions );                              //
  CreateCommonControl( AParent, TOOLBARCLASSNAME, ToolbarAligns[ Align ] or     //
                       WS_CHILD or WS_VISIBLE {or WS_TABSTOP}                   //
                       or TBSTYLE_TOOLTIPS or Flags,                            //
                       (not (Align in [caNone])) and                            //
                        not (tboNoDivider in AOptions),  nil );                 //
  fCommandActions.aClear := ClearToolbar;                                       //
  fCommandActions.aGetCount := TB_BUTTONCOUNT;                                  //
  with fBoundsRect do                                                           //
  begin if AAlign in [ caNone ] then                                                //
        begin Bottom := Top + 26;                                                       //
              Right := Left + 1000;                                                     //
        end else                                                                     //
        begin Left := 0; Right := 0;                                                    //
              Top := 0; Bottom := 0;                                                    //
        end;                                                                        //
  end;                                                                          //
  Perform(TB_SETEXTENDEDSTYLE, 0, Perform(TB_GETEXTENDEDSTYLE, 0, 0) or         //
      TBSTYLE_EX_DRAWDDARROWS);                                                 //
  AttachProc( WndProcToolbarCtrl );                                             //
  Perform( TB_BUTTONSTRUCTSIZE, Sizeof( TTBButton ), 0 );                       //
  Perform( TB_SETINDENT, fMargin, 0 );                                          //
  with fBoundsRect do                                                           //
  begin                                                                         //
    if AAlign in [ caLeft, caRight ] then                                       //
      Right := Left + 24                                                        //
    else if not (AAlign in [caNone]) then                                       //
      Bottom := Top + 22;                                                       //
  end;                                                                          //
  if ABitmap <> 0 then                                                          //
    TBAddBitmap( ABitmap );                                                     //
  TBAddButtons( AButtons, ABtnImgIdxArray );                                    //
  Perform( WM_SIZE, 0, 0 );                                                     //
end; ///////////////////////////////////////////////////////////////////////////
constructor TImageList.CreateImageList(POwner: Pointer);                        //
var AOwner: PControl;                                                           //
begin {*************} DoInitCommonControls( ICC_WIN95_CLASSES );                    //
      Create;                                                                       //
      FAllocBy := 1;                                                                //
      FMasked := True;                                                              //
      if POwner = nil then exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      FBkColor := TColor( CLR_NONE );
      AOwner := POwner;                                                             //
      FControl := AOwner;                                                           //
      fNext := PImageList( AOwner.fImageList );                                     //
      if AOwner.fImageList <> nil then                                              //
         PImageList( AOwner.fImageList ).fPrev := @Self;                            //
      AOwner.fImageList := @Self;                                                   //
end;////////////////////////////////////////////////////////////////////////////
constructor TThread.ThreadCreate;                                               //
begin IsMultiThread := True;                                                        //
      Create;                                                                       //
      FSuspended := True;                                                           //
      FHandle := CreateThread( nil, // no security                                  //
                              0,   // the same stack size                           //
                              @ThreadFunc, // thread entry point                    //
                              @Self,      // parameter to pass to ThreadFunc        //
                              CREATE_SUSPENDED,   // always SUSPENDED               //
                              FThreadID ); // receive thread ID                     //
end;////////////////////////////////////////////////////////////////////////////
constructor TThread.ThreadCreateEx( const Proc: TOnThreadExecute );             //
begin                                                                           //
  ThreadCreate;                                                                 //
  OnExecute := Proc;                                                            //
  Resume;                                                                       //
end;                                                                            //
{$ENDIF USE_CONSTRUCTORS} //****************************************************//
procedure InvalidateExW( Wnd: HWnd );
begin InvalidateRect( Wnd, nil, TRUE );
      Wnd := GetWindow( Wnd, GW_CHILD );
      while Wnd <> 0 do
      begin
        InvalidateExW( Wnd );
        Wnd := GetWindow( Wnd, GW_HWNDNEXT );
      end;
end; ///////////////////////////////////////////////////////////////////////////
procedure TControl.InvalidateEx;
begin if fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      InvalidateExW( fHandle );
end; ///////////////////////////////////////////////////////////////////////////
procedure InvalidateNCW( Wnd: HWnd; Recursive: Boolean );
begin SendMessage( Wnd, WM_NCPAINT, 1, 0 );
      if not Recursive then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      Wnd := GetWindow( Wnd, GW_CHILD );
      while Wnd <> 0 do
      begin
        InvalidateNCW( Wnd, Recursive );
        Wnd := GetWindow( Wnd, GW_HWNDNEXT );
      end;
end; ///////////////////////////////////////////////////////////////////////////
procedure TControl.InvalidateNC(Recursive: Boolean);
begin
  if fHandle = 0 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  InvalidateNCW( fHandle, Recursive );
end; ///////////////////////////////////////////////////////////////////////////
procedure TControl.SetClientMargin(const Index: Integer; Value: ShortInt);
begin
  case Index of
  1: fClientTop := Value;
  2: fClientBottom := Value;
  3: fClientLeft := Value;
  4: fClientRight := Value;
  end;
  {$IFNDEF OLD_ALIGN}include(fAligning,oaFromSelf);{$ENDIF}//???
  Global_Align( @Self );
end;
{$IFDEF F_P}
function TControl.GetClientMargin(const Index: Integer): ShortInt;
begin
  CASE Index OF
  1: Result := fClientTop;
  2: Result := fClientBottom;
  3: Result := fClientLeft;
  4: Result := fClientRight;
  END;
end;
{$ENDIF F_P}
{------------------------------------------------------------------------------}
{                        G R A P H   C O N T R O L S                           }
{------------------------------------------------------------------------------}
type TGrayTextData = packed record
       Ctl: PControl;
       W, H: Integer;
       Flags: DWORD;
     end;
     PGrayTextData = ^TGrayTextData; ///////////////////////////////////////////
function DrawTextGrayed( DC: HDC; lData, wData, cX, cY: Integer ): BOOL; stdcall;
var GDT: PGrayTextData;
    R: TRect;
begin
  GDT := Pointer( lData );
  R := MakeRect( 0, 0, cX, cY );
  DrawFormattedText( GDT.Ctl, DC, R, GDT.Flags or $80000000 );
  Result := TRUE;
end; ///////////////////////////////////////////////////////////////////////////
procedure DrawFormattedText( Ctl: PControl; DC: HDC; var R: TRect; Flags: DWORD {EditCtl: Boolean} );
var Fmt: DWORD;
    OldFont: Integer;
    OldBrush: Integer;
    OldBk: Integer;
    ParentHavingFont: PControl;
    GTD: TGrayTextData;
    dX, dY: Integer;
    R1: TRect;
begin Fmt := DT_EXPANDTABS or Flags and $7FFFFFFF;
  if  Ctl.WordWrap then
      Fmt := Fmt or DT_WORDBREAK;
  if  Flags and DT_EDITCONTROL <> 0 then
      Inc( R.Left, 4 );
  ParentHavingFont := Ctl;
  while (ParentHavingFont <> nil) and ( ParentHavingFont.FFont = nil )
        and {$IFDEF USE_FLAGS} not(G3_IsForm in ParentHavingFont.fFlagsG3)
            {$ELSE} not ParentHavingFont.IsForm {$ENDIF} do
      ParentHavingFont := ParentHavingFont.Parent;
  OldFont := 0;
  if  ( ParentHavingFont <> nil ) then
  begin OldFont := SelectObject( DC, ParentHavingFont.Font.Handle );
        SetTextColor( DC, ParentHavingFont.Font.FColorRGB );
  end;
  R1 := R;
  {$IFDEF UNICODE_CTRLS}Windows.DrawTextW
  {$ELSE}               Windows.DrawTextA
  {$ENDIF}( DC, PKOLChar( Ctl.Caption ), Length( Ctl.Caption ), R,
    Fmt or DT_CALCRECT ); // TODO: fixme (Length('kanji') != WStrLen('kanji'))
  CASE Ctl.fTextAlign OF
  taCenter: dX := (R1.Right - R1.Left - (R.Right - R.Left)) div 2;
  taRight:  dX := R1.Right - R.Right;
  else      dX := 0;
  END;
  CASE Ctl.fVerticalAlign OF
  vaCenter: dY := (R1.Bottom - R1.Top - (R.Bottom - R.Top)) div 2;
  vaBottom: dY := R1.Bottom - R.Bottom;
  else      dY := 0;
  END;
  OffsetRect( R, dX, dY );
  if  {$IFDEF USE_FLAGS} not(F3_Disabled in Ctl.fStyle.f3_Style)
      {$ELSE}            Ctl.fEnabled {$ENDIF}
  or (Flags and $80000000 <> 0) then
  begin OldBk := SetBkMode( DC, TRANSPARENT );
        OldBrush := SelectObject( DC, GetStockObject( NULL_BRUSH ) );
        {$IFDEF UNICODE_CTRLS}Windows.DrawTextW
        {$ELSE}               Windows.DrawTextA
        {$ENDIF}( DC, PKOLChar( Ctl.Caption ), Length( Ctl.Caption ), R, Fmt );
        SelectObject( DC, OldBrush );
        SetBkMode( DC, OldBk );
  end else
  begin GTD.Ctl := Ctl;
        GTD.W := R.Right - R.Left;
        GTD.H := R.Bottom - R.Top;
        GTD.Flags := Flags;
        Windows.DrawState( DC, GetStockObject( NULL_BRUSH ), @ DrawTextGrayed,
          Integer( @ GTD ), Length( Ctl.fCaption ), R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
          DST_COMPLEX or DSS_DISABLED );
  end;
  if  ( ParentHavingFont <> nil ) then
      SelectObject( DC, OldFont );
end;

{$IFDEF USE_GRAPHCTLS}
{$IFDEF GRAPHCTL_XPSTYLES}
type TOpenThemeDataProc = function( Wnd: HWnd; pszClassList: PWideChar ): THandle;
                          stdcall;
     TDrawThemeBackground = function( Theme: THandle; DC: HDC; iPartId: Integer;
                          iStateId: Integer; Rect, ClipRect: PRect ): Integer;
                          stdcall;
     TGetThemeBackgroundContentRect = function( Theme: THandle; DC: HDC;
                          iPartId, iStateId: Integer; Rect, ContentRect: PRect ):
                          Integer; stdcall;
     TDrawThemeText = function( Theme: THandle; DC: HDC; iPartId, iStateId: Integer;
                          pszText: PWideChar; iCharCount: Integer;
                          dwTextFlags, dwTextFlags2: DWORD; Rect: PRect ): Integer;
                          stdcall;
     TCloseThemeData = function( Theme: THandle ): Integer; stdcall;
var fOpenThemeDataProc: TOpenThemeDataProc;
    fDrawthemeBackground: TDrawThemeBackground;
    fGetThemeBackgroundcontentRect: TGetThemeBackgroundContentRect;
    fDrawThemeText: TDrawThemeText;
    fCloseThemeData: TCloseThemeData;
    uxtheme_lib: THandle;
function OpenThemeDataProc: TOpenThemeDataProc;
begin Result := nil;
      if Integer(uxtheme_lib) = -1 then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      if uxtheme_lib = 0 then
         uxtheme_lib := LoadLibrary( 'uxtheme' );
      if uxtheme_lib = 0 then
      begin uxtheme_lib := DWORD( -1 ); Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
      fOpenThemeDataProc := GetProcAddress( uxtheme_lib, 'OpenThemeData' );
      fDrawthemeBackground := GetProcAddress( uxtheme_lib, 'DrawThemeBackground' );
      fGetThemeBackgroundcontentRect := GetProcAddress( uxtheme_lib, 'GetThemeBackgroundContentRect' );
      fDrawThemeText := GetProcAddress( uxtheme_lib, 'DrawThemeText' );
      fCloseThemeData := GetProcAddress( uxtheme_lib, 'CloseThemeData' );
      if not Assigned( fOpenThemeDataProc ) or
         not Assigned( fDrawThemeBackground ) or
         not Assigned( fGetThemeBackgroundcontentRect ) or
         not Assigned( fDrawThemeText ) or
         not Assigned( fCloseThemeData ) then
      begin
        FreeLibrary( uxtheme_lib );
        uxtheme_lib := DWORD( -1 );
        fOpenThemeDataProc := nil;
        fDrawThemeBackground := nil;
        fGetThemeBackgroundcontentRect := nil;
        fDrawThemeText := nil;
        fCloseThemeData := nil;
      end;
      Result := fOpenThemeDataProc;
end;

procedure DrawFormattedTextXP( Theme: THandle; Ctl: PControl; DC: HDC;
  var R: TRect; CtlType, CtlStates, Flags1, Flags2: Integer );
var OldFont: Integer;
    OldBrush: Integer;
    ParentHavingFont: PControl;
begin ParentHavingFont := Ctl;
  while (ParentHavingFont <> nil) and ( ParentHavingFont.FFont = nil )
        and {$IFDEF USE_FLAGS} not(G3_IsForm in ParentHavingFont.fFlagsG3)
            {$ELSE} not ParentHavingFont.IsForm {$ENDIF} do
    ParentHavingFont := ParentHavingFont.Parent;
  OldFont := 0;
  if  ( ParentHavingFont <> nil ) then
      OldFont := SelectObject( DC, ParentHavingFont.Font.Handle );
  OldBrush := SelectObject( DC, GetStockObject( NULL_BRUSH ) );
  fDrawThemeText( Theme, DC, CtlType, CtlStates, @ KOLWideString( Ctl.fCaption )[ 1 ],
                  Length( Ctl.fCaption ), Flags1, Flags2, @ R );
  SelectObject( DC, OldBrush );
  if  ( ParentHavingFont <> nil ) then SelectObject( DC, OldFont );
end;
{$ENDIF}

procedure PaintGraphicChildren( Self_, _Sender: PControl; DC: HDC );
var i, sav: Integer;
    C: PControl;
    R: TRect;
    rgn: HRgn;
begin
  for i := Self_.ChildCount-1 downto 0 do
  begin
    C := Self_.Children[ i ];
    if not C.Visible then continue;
    R := C.BoundsRect;
    if  (C.Handle = 0)
    and {$IFDEF USE_FLAGS} (G6_GraphicCtl in C.fFlagsG6)
        {$ELSE} not C.fWindowed {$ENDIF}
    {$IFDEF SAFE_CODE} and Assigned( C.EV.fPaintProc ) {$ENDIF} then
    begin
      sav := SaveDC( DC );
      rgn := CreateRectRgnIndirect( R );
      ExtSelectClipRgn( DC, rgn, RGN_AND );
      SelectClipRgn( DC, rgn );
      DeleteObject( rgn );
      Free_And_Nil( C.fCanvas );
      C.fCanvas := Self_.Canvas;
      Self_.Canvas.Brush.Assign( Self_.Brush );
      Self_.Canvas.Font.Assign( Self_.Font ); // íå ïðèñâàèâàåòñÿ?
      Self_.fCanvas.DeselectHandles;          // íå ïîìîãàåò???
      {$IFDEF NIL_EVENTS}
      if  Assigned( C.EV.fOnPrepaint ) then
      {$ENDIF}
          C.EV.fOnPrePaint( C, DC );
      C.EV.fPaintProc( DC );
      if  Assigned( C.EV.fOnPaint ) then
          C.EV.fOnPaint( C, DC );
      {$IFDEF NIL_EVENTS}
      if  Assigned( C.EV.fOnPostPaint ) then
      {$ENDIF}
          C.EV.fOnPostPaint( C, DC );
      C.fCanvas := nil;
      Self_.Canvas.Brush.Assign( Self_.Brush );
      Self_.Canvas.Font.Assign( Self_.Font );
      RestoreDC( DC, sav );
      ExcludeClipRect( DC, R.Left, R.Top, R.Right, R.Bottom );
    end;
  end;
  if  {$IFDEF USE_FLAGS} G5_IsGroupbox in Self_.fFlagsG5
      {$ELSE} Self_.fIsGroupBox {$ENDIF} then
  begin
      Self_.DF.fErasingBkgnd := TRUE;
      R := Self_.BoundsRect;
      OffsetRect( R, -R.Left, -R.Top );
      Self_.Canvas.FillRect( R );
      Self_.GroupBoxPaint( DC );
      Self_.DF.fErasingBkgnd := FALSE;
  end else
  if   Assigned( Self_.EV.fOnPaint2 ) then
       Self_.EV.fOnPaint2( Self_, DC )
  else Self_.Canvas.FillRect( Self_.ClientRect );
end;

function WndProc_ParentOfGraphicCtl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var WasOnPaint: TOnPaint;
    i: Integer;
    C: PControl;
    Pt: TPoint;
    PF: PControl;
    save_Paint2: TOnPaint;
begin
  Result := FALSE;
  if (Msg.message = WM_PAINT) {or (Msg.message = WM_PRINT)} then
  begin WasOnPaint := Self_.EV.fOnPaint;
      Self_.{$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
      .fOnPaint2 := Self_.EV.fOnPaint;
      //Self_.fPaintMsg := Msg;
      {$IFDEF MAKE_METHOD}
      TMethod( Self_.EV.fOnPaint ) := MakeMethod( Self_, @ PaintGraphicChildren );
      {$ELSE}
      TMethod( Self_.EV.fOnPaint ).Code := @ PaintGraphicChildren;
      TMethod( Self_.EV.fOnPaint ).Data := Self_;
      {$ENDIF}
      save_Paint2 := Self_.EV.fOnPaint2;
      if  not Assigned( Self_.EV.fOnPaint2 ) then
      begin
          {$IFDEF MAKE_METHOD}
          Self_.EV.fOnPaint2 := TOnPaint( MakeMethod( nil, @ DummyPaintClear ) );
          {$ELSE}
          TMethod( Self_.EV.fOnPaint2 ).Code := @ DummyPaintClear;
          //TMethod( Self_.EV.fOnPaint2 ).Data := nil;
          {$ENDIF}
      end;
      i := Self_.fDynHandlers.fCount;
      Self_.fDynHandlers.fCount := Self_.fDynHandlers.IndexOf( @ WndProc_ParentOfGraphicCtl );
      Result := EnumDynHandlers( Self_, Msg, Rslt );
      Self_.fDynHandlers.fCount := i;
      if not Result then
        {Result :=} WndProcPaint( Self_, Msg, Rslt );
      Self_.EV.fOnPaint := WasOnPaint;
      Result := TRUE;
  end else
  if (Msg.message >= WM_MOUSEFIRST) and (Msg.message <= WM_MOUSELAST) then
  begin
    Pt.X := SmallInt( LoWord( Msg.lParam ) );
    Pt.Y := SmallInt( HiWord( Msg.lParam ) );
    for i := 0 to Self_.ChildCount-1 do
    begin
      if   (i = 0) and (Self_.fPushedBtn <> nil) then
           C := Self_.fPushedBtn
      else C := Self_.Children[ i ];
      if  (C = Self_.fPushedBtn) OR
          {$IFDEF USE_FLAGS}
                  (F3_Visible in C.fStyle.f3_Style)
          and not (F3_Disabled in C.fStyle.f3_Style)
          {$ELSE} C.fVisible and C.fEnabled {$ENDIF}
      and PtInRect( C.BoundsRect, Pt ) then
      begin
        if  {$IFDEF USE_FLAGS} (G6_GraphicCtl in C.fFlagsG6)
            {$ELSE} not C.fWindowed {$ENDIF}
        and (C.fCursor <> 0) and (C.fCursor <> Self_.fCursor) and
            (ScreenCursor = 0) then
        begin if Self_.fSaveCursor = 0 then
              begin Self_.fSaveCursor := Self_.fCursor;
                    if  Self_.fCursor = 0 then
                        Self_.fSaveCursor := LoadCursor( 0, IDC_ARROW );
              end;
              Self_.Cursor := C.fCursor;
              Windows.SetCursor( C.fCursor );
        end;
        {$IFDEF GRAPHCTL_HOTTRACK}
        if  {$IFDEF USE_FLAGS} (G6_GraphicCtl in C.fFlagsG6)
            {$ELSE} not C.fWindowed {$ENDIF}
        and (Applet.DF.fHotCtl <> C) then
        begin
          if Applet.DF.fHotCtl <> nil then
          begin
              {$IFDEF USE_FLAGS}
                      exclude( Applet.DF.fHotCtl.fFlagsG4, G4_Hot );
              {$ELSE} Applet.DF.fHotCtl.fHot := FALSE; {$ENDIF}
              if  {$IFDEF USE_FLAGS} (G6_GraphicCtl in Applet.DF.fHotCtl.fFlagsG6)
                  {$ELSE} not Applet.DF.fHotCtl.fWindowed {$ENDIF} then
              begin
                  Applet.DF.fHotCtl.Invalidate;
                  {$IFDEF NIL_EVENTS}
                  if  Assigned( Applet.DF.fHotCtl.EV.fOnMouseLeave ) then
                  {$ENDIF}
                      Applet.DF.fHotCtl.EV.fOnMouseLeave( Applet.DF.fHotCtl );
              end;
              Applet.DF.fHotCtl.RefDec;
          end;
          C.RefInc;
          Applet.DF.fHotCtl := C;
          {$IFDEF USE_FLAGS} include( C.fFlagsG4, G4_Hot );
          {$ELSE} C.fHot := TRUE; {$ENDIF}
          C.Invalidate;
          Self_.EV.fMouseLeaveProc := Self_.MouseLeaveFromParentOfGraphCtl;
          ProvideMouseEnterLeave( Self_ );
          {$IFDEF NIL_EVENTS}
          if  Assigned( C.EV.fOnMouseEnter ) then
          {$ENDIF}
              C.EV.fOnMouseEnter( C );
        end;
        {$ENDIF GRAPHCTL_HOTTRACK}
        if  {$IFDEF USE_FLAGS} not(G6_GraphicCtl in C.fFlagsG6)
            {$ELSE} C.fWindowed {$ENDIF} then
        begin
            Msg.hwnd := C.fHandle;
            Pt := Self_.Client2Screen( Pt );
            Pt := C.Screen2Client( Pt );
            Msg.lParam := Pt.Y shl 16 or (Pt.X and $FFFF);
        end;
        Rslt := C.WndProc( Msg );
        if  {$IFDEF USE_FLAGS} (G6_GraphicCtl in C.fFlagsG6)
            {$ELSE} not C.fWindowed {$ENDIF} then
            {$IFDEF NIL_EVENTS}
            if  Assigned( C.EV.fGraphCtlMouseEvent ) then
            {$ENDIF}
                C.EV.fGraphCtlMouseEvent( Msg )
          else if (Msg.message = WM_LBUTTONDOWN) or
                  (Msg.message = WM_RBUTTONDOWN) or
                  (Msg.message = WM_MBUTTONDOWN) then C.DoClick;
        Result := TRUE; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      end;
    end;
    {$IFDEF GRAPHCTL_HOTTRACK}
    Self_.MouseLeaveFromParentOfGraphCtl( Self_ );
    {$ENDIF GRAPHCTL_HOTTRACK}
    if  {$IFDEF USE_FLAGS} (G5_IsGroupbox in Self_.fFlagsG5)
        {$ELSE} Self_.fIsGroupBox {$ENDIF}
    and (
         (Msg.message = WM_LBUTTONDOWN) or
         (Msg.message = WM_LBUTTONDBLCLK) or
         (Msg.message = WM_LBUTTONUP)
        ) then
    begin
      Self_.Invalidate;
    end;
    if Self_.fSaveCursor <> 0 then
    begin Self_.Cursor := Self_.fSaveCursor;
          Self_.fSaveCursor := 0;
          if  ScreenCursor = 0 then Windows.SetCursor( Self_.fCursor );
    end;
  end else
  if (Msg.message >= WM_KEYFIRST) and (Msg.message <= WM_KEYLAST) then
  begin
    if   Self_.IsControl then
         PF := Self_.ParentForm
    else PF := Self_;
    if  (PF.DF.fCurrentControl <> nil)
    and {$IFDEF USE_FLAGS} (G6_GraphicCtl in PF.DF.fCurrentControl.fFlagsG6)
        {$ELSE} not PF.DF.fCurrentControl.fWindowed {$ENDIF} then
    begin if   Assigned( PF.DF.fCurrentControl.fKeyboardProcess ) and
               PF.DF.fCurrentControl.fKeyboardProcess( Msg, Rslt ) then
          else Rslt := PF.DF.fCurrentControl.WndProc( Msg );
          Result := TRUE;
    end else
    begin
      if  {$IFDEF USE_FLAGS} (G5_IsGroupbox in Self_.fFlagsG5)
          {$ELSE} Self_.fIsGroupBox {$ENDIF}
      and (Msg.wParam = WORD( ' ' )) and
          (
           (Msg.message = WM_KEYDOWN) or
           (Msg.message = WM_SYSKEYDOWN) or
           (Msg.message = WM_KEYUP) or
           (Msg.message = WM_SYSKEYUP) or
           (Msg.message = WM_CHAR) or
           (Msg.message = WM_SYSCHAR)
          ) then
      begin
        Self_.Invalidate;
      end;
    end;
  end else
  if Msg.message = CM_QUIT then
  begin
    C := Pointer( Msg.wParam );
    C.Free;
  end else
  if Msg.message = CM_FOCUSGRAPHCTL then
  begin
    C := Pointer( Msg.wParam );
    PF := C.ParentForm;
    if (PF.DF.fCurrentControl <> nil) and (PF.DF.fCurrentControl <> C) then
    begin
        {$IFDEF USE_FLAGS}
                exclude( PF.DF.fCurrentControl.fFlagsG6, G6_Focused );
        {$ELSE} PF.DF.fCurrentControl.fFocused := FALSE; {$ENDIF}
        PF.DF.fCurrentControl.Invalidate;
    end;
    PF.DF.fCurrentControl := C;
    C.Parent.DF.fCurrentControl := C;
    //C.Parent.fFocusHandle := C.Parent.fHandle;
    {$IFDEF USE_FLAGS} include( C.fFlagsG6, G6_Focused );
    {$ELSE} C.fFocused := TRUE; {$ENDIF}
    if  Assigned( C.EV.fOnEnter ) then
        C.EV.fOnEnter( C );
    C.Invalidate;
    C.EV.fLeave := C.LeaveGraphButton;
    C.RefDec;
  end;
end;////////////////////////////////////////////////////////////////////////////
function WndProc_FormHavingGraphCtl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Msg2: TMsg;
begin Result := FALSE;
  if Msg.message = WM_ACTIVATE then
      begin if  Self_.DF.fCurrentControl <> nil then
      Self_.DF.fCurrentControl.Invalidate;
      end else
  if (Msg.message >= WM_KEYFIRST) and (Msg.message <= WM_KEYLAST) then
  begin if  (Self_.DF.fCurrentControl <> nil)
        and {$IFDEF USE_FLAGS} (G6_GraphicCtl in Self_.DF.fCurrentControl.fFlagsG6)
        {$ELSE} not Self_.DF.fCurrentControl.fWindowed {$ENDIF} then
        begin if (Msg.message = WM_KEYDOWN) and ((Msg.wParam = 32) or (Msg.wParam = 13)) then
              begin if  not PeekMessage( Msg2, Msg.hwnd, WM_CHAR, WM_CHAR, pm_noRemove )
                        or (Msg2.wParam <> Msg.wParam) then
                        Msg.message := WM_CHAR;
              end else
              if  (Msg.message = WM_SYSKEYDOWN) and ((Msg.wParam = 32) or (Msg.wParam = 13)) then
              begin if not PeekMessage( Msg2, Msg.hwnd, WM_SYSCHAR, WM_SYSCHAR, pm_noRemove ) or
                       (Msg2.wParam <> Msg.wParam) then
                       Msg.message := WM_SYSCHAR;
              end;
              if   Assigned( Self_.DF.fCurrentControl.fKeyboardProcess ) and
                   Self_.DF.fCurrentControl.fKeyboardProcess( Msg, Rslt ) then
              else Rslt := Self_.DF.fCurrentControl.WndProc( Msg );
              Result := TRUE;
        end;
  end;
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF GRAPHCTL_HOTTRACK}
procedure TControl.MouseLeaveFromParentOfGraphCtl(Sender: PObj);
var C: PControl;
    Pt: TPoint;
begin
  if AppletTerminated then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  GetCursorPos( Pt );
  Pt := Screen2Client( Pt );
  if  (Applet.DF.fHotCtl <> nil) and (fChildren.IndexOf( Applet.DF.fHotCtl ) >= 0) then
  begin
      C := Applet.DF.fHotCtl;
      if PtInRect( C.BoundsRect, Pt ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      Applet.DF.fHotCtl := nil;
      {$IFDEF USE_FLAGS} exclude( C.fFlagsG4, G4_Hot );
      {$ELSE} C.fHot := FALSE; {$ENDIF}
      if  {$IFDEF USE_FLAGS} (G6_GraphicCtl in C.fFlagsG6)
          {$ELSE} not C.fWindowed {$ENDIF} then
          C.Invalidate;
      if  Assigned( C.OnMouseLeave ) then
          C.OnMouseLeave( C );
      C.RefDec;
  end;
end;
{$ENDIF GRAPHCTL_HOTTRACK}

procedure NotifyGraphCtlAboutNewParent(Prnt, Chld: PControl);
begin
  if  (Chld <> nil) and (Prnt <> nil) then
      Prnt.AttachProc( WndProc_ParentOfGraphicCtl );
end;

function _NewGraphCtl( AParent: PControl; ATabStop: Boolean;
         ACommandActions: TCommandActionsParam ): PControl;
var IdxActions: Integer;
begin new( Result, Create );
      {$IFDEF DEBUG_OBJKIND} Result.fObjKind := 'TControl:GraphicControl';
      {$ENDIF}
      {$IFDEF COMMANDACTIONS_OBJ}
          IdxActions := Integer( ACommandActions );
          if  IdxActions >= 120 then
              IdxActions := PByte( ACommandActions )^;
          if  AllActions_Objs[IdxActions] <> nil then
              begin Result.fCommandActions := AllActions_Objs[IdxActions];
              Result.fCommandActions.RefInc;
              end else
              begin new( Result.fCommandActions, Create );
              {$IFDEF DEBUG_OBJKIND}
              Result.fCommandActions.fObjKind := 'TCommandActionsObj';
              {$ENDIF}
              AllActions_Objs[IdxActions] := Result.fCommandActions;
              {$IFDEF SAFE_CODE}
              if  ACommandActions <> nil then
              {$ENDIF}
                  Move( ACommandActions^, Result.fCommandActions.aClear, Sizeof( TCommandActions ) );
          end;
          Result.Add2AutoFree( Result.fCommandActions );
          {$ELSE} {$IFDEF SAFE_CODE}
          if  ACommandActions <> nil then
          {$ENDIF}
              Result.fCommandActions := ACommandActions^;
      {$ENDIF}
      Result.PP.fDoInvalidate := InvalidateNonWindowed;
      {$IFDEF USE_FLAGS} include( Result.fFlagsG6, G6_GraphicCtl );
      {$ELSE} Result.fWindowed := FALSE; {$ENDIF}
      {$IFDEF USE_FLAGS}
              include( Result.fFlagsG3, G3_IsControl );
              include( Result.fFlagsG4, G4_CreateVisible );
              if  ATabStop then
                  include( Result.fStyle.f2_Style, F2_TabStop );
      {$ELSE} Result.fCreateVisible := TRUE;
              Result.fVisible := TRUE;
              Result.fIsControl := TRUE;
              Result.fTabstop := ATabStop;
      {$ENDIF}
      Result.fMenu := CtlIdCount;
      Inc( CtlIdCount );
      Result.DF.fBitBtnOptions := [ bboFixed ]; // to return Checked = fChecked w/o window handle
      {$IFDEF USE_FLAGS}
              Result.fFlagsG1 := Result.fFlagsG1 + [ G1_IgnoreWndCaption, G1_SizeRedraw ];
      {$ELSE} Result.fIgnoreWndCaption := TRUE;
              Result.fSizeRedraw := TRUE;
      {$ENDIF}
      Result.PP.fNotifyChild := @ NotifyGraphCtlAboutNewParent;
      if  ATabStop then
          Result.fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ];
      if  AParent <> nil then
          begin Result.Parent := AParent;
          Result.Border := AParent.Border;
          AParent.AttachProc( WndProc_ParentOfGraphicCtl );
          if ATabStop then
          begin Inc( AParent.ParentForm.fTabOrder );
                Result.fTabOrder := AParent.ParentForm.fTabOrder;
          end;
          if  {$IFDEF USE_FLAGS} G3_IsControl in AParent.fFlagsG3
              {$ELSE} AParent.fIsControl {$ENDIF} then
              AParent.ParentForm.AttachProc( WndProc_FormHavingGraphCtl );
          if  {$IFDEF USE_FLAGS} G5_IsGroupbox in APArent.fFlagsG5
              {$ELSE} AParent.fIsGroupBox {$ENDIF} then
          begin AParent.Style := AParent.Style and
                    not BS_GROUPBOX; // otherwise the groupbox is flickering A LOT!
                AParent.Parent.AttachProc( WndProc_ParentOfGraphicCtl );
          end;

           Result.fFont := Result.fFont.Assign( AParent.fFont );
           if Result.fFont <> nil then
                begin  Result.fFont.fParentGDITool := AParent.fFont;
             Result.fFont.fOnGTChange := Result.FontChanged;
             Result.FontChanged( Result.fFont );
           end;
      end;
      Result.fBoundsRect.Right := Result.fBoundsRect.Left + 64;
      Result.fBoundsRect.Bottom := Result.fBoundsRect.Top + 22;
      Result.EV.fOnPaint := nil;

      {$IFDEF GRAPHCTL_XPSTYLES}
      if WinVer < wvXP then
        DoNotDrawGraphCtlsUsingXPStyles := TRUE;
      {$ENDIF}
end;////////////////////////////////////////////////////////////////////////////
function NewGraphLabel( AParent: PControl; const ACaption: AnsiString ): PControl;
begin {$IFDEF INPACKAGE} Result := NewLabel( AParent, ACaption );
      {$ELSE} Result := _NewGraphCtl( AParent, FALSE,
              {$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed
              {$ELSE} @LabelActions {$ENDIF} );
              Result.aAutoSzX := 1;
              Result.aAutoSzY := 1;
              Result.EV.fPaintProc := Result.GraphicLabelPaint;
              Result.Caption := ACaption;
      {$ENDIF}
end;////////////////////////////////////////////////////////////////////////////
function NewWordWrapGraphLabel( AParent: PControl; const ACaption: KOLString ): PControl;
begin {$IFDEF INPACKAGE} Result := NewWordWrapLabel( AParent, ACaption );
      {$ELSE} Result := NewGraphLabel( AParent, ACaption );
              {$IFDEF USE_FLAGS} include( Result.fFlagsG1, G1_WordWrap );
              {$ELSE} Result.fWordWrap := TRUE; {$ENDIF}
      {$ENDIF}
end;////////////////////////////////////////////////////////////////////////////
function NewGraphPaintBox( AParent: PControl ): PControl;
begin {$IFDEF INPACKAGE} Result := NewPaintbox( AParent );
      {$ELSE}            Result := NewGraphLabel( AParent, '' ); {$ENDIF}
end;////////////////////////////////////////////////////////////////////////////
procedure ClickGraphCheck(Sender: PObj);
var Ctl: PControl;
begin Ctl := Pointer( Sender );
      if  not Ctl.Enabled then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      Ctl.Focused := TRUE;
      if  Assigned( Ctl.OnEnter ) then
          Ctl.OnEnter( Ctl );
      {$IFDEF USE_FLAGS}
              if   G4_Checked in Ctl.fFlagsG4 then
                   exclude( Ctl.fFlagsG4, G4_Checked )
              else include( Ctl.fFlagsG4, G4_Checked );
      {$ELSE} Ctl.fChecked := not Ctl.fChecked; {$ENDIF}
      Ctl.Invalidate;
      if  Assigned( Ctl.OnClick ) then
          Ctl.OnClick( Ctl );
end;////////////////////////////////////////////////////////////////////////////
function NewGraphCheckBox( AParent: PControl; const ACaption: KOLString ): PControl;
begin {$IFDEF INPACKAGE} Result := NewCheckbox( AParent, ACaption );
      {$ELSE} Result := NewGraphButton( AParent, ACaption );
      Result.TextAlign := taLeft;
      Result.aAutoSzX := GetSystemMetrics( SM_CXMENUCHECK ) + 4;
      Result.EV.fPaintProc := Result.GraphicCheckBoxPaint;
      Result.EV.fGraphCtlMouseEvent := Result.GraphicCheckBoxMouse;
      Result.PP.fControlClick := @ ClickGraphCheck;
      {$ENDIF}
end;////////////////////////////////////////////////////////////////////////////
procedure ClickGraphRadio(Sender: PObj);
var Ctl, C: PControl;
    i: Integer;
begin Ctl := Pointer( Sender );
      if not Ctl.Enabled then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      Ctl.Focused := TRUE;
      Ctl.Checked := TRUE;
      if Ctl.Parent <> nil then
      for i := 0 to Ctl.Parent.ChildCount-1 do
          begin C := Ctl.Parent.Children[ i ];
        if (C <> Ctl) and (@ C.PP.fControlClick = @ ClickGraphRadio) then
          C.Checked := FALSE;
      end;
end;////////////////////////////////////////////////////////////////////////////
function NewGraphRadioBox( AParent: PControl; const ACaption: KOLString ): PControl;
begin {$IFDEF INPACKAGE}  Result := NewRadiobox( AParent, ACaption );
      if (@ ClickGraphRadio) <> nil then;
      {$ELSE} Result := NewGraphButton( AParent, ACaption );
      Result.TextAlign := taLeft;
      Result.aAutoSzX := GetSystemMetrics( SM_CXMENUCHECK ) + 4;
      Result.EV.fPaintProc := Result.GraphicRadioBoxPaint;
      Result.PP.fControlClick := @ ClickGraphRadio;
      {$IFDEF USE_FLAGS}
      if  not(G1_HasRadio in AParent.fFlagsG1) then
      begin
          include( AParent.fFlagsG1, G1_HasRadio );
          Result.SetRadioChecked;
      end;
      {$ELSE}
      AParent.PropInt[ @RADIO_LAST ] := Result.fMenu;
      if AParent.PropInt[ @RADIO_1ST ] = 0 then
      begin
         AParent.PropInt[ @RADIO_1ST ] := Result.fMenu;
         Result.SetRadioChecked;
      end;
      {$ENDIF}
      {$ENDIF}
end;////////////////////////////////////////////////////////////////////////////
procedure GraphButtonSetFocus(Ctl: PControl);
var PF, CC: PControl;
    W: HWnd;
begin if  {$IFDEF USE_FLAGS} not(F2_Tabstop in Ctl.fStyle.f2_Style)
      {$ELSE} not Ctl.fTabStop {$ENDIF} then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      PF := Ctl.ParentForm;
      if  (PF.DF.fCurrentControl <> nil) and (PF.DF.fCurrentControl <> Ctl) and
          (PF.DF.fCurrentControl <> Ctl.fParent) then
          begin CC := PF.DF.fCurrentControl;
          CC.RefInc;
          Ctl.fParent.Focused := TRUE;
          if  Assigned( CC.EV.fLeave ) then
              CC.EV.fLeave( PF.DF.fCurrentControl )
          else
              Windows.SetFocus( 0 );
          CC.RefDec;
      end else
          begin W := GetFocus;
          if  (W <> Ctl.Parent.fHandle) and (W <> 0) then
                begin Windows.SetFocus( 0 );
              Ctl.fParent.Focused := TRUE;
          end;
      end;
      if  Ctl.fParent.fHandle <> 0 then
          begin {$IFDEF USE_FLAGS} include( Ctl.fFlagsG6, G6_Focused );
          {$ELSE} Ctl.fFocused := TRUE; {$ENDIF}
          Ctl.fParent.Postmsg( CM_FOCUSGRAPHCTL, Integer( Ctl ), 0 );
          Ctl.RefInc;
      end;
      if  Assigned( Ctl.EV.fOnEnter ) then
          Ctl.EV.fOnEnter( Ctl );
end;////////////////////////////////////////////////////////////////////////////
function NewGraphButton( AParent: PControl; const ACaption: KOLString ): PControl;
begin {$IFDEF INPACKAGE}
      Result := NewButton( AParent, ACaption );
      {$ELSE}
      Result := _NewGraphCtl( AParent, TRUE,
             {$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed
             {$ELSE} @ButtonActions {$ENDIF} );
      Result.EV.fPaintProc := Result.GraphicButtonPaint;
      Result.Caption := ACaption;
      Result.TextAlign := taCenter;
      Result.VerticalAlign := vaCenter;
      Result.EV.fGraphCtlMouseEvent := Result.GraphicButtonMouse;
      Result.fSetFocus := @GraphButtonSetFocus;
      Result.fKeyboardProcess := Result.GraphButtonKeyboardProcess;
      {$ENDIF}
end;////////////////////////////////////////////////////////////////////////////
function EditGraphEdit(Ctl: PControl): PControl;
var E: PControl;
begin E := NewEditBox( Ctl.fParent, Ctl.DF.fEditOptions );
      E.SetBoundsRect( Ctl.BoundsRect );
      E.SetAlign( Ctl.Align );
      E.fTabOrder := Ctl.fTabOrder;
      E.Text := Ctl.Text;
      E.OnChange := Ctl.ChangeGraphEdit;
      E.Color := Ctl.Color;
      E.fCursor := Ctl.fCursor;
      E.CreateWindow;
      E.OnLeave := Ctl.LeaveGraphEdit;
      E.EV.fLeave := Ctl.LeaveGraphEdit;
      E.Focused := TRUE;
      E.OnChar := Ctl.OnChar;
      E.OnKeyDown := Ctl.OnKeyDown;
      E.OnKeyUp := Ctl.OnKeyUp;
      E.OnDestroy := Ctl.DestroyGraphEdit;
      //E.Font.Assign( Font );
      Result := E;
      Ctl.Visible := FALSE;
      Ctl.DF.fEditCtl := E;
      {$IFDEF NIL_EVENTS}
      if  Assigned( Ctl.EV.fOnEnter ) then
      {$ENDIF}
          Ctl.EV.fOnEnter( Ctl );
end;////////////////////////////////////////////////////////////////////////////
function NewGraphEditbox( AParent: PControl; Options: TEditOptions ): PControl;
begin {$IFDEF INPACKAGE}
  Result := NewEditbox( AParent, Options );
  {$ELSE}
  Result := _NewGraphCtl( AParent, TRUE,
         {$IFDEF PACK_COMMANDACTIONS} EditActions_Packed
         {$ELSE} @EditActions {$ENDIF} );
  Result.aAutoSzY := 1;
  Result.EV.fPaintProc := Result.GraphicEditPaint;
  Result.DF.fEditOptions := Options;
  Result.VerticalAlign := vaCenter;
  Result.fColor := clWindow;
  Result.EV.fGraphCtlMouseEvent := Result.GraphicEditMouse;
  Result.fSetFocus := @EditGraphEdit;
  Result.fLookTabKeys := [ tkTab, tkUpDown, tkPageUpPageDn ];
  Result.EV.fLeave := Result.LeaveGraphEdit;
  {$ENDIF}
end;////////////////////////////////////////////////////////////////////////////
{ TGraphicControl }

function TControl.DoGraphCtlPrepaint: TRect;
begin
  Result := ClientRect;
  if not Assigned( TMethod( EV.fOnPrepaint ).Data ) and not Transparent then
  begin if  fBrush <> nil then
            Canvas.Brush.Assign( fBrush )
        else Canvas.Brush.Color := Color;
        Canvas.FillRect( Result );
  end;
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.GraphicLabelPaint(DC: HDC);
var R: TRect;
begin R := DoGraphCtlPrepaint;
      if  Text <> '' then DrawFormattedText( @ Self, DC, R, 0 );
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.GraphicCheckBoxPaint(DC: HDC);
var R, R1: TRect;
    Flag: DWORD;
    W, H: Integer;
    {$IFDEF GRAPHCTL_XPSTYLES}
    Theme: THandle;
    {$ENDIF}
begin R := DoGraphCtlPrepaint;
  {$IFDEF GRAPHCTL_XPSTYLES}
  OpenThemeDataProc;
  Theme := 0;
  if  Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then
      Theme := fOpenThemeDataProc( 0, 'Button' );
  if  Theme <> 0 then begin
      W := GetSystemMetrics( SM_CXMENUCHECK );
      H := GetSystemMetrics( SM_CYMENUCHECK );
      R1 := R;
      R1.Right := R1.Left + W;
      if   {$IFDEF USE_FLAGS} G1_WordWrap in fFlagsG1
           {$ELSE} fWordWrap {$ENDIF} then
           R1.Top := R1.Top + Border
      else R1.Top := R1.Top + (R1.Bottom - R1.Top - H) div 2;
      R1.Bottom := R1.Top + H;
      Flag := 1; {CBS_UNCHECKEDNORMAL}
      if  not Enabled then
          Flag := 4 {CBS_UNCHECKEDDISABLED}
      else if  {$IFDEF USE_FLAGS} G4_Hot in fFlagsG4
          {$ELSE} fHot {$ENDIF} then
          Flag := 2; {CBS_UNCHECKEDHOT}
      if  {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4
          {$ELSE} fChecked {$ENDIF} then
          Inc( Flag, 4 );
      fDrawThemeBackground( Theme, DC, 3 {BP_CHECKBOX}, Flag, @R1, @R  );
      R.Left := R1.Left + W + Border;
      if fCaption <> '' then begin
          DrawFormattedText( @ Self, DC, R, DT_CALCRECT );
          if  {$IFDEF USE_FLAGS} G1_WordWrap in fFlagsG1
              {$ELSE} fWordWrap {$ENDIF} then begin
              DrawFormattedText( @ Self, DC, R, 0 );
              GraphCtlDrawFocusRect( DC, R );
          end else begin
              GraphCtlDrawFocusRect( DC, R );
              DrawFormattedTextXP( Theme, @ Self, DC, R, 3 {BP_CHECKBOX}, Flag, 0, 0 );
          end;
      end;
      fCloseThemeData( Theme );
  end else
  {$ENDIF}
  begin W := GetSystemMetrics( SM_CXMENUCHECK );
        H := GetSystemMetrics( SM_CYMENUCHECK );
        R1 := R;
        R1.Right := R1.Left + W;
        if   {$IFDEF USE_FLAGS} G1_WordWrap in fFlagsG1
             {$ELSE} fWordWrap {$ENDIF} then
             R1.Top := R1.Top + Border
        else R1.Top := R1.Top + (R1.Bottom - R1.Top - H) div 2;
        R1.Bottom := R1.Top + H;
        Flag := 0;
        if  {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4
            {$ELSE} fChecked {$ENDIF} then
            Flag := DFCS_CHECKED;
        DrawFrameControl( DC, R1, DFC_BUTTON, DFCS_BUTTONCHECK or
                          $800 {DFCS_TRANSPARENT} or Flag );
        R.Left := R1.Left + W + Border;
        DrawFormattedText( @ Self, DC, R, 0 );
        GraphCtlDrawFocusRect( DC, R );
  end;
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.GraphicCheckBoxMouse(var Msg: TMsg);
begin if (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_LBUTTONDBLCLK) then
         ClickGraphCheck( @ Self );
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.GraphicRadioBoxPaint(DC: HDC);
var R, R1: TRect;
    Flag: DWORD;
    W, H: Integer;
    {$IFDEF GRAPHCTL_XPSTYLES}
    Theme: THandle;
    {$ENDIF}
begin R := DoGraphCtlPrepaint;
  {$IFDEF GRAPHCTL_XPSTYLES}
  OpenThemeDataProc;
  Theme := 0;
  if  Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then
      Theme := fOpenThemeDataProc( 0, 'Button' );
  if  Theme <> 0 then begin
      W := GetSystemMetrics( SM_CXMENUCHECK );
      H := GetSystemMetrics( SM_CYMENUCHECK );
      R1 := R;
      R1.Right := R1.Left + W;
      if   {$IFDEF USE_FLAGS} G1_WordWrap in fFlagsG1
           {$ELSE} fWordWrap {$ENDIF} then
           R1.Top := R1.Top + Border
      else R1.Top := R1.Top + (R1.Bottom - R1.Top - H) div 2;
      R1.Bottom := R1.Top + H;
      Flag := 1; {CBS_UNCHECKEDNORMAL}
      if  not Enabled then
          Flag := 4 {CBS_UNCHECKEDDISABLED}
      else if  {$IFDEF USE_FLAGS} G4_Hot in fFlagsG4
               {$ELSE} fHot {$ENDIF} then
          Flag := 2; {CBS_UNCHECKEDHOT}
      if  {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4
          {$ELSE} fChecked {$ENDIF} then
          Inc( Flag, 4 );
      fDrawThemeBackground( Theme, DC, 2 {BP_RADIOBOX}, Flag, @R1, @R  );
      R.Left := R1.Left + W + Border;
      if  fCaption <> '' then begin
          DrawFormattedText( @ Self, DC, R, DT_CALCRECT );
          if  {$IFDEF USE_FLAGS} G1_WordWrap in fFlagsG1
              {$ELSE} fWordWrap {$ENDIF} then begin
              DrawFormattedText( @ Self, DC, R, 0 );
              GraphCtlDrawFocusRect( DC, R );
          end else begin
              GraphCtlDrawFocusRect( DC, R );
              DrawFormattedTextXP( Theme, @ Self, DC, R, 2 {BP_RADIOBOX}, Flag, 0, 0 );
          end;
      end;
      fCloseThemeData( Theme );
  end else
  {$ENDIF}
  begin W := GetSystemMetrics( SM_CXMENUCHECK );
        H := GetSystemMetrics( SM_CYMENUCHECK );
        R1 := R;
        R1.Right := R1.Left + W;
        if   {$IFDEF USE_FLAGS} G1_WordWrap in fFlagsG1
             {$ELSE} fWordWrap {$ENDIF} then
             R1.Top := R1.Top + Border
        else R1.Top := R1.Top + (R1.Bottom - R1.Top - H) div 2;
        R1.Bottom := R1.Top + H;
        Flag := 0;
        if  {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4
            {$ELSE} fChecked {$ENDIF} then
            Flag := DFCS_CHECKED;
        DrawFrameControl( DC, R1, DFC_BUTTON, DFCS_BUTTONRADIO
                          or $800 {DFCS_TRANSPARENT} {or DFCS_ADJUSTRECT} or Flag );
        R.Left := R1.Right + 2;
        DrawFormattedText( @ Self, DC, R, 0 );
        GraphCtlDrawFocusRect( DC, R );
  end;
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.GraphicButtonPaint(DC: HDC);
var R: TRect;
    Flag: DWORD;
    {$IFDEF GRAPHCTL_XPSTYLES}
    Flag1: DWORD;
    Theme: THandle;
    {$ENDIF}
    II: TIconInfo;
    BI: TagBitmap;
    Y: Integer;
    R1: TRect;
begin R := DoGraphCtlPrepaint;
  {$IFDEF GRAPHCTL_XPSTYLES}
  OpenThemeDataProc;
  Theme := 0;
  if  Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then
      Theme := fOpenThemeDataProc( 0, 'Button' );
  if  Theme <> 0 then begin
      Flag := 1; {PBS_UNCHECKEDNORMAL}
      if  not Enabled then
          Flag := 4 {PBS_UNCHECKEDDISABLED}
      else
      if  {$IFDEF USE_FLAGS} G4_Pushed in fFlagsG4
          {$ELSE} fPushed {$ENDIF} then
          Flag := 3 {PBS_UNCHECKEDPRESSED}
      else
      if  {$IFDEF USE_FLAGS} G4_Hot in fFlagsG4
          {$ELSE} fHot {$ENDIF} then
          Flag := 2; {PBS_UNCHECKEDHOT}
      if  {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4
          {$ELSE} fChecked {$ENDIF} then
          Inc( Flag, 4 );
      fDrawThemeBackground( Theme, DC, 1 {BP_PUSHBUTTON}, Flag, @R, @R  );
      fGetThemeBackgroundContentRect( Theme, DC, 1 {BS_PUSHBUTTON}, Flag, @R, @R1 );
      GraphCtlDrawFocusRect( DC, R1 );
      if (DF.fButtonIcon <> 0) and GetIconInfo( DF.fButtonIcon, II ) then begin
          if GetObject( II.hbmColor, Sizeof( BI ), @ BI ) <> 0 then begin
              CASE fVerticalAlign OF
              vaTop:    Y := R.Top + Border;
              vaBottom: Y := R.Bottom - Border - BI.bmHeight;
              else {vaCenter:}Y := R.Top + (R.Bottom - R.Top - BI.bmHeight) div 2;
              END;
              DrawIcon( DC, R.Left + Border, Y, DF.fButtonIcon );
              Inc( R1.Left, BI.bmWidth + Border * 2 );
          end;
          DeleteObject( II.hbmColor );
          if II.hbmMask <> 0 then
            DeleteObject( II.hbmMask );
      end;
      if  fCaption <> '' then begin
          Flag1 := DT_SINGLELINE;
          if  WordWrap then Flag1 := DT_WORDBREAK;
          DrawFormattedText( @ Self, DC, R1, DT_CALCRECT );
          DrawFormattedTextXP( Theme, @ Self, DC, R1, 1 {BP_PUSHBUTTON}, Flag,
            Flag1, 0 );
      end;
      fCloseThemeData( Theme );
  end else
  {$ENDIF}
  begin
    Flag := 0;
    if  {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4
        {$ELSE} fChecked {$ENDIF} then Flag := DFCS_CHECKED
    else if  {$IFDEF USE_FLAGS} G4_Pushed in fFlagsG4
             {$ELSE} fPushed {$ENDIF} then
             Flag := DFCS_PUSHED;
    if  {$IFDEF USE_FLAGS} G3_Flat in fFlagsG3
        {$ELSE} fFlat {$ENDIF} then
        Flag := Flag or DFCS_FLAT;
    DrawFrameControl( DC, R, DFC_BUTTON, DFCS_BUTTONPUSH or
                      $800 {DFCS_TRANSPARENT} or DFCS_ADJUSTRECT or Flag );
    R1 := R;
    if (DF.fButtonIcon <> 0) and GetIconInfo( DF.fButtonIcon, II ) then begin
        if  GetObject( II.hbmColor, Sizeof( BI ), @ BI ) <> 0 then begin
            CASE fVerticalAlign OF
            vaTop:    Y := R.Top + Border;
            vaBottom: Y := R.Bottom - Border - BI.bmHeight;
            else {vaCenter:}Y := R.Top + (R.Bottom - R.Top - BI.bmHeight) div 2;
            END;
            DrawIcon( DC, R.Left + Border, Y, DF.fButtonIcon );
            Inc( R1.Left, BI.bmWidth + Border * 2 );
        end;
        DeleteObject( II.hbmColor );
        if  II.hbmMask <> 0 then DeleteObject( II.hbmMask );
    end;
    DrawFormattedText( @ Self, DC, R1, 0 );
    GraphCtlDrawFocusRect( DC, R );
  end;
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.GraphicButtonMouse(var Msg: TMsg);
var Pt: TPoint;
begin CASE Msg.message OF
      WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
        begin GraphButtonSetFocus(@Self);
              RefInc;
              SetCapture( Parent.Handle );
              Parent.fPushedBtn := @ Self;
              {$IFDEF USE_FLAGS} include( fFlagsG4, G4_Pushed );
              {$ELSE} fPushed := TRUE; {$ENDIF}
              Invalidate;
        end;
      WM_LBUTTONUP:
        begin
          ReleaseCapture;
          Invalidate;
          if  {$IFDEF USE_FLAGS} G4_Pushed in fFlagsG4
              {$ELSE} fPushed {$ENDIF} then begin
              Pt.X := SmallInt( LoWord( Msg.lParam ) );
              Pt.Y := SmallInt( HiWord( Msg.lParam ) );
              if  PtInRect( ClientRect, Pt ) then DoClick;
              {$IFDEF USE_FLAGS} exclude( fFlagsG4, G4_Pushed );
              {$ELSE} fPushed := FALSE; {$ENDIF}
              Parent.fPushedBtn := nil;
              RefDec;
          end;
        end;
      END;
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.LeaveGraphButton( Sender: PObj );
begin {$IFDEF USE_FLAGS} exclude( fFlagsG6, G6_Focused );
      {$ELSE} fFocused := FALSE; {$ENDIF}
      if  Parent.DF.fCurrentControl = @ Self then
          Parent.DF.fCurrentControl := nil;
      if  ParentForm.DF.fCurrentControl = @ Self then
          ParentForm.DF.fCurrentControl := nil;
      Invalidate;
      {$IFDEF NIL_EVENTS}
      if  Assigned( EV.fOnLeave ) then
      {$ENDIF}
          EV.fOnLeave( @ Self );
end;////////////////////////////////////////////////////////////////////////////
function TControl.GraphButtonKeyboardProcess(var Msg: TMsg;
  var Rslt: Integer): Boolean;
var SpacePressed: Boolean;
begin Result := FALSE;
      SpacePressed := Msg.wParam = Word( ' ' );
      {$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER}
      SpacePressed := SpacePressed or (Msg.wParam = 13);
      {$ENDIF}
      if not SpacePressed then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      if  (Msg.message = WM_KEYDOWN) or (Msg.message = WM_SYSKEYDOWN) then
      begin
          Parent.fPushedBtn := @ Self;
          {$IFDEF USE_FLAGS} include( fFlagsG4, G4_Pushed );
          {$ELSE} fPushed := TRUE; {$ENDIF}
          Invalidate;
          Result := TRUE; /////
      end else
      if  (Msg.message = WM_KEYUP) or (Msg.message = WM_SYSKEYUP) then
      begin
          {$IFDEF USE_FLAGS} exclude( fFlagsG4, G4_Pushed );
          {$ELSE} fPushed := FALSE; {$ENDIF}
          Parent.fPushedBtn := nil;
          Invalidate;
          Result := TRUE; /////
      end else
      if (Msg.message = WM_CHAR) or (Msg.message = WM_SYSCHAR) then
      begin
          DoClick;
          Result := TRUE;
      end;
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.GraphicEditPaint(DC: HDC);
var R: TRect;
    {$IFDEF GRAPHCTL_XPSTYLES}
    R1: TRect;
    Flag, Flag1: DWORD;
    Theme: THandle;
    {$ENDIF}
begin R := ClientRect;
      {$IFDEF GRAPHCTL_XPSTYLES}
      OpenThemeDataProc;
      Theme := 0;
      if  Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then
          Theme := fOpenThemeDataProc( 0, 'Edit' );
      if  Theme <> 0 then
      begin
          Flag := 1; {ETS_NORMAL}
          if   not Enabled then
               Flag := 4 {ETS_DISABLED}
          else if  eoReadonly in DF.fEditOptions then
               Flag := 6 {ETS_READONLY}
          else if  {$IFDEF USE_FLAGS} G6_Focused in fFlagsG6
                   {$ELSE} fFocused {$ENDIF} then
               Flag := 5 {ETS_FOCUSED}
          else if  {$IFDEF USE_FLAGS} G4_Hot in fFlagsG4
                   {$ELSE} fHot {$ENDIF} then
               Flag := 2; {ETS_HOT}
          fDrawThemeBackground( Theme, DC, 1 {EP_EDITTEXT}, Flag, @R, @R  );
          Inc( R.Left, 2 );
          Dec( R.Right, 2 );
          fGetThemeBackgroundContentRect( Theme, DC, 1 {EP_EDITTEXT}, Flag, @R, @R1 );
          if fCaption <> '' then
          begin
              Flag1 := DT_SINGLELINE;
              if  eoMultiline in DF.fEditOptions then
                  Flag1 := DT_WORDBREAK;
              CASE fTextAlign OF
              taCenter: Flag1 := Flag1 or DT_CENTER;
              taRight:  Flag1 := Flag1 or DT_RIGHT;
              END;
              CASE fVerticalAlign OF
              vaCenter: Flag1 := Flag1 or DT_VCENTER;
              vaBottom: Flag1 := Flag1 or DT_BOTTOM;
              END;
              DrawFormattedTextXP( Theme, @ Self, DC, R1, 1 {EP_EDITTEXT}, Flag,
                Flag1, 0 );
          end;
          fCloseThemeData( Theme );
      end else
      {$ENDIF}
      begin
        if  not Assigned( EV.fOnPrepaint ) and not Transparent then begin
            Canvas.Brush.Color := fColor;
            Canvas.FillRect( R );
        end;
        DrawEdge( DC, R, BDR_SUNKENINNER or BDR_SUNKENOUTER, BF_ADJUST or BF_RECT  );
        DrawFormattedText( @ Self, DC, R, DT_EDITCONTROL );
      end;
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.GraphicEditMouse(var Msg: TMsg);
var E: PControl;
    Pt: TPoint;
begin CASE Msg.message OF
      WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
        if  not ( eoReadOnly in DF.fEditOptions ) then begin
            E := EditGraphEdit(@Self);
            Pt.X := Smallint( LoWord( Msg.lParam ) ) - Left;
            Pt.Y := Smallint( HiWord( Msg.lParam ) ) - Top;
            PostMessage( E.Handle, Msg.message, Msg.wParam,
                Pt.Y shl 16 or Pt.X and $FFFF );
        end;
      END;
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.LeaveGraphEdit(Sender: PObj);
begin if  {$IFDEF USE_FLAGS} not(G6_GraphicCtl in PControl(Sender).fFlagsG6)
          {$ELSE} PControl( Sender ).fWindowed {$ENDIF}
      and ( DF.fEditCtl <> nil ) then begin
          Text := PControl( Sender ).Text;
          DF.fEditCtl := nil;
          Visible := TRUE;
          ParentForm.DF.fCurrentControl := @ Self;
          Parent.DF.fCurrentControl := @ Self;
          Parent.Postmsg( CM_QUIT, DWORD( Sender ), 0 );
      end else
      if  Assigned( DF.fEditCtl ) then
          DF.fEditCtl.EV.fLeave( DF.fEditCtl );
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.ChangeGraphEdit(Sender: PObj);
begin Text := PControl( Sender ).Text;
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.DestroyGraphEdit(Sender: PObj);
begin
  DF.fEditCtl := nil;
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.GraphCtlDrawFocusRect(DC: HDC; const R: TRect);
var rgn: HRgn;
begin if  {$IFDEF USE_FLAGS} (G6_Focused in fFlagsG6)
          {$ELSE} fFocused {$ENDIF}
      and (GetActiveWindow = ParentForm.Handle) then begin
          BeginPath( DC );
          Canvas.FrameRect( R );
          EndPath( DC );
          Canvas.FrameRect( R );
          DrawFocusRect( DC, R );
          rgn := PathToRegion( DC );
          ExtSelectClipRgn( DC, rgn, RGN_DIFF );
          DeleteObject( rgn );
      end;
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.GroupBoxPaint(DC: HDC);
var bk_erased: Boolean;
    procedure DoEraseBkgnd;
    var R: TRect;
    begin
        bk_erased := TRUE;
        If  Assigned( EV.fOnEraseBkgnd ) then
            EV.fOnEraseBkgnd( @ Self, DC )
        else begin
            R := BoundsRect;
            OffsetRect( R, -R.Left, -R.Top );
            SetBkMode( DC, OPAQUE );
            SetBkColor( DC, Color2RGB( fColor ) );
            SetBrushOrgEx( DC, 0, 0, nil );
            Windows.FillRect( DC, R, Global_GetCtlBrushHandle( @ Self ) );
        End;
    end;
var R, R1, R0: TRect;
    rgn, rgn2, rgntxt, rgnsav, rgnsavall: HRgn;
    i: Integer;
    C: PControl;
    {$IFDEF GRAPHCTL_XPSTYLES}
    Theme: THandle;
    Flag: DWORD;
    {$ENDIF}
begin if not DF.fErasingBkgnd then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
      R := ClientRect;
      Dec( R.Top, 14 { Self_.fClientTop div 2 } );
      Dec( R.Left, fClientLeft );
      Inc( R.Right, fClientRight );
      Inc( R.Bottom, fClientBottom );
      rgnsavall := CreateRectRgn( 0, 0, 0, 0 );
      GetClipRgn( DC, rgnsavall );
      TRY
          For i := 0 to ChildCount-1 do begin
              C := Children[ i ];
              If  {$IFDEF USE_FLAGS} (G6_GraphicCtl in C.fFlagsG6)
                  {$ELSE} not C.fWindowed {$ENDIF}
              and {$IFDEF USE_FLAGS} (F3_Visible in C.fStyle.f3_Style)
                  {$ELSE} C.fVisible {$ENDIF} then begin
                  rgn := CreateRectRgnIndirect( C.BoundsRect );
                  ExtSelectClipRgn( DC, rgn, RGN_DIFF );
                  DeleteObject( rgn );
              End;
          End;
          {$IFDEF GRAPHCTL_XPSTYLES}
          OpenThemeDataProc;
          Theme := 0;
          if  Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then
              Theme := fOpenThemeDataProc( 0, 'Button' );
          If  Theme <> 0 then begin
              DoEraseBkgnd;
              Flag := 1; {GBS_NORMAL}
              if not Enabled then Flag := 2; {GBS_DISABLED}
              R1 := R;
              rgnsav := 0;
              if  fCaption <> '' then
              begin
                  R1.Top := 0;
                  Inc( R1.Left, 8 );
                  Dec( R1.Right, 8 );
                  BeginPath( DC );
                  DrawFormattedTextXP( Theme, @ Self, DC, R1, 4 {BP_GROUPBOX}, Flag, 0, 0 );
                  EndPath( DC );
                  rgntxt := PathToRegion( DC );
                  if  rgntxt = 0 then begin
                      R1.Right := R1.Left + Canvas.TextWidth( fCaption );
                      R1.Bottom := R1.Top + Canvas.TextHeight( fCaption );
                      rgntxt := CreateRectRgnIndirect( R1 );
                  end;
                  DrawFormattedTextXP( Theme, @ Self, DC, R1, 4 {BP_GROUPBOX}, Flag, 0, 0 );
                  GetRgnBox( rgntxt, R0 );
                  Dec( R0.Left, 3 );
                  Inc( R0.Right, 3 );
                  DeleteObject( rgntxt );
                  rgn := CreateRectRgnIndirect( R0 );
              end else rgn := 0;
              if rgn <> 0 then
              begin
                rgnsav := CreateRectRgn( 0, 0, 0, 0 );
                GetClipRgn( DC, rgnsav );
                ExtSelectClipRgn( DC, rgn, RGN_DIFF );
                DeleteObject( rgn );
              end;
              fDrawThemeBackground( Theme, DC, 4 {BP_GROUPBOX}, Flag, @R, @R  );
              if rgnsav <> 0 then begin
                  SelectClipRgn( DC, rgnsav );
                  DeleteObject( rgnsav );
              end;
              fCloseThemeData( Theme );
          end else
          {$ENDIF}
          begin
              bk_erased := FALSE;
              R1 := R;
              R1.Top := 0;
              R1.Bottom := ClientRect.Top;
              Inc( R1.Left, 16 );
              Dec( R1.Right, 16 );
              fVerticalAlign := vaCenter;
              BeginPath( DC );
              Canvas.TextOut( R1.Left, R1.Top, fCaption );
              EndPath( DC );
              Canvas.TextOut( R1.Left, R1.Top, fCaption );
              rgntxt := PathToRegion( DC );
              if rgntxt = 0 then // òàêîå - â ñëó÷àå øðèôòà ïî óìîë÷àíèþ!
              begin
                R1.Right := R1.Left + Canvas.TextWidth( fCaption );
                R1.Bottom := R1.Top + Canvas.TextHeight( fCaption );
                rgntxt := CreateRectRgnIndirect( R1 );
              end;

              GetRgnBox( rgntxt, R0 );
              rgn2 := CreateRectRgnIndirect( R0 );

              rgnsav := CreateRectRgn( 0, 0, 0, 0 );
              GetClipRgn( DC, rgnsav );
              ExtSelectClipRgn( DC, rgn2, RGN_DIFF );
              DeleteObject( rgn2 );

              BeginPath( DC );
              DrawEdge( DC, R, BDR_RAISEDINNER or BDR_SUNKENOUTER, BF_RECT );
              EndPath( DC );
              rgn := PathToRegion( DC );
              if rgn = 0 then DoEraseBkgnd;
              DrawEdge( DC, R, BDR_RAISEDINNER or BDR_SUNKENOUTER, BF_RECT );

              SelectClipRgn( DC, rgnsav );
              DeleteObject( rgnsav );

              if rgn <> 0 then
              begin
                ExtSelectClipRgn( DC, rgn, RGN_DIFF );
                DeleteObject( rgn );
              end;
              ExtSelectClipRgn( DC, rgntxt, RGN_DIFF );
              DeleteObject( rgntxt );

              if not bk_erased then DoEraseBkgnd;
          End;
      FINALLY
          SelectClipRgn( DC, rgnsavall );
          DeleteObject( rgnsavall );
      END;
end;
{$ENDIF USE_GRAPHCTLS}//--------------------------------------------------------

{$IFDEF ASM_VERSION}{$ELSE PASCAL}
function TControl.MakeWordWrap: PControl;
begin {$IFDEF USE_FLAGS} include( fFlagsG1, G1_WordWrap );
      {$ELSE}            fWordWrap := TRUE; {$ENDIF}
      if  IsButton then
          Style := fStyle.Value or BS_MULTILINE
      else
          Style := fStyle.Value and not SS_LEFTNOWORDWRAP;
      Result := @ Self;
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
function ParentAnchorChildren( Sender: PControl; var Msg: TMsg;
  var Rslt: Integer ): Boolean;
var NewW, NewH: Integer;
    dW, dH: Integer;
    i: Integer;
    C: PControl;
    {$IFNDEF ANCHORS_WM_SIZE}
    CR: TRect;
    {$ENDIF}
begin Result := FALSE;
      If  (Msg.message = {$IFDEF ANCHORS_WM_SIZE} WM_SIZE {$ELSE} WM_WINDOWPOSCHANGED {$ENDIF} )
          and not IsIconic(Sender.Handle) then begin
          {$IFDEF ANCHORS_WM_SIZE}
          NewW := LoWord( Msg.lParam );
          NewH := HiWord( Msg.lParam );
          {$ELSE}
          CR := Sender.ClientRect;
          NewW := CR.Right;
          NewH := CR.Bottom;
          {$ENDIF}
          dW := NewW - Sender.fOldWidth;
          dH := NewH - Sender.fOldHeight;
          For i := 0 to Sender.ChildCount - 1 do begin
              C := Sender.Children[ i ];
              If  dW <> 0 then begin
                  if C.AnchorRight and C.AnchorLeft then
                    C.Width := C.Width + dW
                  else if C.AnchorRight then
                    C.Left := C.Left + dW;
              End;
              If  dH <> 0 then begin
                  if C.AnchorBottom and C.AnchorTop then
                    C.Height := C.Height + dH
                  else if C.AnchorBottom then
                    C.Top := C.Top + dH;
              End;
          End;
          Sender.fOldWidth := NewW;
          Sender.fOldHeight := NewH;
      End;
end;////////////////////////////////////////////////////////////////////////////
function TControl.Anchor(aLeft, aTop, aRight, aBottom: Boolean): PControl;
begin if   (not aLeft) and aRight then
           AnchorLeft := FALSE
      else AnchorLeft := aLeft;
      if   (not aTop) and aBottom then
           AnchorTop := FALSE
      else AnchorTop := aTop;
      AnchorRight := aRight;
      AnchorBottom := aBottom;
      Result := @ Self;
end;
function TControl.GetLBTopIndex: Integer;
begin Result := Perform(LB_GETTOPINDEX,0,0);
end;////////////////////////////////////////////////////////////////////////////
function TControl.LBItemAtPos(X, Y: Integer): Integer;
var R: TRect;
    P: TPoint;
    i: Integer;
begin P := MakePoint(X,Y);
      For i := LBTopIndex to Count -1 do begin
          Perform(LB_GETITEMRECT, i , Integer(@R));
          if  PointInRect(P,R) then begin
              Result := i; Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
          end;
      End;
      Result := -1;
end;////////////////////////////////////////////////////////////////////////////
procedure TControl.SetLBTopIndex(const Value: Integer);
begin Perform(LB_SETTOPINDEX,Value,0); end;/////////////////////////////////////
{$ENDIF WIN_GDI}//--------------------------------------------------------------
{$IFDEF ASM_VERSION}{$ELSE  PAS_VERSION}
function TControl.FormGetIntParam: Integer;
var C: Byte;
    Sign, Cont: Boolean;
begin Result := 0;
      While TRUE do begin
          C := Byte( DF.FormParams^ );
          inc( DF.FormParams );
          Cont := C and 1 <> 0;
          C := C shr 1;
          If  Cont then
              Result := (Result shl 7) or C
          else begin
              Sign := C and 1 <> 0;
              C := C shr 1;
              Result := (Result shl 6) or C;
              if  Sign then
                  Result := -Result;
              break;
          End;
      End;
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}
function TControl.FormGetColorParam: Integer;
begin Result := FormGetIntParam;
      Result := (Result shr 1) or (Result shl 31);
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE  PASCAL}
procedure TControl.FormGetStrParam;
var i: Integer;
begin i := FormGetIntParam;
      SetString( FormString, DF.FormParams, i );
      inc( DF.FormParams, i );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure TControl.FormCreateParameters(
    alphabet: PFormInitFuncArray;
    params: PAnsiChar );
begin DF.FormCurrentParent := @Self;
      DF.FormLastCreatedChild := @Self;
      DF.FormParams := params;
      DF.FormAlphabet := alphabet;
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE  PASCAL}
procedure TControl.FormExecuteCommands(AForm: PControl; ControlPtrOffsets: PSmallIntArray);
var N: Integer;
    Ctrl: PPcontrol;
begin while {FormParams <> ''} TRUE do begin
          N := FormGetIntParam;
          if  N = 0 then
              break;
          if  N < 0 then
          begin
              N := -N;
              Ctrl := PPControl( Pointer( Integer(AForm)
                                 + (ControlPtrOffsets[0] shl 2) ) );
              ControlPtrOffsets := Pointer( Integer( ControlPtrOffsets ) + 2 );
              Ctrl^ := DF.FormAlphabet[N-1]( @Self );
              DF.FormLastCreatedChild := Ctrl^;
          end else begin
              Ctrl := @ DF.FormLastCreatedChild;
              PFormInitFuncArray1( DF.FormAlphabet )[N-1]( Ctrl^, 1 );
          end;
      end;
      FormString := '';
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}
procedure FormPrepareStrParamCreateCtrl;
asm PUSH EAX
    CALL TControl.FormGetStrParam
    POP  ECX
    MOV  EAX, [ECX].TControl.DF.FormCurrentParent
    MOV  EDX, [ECX].TControl.FormString
end;////////////////////////////////////////////////////////////////////////////
procedure FormPrepareIntParamCreateCtrl;
asm PUSH EAX
    CALL TControl.FormGetIntParam
    XCHG EDX, EAX
    POP  ECX
    MOV  EAX, [ECX].TControl.DF.FormCurrentParent
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}
function FormNewLabel( Form: PControl ): PControl;
begin Form.FormGetStrParam;
      Result := NewLabel( Form.DF.FormCurrentParent, Form.FormString );
end;
{$ENDIF}////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}
function FormNewWordWrapLabel( Form: PControl ): PControl;
begin Form.FormGetStrParam;
      Result := NewWordWrapLabel( Form.DF.FormCurrentParent, Form.FormString );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}
function FormNewLabelEffect( Form: PControl ): PControl;
var Shd: Integer;
begin Form.FormGetStrParam;
      Shd := Form.FormGetIntParam;
      Result := NewLabelEffect( Form.DF.FormCurrentParent, Form.FormString, Shd );
end;
{$ENDIF}////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}
function FormNewButton( Form: PControl ): PControl;
begin Form.FormGetStrParam;
      Result := NewButton( Form.DF.FormCurrentParent, Form.FormString );
end;
{$ENDIF}////////////////////////////////////////////////////////////////////////
function FormNewBitBtn( Form: PControl ): PControl;
type PBitBtnOptions = ^TBitBtnOptions;
var Cap: KOLString;
    i, j, k, bmp: Integer;
begin Form.FormGetStrParam;
      Cap := Form.FormString;
      i := Form.FormGetIntParam;
      j := Form.FormGetIntParam;
      Form.FormGetStrParam;
      k := Form.FormGetIntParam;
      bmp := 0;
      if  Form.FormString <> '' then
          bmp := LoadBmp( hInstance, PKOLChar( KOLString( Form.FormString ) ), Form );
    Result := NewBitBtn( Form.DF.FormCurrentParent, Cap,
                         PBitBtnOptions( @i )^,
                         TGlyphLayout( j ),
                         bmp, k );
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}
function FormNewPanel( Form: PControl ): PControl;
begin Result := NewPanel( Form.DF.FormCurrentParent,
                          TEdgeStyle( Form.FormGetIntParam ) );
end;
{$ENDIF}////////////////////////////////////////////////////////////////////////
function FormNewGradientPanel( Form: PControl ): PControl;
var C1, C2: TColor;
begin C1 := Form.FormGetColorParam;
      C2 := Form.FormGetColorParam;
      Result := NewGradientPanel( Form.DF.FormCurrentParent, C1, C2 );
end;////////////////////////////////////////////////////////////////////////////
function FormNewGradientPanelEx( Form: PControl ): PControl;
var C1, C2: TColor;
    Style, Layout: Integer;
begin C1 := Form.FormGetColorParam;
      C2 := Form.FormGetColorParam;
      Style := Form.FormGetIntParam;
      Layout := Form.FormGetIntParam;
      Result := NewGradientPanelEx( Form.DF.FormCurrentParent, C1, C2,
          TGradientStyle( Style ), TGradientLayout( Layout ) );
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE  PASCAL}
function FormNewGroupbox( Form: PControl ): PControl;
begin Form.FormGetStrParam;
      Result := NewGroupbox( Form.DF.FormCurrentParent,
                             Form.FormString );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
function FormNewPaintbox( Form: PControl ): PControl;
begin Result := NewPaintbox( Form.DF.FormCurrentParent ); end;//////////////////
function FormNewImageShow( Form: PControl ): PControl;
begin Result := NewImageShow( Form.DF.FormCurrentParent, nil, 0 ); end;/////////
{$IFDEF ASM_VERSION}{$ELSE}
function FormNewEditBox( Form: PControl ): PControl;
type PEditOptions = ^TEditOptions;
var  i: Integer;
begin i := Form.FormGetIntParam;
      Result := NewEditbox( Form.DF.FormCurrentParent, PEditOptions( @ i )^ );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF USE_RICHEDIT}///////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}
function FormNewRichEdit( Form: PControl ): PControl;
type PEditOptions = ^TEditOptions;
var  i: Integer;
begin i := Form.FormGetIntParam;
      Result := NewRichEdit( Form.DF.FormCurrentParent,
                             PEditOptions( @ i )^ );
end;
{$ENDIF PAS_VERSION}
{$ENDIF USE_RICHEDIT}///////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}
function FormNewComboBox( Form: PControl ): PControl;
type PComboOptions = ^TComboOptions;
var  i: Integer;
begin i := Form.FormGetIntParam;
      Result := NewCombobox( Form.DF.FormCurrentParent, PComboOptions( @ i )^ );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}
function FormNewCheckbox( Form: PControl ): PControl;
begin Form.FormGetStrParam;
      Result := NewCheckbox( Form.DF.FormCurrentParent, Form.FormString );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}
function FormNewRadiobox( Form: PControl ): PControl;
begin Form.FormGetStrParam;
      Result := NewRadiobox( Form.DF.FormCurrentParent, Form.FormString );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
function FormNewSplitter( Form: PControl ): PControl;
var p, n: Integer;
begin p := Form.FormGetIntParam;
      n := Form.FormGetIntParam;
      Result := NewSplitter( Form.DF.FormCurrentParent, p, n );
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}
function FormNewListbox( Form: PControl ): PControl;
type PListOptions = ^TListOptions;
var  i: Integer;
begin i := Form.FormGetIntParam;
      Result := NewListbox( Form.DF.FormCurrentParent, PListOptions( @ i )^ );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
function FormNewListView( Form: PControl ): PControl;
type PListViewOptions = ^TListViewOptions;
var lvs: TListViewStyle;
    i: Integer;
begin lvs := TListViewStyle( Form.FormGetIntParam );
      i := Form.FormGetIntParam;
      Result := NewListView( Form.DF.FormCurrentParent,
                             lvs, PListViewOptions( @i )^,
                             nil, nil, nil );
end;////////////////////////////////////////////////////////////////////////////
function FormNewTreeView( Form: PControl ): PControl;
type PTreeViewOptions = ^TTreeViewOptions;
var i: Integer;
begin i := Form.FormGetIntParam;
      Result := NewTreeView( Form.DF.FormCurrentParent,
                             PTreeViewOptions( @i )^,
                             nil, nil );
end;////////////////////////////////////////////////////////////////////////////
function FormNewScrollbox( Form: PControl ): PControl;
type PScrollerBars = ^TScrollerBars;
var es: TEdgeStyle;
    b: Integer;
begin es := TEdgeStyle( Form.FormGetIntParam );
      b := Form.FormGetIntParam;
      Result := NewScrollbox( Form.DF.FormCurrentParent, es, PScrollerBars( @ b )^ );
end;////////////////////////////////////////////////////////////////////////////
function FormNewScrollboxEx( Form: PControl ): PControl;
begin Result := NewScrollboxEx( Form.DF.FormCurrentParent,
                                TEdgeStyle( Form.FormGetIntParam ) );
end;////////////////////////////////////////////////////////////////////////////
function FormNewScrollBar( Form: PControl ): PControl;
begin Result := NewScrollbar( Form.DF.FormCurrentParent,
                              TScrollerBar( Form.FormGetIntParam ) );
end;////////////////////////////////////////////////////////////////////////////
function FormNewProgressBar( Form: PControl ): PControl;
begin Result := NewProgressBar( Form.DF.FormCurrentParent ); end;///////////////
function FormNewProgressBarEx( Form: PControl ): PControl;
type PProgressbarOptions = ^TProgressbarOptions;
begin Result := NewProgressBarEx( Form.DF.FormCurrentParent,
                                  PProgressbarOptions(Form.FormGetIntParam)^ );
end;////////////////////////////////////////////////////////////////////////////
function FormNewDateTimePicker( Form: PControl ): PControl;
type PDateTimePickerOptions = ^TDateTimePickerOptions;
var o: Integer;
begin o := Form.FormGetIntParam;
      Result := NewDateTimePicker( Form.DF.FormCurrentParent,
                                   PDateTimePickerOptions( @ o )^ );
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF _D4orHigher}
function FormNewTabControl( Form: PControl ): PControl;
type PTabControlOptions = ^TTabControlOptions;
var N, i, o: Integer;
    Tabs1: array of KOLString;
    Tabs2: array of PKOLChar;
begin N := Form.FormGetIntParam;
      SetLength( Tabs1, N );
      SetLength( Tabs2, N );
      for i := 0 to N-1 do
      begin
          Form.FormGetStrParam;
          Tabs1[i] := Form.FormString;
          Tabs2[i] := PKOLChar( Tabs1[i] );
      end;
      o := Form.FormGetIntParam;
      i := Form.FormGetIntParam;
      Result := NewTabControl( Form.DF.FormCurrentParent,
                               Tabs2,
                               PTabControlOptions(@ o)^,
                               nil, i );
      SetLength( Tabs1, 0 );
      SetLength( Tabs2, 0 );
end;
{$ENDIF}////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ENDIF PAS_VERSION}////////////////////////////////////////
function ParentForm_PCharParam(Control: PControl): PKOLChar;
var Form: PControl;
begin Form := Control.FormParentForm;
      Form.FormGetStrParam;
      Result := PKOLChar( KOLString( Form.FormString ) );
end;////////////////////////////////////////////////////////////////////////////
function ParentForm_IntParamPas(Form: PControl): Integer;
begin Result := Form.FormParentForm.FormGetIntParam; end;///////////////////////////
function ParentForm_ColorParamPas(Form: PControl): Integer;
begin Result := Form.FormParentForm.FormGetColorParam; end;/////////////////////////
{$IFDEF ASM_VERSION} // only to call from asm -- returns EAX=Parent Form, EDX=ECX=PChar param
{$ENDIF ASM_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE  PASCAL}
procedure FormSetSize( Form: PControl );
var W, H: Integer;
begin W := ParentForm_IntParamPas( Form );
      H := ParentForm_IntParamPas( Form );
      Form.SetSize( W, H );
end;
{$ENDIF}////////////////////////////////////////////////////////////////////////
procedure FormSetHeight( Form: PControl );
begin Form.Height := ParentForm_IntParamPas(Form); end;/////////////////////////
procedure FormSetWidth( Form: PControl );
begin Form.Width := ParentForm_IntParamPas(Form); end;//////////////////////////
{$IFDEF ASM_VERSION}{$ELSE  PASCAL}
procedure FormSetPosition( Form: PControl );
var X, Y: Integer;
begin X := ParentForm_IntParamPas(Form);
      Y := ParentForm_IntParamPas(Form);
      Form.SetPosition( X, Y );
end;
{$ENDIF}////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE  PASCAL}
procedure FormSetClientSize( Form: PControl );
var W, H: Integer;
begin W := ParentForm_IntParamPas(Form);
      H := ParentForm_IntParamPas(Form);
      Form.SetClientSize( W, H );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE  PASCAL}
procedure FormSetAlign( Form: PControl );
begin Form.SetAlign( TControlAlign( ParentForm_IntParamPas(Form) ) ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF USE_NAMES}
procedure FormSetName( Form: PControl );
var C: PControl;
begin C := Form;
      Form := Form.FormParentForm;
      Form.FormGetStrParam;
      C.SetName( Form, Form.FormString );
end;
{$ENDIF USE_NAMES}//////////////////////////////////////////////////////////////
procedure FormSetTag( Form: PControl );
var tag: DWORD;
begin
    tag := ParentForm_IntParamPas(Form);
    Form.Tag := tag;
end;
{$IFDEF UNICODE_CTRLS}
procedure FormSetUnicode( Form: PControl );
begin Form.SetUnicode( TRUE ); end;
{$ENDIF UNICODE_CTRLS}//////////////////////////////////////////////////////////
procedure FormAssignHelpContext( Form: PControl );
begin Form.AssignHelpContext( ParentForm_IntParamPas( Form ) ); end;////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetCanResizeFalse( Form: PControl );
begin Form.CanResize := FALSE; end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormInitMenu( Form: PControl );
begin Form.Perform( WM_INITMENU, 0, 0 ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormSizeGripFalse( Form: PControl );
begin Form.SizeGrip := FALSE; end; /////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetExStyle( Form: PControl );
begin Form.ExStyle := Form.ExStyle or DWORD( ParentForm_IntParamPas(Form) ); end;
{$ENDIF}////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetVisibleFalse( Form: PControl );
begin Form.Visible := FALSE; end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetEnabledFalse( Form: PControl );
begin Form.Enabled := FALSE; end;
{$ENDIF}////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormResetStyles( Form: PControl );
begin Form.Style := Form.Style and not ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetStyle( Form: PControl );
begin Form.Style := Form.Style or DWORD( ParentForm_IntParamPas(Form)); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE  PASCAL}
procedure FormSetAlphaBlend( Form: PControl );
begin Form.AlphaBlend := ParentForm_IntParamPas( Form ); end;
{$ENDIF}////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetHasBorderFalse( Form: PControl );
begin Form.HasBorder := FALSE; end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetHasCaptionFalse( Form: PControl );
begin Form.HasCaption := FALSE; end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormResetCtl3D( Form: PControl );
begin Form.Ctl3D := FALSE; end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormIconLoad_hInstance( Form: PControl );
begin Form.IconLoad( hInstance,
                     MAKEINTRESOURCE( ParentForm_IntParamPas(Form) ) );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormIconLoadCursor_0( Form: PControl );
begin Form.IconLoadCursor( 0, MakeIntResource( ParentForm_IntParamPas(Form) ) );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetIconNeg1( Form: PControl );
begin Form.Icon := THandle( -1 ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormIconLoad_hInstance_str( Form: PControl );
begin Form.FormGetStrParam;
      Form.IconLoad( hInstance, PKOLChar( KOLString( Form.FormString ) ) );
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetWindowState( Form: PControl );
begin Form.WindowState := TWindowState( ParentForm_IntParamPas(Form) ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormCursorLoad_0( Form: PControl );
begin Form.CursorLoad( 0, MAKEINTRESOURCE( ParentForm_IntParamPas(Form) ) ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormCursorLoad_hInstance( Form: PControl );
var C: PControl;
begin C := Form;
      Form := Form.FormParentForm;
      Form.FormGetStrParam;
      C.CursorLoad( 0, PKOLChar( KOLString( Form.FormString ) ) );
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetColor( Form: PControl );
begin Form.Color := ParentForm_ColorParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetBrushStyle( Form: PControl );
begin Form.Brush.BrushStyle := TBrushStyle( ParentForm_IntParamPas(Form) ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetBrushBitmap( Form: PControl );
var C: PControl;
begin C := Form;
      Form := Form.FormParentForm;
      {$IFDEF UNICODE_CTRLS}
      Form.FormGetStrParam;
      {$ENDIF}
      C.Brush.BrushBitmap :=
          LoadBmp( hInstance,
          {$IFDEF UNICODE_CTRLS} PKOLChar( KOLString( Form.FormString ) )
          {$ELSE}                ParentForm_PCharParam(Form)
          {$ENDIF}               , Form );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetFontColor( Form: PControl );
begin Form.Font.Color := ParentForm_ColorParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetFontStyles( Form: PControl );
type PFontStyle = ^TFontStyle;
var fs: Byte;
begin fs := ParentForm_IntParamPas(Form);
      Form.Font.FontStyle := PFontStyle( @ fs )^;
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetFontHeight( Form: PControl );
begin Form.Font.FontHeight := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetFontWidth( Form: PControl );
begin Form.Font.FontWidth := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure ParentForm_StrParam( Form: PControl );
begin Form := Form.FormParentForm;
      Form.FormGetStrParam;
end;////////////////////////////////////////////////////////////////////////////
procedure FormSetFontName( Form: PControl );
begin ParentForm_StrParam(Form);
      Form.Font.FontName := Form.FormParentForm.FormString;
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetFontOrientation( Form: PControl );
begin Form.Font.FontOrientation := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetFontCharset( Form: PControl );
begin Form.Font.FontCharset := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetFontPitch( Form: PControl );
begin Form.Font.FontPitch := TFontPitch( ParentForm_IntParamPas(Form) ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetBorder( Form: PControl );
begin Form.Border := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetMarginTop( Form: PControl );
begin Form.MarginTop := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetMarginBottom( Form: PControl );
begin Form.MarginBottom := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetMarginLeft( Form: PControl );
begin Form.MarginLeft := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetMarginRight( Form: PControl );
begin Form.MarginRight := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetSimpleStatusText( Form: PControl );
begin Form.SimpleStatusText := ParentForm_PCharParam(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetStatusText( Form: PControl );
var I: Integer;
begin I := ParentForm_IntParamPas(Form);
      Form.StatusText[I] := ParentForm_PCharParam(Form);
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormRemoveCloseIcon( Form: PControl );
begin DeleteMenu( GetSystemMenu( Form.GetWindowHandle, False ),
                  SC_CLOSE, MF_BYCOMMAND );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormSetEraseBkgndTrue( Form: PControl );
begin Form.EraseBackground := TRUE; end;
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetMinWidth( Form: PControl );
begin Form.MinWidth := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetMaxWidth( Form: PControl );
begin Form.MaxWidth := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetMinHeight( Form: PControl );
begin Form.MinHeight := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetMaxHeight( Form: PControl );
begin Form.MaxHeight := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF noASM_VERSION}
procedure FormSetRepeatInterval( Form: PControl );
asm CALL ParentForm_IntParamAsm
    MOV  [EAX].TControl.fRepeatInterval, EDX
end;
{$ELSE PAS_VERSION}
procedure FormSetRepeatInterval( Form: PControl );
begin Form.RepeatInterval := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormSetKeyPreviewTrue( Form: PControl );
begin {$IFDEF KEY_PREVIEW}
          Form.KeyPreview := TRUE;
      {$ENDIF}
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetTextShiftX( Form: PControl );
begin Form.TextShiftX := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetTextShiftY( Form: PControl );
begin Form.TextShiftY := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetColor2( Form: PControl );
begin Form.Color2 := ParentForm_ColorParamPas( Form ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetTextAlign( Form: PControl );
begin Form.TextAlign := TTextAlign( ParentForm_IntParamPas(Form) ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetTextVAlign( Form: PControl );
begin Form.VerticalAlign := TVerticalAlign( ParentForm_IntParamPas(Form) ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormSetTabStopFalse( Form: PControl );
begin Form.TabStop := FALSE; end;
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetIgnoreDefault( Form: PControl );
begin Form.IgnoreDefault := Boolean( ParentForm_IntParamPas(Form) ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormSetHintText( Form: PControl );
begin {$IFDEF USE_MHTOOLTIP}
      ParentForm_StrParam(Form);
      Form.Hint.Text := Form.FormParentForm.FormString;
      {$ENDIF USE_MHTOOLTIP}
end;////////////////////////////////////////////////////////////////////////////
procedure FormSetAnchor( Form: PControl );
var i: Integer;
begin i := ParentForm_IntParamPas(Form);
      Form.AnchorLeft   := I and 1 <> 0;
      Form.AnchorTop    := I and 2 <> 0;
      Form.AnchorRight  := I and 4 <> 0;
      Form.AnchorBottom := I and 8 <> 0;
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetCaption( Form: PControl );
var   Ctl: PControl;
begin Ctl := Form;
      Form := Form.FormParentForm;
      Form.FormGetStrParam;
      Ctl.Caption := Form.FormString;
end;
{$ENDIF PAS_VERSION}
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetGradienStyle( Form: PControl );
begin Form.GradientStyle := TGradientStyle( ParentForm_IntParamPas(Form) ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormOverrideScrollbars( Form: PControl );
begin OverrideScrollbars( Form ); end;
{$IFDEF USE_RICHEDIT}
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetRE_AutoFontFalse( Form: PControl );
begin Form.RE_AutoFont := FALSE; end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetRE_AutoFontSizeAdjustFalse( Form: PControl );
begin Form.RE_AutoFontSizeAdjust := FALSE; end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetRE_DualFontTrue( Form: PControl );
begin Form.RE_DualFont := TRUE; end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetRE_UIFontsTrue( Form: PControl );
begin Form.RE_UIFonts := TRUE; end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetRE_IMECancelCompleteTrue( Form: PControl );
begin Form.RE_IMECancelComplete := TRUE; end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetRE_IMEAlwaysSendNotifyTrue( Form: PControl );
begin Form.RE_IMEAlwaysSendNotify := TRUE; end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetMaxTextSize( Form: PControl );
begin Form.MaxTextSize := DWORD( ParentForm_IntParamPas(Form) ); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetRE_AutoKeyboardTrue( Form: PControl );
begin Form.RE_AutoKeyboard := TRUE; end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormSetRE_DisableOverwriteChangeTrue( Form: PControl );
begin Form.RE_DisableOverwriteChange := TRUE;
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetRE_Zoom( Form: PControl );
var   zoom: TSmallPoint;
begin zoom.X := ParentForm_IntParamPas(Form);
      zoom.Y := ParentForm_IntParamPas(Form);
      Form.RE_Zoom := zoom;
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$ENDIF USE_RICHEDIT}
procedure FormSetListItems( Form: PControl );
var N, i: Integer;
begin N := ParentForm_IntParamPas(Form);
      for i := 0 to N-1 do BEGIN
          ParentForm_StrParam(Form);
          Form.Items[i] := Form.FormParentForm.FormString;
      END;
end;
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetCount( Form: PControl );
begin Form.Count := ParentForm_IntParamPas(Form);
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetDroppedWidth( Form: PControl );
begin Form.DroppedWidth := ParentForm_IntParamPas(Form);
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormSetButtonIcon( Form: PControl );
begin
    Form.SetButtonIcon( LoadImage( hInstance,
         ParentForm_PCharParam(Form),
         IMAGE_ICON, 0, 0, $8000 {LR_SHARED} ) );
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetButtonImage( Form: PControl );
var   w, h: Integer;
begin w := ParentForm_IntParamPas(Form);
      h := ParentForm_IntParamPas(Form);
      Form.SetButtonIcon( LoadImage( hInstance,
          ParentForm_PCharParam(Form),
          IMAGE_ICON, w, h, $8000 {LR_SHARED} ) );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetButtonBitmap( Form: PControl );
begin Form.SetButtonBitmap( LoadBitmap( hInstance,
           ParentForm_PCharParam(Form) ) );
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormSetDefaultBtn( Form: PControl );
var i: Integer;
begin i := ParentForm_IntParamPas(Form);
      Form.SetDefaultBtn( i, TRUE );
end;
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetMaxProgress( Form: PControl );
begin Form.MaxProgress := ParentForm_IntParamPas(Form);
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetProgress( Form: PControl );
begin Form.Progress := ParentForm_IntParamPas(Form);
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormLVColumsAdd( Form: PControl );
var   N, i, w: Integer;
begin N := ParentForm_IntParamPas(Form);
      for i := 0 to N-1 do BEGIN
          w := ParentForm_IntParamPas(Form);
          ParentForm_StrParam(Form);
          Form.LVColAdd( Form.FormParentForm.FormString, taLeft, w );
      END;
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetLVColOrder( Form: PControl );
var   N, i: Integer;
begin N := ParentForm_IntParamPas(Form);
      i := ParentForm_IntParamPas(Form);
      Form.LVColOrder[N] := i;
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetLVColImage( Form: PControl );
var   N, i: Integer;
begin N := ParentForm_IntParamPas(Form);
      i := ParentForm_IntParamPas(Form);
      Form.LVColImage[N] := i;
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetTVIndent( Form: PControl );
begin Form.TVIndent := ParentForm_IntParamPas(Form);
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormSetTBBtnImgWidth( Form: PControl );
begin Form.TBBtnImgWidth := ParentForm_IntParamPas( Form );
end;////////////////////////////////////////////////////////////////////////////
procedure FormTBAddBitmap( Form: PControl );
var   map: array[ 0..1 ] of TColor;
      b: Integer;
      C: PControl;
begin C := Form;
      Form := Form.FormParentForm;
      b := Form.FormGetIntParam;
      if  b >= 0 then
      begin
          Form.FormGetStrParam;
          if  b <> 0 then
          begin
              map[0] := Form.FormGetColorParam;
              map[1] := Color2RGB( clBtnFace );
              b := LoadMappedBitmapEx( Form, hInstance, PKOLChar( KOLString( Form.FormString )), map );
          end else
              b := LoadBmp( hInstance, PKOLChar(KOLString(Form.FormString)), Form );
      end;
      C.TBAddBitmap( b );
end;////////////////////////////////////////////////////////////////////////////
procedure FormSetTBButtonSize( Form: PControl );
begin Form.Perform( TB_SETBUTTONSIZE, 0,
                    ParentForm_IntParamPas(Form) or $10000 {or (HiWord(HW) shl 16)} );
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF _D4orHigher}
procedure FormTBSetTooltips( Form: PControl );
var   A1: array of KOLString;
      A2: array of PKOLChar;
      N, i: Integer;
      C: PControl;
begin C := Form;
      Form := Form.FormParentForm;
      N := Form.FormGetIntParam;
      SetLength( A1, N );
      SetLength( A2, N );
      for i := 0 to N-1 do
      begin
          Form.FormGetStrParam;
          A1[i] := Form.FormString;
          A2[i] := PKOLChar( A1[i] );
      end;
      C.TBSetTooltips( 0, A2 );
      SetLength( A1, 0 );
      SetLength( A2, 0 );
end;
{$ENDIF _D4orHigher}////////////////////////////////////////////////////////////
procedure FormSetTBButtonsMinWidth( Form: PControl );
begin Form.TBButtonsMinWidth := ParentForm_IntParamPas(Form);
end;////////////////////////////////////////////////////////////////////////////
procedure FormSetTBButtonsMaxWidth( Form: PControl );
begin Form.TBButtonsMaxWidth := ParentForm_IntParamPas(Form);
end;////////////////////////////////////////////////////////////////////////////
procedure FormHideToolbarButton( Form: PControl );
var i: Integer;
begin i := ParentForm_IntParamPas(Form);
      {$IFDEF USE_GRUSH}
              ShowHideToolbarButton( Form, i, FALSE );
      {$ELSE} Form.TBButtonVisible[ i ] := FALSE; {$ENDIF}
end;////////////////////////////////////////////////////////////////////////////
procedure FormDisableToolbarButton( Form: PControl );
var   i: Integer;
begin i := ParentForm_IntParamPas(Form);
      {$IFDEF USE_GRUSH}
              EnableToolbarButton( Form, i, FALSE );
      {$ELSE} Form.TBButtonEnabled[ i ] := FALSE; {$ENDIF}
end;////////////////////////////////////////////////////////////////////////////
procedure FormFixFlatXPToolbar( Form: PControl );
begin Form.OnTBCustomDraw := nil;
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetDateTimeFormat( Form: PControl );
begin ParentForm_StrParam(Form);
      Form.DateTimeFormat := Form.FormParentForm.FormString;
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormSetDateTimeColor( Form: PControl );
var   i: Integer;
      C: TColor;
begin C := ParentForm_ColorParamPas( Form );
      i := ParentForm_IntParamPas( Form );
      Form.DateTimePickerColors[TDateTimePickerColor(i)] := C;
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetCurrentTab( Form: PControl );
var i: Integer;
begin i := ParentForm_IntParamPas(Form);
      Form.CurIndex := i;
      Form.Pages[i].BringToFront;
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetCurIdx( Form: PControl );
begin Form.CurIndex := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetSBMin( Form: PControl );
begin Form.SBMin := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetSBMax( Form: PControl );
begin Form.SBMax := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetSBPosition( Form: PControl );
begin Form.SBPosition := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetSBPageSize( Form: PControl );
begin Form.SBPageSize := ParentForm_IntParamPas(Form); end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormLastCreatedChildAsNewCurrentParent( Form: PControl );
var   C: PControl;
begin C := Form;
      Form := Form.FormParentForm;
      Form.DF.FormCurrentParent := C;
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormSetUpperParent( Form: PControl );
begin Form := Form.FormParentForm;
      Form.DF.FormCurrentParent := Form.DF.FormCurrentParent.Parent;
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}
procedure FormSetTabpageAsParent( Form: PControl );
var   i: Integer;
      C: PControl;
begin C := Form;
      Form := Form.FormParentForm;
      i := Form.FormGetIntParam;
      Form.DF.FormCurrentParent := C.Pages[i];
      Form.DF.FormLastCreatedChild := Form.DF.FormCurrentParent;
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE PASCAL}//////////////////////////////////////////////
procedure FormSetCurCtl( Form: PControl );
var   i: Integer;
      C: PControl;
begin Form := Form.FormParentForm;
      i := Form.FormGetIntParam;
      C := PPControl(Integer( Form.DF.FormAddress ) + i * 4)^;
      if  C = nil then C := Form;
      Form.DF.FormLastCreatedChild := C;
end;
{$ENDIF PAS_VERSION}////////////////////////////////////////////////////////////
procedure FormSetParent( Form: PControl );
var   C: PControl;
begin C := Form;
      Form := Form.FormParentForm;
      Form.DF.FormCurrentParent := C;
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}/////////////////////////////////////////////////////
procedure FormSetEvent( Form: PControl );
type  TSetEventProc = procedure( TargetCtl: PControl; const event: TOnEvent );
var   C: PControl;
      idx_handler, idx_setter: Integer;
      handler, setter: Pointer;
      event: TOnEvent;
      set_proc: TSetEventProc;
begin C := Form;
      Form := Form.FormParentForm;
      idx_handler := Form.FormGetIntParam;
      idx_setter := Form.FormGetIntParam;
      handler := @Form.DF.FormAlphabet[idx_handler];
      setter := @Form.DF.FormAlphabet[idx_setter];
      set_proc := TSetEventProc( setter );
      Pointer( TMethod( event ).Code ) := handler;
      TMethod( event ).Data := Form.DF.FormObj;
      set_proc( PControl( C ), event );
end;
{$ENDIF}////////////////////////////////////////////////////////////////////////
{$IFDEF ASM_VERSION}{$ELSE}/////////////////////////////////////////////////////
procedure FormSetIndexedEvent( Form: PControl );
type  TSetIndexedEventProc = procedure( TargetCtl: PControl; Index: Integer;
                                        const event: TOnEvent );
var   C: PControl;
      idx_handler, idx_setter, idx: Integer;
      handler, setter: Pointer;
      event: TOnEvent;
      set_proc: TSetIndexedEventProc;
begin C := Form;
      Form := Form.FormParentForm;
      idx_handler := Form.FormGetIntParam;
      idx := Form.FormGetIntParam;
      idx_setter := Form.FormGetIntParam;
      handler := @Form.DF.FormAlphabet[idx_handler];
      setter := @Form.DF.FormAlphabet[idx_setter];
      set_proc := TSetIndexedEventProc( setter );
      Pointer( TMethod( event ).Code ) := handler;
      TMethod( event ).Data := Form.DF.FormObj;
      set_proc( PControl( C ), idx, event );
end;
{$ENDIF}////////////////////////////////////////////////////////////////////////
procedure DummyOverrideScrollbars(Sender: PControl);
begin
end;

{$IFnDEF PAS_VERSION}
    {$I KOL_ASM.inc} //<<<<<<<<<<<<<<<<<<<<<<< KOL_ASM.inc
    {$IFnDEF UNICODE_CTRLS}
        {$I KOL_ASM_NOUNICODE.inc} //<<<<<<<<< KOL_ASM_NOUNICODE.inc
    {$ENDIF noUNICODE}
{$ENDIF PAS_VERSION}
{$IFDEF LIN}
  {$DEFINE implementation} {$I KOL_Linux.inc} {$UNDEF implementation}
{$ENDIF LIN}

{$IFDEF USE_CUSTOMEXTENSIONS}
  {$I CUSTOM_CODE_EXTENSION.inc} // See comments in TControl
{$ENDIF USE_CUSTOMEXTENSIONS}

{$IFDEF EVENTS_DYNAMIC}//-------------------------------------------------------
{$IFDEF ASM_VERSION}
function TControl.ProvideUniqueEvents: PEvents;
const Size_TEvents = Sizeof(TEvents);
asm      PUSH  ESI
         XCHG  ESI, EAX
         MOV   EAX, [ESI].TControl.EV
         CMP   EAX, offset[EmptyEvents]
         JNZ   @@ready

         MOV   EAX, Size_TEvents
         CALL  System.@GetMem
         MOV   [ESI].TControl.EV, EAX
         PUSH  EAX
         XCHG  EDX, EAX
         MOV   EAX, offset[EmptyEvents]
         MOV   ECX, Size_TEvents
         CALL  Move
         PUSH  ESI
         PUSH  offset[FreeEV]
         XCHG  EAX, ESI
         CALL  TControl.Add2AutoFreeEx
         POP   EAX
@@ready:
         POP   ESI
end;
{$ELSE}
function TControl.ProvideUniqueEvents: PEvents;
begin if  EV = @EmptyEvents then
      begin
          GetMem( EV, Sizeof(TEvents) );
          Move( EmptyEvents, EV^, Sizeof(TEvents) );
          Add2AutoFreeEx( FreeEV );
      end;
      Result := EV;
end; {$ENDIF PAS_VERSION}///////////////////////////////////////////////////////

procedure TControl.FreeEV;
begin FreeMem( EV );
      EV := @EmptyEvents;
end;////////////////////////////////////////////////////////////////////////////
function TControl.Get_OnHelp: TOnHelp;
begin Result := EV.fOnHelp; end;
procedure TControl.Set_OnHelp(const Value: TOnHelp);
begin ProvideUniqueEvents.fOnHelp := Value; end;
function TControl.Get_OnBitBtnDraw: TOnBitBtnDraw;
begin Result := EV.FOnBitBtnDraw; end;
procedure TControl.Set_OnBitBtnDraw(const Value: TOnBitBtnDraw);
begin ProvideUniqueEvents.FOnBitBtnDraw := Value; end;
function TControl.Get_OnMeasureItem: TOnMeasureItem;
begin Result := EV.fOnMeasureItem; end;
function TControl.Get_OnShow: TOnEvent;
begin Result := EV.fOnShow; end;
function TControl.Get_OnHide: TOnEvent;
begin Result := EV.fOnHide; end;
function TControl.Get_OnClose: TOnEventAccept;
begin Result := EV.fOnClose; end;
function TControl.Get_OnQueryEndSession: TOnEventAccept;
begin Result := EV.fOnQueryEndSession; end;
function TControl.Get_OnPaint: TOnPaint;
begin Result := EV.fOnPaint; end;
function TControl.Get_OnPrePaint: TOnPaint;
begin Result := EV.fOnPrepaint; end;
procedure TControl.Set_OnPrePaint(const Value: TOnPaint);
begin ProvideUniqueEvents.fOnPrepaint := Value; end;
function TControl.Get_OnPostPaint: TOnPaint;
begin Result := EV.fOnPostPaint; end;
procedure TControl.Set_OnPostPaint(const Value: TOnPaint);
begin ProvideUniqueEvents.fOnPostPaint := Value; end;
function TControl.Get_OnEraseBkgnd: TOnPaint;
begin Result := EV.fOnEraseBkgnd; end;
procedure TControl.Set_OnEraseBkgnd(const Value: TOnPaint);
begin ProvideUniqueEvents.fOnEraseBkgnd := Value;
      AttachProc( WndProcEraseBkgnd );
end;////////////////////////////////////////////////////////////////////////////
function TControl.Get_OnClick: TOnEvent;
begin Result := EV.fOnClick; end;
function TControl.Get_OnResize: TOnEvent;
begin Result := EV.fOnResize; end;
function TControl.Get_OnMove: TOnEvent;
begin Result := EV.fOnMove; end;
function TControl.Get_OnMoving: TOnEventMoving;
begin Result := EV.fOnMoving; end;
function TControl.Get_OnSplit: TOnSplit;
begin Result := EV.FOnSplit; end;
procedure TControl.Set_OnSplit(const Value: TOnSplit);
begin ProvideUniqueEvents.FOnSplit := Value; end;
function TControl.Get_OnKeyDown: TOnKey;
begin Result := EV.fOnKeyDown; end;
function TControl.Get_OnKeyUp: TOnKey;
begin Result := EV.fOnKeyUp; end;
function TControl.Get_OnChar: TOnChar;
begin Result := EV.fOnChar; end;
function TControl.Get_OnDeadChar: TOnChar;
begin Result := EV.fOnDeadChar; end;
function TControl.Get_OnMouseUp: TOnMouse;
begin Result := EV.fOnMouseUp; end;
function TControl.Get_OnMouseDown: TOnMouse;
begin Result := EV.fOnMouseDown; end;
function TControl.Get_OnMouseMove: TOnMouse;
begin Result := EV.fOnMouseMove; end;
function TControl.Get_OnMouseDblClk: TOnMouse;
begin Result := EV.fOnMouseDblClk; end;
function TControl.Get_OnMouseWheel: TOnMouse;
begin Result := EV.fOnMouseWheel; end;
function TControl.Get_OnMouseEnter: TOnEvent;
begin Result := EV.fOnMouseEnter; end;
function TControl.Get_OnMouseLeave: TOnEvent;
begin Result := EV.fOnMouseLeave; end;
function TControl.Get_OnTestMouseOver: TOnTestMouseOver;
begin Result := EV.fOnTestMouseOver; end;
function TControl.Get_OnEndEditLVItem: TOnEditLVItem;
begin Result := EV.fOnEndEditLVItem; end;
function TControl.Get_OnDeleteLVItem: TOnDeleteLVItem;
begin Result := EV.fOnDeleteLVItem; end;
function TControl.Get_OnLVData: TOnLVData;
begin Result := EV.fOnLVData; end;
function TControl.Get_OnCompareLVItems: TOnCompareLVItems;
begin Result := EV.fOnCompareLVItems; end;
procedure TControl.Set_OnCompareLVItems(const Value: TOnCompareLVItems);
begin ProvideUniqueEvents.fOnCompareLVItems := Value; end;
function TControl.Get_OnColumnClick: TOnLVColumnClick;
begin Result := EV.fOnColumnClick; end;
function TControl.Get_OnLVStateChange: TOnLVStateChange;
begin Result := EV.FOnLVStateChange; end;
function TControl.Get_OnDrawItem: TOnDrawItem;
begin Result := EV.fOnDrawItem; end;
function TControl.Get_OnLVCustomDraw: TOnLVCustomDraw;
begin Result := EV.fOnLVCustomDraw; end;
function TControl.Get_OnTVBeginDrag: TOnTVBeginDrag;
begin Result := EV.FOnTVBeginDrag; end;
procedure TControl.Set_OnTVBeginDrag(const Value: TOnTVBeginDrag);
begin ProvideUniqueEvents.FOnTVBeginDrag := Value; end;
function TControl.Get_OnTVBeginEdit: TOnTVBeginEdit;
begin Result := EV.FOnTVBeginEdit; end;
procedure TControl.Set_OnTVBeginEdit(const Value: TOnTVBeginEdit);
begin ProvideUniqueEvents.FOnTVBeginEdit := Value; end;
function TControl.Get_OnTVEndEdit: TOnTVEndEdit;
begin Result := EV.FOnTVEndEdit; end;
procedure TControl.Set_OnTVEndEdit(const Value: TOnTVEndEdit);
begin ProvideUniqueEvents.fOnTVEndEdit := Value; end;
function TControl.Get_OnTVExpanding: TOnTVExpanding;
begin Result := EV.FOnTVExpanding; end;
procedure TControl.Set_OnTVExpanding(const Value: TOnTVExpanding);
begin ProvideUniqueEvents.FOnTVExpanding := Value; end;
function TControl.Get_OnTVExpanded: TOnTVExpanded;
begin Result := EV.FOnTVExpanded; end;
procedure TControl.Set_OnTVExpanded(const Value: TOnTVExpanded);
begin ProvideUniqueEvents.FOnTVExpanded := Value; end;
function TControl.Get_OnTVDelete: TOnTVDelete;
begin Result := EV.FOnTVDelete; end;
function TControl.Get_OnTVSelChanging: TOnTVSelChanging;
begin Result := EV.fOnTVSelChanging; end;
procedure TControl.Set_OnTVSelChanging(const Value: TOnTVSelChanging);
begin ProvideUniqueEvents.FOnTVSelChanging := Value; end;
function TControl.Get_OnDTPUserString: TDTParseInputEvent;
begin Result := EV.FOnDTPUserString; end;
procedure TControl.Set_OnDTPUserString(const Value: TDTParseInputEvent);
begin ProvideUniqueEvents.FOnDTPUserString := Value; end;
function TControl.Get_OnSBBeforeScroll: TOnSBBeforeScroll;
begin Result := EV.FOnSBBeforeScroll; end;
procedure TControl.Set_OnSBBeforeScroll(const Value: TOnSBBeforeScroll);
begin ProvideUniqueEvents.fOnSBBeforeScroll := Value; end;
function TControl.Get_OnSBScroll: TOnSBScroll;
begin Result := EV.FOnSBScroll; end;
procedure TControl.Set_OnSBScroll(const Value: TOnSBScroll);
begin ProvideUniqueEvents.FOnSBScroll := Value; end;
function TControl.Get_OnScroll: TOnScroll;
begin Result := EV.fOnScroll; end;
function TControl.Get_OnMessage: TOnMessage;
begin Result := EV.fOnMessage; end;
procedure TControl.Set_OnMessage(const Value: TOnMessage);
begin ProvideUniqueEvents.fOnMessage := Value; end;
function TControl.Get_TOnEvent(const Index: Integer): TOnEvent;
begin Result := TOnEvent( EV.MethodEvents[Index] ); end;
procedure TControl.Set_TOnEvent(const Index: Integer; const Value: TOnEvent);
begin ProvideUniqueEvents.MethodEvents[Index] := TMethod( Value ); end;
function TControl.Get_OnDropFiles: TOnDropFiles;
begin Result := EV.fOnDropFiles; end;
{$ENDIF EVENTS_DYNAMIC}//-------------------------------------------------------
{$IFnDEF NOT_USE_RICHEDIT}
procedure TControl.FreeCharFormatRec;
begin {$IFnDEF STATIC_RICHEDIT_DATA} FreeMem( DF.fRECharFormatRec ); {$ENDIF} end;
{$ENDIF}
function TControl.GetAnchor(const Index: Integer): Boolean;
begin Result := fAnchors and Index <> 0; end;
procedure TControl.SetAnchor(const Index: Integer; const Value: Boolean);
begin if   Value then
           fAnchors := fAnchors or Index
      else fAnchors := fAnchors and not Index;
      if  Parent <> nil then
      begin
          fParent.AttachProc( ParentAnchorChildren );
          Parent.fOldWidth := Parent.ClientWidth;
          Parent.fOldHeight := Parent.ClientHeight;
      end;
end;////////////////////////////////////////////////////////////////////////////
function TControl.Get_StatusWnd: HWND;
begin Result := 0;
      if  fStatusCtl <> nil then
          Result := fStatusCtl.GetWindowHandle;
end;////////////////////////////////////////////////////////////////////////////
function TControl.Get_Prop_Int(PropName: PKOLChar): Integer;
begin Result := GetProp( GetWindowHandle, PropName ); end;
procedure TControl.Set_Prop_Int(PropName: PKOLChar; const Value: Integer);
begin SetProp( GetWindowHandle, PropName, Value ); end;
function TControl.GetHelpContext: Integer;
begin Result := 0;
      if  fHandle <> 0 then
          Result := GetWindowContextHelpId( fHandle );
end;////////////////////////////////////////////////////////////////////////////
function TControl.Get_Ctl3D: Boolean;
begin Result := fCtl3D_child and 2 <> 0; end;
procedure TControl.ResetEvent(idx: Integer);
begin TMethod( EV.MethodEvents[idx] ).Code := DummyProcTable[ InitEventsTable[ idx ] and $F ];
      TMethod( EV.MethodEvents[idx] ).Data := nil;
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF COMMANDACTIONS_OBJ}
{ TCommandActionsObj }
{$IFDEF ASM_VERSION}////////////////////////////////////////////////////////////
destructor TCommandActionsObj.Destroy;
asm MOV  EDX, [EAX].fIndexInActions
    MOV  dword ptr [EDX*4+AllActions_Objs], 0
    CALL TObj.Destroy
end; {$ELSE}////////////////////////////////////////////////////////////////////
destructor TCommandActionsObj.Destroy;
begin AllActions_Objs[fIndexInActions] := nil;
      inherited;
end; {$ENDIF}///////////////////////////////////////////////////////////////////
{$ENDIF}
{$IFDEF GRAPHCTL_XPSTYLES}{$DEFINE INIT_FINIT}{$ENDIF}
{$IFDEF USE_NAMES}{$DEFINE INIT_FINIT}{$ENDIF}
{$IFNDEF NOT_UNLOAD_RICHEDITLIB}{$IFDEF UNLOAD_RICHEDITLIB}
         {$DEFINE INIT_FINIT}
{$ENDIF}{$ENDIF}
{$IFDEF INIT_FINIT}//-----------------------------------------------------------
//******************************************************************************
initialization //...............................................................
{$IFDEF GRAPHCTL_XPSTYLES}
 CheckThemes;
 if  AppTheming then
     InitThemes;
{$ENDIF}
finalization //.................................................................
{$IFDEF GRAPHCTL_XPSTYLES}
 if  AppTheming then
     DeinitThemes;
{$ENDIF}
{$IFNDEF NOT_UNLOAD_RICHEDITLIB}
{$IFDEF UNLOAD_RICHEDITLIB}
  if  FRichEditModule <> 0 then
      FreeLibrary( FRichEditModule );
{$ENDIF UNLOAD_RICHEDITLIB}
{$ENDIF}
{$ENDIF INIT_FINIT}//-----------------------------------------------------------

end.