//[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 Kladov Vladimir.



//[VERSION]

****************************************************************

* VERSION 2.08

****************************************************************

//[END OF VERSION]



  K.O.L. - is a set of objects to create small programs

  with the Delphi, but without the VCL. KOL allows to

  create executables of size about 10 times smaller then

  those created with the VCL. 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-2003.



  For code provided by other  developers (even if later

  changed by me) authors are noted in the source.



  mailto: bonanzas@online.sinor.ru

  Web-Page: http://bonanzas.rinet.ru



  See also Mirror Classes Kit (M.C.K.) which allows

  to create KOL programs visually.



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



//[UNIT DEFINES]

{$INCLUDE delphidef.inc}



//[START OF UNIT]

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>



  Several conditional symbols can be used in a project

  (Project | Options | Directories/Conditional Defines)

  to change code generated a bit. There are following:

|<pre>



  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_NAMES             - to use property Name with any TObj. This makes also

                          available global function FindObj( name ): PObj.

  (USE_CONSTRUCTORS     - to use constructors like in VCL. Note: this option is

                          not carefully tested!)

  USE_CUSTOMEXTENSIONS  - to extend TControl with custom additions.

  UNICODE_CTRLS         - to use Unicode versions of controls (WM_XXXXW messages,

                          etc.)

  USE_MHTOOLTIP         - to use MHTOOLTIP.

  NOT_USE_OnIdle        - to stop using OnIdle event (to make code smaller

                          if it is not used actually).

  USE_ASM_DODRAG        - to use assembler version of code for DoDrag.

  ENUM_DYN_HANDLERS_AFTER_RUN - to allow all the events handling even when

                        AppletTerminated become TRUE.

  ALL_BUTTONS_RESPOND_TO_ENTER - obvious (by default, buttons respond to key

                        SPACE, since those are working this way in Windows).

  ESC_CLOSE_DIALOGS     - to allow closing all dialogs with ESCAPE.

  KEY_PREVIEW           - form also receive WM_KEYDOWN (OnKeyDown event fired)

  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).

  NEW_MODAL             - to use extended modalness.

  USE_SETMODALRESULT    - to guarantee ModalResult property assigninig handling.

  USE_MENU_CURCTL       - to use CurCtl property in popup menu to detect which

                        control initiated a pop-up.

  NEW_MENU_ACCELL       - to use another menu accelerators handling, without

                        AcceleratorTable

  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).

  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.

  TEST_CLOSE            - to debug Close.

  DEBUG_MENU            - to debug menu.

  DEBUG_DBLBUFF         - to debug DoubleBuffered.

  DEBUG                 - other debugging.



  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



  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.

  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.



  |</pre>

}

{= K.O.L - êëþ÷åâàÿ áèáëèîòåêà îáúåêòîâ. (C) Êëàäîâ Âëàäèìèð, 2000-2003.

}



//[OPTIONS]

{$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+}

{$IFDEF INPACKAGE} // use this symbol in packages requiring kol.pas

  {$WARNINGS OFF}

{$ENDIF}

{$IFDEF _D7orHigher}

  {$WARN UNSAFE_TYPE OFF} // Too many such warnings in Delphi7

  {$WARN UNSAFE_CODE OFF}

  {$WARN UNSAFE_CAST OFF}

{$ENDIF}





//[START OF INTERFACE]

interface



//{$DEFINE DEBUG_GDIOBJECTS}

//{$DEFINE CHK_GDI}



//[USES]

uses

    messages, windows, RichEdit {$IFDEF CHK_GDI}, ChkGdi {$ENDIF};

//[END OF USES]



{$IFDEF DEBUG_GDIOBJECTS}

var

  BrushCount: Integer;

  FontCount: Integer;

  PenCount: Integer;

{$ENDIF}





//{_#IF [DELPHI]}

{$INCLUDE delphicommctrl.inc}

//{_#ENDIF}



type

//[_TObj DEFINITION]



{-}

   _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;

{+}



  {++}(* TObj = class;*){--}

  PObj = {-}^{+}TObj;

  {* }



  {++}(* TList = class;*){--}

  PList = {-}^{+}TList;

  {* }



//[TObjectMethod DECLARATION]

  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. }



//[TPointerList DECLARATION]

   PPointerList = ^TPointerList;

   TPointerList = array[0..MaxInt div 4 - 1] of Pointer;



{ ---------------------------------------------------------------------



                  TObj - base object to derive all others



---------------------------------------------------------------------- }

//[TObj DEFINITION]

   TObj = {-} object( _TObj ) {+}{++}(*class*){--}

   {* Prototype for all objects of KOL. All its methods are important to

      implement objects in a manner similar to Delphi TObject class. }

   {= Áàçîâûé êëàññ äëÿ âñåõ ïðî÷èõ îáúåêòîâ KOL. }

   protected

     fRefCount: Integer;

     fOnDestroy: TOnEvent;

     procedure DoDestroy;

   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; {+}{++}(* override; *){--}

     {* Disposes memory, allocated to an object. Does not release huge strings,

        dynamic arrays and so on. Such memory should be freeing in overriden

        destructor. }

     {= Îñâîáîæäàåò ïàìÿòü, âûäåëåííóþ äëÿ îáúåêòà. Íå îñâîáîæäàåò ïàìÿòü, âûäåëåííóþ

        äëÿ ñòðîê, äèíàìè÷èñêèõ ìàññèâîâ è ò.ï. Òàêàÿ ïàìÿòü äîëæíà áûòü îñâîáîæäåíà

        â ïåðåîïðåäåëåííîì äåñòðóêòîðå îáúåêòà. }

   {++}(*protected*){--}

     {++}(*

     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). }

     *){--}

     procedure Final;

     {* It is called in destructor to perform OnDestroy event call and to

        released objects, added to fAutoFree list. }

   public

     procedure Free;

     {* 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. }



     {-}

     // 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). }

     {+}

     procedure RefInc;

     {* See comments below. }

     {= Ñì. RefDec íèæå. }

     procedure RefDec;

     {* 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).

     }

     {= Óìåíüøàåò ñ÷åò÷èê èñïîëüçîâàíèÿ. Åñëè â ðåçóëüòàòå ñ÷åò÷èê ñòàíîâèòñÿ

        < 0, è ìåòîä Free óæå áûë âûçâàí, îáúåêò (ñàìî-) ðàçðóøàåòñÿ. Èíà÷å,

        ìåòîä Free íå ðàçðóøàåò îáúåêò, à òîëüêî óñòàíàâëèâàåò ôëàã "Free áûë

        âûçâàí".

        |<br>

        Èñïîëüçóéòå RefInc..RefDec äëÿ ïðåäîòâðàùåíèÿ ðàçðóøåíèÿ îáúåêòà íà

        íåêîòîðîì ó÷àñòêå êîäà (åñëè åñòü òàêàÿ íåîáõîäèìîñòü).

        |<br>

        Åñëè íóæíî óáèòü (âðåìåííûé) îáúåêò âìåñòå ñ ïîñëåäíèì RefDec, ñäåëàéòå

        âûçîâ Free íåìåäëåííî ÏÅÐÅÄ ïîñëåäíèì RefDec. }

     property RefCount: Integer read fRefCount;

     {* }

     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). }

    property Tag: DWORD read fTag write fTag;

    {* Custom data field. }

   protected

     {$IFDEF USE_NAMES}

     FName: String;

     procedure SetName( const NewName: String );

     {$ENDIF}

   public

     {$IFDEF USE_NAMES}

     property Name: String read FName write SetName;

     {$ENDIF}

   end;

//[END OF TObj DEFINITION]



{ ---------------------------------------------------------------------



        TList - object to implement list of pointers (or dwords)



---------------------------------------------------------------------- }

//[TList DEFINITION]

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

  {++}(*public*){--}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* Destroys list, freeing memory, allocated for pointers. Programmer

       is resposible for destroying of data, referenced by the pointers. }

    {= }

  {++}(*protected*){--}

    procedure SetCapacity( Value: Integer );

    function Get( Idx: Integer ): Pointer;

    procedure Put( Idx: Integer; Value: Pointer );

    {$IFDEF USE_CONSTRUCTORS}

    procedure Init; virtual;

    {$ENDIF USE_CONSTRUCTORS}

  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. }

    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}

  end;

//[END OF TList DEFINITION]



//[NewList DECLARATION]

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}





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. }



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 USE_NAMES}

var

  NamedObjectsList: PList;



function FindObj( const Name: String ): PObj;

{$ENDIF}















{ -- tree (non-visual) -- }



type

//[TTree DEFINITION]

  {++}(*TTree = class;*){--}

  PTree = {-}^{+}TTree;

  TTree = object( TObj )

  {* Object to store tree-like data in memory (non-visual). }

  protected

    fParent: PTree;

    fChildren: PList;

    fPrev: PTree;

    fNext: PTree;

    fNodeName: String;

    fData: Pointer;

    function GetCount: Integer;

    function GetItems(Idx: Integer): PTree;

    procedure Unlink;

    function GetRoot: PTree;

    function GetLevel: Integer;

    function GetTotal: Integer;

    function GetIndexAmongSiblings: Integer;

  protected

    {$IFDEF USE_CONSTRUCTORS}

    constructor CreateTree( AParent: PTree; const AName: String );

    {* }

    {$ENDIF}

  {++}(*public*){--}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* }

  {++}(*protected*){--}

    procedure Init; {-}virtual;{+}{++}(*override;*){--}

  public

    procedure Clear;

    {* Destoyes all child nodes. }

    property Name: String read fNodeName write fNodeName;

    {* Optional node name. }

    property Data: Pointer read fData write fData;

    {* Optional user-defined pointer. }

    property Count: Integer read GetCount;

    {* Number of child nodes of given node. }

    property Items[ Idx: Integer ]: PTree read GetItems;

    {* Child nodes list items. }

    procedure Add( Node: PTree );

    {* Adds another node as a child of given tree node. This operation

       as well as Insert can be used to move node together with its children

       to another location of the same tree or even from another tree.

       Anyway, added Node first correctly removed from old place (if it is

       defined for it). But for simplest task, such as filling of tree with

       nodes, code should looking as follows:

       !  Node := NewTree( nil, 'test of creating node without parent' );

       !  RootOfMyTree.Add( Node );

       Though, this code gives the same result as:

       !  Node := NewTree( RootOfMyTree, 'test of creatign node as a child' ); }

    procedure Insert( Before, Node: PTree );

    {* Inserts earlier created 'Node' just before given child node 'Before'

       as a child of given tree node. See also Add method. }

    property Parent: PTree read fParent;

    {* Returns parent node (or nil, if there is no parent). }

    property Index: Integer read GetIndexAmongSiblings;

    {* Returns an index of the node in a list of nodes of the same parent

       (or -1, if Parent is not defined). }

    property PrevSibling: PTree read fPrev;

    {* Returns previous node in a list of children of the Parent. Nil is

       returned, if given node is the first child of the Parent or has

       no Parent. }

    property NextSibling: PTree read fNext;

    {* Returns next node in a list of children of the Parent. Nil is returned,

       if given node is the last child of the Parent or has no Parent at all. }

    property Root: PTree read GetRoot;

    {* Returns root node (i.e. the last Parent, enumerating parents recursively). }

    property Level: Integer read GetLevel;

    {* Returns level of the node, i.e. integer value, equal to 0 for root

       of a tree, 1 for its children, etc. }

    property Total: Integer read GetTotal;

    {* Returns total number of children of the node and all its children

       counting its recursively (but node itself is not considered, i.e.

       Total for node without children is equal to 0). }

    procedure SortByName;

    {* Sorts children of the node in ascending order. Sorting is not

       recursive, i.e. only immediate children are sorted. }

    procedure SwapNodes( i1, i2: Integer );

    {* Swaps two child nodes. }

    function IsParentOfNode( Node: PTree ): Boolean;

    {* Returns true, if Node is the tree itself or is a parent of the given node

       on any level. }

    function IndexOf( Node: PTree ): Integer;

    {* Total index of the child node (on any level under this node). }



  end;

//[END OF TTree DEFINITION]



//[NewTree DECLARATION]

function NewTree( AParent: PTree; const AName: String ): PTree;

{* Constructs tree node, adding it to the end of children list of

   the AParent. If AParent is nil, new root tree node is created. }















//[DummyObjProc, DummyObjProcParam DECLARATION]

procedure DummyObjProc( Sender: PObj );

procedure DummyObjProcParam( Sender: PObj; Param: Pointer );









{ --- threads --- }

//[THREADS]



const

  ABOVE_NORMAL_PRIORITY_CLASS = $8000; // only for Windows 2K

  BELOW_NORMAL_PRIORITY_CLASS = $4000; // and higher !



type

  {++}(*TThread = class;*){--}

  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 DEFINITION]

  TThread = object(TObj)

  {* 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;

    function GetPriorityCls: Integer;

    function GetThrdPriority: Integer;

    procedure SetPriorityCls(Value: Integer);

    procedure SetThrdPriority(Value: Integer);

  {++}(*public*){--}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* }

  public

    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. }



    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. }

  end;

//[END OF TThread DEFINITION]



//[NewThread, NewThreadEx, NewThreadAutoFree, Global_Synchronized DECLARATIONS]

function NewThread: PThread;

{* Creates thread object (always suspended). After creating, set event

   OnExecute and perform Resume operation. }



function NewThreadEx( const Proc: TOnThreadExecute ): PThread;

{* 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. }



var Global_Synchronized: procedure( Sender: PObj; Param: Pointer ) = DummyObjProcParam;

// It is not necessary to declare it as threadvar.





























{ -- streams -- }

//[STREAMS]



type

  TMoveMethod = ( spBegin, spCurrent, spEnd );



  {++}(*TStream = class;*){--}

  PStream = {-}^{+}TStream;



  PStreamMethods = ^TStreamMethods;

  TStreamMethods = Packed Record

    fSeek: function( Strm: PStream; MoveTo: Integer; MoveMethod: TMoveMethod ): DWORD;

    fGetSiz: function( Strm: PStream ): DWORD;

    fSetSiz: procedure( Strm: PStream; Value: DWORD );

    fRead: function( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

    fWrite: function( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

    fClose: procedure( Strm: PStream );

    fCustom: Pointer;

    fWait: procedure( Strm: PStream );

  end;



  TStreamData = Packed Record

    fHandle: THandle;

    fCapacity, fSize, fPosition: DWORD;

    fThread: PThread;

  end;



{ ---------------------------------------------------------------------



                TStream - streaming objects incapsulation



---------------------------------------------------------------------- }

//[TStream DEFINITION]

  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: DWORD; // parameters to use in thread

    function GetCapacity: DWORD;

    procedure SetCapacity(const Value: DWORD);

    function DoAsyncRead( Sender: PThread ): Integer;

    function DoAsyncWrite( Sender: PThread ): Integer;

    function DoAsyncSeek( Sender: PThread ): Integer;

  protected

    function GetFileStreamHandle: THandle;

    procedure SetPosition(Value: DWord);

    function GetPosition: DWord;

    function GetSize: DWord;

    procedure SetSize(NewSize: DWord);

  {++}(*public*){--}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

  public

    function Read(var Buffer; Count: DWord): DWord;

    {* Reads Count bytes from a stream. Returns number of bytes read. }

    function Seek(MoveTo: Integer; MoveMethod: TMoveMethod): DWord;

    {* Allows to change current position or to obtain it. Property

       Position uses this method both for get and set position. }

    function Write(var Buffer; Count: DWord): DWord;

    {* Writes Count bytes from Buffer, starting from current position

       in a stream. Returns how much bytes are written. }

    function WriteStr( S: String ): DWORD;

    {* Writes string to the stream, not including ending #0. Exactly

       Length( S ) characters are written. }

    function WriteStrZ( S: String ): DWORD;

    {* Writes string, adding #0. Number of bytes written is returned. }

    function ReadStrZ: String;

    {* Reads string, finished by #0. After reading, current position in

       the stream is set to the byte, follows #0. }

    function ReadStr: String;

    {* 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 WriteStrEx(S: String): 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: String): 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: String;

    {* Reads string from stream and returns it. }

    function WriteStrPas( S: String ): 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: String;

    {* 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: DWord 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: DWord 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: Integer; 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: DWORD read GetCapacity write SetCapacity;

    {* Amound of memory allocated for data (MemoryStream). }



  end;

//[END OF TStream DEFINITION]



//[_NewStream DECLARATION]

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; MoveTo: Integer; MoveFrom: TMoveMethod ): DWORD;

function GetSizeFileStream( Strm: PStream ): DWORD;

function ReadFileStream( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

function WriteFileStream( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

function WriteFileStreamEOF( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

procedure CloseFileStream( Strm: PStream );

function SeekMemStream( Strm: PStream; MoveTo: Integer; MoveFrom: TMoveMethod ): DWORD;

function GetSizeMemStream( Strm: PStream ): DWORD;

procedure SetSizeMemStream( Strm: PStream; NewSize: DWORD );

function ReadMemStream( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

function WriteMemStream( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

procedure CloseMemStream( Strm: PStream );

procedure SetSizeFileStream( Strm: PStream; NewSize: DWORD );



function DummyReadWrite( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

procedure DummySetSize( Strm: PStream; Value: DWORD );

procedure DummyStreamProc(Strm: PStream);





//[NewFileStream DECLARATION]

function NewFileStream( const FileName: String; 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 NewReadFileStream( const FileName: String ): PStream;

{* Creates file stream for read only. }



function NewWriteFileStream( const FileName: String ): PStream;

{* Creates file stream for write only. Truncating of file (if needed)

   is provided automatically. }



function NewReadWriteFileStream( const FileName: String ): PStream;

{* Creates stream for read and write file. To truncate file, if it is

   necessary, change Size property. }



//[NewMemoryStream DECLARATION]

function NewMemoryStream: PStream;

{* Creates memory stream (read and write). }



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. }



//[Stream2Stream DECLARATION]

function Stream2Stream( Dst, Src: PStream; Count: DWORD ): DWORD;

{* 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; Count: DWORD ): DWORD;

{* 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; Count, BufSz: DWORD ): DWORD;

{* 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 }



//[Resource2Stream DECLARATION]

function Resource2Stream( DestStrm : PStream; Inst : HInst;

                          ResName : PChar; ResType : PChar ): 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;

   !......

   }





















































































{ -- string list objects -- }

//[TStrList]



type

  {++}(*TStrList = class;*){--}

  PStrList = {-}^{+}TStrList;

{ ---------------------------------------------------------------------



                TStrList - string list



---------------------------------------------------------------------- }

//[TStrList DEFINITION]

  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;

    fTextBuf: PChar;

    fTextSiz: DWORD;

    function GetPChars(Idx: Integer): PChar;

    //procedure AddTextBuf( Src: PChar; Len: DWORD );

  protected

    function Get(Idx: integer): string;

    function GetTextStr: string;

    procedure Put(Idx: integer; const Value: string);

    procedure SetTextStr(const Value: string);

  {++}(*public*){--}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

  protected

    // by Dod:

    procedure SetValue(const AName, Value: string);

    function GetValue(const AName: string): string;

  public

    // by Dod:

    function IndexOfName(AName: string): Integer;

    {* by Dod. Returns index of line starting like Name=... }

    property Values[const AName: string]: string read GetValue write SetValue;

    {* by Dod. Returns right side of a line starting like Name=... }

  public

    function Add(const S: string): 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). }

    function IndexOf(const S: string): integer;

    {* Returns index of first string, equal to given one. }

    function IndexOf_NoCase(const S: string): integer;

    {* Returns index of first string, equal to given one (while comparing it

       without case sensitivity). }

    function IndexOfStrL_NoCase( Str: PChar; L: Integer ): integer;

    {* Returns index of first string, equal to given one (while comparing it

       without case sensitivity). }

    function Find(const S: String; var Index: Integer): Boolean;

    {* Returns Index of the first 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. }

    procedure Insert(Idx: integer; const S: string);

    {* Inserts string before one with given index. }

    function LoadFromFile(const FileName: string): 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: string);

    {* Merges string list with strings in a file. Fast. }

    procedure Move(CurIndex, NewIndex: integer);

    {* Moves string to another location. }

    procedure SetText(const S: string; 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: String; Append2List: Boolean );

    {* Allows to assign UNIX-style text (with #10 as string separator). }

    function SaveToFile(const FileName: string): Boolean;

    {* Stores string list to a file. }

    procedure SaveToStream(Stream: PStream);

    {* Saves string list to a stream (from current position). }

    function AppendToFile(const FileName: string): Boolean;

    {* Appends strings of string list to the end of a file. }

    property Count: integer read fCount;

    {* Number of strings in a string list. }

    property Items[Idx: integer]: string 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 ]: PChar read GetPChars;

    {* Fast access to item strings as PChars. }

    function Last: String;

    {* Last item (or '', if string list is empty). }

    property Text: string 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. }



    // by Alexander Pravdin:

  protected

    fNameDelim: Char;

    function GetLineName( Idx: Integer ): string;

    procedure SetLineName( Idx: Integer; const NV: string );

    function GetLineValue(Idx: Integer): string;

    procedure SetLineValue(Idx: Integer; const Value: string);

  public

    property LineName[ Idx: Integer ]: string read GetLineName write SetLineName;

    property LineValue[ Idx: Integer ]: string read GetLineValue write SetLineValue;

    property NameDelimiter: Char read fNameDelim write fNameDelim;

    function Join( const sep: String ): String;

    {* by Sergey Shishmintzev. }

  end;

//[END OF TStrList DEFINITION]



//[DefaultNameDelimiter]

var DefaultNameDelimiter: Char = '=';

    ThsSeparator: Char = ',';



//[NewStrList DECLARATION]

function NewStrList: PStrList;

{* Creates string list object. }



function  GetFileList(const dir: string): PStrList;

{* By Alexander Shakhaylo. Returns list of file names of the given directory. }



{$IFNDEF _FPC}

function WStrLen( W: PWideChar ): Integer;

{* Returns Length of null-terminated Unicode string. }

{$ENDIF _FPC}



//[TStrListEx]

type

  {++}(*TStrListEx = class;*){--}

  PStrListEx = {-}^{+}TStrListEx;



//[TStrListEx DEFINITION]

  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;

    procedure SetObjects(Idx: Integer; const Value: DWORD);

    procedure Init; {-}virtual;{+}{++}(*override;*){--}

    procedure ProvideObjCapacity( NewCap: Integer );

  public

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* }

    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. }

    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 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: String; 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: String; 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. }

  end;

//[END OF TStrListEx DEFINITION]



//[NewStrListEx DECLARATION]

function NewStrListEx: PStrListEx;

{* Creates extended string list object. }









































{+}

////////////////////////////////////////////////////////////////////////////////

//                            GRAPHIC OBJECTS                                 //

////////////////////////////////////////////////////////////////////////////////

//[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

//[COLOR CONSTANTS]

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

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

  clSilver = TColor($C0C0C0);

  clRed = TColor($0000FF);

  clLime = TColor($00FF00);

  clYellow = TColor($00FFFF);

  clBlue = TColor($FF0000);

  clFuchsia = TColor($FF00FF);

  clAqua = TColor($FFFF00);

  clLtGray = TColor($C0C0C0);

  clDkGray = TColor($808080);

  clWhite = TColor($FFFFFF);

  clNone = TColor($1FFFFFFF);

  clDefault = TColor($20000000);



  clMoneyGreen = TColor($C0DCC0);

  clSkyBlue = TColor($F0CAA6);

  clCream = TColor($F0FBFF);

  clMedGray = TColor($A4A0A0);

//[END OF COLOR CONSTANTS]



const

//[TGraphicTool FIELD OFFSET CONSTANTS]

  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;

//[END OF TGraphicTool FIELD OFFSET CONSTANTS]



//[TGraphicTool]

type

   TGraphicToolType = ( gttBrush, gttFont, gttPen );

   {* Graphic object types, mainly for internal use. }



   {++}(*TGraphicTool = class;*){--}

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

   {* 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]

   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 Char;

   end;



//[TGDIBrush]

   TGDIBrush = packed record

     Bitmap: HBitmap;

     Style: TBrushStyle;

     LineColor: TColor;

   end;



//[TGDIPen]

   TGDIPen = packed record

     BrushBitmap: HBitmap;

     BrushStyle: TBrushStyle;

     Style: TPenStyle;

     Width: Integer;

     Mode: TPenMode;

     Geometric: Boolean;

     EndCap: TPenEndCap;

     Join: TPenJoin;

   end;



//[TGDIToolData]

   TGDIToolData = packed record

     Color: TColor;

     case Integer of

     1: (Font: TGDIFont);

     2: (Pen: TGDIPen);

     3: (Brush: TGDIBrush);

   end;



//[TNewGraphicTool]

   TNewGraphicTool = function: PGraphicTool;



{ ---------------------------------------------------------------------



     TGraphicTool - object to implement GDI-tools (brush, pen, font)



---------------------------------------------------------------------- }

//[TGraphicTool DEFINITION]

  TGraphicTool = object( TObj )

  {* Incapsulates all GDI objects: Pen, Brush and Font. }

  protected

    fType: TGraphicToolType;

    fHandle: THandle;

    fParentGDITool: PGraphicTool;

    fOnChange: TOnGraphicChange;

    fColorRGB: TColor;

    fData: TGDIToolData;



    fNewProc: TNewGraphicTool;

    fMakeHandleProc: function( Self_: PGraphicTool ): THandle;



    procedure SetInt( const Index: Integer; Value: Integer );

    {$IFDEF F_P}

    function GetInt( const Index: Integer ): Integer;

    {$ENDIF}

    procedure SetColor( Value: TColor );

    procedure SetBrushBitmap(const Value: HBitmap);

    procedure SetBrushStyle(const Value: TBrushStyle);

    procedure SetFontCharset(const Value: TFontCharset);

    procedure SetFontQuality(const Value: TFontQuality);

    function GetFontName: String;

    procedure SetFontName(const Value: String);

    procedure SetFontOrientation(Value: Integer);

    procedure SetFontPitch(const Value: TFontPitch);

    function GetFontStyle: TFontStyle;

    procedure SetFontStyle(const Value: TFontStyle);

    procedure SetPenMode(const Value: TPenMode);

    procedure SetPenStyle(const Value: TPenStyle);

    procedure SetGeometricPen(const Value: Boolean);

    procedure SetPenEndCap(const Value: TPenEndCap);

    procedure SetPenJoin(const Value: TPenJoin);

    procedure SetFontWeight(const Value: Integer);

    procedure SetLogFontStruct(const Value: TLogFont);

    function GetLogFontStruct: TLogFont;

  protected

    procedure Changed;

    {* }

    function GetHandle: THandle;

    {* }

  public

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* }

    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. }

    property OnChange: TOnGraphicChange read fOnChange write fOnChange;

    {* Called, when object is changed. }

    function ReleaseHandle: Integer;

    {* 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. }

    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. }

    procedure AssignHandle( NewHandle: Integer );

    {* Assigns value to Handle property. }



    property BrushBitmap: HBitmap read fData.Brush.Bitmap write SetBrushBitmap;

    {* Brush bitmap. For more info about using brush bitmap,

       see Delphi or Win32 help files. }

    property BrushStyle: TBrushStyle read fData.Brush.Style write SetBrushStyle;

    {* Brush style. }

    property BrushLineColor: TColor index go_BrushLineColor

             {$IFDEF F_P}

             read GetInt

             {$ELSE DELPHI}

             read fData.Brush.LineColor

             {$ENDIF F_P/DELPHI}

             write SetInt;

    {* Brush line color, used to represent lines in hatched brush. Default value is clBlack. }



    property FontHeight: Integer index go_FontHeight

             {$IFDEF F_P}

             read GetInt

             {$ELSE DELPHI}

             read fData.Font.Height

             {$ENDIF F_P/DELPHI}

             write SetInt;

    {* Font height. Value 0 (default) seys 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. }

    property FontWidth: Integer index go_FontWidth

             {$IFDEF F_P}

             read GetInt

             {$ELSE DELPHI}

             read fData.Font.Width

             {$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 fData.Font.Pitch write SetFontPitch;

    {* Font pitch. Change it very rare. }

    property FontStyle: TFontStyle read GetFontStyle write SetFontStyle;

    {* Very useful property to control text appearance. }

    property FontCharset: TFontCharset read fData.Font.Charset write SetFontCharset;

    {* Do not change it if You do not know what You do. }

    property FontQuality: TFontQuality read fData.Font.Quality write SetFontQuality;

    {* Font quality. }

    property FontOrientation: Integer read fData.Font.Orientation 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). }

    property FontWeight: Integer read fData.Font.Weight 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: String read GetFontName write SetFontName;

    {* Font face name. }

    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 fData.Pen.Width

             {$ENDIF F_P/DELPHI}

             write SetInt;

    {* Value 0 means default pen width. }

    property PenStyle: TPenStyle read fData.Pen.Style write SetPenStyle;

    {* Pen style. }

    property PenMode: TPenMode read fData.Pen.Mode write SetPenMode;

    {* Pen mode. }



    property GeometricPen: Boolean read fData.Pen.Geometric 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 fData.Pen.BrushStyle write SetBrushStyle;

    {* Brush style for hatched geometric pen. }

    property PenBrushBitmap: HBitmap read fData.Pen.BrushBitmap 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 fData.Pen.EndCap write SetPenEndCap;

    {* Pen end cap mode - for GeometricPen only. }

    property PenJoin: TPenJoin read fData.Pen.Join 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. }

  end;

//[END OF TGraphicTool DEFINITION]



//[Color2XXX FUNCTIONS]

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 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. }

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). }



//[DefFont VARIABLE]

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;

     Name: 'MS Sans Serif';

  );

  DefFontColor: TColor = clWindowText;

  {* Default font color. }



//[GlobalGraphics_UseFontOrient]

  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. }



{ -- Constructors for different GDI tools -- }



//[New FUNCTIONS FOR TGraphicTool]

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 -- }

//[TCanvas]

const

  HandleValid = 1;

  PenValid    = 2;

  BrushValid  = 4;

  FontValid   = 8;

  ChangingCanvas = 16;



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;



type

  {++}(*TCanvas = class;*){--}

  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 DEFINITION]

  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;

    fHandle : HDC;

    fPenPos : TPoint;

    fBrush, fFont, fPen : PGraphicTool; // order is important for ASM version

    fState : Byte;

    fCopyMode : TCopyMode;

    fOnChange: TOnEvent;

    fOnGetHandle: TOnGetHandle;

    procedure SetHandle( Value : HDC );

    procedure SetPenPos( const Value : TPoint );

    procedure CreatePen;

    procedure CreateBrush;

    procedure CreateFont;

    procedure ObjectChanged( Sender : PGraphicTool );

    procedure Changing;

    function GetBrush: PGraphicTool;

    function GetFont: PGraphicTool;

    function GetPen: PGraphicTool;

    function GetHandle: HDC;

    procedure AssignChangeEvents;

    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. }

  {++}(*public*){--}

    destructor Destroy;{-}virtual;{+}{++}(*override;*){--}

    {* }

  {++}(*protected*){--}

    property OnGetHandle: TOnGetHandle read fOnGetHandle write fOnGetHandle;

    {* For internal use only. }

  public

    property Handle : HDC read GetHandle write SetHandle;

    {* 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 Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall;

    {* Draws arc. For more info, see Delphi TCanvas help. }

    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. }

    procedure FillRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);

    {* Fills rectangle. For more info, see Delphi TCanvas help. }

    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. }

    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. }

    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. }

    procedure TextOut(X, Y: Integer; const Text: String); stdcall;

    {* Draws a text. For more info, see Delphi TCanvas help. }

    procedure ExtTextOut( X, Y: Integer; Options: DWORD; const Rect: TRect; const Text: String;

              const Spacing: array of Integer );

    {* }

    procedure DrawText(Text:String; var Rect:TRect; Flags:DWord);

    {* }

    procedure TextRect(const Rect: TRect; X, Y: Integer; const Text: string);

    {* Draws a text, clipping output into given rectangle.

       For more info, see Delphi TCanvas help. }

    function TextExtent(const Text: string): 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 : String; 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). }

    function TextWidth(const Text: string): Integer;

    {* Calculates text width (using TextArea). }

    function TextHeight(const Text: string): Integer;

    {* Calculates text height (using TextArea). }

    function ClipRect: TRect;

    {* returns ClipBox. by Dmitry Zharov. }



    {$IFNDEF _FPC}

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

    procedure WTextOut(X, Y: Integer; const WText: WideString); stdcall;

    {* Draws a Unicode text. }

    procedure WExtTextOut( X, Y: Integer; Options: DWORD; const Rect: TRect;

              const WText: WideString; const Spacing: array of Integer );

    {* }

    procedure WDrawText(WText: WideString; var Rect:TRect; Flags:DWord);

    {* }

    procedure WTextRect(const Rect: TRect; X, Y: Integer;

              const WText: WideString);

    {* Draws a Unicode text, clipping output into given rectangle. }

    function WTextExtent( const WText: WideString ): TSize;

    {* Calculates Unicode text width and height. }

    function WTextWidth( const WText: WideString ): Integer;

    {* Calculates Unicode text width. }

    function WTextHeight( const WText: WideString ): 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 fOnChange write fOnChange;

    {* }

    function Assign( SrcCanvas : PCanvas ) : Boolean;

    {* }

    function RequiredState( ReqState : DWORD ): Integer; 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. }

    procedure DeselectHandles;

    {* Call this method to deselect all graphic tool objects from the canvas. }

    property Pixels[ X, Y: Integer ]: TColor read GetPixels write SetPixels;

    {* Obvious. }

  end;

//[END OF TCanvas DEFINITION]



//[GlobalCanvas_OnTextArea]

var

    GlobalCanvas_OnTextArea : TOnTextArea;

    {* 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). }



//[NewCanvas DECLARATION]

function NewCanvas( DC: HDC ): PCanvas;

{* Use to construct Canvas on base of memory DC. }



//[Extended FUNCTIONS TO WORK WITH CANVAS]

{++}(*

{$IFDEF F_P}

function Windows_Polygon(DC: HDC; var Points; Count: Integer): BOOL; stdcall;

function Windows_Polyline(DC: HDC; var Points; Count: Integer): BOOL; stdcall;

function FillRect(hDC: HDC; const lprc: TRect; hbr: HBRUSH): Integer; stdcall;

function OffsetRect(var lprc: TRect; dx, dy: Integer): BOOL; stdcall;

function CreateAcceleratorTable(var Accel; Count: Integer): HACCEL; stdcall;

function TrackPopupMenu(hMenu: HMENU; uFlags: UINT; x, y, nReserved: Integer;

  hWnd: HWND; prcRect: PRect): BOOL; stdcall;

function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL;

  const NewState: TTokenPrivileges; BufferLength: DWORD;

  var PreviousState: TTokenPrivileges; var ReturnLength: DWORD): BOOL; stdcall;

function InflateRect(var lprc: TRect; dx, dy: Integer): BOOL; stdcall;

{$IFDEF F_P105ORBELOW}

function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL; stdcall;

function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL; stdcall;

{$ENDIF F_P105ORBELOW}

{$ENDIF}

*){--}





























{ -- Image list object -- }

//[IMAGE LIST]



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. }



  {++}(*TImageList = class;*){--}

  PImageList = {-}^{+}TImageList;

  {* }



  TImgLOVrlayIdx = 1..15;



{ ---------------------------------------------------------------------



                TImageList - images container



----------------------------------------------------------------------- }

//[TImageList DEFINITION]

  TImageList = object( TObj )

  {* 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;{+}{++}(*override;*){--}

    {*}

    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 : PChar; TranspColor : TColor ) : Boolean;

    {* Loads ImageList from resource. }

    //function LoadIcon( ResourceName : PChar ) : Boolean;

    //function LoadCursor( ResourceName : PChar ) : Boolean;

    function LoadFromFile( FileName : PChar; 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). }

    {$IFDEF USE_CONSTRUCTORS}

    constructor CreateImageList( POwner: Pointer );

    {$ENDIF USE_CONSTRUCTORS}

  end;

//[END OF TImageList DEFINITION]



//[IMAGE LIST API]



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;

function ImageList_LoadImageA(Instance: THandle; Bmp: PAnsiChar; CX, Grow: Integer;

  Mask: TColorRef; pType, Flags: Cardinal): HImageList; stdcall;

function ImageList_LoadImageW(Instance: THandle; Bmp: PWideChar; CX, Grow: Integer;

  Mask: TColorRef; pType, Flags: Cardinal): HImageList; stdcall;

function ImageList_LoadImage(Instance: THandle; Bmp: PChar; CX, Grow: Integer;

  Mask: TColorRef; pType, Flags: Cardinal): HImageList; stdcall;

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: PChar;

  CX, Grow: Integer; MasK: TColorRef): HImageList; stdcall;



//function ImageList_Read(Stream: IStream): HImageList; stdcall;

//function ImageList_Write(ImageList: HImageList; Stream: IStream): BOOL; stdcall;



//[TImageInfo]

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;



//[LoadBmp]

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





























//[BITMAPS]

type

  tagBitmap = Windows.TBitmap;



  TPixelFormat = ( pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit,

                   pf32bit, pfCustom );

  {* Available pixel formats. }

  TBitmapHandleType = ( bmDIB, bmDDB );

  {* Available bitmap handle types. }



  {++}(*TBitmap = class;*){--}

  PBitmap = {-}^{+}TBitmap;

{ ----------------------------------------------------------------------



                      TBitmap - bitmap image



----------------------------------------------------------------------- }

//[TBitmap DEFINITION]

  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

  {++}(*public*){--}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

  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: String );

    {* Loads bitmap from file (LoadFromStream used). }

    function LoadFromFileEx( const Filename: String ): Boolean;

    {* Loads bitmap from a file. If necessary, bitmap is RLE-decoded. Code given

       by Vyacheslav A. Gavrik. }

    procedure SaveToFile( const Filename: String );

    {* Stores bitmap to file (SaveToStream 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 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: PChar );

    {* 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. }

    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. }

    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;

//[END OF TBitmap DEFINITION]



//[NewBitmap DECLARATION]

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. }



//[CalcScanLineSize DECLARATION]

function CalcScanLineSize( Header: PBitmapInfoHeader ): Integer;

{* May be will be useful. }



//[DefaultPixelFormat VARIABLE]

var

  //DefaultBitsPerPixel: Integer = 16;

  DefaultPixelFormat: TPixelFormat = pf16bit;



//[Mapped bitmaps]



{ -- Function to load bitmap mapping some its colors. -- }

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: PChar; const Map: array of TColor )

         : HBitmap;

{* Like LoadMappedBitmap, but much powerful. It uses CreateMappedBitmapEx

   by Alex Pravdin, 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: PChar; 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). }

























//[ICONS]



type

  {++}(*TIcon = class;*){--}

  PIcon = {-}^{+}TIcon;

{ ----------------------------------------------------------------------



                          TIcon - icon image



----------------------------------------------------------------------- }

//[TIcon DEFINITION]

  TIcon = object( TObj )

  {* Object type to incapsulate icon or cursor image. }

  protected

    FSize : Integer;

    FHandle: HIcon;

    FShareIcon: Boolean;

    procedure SetSize(const Value: Integer);

    procedure SetHandle(const Value: HIcon);

    function GetHotSpot: TPoint;

    function GetEmpty: Boolean;

  protected

  {++}(*public*){--}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

  public

    property Size : Integer read FSize write SetSize;

    {* Icon dimension (width and/or height, which are equal to each other always). }

    property Handle : HIcon read FHandle write SetHandle;

    {* Windows icon object handle. }

    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 : String );

    {* 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: PChar; 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: String; 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 : String );

    {* 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;

//[END OF TIcon DEFINITION]



//[Icon save functions]



  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 : String );

  {* 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). }



//[NewIcon DECLARATION]

  function NewIcon: PIcon;

  {* Creates new icon object, setting its Size to 32 by default. Created icon

     is Empty. }



//[GetFileIconCount DECLARATION]

  function GetFileIconCount( const FileName: String ): Integer;

  {* Returns number of icon resources stored in given (executable) file. }



//[ICON STRUCTURES]

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, see below *)

    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;



//[LoadImgIcon DECLARATION]

function LoadImgIcon( RsrcName: PChar; Size: Integer ): HIcon;

{* Loads icon of specified size from the resource. }



















































////////////////////////////////////////////////////////////////////////////////

//                       UNIVERSAL CONTROL OBJECT                             //

////////////////////////////////////////////////////////////////////////////////



//[CM_XXX CONSTANTS]



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_CLOSE           = CM_BASE + 20;

  CM_MDIClientShowEdge = CM_BASE + 21;



  CM_INVALIDATECHILD   = CM_BASE + 22;

  CM_FOCUSGRAPHCTL     = CM_BASE + 23;



//[CN_XXX CONSTANTS]



  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;





//[ID_SELF DEFINED]

  ID_SELF: array[ 0..5 ] of Char = ( '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). }



//[ID_PREVPROC DEFINED]

  ID_PREVPROC: array[ 0..9 ] of Char = ( 'P','R','E','V','_','P','R','O','C',#0 );

  {* }



//[MK_ALT DEFINED]

  MK_ALT = $20;



//[RICHEDIT STRUCTURES]

type

  TCharFormat2A = 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 AnsiChar;

    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;

  TCharFormat2 = TCharFormat2A;



  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;



//[CONTROLS]



type

  {++}(*TControl = class;*){--}

  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. }



//[TWindowFunc TYPE]

  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. }





//[Mouse TYPES]

  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. }



//[Key TYPES]

  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: Char; 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). }



//[Event TYPES]

  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. }



  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: 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. }



//[Create Window STRUCTURES]

  TCreateParams = packed record

  {* Record to pass it through CreateSubClass method. }

    Caption: PChar;

    Style: cardinal;

    ExStyle: cardinal;

    X, Y: Integer;

    Width, Height: Integer;

    WndParent: HWnd;

    Param: Pointer;

    WindowClass: TWndClass;

    WinClassName: array[0..63] of Char;

  end;



  TCreateWndParams = packed Record

    ExStyle: DWORD;

    WinClassName: PChar;

    Caption: PChar;

    Style: DWORD;

    X, Y, Width, Height: Integer;

    WndParent: HWnd;

    Menu: HMenu;

    Inst: THandle;

    Param: Pointer;

    WinClsNamBuf: array[ 0..63 ] of Char;

    WindowClass: TWndClass;

  end;





//[COMMAND ACTIONS TYPE FOR DIFFERENT CONTROLS]

  PCommandActions = ^TCommandActions;

  TCommandActions = packed Record

    aClear: procedure( Sender: PControl );

    aAddText: procedure( Sender: PControl; const S: String );

    aClick, aEnter, aLeave: WORD; aChange: SmallInt; aSelChange: SmallInt;

    aGetCount, aSetCount, aGetItemLength, aGetItemText, aSetItemText,

    aGetItemData, aSetItemData: WORD;

    aAddItem, aDeleteItem, aInsertItem: WORD;

    aFindItem, aFindPartial: WORD;

    aItem2Pos, aPos2Item: BYTE;

    aGetSelCount, aGetSelected, aGetSelRange, aExGetSelRange, aGetCurrent,

    aSetSelected, aSetCurrent, aSetSelRange, aExSetSelRange,

    aGetSelection, aReplaceSel: WORD;

    aTextAlignLeft, aTextAlignRight, aTextAlignCenter: WORD;

    aTextAlignMask: Byte;

    aVertAlignCenter, aVertAlignTop, aVertAlignBottom: Byte;

    aDir, aSetLimit: Word; aSetImgList: Word;

    aAutoSzX, aAutoSzY: Word;

    aSetBkColor: Word;

    aItem2XY: Word;

  end;



//[Align TYPES]

  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 = ( vaCenter, vaTop, vaBottom );

  {* Vertical alignments available. }

  TControlAlign = ( caNone, caLeft, caTop, caRight, caBottom, caClient );

  {* Control alignments available. }



//[BitBtn TYPES]

  TBitBtnOption = ( bboImageList,

                    bboNoBorder,

                    bboNoCaption,

                    bboFixed );

  {* 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). }



//[ListView TYPES]

  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 plce 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: PChar ): 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: 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. }

  {$IFNDEF _D2}

  {$IFNDEF _FPC}

  TOnLVDataW = procedure( Sender: PControl; Idx, SubItem: Integer;

              var Txt: WideString; var ImgIdx: Integer; var State: DWORD;

              var Store: Boolean ) of object;

  {* Event type for OnLVDataW event (the same as OnLVData, but for unicode verion

     of the control OnLVDataW allows to return WideString text in the event

     handler). 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. }

  {$ENDIF _FPC}

  {$ENDIF _D2}

  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). }

  TOnLVDelete = procedure( Sender: PControl; Idx: Integer ) of object;

  {* Event type for OnLVDelete event, called when an item is been deleting. }



  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. }



//[Paint TYPES]

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

  TPaintProc = procedure( DC: HDC ) of object;



  TGradientStyle = ( gsVertical, gsHorizontal, gsRectangle, gsElliptic, gsRombic );

  {* 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. }



//[Edit TYPES]

  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. }



  TRichFmtArea = ( raSelection, raWord, raAll );

  {* Characters formatting area for RichEdit. }

  TRETextFormat = ( reRTF, reText, rePlainRTF, reRTFNoObjs, rePlainRTFNoObjs,

                    reTextized );

  {* 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 OLE objects

     rePlainRTF - reRTF without language-specific keywords

     reRTFNoObjs - reRTF without OLE objects

     rePlainRTFNoObjs - rePlainRTF without OLE objects

     |</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. }



  TCharFormat = TCharFormat2;

  TParaFormat = TParaFormat2;



  TOnTestMouseOver = function( Sender: PControl ): Boolean of object;

  {* Event type for TControl.OnTestMouseOver event. The handler should

     return True, if it dectects, that mouse is over control. }



  TEdgeStyle = ( esRaised, esLowered, esNone );

  {* Edge styles (for panel - see NewPanel). }



//[List TYPES]

  TListOption = ( loNoHideScroll, loNoExtendSel, loMultiColumn, loMultiSelect,

                  loNoIntegralHeight, loNoSel, loSort, loTabstops,

                  loNoStrings, loNoData, loOwnerDrawFixed, loOwnerDrawVariable );

  {* Options for ListBox (see NewListbox). }

  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. }



//[Progress TYPES]

  TProgressbarOption = ( pboVertical, pboSmooth );

  {* Options for progress bar. }

  TProgressbarOptions = set of TProgressbarOption;

  {* Set of options available for progress bar. }



//[TreeView TYPES]

  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. }



//[TabControl TYPES]

  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). }



//[Toolbar TYPES]

  TToolbarOption = ( tboTextRight, tboTextBottom, tboFlat, tboTransparent,

                 tboWrapable, tboNoDivider, tbo3DBorder );

  {* 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. }



  TDateTimePickerOption = ( dtpoTime, dtpoDateLong, dtpoUpDown, dtpoRightAlign,

    dtpoShowNone, dtpoParseInput );

  {* }

  TDateTimePickerOptions = set of TDateTimePickerOption;

  {* }

  TDTParseInputEvent = procedure(Sender: PControl; const UserString: string;

    var DateAndTime: TDateTime; var AllowChange: Boolean) of object;

  {* }

  TDateTimeRange = array[ 0..1 ] of TDateTime;

  {* }

  TDateTimePickerColor = ( dtpcBackground, dtpcMonthBk, dtpcText, dtpcTitleBk,

    dtpcTitleText, dtpcTrailingText );



//[TOnDropFiles TYPE]

  TOnDropFiles = procedure( Sender: PControl; const FileList: 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: String;

     !           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; }



//[Scroll TYPES]

  TScrollerBar = ( sbHorizontal, sbVertical );

  TScrollerBars = set of TScrollerBar;



  TOnScroll = procedure( Sender: PControl; Bar: TScrollerBar; ScrollCmd: DWORD;

            ThumbPos: DWORD ) of object;



//[TOnHelp EVENT TYPE]

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

            of object;



//[ScrollBar TYPES]

  TOnSBBeforeScroll =

    procedure(

      Sender: PControl; OldPos, NewPos: Integer; Cmd: Word;

      var AllowChange: Boolean) of object;

  TOnSBScroll = procedure(Sender: PControl; Cmd: Word) of object;



  TOnGraphCtlMouse = procedure( var Msg: TMsg ) of object;

  TTriStateCheck = (tsUnchecked{=0}, tsChecked{=1}, tsIndeterminate{=2});





  {$IFDEF USE_MHTOOLTIP}

  {$DEFINE pre_interface}

  {$I KOLMHToolTip}

  {$UNDEF pre_interface}

  {$ENDIF}



{ ----------------------------------------------------------------------



             TControl - object to implement any visual control



----------------------------------------------------------------------- }

//[TControl DEFINITION]

  TControl = object( TObj )

  protected

    fSBMinMax: TPoint;

    fSBPageSize: Integer;

    fSBPosition: Integer;

    procedure SetSBMax(Value: Longint);

    procedure SetSBMin(Value: Longint);

    procedure SetSBPageSize(Value: Integer);

    procedure SetSBPosition(Value: Integer);

    procedure SetSBMinMax(const Value: TPoint);



    function GetDate: TDateTime;

    function GetTime: TDateTime;

    procedure SetDate(const Value: TDateTime);

    procedure SetTime(const Value: TDateTime);

  {*! 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>. }

  protected

    function GetHelpPath: String;

    procedure SetHelpPath(const Value: String);

    procedure SetOnQueryEndSession(const Value: TOnEventAccept);

    procedure SetOnMinMaxRestore(const Index: Integer; const Value: TOnEvent);

    procedure SetConstraint(const Index, Value: Integer);

    {$IFDEF F_P}

    function GetOnMinMaxRestore(const Index: Integer): TOnEvent;

    function GetConstraint(const Index: Integer): Integer;

    {$ENDIF F_P}

    procedure SetOnScroll(const Value: TOnScroll);

    function GetLVColalign(Idx: Integer): TTextAlign;

    procedure SetLVColalign(Idx: Integer; const Value: TTextAlign);



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

    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;

    procedure SetHasBorder(const Value: Boolean);



    function GetHasCaption: Boolean;

    procedure SetHasCaption(const Value: Boolean);



    function GetCanResize: Boolean;

    procedure SetCanResize( const Value: Boolean );



    function GetStayOnTop: Boolean;

    procedure SetStayOnTop(const Value: Boolean);

    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): String;

    procedure SetItems(Idx: Integer; const Value: String);



    function GetItemsCount: Integer;

    function GetItemSelected(ItemIdx: Integer): Boolean;

    procedure SetItemSelected(ItemIdx: Integer; const Value: Boolean);



    procedure SetCtl3D(const Value: Boolean);

    function GetCurIndex: Integer;

    procedure SetCurIndex(const Value: Integer);

    function GetTextAlign: TTextAlign;

    function GetVerticalAlign: TVerticalAlign;

    procedure SetTextAlign(const Value: TTextAlign);

    procedure SetVerticalAlign(const Value: TVerticalAlign);



    function GetCanvas: PCanvas;

    function Dc2Canvas( Sender: PCanvas ): HDC;

    procedure SetShadowDeep(const Value: Integer);

    procedure SetDoubleBuffered(const Value: Boolean);



    procedure SetStatusText(Index: Integer; Value: PChar);

    function GetStatusText( Index: Integer ): PChar;

    function GetStatusPanelX(Idx: Integer): Integer;

    procedure SetStatusPanelX(Idx: Integer; const Value: Integer);



    procedure SetTransparent(const Value: Boolean);

    function GetImgListIdx(const Index: Integer): PImageList;



    procedure SetImgListIdx(const Index: Integer; const Value: PImageList);

    function GetLVColText(Idx: Integer): String;

    procedure SetLVColText(Idx: Integer; const Value: String);

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    function GetLVColTextW(Idx: Integer): WideString;

    procedure SetLVColTextW(Idx: Integer; const Value: WideString);

    {$ENDIF _D2}

    {$ENDIF _FPC}

    function LVGetItemText(Idx, Col: Integer): String;

    procedure LVSetItemText(Idx, Col: Integer; const Value: String);

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    function LVGetItemTextW(Idx, Col: Integer): WideString;

    procedure LVSetItemTextW(Idx, Col: Integer; const Value: WideString);

    {$ENDIF _D2}

    {$ENDIF _FPC}

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



    function GetChildCount: Integer;



    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): String;

    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: String);



    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;

    procedure Set_Align(const Value: TControlAlign);

    function GetSelection: String;

    procedure SetSelection(const Value: String);

    procedure SetTabOrder(const Value: Integer);

    function GetFocused: Boolean;

    procedure SetFocused(const Value: Boolean);

    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): String;

    procedure REWriteText(Format: TRETextFormat; SelectionOnly: Boolean;

      const Value: String);

    function REGetFontName: String;

    procedure RESetFontName(const Value: String);

    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;

    procedure RESetAutoURLDetect(const Value: Boolean);



    function GetMaxTextSize: DWORD;

    procedure SetMaxTextSize(const Value: DWORD);

    procedure SetOnResize(const Value: TOnEvent);



    procedure DoSelChange;



    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;

    procedure RESetTransparent(const Value: Boolean);

    procedure RESetOnURL(const Index: Integer; const Value: TOnEvent);

    {$IFDEF F_P}

    function REGetOnURL(const Index: Integer): TOnEvent;

    {$ENDIF F_P}

    function REGetLangOptions(const Index: Integer): Boolean;

    procedure RESetLangOptions(const Index: Integer; const Value: Boolean);

    function LVGetItemImgIdx(Idx: Integer): Integer;

    procedure LVSetItemImgIdx(Idx: Integer; const Value: Integer);

    procedure SetFlat(const Value: Boolean);

    procedure SetOnMouseEnter(const Value: TOnEvent);

    procedure SetOnMouseLeave(const Value: TOnEvent);

    procedure EdSetTransparent(const Value: Boolean);

    procedure SetOnTestMouseOver(const Value: TOnTestMouseOver);

    function GetPages(Idx: Integer): PControl;

    function TCGetItemText(Idx: Integer): String;

    procedure TCSetItemText(Idx: Integer; const Value: String);

    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): String;

    procedure TVSetItemText(Item: THandle; const Value: String);

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    function TVGetItemTextW(Item: THandle): WideString;

    procedure TVSetItemTextW(Item: THandle; const Value: WideString);

    {$ENDIF _D2}

    {$ENDIF _FPC}

    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: Integer);

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

    procedure SetOnDeleteAllLVItems(const Value: TOnEvent);

    procedure SetOnDeleteLVItem(const Value: TOnDeleteLVItem);

    procedure SetOnEditLVItem(const Value: TOnEditLVItem);

    procedure SetOnLVData(const Value: TOnLVData);

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    procedure SetOnLVDataW(const Value: TOnLVDataW);

    {$ENDIF _D2}

    {$ENDIF _FPC}

    procedure SetOnColumnClick(const Value: TOnLVColumnClick);

    procedure SetOnDrawItem(const Value: TOnDrawItem);

    procedure SetOnMeasureItem(const Value: TOnMeasureItem);



    procedure SetItemsCount(const Value: Integer);



    function GetItemData(Idx: Integer): DWORD;

    procedure SetItemData(Idx: Integer; const Value: DWORD);

    function GetLVCurItem: Integer;

    procedure SetLVCurItem(const Value: Integer);

    function GetLVFocusItem: Integer;

    procedure SetOnDropFiles(const Value: TOnDropFiles);

    procedure SetOnHide(const Value: TOnEvent);

    procedure SetOnShow(const Value: TOnEvent);

    procedure SetClientMargin(const Index, Value: Integer);

    {$IFDEF F_P}

    function GetClientMargin(const Index: Integer): Integer;

    {$ENDIF F_P}

    procedure SetOnPaint(const Value: TOnPaint);

    procedure SetOnEraseBkgnd(const Value: TOnPaint);

    procedure SetTVRightClickSelect(const Value: Boolean);

    procedure SetOnLVStateChange(const Value: TOnLVStateChange);

    procedure SetOnLVDelete(const Value: TOnLVDelete);

    procedure SetOnMove(const Value: TOnEvent);

    procedure SetColor1(const Value: TColor);

    procedure SetColor2(const Value: TColor);

    procedure SetGradientLayout(const Value: TGradientLayout);

    procedure SetGradientStyle(const Value: TGradientStyle);

    procedure SetDroppedDown(const Value: Boolean);

    function get_ClassName: String;

    procedure set_ClassName(const Value: String);

    procedure SetClsStyle( Value: DWord );



    procedure SetStyle( Value: DWord );

    procedure SetExStyle( Value: DWord );



    procedure SetCursor( Value: HCursor );



    procedure SetIcon( Value: HIcon );

    procedure SetMenu( Value: HMenu );

    function GetCaption: String;

    procedure SetCaption( const Value: String );



    procedure SetWindowState( Value: TWindowState );

    function GetWindowState: TWindowState;



    procedure ApplyFont2Wnd;

    procedure DoClick;



    function TBAddInsButtons( Idx: Integer; const Buttons: array of PChar; const BtnImgIdxArray: array

              of Integer ): Integer; stdcall;

    procedure SetBitBtnDrawMnemonic(const Value: Boolean);

    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}



  protected

    fHandle: HWnd;

    fFocusHandle: HWnd;

    fClsStyle: DWord;

    fStyle: DWord;

    fExStyle: DWord;

    fCursor: HCursor;

    fCursorShared: Boolean;

    fIcon: HIcon;

    fIconShared: Boolean;

    fCaption: PChar; // it is now preferred to store Caption as PChar (null-

                     // terminated string), dynamically allocated in memory.

    fIgnoreWndCaption: Boolean;



    fWindowState: TWindowState;

    fShowAction: Integer;

    fCanvas: PCanvas;

    fDefWndProc: Pointer;

    fNCDestroyed: Boolean;



    FParent: PControl;

    //FTag: Integer;

    fEnabled: Boolean; // Caution!!! fVisible must follow fEnabled! ___

    fVisible: Boolean; //____________________________________________//

    fTabstop: Boolean;

    fTabOrder: Integer;

    fTextAlign: TTextAlign;

    fVerticalAlign: TVerticalAlign;

    fWordWrap: Boolean;

    fPreventResize: Boolean;

    fAlphaBlend: Integer;

    FDroppedWidth: Integer;



    fChildren: PList;

    {* List of children. }

    fMDIClient: PControl;

    {* MDI client window control }

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

    {* MDI children list }

    fMDIChildren: PList;

    {* List of MDI children. It is filled for MDI client window. }

    fWndFunc: Pointer;

    {* Initially pointer to WndFunc. For MDI child window, points to DefMDIChildProc. }

    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. }

    fMDIDestroying: Boolean;

    {* }



    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. }

    fTmpBrushColorRGB: TColor;

    { }

    fMembersCount: Integer;

    {* Memebers count is first used in XCustomControl to separate

       some internal child controls from common XControl.Children

       and make it invisible among Children[]. }

    fDrawCtrl1st: PControl;

    {* Child control to draw it first, i.e. foreground of others. }

    FCreating: Boolean;

    {* True, when creating of object is in progress. }

    fDestroying: Boolean;

    {* True, when destroying of the window is started. Made protected to

       be accessible in descending classes. }

    fMenu: HMenu;

    {* Usually used to store handle of attached main menu, but sometimes

       is used to store control ID (for standard GUI controls only). }

    fMenuObj: PObj;

    {* PMenu pointer to TMenu object. Freed automatically with entire

       chain of menu objects attached to a control (or form). }

{$IFNDEF NEW_MENU_ACCELL}

    fAccelTable: HAccel;

{$ENDIF}

    {* 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. }

    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). }

    fIsApplet: Boolean;

    {* True, if the object represent application taskbar button. }

    fIsForm: Boolean;

    {* True, if the object is form. }

    fIsMDIChild: Boolean;

    {* TRUE, if the object is MDI child form. }

    fIsControl: Boolean;

    {* True, if it is a control on form. }

    fIsStaticControl: Byte;

    {* True, if it is static control with a caption. (To prevent flickering

       it in DoubleBuffered mode. }

    fIsCommonControl: Boolean;

    {* True, if it is common control. }

    fChangedPosSz: Byte;

    {* Flags of changing left (1), top (2), width (4) or height (8) }

    fCannotDoubleBuf: Boolean;

    {* True, if cannot set DoubleBuffered to True (RichEdit). }

    fUpdRgn: HRgn;

    fCollectUpdRgn: HRGN;

    fEraseUpdRgn: Boolean;

    fPaintDC: HDC;

    fDblBufBmp: HBitmap;

    {* Memory bitmap, used for DoubleBuffered painting. }

    fDblBufW, fDblBufH: Integer;

    {* Dimensions of fDblBufBmp. }

    fDblBufPainting: Boolean;

    fLookTabKeys: TTabKeys;

    fNotUpdate: Boolean;

    fDynHandlers: PList;

    fColumn: Integer;

    FSupressTab: Boolean;

    fUpdateCount: Integer;

    fPaintLater: Boolean;

    fOnLeave: TOnEvent;

    fEditing: Boolean;

    fAutoPopupMenu: PObj;

    fHelpContext: Integer;



    // Order of following fields is important:

    //_______________________________________________________________________________________________

    fOnDynHandlers: TWindowFunc;                                                                   //

    fWndProcKeybd: function( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;         //

    fControlClick: procedure( Sender : PObj );                                                     //

    fControlClassName: PChar;                                                                      //

    fWindowed: Boolean;                                                                            //

    {* True, if control is windowed (or is a form). Now always True,                               //

       because KOL does not yet contain Graphic controls. }                                        //

    //                                                                                             //

    fCtlClsNameChg: Boolean;                                                                       //

    {* True, if control class name changed and memory is allocated to store it. }                  //

    fWndProcResizeFlicks: function( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;  //

    fGotoControl: function( Self_: PControl; Key: DWORD; CheckOnly: Boolean ): Boolean;            //

    fCtl3Dchild: Boolean;                                                                          //

    fCtl3D: Boolean;                                                                               //

    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. }                      //

    fFont: PGraphicTool;                                                                           //

    fColor: TColor;                                                                                //

    {* Color of control background. }                                                              //

    fBrush: PGraphicTool;                                                                          //

    fMargin: Integer;                                                                              //

    fBoundsRect: TRect;                                                                            //

    fClientTop, fClientBottom, fClientLeft, fClientRight: Integer;                                 //

    {* Store adjustment factor of ClientRect for some 'idiosincrasies' windows,                    //

       such as Groupbox or Tabcontrol. }                                                           //

    //_____________________________________________________________________________________________//

    // this is the end of fiels set, which order is important



    fDoubleBuffered: Boolean;                                                                      //

    fTransparent: Boolean;                                                                         //



    fOnMessage: TOnMessage;

    fOldOnMessage: TOnMessage;



    fOnClick: TOnEvent;

    fRightClick: Boolean;

    fCurrentControl: PControl;

    fCreateVisible, fCreateHidden: Boolean;

    fRadio1st, fRadioLast : THandle;

    fDropDownProc: procedure( Sender : PObj );

    fDropped: Boolean;

    fCurIdxAtDrop: Integer;

    fPrevWndProc: Pointer;

    fClickDisabled: Byte;

    fCurItem, fCurIndex: Integer;

    FOnScroll: TOnScroll;

    FScrollLineDist: array[ 0..1 ] of Integer;



    fDefaultBtn: Boolean;

    fCancelBtn: Boolean;

    fDefaultBtnCtl: PControl;

    fCancelBtnCtl: PControl;

    fAllBtnReturnClick: Boolean;

    fIgnoreDefault: Boolean;



    fOnMouseDown: TOnMouse; // CAUTION!!! Order of mouse event handlers is important. ____

    fOnMouseUp: TOnMouse;                                                               //

    fOnMouseMove: TOnMouse;                                                             //

    fOnMouseDblClk: TOnMouse;                                                           //

    fOnMouseWheel: TOnMouse;     //_____________________________________________________//



    fOldDefWndProc: Pointer;



    fOnChange: TOnEvent;

    fOnEnter: TOnEvent;



    FOnLVCustomDraw: TOnLVCustomDraw;

    FOnSBBeforeScroll: TOnSBBeforeScroll;

    FOnSBScroll: TOnSBScroll;

  protected

    procedure SetOnLVCustomDraw(const Value: TOnLVCustomDraw);

  public

    fCommandActions: TCommandActions;

  protected

    fOnChar: TOnChar;

    fOnKeyUp: TOnKey;

    fOnKeyDown: TOnKey;



    fOnPaint: TOnPaint;

    fOnPaint2: TOnPaint;

    fPaintMsg: TMsg;

    fOnPrepaint: TOnPaint;

    fOnPostPaint: TOnPaint;

    fPaintProc: TPaintProc;



    FMaxWidth: Integer;

    FMinWidth: Integer;

    FMaxHeight: Integer;

    FMinHeight: Integer;

    fShadowDeep: Integer;

    fStatusCtl: PControl;

    fStatusWnd: HWnd;

    fStatusTxt: PChar;

    fColor1: TColor;

    fColor2: TColor;

    fLVColCount: Integer;

    fLVOptions: TListViewOptions;

    fLVStyle: TListViewStyle;

    fOnEditLVITem: TOnEditLVItem;

    fLVTextBkColor: TColor;

    fLVItemHeight: Integer;



    fOnDropDown: TOnEvent;

    fOnCloseUp: TOnEvent;



    fModalResult: Integer;

    

    fModal: Integer;

    fModalForm: PControl;



    FAlign: TControlAlign;

    fNotUseAlign: Boolean;

    fDragCallback: TOnDrag;

    fDragging: Boolean;

    fDragStartPos: TPoint;

    fMouseStartPos: TPoint;

    fSplitStartPos: TPoint;

    fSplitStartPos2: TPoint;

    fSplitStartSize: Integer;

    fSplitMinSize1, fSplitMinSize2: Integer;

    fOnSplit: TOnSplit;

    fSecondControl: PControl;

    fOnSelChange: TOnEvent;

    fTmpFont: PGraphicTool;



    fRECharFormatRec: TCharFormat2;

    fREError: Integer;

    fREStream: PStream;

    fREStrLoadLen: DWORD;

    fREParaFmtRec: TParaFormat2;

    FOnResize: TOnEvent;

    fOnProgress: TOnEvent;

    fCharFmtDeltaSz: Integer;

    fParaFmtDeltaSz: Integer;

    fREOvr: Boolean;

    fReOvrDisable: Boolean;

    fOnREInsModeChg: TOnEvent;

    fREScrolling: Boolean;

    fUpdCount: Integer;

    fOnREOverURL: TOnEvent;

    fOnREURLClick: TOnEvent;

    fRECharArea: TRichFmtArea;

    fBitBtnOptions : TBitBtnOptions;

    fGlyphLayout : TGlyphLayout;

    fGlyphBitmap : HBitmap;

    fGlyphCount : Integer;

    fGlyphWidth, fGlyphHeight: Integer;

    fOnBitBtnDraw: TOnBitBtnDraw;

    fFlat: Boolean;

    fSizeRedraw: Boolean; {YS}



    fOnMouseLeave: TOnEvent;

    fOnMouseEnter: TOnEvent;

    fOnTestMouseOver: TOnTestMouseOver;



    fMouseInControl: Boolean;

    fRepeatInterval: Integer;

    fChecked: Boolean;

    fPushed: Boolean;

    fPrevFocusWnd: HWnd;



    fOnTVBeginDrag: TOnTVBeginDrag;

    fOnTVBeginEdit: TOnTVBeginEdit;

    fOnTVEndEdit: TOnTVEndEdit;

    fOnTVExpanded: TOnTVExpanded;

    fOnTVExpanding: TOnTVExpanding;

    fOnTVDelete: TOnTVDelete;



    fOnDeleteLVItem: TOnDeleteLVItem;

    fOnDeleteAllLVItems: TOnEvent;

    fOnLVData: TOnLVData;

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    fOnLVDataW: TOnLVDataW;

    {$ENDIF _D2}

    {$ENDIF _FPC}

    fOnCompareLVItems: TOnCompareLVItems;

    fOnColumnClick: TOnLVColumnClick;

    fOnDrawItem: TOnDrawItem;

    fOnMeasureItem: TOnMeasureItem;

    fREUrl: String;

    FMinimizeWnd: PControl;

    FFixWidth: Integer;

    FFixHeight: Integer;

    FOnDropFiles: TOnDropFiles;

    FOnHide: TOnEvent;

    FOnShow: TOnEvent;

    fOnEraseBkgnd: TOnPaint;

    fCustomData: Pointer;

    fCustomObj: PObj;

    fOnTVSelChanging: TOnTVSelChanging;



    fOnClose: TOnEventAccept;

    fOnQueryEndSession: TOnEventAccept;

    fCloseQueryReason: TCloseQueryReason;



    //----- order of following 3 events important: //

    fOnMinimize: TOnEvent;                         //

    fOnMaximize: TOnEvent;                         //

    fOnRestore: TOnEvent;                          //

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



    //fCreateParamsExt: procedure( Self_: PControl; var Params: TCreateParams );

    fCreateWndExt: procedure( Sender: PControl );



    fTBttCmd: PList;

    fTBttTxt: PStrList;

    fTBevents: PList; // events for TBAssignEvents

    fTBBtnImgWidth: Integer; // custom toolbar bitmap width

    FTBBtMinWidth: Integer;

    FTBBtMaxWidth: Integer;

    fGradientStyle: TGradientStyle;

    fGradientLayout: TGradientLayout;

    fVisibleWoParent: Boolean;





    fTVRightClickSelect: Boolean;

    FOnMove: TOnEvent;

    FOnLVStateChange: TOnLVStateChange;

    FOnLVDelete: TOnLVDelete;

    fAutoSize: procedure( Self_: PControl );

    fIsButton: Boolean;

    fSizeGrip: Boolean;

    fNotAvailable: Boolean;

    FPressedMnemonic: DWORD;

    FBitBtnDrawMnemonic: Boolean;

    FBitBtnGetCaption: function( Self_: PControl; const S: String ): String;

    FBitBtnExtDraw: procedure( Self_: PControl; DC: HDC; X, Y: Integer; const R: TRect;

                    const CapText, CapTxtOrig: String; Color: TColor );

    FTextShiftX, FTextShiftY: Integer;

    fNotifyChild: procedure( Self_, Child: PControl );

    fScrollChildren: procedure( Self_: PControl );

    fOnHelp: TOnHelp;



    FOnDTPUserString: TDTParseInputEvent;



    {$IFDEF USE_MHTOOLTIP}

    {$DEFINE var}

    {$I KOLMHToolTip}

    {$UNDEF var}



    {$DEFINE function}

    {$I KOLMHToolTip}

    {$UNDEF function}

    {$ENDIF}



    procedure Init; {-}virtual;{+}{++}(*override;*){--}

    {* }

    procedure InitParented( AParent: PControl ); virtual;

    {* Initialization of visual object. }

    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. }



    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. }

    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. }

    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: PChar );

    {* 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;

    {* Updates fStyle, fExStyle, fClsStyle from window handle }

    procedure SetOnChar(const Value: TOnChar);

    {* }

    procedure SetOnKeyDown(const Value: TOnKey);



    {* }

    procedure SetOnKeyUp(const Value: TOnKey);

    {* }

    procedure SetMouseDown(const Value: TOnMouse);

    {* }

    procedure SetMouseMove(const Value: TOnMouse);

    {* }

    procedure SetMouseUp(const Value: TOnMouse);

    {* }

    procedure SetMouseWheel(const Value: TOnMouse);

    {* }

    procedure SetMouseDblClk(const Value: TOnMouse);

    {* }

    procedure SetHelpContext( Value: Integer );

    {* }

    procedure SetOnTVDelete( const Value: TOnTVDelete );

    {* }

    procedure SetDefaultBtn(const Index: Integer; const Value: Boolean);

    {$IFDEF F_P}

    function GetDefaultBtn(const Index: Integer): Boolean;

    {$ENDIF F_P}

    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: String );



  public

    constructor CreateParented( AParent: PControl );

    {* Creates new instance of TControl object, calling InitParented }

    //FormPointer_DoNotUseItPlease_ItIsUsedByMCK: Pointer;

    { ^ no more needed }

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* 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. }

    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. }



    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. Thus is, True is returned if either control

       is Visible or hidden, but marked with flag fCreateHidden. }

    property CreateVisible: Boolean read fCreateVisible write fCreateVisible;

    {* 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. }

    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 or

       toolbar) caLeft or caRight, this can cause infinite recursion in the

       application. }

    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. }

    property MinWidth: Integer index 0

             {$IFDEF F_P}   read GetConstraint

             {$ELSE DELPHI} read FMinWidth

             {$ENDIF F_P/DELPHI} write SetConstraint;

    {* Minimal width constraint. }

    property MinHeight: Integer index 1

             {$IFDEF F_P}   read GetConstraint

             {$ELSE DELPHI} read FMinHeight

             {$ENDIF F_P/DELPHI} write SetConstraint;

    {* Minimal height constraint. }

    property MaxWidth: Integer index 2

             {$IFDEF F_P}   read GetConstraint

             {$ELSE DELPHI} read FMaxWidth

             {$ENDIF F_P/DELPHI} write SetConstraint;

    {* Maximal width constraint. }

    property MaxHeight: Integer index 3

             {$IFDEF F_P}   read GetConstraint

             {$ELSE DELPHI} read FMaxHeight

             {$ENDIF F_P/DELPHI} write SetConstraint;

    {* Maximal height constraint. }



    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. }

    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 TVisual at the given position (relatively to top left

       corner of the ClientRect). }



    procedure Invalidate;

    {* Invalidates rectangle, occupied by the visual (but only if Showing =

       True). }



    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 fWindowed;

    {* 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). }



    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). }

    property MDIClient: PControl read fMDIClient;

    {* For MDI forms only: returns MDI client window control, containng all MDI

       children. Use this window to send specific messages to rule MDI children. }



    property ChildCount: Integer read GetChildCount;//GetChildCountWOMembers;

    {* Returns number of commonly accessed child objects (without

       MembersCount). }

    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[]. }

    property MembersCount: Integer read FMembersCount;

    {* Returns number of "internal" child objects, which are

       not accessible through common Children[] property. }

    property Members[ Idx: Integer ]: PControl read GetMembers;

    {* Members and children array of the object (first from 0 to

       MembersCount-1 are Members[], and Children[] are followed by

       them. Usually You do not need to use this list. Use instead

       Children[0..ChildCount] property, Members[] is intended for

       internal needs of XCL (and in KOL by now Members and Children

       actually are the same properties). }



    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. }



    function ParentForm: PControl;

    {* |<#form>

       Returns parent form for a control (of @Self for form itself. }

    property ActiveControl: PControl read fCurrentControl write 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). }

    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}

    {$I KOLMHToolTip}

    {$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');

    }



    property Style: DWord read fStyle 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: PChar );

    {* Loads Cursor from the resource. See also comments for Icon property. }



    property Icon: HIcon read GetIcon 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: PChar );

    {* |<#appbutton>

       |<#form>

       See Icon property. }

    procedure IconLoadCursor( Inst: Integer; ResName: PChar );

    {* |<#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 fHelpContext 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: String 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 fOnHelp write fOnHelp;

    {* 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. }



    property Caption: String 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: String 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. }

    property SelStart: Integer read GetSelStart write SetSelStart;

    {* |<#edit>

       |<#memo>

       |<#richedit>

       |<#listbox>

       |<#combo>

       Start of selection (editbox - character position, listbox and combobox -

       index of [the first] selected item). }

    property SelLength: Integer read GetSelLength write SetSelLength;

    {* |<#edit>

       |<#memo>

       |<#richedit>

       |<#listbox>

       |<#listview>

       Length of selection (editbox - number of characters selected, multiline

       listbox - number of items selected). }



    property Selection: String 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: String; 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. }



    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. 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 ]: String 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 ): Integer;

    {* |<#edit>

       |<#memo>

       Only for edit controls: converts line index to character position. }

    function Pos2Item( Pos: Integer ): Integer;

    {* |<#edit>

       |<#memo>

       Only for edit controls: converts character position to line index. }



    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: String ): 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: String; 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>

       Returns True, if a line (in editbox) or an item (in listbox, combobox) 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 read fOnDropDown write fOnDropDown;

    {* |<#combo>

       |<#toolbar>

       Is called when combobox is dropped down (or drop-down button of

       toolbar is pressed - see also OnTBDropDown). }

    property OnCloseUp: TOnEvent read fOnCloseUp write fOnCloseUp;

    {* |<#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 FDroppedWidth write SetDroppedWidth;

    {* |<#combo>

       Allows to change width of dropped down items list for combobox (only!)

       control. }

    property DroppedDown: Boolean read fDropped write SetDroppedDown;

    {* |<#combo>

       Dropped down state for combo box. Set it to TRUE or FALSE to change

       dropped down state. }

    procedure AddDirList( const Filemask: String; 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 fOnBitBtnDraw write fOnBitBtnDraw;

    {* |<#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 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 fTextShiftX write fTextShiftX;

    {* |<#bitbtn>

       Horizontal shift for bitbtn text when the bitbtn is pressed. }

    property TextShiftY: Integer read fTextShiftY write 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 fOnMeasureItem 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 fDefaultBtn

             {$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 fCancelBtn

             {$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 any its 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 fIgnoreDefault write fIgnoreDefault;

    {* 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). }





    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. }

    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 fCtl3D 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 fModalResult write

    {$IFDEF USE_SETMODALRESULT}

    SetModalResult;

    {$ELSE}

    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 fModalForm write fModalForm;

    {* |<#form>

       |<#appbutton>

       Form currently shown modal from this form or from Applet. }



    procedure Hide;

    {* |<#appbutton>

       |<#form>

       Makes control hidden. }

    property OnShow: TOnEvent read FOnShow 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 FOnHide write SetOnHide;

    {* Is called when a control or form becomes hidden. }

    property WindowState: TWindowState read GetWindowState write SetWindowState;

    {* |<#form>

       Window state. }



    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). }

    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. }



    property OnMessage: TOnMessage read fOnMessage write fOnMessage;

    {* |<#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). }



    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 FIsApplet;

    {* Returns true, if the control is created using NewApplet (or CreateApplet).

    }

    property IsForm: Boolean read fIsForm;

    {* Returns True, if the object is form window. }

    property IsMDIChild: Boolean read fIsMDIChild;

    {* Returns TRUE, if the object is MDI child form. In such case, IsForm also

       returns TRUE. }

    property IsControl: Boolean read fIsControl;

    {* Returns True, is the control is control (not form or applet). }

    property IsButton: Boolean read fIsButton;

    {* Returns True, if the control is button-like or containing buttons (button,

       bitbtn, checkbox, radiobox, toolbar). }



    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;

    {* 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: Integer 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: Integer read fMargin write fMargin;

    {* |<#form>

       Old name for property Border. }



    property MarginTop: Integer 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: Integer 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: Integer 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: Integer 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 read fTabstop write fTabstop;

    {* 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: Integer 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. }

    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. }

    property WordWrap: Boolean read fWordWrap write fWordWrap;

    {* TRUE, if this is a label, created using NewWordWrapLabel. }

    property ShadowDeep: Integer read FShadowDeep write SetShadowDeep;

    {* |<#3dlabel>

       Deep of a shadow (for label effect only, created calling NewLabelEffect). }



    property CannotDoubleBuf: Boolean read fCannotDoubleBuf write fCannotDoubleBuf;

    {* }

    property DoubleBuffered: Boolean read fDoubleBuffered 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 IsSelfOrParentDblBuf: Boolean;

    {* Returns true, if DoubleBuffered or one of parents is DoubleBuffered. }

    function DblBufTopParent: PControl;

    {* Returns the topmost DoubleBuffered Parent control. }

    property Transparent: Boolean read fTransparent 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 fTransparent 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: Integer 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).  }



    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: String read get_ClassName write set_ClassName;

    {* Name of window class - unique for every window class

       in every run session of a program. }



    property OnClose: TOnEventAccept read fOnClose write fOnClose;

    {* |<#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 fOnQueryEndSession 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. }

    property CloseQueryReason: TCloseQueryReason read fCloseQueryReason;

    {* Reason why OnClose or OnQueryEndSession called. }

    property OnMinimize: TOnEvent index 0

             {$IFDEF F_P}   read GetOnMinMaxRestore

             {$ELSE DELPHI} read fOnMinimize

             {$ENDIF F_P/DELPHI} write SetOnMinMaxRestore;

    {* |<#form>

       Called when window is minimized. }

    property OnMaximize: TOnEvent index 8

             {$IFDEF F_P}   read GetOnMinMaxRestore

             {$ELSE DELPHI} read fOnMaximize

             {$ENDIF F_P/DELPHI} write SetOnMinMaxRestore;

    {* |<#form>

       Called when window is maximized. }

    property OnRestore: TOnEvent index 16

             {$IFDEF F_P}   read GetOnMinMaxRestore

             {$ELSE DELPHI} read fOnRestore

             {$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 fEraseUpdRgn write fEraseUpdRgn;

    {* 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. }



    property OnPaint: TOnPaint read fOnPaint 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. }

    property OnPrePaint: TOnPaint read fOnPrePaint write fOnPrePaint;

    {* Only for graphic controls. If you assign it, call Invalidate also. }

    property OnPostPaint: TOnPaint read fOnPostPaint write fOnPostPaint;

    {* Only for graphic controls. If you assign it, call Invalidate also. }



    property OnEraseBkgnd: TOnPaint read fOnEraseBkgnd write SetOnEraseBkgnd;

    {* 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;

    !

     }





    property OnClick: TOnEvent read fOnClick write fOnClick;

    {* |<#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. }

    property RightClick: Boolean read fRightClick;

    {* |<#toolbar>

       |<#listview>

       Use this property to determine which mouse button was clicked

       (applicable to toolbar in the OnClick event handler). }

    property OnEnter: TOnEvent read fOnEnter write fOnEnter;

    {* Called when control receives focus. }

    property OnLeave: TOnEvent read fOnLeave write fOnLeave;

    {* Called when control looses focus. }

    property OnChange: TOnEvent read fOnChange write fOnChange;

    {* |<#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 read fOnSelChange write fOnSelChange;

    {* |<#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 FOnResize write SetOnResize;

    {* Called whenever control receives message WM_SIZE (thus is, if

       control is resized. }

    property OnMove: TOnEvent read FOnMove write SetOnMove;

    {* Called whenever control receives message WM_MOVE (i.e. when control is

       moved over its parent). }



    property MinSizePrev: Integer read fSplitMinSize1 write fSplitMinSize1;

    {* |<#splitter>

       Minimal allowed (while dragging splitter) size of previous control

       for splitter (see NewSplitter). }

    property SplitMinSize1: Integer read fSplitMinSize1 write fSplitMinSize1;

    {* The same as MinSizePrev. }

    property MinSizeNext: Integer read fSplitMinSize2 write fSplitMinSize2;

    {* |<#splitter>

       Minimal allowed (while dragging splitter) size of the rest of parent

       of splitter or of SecondControl (see NewSplitter). }

    property SplitMinSize2: Integer read fSplitMinSize2 write fSplitMinSize2;

    {* The same as MinSizeNext. }

    property SecondControl: PControl read fSecondControl write 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 fOnSplit write fOnSplit;

    {* |<#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 FDragging;

    {* |<#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 fOnKeyDown write SetOnKeyDown;

    {* Obvious. }

    property OnKeyUp: TOnKey read fOnKeyUp write SetOnKeyUp;

    {* Obvious. }

    property OnChar: TOnChar read fOnChar write SetOnChar;

    {* Obvious. }



    property OnMouseDown: TOnMouse read fOnMouseDown write SetMouseDown;

    {* Obvious. }

    property OnMouseUp: TOnMouse read fOnMouseUp write SetMouseUp;

    {* Obvious. }

    property OnMouseMove: TOnMouse read fOnMouseMove write SetMouseMove;

    {* Obvious. }

    property OnMouseDblClk: TOnMouse read fOnMouseDblClk write SetMouseDblClk;

    {* Obvious. }

    property OnMouseWheel: TOnMouse read fOnMouseWheel write SetMouseWheel;

    {* Obvious. }



    property OnMouseEnter: TOnEvent read fOnMouseEnter write SetOnMouseEnter;

    {* Is called when mouse is entered into control. See also OnMouseLeave. }

    property OnMouseLeave: TOnEvent read fOnMouseLeave 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 fOnTestMouseOver 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 fMouseInControl;

    {* |<#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 fFlat 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 fRepeatInterval write 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: String ): Integer;

    {* |<#listbox>

       |<#combo>

       Only for listbox and combobox. }



    function Insert( Idx: Integer; const S: String ): Integer;

    {* |<#listbox>

       |<#combo>

       Only for listbox and combobox. }

    procedure Delete( Idx: Integer );

    {* |<#listbox>

       |<#combo>

       Only for listbox and combobox. }

    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 ]: PChar 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: PChar 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).

       }

    property SizeGrip: Boolean read fSizeGrip write fSizeGrip;

    {* 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 fStatusWnd;

    {* |<#form>

       Provided for case if You want to use API direct message sending to

       status bar. }



    property Color1: TColor read fColor1 write SetColor1;

    {* |<#gradient>

       Top line color for GradientPanel. }

    property Color2: TColor read 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 FGradientStyle write SetGradientStyle;

    {* |<#gradient>

       Styles other then gsVertical and gsHorizontal has effect only for

       gradient panel, created by NewGradientPanelEx. }

    property GradientLayout: TGradientLayout read 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, ToolBar 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: String; 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. }

    property TC_Items[ Idx: Integer ]: String 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: String): Integer;

    {* |<#tabcontrol>

       By Mr Brdo. Index of page by its Caption. }

    function TC_SearchFor(const S: String; StartAfter: Integer; Partial: Boolean): Integer;

    {* |<#tabcontrol>

       By Mr Brdo. Index of page by its Caption. }



    //======== ListView style and options:

    property LVStyle: TListViewStyle read fLVStyle write SetLVStyle;

    {* |<#listview>

       ListView style of view. Can be changed at run time. }



    property LVOptions: TListViewOptions read 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 TextColor. }

    property LVTextBkColor: TColor index LVM_GETTEXTBKCOLOR

             {$IFDEF F_P}   read LVGetColorByIdx

             {$ELSE DELPHI} read 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 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: String; aalign: TTextAlign; aWidth: Integer );

    {* |<#listview>

       Adds new column. Pass 'width' <= 0 to provide default column width.

       'text' is a column header text. }

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    procedure LVColAddW( const aText: WideString; aalign: TTextAlign; aWidth: Integer );

    {* |<#listview>

       Adds new column (unicode version). }

    {$ENDIF _D2}

    {$ENDIF _FPC}

    procedure LVColInsert( ColIdx: Integer; const aText: String; aAlign: TTextAlign; aWidth: Integer );

    {* |<#listview>

       Inserts new column at the Idx position (1-based column index). }

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    procedure LVColInsertW( ColIdx: Integer; const aText: WideString; aAlign: TTextAlign; aWidth: Integer );

    {* |<#listview>

       Inserts new column at the Idx position (1-based column index). }

    {$ENDIF _D2}

    {$ENDIF _FPC}

    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 ]: String read GetLVColText write SetLVColText;

    {* |<#listview>

       Allows to get/change column header text at run time. }

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    property LVColTextW[ Idx: Integer ]: WideString read GetLVColTextW write SetLVColTextW;

    {* |<#listview>

       Allows to get/change column header text at run time. }

    {$ENDIF _D2}

    {$ENDIF _FPC}

    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. }

    function LVNextSelected( IdxPrev: Integer ): Integer;

    {* |<#listview>

       Returns an index of next (after IdxPrev) selected item in a list view. }



    function LVAdd( const aText: String; 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: String ): Integer;

    {* |<#listview>

       Adds an item to the end of list view. Returns an index of the item added. }

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    function LVItemAddW( const aText: WideString ): Integer;

    {* |<#listview>

       Adds an item to the end of list view. Returns an index of the item added. }

    {$ENDIF _D2}

    {$ENDIF _FPC}

    function LVInsert( Idx: Integer; const aText: String; 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: String ): Integer;

    {* |<#listview>

       Inserts an item to Idx position. }

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    function LVItemInsertW( Idx: Integer; const aText: WideString ): Integer;

    {* |<#listview>

       Inserts an item to Idx position. }

    {$ENDIF _D2}

    {$ENDIF _FPC}



    procedure LVDelete( Idx: Integer );

    {* |<#listview>

       Deletes item of ListView with subitems (full row - in lvsDetail view style. }

    procedure LVSetItem( Idx, Col: Integer; const aText: String; 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 ]: String read LVGetItemText write LVSetItemText;

    {* |<#listview>

       Access to List View item text. }

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    property LVItemsW[ Idx, Col: Integer ]: WideString read LVGetItemTextW write LVSetItemTextW;

    {* |<#listview>

       Access to List View item text. }

    {$ENDIF _D2}

    {$ENDIF _FPC}

    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: String ): Integer;

    {* Returns first list view item index with caption matching S.

       The same as LVSearchFor( S, -1, FALSE ). }

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    function LVIndexOfW( const S: WideString ): Integer;

    {* Returns first list view item index with caption matching S.

       The same as LVSearchForW( S, -1, FALSE ). }

    {$ENDIF _D2}

    {$ENDIF _FPC}

    function LVSearchFor( const S: String; 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. }

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    function LVSearchForW( const S: WideString; 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. }

    {$ENDIF _D2}

    {$ENDIF _FPC}



    //======== 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 fOnEditLVITem write SetOnEditLVItem;

    {* |<#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 OnDeleteLVItem: TOnDeleteLVItem read fOnDeleteLVItem write SetOnDeleteLVItem;

    {* |<#listview>

       Called for every deleted list view item. }

    property OnDeleteAllLVItems: TOnEvent read 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 fOnLVData 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. }

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    property OnLVDataW: TOnLVDataW read fOnLVDataW write SetOnLVDataW;

    {* |<#listview>

       The same as OnLVData, but for unicode version of the list view allows

       to return WideString text in the event handler. Though for unicode list

       view it is still possible to use ordinary event OnLVData, it is

       very recommended to use this event istead. }

    {$ENDIF _D2}

    {$ENDIF _FPC}



    property OnCompareLVItems: TOnCompareLVItems read fOnCompareLVItems write fOnCompareLVItems;

    {* |<#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 fOnColumnClick 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 FOnLVStateChange 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 OnLVDelete: TOnLVDelete read FOnLVDelete write SetOnLVDelete;

    {* |<#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 OnDrawItem: TOnDrawItem read fOnDrawItem 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 FOnLVCustomDraw 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 fLVItemHeight write Set_LVItemHeight;





    //======== TreeView specific properties and methods:

    function TVInsert( nParent, nAfter: THandle; const Txt: String ): 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> }

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    function TVInsertW( nParent, nAfter: THandle; const Txt: WideString ): 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><br>

       This version of the method is Unicode. The tree view control should be

       set up as unicode control calling Perform( TVM_SETUNICODEFORMAT, 1, 0 ),

       and conditional symbol UNICODE_CTRLS must be defined to provide event

       handling for such kind of tree view (and other Unicode) controls. }

    {$ENDIF _D2}

    {$ENDIF _FPC}

    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 ]: String read TVGetItemText write TVSetItemText;

    {* |<#treeview>

       Text of tree view item. }

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    property TVItemTextW[ Item: THandle ]: WideString read TVGetItemTextW write TVSetItemTextW;

    {* |<#treeview>

       Text of tree view item. }

    {$ENDIF _D2}

    {$ENDIF _FPC}

    function TVItemPath( Item: THandle; Delimiter: Char ): String;

    {* |<#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. }

    {$IFNDEF _FPC}

    {$IFNDEF _D2}

    function TVItemPathW( Item: THandle; Delimiter: WideChar ): WideString;

    {* |<#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. If Item is not specified ( =0 ), path is returned

       for Selected item. }

    {$ENDIF _D2}

    {$ENDIF _FPC}



    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 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 fEditing;

    {* |<#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. }

    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".

       Values 1..15 can be used only - this is the Windows restriction on

       state images. }



    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 fOnTVBeginDrag write fOnTVBeginDrag;

    {* |<#treeview>

       Is called for tree view, when its item is to be dragging. }

    property OnTVBeginEdit: TOnTVBeginEdit read fOnTVBeginEdit write fOnTVBeginEdit;

    {* |<#treeview>

       Is called for tree view, when its item label is to be editing. }

    property OnTVEndEdit: TOnTVEndEdit read fOnTVEndEdit write fOnTVEndEdit;

    {* |<#treeview>

       Is called when item label is edited. It is possible to cancel

       edit, returning False as a result. }

    property OnTVExpanding: TOnTVExpanding read fOnTVExpanding write fOnTVExpanding;

    {* |<#treeview>

       Is called just before expanding/collapsing item. It is possible to

       return False to prevent expanding item. }

    property OnTVExpanded: TOnTVExpanded read fOnTVExpanded write fOnTVExpanded;

    {* |<#treeview>

       Is called after expanding/collapsing item children. }

    property OnTVDelete: TOnTVDelete read fOnTVDelete 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 fOnTVSelChanging write fOnTVSelChanging;

    {* |<#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 view icons,

       |<br> THandle(-10) to add standard large view 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 PChar; 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 PChar;

             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 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 fCurItem;

    {* |<#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.

       |<br>

       In case, when button (or toolbar itself) is clicked using right

       mouse button, CurItem and CurIndex are always set to -1. To further

       determine which button was clicked, get mouse coordinates on screen,

       apply Screen2Client method of toolbar control to it and then use

       TBButtonAtPos function to determine which button was under cursor.

    }



    property TBButtonCount: Integer read GetItemsCount; //TBGetButtonCount;

    {* |<#toolbar>

       Returns count of buttons on toolbar. The same as Count. }



    property TBBtnImgWidth: Integer read fTBBtnImgWidth write 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 ]: String 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). }



    property TBButtonWidth[ BtnID: Integer ]: Integer read TBGetBtnWidth write TBSetBtnWidth;

    {* |<#toolbar>

       Allows to obtain / change toolbar button width. }



    property TBButtonsMinWidth: Integer index 0

             {$IFDEF F_P}   read TBGetBtMinMaxWidth

             {$ELSE DELPHI} read 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 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 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; Tooltips: array of PChar );

    {* |<#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). }



    property OnTBDropDown: TOnEvent read fOnDropDown write fOnDropDown;

    {* |<#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 fOnClick write fOnClick;

    {* |<#toolbar>

       The same as OnClick. }



    //================== RichEdit specific: ==================



    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 fRECharArea write 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_FmtBackColor: Integer index (62 shl 16) or CFM_BACKCOLOR read REGetFontAttr write RESetFontAttr1;

    {* |<#richedit>

       Background color for an <A area>. }

    //property RE_FmtBackColorValid: Boolean index CFM_BACKCOLOR read REGetFontEffect;

    {* |<#richedit>

       True, if RE_FmtBackColor valid for entire <A area>. }

    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 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: String 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_OFFSETINDENT 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;

    }

    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_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 read fOnREInsModeChg write fOnREInsModeChg;

    {* |<#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 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 read fOnProgress write fOnProgress;

    {* |<#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: String; 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: String; 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 ]: String 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: String; ACanUndo: Boolean );

    {* }

    procedure RE_InsertRTF( const S: String );

    {* }

    property RE_Error: Integer read 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: String; 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). }



    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: String read fREUrl;

    {* |<#richedit>

       Detected URL (valid in OnRE_OverURL and OnRE_URLClick event handlers). }

    property OnRE_OverURL: TOnEvent index 0

             {$IFDEF F_P}   read REGetOnURL

             {$ELSE DELPHI} read fOnREOverURL

             {$ENDIF F_P/DELPHI} 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

             {$IFDEF F_P}   read REGetOnURL

             {$ELSE DELPHI} read fOnREURLClick

             {$ENDIF F_P/DELPHI} 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;

    // not 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.

       }



    //========== 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. }



    function RE_Redo: Boolean;

    {* |<#richedit>

       Only for RichEdit control: Returns True if successful. }



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

    // DateTimePicker

    property OnDTPUserString: TDTParseInputEvent read FOnDTPUserString

             write FOnDTPUserString;

    {* 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 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: String write SetDateTimeFormat;





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



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

    // ScrollBar

    property SBMin: Longint read fSBMinMax.X write SetSBMin;

    property SBMax: Longint read fSBMinMax.Y write SetSBMax;

    property SBMinMax: TPoint read fSBMinMax write SetSBMinMax;

    property SBPosition: Integer read fSBPosition write SetSBPosition;

    property SBPageSize: Integer read fSBPageSize write SetSBPageSize;



    property OnSBBeforeScroll: TOnSBBeforeScroll read FOnSBBeforeScroll write FOnSBBeforeScroll;

    property OnSBScroll: TOnSBScroll read FOnSBScroll write FOnSBScroll;



    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;

    //

    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. }

    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). }



    function AutoSize( AutoSzOn: Boolean ): PControl;

    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 Shift( dX, dY : Integer ): PControl;

    {* Moves control respectively to current position (Left := Left + dX,

       Top := Top + dY). }

    function SetPosition( X, Y: Integer ): PControl;

    {* Moves control directly to the specified position. }



    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. }

    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). }



    property Checked: Boolean read GetChecked write Set_Checked;

    {* |<#checkbox>

       |<#radiobox>

       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. }

    function SetRadioCheckedOld: PControl;

    {* |<#radiobox>

       Old version of SetRadioChecked (implemented using recommended API

       call. It does not work properly, if control is not visible

       (together with its form). }

    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 FOnDropFiles 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 FOnScroll write SetOnScroll;

    {* }

  protected

    {$IFDEF USE_DROPDOWNCOUNT}

    fDropDownCount: Cardinal;

    {$ENDIF}

    fGraphCtlMouseEvent: TOnGraphCtlMouse;

  public

    {$IFDEF USE_DROPDOWNCOUNT}

    property DropDownCount: Cardinal read fDropDownCount write fDropDownCount;

    {$ENDIF}

  protected

    fPushedBtn: PControl;

    fFocused: Boolean;

    fEditOptions: TEditOptions;

    fEditCtl: PControl;

    fSetFocus: procedure of object;

    fSaveCursor: HCursor;

    fLeave: TOnEvent;

    fKeyboardProcess: TOnMessage;

    fHot: Boolean;

    fHotCtl: PControl;

    fMouseLeaveProc: TOnEvent;

    fIsGroupBox: Boolean;

    fErasingBkgnd: Boolean;

    fButtonIcon: HIcon;

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

    procedure GraphButtonSetFocus;

    function GraphButtonKeyboardProcess( var Msg: TMsg; var Rslt: Integer ): Boolean;

    procedure LeaveGraphButton( Sender: PObj );

    procedure GraphicEditPaint( DC: HDC );

    procedure GraphicEditMouse( var Msg: TMsg );

    function EditGraphEdit: PControl;

    procedure DestroyGraphEdit( Sender: PObj );

    procedure LeaveGraphEdit( Sender: PObj );

    procedure ChangeGraphEdit( Sender: PObj );

    procedure GraphEditboxSetFocus;

    procedure GraphCtlDrawFocusRect( DC: HDC; const R: TRect );

    {$IFDEF GRAPHCTL_HOTTRACK}

    procedure MouseLeaveFromParentOfGraphCtl( Sender: PObj );

    {$ENDIF GRAPHCTL_HOTTRACK}

    procedure GroupBoxPaint( DC: HDC );

    {$IFDEF KEY_PREVIEW}

  protected

    fKeyPreview: Boolean;

  public

    property KeyPreview: Boolean read fKeyPreview write fKeyPreview;

    {$ENDIF KEY_PREVIEW}

  public

    {$IFDEF USE_CONSTRUCTORS}

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

    // constructors here:

    constructor CreateWindowed( AParent: PControl; AClassName: PChar; ACtl3D: Boolean );

    constructor CreateApplet( const ACaption: String );

    constructor CreateForm( AParent: PControl; const ACaption: String );

    constructor CreateControl( AParent: PControl; AClassName: PChar; AStyle: DWORD;

                               ACtl3D: Boolean; Actions: PCommandActions );

    constructor CreateButton( AParent: PControl; const ACaption: String );

    constructor CreateBitBtn( AParent: PControl; const ACaption: String;

         AOptions: TBitBtnOptions; ALayout: TGlyphLayout; AGlyphBitmap: HBitmap;

         AGlyphCount: Integer);

    constructor CreateLabel( AParent: PControl; const ACaption: String );

    constructor CreateWordWrapLabel( AParent: PControl; const ACaption: String );

    constructor CreateLabelEffect( AParent: PControl; ACaption: String; 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: String );

    constructor CreateCheckbox( AParent: PControl; const ACaption: String );

    constructor CreateRadiobox( AParent: PControl; const ACaption: String );

    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: PChar; 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.



  end;

//[END OF TControl DEFINITION]



  {$IFDEF USE_MHTOOLTIP}

  {$DEFINE interface}

  {$I KOLMHToolTip}

  {$UNDEF interface}

  {$ENDIF}



//[Paint Background PROCEDURE]

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>. }



procedure DummyPaintProc( Sender: PControl; DC: HDC );



//[GetShiftState DECLARATION]

function GetShiftState: DWORD;



//[WndProcXXX DECLARATIONS]

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 WndProcBufferedDraw( Self_: 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. }



//[InitCommonXXXX DECLARATIONS]

procedure InitCommonControlSizeNotify( Ctrl: PControl );

procedure InitCommonControlCommonNotify( Ctrl: PControl );



//[Buffered Draw DECLARATIONS]

var

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

                         = WndProcDummy;

  Global_DblBufCreateWnd: procedure( Sender: PObj ) = DummyObjProc;

  Global_Invalidate: procedure( Sender: PObj ) = DummyObjProc;

  {* Is called in TControl.Invalidate to extend it in case when DoubleBuffered

     painting used. }



  Global_TranspDrawBkgnd: procedure( DC: HDC; Sender: PControl );



  //Global_OnCreateWindow: procedure( Sender: PObj ) = DummyObjProc;

  //{* Is called when TControl object is created. }

  //Global_OnDestroyWindow: procedure( Sender: PObj ) = DummyObjProc;

  //{* Is called before destroying TControl object (after accepting it,

  //   if event OnClose is defined). }

  Global_OnBeginPaint: procedure( Sender: PControl; DC: HDC ) = DummyPaintProc;

  {* Is called before painting a window. }

  Global_OnEndPaint: procedure( Sender: PControl; DC: HDC ) = DummyPaintProc;

  {* Is called after painting a window. }

  HelpFilePath: PChar;

  {* 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). }



//[Html Help DECLARATIONS]

procedure AssignHtmlHelp( const HtmlHelpPath: String );

procedure HtmlHelpCommand( Wnd: HWnd; const HelpFilePath: String; 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: PChar;              //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:       PChar;       // 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:       PChar;       // 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:   PChar;       // semi-colon separated keywords

    pszUrl:        PChar;       // URL to jump to if no keywords found (may be NULL)

    pszMsgText:    PChar;       // Message text to display in MessageBox if pszUrl is NULL and no keyword match

    pszMsgTitle:   PChar;       // Message text to display in MessageBox if pszUrl is NULL and no keyword match

    pszWindow:     PChar;       // 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:    PChar;        // 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:         PChar;        // 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:           PChar;        // 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:        PChar;        // 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:            PChar;        // IN: Location of the table of contents file

    pszIndex:          PChar;        // IN: Location of the index file

    pszFile:           PChar;        // IN: Default location of the html file

    pszHome:           PChar;        // 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:          PChar;         // Text for HHWIN_BUTTON_JUMP1

    pszJump2:          PChar;         // Text for HHWIN_BUTTON_JUMP2

    pszUrlJump1:       PChar;         // URL for HHWIN_BUTTON_JUMP1

    pszUrlJump2:       PChar;         // URL for HHWIN_BUTTON_JUMP2

    rcMinSize:         TRect;         // Minimum size for window (ignored in version 1)



    cbInfoTypes:       Integer;       // size of paInfoTypes;

    pszCustomTabs:     PChar;         // 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:         PChar;                  // 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;                //tagHH_GPROPID, HH_GPROPID

  HH_GPROPID = tagHH_GPROPID;

  THHGPropID = HH_GPROPID;



///////////////////////////////////////////////////////////////////////////////

//

// Global Property structure

//

{type

  PHHGlobalProperty = ^THHGlobalProperty;

  tagHH_GLOBAL_PROPERTY = record                  //tagHH_GLOBAL_PROPERTY, HH_GLOBAL_PROPERTY

    id:                THHGPropID;

    Dummy:             Integer;                  // Added to enforce 8-byte packing

    var_:              VARIANT;

  end;

  HH_GLOBAL_PROPERTY = tagHH_GLOBAL_PROPERTY;

  THHGlobalProperty = tagHH_GLOBAL_PROPERTY;}

//[END OF HTMLHELP DECLARATIONS]



//[GetCtlBrush DECLARATIONS]

function SimpleGetCtlBrushHandle( Sender: PControl ): HBrush; //forward;



var

  Global_GetCtlBrushHandle: function( Sender: PControl ): HBrush = SimpleGetCtlBrushHandle;

  {* Is called to obtain brush handle. }



  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. }



//[WndFunc DECLARATION]

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. }



//[Applet VARIABLES]

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). }



//[Screen DECLARATIONS]

    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. }



//[Status DECLARATIONS]

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. }



{$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 ): PControl;

{* Creates graphic control basics. }



function NewGraphLabel( AParent: PControl; const ACaption: String ): PControl;

{* Creates graphic label, which does not require a window handle. }



function NewWordWrapGraphLabel( AParent: PControl; const ACaption: String ): 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: String ): PControl;

{* Creates graphic checkbox. }



function NewGraphRadioBox( AParent: PControl; const ACaption: String ): PControl;

{* Creates graphic radiobox. }



function NewGraphButton( AParent: PControl; const ACaption: String ): 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). }



//[Run DECLARATION]

procedure Run( var AppletWnd: 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

}



procedure TerminateExecution( var AppletWnd: PControl );



//[Applet FUNCTIONS DECLARATIONS]

procedure AppletMinimize;

{* Minimizes the application (Applet should be assigned to have effect). }

procedure AppletHide;

{* Minimizes and hides application. }

procedure AppletRestore;

{* Restores Applet when minimized. }



//[Idle handler DECALRATIONS]

{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-}







//[InitCommonXXXX ANOTHER DECLARATIONS]



{* 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



//[Ole DECLARATIONS]

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: string): PWideChar;

{* }



{+}

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

procedure SysFreeString( psz: PWideChar ); stdcall;





















{ -- Contructors for visual controls -- }

//[NewXXXX DECLARATIONS]



//[_NewWindowed DECLARATION]

function _NewWindowed( AParent: PControl; ControlClassName: PChar; Ctl3D: Boolean ): PControl;



//[NewApplet DECLARATION]

function NewApplet( const Caption: String ): 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 }



//[NewForm DECLARATION]

function NewForm( AParent: PControl; const Caption: String ): 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 }



//[_NewControl DECLARATION]

function _NewControl( AParent: PControl; ControlClassName: PChar;

         Style: DWORD; Ctl3D: Boolean; Actions: PCommandActions ): PControl;



//[NewButton DECLARATION]

function NewButton( AParent: PControl; const Caption: String ): 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 }



//[NewBitBtn DECLARATION]

function NewBitBtn( AParent: PControl; const Caption: String;

         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 }



//[NewLabel DECLARATION]

function NewLabel( AParent: PControl; const Caption: String ): 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 }



//[NewWordWrapLabel DECLARATION]

function NewWordWrapLabel( AParent: PControl; const Caption: String ): 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 }



//[NewLabelEffect DECLARATION]

function NewLabelEffect( AParent: PControl; const Caption: String; 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 }



//[NewPaintbox DECLARATION]

function NewPaintbox( AParent: PControl ): PControl;

{* |<#control>

   Creates owner-drawn STATIC control. Set its <D OnPaint> event to

   perform custom painting.

   |#paintbox }



//[NewImageShow DECLARATION]

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). }



//[NewScrollBar DECLARATION]

function NewScrollBar( AParent: PControl; BarSide: TScrollerBar ): PControl;

{ * not yet finished... }



//[NewScrollBox DECLARATION]

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). }



//[NewGradientPanel DECLARATION]

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. }



//[NewPanel DECLARATION]

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). }



//[NewMDIxxx DECLARATIONS]

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: String ): PControl;

{* |<#control>

   Creates MDI client window. AParent should be a MDI client window,

   created with NewMDIClient function. }



//[NewSplitter DECLARATIONS]

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. }



//[NewGroupbox DECLARATION]

function NewGroupbox( AParent: PControl; const Caption: String ): 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. }



//[NewCheckbox DECLARATION]

function NewCheckbox( AParent: PControl; const Caption: String ): PControl;

{* |<#control>

   Creates check box control. Special properties, methods, events:

   |#checkbox }



function NewCheckBox3State( AParent: PControl; const Caption: String ): PControl;

{* |<#control>

   Creates check box control with 3 states. Special properties, methods,

   events:

   |#checkbox }



//[NewRadiobox DECLARATION]

function NewRadiobox( AParent: PControl; const Caption: String ): 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 }



//[NewEditbox DECLARATION]

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 }



//[NewRichEdit DECLARATION]

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. }



//[NewListbox DECLARATION]

function NewListbox( AParent: PControl; Options: TListOptions ): PControl;

{* |<#control>

   Creates list box control. Following properties, methods and events are

   special for Listbox:

   |#listbox }



//[NewCombobox DECLARATION]

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 infinit recursion in the

   application.

   |<br>Following properties, methods and events are

   special for Combobox:

   |#combo }



//[_NewCommonControl DECLARATION]

function _NewCommonControl( AParent: PControl; ClassName: PChar; Style: DWORD;

                            Ctl3D: Boolean; Actions: PCommandActions ): PControl;



//[NewProgressbar DECLARATION]

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. }



//[NewListVew DECLARATION]

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 }



//[NewTreeView DECLARATION]

function NewTreeView( AParent: PControl; Options: TTreeViewOptions;

                      ImgListNormal, ImgListState: PImageList ): PControl;

{* |<#control>

   Creates tree view control. See tree view methods and properties:

   |#treeview }



//[NewTabControl DECLARATION]

function NewTabControl( AParent: PControl; Tabs: array of String; 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 CurrentIndex>;

   |<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 }



//[NewToolbar DECLARATION]

function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarOptions;

                     Bitmap: HBitmap; Buttons: array of PChar;

                     BtnImgIdxArray: array of Integer ) : PControl;

{* |<#control>

   Creates toolbar control. Bitmap must contain images for all buttons

   excluding separators (defined by string '-' in Buttons array), 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.

   }



//[NewDateTimePicker DECLARATION]

function NewDateTimePicker( AParent: PControl; Options: TDateTimePickerOptions )

         : PControl;

{* |<#control>

   Creates date and time picker common control.

}







{ -- Constructor for Image List objet -- }



//[NewImageList DECLARATION]

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). }

































































//[TIMER]

type

  {++}(*TTimer = class;*){--}

  PTimer = {-}^{+}TTimer;

{ ----------------------------------------------------------------------



                            TTimer object



----------------------------------------------------------------------- }

//[TTimer DEFINITION]

  TTimer = object( TObj )

  {* Easy timer incapsulation object. Uses applet window to

     receive timer events. So, either assign your main form

     to Applet variable or create applet button object (and

     assign it to Applet) before enabling timer. }

  protected

    fHandle : Integer;

    fEnabled: Boolean;

    fInterval: Integer;

    fOnTimer: TOnEvent;

    procedure SetEnabled(const Value: Boolean); virtual;

    procedure SetInterval(const Value: Integer);

  protected

  {++}(*public*){--}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* 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. Before assigning True,

       make sure, that Applet global variable is assigned to applet object

       (NewApplet) or to form (NewForm). }

    property Interval : Integer read fInterval write SetInterval;

    {* Interval in milliseconds (1000 is default and means 1 second). }

    property OnTimer : TOnEvent read fOnTimer write fOnTimer;

    {* Event, which is called when time interval is over. }

  end;

//[END OF TTimer DEFINITION]



//[NewTimer DECLARATION]

function NewTimer( Interval: Integer ): PTimer;

{* Constructs initially disabled timer with interval 1000 (1 second). }





//[MULTIMEDIA TIMER]

type

  {++}(*TMMTimer = class;*){--}

  PMMTimer = {-}^{+}TMMTimer;



//[TMMTimer DEFINITION]

  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;{+}{++}(*override;*){--}

  public

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* }

    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;

//[END OF TMMTimer DEFINITION]



//[NewMMTimer DECLARATION]

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. }







































{ -- TTrayIcon object -- }

//[TRAYICON]



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. }



  {++}(*TTrayIcon = class;*){--}

  PTrayIcon = {-}^{+}TTrayIcon;

{ ----------------------------------------------------------------------



                TTrayIcon - icon in tray area of taskbar



----------------------------------------------------------------------- }

//[TTrayIcon DEFINITION]

  TTrayIcon = object(TObj)

  {* Object to place (and change) a single icon onto taskbar tray. }

  protected

    FIcon: HIcon;

    FActive: Boolean;

    FTooltip: String;

    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: String);

    procedure SetAutoRecreate(const Value: Boolean);

  protected

  {++}(*public*){--}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* 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 : String 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.

  }

//[END OF TTrayIcon DEFINITION]



//[NewTrayIcon DECLARATION]

function NewTrayIcon( Wnd: PControl; Icon: HIcon ): PTrayIcon;

{* Constructor of TTrayIcon object. Pass main form or applet as Wnd

   parameter. }

























//[JUST ONE]

{ -- JustOne -- }



type

  TOnAnotherInstance = procedure( const CmdLine: String ) of object;

  {* Event type to use in JustOneNotify function. }



function JustOne( Wnd: PControl; const Identifier : String ) : 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 : String;

                        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. -- }



//[Message Box DECLARATIONS]

function MsgBox( const S: String; 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: String );

{* Displays message box with the same title as Applet.Caption (or 'Error',

   if Applet is not running). }

function ShowMsg( const S: String; 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: String );

{* Like ShowMsg, but has only styles MB_OK and MB_SETFOREGROUND. }

procedure ShowMsgModal( const S: String );

{* This message function can be used out of a message loop (e.g., after

   finishing the application). It is always modal.

      Actually, a form with word-wrap label (decorated as borderless edit

   box with btnFace color) and with OK button is created and shown modal.

   When a dialog is called from outside message loop, caption 'Information'

   is always displayed.

   Dialog form is automatically resized vertically to fit message text

   (but until screen height is achieved) and shown always centered on

   screen. The width is fixed (400 pixels).

   |<br>

   Do not use this function outside the message loop for case, when the

   Applet variable is not used in an application. }

function ShowQuestion( const S: String; Answers: String ): Integer;

{* Modal dialog like ShowMsgModal. It is based on KOL form, so it can

   be called also out of message loop, e.g. after finishing the

   application. Also, this function *must* be used in MDI applications

   in place of any dialog functions, based on MessageBox.

   |<br>

   The second parameter should be empty string or several possible

   answers separated by '/', e.g.: 'Yes/No/Cancel'. Result is

   a number answered, starting from 1. For example, if  'Cancel'

   was pressed, 3 will be returned.

   |<br>

   User can also press ESCAPE key, or close modal dialog. In such case

   -1 is returned. }

function ShowQuestionEx( const S: String; Answers: String; CallBack: TOnEvent ): Integer;

{* Like ShowQuestion, but with CallBack function, called just before showing

   the dialog. }

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). }



{++}(*

function FormatMessage(dwFlags: DWORD; lpSource: Pointer; dwMessageId: DWORD; dwLanguageId: DWORD;

  lpBuffer: PChar; nSize: DWORD; Arguments: Pointer): DWORD; stdcall;

*){--}

function SysErrorMessage(ErrorCode: Integer): string;

{* 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>

}

//[I64 TYPE]

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;

{* }

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 ): String;

{* }

function Str2Int64( const S: String ): I64;

{* }

function Int64_2Double( const X: I64 ): Double;

{* }

function Double2Int64( D: Double ): I64;

{*







  <R Floating point numbers>

}



const

  NAN = 0.0 / 0.0;

{+}

  {++}(*const NAN = 1e-100;*){--}





function IsNan(const AValue: Double): Boolean;

{* Checks is an argument passed is NAN. }



function IntPower(Base: Extended; Exponent: Integer): Extended;

{* Result := Base ^ Exponent; }



//[String<->Double DECLARATIONS]

function Str2Double( const S: String ): Double;

{* }



function Double2Str( D: Double ): String;

{* }

function Extended2Str( E: Extended ): String;

{* }



function Double2StrEx( D: Double ): String;

{* experimental, do not use }



function TruncD( D: Double ): Double;

{* Result := trunc( D ) as Double;

|<hr>































  <R Small bit arrays (max 32 bits in array)>

  See also TBits object.

}



//[SMALL BIT ARRAYS DECLARATIONS]

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}



//[TMethod TYPE]

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). }



//[Rectangles&Points DECLARATIONS]

   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 MakePoint( X, Y: Integer ): TPoint;

   {* Use instead of VCL function Point }

//[MakeFlags DECLARATION]

   function MakeFlags( FlgSet: PDWORD; FlgArray: array of Integer): Integer;

   {* }



  function MakeDateTimeRange( D1, D2: TDateTime ): TDateTimeRange;

  {* Returns TDateTimeRange from two TDateTime bounds. }



//[Integer FUNCTIONS DECLARATIONS]

   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

   |<hr>









  <R String to number and number to string conversions>

}

//[Integer<->String DECLARATIONS]

function Int2Hex( Value : DWord; Digits : Integer ) : String;

{* 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 ) : String;

{* Obvious. }

function UInt2Str( Value: DWORD ): String;

{* The same as Int2Str, but for unsigned integer value. }

function Int2StrEx( Value, MinWidth: Integer ): String;

{* Like Int2Str, but resulting string filled with leading spaces to provide

   at least MinWidth characters. }

function Int2Rome( Value: Integer ): String;

{* Represents number 1..8999 to Rome numer. }

function Int2Ths( I : Integer ) : String;

{* Converts integer into string, separating every three digits from each

   other by character ThsSeparator. (Convert to thousands). You  }

function Int2Digs( Value, Digits : Integer ) : String;

{* 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 ) : String;

{* 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: PChar ): 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 : String) : 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 : String) : 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 : String) : Integer;

{* As Hex2Int, but also checks for leading '0x' and skips it. }

function Octal2Int( const Value: String ) : 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: String ) : Integer;

{* Converts binary number to integer. Like Octal2Int, but only digits

   0 and 1 are allowed. }

{$IFNDEF _FPC}

function Format( const fmt: string; params: array of const ): String;

{* 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}

//[String FUNCTIONS DECLARATIONS]

function StrComp(const Str1, Str2: PChar): Integer;

{* Compares two strings fast. -1: Str1<Str2; 0: Str1=Str2; +1: Str1>Str2 }

function StrComp_NoCase(const Str1, Str2: PChar): Integer;

{* Compares two strings fast without case sensitivity.

   Returns: -1 when Str1<Str2; 0 when Str1=Str2; +1 when Str1>Str2 }

function StrLComp(const Str1, Str2: PChar; 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 StrLComp_NoCase(const Str1, Str2: PChar; 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. }

function StrCopy( Dest, Source: PChar ): PChar;

{* Copy source string to destination (fast). Pointer to Dest is returned. }

function StrCat( Dest, Source: PChar ): PChar;

{* Append source string to destination (fast). Pointer to Dest is returned. }

function StrLen(const Str: PChar): Cardinal;

{* StrLen returns the number of characters in Str, not counting the null

  terminator. }

function StrScanLen(Str: PChar; Chr: Char; Len: Integer): PChar;

{* 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: PChar; Chr: Char): PChar;

{* Fast search of given character in a string. Pointer to found character

   (or nil) is returned. }

function StrRScan(const Str: PChar; Chr: Char): PChar;

{* 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: PChar ): 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: PChar ): Boolean;

{* Like StrIsStartingFrom above, but without case sensitivity. }

function TrimLeft(const S: string): string;

{* Removes spaces, tabulations and control characters from the starting

   of string S. }

function TrimRight(const S: string): string;

{* Removes spaces, tabulates and other control characters from the

   end of string S. }

function Trim( const S : string): string;

{* Makes TrimLeft and TrimRight for given string. }

function RemoveSpaces( const S: String ): String;

{* Removes all characters less or equal to ' ' in S and returns it. }

procedure Str2LowerCase( S: PChar );

{* Converts null-terminated string to lowercase (inplace). }

function LowerCase(const S: string): string;

{* Obvious. }

function UpperCase(const S: string): string;

{* Obvious. }

function AnsiUpperCase(const S: string): string;

{* Obvious. }

function AnsiLowerCase(const S: string): string;

{* Obvious. }

{$IFNDEF _D2}

{$IFNDEF _FPC}

function WAnsiUpperCase(const S: WideString): WideString;

{* Obvious. }

function WAnsiLowerCase(const S: WideString): WideString;

{* Obvious. }

{$ENDIF _FPC}

{$ENDIF _D2}

function AnsiCompareStr(const S1, S2: string): 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: PChar): Integer;

{* The same, but for PChar ANSI strings }

function AnsiCompareStrNoCase(const S1, S2: string): 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 _AnsiCompareStrNoCase(S1, S2: PChar): Integer;

{* The same, but for PChar ANSI strings }

function AnsiCompareText( const S1, S2: String ): Integer;

{* }



{$IFNDEF _FPC}

function LStrFromPWCharLen(Source: PWideChar; Length: Integer): String;

{* from Delphi5 - because D2 does not contain it. }

function LStrFromPWChar(Source: PWideChar): String;

{* from Delphi5 - because D2 does not contain it. }

{$ENDIF _FPC}



function CopyEnd( const S : String; Idx : Integer ) : String;

{* 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 : String; Len : Integer ) : String;

{* Returns last Len characters of the source string. If Len > Length( S ),

   entire string S is returned. }

procedure DeleteTail( var S : String; Len : Integer );

{* Deletes last Len characters from string. }

function IndexOfChar( const S : String; Chr : Char ) : Integer;

{* Returns index of given character (1..Length(S)), or

   -1 if a character not found. }

function IndexOfCharsMin( const S, Chars : String ) : 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. }

{$IFNDEF _D2}

{$IFNDEF _FPC}

function IndexOfWideCharsMin( const S, Chars : WideString ) : 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 : String ) : 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 : String; const Separators : String ) : String;

{* 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. }

{$IFNDEF _FPC}

{$IFNDEF _D2}

function WParse( var S : WideString; const Separators : WideString ) : WideString;

{* 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 : String; const Separators : String ) : String;

{* 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 : String ) : String;

{* Converts string to Pascal-like string expression (concatenation of

   strings with quotas and characters with leading '#'). }

function StrEq( const S1, S2 : String ) : 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). }

function AnsiEq( const S1, S2 : String ) : Boolean;

{* Returns True, if AnsiLowerCase(S1) = AnsiLowerCase(S2). I.e., if ANSI

   stringsare equal to each other without caring of characters case

   sensitivity. }

{$IFNDEF _D2}

{$IFNDEF _FPC}

function WAnsiEq( const S1, S2 : WideString ) : 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 : String; const A : array of String ) : 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}

{$IFNDEF _D2}

function WStrIn( const S : WideString; const A : array of WideString ) : 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. }

{$ENDIF _D2}

{$ENDIF _FPC}

function StrIs( const S : String; const A : array of String; 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 : PChar ) : Boolean;

{* }

function _2StrSatisfy( S, Mask: PChar ): Boolean;

{* }

function StrSatisfy( const S, Mask : String ) : 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: String; const From, ReplTo: String ): 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: WideString; const From, ReplTo: WideString ): 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 WideString type). }

{$ENDIF _D2}

{$ENDIF _FPC}



function StrRepeat( const S: String; Count: Integer ): String;

{* Repeats given string Count times. E.g., StrRepeat( 'A', 5 ) gives 'AAAAA'. }

{$IFNDEF _FPC}

{$IFNDEF _D2}

function WStrRepeat( const S: WideString; Count: Integer ): WideString;

{* Repeats given wide string Count times. E.g., StrRepeat( 'A', 5 ) gives 'AAAAA'. }

{$ENDIF _D2}

{$ENDIF _FPC}



procedure NormalizeUnixText( var S: String );

{* In the string S, replaces all occurances of character #10 (without leading #13)

   to the character #13. }



function StrPCopy(Dest: PChar; const Source: string): PChar;

{* Copyes Pascal-style string into null-terminaed one. }

function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;

{* Copyes first MaxLen characters of Pascal-style string into

   null-terminated one. }



function DelimiterLast( const Str, Delimiters: String ): 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: PChar ): PChar;

{* 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. }

function SkipSpaces( P: PChar ): PChar;

{* Skips all characters #1..' ' in a string.

}

{$IFDEF F_P}

function DummyStrFun( const S: String ): String;

{$ENDIF}





//[Memory FUNCTIONS DECLARATIONS]

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>

}



//[clipboard FUNCTIONS DECLARATIONS]

function Clipboard2Text: String;

{* If clipboard contains text, this function returns it for You. }

{$IFNDEF _FPC}

{$IFNDEF _D2}

function Clipboard2WText: WideString;

{* If clipboard contains text, this function returns it for You (as Unicode string). }

{$ENDIF _D2}

{$ENDIF _FPC}

function Text2Clipboard( const S: String ): Boolean;

{* Puts given string to a clipboard. }

{$IFNDEF _FPC}

{$IFNDEF _D2}

function WText2Clipboard( const WS: WideString ): Boolean;

{* Puts given Unicode string to a clipboard.

|<hr>

}

{$ENDIF _D2}

{$ENDIF _FPC}







//[Mnemonics FUNCTIONS DECLARATIONS]

var SearchMnemonics: function ( const S: String ): String

    = {$IFDEF F_P} DummyStrFun {$ELSE} UpperCase {$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>

}

//[TDateTime TYPE DEFINITION]

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 Word;



  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. }



  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.}



{++}(*

procedure GetLocalTime(var lpSystemTime: TSystemTime); stdcall;

procedure GetSystemTime(var lpSystemTime: TSystemTime); stdcall;

*){--}



//[Date&Time FUNCTIONS DECLARATIONS]

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: Word): 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 CatholicEaster( nYear: Integer ): TDateTime;

{* Returns date of catholic easter for given year. }



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 : PChar ) : String;

{* 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 : PChar ) : String;

{* Formats time, stored in TSystemTime record into string, using given locale

   and date/time formatting flags. }



function Date2StrFmt( const Fmt: String; D: TDateTime ): String;

{* 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: String; D: TDateTime ): String;

{* 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 ): String;

{* Formats date and time to string in short date format using current user

   locale. }

function Str2DateTimeFmt( const sFmtStr, sS: String ): 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 Str2DateTimeShort( const S: String ): TDateTime;

{* Restores date and time from string correspondently to current user locale. }

function Str2DateTimeShortEx( const S: String ): TDateTime;

{* Like Str2DateTimeShort above, but uses locale defined date and time

   separators to avoid recognizing time as a date in some cases.

|<hr>





  <R File and directory routines>

}



//[OpenFile CONSTANTS]

const

  ofOpenRead          = $80000000;

  {* Use this flag (in combination with others) to open file for "read" only. }

  ofOpenWrite         = $40000000;

  {* Use this flag (in combination with others) to open file for "write" only. }

  ofOpenReadWrite     = $C0000000;

  {* Use this flag (in combination with others) to open file for "read" and "write". }

  ofShareExclusive    = $00;

  {* Use this flag (in combination with others) to open file for exclusive use. }

  ofShareDenyWrite    = $01;

  {* 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     = $02;

  {* 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     = $03;

  {* 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         = $100;

  {* Default creation disposition. Use this flag for creating new file (usually

     for write access. }

  ofCreateAlways      = $200;

  {* 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      = $300;

  {* Use this flag (in combination with others) to open existing file only. }

  ofOpenAlways        = $400;

  {* Use this flag (in combination with others) to open existing or create new

     (if such file is not yet exists). }

  ofTruncateExisting  = $500;

  {* Use this flag (in combination with others) to open existing file and truncate

     it to size 0. }



  ofAttrReadOnly = $10000;

  {* Use this flag to create Read-Only file (?). }

  ofAttrHidden   = $20000;

  {* Use this flag to create hidden file. }

  ofAttrSystem   = $40000;

  {* Use this flag to create system file. }

  ofAttrTemp       = $1000000;

  {* Use this flag to create temp file. }

  ofAttrArchive  = $200000;

  {* Use this flag to create archive file. }

  ofAttrCompressed = $8000000;

  {* Use this flag to create compressed file. Has effect only on NTFS, and

     only if ofAttrCompressed is not specified also. }

  ofAttrOffline    = $10000000;

  {* Use this flag to create offline file. }

//[END OF OpenFileConstants]



//[File FUNCTIONS DECLARATIONS]

function FileCreate(const FileName: string; 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: String ) : 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. }

function FileRead(Handle: THandle; var Buffer; Count: DWord): DWord;

{* Reads bytes from current position in file to buffer. Returns number of

   read bytes. }

function File2Str(Handle: THandle): String;

{* Reads file from current position to the end and returns result as ansi string. }



function FileSeek(Handle: THandle; MoveTo: integer; MoveMethod: TMoveMethod): DWord;

{* Changes current position in file. }

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 : String ) : String;

{* Returns full path name for given file. Validness of source FileName path

   is not checked at all. }

function FileShortPath( const FileName: String ): String;

{* Returns short path to the file or directory. }

function FileIconSystemIdx( const Path: String ): 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: String ): 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). }

procedure LogFileOutput( const filepath, str: String );

{* Debug function. Use it to append given string to the end of the given file. }



function StrSaveToFile( const Filename, Str: String ): 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: String ): String;

{* 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. }



function Mem2File( Filename: PChar; 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: PChar; Mem: Pointer; MaxLen: Integer ): Integer;

{* Loads file content to memory. }



function FileSize( const Path: String ) : Integer;

{* Returns file size in bytes without opening it. If file too large

   to represent its size as Integer, -1 is returned. }

function GetUniqueFilename( PathName: string ) : String;

{* 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. }



//[Directory FUNCTIONS DECLARATIONS]

function GetStartDir: String;

{* Returns path to directory where executable is located (regardless

   of current directory). }

function DirectoryExists(const Name: string): Boolean;

{* Returns True if given directory (folder) exists. }

function DirectoryEmpty(const Name: String): Boolean;

{* Returns True if given directory is not exists or empty. }

{

function DirectorySize( const Path: String ): I64;

-- moved after PDirList

}

function DirectoryHasSubdirs( const Path: String ): Boolean;

{* Returns TRUE if given directory exists and has subdirectories. }

function CheckDirectoryContent( const Name: String; SubDirsOnly: Boolean; const Mask: String ): Boolean;

{* Returns TRUE if directory does not contain files (or directories only)

   satisfying given mask. }



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

// Following functions/procedures are created by Edward Aretino:

// IncludeTrailingPathDelimiter, ExcludeTrailingPathDelimiter,

// ForceDirectories, CreateDir, ChangeFileExt

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

function IncludeTrailingPathDelimiter(const S: string): string;

{* by Edward Aretino. Adds '\' to the end if it is not present. }

function ExcludeTrailingPathDelimiter(const S: string): string;

{* by Edward Aretino. Removes '\' at the end if it is present. }

function ForceDirectories(Dir: String): Boolean;

{* by Edward Aretino. Creates given directory if not present. All needed

   subdirectories are created if necessary. }

function CreateDir(const Dir: string): Boolean;

{* by Edward Aretino. Creates given directory. }

function ChangeFileExt(FileName: String; const Extension: string): string;

{* by Edward Aretino. Changes file extention. }



function ExcludeTrailingChar( const S: String; C: Char ): String;

{* If S is finished with character C, it is excluded. }

function IncludeTrailingChar( const S: String; C: Char ): String;

{* If S is not finished with character C, it is added. }



function ExtractFilePath( const Path: String ) : String;

{* Returns only path part from exact path to file. }

function ExtractFileName( const Path: String ) : String;

{* Extracts file name from exact path to file. }

function ExtractFileNameWOext( const Path: String ) : String;

{* Extracts file name from path to file or from filename. }

function ExtractFileExt( const Path: String ) : String;

{* Extracts extention from file name (returns it with dot '.' first) }

function ReplaceFileExt( const Path, NewExt: String ): String;

{* Returns a path with extension replaced to a given one. }

function ExtractShortPathName( const Path: String ): String;

{* }

function FilePathShortened( const Path: String; MaxLen: Integer ): String;

{* Returns shortened file path to fit MaxLen characters. }

function FilePathShortenPixels( const Path: String; DC: HDC; MaxPixels: Integer ): String;

{* 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: String; DC: HDC; MaxPixels: Integer ): String;

{* Exactly the same as MinimizeName in FileCtrl.pas (VCL). }



function GetSystemDir: String;

{* Returns path to windows system directory. }

function GetWindowsDir : string;

{* Returns path to Windows directory. }

function GetWorkDir : string;

{* Returns path to application's working directory. }

function GetTempDir : string;

{* Returns path to default temp folder (directory to place temporary files). }

function CreateTempFile( const DirPath, Prefix: String ): String;

{* Returns path to just created temporary file. }

function  GetFileListStr(FPath{e.g.'c:\tmp\'}, FMask{e.g.'*.*'}: string): string;

{* List of files in string, separating each path from others with semicolon (';').

   E.g.: 'c:\tmp\unit1.dcu;c:\tmp\unit1.~pa' (for use with DeleteFile2Recycle())}

function DeleteFiles( const DirPath: String ): Boolean;

{* Deletes files by file mask (given with wildcards '*' and '?'). }

function DeleteFile2Recycle( const Filename : String ) : 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 semicolon (';'). E.g.: 'unit1.dcu;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: String; Move: Boolean ): Boolean;

{* }

{-}

function DiskFreeSpace( const Path: String ): I64; {+}

{* 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. }



//[Registry FUNCTIONS DECLARATIONS]

{++}(*

function RegSetValueEx(hKey: HKEY; lpValueName: PChar;

  Reserved: DWORD; dwType: DWORD; lpData: Pointer; cbData: DWORD): Longint; stdcall;

*){--}

function RegKeyOpenRead( Key: HKey; const SubKey: String ): 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: String ): 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: String ): HKey;

{* Creates and opens key. }

function RegKeyGetStr( Key: HKey; const ValueName: String ): String;

{* 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: String ): String;

{* 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: String ): 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: String; const Value: String ): Boolean;

{* Writes new key value as null-terminated string (type REG_SZ). If not

   successful, returns False. }

function RegKeySetStrEx( Key: HKey; const ValueName: string; const Value: string;

                         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: String; 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: String ): Boolean;

{* Deletes key. Does nothing if key passed is 0 (returns FALSE). }

function RegKeyDeleteValue( Key: HKey; const SubKey: String ): Boolean;

{* Deletes value. - by neuron, e-mailto:neuron@hollowtube.mine.nu }

function RegKeyExists( Key: HKey; const SubKey: String ): Boolean;

{* Returns TRUE, if given subkey exists under given Key. }

function RegKeyValExists( Key: HKey; const ValueName: String ): Boolean;

{* Returns TRUE, if given value exists under the Key.

}

function RegKeyValueSize( Key: HKey; const ValueName: String ): 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: String; 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: String; const Buffer; Count: Integer ): Boolean;

{* Stores binary data in the registry. }

function RegKeyGetDateTime(Key: HKey; const ValueName: String): TDateTime;

{* Returns datetime variable stored in registry in binary format. }

function RegKeySetDateTime(Key: HKey; const ValueName: String; DateTime: TDateTime): Boolean;

{* Stores DateTime variable in the registry. }





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

// registry functions by Valerian Luft <luft@valerian.de>

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

function RegKeyGetSubKeys( const Key: HKEY; List: PStrList): Boolean;

{* The function enumerates subkeys of the specified open registry key.

   True is returned, if successful.

}

function RegKeyGetValueNames(const Key: HKEY; List: PStrList): Boolean;

{* The function enumerates value names of the specified open registry key.

   True is returned, if successful.

}

function RegKeyGetValueTyp (const Key:HKEY; const ValueName: String) : 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). }



//[Sorting TYPES]

type

  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 -1 or +1 (correspondently for cases e1<e2

     and e2>e2). 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 an

     array. }



//[SortData FUNCTIONS DECLARATIONS]

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. }



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 -- }

//[DirList Object]



type

  TDirItemAction = ( diSkip, diAccept, diCancel );

  TOnDirItem = procedure( Sender: PObj; var DirItem: TWin32FindData; var Accept: TDirItemAction )

             of object;

  TSortDirRules = ( sdrNone, sdrFoldersFirst, sdrCaseSensitive, sdrByName, sdrByExt,

                    sdrBySize, sdrBySizeDescending, sdrByDateCreate, sdrByDateChanged,

                    sdrByDateAccessed );

  {* List of rules (options) to sort directories. Rules are passed to Sort

     method in an array, and first placed rules are applied first. }



  {++}(*TDirList = class;*){--}

  PDirList = {-}^{+}TDirList;

{ ----------------------------------------------------------------------



                TDirList - Directory scanning



----------------------------------------------------------------------- }

//[TDirList DEFINITION]

  TDirList = object( TObj )

  {* Allows easy directory scanning. This is not visual object, but

     storage to simplify working with directory content. }

  protected

    FList : PList;

    FPath: string;

    fFilters: PStrList;

    fOnItem: TOnDirItem;

    function Get(Idx: Integer): PWin32FindData;

    function GetCount: Integer;

    function GetNames(Idx: Integer): string;

    function GetIsDirectory(Idx: Integer): Boolean;

  protected

    function SatisfyFilter( FileName : PChar; FileAttr, FindAttr : DWord ) : Boolean;

  {++}(*public*){--}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* Destructor. As usual, call Free method to destroy an object. }

  public

    property Items[ Idx : Integer ] : PWin32FindData 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 ] : string read GetNames;

    {* Full long names of directory items. }

    property Path : string read FPath;

    {* Path of scanned directory. }

    procedure Clear;

    {* Call it to clear list of files. }

    procedure ScanDirectory( const DirPath, Filter : String; 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 : String; 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}: String;

            Dirs, FullPaths: Boolean ): String;

   {* 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. }

  end;

//[END OF TDirList DEFINITION]



//[NewDirList DECLARATIONS]

function NewDirList( const DirPath, Filter: String; 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: String; 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. }



//[DirectorySize DECLARATION]

{-}

function DirectorySize( const Path: String ): I64;

{* Returns directory size in bytes as large 64 bit integer. }

{+}





//[OpenSaveDialog OPTIONS]

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. }



  {++}(*TOpenSaveDialog = class;*){--}

  POpenSaveDialog = {-}^{+}TOpenSaveDialog;

{ ----------------------------------------------------------------------



                              TOpenSaveDialog



----------------------------------------------------------------------- }

//[TOpenSaveDialog DEFINITION]

  TOpenSaveDialog = object( TObj )

  {* Object to show standard Open/Save dialog. Initially provided

     for XCL by Carlo Kok. }

  protected

    FFilter : String;

    fFilterIndex : Integer;

    fOpenDialog : Boolean;

    FInitialDir : String;

    FDefExtension : String;

    FFilename : string;

    FTitle : string;

    FOptions : TOpenSaveOptions;

    fWnd: THandle;

  public

    {$IFDEF OpenSaveDialog_Extended}

    TemplateName: String;

    HookProc: Pointer;

    {$ENDIF}

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* destructor }

    Function Execute : Boolean;

    {* Call it after creating to perform selecting of file by user. }

    property Filename : String read FFilename write FFileName;

    {*

    Filename is seperated 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 : string read FInitialDir write FInitialDir;

    {* Initial directory path. If not set, current directory (usually

       directory when program is started) is used. }

    property Filter : String 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 : String read Ftitle write Ftitle;

    {* Title for dialog. }

    property Options : TOpenSaveOptions read FOptions write FOptions;

    {* Options. }

    property DefExtension : String 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. }

  end;

//[END OF TOpenSaveDialog DEFINITION]



//[Default OpenSaveDialog OPTIONS]

const DefOpenSaveDlgOptions: TOpenSaveOptions = [ OSHideReadonly,

  OSOverwritePrompt, OSFileMustExist, OSPathMustExist ];



//[NewOpenSaveDialog DECLARATION]

function NewOpenSaveDialog( const Title, StrtDir: String;

         Options: TOpenSaveOptions ): POpenSaveDialog;

{* Creates object, which can be used (several times) to open file(s)

   selecting dialog. }







//[OpenDirectory Object]

type

  {++}(*TOpenDirDialog = class;*){--}

  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: PChar;

                              var EnableOK: Integer; var StatusText: 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 DEFINITION]

  TOpenDirDialog = object( TObj )

  {* Dialog for open directories, uses SHBrowseForFolder. }

  protected

    FTitle: String;

    FOptions: TOpenDirOptions;

    FCallBack: Pointer;

    FCenterProc: procedure( Wnd: HWnd );

    FBuf : array[ 0..MAX_PATH ] of Char;

    FInitialPath: String;

    FCenterOnScreen: Boolean;

    FDoSelChanged: procedure( Wnd: HWnd; Msg: DWORD; lParam, lpData: LParam ); stdcall;

    FOnSelChanged: TOnODSelChange;

    FStatusText: String;

    FWnd: HWnd;

    function GetPath: String;

    procedure SetInitialPath(const Value: String);

    procedure SetCenterOnScreen(const Value: Boolean);

    procedure SetOnSelChanged(const Value: TOnODSelChange);

    function GetInitialPath: String;

  public

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* destructor }

    function Execute : Boolean;

    {* Call it to select directory by user. Returns True, if operation was

       not cancelled by user. }

    property Title : String read FTitle write FTitle;

    {* Title for a dialog. }

    property Options : TOpenDirOptions read FOptions write FOptions;

    {* Option flags. }

    property Path : String read GetPath;

    {* Resulting (selected by user) path. }

    property InitialPath: String 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 eneble/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. }

  end;

//[END OF TOpenDirDialog DEFINITION]



//[NewOpenSaveDialog DECLARATION]

function NewOpenDirDialog( const Title: String; Options: TOpenDirOptions ):

         POpenDirDialog;

{* Creates object, which can be used (several times) to open directory

   selecting dialog (using SHBrowseForFolder API call). }



















//[Color Dialog Object]

type

  TColorCustomOption = ( ccoFullOpen, ccoShortOpen, ccoPreventFullOpen );



  {++}(*TColorDialog = class;*){--}

  PColorDialog = {-}^{+}TColorDialog;

{ ----------------------------------------------------------------------



                               TColorDialog



----------------------------------------------------------------------- }

//[TColorDialog DEFINITION]

  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;

//[END OF TColorDialog DEFINITION]



//[NewColorDialog DECLARATION]

function NewColorDialog( FullOpen: TColorCustomOption ): PColorDialog;

{* Creates color choosing dialog object. }



















//[Ini files]

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. }



  {++}(*TIniFile = class;*){--}

  PIniFile = {-}^{+}TIniFile;

{ ----------------------------------------------------------------------



                TIniFile - store/load data to ini-files



----------------------------------------------------------------------- }

//[TIniFile DEFINITION]

  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: String;

    fSection: String;

  protected

  public

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* destructor }

    property Mode: TIniFileMode read fMode write fMode;

    {* ifmWrite, if write data to ini-file rather than read it. }

    property FileName: String read fFileName;

    {* Ini file name. }

    property Section: String read fSection write fSection;

    {* Current ini section. }

    function ValueInteger( const Key: String; Value: Integer ): Integer;

    {* Reads or writes integer data value. }

    function ValueString( const Key: String; const Value: String ): String;

    {* Reads or writes string data value. }

    function ValueBoolean( const Key: String; Value: Boolean ): Boolean;

    {* Reads or writes boolean data value. }

    function ValueData( const Key: String; 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: String );

    {* Clears given key in current section. }



    /////////////// + by Vyacheslav A. Gavrik:

    procedure GetSectionNames(Names:PStrList);

    {* 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:PStrList);

    {* Read/write current section content to/from string list. (Depending on

       current Mode value). }

    ///////////////



  end;

//[END OF TIniFile DEFINITION]



//[OpenIniFile DECLARATION]

function OpenIniFile( const FileName: String ): PIniFile;

{* Opens ini file, creating TIniFile object instance to work with it. }

















//[MENU OBJECT]



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: PAnsiChar;   { used if MIIM_TYPE}

    cch: UINT;               { used if MIIM_TYPE}

    hbmpItem: HBITMAP;       { used if MIIM_BITMAP - not exists under Windows95 }

  end;



type

  {++}(*TMenu = class;*){--}

  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 DEFINITION]

  TMenu = object( TObj )

  {* 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;

    FParent: PMenu;

    FControl: PControl;

    fNextMenu : PMenu;

    FRadioGroup: Integer;

    FIsCheckItem: Boolean;

    FIsSeparator: Boolean;

    FMenuBreak: TMenuBreak;

    FItems: PList;

    FOnMenuItem : TOnMenuItem;

    FOnRadioOff : TOnMenuItem;

    fOnPopup: TOnEvent;

    fByAccel: Boolean;

    FPopupFlags: DWORD;

    //fAutoPopup: Boolean;

    FVisible: Boolean;

    FSavedState: DWORD;

    FData: Pointer;

    FOwnerDraw: Boolean;

    FCaption: String;

    FBitmap: HBitmap;

    FBmpChecked: HBitmap;

    FBmpItem: HBitmap;

    ClearBitmapsProc: procedure( Sender: PMenu );

    FClearBitmaps: Boolean;

    FNotPopup: Boolean;

    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 SetVisible( Value: Boolean );

    procedure SetData( Value: Pointer );

    procedure SetMenuItemCaption( const Value: String );

    function FillMenuItems(AHandle: HMenu; StartIdx: Integer;

      const Template: array of PChar): 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 );

    procedure SetHelpContext( Value: Integer );

    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): String;

    procedure SetItemText(Idx: Integer; const Value: String);

    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;

  public

    destructor Destroy; {-}virtual;{+}{++}(*override;*){--}

    {* 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.

    }

    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 FParent;

    {* 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: String 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 SetVisible;

    {* 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. }

    property HelpContext: Integer read FHelpContext write SetHelpContext;

    {* Help context for entire menu (help context can not be assigned to

       individual menu items). }



    procedure AssignEvents( StartIdx: Integer; 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: PChar; 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 ]: String 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. }

    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: PChar; Event: TOnMenuItem; Options: TMenuOptions): Integer;

    {* Adds menu item dynamically. Returns ID of the added item. }

    function InsertItem(InsertBefore: Integer; ACaption: PChar; Event: TOnMenuItem; Options: TMenuOptions): Integer;

    {* Inserts menu item before an item with ID, given by InsertBefore parameter. }

    function InsertItemEx(InsertBefore: Integer; ACaption: PChar; 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;

    {* By Alexander Pravdin. This property is assigned to a control which were

       initiated a pop-up, for popup menu. }

    {$ENDIF USE_MENU_CURCTL}



  end;

//[END OF TMenu DEFINITION]



//[MenuStructSize VARIABLE]

function MenuStructSize: Integer;

{* Returns 44 under Windows95, and 48 (=sizeof(TMenuItemInfo) under all other

   Windows versions. }



//[NewMenu DECLARATION]

function NewMenu( AParent : PControl; MaxCmdReserve: DWORD; const Template : array of PChar;

                      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 PChar;

                      aOnMenuItems: array of TOnMenuItem ): PMenu;

{* Creates menu, assigning its own event handler for every (enough) menu item. }



//[MakeAccelerator DECLARATION]

function MakeAccelerator( fVirt: Byte; Key: Word ): TMenuAccelerator;

{* Creates accelerator item to assign it to TMenu.ItemAccelerator[ ] property

   easy.}



//[GetAcceleratorText DECLARATION]

// {YS} added 7 Aug 2004

function GetAcceleratorText( const Accelerator: TMenuAccelerator ): string;

{* Returns text representation of accelerator. }



{|<hr>

















   <R System functions and working with windows>

}

//[Window FUNCTIONS DECLARATIONS]

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: String ): 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: String; 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 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: String;

         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>

   Trie 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: String;

         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: String;

         Show: DWORD; const InStr: String; var OutStr: String; 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 : String; Force, Reboot : Boolean ) : Boolean;

{* Shut down of Windows NT. Pass Machine = '' to shutdown this PC.

   Pass Reboot = True to reboot immediatelly after shut down. }



type

  TWindowsVersion = ( wv31, wv95, wv98, wvNT, wvY2K, wvXP, wvLongHorn );

  {* 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. }



//[Parameters FUNCTIONS DECLARATIONS]

function ParamStr( Idx: Integer ): String;

{* Returns command-line parameter by index. This function supersides

   standard ParamStr function. }

function ParamCount: Integer;

{* Returns number of parameters in command line.

|<hr>

}





//{$DEFINE CHK_BITBLT}

procedure Chk_BitBlt;

{$IFDEF ASM_VERSION}

procedure StartDC;

procedure FinishDC;

{$ENDIF ASM_VERSION}



//[WndProcXXX OTHER DECLARATIONS]

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;



//[Assert OPERATOR DECLARATION]

{-}

{$IFDEF _D2}

// Assert operator was not available in Delphi2. Provide here easy Assert

// procedure for Delphi2.

procedure Assert( Cond: Boolean; const Msg: String );



var AssertErrorProc: procedure( const Message, Filename: AnsiString; LineNumber: Integer );

{$ENDIF}

{+}





//[CUSTOM EXTENSIONS]

{$IFDEF USE_CUSTOMEXTENSIONS}

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

{$ENDIF}





{$IFDEF DEBUG_ENDSESSION}

var EndSession_Initiated: Boolean;

{$ENDIF}



//[FMMNotify VARIABLE]

var

  FMMNotify: procedure( var Msg: TMsg );



//[procedure ClearText forward declaration]

procedure ClearText( Sender: PControl );

//[procedure ClearListbox forward declaration]

procedure ClearListbox( Sender: PControl );

//[procedure ClearCombobox forward declaration]

procedure ClearCombobox( Sender: PControl );

//[procedure ClearListView forward declaration]

procedure ClearListView( Sender: PControl );

//[procedure ClearTreeView forward declaration]

procedure ClearTreeView( TV: PControl );



//[START OF ACTIONS]

const

  ButtonActions: TCommandActions = (

    aClear: ClearText;

    aAddText: nil;

    aClick: BN_CLICKED;

    aEnter: BN_SETFOCUS;

    aLeave: BN_KILLFOCUS;

    aChange: 0; //BN_CLICKED;

    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;

    aItem2Pos: 0;

    aPos2Item: 0;

    aGetSelCount: 0;

    aGetSelected: 0;

    aGetSelRange: 0;

    aExGetSelRange: 0;

    aGetCurrent: 0;

    aSetSelected: 0;

    aSetCurrent: 0;

    aSetSelRange: 0;

    aExSetSelRange: 0;

    aGetSelection: 0;

    aReplaceSel: 0;

    aTextAlignLeft: BS_LEFT;

    aTextAlignRight: BS_RIGHT;

    aTextAlignCenter: BS_CENTER;

    aTextAlignMask: 0;

    aVertAlignCenter: BS_VCENTER shr 8;

    aVertAlignTop: BS_TOP shr 8;

    aVertAlignBottom: BS_BOTTOM shr 8;

    aDir: 0;

    aSetLimit: 0;

    aSetImgList: 0;

    aAutoSzX: 14;

    aAutoSzY: 6;

    aSetBkColor: 0;

  );



const

  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;

    aItem2Pos: 0;

    aPos2Item: 0;

    aGetSelCount: 0;

    aGetSelected: 0;

    aGetSelRange: 0;

    aExGetSelRange: 0;

    aGetCurrent: 0;

    aSetSelected: 0;

    aSetCurrent: 0;

    aSetSelRange: 0;

    aExSetSelRange: 0;

    aGetSelection: 0;

    aReplaceSel: 0;

    aTextAlignLeft: SS_LEFT;

    aTextAlignRight: SS_RIGHT;

    aTextAlignCenter: SS_CENTER;

    aTextAlignMask: SS_LEFTNOWORDWRAP;

    aVertAlignCenter: SS_CENTERIMAGE shr 8;

    aVertAlignTop: 0;

    aVertAlignBottom: 0;

    aDir: 0;

    aSetLimit: 0;

    aSetImgList: 0;

    aAutoSzX: 1;

    aAutoSzY: 1;

    aSetBkColor: 0;

  );



const

  EN_LINK                             = $070b;

  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;

    aItem2Pos: EM_LINEINDEX;

    aPos2Item: EM_LINEFROMCHAR;

    aGetSelCount: EM_GETSEL;

    aGetSelected: 0;

    aGetSelRange: EM_GETSEL;

    aExGetSelRange: 0;

    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;

    aTextAlignMask: 0;

    aVertAlignCenter: 0;

    aVertAlignTop: 0;

    aVertAlignBottom: 0;

    aDir: 0;

    aSetLimit: EM_SETLIMITTEXT;

    aSetImgList: 0;

    aAutoSzX: 0;

    aAutoSzY: 6;

    aSetBkColor: 0;

    aItem2XY: EM_POSFROMCHAR;

  );



const

  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;

    aItem2Pos: 0;

    aPos2Item: 0;

    aGetSelCount: LB_GETSELCOUNT;

    aGetSelected: LB_GETSEL;

    aGetSelRange: 0;

    aExGetSelRange: 0;

    aGetCurrent: LB_GETCURSEL;

    aSetSelected: LB_SETSEL;

    aSetCurrent: LB_SETCURSEL;

    aSetSelRange: 0;

    aExSetSelRange: 0;

    aGetSelection: 0;

    aReplaceSel: 0;

    aTextAlignLeft: 0;

    aTextAlignRight: 0;

    aTextAlignCenter: 0;

    aTextAlignMask: 0;

    aVertAlignCenter: 0;

    aVertAlignTop: 0;

    aVertAlignBottom: 0;

    aDir: LB_DIR;

    aSetLimit: 0;

    aSetImgList: 0;

    aAutoSzX: 0;

    aAutoSzY: 0;

    aSetBkColor: 0;

    aItem2XY: LB_GETITEMRECT;

  );



const

  ComboActions: TCommandActions = (

    aClear: ClearCombobox;

    aAddText: nil;

    aClick: CBN_DBLCLK;

    aEnter: CBN_SETFOCUS;

    aLeave: CBN_KILLFOCUS;

    aChange: CBN_EDITCHANGE;

    aSelChange: CM_CBN_SELCHANGE; // 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;

    aItem2Pos: 0;

    aPos2Item: 0;

    aGetSelCount: 0;

    aGetSelected: CB_GETCURSEL;

    aGetSelRange: 0;

    aExGetSelRange: 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;

    aTextAlignMask: 0;

    aVertAlignCenter: 0;

    aVertAlignTop: 0;

    aVertAlignBottom: 0;

    aDir: CB_DIR;

    aSetLimit: 0;

    aSetImgList: 0;

    aAutoSzX: 0;

    aAutoSzY: 6;

    aSetBkColor: 0;

  );



const

  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: 0;

    aInsertItem: 0;

    aFindItem: 0;

    aFindPartial: 0;

    aItem2Pos: 0;

    aPos2Item: 0;

    aGetSelCount: $8000 or LVM_GETSELECTEDCOUNT;

    aGetSelected: 0;

    aGetSelRange: 0;

    aExGetSelRange: 0;

    aGetCurrent: LVM_GETNEXTITEM;

    aSetSelected: 0;

    aSetCurrent: 0;

    aSetSelRange: 0;

    aExSetSelRange: 0;

    aGetSelection: 0;

    aReplaceSel: 0;

    aTextAlignLeft: 0;

    aTextAlignRight: 0;

    aTextAlignCenter: 0;

    aTextAlignMask: 0;

    aVertAlignCenter: 0;

    aVertAlignTop: 0;

    aVertAlignBottom: 0;

    aDir: 0;

    aSetLimit: 0;

    aSetImgList: LVM_SETIMAGELIST;

    aAutoSzX: 0;

    aAutoSzY: 0;

    aSetBkColor: LVM_SETBKCOLOR;

    aItem2XY: LVM_GETITEMRECT;

  );



const

  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: 0;

    aInsertItem: 0;

    aFindItem: 0;

    aFindPartial: 0;

    aItem2Pos: 0;

    aPos2Item: 0;

    aGetSelCount: 0;

    aGetSelected: 0;

    aGetSelRange: 0;

    aExGetSelRange: 0;

    aGetCurrent: 0;

    aSetSelected: 0;

    aSetCurrent: 0;

    aSetSelRange: 0;

    aExSetSelRange: 0;

    aGetSelection: 0;

    aReplaceSel: 0;

    aTextAlignLeft: 0;

    aTextAlignRight: 0;

    aTextAlignCenter: 0;

    aTextAlignMask: 0;

    aVertAlignCenter: 0;

    aVertAlignTop: 0;

    aVertAlignBottom: 0;

    aDir: CB_DIR;

    aSetLimit: 0;

    aSetImgList: TVM_SETIMAGELIST;

    aAutoSzX: 0;

    aAutoSzY: 0;

    aSetBkColor: TVM_SETBKCOLOR;

    aItem2XY: TVM_GETITEMRECT;

  );



const

  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;

    aItem2Pos: 0;

    aPos2Item: 0;

    aGetSelCount: 0;

    aGetSelected: 0;

    aGetSelRange: 0;

    aExGetSelRange: 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;

    aTextAlignMask: 0;

    aVertAlignCenter: 0;

    aVertAlignTop: 0;

    aVertAlignBottom: 0;

    aDir: CB_DIR;

    aSetLimit: 0;

    aSetImgList: TCM_SETIMAGELIST;

    aAutoSzX: 0;

    aAutoSzY: 0;

    aSetBkColor: 0;

    aItem2XY: TCM_GETITEMRECT;

  );



const

  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;

    aItem2Pos: EM_LINEINDEX;

    aPos2Item: EM_LINEFROMCHAR;

    aGetSelCount: 0; //EM_EXGETSEL;

    aGetSelected: 0;

    aGetSelRange: 0;

    aExGetSelRange: EM_EXGETSEL;

    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;

    aTextAlignMask: 0;

    aVertAlignCenter: 0;

    aVertAlignTop: 0;

    aVertAlignBottom: 0;

    aDir: 0;

    aSetLimit: EM_EXLIMITTEXT;

    aSetImgList: 0;

    aAutoSzX: 0;

    aAutoSzY: 0;

    aSetBkColor: EM_SETBKGNDCOLOR;

    aItem2XY: EM_POSFROMCHAR;

  );



//[IMPLEMENTATION]

implementation



//[USES-2]

uses

  ShellAPI,

  commdlg

  ; //, commctrl;

            // in Delphi3, including of commctrl.pas increases executable

            // onto about 30K. So, all needed definitions are copied here

            // (see commctrl.inc).

//[END OF USES-2]



{$IFDEF _D2orD3}

const

  OFN_ENABLESIZING = $00800000;

{$ENDIF}



//[procedure Chk_BitBlt_ShowError]

procedure Chk_BitBlt_ShowError;

var Rslt: Integer;

begin

    Rslt := GetLastError;

    ShowMessage( 'BitBlt ERROR: ' + Int2Str( Rslt )

                 + ' ' + SysErrorMessage( Rslt ) );

end;

//[ENDe Chk_BitBlt_ShowError]



//[procedure Chk_BitBlt]

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;

//[ENDe Chk_BitBlt]



//[FUNCTION MulDiv]

{$IFNDEF FPC}

function MulDiv( A, B, C: Integer ): Integer;

asm

  IMUL EDX

  IDIV ECX

end;

{$ENDIF}

//[END MulDiv]



{-}

{$ifdef _D2}



//[PROCEDURE Assert]

procedure Assert( Cond: Boolean; const Msg: String );

begin

  if not Cond then

  begin

    AssertErrorProc( Msg, '', 0 );

    //MsgOK( Msg );

    asm

      int 3;

    end;

  end;

end;



//[API CreateDIBSection]

function CreateDIBSection(DC: HDC; const p2: TBitmapInfo; p3: UINT;

  var p4: Pointer; p5: THandle; p6: DWORD): HBITMAP; stdcall;

external gdi32 name 'CreateDIBSection';





//[PROCEDURE _LStrFromPCharLen]

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}

{+}



//[API InitCommonControls]

procedure InitCommonControls; external cctrl name 'InitCommonControls';



type

  TInitCommonControlsEx = packed record

    dwSize: DWORD;

    dwICC: DWORD;

  end;

  PInitCommonControlsEx = ^TInitCommonControlsEx;



var ComCtl32_Module: HModule;

//[procedure DoInitCommonControls]

procedure DoInitCommonControls( dwICC: DWORD );

var Proc: procedure( ICC: PInitCommonControlsEx ); stdcall;

    ICC: TInitCommonControlsEx;

begin

  InitCommonControls;

  if ComCtl32_Module = 0 then

    ComCtl32_Module := LoadLibrary( 'comctl32.dll' );

  @ Proc := GetProcAddress( ComCtl32_Module, 'InitCommonControlsEx' );

  if Assigned( Proc ) then

  begin

    ICC.dwSize := Sizeof( ICC );

    ICC.dwICC := dwICC;

    Proc( @ ICC );

  end;

end;

//[END DoInitCommonControls]



const size_TRect = 16; // used often in assembler versions of code

{-}



{$IFDEF ASM_VERSION}

const

  EmptyString: String = '';



//[PROCEDURE EAX2PChar]

procedure EAX2PChar;

asm

        TEST     EAX, EAX

        JNZ      @@exit

        MOV      EAX, offset[EmptyString]

@@exit:

end;



//[PROCEDURE EDX2PChar]

procedure EDX2PChar;

asm

        TEST     EDX, EDX

        JNZ      @@exit

        MOV      EDX, offset[EmptyString]

@@exit:

end;



//[PROCEDURE ECX2PChar]

procedure ECX2PChar;

asm

        JECXZ   @@convert

        RET

@@convert:

        MOV     ECX, offset[EmptyString]

@@exit:

end;



//[PROCEDURE RemoveStr]

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;

{$ELSE ASM_VERSION}

{$ENDIF ASM_VERSION}

{+}



//[PROCEDURE MsgOK]

procedure MsgOK( const S: String );

begin

  MsgBox( S, MB_OK );

end;



{$IFDEF ASM_VERSION}

//[function MsgBox]

function MsgBox( const S: String; Flags: DWORD ): DWORD;

asm

        PUSH      EDX

        PUSH      EAX



        MOV       ECX, [Applet]

        XOR       EAX, EAX

        JECXZ     @@1

        MOV       EAX, [ECX].TControl.fCaption

@@1:

        XCHG      EAX, [ESP]

        PUSH      EAX

        PUSH      0

        CALL      MessageBox

end;

{$ELSE ASM_VERSION} //Pascal

function MsgBox( const S: String; Flags: DWORD ): DWORD;

var Title: PChar;

begin

  Title := nil;

  if assigned( Applet ) then

  begin

    Title := PChar( Applet.fCaption );

  end;

  Result := MessageBox( 0 {Wnd}, PChar( S ), Title, Flags );

end;

//[END MsgBox]

{$ENDIF ASM_VERSION}



//[function ShowMsg]

function ShowMsg( const S: String; Flags: DWORD ): DWORD;

var Title: PChar;

    Wnd: HWnd;

begin

  Title := nil;

  Wnd := 0;

  if assigned( Applet ) then

  begin

     Title := PChar( Applet.fCaption );

     Wnd := Applet.Handle;

  end;

  Result := MessageBox( Wnd, PChar( S ), Title, Flags );

end;

//[END ShowMsg]



//[procedure ShowMessage]

procedure ShowMessage( const S: String );

begin

  ShowMsg( S, MB_OK or MB_SETFOREGROUND );

end;

//[ENDe ShowMessage]



//[procedure OKClick]

procedure OKClick( Dialog, Btn: PControl );

var Rslt: Integer;

begin

  Rslt := -1;

  if Btn <> nil then

    Rslt := Btn.Tag;

  Dialog.ModalResult := Rslt;

  Dialog.Close;

end;

//[END OKClick]



//[procedure KeyClick]

procedure KeyClick( Dialog, Btn: PControl; var Key: Longint; Shift: DWORD );

begin

  if (Key = VK_RETURN) or (Key = VK_ESCAPE) then

  begin

    if Key = VK_ESCAPE then

      Btn := nil;

    OKClick( Dialog, Btn );

  end;

end;

//[ENDe KeyClick]



//[procedure CloseMsg]

procedure CloseMsg( Dummy, Dialog: PControl; var Accept: Boolean );

begin

  Accept := FALSE;

  Dialog.ModalResult := -1;

end;

//[ENDe CloseMsg]



//[function ShowQuestionEx]

function ShowQuestionEx( const S: String; Answers: String; CallBack: TOnEvent ): Integer;

{$IFDEF F_P105ORBELOW}

type POnEvent = ^TOnEvent;

     PONKey = ^TOnKey;

var M: TMethod;

{$ENDIF F_P105ORBELOW}

var Dialog: PControl;

    Buttons: PList;

    Btn: PControl;

    AppTermFlag: Boolean;

    Lab: PControl;

    Y, W, I: Integer;

    Title: String;

    DlgWnd: HWnd;

    AppCtl: PControl;

begin

  AppTermFlag := AppletTerminated;

  AppCtl := Applet;

  AppletTerminated := FALSE;

  Title := 'Information';

  if pos( '/', Answers ) > 0 then

    Title := 'Question';

  if Applet <> nil then

    Title := Applet.Caption;

  Dialog := NewForm( Applet, Title ).SetSize( 300, 40 );

  Dialog.Style := Dialog.Style and not (WS_MINIMIZEBOX or WS_MAXIMIZEBOX);

  Dialog.OnClose := TOnEventAccept( MakeMethod( Dialog, @CloseMsg ) );

  Dialog.Margin := 8;

  Lab := NewEditbox( Dialog, [ eoMultiline, eoReadonly, eoNoHScroll, eoNoVScroll ] ).SetSize( 278, 20 );

  Lab.HasBorder := FALSE;

  Lab.Color := clBtnFace;

  Lab.Caption := S;

  Lab.Style := Lab.Style and not WS_TABSTOP;

  Lab.TabStop := FALSE;

  //Lab.LikeSpeedButton;



  //Lab.CreateWindow; //virtual!!! -- not needed, window created in Perform

  while TRUE do

  begin

    Y := HiWord( Lab.Perform( EM_POSFROMCHAR, Length( S ) - 1, 0 ) );

    if Y < Lab.Height - 20 then break;

    Lab.Height := Lab.Height + 4;

    if Lab.Height + 40 > GetSystemMetrics( SM_CYSCREEN ) then break;

  end;



  Buttons := NewList;

  W := 0;

  if Answers = '' then

  begin

    Btn := NewButton( Dialog, '  OK  ' ).PlaceUnder;

    W := Btn.Width;

    Buttons.Add( Btn );

  end

    else

  while Answers <> '' do

  begin

    Btn := NewButton( Dialog, '  ' + Parse( Answers, '/' ) + '  ' );

    Buttons.Add( Btn );

    if W = 0 then

      Btn.PlaceUnder

    else

      Btn.PlaceRight;

    Btn.AutoSize( TRUE );

    if W > 0 then

    begin

      //Inc( W, 6 );

      Btn.Left := Btn.Left + 6;

    end;

    W := Btn.BoundsRect.Right + 12;

  end;

  if Dialog.ClientWidth < W then

    Dialog.ClientWidth := W;

  W := (Dialog.ClientWidth - W) div 2;

  for I := 0 to Buttons.Count-1 do

  begin

    Btn := Buttons.Items[ I ];

    Btn.Tag := I + 1;

    {$IFDEF F_P105ORBELOW}

    M := MakeMethod( Dialog, @OKClick );

    Btn.OnClick := POnEvent( @ M )^;

    M := MakeMethod( Dialog, @KeyClick );

    Btn.OnKeyDown := POnKey( @ M )^;

    {$ELSE}

    Btn.OnClick := TOnEvent( MakeMethod( Dialog, @OKClick ) );

    Btn.OnKeyDown := TOnKey( MakeMethod( Dialog, @KeyClick ) );

    {$ENDIF}

    Btn.Left := Btn.Left + W;

    if I = 0 then

    begin

      Btn.ResizeParentBottom;

      Dialog.ActiveControl := Btn;

    end;

  end;

  Dialog.CenterOnParent.Tabulate.CanResize := FALSE;

  Buttons.Free;



  if Assigned( CallBack ) then

    CallBack( Dialog );

  Dialog.CreateWindow; // virtual!!!



  if (Applet <> nil) and Applet.IsApplet then

  begin

    Dialog.ShowModal;

    Result := Dialog.ModalResult;

    Dialog.Free;

  end

    else

  begin

    DlgWnd := Dialog.Handle;

    while IsWindow( DlgWnd ) and (Dialog.ModalResult = 0) do

      Dialog.ProcessMessage;

    Result := Dialog.ModalResult;

    Dialog.Free;

    CreatingWindow := nil;

    Applet := AppCtl;

  end;



  AppletTerminated := AppTermFlag;

end;

//[END ShowQuestionEx]



//[function ShowQuestion]

function ShowQuestion( const S: String; Answers: String ): Integer;

begin

  Result := ShowQuestionEx( S, Answers, nil );

end;

//[END ShowQuestion]



//[procedure ShowMsgModal]

procedure ShowMsgModal( const S: String );

begin

  ShowQuestion( S, '' );

end;

//[ENDe ShowMsgModal]



//[procedure SpeakerBeep]

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;

//[ENDe SpeakerBeep]



{++}(*

//[API FormatMessage]

function FormatMessage; external kernel32 name 'FormatMessageA';

*){--}



//[FUNCTION SysErrorMessage]

function SysErrorMessage(ErrorCode: Integer): string;

var

  Len: Integer;

  Buffer: array[0..255] of Char;

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] in [#0..#32 {, '.'}]) do Dec(Len);

  SetString(Result, Buffer, Len);

end;

//[END SysErrorMessage]



//[function MakeMethod]

function MakeMethod( Data, Code: Pointer ): TMethod;

begin

  Result.Data := Data;

  Result.Code := Code;

end;

//[END MakeMethod]



//[function GetShiftState]

function GetShiftState: DWORD;

begin

  Result := 0;

  if GetKeyState( VK_SHIFT ) < 0 then

    Result := Result or MK_SHIFT;

  if GetKeyState( VK_CONTROL ) < 0 then

    Result := Result or MK_CONTROL;

  //if LONGBOOL(Msg.lParam and $20000000) then

  if GetKeyState( VK_MENU ) < 0 then

    Result := Result or MK_ALT;

end;

//[END GetShiftState]



//[FUNCTION MakeRect]

{$IFDEF ASM_VERSION}

function MakeRect( Left, Top, Right, Bottom: Integer ): TRect; stdcall;

asm

        PUSH       ESI

        PUSH       EDI



        MOV        EDI, @Result

        LEA        ESI, [Left]



        MOVSD

        MOVSD

        MOVSD

        MOVSD



        POP        EDI

        POP        ESI

end;

{$ELSE ASM_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 ASM_VERSION}

//[END MakeRect]



//[FUNCTION RectsEqual]

{$IFDEF ASM_VERSION}

function RectsEqual( const R1, R2: TRect ): Boolean;

asm

        //LEA       EAX, [R1]

        //LEA       EDX, [R2]

        MOV       ECX, size_TRect

        CALL      CompareMem

end;

{$ELSE ASM_VERSION} //Pascal

function RectsEqual( const R1, R2: TRect ): Boolean;

begin

  Result := CompareMem( @R1, @R2, Sizeof( TRect ) );

end;

{$ENDIF ASM_VERSION}

//[END RectsEqual]



//[function RectsIntersected]

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;

//[END RectsIntersected]





//[FUNCTION PointInRect]

{$IFDEF ASM_VERSION}

function PointInRect( const P: TPoint; const R: TRect ): Boolean;

asm

        PUSH      ESI

        MOV       ECX, EAX

        MOV       ESI, EDX

        LODSD

        CMP       EAX, [ECX]

        JG        @@fail

        LODSD

        CMP       EAX, [ECX+4]

        JG        @@fail

        LODSD

        CMP       [ECX], EAX

        JG        @@fail

        LODSD

        CMP       [ECX+4], EAX

@@fail: SETLE     AL

        POP       ESI

end;

{$ELSE ASM_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 ASM_VERSION}

//[END PointInRect]



//[FUNCTION MakePoint]

{$IFDEF ASM_VERSION}

function MakePoint( X, Y: Integer ): TPoint;

asm

        MOV      ECX, @Result

        MOV      [ECX].TPoint.x, EAX

        MOV      [ECX].TPoint.y, EDX

end;

{$ELSE ASM_VERSION} //Pascal

function MakePoint( X, Y: Integer ): TPoint;

begin

   Result.x := X;

   Result.y := Y;

end;

{$ENDIF ASM_VERSION}

//[END MakePoint]



//[FUNCTION MakeFlags]

{$IFDEF ASM_VERSION}

function MakeFlags( FlgSet: PDWORD; FlgArray: array of Integer): Integer;

asm

        PUSH     EBX

        PUSH     ESI

        MOV      EBX, [EAX]

        MOV      ESI, EDX

        XOR      EDX, EDX

        INC      ECX

        JZ       @@exit

@@loo:

        LODSD

        TEST     EAX, EAX

        JGE      @@ge

        NOT      EAX

        TEST     BL, 1

        JZ       @@or

        DEC      EBX

@@ge:

        TEST     BL, 1

        JZ       @@nx

@@or:

        OR       EDX, EAX

@@nx:

        SHR      EBX, 1

        LOOP     @@loo



@@exit:

        XCHG     EAX, EDX

        POP      ESI

        POP      EBX

end;

{$ELSE ASM_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 ASM_VERSION}

//[END MakeFlags]



//[procedure HelpFastIncNum2Els]

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};

//[ENDe HelpFastIncNum2Els]



//[procedure Swap]

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;

//[ENDe Swap]

{$ENDIF F_P/DELPHI}



//[function Min]

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};

//[END Min]



//[function Max]

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};

//[END Max]



{$IFDEF REDEFINE_ABS}

//[function Abs]

function Abs( X: Integer ): Integer;

asm

  {$IFDEF F_P}

  MOV EAX, [X]

  {$ENDIF F_P}

  TEST EAX, EAX

  JGE @@1

  NEG EAX

@@1:

end {$IFDEF F_P} [ 'EAX' ] {$ENDIF};

//[END Abs]

{$ENDIF}



//[function Sgn]

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;

//[END Sgn]



//[function iSqrt]

function iSQRT( X: Integer ): Integer;

var I, N: Integer;

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 shl 1;

    end;

    if I <= 0 then Exit;

    Result := Result + I;

  end;

end;

//[END iSqrt]



{$IFDEF ASM_VERSION}

//[PROCEDURE StartDC]

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;

//[END StartDC]



//[procedure FinishDC]

procedure FinishDC;

asm

        POP      ECX

        POP      EAX

        POP      EDX

        PUSH     ECX

        PUSH     EDX

        PUSH     EAX

        PUSH     EDX

        CALL     SelectObject

        CALL     DeleteDC

end;

//[ENDe FinishDC]

{$ELSE ASM_VERSION}

{$ENDIF ASM_VERSION}



//[procedure FastIncNum2Elements]

procedure FastIncNum2Elements( List: TList; FromIdx, Count, Value: Integer );

begin

  HelpFastIncNum2Els( @List.fItems[ FromIdx ], Value, Count );

end;



//[function EnumDynHandlers FORWARD DECLARATION]

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

  forward;



//[procedure DummyObjProc]

procedure DummyObjProc( Sender: PObj );

begin

end;



//[procedure DummyObjProcParam]

procedure DummyObjProcParam( Sender: PObj; Param: Pointer );

begin

end;



//[procedure DummyPaintProc]

procedure DummyPaintProc( Sender: PControl; DC: HDC );

begin

end;



//[procedure Free_And_Nil]

procedure Free_And_Nil( var Obj );

var Obj1: PObj;

begin

  Obj1 := PObj( Obj );

  Pointer( Obj ) := nil;

  Obj1.Free;

end;

//[ENDe Free_And_Nil]



{$IFDEF USE_NAMES}

function FindObj( const Name: String ): PObj;

var i: Integer;

    Obj: PObj;

begin

  if NamedObjectsList = nil then

    NamedObjectsList := NewList;

  for i := 0 to NamedObjectsList.Count-1 do

  begin

    Obj := NamedObjectsList.Items[ i ];

    if Name = Obj.FName then

    begin

      Result := Obj; Exit;

    end;

  end;

  Result := nil;

end;

{$ENDIF}









{-}

{ _TObj }



//[procedure _TObj.Init]

procedure _TObj.Init;

begin

{$IFDEF _D2orD3}

  FillChar( Pointer( Integer(@Self) + 4 )^, Sizeof( Self ) - 4, 0 );

{$ENDIF}

end;





//[function _TObj.VmtAddr]

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}

constructor TObj.Create;

asm

        //CALL      System.@ObjSetup - Generated always by compiler

        //JZ        @@exit



        PUSH      EAX

        MOV       EDX, [EAX]

        CALL      dword ptr [EDX]

        POP       EAX



@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

constructor TObj.Create;

begin

  Init;

  {++}(* inherited; *){--}

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TObj.DoDestroy]

procedure TObj.DoDestroy;

asm

        MOV       EDX, [EAX].fRefCount

        SAR       EDX, 1

        JZ        @@1

        JC        @@exit

        DEC       [EAX].fRefCount

        STC



@@1:    JC        @@exit

        MOV       EDX, [EAX]

        CALL      dword ptr [EDX + 4]

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

procedure TObj.DoDestroy;

begin

  if fRefCount <> 0 then

  begin

    if not LongBool( fRefCount and 1) then

       Dec( fRefCount );

  end

  else

     Destroy;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TObj.RefDec]

procedure TObj.RefDec;

asm

        SUB      [EAX].fRefCount, 2

        JGE      @@exit

        TEST     [EAX].fRefCount, 1

        JZ       @@exit

        MOV      EDX, [EAX]

        PUSH     dword ptr [EDX+4]

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

procedure TObj.RefDec;

begin

  Dec( fRefCount, 2 );

  if (fRefCount < 0) and LongBool(fRefCount and 1) then

    Destroy;

end;

{$ENDIF ASM_VERSION}



//[procedure TObj.RefInc]

procedure TObj.RefInc;

begin

  Inc( fRefCount, 2 );

end;



{-}

//[function TObj.VmtAddr]

function TObj.VmtAddr: Pointer;

asm

       MOV    EAX, [EAX - 4]

end;



//[function TObj.InstanceSize]

function TObj.InstanceSize: Integer;

asm

       MOV    EAX, [EAX]

       MOV    EAX,[EAX-4]

end;

{+}



//[procedure TObj.Free]

{$IFDEF F_P}

procedure TObj.Free;

begin

  if Self <> nil then

    DoDestroy;

end;

{$ELSE DELPHI}

procedure TObj.Free;

asm

   TEST    EAX,EAX

   JNE     DoDestroy

end;

{$ENDIF F_P/DELPHI}



{$IFDEF ASM_VERSION}

destructor TObj.Destroy;

asm

        PUSH      EAX

        CALL      Final

        POP       EAX

        {$IFDEF USE_NAMES}

        PUSH      EAX

        XOR   EDX, EDX

        CALL  SetName

        POP       EAX

        {$ENDIF}

        XOR       EDX, EDX

        CALL      System.@FreeMem

        //CALL      System.@Dispose

end;

{$ELSE ASM_VERSION} //Pascal

destructor TObj.Destroy;

begin

  Final;

  {$IFDEF USE_NAMES}

  Name := '';

  {$ENDIF}

  {$IFDEF DEBUG_ENDSESSION}

  if EndSession_Initiated then

    LogFileOutput( GetStartDir + 'es_debug.txt',

                   'FINALLED: ' + Int2Hex( DWORD( @ Self )

                   {$IFDEF USE_NAMES}

                   + ' (name:' + FName + ')'

                   {$ENDIF}

                   , 8 ) );

  {$ENDIF}

  {-}

  Dispose( @Self );

  {+} {++}(*

  inherited; *){--}

end;

{$ENDIF ASM_VERSION}



{++}(*

//[procedure TObj.Init]

procedure TObj.Init;

begin



end;

*){--}



{$IFDEF ASM_VERSION}

//[procedure TObj.Final]

procedure TObj.Final;

asm     //cmd    //opd

        XOR      ECX, ECX

        XCHG     ECX, [EAX].fOnDestroy.TMethod.Code

        JECXZ    @@doAutoFree

        PUSH     EAX

        XCHG     EDX, EAX

        MOV      EAX, [EDX].fOnDestroy.TMethod.Data

        CALL     ECX

        POP      EAX

@@doAutoFree:

        XOR      ECX, ECX

        XCHG     ECX, [EAX].fAutoFree

        JECXZ    @@exit

        PUSH     ESI

        PUSH     ECX

        MOV      ESI, [ECX].TList.fItems

        MOV      ECX, [ECX].TList.fCount

@@freeloop:

        LODSD

        XCHG     EDX, EAX

        LODSD

        PUSH     ECX

        CALL     EDX

        POP      ECX

        DEC      ECX

        LOOP     @@freeloop

        POP      EAX

        CALL     TObj.Free

        POP      ESI

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

procedure TObj.Final;

var I: Integer;

    ProcMethod: TMethod;

    Proc: TObjectMethod Absolute ProcMethod;

begin

  if Assigned( fOnDestroy ) then

  begin

    fOnDestroy( @Self );

    fOnDestroy := nil;

  end;

  if fAutoFree <> nil then

  begin

    for I := 0 to fAutoFree.fCount div 2 - 1 do

    begin

      ProcMethod.Code := fAutoFree.fItems[ I * 2 ];

      ProcMethod.Data := fAutoFree.fItems[ I * 2 + 1 ];

      {-}

      Proc;

      {+}{++}(*

      asm

        MOV  EAX, [ProcMethod.Data]

        {$IFDEF F_P}

        PUSH EAX

        {$ENDIF F_P}

        MOV  ECX, [ProcMethod.Code]

        CALL ECX

      end {$IFDEF F_P}[ 'EAX', 'EDX', 'ECX' ]{$ENDIF};

      *){--}

    end;

    fAutoFree.Free;

    fAutoFree := nil;

  end;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TObj.Add2AutoFree]

procedure TObj.Add2AutoFree(Obj: PObj);

asm     //cmd    //opd

        PUSH     EBX

        PUSH     EDX

        XCHG     EBX, EAX

        MOV      EAX, [EBX].fAutoFree

        TEST     EAX, EAX

        JNZ      @@1

        CALL     NewList

        MOV      [EBX].fAutoFree, EAX

@@1:    MOV      EBX, EAX

        XOR      EDX, EDX

        POP      ECX

        CALL     TList.Insert

        XCHG     EAX, EBX

        XOR      EDX, EDX

        MOV      ECX, offset TObj.Free

        //XOR      ECX, ECX

        CALL     TList.Insert

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

procedure TObj.Add2AutoFree(Obj: PObj);

begin

  if fAutoFree = nil then

    fAutoFree := NewList;

  fAutoFree.Insert( 0, Obj );

  fAutoFree.Insert( 0, Pointer( @TObj.Free ) );

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TObj.Add2AutoFreeEx]

procedure TObj.Add2AutoFreeEx( Proc: TObjectMethod );

asm     //cmd    //opd

        PUSH     EBX

        XCHG     EAX, EBX

        MOV      EAX, [EBX].fAutoFree

        TEST     EAX, EAX

        JNZ      @@1

        CALL     NewList

        MOV      [EBX].fAutoFree, EAX

@@1:    XOR      EDX, EDX

        MOV      ECX, [EBP+12] // Data

        MOV      EBX, EAX

        CALL     TList.Insert

        XCHG     EAX, EBX

        XOR      EDX, EDX

        MOV      ECX, [EBP+8] // Code

        CALL     TList.Insert

        POP      EBX

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF USE_NAMES}

procedure TObj.SetName(const NewName: String);

begin

  if FName <> '' then

  begin

    NamedObjectsList.Remove( @ Self );

    FName := '';

  end;

  if FindObj( NewName ) <> nil then Exit; // prevent duplications!

  FName := NewName;

  if FName <> '' then

    NamedObjectsList.Add( @ Self );

end;

{$ENDIF}





























{ TList }



{$IFDEF USE_CONSTRUCTORS}

//[function NewList]

function NewList: PList;

begin

  New( Result, Create );

  //Result.fAddBy := 4;

end;

//[END NewList]



//[procedure TList.Init]

procedure TList.Init;

begin

  inherited;

  fAddBy := 4;

end;

{$ELSE not_USE_CONSTRUCTORS}

//[function NewList]

function NewList: PList;

begin

  {-}

  New( Result, Create );

  {+} {++}(* Result := PList.Create; *){--}

  //Result.fAddBy := 4;

end;

//[END NewList]

{$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}



{$IFDEF ASM_VERSION}

destructor TList.Destroy;

asm

        PUSH      EAX

        CALL      TList.Clear

        POP       EAX

        CALL      TObj.Destroy

end;

{$ELSE ASM_VERSION} //Pascal

destructor TList.Destroy;

begin

   Clear;

   inherited;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TList.Release]

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.Free

end;

{$ELSE ASM_VERSION} //Pascal

procedure TList.Release;

var I: Integer;

begin

  if @ Self = nil then Exit;

  for I := 0 to fCount - 1 do

    if fItems[ I ] <> nil then

      FreeMem( fItems[ I ] );

  Free;

end;

{$ENDIF ASM_VERSION}



//[procedure TList.ReleaseObjects]

procedure TList.ReleaseObjects;

var I: Integer;

begin

  if @ Self = nil then Exit;

  for I := fCount-1 downto 0 do

    PObj( fItems[ I ] ).Free;

  Free;

end;



{$IFDEF ASM_VERSION}

//[procedure TList.SetCapacity]

procedure TList.SetCapacity( Value: Integer );

asm

        CMP       EDX, [EAX].fCount

        {$IFDEF USE_CMOV}

        CMOVL     EDX, [EAX].fCount

        {$ELSE}

        JGE       @@1

        MOV       EDX, [EAX].fCount

@@1:    {$ENDIF}

        CMP       EDX, [EAX].fCapacity

        JE        @@exit



        MOV       [EAX].fCapacity, EDX

        SAL       EDX, 2

        LEA       EAX, [EAX].fItems

        CALL      System.@ReallocMem

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

//var NewItems: PPointerList;

procedure TList.SetCapacity( Value: Integer );

begin

   if Value < Count then

      Value := Count;

   if Value = fCapacity then Exit;

   ReallocMem( fItems, Value * Sizeof( Pointer ) );

   fCapacity := Value;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TList.Clear]

procedure TList.Clear;

asm

        PUSH      [EAX].fItems

        XOR       EDX, EDX

        MOV       [EAX].fItems, EDX

        MOV       [EAX].fCount, EDX

        MOV       [EAX].fCapacity, EDX

        POP       EAX

        CALL      System.@FreeMem

end;

{$ELSE ASM_VERSION} //Pascal

procedure TList.Clear;

begin

   if fItems <> nil then

      FreeMem( fItems );

   fItems := nil;

   fCount := 0;

   fCapacity := 0;

end;

{$ENDIF ASM_VERSION}



//[procedure TList.SetAddBy]

procedure TList.SetAddBy(Value: Integer);

begin

  if Value < 1 then Value := 1;

  fAddBy := Value;

end;



{$IFDEF ASM_VERSION}

//[procedure TList.Add]

procedure TList.Add( Value: Pointer );

asm

        PUSH      EDX

        LEA       ECX, [EAX].fCount

        MOV       EDX, [ECX]

        INC       dword ptr [ECX]

          PUSH      EDX

          CMP       EDX, [EAX].fCapacity

            PUSH      EAX

            JL        @@ok



            MOV       ECX, [EAX].fAddBy

            TEST      ECX, ECX

            JNZ       @@add

            MOV       ECX, EDX

            SHR       ECX, 2

            INC       ECX

          @@add:

            ADD       EDX, ECX

            CALL      TList.SetCapacity

@@ok:

            POP       ECX  // ECX = Self

          POP       EAX    // EAX = fCount -> Result (for TList.Insert)

        POP       EDX      // EDX = Value



        MOV       ECX, [ECX].fItems

        MOV       [ECX + EAX*4], EDX

end;

{$ELSE ASM_VERSION} //Pascal

procedure TList.Add( Value: Pointer );

begin

   //if fAddBy <= 0 then fAddBy := 4;

   if fCapacity <= Count then

   begin

     if fAddBy <= 0 then

       Capacity := Count + Min( 1000, Count div 4 + 1 )

     else

       Capacity := Count + fAddBy;

   end;

   fItems[ fCount ] := Value;

   Inc( fCount );

end;

{$ENDIF ASM_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]

procedure TList.Delete( Idx: Integer );

begin

   {Assert( (Idx >= 0) and (Idx < fCount), 'TList.Delete: index out of bounds' );

   Move( fItems[ Idx + 1 ], fItems[ Idx ], Sizeof( Pointer ) * (Count - Idx - 1) );

   Dec( fCount );}

   DeleteRange( Idx, 1 );

end;



{$IFDEF ASM_VERSION}

//[procedure TList.DeleteRange]

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 ASM_VERSION} //Pascal

procedure TList.DeleteRange(Idx, Len: Integer);

begin

  if Len <= 0 then Exit;

  if Idx >= Count then Exit;

  Assert( (Idx >= 0), 'TList.DeleteRange: index out of bounds' );

  if DWORD( Idx + Len ) > DWORD( Count ) then

    Len := Count - Idx;

  Move( fItems[ Idx + Len ], fItems[ Idx ], Sizeof( Pointer ) * (Count - Idx - Len) );

  Dec( fCount, Len );

end;

{$ENDIF ASM_VERSION}



//[procedure TList.Remove]

procedure TList.Remove(Value: Pointer);

var I: Integer;

begin

  I := IndexOf( Value );

  if I >= 0 then

    Delete( I );

end;



//[procedure TList.Put]

procedure TList.Put( Idx: Integer; Value: Pointer );

begin

   if Idx < 0 then Exit;

   if Idx >= Count then Exit;

   //Assert( (Idx >= 0) and (Idx < fCount), 'TList.Put: index out of bounds' );

   fItems[ Idx ] := Value;

end;



//[function TList.Get]

function TList.Get( Idx: Integer ): Pointer;

begin

   Result := nil;

   if Idx < 0 then Exit;

   if Idx >= fCount then Exit;

   //Assert( (Idx >= 0) and (Idx < fCount), 'TList.Get: index out of bounds' );

   Result := fItems[ Idx ];

end;



{$IFDEF ASM_VERSION}

//[function TList.IndexOf]

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 ASM_VERSION} //Pascal

function TList.IndexOf( Value: Pointer ): Integer;

var I: Integer;

begin

   Result := -1;

   for I := 0 to Count - 1 do

   begin

      if fItems[ I ] = Value then

      begin

         Result := I;

         break;

      end;

   end;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TList.Insert]

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 ASM_VERSION} //Pascal

procedure TList.Insert(Idx: Integer; Value: Pointer);

begin

   Assert( (Idx >= 0) and (Idx <= Count), 'List index out of bounds' );

   Add( nil );

   if fCount > Idx then

     Move( FItems[ Idx ], FItems[ Idx + 1 ], (fCount - Idx - 1) * Sizeof( Pointer ) );

   FItems[ Idx ] := Value;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TList.MoveItem]

procedure TList.MoveItem(OldIdx, NewIdx: Integer);

asm

        CMP       EDX, ECX

        JE        @@exit



        CMP       ECX, [EAX].fCount

        JGE       @@exit



        PUSH      EDI



        MOV       EDI, [EAX].fItems

        PUSH      dword ptr [EDI + EDX*4]

          PUSH      ECX

          PUSH      EAX

          CALL      TList.Delete

          POP       EAX

          POP       EDX

        POP       ECX



        POP       EDI

        CALL      TList.Insert

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

procedure TList.MoveItem(OldIdx, NewIdx: Integer);

var Item: Pointer;

    //I: Integer;

begin

  if OldIdx = NewIdx then Exit;

  if NewIdx >= Count then Exit;

  Item := Items[ OldIdx ];

  Delete( OldIdx );

  Insert( NewIdx, Item );

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[function TList.Last]

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 ASM_VERSION} //Pascal

function TList.Last: Pointer;

begin

  if Count = 0 then

    Result := nil

  else

    Result := Items[ Count-1 ];

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TList.Swap]

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 ASM_VERSION} //Pascal

procedure TList.Swap(Idx1, Idx2: Integer);

var Tmp: Pointer;

begin

  Tmp := FItems[ Idx1 ];

  FItems[ Idx1 ] := FItems[ Idx2 ];

  FItems[ Idx2 ] := Tmp;

end;

{$ENDIF ASM_VERSION}



//[procedure TList.SetCount]

procedure TList.SetCount(const Value: Integer);

begin

  if Value >= Count then exit;

  fCount := Value;

end;



//[procedure TList.Assign]

procedure TList.Assign(SrcList: PList);

begin

  Clear;

  if SrcList.fCount > 0 then

  begin

    Capacity := SrcList.fCount;

    fCount := SrcList.fCount;

    Move( SrcList.FItems[ 0 ], FItems[ 0 ], Sizeof( Pointer ) * fCount );

  end;

end;





































{ -- Window procedure -- }



{$IFDEF ASM_VERSION} //!!//!!

//[FUNCTION CallCtlWndProc]

function CallCtlWndProc( Ctl: PControl; var Msg: TMsg ): Integer;

begin

  Result := Ctl.WndProc( Msg );

end;

//[END CallCtlWndProc]



//[function WndFunc]

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



//set_self_prop:

        PUSH      ECX

          PUSH      ECX

          PUSH      Offset[ID_SELF]

          PUSH      EAX

          CALL      SetProp



          XOR       EAX, EAX

          MOV       [CreatingWindow], EAX

        POP       EAX                 // EAX = self_

        JMP       @@self_got



@@get_self_prop:

        PUSH      Offset[ID_SELF]

        PUSH      EAX

        CALL      GetProp

        TEST      EAX, EAX

        JNZ       @@self_got



@@self_is_nil:

        OR        EAX, [ Applet ]

        JNZ       @@self_got



//try_defwndproc:

        POP       EDI

        POP       ESI

        MOV       ESP, EBP

        POP       EBP

        JMP       DefWindowProc



//@@id_self:

//        DB        'SELF_',0



@@self_got:

        MOV       EDX, EDI

        //CALL      TControl.WndProc

        CALL      CallCtlWndProc



        POP       EDI

        POP       ESI



        MOV       ESP, EBP

end;

{$ELSE ASM_VERSION} //Pascal

function WndFunc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer )

                                   : Integer; stdcall;

var M: TMsg;

    self_: PControl;

begin

   M.hwnd := W;

   M.message := Msg;

   M.wParam := wParam;

   M.lParam := lParam;



   {$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 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;

        SetProp( W, ID_SELF, THandle( CreatingWindow ) );

        CreatingWindow := nil;

     end

        else

     self_ := Pointer( GetProp( W, ID_SELF ) );

   end;



   if self_ <> nil then

      Result := self_.WndProc( M )

   else

   if Assigned( Applet ) 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}

end;

//[END WndFunc]

{$ENDIF ASM_VERSION}



var

  IdleHandlers: PList;

  ProcessIdle: procedure ( Sender: PObj ) = DummyObjProc;



//[procedure ProcessIdleProc]

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]

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;

//[END FindIdleHandler]



//[procedure RegisterIdleHandler]

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]

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;



//[procedure TerminateExecution]

procedure TerminateExecution( var AppletWnd: 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;

    AppletWnd := nil;

    App.Free;

    App.RefDec;

  end;

end;



//[PROCEDURE CallTControlCreateWindow]

{$IFDEF ASM_VERSION}

procedure CallTControlCreateWindow( Ctl: PControl );

begin

  Ctl.CreateWindow;

end;

//[END CallTControlCreateWindow]



//[PROCEDURE Run]

procedure Run( var AppletWnd: PControl );

asm

        PUSH      EBX

        XCHG      EBX, EAX



        INC       [AppletRunning]

        MOV       EAX, [EBX]

        MOV       [Applet], EAX

        CALL      CallTControlCreateWindow

        JMP       @@2

@@1:

        CALL      WaitMessage

        MOV       EAX, [EBX]

        CALL      TControl.ProcessMessages

        {$IFNDEF NOT_USE_OnIdle}

        MOV       EAX, [EBX]

        CALL      [ProcessIdle]

        {$ENDIF}

@@2:

        CMP       [AppletTerminated],0

        JZ        @@1



        XCHG      EAX, EBX



        POP       EBX

        TEST      EAX, EAX

        JNZ       TerminateExecution

end;

{$ELSE ASM_VERSION} //Pascal

procedure Run( var AppletWnd: PControl );

begin

  AppletRunning := True;

  Applet := AppletWnd;

  AppletWnd.CreateWindow; //virtual!!!

  while not AppletTerminated do

  begin

    WaitMessage;

    AppletWnd.ProcessMessages;

    {$IFNDEF NOT_USE_OnIdle}

    ProcessIdle( AppletWnd );

    {$ENDIF}

  end;

  if AppletWnd <> nil then

    TerminateExecution( AppletWnd );

end;

//[END Run]

{$ENDIF ASM_VERSION}



//[procedure AppletMinimize]

procedure AppletMinimize;

begin

  if Applet = nil then Exit;

  Applet.Perform( WM_SYSCOMMAND, SC_MINIMIZE, 0 );

end;



//[procedure AppletHide]

procedure AppletHide;

begin

  if Applet = nil then Exit;

  AppletMinimize;

  Applet.Hide;

end;



//[procedure AppletRestore]

procedure AppletRestore;

begin

  if Applet = nil then Exit;

  Applet.Show;

  Applet.Perform( WM_SYSCOMMAND, SC_RESTORE, 0 );

end;



//[function ScreenWidth]

function ScreenWidth: Integer;

begin

  Result := GetSystemMetrics( SM_CXSCREEN );

end;

//[END ScreenWidth]



//[function ScreenHeight]

function ScreenHeight: Integer;

begin

  Result := GetSystemMetrics( SM_CYSCREEN );

end;

//[END ScreenHeight]















{$IFDEF USE_CONSTRUCTORS}

  {$DEFINE WNDPROCAPP_USED}

  {$DEFINE WNDPROCAPP_ASM_USED}

{$ENDIF USE_CONSTRUCTORS}

{$IFNDEF ASM_VERSION}

  {$DEFINE WNDPROCAPP_USED}

{$ENDIF  ASM_VERSION}



  {$DEFINE WNDPROCAPP_USED}







{$IFNDEF WNDPROCAPP_USED}

//[WndProcXXX FORWARD DECLARATIONS]

  {$IFNDEF ASM_VERSION}

function WndProcApp( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;

  {$ENDIF}

{$ENDIF}

function WndProcForm( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;

//function WndProcCtrl( 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 WndProcParentResize(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward;

//function WndProcResize(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;

//[END OF WndProcXXX FORWARD DECLARATIONS]



























{ -- Graphics support -- }



//[function _NewGraphicTool]

function _NewGraphicTool: PGraphicTool;

begin

  {-}

  New( Result, Create );

  {+}

  {++}(*Result := PGraphicTool.Create;*){--}

end;

//[END _NewGraphicTool]



//[FUNCTION SimpleGetCtlBrushHandle]

{$IFDEF ASM_VERSION}

function SimpleGetCtlBrushHandle( Sender: PControl ): HBrush;

asm     //        //

@@1:    MOV       ECX, [EAX].TControl.fParent

        JECXZ     @@2

        MOV       EDX, [EAX].TControl.fColor

        CMP       EDX, [ECX].TControl.fColor

        XCHG      EAX, ECX

        JE        @@1

        XCHG      EAX, ECX

@@2:    PUSH      EBX

        XCHG      EBX, EAX

        MOV       ECX, [EBX].TControl.fTmpBrush

        JECXZ     @@3

        MOV       EAX, [EBX].TControl.fColor

        CALL      Color2RGB

        CMP       EAX, [EBX].TControl.fTmpBrushColorRGB

        JE        @@3

        XOR       EAX, EAX

        XCHG      [EBX].TControl.fTmpBrush, EAX

        PUSH      EAX

        CALL      DeleteObject

@@3:    MOV       EAX, [EBX].TControl.fTmpBrush

        TEST      EAX, EAX

        JNE       @@4

        MOV       EAX, [EBX].TControl.fColor

        CALL      Color2RGB

        MOV       [EBX].TControl.fTmpBrushColorRGB, EAX

        PUSH      EAX

        CALL      CreateSolidBrush

        MOV       [EBX].TControl.fTmpBrush, EAX

@@4:    POP       EBX

end;

{$ELSE ASM_VERSION PAS_VERSION}

function SimpleGetCtlBrushHandle( Sender: PControl ): HBrush;

begin

  if (Sender.fParent <> nil) and (Sender.fColor = Sender.fParent.fColor) then

    Result := SimpleGetCtlBrushHandle( Sender.fParent )

  else

  begin

    if (Sender.fTmpBrush <> 0) and

       (Color2RGB( Sender.fColor ) <> Sender.fTmpBrushColorRGB) then

    begin

      DeleteObject( Sender.fTmpBrush );

      Sender.fTmpBrush := 0;

    end;

    if Sender.fTmpBrush = 0 then

    begin

      Sender.fTmpBrushColorRGB := Color2RGB( Sender.fColor );

      Sender.fTmpBrush := CreateSolidBrush( Sender.fTmpBrushColorRGB );

    end;

    Result := Sender.fTmpBrush;

  end;

end;

{$ENDIF ASM_VERSION}

//[END SimpleGetCtlBrushHandle]



//[function NormalGetCtlBrushHandle]

function NormalGetCtlBrushHandle( Sender: PControl ): HBrush;

begin

  if (Sender.fParent <> nil) then

    Sender.Brush.fParentGDITool := Sender.fParent.Brush;

  {if (Sender.Brush.fHandle <> 0) and

     (Color2RGB( Sender.fBrush.fData.Color ) <> Sender.fBrush.fColorRGB) then

    DeleteObject( Sender.Brush.ReleaseHandle );}

  Result := Sender.Brush.Handle;

end;

//[END NormalGetCtlBrushHandle]



{++}(*

//[API CreateFontIndirect]

function CreateFontIndirect(const p1: TLogFont): HFONT; stdcall;

external gdi32 name 'CreateFontIndirectA';

*){--}

//[MakeXXXHandle FORWARD DECLARATIONS]

function MakeFontHandle( Self_: PGraphicTool ): THandle; forward;

function MakeBrushHandle( Self_: PGraphicTool ): THandle; forward;

function MakePenHandle( Self_: PGraphicTool ): THandle; forward;

function MakeGeometricPenHandle( Self_: PGraphicTool ): THandle; forward;

//[END OF MakeXXXHandle FORWARD DECLARATIONS]



//[FUNCTION NewBrush]

{$IFDEF ASM_VERSION}

function NewBrush: PGraphicTool;

asm

        MOV      [Global_GetCtlBrushHandle], offset NormalGetCtlBrushHandle  

        CALL     _NewGraphicTool

        MOV      [EAX].TGraphicTool.fNewProc, offset[NewBrush]

        MOV      [EAX].TGraphicTool.fType, gttBrush

        MOV      [EAX].TGraphicTool.fMakeHandleProc, offset[MakeBrushHandle]

        MOV      [EAX].TGraphicTool.fData.Color, clBtnFace

end;

{$ELSE ASM_VERSION} //Pascal

function NewBrush: PGraphicTool;

begin

  Global_GetCtlBrushHandle := NormalGetCtlBrushHandle;

  Result := _NewGraphicTool;

  with Result {-}^{+} do

  begin

    fNewProc := @ NewBrush;

    fType := gttBrush;

    fMakeHandleProc := @ MakeBrushHandle;

    Result.fData.Color := clBtnFace;

    //Result.fData.Brush.Style := bsSolid;

  end;

end;

{$ENDIF ASM_VERSION}

//[END NewBrush]



const size_FontData = sizeof( Integer {fFontHeight} ) + sizeof( Integer {fFontWidth} ) +

                      sizeof( TFontPitch ) +  sizeof( TFontStyle ) +

                      sizeof( Integer {fFontOrientation} ) +

                      sizeof( Integer {fFontWeight} ) + sizeof( TFontCharset ) +

                      sizeof( TFontQuality );



//[FUNCTION NewFont]

{$IFDEF ASM_VERSION}

function NewFont: PGraphicTool;

const FontDtSz = sizeof( TGDIFont );

asm

        CALL     _NewGraphicTool

        MOV      [EAX].TGraphicTool.fNewProc, offset[NewFont]

        MOV      [EAX].TGraphicTool.fType, gttFont

        MOV      [EAX].TGraphicTool.fMakeHandleProc, offset[MakeFontHandle]

        MOV      EDX, [DefFontColor]

        MOV      [EAX].TGraphicTool.fData.Color, EDX



        PUSH     EAX

        LEA      EDX, [EAX].TGraphicTool.fData.Font

        MOV      EAX, offset[ DefFont ]

        XOR      ECX, ECX

        MOV      CL, FontDtSz

        CALL     System.Move

        POP      EAX

end;

{$ELSE ASM_VERSION} //Pascal

function NewFont: PGraphicTool;

begin

  Result := _NewGraphicTool;

  with Result {-}^{+} do

  begin

    fNewProc := @ NewFont;

    fType := gttFont;

    fMakeHandleProc := @ MakeFontHandle;

    fData.Color := DefFontColor;

    Move( DefFont, fData.Font, Sizeof( TGDIFont ) );

  end;

end;

{$ENDIF ASM_VERSION}

//[END NewFont]



//[FUNCTION NewPen]

{$IFDEF ASM_VERSION}

function NewPen: PGraphicTool;

asm

        CALL     _NewGraphicTool

        MOV      [EAX].TGraphicTool.fNewProc, offset[NewPen]

        MOV      [EAX].TGraphicTool.fType, gttPen

        MOV      [EAX].TGraphicTool.fMakeHandleProc, offset[MakePenHandle]

        MOV      [EAX].TGraphicTool.fData.Pen.Mode, pmCopy

end;

{$ELSE ASM_VERSION} //Pascal

function NewPen: PGraphicTool;

begin

  Result := _NewGraphicTool;

  with Result{-}^{+} do

  begin

    fNewProc := @ NewPen;

    fType := gttPen;

    fMakeHandleProc := @ MakePenHandle;

    fData.Pen.Mode := pmCopy;

  end;

end;

{$ENDIF ASM_VERSION}

//[END NewPen]



//+

//[function Color2RGB]

function Color2RGB( Color: TColor ): TColor;

begin

  if Color < 0 then

    Result := GetSysColor(Color and $FF) else

    Result := Color;

end;

//[END Color2RGB]



//[function ColorsMix]

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

   XCHG EAX, [ESP]

   CALL Color2Rgb

   POP EDX

   AND EAX, 0FEFEFEh

   AND EDX, 0FEFEFEh

   SHR EAX, 1

   SHR EDX, 1

   ADD EAX, EDX

end;

{$ENDIF F_P/DELPHI}

//[END ColorsMix]



//[FUNCTION Color2RGBQuad]

{$IFDEF ASM_VERSION}

function Color2RGBQuad( Color: TColor ): TRGBQuad;

asm

        CALL     Color2RGB

        // code by bart:

        xchg    ah,al                   // xxRRGGBB

        ror     eax,16                  // BBGGxxRR

        xchg    ah,al                   // BBGGRRxx

        shr     eax,8                   // 00BBGGRR

end;

{$ELSE ASM_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 ASM_VERSION}

//[END Color2RGBQuad]



//[FUNCTION Color2Color16]

{$IFDEF ASM_VERSION}

function Color2Color16( Color: TColor ): WORD;

asm

  MOV  EDX, EAX

  SHR  EDX, 19

  AND  EDX, $1F

  MOV  ECX, EAX

  SHR  ECX, 5

  AND  ECX, $7E0;

  MOV  AH, AL

  AND  EAX, $F800

  OR   EAX, EDX

  OR   EAX, ECX

end;

{$ELSE ASM_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 ASM_VERSION}

//[END Color2Color16]



{ TGraphicTool }



{$IFDEF ASM_VERSION}

//[function TGraphicTool.Assign]

function TGraphicTool.Assign(Value: PGraphicTool): PGraphicTool;

const SzfData = sizeof( fData );

asm     //        //

        TEST      EDX, EDX

        JNZ       @@1

        TEST      EAX, EAX

        JZ        @@0

        CALL      TObj.DoDestroy

        XOR       EAX, EAX

@@0:    RET

@@1:    PUSH      EDI

        MOV       EDI, EDX

        TEST      EAX, EAX

        JNZ       @@2

        XCHG      EAX, EDX

        CALL      dword ptr[EAX].TGraphicTool.fNewProc

@@2:    CMP       EAX, EDI

        JE        @@exit

        PUSH      EBX

        XCHG      EBX, EAX



        MOV       ECX, [EBX].TGraphicTool.fHandle

        JECXZ     @@3

        CMP       ECX, [EDI].TGraphicTool.fHandle

        JE        @@exit1

@@3:

        MOV       EAX, EBX

        CALL      TGraphicTool.Changed

        LEA       EDX, [EBX].TGraphicTool.fData

        LEA       EAX, [EDI].TGraphicTool.fData

        MOV       ECX, SzfData

        CALL      System.Move

        MOV       EAX, EBX

        CALL      TGraphicTool.Changed



@@exit1:

        XCHG      EAX, EBX

        POP       EBX

@@exit: POP       EDI

end;

{$ELSE ASM_VERSION}

function TGraphicTool.Assign(Value: PGraphicTool): PGraphicTool;

var _Self: PGraphicTool;

begin

  Result := nil;

  if Value = nil then

  begin

    if @Self <> nil then

       DoDestroy;

    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

  if _Self.fHandle <> 0 then

     if Value.fHandle = _Self.fHandle then Exit;

  _Self.Changed; // to destroy handle if allocated and release it from the canvas (if any uses it)

  Assert( Value.fType = _Self.fType, 'Attempt to assign to different GDI tool type' );

  Move( Value.fData, _Self.fData, Sizeof( fData ) );

  _Self.Changed; // to inform owner control, that its tool (font, brush) changed

end;

{$ENDIF ASM_VERSION}



//[procedure TGraphicTool.AssignHandle]

procedure TGraphicTool.AssignHandle(NewHandle: Integer);

begin

  //------------ by Yury Sidorov --------

  //Changed;

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

  if fHandle <> 0 then                   //

    DeleteObject( fHandle );             //

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

  fHandle := NewHandle;

  GetObject( fHandle, Sizeof( TGDIFont ), @ fData.Font );

  Changed;

end;



{$IFDEF ASM_VERSION}

//[procedure TGraphicTool.Changed]

procedure TGraphicTool.Changed;

asm

        XOR      ECX, ECX

        XCHG     ECX, [EAX].fHandle

        JECXZ    @@exit

        PUSH     EAX

        PUSH     ECX



        CALL     @@CallOnChange



        CALL     DeleteObject

        POP      EAX

@@exit:



@@CallOnChange:

        MOV      ECX, [EAX].fOnChange.TMethod.Code

        JECXZ    @@no_onChange

        PUSH     EAX

        XCHG     EDX, EAX

        MOV      EAX, [EDX].fOnChange.TMethod.Data

        CALL     ECX

        POP      EAX

@@no_onChange:

end;

{$ELSE ASM_VERSION} //Pascal

procedure TGraphicTool.Changed;

var H: THandle;

begin

   if fHandle <> 0 then

   begin

     H := fHandle;

     fHandle := 0;

     ////////////////////////////////

     if Assigned( fOnChange ) then

        fOnChange( @Self );

     ////////////////////////////////

     DeleteObject( H );

      {$IFDEF DEBUG_GDIOBJECTS}

      case fType of

      gttBrush:  Dec( BrushCount );

      gttFont:   Dec( FontCount );

      gttPen:    Dec( PenCount );

      end;

      {$ENDIF}

   end;

   //////////////////////////////////

   if Assigned( fOnChange ) then

      fOnChange( @Self );

   //////////////////////////////////

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[destructor TGraphicTool.Destroy]

destructor TGraphicTool.Destroy;

asm

          PUSH      EAX

          CMP       [EAX].fType, gttFont

          JE        @@0

          MOV       ECX, [EAX].fData.Brush.Bitmap

          JECXZ     @@0

          PUSH      ECX

          CALL      DeleteObject

          POP       EAX

          PUSH      EAX

@@0:

        MOV       ECX, [EAX].fHandle

        JECXZ     @@1

        PUSH      ECX

        CALL      DeleteObject

@@1:

          POP       EAX

          CALL      TObj.Destroy

end;

{$ELSE ASM_VERSION} //Pascal

destructor TGraphicTool.Destroy;

begin

  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;

  inherited;

end;

{$ENDIF ASM_VERSION}



//[function TGraphicTool.HandleAllocated]

function TGraphicTool.HandleAllocated: Boolean;

begin

  Result := fHandle <> 0;

end;



{$IFDEF ASM_VERSION}

//[function TGraphicTool.ReleaseHandle]

function TGraphicTool.ReleaseHandle: Integer;

asm     //        //

        PUSH      EAX

        CALL      Changed

        POP       EDX

        XOR       EAX, EAX

        XCHG      [EDX].fHandle, EAX  

end;

{$ELSE ASM_VERSION PAS_VERSION}

function TGraphicTool.ReleaseHandle: Integer;

begin

  Changed;

  Result := fHandle;

  fHandle := 0;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TGraphicTool.SetInt]

procedure TGraphicTool.SetInt( const Index: Integer; Value: Integer );

asm

        LEA    EDX, [EDX+EAX].fData

        CMP    [EDX], ECX

        JE     @@exit

        MOV    [EDX], ECX

        CALL   Changed

@@exit:

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF F_P}

//[function TGraphicTool.GetInt]

function TGraphicTool.GetInt(const Index: Integer): Integer;

var Where: PInteger;

begin

  Where := Pointer( Integer( @ fData ) + Index );

  Result := Where^;

end;

{$ENDIF}



//[procedure TGraphicTool.SetColor]

procedure TGraphicTool.SetColor( Value: TColor );

begin

  SetInt( go_Color, Value );

  fColorRGB := Color2RGB( Value );

end;



{$IFDEF ASM_VERSION}

//[function TGraphicTool.IsFontTrueType]

function TGraphicTool.IsFontTrueType: Boolean;

asm

        CALL     GetHandle

        TEST     EAX, EAX

        JZ       @@exit



        PUSH     EBX



        PUSH     EAX                  // fHandle



        PUSH     0

        CALL     GetDC



        PUSH     EAX                  // DC

        MOV      EBX, EAX

        CALL     SelectObject

        PUSH     EAX



        XOR      ECX, ECX

        PUSH     ECX

        PUSH     ECX

        PUSH     ECX

        PUSH     ECX

        PUSH     EBX

        CALL     GetFontData



        XCHG     EAX, [ESP]



        PUSH     EAX

        PUSH     EBX

        CALL     SelectObject



        PUSH     EBX

        PUSH     0

        CALL     ReleaseDC



        POP      EAX

        INC      EAX

        SETNZ    AL



        POP      EBX

@@exit:

end;

{$ELSE ASM_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 ASM_VERSION}



//[procedure TGraphicTool.SetBrushBitmap]

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;



//[procedure TGraphicTool.SetBrushStyle]

procedure TGraphicTool.SetBrushStyle(const Value: TBrushStyle);

begin

  if fData.Brush.Style = Value then Exit;

  fData.Brush.Style := Value;

  Changed;

end;



//[procedure TGraphicTool.SetFontCharset]

procedure TGraphicTool.SetFontCharset(const Value: TFontCharset);

begin

  if fData.Font.Charset = Value then Exit;

  fData.Font.Charset := Value;

  Changed;

end;



//[procedure TGraphicTool.SetFontQuality]

procedure TGraphicTool.SetFontQuality(const Value: TFontQuality);

begin

  if fData.Font.Quality = Value then Exit;

  fData.Font.Quality := Value;

  Changed;

end;



//[function TGraphicTool.GetFontName]

function TGraphicTool.GetFontName: String;

begin

  Result := fData.Font.Name;

end;



//[procedure TGraphicTool.SetFontName]

procedure TGraphicTool.SetFontName(const Value: String);

begin

  if fData.Font.Name = Value then Exit;

  FillChar( fData.Font.Name[ 0 ], LF_FACESIZE, 0 );

  StrLCopy( fData.Font.Name, PChar( Value ), LF_FACESIZE );

  Changed;

end;



{$IFDEF ASM_VERSION}

//[procedure TextAreaEx]

procedure TextAreaEx( Sender: PCanvas; var Sz : TSize; var Pt : TPoint );

asm

        PUSH     EBX

        PUSH     ESI

        PUSH     EDI

        PUSH     EBP

        MOV      EBP, ESP

        PUSH     EDX // [EBP-4] = @Sz

        PUSH     ECX // [EBP-8] = @Pt

        MOV      EBX, EAX

        CALL     TCanvas.GetFont

        MOV      ESI, [EAX].TGraphicTool.fData.Font.Orientation

        CALL     TGraphicTool.IsFontTrueType

        TEST     AL, AL

        JZ       @@exit



        MOV      EDI, [EBP-8]

        XOR      EAX, EAX

        STOSD

        STOSD

        TEST     ESI, ESI

        JZ       @@exit



        PUSH     EAX // Pts[1].x

        PUSH     EAX // Pts[1].y



        PUSH     ESI

        FILD     dword ptr [ESP]

        POP      EDX



        FILD     word ptr [@@1800]

        FDIV

        //FWAIT

        FLDPI

        FMUL

        //FWAIT



        FLD      ST(0)

        FSINCOS

        FWAIT



        MOV      ESI, [EBP-4]

        LODSD         // Sz.cx

        PUSH     EAX

        FILD     dword ptr [ESP]

        FMUL

        FISTP    dword ptr [ESP] // Pts[2].x

        FWAIT

        NEG      EAX

        PUSH     EAX

        FILD     dword ptr [ESP]

        FMUL

        FISTP    dword ptr [ESP] // Pts[2].y

        FWAIT



        FLDPI

        FLD1

        FLD1

        FADD

        FDIV

        FADD

        FSINCOS

        FWAIT



        LODSD

        NEG      EAX

        PUSH     EAX

        FILD     dword ptr [ESP]

        FMUL

        FISTP    dword ptr [ESP] // Pts[4].x

        FWAIT

        NEG      EAX

        PUSH     EAX

        FILD     dword ptr [ESP]

        FMUL

        FISTP    dword ptr [ESP] // Pts[4].y

        FWAIT



        POP      ECX

        POP      EDX

        PUSH     EDX

        PUSH     ECX

        ADD      EDX, [ESP+12]

        ADD      ECX, [ESP+8]

        PUSH     EDX

        PUSH     ECX



        MOV      ESI, ESP

        XOR      EDX, EDX // MinX

        XOR      EDI, EDI // MinY

        XOR      ECX, ECX

        MOV      CL, 3



@@loo1: LODSD

        CMP      EAX, EDI

        JGE      @@1

        XCHG     EDI, EAX

@@1:    LODSD

        CMP      EAX, EDX

        JGE      @@2

        XCHG     EDX, EAX

@@2:    LOOP     @@loo1



        MOV      ESI, [EBP-4]

        MOV      [ESI], ECX

        MOV      [ESI+4], ECX

        MOV      CL, 4

@@loo2:

        POP      EBX

        SUB      EBX, EDI

        CMP      EBX, [ESI+4]

        JLE      @@3

        MOV      [ESI+4], EBX

@@3:

        POP      EAX

        SUB      EAX, EDX

        CMP      EAX, [ESI]

        JLE      @@4

        MOV      [ESI], EAX

@@4:

        LOOP     @@loo2



        MOV      EDI, [EBP-8]

        STOSD

        XCHG     EAX, EBX

        STOSD

        JMP      @@exit



@@1800: DW  1800



@@exit:

        MOV      ESP, EBP

        POP      EBP

        POP      EDI

        POP      ESI

        POP      EBX

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TGraphicTool.SetFontOrientation]

procedure TGraphicTool.SetFontOrientation(Value: Integer);

asm

        PUSH     EAX

@@1:    MOV      EAX, EDX

        MOV      ECX, 3600

        CDQ

        IDIV     ECX     // EDX = Value mod 3600

        POP      EAX



        MOV      byte ptr [GlobalGraphics_UseFontOrient], 1

        MOV      [GlobalCanvas_OnTextArea], offset[TextAreaEx]



        MOV      [EAX].fData.Font.Escapement, EDX

        MOV      ECX, EDX

        MOV      DX, go_FontOrientation

        CALL     SetInt

end;

{$ELSE ASM_VERSION} //Pascal

procedure TGraphicTool.SetFontOrientation(Value: Integer);

begin

  GlobalGraphics_UseFontOrient := True;

  GlobalCanvas_OnTextArea := TextAreaEx;

  Value := Value mod 3600; // -3599..+3599

  SetInt( go_FontOrientation, Value );

  SetInt( go_FontEscapement, Value );

end;

{$ENDIF ASM_VERSION}



//[procedure TGraphicTool.SetFontPitch]

procedure TGraphicTool.SetFontPitch(const Value: TFontPitch);

begin

  if fData.Font.Pitch = Value then Exit;

  fData.Font.Pitch := Value;

  Changed;

end;



{$IFDEF ASM_VERSION}

//[function TGraphicTool.GetFontStyle]

function TGraphicTool.GetFontStyle: TFontStyle;

asm

       MOV   EDX, dword ptr [EAX].fData.Font.Italic

       AND   EDX, $010101

       MOV   EAX, [EAX].fData.Font.Weight

       CMP   EAX, 700

       SETGE AL       //AL:1 = fsBold

       ADD   EDX, EDX

       OR    EAX, EDX //AL:2 = fsItalic

       SHR   EDX, 7

       OR    EAX, EDX //AL:3 = fsUnderline

       SHR   EDX, 7

       OR    EAX, EDX //AL:4 = fsStrikeOut

end;

{$ELSE ASM_VERSION} //Pascal

function TGraphicTool.GetFontStyle: TFontStyle;

type PFontStyle = ^TFontStyle;

begin

  Result := [ ];

  if fData.Font.Weight >= 700 then Result := [ fsBold ];

  if fData.Font.Italic        then Result := Result + [ fsItalic ];

  if fData.Font.Underline     then Result := Result + [ fsUnderline ];

  if fData.Font.StrikeOut     then Result := Result + [ fsStrikeOut ];

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TGraphicTool.SetFontStyle]

procedure TGraphicTool.SetFontStyle(const Value: TFontStyle);

asm

        PUSH     EDI

        MOV      EDI, EAX

        PUSH     EDX

        CALL     GetFontStyle

        POP      EDX

        CMP      AL, DL

        JE       @@exit

        PUSH     EDI



        LEA      EDI, [EDI].fData.Font.Weight

        MOV      ECX, [EDI]

        SHR      EDX, 1

        JNC      @@1

        CMP      ECX, 700

        JGE      @@2

        MOV      ECX, 700

        JMP      @@2

@@1:    CMP      ECX, 700

        JL       @@2

        XOR      ECX, ECX

@@2:    XCHG     EAX, ECX

        STOSD    // change Weight

        SHR      EDX, 1

        SETC     AL

        STOSB    // change Italic

        SHR      EDX, 1

        SETC     AL

        STOSB    // change Underline

        SHR      EDX, 1

        SETC     AL

        STOSB    // change StrikeOut

        POP      EAX

        CALL     Changed

@@exit: POP      EDI

end;

{$ELSE ASM_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 ASM_VERSION}



//[procedure TGraphicTool.SetPenMode]

procedure TGraphicTool.SetPenMode(const Value: TPenMode);

begin

  if fData.Pen.Mode = Value then Exit;

  fData.Pen.Mode := Value;

  Changed;

end;



//[procedure TGraphicTool.SetPenStyle]

procedure TGraphicTool.SetPenStyle(const Value: TPenStyle);

begin

  if fData.Pen.Style = Value then Exit;

  fData.Pen.Style := Value;

  Changed;

end;



{$IFDEF ASM_VERSION}

//[function TGraphicTool.GetHandle]

function TGraphicTool.GetHandle: THandle;

const DataSz = sizeof( TGDIToolData );

asm

        PUSH      EBX

@@start:

        XCHG      EBX, EAX

        MOV       ECX, [EBX].fHandle

        JECXZ     @@1



        MOV       EAX, [EBX].fData.Color

        CALL      Color2RGB

        CMP       EAX, [EBX].fColorRGB

        JE        @@1



        MOV       EAX, EBX

        CALL      ReleaseHandle

        PUSH      EAX

        CALL      DeleteObject



@@1:    MOV       ECX, [EBX].fHandle

        INC       ECX

        LOOP      @@exit



        MOV       ECX, [EBX].fParentGDITool

        JECXZ     @@2

        LEA       EDX, [ECX].fData

        LEA       EAX, [EBX].fData

        MOV       ECX, DataSz

        CALL      CompareMem

        TEST      AL, AL

        MOV       EAX, [EBX].fParentGDITool

        JNZ       @@start



@@2:    MOV       ECX, [EBX].fHandle

        INC       ECX

        LOOP      @@exit



        MOV       EAX, [EBX].fData.Color

        CALL      Color2RGB

        MOV       [EBX].fColorRGB, EAX

        XCHG      EAX, EBX

        CALL      dword ptr [EAX].fMakeHandleProc

        XCHG      ECX, EAX



@@exit: XCHG      EAX, ECX

        POP       EBX

end;

{$ELSE ASM_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 Assigned( fParentGDITool ) then

    begin

      if CompareMem( @ fData, @ fParentGDITool.fData, Sizeof( fData ) ) then

      begin

        Result := fParentGDITool.Handle;

        Exit;

      end;

    end;



    if fHandle = 0 then

    begin

      fColorRGB := Color2RGB( fData.Color );

      fMakeHandleProc( @Self );

    end;

    Result := fHandle;

  end;

end;

{$ENDIF ASM_VERSION}



//[FUNCTION MakeBrushHandle]

{$IFDEF ASM_VERSION}

function MakeBrushHandle( Self_: PGraphicTool ): THandle;

asm

        PUSH     EBX

        XCHG     EBX, EAX

        MOV      EAX, [EBX].TGraphicTool.fHandle

        TEST     EAX, EAX

        JNZ      @@exit



        MOV      EAX, [EBX].TGraphicTool.fData.Color

        CALL     Color2RGB   // EAX = ColorRef



        XOR      EDX, EDX



        MOV      ECX, [EBX].TGraphicTool.fData.Brush.Bitmap

        PUSH     ECX

        JECXZ    @@1



        MOV      DL, BS_PATTERN

        JMP      @@2



@@1:

        MOV      CL, [EBX].TGraphicTool.fData.Brush.Style

        MOV      DL, CL

        SUB      CL, 2

        JL       @@2



        XCHG     ECX, [ESP]



@@2:    PUSH     EAX

        PUSH     EDX



        PUSH     ESP

        CALL     CreateBrushIndirect

        MOV      [EBX].TGraphicTool.fHandle, EAX



        ADD      ESP, 12



@@exit:

        POP      EBX

end;

{$ELSE ASM_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;

  //GlobalGraphics_OnObjectCreated( @Self );

  Result := Self_.fHandle;

end;

{$ENDIF ASM_VERSION}

//[END MakeBrushHandle]



//[FUNCTION MakeFontHandle]

{$IFDEF ASM_VERSION}

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 ASM_VERSION} //Pascal

function MakeFontHandle( Self_: PGraphicTool ): THandle;

//var LogFont: TLogFont;

begin

  with Self_{-}^{+} do

  begin

    if fHandle = 0 then

    begin

      fHandle := CreateFontIndirect( PLogFont( @ fData.Font )^ );

      {$IFDEF DEBUG_GDIOBJECTS}

      Inc( FontCount );

      {$ENDIF}

    end;

    Result := fHandle;

  end;

end;

{$ENDIF ASM_VERSION}

//[END MakeFontHandle]



//[FUNCTION MakePenHandle]

{$IFDEF ASM_VERSION}

function MakePenHandle( Self_: PGraphicTool ): THandle;

asm

        PUSH     EBX

        MOV      EBX, EAX



        MOV      EAX, [EBX].TGraphicTool.fHandle

        TEST     EAX, EAX

        JNZ      @@exit



        MOV      EAX, [EBX].TGraphicTool.fData.Color

        CALL     Color2RGB

        PUSH     EAX

        PUSH     EAX

        PUSH     [EBX].TGraphicTool.fData.Pen.Width

        MOVZX    EAX, [EBX].TGraphicTool.fData.Pen.Style

        PUSH     EAX

        PUSH     ESP

        CALL     CreatePenIndirect

        MOV      [EBX].TGraphicTool.fHandle, EAX

        ADD      ESP, 16

@@exit:

        POP      EBX

end;

{$ELSE ASM_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 ASM_VERSION}

//[END MakePenHandle]



//+

//[procedure TGraphicTool.SetGeometricPen]

procedure TGraphicTool.SetGeometricPen(const Value: Boolean);

begin

  if fData.Pen.Geometric = Value then Exit;

  fData.Pen.Geometric := Value;

  fMakeHandleProc := MakeGeometricPenHandle;

  Changed;

end;



//[procedure TGraphicTool.SetPenEndCap]

procedure TGraphicTool.SetPenEndCap(const Value: TPenEndCap);

begin

  if fData.Pen.EndCap = Value then Exit;

  fData.Pen.EndCap := Value;

  Changed;

end;



//[procedure TGraphicTool.SetPenJoin]

procedure TGraphicTool.SetPenJoin(const Value: TPenJoin);

begin

  if fData.Pen.Join = Value then Exit;

  fData.Pen.Join := Value;

  Changed;

end;



//[FUNCTION MakeGeometricPenHandle]

{$IFDEF ASM_VERSION}

function MakeGeometricPenHandle( Self_: PGraphicTool ): THandle;

asm

        MOV      ECX, [EAX].TGraphicTool.fHandle

        INC      ECX

        LOOP     @@exit



        PUSH     EBX

        XCHG     EBX, EAX

        MOV      EAX, [EBX].TGraphicTool.fData.Color

        CALL     Color2RGB // EAX = Color2RGB( fColor )

        CDQ                // EDX = lbHatch (0)

        MOV      ECX, [EBX].TGraphicTool.fData.Pen.BrushBitmap

        JECXZ    @@no_brush_bitmap



        XCHG     EDX, ECX // lbHatch = fPenBrushBitmap

        MOV      CL, BS_PATTERN // = 3

        JMP      @@create_pen



@@no_brush_bitmap:

        MOVZX    ECX, [EBX].TGraphicTool.fData.Pen.BrushStyle

        CMP      CL, 1

        JLE      @@create_pen

        MOV      EDX, ECX

        MOV      CL, 2

        SUB      EDX, ECX



@@create_pen:

        PUSH     EDX

        PUSH     EAX

        PUSH     ECX

        MOV      ECX, ESP



        CDQ

        PUSH     EDX

        PUSH     EDX

        PUSH     ECX

        PUSH     [EBX].TGraphicTool.fData.Pen.Width

        MOVZX    ECX, [EBX].TGraphicTool.fData.Pen.Join

        SHL      ECX, 12

        MOVZX    EDX, [EBX].TGraphicTool.fData.Pen.EndCap

        SHL      EDX, 8

        OR       EDX, ECX

        OR       DL, byte ptr [EBX].TGraphicTool.fData.Pen.Style

        OR       EDX, PS_GEOMETRIC

        PUSH     EDX

        CALL     ExtCreatePen



        POP      ECX

        POP      ECX

        POP      ECX



        MOV      [EBX].TGraphicTool.fHandle, EAX

        POP      EBX

        RET

@@exit:

        XCHG     EAX, ECX

end;

{$ELSE ASM_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  begin

               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;

  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 ASM_VERSION}

//[END MakeGeometricPenHandle]



//[procedure TGraphicTool.SetFontWeight]

procedure TGraphicTool.SetFontWeight(const Value: Integer);

begin

  if fData.Font.Weight = Value then Exit;

  fData.Font.Weight := Value;

  Changed;

end;



//[procedure TGraphicTool.SetLogFontStruct]

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]

function TGraphicTool.GetLogFontStruct: TLogFont;

begin

  Move(fData.Font, Result, SizeOf(TLogFont));

end;

























{ TCanvas }



type

  TStock = Packed Record

    StockPen: HPEN;

    StockBrush: HBRUSH;

    StockFont: HFONT;

  end;



var

  Stock: TStock;



//[destructor TCanvas.Destroy]

destructor TCanvas.Destroy;

begin

  Handle := 0;

  fPen.Free;

  fBrush.Free;

  fFont.Free;

  //if Assigned( GlobalCanvas_OnDestroyCanvas ) then

  //   GlobalCanvas_OnDestroyCanvas( Self );

  inherited;

end;



{$IFDEF ASM_VERSION}

//[function TCanvas.Assign]

function TCanvas.Assign(SrcCanvas: PCanvas): Boolean;

asm

        PUSH     EBX

        PUSH     ESI

        XCHG     EBX, EAX

        MOV      ESI, EDX



        MOV      EAX, [EBX].fFont

        MOV      EDX, [ESI].fFont

        CALL     TGraphicTool.Assign

        MOV      [EBX].fFont, EAX



        MOV      EAX, [EBX].fBrush

        MOV      EDX, [ESI].fBrush

        CALL     TGraphicTool.Assign

        MOV      [EBX].fBrush, EAX



        MOV      EAX, [EBX].fPen

        MOV      EDX, [ESI].fPen

        CALL     TGraphicTool.Assign

        MOV      [EBX].fPen, EAX



        CALL     AssignChangeEvents



        MOV      ECX, [EBX].fFont

        OR       ECX, [EBX].fBrush

        OR       ECX, [EBX].fPen

        SETNZ    AL



        MOV      EDX, [ESI].fPenPos.x

        MOV      ECX, [ESI].fPenPos.y

        CMP      EDX, [EBX].fPenPos.x

        JNE      @@chg_penpos

        CMP      ECX, [EBX].fPenPos.y

        JE       @@1

@@chg_penpos:

        MOV      AL, 1

        MOV      [EBX].fPenPos.x, EDX

        MOV      [EBX].fPenPos.y, ECX

@@1:

        MOV       EDX, [ESI].fCopyMode

        CMP       EDX, [EBX].fCopyMode

        JE        @@2

        MOV       [EBX].fCopyMode, EDX

        MOV       AL, 1

@@2:

        POP       ESI

        POP       EBX

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.CreateBrush]

procedure TCanvas.CreateBrush;

asm

        PUSH     EBX

        MOV      EBX, EAX



        MOV      ECX, [EAX].fBrush

        JECXZ    @@chk_owner



        MOV      EAX, ECX

        CALL     TGraphicTool.GetHandle

        PUSH     EAX



        MOV      EAX, EBX

        CALL     AssignChangeEvents



        MOV      EAX, EBX

        CALL     TCanvas.GetHandle

        PUSH     EAX



        CALL     SelectObject



        MOV      EDX, [EBX].TCanvas.fBrush

        CMP      [EDX].TGraphicTool.fData.Brush.Style, bsSolid



        MOV      EAX, [EDX].TGraphicTool.fData.Color

@@0:

        MOV      EBX, [EBX].TCanvas.fHandle

        MOV      ECX, offset[Color2RGB]

        JNZ      @@1



        PUSH     OPAQUE

        PUSH     EBX



        CALL     ECX //Color2RGB

        PUSH     EAX

        PUSH     EBX

        JMP      @@2

@@1:

        PUSH     TRANSPARENT

        PUSH     EBX



        CALL     ECX //Color2RGB

        NOT      EAX

        PUSH     EAX

        PUSH     EBX

@@2:

        CALL     SetBkColor

        CALL     SetBkMode

@@exit:

        POP      EBX

        RET



@@chk_owner:

        MOV      ECX, [EBX].fOwnerControl

        JECXZ    @@exit



        MOV      EAX, [ECX].TControl.fColor

        XOR      ECX, ECX

        JMP      @@0

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.CreateBrush;

begin

  //UnrealizeObject( Brush.Handle );

  // if GdiObject parameter of UnrealizeObject is brush handle,

  // this call does nothing (from Win32.hlp)



  if assigned( fBrush ) then

  begin

    SelectObject( GetHandle, fBrush.Handle );

    //fBrush.fOnChange := ObjectChanged;

    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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.CreateFont]

procedure TCanvas.CreateFont;

asm

        PUSH     EBX

        MOV      EBX, EAX



        MOV      ECX, [EAX].TCanvas.fFont

        JECXZ    @@chk_owner



        MOV      EAX, [ECX].TGraphicTool.fData.Color

        PUSH     ECX

        CALL     Color2RGB

        XCHG     EAX, [ESP]



        CALL     TGraphicTool.GetHandle

        PUSH     EAX



        MOV      EAX, EBX

        CALL     AssignChangeEvents;



        MOV      EAX, EBX

        CALL     TCanvas.GetHandle

        PUSH     EAX

        MOV      EBX, EAX



        CALL     SelectObject



@@set_txcolor:

        PUSH     EBX

        CALL     SetTextColor



@@exit:

        POP      EBX

        RET



@@chk_owner:

        MOV      ECX, [EBX].fOwnerControl

        JECXZ    @@exit



        MOV      EBX, [EBX].fHandle

        MOV      EAX, [ECX].TControl.fTextColor

        CALL     Color2RGB

        PUSH     EAX

        JMP      @@set_txcolor

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.CreateFont;

begin

  if assigned( fFont ) then

  begin

    SelectObject( GetHandle, fFont.Handle );

    SetTextColor( fHandle, Color2RGB( fFont.fData.Color ) );

    //fFont.fOnChange := ObjectChanged;

    AssignChangeEvents;

  end

     else

  if Assigned( fOwnerControl ) then

  begin

    SetTextColor( fHandle, Color2RGB( PControl( fOwnerControl ).fTextColor ) );

  end;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.CreatePen]

procedure TCanvas.CreatePen;

asm

        MOV      ECX, [EAX].TCanvas.fPen

        JECXZ    @@exit



        PUSH     EBX

        MOV      EBX, EAX



        MOV      DL, [ECX].TGraphicTool.fData.Pen.Mode

        MOVZX    EDX, DL

        INC      EDX

        PUSH     EDX



        MOV      EAX, ECX

        CALL     TGraphicTool.GetHandle

        PUSH     EAX



        MOV      EAX, EBX

        CALL     AssignChangeEvents



        MOV      EAX, EBX

        CALL     TCanvas.GetHandle

        PUSH     EAX

        MOV      EBX, EAX



        CALL     SelectObject

        PUSH     EBX

        CALL     SetROP2



        POP      EBX

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.CreatePen;

begin

  if assigned( fPen ) then

  begin

    SelectObject( GetHandle, fPen.Handle );

    SetROP2( fHandle, Ord( fPen.fData.Pen.Mode ) + 1 );

    //fPen.fOnChange := ObjectChanged;

    AssignChangeEvents;

  end;

end;

{$ENDIF ASM_VERSION}



//[function TCanvas.GetPixels]

function TCanvas.GetPixels(X, Y: Integer): TColor;

begin

  RequiredState( HandleValid );

  Result := Windows.GetPixel(FHandle, X, Y);

end;



//[procedure TCanvas.SetPixels]

procedure TCanvas.SetPixels(X, Y: Integer; const Value: TColor);

begin

  Changing;

  RequiredState( HandleValid );

  Windows.SetPixel(FHandle, X, Y, Color2RGB( Value ));

end;



{$IFDEF ASM_VERSION}

//[procedure TCanvas.DeselectHandles]

procedure TCanvas.DeselectHandles;

asm

        PUSH     EBX

        PUSH     ESI

        PUSH     EDI

        LEA      EBX, [EAX].TCanvas.fState

        //CALL     TCanvas.GetHandle

        MOV      EAX, [EAX].TCanvas.fHandle

        TEST     EAX, EAX

        JZ       @@exit



        MOVZX    EDX, byte ptr[EBX]

        AND      DL, PenValid or BrushValid or FontValid

        JZ       @@exit



        PUSH     EAX

        LEA      EDI, [Stock]



        MOV      ECX, [EDI]

        INC      ECX

        LOOP     @@1



        MOV      ESI, offset[ GetStockObject ]



        PUSH     BLACK_PEN

        CALL     ESI

        STOSD



        PUSH     HOLLOW_BRUSH

        CALL     ESI

        STOSD



        PUSH     SYSTEM_FONT

        CALL     ESI

        STOSD



@@1:

        LEA      ESI, [Stock]

        POP      EDX



        LODSD

        PUSH     EAX

        PUSH     EDX



        LODSD

        PUSH     EAX

        PUSH     EDX



        LODSD

        PUSH     EAX

        PUSH     EDX



        MOV      ESI, offset[ SelectObject ]

        CALL     ESI

        CALL     ESI

        CALL     ESI



        AND      byte ptr [EBX], not( PenValid or BrushValid or FontValid )

@@exit:

        POP      EDI

        POP      ESI

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.DeselectHandles;

begin

   //if (GetHandle <> 0) and

   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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[function TCanvas.RequiredState]

function TCanvas.RequiredState(ReqState: DWORD): Integer; stdcall;

asm

        PUSH     EBX

        PUSH     ESI

        MOV      EBX, ReqState

        MOV      ESI, [EBP+8] //Self

        MOV      EAX, ESI

        TEST     BL, ChangingCanvas

        JZ       @@1

        CALL     Changing

@@1:    AND      BL, 0Fh



        TEST     BL, HandleValid

        JZ       @@2

        CALL     TCanvas.GetHandle

        TEST     EAX, EAX

        JZ       @@ret_0

@@2:

        MOV      AL, [ESI].TCanvas.fState

        NOT      EAX

        AND      BL, AL

        JZ       @@ret_handle



        TEST     BL, FontValid

        JZ       @@3

        MOV      EAX, ESI

        CALL     CreateFont

@@3:    TEST     BL, PenValid

        JZ       @@5

        MOV      EAX, ESI

        CALL     CreatePen

        MOV      ECX, [ESI].TCanvas.fPen

        JCXZ     @@5

        MOV      AL, [ECX].TGraphicTool.fData.Pen.Style

        DEC      AL

        {$IFDEF PARANOIA}

        DB $2C, 3

        {$ELSE}

        SUB      AL, 3

        {$ENDIF}

        JB       @@6

@@5:    TEST     BL, BrushValid

        JZ       @@7

@@6:    MOV      EAX, ESI

        CALL     CreateBrush

@@7:    OR       [ESI].TCanvas.fState, BL

@@ret_handle:

        MOV      EAX, [ESI].TCanvas.fHandle

@@ret_0:

        POP      ESI

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function TCanvas.RequiredState(ReqState: DWORD): Integer; 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 assigned( fPen ) 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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.SetHandle]

procedure TCanvas.SetHandle(Value: HDC);

asm

        PUSH     EBX

        MOV      EBX, EAX

        MOV      ECX, [EBX].fHandle

        CMP      ECX, EDX

        JZ       @@exit

        JECXZ    @@chk_val



        PUSH     EDX

        PUSH     ECX

          CALL     DeselectHandles

        POP      EDX



        MOV      ECX, [EBX].fOwnerControl

        JECXZ    @@chk_Release

        CMP      [ECX].TControl.fPaintDC, EDX

        JE       @@clr_Handle



@@chk_Release:

        PUSH     EDX

        CMP      [EBX].fOnGetHandle.TMethod.Code, offset[TControl.DC2Canvas]

        JNE      @@deldc

        PUSH     [ECX].TControl.fHandle

        CALL     ReleaseDC

        JMP      @@clr_Handle

@@deldc:

        CALL     DeleteDC



@@clr_Handle:

        XOR      ECX, ECX

        MOV      [EBX].TCanvas.fHandle, ECX

        MOV      [EBX].TCanvas.fIsPaintDC, CL

        AND      [EBX].TCanvas.fState, not HandleValid



        POP      EDX

@@chk_val:

        TEST     EDX, EDX

        JZ       @@exit



        OR       [EBX].TCanvas.fState, HandleValid

        MOV      [EBX].TCanvas.fHandle, EDX

        LEA      EDX, [EBX].TCanvas.fPenPos

        MOV      EAX, EBX

        CALL     SetPenPos



@@exit: POP      EBX

end;

{$ELSE ASM_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;

    {if not fIsPaintDC and

       not( assigned(fOwnerControl) and

            PControl(fOwnerControl).fDoubleBuffered )

       then}

      if not( assigned(fOwnerControl) and

              (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

             DeleteDC( fHandle );

      ////////////////////

      end;

    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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.SetPenPos]

procedure TCanvas.SetPenPos(const Value: TPoint);

asm

          MOV     ECX, [EDX].TPoint.y

          MOV     EDX, [EDX].TPoint.x

          MOV     [EAX].fPenPos.x, EDX

          MOV     [EAX].fPenPos.y, ECX

          CALL    MoveTo

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.SetPenPos(const Value: TPoint);

begin

  fPenPos := Value;

  MoveTo( Value.x, Value.y );

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.Changing]

procedure TCanvas.Changing;

asm

        PUSHAD

        MOV      ECX, [EAX].fOnChange.TMethod.Code

        JECXZ    @@exit

        XCHG     EDX, EAX

        MOV      EAX, [EDX].fOnChange.TMethod.Data

        CALL     ECX

@@exit:

        POPAD

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.Changing;

begin

  if Assigned( fOnChange ) then

     fOnChange( @Self );

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.Arc]

procedure TCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall;

asm

        PUSH     ESI



        PUSH     HandleValid or PenValid or ChangingCanvas

        PUSH     dword ptr [EBP+8]

        CALL     RequiredState



        MOV      EDX, EAX



        LEA      ESI, [Y4]

        STD



        XOR      ECX, ECX

        MOV      CL, 8

@@1:

        LODSD

        PUSH     EAX



        LOOP     @@1



        CLD

        PUSH     EDX  //Canvas.fHandle

        CALL     Windows.Arc

        POP      ESI

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.Chord]

procedure TCanvas.Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall;

asm

        PUSH     HandleValid or PenValid or BrushValid or ChangingCanvas

        PUSH     dword ptr [EBP + 8]

        CALL     RequiredState



        MOV      EDX, EAX



        PUSH     ESI

        LEA      ESI, [Y4]

        STD



        XOR      ECX, ECX

        MOV      CL, 8

@@1:

        LODSD

        PUSH     EAX



        LOOP     @@1



        CLD

        PUSH     EDX  //Canvas.fHandle

        CALL     Windows.Chord

        POP      ESI

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.CopyRect]

procedure TCanvas.CopyRect(const DstRect: TRect; SrcCanvas: PCanvas;

  const SrcRect: TRect);

asm

        PUSH     ESI

        PUSH     EDI



        PUSH     [EAX].fCopyMode



        PUSH     EDX



          PUSH     HandleValid or BrushValid

          PUSH     ECX



          PUSH     HandleValid or FontValid or BrushValid or ChangingCanvas

          PUSH     EAX

          MOV      ESI, offset[ RequiredState ]

          CALL     ESI

          MOV      EDI, EAX     // EDI = @Self.fHandle



          CALL     ESI

          MOV      EDX, EAX     // EDX = SrcCanvas.fHandle



        POP      ECX          // ECX = @DstRect



        MOV      ESI, [SrcRect]



        MOV      EAX, [ESI].TRect.Bottom

        SUB      EAX, [ESI].TRect.Top

        PUSH     EAX



        MOV      EAX, [ESI].TRect.Right

        SUB      EAX, [ESI].TRect.Left

        PUSH     EAX



        PUSH     [ESI].TRect.Top



        LODSD

        PUSH     EAX



        PUSH     EDX



        MOV      EAX, [ECX].TRect.Bottom

        MOV      EDX, [ECX].TRect.Top

        SUB      EAX, EDX

        PUSH     EAX



        MOV      EAX, [ECX].TRect.Right

        MOV      ESI, [ECX].TRect.Left

        SUB      EAX, ESI

        PUSH     EAX



        PUSH     EDX



        PUSH     ESI



        PUSH     EDI



        CALL     StretchBlt



        POP      EDI

        POP      ESI

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.DrawFocusRect]

procedure TCanvas.DrawFocusRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);

asm

        PUSH     EDX



        PUSH     HandleValid or BrushValid or FontValid or ChangingCanvas

        PUSH     EAX

        CALL     RequiredState



        PUSH     EAX

        CALL     Windows.DrawFocusRect

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.Ellipse]

procedure TCanvas.Ellipse(X1, Y1, X2, Y2: Integer);

asm

        PUSH     [Y2]

        PUSH     [X2]

        PUSH     ECX

        PUSH     EDX



        PUSH     HandleValid or PenValid or BrushValid or ChangingCanvas

        PUSH     EAX

        CALL     RequiredState



        PUSH     EAX

        CALL     Windows.Ellipse

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.FillRect]

procedure TCanvas.FillRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);

asm

        PUSH     EBX

        XCHG     EBX, EAX

        PUSH     EDX

        PUSH     HandleValid or BrushValid or ChangingCanvas

        PUSH     EBX

        CALL     RequiredState

        MOV      ECX, [EBX].fBrush

        JECXZ    @@chk_ctl



@@fill_with_Brush:

        XCHG     EAX, ECX

        CALL     TGraphicTool.GetHandle

        POP      EDX

        PUSH     EAX

        JMP      @@fin

@@chk_ctl:

        MOV      ECX, [EBX].fOwnerControl

        JECXZ    @@dflt_fill

        XCHG     EAX, ECX

        MOV      ECX, [EAX].TControl.fBrush

        INC      ECX

        LOOP     @@fill_with_Brush

        MOV      EAX, [EAX].TControl.fColor

        CALL     Color2RGB

        PUSH     EAX

        CALL     CreateSolidBrush

        POP      EDX

        PUSH     EAX

        PUSH     EAX

        PUSH     EDX

        PUSH     [EBX].fHandle

        CALL     Windows.FillRect

        CALL     DeleteObject

        POP      EBX

        RET

@@dflt_fill:

        POP      EDX

        PUSH     COLOR_WINDOW + 1

@@fin:

        PUSH     EDX

        PUSH     [EBX].fHandle

        CALL     Windows.FillRect

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.FillRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);

var Br: HBrush;

begin

  RequiredState( HandleValid or BrushValid or ChangingCanvas );

  if assigned( fBrush ) then

  begin

    Windows.FillRect(fHandle, Rect, fBrush.Handle);

  end

    else

  if assigned( fOwnerControl ) then

  begin

    if assigned( PControl( fOwnerControl ).fBrush ) 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;

  end

  else

  begin

    Windows.FillRect(fHandle, Rect, HBrush(COLOR_WINDOW + 1) );

  end;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.FillRgn]

procedure TCanvas.FillRgn(const Rgn: HRgn);

asm

        PUSH     EBX

        XCHG     EBX, EAX

        PUSH     EDX



        PUSH     HandleValid or BrushValid or ChangingCanvas

        PUSH     EBX

        CALL     RequiredState



        MOV      ECX, [EBX].TCanvas.fBrush

        JECXZ    @@1



        //PUSH     [ECX].TGraphicTool.fData.Color

        //JMP      @@cr_br



@@fill_rgn_using_Brush:

        XCHG     EAX, ECX

        CALL     TGraphicTool.GetHandle

        POP      EDX

        PUSH     EAX

        PUSH     EDX

        PUSH     [EBX].fHandle

        CALL     Windows.FillRgn

        JMP      @@fin



@@1:    MOV      ECX, [EBX].TCanvas.fOwnerControl

        MOV      EAX, -1 // clWhite

        JECXZ    @@2



        XCHG     EAX, ECX

        MOV      ECX, [EAX].TControl.fBrush

        INC      ECX

        LOOP     @@fill_rgn_using_Brush



        MOV      EAX, [EAX].TControl.fColor

@@2:

        CALL     Color2RGB

        PUSH     EAX

        CALL     CreateSolidBrush // EAX = Br



        POP      EDX // Rgn



        PUSH     EAX //-------------------//

        PUSH     EAX           // Br

        PUSH     EDX           // Rgn

        PUSH     [EBX].FHandle // fHandle

        CALL     Windows.FillRgn



        CALL     DeleteObject



@@fin:

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.FillRgn(const Rgn: HRgn);

var Br : HBrush;

begin

  RequiredState( HandleValid or BrushValid or ChangingCanvas );

  if assigned( fBrush ) then

    Windows.FillRgn(FHandle, Rgn, fBrush.Handle )

    else

  if assigned( fOwnerControl ) then

  begin

    if Assigned( PControl( fOwnerControl ).fBrush ) 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;

  end

     else

  begin

    Br := CreateSolidBrush( DWORD(clWindow) );

    Windows.FillRgn( fHandle, Rgn, Br );

    DeleteObject( Br );

  end;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.FloodFill]

procedure TCanvas.FloodFill(X, Y: Integer; Color: TColor;

  FillStyle: TFillStyle);

asm

        PUSH     EBX

        MOV      EBX, EAX



        MOVZX    EAX, [FillStyle]

        TEST     EAX, EAX

        MOV      EAX, FLOODFILLSURFACE   // = 1

        JZ       @@1

        //MOV      EAX, FLOODFILLBORDER  // = 0

        DEC      EAX

@@1:

        PUSH     EAX

        PUSH     [Color]

        PUSH     ECX

        PUSH     EDX



        PUSH     HandleValid or BrushValid or ChangingCanvas

        PUSH     EBX

        CALL     RequiredState

        PUSH     EAX

        CALL     Windows.ExtFloodFill



        POP      EBX

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.FrameRect]

procedure TCanvas.FrameRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);

asm

        PUSH     EBX

        XCHG     EBX, EAX

        PUSH     EDX



        MOV      ECX, [EBX].TCanvas.fBrush

        JECXZ    @@1



        PUSH     [ECX].TGraphicTool.fData.Color

        JMP      @@cr_br



@@1:    MOV      ECX, [EBX].TCanvas.fOwnerControl

        JECXZ    @@2



        PUSH     [ECX].TControl.fColor

        JMP      @@cr_br



@@2:    PUSH     clWhite

@@cr_br:POP      EAX                  // @Rect

        CALL     Color2RGB

        PUSH     EAX

        CALL     CreateSolidBrush

        POP      EDX

          PUSH     EAX

        PUSH     EAX

        PUSH     EDX



        PUSH     HandleValid or ChangingCanvas

        PUSH     EBX

        ///MOV      EBX, EDX

        CALL     RequiredState



        PUSH     EAX

        CALL     Windows.FrameRect



        ///PUSH     EBX

        CALL     DeleteObject



        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.FrameRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect);

var SolidBr : HBrush;

begin

  RequiredState( HandleValid or ChangingCanvas );

  if assigned( fBrush ) then

    SolidBr := CreateSolidBrush( Color2RGB( fBrush.fData.Color ) )

  else

  if assigned( fOwnerControl ) then

    SolidBr := CreateSolidBrush( PControl(fOwnerControl).fColor )

  else

    SolidBr := CreateSolidBrush( clWhite );

  Windows.FrameRect(FHandle, Rect, SolidBr);

  DeleteObject( SolidBr );

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.LineTo]

procedure TCanvas.LineTo(X, Y: Integer);

asm

        PUSH     ECX

        PUSH     EDX

        PUSH     HandleValid or PenValid or BrushValid or ChangingCanvas

        PUSH     EAX

        CALL     RequiredState

        PUSH     EAX  //Canvas.fHandle

        CALL     Windows.LineTo

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.LineTo(X, Y: Integer);

begin

  RequiredState( HandleValid or PenValid or BrushValid or ChangingCanvas );

  Windows.LineTo( fHandle, X, Y );

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.MoveTo]

procedure TCanvas.MoveTo(X, Y: Integer);

asm

        PUSH     0

        PUSH     ECX

        PUSH     EDX

        PUSH     HandleValid

        PUSH     EAX

        CALL     RequiredState

        PUSH     EAX  //Canvas.fHandle

        CALL     Windows.MoveToEx

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.MoveTo(X, Y: Integer);

begin

  RequiredState( HandleValid );

  Windows.MoveToEx( fHandle, X, Y, nil );

end;

{$ENDIF ASM_VERSION}



//[procedure TCanvas.ObjectChanged]

procedure TCanvas.ObjectChanged(Sender: PGraphicTool);

begin

  DeselectHandles;

  //if Assigned( GlobalCanvas_OnObjectChanged ) then

  //   GlobalCanvas_OnObjectChanged( Sender );

end;



{$IFDEF ASM_VERSION}

//[procedure TCanvas.Pie]

procedure TCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall;

asm

        PUSH     HandleValid or PenValid or BrushValid or ChangingCanvas

        PUSH     dword ptr [EBP + 8]

        CALL     RequiredState



        MOV      EDX, EAX



        PUSH     ESI

        LEA      ESI, [Y4]

        STD



        XOR      ECX, ECX

        MOV      CL, 8

@@1:

        LODSD

        PUSH     EAX



        LOOP     @@1



        CLD

        PUSH     EDX  //Canvas.fHandle

        CALL     Windows.Pie

        POP      ESI

end;

{$ELSE ASM_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 ASM_VERSION}



{++}(*

{$IFDEF F_P}

//[Windows API FUNCTIONS ADDITIONAL DECLARATIONS FOR Free Pascal]

function Windows_Polygon; external gdi32 name 'Polygon';

function Windows_Polyline; external gdi32 name 'Polyline';

function FillRect; external user32 name 'FillRect';

function OffsetRect; external user32 name 'OffsetRect';

function CreateAcceleratorTable; external user32 name 'CreateAcceleratorTableA';

function TrackPopupMenu; external user32 name 'TrackPopupMenu';

function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL;

  const NewState: TTokenPrivileges; BufferLength: DWORD;

  var PreviousState: TTokenPrivileges; var ReturnLength: DWORD): BOOL; external advapi32 name 'AdjustTokenPrivileges';

function InflateRect; external user32 name 'InflateRect';

{$IFDEF F_P105ORBELOW}

function InvalidateRect; external user32 name 'InvalidateRect';

function ValidateRect; external user32 name 'ValidateRect';

{$ENDIF F_P105ORBELOW}

//[END OF Windows API FUNCTIONS ADDITIONAL DECLARATIONS FOR Free Pascal]

{$ENDIF}

*){--}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.Polygon]

procedure TCanvas.Polygon(const Points: array of TPoint);

asm

        INC      ECX

        PUSH     ECX

        PUSH     EDX



        PUSH     HandleValid or PenValid or BrushValid or ChangingCanvas

        PUSH     EAX

        CALL     RequiredState



        PUSH     EAX

        CALL     Windows.Polygon

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.Polyline]

procedure TCanvas.Polyline(const Points: array of TPoint);

asm

        INC      ECX

        PUSH     ECX

        PUSH     EDX



        PUSH     HandleValid or PenValid or BrushValid or ChangingCanvas

        PUSH     EAX

        CALL     RequiredState



        PUSH     EAX

        CALL     Windows.Polyline

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.Rectangle]

procedure TCanvas.Rectangle(X1, Y1, X2, Y2: Integer);

asm

        PUSH     [Y2]

        PUSH     [X2]

        PUSH     ECX

        PUSH     EDX



        PUSH     HandleValid or BrushValid or PenValid or ChangingCanvas

        PUSH     EAX

        CALL     RequiredState



        PUSH     EAX

        CALL     Windows.Rectangle

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.RoundRect]

procedure TCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);

asm

        PUSH     [Y3]

        PUSH     [X3]

        PUSH     [Y2]

        PUSH     [X2]

        PUSH     ECX

        PUSH     EDX



        PUSH     HandleValid or BrushValid or PenValid or ChangingCanvas

        PUSH     EAX

        CALL     RequiredState



        PUSH     EAX

        CALL     Windows.RoundRect

end;

{$ELSE ASM_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 ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.TextArea]

procedure TCanvas.TextArea(const Text: String; var Sz: TSize;

  var P0: TPoint);

asm

        PUSH     EBX

        MOV      EBX, EAX



        PUSH     ECX

        CALL     TextExtent

        POP      EDX



        MOV      ECX, [P0]

        XOR      EAX, EAX

        MOV      [ECX].TPoint.x, EAX

        MOV      [ECX].TPoint.y, EAX



        CMP      [GlobalCanvas_OnTextArea], EAX

        JZ       @@exit

        MOV      EAX, EBX

        CALL     [GlobalCanvas_OnTextArea]



@@exit:

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.TextArea(const Text: String; var Sz: TSize;

  var P0: TPoint);

begin

  Sz := TextExtent( Text );

  P0.x := 0; P0.y := 0;

  if Assigned( GlobalCanvas_OnTextArea ) then

     GlobalCanvas_OnTextArea( @Self, Sz, P0 );

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[function TCanvas.TextExtent]

function TCanvas.TextExtent(const Text: string): TSize;

asm

        PUSH     EBX

        PUSH     ESI

        MOV      EBX, EAX



        PUSH     ECX               // prepare @Result



        MOV      EAX, EDX

        CALL     System.@LStrLen

        PUSH     EAX               // prepare Length(Text)



        CALL     EDX2PChar

        PUSH     EDX               // prepare PChar(Text)



        PUSH     HandleValid or FontValid

        PUSH     EBX

        CALL     RequiredState



        XCHG     ESI, EAX

        TEST     ESI, ESI          // ESI = fHandle before

        JNZ      @@1



        PUSH     ESI

        CALL     CreateCompatibleDC



        MOV      EDX, EBX

        XCHG     EAX, EDX // EAX := @Self; EDX := DC

        CALL     SetHandle

@@1:

//********************************************************** // Added By M.Gerasimov

//*

        CMP      [EBX].TCanvas.fIsPaintDC, 1

        JZ       @@2

        XOR      ESI,ESI

@@2:

//*

//********************************************************** // Added By M.Gerasimov

        PUSH     HandleValid or FontValid

        PUSH     EBX

        CALL     RequiredState

        PUSH     EAX               // prepare DC



        CALL     Windows.GetTextExtentPoint32



        TEST     ESI, ESI

        JNZ      @@exit



        XOR      EDX, EDX

        XCHG     EAX, EBX

        CALL     SetHandle



@@exit:

        POP      ESI

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function TCanvas.TextExtent(const Text: string): TSize;

var DC : HDC;

    ClearHandle : Boolean;

begin

  //Result.cX := 0;

  //Result.cY := 0;

  ClearHandle := False;

  RequiredState( HandleValid or FontValid );

  DC := fHandle;

  if DC = 0 then

  begin

     DC := CreateCompatibleDC( 0 );

     ClearHandle := True;

     SetHandle( DC );

  end;

//********************************************************** // Added By Gerasimov

//*

  If Not fIsPaintDC then ClearHandle := True;

//*

//********************************************************** // Added By Gerasimov

  RequiredState( HandleValid or FontValid );

  Windows.GetTextExtentPoint32( fHandle, PChar(Text), Length(Text), Result);

  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 ASM_VERSION}



//[function TCanvas.TextHeight]

function TCanvas.TextHeight(const Text: string): Integer;

begin

  Result := TextExtent(Text).cY;

end;



{$IFDEF ASM_VERSION}

//[procedure TCanvas.TextOut]

procedure TCanvas.TextOut(X, Y: Integer; const Text: String); stdcall;

asm

        PUSH     EBX

        MOV      EBX, [EBP+8]



        MOV      EAX, [Text]

        PUSH     EAX

        CALL     System.@LStrLen

        XCHG     EAX, [ESP]             // prepare Length(Text)



        //CALL     System.@LStrToPChar  // string does not need to be null-terminated !

        PUSH     EAX                    // prepare PChar(Text)

        PUSH     [Y]                    // prepare Y

        PUSH     [X]                    // prepare X



        PUSH     HandleValid or FontValid or BrushValid or ChangingCanvas

        PUSH     EBX

        CALL     RequiredState

        PUSH     EAX                    // prepare fHandle

        CALL     Windows.TextOut



        { -- by suggetion of Alexey (Lecha2002)

        MOV      EAX, EBX

        MOV      EDX, [Text]

        CALL     TextWidth

        MOV      EDX, [X]

        ADD      EDX, EAX



        MOV      ECX, [Y]

        MOV      EAX, EBX

        CALL     MoveTo

        }



        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.TextOut(X, Y: Integer; const Text: String); stdcall;

begin

  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );

  Windows.TextOut(FHandle, X, Y, PChar(Text), Length(Text));

  //MoveTo(X + TextWidth(Text), Y); -- by suggestion of Alexey (Lecha2002)

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.TextRect]

procedure TCanvas.TextRect(const Rect: TRect; X, Y: Integer; const Text: string);

asm

        PUSH     EBX

        XCHG     EBX, EAX



        PUSH     0              // prepare 0



        PUSH     EDX

        PUSH     ECX



        MOV      EAX, [Text]

        //CALL     System.@LStrToPChar

        PUSH     EAX



        //MOV      EAX, [Text]

        CALL     System.@LStrLen



        POP      ECX            // ECX = @Text[1]



        POP      EDX            // EDX = X

        XCHG     EAX, [ESP]     // prepare Length(Text), EAX = @Rect

        PUSH     ECX            // prepare PChar(Text)

        PUSH     EAX            // prepare @Rect



        XOR      EAX, EAX

        MOV      AL, ETO_CLIPPED // = 4

        MOV      ECX, [EBX].fBrush

        JECXZ    @@opaque



        CMP      [ECX].TGraphicTool.fData.Brush.Style, bsClear

        JZ       @@txtout



@@opaque:

        DB $0C, ETO_OPAQUE //OR       AL, ETO_OPAQUE

@@txtout:

        PUSH     EAX            // prepare Options

        PUSH     [Y]            // prepare Y

        PUSH     EDX            // prepare X



        PUSH     HandleValid or FontValid or BrushValid or ChangingCanvas

        PUSH     EBX

        CALL     RequiredState  // EAX = fHandle

        PUSH     EAX            // prepare fHandle



        CALL     Windows.ExtTextOut



        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.TextRect(const Rect: TRect; X, Y: Integer; const Text: string);

var

  Options: Integer;

begin

  //Changing;

  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );

  Options := ETO_CLIPPED;

  if assigned( fBrush ) and (fBrush.fData.Brush.Style <> bsClear)

  or not assigned( fBrush ) then Inc(Options, ETO_OPAQUE);

  Windows.ExtTextOut( fHandle, X, Y, Options,

                      @Rect, PChar(Text),

                      Length(Text), nil);

end;

{$ENDIF ASM_VERSION}



//[procedure TCanvas.ExtTextOut]

procedure TCanvas.ExtTextOut( X, Y: Integer; Options: DWORD; const Rect: TRect; const Text: String;

          const Spacing: array of Integer );

begin

  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );

  Windows.ExtTextOut(FHandle, X, Y, Options, @Rect, PChar(Text), Length(Text), @Spacing[ 0 ]);

end;



//[procedure TCanvas.DrawText]

procedure TCanvas.DrawText(Text:String; var Rect:TRect; Flags:DWord);

begin

  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );

  Windows.DrawText(Handle,PChar(Text),Length(Text),Rect,Flags);

end;



//[function TCanvas.ClipRect]

function TCanvas.ClipRect: TRect;

begin

  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );

  GetClipBox(Handle, Result);

end;



//[function TCanvas.TextWidth]

function TCanvas.TextWidth(const Text: string): Integer;

begin

  Result := TextExtent(Text).cX;

end;



{$IFDEF ASM_VERSION}

//[function TCanvas.GetBrush]

function TCanvas.GetBrush: PGraphicTool;

asm

        MOV      ECX, [EAX].fBrush

        INC      ECX

        LOOP     @@exit



        PUSH     EAX

        CALL     NewBrush

        POP      EDX

        PUSH     EAX



        MOV      [EDX].fBrush, EAX



        MOV      [EAX].TGraphicTool.fOnChange.TMethod.Code, Offset[TCanvas.ObjectChanged]

        MOV      [EAX].TGraphicTool.fOnChange.TMethod.Data, EDX

        MOV      ECX, [EDX].fOwnerControl

        JECXZ    @@1



        PUSH     [ECX].TControl.fBrush

        MOV      ECX, [ECX].TControl.fColor

        MOV      [EAX].TGraphicTool.fData.Color, ECX

        POP      EDX

        TEST     EDX, EDX

        JZ       @@1



        CALL     TGraphicTool.Assign



@@1:    POP      ECX



@@exit: XCHG     EAX, ECX

end;

{$ELSE ASM_VERSION} //Pascal

function TCanvas.GetBrush: PGraphicTool;

begin

  if not assigned( fBrush ) then

  begin

    fBrush := NewBrush;

    if assigned( fOwnerControl ) then

    begin

      fBrush.fData.Color := PControl(fOwnerControl).fColor;

      if assigned( PControl(fOwnerControl).fBrush ) then

         {fBrush := }fBrush.Assign( PControl(fOwnerControl).fBrush );

      // both statements above needed

    end;

    //fBrush.OnChange := ObjectChanged;

    AssignChangeEvents;

  end;

  Result := fBrush;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[function TCanvas.GetFont]

function TCanvas.GetFont: PGraphicTool;

asm

        MOV      ECX, [EAX].TCanvas.fFont

        INC      ECX

        LOOP     @@exit



        PUSH     EAX

        CALL     NewFont

        POP      EDX

        PUSH     EAX



        MOV      [EDX].TCanvas.fFont, EAX

        MOV      [EAX].TGraphicTool.fOnChange.TMethod.Code, Offset[TCanvas.ObjectChanged]

        MOV      [EAX].TGraphicTool.fOnChange.TMethod.Data, EDX



        MOV      ECX, [EDX].fOwnerControl

        JECXZ    @@1



        PUSH     [ECX].TControl.fFont

        MOV      ECX, [ECX].TControl.fTextColor

        MOV      [EAX].TGraphicTool.fData.Color, ECX

        POP      EDX

        TEST     EDX, EDX

        JZ       @@1



        CALL     TGraphicTool.Assign



@@1:    POP      ECX



@@exit: MOV      EAX, ECX

end;

{$ELSE ASM_VERSION} //Pascal

function TCanvas.GetFont: PGraphicTool;

begin

  if not assigned( fFont ) then

  begin

    fFont := NewFont;

    if assigned( fOwnerControl ) then

    begin

      fFont.Color := PControl(fOwnerControl).fTextColor;

      if assigned( PControl(fOwnerControl).fFont ) then

        {fFont := }fFont.Assign( PControl(fOwnerControl).fFont );

    end;

    //fFont.OnChange := ObjectChanged;

    AssignChangeEvents;

  end;

  Result := fFont;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[function TCanvas.GetPen]

function TCanvas.GetPen: PGraphicTool;

asm

        MOV      ECX, [EAX].TCanvas.fPen

        INC      ECX

        LOOP     @@exit



        PUSH     EAX

        CALL     NewPen

        POP      EDX

        MOV      [EDX].fPen, EAX

        PUSH     EAX

        MOV      EAX, EDX

        CALL     AssignChangeEvents

        POP      ECX



@@exit: MOV      EAX, ECX

end;

{$ELSE ASM_VERSION} //Pascal

function TCanvas.GetPen: PGraphicTool;

begin

  if not assigned( fPen ) then

  begin

    fPen := NewPen;

    AssignChangeEvents;

  end;

  Result := fPen;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[function TCanvas.GetHandle]

function TCanvas.GetHandle: HDC;

asm

        CMP      word ptr[EAX].fOnGetHandle.TMethod.Code+2, 0

        MOV      EDX, EAX

        MOV      EAX, [EDX].fHandle

        JZ       @@exit

        MOV      EAX, [EDX].fOnGetHandle.TMethod.Data

        PUSH     EDX

        CALL     [EDX].fOnGetHandle.TMethod.Code

        XCHG     EAX, [ESP]

        POP      EDX

        PUSH     EDX

        CALL     SetHandle

        POP      EAX

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

function TCanvas.GetHandle: HDC;

begin

  if assigned( fOnGetHandle ) then

  begin

    Result := fOnGetHandle( @Self );

    //fHandle := Result;

    SetHandle( Result );

  end

  else

    Result := fHandle;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TCanvas.AssignChangeEvents]

procedure TCanvas.AssignChangeEvents;

asm

        PUSH     ESI

        LEA      ESI, [EAX].fBrush

        MOV      CL, 3

        MOV      EDX, EAX

@@1:    LODSD

        TEST     EAX, EAX

        JZ       @@nxt

        MOV      [EAX].TGraphicTool.fOnChange.TMethod.Data, EDX

        MOV      [EAX].TGraphicTool.fOnChange.TMethod.Code, offset[ ObjectChanged ]

@@nxt:  DEC      CL

        JNZ      @@1

        POP      ESI

end;

{$ELSE ASM_VERSION} //Pascal

procedure TCanvas.AssignChangeEvents;

begin

  if assigned( fFont ) then

     fFont.fOnChange := ObjectChanged;

  if assigned( fBrush ) then

     fBrush.fOnChange := ObjectChanged;

  if assigned( fPen ) then

     fPen.fOnChange := ObjectChanged;

end;

{$ENDIF ASM_VERSION}



{$IFNDEF _FPC}

{$IFNDEF _D2}

//[procedure TCanvas.WDrawText]

procedure TCanvas.WDrawText(WText: WideString; var Rect: TRect;

  Flags: DWord);

begin

  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );

  Windows.DrawTextW(Handle,PWideChar(WText),Length(WText),Rect,Flags);

end;



//[procedure TCanvas.WExtTextOut]

procedure TCanvas.WExtTextOut(X, Y: Integer; Options: DWORD;

  const Rect: TRect; const WText: WideString;

  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]

procedure TCanvas.WTextOut(X, Y: Integer; const WText: WideString);

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]

procedure TCanvas.WTextRect(const Rect: TRect; X, Y: Integer;

  const WText: WideString);

var

  Options: Integer;

begin

  //Changing;

  RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas );

  Options := ETO_CLIPPED;

  if assigned( fBrush ) and (fBrush.fData.Brush.Style <> bsClear)

  or not assigned( fBrush ) then Inc(Options, ETO_OPAQUE);

  Windows.ExtTextOutW( fHandle, X, Y, Options,

                      @Rect, PWideChar(WText),

                      Length(WText), nil);

end;



//[function TCanvas.WTextExtent]

function TCanvas.WTextExtent(const WText: WideString): 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]

function TCanvas.WTextHeight(const WText: WideString): Integer;

begin

  Result := WTextExtent( WText ).cy;

end;



//[function TCanvas.WTextWidth]

function TCanvas.WTextWidth(const WText: WideString): Integer;

begin

  Result := WTextExtent( WText ).cx;

end;

{$ENDIF _D2}

{$ENDIF _FPC}





















{-}

//[function MakeInt64]

function MakeInt64( Lo, Hi: DWORD ): I64;

begin

  Result.Lo := Lo;

  Result.Hi := Hi;

end;



//[function Int2Int64]

function Int2Int64( X: Integer ): I64;

asm

  MOV  [EDX], EAX

  MOV  ECX, EDX

  CDQ

  MOV  [ECX+4], EDX

end;



//[procedure IncInt64]

procedure IncInt64( var I64: I64; Delta: Integer );

asm

  ADD  [EAX], EDX

  ADC  dword ptr [EAX+4], 0

end;



//[procedure DecInt64]

procedure DecInt64( var I64: I64; Delta: Integer );

asm

  SUB  [EAX], EDX

  SBB  dword ptr [EDX], 0

end;



//[function Add64]

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]

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]

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]

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;



//[FUNCTION Mul64i]

{$IFDEF ASM_VERSION}

function Mul64i( const X: I64; Mul: Integer ): I64;

asm     //cmd    //opd

        TEST     EDX, EDX

        PUSHFD

        JGE      @@1

        NEG      EDX

@@1:    PUSH     ECX

        CALL     Mul64EDX

        POP      EAX

        POPFD

        JGE      @@2

        MOV      EDX, EAX

        CALL     Neg64

@@2:

end;

{$ELSE ASM_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 ASM_VERSION}

//[END Mul64i]



//[function Div64EDX]

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;



//[FUNCTION Div64i]

{$IFDEF ASM_VERSION}

function Div64i( const X: I64; D: Integer ): I64;

asm     //cmd    //opd

        PUSH     EBX

        XOR      EBX, EBX

        PUSH     ESI

        XCHG     ESI, EAX

        LODSD

        MOV      [ECX], EAX

        LODSD

        MOV      [ECX+4], EAX

        MOV      ESI, ECX

        PUSH     EDX

        XCHG     EAX, ECX

        CALL     Sgn64

        TEST     EAX, EAX

        JGE      @@1

        INC      EBX

        MOV      EAX, ESI

        MOV      EDX, ESI

        CALL     Neg64

@@1:    POP      EDX

        TEST     EDX, EDX

        JGE      @@2

        XOR      EBX, 1

        NEG      EDX

@@2:    MOV      EAX, ESI

        MOV      ECX, ESI

        CALL     Div64EDX

        DEC      EBX

        JNZ      @@3

        MOV      EDX, ESI

        XCHG     EAX, ESI

        CALL     Neg64

@@3:    POP      ESI

        POP      EBX

end;

{$ELSE ASM_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 ASM_VERSION}

//[END Div64i]



//[function Mod64i]

function Mod64i( const X: I64; D: Integer ): Integer;

begin

  Result := Sub64( X, Mul64i( Div64i( X, D ), D ) ).Lo;

end;



//[function Sgn64]

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]

function Cmp64( const X, Y: I64 ): Integer;

begin

  Result := Sgn64( Sub64( X, Y ) );

end;



//[function Int64_2Str]

function Int64_2Str( X: I64 ): String;

var M: Boolean;

    Y: Integer;

    Buf: array[ 0..31 ] of Char;

    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 ] := Char( Y + Integer( '0' ) );

    X := Div64i( X, 10 );

  end;

  if M then

  begin

    Dec( I );

    Buf[ I ] := '-';

  end;

  Result := PChar( @Buf[ I ] );

end;



//[function Str2Int64]

function Str2Int64( const S: String ): 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 not( S[ I ] in [ '0'..'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]

function Int64_2Double( const X: I64 ): Double;

asm

  FILD qword ptr [EAX]

  FSTP @Result

end;



//[function Double2Int64]

function Double2Int64( D: Double ): I64;

asm

  FLD   D

  FISTP qword ptr [EAX]

end;



{+}

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

  {+}{++}(*Result := AValue = NAN;*){--}

end;



//[function IntPower]

function IntPower(Base: Extended; Exponent: Integer): Extended;

{$IFDEF F_P}

begin

  if Exponent = 0 then

  begin

    Result := 1.0;

    Exit;

  end;

  if Exponent < 0 then

  begin

    Exponent := -Exponent;

    Base := 1.0 / Base;

  end;

  Result := Base;

  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;

(* version of code by Borland:

asm

        mov     ecx, eax

        cdq

        fld1                      { Result := 1 }

        xor     eax, edx

        sub     eax, edx          { eax := Abs(Exponent) }

        jz      @@3

        fld     Base

        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 }

        cmp     ecx, 0

        jge     @@3

        fld1

        fdivrp                    { Result := 1 / Result }

@@3:

        fwait

end;*)

{$ENDIF F_P/DELPHI}



//[function Str2Double]

function Str2Double( const S: String ): 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

    '.': if not Pt then Pt := TRUE else break;

    '0'..'9': if not Pt then

                 Result := Result * 10.0 + 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 TruncD]

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;

{+}{++}(*

begin

  Result := Trunc( D );

end;

*){--}



// Precision 15

//[function Extended2Str]

function Extended2Str( E: Extended ): String;

    function UnpackFromBuf( const Buf: array of Byte; N: Integer ): String;

    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 ] := Char( Ord('0') + K );

        Inc( J );

        K := Buf[ I ] and $F;

        Result[ J ] := Char( 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 not (Result[ L ] in ['0','.']) 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

    asm

      FLD    [E]

      FBSTP  [Buf1]

    end;

    if Buf1[ 7 ] <> 0 then break;

    E := E * I10;

    Dec( N );

  end;



  Result := UnpackFromBuf( Buf1, N );



  if S then Result := '-' + Result;

end;



//[function Double2Str]

function Double2Str( D: Double ): String;

begin

  Result := Extended2Str( D );

end;



//[function Double2StrEx]

function Double2StrEx( D: Double ): String;

var E, E1, E2: Double;

    S: String;

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]

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 // first(AL) > 31 ?

   {$ENDIF}

   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     // (2) last - first >= 32 ?

   {$ENDIF}

   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]

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}



//[FUNCTION Int2Hex]

{$IFDEF ASM_VERSION}

function Int2Hex( Value : DWord; Digits : Integer ) : String;

asm



        // EAX = Value

        // EDX = Digits (actually DL needed)

        // ECX = @Result



        PUSH      0

        ADD       ESP, -0Ch



        PUSH      EBX

        PUSH      ECX



        LEA       EBX, [ESP+8+0Fh]  // EBX := @Buf[ 15 ]

        AND       EDX, $F



@@loop: DEC       EBX

        DEC       EDX



        PUSH      EAX

        {$IFDEF PARANOIA}

        DB $24, $0F

        {$ELSE}

        AND       AL, 0Fh

        {$ENDIF}

        {$IFDEF PARANOIA}

        DB $3C, 9

        {$ELSE}

        CMP       AL, 9

        {$ENDIF}

        JA        @@10

        {$IFDEF PARANOIA}

        DB $04, 30h-41h+0Ah

        {$ELSE}

        ADD       AL,30h-41h+0Ah

        {$ENDIF}

@@10:

        {$IFDEF PARANOIA}

        DB $04, 41h-0Ah

        {$ELSE}

        ADD       AL,41h-0Ah

        {$ENDIF}

        MOV       byte ptr [EBX], AL

        POP       EAX

        SHR       EAX, 4



        JNZ       @@loop



        TEST      EDX, EDX

        JG        @@loop



        POP       EAX      // EAX = @Result

        MOV       EDX, EBX // EDX = @resulting string

        CALL      System.@LStrFromPChar



        POP       EBX

        ADD       ESP, 10h



{== by KSer - to test it only.

function Int2Hex( Value : DWord; Digits : Integer ) : shortString;

asm

        MOV       [ECX], DL

        XADD      EDX, ECX

@@loop1:

        PUSH      EAX

        db   $24, $0F    // and  al,$0F

        AAM

        //AAD

        DB $D5, $11

        db   $04, $30    // add  al,$30

        MOV       [EDX], AL

        POP       EAX

        SHR       EAX, 4

        DEC       EDX

        LOOP      @@loop1

}

end;

{$ELSE ASM_VERSION} //Pascal (mixed)

function Int2Hex( Value : DWord; Digits : Integer ) : String;

var Buf: array[ 0..8 ] of Char;

    Dest : PChar;



    function HexDigit( B : Byte ) : Char;

    {$IFDEF F_P}

    const

      HexDigitChr: array[ 0..15 ] of Char = ( '0','1','2','3','4','5','6','7',

                                              '8','9','A','B','C','D','E','F' );

    begin

      Result := HexDigitChr[ B and $F ];

    end;

    {$ELSE DELPHI}

    asm

            {$IFDEF PARANOIA}

             DB $3C,9

             {$ELSE}

             CMP  AL,9

             {$ENDIF}

             JA   @@1

             {$IFDEF PARANOIA}

             DB $04, $30-$41+$0A

             {$ELSE}

             ADD  AL,30h-41h+0Ah

             {$ENDIF}

    @@1:

             {$IFDEF PARANOIA}

             DB $04, $41-$0A

             {$ELSE}

             ADD  AL,41h-0Ah

             {$ENDIF}

    end;

    {$ENDIF F_P/DELPHI}

begin

  Dest := @Buf[ 8 ];

  Dest^ := #0;

  repeat

    Dec( Dest );

    Dest^ := '0';

    if Value <> 0 then

    begin

      Dest^ := HexDigit( Value and $F );

      Value := Value shr 4;

    end;

    Dec( Digits );

  until (Value = 0) and (Digits <= 0);

  Result := Dest;

end;

{$ENDIF ASM_VERSION}

//[END Int2Hex]



//[FUNCTION Hex2Int]

{$IFDEF ASM_VERSION}

function Hex2Int( const Value : String) : Integer;

asm

        CALL     EAX2PChar

        PUSH     ESI

        XCHG     ESI, EAX

        XOR      EDX, EDX

        TEST     ESI, ESI

        JE       @@exit

        LODSB

        {$IFDEF PARANOIA}

        DB $3C, '$'

        {$ELSE}

        CMP      AL, '$'

        {$ENDIF}

        JNE      @@1

@@0:    LODSB

@@1:    TEST     AL, AL

        JE       @@exit

        {$IFDEF PARANOIA}

        DB $2C, '0'

        {$ELSE}

        SUB      AL, '0'

        {$ENDIF}

        {$IFDEF PARANOIA}

        DB $3C, 9

        {$ELSE}

        CMP      AL, '9' - '0'

        {$ENDIF}

        JBE      @@3



        {$IFDEF PARANOIA}

        DB $2C, $11

        {$ELSE}

        SUB      AL, 'A' - '0'

        {$ENDIF}

        {$IFDEF PARANOIA}

        DB $3C, 5

        {$ELSE}

        CMP      AL, 'F' - 'A'

        {$ENDIF}

        JBE      @@2



        {$IFDEF PARANOIA}

        DB $2C, 32

        {$ELSE}

        SUB      AL, 32

        {$ENDIF}

        {$IFDEF PARANOIA}

        DB $3C, 5

        {$ELSE}

        CMP      AL, 'F' - 'A'

        {$ENDIF}

        JA       @@exit

@@2:

        {$IFDEF PARANOIA}

        DB $04, 0Ah

        {$ELSE}

        ADD      AL, 0Ah

        {$ENDIF}

@@3:

        SHL      EDX, 4

        ADD      DL, AL

        JMP      @@0



@@exit: XCHG     EAX, EDX

        POP      ESI

end;

{$ELSE ASM_VERSION} //Pascal

function Hex2Int( const Value : String) : 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 ] in [ '0'..'9' ] then

       Result := (Result shl 4) or (Ord(Value[I]) - Ord('0'))

    else

    if Value[ I ] in [ 'A'..'F' ] then

       Result := (Result shl 4) or (Ord(Value[I]) - Ord('A') + 10)

    else

    if Value[ I ] in [ 'a'..'f' ] then

       Result := (Result shl 4) or (Ord(Value[I]) - Ord('a') + 10)

    else

      break;

    Inc( I );

  end;

end;

{$ENDIF ASM_VERSION}

//[END Hex2Int]



//[FUNCTION Octal2Int]

function Octal2Int( const Value: String ) : Integer;

var I: Integer;

begin

  Result := 0;

  for I := 1 to Length( Value ) do

  begin

    if Value[ I ] in [ '0'..'7' ] then

      Result := Result * 8 + Ord( Value[ I ] ) - Ord( '0' )

    else break;

  end;

end;

//[END Octal2Int]



//[FUNCTION Binary2Int]

function Binary2Int( const Value: String ) : Integer;

var I: Integer;

begin

  Result := 0;

  for I := 1 to Length( Value ) do

  begin

    if Value[ I ] in [ '0'..'1' ] then

      Result := Result * 2 + Ord( Value[ I ] ) - Ord( '0' )

    else break;

  end;

end;

//[END Binary2Int]



//[FUNCTION cHex2Int]

{$IFDEF ASM_VERSION}

function cHex2Int( const Value : String) : Integer;

asm

     TEST  EAX, EAX

     JZ    @@exit

     CMP   word ptr [EAX], '0x'

     JZ    @@skip_2_chars

     CMP   word ptr [EAX], '0X'

     JNZ   @@2Hex2Int

@@skip_2_chars:

     INC   EAX

     INC   EAX

@@2Hex2Int:

     JMP   Hex2Int

@@exit:

end;

{$ELSE ASM_VERSION}

function cHex2Int( const Value : String) : Integer;

begin

  if StrEq( Copy( Value, 1, 2 ), '0x' ) then

    Result := Hex2Int( CopyEnd( Value, 3 ) )

  else Result := Hex2Int( Value );

end;

{$ENDIF ASM_VERSION}

//[END cHex2Int]



//[FUNCTION Int2Str]

{$IFDEF ASM_VERSION}

function Int2Str( Value : Integer ) : String;

asm

        XOR       ECX, ECX

        PUSH      ECX

        ADD       ESP, -0Ch



        PUSH      EBX

        LEA       EBX, [ESP + 15 + 4]

        PUSH      EDX

        CMP       EAX, ECX

        PUSHFD

        JGE       @@1

        NEG       EAX

@@1:

        MOV       CL, 10



@@2:

        DEC       EBX

        XOR       EDX, EDX

        DIV       ECX

        ADD       DL, 30h

        MOV       [EBX], DL

        TEST      EAX, EAX

        JNZ       @@2



        POPFD

        JGE       @@3



        DEC       EBX

        MOV       byte ptr [EBX], '-'

@@3:

        POP       EAX

        MOV       EDX, EBX

        CALL      System.@LStrFromPChar



        POP       EBX

        ADD       ESP, 10h

end;

{$ELSE ASM_VERSION} //Pascal

function Int2Str( Value : Integer ) : String;

var Buf : array[ 0..15 ] of Char;

    Dst : PChar;

    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^ := Char( (D mod 10) + Byte( '0' ) );

    D := D div 10;

  until D = 0;

  if Minus then

  begin

    Dec( Dst );

    Dst^ := '-';

  end;

  Result := Dst;

end;

{$ENDIF ASM_VERSION}

//[END Int2Str]



//[function UInt2Str]

function UInt2Str( Value: DWORD ): String;

var Buf : array[ 0..15 ] of Char;

    Dst : PChar;

    D: DWORD;

begin

  Dst := @Buf[ 15 ];

  Dst^ := #0;

  D := Value;

  repeat

    Dec( Dst );

    Dst^ := Char( (D mod 10) + Byte( '0' ) );

    D := D div 10;

  until D = 0;

  Result := Dst;

end;



//[function Int2StrEx]

function Int2StrEx( Value, MinWidth: Integer ): String;

begin

  Result := Int2Str( Value );

  while Length( Result ) < MinWidth do

    Result := ' ' + Result;

end;



//[function Int2Rome]

function Int2Rome( Value: Integer ): String;

const RomeDigs: String = 'IVXLCDMT';

  function RomeNum( N, FromIdx: Integer ): String;

  begin

    CASE N OF

    1, 2, 3:    Result := StrRepeat( RomeDigs[ FromIdx ], N );

    4:          Result := RomeDigs[ FromIdx ] + RomeDigs[ FromIdx + 1 ];

    5, 6, 7, 8: Result := RomeDigs[ FromIdx + 1 ] + StrRepeat( RomeDigs[ FromIdx ],

                       N - 5 );

    9:          Result := RomeDigs[ FromIdx ] + 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;



//[FUNCTION Int2Ths]

{$IFDEF ASM_VERSION}

function Int2Ths( I : Integer ) : String;

asm

        PUSH     EBP

        MOV      EBP, ESP

        PUSH     EAX

        PUSH     EDX

        CALL     Int2Str

        POP      EDX

        POP      EAX

        TEST     EAX, EAX

        JGE      @@0

        NEG      EAX

@@0:

        CMP      EAX, 1000

        JL       @@Exit

        PUSH     EDX

        MOV      EAX, [EDX]

        PUSH     EAX

        CALL     System.@LStrLen         // EAX = Length(Result)

        POP      EDX

        PUSH     EDX                     // EDX = @Result[ 1 ]

        XOR      ECX, ECX



@@1:

        ROL      ECX, 8

        DEC      EAX

        MOV      CL, [EDX+EAX]

        JZ       @@fin

        CMP      ECX, 300000h

        JL       @@1



        PUSH     ECX

        XOR      ECX, ECX

        MOV      CL, [ThsSeparator]

        JMP      @@1



@@fin:  //CMP      CX, ',-'

        CMP      CL, '-'

        JNE      @@fin1

        CMP      CH, [ThsSeparator]

        JNE      @@fin1

        MOV      CH, 0                   // this corrects -,ddd,...

@@fin1: CMP      ECX, 01000000h

        JGE      @@fin2

        INC      EAX

        ROL      ECX, 8

        JMP      @@fin1

@@fin2: PUSH     ECX



        LEA      EDX, [ESP+EAX]

        MOV      EAX, [EBP-4]

        CALL     System.@LStrFromPChar

@@Exit:

        MOV      ESP, EBP

        POP      EBP

end;

{$ELSE ASM_VERSION} //Pascal

function Int2Ths( I : Integer ) : String;

var S : String;

begin

  S := Int2Str( I );

  Result := '';

  while S <> '' do

  begin

    if Result <> '' then

       Result := ThsSeparator + Result;

    Result := CopyTail( S, 3 ) + Result;

    S := Copy( S, 1, Length( S ) - 3 );

  end;

  if Copy( Result, 1, 2 ) = '-' + ThsSeparator then

     Result := '-' + CopyEnd( Result, 3 );

end;

{$ENDIF ASM_VERSION}

//[END Int2Ths]



//[FUNCTION Int2Digs]

{$IFDEF ASM_VERSION}

function Int2Digs( Value, Digits : Integer ) : String;

asm

        PUSH     EBP

        MOV      EBP, ESP

        PUSH     EDX             // [EBP-4] = Digits

        PUSH     ECX

        MOV      EDX, ECX

        CALL     Int2Str

        POP      ECX

        PUSH     ECX             // [EBP-8] = @Result

        MOV      EAX, [ECX]

        PUSH     EAX

        CALL     System.@LStrLen

        POP      EDX             // EDX = @Result[1]

        MOV      ECX, EAX        // ECX = Length( Result )

        ADD      EAX, EAX

        SUB      ESP, EAX

        MOV      EAX, ESP

        PUSHAD

        CALL     StrCopy

        POPAD

        MOV      EDX, EAX

        ADD      ESP, -100

        CMP      byte ptr [EDX], '-'

        PUSHFD

        JNE      @@1

        INC      EDX

@@1:

        MOV      EAX, [EBP-4]    // EAX = Digits

        CMP      ECX, EAX

        JGE      @@2

        DEC      EDX

        MOV      byte ptr [EDX], '0'

        INC      ECX

        JMP      @@1

@@2:

        POPFD

        JNE      @@3

        DEC      EDX

        MOV      byte ptr [EDX], '-'

@@3:

        MOV      EAX, [EBP-8]

        CALL     System.@LStrFromPChar

        MOV      ESP, EBP

        POP      EBP

end;

{$ELSE ASM_VERSION} //Pascal

function Int2Digs( Value, Digits : Integer ) : String;

var M : String;

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 ASM_VERSION}

//[END Int2Digs]



//[FUNCTION Num2Bytes]

{$IFDEF ASM_VERSION}

function Num2Bytes( Value : Double ) : String;

asm

        PUSH     EBX

        PUSH     ESI

        PUSH     EDI

        MOV      EBX, ESP

        MOV      ESI, EAX



        MOV      ECX, 4

        MOV      EDX, 'TGMk'

@@1:

        FLD      [Value]

@@10:

        FICOM    dword ptr [@@1024]

        FSTSW    AX

        SAHF

        JB       @@2



        FIDIV    dword ptr [@@1024]

        FST      [Value]

        WAIT



        TEST     DL, 20h

        JE       @@ror

        AND      DL, not 20h

        JMP      @@nxt

@@1024: DD       1024

@@100:  DD       100



@@ror:

        ROR      EDX, 8

@@nxt:

        LOOP     @@10

@@2:

        TEST     DL, 20h

        JZ       @@3

        MOV      DL, 0

@@3:    MOV      DH, 0

        PUSH     DX

        MOV      EDI, ESP



        FLD      ST(0)

        CALL     System.@TRUNC

        {$IFDEF _D2orD3}

        PUSH     0

        {$ELSE}

        PUSH     EDX

        {$ENDIF}

        PUSH     EAX

        FILD     qword ptr [ESP]

        POP      EDX

        POP      EDX



        MOV      EDX, ESI

        CALL     Int2Str



        FSUBP    ST(1), ST

        FIMUL    dword ptr [@@100]

        CALL     System.@TRUNC



        TEST     EAX, EAX

        JZ       @@4



        XOR      ECX, ECX

        MOV      CL, 0Ah

        CDQ

        IDIV     ECX

        TEST     EDX, EDX

        JZ       @@5



        MOV      AH, DL

        SHL      EAX, 16

        ADD      EAX, '00. '

        PUSH     EAX

        MOV      EDI, ESP

        INC      EDI

        JMP      @@4



@@5:    SHL      EAX, 8

        ADD      AX, '0.'

        PUSH     AX

        MOV      EDI, ESP



@@4:

        MOV      EAX, [ESI]

        CALL     System.@LStrLen

        ADD      ESP, -100



        SUB      EDI, EAX

        PUSH     ESI

        PUSH     EDI

        MOV      ESI, [ESI]

        MOV      ECX, EAX

        REP      MOVSB



        POP      EDX

        POP      EAX

        CALL     System.@LStrFromPChar



        MOV      ESP, EBX

        POP      EDI

        POP      ESI

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function Num2Bytes( Value : Double ) : String;

const Suffix = 'KMGT';

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 + Suffix[ I ];

end;

{$ENDIF ASM_VERSION}

//[END Num2Bytes]



//[FUNCTION S2Int]

{$IFDEF ASM_VERSION}

function S2Int( S: PChar ): Integer;

asm

        XCHG     EDX, EAX

        XOR      EAX, EAX

        TEST     EDX, EDX

        JZ       @@exit



        XOR      ECX, ECX

        MOV      CL, [EDX]

        INC      EDX

        CMP      CL, '-'

        PUSHFD

        JE       @@0

@@1:    CMP      CL, '+'

        JNE      @@2

@@0:    MOV      CL, [EDX]

        INC      EDX

@@2:    SUB      CL, '0'

        CMP      CL, '9'-'0'

        JA       @@fin

        LEA      EAX, [EAX+EAX*4] //

        LEA      EAX, [ECX+EAX*2] //

        JMP      @@0

@@fin:  POPFD

        JNE      @@exit

        NEG      EAX

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

function S2Int( S: PChar ): 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^ in [ '0'..'9' ] do

   begin

      Result := Result * 10 + Integer( S^ ) - Integer( '0' );

      Inc( S );

   end;

   if M < 0 then

      Result := -Result;

end;

{$ENDIF ASM_VERSION}

//[END S2Int]



//[FUNCTION Str2Int]

{$IFDEF ASM_VERSION}

function Str2Int(const Value : String) : Integer;

asm

        CALL     EAX2PChar

        CALL     S2Int

end;

{$ELSE ASM_VERSION} //Pascal

function Str2Int(const Value : String) : Integer;

begin

  Result := S2Int( PChar( Value ) );

end;

{$ENDIF ASM_VERSION}

//[END Str2Int]



//[function StrCopy]

function StrCopy( Dest, Source: PChar ): PChar; 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};



function StrCat( Dest, Source: PChar ): PChar;

begin

  StrCopy( StrScan( Dest, #0 ), Source );

  Result := Dest;

end;



//[function StrScan]

function StrScan(Str: PChar; Chr: Char): PChar; 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};



//[function StrRScan]

function StrRScan(const Str: PChar; Chr: Char): PChar; 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};



//[function StrScanLen]

function StrScanLen(Str: PChar; Chr: Char; Len: Integer): PChar; 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};



//[FUNCTION TrimLeft]

{$IFDEF ASM_VERSION}

function TrimLeft(const S: string): string;

asm

        XCHG     EAX, EDX

        CALL     EDX2PChar

        DEC      EDX

@@1:    INC      EDX

        MOVZX    ECX, byte ptr [EDX]

        JECXZ    @@fin

        CMP      CL, ' '

        JBE      @@1

@@fin:

        CALL     System.@LStrFromPChar

end;

{$ELSE ASM_VERSION} //Pascal

function TrimLeft(const S: string): string;

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 ASM_VERSION}

//[END TrimLeft]



//[FUNCTION TrimRight]

{$IFDEF ASM_VERSION}

function TrimRight(const S: string): string;

asm

        PUSH     EDX

        PUSH     EAX



        PUSH     EAX

        CALL     System.@LStrLen

        XCHG     EAX, [ESP]

        //CALL     System.@LStrToPChar

        CALL     EAX2PChar

        POP      ECX

        INC      ECX

@@1:    DEC      ECX

        MOV      DL, [EAX+ECX]

        JL       @@fin

        CMP      DL, ' '

        JBE      @@1

@@fin:

        INC      ECX

        POP      EAX

        XOR      EDX, EDX

        INC      EDX

        CALL     System.@LStrCopy

end;

{$ELSE ASM_VERSION} //Pascal

function TrimRight(const S: string): string;

var

  I: Integer;

begin

  I := Length(S);

  while (I > 0) and (S[I] <= ' ') do Dec(I);

  Result := Copy(S, 1, I);

end;

{$ENDIF ASM_VERSION}

//[END TrimRight]



//[FUNCTION Trim]

{$IFDEF ASM_VERSION}

function Trim( const S : string): string;

asm

        PUSH     EDX

        CALL     TrimRight

        POP      EDX

        MOV      EAX, [EDX]

        CALL     TrimLeft

end;

{$ELSE ASM_VERSION} //Pascal

function Trim( const S : string): string;

begin

   Result := TrimLeft( TrimRight( S ) );

end;

{$ENDIF ASM_VERSION}

//[END Trim]



//[function RemoveSpaces]

function RemoveSpaces( const S: String ): String;

var I: Integer;

begin

  Result := S;

  for I := Length( S ) downto 1 do

    if S[ I ] <= ' ' then Delete( Result, I, 1 );

end;



//[procedure Str2LowerCase]

procedure Str2LowerCase( S: PChar );

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};



//[FUNCTION LowerCase]

{$IFDEF ASM_VERSION}

function LowerCase(const S: string): string;

asm

        PUSH     ESI

        XCHG     EAX, EDX

        PUSH     EAX

        CALL     System.@LStrAsg

        POP      EAX



        CALL     UniqueString



        PUSH     EAX

        CALL     System.@LStrLen

        POP      ESI



        XCHG     ECX, EAX



        JECXZ    @@exit



@@go:

        LODSB

        {$IFDEF PARANOIA}

        DB $2C, 'A'

        {$ELSE}

        SUB      AL, 'A'

        {$ENDIF}

        {$IFDEF PARANOIA}

        DB $3C, 26

        {$ELSE}

        CMP      AL, 'Z'-'A'+1

        {$ENDIF}

        JNB      @@1



        ADD      byte ptr [ESI - 1], 20h

@@1:

        LOOP     @@go

@@exit:

        POP      ESI

end;

{$ELSE ASM_VERSION} //Pascal

function LowerCase(const S: string): string;

var I : Integer;

begin

  Result := S;

  for I := 1 to Length( S ) do

    if Result[ I ] in [ 'A'..'Z' ] then

       Inc( Result[ I ], 32 );

end;

{$ENDIF ASM_VERSION}

//[END LowerCase]



//[FUNCTION UpperCase]

{$IFDEF ASM_VERSION}

function UpperCase(const S: string): string;

asm

        PUSH     ESI

        XCHG     EAX, EDX

        PUSH     EAX

        CALL     System.@LStrAsg

        POP      EAX



        CALL     UniqueString



        PUSH     EAX

        CALL     System.@LStrLen

        POP      ESI



        XCHG     ECX, EAX



        JECXZ    @@exit



@@go:

        LODSB

        {$IFDEF PARANOIA}

        DB $2C, 'a'

        {$ELSE}

        SUB      AL, 'a'

        {$ENDIF}

        {$IFDEF PARANOIA}

        DB $3C, $1A

        {$ELSE}

        CMP      AL, 'z'-'a'+1

        {$ENDIF}

        JNB      @@1



        SUB      byte ptr [ESI - 1], 20h

@@1:

        LOOP     @@go

@@exit:

        POP      ESI

end;

{$ELSE ASM_VERSION} //Pascal

function UpperCase(const S: string): string;

var I : Integer;

begin

  Result := S;

  for I := 1 to Length( S ) do

    if Result[ I ] in [ 'a'..'z' ] then

       Dec( Result[ I ], 32 );

end;

{$ENDIF ASM_VERSION}

//[END UpperCase]



{$IFDEF F_P}

//[function DummyStrFun]

function DummyStrFun( const S: String ): String;

begin

  Result := S;

end;

{$ENDIF F_P}



//[FUNCTION CopyEnd]

{$IFDEF ASM_VERSION}

function CopyEnd( const S : String; Idx : Integer ) : String;

asm

        PUSH     ECX

        PUSH     EAX

        PUSH     EDX



        CALL     System.@LStrLen



        POP      EDX

        TEST     EDX, EDX

        JG       @@1

        XOR      EDX, EDX

        INC      EDX

@@1:

        SUB      EAX, EDX

        MOV      ECX, EAX



        POP      EAX

        JGE      @@ret_end



        POP      EAX

        JL       System.@LStrClr



@@ret_end:

        INC      ECX

        CALL     System.@LStrCopy

end;

{$ELSE ASM_VERSION} //Pascal

function CopyEnd( const S : String; Idx : Integer ) : String;

begin

  Result := Copy( S, Idx, MaxInt );

end;

{$ENDIF ASM_VERSION}

//[END CopyEnd]



//[FUNCTION CopyTail]

{$IFDEF ASM_VERSION}

function CopyTail( const S : String; Len : Integer ) : String;

asm

        PUSH     ECX

        PUSH     EAX

          PUSH     EDX

            CALL     System.@LStrLen

          POP      ECX

          CMP      ECX, EAX

          {$IFDEF USE_CMOV}

          CMOVG    ECX, EAX

          {$ELSE}

          JLE      @@1

          MOV      ECX, EAX

@@1:      {$ENDIF}



        MOV      EDX, EAX

        SUB      EDX, ECX

        INC      EDX

        POP      EAX

        CALL     System.@LStrCopy

end;

{$ELSE ASM_VERSION} //Pascal

function CopyTail( const S : String; Len : Integer ) : String;

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 ASM_VERSION}

//[END CopyTail]



//[PROCEDURE DeleteTail]

{$IFDEF ASM_VERSION}

procedure DeleteTail( var S : String; Len : Integer );

asm

        PUSH     EAX

        PUSH     EDX

        MOV      EAX, [EAX]

        CALL     System.@LStrLen

        POP      ECX

        CMP      ECX, EAX

        {$IFDEF USE_CMOV}

        CMOVG    ECX, EAX

        {$ELSE}

        JLE      @@1

        MOV      ECX, EAX

@@1:    {$ENDIF}



        MOV      EDX, EAX

        SUB      EDX, ECX

        INC      EDX

        POP      EAX

        CALL     System.@LStrDelete

end;

{$ELSE ASM_VERSION} //Pascal

procedure DeleteTail( var S : String; Len : Integer );

var L : Integer;

begin

  L := Length( S );

  if Len > L then

     Len := L;

  Delete( S, L - Len + 1, Len );

end;

{$ENDIF ASM_VERSION}

//[END DeleteTail]



//[FUNCTION IndexOfChar]

{$IFDEF ASM_VERSION}

function IndexOfChar( const S : String; Chr : Char ) : Integer;

asm

        //PUSH     EDX

        //CALL     System.@LStrToPChar

        //POP      EDX

        CALL     EAX2PChar

        PUSH     EAX

        CALL     StrScan

        POP      EDX

        TEST     EAX, EAX

        JE       @@exit__1

        SUB      EAX, EDX

        INC      EAX

        RET

@@exit__1:

        DEC      EAX

end;

{$ELSE ASM_VERSION} //Pascal

function IndexOfChar( const S : String; Chr : Char ) : Integer;

var P, F : PChar;

begin

   P := PChar( S );

   F := StrScan( P, Chr );

   Result := -1;

   if F = nil then Exit;

   Result := Integer( F ) - Integer( P ) + 1;

end;

{$ENDIF ASM_VERSION}

//[END IndexOfChar]



//[FUNCTION IndexOfCharsMin]

{$IFDEF ASM_VERSION}

function IndexOfCharsMin( const S, Chars : String ) : Integer;

asm

        PUSH     ESI

        PUSH     EAX

        CALL     EDX2PChar

        MOV      ESI, EDX



        XOR      ECX, ECX

        DEC      ECX



@@1:    LODSB

        TEST     AL, AL

        JZ       @@exit



        XCHG     EDX, EAX

        POP      EAX

        PUSH     EAX



        PUSH     ECX

        CALL     IndexOfChar

        POP      ECX

        TEST     EAX, EAX

        JLE      @@1



        TEST     ECX, ECX

        JLE      @@2

        CMP      EAX, ECX

        JGE      @@1

@@2:    //XCHG     ECX, EAX

        //JMP      @@1



@@exit: XCHG     EAX, ECX

          JL     @@1

        POP      ECX

        POP      ESI

end;

{$ELSE ASM_VERSION} //Pascal

function IndexOfCharsMin( const S, Chars : String ) : 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 ASM_VERSION}

//[END IndexOfCharsMin]



{$IFNDEF _FPC}

{$IFNDEF _D2}

//[function IndexOfWideCharsMin]

function IndexOfWideCharsMin( const S, Chars : WideString ) : 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}



//[FUNCTION IndexOfStr]

{$IFDEF ASM_VERSION}

function IndexOfStr( const S, Sub : String ) : Integer;

asm

        PUSH     EBX

        PUSH     ESI

        PUSH     EDI



        PUSH     EAX

        MOV      EAX, EDX

        PUSH     EDX

        CALL     System.@LStrLen

        MOV      EDI, EAX

        POP      EAX

        //CALL     System.@LStrToPChar

        CALL     EAX2PChar

        MOV      BL, [EAX]

        XCHG     EAX, [ESP]

        //CALL     System.@LStrToPChar

        CALL     EAX2PChar



        MOV      ESI, EAX



        DEC      EAX

@@1:    INC      EAX

        MOV      DL, BL

        CALL     StrScan

        TEST     EAX, EAX

        JE       @@exit__1



        POP      EDX

        PUSH     EDX



        MOV      ECX, EDI

        PUSH     EAX

        CALL     StrLComp

        POP      EAX

        JNE      @@1



        SUB      EAX, ESI

        INC      EAX

        JMP      @@exit



@@exit__1:

        DEC      EAX

@@exit:

        POP      EDX

        POP      EDI

        POP      ESI

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function IndexOfStr( const S, Sub : String ) : Integer;

var I : Integer;

begin

  Result := Length( S );

  if Sub = '' then Exit;

  Result := 0;

  if S = '' then Exit;

  if Length( Sub ) > Length( S ) then Exit;

  Result := 1;

  while Result + Length( Sub ) - 1 <= Length( S ) do

  begin

    I := IndexOfChar( CopyEnd( S, Result ), Sub[ 1 ] );

    if I <= 0 then break;

    Result := Result + I - 1;

    if Result <= 0 then Exit;

    if Copy( S, Result, Length( Sub ) ) = Sub then Exit;

    Inc( Result );

  end;

  Result := -1;

end;

{$ENDIF ASM_VERSION}

//[END IndexOfStr]



//[FUNCTION Parse]

{$IFDEF ASM_VERSION} //???

function Parse( var S : String; const Separators : String ) : String;

asm

         PUSH    EBX

         PUSH    EDI

         MOV     EBX, EAX



         PUSH    ECX

         MOV     EAX, [EBX]

         CALL    IndexOfCharsMin

         INC     EAX

         JNE     @@1

         MOV     EAX, [EBX]

         CALL    System.@LStrLen

         INC     EAX

         INC     EAX

@@1:

         DEC     EAX

         MOV     EDI, EAX

         MOV     ECX, EAX

         DEC     ECX

         XOR     EDX, EDX

         INC     EDX

         MOV     EAX, [EBX]

         CALL    System.@LStrCopy



         MOV     EAX, [EBX]

         MOV     EDX, EDI

         INC     EDX

         MOV     ECX, EBX

         CALL    CopyEnd



         POP     EDI

         POP     EBX

end;

{$ELSE ASM_VERSION} //Pascal

function Parse( var S : String; const Separators : String ) : String;

var Pos : Integer;

begin

  Pos := IndexOfCharsMin( 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 ASM_VERSION}

//[END Parse]



{$IFNDEF _FPC}

{$IFNDEF _D2}

//[function WParse]

function WParse( var S : WideString; const Separators : WideString ) : WideString;

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]

function ParsePascalString( var S : String; const Separators : String ) : String;

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 : String;

    Ou, Val : Integer;

begin

  Pos := 1;

  Spc := IndexOfChar( Separators, ' ' ) >= 0;

  SkipSpaces;

  if Length( S ) < Pos then

  begin

    Result := S;

    S := '';

    exit;

  end;

  Buf := PChar( S );

  Ou := 1;

  if S[ Pos ] in [ '''', '#' ] 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;

        //if Pos < Length( S ) then Inc( Pos );

      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 ] in [ '0'..'9' ]) or

             Hex and (S[ Pos ] in [ 'a'..'f', 'A'..'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 ] := Char( 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]

function String2PascalStrExpr( const S : String ) : String;

var I, Strt : Integer;

  function String2DoubleQuotas( const S : String ) : String;

  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 ] < ' ') 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;



//[function CompareMem]

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};



//[FUNCTION AllocMem]

{$IFDEF ASM_VERSION}

function AllocMem( Size : Integer ) : Pointer;

asm     //cmd    //opd

        TEST     EAX, EAX

        JZ       @@exit

        PUSH     EAX

        CALL     System.@GetMem

        POP      EDX

        PUSH     EAX

        MOV      CL, 0

        CALL     System.@FillChar

        POP      EAX

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

function AllocMem( Size : Integer ) : Pointer;

begin

   Result := nil;

   if Size > 0 then

   begin

     GetMem( Result, Size );

     FillChar( Result^, Size, 0 );

   end;

end;

{$ENDIF ASM_VERSION}

//[END AllocMem]



//[procedure DisposeMem]

procedure DisposeMem( var Addr : Pointer );

begin

   if Addr <> nil then

      FreeMem( Addr );

   Addr := nil;

end;



//[function AnsiUpperCase]

function AnsiUpperCase(const S: string): string;

var

  Len: Integer;

begin

  Len := Length(S);

  SetString(Result, PChar(S), Len);

  if Len > 0 then CharUpperBuff(Pointer(Result), Len);

end;



//[function AnsiLowerCase]

function AnsiLowerCase(const S: string): string;

var

  Len: Integer;

begin

  Len := Length(S);

  SetString(Result, PChar(S), Len);

  if Len > 0 then CharLowerBuff(Pointer(Result), Len);

end;



{$IFNDEF _D2}

{$IFNDEF _FPC}

//[function WAnsiUpperCase]

function WAnsiUpperCase(const S: WideString): WideString;

var Len: Integer;

begin

  Len := Length(S);

  Result := S;

  if Len > 0 then CharUpperBuffW(Pointer(Result), Len);

end;



//[function WAnsiLowerCase]

function WAnsiLowerCase(const S: WideString): WideString;

var Len: Integer;

begin

  Len := Length(S);

  Result := S;

  if Len > 0 then CharLowerBuffW(Pointer(Result), Len);

end;

{$ENDIF _FPC}

{$ENDIF _D2}



//[function AnsiCompareStr]

function AnsiCompareStr(const S1, S2: string): Integer;

begin

  Result := CompareString(LOCALE_USER_DEFAULT, 0, PChar(S1), -1,

    PChar(S2), -1 ) - 2;

end;



//[function _AnsiCompareStr]

function _AnsiCompareStr(S1, S2: PChar): Integer;

begin

  Result := CompareString( LOCALE_USER_DEFAULT, 0, S1, -1,

                           S2, -1) - 2;

end;



//[function AnsiCompareStrNoCase]

function AnsiCompareStrNoCase(const S1, S2: string): Integer;

begin

  Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S1), -1,

    PChar(S2), -1 ) - 2;

end;



//[function _AnsiCompareStrNoCase]

function _AnsiCompareStrNoCase(S1, S2: PChar): Integer;

begin

  Result := CompareString( LOCALE_USER_DEFAULT, NORM_IGNORECASE, S1, -1,

                           S2, -1) - 2;

end;



//[function AnsiCompareText]

function AnsiCompareText( const S1, S2: String ): Integer;

begin

  Result := AnsiCompareStrNoCase( S1, S2 );

end;



//[function StrLCopy]

function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; 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};



//[FUNCTION StrPCopy]

{$IFDEF ASM_VERSION}

function StrPCopy(Dest: PChar; const Source: string): PChar;

asm

        PUSH     EAX

        MOV      EAX, EDX

        CALL     System.@LStrLen

        MOV      ECX, EAX

        POP      EAX

        CALL     EDX2PChar

        CALL     StrLCopy

end;

{$ELSE ASM_VERSION} //Pascal

function StrPCopy(Dest: PChar; const Source: string): PChar;

begin

  Result := StrLCopy(Dest, PChar(Source), Length(Source));

end;

{$ENDIF ASM_VERSION}

//[END StrPCopy]



//[FUNCTION StrEq]

{$IFDEF ASM_VERSION}

function StrEq( const S1, S2 : String ) : Boolean;

asm

        TEST     EDX, EDX

        JNZ      @@1

@@0:    CMP      EAX, EDX

        JMP      @@exit

@@1:    TEST     EAX, EAX

        JZ       @@0

        MOV      ECX, [EAX-4]

        CMP      ECX, [EDX-4]

        JNE      @@exit

        PUSH     EAX

        PUSH     EDX

        PUSH     0

        MOV      EDX, ESP

        CALL     LowerCase

        PUSH     0

        MOV      EAX, [ESP + 8]

        MOV      EDX, ESP

        CALL     LowerCase

        POP      EAX

        POP      EDX

        PUSH     EDX

        PUSH     EAX

        CALL     System.@LStrCmp

        MOV      EAX, ESP

        PUSHFD

        XOR      EDX, EDX

        MOV      DL, 2

        CALL     System.@LStrArrayClr

        POPFD

        POP      EDX

        POP      EDX

        POP      EDX

        POP      EDX

@@exit:

        SETZ     AL

end;

{$ELSE ASM_VERSION} //Pascal

function StrEq( const S1, S2 : String ) : Boolean;

begin

  Result := (Length( S1 ) = Length( S2 )) and

            (LowerCase( S1 ) = LowerCase( S2 ));

end;

{$ENDIF ASM_VERSION}

//[END StrEq]



//[FUNCTION AnsiEq]

{$IFDEF ASM_VERSION}

function AnsiEq( const S1, S2 : String ) : Boolean;

asm

        CALL     AnsiCompareStrNoCase

        TEST     EAX, EAX

        SETZ     AL

end;

{$ELSE ASM_VERSION} //Pascal

function AnsiEq( const S1, S2 : String ) : Boolean;

begin

  Result := AnsiCompareStrNoCase( S1, S2 ) = 0;

end;

{$ENDIF ASM_VERSION}

//[END AnsiEq]



{$IFNDEF _D2}

{$IFNDEF _FPC}

//[function WAnsiEq]

function WAnsiEq( const S1, S2 : WideString ) : Boolean;

begin

  Result := WAnsiLowerCase( S1 )=WAnsiLowerCase( S2 );

end;

{$ENDIF _FPC}

{$ENDIF _D2}



//[FUNCTION StrIn]

{$IFDEF ASM_VERSION}

function StrIn(const S: String; const A: array of String): Boolean;

asm

@@1:

        TEST     ECX, ECX

        JL       @@ret_0



        PUSH     EDX

        MOV      EDX, [EDX+ECX*4]

        DEC      ECX



        PUSH     ECX

        PUSH     EAX

        CALL     StrEq

        DEC      AL

        POP      EAX

        POP      ECX



        POP      EDX

        JNZ      @@1



        MOV      AL, 1

        RET



@@ret_0:XOR      EAX, EAX

end;

{$ELSE ASM_VERSION} //Pascal

function StrIn(const S: String; const A: array of String): 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 ASM_VERSION}

//[END StrIn]



{$IFNDEF _D2}

{$IFNDEF _FPC}

//[function WStrIn]

function WStrIn( const S : WideString; const A : array of WideString ) : 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 StrIs]

function StrIs( const S : String; const A : array of String; 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]

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;



//[FUNCTION _StrSatisfy]

{$IFDEF ASM_VERSION}

function _StrSatisfy( S, Mask : PChar ) : Boolean;

asm

    TEST EAX, EAX

    JZ   @@exit

        XCHG     ECX, EAX

        //       EDX <- Mask

        //       ECX <- S

        XOR      EAX, EAX

        MOV      AL, '*'

@@rest_satisfy:

        PUSH     ECX

        PUSH     EDX



@@nx_char:

        MOV      AH, [EDX]

        OR       AH, [ECX]

        JZ       @@fin //@@ret_true



        MOV      AH, 0



        CMP      word ptr [EDX], AX //'*'

        JE       @@fin //@@ret_true



        CMP      byte ptr [ECX], AH

        JNE      @@10



        DEC      EDX

@@1:

        INC      EDX

        CMP      byte ptr [EDX], AL //'*'

        JE       @@1

        //CMP      byte ptr [EDX], '?'

        //JE       @@1



        CMP      byte ptr [EDX], AH

        SETZ     AL

        JMP      @@fin



@@10:   CMP      byte ptr [EDX], AH

        JE       @@ret_false



        CMP      byte ptr [EDX], '?'

        JNE      @@11



@@go_nx_char:

        INC      ECX

        INC      EDX

        JMP      @@nx_char



@@11:

        CMP      byte ptr [EDX], AL //'*'

        JNE      @@20



        INC      EDX

@@12:   CMP      byte ptr [ECX], AH

        JE       @@ret_false



        CALL     @@rest_satisfy

        TEST     AL, AL

        JNE      @@fin

        MOV      AL, '*'



        INC      ECX

        JMP      @@12



@@20:   MOV      AH, [EDX]

        XOR      AH, [ECX]



        JE       @@go_nx_char

@@ret_false:

        XOR      EAX, EAX



@@fin:

        POP      EDX

        POP      ECX

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

function _StrSatisfy( S, Mask : PChar ) : 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 ASM_VERSION}

//[END _StrSatisfy]



//[FUNCTION StrSatisfy]

{$IFDEF ASM_VERSION}

function StrSatisfy( const S, Mask: String ): Boolean;

asm

        PUSH     ESI

        XCHG     ESI, EAX

        PUSH     0

        XCHG     EAX, EDX

        CALL     EAX2PChar

        MOV      EDX, ESP



        CMP      byte ptr [EAX], 0

        JZ       @@0

        CALL     AnsiLowerCase

@@0:

        XCHG     EAX, ESI

        PUSH     0

        CALL     EAX2PChar

        MOV      EDX, ESP



        CMP      byte ptr [EAX], 0

        JZ       @@1

        CALL     AnsiLowerCase

@@1:

        POP      EAX

        POP      EDX

        PUSH     EDX

        PUSH     EAX

        CALL     _StrSatisfy



        XCHG     ESI, EAX



        CALL     RemoveStr

        CALL     RemoveStr

        XCHG     EAX, ESI



        POP      ESI

end;

{$ELSE ASM_VERSION} //Pascal

function StrSatisfy( const S, Mask: String ): Boolean;

begin

  Result := _StrSatisfy( PChar( AnsiLowerCase( S ) ),

                         PChar( AnsiLowerCase( Mask ) ) );

end;

{$ENDIF ASM_VERSION}

//[END StrSatisfy]



//[FUNCTION _2StrSatisfy]

{$IFDEF ASM_VERSION}

function _2StrSatisfy( S, Mask: PChar ): Boolean;

asm     //     //

        PUSH   EBX

        XCHG   EBX, EAX

        PUSH   0

        MOV    EAX, ESP

        CALL   System.@LStrFromPChar

        PUSH   0

        MOV    EAX, ESP

        MOV    EDX, EBX

        CALL   System.@LStrFromPChar

        POP    EAX

        POP    EDX

        PUSH   EDX

        PUSH   EAX

        CALL   StrSatisfy

        XCHG   EBX, EAX

        CALL   RemoveStr

        CALL   RemoveStr

        XCHG   EAX, EBX

        POP    EBX

end;

{$ELSE ASM_VERSION} // Pascal

function _2StrSatisfy( S, Mask: PChar ): Boolean;

begin

  Result := StrSatisfy( S, Mask );

end;

{$ENDIF ASM_VERSION}

//[END _2StrSatisfy]



//[function StrReplace]

function StrReplace( var S: String; const From, ReplTo: String ): 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]

procedure SetLengthW( var W: WideString; 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]

function CopyW( const W: WideString; From, Count: Integer ): WideString;

begin

  Result := '';

  if Count <= 0 then Exit;

  SetLengthW( Result, Count );

  Move( W[ From ], Result[ 1 ], Count * Sizeof( WideChar ) );

end;



//[function posW]

function posW( const S1, S2: String ): Integer;

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}



{$IFNDEF _FPC}

{$IFNDEF _D2}

//[function WStrReplace]

function WStrReplace( var S: WideString; const From, ReplTo: WideString ): 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]

function WStrRepeat( const S: WideString; Count: Integer ): WideString;

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 ], L * Sizeof( WideChar ) );

end;

{$ENDIF _D2}

{$ENDIF _FPC}



{+}

//[function StrRepeat]

function StrRepeat( const S: String; Count: Integer ): String;

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 ], L );

end;





//[PROCEDURE NormalizeUnixText]

{$IFDEF ASM_VERSION}

procedure NormalizeUnixText( var S: String );

asm     //cmd    //opd

        CMP      dword ptr [EAX], 0

        JZ       @@exit

        PUSH     EBX

        PUSH     EDI

        MOV      EBX, EAX

        CALL     UniqueString

        MOV      EDI, [EBX]

@@1:    MOV      EAX, EDI

        CALL     System.@LStrLen

        XCHG     ECX, EAX

        MOV      AX, $0D0A



        CMP      byte ptr [EDI], AL

        JNE      @@loo

        MOV      byte ptr [EDI], AH

@@loo:

        TEST     ECX, ECX

        JZ       @@fin

@@loo1:

        REPNZ SCASB

        JNZ      @@fin

        CMP      byte ptr [EDI-2], AH

        JE       @@loo

        MOV      byte ptr [EDI-1], AH

        JNE      @@loo1

@@fin:  POP      EDI

        POP      EBX

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

procedure NormalizeUnixText( var S: String );

var I: Integer;

begin

  if S <> '' then

  begin

    if S[ 1 ] = #10 then

      S[ 1 ] := #13;

    for I := 2 to Length(S) do

      if (S[I]=#10) and (S[I-1]<>#13) then

        S[I] := #13;

  end;

end;

{$ENDIF ASM_VERSION}

//[END NormalizeUnixText]



//[function StrComp]

function StrComp(const Str1, Str2: PChar): 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};



function StrComp_NoCase(const Str1, Str2: PChar): 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]

function StrLComp_NoCase(const Str1, Str2: PChar; 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};



//[function StrLComp]

function StrLComp(const Str1, Str2: PChar; 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};



//[function StrLen]

function StrLen(const Str: PChar): 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};



//[FUNCTION __DelimiterLast]

{$IFDEF ASM_VERSION}

function __DelimiterLast( Str: PChar; Delimiters: PChar ): PChar;

asm

        PUSH     ESI



        CALL     EAX2PChar



        MOV      ESI, EDX

        MOV      EDX, EAX



@@tolast:

        CMP      byte ptr [EAX], 0

        JZ       @@next1

        INC      EAX

        JMP      @@tolast



@@next1:

        PUSH     EAX



@@next:

        LODSB

        TEST     AL, AL

        JZ       @@exit



        PUSH     EDX

        XCHG     EDX, EAX

        CALL     StrRScan

        POP      EDX



        TEST     EAX, EAX

        JZ       @@next



        POP      ECX

        CMP      byte ptr [ECX], 0

        JZ       @@next1



        CMP      EAX, ECX

        JG       @@next1



        PUSH     ECX

        JLE      @@next



@@exit: POP      EAX

        POP      ESI

end;

{$ELSE ASM_VERSION} //Pascal

function __DelimiterLast( Str: PChar; Delimiters: PChar ): PChar;

var

    P, F : PChar;

begin

  P := Str;

  Result := P + StrLen( Str );

  while Delimiters^ <> #0 do

  begin

    F := StrRScan( P, Delimiters^ );

    if F <> nil then

    if (Result^ = #0) or (Integer(F) > Integer(Result)) then

       Result := F;

    Inc( Delimiters );

  end;

end;

{$ENDIF ASM_VERSION}

//[END __DelimiterLast]



//[function SkipSpaces]

function SkipSpaces( P: PChar ): PChar;

begin

  while True do

  begin

    while (P[0] <> #0) and (P[0] <= ' ') do Inc(P);

    if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;

  end;

  Result := P;

end;



//[function SkipParam]

function SkipParam(P: PChar): PChar;

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;



//[FUNCTION ParamStr]

function ParamStr( Idx: Integer ): String;

var

  P, P1: PChar;

  Buffer: array[ 0..260 ] of Char;

begin

  if Idx = 0 then

    SetString( Result, Buffer, GetModuleFileName( 0, Buffer, Sizeof( Buffer ) ) )

  else

  begin

    P := GetCommandLine;

    repeat

      P := SkipSpaces( P );

      P1 := P;

      P := SkipParam(P);

      if Idx = 0 then Break;

      Dec(Idx);

    until (Idx < 0) or (P = P1);

    Result := Copy( P1, 1, P - P1 );

    if Length( Result ) >= 2 then

    if (Result[ 1 ] = '"') and (Result[ Length( Result ) ] = '"') then

      Result := Copy( Result, 2, Length( Result ) - 2 );

  end;

end;

//[END ParamStr]



//[FUNCTION ParamCount]

function ParamCount: Integer;

var

  S: string;

begin

  Result := 0;

  while True do

  begin

    S := ParamStr(Result + 1);

    if S = '' then Break;

    Inc(Result);

  end;

end;

//[END ParamCount]



//[FUNCTION DelimiterLast]

{$IFDEF ASM_VERSION}

function DelimiterLast( const Str, Delimiters: String ): Integer;

asm

        CALL     EAX2PChar

        CALL     EDX2PChar

        PUSH     EAX

        CALL     __DelimiterLast

        POP      EDX

        SUB      EAX, EDX

        INC      EAX

end;

{$ELSE ASM_VERSION} //Pascal

function DelimiterLast( const Str, Delimiters: String ): Integer;

var PStr: PChar;

begin

  PStr := PChar( Str );

  Result := Integer( __DelimiterLast( PStr, PChar( Delimiters ) ) )

          - Integer( PStr )

          + 1; // {Viman}

end;

{$ENDIF ASM_VERSION}

//[END DelimiterLast]



// Thanks to Marco Bobba - Marisa Bo for this code

//[function StrIsStartingFrom]

function StrIsStartingFrom( Str, Pattern: PChar ): 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, CH

        JE      @@1

      @@2:

        TEST    CL, CL

        SETZ    AL

end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};



function StrIsStartingFromNoCase( Str, Pattern: PChar ): 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};



{$IFNDEF _FPC}

//[FUNCTION Format]

{$IFDEF ASM_VERSION}

function Format( const fmt: string; params: array of const ): String;

asm

        PUSH    ESI

        PUSH    EDI

        PUSH    EBX

        MOV     EBX, ESP

        ADD     ESP, -2048

        MOV     ESI, ESP



        INC     ECX

        JZ      @@2

@@1:

        MOV     EDI, [EDX + ECX*8 - 8]

        PUSH    EDI

        LOOP    @@1

@@2:

        PUSH    ESP

        PUSH    EAX

        PUSH    ESI



        CALL    wvsprintf



        MOV     EDX, ESI

        MOV     EAX, @Result

        CALL    System.@LStrFromPChar



        MOV     ESP, EBX

        POP     EBX

        POP     EDI

        POP     ESI

end;

{$ELSE ASM_VERSION} //Pascal

function Format( const fmt: string; params: array of const ): String;

var Buffer: array[ 0..2047 ] of Char;

    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( @Buffer[0], PChar( fmt ), PChar( ElsArray ) );

  Result := Buffer;

  if ElsArray <> nil then

     FreeMem( ElsArray );

end;

{$ENDIF ASM_VERSION}

//[END Format]



//[function LStrFromPWCharLen]

function LStrFromPWCharLen(Source: PWideChar; Length: Integer): String;

var

  DestLen: Integer;

  Buffer: array[0..2047] of Char;

begin

  if Length <= 0 then

  begin

    //_LStrClr(Result);

    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;

      //System.LStrFromPCharLen(Result, Buffer, DestLen);

      Exit;

    end;

  end;

  DestLen := WideCharToMultiByte(0, 0, Source, Length, nil, 0, nil, nil);

  // _LStrFromPCharLen(Dest, nil, DestLen);

  SetLength( Result, DestLen );

  WideCharToMultiByte(0, 0, Source, Length, Pointer(Result), DestLen, nil, nil);

end;



//[function LStrFromPWChar]

function LStrFromPWChar(Source: PWideChar): String;

{* 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 _FPC}





/////////////////////////////////////////////////////////////////////////

//

//

//                          F   I   L   E   S

//

//

/////////////////////////////////////////////////////////////////////////

//[FILES]

{

   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 ASM_VERSION}



//[FUNCTION FileCreate]

{$IFDEF ASM_VERSION}

function FileCreate( const FileName: string; OpenFlags: DWord): THandle;

asm

        XOR      ECX, ECX

        PUSH     ECX

        MOV      ECX, EDX

        SHR      ECX, 16

        AND      CX, $1FFF

        JNZ      @@1

        MOV      CL, FILE_ATTRIBUTE_NORMAL

@@1:    PUSH     ECX

        MOV      CL, DH

        PUSH     ECX                  // CreationMode

        PUSH     0

        MOV      CL, DL

        PUSH     ECX                  // ShareMode

        MOV      DX, 0

        PUSH     EDX                  // AccessMode

        //CALL     System.@LStrToPChar // FileName must not be ''

        PUSH     EAX

        CALL     CreateFile

end;

{$ELSE ASM_VERSION} //Pascal

function FileCreate(const FileName: string; OpenFlags: DWord): THandle;

var Attr: DWORD;

begin

  Attr := (OpenFlags shr 16) and $1FFF;

  if Attr = 0 then Attr := FILE_ATTRIBUTE_NORMAL;

  Result := CreateFile( PChar(FileName), OpenFlags and $F0000000,

                        OpenFlags and $F, nil, (OpenFlags shr 8) and $F,

                        Attr, 0 );

end;

{$ENDIF ASM_VERSION}

//[END FileCreate]



//[FUNCTION FileClose]

{$IFDEF ASM_VERSION}

function FileClose( Handle: THandle): Boolean;

asm

        PUSH     EAX

        CALL     CloseHandle

        TEST     EAX, EAX

        SETNZ    AL

end;

{$ELSE ASM_VERSION} //Pascal

function FileClose(Handle: THandle): boolean;

begin

     Result := CloseHandle(Handle);

end;

{$ENDIF ASM_VERSION}

//[END FileClose]



//[FUNCTION FileExists]

{$IFDEF ASM_VERSION}

function FileExists( const FileName : String ) : Boolean;

const size_TWin32FindData = sizeof( TWin32FindData );

asm

        CALL     EAX2PChar

        PUSH     EAX

        CALL     GetFileAttributes

        INC      EAX

        JZ       @@exit

        DEC      EAX

        {$IFDEF PARANOIA}

        DB $24, FILE_ATTRIBUTE_DIRECTORY

        {$ELSE}

        AND      AL, FILE_ATTRIBUTE_DIRECTORY

        {$ENDIF}

        SETZ     AL

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

function FileExists( const FileName : String ) : Boolean;

var

  Code: Integer;

begin

  Code := GetFileAttributes(PChar(FileName));

  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code = 0);

end;

{$ENDIF ASM_VERSION}

//[END FileExists]



//[FUNCTION FileSeek]

{$IFDEF ASM_VERSION}

function FileSeek( Handle: THandle; MoveTo: integer; MoveMethod: TMoveMethod): DWord;

asm

        MOVZX    ECX, CL

        PUSH     ECX

        PUSH     0

        PUSH     EDX

        PUSH     EAX

        CALL     SetFilePointer

end;

{$ELSE ASM_VERSION} //Pascal

function FileSeek(Handle: THandle; MoveTo: integer; MoveMethod: TMoveMethod): DWord;

begin

  Result := SetFilePointer(Handle, MoveTo, nil, Ord( MoveMethod ) );

end;

{$ENDIF ASM_VERSION}

//[END FileSeek]



//[FUNCTION FileRead]

{$IFDEF ASM_VERSION}

function FileRead( Handle: THandle; var Buffer; Count: DWord): DWord;

asm

        PUSH     EBP

        PUSH     0

        MOV      EBP, ESP

        PUSH     0

        PUSH     EBP

        PUSH     ECX

        PUSH     EDX

        PUSH     EAX

        CALL     ReadFile

        TEST     EAX, EAX

        POP      EAX

        JNZ      @@exit

        XOR      EAX, EAX

@@exit:

        POP      EBP

end;

{$ELSE ASM_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 ASM_VERSION}

//[END FileRead]



//[FUNCTION File2Str]

{$IFDEF ASM_VERSION}

function File2Str( Handle: THandle): String;

asm

        PUSH     EDX

        TEST     EAX, EAX

        JZ       @@exit // return ''



        PUSH     EBX

        MOV      EBX, EAX // EBX = Handle

        XOR      EDX, EDX

        XOR      ECX, ECX

        INC      ECX

        CALL     FileSeek

        PUSH     EAX // Pos

        PUSH     0

        PUSH     EBX

        CALL     GetFileSize

        POP      EDX

        SUB      EAX, EDX // EAX = Size - Pos

        JZ       @@exitEBX



        PUSH     EAX

        CALL     System.@GetMem

        XCHG     EAX, EBX

        MOV      EDX, EBX

        POP      ECX

        PUSH     ECX

        CALL     FileRead

        POP      ECX

        MOV      EDX, EBX

        POP      EBX

        POP      EAX

        PUSH     EDX

        {$IFDEF _D2}

        CALL     _LStrFromPCharLen

        {$ELSE}

        CALL     System.@LStrFromPCharLen

        {$ENDIF}

        JMP      @@freebuf



@@exitEBX:

        POP      EBX

@@exit:

        XCHG     EDX, EAX

        POP      EAX // @Result

        PUSH     EDX

        CALL     System.@LStrFromPChar

@@freebuf:

        POP      EAX

        TEST     EAX, EAX

        JZ       @@fin

        CALL     System.@FreeMem

@@fin:

end;

{$ELSE ASM_VERSION} //Pascal

function File2Str(Handle: THandle): String;

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 ASM_VERSION}

//[END File2Str]



//[FUNCTION FileWrite]

{$IFDEF ASM_VERSION}

function FileWrite( Handle: THandle; const Buffer; Count: DWord): DWord;

asm

        PUSH     EBP

        PUSH     EBP

        MOV      EBP, ESP

        PUSH     0

        PUSH     EBP

        PUSH     ECX

        PUSH     EDX

        PUSH     EAX

        CALL     WriteFile

        TEST     EAX, EAX

        POP      EAX

        JNZ      @@exit

        XOR      EAX, EAX

@@exit:

        POP      EBP

end;

{$ELSE ASM_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 ASM_VERSION}

//[END FileWrite]



//[FUNCTION FileEOF]

{$IFDEF ASM_VERSION}

function FileEOF( Handle: THandle ) : Boolean;

asm

        PUSH     EAX



        PUSH     0

        PUSH     EAX

        CALL     GetFileSize



        XCHG     EAX, [ESP]



        MOV      CL, spCurrent

        XOR      EDX, EDX

        CALL     FileSeek



        POP      EDX

        CMP      EAX, EDX

        SETGE    AL

end;

{$ELSE ASM_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 ASM_VERSION}

//[END FileEOF]



//[FUNCTION FileFullPath]

{$IFDEF ASM_noVERSION}

function FileFullPath( const FileName: String ) : String;

const

  BkSlash: String = '\';

  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]

        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 ASM_VERSION} //Pascal

function FileFullPath( const FileName: String ) : String;

var SFI: TShFileInfo;

    Src, S: String;

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

      ShGetFileInfo( PChar( 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 ASM_VERSION}

//[END FileFullPath]



//[function FileShortPath]

function FileShortPath( const FileName: String ): String;

var Buf: array[ 0..MAX_PATH ] of Char;

begin

  GetShortPathName( PChar( FileName ), Buf, Sizeof( Buf ) );

  Result := Buf;

end;



//[function FileIconSystemIdx]

function FileIconSystemIdx( const Path: String ): Integer;

var SFI: TShFileInfo;

begin

  SFI.iIcon := 0; // Bartov

  ShGetFileInfo( PChar( Path ), 0, SFI, sizeof( SFI ),

                 //-- Babenko Alexey: -----------------//

                 // SHGFI_ICON or                     //

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

                 SHGFI_SMALLICON or SHGFI_SYSICONINDEX );

  Result := SFI.iIcon;

end;



//[function FileIconSysIdxOffline]

function FileIconSysIdxOffline( const Path: String ): Integer;

var SFI: TShFileInfo;

begin

  SFI.iIcon := 0; // Bartov

  ShGetFileInfo( PChar( Path ), FILE_ATTRIBUTE_NORMAL, SFI, sizeof( SFI ),

                 //-- Babenko Alexey: -----------------//

                 //SHGFI_ATTRIBUTES or SHGFI_ICON or //

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

                 SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES );

  Result := SFI.iIcon;

end;



//[procedure LogFileOutput]

procedure LogFileOutput( const filepath, str: String );

var F: HFile;

begin

  F := FileCreate( filepath, ofOpenWrite or ofOpenAlways );

  if F = INVALID_HANDLE_VALUE then Exit;

  FileSeek( F, 0, spEnd );

  FileWrite( F, {$IFNDEF _D2} String {$ENDIF}

             ( str + #13#10 )[ 1 ], Length( str ) + 2 );

  FileClose( F );

end;



//[function StrSaveToFile]

function StrSaveToFile( const Filename, Str: String ): Boolean;

begin

  Result := Mem2File( PChar( Filename ), PChar( Str ), Length( Str ) )

            = Length( Str );

end;



//[function StrLoadFromFile]

function StrLoadFromFile( const Filename: String ): String;

var F: HFile;

begin

  if StrEq( Filename, 'CON' ) then

    Result := File2Str(GetStdHandle(STD_INPUT_HANDLE))

  else

  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 Mem2File]

function Mem2File( Filename: PChar; Mem: Pointer; Len: Integer ): Integer;

var F: HFile;

begin

  Result := 0;

  F := FileCreate( Filename, ofOpenWrite or ofCreateAlways );

  if F = INVALID_HANDLE_VALUE then Exit;

  Result := FileWrite( F, Mem^, Len );

  FileClose( F );

end;



//[function File2Mem]

function File2Mem( Filename: PChar; Mem: Pointer; MaxLen: Integer ): Integer;

var F: HFile;

begin

  Result := 0;

  F := FileCreate( Filename, ofOpenRead or ofOpenExisting or ofShareDenyWrite );

  if F = INVALID_HANDLE_VALUE then Exit;

  Result := FileRead( F, Mem^, MaxLen );

  FileClose( F );

end;



//[FUNCTION DirectoryExists]

{$IFDEF ASM_VERSION}

function DirectoryExists( const Name: string): Boolean;

asm

        //CALL     System.@LStrToPChar // Name must not be ''

        PUSH     EAX

        CALL     GetFileAttributes

        INC      EAX

        JZ       @@exit

        DEC      EAX

        {$IFDEF PARANOIA}

        DB $24, FILE_ATTRIBUTE_DIRECTORY

        {$ELSE}

        AND      AL, FILE_ATTRIBUTE_DIRECTORY

        {$ENDIF}

        SETNZ    AL

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

function DirectoryExists(const Name: string): Boolean;

var

  Code: Integer;

begin

  Code := GetFileAttributes(PChar(Name));

  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);

end;

{$ENDIF ASM_VERSION}

//[END DirectoryExists]



//[function CheckDirectoryContent]

function CheckDirectoryContent( const Name: String; SubDirsOnly: Boolean; const Mask: String ): Boolean;

var FD: TWin32FindData;

    FH: THandle;

begin

  if not DirectoryExists( Name ) then

    Result := TRUE

  else

  begin

    FH := Windows.FindFirstFile( PChar( IncludeTrailingPathDelimiter( Name )

       + Mask ), FD );

    if FH = INVALID_HANDLE_VALUE then

      Result := TRUE

    else

    begin

      Result := TRUE;

      repeat

        if not StrIn( 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 Windows.FindNextFile( FH, FD );

      Windows.FindClose( FH );

    end;

  end;

end;



//[function DirectoryEmpty]

function DirectoryEmpty(const Name: String): Boolean;

begin

  Result := CheckDirectoryContent( Name, FALSE, '*.*' );

end;



{-}

//[function DirectorySize]

function DirectorySize( const Path: String ): I64;

var DirList: PDirList;

    I: Integer;

begin

  Result := MakeInt64( 0, 0 );

  DirList := NewDirList( Path, '*.*', 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;

{+}



//[function DirectoryHasSubdirs]

function DirectoryHasSubdirs( const Path: String ): Boolean;

begin

  Result := not CheckDirectoryContent( Path, TRUE, '*.*' );

end;



//[function GetFileList]

function GetFileList(const dir: string): PStrList;

var

   Srch: TWin32FindData;

   flag: Integer;

   succ: boolean;

begin

   result := nil;

   flag := FindFirstFile(PChar(dir), Srch);

   //succ := flag <> 0; //---------------------------------------

   succ := flag <> Integer(INVALID_HANDLE_VALUE); // M.V.Chirikov

   while succ do begin

      if (not (Srch.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0))then begin

         if Result = nil then begin

            Result := NewStrList;

         end;

         Result.Add(Srch.cFileName);

      end;

      succ := FindNextFile(Flag, Srch);

   end;

   FindClose(Flag);

end;



//[function ExcludeTrailingChar]

function ExcludeTrailingChar( const S: String; C: Char ): String;

begin

  Result := S;

  if Result <> '' then

  if Result[ Length( Result ) ] = C then

    Delete( Result, Length( Result ), 1 );

end;



//[function IncludeTrailingChar]

function IncludeTrailingChar( const S: String; C: Char ): String;

begin

  Result := S;

  if (Result = '') or (Result[ Length( Result ) ] <> C) then

    Result := Result + C;

end;



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

// Following functions/procedures are created by Edward Aretino:

// IncludeTrailingPathDelimiter, ExcludeTrailingPathDelimiter,

// ForceDirectories, CreateDir, ChangeFileExt

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

//[function IncludeTrailingPathDelimiter]

function IncludeTrailingPathDelimiter(const S: string): string;

begin

   {if CopyTail(S, 1) <> '\' then

     Result := S + '\'

   else

     Result := S;}

   Result := IncludeTrailingChar( S, '\' );

end;



//[function ExcludeTrailingPathDelimiter]

function ExcludeTrailingPathDelimiter(const S: string): string;

begin

   {Result := S;

   if Length(Result) = 0 then Exit;



   if (CopyTail(Result, 1) = '\') then

     DeleteTail(Result, 1);}

   Result := ExcludeTrailingChar( S, '\' );

end;



//[function ForceDirectories]

function ForceDirectories(Dir: string): 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]

function CreateDir(const Dir: string): Boolean;

begin

   Result := Windows.CreateDirectory(PChar(Dir), nil);

end;



//[function ChangeFileExt]

function ChangeFileExt(FileName: String; const Extension: string): string;

var

   FileExt: String;

begin

   FileExt := ExtractFileExt(FileName);

   DeleteTail(FileName, Length(FileExt));

   Result := FileName+ Extension;

end;



{$IFDEF ASM_VERSION}

{$IFNDEF _D2}

{$DEFINE ASM_LStrFromPCharLen}

{$ENDIF}

{$ENDIF ASM_VERSION}



{$IFDEF ASM_LStrFromPCharLen}

  {$DEFINE ASM_DIRDelimiters}

{$ENDIF}



{$IFDEF ASM_VERSION}

  {$DEFINE ASM_DIRDelimiters}

{$ENDIF ASM_VERSION}



{$IFDEF ASM_DIRDelimiters}

const

  DirDelimiters: PChar = ':\';

{$ENDIF}



//[FUNCTION ExtractFileName]

{$IFDEF ASM_VERSION}

function ExtractFileName( const Path : String ) : String;

asm

        PUSH     EDX

        PUSH     EAX

        MOV      EDX, [DirDelimiters]

        CALL     __DelimiterLast

        POP      EDX

        CMP      byte ptr [EAX], 0

        JZ       @@1

        XCHG     EDX, EAX

        INC      EDX

@@1:    POP      EAX

        CALL     System.@LStrFromPChar

end;

{$ELSE ASM_VERSION} //Pascal

function ExtractFileName( const Path : String ) : String;

var P: PChar;

begin

  P := __DelimiterLast( PChar( Path ), ':\' );

  if P^ = #0 then

    Result := Path

  else

    Result := P + 1;

end;

{$ENDIF ASM_VERSION}

//[END ExtractFileName]



//[FUNCTION ExtractFilePath]

{$IFDEF ASM_LStrFromPCharLen} // LStrFromPCharLen - there are no in D2

function ExtractFilePath( const Path : String ) : String;

asm

        PUSH     EDX

        MOV      EDX, [DirDelimiters]

        CALL     EAX2PChar

        PUSH     EAX

        CALL     __DelimiterLast

        XCHG     EDX, EAX

        XOR      ECX, ECX

        POP      EAX

        CMP      byte ptr [EDX], CL

        JZ       @@ret_0

        SUB      EDX, EAX

        INC      EDX

        XCHG     EDX, EAX

        XCHG     ECX, EAX

@@ret_0:

        POP      EAX

        CALL     System.@LStrFromPCharLen

end;

{$ELSE} //Pascal

function ExtractFilePath( const Path : String ) : String;

//var I : Integer;

var P, P0: PChar;

begin

  P0 := PChar( Path );

  P := __DelimiterLast( P0, ':\' );

  if P^ = #0 then

    Result := ''

  else

    Result := Copy( Path, 1, P - P0 + 1 );

end;

{$ENDIF}



//[function ExtractFileNameWOext]

function ExtractFileNameWOext( const Path : String ) : String;

begin

  Result := ExtractFileName( Path );

  Result := Copy( Result, 1, Length( Result ) - Length( ExtractFileExt( Result ) ) );

end;



{$IFDEF ASM_VERSION}

const

  ExtDelimeters: PChar = '.';



//[function ExtractFileExt]

function ExtractFileExt( const Path : String ) : String;

asm

        PUSH     EDX

        MOV      EDX, [ExtDelimeters]

        CALL     EAX2PChar

        CALL     __DelimiterLast

@@1:    XCHG     EDX, EAX

        POP      EAX

        CALL     System.@LStrFromPChar

end;

{$ELSE ASM_VERSION} //Pascal

function ExtractFileExt( const Path : String ) : String;

var P: PChar;

begin

  P := __DelimiterLast( PChar( Path ), '.' );

  Result := P;

end;

{$ENDIF ASM_VERSION}

//[END ExtractFilePath]



//[function ReplaceFileExt]

function ReplaceFileExt( const Path, NewExt: String ): String;

begin

  Result := ExtractFilePath( Path ) +

            ExtractFileNameWOext( ExtractFileName( Path ) ) +

            NewExt;

end;



//[function ExtractShortPathName]

function ExtractShortPathName( const Path: String ): String;

var

  Buffer: array[0..MAX_PATH - 1] of Char;

begin

  SetString(Result, Buffer,

    GetShortPathName(PChar(Path), Buffer, SizeOf(Buffer)));

end;



//[function FilePathShortened]

function FilePathShortened( const Path: String; MaxLen: Integer ): String;

begin

  Result := FilePathShortenPixels( Path, 0, MaxLen );

end;



//[function PixelsLength]

function PixelsLength( DC: HDC; const Text: String ): Integer;

var Sz: TSize;

begin

  if DC = 0 then

    Result := Length( Text )

  else

  begin

    Windows.GetTextExtentPoint32( DC, PChar( Text ), Length( Text ), Sz );

    Result := Sz.cx;

  end;

end;



//[function FilePathShortenPixels]

function FilePathShortenPixels( const Path: String; DC: HDC; MaxPixels: Integer ): String;

var L0, L1: Integer;

    Prev: String;

begin

 Result := Path;

 L0 := PixelsLength( DC, Result );

 while L0 > MaxPixels do

 begin

   Prev := Result;

   L1 := pos( '\...\', Result );

   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;



//[procedure CutFirstDirectory]

procedure CutFirstDirectory(var S: String);

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('\',S);

    if P <> 0 then

    begin

      Delete(S, 1, P);

      S := '...\' + S;

    end

    else

      S := '';

    if Root then

      S := '\' + S;

  end;

end;



//[function MinimizeName]

function MinimizeName( const Path: String; DC: HDC; MaxPixels: Integer ): String;

var

  Drive, Dir, Name: String;

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;



//[FUNCTION FileSize]

{$IFDEF ASM_VERSION}

function FileSize( const Path : String ) : Integer;

const size_TWin32FindData = sizeof( TWin32FindData );

asm

        ADD      ESP, - size_TWin32FindData

        PUSH     ESP

        //CALL     System.@LStrToPChar // Path must not be ''

        PUSH     EAX

        CALL     FindFirstFile

        INC      EAX

        JZ       @@exit

        DEC      EAX

        PUSH     EAX

        CALL     FindClose



        MOV      EAX, [ESP].TWin32FindData.nFileSizeLow

@@exit:

        ADD      ESP, size_TWin32FindData

end;

{$ELSE ASM_VERSION} //Pascal

function FileSize( const Path : String ) : Integer;

var FD : TWin32FindData;

    FH : THandle;

begin

  FH := FindFirstFile( PChar( Path ), FD );

  Result := 0;

  if FH = INVALID_HANDLE_VALUE then exit;

  Result := FD.nFileSizeLow;

  if ((FD.nFileSizeLow and $80000000) <> 0) or

     (FD.nFileSizeHigh <> 0) then Result := -1;

  FindClose( FH );

end;

{$ENDIF ASM_VERSION}

//[END FileSize]



//*

//[function FileTimeCompare]

function FileTimeCompare( const FT1, FT2 : TFileTime ) : Integer;

var ST1, ST2 : TSystemTime;

begin

  FileTimeToSystemTime( FT1, ST1 );

  FileTimeToSystemTime( FT2, ST2 );

  Result := CompareSystemTime( ST1, ST2 );

end;



//[function GetSystemDir]

function GetSystemDir: String;

var Buf: array[ 0..MAX_PATH ] of Char;

begin

  GetSystemDirectory( @ Buf[ 0 ], MAX_PATH + 1 );

  Result := IncludeTrailingPathDelimiter( PChar( @ Buf[ 0 ] ) );

end;



//*

//[function GetWindowsDir]

function GetWindowsDir : string;

var Buf : array[ 0..MAX_PATH ] of Char;

begin

  GetWindowsDirectory( @Buf[ 0 ], MAX_PATH + 1 );

  Result := IncludeTrailingPathDelimiter( PChar( @ Buf[ 0 ] ) );

end;



//[function GetWorkDir]

function GetWorkDir : string;

var Buf: array[ 0..MAX_PATH ] of Char;

begin

  GetCurrentDirectory( MAX_PATH + 1, @ Buf[ 0 ] );

  Result := IncludeTrailingPathDelimiter( PChar( @ Buf[ 0 ] ) );

end;



//*

//[function GetTempDir]

function GetTempDir : string;

var Buf : array[ 0..MAX_PATH ] of Char;

begin

  Windows.GetTempPath( MAX_PATH + 1, @Buf[ 0 ] );

  Result := IncludeTrailingPathDelimiter( PChar( @ Buf[ 0 ] ) );

end;



//[function CreateTempFile]

function CreateTempFile( const DirPath, Prefix: String ): String;

var Buf: array[ 0..MAX_PATH ] of Char;

begin

  GetTempFileName( PChar( DirPath ), PChar( Prefix ), 0, Buf );

  Result := Buf;

end;



//[function GetFileListStr]

function GetFileListStr(FPath{e.g.'c:\tmp\'}, FMask{e.g.'*.*'}: string): string;

{* List of files in string, separating each path from others with semicolon (';').

   E.g.: 'c:\tmp\unit1.dcu;c:\tmp\unit1.~pa' (for use with DeleteFile2Recycle())}

var

   Srch: TWin32FindData;

   flag: Integer;

   succ: boolean;

   dir:string;

begin

   result := '';

   if (FPath<>'') and (FPath[length(FPath)]<>'\') then FPath:=FPath+'\';

   if (FMask<>'') and (FMask[1]='\') then FMask:=CopyEnd(FMask,2);

   dir:=FPath+FMask;

   flag := FindFirstFile(PChar(dir), Srch);

   succ := flag <> Integer(INVALID_HANDLE_VALUE);

   while succ do begin

      if (not (Srch.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0))then begin

         if Result<>''then Result:=Result+';';

         Result:=Result+FPath+Srch.cFileName;

      end;

      succ := FindNextFile(Flag, Srch);

   end;

   FindClose(Flag);

end;



//[function DeleteFiles]

function DeleteFiles( const DirPath: String ): Boolean;

var Files, Name: String;

begin

  Files := GetFileListStr( ExtractFilePath( DirPath ), ExtractFileName( DirPath ) );

  Result := TRUE;

  while Files <> '' do

  begin

    Name := Parse( Files, ';' );

    Result := Result and DeleteFile( PChar( Name ) );

  end;

end;



//*

//[function DeleteFile2Recycle]

function DeleteFile2Recycle( const Filename : String ) : Boolean;

var FOS : TSHFileOpStruct;

    Buf : PChar;

    L : Integer;

begin

  L := Length( Filename );

  GetMem( Buf, L + 2 );

  StrCopy( Buf, PChar( Filename ) );

  Buf[ L + 1 ] := #0;

  for L := L downto 0 do

    if Buf[ L ] = ';' then Buf[ L ] := #0;

  FillChar( FOS, Sizeof( FOS ), 0 );

  if Applet <> nil then

    FOS.Wnd := Applet.Handle;

  FOS.wFunc := FO_DELETE;

  FOS.pFrom := Buf;

  FOS.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;

  FOS.fAnyOperationsAborted := True;

  FOS.lpszProgressTitle := PChar( 'Delete ' + Filename + ' to Recycle bin' );

  Result := SHFileOperation( FOS ) = 0;

  if Result then

    Result := not FOS.fAnyOperationsAborted;

  FreeMem( Buf );

end;



//[function CopyMoveFiles]

function CopyMoveFiles( const FromList, ToList: String; Move: Boolean ): Boolean;

var FOS : TSHFileOpStruct;

    Buf : PChar;

    L : Integer;

begin

  L := Length( FromList );

  GetMem( Buf, L + 2 );

  StrCopy( Buf, PChar( FromList ) );

  Buf[ L + 1 ] := #0;

  for L := L downto 0 do

    if Buf[ L ] = ';' then Buf[ L ] := #0;

  FillChar( FOS, Sizeof( FOS ), 0 );

  if Applet <> nil then

    FOS.Wnd := Applet.Handle;

  if Move then

  begin

    FOS.wFunc := FO_MOVE;

    FOS.lpszProgressTitle := PChar( 'Move files' );

  end

    else

  begin

    FOS.wFunc := FO_COPY;

    FOS.lpszProgressTitle := PChar( 'Copy files' );

  end;

  FOS.pFrom := Buf;

  FOS.pTo := PChar( ToList + #0 );

  FOS.fFlags := FOF_ALLOWUNDO;

  FOS.fAnyOperationsAborted := True;

  Result := SHFileOperation( FOS ) = 0;

  if Result then

    Result := not FOS.fAnyOperationsAborted;

  FreeMem( Buf );

end;



{-}

//[function DiskFreeSpace]

function DiskFreeSpace( const Path: String ): I64;

type TGetDFSEx = function( Path: PChar; 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( V );

  Ex := FALSE;

  if V.dwPlatformId = VER_PLATFORM_WIN32_NT then

  begin

    Ex := V.dwMajorVersion >= 4;

  end

    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.dll' );

    GetDFSEx := GetProcAddress( Kern32, 'GetDiskFreeSpaceExA' );

  end;

  if Assigned( GetDFSEx ) then

    GetDFSEx( PChar( Path ), @ FBA, @ TNB, @Result )

  else

  begin

    GetDiskFreeSpace( PChar( Path ), SpC, BpS, NFC, TNC );

    Result := Mul64i( MakeInt64( SpC * BpS, 0 ), NFC );

  end;

end;

{+}



//*

//[function GetUniqueFilename]

function GetUniqueFilename( PathName: string ) : String;

var Path, Nam, Ext : String;

    I, J, K : Integer;

begin

  Result := PathName;

  Path := ExtractFilePath( PathName );

  if not DirectoryExists( Path ) then Exit;

  Nam := ExtractFileNameWOext( PathName );

  if Nam = '' then

  begin

    if Path[ Length( Path ) ] = '\' then

       Path := Copy( Path, 1, Length( Path ) - 1 );

    PathName := Path;

    Result := Path;

  end;

  Nam := ExtractFileNameWOext( PathName );

  Ext := ExtractFileExt( PathName );

  I := Length( Nam );

  for J := I downto 1 do

  if not (Nam[ J ] in [ '0'..'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;



//[FUNCTION GetStartDir]

{$IFDEF ASM_VERSION}

function GetStartDir : String;

asm

        PUSH     EBX

        MOV      EBX, EAX



        XOR      EAX, EAX

        MOV      AH, 2

        SUB      ESP, EAX

        MOV      EDX, ESP

        PUSH     EAX

        PUSH     EDX

        PUSH     0

        CALL     GetModuleFileName



        LEA      EDX, [ESP + EAX]

@@1:    DEC      EDX

        CMP      byte ptr [EDX], '\'

        JNZ      @@1



        INC      EDX

        MOV      byte ptr [EDX], 0



        MOV      EAX, EBX

        MOV      EDX, ESP

        CALL     System.@LStrFromPChar



        ADD      ESP, 200h

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function GetStartDir : String;

var Buffer:array[0..260] of Char;

    I : Integer;

begin

  I := GetModuleFileName( 0, Buffer, Sizeof( Buffer ) );

  for I := I downto 0 do

    if Buffer[ I ] = '\' then

    begin

      Buffer[ I + 1 ] := #0;

      break;

    end;

  Result := Buffer;

end;

{$ENDIF ASM_VERSION}

//[END GetStartDir]



//[END FILES]







{ TDirList }



//[function NewDirList]

function NewDirList( const DirPath, Filter: String; Attr: DWORD ): PDirList;

begin

  {-}

  New( Result, Create );

  {+}{++}(*Result := PDirList.Create;*){--}

  Result.ScanDirectory( DirPath, Filter, Attr );

end;

//[END NewDirList]



//[function NewDirListEx]

function NewDirListEx( const DirPath, Filters: String; Attr: DWORD ): PDirList;

begin

  {-}

  New( Result, Create );

  {+}{++}(*Result := PDirList.Create;*){--}

  Result.ScanDirectoryEx( DirPath, Filters, Attr );

end;

//[END NewDirListEx]



{$IFDEF ASM_VERSION}

//[procedure TDirList.Clear]

procedure TDirList.Clear;

asm

        XOR      ECX, ECX

        XCHG     ECX, [EAX].fList

        JECXZ    @@exit

        XCHG     EAX, ECX

        CALL     TList.Release

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

procedure TDirList.Clear;

begin

  if FList <> nil then

    FList.Release;

  FList := nil;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[destructor TDirList.Destroy]

destructor TDirList.Destroy;

asm

        PUSH     EBX

        MOV      EBX, EAX

        CALL     Clear

        LEA      EAX, [EBX].FPath

        CALL     System.@LStrClr

        XCHG     EAX, EBX

        CALL     TObj.Destroy

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

destructor TDirList.Destroy;

begin

  Clear;

  FPath := '';

  inherited;

end;

{$ENDIF ASM_VERSION}



//[FUNCTION FindFilter]

{$IFDEF ASM_VERSION}

function FindFilter( const Filter: String): String;

asm

        XCHG     EAX, EDX

        PUSH     EAX

        CALL     System.@LStrAsg

        POP      EAX

        CMP      dword ptr [EAX], 0

        JNE      @@exit

        LEA      EDX, @@mask_all

        JE       System.@LStrFromPChar

@@mask_all:  DB  '*.*',0

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

function FindFilter(const Filter: String): String;

begin

  Result := Filter;

  if Result = '' then Result := '*.*';

end;

{$ENDIF ASM_VERSION}

//[END FindFilter]



//+

//[function TDirList.Get]

function TDirList.Get(Idx: Integer): PWin32FindData;

begin

  Result := FList.fItems[ Idx ];

end;



{$IFDEF ASM_VERSION}

//[function TDirList.GetCount]

function TDirList.GetCount: Integer;

asm

        MOV      EAX, [EAX].fList

        TEST     EAX, EAX

        {$IFDEF USE_CMOV}

        CMOVNZ   EAX, [EAX].TList.fCount

        {$ELSE}

        JZ       @@exit

        MOV      EAX, [EAX].TList.fCount

@@exit: {$ENDIF}

end;

{$ELSE ASM_VERSION} //Pascal

function TDirList.GetCount: Integer;

begin

  Result := 0;

  if FList = nil then Exit;

  Result := FList.Count;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[function TDirList.GetNames]

function TDirList.GetNames(Idx: Integer): string;

asm

        MOV      EAX, [EAX].fList

        MOV      EAX, [EAX].TList.fItems

        MOV      EDX, [EAX + EDX*4]

//*/////////////////////////////////////////////////////

//      ADD      EDX, TWin32FindData.cFileName

//*/////////////////////////////////////////////////////

        ADD      EDX, offset TWin32FindData.cFileName //

//*/////////////////////////////////////////////////////

        MOV      EAX, ECX

        CALL     System.@LStrFromPChar

end;

{$ELSE ASM_VERSION} //Pascal

function TDirList.GetNames(Idx: Integer): string;

begin

  Result := PChar(@PWin32FindData(fList.fItems[ Idx ]).cFileName[0]);

  //Result := PChar(@Items[Idx].cFileName[0]);

end;

{$ENDIF ASM_VERSION}



//[function TDirList.GetIsDirectory]

function TDirList.GetIsDirectory(Idx: Integer): Boolean;

begin

  Result := LongBool( Items[ Idx ].dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY );

end;



{$IFDEF ASM_noVERSION}

//[function TDirList.SatisfyFilter]

function TDirList.SatisfyFilter(FileName: PChar; 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 ASM_VERSION} //Pascal

function TDirList.SatisfyFilter(FileName: PChar; FileAttr,

  FindAttr: DWord): Boolean;

{$IFDEF F_P}

const Dot: String = '.';

{$ENDIF F_P}

var I: Integer;

    F: PChar;

    HasOnlyNegFilters: Boolean;

begin

  Result := (((FileAttr and FindAttr) = FindAttr) or

            LongBool(FindAttr and FILE_ATTRIBUTE_NORMAL));

  if not Result then Exit;



  if (FileName <> {$IFDEF F_P}Dot{$ELSE}'.'{$ENDIF}) and

     (FileName <> '..') 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.fCount - 1 do

  begin

    F := PChar(fFilters.fList.fItems[ I ]);

    if F = '' then continue;



    if (F = {$IFDEF F_P}Dot{$ELSE}'.'{$ENDIF}) or (F = '..') then

    begin

      if FileName = F then

        Exit;

    end

      else

    if (Filename = {$IFDEF F_P}Dot{$ELSE}'.'{$ENDIF}) or (FileName = '..') then

    begin

      //Result := FALSE;

      continue;

    end;



    if F[ 0 ] = '^' then

    begin

      if StrSatisfy( FileName, PChar(@F[ 1 ]) ) then

      begin

         Result := False;

         Exit;

      end;

    end

      else

    begin

      HasOnlyNegFilters := FALSE;

      if StrSatisfy( FileName, F ) then

      begin

        Result := True;

        Exit;

      end;

    end;

  end;



  Result := HasOnlyNegFilters and

            (FileName <> {$IFDEF F_P}Dot{$ELSE}'.'{$ENDIF}) and

            (FileName <> '..');



end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TDirList.ScanDirectory]

procedure TDirList.ScanDirectory(const DirPath, Filter: String;

  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

        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 ASM_VERSION} //Pascal

procedure TDirList.ScanDirectory(const DirPath, Filter: String;

  Attr: DWord);

var FindData : TWin32FindData;

    E : PWin32FindData;

    FindHandle : THandle;

    Action: TDirItemAction;

begin

  Clear;

  FList := NewList;

  FPath := DirPath;

  if FPath = '' then Exit;

  FPath := IncludeTrailingPathDelimiter( FPath );

  if fFilters = nil then

  begin

    fFilters := NewStrList;

    if Filter = '*.*' then

      fFilters.Add( '*' )

    else

      fFilters.Add( Filter );

  end;

  FindHandle := FindFirstFile( PChar( FPath + FindFilter( Filter ) ),

                               FindData );

  if FindHandle = INVALID_HANDLE_VALUE then Exit;

  while True do

  begin

    if SatisfyFilter( PChar(@FindData.cFileName[0]),

                      FindData.dwFileAttributes, Attr ) then

    begin

      Action := diAccept;

      if Assigned( OnItem ) then

        OnItem( @Self, FindData, Action );

      CASE Action OF

      diSkip: ;

      diAccept:

        begin

          GetMem( E, Sizeof( FindData ) );

          E^ := FindData;

          FList.Add( E );

        end;

      diCancel: break;

      END;

    end;

    if not FindNextFile( FindHandle, FindData ) then break;

  end;

  FindClose( FindHandle );

  fFilters.Free;

  fFilters := nil;

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TDirList.ScanDirectoryEx]

procedure TDirList.ScanDirectoryEx(const DirPath, Filters: String;

  Attr: DWord);

asm

        PUSH     EBX

        MOV      EBX, EAX



        PUSHAD

        CALL     NewStrList

        MOV      [EBX].fFilters, EAX

        POPAD



        PUSHAD

        PUSH     0

        MOV      EAX, ESP

        MOV      EDX, ECX

        CALL     System.@LStrLAsg

@@1:    MOV      ECX, [ESP]

        JECXZ    @@2

        MOV      EAX, ESP

        MOV      EDX, offset[@@semicolon]

        PUSH     0

        MOV      ECX, ESP

        CALL     Parse

        MOV      EAX, [ESP]

        MOV      EDX, ESP

        CALL     Trim

        POP      EDX

        PUSH     EDX

        TEST     EDX, EDX

        JZ       @@filt_added

        MOV      EAX, [EBX].fFilters

        CALL     TStrList.Add

@@filt_added:

        CALL     RemoveStr

        JMP      @@1



        //       ';' string literal

        DD       -1, 1

@@semicolon:

        DB       ';',0



@@2:    POP      ECX

        POPAD

        XOR      ECX, ECX

        PUSH     [Attr]

        CALL     ScanDirectory

        {XOR      EAX, EAX

        XCHG     EAX, [EBX].fFilters

        CALL     TObj.Free}

        POP      EBX

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

procedure TDirList.ScanDirectoryEx(const DirPath, Filters: String;

  Attr: DWord);

var F, FF: String;

begin

  FF := Filters;

  fFilters := NewStrList;

  while FF <> '' do

  begin

    F := Trim( Parse( FF, ';' ) );

    if F <> '' then

      fFilters.Add( F );

  end;

  ScanDirectory( DirPath, '', Attr );

end;

{$ENDIF ASM_VERSION}



type

  PSortDirData = ^TSortDirData;

  TSortDirData = packed Record

    FoldersFirst, CaseSensitive : Boolean;

    Rules : array[ 0..11 ] of TSortDirRules;

    Dir : PDirList;

  end;



//[FUNCTION CompareDirItems]

{$IFDEF ASM_noVERSION}

function CompareDirItems( const Data : PSortDirData; const e1, e2 : DWORD ) : Integer;

asm

        PUSH     EBX

        PUSH     ESI

        PUSH     EDI

        XCHG     EBX, EAX

        MOV      EAX, [EBX].TSortDirData.Dir

        MOV      EAX, [EAX].TDirList.fList

        MOV      EAX, [EAX].TList.fItems

        MOV      ESI, [EAX+EDX*4]

        MOV      EDI, [EAX+ECX*4]

        MOV      DL, byte ptr[ESI].TWin32FindData.dwFileAttributes

        MOV      DH, byte ptr[EDI].TWin32FindData.dwFileAttributes

        AND      DX, 2020h

        XOR      EAX, EAX

        CMP      DL, DH

        JE       @@1

        CMP      [EBX].TSortDirData.FoldersFirst, AL

        JE       @@1

        OR       AL, DL

        JNE      @@exit_near

        DEC      EAX

        //JMP      @@exit

@@exit_near:

        POP      EDI

        POP      ESI

        POP      EBX

        RET



@@sdrByDateChanged:

        LEA      EAX, [ESI].TWin32FindData.ftLastWriteTime

        LEA      EDX, [EDI].TWin32FindData.ftLastWriteTime

        JMP      @@sdrByDate1



@@sdrByDateAccessed:

        LEA      EAX, [ESI].TWin32FindData.ftLastAccessTime

        LEA      EDX, [EDI].TWin32FindData.ftLastAccessTime

        JMP      @@sdrByDate1



@@jmp_table:

        DD       offset[@@exit1], offset[@@2], offset[@@2]

        DD       offset[@@sdrByName], offset[@@sdrByExt]

        DD       offset[@@sdrBySize], offset[@@sdrBySize]

        DD       offset[@@sdrByDateCreate], offset[@@sdrByDateChanged]

        DD       offset[@@sdrByDateAccessed]



@@1:

        LEA      EDX, [EBX].TSortDirData.Rules

        PUSH     EDX

@@2:

        POP      EDX

        XOR      EAX, EAX

        MOV      AL, [EDX]

        INC      EDX

        PUSH     EDX



        JMP      dword ptr [@@jmp_table+EAX*4]

        //////// ///////////////////



@@sdrByDateCreate:

        LEA      EAX, [ESI].TWin32FindData.ftCreationTime

        LEA      EDX, [EDI].TWin32FindData.ftCreationTime

@@sdrByDate1:

        PUSH     EDX

        PUSH     EAX     

        CALL     CompareFileTime

        TEST     EAX, EAX

        JE       @@2

        JMP      @@exit1



@@sdrBySize:

        MOV      EAX, [ESI].TWin32FindData.nFileSizeHigh

        SUB      EAX, [EDI].TWin32FindData.nFileSizeHigh

        JNE      @@sdrBySize1

        MOV      EAX, [ESI].TWin32FindData.nFileSizeLow

        SUB      EAX, [EDI].TWin32FindData.nFileSizeLow

@@to_2:

        JE       @@2

@@sdrBySize1:

        POP      EDX

        DEC      EDX

        CMP      byte ptr[EDX], sdrBySizeDescending

        JNE      @@sdrBySize2

        NEG      EAX

@@sdrBySize2:

        JNE      @@exit

        //////// ///////////////////



        DD       -1, 1

@@point:DB       '.',0



@@sdrByExt:

        LEA      EAX, [EDI].TWin32FindData.cFileName

        MOV      EDX, offset[@@point]

        PUSH     EDX

        CALL     __DelimiterLast

        POP      EDX

        PUSH     EAX

        LEA      EAX, [ESI].TWin32FindData.cFileName

        CALL     __DelimiterLast

        POP      EDX

        JMP      @@sdrByName0



@@sdrByName:

        LEA      EAX, [ESI].TWin32FindData.cFileName

        LEA      EDX, [EDI].TWin32FindData.cFileName

@@sdrByName0:

        CMP      [EBX].TSortDirData.CaseSensitive, 0

        JNE      @@sdrByName1

        CALL     _AnsiCompareStrNoCase

        JMP      @@sdrByName2

@@sdrByName1:

        CALL     _AnsiCompareStr

@@sdrByName2:

        TEST     EAX, EAX

        JE       @@to_2

        //JMP    @@exit1



@@exit1:

        POP      EDX

@@exit:

        POP      EDI

        POP      ESI

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function CompareDirItems( const Data : PSortDirData; const e1, e2 : DWORD ) : Integer;

var I : Integer;

    Item1, Item2 : PWin32FindData;

    S1, S2 : PChar;

    IsDir1, IsDir2 : Boolean;

    Date1, Date2 : PFileTime;

begin

  Item1 := Data.Dir.fList.fItems[ e1 ];

  Item2 := Data.Dir.fList.fItems[ e2 ];

  Result := 0;

  IsDir1 := (Item1.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0;

  IsDir2 := (Item2.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0;

  if (IsDir1 <> IsDir2) and Data.FoldersFirst then

  begin

    if IsDir1 then Result := -1 else Result := 1;

    exit;

  end;

  for I := 0 to High(Data.Rules) do

  begin

    case Data.Rules[ I ] of

    sdrByName:

      begin

        S1 := Item1.cFileName;

        S2 := Item2.cFileName;

        if not Data.CaseSensitive then

          Result := _AnsiCompareStrNoCase( S1, S2 )

        else

          Result := _AnsiCompareStr( S1, S2 );

      end;

    sdrByExt:

      begin

        S1 := Item1.cFileName;

        S2 := Item2.cFileName;

        S1 := __DelimiterLast( S1, '.' );

        S2 := __DelimiterLast( S2, '.' );

        if not Data.CaseSensitive then

           Result := _AnsiCompareStrNoCase( S1, S2 )

        else

           Result := _AnsiCompareStr( S1, S2 );

      end;

    sdrBySize, sdrBySizeDescending:

      begin

        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;

        if Data.Rules[ I ] = sdrBySizeDescending then

           Result := -Result;

      end;

    sdrByDateCreate:

      begin

        Date1 := @Item1.ftCreationTime;

        Date2 := @Item2.ftCreationTime;

        Result := CompareFileTime( Date1^, Date2^ );

      end;

    sdrByDateChanged:

      begin

        Date1 := @Item1.ftLastWriteTime;

        Date2 := @Item2.ftLastWriteTime;

        Result := CompareFileTime( Date1^, Date2^ );

      end;

    sdrByDateAccessed:

      begin

        Date1 := @Item1.ftLastAccessTime;

        Date2 := @Item2.ftLastAccessTime;

        Result := CompareFileTime( Date1^, Date2^ );

      end;

    end; {case}

    if Result <> 0 then break;

  end;

end;

{$ENDIF ASM_VERSION}

//[END CompareDirItems]



//[PROCEDURE SwapDirItems]

{$IFDEF ASM_VERSION}

procedure SwapDirItems( const Data : PSortDirData; const e1, e2 : DWORD );

asm

        MOV      EAX, [EAX].TSortDirData.Dir

        MOV      EAX, [EAX].TDirList.fList

        MOV      EAX, [EAX].TList.fItems

        LEA      EDX, [EAX+EDX*4]

        LEA      ECX, [EAX+ECX*4]

        MOV      EAX, [EDX]

        XCHG     EAX, [ECX]

        MOV      [EDX], EAX

end;

{$ELSE ASM_VERSION} //Pascal

procedure SwapDirItems( const Data : PSortDirData; const e1, e2 : DWORD );

var Tmp : Pointer;

begin

  Tmp := Data.Dir.FList.fItems[ e1 ];

  Data.Dir.FList.fItems[ e1 ] := Data.Dir.FList.fItems[ e2 ];

  Data.Dir.FList.fItems[ e2 ] := Tmp;

end;

{$ENDIF ASM_VERSION}

//[END SwapDirItems]



{

  TSortDirData = packed Record

    FoldersFirst, CaseSensitive : Boolean;

    Rules : array[ 0..11 ] of TSortDirRules;

    Dir : PDirList;

  end;

}

{$IFDEF ASM_VERSION}

procedure TDirList.Sort(Rules: array of TSortDirRules);

const   high_DefSortDirRules = High( DefSortDirRules );

asm

        PUSH     EBX

        PUSH     ESI

        XOR      EBX,EBX

        CMP      [EAX].fList, EBX

        JE       @@exit



        PUSH     EAX           // prepare Dir = @Self

        XOR      EAX, 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



        PUSH     BX           // prepare FoldersFirst(BL), CaseSensitive(BH)

        MOV      EBX, [ESP].TSortDirData.Dir

        MOV      EAX, ESP

        PUSH     offset[SwapDirItems]

        MOV      ECX, offset[CompareDirItems]

        MOV      EDX, [EBX].fList

        MOV      EDX, [EDX].TList.fCount

        CALL     SortData



        ADD      ESP, 18

        JMP      @@exit



@@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 ASM_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 J > High( SortDirData.Rules ) then exit;

      if RulePresent( Rule ) then exit;

      SortDirData.Rules[ J ] := Rule;

      Inc( J );

    end;

begin

  if fList = nil then Exit;

  J := 0;

  for I := 0 to High(Rules) do

    AddRule( Rules[ I ] );

  for I := 0 to High(DefSortDirRules) do

    AddRule( DefSortDirRules[ I ] );

  while J < High( SortDirData.Rules ) do

  begin

    SortDirData.Rules[ J ] := sdrNone;

    Inc( J );

  end;



  SortDirData.Dir := @Self;

  SortDirData.FoldersFirst := RulePresent( sdrFoldersFirst );

  SortDirData.CaseSensitive := RulePresent( sdrCaseSensitive );

  SortData( Pointer( @SortDirData ), fList.fCount, @CompareDirItems, @SwapDirItems );

end;

{$ENDIF ASM_VERSION}





//[function TDirList.FileList]

function TDirList.FileList(const Separator: String; Dirs,

  FullPaths: Boolean): String;

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;











////////////////////////////////////////////////////////////////////////

//

//

//                        R  E  G  I  S  T  R  Y

//

//

////////////////////////////////////////////////////////////////////////







{++}(*

function RegSetValueEx; external advapi32 name 'RegSetValueExA';

*){--}





{ -- registry -- }



//[function RegKeyOpenRead]

function RegKeyOpenRead( Key: HKey; const SubKey: String ): HKey;

begin

  if RegOpenKeyEx( Key, PChar( SubKey ), 0, KEY_READ, Result ) <> ERROR_SUCCESS then

     Result := 0;

end;



//[function RegKeyOpenWrite]

function RegKeyOpenWrite( Key: HKey; const SubKey: String ): HKey;

begin

  if RegOpenKeyEx( Key, PChar( SubKey ), 0, KEY_READ or KEY_WRITE, Result ) <> ERROR_SUCCESS then

     Result := 0;

end;



//[function RegKeyOpenCreate]

function RegKeyOpenCreate( Key: HKey; const SubKey: String ): HKey;

var dwDisp: DWORD;

begin

  if RegCreateKeyEx( Key, PChar( SubKey ), 0, nil, 0, KEY_ALL_ACCESS, nil, Result,

                     @dwDisp ) <> ERROR_SUCCESS then

    Result := 0;

end;



//[function RegKeyGetDw]

function RegKeyGetDw( Key: HKey; const ValueName: String ): DWORD;

var dwType, dwSize: DWORD;

begin

  dwSize := sizeof( DWORD );

  Result := 0;

  if (Key = 0) or

     (RegQueryValueEx( Key, PChar( ValueName ), nil, @dwType, PByte( @Result ), @dwSize ) <> ERROR_SUCCESS)

     or (dwType <> REG_DWORD) then Result := 0;

end;



//[function RegKeyGetStr]

function RegKeyGetStr( Key: HKey; const ValueName: String ): String;

var dwType, dwSize: DWORD;

    Buffer: PChar;



    function Query: Boolean;

    begin

      Result := RegQueryValueEx( Key, PChar( 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 );

  if Query then

    Result := Buffer;

  FreeMem( Buffer );

end;



//[function RegKeyGetStrEx]

function RegKeyGetStrEx( Key: HKey; const ValueName: String ): String;

var dwType, dwSize: DWORD;

    Buffer, Buffer2: PChar;

    Sz: Integer;

    function Query: Boolean;

    begin

      Result := RegQueryValueEx( Key, PChar( 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 );

  if Query then

  begin

    if dwtype = REG_EXPAND_SZ then

    begin

      //------------------------------------------------------ by Dmitry Zharov

      // Sz := ExpandEnvironmentStrings(Buffer,nil,0);         18-Aug-2004

      // SetLength( Result, Sz );

      // ExpandEnvironmentStrings(Buffer, PChar(Result), Sz);

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

      Sz := ExpandEnvironmentStrings(Buffer,nil,0);  // bug in size detection! sometimes we get an additional 2 bytes at the end...

      GetMem(Buffer2,Sz);                            //

      ExpandEnvironmentStrings(Buffer, Buffer2, Sz); //

      Result:=Buffer2;                               //

      FreeMem(Buffer2);                              //

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

    end

      else

    Result := Buffer;

  end;

  FreeMem( Buffer );

end;



//[function RegKeySetDw]

function RegKeySetDw( Key: HKey; const ValueName: String; Value: DWORD ): Boolean;

begin

  Result := (Key <> 0) and (RegSetValueEx( Key, PChar( ValueName ), 0, REG_DWORD, @Value, sizeof( DWORD ) )

            = ERROR_SUCCESS);

end;



//[function RegKeySetStr]

function RegKeySetStr( Key: HKey; const ValueName: String; const Value: String ): Boolean;

begin

  Result := (Key <> 0) and (RegSetValueEx( Key, PChar( ValueName ), 0,

            REG_SZ, PChar(Value),

             Length( Value ) + 1 ) = ERROR_SUCCESS);

end;



//[function RegKeySetStrEx]

function RegKeySetStrEx( Key: HKey; const ValueName: string; const Value: string;

                         expand: boolean): Boolean;

var dwType: DWORD;

begin

  dwType := REG_SZ;

  if expand then

    dwType := REG_EXPAND_SZ;

  Result := (Key <> 0) and (RegSetValueEx(Key, PChar(ValueName), 0, dwType,

            PChar(Value), Length(Value) + 1) = ERROR_SUCCESS);

end;



//[procedure RegKeyClose]

procedure RegKeyClose( Key: HKey );

begin

  if Key <> 0 then

    RegCloseKey( Key );

end;



//[function RegKeyDelete]

function RegKeyDelete( Key: HKey; const SubKey: String ): Boolean;

begin

  Result := FALSE;

  if Key <> 0 then

    Result := RegDeleteKey( Key, PChar( SubKey ) ) = ERROR_SUCCESS;

end;



//[function RegKeyDeleteValue]

function RegKeyDeleteValue( Key: HKey; const SubKey: String ): Boolean;

begin

  Result := FALSE;

  if Key <> 0 then

    Result := RegDeleteValue( Key, PChar( SubKey ) ) = ERROR_SUCCESS;

end;



//[function RegKeyExists]

function RegKeyExists( Key: HKey; const SubKey: String ): 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]

function RegKeyValExists( Key: HKey; const ValueName: String ): Boolean;

var dwType, dwSize: DWORD;

begin

  Result := (Key <> 0) and

            (RegQueryValueEx( Key, PChar( ValueName ), nil,

            @dwType, nil, @dwSize ) = ERROR_SUCCESS);

end;



//[function RegKeyValueSize]

function RegKeyValueSize( Key: HKey; const ValueName: String ): Integer;

begin

  Result := 0;

  if Key = 0 then Exit;

  RegQueryValueEx( Key, PChar( ValueName ), nil, nil, nil, @ DWORD( Result ) );

end;



//[function RegKeyGetBinary]

function RegKeyGetBinary( Key: HKey; const ValueName: String; var Buffer; Count: Integer ): Integer;

begin

  Result := 0;

  if Key = 0 then Exit;

  Result := Count;

  RegQueryValueEx( Key, PChar( ValueName ), nil, nil, @ Buffer, @ Result );

end;



//[function RegKeySetBinary]

function RegKeySetBinary( Key: HKey; const ValueName: String; const Buffer; Count: Integer ): Boolean;

begin

  Result := (Key <> 0) and (RegSetValueEx( Key, PChar( ValueName ), 0,

                    REG_BINARY, @ Buffer, Count ) = ERROR_SUCCESS);

end;



//[function RegKeyGetDateTime]

function RegKeyGetDateTime(Key: HKey; const ValueName: String): TDateTime;

begin

  RegKeyGetBinary( Key, ValueName, Result, Sizeof( Result ) );

end;



//[function RegKeySetDateTime]

function RegKeySetDateTime(Key: HKey; const ValueName: String; DateTime: TDateTime): Boolean;

begin

  Result := RegKeySetBinary( Key, ValueName, DateTime, Sizeof( DateTime ) );

end;



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

// functions by Valerian Luft <luft@valerian.de>

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

//[function RegKeyGetSubKeys]

function RegKeyGetSubKeys( const Key: HKEY; List: PStrList) : Boolean;

var

  I, Size, NumSubKeys, MaxSubKeyLen : DWORD;

  KeyName: String;

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

          //FillChar(KeyName[1],Size,#0);

          RegEnumKeyEx(Key, I, @KeyName[1], Size, nil, nil, nil, nil);

          SetLength(KeyName, lstrlen(@KeyName[1]));

          List.Add(KeyName);

        end;

      end;

      Result:= True;

  end;

end;





//[function RegKeyGetValueNames]

function RegKeyGetValueNames(const Key: HKEY; List: PStrList): Boolean;

var

  I, Size, NumSubKeys, NumValueNames, MaxValueNameLen: DWORD;

  ValueName: String;

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

          SetLength(ValueName, lstrlen(@ValueName[1]));

          List.Add(ValueName);

        end;

     Result := True;

  end ;

end;





//[function RegKeyGetValueTyp]

function RegKeyGetValueTyp (const Key:HKEY; const ValueName: String) : 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. }



//[procedure DivMod]

procedure DivMod(Dividend: Integer; Divisor: Word;

  var Result, Remainder: Word);

{$IFDEF F_P}

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}



{++}(*

//[API GetLocalTime, GetSystemTime]

procedure GetLocalTime; external kernel32 name 'GetLocalTime';

procedure GetSystemTime; external kernel32 name 'GetSystemTime';

*){--}



//*

//[function Now]

function Now : TDateTime;

var SystemTime : TSystemTime;

begin

   GetLocalTime( SystemTime );

   SystemTime2DateTime( SystemTime, Result );

end;



//[function Date]

function Date: TDateTime;

begin

  Result := Trunc( Now );

end;



//[procedure DecodeDateFully]

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]

procedure DecodeDate( DateTime: TDateTime; var Year, Month, Day: WORD );

var Dummy: Word;

begin

  DecodeDateFully( DateTime, Year, Month, Day, Dummy );

end;



//[function EncodeDate]

function EncodeDate( Year, Month, Day: WORD; var DateTime: TDateTime ): Boolean;

var ST: TSystemTime;

begin

  FillChar( ST, Sizeof( ST ), 0 );

  ST.wYear := Year;

  ST.wMonth := Month;

  ST.wDay := Day;

  Result := SystemTime2DateTime( ST, DateTime );

end;



//[FUNCTION CompareSystemTime]

{$IFDEF ASM_VERSION}

function CompareSystemTime( const D1, D2 : TSystemTime) : Integer; assembler;

asm

        PUSH     ESI

        PUSH     EBX

        MOV      ESI, EAX

        XOR      EAX, EAX

        XOR      ECX, ECX

        MOV      CL, 8  // 8 words: wYear, wMonth,..., wMilliseconds

@@loo:

        LODSW

        MOV      BX, [EDX]

        INC      EDX

        INC      EDX



        CMP      CL, 6

        JE       @@cont  // skip compare DayOfWeek



        SUB      AX, BX

        JNE      @@calc



@@cont:

        LOOP     @@loo

        JMP      @@exit



@@calc:

        SBB      EAX, EAX

        {$IFDEF PARANOIA}

        DB $0C, 1

        {$ELSE}

        OR       AL, 1

        {$ENDIF}



@@exit:

        POP      EBX

        POP      ESI

end;

{$ELSE ASM_VERSION} //Pascal

function CompareSystemTime(const D1, D2 : TSystemTime) : Integer;

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;

begin

   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;

end;

{$ENDIF ASM_VERSION}

//[END CompareSystemTime]



//*

//[procedure IncDays]

procedure IncDays( var SystemTime : TSystemTime; DaysNum : Integer );

var DateTime : TDateTime;

begin

   SystemTime2DateTime( SystemTime, DateTime );

   DateTime := DateTime + DaysNum;

   DateTime2SystemTime( DateTime, SystemTime );

end;



//*

//[procedure IncMonths]

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]

function IsLeapYear(Year: Word): Boolean;

begin

  Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));

end;



//*

//[function SystemTime2DateTime]

function SystemTime2DateTime(const SystemTime : TSystemTime; var DateTime : TDateTime ) : Boolean;

var I : Integer;

    Day : Integer;

    DayTable: PDayTable;

begin

  Result := False;

  DateTime := 0.0;

  DayTable := @MonthDays[IsLeapYear(SystemTime.wYear)];

  with SystemTime do

//-------- by Vadim Petrov ----------------------------------------------------------------

//if (wYear >= 1) and (wYear <= 9999) and (wMonth >= 1) and (wMonth <= 12) and

//  (wDay >= 1) and (wDay <= DayTable^[wMonth]) and

//  (wHour < 24) and (wMinute < 60) and (wSecond < 60) and (wMilliSeconds < 1000) then

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

  if {(wYear >= 0) !always true! and} (wYear <= 9999) and

    {(wMonth >= 0) !always true! and} (wMonth <= 12) and

    {(wDay >= 0) !always true! and} (wDay <= DayTable^[wMonth]) and                                      //

    (wHour < 24) and (wMinute < 60) and (wSecond < 60) and (wMilliSeconds < 1000) 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 := I * 365 + I div 4 - I div 100 + I div 400 + Day

             + (wHour * 3600000 + wMinute * 60000 + wSecond * 1000 + wMilliSeconds) / MSecsPerDay;

    Result := True;

  end;

end;



//*

//[function DayOfWeek]

function DayOfWeek(Date: TDateTime): Integer;

begin

  Result := (Trunc( Date ) + 6) mod 7 + 1;

end;



//*

//[function DateTime2SystemTime]

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;

  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 := DayOfWeek( DateTime );

    DivMod(MSec, 60000, MinCount, MSecCount);

    DivMod(MinCount, 60, wHour, wMinute);

    DivMod(MSecCount, 1000, wSecond, wMilliSeconds);

    Result := True;

  end;

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]

function DateTime_System2Local( DTSys: TDateTime ): TDateTime;

begin

  Result := DTSys + DateTime_DiffSysLoc;

end;



//[function DateTime_Local2System]

function DateTime_Local2System( DTLoc: TDateTime ): TDateTime;

begin

  Result := DTLoc - DateTime_DiffSysLoc;

end;



//*

//[function CatholicEaster]

function CatholicEaster( nYear: Integer ): TDateTime;

var

   nMoon, nEpact, nSunday, nGold, nCent, nCorx, nCorz: Integer;

   SystemTime : TSystemTime;

begin

   FillChar( SystemTime, Sizeof( SystemTime ), 0 );

   with SystemTime do

   begin



    wYear := nYear;



    { The Golden Number of the year in the 19 year Metonic Cycle }

    nGold := ( ( wYear mod 19 ) + 1  );



    { Calculate the Century }

    nCent := ( ( wYear div 100 ) + 1 );



    { No. of Years in which leap year was dropped in order to keep in step

      with the sun }

    nCorx := ( ( 3 * nCent ) div 4 - 12 );



    { Special Correction to Syncronize Easter with the moon's orbit }

    nCorz := ( ( 8 * nCent + 5 ) div 25 - 5 );



    { Find Sunday }

    nSunday := ( ( 5 * wYear ) div 4 - nCorx - 10 );



    { Set Epact (specifies occurance of full moon }

    nEpact := ( ( 11 * nGold + 20 + nCorz - nCorx ) mod 30 );



    if ( nEpact < 0 ) then

       nEpact := nEpact + 30;



    if ( ( nEpact = 25 ) and ( nGold > 11 ) ) or ( nEpact = 24 ) then

       nEpact := nEpact + 1;



    { Find Full Moon }

    nMoon := 44 - nEpact;



    if ( nMoon < 21 ) then

       nMoon := nMoon + 30;



    { Advance to Sunday }

    nMoon := ( nMoon + 7 - ( ( nSunday + nMoon ) mod 7 ) );



    if ( nMoon > 31 ) then

       begin

         wMonth := 4;

         wDay   := ( nMoon - 31 );

       end

    else

       begin

         wMonth := 3;

         wDay   := nMoon;

       end;

   end;

   SystemTime2DateTime( SystemTime, Result );

end;



//*

//[function SystemDate2Str]

function SystemDate2Str( const SystemTime : TSystemTime; const LocaleID : DWORD;

                         const DfltDateFormat : TDateFormat; const DateFormat : PChar ) : String;

var Buf : PChar;

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

      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]

function SystemTime2Str( const SystemTime : TSystemTime; const LocaleID : DWORD;

                         const Flags : TTimeFormatFlags; const TimeFormat : PChar ) : String;

var Buf : PChar;

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

      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]

function Date2StrFmt( const Fmt: String; D: TDateTime ): String;

var ST: TSystemTime;

    lpFmt: PChar;

begin

  DateTime2SystemTime( D, ST );

  lpFmt := nil;

  if Fmt <> '' then lpFmt := PChar( Fmt );

  Result := SystemDate2Str( ST, LOCALE_USER_DEFAULT, dfShortDate, lpFmt );

end;



//[function Time2StrFmt]

function Time2StrFmt( const Fmt: String; D: TDateTime ): String;

var ST: TSystemTime;

    lpFmt: PChar;

begin

  if D < 1 then D := D + 1;

  DateTime2SystemTime( D, ST );

  lpFmt := nil;

  if Fmt <> '' then lpFmt := PChar( Fmt );

  Result := SystemTime2Str( ST, LOCALE_USER_DEFAULT, [], lpFmt );

end;



//[function DateTime2StrShort]

function DateTime2StrShort( D: TDateTime ): String;

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]

function Str2DateTimeFmt( const sFmtStr, sS: String ): TDateTime;

var h12, hAM: Boolean;

    FmtStr, S: PChar;



  function GetNum( var S: PChar; NChars: Integer ): Integer;

  begin

    Result := 0;

    while (S^ <> #0) and (NChars <> 0) do

    begin

      Dec( NChars );

      if S^ in ['0'..'9'] then

      begin

        Result := Result * 10 + Ord(S^) - Ord('0');

        Inc( S );

      end

      else

        break;

    end;

  end;



  function GetYear( var S: PChar; NChars: Integer ): Integer;

  var STNow: TSystemTime;

      OldDate: Boolean;

  begin

    Result := GetNum( S, NChars );

    GetSystemTime( STNow );

    OldDate := Result < 50;

    Result := Result + STNow.wYear - STNow.wYear mod 100;

    if OldDate then Dec( Result, 100 );

  end;



  function GetMonth( const fmt: String; var S: PChar ): Integer;

  var SD: TSystemTime;

      M: Integer;

      C, MonthStr: String;

  begin

    GetSystemTime( SD );

    for M := 1 to 12 do

    begin

      SD.wMonth := M;

      C := SystemDate2Str( SD, LOCALE_USER_DEFAULT, dfLongDate, PChar( fmt + '/dd/yyyy/' ) );

      MonthStr := Parse( C, '/' );

      if AnsiCompareStrNoCase( MonthStr, Copy( S, 1, Length( MonthStr ) ) ) = 0 then

      begin

        Result := M;

        Inc( S, Length( MonthStr ) );

        Exit;

      end;

    end;

    Result := 1;

  end;



  procedure SkipDayOfWeek( const fmt: String; var S: PChar );

  var SD: TSystemTime;

      Dt: TDateTime;

      D: Integer;

      C, DayWeekStr: String;

  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, PChar( 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: String; var S: PChar );

  var SD: TSystemTime;

      AM: Boolean;

      C, TimeMarkStr: String;

  begin

    GetSystemTime( SD );

    SD.wHour := 0;

    for AM := FALSE to TRUE do

    begin

      C := SystemDate2Str( SD, LOCALE_USER_DEFAULT, dfLongDate, PChar( 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: PChar ): Boolean;

  begin

    if StrIsStartingFrom( FmtStr, S ) then

    begin

      Inc( FmtStr, StrLen( S ) );

      Result := TRUE;

    end

      else

      Result := FALSE;

  end;



  function FmtIs( S1, S2: PChar ): Boolean;

  begin

    Result := FmtIs1( S1 ) or FmtIs1( S2 );

  end;



var ST: TSystemTime;

begin

  FmtStr := PChar( sFmtStr);

  S := PChar( sS );

  FillChar( ST, Sizeof( ST ), 0 );

  h12 := FALSE;

  hAM := FALSE;

  while (FmtStr^ <> #0) and (S^ <> #0) do

  begin

    if (FmtStr^ in ['a'..'z','A'..'Z']) and (S^ in ['0'..'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^ in [ 'M', 'd', '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;



var FmtBuf: PChar;

    DateSeparator : Char = #0; // + ECM



//[function Str2DateTimeShort]

function Str2DateTimeShort( const S: String ): TDateTime;

var FmtStr, FmtStr2: String;



  function EnumDateFmt( lpstrFmt: PChar ): Boolean; stdcall;

  begin

    GetMem( FmtBuf, StrLen( lpstrFmt ) + 1 );

    StrCopy( 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;



// + ECM

//[function Str2DateTimeShortEx]

function Str2DateTimeShortEx( const S: String ): TDateTime;

var St: String;

  Buff: Array[0..1] of Char;

begin

  if DateSeparator = #0 then

  begin

    if GetLocaleInfo(GetThreadLocale,LOCALE_SDATE,Buff,2) > 0 then

      DateSeparator := Buff[0];

  end;

  St := S;

  if Pos(DateSeparator,S) = 0 then

    St := '0.0.0 '+S;

  Result := Str2DateTimeShort(St);

end;





































///////////////////////////////////////////////////////////////////////

//

//

//                          T  H  R  E  A  D  S

//

//

///////////////////////////////////////////////////////////////////////

















{ -- Thread -- }



//[function ThreadFunc]

function ThreadFunc(Thread: PThread): integer; stdcall;

begin

  Result := Thread.Execute;

end;



{$IFDEF USE_CONSTRUCTORS}

//[function NewThread]

function NewThread: PThread;

begin

  new( Result, ThreadCreate );

end;

//[END NewThread]

{$ELSE not_USE_CONSTRUCTORS}

//*

//[function NewThread]

function NewThread: PThread;

begin

  {$IFNDEF FPC105ORBELOW}

  IsMultiThread := True;

  {$ENDIF}

  {-}

  New( Result, Create );

  {+}

  {++}(*Result := PThread.Create;*){--}

  Result.FSuspended := True;

  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

end;

//[END NewThread]

{$ENDIF USE_CONSTRUCTORS}



{$IFDEF USE_CONSTRUCTORS}

//[function NewThreadEx]

function NewThreadEx( const Proc: TOnThreadExecute ): PThread;

begin

  new( Result, ThreadCreateEx( Proc ) );

end;

{$ELSE not_USE_CONSTRUCTORS}



//[FUNCTION NewThreadEx]

{$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 ASM_VERSION} //Pascal

function NewThreadEx( const Proc: TOnThreadExecute ): PThread;

begin

  Result := NewThread;

  Result.OnExecute := {++}(*{$IFDEF F_P} @ {$ENDIF}*){--}Proc;

  Result.Resume;

end;

{$ENDIF ASM_VERSION}

//[END NewThreadEx]



{$ENDIF USE_CONSTRUCTORS}



//[function NewThreadAutoFree]

function NewThreadAutoFree( const Proc: TOnThreadExecute ): PThread;

begin

  Result := NewThread;

  Result.OnExecute := {++}(*{$IFDEF F_P} @ {$ENDIF}*){--}Proc;

  Result.F_AutoFree := TRUE;

  if Assigned( Proc ) then

    Result.Resume;

end;



{ TThread }



{$IFDEF ASM_VERSION}

//[destructor TThread.Destroy]

destructor TThread.Destroy;

asm

        PUSH     EBX

        MOV      EBX, EAX

        CMP      [EAX].FTerminated, 0

        JNZ      @@1

        CALL     Terminate

        MOV      EAX, EBX

        CALL     WaitFor

@@1:    MOV      ECX, [EBX].FHandle

        JECXZ    @@2

        PUSH     ECX

        CALL     CloseHandle

@@2:    POP      EAX

        XCHG     EBX, EAX

        JMP      TObj.Destroy

end;

{$ELSE ASM_VERSION} //Pascal

destructor TThread.Destroy;

begin

  if not FTerminated then

  begin

    Terminate;

    WaitFor;

  end;

  if (FHandle <> 0) then

    CloseHandle(FHandle);

  inherited;

end;

{$ENDIF ASM_VERSION}



//*

//[function TThread.Execute]

function TThread.Execute: integer;

begin

  Result := 0;

  if Assigned( FOnExecute ) then

     Result := FOnExecute( @Self );

  if F_AutoFree then

  begin

    FTerminated := TRUE; // fake thread object (to prevent terminating while freeing)

    Free;

  end;

end;



//*

//[function TThread.GetPriorityCls]

function TThread.GetPriorityCls: Integer;

begin

  Result := GetPriorityClass(FHandle);

end;



//*

//[function TThread.GetThrdPriority]

function TThread.GetThrdPriority: Integer;

begin

  Result := GetThreadPriority(FHandle);

end;



//*

//[procedure TThread.Resume]

procedure TThread.Resume;

begin

  FSuspended := False;

  if (ResumeThread(FHandle) > 1) then

    FSuspended := True

  else

  if Assigned(FOnResume) then

    FOnResume(@Self);

end;



//*

//[procedure TThread.SetPriorityCls]

procedure TThread.SetPriorityCls(Value: Integer);

begin

  {$IFDEF DEBUG}

  if not SetPriorityClass(GetCurrentProcess, Value) then

  begin

    ShowMessage( SysErrorMessage( GetLastError ) );

  end;

  {$ELSE}

  SetPriorityClass(GetCurrentProcess, Value);

  {$ENDIF}

end;



//*

//[procedure TThread.SetThrdPriority]

procedure TThread.SetThrdPriority(Value: Integer);

begin

  SetThreadPriority(FHandle, Value);

end;



//*

//[procedure TThread.Suspend]

procedure TThread.Suspend;

begin

  FSuspended := TRUE;

  if Assigned(FOnSuspend) then

    Synchronize( FOnSuspend );

  SuspendThread(FHandle);

end;



//*

//[procedure CallSynchronized]

procedure CallSynchronized( Sender: PObj; Param: Pointer );

var Thread: PThread;

begin

  Thread := PThread( Sender );

  if Param <> nil then

    Thread.FMethodEx( Thread, Param )

  else

    Thread.FMethod( );

end;



//*

//[procedure TThread.Synchronize]

procedure TThread.Synchronize(Method: TThreadMethod);

begin

  Global_Synchronized := CallSynchronized;

  FMethod := Method;

  if Applet <> nil then

    SendMessage( Applet.fHandle, CM_EXECPROC, 0, Integer( @Self ) );

end;



//[procedure TThread.SynchronizeEx]

procedure TThread.SynchronizeEx( Method: TThreadMethodEx; Param: Pointer );

begin

  Assert( Param <> nil, 'Parameter must not be NIL' );

  Global_Synchronized := CallSynchronized;

  FMethodEx := Method;

  SendMessage( Applet.fHandle, CM_EXECPROC, Integer( Param ), Integer( @Self ) );

end;



//*

//[procedure TThread.Terminate]

procedure TThread.Terminate;

begin

  TerminateThread(FHandle,0);

  FTerminated := True;

end;



//*

//[function TThread.WaitFor]

function TThread.WaitFor: Integer;

begin

  RefInc;

  Result := -1;

  if FHandle = 0 then Exit;

  WaitForSingleObject(FHandle, INFINITE);

  GetExitCodeThread(FHandle, DWORD(Result));

  RefDec;

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]

function TStream.GetPosition: DWord;

begin

  Result := Seek( 0, spCurrent );

end;



//[procedure TStream.SetPosition]

procedure TStream.SetPosition(Value: DWord);

begin

  Seek( Value, spBegin );

end;



{$IFDEF ASM_VERSION}

//[function TStream.GetSize]

function TStream.GetSize: DWord;

asm

        CALL     [EAX].fMethods.fGetSiz

end;

{$ELSE ASM_VERSION} //Pascal

function TStream.GetSize: DWord;

begin

  Result := fMethods.fGetSiz( @Self );

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[procedure TStream.SetSize]

procedure TStream.SetSize(NewSize: DWord);

asm

        CALL     [EAX].fMethods.fSetSiz

end;

{$ELSE ASM_VERSION} //Pascal

procedure TStream.SetSize(NewSize: DWord);

begin

  fMethods.fSetSiz( @Self, NewSize );

end;

{$ENDIF ASM_VERSION}



//[function TStream.GetFileStreamHandle]

function TStream.GetFileStreamHandle: THandle;

begin

  Result := fData.fHandle;

end;



{$IFDEF ASM_VERSION}

//[function TStream.Read]

function TStream.Read(var Buffer; Count: DWord): DWord;

asm

        CALL     [EAX].fMethods.fRead

end;

{$ELSE ASM_VERSION} //Pascal

function TStream.Read(var Buffer; Count: DWord): DWord;

begin

  Result := fMethods.fRead( @Self, Buffer, Count );

end;

{$ENDIF ASM_VERSION}



//[function TStream.GetCapacity]

function TStream.GetCapacity: DWORD;

begin

  Result := fData.fCapacity;

end;



//[procedure TStream.SetCapacity]

procedure TStream.SetCapacity(const Value: DWORD);

var OldSize: DWORD;

begin

  if fData.fCapacity >= Value then Exit;

  OldSize := Size;

  Size := Value;

  Size := OldSize;

end;



//[function TStream.Busy]

function TStream.Busy: Boolean;

begin

  Result := Assigned( fData.fThread );

end;



//[function TStream.DoAsyncRead]

function TStream.DoAsyncRead( Sender: PThread ): Integer;

begin

  Read( Pointer( fParam1 )^, fParam2 );

  fData.fThread := nil;

  Result := 0;

end;



//[procedure TStream.ReadAsync]

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]

function TStream.DoAsyncSeek( Sender: PThread ): Integer;

begin

  Seek( fParam1, TMoveMethod( fParam2 ) );

  fData.fThread := nil;

  Result := 0;

end;



//[procedure TStream.SeekAsync]

procedure TStream.SeekAsync(MoveTo: Integer; 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]

function TStream.DoAsyncWrite( Sender: PThread ): Integer;

begin

  Write( Pointer( fParam1 )^, fParam2 );

  fData.fThread := nil;

  Result := 0;

end;



//[procedure TStream.WriteAsync]

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]

procedure TStream.Wait;

begin

  if not Assigned( fData.fThread ) then Exit;

  if Assigned( fMethods.fWait ) then

    fMethods.fWait( @Self )

  else

    fData.fThread.WaitFor;

end;



{$IFDEF ASM_VERSION}

//[function TStream.Write]

function TStream.Write(var Buffer; Count: DWord): DWord;

asm

        CALL     [EAX].fMethods.fWrite

end;

{$ELSE ASM_VERSION} //Pascal

function TStream.Write(var Buffer; Count: DWord): DWord;

begin

  Result := fMethods.fWrite( @Self, Buffer, Count );

end;

{$ENDIF ASM_VERSION}



//[function TStream.WriteStr]

function TStream.WriteStr(S: String): DWORD;

begin

  if S <> '' then

    Result := fMethods.fWrite( @Self, S[1], Length( S ) )

  else

    Result := 0;

end;



//[function TStream.ReadStrZ]

function TStream.ReadStrZ: String;

var C: Char;

begin

  Result := '';

  REPEAT

    C := #0;

    Read( C, 1 );

    if C <> #0 then Result := Result + C;

  UNTIL C = #0;

end;



//[function TStream.ReadStr]

function TStream.ReadStr: String;

var C: Char;

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 in [ #13, #0 ];

end;



//[function TStream.WriteStrZ]

function TStream.WriteStrZ(S: String): DWORD;

var C: Char;

begin

  if S = '' then

    begin

      C := #0;

      Result := Write( C, 1 );

    end

  else

    Result := Write( S[ 1 ], Length( S ) + 1 );

end;



//[function TStream.WriteStrEx]

function TStream.WriteStrEx(S: String): 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]

function TStream.ReadStrExVar(var S: String): 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]

function TStream.ReadStrEx: String;

begin

  readstrexvar(result);

end;



//[function TStream.WriteStrPas]

function TStream.WriteStrPas( S: String ): 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]

function TStream.ReadStrPas: String;

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_VERSION}

//[function TStream.Seek]

function TStream.Seek(MoveTo: integer; MoveMethod: TMoveMethod): DWord;

asm

        CALL     [EAX].fMethods.fSeek

end;

{$ELSE ASM_VERSION} //Pascal

function TStream.Seek(MoveTo: integer; MoveMethod: TMoveMethod): DWord;

begin

  Result := fMethods.fSeek( @Self, MoveTo, MoveMethod );

end;

{$ENDIF ASM_VERSION}



{$IFDEF ASM_VERSION}

//[destructor TStream.Destroy]

destructor TStream.Destroy;

asm

        PUSH     EAX

        PUSH     [EAX].fData.fThread

        CALL     [EAX].fMethods.fClose

        POP      EAX

        CALL     TObj.Free

        POP      EAX

        CALL     TObj.Destroy

end;

{$ELSE ASM_VERSION} //Pascal

destructor TStream.Destroy;

begin

  fMethods.fClose( @Self );

  fData.fThread.Free;

  inherited;

end;

{$ENDIF ASM_VERSION}



//+-

//[function _NewStream]

function _NewStream( const StreamMethods: TStreamMethods ): PStream;

begin

  {-}

  New( Result, Create );

  {+}{++}(*Result := PStream.Create;*){--}

  Move( StreamMethods, Result.fMethods, Sizeof( TStreamMethods ) );

  Result.fPMethods := @Result.fMethods;

end;



//+

//[function SeekFileStream]

function SeekFileStream( Strm: PStream; MoveTo: Integer; MoveFrom: TMoveMethod ): DWORD;

begin

  Result := FileSeek( Strm.fData.fHandle, MoveTo, MoveFrom );

end;



//+

//[function GetSizeFileStream]

function GetSizeFileStream( Strm: PStream ): DWORD;

begin

  Result := GetFileSize( Strm.fData.fHandle, nil );

  if Result = DWORD( -1 ) then Result := 0;

end;



//[procedure DummySetSize]

procedure DummySetSize( Strm: PStream; Value: DWORD );

begin

end;



//[procedure DummyStreamProc]

procedure DummyStreamProc(Strm: PStream);

begin

end;



//[function DummyReadWrite]

function DummyReadWrite( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

asm

  XOR EAX, EAX

end;



//[function ReadFileStream]

function ReadFileStream( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

begin

  Result := FileRead( Strm.fData.fHandle, Buffer, Count );

end;



//[function WriteFileStream]

function WriteFileStream( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

begin

  Result := FileWrite( Strm.fData.fHandle, Buffer, Count );

end;



//[FUNCTION WriteFileStreamEOF]

{$IFDEF ASM_VERSION}

function WriteFileStreamEOF( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

asm

        PUSH     EBX

        PUSH     [EAX].TStream.fData.fHandle

        CALL     WriteFileStream

        XCHG     EBX, EAX

        CALL     SetEndOfFile

        XCHG     EAX, EBX

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function WriteFileStreamEOF( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

begin

  Result := WriteFileStream( Strm, Buffer, Count );

  SetEndOfFile( Strm.fData.fHandle );

end;

{$ENDIF ASM_VERSION}

//[END WriteFileStreamEOF]



//[procedure CloseFileStream]

procedure CloseFileStream( Strm: PStream );

begin

  FileClose( Strm.fData.fHandle );

end;



//[FUNCTION SeekMemStream]

{$IFDEF ASM_VERSION}

function SeekMemStream( Strm: PStream; MoveTo: Integer; MoveFrom: TMoveMethod ): DWORD;

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 ASM_VERSION} //Pascal

function SeekMemStream( Strm: PStream; MoveTo: Integer; MoveFrom: TMoveMethod ): DWORD;

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 ASM_VERSION}

//[END SeekMemStream]



//[function GetSizeMemStream]

function GetSizeMemStream( Strm: PStream ): DWORD;

begin

  Result := Strm.fData.fSize;

end;



//[PROCEDURE SetSizeMemStream]

{$IFDEF ASM_VERSION}

procedure SetSizeMemStream( Strm: PStream; NewSize: DWORD );

asm

        CMP      [EAX].TStream.fData.fCapacity, EDX

        JGE      @@cap_ok

        PUSH     EDX

        PUSH     EAX

        MOV      ECX, [EAX].TStream.fMemory

        JECXZ    @@get_mem

        TEST     EDX, EDX

        JZ       @@free_mem

        LEA      EAX, [EAX].TStream.fMemory

        CALL     System.@ReallocMem

        JMP      @@1

@@get_mem:

        XCHG     EAX, EDX

        CALL     System.@GetMem

        XCHG     EDX, EAX

        POP      EAX

        MOV      [EAX].TStream.fMemory, EDX

        JMP      @@2

@@free_mem:

        XCHG     EDX, [EAX].TStream.fMemory

        XCHG     EAX, EDX

        CALL     System.@FreeMem

@@1:

        POP      EAX

@@2:

        POP      EDX



@@cap_ok:

        MOV      [EAX].TStream.fData.fSize, EDX

        CMP      [EAX].TStream.fData.fPosition, EDX

        JLE      @@exit

        MOV      [EAX].TStream.fData.fPosition, EDX

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

procedure SetSizeMemStream( Strm: PStream; NewSize: DWORD );

var S: PStream;

begin

  S := Strm;

  if S.fData.fCapacity < NewSize then

  begin

    if S.fMemory = nil then

    begin

      if NewSize <> 0 then

         GetMem( S.fMemory, NewSize );

    end

      else

    if NewSize = 0 then

    begin

      FreeMem( S.fMemory );

      S.fMemory := nil;

    end

      else

      ReallocMem( S.fMemory, NewSize );

    S.fData.fCapacity := NewSize;

  end;

  S.fData.fSize := NewSize;

  if S.fData.fPosition > S.fData.fSize then

     S.fData.fPosition := S.fData.fSize;

end;

{$ENDIF ASM_VERSION}

//[END SetSizeMemStream]



//[FUNCTION ReadMemStream]

{$IFDEF ASM_VERSION}

function ReadMemStream( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

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 ASM_VERSION} //Pascal

function ReadMemStream( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

var S: PStream;

begin

  S := Strm;

  if Count + S.fData.fPosition > S.fData.fSize then

     Count := S.fData.fSize - S.fData.fPosition;

  Result := Count;

  Move( Pointer( DWORD(S.fMemory) + S.fData.fPosition )^, Buffer, Result );

  Inc( S.fData.fPosition, Result );

end;

{$ENDIF ASM_VERSION}

//[END ReadMemStream]



//[FUNCTION WriteMemStream]

{$IFDEF ASM_VERSION}

function WriteMemStream( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

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 ASM_VERSION} //Pascal

function WriteMemStream( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

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 ASM_VERSION}

//[END WriteMemStream]



//[PROCEDURE CloseMemStream]

{$IFDEF ASM_VERSION}

procedure CloseMemStream( Strm: PStream );

asm

        MOV      ECX, [EAX].TStream.fMemory

        JECXZ    @@exit

        XCHG     EAX, ECX

        CALL     System.@FreeMem

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

procedure CloseMemStream( Strm: PStream );

var S: PStream;

begin

  S := Strm;

  if S.fMemory <> nil then

    FreeMem( S.fMemory );

end;

{$ENDIF ASM_VERSION}

//[END CloseMemStream]



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;

  );



// by Roman Vorobets:

//[procedure SetSizeFileStream]

procedure SetSizeFileStream( Strm: PStream; NewSize: DWORD );

var

  P: DWORD;

begin

  P:=Strm.Position;

  Strm.Position:=NewSize;

  SetEndOfFile(Strm.Handle);

  if P < NewSize then

    Strm.Position:=P;

end;



//[function NewFileStream]

function NewFileStream( const FileName: String; Options: DWORD ): PStream;

begin

  Result := _NewStream( BaseFileMethods );

  Result.fMethods.fRead := ReadFileStream;

  Result.fMethods.fWrite := WriteFileStream; // not WriteStreamEOF, Àëåêñåé Øóâàëîâ

  Result.fMethods.fSetSiz := SetSizeFileStream;

  Result.fData.fHandle := FileCreate( FileName, Options );

end;



//[FUNCTION NewReadFileStream]

{$IFDEF ASM_VERSION}

function NewReadFileStream( const FileName: String ): PStream;

asm

        PUSH     EBX

        XCHG     EBX, EAX

        MOV      EAX, offset[BaseFileMethods]

        CALL     _NewStream

        MOV      [EAX].TStream.fMethods.fRead, offset[ReadFileStream]

        XCHG     EBX, EAX

        MOV      EDX, ofOpenRead or ofOpenExisting or ofShareDenyWrite

        CALL     FileCreate

        MOV      [EBX].TStream.fData.fHandle, EAX

        XCHG     EAX, EBX

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function NewReadFileStream( const FileName: String ): PStream;

begin

  Result := _NewStream( BaseFileMethods );

  Result.fMethods.fRead := ReadFileStream;

  Result.fData.fHandle := FileCreate( FileName,

                                      ofOpenRead or ofShareDenyWrite or ofOpenExisting );

end;

{$ENDIF ASM_VERSION}

//[END NewReadFileStream]



//[FUNCTION NewWriteFileStream]

{$IFDEF ASM_VERSION}

function NewWriteFileStream( const FileName: String ): PStream;

asm

        PUSH     EBX

        XCHG     EBX, EAX

        MOV      EAX, offset[BaseFileMethods]

        CALL     _NewStream

        MOV      [EAX].TStream.fMethods.fWrite, offset[WriteFileStreamEOF]

        MOV      [EAX].TStream.fMethods.fSetSiz, offset[SetSizeFileStream]

        XCHG     EBX, EAX

        MOV      EDX, ofOpenWrite or ofCreateAlways or ofShareDenyWrite

        CALL     FileCreate

        MOV      [EBX].TStream.fData.fHandle, EAX

        XCHG     EAX, EBX

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function NewWriteFileStream( const FileName: String ): 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 ASM_VERSION}

//[END NewWriteFileStream]



//[FUNCTION NewReadWriteFileStream]

{$IFDEF ASM_noVERSION}

function NewReadWriteFileStream( const FileName: String ): PStream;

asm

        PUSH     EBX

        XCHG     EBX, EAX

        MOV      EAX, offset[BaseFileMethods]

        CALL     _NewStream

        MOV      [EAX].TStream.fMethods.fRead, offset[ReadFileStream]

        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 ASM_VERSION} //Pascal

function NewReadWriteFileStream( const FileName: String ): PStream;

var Creation: DWORD;

begin

  Result := _NewStream( BaseFileMethods );

  Result.fMethods.fRead := ReadFileStream;

  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 ASM_VERSION}

//[END NewReadWriteFileStream]



//[function NewMemoryStream]

function NewMemoryStream: PStream;

begin

  Result := _NewStream( MemoryMethods );

end;



//[FUNCTION WriteExMemoryStream]

{$IFDEF ASM_VERSION}

function WriteExMemoryStream( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

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 ASM_VERSION}

function WriteExMemoryStream( Strm: PStream; var Buffer; Count: DWORD ): DWORD;

var S: PStream;

begin

  S := Strm;

  if Count + S.fData.fPosition > S.fData.fSize then

    Count := S.fData.fSize - S.fData.fPosition;

  Result := Count;

  Move( Buffer, Pointer( DWORD(S.fMemory) + S.fData.fPosition )^, Result );

  Inc( S.fData.fPosition, Result );

end;

{$ENDIF ASM_VERSION}

//[END WriteExMemoryStream]



//[procedure DummyClose_ExMemStream]

procedure DummyClose_ExMemStream( Strm: PStream );

begin

  // nothing to do - ignore call (memory is not released by any way)

end;



//[function NewExMemoryStream]

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 Stream2Stream]

function Stream2Stream( Dst, Src: PStream; Count: DWORD ): DWORD;

var Buf: Pointer;

begin

  if Src.fMemory <> nil then

  begin

     if Src.fData.fPosition + Count > Src.fData.fSize then

        Count := Src.fData.fSize - Src.fData.fPosition;

     Result := Dst.Write( Pointer(DWORD(Src.fMemory)+Src.fData.fPosition)^,

                   Count );

     Inc( Src.fData.fPosition, Result );

  end

     else

  if Dst.fMemory <> nil then

  begin

    if Dst.fData.fPosition + Count > Dst.fData.fSize then

       Dst.SetSize( Dst.fData.fPosition + Count );

    Result := Src.Read( Pointer( DWORD( Dst.fMemory ) + Dst.fData.fPosition )^,

                        Count );

    Inc( Dst.fData.fPosition, Result );

  end

     else

  begin

    GetMem( Buf, Count );

    Count := Src.Read( Buf^, Count );

    Result := Dst.Write( Buf^, Count );

    FreeMem( Buf );

  end;

end;



//[function Stream2StreamEx]

function Stream2StreamEx( Dst, Src: PStream; Count: DWORD ): DWORD;

begin

  Result := Stream2StreamExBufSz( Dst, Src, Count, 65536 );

end;



//[function Stream2StreamExBufSz]

function Stream2StreamExBufSz( Dst, Src: PStream; Count, BufSz: DWORD ): DWORD;

var

  buf:pointer;

  rd, wr:dword;

begin

  if count=0 then result:=0 else

  begin

    result:=0;

    BufSz := Min( BufSz, Count );

    if BufSz = 0 then BufSz := Count;

    getmem(buf,BufSz);

    repeat

      if count<BufSz then rd:=count else rd:=BufSz;

      rd:=src.read(buf^,rd);

      wr := dst.write(buf^,rd);

      inc(result,wr);

      dec(Count, rd);

    until (rd<>BufSz) or (Count=0);

    freemem(buf);

  end;

end;



//[FUNCTION Resource2Stream]

{$IFDEF ASM_VERSION}

function Resource2Stream( DestStrm : PStream; Inst : HInst;

                          ResName : PChar; ResType : PChar ): 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 ASM_VERSION} //Pascal

function Resource2Stream( DestStrm : PStream; Inst : HInst;

                          ResName : PChar; ResType : PChar ): Integer;

var R : HRSRC;

    G : HGlobal;

    P : PChar;

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

      { from Win32.hlp: "You do not need to call the FreeResource

        function to free a resource loaded by using the LoadResource

        function." }

    end;

  end;

end;

{$ENDIF ASM_VERSION}

//[END Resource2Stream]

























///////////////////////////////////////////////////////////////////////////

//

//

//                        I  N  I  -  F  I  L  E  S

//

//

///////////////////////////////////////////////////////////////////////////





{ TIniFile }



{$IFDEF ASM_VERSION}

//[destructor TIniFile.Destroy]

destructor TIniFile.Destroy;

asm     //cmd    //opd

        PUSH     EAX

        LEA      EDX, [EAX].fFileName

        PUSH     EDX

        LEA      EAX, [EAX].fSection

        CALL     System.@LStrClr

        POP      EAX

        CALL     System.@LStrClr

        POP      EAX

        CALL     TObj.Destroy

end;

{$ELSE ASM_VERSION} //Pascal

destructor TIniFile.Destroy;

begin

  fFileName := '';

  fSection := '';

  inherited;

end;

{$ENDIF ASM_VERSION}



{$IFNDEF _D5orHigher}

// Place here correct definition for WritePrivateProfileStruct

// and GetPrivateProfileStruct (a bug in Delphi2, Delphi3 and Delphi4)

//[API WritePrivateProfileStruct]

function WritePrivateProfileStruct(lpszSection, lpszKey: PChar;

  lpStruct: Pointer; uSizeStruct: UINT; szFile: PChar): BOOL; stdcall;

  external kernel32 name 'WritePrivateProfileStructA';

//[API GetPrivateProfileStruct]

function GetPrivateProfileStruct(lpszSection, lpszKey: PAnsiChar;

  lpStruct: Pointer; uSizeStruct: UINT; szFile: PAnsiChar): BOOL; stdcall;

  external kernel32 name 'GetPrivateProfileStructA';



// + by Slava A. Gavrik:

////////////////////////////////////////////////////////////////////////////

//[function WritePrivateProfileSection]

function WritePrivateProfileSection(lpAppName, lpString,

  lpFileName: PChar): BOOL; stdcall;

  external kernel32 name 'WritePrivateProfileSectionA';

//[function GetPrivateProfileSection]

function GetPrivateProfileSection(lpAppName: PChar; lpReturnedString: PChar;

  nSize: DWORD; lpFileName: PChar): DWORD; stdcall;

  external kernel32 name 'GetPrivateProfileSectionA';



//[function GetPrivateProfileSectionNames]

function GetPrivateProfileSectionNames(lpszReturnBuffer: PChar; nSize:

DWORD;

  lpFileName: PChar): DWORD; stdcall;

  external kernel32 name 'GetPrivateProfileSectionNamesA';

////////////////////////////////////////////////////////////////////////////

{$ENDIF}





//[procedure TIniFile.ClearAll]

procedure TIniFile.ClearAll;

begin

  WritePrivateProfileString( nil, nil, nil,

                             PChar( fFileName ) );

end;



//[procedure TIniFile.ClearKey]

procedure TIniFile.ClearKey(const Key: String);

begin

  WritePrivateProfileString( PChar( fSection ), PChar( Key ), nil,

                             PChar( fFileName ) );

end;



//[procedure TIniFile.ClearSection]

procedure TIniFile.ClearSection;

begin

  WritePrivateProfileString( PChar( fSection ), nil, nil,

                             PChar( fFileName ) );

end;



//[function TIniFile.ValueBoolean]

function TIniFile.ValueBoolean(const Key: String; Value: Boolean): Boolean;

begin

  if fMode = ifmRead then

     Result := GetPrivateProfileInt( PChar( fSection ), PChar( Key ),

               Integer( Value ), PChar( fFileName ) ) <> 0

  else

  begin

    WritePrivateProfileString( PChar( fSection ), PChar( Key ),

              PChar( Int2Str( Integer( Value ) ) ), PChar( fFileName ) );

    Result := Value;

  end;

end;



//[function TIniFile.ValueData]

function TIniFile.ValueData(const Key: String; Value: Pointer;

  Count: Integer): Boolean;

begin

  if fMode = ifmRead then

     Result := GetPrivateProfileStruct( PChar( fSection ), PChar( Key ),

               Value, Count, PChar( fFileName ) )

  else

     Result := WritePrivateProfileStruct( PChar( fSection ), PChar( Key ),

               Value, Count, PChar( fFileName ) );

end;



//[function TIniFile.ValueInteger]

function TIniFile.ValueInteger(const Key: String; Value: Integer): Integer;

begin

  if fMode = ifmRead then

     Result := GetPrivateProfileInt( PChar( fSection ), PChar( Key ),

               Integer( Value ), PChar( fFileName ) )

  else

  begin

     Result := Value;

     WritePrivateProfileString( PChar( fSection ), PChar( Key ),

               PChar( Int2Str( Value ) ), PChar( fFileName ) );

  end;

end;



//[function TIniFile.ValueString]

function TIniFile.ValueString(const Key, Value: String): String;

var

  Buffer: array[0..2047] of Char;

begin

  if fMode = ifmRead then

  begin

    Buffer[ 0 ] := #0;

    GetPrivateProfileString(PChar(fSection),

         PChar(Key), PChar(Value), Buffer, SizeOf(Buffer), PChar(fFileName));

    Result := Buffer;

  end

    else

  begin

     Result := Value;

     WritePrivateProfileString( PChar( fSection ), PChar( Key ),

               PChar( Value ), PChar( fFileName ) );

  end;

end;



//[function OpenIniFile]

function OpenIniFile( const FileName: String ): PIniFile;

begin

  {-}

  New( Result, Create );

  {+}{++}(*Result := PIniFile.Create;*){--}

  Result.fFileName := FileName;

end;



/////////////////////////////////////////////////// GetSectionNames, SectionData

// - by Vyacheslav A. Gavrik :



const

  IniBufferSize = 32767;

  IniBufferStrSize = IniBufferSize+4;         /// äëÿ ìàõèíàöèé :)



{$IFDEF ASM_VERSION}

//[procedure _FillStrList]

procedure _FillStrList;    // Ýòà ÷àñòü êîäà îáùàÿ äëÿ äâóõ ñëåäóþùèõ ïðîöåäóð

asm

///////////////////////////////

        OR      EAX,0

        JE      @@EXIT                  //ERROR

//        LEA     EAX,[EAX-IniBufferSize]

//        JE      @@EXIT

//      âîçìîæíà íåõâàòêà Áóôåðà... â ïðèíöèïå íå îøèáêà :)

//      âîçâðàùàåì ÷òî âëåçëî...

//////////////////////////////

@@LOOP:

        LEA     EAX,[ESI+4]

        CALL    StrLen

        MOV     [ESI],EAX

        LEA     EDX,[ESI+4]

        INC     EAX

        ADD     ESI,EAX



        MOV     EAX,EDI



        CALL    TStrList.ADD



        CMP     byte ptr [ESI+4],0

        JNE     @@LOOP



@@EXIT:

        POP     EAX

        CALL    System.@FreeMem





        POP     ECX

        POP     EBX

        POP     EDI

        POP     ESI

end;





//[procedure TIniFile.GetSectionNames]

procedure TIniFile.GetSectionNames(Names: PStrList);

asm

        PUSH    ESI

        PUSH    EDI

        PUSH    EBX

        PUSH    ECX



        MOV     EBX,EAX

        MOV     EAX, IniBufferStrSize

        MOV     EDI,EDX



        CALL    System.@GetMem

        MOV     ESI,EAX

        PUSH    EAX



        PUSH    [EBX].fFileName

        MOV     EAX,IniBufferSize

        PUSH    EAX



        LEA     EAX,[ESI+4]

        PUSH    EAX



        CALL    GetPrivateProfileSectionNames

        JMP     _FillStrList

end;



//[procedure TIniFile.SectionData]

procedure TIniFile.SectionData(Names: PStrList);

asm

        PUSH    ESI

        PUSH    EDI

        PUSH    EBX

        PUSH    ECX



        MOV     EBX,EAX

        MOV     EAX, IniBufferStrSize

        MOV     EDI,EDX



        CALL    System.@GetMem

        MOV     ESI,EAX

        PUSH    EAX



        OR     [EBX].fMode,0

        JNE     @@DOWrite



        PUSH    [EBX].fFileName

        MOV     EAX,IniBufferSize

        PUSH    EAX



        LEA     EAX,[ESI+4]

        PUSH    EAX

        PUSH    [EBX].fSection



        CALL    GetPrivateProfileSection

        JMP     _FillStrList



@@DOWrite:



        PUSH    EBX

        PUSH    ESI

        PUSH    EDX

        PUSH    EBP



        MOV     EDX,0

        MOV     EBP,[EDI].TStrList.fCount

        MOV     EBX,IniBufferSize-2 // îñòàâèì ìåñòî äëÿ #0#0



{ECM+++>} OR      EBP,EBP  // otherwise GetPChars when StrList.Count = 0 crashed



@@LOOP:

        JE      @@ENDLOOP



        OR      EBX,EBX

        JE      @@ENDLOOP



        PUSH    EDX

        MOV     EAX,EDI

        CALL    TStrList.GetPChars



        PUSH    EAX

        CALL    StrLen

        POP     EAX



        XOR     ECX,-1

        MOV     EDX,ESI



        SUB     EBX,ECX

        JA      @@L1

        ADD     ECX,EBX

        XOR     EBX,EBX

@@L1:



        ADD     ESI,ECX



        CALL    MOVE

@@L2:

        POP     EDX

        INC     EDX

        DEC     EBP

        JMP     @@LOOP

@@ENDLOOP:

        MOV     WORD PTR [ESI],0



        POP     EBP

        POP     EDX

        POP     ESI

        POP     EBX

///////////////////////////////////

        MOV     EAX,EBX                 // íîäî î÷èùàòü

        CALL    ClearSection

//////////////////////////////////



        PUSH    [EBX].fFileName

        PUSH    ESI

        PUSH    [EBX].fSection



        CALL    WritePrivateProfileSection



        POP     EAX

        CALL    System.@FreeMem



        POP     ECX

        POP     EBX

        POP     EDI

        POP     ESI



end;

{$ELSE ASM_VERSION} //Pascal



//[procedure TIniFile.GetSectionNames]

procedure TIniFile.GetSectionNames(Names: PStrList);

var

  i:integer;

  Pc:PChar;

  PcEnd:PChar;

  Buffer:Pointer;

begin

  GetMem(Buffer,IniBufferSize);

  Pc:=Buffer;

  i := GetPrivateProfileSectionNames(Buffer, IniBufferSize, PChar(fFileName));

  PcEnd:=Pc+i;

  repeat

    Names.Add(Pc);

    Pc:=PC+Length(PC)+1;

  until PC>=PcEnd;

  FreeMem(Buffer);

end;



//[procedure TIniFile.SectionData]

procedure TIniFile.SectionData(Names: PStrList);

var

  i:integer;

  Pc:PChar;

  PcEnd:PChar;

  Buffer:Pointer;

begin

  GetMem(Buffer,IniBufferSize);

  Pc:=Buffer;

  if fMode = ifmRead then

  begin

    i:=GetPrivateProfileSection(PChar(fSection), Buffer, IniBufferSize, PChar(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

      StrCopy(Pc,Names.ItemPtrs[i]);

      Pc:=PC+Length(PC)+1;

    end;

    Pc[0]:=#0;

    ClearSection;

    WritePrivateProfileSection(PChar(fSection), Buffer, PChar(fFileName));



  end;

  FreeMem(Buffer);

end;

{$ENDIF ASM_VERSION}



//////////////////////////////////////////////////////////////////////























/////////////////////////////////////////////////////////////////////////

//

//

//                                M  E  N  U

//

//

/////////////////////////////////////////////////////////////////////////



{ -- Menu implementation -- }



//[FUNCTION MakeAccelerator]

{$IFDEF ASM_VERSION}

function MakeAccelerator( fVirt: Byte; Key: Word ): TMenuAccelerator;

asm

        MOVZX    EAX, AL

        PUSH     EAX

        MOV      [ESP+1], DX

        POP      EAX

end;

{$ELSE ASM_VERSION} //Pascal

function MakeAccelerator( fVirt: Byte; Key: Word ): TMenuAccelerator;

begin

  Result.fVirt := fVirt;

  Result.Key := Key;

end;

{$ENDIF ASM_VERSION}

//[END MakeAccelerator]



//[FUNCTION GetAcceleratorText]

function GetAcceleratorText( const Accelerator: TMenuAccelerator ): string;

var

  KeyName: array[0..255] of Char;



  procedure AddKeyName( Code: Integer );

  begin

    Code := MapVirtualKey(Code, 0);

    if Code = 0 then exit;

    if GetKeyNameText(Code shl 16, KeyName, SizeOf(KeyName)) > 0 then begin

      if Result <> '' then

        Result := Result + '+';

      Result := Result + 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;

//[END GetAcceleratorText]





const

  MIDATA_CHECKITEM = $40000000;

  MIDATA_RADIOITEM = $80000000;



//[function WndProcMenu]

{$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 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 );

           //M.FProcessed := True;

           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} // fixed

        M.fCurCtl := Sender;   // fixed

      {$ENDIF}                 // fixed

        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}





var FDynamicMenuID: DWORD = $1000;



//[function NewMenu]

function NewMenu( AParent : PControl; MaxCmdReserve : DWORD; const Template : array of PChar;

                      aOnMenuItem: TOnMenuItem ): PMenu;

var M: PMenu;

    {$IFDEF INITIALFORMSIZE_FIXMENU}

    R: TRect;

    {$ENDIF}

begin

  {-}

  New( Result, Create );

  {+}{++}(*Result := PMenu.Create;*){--}

  Result.FVisible := TRUE;

  Result.FPopupFlags := TPM_LEFTALIGN or TPM_LEFTBUTTON;

  Result.FItems := NewList;

  Result.FOnMenuItem := aOnMenuItem;

  if (High(Template)>=0) and (Template[0] <> nil) then

  begin

    if (AParent <> nil) and (AParent.fMenuObj = nil) and not AParent.fIsControl then

      Result.FHandle := CreateMenu

    else

      Result.FHandle := CreatePopupMenu;

    Result.FillMenuItems( Result.FHandle, 0, Template );

  end;

  if assigned( AParent ) 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 not AParent.fIsControl 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 );

    end;

  end;

end;

//[END NewMenu]



//[function NewMenuEx]

function NewMenuEx( AParent : PControl; FirstCmd : Integer; const Template : array of PChar;

                      aOnMenuItems: array of TOnMenuItem ): PMenu;

begin

  Result := NewMenu( AParent, FirstCmd, Template, nil );

  Result.AssignEvents( 0, aOnMenuItems );

end;

//[END NewMenuEx]



{ TMenu }



const

  Breaks: array[ TMenuBreak ] of DWORD = ( 0, MFT_MENUBREAK, MFT_MENUBARBREAK );



{ + by AK - Andrzej Kubaszek }

//[function MenuStructSize]

function MenuStructSize: Integer;

begin

  Result := 44;

  if not( WinVer in [wv31, wv95, wvNT] ) then

    Result := {48=} Sizeof( TMenuItemInfo );

end;



//[destructor TMenu.Destroy]

destructor TMenu.Destroy;

var Next, Prnt: PMenu;

begin

  if Count > 0 then

  begin

    FItems.ReleaseObjects;

    FItems := NewList;

  end;

  if FParent <> nil then

  begin

    Prnt := FParent;

    FParent := nil;

    Next := Prnt.RemoveSubMenu( FId );

    Prnt.FItems.Remove( @ Self );

    if Next = nil then Exit;

  end;

   if (FControl <> nil) and (FControl.fMenu = FHandle) and (FHandle <> 0) then

   begin

     //if FControl.fHandle <> 0 then

     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

     DestroyMenu( FHandle );

   FCaption := '';

   FItems.Free;

   inherited;

   Next.Free;

   // all later created (popup) menus (of the same control)

   // are destroyed too

end;



//[function TMenu.GetInfo]

function TMenu.GetInfo( var MII: TMenuItemInfo ): Boolean;

begin

  MII.cbSize := MenuStructSize;

  Result := GetMenuItemInfo( Parent.FHandle, FId, FALSE,

            Windows.PMenuitemInfo( @ MII )^ );

end;



//[procedure TMenu.RedrawFormMenuBar]

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]

function TMenu.SetInfo( var MII: TMenuItemInfo ): Boolean;

var H: THandle;

begin

  MII.cbSize := MenuStructSize;

  H := FHandle;

  if FParent <> nil then

    H := FParent.FHandle;

  Result := SetMenuItemInfo( H, FId, FALSE, Windows.PMenuitemInfo( @ MII )^ );

  if Result and ((FParent = nil) or (FParent.FParent = nil)) then {YS}

    RedrawFormMenuBar;

end;



//[function TMenu.SetTypeInfo]

function TMenu.SetTypeInfo( var MII: TMenuItemInfo ): Boolean;

begin

  if not FIsSeparator then

  begin

    if FBmpItem = 0 then

      MII.dwTypeData := PChar( FCaption )

    else

      MII.dwTypeData := Pointer( FBmpItem );

    MII.cch := Length( FCaption );

  end;

  Result := SetInfo( MII );

end;



//[function TMenu.GetTopParent]

function TMenu.GetTopParent: PMenu;

begin

  Result := @ Self;

  while Result.FParent <> nil do

    Result := Result.FParent;

end;



//[function TMenu.GetControl]

function TMenu.GetControl: PControl;

begin

  Result := TopParent.FControl;

end;



//[function TMenu.GetItems]

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.FItems = nil then Exit;

    for I := 0 to ParentMenu.FItems.FCount-1 do

    begin

      Inc( FromIdx );

      Result := SearchItems( ParentMenu.FItems.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]

function TMenu.GetCount: Integer;

var I: Integer;

    SubM: PMenu;

begin

  Result := FItems.FCount;

  for I := 0 to Result-1 do

  begin

    SubM := FItems.Items[ I ];

    Result := Result + SubM.Count;

  end;

end;



//[function TMenu.IndexOf]

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.FItems.FCount-1 do

    begin

      Inc( FromIdx );

      Result := SearchMenu( ParentMenu.FItems.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]

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]

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]

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]

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]

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]

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]

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                                              {AK}

  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;



//[procedure TMenu.SetAccelerator]

{$IFNDEF NEW_MENU_ACCELL}

procedure TMenu.SetAccelerator(const Value: TMenuAccelerator);

const MaxAccel = 1000;

type TAccTab = array[0..10000] of TAccel;

     PAccTab = ^TAccTab;

     //TSetAcceleratorProc = procedure( Self_: PMenu; Idx: Integer; const Value: TMenuAccelerator );

var AccTab: PAccTab;

    I, N : Integer;

    M, SubM: PMenu;

    C: PControl;

    Main: Boolean;

begin

  //SetAcceleratorProc := TSetAcceleratorProc( MakeMethod( nil, @TMenu.SetAccelerator ).Code );

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

    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]

procedure TMenu.SetMenuItemCaption( const Value: String );

var MII: TMenuItemInfo;

begin

  FCaption := Value;

{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;

  //+++++++++++++++++++ to fix turning radio mark to check mark in NT4

  MII.cch := 0;

  GetInfo( MII );

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

  MII.dwTypeData := PChar( Value );

  MII.cch := Length( Value );

  SetInfo( MII );

end;



//[procedure TMenu.SetMenuBreak]

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

  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.SetVisible]

procedure TMenu.SetVisible( Value: Boolean );

var I, J: Integer;

    M: PMenu;

    Before: Integer;

    ByPosition: Boolean;

    MII: TMenuItemInfo;

begin

  if Value then

    if FParent <> nil then

      FParent.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 FParent = nil then Exit;

  if Value then

  begin // show menu item inserting it again into appropriate position

    Before := -1;

    ByPosition := TRUE;

    I := FParent.FItems.IndexOf( @ Self );

    for J := I + 1 to FParent.FItems.FCount-1 do

    begin

      M := FParent.FItems.Items[ J ];

      if M.FVisible then

      begin

        Before := M.FId;

        ByPosition := FALSE;

        break;

      end;

    end;



    FillChar( MII, Sizeof( MII ), 0 );

    MII.cbSize := MenuStructSize;

    MII.fMask := 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;

      MII.dwTypeData := PChar( FCaption );

      MII.cch := Length( FCaption );

    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;



    InsertMenuItem( FParent.FHandle, Before, ByPosition,

                    Windows.PMenuitemInfo( @ MII )^ );

  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 (FParent <> nil) and (FParent.FControl <> nil) then

    RedrawFormMenuBar;

end;



//[procedure TMenu.RadioCheckItem]

procedure TMenu.RadioCheckItem;

var I, J: Integer;

    M, First, Last: PMenu;

begin

  if (FParent <> nil) and (FRadioGroup <> 0) then

  begin

    I := FParent.FItems.IndexOf( @ Self );

    if I >= 0 then

    begin

      First := @ Self;

      Last := @ Self;

      for J := I-1 downto 0 do

      begin

        M := FParent.FItems.Items[ J ];

        if M.FRadioGroup <> FRadioGroup then break;

        if M.FVisible then

          First := M;

      end;

      for J := I+1 to FParent.FItems.FCount-1 do

      begin

        M := FParent.FItems.Items[ J ];

        if M.FRadioGroup <> FRadioGroup then break;

        if M.FVisible then

          Last := M;

      end;

      if First <> Last then

      begin

        CheckMenuRadioItem( FParent.FHandle, First.FId, Last.FId,

                            FId, MF_BYCOMMAND {or MF_CHECKED} );

        Exit;

      end;

    end;

  end;

  Checked := TRUE;

end;



//[function TMenu.FillMenuItems]

function TMenu.FillMenuItems(AHandle: HMenu; StartIdx: Integer;

  const Template: array of PChar): Integer;

var S, S1: PChar;

    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;

    if S = {$IFDEF F_P}'' +{$ENDIF} ')' then

    begin

       Result := I + 1;

       Exit;

    end;



    {-}

    new( Item, Create );

    {+}{++}(*Item := PMenu.Create;*){--}

    Item.FVisible := TRUE;

    Item.FParent := @ Self;

    Item.FItems := NewList;

    FItems.Add( Item );



    FillChar( MII, Sizeof( MII ), 0 );

    MII.cbSize := MenuStructSize;

    MII.fMask := MIIM_DATA or MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;

    if S <> {$IFDEF F_P}'' +{$ENDIF} '-' then

    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 ];

    if S1 = {$IFDEF F_P}'' +{$ENDIF} '(' then Item.FHandle := CreatePopupMenu;

    end;                                     //YS

    MII.hSubMenu := Item.FHandle;

    MII.dwTypeData := PChar( S );

    MII.cch := StrLen( S );

    InsertMenuItem( AHandle, DWORD(-1), True, Windows.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]

procedure TMenu.AssignEvents(StartIdx: Integer;

  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;



//[procedure TMenu.Popup]

function TMenu.Popup(X, Y: Integer): Integer;

begin

  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}

end;



//[procedure TMenu.PopupEx]

function TMenu.PopupEx( X, Y: Integer ): Integer;

var OldBounds: TRect;

    WasVisible: Boolean;

begin

  WasVisible := TRUE;

  if FControl <> nil then

  begin

    OldBounds := FControl.BoundsRect;

    if not FControl.fIsControl 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;

end;



//[function TMenu.GetItemChecked]

function TMenu.GetItemChecked( Item : Integer ) : Boolean;

begin

  Result := Items[ Item ].Checked;

end;



//[procedure TMenu.SetItemChecked]

procedure TMenu.SetItemChecked( Item : Integer; Value : Boolean );

begin

  Items[ Item ].Checked := Value;

end;



//[function TMenu.GetMenuItemHandle]

function TMenu.GetMenuItemHandle( Idx : Integer ): DWORD;

begin

  Result := Items[ Idx ].FId;

end;



//[procedure TMenu.RadioCheck]

procedure TMenu.RadioCheck( Idx : Integer );

begin

  Items[ Idx ].RadioCheckItem;

end;



//[function TMenu.GetItemBitmap]

function TMenu.GetItemBitmap(Idx: Integer): HBitmap;

begin

  Result := Items[ Idx ].Bitmap;

end;



//[procedure TMenu.SetItemBitmap]

procedure TMenu.SetItemBitmap(Idx: Integer; const Value: HBitmap);

begin

  Items[ Idx ].Bitmap := Value;

end;



//[procedure TMenu.AssignBitmaps]

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]

function TMenu.GetItemText(Idx: Integer): String;

begin

  Result := Items[ Idx ].FCaption;

end;



//[procedure TMenu.SetItemText]

procedure TMenu.SetItemText(Idx: Integer; const Value: String);

begin

  Items[ Idx ].Caption := Value;

end;



//[function TMenu.GetItemEnabled]

function TMenu.GetItemEnabled(Idx: Integer): Boolean;

begin

  Result := Items[ Idx ].Enabled;

end;



//[procedure TMenu.SetItemEnabled]

procedure TMenu.SetItemEnabled(Idx: Integer; const Value: Boolean);

begin

  Items[ Idx ].Enabled := Value;

end;



//[function TMenu.GetItemVisible]

function TMenu.GetItemVisible(Idx: Integer): Boolean;

begin

  Result := Items[ Idx ].Visible;

end;



//[procedure TMenu.SetItemVisible]

procedure TMenu.SetItemVisible(Idx: Integer; const Value: Boolean);

begin

  Items[ Idx ].Visible := Value;

end;



//[function TMenu.ParentItem]

function TMenu.ParentItem( Idx: Integer ): Integer;

begin

  Result := TopParent.IndexOf( Items[ Idx ].FParent );

end;



//[function TMenu.GetItemAccelerator]

function TMenu.GetItemAccelerator(Idx: Integer): TMenuAccelerator;

begin

  Result := Items[ Idx ].Accelerator;

end;



//[procedure TMenu.SetItemAccelerator]

procedure TMenu.SetItemAccelerator(Idx: Integer; const Value: TMenuAccelerator);

begin

  Items[ Idx ].Accelerator := Value;

end;



//[function TMenu.GetItemSubMenu]

function TMenu.GetItemSubMenu( Idx: Integer ): HMenu;

begin

  Result := Items[ Idx ].SubMenu;

end;



//[function WndProcHelp FORWARD DECLARATION]

function WndProcHelp( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;

forward;



//[procedure TMenu.SetHelpContext]

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;



//[procedure TMenu.SetSubmenu]

procedure TMenu.SetSubmenu( Value: HMenu );

var MII: TMenuItemInfo;

begin

  MII.fMask := MIIM_SUBMENU;

  MII.hSubMenu := Value;

  SetInfo( MII );

  FHandle := Value;

end;



//[function WndProcMeasureItem]

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]

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]

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]

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]

procedure TMenu.SetOwnerDraw( Value: Boolean );

const Masks: array[ Boolean ] of DWORD = ( 0, $FFFFFFFF );

var MII: TMenuItemInfo;

begin

  FOwnerDraw := Value;

  FillChar( MII, Sizeof( MII ), 0 );

  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]

function TMenu.Insert(InsertBefore: Integer; ACaption: PChar; 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 );

  {+}{++}(*Result := PMenu.Create;*){--}

  Result.FVisible := TRUE;

  Result.FParent := @ Self;

  Result.FItems := NewList;

  Result.FIsSeparator := moSeparator in Options;

  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.FItems.Insert( M.Parent.FItems.IndexOf( M ), Result );

    end;

  end;

  if M = nil then

  begin

    InsertBefore := -1;

    FItems.Add( Result );

  end;

  Result.FOnMenuItem := Event;



  FillChar( MII, Sizeof( MII ), 0 );

  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 := ACaption;

  if not (moBitmap in Options) then MII.cch := StrLen( ACaption );

  InsertMenuItem( FHandle, InsertBefore, InsertBefore = -1,

                  Windows.PMenuItemInfo( @ MII )^ );

  if moBitmap in Options then

  begin

    Result.BitmapItem := DWORD( ACaption );

  end

  else

    Result.FCaption := ACaption;

  RedrawFormMenuBar;

end;



//[function TMenu.AddItem]

function TMenu.AddItem(ACaption: PChar; Event: TOnMenuItem; Options: TMenuOptions): Integer;

begin

  Result := InsertItem( -1, ACaption, Event, Options );

end;



//[function TMenu.InsertItem]

function TMenu.InsertItem( InsertBefore: Integer; ACaption: PChar; Event: TOnMenuItem;

  Options: TMenuOptions): Integer;

begin

  Result := InsertItemEx( InsertBefore, ACaption, Event, Options, FALSE );

end;



//[function TMenu.InsertItemEx]

function TMenu.InsertItemEx(InsertBefore: Integer; ACaption: PChar;

  Event: TOnMenuItem; Options: TMenuOptions; ByPosition: Boolean): Integer;

var M: PMenu;

begin

  M := Insert( InsertBefore, ACaption, Event, Options );

  Result := M.FId;

end;



//[procedure TMenu.InsertSubMenu]

procedure TMenu.InsertSubMenu( SubMenuToInsert: PMenu; InsertBefore: Integer );

var AFlags: DWORD;

    M: PMenu;

    MII: TMenuItemInfo;

begin

  if SubMenuToInsert.FParent <> nil then

    SubMenuToInsert := SubMenuToInsert.FParent.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

    FItems.Add( SubMenuToInsert );

    SubMenuToInsert.FParent := @ Self;

  end

    else

  begin

    M.FParent.FItems.Insert( M.FParent.FItems.IndexOf( M ), SubMenuToInsert );

    SubMenuToInsert.FParent := M.FParent;

  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,

                PChar( SubMenuToInsert.FBmpItem ) )

  else

    InsertMenu( FHandle, InsertBefore, AFlags or MF_STRING or MF_POPUP, SubMenuToInsert.FHandle,

                PChar( SubMenuToInsert.Caption ) );

  if SubMenuToInsert.FId = 0 then

  begin

    SubMenuToInsert.FId := FDynamicMenuID;

    Inc( FDynamicMenuID );

    MII.cbSize := MenuStructSize;

    MII.fMask := MIIM_ID;

    MII.wID := SubMenuToInsert.FId;

    SetMenuItemInfo( SubMenuToInsert.FParent.FHandle, SubMenuToInsert.FParent.FItems.IndexOf( SubMenuToInsert ),

                     TRUE, Windows.PMenuItemInfo( @ MII )^ );

  end;

  RedrawFormMenuBar;

end;



//[function TMenu.RemoveSubMenu]

function TMenu.RemoveSubMenu( ItemToRemove: Integer ): PMenu;

{$IFDEF DEBUG_MENU}var OK: Boolean; {$ENDIF}

begin

  Result := Items[ ItemToRemove ];

  if Result = nil then Exit;

  if Result.FParent <> nil then

    {$IFDEF DEBUG_MENU} OK := {$ENDIF}

    RemoveMenu( Result.FParent.FHandle, Result.FId, MF_BYCOMMAND )

  else

    {$IFDEF DEBUG_MENU} OK := {$ENDIF}

    RemoveMenu( FHandle, Result.FId, MF_BYCOMMAND );

  {$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;



//[procedure ClearText]

procedure ClearText( Sender: PControl );

begin

  Sender.Caption := '';

end;



//[procedure ClearListbox]

procedure ClearListbox( Sender: PControl );

begin

  Sender.Perform( LB_RESETCONTENT, 0, 0 );

end;



//[procedure ClearCombobox]

procedure ClearCombobox( Sender: PControl );

begin

  Sender.Perform( CB_RESETCONTENT, 0, 0 );

end;



//[procedure ClearListView]

procedure ClearListView( Sender: PControl );

begin

  Sender.Perform( LVM_DELETEALLITEMS, 0, 0 );

end;



//[procedure ClearToolbar]

procedure ClearToolbar( Sender: PControl );

begin

  while Sender.TBButtonCount > 0 do

    Sender.TBDeleteButton( Sender.TBIndex2Item( 0 ) );

  Sender.Perform( TB_SETBITMAPSIZE, 0, 0 );

end;



{ -- Constructor of canvas -- }

//[function NewCanvas]

function NewCanvas( DC: HDC ): PCanvas;

begin

  {-}

  New( Result, Create );

  {+}

  {++}(*

  Result := PCanvas.Create;

  *){--}

  Result.ModeCopy := cmSrcCopy;

  if DC <> 0 then

  begin

    Result.SetHandle( DC );

    //Result.fIsPaintDC := True; // If Canvas will be destroyed, DC will not be deleted

  end;

end;

//[END NewCanvas]



{ -- Contructors of controls -- }



{$IFDEF ASM_VERSION}

//[FUNCTION _NewTControl]

function _NewTControl( AParent: PControl ): PControl;

begin

  New( Result, CreateParented( AParent ) );

end;

//[END _NewTControl]



//[function _NewWindowed]

function _NewWindowed( AParent: PControl; ControlClassName: PChar; Ctl3D: Boolean ): PControl;

asm

        PUSH     EBX

        PUSH     ESI

        PUSH     EDI



        PUSH     ECX // Ctl3D

        PUSH     EDX // ControlClassName



        MOV      ESI, EAX // ESI = AParent

        CALL     _NewTControl

        XCHG     EBX, EAX // EBX = Result

        POP      [EBX].TControl.fControlClassName

        INC      [EBX].TControl.fWindowed



        INC      EAX

        POP      EDX // DL = parameter Ctl3D

        TEST     ESI, ESI

        JZ       @@no_parent



        LEA      ESI, [ESI].TControl.fWndProcResizeFlicks

        LEA      EDI, [EBX].TControl.fWndProcResizeFlicks

        MOVSD    // fWndProcResizeFlicks

        MOVSD    // fGotoControl

        //MOVSW    // fDoubleBuffered, fTransparent

        LODSB    // fCtl3Dchild

        STOSB

        DEC      AL

        LODSB    // fCtl3D

        JZ       @@passed3D

        XOR      EDX, EDX

@@passed3D:

        XCHG     EAX, EDX

        STOSB    // fCtl3D



        MOVSD    // fTextColor

        LODSD

        XCHG     EDX, EAX

        XOR      EAX, EAX

        PUSH     EDX

        CALL     TGraphicTool.Assign

        STOSD    // fFont

        POP      EDX

        XCHG     ECX, EAX

        JECXZ    @@no_font

        MOV      [ECX].TGraphicTool.fParentGDITool, EDX

        MOV      [ECX].TGraphicTool.fOnChange.TMethod.Code, offset[TControl.FontChanged]

        MOV      [ECX].TGraphicTool.fOnChange.TMethod.Data, EBX

        MOV      EAX, EBX

        MOV      EDX, ECX

        CALL     TControl.FontChanged

@@no_font:



        MOVSD    // fColor

        LODSD

        XCHG     EDX, EAX

        XOR      EAX, EAX

        PUSH     EDX

        CALL     TGraphicTool.Assign

        STOSD    // fBrush

        POP      EDX

        XCHG     ECX, EAX

        JECXZ    @@no_brush

        MOV      [ECX].TGraphicTool.fParentGDITool, EDX

        MOV      [ECX].TGraphicTool.fOnChange.TMethod.Code, offset[TControl.BrushChanged]

        MOV      [ECX].TGraphicTool.fOnChange.TMethod.Data, EBX

        MOV      EAX, EBX

        MOV      EDX, ECX

        CALL     TControl.BrushChanged

@@no_brush:



        LODSD

        STOSD    // fMargin

        STOSD    // fBoundsRect.Left

        PUSH     EAX

        ADD      EAX, [ESI+16] // AParent.fClientTop

        STOSD    // fBoundsRect.Top

        POP      EAX

        ADD      EAX, 64

        STOSD    // fBoundsRect.Right

        STOSD    // fBoundsRect.Bottom



@@no_parent:

        XCHG     EAX, EBX

        //DEC      byte ptr [EAX].TControl.fAlphaBlend

        //INC      byte ptr [EAX].TControl.fEraseUpdRgn

        POP      EDI

        POP      ESI

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function _NewWindowed( AParent: PControl; ControlClassName: PChar; Ctl3D: Boolean ): PControl;

begin

  {-}

  New( Result, CreateParented( AParent ) );

  {+}{++}(*Result := PControl.CreateParented( AParent );*){--}

  Result.fControlClassName := ControlClassName;

  if AParent <> nil then

  begin

     Result.fWndProcResizeFlicks := AParent.fWndProcResizeFlicks;

     Result.fGotoControl := AParent.fGotoControl;

     //Result.fDoubleBuffered := AParent.fDoubleBuffered;

     //Result.fTransparent := AParent.fTransparent;

     Result.fCtl3Dchild := AParent.fCtl3Dchild;

     if AParent.fCtl3Dchild then

       Result.fCtl3D := Ctl3D

     else

       Result.fCtl3D := False;

     Result.fMargin := AParent.fMargin;

     with Result.fBoundsRect do

     begin

       Left := AParent.fMargin + AParent.fClientLeft;

       Top  := AParent.fMargin + AParent.fClientTop;

       Right := Left + 64;

       Bottom := Top + 64;

     end;

     Result.fTextColor := AParent.fTextColor;

     Result.fFont := Result.fFont.Assign( AParent.fFont );

     if Result.fFont <> nil then

     begin

       Result.fFont.fParentGDITool := AParent.fFont;

       Result.fFont.fOnChange := Result.FontChanged;

       Result.FontChanged( Result.fFont );

     end;

     Result.fColor := AParent.fColor;

     Result.fBrush := Result.fBrush.Assign( AParent.fBrush );

     if Result.fBrush <> nil then

     begin

       Result.fBrush.fParentGDITool := AParent.fBrush;

       Result.fBrush.fOnChange := Result.BrushChanged;

       Result.BrushChanged( Result.fBrush );

     end;

  end;

  //Result.fAlphaBlend := 255;

  //Result.fEraseUpdRgn := TRUE;

end;

//[END _NewWindowed]

{$ENDIF ASM_VERSION}



//===================== Form ========================//



{$IFDEF USE_CONSTRUCTORS}

//[function NewForm]

function NewForm( AParent: PControl; const Caption: String ): PControl;

begin

  new( Result, CreateForm( AParent, Caption ) );

end;

//[END NewForm]

{$ELSE not_USE_CONSTRUCTORS}



//[FUNCTION NewForm]

{$IFDEF ASM_VERSION}

function NewForm( AParent: PControl; const Caption: String ): PControl;

const FormClass: array[ 0..4 ] of Char = ( 'F', 'o', 'r', 'm', #0 );

asm

        PUSH     EBX

        PUSH     EDX

        MOV      EDX, offset[FormClass]

        MOV      CL, 1

        CALL     _NewWindowed

        MOV      EBX, EAX

        INC      [EBX].TControl.fSizeGrip

        OR       byte ptr [EBX].TControl.fClsStyle, CS_DBLCLKS

        MOV      EDX, offset[WndProcForm]

        CALL     TControl.AttachProc

        MOV      EDX, offset[WndProcDoEraseBkgnd]

        MOV      EAX, EBX

        CALL     TControl.AttachProc

        POP      EDX

        MOV      EAX, EBX

        CALL     TControl.SetCaption

        INC      [EBX].TControl.fSizeGrip

        INC      [EBX].TControl.fIsForm

        XCHG     EAX, EBX

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function NewForm( AParent: PControl; const Caption: String ): PControl;

begin

  Result := _NewWindowed( AParent, 'Form', True );

  Result.fClsStyle := Result.fClsStyle or CS_DBLCLKS;

  Result.AttachProc( WndProcForm );

  Result.AttachProc( WndProcDoEraseBkgnd );

  Result.Caption := Caption;

  Result.fSizeGrip := TRUE;

  Result.fIsForm := TRUE;

end;

{$ENDIF ASM_VERSION}

//[END NewForm]



{$ENDIF USE_CONSTRUCTORS}



//===================== Applet button ========================//



//{$DEFINE WNDPROCAPP_USED}

{$IFDEF WNDPROCAPP_USED}



//[FUNCTION WndProcApp]

{$IFDEF ASM_VERSION}

  {$IFDEF WNDPROCAPP_ASM_USED}

  function WndProcApp(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.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}

{$ELSE ASM_VERSION} //Pascal

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

begin

  Result := False;

  case Msg.message of

  WM_SETFOCUS:

    {$IFDEF NEW_MODAL}

    if Self_.fModalForm <> nil then

      SetFocus( Self_.fModalForm.fHandle )

    else if ( Self_.FCurrentControl <> nil ) and not

            ( Self_.fCurrentControl.IsForm xor Self_.fIsApplet ) then

    {$ELSE not_NEW_MODAL}

    if Self_.FCurrentControl <> nil then

    {$ENDIF NEW_MODAL}

    begin

      if Self_.FCurrentControl.CreateWindow then

        SetFocus( Self_.FCurrentControl.fHandle );

      Result := True;

    end;

  WM_SYSCOMMAND:

    if Msg.wParam and $FFF0 = SC_CLOSE then

    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;

{$ENDIF ASM_VERSION}

//[END WndProcApp]



{$ENDIF WNDPROCAPP_USED}



{$IFDEF USE_CONSTRUCTORS}

{$DEFINE CREATEAPPBUTTON_USED}

//[function NewApplet]

function NewApplet( const Caption: String ): PControl;

begin

  new( Result, CreateApplet( Caption ) );

end;

//[END NewApplet]

{$ELSE not_USE_CONSTRUCTORS}



//[FUNCTION NewApplet]

{$IFDEF ASM_VERSION}

function NewApplet( const Caption: String ): PControl;

const AppClass: array[ 0..3 ] of Char = ( 'A', 'p', 'p', #0 );

asm

        XOR      ECX, ECX

        INC      ECX

        MOV      [AppButtonUsed], CL

        PUSH     EAX

        MOV      EDX, offset[AppClass]

        XOR      EAX, EAX

        CALL     _NewWindowed

        INC      [EAX].TControl.FIsApplet

        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



        // BODY of CreateAppButton here:

        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  // SC_MOVE

        {$ENDIF}

        PUSH     EAX

        PUSH     ECX



        PUSH     EDX

        {$IFDEF PARANOIA}

        DB $2C, $10

        {$ELSE}

        SUB      AL, $10  // SC_SIZE

        {$ENDIF}

        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:

        //MOV      [EAX].TControl.FCreateWndExt, offset[CreateAppButton]

        POP      [EAX].TControl.FCreateWndExt

        PUSH     EAX

        CALL     @@newapp2



        // BODY of WndProcApp here:

        CMP      word ptr [EDX].TMsg.message, WM_SETFOCUS

        JNZ      @@chk_CLOSE

        MOV      ECX, [EAX].TControl.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 ASM_VERSION} //Pascal



//[procedure CreateAppButton]

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]

function NewApplet( const Caption: String ): PControl;

begin

  AppButtonUsed := True;

  Result := _NewWindowed( nil, 'App', True );

  Result.FIsApplet := TRUE;

  Result.fStyle := WS_VISIBLE or WS_SYSMENU or WS_POPUP or WS_MINIMIZEBOX or WS_CAPTION;

  Result.fExStyle := WS_EX_APPWINDOW;

  Result.FCreateWndExt := CreateAppButton;

  Result.AttachProc( WndProcApp );

  Result.Caption := Caption;

end;

{$ENDIF ASM_VERSION}

//[END NewApplet]

{$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  // SC_MOVE

        {$ENDIF}

        PUSH     EAX

        PUSH     ECX



        PUSH     EDX

        {$IFDEF PARANOIA}

        DB $2C, $10

        {$ELSE}

        SUB      AL, $10  // SC_SIZE

        {$ENDIF}

        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;



{-}

{$IFNDEF ASM_VERSION}

  //{$DEFINE CREATEPARAMS2_USED}

{$ENDIF}

{$IFDEF USE_CONSTRUCTORS}

  //{$DEFINE CREATEPARAMS2_USED}

{$ENDIF}

{+}



{$IFDEF CREATEPARAMS2_USED} // seems not needed more

//[procedure CreateParams2]

procedure CreateParams2( Self_: PControl; var Params: TCreateParams);

begin

  Self_.CreateSubclass( Params, Self_.fControlClassName );

end;

{$ENDIF}



//[FUNCTION _NewControl]

{$IFDEF ASM_VERSION}

function _NewControl( AParent: PControl; ControlClassName: PChar;

                      Style: DWORD; Ctl3D: Boolean; Actions: PCommandActions ): PControl;

const szActions = sizeof(TCommandActions);

asm

        PUSH     EBX

        PUSH     EAX  // push AParent

        PUSH     ECX  // push Style

        MOVZX    ECX, Ctl3D

        CALL     _NewWindowed

        XCHG     EBX, EAX

        INC      [EBX].TControl.fIsControl

        INC      [EBX].TControl.fVerticalAlign

        MOV      EAX, Actions

        TEST     EAX, EAX

        JZ       @@noActions

        LEA      EDX, [EBX].TControl.fCommandActions

        XOR      ECX, ECX

        MOV      CL, szActions

        CALL     System.Move

@@noActions:

        POP      EDX  // pop Style

        OR       EDX, WS_CLIPSIBLINGS or WS_CLIPCHILDREN

        MOV      byte ptr [EBX].TControl.fLookTabKeys, $0F

        CMP      [EBX].TControl.fCtl3D, 0

        JZ       @@noCtl3D

        AND      EDX, not WS_BORDER

        OR       byte ptr [EBX].TControl.fExStyle + 1, WS_EX_CLIENTEDGE shr 8

@@noCtl3D:

        MOV      [EBX].TControl.fStyle, EDX

        TEST     EDX, WS_VISIBLE

        SETNZ    AL

        MOV      [EBX].TControl.fVisible, AL

        TEST     EDX, WS_TABSTOP

        POP      ECX // pop AParent

        PUSHFD

        JECXZ    @@noParent

        MOV      EAX, [ECX].TControl.fCursor

        MOV      [EBX].TControl.fCursor, EAX

        XCHG     EAX, ECX

        CALL     TControl.ParentForm

        XCHG     ECX, EAX

        JECXZ    @@noParent

        INC      [ECX].TControl.fTabOrder

        MOV      EDX, [ECX].TControl.fTabOrder

        MOV      [EBX].TControl.fTabOrder, EDX

@@noParent:

        POPFD

        JZ       @@noTabStop

        INC      [EBX].TControl.fTabstop

        JECXZ    @@noTabstop

        XCHG     EAX, ECX

        MOV      ECX, [EAX].TControl.FCurrentControl

        INC      ECX

        LOOP     @@noTabStop

        MOV      [EAX].TControl.FCurrentControl, EBX

@@noTabStop:

        MOVZX    EDX, [CtlIdCount]

        INC      [CtlIdCount]

        MOV      [EBX].TControl.fMenu, EDX

        MOV      EDX, offset[WndProcCtrl]

        MOV      EAX, EBX

        CALL     TControl.AttachProc

        XCHG     EAX, EBX

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function _NewControl( AParent: PControl; ControlClassName: PChar;

                      Style: DWORD; Ctl3D: Boolean; Actions: PCommandActions ): PControl;

var Form: PControl;

begin

  Result := _NewWindowed( AParent, ControlClassName, Ctl3D );

  if Actions <> nil then

    Result.fCommandActions := Actions^;

  Result.fIsControl := True;

  Result.fStyle := Style or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;

  Result.fVerticalAlign := vaTop;

  Result.fVisible := (Style and WS_VISIBLE) <> 0;

  Result.fTabstop := (Style and WS_TABSTOP) <> 0;

  if (AParent <> nil) then

  begin

    Inc( AParent.ParentForm.fTabOrder );

    Result.fTabOrder := AParent.ParentForm.fTabOrder;

    Result.fCursor := AParent.fCursor;

  end;

  Result.fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ];

  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.fCreateParamsExt := CreateParams2;

  Result.fMenu := CtlIdCount;

  Inc( CtlIdCount );

  Result.AttachProc( WndProcCtrl );

end;

{$ENDIF ASM_VERSION}

//[END _NewControl]



//===================== Button ========================//



//[function TControl.SetButtonIcon]

function TControl.SetButtonIcon(aIcon: HIcon): PControl;

var PrevImg: THandle;

begin

  Style := Style or BS_ICON;

  fButtonIcon := aIcon;

  PrevImg := Perform( BM_SETIMAGE, IMAGE_ICON, aIcon );

  if PrevImg <> 0 then

    DeleteObject( PrevImg );

  Result := @ Self;

end;



//[function TControl.SetButtonBitmap]

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]

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}



//[function AutoMinimizeApplet]

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

begin

  if (msg.Message=WM_SYSCOMMAND) and (msg.wParam=SC_MINIMIZE) then begin

    AppletMinimize;

    Result := True;

  end else

    Result := False;

end;



{$IFDEF USE_CONSTRUCTORS}

//[function NewButton]

function NewButton( AParent: PControl; const Caption: String ): PControl;

begin

  new( Result, CreateButton( AParent, Caption ) );

end;

{$ELSE USE_CONSTRUCTORS}



{$IFDEF ASM_VERSION}

const ButtonClass: array[ 0..6 ] of Char = ( 'B','U','T','T','O','N',#0 );

{$ENDIF ASM_VERSION}



//[FUNCTION NewButton]

{$IFDEF ASM_VERSION}

function NewButton( AParent: PControl; const Caption: String ): PControl;

const szActions = sizeof(TCommandActions);

asm

        PUSH     EDX



        PUSH     0

        PUSH     offset[ButtonActions]



        MOV      EDX, offset[ButtonClass]

        MOV      ECX, WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or WS_TABSTOP

        CALL     _NewControl

        INC      [EAX].TControl.fIgnoreDefault

        MOV      EDX, [EAX].TControl.fBoundsRect.Top

        ADD      EDX, 22

        MOV      [EAX].TControl.fBoundsRect.Bottom, EDX

        MOV      [EAX].TControl.fTextAlign, taCenter

        INC      [EAX].TControl.fIsButton



        POP      EDX

        PUSH     EAX

        CALL     TControl.SetCaption

        POP      EAX

        {$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER}

        PUSH     EAX

        MOV      EDX, offset[WndProcBtnReturnClick]

        CALL     TControl.AttachProc

        POP      EAX

        {$ENDIF}

end;

{$ELSE ASM_VERSION} //Pascal

function NewButton( AParent: PControl; const Caption: String ): PControl;

begin

  Result := _NewControl( AParent, 'BUTTON',

            WS_VISIBLE or WS_CHILD or

            BS_PUSHLIKE or WS_TABSTOP, False, @ButtonActions );

  Result.fIgnoreDefault := TRUE;

  Result.fCtl3D := TRUE;

  with Result.fBoundsRect do

    Bottom := Top + 22;

  Result.fTextAlign := taCenter;

  Result.Caption := Caption;

  Result.fIsButton := TRUE;

  {$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER}

  Result.AttachProc( WndProcBtnReturnClick );

  {$ENDIF}

end;

{$ENDIF ASM_VERSION}

//[END NewButton]



{$ENDIF USE_CONSTRUCTORS}



//----------------- BitBtn -----------------------



//[FUNCTION WndProc_DrawItem]

{$IFDEF ASM_VERSION}

function WndProc_DrawItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer )

                          : Boolean;

asm     //cmd    //opd

       CMP       word ptr [EDX].TMsg.message, WM_DRAWITEM

       JNZ       @@ret_false

       MOV       EAX, [EDX].TMsg.lParam

       MOV       ECX, [EAX].TDrawItemStruct.hwndItem

       JECXZ     @@ret_false

       PUSH      EDX

       PUSH      offset[ID_SELF]

       PUSH      ECX

       CALL      GetProp

       POP       EDX

       TEST      EAX, EAX

       JZ        @@ret_false

       PUSH      [EDX].TMsg.lParam

       PUSH      [EDX].TMsg.wParam

       PUSH      CN_DRAWITEM

       PUSH      EAX

       CALL      TControl.Perform

       MOV       AL, 1

       RET

@@ret_false:

       XOR       EAX, EAX

end;

{$ELSE ASM_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 );

    Control := Pointer( GetProp( DI.hwndItem, ID_SELF ) );

    if Control <> nil then

    begin

      {Rslt := Integer(

      Control.OnDrawItem( Control, DI.hDC, DI.rcItem, DI.itemID,

                         TDrawAction( Byte( DI.itemAction ) ),

                         TDrawState( Word( DI.itemState ) ) ) );}

      Rslt := Control.Perform( CN_DRAWITEM, Msg.wParam, Msg.lParam );

      Result := TRUE;

    end;

      //else Rslt := 0;

  end;

end;

{$ENDIF ASM_VERSION}

//[END WndProc_DrawItem]



//[function ExcludeAmpersands]

function ExcludeAmpersands( Self_: PControl; const S: String ): String;

var I: Integer;

begin

  Result := S;

  if not Self_.FBitBtnDrawMnemonic then Exit;

  for I := Length( Result ) downto 1 do

  begin

    if Result[ I ] = '&' then

      Delete( Result, I, 1 );

  end;

end;



//[procedure BitBtnExtDraw]

procedure BitBtnExtDraw( Self_: PControl; DC: HDC; X, Y: Integer; const R: TRect;

          const CapText, CapTxtOrig: String; Color: TColor );

var I, J, W, H: Integer;

    Sz: TSize;

    Pen, OldPen: HPen;

begin

  if not Self_.FBitBtnDrawMnemonic then Exit;

  J := 0;

  for I := 1 to Length( CapTxtOrig ) do

  begin

    if CapTxtOrig[ I ] <> '&' then

      Inc( J )

    else

    begin

      Windows.GetTextExtentPoint32( DC, PChar( CapText ), J, Sz );

      W := Sz.cx;

      Windows.GetTextExtentPoint32( DC, '_', 1, Sz );

      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]

procedure TControl.SetBitBtnDrawMnemonic(const Value: Boolean);

begin

  FBitBtnDrawMnemonic := Value;

  FBitBtnGetCaption := ExcludeAmpersands;

  FBitBtnExtDraw := BitBtnExtDraw;

  Invalidate;

end;



//[function TControl.GetBitBtnImgIdx]

function TControl.GetBitBtnImgIdx: Integer;

begin

  Result := LoWord( fGlyphCount );

end;



//[procedure TControl.SetBitBtnImgIdx]

procedure TControl.SetBitBtnImgIdx(const Value: Integer);

begin

  if not( bboImageList in fBitBtnOptions ) then Exit;

  fGlyphCount := HiWord( fGlyphCount ) or (Value and $FFFF);

  Invalidate;

end;



//[function TControl.GetBitBtnImageList]

function TControl.GetBitBtnImageList: THandle;

begin

  Result := 0;

  if bboImageList in fBitBtnOptions then

    Result := fGlyphBitmap;

end;



//[procedure TControl.SetBitBtnImageList]

procedure TControl.SetBitBtnImageList(const Value: THandle);

begin

  fGlyphBitmap := Value;

  if Value <> 0 then

  begin

    fBitBtnOptions := fBitBtnOptions + [ bboImageList ];

    ImageList_GetIconSize( Value, fGlyphWidth, fGlyphHeight );

  end

  else

    fBitBtnOptions := fBitBtnOptions - [ bboImageList ];

  Invalidate;

end;



//[FUNCTION WndProcBitBtn]

{$IFDEF ASM_noVERSION} // remove &-s from view //+ TextShift & if Y < 0 then Y := 0; // + glyph + TextShift if not glyphOver

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:

        TEST     byte ptr [EDI].TControl.fChecked, 1

        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: CMP      [EDI].TControl.fMouseInControl, BH

        JZ       @@not4

        TEST     EBX, EBX

        JZ       @@4

        CMP      BL, 3

        JNZ      @@not4

@@4:    MOV      BL, 4

@@not4: MOV      ECX, [EDI].TControl.fOnBitBtnDraw.TMethod.Code

        TEST     ECX, ECX

        JZ       @@noOnBitBtnDraw

        //JECXZ    @@noOnBitBtnDraw

        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

        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:

        MOVZX    ECX, [EDI].TControl.fFlat

        JECXZ    @@noFlat

        AND      CL, [EDI].TControl.fMouseInControl

        JZ       @@noborder

@@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

        // [EBP+4] = TxRect



        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

        //MOV      EAX, EBX

        //CALL     TControl.DoClick

        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_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

        XOR      [EBX].TControl.fChecked, 1

        MOV      ECX, [EBX].TControl.fOnChange.TMethod.Code

        JECXZ    @@not_fixed

        MOV      EAX, [EBX].TControl.fOnChange.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 ASM_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;

    //BI: TBitmapInfo;

    //Dib: TDibSection;

    TxRect: TRect;

    OldFont: HFont;

    OldTextColor: TColor;

    CapText, CapTxtOrig: String;

    TextSz: TSize;

    DC: HDC;

    OldBmp: HBitmap;

    Handled: Boolean;

    //Br: HBrush;

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;

    IsDown := (DIS.itemState and ODS_SELECTED <> 0) or

      ({(bboFixed in Self_.fBitBtnOptions) and} Self_.fChecked);

    IsDefault := DIS.itemState and ODS_FOCUS <> 0;

    IsDisabled := DIS.itemState and ODS_DISABLED <> 0;

    G := 0;

    if IsDown {and not(bboFixed in Self_.fBitBtnOptions)

    or (bboFixed in Self_.fBitBtnOptions) and Self_.fChecked} then

      G := 1;

    if IsDisabled then

      G := 2;

    if (G = 0) and IsDefault then

      G := 3;

    if ((G = 0) or (G = 3)) and Self_.MouseInControl then

      G := 4;

    if Assigned( Self_.fOnBitBtnDraw ) then

    begin

      if Assigned( Self_.fCanvas ) then

        Self_.fCanvas.SetHandle( DIS.hDC );

      Handled := Self_.fOnBitBtnDraw( Self_, G );

      if Assigned( Self_.fCanvas ) then

        Self_.fCanvas.SetHandle( 0 );

      if Handled then Exit;

    end;

    if not ( bboNoBorder in Self_.fBitBtnOptions ) then

    begin

      if IsDefault then

      begin

        Windows.FrameRect( DIS.hDC, DIS.rcItem, GetStockObject( BLACK_BRUSH ) );

        InflateRect( DIS.rcItem, -1, -1 );

      end;

      if not Self_.fFlat or Self_.fMouseInControl 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_.fGlyphBitmap <> 0 then

    begin

      ImgW := Self_.fGlyphWidth;

      ImgH := Self_.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_.fGlyphLayout <> glyphOver) then

        begin

          Inc( X, Self_.TextShiftX );

          Inc( Y, Self_.TextShiftY );

        end;

        case Self_.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;



        //Br := CreateSolidBrush( Color2RGB( Self_.fColor ) );

        //Windows.FillRect( DIS.hDC, MakeRect( X, DIS.rcItem.Top, X + OutW, DIS.rcItem.Bottom ), Br );

        //DeleteObject( Br );



        if bboImageList in Self_.fBitBtnOptions then

          begin

            I := LoWord( Self_.fGlyphCount );

            if //(HiWord( Self_.fGlyphCount ) > 1) and

               (HiWord( Self_.fGlyphCount ) > G) then

               I := I + G;

            Flags := 0; // ILD_NORMAL

            Blend := 0;

            if not Self_.fTransparent then

              Bk := Color2RGB( Self_.fColor )

            else

              begin

                Bk := Integer(CLR_NONE);

                Flags := ILD_TRANSPARENT;

              end;

            if HiWord( Self_.fGlyphCount ) = 1 then

            begin

              Blend := Integer(CLR_DEFAULT);

              if IsDefault then

                Flags := Flags or ILD_BLEND25;

            end;

            ImageList_DrawEx( Self_.fGlyphBitmap, I, DIS.hDC, X, Y, 0, 0,

              Bk, Blend, Flags );

          end

        else

          begin

            DC := CreateCompatibleDC( 0 );

            OldBmp := SelectObject( DC, Self_.fGlyphBitmap );



            I := 0;

            if Self_.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_.fBitBtnOptions) then

    //if (Self_.Text <> '') then

    if (TxRect.Right > TxRect.Left) and (TxRect.Bottom > TxRect.Top) then

    begin

      CapText := Self_.Caption;

      /////////////////////////////////////////////  added 19 Nov 2001

      CapTxtOrig := CapText;

      if Assigned( Self_.FBitBtnGetCaption ) then

        CapText := Self_.FBitBtnGetCaption( Self_, CapText );

      /////////////////////////////////////////////



      Bk := 0;

      Blend := 0;

      Flags := ETO_CLIPPED;

      if Self_.fTransparent or (Self_.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 assigned( Self_.fFont ) then

        OldFont := SelectObject( DIS.hDC, Self_.fFont.Handle );

      OldTextColor := SetTextColor( DIS.hDC, Color2RGB( Self_.fTextColor ) );



      Windows.GetTextExtentPoint32( DIS.hDC, PChar( 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;



      Windows.ExtTextOut( DIS.hDC, X, Y, Flags, @TxRect,

        PChar( CapText ), Length( CapText ), nil );



      //////////////////////////////////////////////////////////////////////////

      //  added 19 Nov 2001 to provide underlying mnemonic characters

      if Assigned( Self_.FBitBtnExtDraw ) then

        Self_.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_.fBitBtnOptions then

    begin

      Self_.fChecked := not Self_.fChecked;

      if Assigned( Self_.fOnChange ) then

        Self_.fOnChange( Self_ );

    end;

    if Self_.fRepeatInterval > 0 then

    begin

      if Msg.message <> WM_KEYDOWN then

        SetTimer( Self_.fHandle, 1, Self_.fRepeatInterval, nil );

      Self_.Invalidate;

    end;

  end;



  // added 15 Aug 2002 to repaint when focus lost:

  if Msg.message = WM_KILLFOCUS then

    Self_.Invalidate;



  if Msg.message = WM_TIMER then

  begin

    if Self_.Perform( BM_GETSTATE, 0, 0 ) and BST_PUSHED = 0 then

    begin

      KillTimer( Self_.fHandle, 1 );

      ReleaseCapture;

    end

       else

    begin

      if bboFixed in Self_.fBitBtnOptions then

      begin

        Self_.fChecked := not Self_.fChecked;

        if Assigned( Self_.fOnChange ) then

          Self_.fOnChange( Self_ );

      end;

      Self_.DoClick;

      Self_.Invalidate;

    end;

  end;

end;

{$ENDIF ASM_VERSION}

//[END WndProcBitBtn]



{$IFDEF USE_CONSTRUCTORS}

//[function NewBitBtn]

function NewBitBtn( AParent: PControl; const Caption: String;

         Options: TBitBtnOptions; Layout: TGlyphLayout; GlyphBitmap: HBitmap;

         GlyphCount: Integer ): PControl;

begin

  new( Result, CreateBitBtn( AParent, Caption, Options, Layout, GlyphBitmap, GlyphCount ) );

end;

//[END NewBitBtn]

{$ELSE not_USE_CONSTRUCTORS}



//[FUNCTION NewBitBtn]

{$IFDEF ASM_VERSION}

function NewBitBtn( AParent: PControl; const Caption: String;

         Options: TBitBtnOptions; Layout: TGlyphLayout; GlyphBitmap: HBitmap; GlyphCount: Integer ): PControl;

const szBitmapInfo = sizeof(TBitmapInfo);

asm

        PUSH     EBX

        PUSH     EDX

        PUSH     ECX



        PUSH     0

        PUSH     offset[ButtonActions]

        MOV      EDX, offset[ButtonClass]

        MOV      ECX, WS_VISIBLE or WS_CHILD or WS_TABSTOP or BS_OWNERDRAW

        CALL     _NewControl

        XCHG     EBX, EAX

        INC      [EBX].TControl.fIgnoreDefault

        INC      [EBX].TControl.fIsButton

        MOV      byte ptr [EBX].TControl.fCommandActions.aAutoSzX, 8

        MOV      byte ptr [EBX].TControl.fCommandActions.aAutoSzY, 8

        POP      EAX

        MOV      [EBX].TControl.fBitBtnOptions, AL

        MOVZX    EDX, Layout

        MOV      [EBX].TControl.fGlyphLayout, DL

        MOV      ECX, GlyphBitmap

        MOV      [EBX].TControl.fGlyphBitmap, ECX

        MOV      EDX, [EBX].TControl.fBoundsRect.Top

        ADD      EDX, 22

        MOV      [EBX].TControl.fBoundsRect.Bottom, EDX

        TEST     ECX, ECX

        JZ       @@noGlyphWH

        {$IFDEF PARANOIA}

        DB $A8, 01

        {$ELSE}

        TEST AL, bboImageList

        {$ENDIF}

        JZ       @@getBmpWH

        PUSH     EAX

        MOV      EAX, ESP

        PUSH     EAX

        MOV      EDX, ESP

        PUSH     EAX

        PUSH     EDX

        PUSH     ECX

        CALL     ImageList_GetIconSize

        POP      EAX

        POP      EDX

        MOV      ECX, GlyphCount

        JMP      @@WHready

@@getBmpWH:

        ADD      ESP, -szBitmapInfo

        PUSH     ESP

        PUSH     szBitmapInfo

        PUSH     ECX

        CALL     GetObject

        XCHG     ECX, EAX

        POP      EAX

        POP      EAX

        POP      EDX

        ADD      ESP, szBitmapInfo-12

        TEST     ECX, ECX

        JZ       @@noGlyphWH

        MOV      ECX, GlyphCount

        INC      ECX

        LOOP     @@GlyphCountOK

        PUSH     EAX

        PUSH     EDX

        XCHG     EDX, ECX

        DIV      ECX

        XCHG     ECX, EAX

        POP      EDX

        POP      EAX

@@GlyphCountOK:

        CMP      ECX, 1

        JLE      @@WHReady

        PUSH     EDX

        CDQ

        IDIV     ECX

        POP      EDX

@@WHReady:

        MOV      [EBX].TControl.fGlyphWidth, EAX

        MOV      [EBX].TControl.fGlyphHeight, EDX

        MOV      [EBX].TControl.fGlyphCount, ECX

        POP      ECX     // ECX = @ Caption[ 1 ]

        PUSH     ECX

        PUSH     EDX

        PUSH     EAX

        TEST     EAX, EAX

        JLE      @@noWidthResize

        JECXZ    @@addWLeft

        CMP      [Layout], glyphOver

        JE       @@addWLeft

        MOVZX    ECX, byte ptr[ECX]

        JECXZ    @@addWLeft

        // else

        CMP      [Layout], glyphLeft

        JZ       @@addWRight

        CMP      [Layout], glyphRight

        JNZ      @@noWidthResize

@@addWRight:

        ADD      [EBX].TControl.fBoundsRect.Right, EAX

        ADD      [EBX].TControl.fCommandActions.aAutoSzX, AX

        JMP      @@noWidthResize

@@addWLeft:

        // then

        ADD      EAX, [EBX].TControl.fBoundsRect.Left

        MOV      [EBX].TControl.fBoundsRect.Right, EAX

        MOV      byte ptr [EBX].TControl.fCommandActions.aAutoSzX, 0

@@noWidthResize:

        TEST     EDX, EDX

        JLE      @@noHeightResize

        CMP      [Layout], glyphTop

        JE       @@addHBottom

        CMP      [Layout], glyphBottom

        JNE      @@addHTop

@@addHBottom:

        ADD      [EBX].TControl.fBoundsRect.Bottom, EDX

        ADD      [EBX].TControl.fCommandActions.aAutoSzY, DX

        JMP      @@noHeightResize

@@addHTop:

        ADD      EDX, [EBX].TControl.fBoundsRect.Top

        MOV      [EBX].TControl.fBoundsRect.Bottom, EDX

        MOV      [EBX].TControl.fCommandActions.aAutoSzY, 0

@@noHeightResize:

        POP      ECX

        POP      EAX

        CDQ

        MOV      DL, 4

        TEST     [EBX].TControl.fBitBtnOptions, 2 //1 shl bboNoBorder

        JNZ      @@noBorderResize

        JECXZ    @@noBorderWinc

        ADD      [EBX].TControl.fBoundsRect.Right, EDX

        CMP      [EBX].TControl.fCommandActions.aAutoSzX, 0

        JZ       @@noBorderWinc

        ADD      [EBX].TControl.fCommandActions.aAutoSzX, DX

@@noBorderWinc:

        TEST     EAX, EAX

        JLE      @@noBorderResize

        ADD      [EBX].TControl.fBoundsRect.Bottom, EDX

        CMP      [EBX].TControl.fCommandActions.aAutoSzY, 0

        JZ       @@noBorderResize

        ADD      [EBX].TControl.fCommandActions.aAutoSzY, DX

@@noBorderResize:

@@noGlyphWH:

        MOV      ECX, [EBX].TControl.fParent

        JECXZ    @@notAttach2Parent

        XCHG     EAX, ECX

        MOV      EDX, offset[WndProc_DrawItem]

        CALL     TControl.AttachProc

@@notAttach2Parent:

        MOV      EAX, EBX

        MOV      EDX, offset[WndProcBitBtn]

        CALL     TControl.AttachProc

        MOV      EAX, EBX

        POP      EDX

        CALL     TControl.SetCaption

        MOV      [EBX].TControl.fTextAlign, taCenter

        {$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER}

        MOV      EAX, EBX

        MOV      EDX, offset[WndProcBtnReturnClick]

        CALL     TControl.AttachProc

        {$ENDIF}

        XCHG     EAX, EBX

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function NewBitBtn( AParent: PControl; const Caption: String;

         Options: TBitBtnOptions; Layout: TGlyphLayout; GlyphBitmap: HBitmap;

         GlyphCount: Integer ): PControl;

var

    B: TBitmapInfo;

    W, H: Integer;

begin

  Result := _NewControl( AParent, 'BUTTON', WS_VISIBLE or WS_CHILD or

            WS_TABSTOP or BS_OWNERDRAW, False, @ButtonActions );

  Result.fIgnoreDefault := TRUE;

  Result.fIsButton := TRUE;

  Result.fCommandActions.aAutoSzX := 8;

  Result.fCommandActions.aAutoSzY := 8;

  //Result.fExStyle := Result.fExStyle and not WS_EX_CONTROLPARENT;

  Result.fBitBtnOptions := Options;

  Result.fGlyphLayout := Layout;

  Result.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.fCommandActions.aAutoSzX := 0;

        end

          else

        if Layout in [ glyphLeft, glyphRight ] then

        begin

          Right := Right + W;

          Inc( Result.fCommandActions.aAutoSzX, W );

        end;

      end;

      if H > 0 then

      begin

        if Layout in [ glyphTop, glyphBottom ] then

        begin

          Bottom := Bottom + H;

          Inc( Result.fCommandActions.aAutoSzY, H );

        end

          else

        begin

          Bottom := Top + H;

          Result.fCommandActions.aAutoSzY := 0;

        end;

      end;

      if not ( bboNoBorder in Options ) then

      begin

        if W > 0 then

        begin

          Inc( Right, 4 );

          if Result.fCommandActions.aAutoSzX > 0 then

            Inc( Result.fCommandActions.aAutoSzX, 4 );

        end;

        if H > 0 then

        begin

          Inc( Bottom, 4 );

          if Result.fCommandActions.aAutoSzY > 0 then

            Inc( Result.fCommandActions.aAutoSzY, 4 );

        end;

      end;

    end;

    Result.fGlyphWidth := W;

    Result.fGlyphHeight := H;

  end;

  Result.fGlyphCount := GlyphCount;

  if AParent <> nil then

    AParent.AttachProc( WndProc_DrawItem );

  Result.AttachProc( WndProcBitBtn );

  //Result.AttachProc( WndProcDoEraseBkgnd );

  Result.fTextAlign := taCenter;

  Result.Caption := Caption;

  {$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER}

  Result.AttachProc( WndProcBtnReturnClick );

  {$ENDIF}

end;

{$ENDIF ASM_VERSION}

//[END NewBitBtn]



{$ENDIF USE_CONSTRUCTORS}



//===================== Check box ========================//



{$IFDEF USE_CONSTRUCTORS}

//[function NewCheckbox]

function NewCheckbox( AParent: PControl; const Caption: String ): PControl;

begin

  new( Result, CreateCheckbox( AParent, Caption ) );

end;

//[END NewCheckbox]

{$ELSE not_USE_CONSTRUCTORS}



//[FUNCTION NewCheckbox]

{$IFDEF ASM_VERSION}

function NewCheckbox( AParent: PControl; const Caption: String ): PControl;

asm

        CALL     NewButton

        MOV      EDX, [EAX].TControl.fBoundsRect.Left

        ADD      EDX, 72

        MOV      [EAX].TControl.fBoundsRect.Right, EDX

        MOV      [EAX].TControl.fStyle, WS_VISIBLE or WS_CHILD or BS_AUTOCHECKBOX or WS_TABSTOP

        MOV      [EAX].TControl.fCommandActions.aAutoSzX, 24

end;

{$ELSE ASM_VERSION} //Pascal

function NewCheckbox( AParent: PControl; const Caption: String ): PControl;

begin

  Result := NewButton( AParent, Caption );

  with Result.fBoundsRect do

  begin

    Right := Left + 72;

  end;

  Result.fStyle := WS_VISIBLE or WS_CHILD or

            BS_AUTOCHECKBOX or WS_TABSTOP;

  Result.fCommandActions.aAutoSzX := 24;

end;

{$ENDIF ASM_VERSION}

//[END NewCheckbox]



{$ENDIF USE_CONSTRUCTORS}



//[function NewCheckBox3State]

function NewCheckBox3State( AParent: PControl; const Caption: String ): PControl;

begin

  Result := NewCheckbox( AParent, Caption );

  Result.fStyle := Result.fStyle and not BS_AUTOCHECKBOX or BS_AUTO3STATE;

end;



//===================== Radiobox ========================//



//[FUNCTION ClickRadio]

{$IFDEF ASM_VERSION}

procedure ClickRadio( Sender:PObj );

asm

        MOV      ECX, [EAX].TControl.fParent

        JECXZ    @@exit

        PUSH     [EAX].TControl.fMenu

        PUSH     [ECX].TControl.fRadioLast

        PUSH     [ECX].TControl.fRadio1st

        PUSH     [ECX].TControl.fHandle

        CALL     CheckRadioButton

@@exit:

end;

{$ELSE ASM_VERSION} //Pascal

procedure ClickRadio( Sender:PObj );

var Self_:PControl;

begin

  Self_ := PControl( Sender );

  if Self_.FParent <> nil then

    CheckRadioButton( Self_.fParent.fHandle,

                      Self_.fParent.fRadio1st,

                      Self_.fParent.fRadioLast,

                      Self_.fMenu );

end;

{$ENDIF ASM_VERSION}

//[END ClickRadio]



{$IFDEF USE_CONSTRUCTORS}

//[function NewRadiobox]

function NewRadiobox( AParent: PControl; const Caption: String ): PControl;

begin

  new( Result, CreateRadiobox( AParent, Caption ) );

end;

//[END NewRadiobox]

{$ELSE not_USE_CONSTRUCTORS}



//[FUNCTION NewRadiobox]

{$IFDEF ASM_VERSION}

function NewRadiobox( AParent: PControl; const Caption: String ): PControl;

const

  RadioboxStyles = WS_VISIBLE or WS_CHILD or BS_RADIOBUTTON or

                   WS_TABSTOP or WS_GROUP or BS_NOTIFY;

asm

        PUSH     EBX

        PUSH     EAX

        CALL     NewCheckbox

        XCHG     EBX, EAX

        MOV      [EBX].TControl.fStyle, RadioboxStyles

        MOV      [EBX].TControl.fControlClick, offset[ClickRadio]

        POP      ECX

        JECXZ    @@exit

        MOV      EDX, [EBX].TControl.fMenu

        MOV      [ECX].TControl.fRadioLast, EDX

        MOV      EAX, [ECX].TControl.fRadio1st

        TEST     EAX, EAX

        JNZ      @@exit

        MOV      [ECX].TControl.fRadio1st, EDX

        MOV      EAX, EBX

        CALL     TControl.SetRadioChecked

@@exit: XCHG     EAX, EBX

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function NewRadiobox( AParent: PControl; const Caption: String ): PControl;

begin

  Result := NewCheckbox( AParent, Caption );

  Result.fStyle := WS_VISIBLE or WS_CHILD or

            BS_RADIOBUTTON or WS_TABSTOP or WS_GROUP or BS_NOTIFY;

  Result.fControlClick := ClickRadio;

  if AParent <> nil then

  begin

    AParent.fRadioLast := Result.fMenu;

    if AParent.fRadio1st = 0 then

    begin

       AParent.fRadio1st := Result.fMenu;

       Result.SetRadioChecked;

    end;

  end;

end;

{$ENDIF ASM_VERSION}

//[END NewRadiobox]



{$ENDIF USE_CONSTRUCTORS}



//===================== Label ========================//



{$IFNDEF USE_CONSTRUCTORS}

{$IFDEF ASM_VERSION}

const StaticClass: array[0..6]of Char=('S','T','A','T','I','C',#0);

{$ENDIF ASM_VERSION}

{$ENDIF USE_CONSTRUCTORS}



{$IFDEF USE_CONSTRUCTORS}

//[function NewLabel]

function NewLabel( AParent: PControl; const Caption: String ): PControl;

begin

  new( Result, CreateLabel( AParent, Caption ) );

end;

//[END NewLabel]

{$ELSE not_USE_CONSTRUCTORS}



//[FUNCTION NewLabel]

{$IFDEF ASM_VERSION}

function NewLabel( AParent: PControl; const Caption: String ): PControl;

asm

        PUSH     EDX



        PUSH     0

        PUSH     offset[LabelActions]

        MOV      ECX, WS_VISIBLE or WS_CHILD or SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY

        MOV      EDX, offset[StaticClass]

        CALL     _NewControl

        INC      [EAX].TControl.fIsStaticControl

        INC      [EAX].TControl.fSizeRedraw

        MOV      EDX, [EAX].TControl.fBoundsRect.Top

        ADD      EDX, 22

        MOV      [EAX].TControl.fBoundsRect.Bottom, EDX

        POP      EDX

        PUSH     EAX

        CALL     TControl.SetCaption

        POP      EAX

end;

{$ELSE ASM_VERSION} //Pascal

function NewLabel( AParent: PControl; const Caption: String ): PControl;

begin

  Result := _NewControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD or

                         SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY,

                         False, @LabelActions );

  Inc( Result.fIsStaticControl );

  Result.fSizeRedraw := True;

  with Result.fBoundsRect do

  begin

    //Right := Left + 64;

    Bottom := Top + 22;

  end;

  Result.Caption := Caption;

end;

{$ENDIF ASM_VERSION}

//[END NewLabel]



{$ENDIF USE_CONSTRUCTORS}



//===================== word wrap Label ========================//



{$IFDEF USE_CONSTRUCTORS}

//[function NewWordWrapLabel]

function NewWordWrapLabel( AParent: PControl; const Caption: String ): PControl;

begin

  new( Result, CreateWordWrapLabel( AParent, Caption ) );

end;

//[END NewWordWrapLabel]

{$ELSE not_USE_CONSTRUCTORS}



//[FUNCTION NewWordWrapLabel]

{$IFDEF ASM_VERSION}

function NewWordWrapLabel( AParent: PControl; const Caption: String ): PControl;

asm

        CALL     NewLabel

        MOV      EDX, [EAX].TControl.fBoundsRect.Top

        ADD      EDX, 44

        MOV      [EAX].TControl.fBoundsRect.Bottom, EDX

        INC      [EAX].TControl.fWordWrap

        AND      byte ptr [EAX].TControl.fStyle, not SS_LEFTNOWORDWRAP

end;

{$ELSE ASM_VERSION} //Pascal

function NewWordWrapLabel( AParent: PControl; const Caption: String ): PControl;

begin

  Result := NewLabel( AParent, Caption );

  Result.fWordWrap := TRUE;

  with Result.fBoundsRect do

  begin

    Bottom := Top + 44;

  end;

  Result.fStyle := Result.fStyle and not SS_LEFTNOWORDWRAP;

end;

{$ENDIF ASM_VERSION}

//[END NewWordWrapLabel]



{$ENDIF USE_CONSTRUCTORS}



//===================== Label Effect ========================//



{$IFDEF USE_CONSTRUCTORS}

function NewLabelEffect( AParent: PControl; const Caption: String; ShadowDeep: Integer ): PControl;

begin

  new( Result, CreateLabelEffect( AParent, Caption, ShadowDeep ) );

end;

{$ELSE not_USE_CONSTRUCTORS}



//[FUNCTION NewLabelEffect]

{$IFDEF ASM_VERSION}

function NewLabelEffect( AParent: PControl; const Caption: String; ShadowDeep: Integer ): PControl;

asm

        PUSH     EBX



        PUSH     ECX

        PUSH     EDX

        XOR      EDX, EDX

        CALL     NewLabel

        MOV      EBX, EAX

        DEC      [EBX].TControl.fIsStaticControl // ñíîâà 0 !

        MOV      EDX, offset[WndProcLabelEffect]

        CALL     TControl.AttachProc



        //MOV      EAX, EBX

        //CALL     TControl.GetWindowHandle



        POP      EDX

        MOV      EAX, EBX

        CALL     TControl.SetCaption



        MOV      EDX, offset[WndProcDoEraseBkgnd]

        MOV      EAX,EBX

        CALL     TControl.AttachProc

        MOV      [EBX].TControl.fTextAlign, taCenter

        MOV      [EBX].TControl.fTextColor, clWindowText

        POP      [EBX].TControl.fShadowDeep

        INC      [EBX].TControl.fIgnoreWndCaption

        ADD      [EBX].TControl.fBoundsRect.Bottom, 40 - 22

        MOV      [EBX].TControl.fColor2, clNone



        XCHG     EAX, EBX

        POP      EBX

end;

{$ELSE ASM_VERSION} //Pascal

function NewLabelEffect( AParent: PControl; const Caption: String; ShadowDeep: Integer ): PControl;

begin

  Result := NewLabel( AParent, '' );

  Dec( Result.fIsStaticControl ); // ñíîâà 0 !

  Result.AttachProc( WndProcLabelEffect );

  //Result.GetWindowHandle;

  Result.Caption := Caption;

  Result.AttachProc( WndProcDoEraseBkgnd );

  Result.fTextAlign := taCenter;

  Result.fTextColor := clWindowText;

  Result.fShadowDeep := ShadowDeep;

  Result.fIgnoreWndCaption := True;

  with Result.fBoundsRect do

  begin

    Bottom := Top + 40;

  end;

  Result.fColor2 := clNone;

end;

{$ENDIF ASM_VERSION}

//[END NewLabelEffect]



{$ENDIF USE_CONSTRUCTORS}



//===================== Paint box ========================//



{$IFDEF USE_CONSTRUCTORS}

//[function NewPaintbox]

function NewPaintbox( AParent: PControl ): PControl;

begin

  new( Result, CreatePaintBox( AParent ) );

end;

{$ELSE not_USE_CONSTRUCTORS}



//[FUNCTION NewPaintbox]

{$IFDEF ASM_VERSION}

function NewPaintbox( AParent: PControl ): PControl;

asm

        XOR      EDX, EDX

        CALL     NewLabel

        //PUSH     EAX

        //MOV      EDX, offset[WndProcPaintBox]

        //CALL     TControl.AttachProc

        //POP      EAX

        ADD      [EAX].TControl.fBoundsRect.Right, 40-64

        ADD      [EAX].TControl.fBoundsRect.Bottom, 40-22

end;

{$ELSE ASM_VERSION} //Pascal

function NewPaintbox( AParent: PControl ): PControl;

begin

  Result := NewLabel( AParent, '' );

  //Result.AttachProc( WndProcPaintBox );

  with Result.fBoundsRect do

  begin

    Right := Left + 40;

    Bottom := Top + 40;

  end;

end;

{$ENDIF ASM_VERSION}

//[END NewPaintbox]



{$ENDIF USE_CONSTRUCTORS}



{$IFDEF _D2}

//[API SetBrushOrgEx]

function SetBrushOrgEx(DC: HDC; X, Y: Integer; PrevPt: PPoint): BOOL; stdcall;

external gdi32 name 'SetBrushOrgEx';

{$ENDIF}



//[FUNCTION WndProcDoEraseBkgnd]

{$IFDEF ASM_VERSION}

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

asm     //        //

        CMP       word ptr [EDX].TMsg.message, WM_ERASEBKGND

        JNE       @@ret_false

        MOV       byte ptr [ECX], 1

        PUSH      EBX

        PUSH      EDI

        MOV       EBX, EAX

        MOV       EDI, [EDX].TMsg.wParam



        CALL      TControl.CreateChildWindows

        CMP       [EBX].TControl.fTransparent, 0

        JNE       @@exit



        PUSH      OPAQUE

        PUSH      EDI

        CALL      SetBkMode

        MOV       EAX, [EBX].TControl.fColor

        CALL      Color2RGB

        PUSH      EAX

        PUSH      EDI

        CALL      SetBkColor

        XOR       EAX, EAX

        PUSH      EAX

        PUSH      EAX

        PUSH      EAX

        PUSH      EDI

        CALL      SetBrushOrgEx

        SUB       ESP, 16

        PUSH      ESP

        PUSH      [EBX].TControl.fHandle

        CALL      GetClientRect

        MOV       EAX, EBX

        CALL      dword ptr[Global_GetCtlBrushHandle]

        MOV       EDX, ESP

        PUSH      EAX

        PUSH      EDX

        PUSH      EDI

        CALL      Windows.FillRect

        ADD       ESP, 16

@@exit: POP       EDI

        POP       EBX

@@ret_false:

        XOR       EAX, EAX

end;

{$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 ASM_VERSION}

//[END WndProcDoEraseBkgnd]



//[function WndProcImageShow]

function WndProcImageShow( Sender: PControl; var Msg: TMsg;

         var Rslt: Integer ): Boolean;

var PaintStruct: TPaintStruct;

    IL: PImageList;

    OldPaintDC: HDC;

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

    //fOnPaint( Self_, fPaintDC );

    IL := Sender.ImageListNormal;

    if IL <> nil then

    begin

      IL.Draw( Sender.fCurIndex, Sender.fPaintDC, 0, 0 );

      Result := TRUE;

    end;

    if Msg.wParam = 0 then

      EndPaint( Sender.fHandle, PaintStruct );

    Sender.fPaintDC := OldPaintDC;

    Rslt := 0;

    //Result := True;

    Exit;

  end;

end;



//[function NewImageShow]

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;

end;

//[END NewImageShow]



//===================== Scrollbar ========================//

const

  KSB_INITIALIZE = WM_USER + 10000;

  KSB_KEY = $3232;



//[function WndProcScrollBar]

function WndProcScrollBar( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;

begin

  Result := False;

  case Msg.message of

    WM_CREATE:

      PostMessage(Sender.Handle, KSB_INITIALIZE, KSB_KEY, KSB_KEY);



    KSB_INITIALIZE:

      if (Msg.wParam = Msg.lParam) and (Msg.wParam = KSB_KEY) then

      begin

        Sender.SBPageSize := Sender.fSBPageSize;

        Sender.SBMinMax := Sender.fSBMinMax;

        Sender.SBPosition := Sender.fSBPosition;

      end;

  end;

end;

//[END WndProcScrollBar]



//[function WndProcScrollBarParent]

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

      Bar := Pointer(GetProp(Msg.lParam, ID_SELF));

      if (Bar <> nil) then begin

        FillChar(SI, SizeOf(SI), 0);

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

          SB_THUMBTRACK: NewPos := SI.nTrackPos;

          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;

        if Assigned(Bar.OnSBBeforeScroll) then

          Bar.OnSBBeforeScroll(Bar, SI.nPos, NewPos, Cmd, AllowChange);

        if AllowChange then

          SI.nPos := NewPos

        else

          SI.nTrackPos := SI.nPos;

        Bar.fSBPosition := SI.nPos;

        Bar.fSBPosition := Bar.SBSetScrollInfo(SI);

        if AllowChange and Assigned(Bar.OnSBScroll) then

            Bar.OnSBScroll(Bar, Cmd);

      end;

    end;

  end;

end;

//[END WndProcScrollBarParent]



//[function NewScrollBar]

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,

    nil

  );

  Result.DetachProc(WndProcCtrl);

  Result.fLookTabKeys := [tkTab];

  Result.AttachProc(WndProcScrollBar);

  AParent.AttachProc(WndProcScrollBarParent);

end;

//[END NewScrollBa