/KO208L.pas

Large files files are truncated, but you can click here to view the full file

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

   …