/KO208L.pas
Pascal | 10844 lines | 3819 code | 1050 blank | 5975 comment | 0 complexity | a81b16c76440c8b48a9fd8dcd1486d3f MD5 | raw 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= <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>
- 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> <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>
- 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>
- 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>
- <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>
- 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>
- 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>
- 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>
- 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>
- 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>
- 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 Bao</a>. Implementation:
- | <a href=mailto:"bonanzas@xcl.cjb.net">Kladov 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>
- 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>
- 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>
- 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>
- 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>
- 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>
- 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>
- 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>
- 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>
- 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>
- 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' );
- |
- 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>
- 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>
- 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>
- 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> <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> <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>
- 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>
- 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