1 | unit ORCtrls; // Oct 26, 1997 @ 10:00am
|
---|
2 |
|
---|
3 | // To Do: eliminate topindex itemtip on mousedown (seen when choosing clinic pts)
|
---|
4 |
|
---|
5 | interface // --------------------------------------------------------------------------------
|
---|
6 |
|
---|
7 | uses Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Forms,
|
---|
8 | ComCtrls, Commctrl, Buttons, ExtCtrls, Grids, ImgList, Menus, CheckLst,
|
---|
9 | Variants, VAClasses;
|
---|
10 |
|
---|
11 | const
|
---|
12 | UM_SHOWTIP = (WM_USER + 9436); // message id to display item tip **was 300
|
---|
13 | UM_GOTFOCUS = (WM_USER + 9437); // message to post when combo gets focus **was 301
|
---|
14 | MAX_TABS = 40; // maximum number of tab stops or pieces
|
---|
15 | LL_REVERSE = -1; // long list scrolling in reverse direction
|
---|
16 | LL_POSITION = 0; // long list thumb moved
|
---|
17 | LL_FORWARD = 1; // long list scrolling in forward direction
|
---|
18 | LLS_LINE = '^____________________________________________________________________________';
|
---|
19 | LLS_DASH = '^----------------------------------------------------------------------------';
|
---|
20 | LLS_SPACE = '^ ';
|
---|
21 |
|
---|
22 | type
|
---|
23 | IORBlackColorModeCompatible = interface(IInterface)
|
---|
24 | ['{3554985C-F524-45FA-8C27-4CDD8357DB08}']
|
---|
25 | procedure SetBlackColorMode(Value: boolean);
|
---|
26 | end;
|
---|
27 |
|
---|
28 | TORComboBox = class; // forward declaration for FParentCombo
|
---|
29 |
|
---|
30 | TTranslator = function (MString: string): string of object;
|
---|
31 |
|
---|
32 | TORStrings = class(TStrings)
|
---|
33 | private
|
---|
34 | MList: TStringList;
|
---|
35 | FPlainText: TStrings;
|
---|
36 | FTranslator: TTranslator;
|
---|
37 | FVerification: boolean;
|
---|
38 | procedure Verify;
|
---|
39 | protected
|
---|
40 | function Get( index:integer): string; override;
|
---|
41 | function GetCount: integer; override;
|
---|
42 | function GetObject(index:integer): TObject; override;
|
---|
43 | procedure Put(Index: Integer; const S: string); override;
|
---|
44 | procedure PutObject(index:integer; Value: TObject); override;
|
---|
45 | procedure SetUpdateState( Value: boolean); override;
|
---|
46 | public
|
---|
47 | function Add(const S: string): integer; override;
|
---|
48 | constructor Create(PlainText: TStrings; Translator: TTranslator);
|
---|
49 | destructor Destroy; override;
|
---|
50 | procedure Clear; override;
|
---|
51 | procedure Delete( index: integer); override;
|
---|
52 | procedure Insert(Index: Integer; const S: string); override;
|
---|
53 | function IndexOf(const S: string): Integer; override;
|
---|
54 | property PlainText: TStrings read FPlainText;
|
---|
55 | property Translator: TTranslator read FTranslator;
|
---|
56 | property Verification: boolean read FVerification write FVerification;
|
---|
57 | end;
|
---|
58 |
|
---|
59 | TORDirection = -1..1; // for compatibility, type is now integer
|
---|
60 | TORNeedDataEvent = procedure(Sender: TObject; const StartFrom: string;
|
---|
61 | Direction, InsertAt: Integer) of object;
|
---|
62 | TORBeforeDrawEvent = procedure(Sender: TObject; Index: Integer; Rect: TRect;
|
---|
63 | State: TOwnerDrawState) of object;
|
---|
64 | TORItemNotifyEvent = procedure(Sender: TObject; Index: integer) of object;
|
---|
65 | TORCheckComboTextEvent = procedure(Sender: TObject; NumChecked: integer; var Text: string) of object;
|
---|
66 | TORSynonymCheckEvent = procedure(Sender: TObject; const Text: string;
|
---|
67 | var IsSynonym: boolean) of object;
|
---|
68 |
|
---|
69 | PItemRec = ^TItemRec;
|
---|
70 | TItemRec = record
|
---|
71 | Reference: Variant; // variant value associated with item
|
---|
72 | UserObject: TObject; // Objects[n] property of listbox item
|
---|
73 | CheckedState: TCheckBoxState; // Used to indicate check box values
|
---|
74 | end;
|
---|
75 |
|
---|
76 | TORListBox = class(TListBox, IVADynamicProperty, IORBlackColorModeCompatible)
|
---|
77 | private
|
---|
78 | FFocusIndex: Integer; // item with focus when using navigation keys
|
---|
79 | FLargeChange: Integer; // visible items less one
|
---|
80 | FTipItem: Integer; // item currently displaying ItemTip
|
---|
81 | FItemTipActive: Boolean; // used to delay appearance of the ItemTip
|
---|
82 | FItemTipColor: TColor; // background color for ItemTip window
|
---|
83 | FItemTipEnable: Boolean; // allows display of ItemTips over items
|
---|
84 | FLastMouseX: Integer; // mouse X position on last MouseMove event
|
---|
85 | FLastMouseY: Integer; // mouse Y position on last MouseMove event
|
---|
86 | FLastItemIndex: Integer; // used for the OnChange event
|
---|
87 | FFromSelf: Boolean; // true if listbox message sent from this unit
|
---|
88 | FDelimiter: Char; // delimiter used by Pieces property
|
---|
89 | FWhiteSpace: Char; // may be space or tab (between pieces)
|
---|
90 | FTabPosInPixels: boolean; // determines if TabPosition is Pixels or Chars
|
---|
91 | FTabPos: array[0..MAX_TABS] of Integer; // character based positions of tab stops
|
---|
92 | FTabPix: array[0..MAX_TABS] of Integer; // pixel positions of tab stops
|
---|
93 | FPieces: array[0..MAX_TABS] of Integer; // pieces that should be displayed for item
|
---|
94 | FLongList: Boolean; // if true, enables special LongList properties
|
---|
95 | FScrollBar: TScrollBar; // scrollbar used when in LongList mode
|
---|
96 | FFirstLoad: Boolean; // true if NeedData has never been called
|
---|
97 | FFromNeedData: Boolean; // true means items added to LongList part
|
---|
98 | FDataAdded: Boolean; // true if items added during NeedData call
|
---|
99 | FCurrentTop: Integer; // TopIndex, changes when inserting to LongList
|
---|
100 | FWaterMark: Integer; // first LongList item after the short list
|
---|
101 | FDirection: Integer; // direction of the current NeedData call
|
---|
102 | FInsertAt: Integer; // insert point for the current NeedData call
|
---|
103 | FParentCombo: TORComboBox; // used when listbox is part of dropdown combo
|
---|
104 | FOnChange: TNotifyEvent; // event called when ItemIndex changes
|
---|
105 | FOnNeedData: TORNeedDataEvent; // event called when LongList needs more items
|
---|
106 | FHideSynonyms: boolean; // Hides Synonyms from the list
|
---|
107 | FSynonymChars: string; // Chars a string must contain to be considered a synonym
|
---|
108 | FOnSynonymCheck: TORSynonymCheckEvent; // Event that allows for custom synonym checking
|
---|
109 | FCreatingItem: boolean; // Used by Synonyms to prevent errors when adding new items
|
---|
110 | FCreatingText: string; // Used by Synonyms to prevent errors when adding new items
|
---|
111 | FOnBeforeDraw: TORBeforeDrawEvent; // event called prior to drawing an item
|
---|
112 | FRightClickSelect: boolean; // When true, a right click selects teh item
|
---|
113 | FCheckBoxes: boolean; // When true, list box contains check boxes
|
---|
114 | FFlatCheckBoxes: boolean; // When true, list box check boxes are flat
|
---|
115 | FCheckEntireLine: boolean; // When checked, clicking anywhere on the line checks the checkbox
|
---|
116 | FOnClickCheck: TORItemNotifyEvent; // Event notifying of checkbox change
|
---|
117 | FDontClose: boolean; // Used to keep drop down open when checkboxes
|
---|
118 | FItemsDestroyed: boolean; // Used to make sure items are not destroyed multiple times
|
---|
119 | FAllowGrayed: boolean;
|
---|
120 | FMItems: TORStrings; // Used to save corresponding M strings ("the pieces")
|
---|
121 | FCaption: TStaticText; // Used to supply a title to IAccessible interface
|
---|
122 | FCaseChanged: boolean; // If true, the names are stored in the database as all caps, but loaded and displayed in mixed-case
|
---|
123 | FLookupPiece: integer; // If zero, list look-up comes from display string; if non-zero, indicates which piece of the item needs to be used for list lookup
|
---|
124 | FIsPartOfComboBox: boolean;
|
---|
125 | FBlackColorMode: boolean;
|
---|
126 | FHideSelection: boolean;
|
---|
127 | procedure AdjustScrollBar;
|
---|
128 | procedure CreateScrollBar;
|
---|
129 | procedure FreeScrollBar;
|
---|
130 | function GetDisplayText(Index: Integer): string;
|
---|
131 | function GetItemID: Variant;
|
---|
132 | function GetItemIEN: Int64;
|
---|
133 | function GetPieces: string;
|
---|
134 | function GetReference(Index: Integer): Variant;
|
---|
135 | function GetTabPositions: string;
|
---|
136 | function GetStyle: TListBoxStyle;
|
---|
137 | procedure NeedData(Direction: Integer; StartFrom: string);
|
---|
138 | function PositionThumb: Integer;
|
---|
139 | procedure ResetItems;
|
---|
140 | procedure ScrollTo(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
|
---|
141 | function GetStringIndex(const AString: string): Integer;
|
---|
142 | function SelectString(const AString: string): Integer;
|
---|
143 | procedure SetCheckBoxes(const Value: boolean);
|
---|
144 | procedure SetDelimiter(Value: Char);
|
---|
145 | procedure SetFlatCheckBoxes(const Value: boolean);
|
---|
146 | procedure SetFocusIndex(Value: Integer);
|
---|
147 | procedure SetLongList(Value: Boolean);
|
---|
148 | procedure SetPieces(const Value: string);
|
---|
149 | procedure SetReference(Index: Integer; AReference: Variant);
|
---|
150 | procedure SetTabPositions(const Value: string);
|
---|
151 | procedure SetTabPosInPixels(const Value: boolean);
|
---|
152 | procedure SetTabStops;
|
---|
153 | procedure SetHideSynonyms(Value: boolean);
|
---|
154 | procedure SetSynonymChars(Value: string);
|
---|
155 | procedure SetStyle(Value: TListBoxStyle);
|
---|
156 | function IsSynonym(const TestStr: string): boolean;
|
---|
157 | function TextToShow(S: string): string;
|
---|
158 | procedure LBGetText (var Message: TMessage); message LB_GETTEXT;
|
---|
159 | procedure LBGetTextLen (var Message: TMessage); message LB_GETTEXTLEN;
|
---|
160 | procedure LBGetItemData (var Message: TMessage); message LB_GETITEMDATA;
|
---|
161 | procedure LBSetItemData (var Message: TMessage); message LB_SETITEMDATA;
|
---|
162 | procedure LBAddString (var Message: TMessage); message LB_ADDSTRING;
|
---|
163 | procedure LBInsertString (var Message: TMessage); message LB_INSERTSTRING;
|
---|
164 | procedure LBDeleteString (var Message: TMessage); message LB_DELETESTRING;
|
---|
165 | procedure LBResetContent (var Message: TMessage); message LB_RESETCONTENT;
|
---|
166 | procedure LBSetCurSel (var Message: TMessage); message LB_SETCURSEL;
|
---|
167 | procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
|
---|
168 | procedure CNDrawItem (var Message: TWMDrawItem); message CN_DRAWITEM;
|
---|
169 | procedure WMDestroy (var Message: TWMDestroy); message WM_DESTROY;
|
---|
170 | procedure WMKeyDown (var Message: TWMKeyDown); message WM_KEYDOWN;
|
---|
171 | procedure WMLButtonDown (var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
|
---|
172 | procedure WMLButtonUp (var Message: TWMLButtonUp); message WM_LBUTTONUP;
|
---|
173 | procedure WMRButtonUp (var Message: TWMRButtonUp); message WM_RBUTTONUP;
|
---|
174 | procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
|
---|
175 | procedure WMCancelMode (var Message: TMessage); message WM_CANCELMODE;
|
---|
176 | procedure WMMove (var Message: TWMMove); message WM_MOVE;
|
---|
177 | procedure WMSize (var Message: TWMSize); message WM_SIZE;
|
---|
178 | procedure WMVScroll (var Message: TWMVScroll); message WM_VSCROLL;
|
---|
179 | procedure CMHintShow (var Message: TMessage); message CM_HINTSHOW;
|
---|
180 | procedure UMShowTip (var Message: TMessage); message UM_SHOWTIP;
|
---|
181 | function GetChecked(Index: Integer): Boolean;
|
---|
182 | procedure SetChecked(Index: Integer; const Value: Boolean);
|
---|
183 | function GetMultiSelect: boolean;
|
---|
184 | function GetCheckedString: string;
|
---|
185 | procedure SetCheckedString(const Value: string);
|
---|
186 | function GetCheckedState(Index: Integer): TCheckBoxState;
|
---|
187 | procedure SetCheckedState(Index: Integer; const Value: TCheckBoxState);
|
---|
188 | function GetMItems: TStrings;
|
---|
189 | procedure SetMItems( Value: TStrings);
|
---|
190 | procedure SetCaption(const Value: string);
|
---|
191 | function GetCaption: string;
|
---|
192 | protected
|
---|
193 | procedure SetMultiSelect(Value: boolean); override;
|
---|
194 | procedure CreateParams(var Params: TCreateParams); override;
|
---|
195 | procedure CreateWnd; override;
|
---|
196 | procedure DestroyWnd; override;
|
---|
197 | procedure Click; override;
|
---|
198 | procedure DoChange; virtual;
|
---|
199 | procedure DoEnter; override;
|
---|
200 | procedure DoExit; override;
|
---|
201 | procedure DestroyItems;
|
---|
202 | procedure Loaded; override;
|
---|
203 | procedure ToggleCheckBox(idx: integer);
|
---|
204 | procedure KeyPress(var Key: Char); override;
|
---|
205 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
---|
206 | procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
---|
207 | procedure MeasureItem(Index: Integer; var Height: Integer); override;
|
---|
208 | procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
|
---|
209 | function GetIndexFromY(YPos :integer) :integer;
|
---|
210 | property isPartOfComboBox: boolean read FIsPartOfComboBox write FIsPartOfComboBox default False;
|
---|
211 | property HideSynonyms: boolean read FHideSynonyms write SetHideSynonyms default FALSE;
|
---|
212 | property SynonymChars: string read FSynonymChars write SetSynonymChars;
|
---|
213 | public
|
---|
214 | constructor Create(AOwner: TComponent); override;
|
---|
215 | destructor Destroy; override;
|
---|
216 | procedure ClearTop;
|
---|
217 | function AddReference(const S: string; AReference: Variant): Integer;
|
---|
218 | procedure InsertReference(Index: Integer; const S: string; AReference: Variant);
|
---|
219 | function IndexOfReference(AReference: Variant): Integer;
|
---|
220 | procedure InsertSeparator;
|
---|
221 | procedure ForDataUse(Strings: TStrings);
|
---|
222 | procedure InitLongList(S: string);
|
---|
223 | function GetIEN(AnIndex: Integer): Int64;
|
---|
224 | function SelectByIEN(AnIEN: Int64): Integer;
|
---|
225 | function SelectByID(const AnID: string): Integer;
|
---|
226 | function SetExactByIEN(AnIEN: Int64; const AnItem: string): Integer;
|
---|
227 | procedure Clear; override;
|
---|
228 | property ItemID: Variant read GetItemID;
|
---|
229 | property ItemIEN: Int64 read GetItemIEN;
|
---|
230 | property FocusIndex: Integer read FFocusIndex write SetFocusIndex;
|
---|
231 | property DisplayText[Index: Integer]: string read GetDisplayText;
|
---|
232 | property References[Index: Integer]: Variant read GetReference write SetReference;
|
---|
233 | property ShortCount: Integer read FWaterMark;
|
---|
234 | property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
|
---|
235 | property CheckedString: string read GetCheckedString write SetCheckedString;
|
---|
236 | property CheckedState[Index: Integer]: TCheckBoxState read GetCheckedState write SetCheckedState;
|
---|
237 | property MItems: TStrings read GetMItems write SetMItems;
|
---|
238 | function VerifyUnique(SelectIndex: Integer; iText: String): integer;
|
---|
239 | procedure SetBlackColorMode(Value: boolean);
|
---|
240 | function SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
241 | function GetDynamicProperty(PropertyID: integer): string;
|
---|
242 | property HideSelection: boolean read FHideSelection write FHideSelection;
|
---|
243 | published
|
---|
244 | property AllowGrayed: boolean read FAllowGrayed write FAllowGrayed default FALSE;
|
---|
245 | property Caption: string read GetCaption write SetCaption;
|
---|
246 | property CaseChanged: boolean read FCaseChanged write FCaseChanged default TRUE;
|
---|
247 | property Delimiter: Char read FDelimiter write SetDelimiter default '^';
|
---|
248 | property ItemTipColor: TColor read FItemTipColor write FItemTipColor;
|
---|
249 | property ItemTipEnable: Boolean read FItemTipEnable write FItemTipEnable default True;
|
---|
250 | property LongList: Boolean read FLongList write SetLongList;
|
---|
251 | property LookupPiece: integer read FLookupPiece write FLookupPiece default 0;
|
---|
252 | property Pieces: string read GetPieces write SetPieces;
|
---|
253 | property TabPosInPixels: boolean read FTabPosInPixels write SetTabPosInPixels default False; // MUST be before TabPositions!
|
---|
254 | property TabPositions: string read GetTabPositions write SetTabPositions;
|
---|
255 | property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
---|
256 | property OnNeedData: TORNeedDataEvent read FOnNeedData write FOnNeedData;
|
---|
257 | property OnBeforeDraw: TORBeforeDrawEvent read FOnBeforeDraw write FOnBeforeDraw;
|
---|
258 | property RightClickSelect: boolean read FRightClickSelect write FRightClickSelect default FALSE;
|
---|
259 | property CheckBoxes: boolean read FCheckBoxes write SetCheckBoxes default FALSE;
|
---|
260 | property Style: TListBoxStyle read GetStyle write SetStyle default lbStandard;
|
---|
261 | property FlatCheckBoxes: boolean read FFlatCheckBoxes write SetFlatCheckBoxes default TRUE;
|
---|
262 | property CheckEntireLine: boolean read FCheckEntireLine write FCheckEntireLine default FALSE;
|
---|
263 | property OnClickCheck: TORItemNotifyEvent read FOnClickCheck write FOnClickCheck;
|
---|
264 | property MultiSelect: boolean read GetMultiSelect write SetMultiSelect default FALSE;
|
---|
265 | property Items: TStrings read GetMItems write SetMItems;
|
---|
266 | end;
|
---|
267 |
|
---|
268 | TORDropPanel = class(TPanel)
|
---|
269 | private
|
---|
270 | FButtons: boolean;
|
---|
271 | procedure WMActivateApp(var Message: TMessage); message WM_ACTIVATEAPP;
|
---|
272 | protected
|
---|
273 | procedure CreateParams(var Params: TCreateParams); override;
|
---|
274 | procedure Resize; override;
|
---|
275 | procedure UpdateButtons;
|
---|
276 | function GetButton(OKBtn: boolean): TSpeedButton;
|
---|
277 | procedure ResetButtons;
|
---|
278 | procedure BtnClicked(Sender: TObject);
|
---|
279 | public
|
---|
280 | constructor Create(AOwner: TComponent); override;
|
---|
281 | end;
|
---|
282 |
|
---|
283 | TORComboStyle = (orcsDropDown, orcsSimple);
|
---|
284 |
|
---|
285 | TORComboPanelEdit = class(TPanel)
|
---|
286 | private
|
---|
287 | FFocused: boolean;
|
---|
288 | FCanvas: TControlCanvas;
|
---|
289 | protected
|
---|
290 | procedure Paint; override;
|
---|
291 | public
|
---|
292 | destructor Destroy; override;
|
---|
293 | end;
|
---|
294 |
|
---|
295 | TORComboEdit = class(TEdit)
|
---|
296 | private
|
---|
297 | procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
|
---|
298 | procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
|
---|
299 | protected
|
---|
300 | procedure CreateParams(var Params: TCreateParams); override;
|
---|
301 | end;
|
---|
302 |
|
---|
303 | TORComboBox = class(TWinControl, IVADynamicProperty, IORBlackColorModeCompatible)
|
---|
304 | private
|
---|
305 | FItems: TStrings; // points to Items in FListBox
|
---|
306 | FMItems: TStrings; // points to MItems in FListBox
|
---|
307 | FListBox: TORListBox; // listbox control for the combobox
|
---|
308 | FEditBox: TORComboEdit; // edit control for the combobox
|
---|
309 | FEditPanel: TORComboPanelEdit; // Used to enable Multi-Select Combo Boxes
|
---|
310 | FDropBtn: TBitBtn; // drop down button for dropdown combo
|
---|
311 | FDropPanel: TORDropPanel; // panel for dropdown combo (parent=desktop)
|
---|
312 | FDroppedDown: Boolean; // true if the list part is dropped down
|
---|
313 | FStyle: TORComboStyle; // style is simple or dropdown for combo
|
---|
314 | FDropDownCount: Integer; // number of items to display when list appears
|
---|
315 | FFromSelf: Boolean; // prevents recursive calls to change event
|
---|
316 | FFromDropBtn: Boolean; // determines when to capture mouse on drop
|
---|
317 | FKeyTimerActive: Boolean; // true when timer running for OnKeyPause
|
---|
318 | FKeyIsDown: Boolean; // true between KeyDown & KeyUp events
|
---|
319 | FChangePending: Boolean;
|
---|
320 | FListItemsOnly: Boolean;
|
---|
321 | FLastFound: string;
|
---|
322 | FLastInput: string; // last thing the user typed into the edit box
|
---|
323 | FOnChange: TNotifyEvent; // maps to editbox change event
|
---|
324 | FOnClick: TNotifyEvent; // maps to listbox click event
|
---|
325 | FOnDblClick: TNotifyEvent; // maps to listbox double click event
|
---|
326 | FOnDropDown: TNotifyEvent; // event called when listbox appears
|
---|
327 | FOnDropDownClose: TNotifyEvent; // event called when listbox disappears
|
---|
328 | FOnKeyDown: TKeyEvent; // maps to editbox keydown event
|
---|
329 | FOnKeyPress: TKeyPressEvent; // maps to editbox keypress event
|
---|
330 | FOnKeyUp: TKeyEvent; // maps to editbox keyup event
|
---|
331 | FOnKeyPause: TNotifyEvent; // delayed change event when using keyboard
|
---|
332 | FOnMouseClick: TNotifyEvent; // called when click event triggered by mouse
|
---|
333 | FOnNeedData: TORNeedDataEvent; // called for longlist when more items needed
|
---|
334 | FCheckedState: string; // Used to refresh checkboxes when combo box cancel is pressed
|
---|
335 | FOnCheckedText: TORCheckComboTextEvent; // Used to modify the edit box display text when using checkboxes
|
---|
336 | FCheckBoxEditColor: TColor; // Edit Box color for Check Box Combo List, when not in Focus
|
---|
337 | FTemplateField: boolean;
|
---|
338 | FCharsNeedMatch: integer; // how many text need to be matched for auto selection
|
---|
339 | FUniqueAutoComplete: Boolean; // If true only perform autocomplete for unique list items.
|
---|
340 | FBlackColorMode: boolean;
|
---|
341 | FDisableHints: boolean; // true if hints have been disabled because drop down window was opened
|
---|
342 | FDropDownStatusChangedCount: integer; // prevents multiple calls to disabling hint window
|
---|
343 | procedure DropDownStatusChanged(opened: boolean);
|
---|
344 | procedure ClearDropDownStatus;
|
---|
345 | function EditControl: TWinControl;
|
---|
346 | procedure AdjustSizeOfSelf;
|
---|
347 | procedure DropButtonDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
|
---|
348 | X, Y: Integer);
|
---|
349 | procedure DropButtonUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
|
---|
350 | X, Y: Integer);
|
---|
351 | procedure FwdChange(Sender: TObject);
|
---|
352 | procedure FwdChangeDelayed;
|
---|
353 | procedure FwdClick(Sender: TObject);
|
---|
354 | procedure FwdDblClick(Sender: TObject);
|
---|
355 | procedure FwdKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
---|
356 | procedure FwdKeyPress(Sender: TObject; var Key: Char);
|
---|
357 | procedure FwdKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
---|
358 | procedure FwdMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
|
---|
359 | X, Y: Integer);
|
---|
360 | procedure FwdNeedData(Sender: TObject; const StartFrom: string;
|
---|
361 | Direction, InsertAt: Integer);
|
---|
362 | procedure SetNumForMatch(const NumberForMatch: integer);
|
---|
363 | function GetAutoSelect: Boolean;
|
---|
364 | function GetColor: TColor;
|
---|
365 | function GetDelimiter: Char;
|
---|
366 | function GetDisplayText(Index: Integer): string;
|
---|
367 | function GetItemHeight: Integer;
|
---|
368 | function GetItemID: Variant;
|
---|
369 | function GetItemIEN: Int64;
|
---|
370 | function GetItemIndex: Integer;
|
---|
371 | function GetItemTipEnable: Boolean;
|
---|
372 | function GetItemTipColor: TColor;
|
---|
373 | function GetLongList: Boolean;
|
---|
374 | function GetMaxLength: Integer;
|
---|
375 | function GetPieces: string;
|
---|
376 | function GetReference(Index: Integer): Variant;
|
---|
377 | function GetSelLength: Integer;
|
---|
378 | function GetSelStart: Integer;
|
---|
379 | function GetSelText: string;
|
---|
380 | function GetShortCount: Integer;
|
---|
381 | function GetSorted: Boolean;
|
---|
382 | function GetHideSynonyms: boolean;
|
---|
383 | function GetSynonymChars: string;
|
---|
384 | function GetTabPositions: string;
|
---|
385 | function GetTabPosInPixels: boolean;
|
---|
386 | function GetText: string;
|
---|
387 | procedure SetAutoSelect(Value: Boolean);
|
---|
388 | procedure SetColor(Value: TColor);
|
---|
389 | procedure SetDelimiter(Value: Char);
|
---|
390 | procedure SetDropDownCount(Value: Integer);
|
---|
391 | procedure SetDroppedDown(Value: Boolean);
|
---|
392 | procedure SetEditRect;
|
---|
393 | procedure SetEditText(const Value: string);
|
---|
394 | procedure SetItemIndex(Value: Integer);
|
---|
395 | procedure SetItemHeight(Value: Integer);
|
---|
396 | procedure SetItemTipEnable(Value: Boolean);
|
---|
397 | procedure SetItemTipColor(Value: TColor);
|
---|
398 | procedure SetLongList(Value: Boolean);
|
---|
399 | procedure SetMaxLength(Value: Integer);
|
---|
400 | procedure SetPieces(const Value: string);
|
---|
401 | procedure SetReference(Index: Integer; AReference: Variant);
|
---|
402 | procedure SetSelLength(Value: Integer);
|
---|
403 | procedure SetSelStart(Value: Integer);
|
---|
404 | procedure SetSelText(const Value: string);
|
---|
405 | procedure SetSorted(Value: Boolean);
|
---|
406 | procedure SetHideSynonyms(Value: boolean);
|
---|
407 | procedure SetSynonymChars(Value: string);
|
---|
408 | procedure SetStyle(Value: TORComboStyle);
|
---|
409 | procedure SetTabPositions(const Value: string);
|
---|
410 | procedure SetTabPosInPixels(const Value: boolean);
|
---|
411 | procedure SetText(const Value: string);
|
---|
412 | procedure SetItems(const Value: TStrings);
|
---|
413 | procedure StartKeyTimer;
|
---|
414 | procedure StopKeyTimer;
|
---|
415 | procedure WMDestroy (var Message: TWMDestroy); message WM_DESTROY;
|
---|
416 | procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
|
---|
417 | procedure WMMove (var Message: TWMMove); message WM_MOVE;
|
---|
418 | procedure WMSize (var Message: TWMSize); message WM_SIZE;
|
---|
419 | procedure WMTimer (var Message: TWMTimer); message WM_TIMER;
|
---|
420 | procedure UMGotFocus (var Message: TMessage); message UM_GOTFOCUS;
|
---|
421 | function GetCheckBoxes: boolean;
|
---|
422 | function GetChecked(Index: Integer): Boolean;
|
---|
423 | function GetCheckEntireLine: boolean;
|
---|
424 | function GetFlatCheckBoxes: boolean;
|
---|
425 | procedure SetCheckBoxes(const Value: boolean);
|
---|
426 | procedure SetChecked(Index: Integer; const Value: Boolean);
|
---|
427 | procedure SetCheckEntireLine(const Value: boolean);
|
---|
428 | procedure SetFlatCheckBoxes(const Value: boolean);
|
---|
429 | function GetCheckedString: string;
|
---|
430 | procedure SetCheckedString(const Value: string);
|
---|
431 | procedure SetCheckBoxEditColor(const Value: TColor);
|
---|
432 | procedure SetListItemsOnly(const Value: Boolean);
|
---|
433 | procedure SetOnCheckedText(const Value: TORCheckComboTextEvent);
|
---|
434 | procedure SetTemplateField(const Value: boolean);
|
---|
435 | function GetOnSynonymCheck: TORSynonymCheckEvent;
|
---|
436 | procedure SetOnSynonymCheck(const Value: TORSynonymCheckEvent);
|
---|
437 | function GetMItems: TStrings;
|
---|
438 | procedure SetCaption(const Value: string);
|
---|
439 | function GetCaption: string;
|
---|
440 | function GetCaseChanged: boolean;
|
---|
441 | procedure SetCaseChanged(const Value: boolean);
|
---|
442 | function GetLookupPiece: integer;
|
---|
443 | procedure SetLookupPiece(const Value: integer);
|
---|
444 | procedure SetUniqueAutoComplete(const Value: Boolean);
|
---|
445 | procedure LoadComboBoxImage;
|
---|
446 | protected
|
---|
447 | procedure DropPanelBtnPressed(OKBtn, AutoClose: boolean);
|
---|
448 | function GetEditBoxText(Index: Integer): string;
|
---|
449 | procedure CheckBoxSelected(Sender: TObject; Index: integer);
|
---|
450 | procedure UpdateCheckEditBoxText;
|
---|
451 | procedure DoEnter; override;
|
---|
452 | procedure DoExit; override;
|
---|
453 | procedure Loaded; override;
|
---|
454 | function GetEnabled: boolean; override;
|
---|
455 | procedure SetEnabled(Value: boolean); override;
|
---|
456 | public
|
---|
457 | constructor Create(AOwner: TComponent); override;
|
---|
458 | destructor Destroy; override;
|
---|
459 | function AddReference(const S: string; AReference: Variant): Integer;
|
---|
460 | procedure Clear;
|
---|
461 | procedure ClearTop;
|
---|
462 | procedure ForDataUse(Strings: TStrings);
|
---|
463 | procedure InitLongList(S: string);
|
---|
464 | procedure InsertSeparator;
|
---|
465 | procedure Invalidate; override;
|
---|
466 | procedure SetTextAutoComplete(TextToMatch : String);
|
---|
467 | function GetIEN(AnIndex: Integer): Int64;
|
---|
468 | function SelectByIEN(AnIEN: Int64): Integer;
|
---|
469 | function SelectByID(const AnID: string): Integer;
|
---|
470 | function SetExactByIEN(AnIEN: Int64; const AnItem: string): Integer;
|
---|
471 | function IndexOfReference(AReference: Variant): Integer;
|
---|
472 | procedure InsertReference(Index: Integer; const S: string; AReference: Variant);
|
---|
473 | procedure SelectAll;
|
---|
474 | procedure SetBlackColorMode(Value: boolean);
|
---|
475 | function SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
476 | function GetDynamicProperty(PropertyID: integer): string;
|
---|
477 | property DisplayText[Index: Integer]: string read GetDisplayText;
|
---|
478 | property DroppedDown: Boolean read FDroppedDown write SetDroppedDown;
|
---|
479 | property ItemID: Variant read GetItemID;
|
---|
480 | property ItemIEN: Int64 read GetItemIEN;
|
---|
481 | property ItemIndex: Integer read GetItemIndex write SetItemIndex;
|
---|
482 | property References[Index: Integer]: Variant read GetReference write SetReference;
|
---|
483 | property SelLength: Integer read GetSelLength write SetSelLength;
|
---|
484 | property SelStart: Integer read GetSelStart write SetSelStart;
|
---|
485 | property SelText: string read GetSelText write SetSelText;
|
---|
486 | property ShortCount: Integer read GetShortCount;
|
---|
487 | property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
|
---|
488 | property CheckedString: string read GetCheckedString write SetCheckedString;
|
---|
489 | property TemplateField: boolean read FTemplateField write SetTemplateField;
|
---|
490 | property MItems: TStrings read GetMItems;
|
---|
491 | published
|
---|
492 | property Anchors;
|
---|
493 | property CaseChanged: boolean read GetCaseChanged write SetCaseChanged default TRUE;
|
---|
494 | property CheckBoxes: boolean read GetCheckBoxes write SetCheckBoxes default FALSE;
|
---|
495 | property Style: TORComboStyle read FStyle write SetStyle;
|
---|
496 | property Align;
|
---|
497 | property AutoSelect: Boolean read GetAutoSelect write SetAutoSelect;
|
---|
498 | property Caption: string read GetCaption write SetCaption;
|
---|
499 | property Color: TColor read GetColor write SetColor;
|
---|
500 | property Ctl3D;
|
---|
501 | property Delimiter: Char read GetDelimiter write SetDelimiter default '^';
|
---|
502 | property DropDownCount: Integer read FDropDownCount write SetDropDownCount;
|
---|
503 | property Enabled;
|
---|
504 | property Font;
|
---|
505 | property Items: TStrings read FItems write SetItems;
|
---|
506 | property ItemHeight: Integer read GetItemHeight write SetItemHeight;
|
---|
507 | property ItemTipColor: TColor read GetItemTipColor write SetItemTipColor;
|
---|
508 | property ItemTipEnable: Boolean read GetItemTipEnable write SetItemTipEnable;
|
---|
509 | property ListItemsOnly: Boolean read FListItemsOnly write SetListItemsOnly;
|
---|
510 | property LongList: Boolean read GetLongList write SetLongList;
|
---|
511 | property LookupPiece: Integer read GetLookupPiece write SetLookupPiece;
|
---|
512 | property MaxLength: Integer read GetMaxLength write SetMaxLength;
|
---|
513 | property ParentColor;
|
---|
514 | property ParentCtl3D;
|
---|
515 | property ParentFont;
|
---|
516 | property ParentShowHint;
|
---|
517 | property Pieces: string read GetPieces write SetPieces;
|
---|
518 | property PopupMenu;
|
---|
519 | property ShowHint;
|
---|
520 | property HideSynonyms: boolean read GetHideSynonyms write SetHideSynonyms default FALSE;
|
---|
521 | property Sorted: Boolean read GetSorted write SetSorted;
|
---|
522 | property SynonymChars: string read GetSynonymChars write SetSynonymChars;
|
---|
523 | property TabPosInPixels: boolean read GetTabPosInPixels write SetTabPosInPixels default False; // MUST be before TabPositions!
|
---|
524 | property TabPositions: string read GetTabPositions write SetTabPositions;
|
---|
525 | property TabOrder;
|
---|
526 | property TabStop;
|
---|
527 | property Text: string read GetText write SetText;
|
---|
528 | property Visible;
|
---|
529 | property FlatCheckBoxes: boolean read GetFlatCheckBoxes write SetFlatCheckBoxes default TRUE;
|
---|
530 | property CheckEntireLine: boolean read GetCheckEntireLine write SetCheckEntireLine default FALSE;
|
---|
531 | property CheckBoxEditColor: TColor read FCheckBoxEditColor write SetCheckBoxEditColor default clBtnFace;
|
---|
532 | property OnCheckedText: TORCheckComboTextEvent read FOnCheckedText write SetOnCheckedText;
|
---|
533 | property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
---|
534 | property OnClick: TNotifyEvent read FOnClick write FOnClick;
|
---|
535 | property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
|
---|
536 | property OnDragDrop;
|
---|
537 | property OnDragOver;
|
---|
538 | property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
|
---|
539 | property OnDropDownClose: TNotifyEvent read FOnDropDownClose write FOnDropDownClose;
|
---|
540 | property OnEnter;
|
---|
541 | property OnExit;
|
---|
542 | property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
|
---|
543 | property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
|
---|
544 | property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
|
---|
545 | property OnKeyPause: TNotifyEvent read FOnKeyPause write FOnKeyPause;
|
---|
546 | property OnMouseClick: TNotifyEvent read FOnMouseClick write FOnMouseClick;
|
---|
547 | property OnNeedData: TORNeedDataEvent read FOnNeedData write FOnNeedData;
|
---|
548 | property OnResize;
|
---|
549 | property OnSynonymCheck: TORSynonymCheckEvent read GetOnSynonymCheck write SetOnSynonymCheck;
|
---|
550 | property CharsNeedMatch: integer read FCharsNeedMatch write SetNumForMatch;
|
---|
551 | {UniqueAutoComplete Was added as a result of the following defects:
|
---|
552 | 7293 - PTM 85: Backspace and Dosage: Desired dosage does not populate if dosage is not in local dosage field
|
---|
553 | 7337 - PTM 160 Meds: #8 IMO - Simple - Change Order in which Error generated if "Enter" is hit instead of "OK"
|
---|
554 | 7278 - PTM 36 Meds: Select 40000 UNT/2ML and backspace to 4000 the dose selected remains 40000
|
---|
555 | 7284 - Inconsistencies of pulling in a dose from the Possible Dose File }
|
---|
556 | property UniqueAutoComplete: Boolean read FUniqueAutoComplete write SetUniqueAutoComplete default False;
|
---|
557 | end;
|
---|
558 |
|
---|
559 | TORAutoPanel = class(TPanel)
|
---|
560 | private
|
---|
561 | FSizes: TList;
|
---|
562 | procedure BuildSizes( Control: TWinControl);
|
---|
563 | procedure DoResize( Control: TWinControl; var CurrentIndex: Integer);
|
---|
564 | protected
|
---|
565 | procedure Loaded; override;
|
---|
566 | procedure Resize; override;
|
---|
567 | public
|
---|
568 | destructor Destroy; override;
|
---|
569 | end;
|
---|
570 |
|
---|
571 | TOROffsetLabel = class(TGraphicControl) // see TCustomLabel in the VCL
|
---|
572 | private
|
---|
573 | FHorzOffset: Integer; // offset from left of label in pixels
|
---|
574 | FVertOffset: Integer; // offset from top of label in pixels
|
---|
575 | FWordWrap: Boolean; // true if word wrap should occur
|
---|
576 | function GetTransparent: Boolean;
|
---|
577 | procedure AdjustSizeOfSelf;
|
---|
578 | procedure DoDrawText(var Rect: TRect; Flags: Word);
|
---|
579 | procedure SetHorzOffset(Value: Integer);
|
---|
580 | procedure SetVertOffset(Value: Integer);
|
---|
581 | procedure SetTransparent(Value: Boolean);
|
---|
582 | procedure SetWordWrap(Value: Boolean);
|
---|
583 | procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
|
---|
584 | procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
|
---|
585 | protected
|
---|
586 | procedure Paint; override;
|
---|
587 | public
|
---|
588 | constructor Create(AOwner: TComponent); override;
|
---|
589 | published
|
---|
590 | property Align;
|
---|
591 | property Caption;
|
---|
592 | property Color;
|
---|
593 | property Enabled;
|
---|
594 | property Font;
|
---|
595 | property HorzOffset: Integer read FHorzOffset write SetHorzOffset;
|
---|
596 | property ParentColor;
|
---|
597 | property ParentFont;
|
---|
598 | property ParentShowHint;
|
---|
599 | property PopupMenu;
|
---|
600 | property ShowHint;
|
---|
601 | property Transparent: Boolean read GetTransparent write SetTransparent;
|
---|
602 | property VertOffset: Integer read FVertOffset write SetVertOffset;
|
---|
603 | property Visible;
|
---|
604 | property WordWrap: Boolean read FWordWrap write SetWordWrap;
|
---|
605 | property OnClick;
|
---|
606 | property OnDblClick;
|
---|
607 | property OnDragDrop;
|
---|
608 | property OnDragOver;
|
---|
609 | property OnEndDrag;
|
---|
610 | property OnMouseDown;
|
---|
611 | property OnMouseMove;
|
---|
612 | property OnMouseUp;
|
---|
613 | property OnStartDrag;
|
---|
614 | end;
|
---|
615 |
|
---|
616 | TORAlignButton = class(TButton)
|
---|
617 | private
|
---|
618 | FAlignment: TAlignment;
|
---|
619 | FWordWrap: boolean;
|
---|
620 | FLayout: TTextLayout;
|
---|
621 | protected
|
---|
622 | procedure CreateParams(var Params: TCreateParams); override;
|
---|
623 | procedure SetAlignment(const Value: TAlignment);
|
---|
624 | procedure SetLayout(const Value: TTextLayout);
|
---|
625 | procedure SetWordWrap(const Value: boolean);
|
---|
626 | public
|
---|
627 | constructor Create(AOwner: TComponent); override;
|
---|
628 | published
|
---|
629 | property Align;
|
---|
630 | property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
|
---|
631 | property Layout: TTextLayout read FLayout write SetLayout default tlCenter;
|
---|
632 | property WordWrap: boolean read FWordWrap write SetWordWrap default FALSE;
|
---|
633 | end;
|
---|
634 |
|
---|
635 | { TORAlignBitBtn = class(TBitBtn)
|
---|
636 | published
|
---|
637 | property Align;
|
---|
638 | end;}
|
---|
639 |
|
---|
640 | TORAlignSpeedButton = class(TSpeedButton)
|
---|
641 | protected
|
---|
642 | procedure Paint; override;
|
---|
643 | public
|
---|
644 | property Canvas;
|
---|
645 | published
|
---|
646 | property Align;
|
---|
647 | property OnResize;
|
---|
648 | end;
|
---|
649 |
|
---|
650 | TORAlignEdit = class(TEdit) //Depricated -- Use TCaptionEdit instead
|
---|
651 | published
|
---|
652 | property Align;
|
---|
653 | end;
|
---|
654 |
|
---|
655 | TORDraggingEvent = procedure(Sender: TObject; Node: TTreeNode; var CanDrag: boolean) of object;
|
---|
656 |
|
---|
657 |
|
---|
658 | TCaptionTreeView = class(TTreeView, IVADynamicProperty)
|
---|
659 | private
|
---|
660 | procedure SetCaption(const Value: string);
|
---|
661 | function GetCaption: string;
|
---|
662 | protected
|
---|
663 | FCaptionComponent: TStaticText;
|
---|
664 | public
|
---|
665 | function SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
666 | function GetDynamicProperty(PropertyID: integer): string;
|
---|
667 | published
|
---|
668 | property Align;
|
---|
669 | property Caption: string read GetCaption write SetCaption;
|
---|
670 | end;
|
---|
671 |
|
---|
672 | TORTreeView = class;
|
---|
673 |
|
---|
674 | TORTreeNode = class(TTreeNode)
|
---|
675 | private
|
---|
676 | FTag: integer;
|
---|
677 | FStringData: string;
|
---|
678 | FCaption: string;
|
---|
679 | function GetParent: TORTreeNode;
|
---|
680 | procedure SetCaption(const Value: string);
|
---|
681 | protected
|
---|
682 | function GetText: string;
|
---|
683 | procedure SetText(const Value: string);
|
---|
684 | procedure UpdateText(const Value: string; UpdateData: boolean = TRUE);
|
---|
685 | function GetBold: boolean;
|
---|
686 | procedure SetBold(const Value: boolean);
|
---|
687 | procedure SetStringData(const Value: string);
|
---|
688 | function GetORTreeView: TORTreeView;
|
---|
689 | public
|
---|
690 | procedure SetPiece(PieceNum: Integer; const NewPiece: string);
|
---|
691 | procedure EnsureVisible;
|
---|
692 | property Bold: boolean read GetBold write SetBold;
|
---|
693 | property Tag: integer read FTag write FTag;
|
---|
694 | property StringData: string read FStringData write SetStringData;
|
---|
695 | property TreeView: TORTreeView read GetORTreeView;
|
---|
696 | property Text: string read GetText write SetText;
|
---|
697 | property Parent: TORTreeNode read GetParent;
|
---|
698 | property Caption: string read FCaption write SetCaption;
|
---|
699 | end;
|
---|
700 |
|
---|
701 | TNodeCaptioningEvent = procedure(Sender: TObject; var Caption: string) of object;
|
---|
702 |
|
---|
703 | TORTreeView = class(TCaptionTreeView)
|
---|
704 | private
|
---|
705 | FOnDragging: TORDraggingEvent;
|
---|
706 | FDelim: Char;
|
---|
707 | FPiece: integer;
|
---|
708 | FOnAddition: TTVExpandedEvent;
|
---|
709 | FShortNodeCaptions: boolean;
|
---|
710 | FOnNodeCaptioning: TNodeCaptioningEvent;
|
---|
711 | procedure SetShortNodeCaptions(const Value: boolean);
|
---|
712 | protected
|
---|
713 | procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
|
---|
714 | function CreateNode: TTreeNode; override;
|
---|
715 | function GetHorzScrollPos: integer;
|
---|
716 | procedure SetHorzScrollPos(Value: integer);
|
---|
717 | function GetVertScrollPos: integer;
|
---|
718 | procedure SetVertScrollPos(Value: integer);
|
---|
719 | procedure SetNodeDelim(const Value: Char);
|
---|
720 | procedure SetNodePiece(const Value: integer);
|
---|
721 | public
|
---|
722 | constructor Create(AOwner: TComponent); override;
|
---|
723 | function FindPieceNode(Value: string;
|
---|
724 | ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; overload;
|
---|
725 | function FindPieceNode(Value: string; APiece: integer;
|
---|
726 | ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; overload;
|
---|
727 | procedure RenameNodes;
|
---|
728 | function GetExpandedIDStr(APiece: integer; ParentDelim: char = #0): string;
|
---|
729 | procedure SetExpandedIDStr(APiece: integer; const Value: string); overload;
|
---|
730 | procedure SetExpandedIDStr(APiece: integer; ParentDelim: char;
|
---|
731 | const Value: string); overload;
|
---|
732 | function GetNodeID(Node: TORTreeNode; ParentDelim: Char = #0): string; overload;
|
---|
733 | function GetNodeID(Node: TORTreeNode; APiece: integer; ParentDelim: Char = #0): string; overload;
|
---|
734 | published
|
---|
735 | property Caption;
|
---|
736 | property NodeDelim: Char read FDelim write SetNodeDelim default '^';
|
---|
737 | property NodePiece: integer read FPiece write SetNodePiece;
|
---|
738 | property OnAddition: TTVExpandedEvent read FOnAddition write FOnAddition;
|
---|
739 | property OnDragging: TORDraggingEvent read FOnDragging write FOnDragging;
|
---|
740 | property HorzScrollPos: integer read GetHorzScrollPos write SetHorzScrollPos default 0;
|
---|
741 | property VertScrollPos: integer read GetVertScrollPos write SetVertScrollPos default 0;
|
---|
742 | property ShortNodeCaptions: boolean read FShortNodeCaptions write SetShortNodeCaptions default False;
|
---|
743 | property OnNodeCaptioning: TNodeCaptioningEvent read FOnNodeCaptioning write FOnNodeCaptioning;
|
---|
744 | end;
|
---|
745 |
|
---|
746 | TORCBImageIndexes = class(TComponent)
|
---|
747 | private
|
---|
748 | FImages: TCustomImageList;
|
---|
749 | FImageChangeLink: TChangeLink;
|
---|
750 | FCheckedEnabledIndex: integer;
|
---|
751 | FGrayedEnabledIndex: integer;
|
---|
752 | FUncheckedEnabledIndex: integer;
|
---|
753 | FCheckedDisabledIndex: integer;
|
---|
754 | FGrayedDisabledIndex: integer;
|
---|
755 | FUncheckedDisabledIndex: integer;
|
---|
756 | protected
|
---|
757 | procedure SetCheckedDisabledIndex(const Value: integer);
|
---|
758 | procedure SetCheckedEnabledIndex(const Value: integer);
|
---|
759 | procedure SetGrayedDisabledIndex(const Value: integer);
|
---|
760 | procedure SetGrayedEnabledIndex(const Value: integer);
|
---|
761 | procedure SetUncheckedDisabledIndex(const Value: integer);
|
---|
762 | procedure SetUncheckedEnabledIndex(const Value: integer);
|
---|
763 | procedure ImageListChanged(Sender: TObject);
|
---|
764 | procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
---|
765 | function IdxString: string;
|
---|
766 | procedure SetIdxString(Value: string);
|
---|
767 | procedure SetImages(const Value: TCustomImageList);
|
---|
768 | public
|
---|
769 | constructor Create(AOwner: TComponent); override;
|
---|
770 | destructor Destroy; override;
|
---|
771 | published
|
---|
772 | property CheckedEnabledIndex: integer read FCheckedEnabledIndex write SetCheckedEnabledIndex;
|
---|
773 | property CheckedDisabledIndex: integer read FCheckedDisabledIndex write SetCheckedDisabledIndex;
|
---|
774 | property GrayedEnabledIndex: integer read FGrayedEnabledIndex write SetGrayedEnabledIndex;
|
---|
775 | property GrayedDisabledIndex: integer read FGrayedDisabledIndex write SetGrayedDisabledIndex;
|
---|
776 | property UncheckedEnabledIndex: integer read FUncheckedEnabledIndex write SetUncheckedEnabledIndex;
|
---|
777 | property UncheckedDisabledIndex: integer read FUncheckedDisabledIndex write SetUncheckedDisabledIndex;
|
---|
778 | end;
|
---|
779 |
|
---|
780 | TGrayedStyle = (gsNormal, gsQuestionMark, gsBlueQuestionMark);
|
---|
781 |
|
---|
782 | TORCheckBox = class(TCheckBox, IORBlackColorModeCompatible)
|
---|
783 | private
|
---|
784 | FStringData: string;
|
---|
785 | FCanvas: TCanvas;
|
---|
786 | FGrayedToChecked: boolean;
|
---|
787 | FCustomImagesOwned: boolean;
|
---|
788 | FCustomImages: TORCBImageIndexes;
|
---|
789 | FGrayedStyle: TGrayedStyle;
|
---|
790 | FWordWrap: boolean;
|
---|
791 | FAutoSize: boolean;
|
---|
792 | FSingleLine: boolean;
|
---|
793 | FSizable: boolean;
|
---|
794 | FGroupIndex: integer;
|
---|
795 | FAllowAllUnchecked: boolean;
|
---|
796 | FRadioStyle: boolean;
|
---|
797 | FAssociate: TControl;
|
---|
798 | FFocusOnBox: boolean;
|
---|
799 | FBlackColorMode: boolean;
|
---|
800 | procedure SetFocusOnBox(value: boolean);
|
---|
801 | procedure CNMeasureItem (var Message: TWMMeasureItem); message CN_MEASUREITEM;
|
---|
802 | procedure CNDrawItem (var Message: TWMDrawItem); message CN_DRAWITEM;
|
---|
803 | procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
|
---|
804 | procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
|
---|
805 | procedure WMLButtonDblClk (var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
|
---|
806 | procedure WMSize (var Message: TWMSize); message WM_SIZE;
|
---|
807 | procedure BMSetCheck (var Message: TMessage); message BM_SETCHECK;
|
---|
808 | procedure BMGetCheck (var Message: TMessage); message BM_GETCHECK;
|
---|
809 | procedure BMGetState (var Message: TMessage); message BM_GETSTATE;
|
---|
810 | function GetImageList: TCustomImageList;
|
---|
811 | function GetImageIndexes: string;
|
---|
812 | procedure SetImageIndexes(const Value: string);
|
---|
813 | procedure SetImageList(const Value: TCustomImageList);
|
---|
814 | procedure SetWordWrap(const Value: boolean);
|
---|
815 | function GetCaption: TCaption;
|
---|
816 | procedure SetCaption(const Value: TCaption);
|
---|
817 | procedure SyncAllowAllUnchecked;
|
---|
818 | procedure SetAllowAllUnchecked(const Value: boolean);
|
---|
819 | procedure SetGroupIndex(const Value: integer);
|
---|
820 | procedure SetRadioStyle(const Value: boolean);
|
---|
821 | procedure SetAssociate(const Value: TControl);
|
---|
822 | protected
|
---|
823 | procedure SetAutoSize(Value: boolean); override;
|
---|
824 | procedure GetDrawData(CanvasHandle: HDC; var Bitmap: TBitmap;
|
---|
825 | var FocRect, Rect: TRect;
|
---|
826 | var DrawOptions: UINT;
|
---|
827 | var TempBitMap: boolean);
|
---|
828 | procedure DrawItem(const DrawItemStruct: TDrawItemStruct); dynamic;
|
---|
829 | procedure Toggle; override;
|
---|
830 | procedure CreateParams(var Params: TCreateParams); override;
|
---|
831 | procedure SetGrayedStyle(Value: TGrayedStyle);
|
---|
832 | constructor ListViewCreate(AOwner: TComponent; ACustomImages: TORCBImageIndexes);
|
---|
833 | procedure CreateCommon(AOwner: TComponent);
|
---|
834 | property CustomImages: TORCBImageIndexes read FCustomImages;
|
---|
835 | procedure SetParent(AParent: TWinControl); override;
|
---|
836 | procedure UpdateAssociate;
|
---|
837 | procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
---|
838 | public
|
---|
839 | constructor Create(AOwner: TComponent); override;
|
---|
840 | destructor Destroy; override;
|
---|
841 | procedure AutoAdjustSize;
|
---|
842 | procedure SetBlackColorMode(Value: boolean);
|
---|
843 | property SingleLine: boolean read FSingleLine;
|
---|
844 | property StringData: string read FStringData write FStringData;
|
---|
845 | published
|
---|
846 | property FocusOnBox: boolean read FFocusOnBox write SetFocusOnBox default false;
|
---|
847 | property GrayedStyle: TGrayedStyle read FGrayedStyle write SetGrayedStyle default gsNormal;
|
---|
848 | property GrayedToChecked: boolean read FGrayedToChecked write FGrayedToChecked default TRUE;
|
---|
849 | property ImageIndexes: string read GetImageIndexes write SetImageIndexes;
|
---|
850 | property ImageList: TCustomImageList read GetImageList write SetImageList;
|
---|
851 | property WordWrap: boolean read FWordWrap write SetWordWrap default FALSE;
|
---|
852 | property AutoSize: boolean read FAutoSize write SetAutoSize default FALSE;
|
---|
853 | property Caption: TCaption read GetCaption write SetCaption;
|
---|
854 | property AllowAllUnchecked: boolean read FAllowAllUnchecked write SetAllowAllUnchecked default TRUE;
|
---|
855 | property GroupIndex: integer read FGroupIndex write SetGroupIndex default 0;
|
---|
856 | property RadioStyle: boolean read FRadioStyle write SetRadioStyle default FALSE;
|
---|
857 | property Associate: TControl read FAssociate write SetAssociate;
|
---|
858 | property OnEnter;
|
---|
859 | property OnExit;
|
---|
860 | end;
|
---|
861 |
|
---|
862 | TORListView = class(TListView)
|
---|
863 | private
|
---|
864 | protected
|
---|
865 | procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
|
---|
866 | procedure LVMSetColumn(var Message: TMessage); message LVM_SETCOLUMN;
|
---|
867 | procedure LVMSetColumnWidth(var Message: TMessage); message LVM_SETCOLUMNWIDTH;
|
---|
868 | end;
|
---|
869 |
|
---|
870 | { TORPopupMenu and TORMenuItem are not available at design time, since they
|
---|
871 | would offer little value there. They are currently used for dynamic menu
|
---|
872 | creation }
|
---|
873 | TORPopupMenu = class(TPopupMenu)
|
---|
874 | private
|
---|
875 | FData: string;
|
---|
876 | public
|
---|
877 | property Data: string read FData write FData;
|
---|
878 | end;
|
---|
879 |
|
---|
880 | TORMenuItem = class(TMenuItem)
|
---|
881 | private
|
---|
882 | FData: string;
|
---|
883 | public
|
---|
884 | property Data: string read FData write FData;
|
---|
885 | end;
|
---|
886 |
|
---|
887 | (*
|
---|
888 | TORCalendar = class(TCalendar)
|
---|
889 | protected
|
---|
890 | procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
|
---|
891 | end;
|
---|
892 | *)
|
---|
893 |
|
---|
894 | TKeyClickPanel = class(TPanel)
|
---|
895 | protected
|
---|
896 | procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
---|
897 | end;
|
---|
898 |
|
---|
899 | TKeyClickRadioGroup = class(TRadioGroup)
|
---|
900 | protected
|
---|
901 | procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
---|
902 | procedure Click; override;
|
---|
903 | public
|
---|
904 | constructor Create(AOwner: TComponent); override;
|
---|
905 | end;
|
---|
906 |
|
---|
907 | TCaptionListBox = class(TListBox, IVADynamicProperty)
|
---|
908 | private
|
---|
909 | FHoverItemPos: integer;
|
---|
910 | FRightClickSelect: boolean; // When true, a right click selects teh item
|
---|
911 | FHintOnItem: boolean;
|
---|
912 | procedure SetCaption(const Value: string);
|
---|
913 | function GetCaption: string;
|
---|
914 | procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
|
---|
915 | procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
|
---|
916 | procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
|
---|
917 | procedure MoveFocusDown;
|
---|
918 | procedure MoveFocusUp;
|
---|
919 | protected
|
---|
920 | FCaptionComponent: TStaticText;
|
---|
921 | procedure DoEnter; override;
|
---|
922 | public
|
---|
923 | function SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
924 | function GetDynamicProperty(PropertyID: integer): string;
|
---|
925 | published
|
---|
926 | property RightClickSelect: boolean read FRightClickSelect write FRightClickSelect default FALSE;
|
---|
927 | property Caption: string read GetCaption write SetCaption;
|
---|
928 | //Make the ListBox's hint contain the contents of the listbox Item the mouse is currently over.
|
---|
929 | property HintOnItem: boolean read FHintOnItem write FHintOnItem default FALSE;
|
---|
930 | end;
|
---|
931 |
|
---|
932 | TCaptionCheckListBox = class(TCheckListBox, IVADynamicProperty)
|
---|
933 | private
|
---|
934 | procedure SetCaption(const Value: string);
|
---|
935 | function GetCaption: string;
|
---|
936 | protected
|
---|
937 | FCaptionComponent: TStaticText;
|
---|
938 | public
|
---|
939 | function SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
940 | function GetDynamicProperty(PropertyID: integer): string;
|
---|
941 | published
|
---|
942 | property Caption: string read GetCaption write SetCaption;
|
---|
943 | end;
|
---|
944 |
|
---|
945 | TCaptionMemo = class(TMemo, IVADynamicProperty)
|
---|
946 | private
|
---|
947 | procedure SetCaption(const Value: string);
|
---|
948 | function GetCaption: string;
|
---|
949 | protected
|
---|
950 | FCaptionComponent: TStaticText;
|
---|
951 | public
|
---|
952 | function SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
953 | function GetDynamicProperty(PropertyID: integer): string;
|
---|
954 | published
|
---|
955 | property Caption: string read GetCaption write SetCaption;
|
---|
956 | end;
|
---|
957 |
|
---|
958 | TCaptionEdit = class(TEdit, IVADynamicProperty)
|
---|
959 | private
|
---|
960 | procedure SetCaption(const Value: string);
|
---|
961 | function GetCaption: string;
|
---|
962 | protected
|
---|
963 | FCaptionComponent: TStaticText;
|
---|
964 | public
|
---|
965 | function SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
966 | function GetDynamicProperty(PropertyID: integer): string;
|
---|
967 | published
|
---|
968 | property Align;
|
---|
969 | property Caption: string read GetCaption write SetCaption;
|
---|
970 | end;
|
---|
971 |
|
---|
972 | TCaptionRichEdit = class(TRichEdit, IVADynamicProperty)
|
---|
973 | private
|
---|
974 | protected
|
---|
975 | FCaption: string;
|
---|
976 | public
|
---|
977 | function SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
978 | function GetDynamicProperty(PropertyID: integer): string;
|
---|
979 | published
|
---|
980 | property Align;
|
---|
981 | property Caption: string read FCaption write FCaption;
|
---|
982 | end;
|
---|
983 |
|
---|
984 | TCaptionComboBox = class(TComboBox, IVADynamicProperty)
|
---|
985 | private
|
---|
986 | procedure SetCaption(const Value: string);
|
---|
987 | function GetCaption: string;
|
---|
988 | protected
|
---|
989 | FCaptionComponent: TStaticText;
|
---|
990 | public
|
---|
991 | function SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
992 | function GetDynamicProperty(PropertyID: integer): string;
|
---|
993 | published
|
---|
994 | property Caption: string read GetCaption write SetCaption;
|
---|
995 | end;
|
---|
996 |
|
---|
997 | TCaptionListView = class(TListView, IVADynamicProperty)
|
---|
998 | public
|
---|
999 | function SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
1000 | function GetDynamicProperty(PropertyID: integer): string;
|
---|
1001 | published
|
---|
1002 | property Caption;
|
---|
1003 | end;
|
---|
1004 |
|
---|
1005 | TCaptionStringGrid = class(TStringGrid, IVADynamicProperty)
|
---|
1006 | private
|
---|
1007 | FJustToTab: boolean;
|
---|
1008 | FCaption: string;
|
---|
1009 | protected
|
---|
1010 | procedure KeyUp(var Key: Word; Shift: TShiftState); override;
|
---|
1011 | public
|
---|
1012 | procedure IndexToColRow( index: integer; var Col: integer; var Row: integer);
|
---|
1013 | function ColRowToIndex( Col: integer; Row: Integer): integer;
|
---|
1014 | function SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
1015 | function GetDynamicProperty(PropertyID: integer): string;
|
---|
1016 | published
|
---|
1017 | property Caption: string read FCaption write FCaption;
|
---|
1018 | property JustToTab: boolean read FJustToTab write FJustToTab default FALSE;
|
---|
1019 | end;
|
---|
1020 |
|
---|
1021 | function FontWidthPixel(FontHandle: THandle): Integer;
|
---|
1022 | function FontHeightPixel(FontHandle: THandle): Integer;
|
---|
1023 | function ItemTipKeyHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall;
|
---|
1024 |
|
---|
1025 | {I may have messed up my Windows.pas file, but mine defines NotifyWinEvent without a stdcall.}
|
---|
1026 | procedure GoodNotifyWinEvent(event: DWORD; hwnd: HWND; idObject, idChild: Longint); stdcall;
|
---|
1027 |
|
---|
1028 | function CalcShortName( LongName: string; PrevLongName: string): string;
|
---|
1029 |
|
---|
1030 | {Returns True if any one of 3 mouse buttons are down left, right, or middle}
|
---|
1031 | function IsAMouseButtonDown : boolean;
|
---|
1032 |
|
---|
1033 | implementation // ---------------------------------------------------------------------------
|
---|
1034 |
|
---|
1035 | {$R ORCTRLS}
|
---|
1036 |
|
---|
1037 | uses
|
---|
1038 | VAUtils;
|
---|
1039 |
|
---|
1040 | const
|
---|
1041 | ALPHA_DISTRIBUTION: array[0..100] of string[3] = ('',' ','ACE','ADG','ALA','AMI','ANA','ANT',
|
---|
1042 | 'ARE','ASU','AZO','BCP','BIC','BOO','BST','CAF','CAR','CD6','CHE','CHO','CMC','CON','CPD',
|
---|
1043 | 'CVI','DAA','DEF','DEP','DIA','DIH','DIP','DP ','EAR','EM ','EPI','ETH','F2G','FIB','FML',
|
---|
1044 | 'FUM','GEL','GLU','GPQ','HAL','HEM','HIS','HUN','HYL','IDS','IND','INT','ISO','KEX','LAN',
|
---|
1045 | 'LEV','LOY','MAG','MAX','MER','MET','MIC','MON','MUD','NAI','NEU','NIT','NUC','OMP','OTH',
|
---|
1046 | 'P42','PAR','PEN','PHA','PHO','PLA','POL','PRA','PRO','PSE','PYR','RAN','REP','RIB','SAA',
|
---|
1047 | 'SCL','SFL','SMO','SPO','STR','SUL','TAG','TET','THI','TOL','TRI','TRY','UNC','VAR','VIT',
|
---|
1048 | 'WRO','ZYM',#127#127#127);
|
---|
1049 |
|
---|
1050 | CBO_CYMARGIN = 8; // vertical whitespace in the edit portion of combobox
|
---|
1051 | CBO_CXBTN = 13; // width of drop down button in combobox
|
---|
1052 | CBO_CXFRAME = 5; // offset to account for frame around the edit part of combobox
|
---|
1053 |
|
---|
1054 | NOREDRAW = 0; // suspend screen updates
|
---|
1055 | DOREDRAW = 1; // allow screen updates
|
---|
1056 |
|
---|
1057 | KEY_TIMER_DELAY = 500; // 500 ms delay after key up before OnKeyPause called
|
---|
1058 | KEY_TIMER_ID = 5800; // arbitrary, use high number in case TListBox uses timers
|
---|
1059 |
|
---|
1060 | { use high word to pass positioning flags since listbox is limited to 32767 items }
|
---|
1061 | //SFI_TOP = $80000000; // top of listbox (decimal value: -2147483648)
|
---|
1062 | //SFI_END = $90000000; // end of listbox (decimal value: -1879048192)
|
---|
1063 | SFI_TOP = -2147483646; // top of listbox (hex value: $80000001)
|
---|
1064 | SFI_END = -1879048192; // end of listbox (hex value: $90000000)
|
---|
1065 |
|
---|
1066 | CheckWidth = 15; // CheckBox Width space to reserve for TORListBox
|
---|
1067 | CheckComboBtnHeight = 21;
|
---|
1068 | MaxNeedDataLen = 64;
|
---|
1069 |
|
---|
1070 | type
|
---|
1071 | TItemTip = class(TCustomControl)
|
---|
1072 | private
|
---|
1073 | FShowing: Boolean; // true when itemtip is visible
|
---|
1074 | FListBox: TORListBox; // current listbox displaying itemtips
|
---|
1075 | FListItem: integer;
|
---|
1076 | FPoint: TPoint;
|
---|
1077 | FSelected: boolean;
|
---|
1078 | FTabs: array[0..MAX_TABS] of Integer; // Holds the pixel offsets for tabs
|
---|
1079 | procedure GetTabSettings;
|
---|
1080 | protected
|
---|
1081 | constructor Create(AOwner: TComponent); override;
|
---|
1082 | destructor Destroy; override;
|
---|
1083 | procedure CreateParams(var Params: TCreateParams); override;
|
---|
1084 | procedure Paint; override;
|
---|
1085 | procedure Hide;
|
---|
1086 | procedure UpdateText(CatchMouse: Boolean);
|
---|
1087 | procedure Show(AListBox: TORListBox; AnItem: Integer; APoint: TPoint; CatchMouse: Boolean);
|
---|
1088 | end;
|
---|
1089 |
|
---|
1090 | TSizeRatio = class // relative sizes and positions for resizing
|
---|
1091 | CLeft: Extended;
|
---|
1092 | CTop: Extended;
|
---|
1093 | CWidth: Extended;
|
---|
1094 | CHeight: Extended;
|
---|
1095 | constructor Create(ALeft, ATop, AWidth, AHeight: Extended);
|
---|
1096 | end;
|
---|
1097 |
|
---|
1098 | var
|
---|
1099 | uKeyHookHandle: HHOOK; // handle to capture key events & hide ItemTip window
|
---|
1100 | uItemTip: TItemTip; // ItemTip window
|
---|
1101 | uItemTipCount: Integer; // number of ItemTip clients
|
---|
1102 | uNewStyle: Boolean; // True if using Windows 95 interface
|
---|
1103 |
|
---|
1104 | { General functions and procedures --------------------------------------------------------- }
|
---|
1105 |
|
---|
1106 | function ClientWidthOfList(AListBox: TORListBox): Integer;
|
---|
1107 | begin
|
---|
1108 | with AListBox do
|
---|
1109 | begin
|
---|
1110 | Result := Width;
|
---|
1111 | if BorderStyle = bsSingle then
|
---|
1112 | begin
|
---|
1113 | Dec(Result, 1);
|
---|
1114 | if Ctl3D then Dec(Result, 1);
|
---|
1115 | end;
|
---|
1116 | end;
|
---|
1117 | Dec(Result, GetSystemMetrics(SM_CXVSCROLL));
|
---|
1118 | end;
|
---|
1119 |
|
---|
1120 | function FontWidthPixel(FontHandle: THandle): Integer;
|
---|
1121 | { return in pixels the average character width of the font passed in FontHandle }
|
---|
1122 | var
|
---|
1123 | DC: HDC;
|
---|
1124 | SaveFont: HFont;
|
---|
1125 | Extent: TSize;
|
---|
1126 | begin
|
---|
1127 | DC := GetDC(0);
|
---|
1128 | try
|
---|
1129 | SaveFont := SelectObject(DC, FontHandle);
|
---|
1130 | try
|
---|
1131 | GetTextExtentPoint32(DC, 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz', 52, Extent);
|
---|
1132 | Result := Trunc((Extent.cx / 26 + 1) / 2); // Round() doesn't line up with dialog units
|
---|
1133 | finally
|
---|
1134 | SelectObject(DC, SaveFont);
|
---|
1135 | end;
|
---|
1136 | finally
|
---|
1137 | ReleaseDC(0, DC);
|
---|
1138 | end;
|
---|
1139 | end;
|
---|
1140 |
|
---|
1141 | function FontHeightPixel(FontHandle: THandle): Integer;
|
---|
1142 | { return in pixels the height of the font passed in FontHandle }
|
---|
1143 | var
|
---|
1144 | DC: HDC;
|
---|
1145 | SaveFont: HFont;
|
---|
1146 | FontMetrics: TTextMetric;
|
---|
1147 | begin
|
---|
1148 | DC := GetDC(0);
|
---|
1149 | SaveFont := SelectObject(DC, FontHandle);
|
---|
1150 | GetTextMetrics(DC, FontMetrics);
|
---|
1151 | Result := FontMetrics.tmHeight;
|
---|
1152 | SelectObject(DC, SaveFont);
|
---|
1153 | ReleaseDC(0, DC);
|
---|
1154 | end;
|
---|
1155 |
|
---|
1156 | function HigherOf(i, j: Integer): Integer;
|
---|
1157 | { returns the greater of two integers }
|
---|
1158 | begin
|
---|
1159 | Result := i;
|
---|
1160 | if j > i then Result := j;
|
---|
1161 | end;
|
---|
1162 |
|
---|
1163 | function LowerOf(i, j: Integer): Integer;
|
---|
1164 | { returns the lesser of two integers }
|
---|
1165 | begin
|
---|
1166 | Result := i;
|
---|
1167 | if j < i then Result := j;
|
---|
1168 | end;
|
---|
1169 |
|
---|
1170 | function Piece(const S: string; Delim: char; PieceNum: Integer): string;
|
---|
1171 | { returns the Nth piece (PieceNum) of a string delimited by Delim }
|
---|
1172 | var
|
---|
1173 | i: Integer;
|
---|
1174 | Strt, Next: PChar;
|
---|
1175 | begin
|
---|
1176 | i := 1;
|
---|
1177 | Strt := PChar(S);
|
---|
1178 | Next := StrScan(Strt, Delim);
|
---|
1179 | while (i < PieceNum) and (Next <> nil) do
|
---|
1180 | begin
|
---|
1181 | Inc(i);
|
---|
1182 | Strt := Next + 1;
|
---|
1183 | Next := StrScan(Strt, Delim);
|
---|
1184 | end;
|
---|
1185 | if Next = nil then Next := StrEnd(Strt);
|
---|
1186 | if i < PieceNum then Result := '' else SetString(Result, Strt, Next - Strt);
|
---|
1187 | end;
|
---|
1188 |
|
---|
1189 | procedure SetPiece(var x: string; Delim: Char; PieceNum: Integer; const NewPiece: string);
|
---|
1190 | { sets the Nth piece (PieceNum) of a string to NewPiece, adding delimiters as necessary }
|
---|
1191 | var
|
---|
1192 | i: Integer;
|
---|
1193 | Strt, Next: PChar;
|
---|
1194 | begin
|
---|
1195 | i := 1;
|
---|
1196 | Strt := PChar(x);
|
---|
1197 | Next := StrScan(Strt, Delim);
|
---|
1198 | while (i < PieceNum) and (Next <> nil) do
|
---|
1199 | begin
|
---|
1200 | Inc(i);
|
---|
1201 | Strt := Next + 1;
|
---|
1202 | Next := StrScan(Strt, Delim);
|
---|
1203 | end;
|
---|
1204 | if Next = nil then Next := StrEnd(Strt);
|
---|
1205 | if i < PieceNum
|
---|
1206 | then x := x + StringOfChar(Delim, PieceNum - i) + NewPiece
|
---|
1207 | else x := Copy(x, 1, Strt - PChar(x)) + NewPiece + StrPas(Next);
|
---|
1208 | end;
|
---|
1209 |
|
---|
1210 | function IntArrayToString(const IntArray: array of Integer): string;
|
---|
1211 | { converts an array of integers to a comma delimited string, 0 element assumed to be count }
|
---|
1212 | var
|
---|
1213 | i: Integer;
|
---|
1214 | begin
|
---|
1215 | Result := '';
|
---|
1216 | for i := 1 to IntArray[0] do Result := Result + IntToStr(IntArray[i]) + ',';
|
---|
1217 | if Length(Result) > 0 then Delete(Result, Length(Result), 1);
|
---|
1218 | end;
|
---|
1219 |
|
---|
1220 | procedure StringToIntArray(AString: string; var IntArray: array of Integer; AllowNeg: boolean = FALSE);
|
---|
1221 | { converts a string to an array of positive integers, count is kept in 0 element }
|
---|
1222 | var
|
---|
1223 | ANum: Integer;
|
---|
1224 | APiece: string;
|
---|
1225 | begin
|
---|
1226 | FillChar(IntArray, SizeOf(IntArray), 0);
|
---|
1227 | repeat
|
---|
1228 | if Pos(',', AString) > 0 then
|
---|
1229 | begin
|
---|
1230 | APiece := Copy(AString, 1, Pos(',', AString) - 1);
|
---|
1231 | Delete(AString, 1, Pos(',', AString));
|
---|
1232 | end else
|
---|
1233 | begin
|
---|
1234 | APiece := AString;
|
---|
1235 | AString := EmptyStr;
|
---|
1236 | end;
|
---|
1237 | ANum := StrToIntDef(Trim(APiece), 0);
|
---|
1238 | if(ANum > 0) or (AllowNeg and (ANum < 0)) then
|
---|
1239 | begin
|
---|
1240 | Inc(IntArray[0]);
|
---|
1241 | IntArray[IntArray[0]] := ANum;
|
---|
1242 | end;
|
---|
1243 | until (Length(AString) = 0) or (IntArray[0] = High(IntArray));
|
---|
1244 | end;
|
---|
1245 |
|
---|
1246 | function StringBetween(const x, First, Last: string): Boolean;
|
---|
1247 | { returns true if x collates between the strings First and Last, not case sensitive }
|
---|
1248 | begin
|
---|
1249 | Result := True;
|
---|
1250 | if (CompareText(x, First) < 0) or (CompareText(x, Last) > 0) then Result := False;
|
---|
1251 | end;
|
---|
1252 |
|
---|
1253 | { ItemTip callback ------------------------------------------------------------------------- }
|
---|
1254 |
|
---|
1255 | function ItemTipKeyHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
|
---|
1256 | { callback used to hide the item tip window whenever a key is pressed }
|
---|
1257 | begin
|
---|
1258 | if lParam shr 31 = 0 then uItemTip.Hide; // hide only on key down
|
---|
1259 | Result := CallNextHookEx(uKeyHookHandle, Code, wParam, lParam);
|
---|
1260 | end;
|
---|
1261 |
|
---|
1262 | { TItemTip --------------------------------------------------------------------------------- }
|
---|
1263 |
|
---|
1264 | procedure AddItemTipRef; // kcm
|
---|
1265 | begin
|
---|
1266 | if uItemTipCount = 0 then uItemTip := TItemTip.Create(Application); // all listboxes share a single ItemTip window
|
---|
1267 | Inc(uItemTipCount);
|
---|
1268 | end;
|
---|
1269 |
|
---|
1270 | procedure RemoveItemTipRef; // kcm
|
---|
1271 | begin
|
---|
1272 | Dec(uItemTipCount);
|
---|
1273 | if (uItemTipCount = 0) and (uItemTip <> nil) then uItemTip.Free;
|
---|
1274 | end;
|
---|
1275 |
|
---|
1276 | constructor TItemTip.Create(AOwner: TComponent);
|
---|
1277 | { the windows hook allows the item tip window to be hidden whenever a key is pressed }
|
---|
1278 | begin
|
---|
1279 | inherited Create(AOwner);
|
---|
1280 | uKeyHookHandle := SetWindowsHookEx(WH_KEYBOARD, ItemTipKeyHook, 0, GetCurrentThreadID);
|
---|
1281 | end;
|
---|
1282 |
|
---|
1283 | destructor TItemTip.Destroy;
|
---|
1284 | { disconnects the windows hook (callback) for keyboard events }
|
---|
1285 | begin
|
---|
1286 | UnhookWindowsHookEx(uKeyHookHandle);
|
---|
1287 | inherited Destroy;
|
---|
1288 | uItemTip := nil;
|
---|
1289 | end;
|
---|
1290 |
|
---|
1291 | procedure TItemTip.CreateParams(var Params: TCreateParams);
|
---|
1292 | { makes the window so that is can be viewed but not activated (can't get events) }
|
---|
1293 | begin
|
---|
1294 | inherited CreateParams(Params);
|
---|
1295 | Params.Style := WS_POPUP or WS_DISABLED or WS_BORDER;
|
---|
1296 | if uNewStyle then Params.ExStyle := WS_EX_TOOLWINDOW;
|
---|
1297 | Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST; // - test this!!
|
---|
1298 | end;
|
---|
1299 |
|
---|
1300 | procedure TItemTip.Paint;
|
---|
1301 | { displays the caption property for the window within the window }
|
---|
1302 | var
|
---|
1303 | AString: string;
|
---|
1304 | y: integer;
|
---|
1305 |
|
---|
1306 | begin
|
---|
1307 | AString := Caption;
|
---|
1308 | with Canvas do
|
---|
1309 | begin
|
---|
1310 | SetBkMode(Handle, TRANSPARENT);
|
---|
1311 | FillRect(ClientRect);
|
---|
1312 | y := ((ClientRect.Bottom - ClientRect.Top) - FontHeightPixel(Canvas.Font.Handle)) div 2;
|
---|
1313 | //TextOut(ClientRect.Left + 1, ClientRect.Top - 1, AString);
|
---|
1314 | // WARNING - Do NOT change the X pos or the tab starting pos - this will cause a missmatch
|
---|
1315 | // between the hint window and what the control displayes
|
---|
1316 | TabbedTextOut(Handle, 0, y, PChar(AString), Length(AString), MAX_TABS+1, FTabs[0], 0);
|
---|
1317 | end;
|
---|
1318 | end;
|
---|
1319 |
|
---|
1320 | procedure TItemTip.Hide;
|
---|
1321 | { hides the tip window and makes sure the listbox isn't still capturing the mouse }
|
---|
1322 | begin
|
---|
1323 | if FShowing then
|
---|
1324 | begin
|
---|
1325 | { The listbox should retain mousecapture if the left mouse button is still down or it
|
---|
1326 | is the dropdown list for a combobox. Otherwise, click events don't get triggered. }
|
---|
1327 | with FListBox do if not (csLButtonDown in ControlState) and (FParentCombo = nil)
|
---|
1328 | then MouseCapture := False;
|
---|
1329 | ShowWindow(Handle, SW_HIDE);
|
---|
1330 | FShowing := False;
|
---|
1331 | end;
|
---|
1332 | end;
|
---|
1333 |
|
---|
1334 | procedure TItemTip.GetTabSettings;
|
---|
1335 | var
|
---|
1336 | DX, X, i, count: integer;
|
---|
1337 |
|
---|
1338 | begin
|
---|
1339 | Count := FListBox.FTabPix[0];
|
---|
1340 | FTabs[0] := 1; // Set first tab stop to location 1 for display purposes
|
---|
1341 | if(Count = 1) then
|
---|
1342 | begin
|
---|
1343 | DX := FListBox.FTabPix[1];
|
---|
1344 | X := (DX * 2) - 1;
|
---|
1345 | end
|
---|
1346 | else
|
---|
1347 | begin
|
---|
1348 | DX := FontWidthPixel(FListBox.Font.Handle) * 8; // windows tab default is 8 chars
|
---|
1349 | X := FListBox.FTabPix[Count];
|
---|
1350 | X := Trunc(X / DX) + 1;
|
---|
1351 | X := (X * DX) - 1; // get the next tab position after that which is specified
|
---|
1352 | end;
|
---|
1353 | for i := 1 to MAX_TABS do
|
---|
1354 | begin
|
---|
1355 | if(i <= Count) then
|
---|
1356 | FTabs[i] := FListBox.FTabPix[i] - 1
|
---|
1357 | else
|
---|
1358 | begin
|
---|
1359 | FTabs[i] := X;
|
---|
1360 | inc(X, DX);
|
---|
1361 | end;
|
---|
1362 | end;
|
---|
1363 | end;
|
---|
1364 |
|
---|
1365 | procedure TItemTip.UpdateText(CatchMouse: Boolean);
|
---|
1366 | var
|
---|
1367 | AWidth, ListClientWidth, X: Integer;
|
---|
1368 | sr: TRect;
|
---|
1369 |
|
---|
1370 | begin
|
---|
1371 | Cursor := FListBox.Cursor;
|
---|
1372 | Canvas.Font := FListBox.Font;
|
---|
1373 | if FSelected then
|
---|
1374 | begin
|
---|
1375 | Canvas.Brush.Color := clHighlight;
|
---|
1376 | Canvas.Font.Color := clHighlightText;
|
---|
1377 | end else // the item is not selected
|
---|
1378 | begin
|
---|
1379 | Canvas.Brush.Color := FListBox.ItemTipColor;
|
---|
1380 | Canvas.Font.Color := clWindowText;
|
---|
1381 | end;
|
---|
1382 | Caption := #9 + FListBox.DisplayText[FListItem];
|
---|
1383 | if Copy(Caption, 1, 2) = '__' then Caption := ' '; // so separators don't extend past window
|
---|
1384 |
|
---|
1385 | GetTabSettings;
|
---|
1386 |
|
---|
1387 | AWidth := LOWORD(GetTabbedTextExtent(Canvas.Handle, PChar(Caption), Length(Caption),
|
---|
1388 | MAX_TABS+1, FTabs[0]));
|
---|
1389 | // inherent scrollbar may not always be visible in a long list
|
---|
1390 | if FListBox.LongList
|
---|
1391 | then ListClientWidth := ClientWidthOfList(FListBox)
|
---|
1392 | else ListClientWidth := FListBox.ClientWidth;
|
---|
1393 | X := FPoint.X;
|
---|
1394 | if(FListBox.FCheckBoxes) then
|
---|
1395 | begin
|
---|
1396 | dec(ListClientWidth, CheckWidth);
|
---|
1397 | inc(X, CheckWidth);
|
---|
1398 | end;
|
---|
1399 | if AWidth > ListClientWidth then
|
---|
1400 | Inc(AWidth, 4)
|
---|
1401 | else
|
---|
1402 | AWidth := ListClientWidth;
|
---|
1403 | if SystemParametersInfo(SPI_GETWORKAREA, 0, @sr, 0) then
|
---|
1404 | begin
|
---|
1405 | if AWidth < (sr.Right - sr.Left) then
|
---|
1406 | begin
|
---|
1407 | if (X + AWidth) > sr.Right then
|
---|
1408 | X := sr.Right - AWidth;
|
---|
1409 | end
|
---|
1410 | else
|
---|
1411 | X := sr.Left;
|
---|
1412 | end;
|
---|
1413 | FShowing := True;
|
---|
1414 | if (GetCaptureControl = nil) and CatchMouse then FListBox.MouseCapture := True;
|
---|
1415 | SetWindowPos(Handle, HWND_TOP, X, FPoint.Y, AWidth, FListBox.ItemHeight,
|
---|
1416 | SWP_SHOWWINDOW or SWP_NOACTIVATE);
|
---|
1417 | Invalidate;
|
---|
1418 | end;
|
---|
1419 |
|
---|
1420 | procedure TItemTip.Show(AListBox: TORListBox; AnItem: Integer; APoint: TPoint;
|
---|
1421 | CatchMouse: Boolean);
|
---|
1422 | { sets the canvas properties and window size and text depending on the item in the listbox }
|
---|
1423 | begin
|
---|
1424 | if not AListBox.Visible then Exit; // added to support DropDown lists
|
---|
1425 | FListBox := AListBox;
|
---|
1426 | FListItem := AnItem;
|
---|
1427 | FPoint := APoint;
|
---|
1428 | FSelected := (FListBox.Perform(LB_GETSEL, FListItem, 0) > 0);
|
---|
1429 | UpdateText(CatchMouse);
|
---|
1430 | end;
|
---|
1431 |
|
---|
1432 | type
|
---|
1433 | TORCBImgIdx = (iiUnchecked, iiChecked, iiGrayed, iiQMark, iiBlueQMark,
|
---|
1434 | iiDisUnchecked, iiDisChecked, iiDisGrayed, iiDisQMark,
|
---|
1435 | iiFlatUnChecked, iiFlatChecked, iiFlatGrayed,
|
---|
1436 | iiRadioUnchecked, iiRadioChecked, iiRadioDisUnchecked, iiRadioDisChecked);
|
---|
1437 |
|
---|
1438 | const
|
---|
1439 | CheckBoxImageResNames: array[TORCBImgIdx] of PChar = (
|
---|
1440 | 'ORCB_UNCHECKED', 'ORCB_CHECKED', 'ORCB_GRAYED', 'ORCB_QUESTIONMARK',
|
---|
1441 | 'ORCB_BLUEQUESTIONMARK', 'ORCB_DISABLED_UNCHECKED', 'ORCB_DISABLED_CHECKED',
|
---|
1442 | 'ORCB_DISABLED_GRAYED', 'ORCB_DISABLED_QUESTIONMARK',
|
---|
1443 | 'ORLB_FLAT_UNCHECKED', 'ORLB_FLAT_CHECKED', 'ORLB_FLAT_GRAYED',
|
---|
1444 | 'ORCB_RADIO_UNCHECKED', 'ORCB_RADIO_CHECKED',
|
---|
1445 | 'ORCB_RADIO_DISABLED_UNCHECKED', 'ORCB_RADIO_DISABLED_CHECKED');
|
---|
1446 |
|
---|
1447 | BlackCheckBoxImageResNames: array[TORCBImgIdx] of PChar = (
|
---|
1448 | 'BLACK_ORLB_FLAT_UNCHECKED', 'BLACK_ORLB_FLAT_CHECKED', 'BLACK_ORLB_FLAT_GRAYED',
|
---|
1449 | 'BLACK_ORCB_QUESTIONMARK', 'BLACK_ORCB_BLUEQUESTIONMARK',
|
---|
1450 | 'BLACK_ORCB_DISABLED_UNCHECKED', 'BLACK_ORCB_DISABLED_CHECKED',
|
---|
1451 | 'BLACK_ORCB_DISABLED_GRAYED', 'BLACK_ORCB_DISABLED_QUESTIONMARK',
|
---|
1452 | 'BLACK_ORLB_FLAT_UNCHECKED', 'BLACK_ORLB_FLAT_CHECKED', 'BLACK_ORLB_FLAT_GRAYED',
|
---|
1453 | 'BLACK_ORCB_RADIO_UNCHECKED', 'BLACK_ORCB_RADIO_CHECKED',
|
---|
1454 | 'BLACK_ORCB_RADIO_DISABLED_UNCHECKED', 'BLACK_ORCB_RADIO_DISABLED_CHECKED');
|
---|
1455 |
|
---|
1456 | var
|
---|
1457 | ORCBImages: array[TORCBImgIdx, Boolean] of TBitMap;
|
---|
1458 |
|
---|
1459 | function GetORCBBitmap(Idx: TORCBImgIdx; BlackMode: boolean): TBitmap;
|
---|
1460 | var
|
---|
1461 | ResName: string;
|
---|
1462 | begin
|
---|
1463 | if(not assigned(ORCBImages[Idx, BlackMode])) then
|
---|
1464 | begin
|
---|
1465 | ORCBImages[Idx, BlackMode] := TBitMap.Create;
|
---|
1466 | if BlackMode then
|
---|
1467 | ResName := BlackCheckBoxImageResNames[Idx]
|
---|
1468 | else
|
---|
1469 | ResName := CheckBoxImageResNames[Idx];
|
---|
1470 | ORCBImages[Idx, BlackMode].LoadFromResourceName(HInstance, ResName);
|
---|
1471 | end;
|
---|
1472 | Result := ORCBImages[Idx, BlackMode];
|
---|
1473 | end;
|
---|
1474 |
|
---|
1475 | procedure DestroyORCBBitmaps; far;
|
---|
1476 | var
|
---|
1477 | i: TORCBImgIdx;
|
---|
1478 | mode: boolean;
|
---|
1479 |
|
---|
1480 | begin
|
---|
1481 | for i := low(TORCBImgIdx) to high(TORCBImgIdx) do
|
---|
1482 | begin
|
---|
1483 | for Mode := false to true do
|
---|
1484 | begin
|
---|
1485 | if(assigned(ORCBImages[i, Mode])) then
|
---|
1486 | ORCBImages[i, Mode].Free;
|
---|
1487 | end;
|
---|
1488 | end;
|
---|
1489 | end;
|
---|
1490 |
|
---|
1491 | { TORStrings }
|
---|
1492 |
|
---|
1493 | function TORStrings.Add(const S: string): integer;
|
---|
1494 | var
|
---|
1495 | RealVerification: Boolean;
|
---|
1496 | begin
|
---|
1497 | RealVerification := Verification;
|
---|
1498 | Verification := False; //Disable verification while lists are not matched
|
---|
1499 | result := FPlainText.Add(Translator(S));
|
---|
1500 | Verification := RealVerification;
|
---|
1501 | MList.Insert(result, S); //Don't need to here because MList never gets custom handlers
|
---|
1502 | end;
|
---|
1503 |
|
---|
1504 | procedure TORStrings.Clear;
|
---|
1505 | var
|
---|
1506 | RealVerification: Boolean;
|
---|
1507 | begin
|
---|
1508 | Verify;
|
---|
1509 | MList.Clear;
|
---|
1510 | RealVerification := Verification;
|
---|
1511 | Verification := False;
|
---|
1512 | FPlainText.Clear;
|
---|
1513 | Verification := RealVerification;
|
---|
1514 | end;
|
---|
1515 |
|
---|
1516 | constructor TORStrings.Create(PlainText: TStrings; Translator: TTranslator);
|
---|
1517 | begin
|
---|
1518 | MList := TStringList.Create;
|
---|
1519 | FPlainText := PlainText;
|
---|
1520 | FTranslator := Translator;
|
---|
1521 | FVerification := False;
|
---|
1522 | end;
|
---|
1523 |
|
---|
1524 | procedure TORStrings.Delete(index: integer);
|
---|
1525 | var
|
---|
1526 | RealVerification: Boolean;
|
---|
1527 | begin
|
---|
1528 | Verify;
|
---|
1529 | MList.Delete(index);
|
---|
1530 | RealVerification := Verification;
|
---|
1531 | Verification := False;
|
---|
1532 | FPlainText.Delete(index);
|
---|
1533 | Verification := RealVerification;
|
---|
1534 | end;
|
---|
1535 |
|
---|
1536 | destructor TORStrings.Destroy;
|
---|
1537 | begin
|
---|
1538 | MList.Free;
|
---|
1539 | inherited;
|
---|
1540 | end;
|
---|
1541 |
|
---|
1542 | function TORStrings.Get(index: integer): string;
|
---|
1543 | begin
|
---|
1544 | Verify;
|
---|
1545 | result := MList[index];
|
---|
1546 | end;
|
---|
1547 |
|
---|
1548 | function TORStrings.GetCount: integer;
|
---|
1549 | begin
|
---|
1550 | Verify;
|
---|
1551 | result := MList.Count;
|
---|
1552 | end;
|
---|
1553 |
|
---|
1554 | function TORStrings.GetObject(index: integer): TObject;
|
---|
1555 | begin
|
---|
1556 | Verify;
|
---|
1557 | result := FPlainText.Objects[index];
|
---|
1558 | end;
|
---|
1559 |
|
---|
1560 | function TORStrings.IndexOf(const S: string): Integer;
|
---|
1561 | begin
|
---|
1562 | Verify;
|
---|
1563 | Result := FPlainText.IndexOf(S);
|
---|
1564 | end;
|
---|
1565 |
|
---|
1566 | procedure TORStrings.Insert(Index: Integer; const S: string);
|
---|
1567 | var
|
---|
1568 | RealVerification: Boolean;
|
---|
1569 | begin
|
---|
1570 | Verify;
|
---|
1571 | MList.Insert(index, S);
|
---|
1572 | RealVerification := Verification;
|
---|
1573 | Verification := False;
|
---|
1574 | FPlainText.Insert(index, Translator(S));
|
---|
1575 | Verification := RealVerification;
|
---|
1576 | end;
|
---|
1577 |
|
---|
1578 |
|
---|
1579 | procedure TORStrings.Put(Index: Integer; const S: string);
|
---|
1580 | var
|
---|
1581 | RealVerification: Boolean;
|
---|
1582 | begin //If this method weren't overridden, the listbox would forget which item was selected.
|
---|
1583 | MList[Index] := S;
|
---|
1584 | RealVerification := Verification;
|
---|
1585 | Verification := False; //Disable verification while lists are not matched
|
---|
1586 | FPlainText[Index] := Translator(S);
|
---|
1587 | Verification := RealVerification;
|
---|
1588 | end;
|
---|
1589 |
|
---|
1590 | procedure TORStrings.PutObject(index: integer; Value: TObject);
|
---|
1591 | begin
|
---|
1592 | FPlainText.Objects[index] := Value;
|
---|
1593 | end;
|
---|
1594 |
|
---|
1595 | procedure TORStrings.SetUpdateState(Value: boolean);
|
---|
1596 | begin
|
---|
1597 | if Value then
|
---|
1598 | FPlainText.BeginUpdate
|
---|
1599 | else
|
---|
1600 | FPlainText.EndUpdate;
|
---|
1601 | end;
|
---|
1602 |
|
---|
1603 | procedure TORStrings.Verify;
|
---|
1604 | var
|
---|
1605 | Errors: TStringList;
|
---|
1606 | i: integer;
|
---|
1607 | M: string;
|
---|
1608 | Plain: string;
|
---|
1609 | TotalCount: integer;
|
---|
1610 | begin
|
---|
1611 | if Verification then begin
|
---|
1612 | if not Assigned(FPlainText) then
|
---|
1613 | raise Exception.Create( 'ORStrings is missing PlainText property.');
|
---|
1614 | if not Assigned(FTranslator) then
|
---|
1615 | raise Exception.Create( 'ORStrings is missing Translator property.');
|
---|
1616 | Errors := TStringList.Create;
|
---|
1617 | try
|
---|
1618 | TotalCount := MList.Count;
|
---|
1619 | if MList.Count <> PlainText.Count then begin
|
---|
1620 | Errors.Add('M string count:'+IntToStr(MList.Count));
|
---|
1621 | Errors.Add('Plain string count:'+IntToStr(PlainText.Count));
|
---|
1622 | if PlainText.Count > TotalCount then
|
---|
1623 | TotalCount := PlainText.Count;
|
---|
1624 | end;
|
---|
1625 | for i := 0 to TotalCount - 1 do begin
|
---|
1626 | if i >= MList.Count then
|
---|
1627 | Errors.Add('PlainText['+IntToStr(i)+']: '+PlainText[i])
|
---|
1628 | else if i >= PlainText.Count then
|
---|
1629 | Errors.Add('ORStrings['+IntToStr(i)+']: '+Translator(MList[i]))
|
---|
1630 | else begin
|
---|
1631 | M := Translator(MList[i]);
|
---|
1632 | Plain := PlainText[i];
|
---|
1633 | if M <> Plain then begin
|
---|
1634 | if UpperCase(M) = UpperCase(Plain) then //Listboxes don't always sort cases right, so we give them a little help here.
|
---|
1635 | begin
|
---|
1636 | PlainText[i] := M;
|
---|
1637 | end
|
---|
1638 | else
|
---|
1639 | begin
|
---|
1640 | Errors.Add('PlainText['+IntToStr(i)+']: '+Plain);
|
---|
1641 | Errors.Add('ORStrings['+IntToStr(i)+']: '+M);
|
---|
1642 | end;
|
---|
1643 | end;
|
---|
1644 | end;
|
---|
1645 | end;
|
---|
1646 | if Errors.Count > 0 then begin
|
---|
1647 | Errors.Insert( 0, 'OR strings are out of sync with plain text strings :');
|
---|
1648 | raise Exception.Create( Errors.Text);
|
---|
1649 | end;
|
---|
1650 | finally
|
---|
1651 | Errors.Free;
|
---|
1652 | end;
|
---|
1653 | end;
|
---|
1654 | end;
|
---|
1655 |
|
---|
1656 | { TORListBox ------------------------------------------------------------------------------- }
|
---|
1657 |
|
---|
1658 | constructor TORListBox.Create(AOwner: TComponent);
|
---|
1659 | { sets initial values for fields used by added properties (ItemTip, Reference, Tab, LongList) }
|
---|
1660 | begin
|
---|
1661 | inherited Create(AOwner);
|
---|
1662 | AddItemTipRef; // kcm
|
---|
1663 | FTipItem := -1;
|
---|
1664 | FItemTipColor := clWindow;
|
---|
1665 | FItemTipEnable := True;
|
---|
1666 | FLastItemIndex := -1;
|
---|
1667 | FFromSelf := False;
|
---|
1668 | FDelimiter := '^';
|
---|
1669 | FWhiteSpace := ' ';
|
---|
1670 | FLongList := False;
|
---|
1671 | FFromNeedData := False;
|
---|
1672 | FFirstLoad := True;
|
---|
1673 | FCurrentTop := -1;
|
---|
1674 | FFocusIndex := -1;
|
---|
1675 | ShowHint := True;
|
---|
1676 | FHideSynonyms := FALSE;
|
---|
1677 | FSynonymChars := '<>';
|
---|
1678 | FTabPosInPixels := False;
|
---|
1679 | FRightClickSelect := FALSE;
|
---|
1680 | FCheckBoxes := FALSE;
|
---|
1681 | FFlatCheckBoxes := TRUE;
|
---|
1682 | FCaseChanged := TRUE;
|
---|
1683 | FLookupPiece := 0;
|
---|
1684 | FIsPartOfComboBox := False;
|
---|
1685 | end;
|
---|
1686 |
|
---|
1687 | destructor TORListBox.Destroy;
|
---|
1688 | { ensures that the special records associated with each listbox item are disposed }
|
---|
1689 | begin
|
---|
1690 | FMItems.Free;
|
---|
1691 | if uItemTip <> nil then uItemTip.Hide;
|
---|
1692 | DestroyItems;
|
---|
1693 | RemoveItemTipRef; //kcm
|
---|
1694 | inherited Destroy;
|
---|
1695 | end;
|
---|
1696 |
|
---|
1697 | procedure TORListBox.CreateParams(var Params: TCreateParams);
|
---|
1698 | { ensures that the listbox can support tab stops }
|
---|
1699 | begin
|
---|
1700 | inherited CreateParams(Params);
|
---|
1701 | with Params do Style := Style or LBS_USETABSTOPS;
|
---|
1702 | end;
|
---|
1703 |
|
---|
1704 | procedure TORListBox.CreateWnd;
|
---|
1705 | { makes sure that actual (rather than 'intercepted') values are restored from FSaveItems
|
---|
1706 | (FSaveItems is part of TCustomListBox), necessary if window is recreated by property change
|
---|
1707 | also gets the first bolus of data in the case of a LongList }
|
---|
1708 | var
|
---|
1709 | RealVerification: Boolean;
|
---|
1710 | begin
|
---|
1711 | FFromSelf := True;
|
---|
1712 | RealVerification := True;
|
---|
1713 | if Assigned( FMItems ) then
|
---|
1714 | begin
|
---|
1715 | RealVerification := FMItems.Verification;
|
---|
1716 | FMItems.Verification := False;
|
---|
1717 | end;
|
---|
1718 | inherited CreateWnd;
|
---|
1719 | if Assigned( FMItems ) then
|
---|
1720 | begin
|
---|
1721 | FMItems.Verification := RealVerification;
|
---|
1722 | FMItems.Verify;
|
---|
1723 | end;
|
---|
1724 | FFromSelf := False;
|
---|
1725 | if FTabPos[0] > 0 then SetTabStops;
|
---|
1726 | end;
|
---|
1727 |
|
---|
1728 | procedure TORListBox.Loaded;
|
---|
1729 | { after the properties are loaded, get the first data bolus for a LongList }
|
---|
1730 | begin
|
---|
1731 | inherited;
|
---|
1732 | if FLongList then FWaterMark := Items.Count;
|
---|
1733 | SetTabStops;
|
---|
1734 | end;
|
---|
1735 |
|
---|
1736 | procedure TORListBox.DestroyWnd;
|
---|
1737 | { makes sure that actual (rather than 'intercepted') values are saved to FSaveItems
|
---|
1738 | (FSaveItems is part of TCustomListBox), necessary if window is recreated by property change }
|
---|
1739 | begin
|
---|
1740 | FFromSelf := True;
|
---|
1741 | inherited DestroyWnd;
|
---|
1742 | FFromSelf := False;
|
---|
1743 | end;
|
---|
1744 |
|
---|
1745 | function TORListBox.TextToShow(S: string): string;
|
---|
1746 | { returns the text that will be displayed based on the Pieces and TabPosition properties }
|
---|
1747 | var
|
---|
1748 | i: Integer;
|
---|
1749 | begin
|
---|
1750 | if FPieces[0] > 0 then
|
---|
1751 | begin
|
---|
1752 | Result := '';
|
---|
1753 | for i := 1 to FPieces[0] do
|
---|
1754 | Result := Result + Piece(S, FDelimiter, FPieces[i]) + FWhiteSpace;
|
---|
1755 | Result := TrimRight(Result);
|
---|
1756 | end
|
---|
1757 | else
|
---|
1758 | begin
|
---|
1759 | SetString(Result, PChar(S), Length(S));
|
---|
1760 | end;
|
---|
1761 | end;
|
---|
1762 |
|
---|
1763 | function TORListBox.IsSynonym(const TestStr: string): boolean;
|
---|
1764 | var
|
---|
1765 | i,cnt,len :integer;
|
---|
1766 |
|
---|
1767 | begin
|
---|
1768 | Result := FALSE;
|
---|
1769 | if((FHideSynonyms) and (FSynonymChars <> '')) then
|
---|
1770 | begin
|
---|
1771 | len := length(FSynonymChars);
|
---|
1772 | cnt := 0;
|
---|
1773 | for i := 1 to len do
|
---|
1774 | if(pos(FSynonymChars[i], TestStr)>0) then inc(cnt);
|
---|
1775 | if(cnt = len) then Result := TRUE;
|
---|
1776 | if assigned(FOnSynonymCheck) then
|
---|
1777 | FOnSynonymCheck(Self, TestStr, Result);
|
---|
1778 | end;
|
---|
1779 | end;
|
---|
1780 |
|
---|
1781 | function TORListBox.GetDisplayText(Index: Integer): string;
|
---|
1782 | { get the item string actually displayed by the listbox rather than what is in Items[n] }
|
---|
1783 | var
|
---|
1784 | Len: Integer;
|
---|
1785 | Buf: array[0..4095] of Char;
|
---|
1786 | begin
|
---|
1787 | Result := '';
|
---|
1788 | FFromSelf := True;
|
---|
1789 | Len := SendMessage(Handle,LB_GETTEXT, Index, Integer(@Buf));
|
---|
1790 | FFromSelf := False;
|
---|
1791 | if Len > 0 then
|
---|
1792 | begin
|
---|
1793 | SetString(Result, Buf, Len);
|
---|
1794 | end;
|
---|
1795 | end;
|
---|
1796 |
|
---|
1797 | function TORListBox.GetDynamicProperty(PropertyID: integer): string;
|
---|
1798 | begin
|
---|
1799 | if PropertyID = DynaPropAccesibilityCaption then
|
---|
1800 | Result := GetCaption
|
---|
1801 | else
|
---|
1802 | Result := '';
|
---|
1803 | end;
|
---|
1804 |
|
---|
1805 | // The following 7 message handling procedures essentially reimplement the TListBoxStrings
|
---|
1806 | // object found in StdCtrls. They do this by intercepting the messages sent by the
|
---|
1807 | // TListBoxStrings object and modifying the contents of WParam, LParam, and Result.
|
---|
1808 | // This allows TORListBox to use the ItemData pointer that is part of each listbox item
|
---|
1809 | // to store its own information yet let the application still use the Objects property
|
---|
1810 | // of standard Delphi listboxes. It also makes it possible to implement the Pieces and
|
---|
1811 | // TabPosition properties without forcing the listbox to be owner drawn.
|
---|
1812 |
|
---|
1813 | procedure TORListBox.LBGetItemData(var Message: TMessage);
|
---|
1814 | { intercept LB_GETITEMDATA and repoint to UserObject rather than internal value in ItemData }
|
---|
1815 | var
|
---|
1816 | ItemRec: PItemRec;
|
---|
1817 | begin
|
---|
1818 | inherited;
|
---|
1819 | if not FFromSelf then with Message do
|
---|
1820 | begin
|
---|
1821 | ItemRec := PItemRec(Result);
|
---|
1822 | if(assigned(ItemRec)) then
|
---|
1823 | Result := Integer(ItemRec^.UserObject)
|
---|
1824 | else
|
---|
1825 | Result := 0;
|
---|
1826 | end;
|
---|
1827 | end;
|
---|
1828 |
|
---|
1829 | procedure TORListBox.LBSetItemData(var Message: TMessage);
|
---|
1830 | { intercept LB_SETITEMDATA as save object in UserObject since ItemData is used interally }
|
---|
1831 | var
|
---|
1832 | ItemRec: PItemRec;
|
---|
1833 | begin
|
---|
1834 | if not FFromSelf then with Message do
|
---|
1835 | begin
|
---|
1836 | FFromSelf := True;
|
---|
1837 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, WParam, 0)); // WParam: list index
|
---|
1838 | FFromSelf := False;
|
---|
1839 | if(assigned(ItemRec)) then
|
---|
1840 | ItemRec^.UserObject := TObject(LParam);
|
---|
1841 | LParam := Integer(ItemRec);
|
---|
1842 | if uItemTip.FShowing and (uItemTip.FListBox = Self) and (uItemTip.FListItem = WParam) then
|
---|
1843 | uItemTip.UpdateText(FALSE);
|
---|
1844 | end;
|
---|
1845 | inherited;
|
---|
1846 | end;
|
---|
1847 |
|
---|
1848 | procedure TORListBox.LBGetText(var Message: TMessage);
|
---|
1849 | { intercept LB_GETTEXT and repoint to full item string rather than what's visible in listbox }
|
---|
1850 | var
|
---|
1851 | ItemRec: PItemRec;
|
---|
1852 | Text: string;
|
---|
1853 | begin
|
---|
1854 | inherited;
|
---|
1855 | if (not FFromSelf) and (Message.Result <> LB_ERR) then with Message do
|
---|
1856 | begin
|
---|
1857 | FFromSelf := True;
|
---|
1858 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, WParam, 0)); // WParam: list index
|
---|
1859 | FFromSelf := False;
|
---|
1860 | if(assigned(ItemRec)) then
|
---|
1861 | begin
|
---|
1862 | FFromSelf := True;
|
---|
1863 | Text := TListBox(self).Items[WParam];
|
---|
1864 | StrCopy(PChar(LParam), PChar(Text)); // LParam: points string buffer
|
---|
1865 | Result := Length(Text); // Result: length of string
|
---|
1866 | FFromSelf := False;
|
---|
1867 | end
|
---|
1868 | else
|
---|
1869 | begin
|
---|
1870 | StrPCopy(PChar(LParam),'');
|
---|
1871 | Result := 0;
|
---|
1872 | end;
|
---|
1873 | end;
|
---|
1874 | end;
|
---|
1875 | procedure TORListBox.LBGetTextLen(var Message: TMessage);
|
---|
1876 | { intercept LB_GETTEXTLEN and return true length of ItemRec^.FullText }
|
---|
1877 | { -- in response to HOU-0299-70576, Thanks to Stephen Kirby for this fix! }
|
---|
1878 | var
|
---|
1879 | ItemRec: PItemRec;
|
---|
1880 | begin
|
---|
1881 | inherited;
|
---|
1882 | if (not FFromSelf) and (Message.Result <> LB_ERR) then with Message do
|
---|
1883 | begin
|
---|
1884 | FFromSelf := True;
|
---|
1885 | ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, WParam, 0));
|
---|
1886 | if(assigned(ItemRec)) then
|
---|
1887 | Result := Length(TListBox(self).Items[WParam]) // Result:length of string
|
---|
1888 | else
|
---|
1889 | Result := 0;
|
---|
1890 | FFromSelf := False;
|
---|
1891 | end;
|
---|
1892 | end;
|
---|
1893 |
|
---|
1894 | procedure TORListBox.LBAddString(var Message: TMessage);
|
---|
1895 | { intercept LB_ADDSTRING and save full string in separate record. Then rebuild a string that
|
---|
1896 | has what's visible (based on Pieces, TabPosition properties) and substitute that in LParam }
|
---|
1897 | var
|
---|
1898 | ItemRec: PItemRec;
|
---|
1899 | begin
|
---|
1900 | if not FFromSelf then
|
---|
1901 | begin
|
---|
1902 | if FLongList then // -- special long list processing - begin
|
---|
1903 | begin
|
---|
1904 | if FFromNeedData then FDataAdded := True else with Message do
|
---|
1905 | begin
|
---|
1906 | WParam := FWaterMark;
|
---|
1907 | Result := Perform(LB_INSERTSTRING, WParam, LParam); // always insert into short list
|
---|
1908 | Exit;
|
---|
1909 | end;
|
---|
1910 | end; // -- special long list processing - end
|
---|
1911 | New(ItemRec);
|
---|
1912 | with ItemRec^, Message do
|
---|
1913 | begin
|
---|
1914 | UserObject := nil;
|
---|
1915 | CheckedState := cbUnchecked;
|
---|
1916 | FCreatingText := PChar(LParam);
|
---|
1917 | end;
|
---|
1918 | FCreatingItem := TRUE;
|
---|
1919 | inherited;
|
---|
1920 | FCreatingItem := FALSE;
|
---|
1921 | // insert into list AFTER calling inherited in case the listbox is sorted
|
---|
1922 | DoChange;
|
---|
1923 | with Message do if Result <> LB_ERR then
|
---|
1924 | begin
|
---|
1925 | FFromSelf := True;
|
---|
1926 | SendMessage(Handle,LB_SETITEMDATA, Result, Integer(ItemRec)); // Result: new item index
|
---|
1927 | FFromSelf := False;
|
---|
1928 | end
|
---|
1929 | else Dispose(ItemRec);
|
---|
1930 | end
|
---|
1931 | else inherited;
|
---|
1932 | end;
|
---|
1933 |
|
---|
1934 | procedure TORListBox.LBInsertString(var Message: TMessage);
|
---|
1935 | { intercepts LB_INSERTSTRING, similar to LBAddString except for special long list processing }
|
---|
1936 | var
|
---|
1937 | ItemRec: PItemRec;
|
---|
1938 | begin
|
---|
1939 | if not FFromSelf then
|
---|
1940 | begin
|
---|
1941 | if FLongList then // -- special long list processing - begin
|
---|
1942 | begin
|
---|
1943 | if FFromNeedData then
|
---|
1944 | begin
|
---|
1945 | FDataAdded := True;
|
---|
1946 | Inc(FCurrentTop);
|
---|
1947 | end
|
---|
1948 | else with Message do
|
---|
1949 | begin
|
---|
1950 | if WParam > FWaterMark then
|
---|
1951 | begin // make sure insert above watermark
|
---|
1952 | FMItems.MList.Move(WParam,FWaterMark);
|
---|
1953 | WParam := FWaterMark;
|
---|
1954 | end;
|
---|
1955 | Inc(FWaterMark);
|
---|
1956 | end;
|
---|
1957 | end; // -- special long list processing - end
|
---|
1958 | New(ItemRec);
|
---|
1959 | with ItemRec^, Message do
|
---|
1960 | begin
|
---|
1961 | UserObject := nil;
|
---|
1962 | CheckedState := cbUnchecked;
|
---|
1963 | FCreatingText := PChar(LParam);
|
---|
1964 | end;
|
---|
1965 | FCreatingItem := TRUE;
|
---|
1966 | inherited;
|
---|
1967 | FCreatingItem := FALSE;
|
---|
1968 | DoChange;
|
---|
1969 | with Message do if Result <> LB_ERR then
|
---|
1970 | begin
|
---|
1971 | FFromSelf := True;
|
---|
1972 | SendMessage(Handle,LB_SETITEMDATA, Result, Integer(ItemRec)); // Result: new item index
|
---|
1973 | FFromSelf := False;
|
---|
1974 | end
|
---|
1975 | else Dispose(ItemRec);
|
---|
1976 | end
|
---|
1977 | else inherited;
|
---|
1978 | end;
|
---|
1979 |
|
---|
1980 | procedure TORListBox.LBDeleteString(var Message: TMessage);
|
---|
1981 | { intercept LB_DELETESTRING and dispose the record associated with the item being deleted }
|
---|
1982 | var
|
---|
1983 | ItemRec: PItemRec;
|
---|
1984 | begin
|
---|
1985 | with Message do
|
---|
1986 | begin
|
---|
1987 | FFromSelf := True;
|
---|
1988 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, WParam, 0)); // WParam: list index
|
---|
1989 | FFromSelf := False;
|
---|
1990 | if(assigned(ItemRec)) then
|
---|
1991 | begin
|
---|
1992 | if FLongList and not FFromNeedData then
|
---|
1993 | Dec(FWaterMark);
|
---|
1994 | Dispose(ItemRec);
|
---|
1995 | end;
|
---|
1996 | end;
|
---|
1997 | FFromSelf := True; // FFromSelf is set here because, under NT, LBResetContent is called
|
---|
1998 | inherited; // when deleting the last string from the listbox. Since ItemRec is
|
---|
1999 | FFromSelf := False; // already disposed, it shouldn't be disposed again.
|
---|
2000 | DoChange;
|
---|
2001 | end;
|
---|
2002 |
|
---|
2003 | procedure TORListBox.LBResetContent(var Message: TMessage);
|
---|
2004 | { intercept LB_RESETCONTENT (list is being cleared) and dispose all records }
|
---|
2005 | var
|
---|
2006 | ItemCount, i: Integer;
|
---|
2007 | ItemRec: PItemRec;
|
---|
2008 | begin
|
---|
2009 | if not FFromSelf then
|
---|
2010 | begin
|
---|
2011 | ItemCount := Perform(LB_GETCOUNT, 0, 0);
|
---|
2012 | for i := 0 to ItemCount - 1 do
|
---|
2013 | begin
|
---|
2014 | FFromSelf := True;
|
---|
2015 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, i, 0));
|
---|
2016 | FFromSelf := False;
|
---|
2017 | Dispose(ItemRec);
|
---|
2018 | end;
|
---|
2019 | Perform(LB_SETCOUNT, 0, 0);
|
---|
2020 | end;
|
---|
2021 | // This was casuing pain for ResetItems when FWaterMark was being cleared for short lists
|
---|
2022 | if FLongList then
|
---|
2023 | FWaterMark := 0;
|
---|
2024 | inherited;
|
---|
2025 | end;
|
---|
2026 |
|
---|
2027 | procedure TORListBox.LBSetCurSel(var Message: TMessage);
|
---|
2028 | { call DoChange, which calls OnChange event whenever ItemIndex changes }
|
---|
2029 | begin
|
---|
2030 | inherited;
|
---|
2031 | DoChange;
|
---|
2032 | end;
|
---|
2033 |
|
---|
2034 | procedure TORListBox.CMFontChanged(var Message: TMessage);
|
---|
2035 | { make sure itemtip and tabs respond to characteristics of the new font }
|
---|
2036 | begin
|
---|
2037 | inherited;
|
---|
2038 | FLargeChange := (Height div ItemHeight) - 1;
|
---|
2039 | SetTabStops;
|
---|
2040 | end;
|
---|
2041 |
|
---|
2042 | procedure TORListBox.WMKeyDown(var Message: TWMKeyDown);
|
---|
2043 | { intercept the keydown messages so that the listbox can be navigated by using the arrow
|
---|
2044 | keys and shifting the focus rectangle rather than generating Click for each keypress }
|
---|
2045 | var
|
---|
2046 | IsSelected: LongBool;
|
---|
2047 | begin
|
---|
2048 | //if Message.CharCode in [VK_RETURN, VK_ESCAPE] then inherited; // ignore other keys
|
---|
2049 | case Message.CharCode of
|
---|
2050 | VK_LBUTTON, VK_RETURN, VK_SPACE:
|
---|
2051 | begin
|
---|
2052 | if (FocusIndex < 0) and (CheckBoxes or MultiSelect) and (Count > 0) then // JNM - 508 compliance
|
---|
2053 | SetFocusIndex(0);
|
---|
2054 | if FocusIndex > -1 then
|
---|
2055 | begin
|
---|
2056 | if MultiSelect then
|
---|
2057 | begin
|
---|
2058 | IsSelected := LongBool(Perform(LB_GETSEL, FocusIndex, 0));
|
---|
2059 | Perform(LB_SETSEL, Longint(not IsSelected), FocusIndex);
|
---|
2060 | end
|
---|
2061 | else Perform(LB_SETCURSEL, FocusIndex, 0);
|
---|
2062 | // Send WM_COMMAND here because LBN_SELCHANGE not triggered by LB_SETSEL
|
---|
2063 | // and LBN_SELCHANGE is what eventually triggers the Click event.
|
---|
2064 | // The LBN_SELCHANGE documentation implies we should send the control id, which is
|
---|
2065 | // 32 bits long, in the high word of WPARAM (16 bits). Since that won't work - we'll
|
---|
2066 | // try sending the item index instead.
|
---|
2067 | //PostMessage() not SendMessage() is Required here for checkboxes, SendMessage() doesn't
|
---|
2068 | //Allow the Checkbox state on the control to be updated
|
---|
2069 | if CheckBoxes then
|
---|
2070 | PostMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle))
|
---|
2071 | else
|
---|
2072 | SendMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle));
|
---|
2073 | end;
|
---|
2074 | end;
|
---|
2075 | VK_PRIOR: SetFocusIndex(FocusIndex - FLargeChange);
|
---|
2076 | VK_NEXT: SetFocusIndex(FocusIndex + FLargeChange);
|
---|
2077 | VK_END: SetFocusIndex(SFI_END);
|
---|
2078 | VK_HOME: SetFocusIndex(SFI_TOP);
|
---|
2079 | VK_LEFT, VK_UP: SetFocusIndex(FocusIndex - 1);
|
---|
2080 | VK_RIGHT, VK_DOWN: SetFocusIndex(FocusIndex + 1);
|
---|
2081 | else inherited;
|
---|
2082 | end;
|
---|
2083 | Message.Result := 0;
|
---|
2084 | end;
|
---|
2085 |
|
---|
2086 | procedure TORListBox.WMLButtonDown(var Message: TWMLButtonDown);
|
---|
2087 | { work around for a very ugly problem when the listbox is used with a dropdown combobox
|
---|
2088 | when the listbox is used this way (parent=desktop) the click events seem to be ignored }
|
---|
2089 | var
|
---|
2090 | AnItem: Integer;
|
---|
2091 | ScrollRect, ListRect: TRect;
|
---|
2092 | ScreenPoint: TSmallPoint;
|
---|
2093 | TmpRect: TRect;
|
---|
2094 | begin
|
---|
2095 | if FParentCombo <> nil then with Message do
|
---|
2096 | begin
|
---|
2097 | FDontClose := FALSE;
|
---|
2098 | ListRect := ClientRect; //+
|
---|
2099 | if FLongList then ListRect.Right := ListRect.Left + ClientWidthOfList(Self); //+
|
---|
2100 | // if the mouse was clicked in the client area set ItemIndex ourselves
|
---|
2101 | if PtInRect(ListRect, Point(XPos, YPos)) then //~
|
---|
2102 | begin
|
---|
2103 | AnItem := GetIndexFromY(YPos);
|
---|
2104 | if AnItem < Items.Count then ItemIndex := AnItem;
|
---|
2105 | FParentCombo.FwdClick(FParentCombo);
|
---|
2106 | FDontClose := TRUE;
|
---|
2107 | end;
|
---|
2108 | // if the mouse was clicked on the scrollbar, send a message to make the scrolling happen
|
---|
2109 | // this is done with WM_NCLBUTTONDOWN, which is ignored if mousecapture is on, so we have
|
---|
2110 | // to turn mousecapture off, then back on since it's needed to hide the listbox
|
---|
2111 | with ListRect do ScrollRect := Rect(Right + 1, Top, Self.Width - 2, Bottom); //~
|
---|
2112 | if {(Items.Count > (FLargeChange + 1)) and} PtInRect(ScrollRect, Point(XPos, YPos)) then //~
|
---|
2113 | begin
|
---|
2114 | if FLongList then // for long lists
|
---|
2115 | begin
|
---|
2116 | ScreenPoint := PointToSmallPoint(FScrollBar.ScreenToClient(
|
---|
2117 | Self.ClientToScreen(Point(XPos, YPos))));
|
---|
2118 | MouseCapture := False;
|
---|
2119 | SendMessage(FScrollBar.Handle, WM_LBUTTONDOWN, Message.Keys,
|
---|
2120 | MakeLParam(ScreenPoint.X, ScreenPoint.Y));
|
---|
2121 | MouseCapture := True;
|
---|
2122 | end else // for normal lists
|
---|
2123 | begin
|
---|
2124 | ScreenPoint := PointToSmallPoint(Self.ClientToScreen(Point(XPos, YPos)));
|
---|
2125 | MouseCapture := False;
|
---|
2126 | SendMessage(Self.Handle, WM_NCLBUTTONDOWN, HTVSCROLL,
|
---|
2127 | MakeLParam(ScreenPoint.X, ScreenPoint.Y));
|
---|
2128 | MouseCapture := True;
|
---|
2129 | end;
|
---|
2130 | end
|
---|
2131 | else
|
---|
2132 | if(FCheckBoxes) then
|
---|
2133 | begin
|
---|
2134 | TmpRect := ListRect;
|
---|
2135 | TmpRect.Top := TmpRect.Bottom;
|
---|
2136 | TmpRect.Right := TmpRect.Left + Width;
|
---|
2137 | inc(TmpRect.Bottom, CheckComboBtnHeight);
|
---|
2138 | if PtInRect(TmpRect, Point(XPos, YPos)) then
|
---|
2139 | begin
|
---|
2140 | inc(TmpRect.Left, (TmpRect.right - TmpRect.Left) div 2);
|
---|
2141 | FParentCombo.DropPanelBtnPressed(XPos <= TmpRect.Left, FALSE);
|
---|
2142 | end;
|
---|
2143 | end;
|
---|
2144 | end;
|
---|
2145 | inherited;
|
---|
2146 | end;
|
---|
2147 |
|
---|
2148 | procedure TORListBox.WMLButtonUp(var Message: TWMLButtonUp);
|
---|
2149 | { If the listbox is being used with a dropdown combo, hide the listbox whenever something is
|
---|
2150 | clicked. The mouse is captured at this point - this isn't called if clicking scrollbar. }
|
---|
2151 | begin
|
---|
2152 | if (FParentCombo <> nil) and ((not FDontClose) or (not FCheckBoxes)) then FParentCombo.DroppedDown := False;
|
---|
2153 | FDontClose := FALSE;
|
---|
2154 | inherited;
|
---|
2155 | end;
|
---|
2156 |
|
---|
2157 | procedure TORListBox.WMRButtonUp(var Message: TWMRButtonUp);
|
---|
2158 | { When the RightClickSelect property is true, this routine is used to select an item }
|
---|
2159 | var
|
---|
2160 | AnItem: Integer;
|
---|
2161 | ListRect: TRect;
|
---|
2162 |
|
---|
2163 | begin
|
---|
2164 | if(FRightClickSelect and (FParentCombo = nil)) then with Message do // List Boxes only, not Combo Boxes
|
---|
2165 | begin
|
---|
2166 | ListRect := ClientRect; //+
|
---|
2167 | if FLongList then ListRect.Right := ListRect.Left + ClientWidthOfList(Self); //+
|
---|
2168 | // if the mouse was clicked in the client area set ItemIndex ourselves
|
---|
2169 | if PtInRect(ListRect, Point(XPos, YPos)) then //~
|
---|
2170 | begin
|
---|
2171 | AnItem := GetIndexFromY(YPos);
|
---|
2172 | if AnItem >= Items.Count then AnItem := -1;
|
---|
2173 | end
|
---|
2174 | else
|
---|
2175 | AnItem := -1;
|
---|
2176 | ItemIndex := AnItem;
|
---|
2177 | end;
|
---|
2178 | inherited;
|
---|
2179 | end;
|
---|
2180 |
|
---|
2181 | procedure TORListBox.WMLButtonDblClk(var Message: TWMLButtonDblClk);
|
---|
2182 | { treat a doubleclick in the scroll region as if it were a single click - see WMLButtonDown }
|
---|
2183 | var
|
---|
2184 | ScrollRect: TRect;
|
---|
2185 | ScreenPoint: TSmallPoint;
|
---|
2186 | begin
|
---|
2187 | if FParentCombo <> nil then with Message do
|
---|
2188 | begin
|
---|
2189 | if(FCheckBoxes) then FDontClose := TRUE;
|
---|
2190 | // if the mouse was clicked on the scrollbar, send a message to make the scrolling happen
|
---|
2191 | // this is done with WM_NCLBUTTONDOWN, which is ignored if mousecapture is on, so we have
|
---|
2192 | // to turn mousecapture off, then back on since it's needed to hide the listbox
|
---|
2193 | with ClientRect do ScrollRect := Rect(Right + 1, Top, Self.Width - 2, Bottom);
|
---|
2194 | if (Items.Count > (FLargeChange + 1)) and PtInRect(ScrollRect, Point(XPos, YPos)) then
|
---|
2195 | begin
|
---|
2196 | if FLongList then // for long lists
|
---|
2197 | begin
|
---|
2198 | ScreenPoint := PointToSmallPoint(FScrollBar.ScreenToClient(
|
---|
2199 | Self.ClientToScreen(Point(XPos, YPos))));
|
---|
2200 | MouseCapture := False;
|
---|
2201 | SendMessage(FScrollBar.Handle, WM_LBUTTONDOWN, Message.Keys,
|
---|
2202 | MakeLParam(ScreenPoint.X, ScreenPoint.Y));
|
---|
2203 | MouseCapture := True;
|
---|
2204 | end else // for normal lists
|
---|
2205 | begin
|
---|
2206 | ScreenPoint := PointToSmallPoint(Self.ClientToScreen(Point(XPos, YPos)));
|
---|
2207 | MouseCapture := False;
|
---|
2208 | SendMessage(Self.Handle, WM_NCLBUTTONDOWN, HTVSCROLL,
|
---|
2209 | MakeLParam(ScreenPoint.X, ScreenPoint.Y));
|
---|
2210 | MouseCapture := True;
|
---|
2211 | end; {if FLongList}
|
---|
2212 | end; {if (Items.Count)}
|
---|
2213 | end; {if FParentCombo}
|
---|
2214 | inherited;
|
---|
2215 | end;
|
---|
2216 |
|
---|
2217 | procedure TORListBox.WMCancelMode(var Message: TMessage);
|
---|
2218 | { This message is sent when focus shifts to another window - need to hide the listbox at this
|
---|
2219 | point if it is being used with a dropdown combobox. }
|
---|
2220 | begin
|
---|
2221 | uItemTip.Hide;
|
---|
2222 | if FParentCombo <> nil then FParentCombo.DroppedDown := False;
|
---|
2223 | inherited;
|
---|
2224 | end;
|
---|
2225 |
|
---|
2226 | procedure TORListBox.WMMove(var Message: TWMMove);
|
---|
2227 | { whenever in LongList mode we need to move the scrollbar along with the listbox }
|
---|
2228 | begin
|
---|
2229 | inherited;
|
---|
2230 | if FScrollBar <> nil then AdjustScrollBar;
|
---|
2231 | end;
|
---|
2232 |
|
---|
2233 | procedure TORListBox.WMSize(var Message: TWMSize);
|
---|
2234 | { calculate the number of visible items in the listbox whenever it is resized
|
---|
2235 | if in LongList mode, size the scrollbar to match the listbox }
|
---|
2236 | begin
|
---|
2237 | inherited;
|
---|
2238 | FLargeChange := (Message.Height div ItemHeight) - 1;
|
---|
2239 | if FScrollBar <> nil then AdjustScrollBar;
|
---|
2240 | end;
|
---|
2241 |
|
---|
2242 | procedure TORListBox.WMVScroll(var Message: TWMVScroll);
|
---|
2243 | { makes sure the itemtip is hidden whenever the listbox is scrolled }
|
---|
2244 | // it would be better if this was done right away (before endscroll, but it seems to mess
|
---|
2245 | // up mouse capture (SaveCaptureControl, HideItemTip, RestoreCaptureControl?)
|
---|
2246 | begin
|
---|
2247 | inherited;
|
---|
2248 | if Message.ScrollCode = SB_ENDSCROLL then uItemTip.Hide;
|
---|
2249 | end;
|
---|
2250 |
|
---|
2251 | procedure TORListBox.CMHintShow(var Message: TMessage);
|
---|
2252 | { if ShowHint is used to delay showing tip, starts showing ItemTip when hint timer expires }
|
---|
2253 | var
|
---|
2254 | APoint: TPoint;
|
---|
2255 | begin
|
---|
2256 | inherited;
|
---|
2257 | FItemTipActive := True;
|
---|
2258 | GetCursorPos(APoint);
|
---|
2259 | APoint := ScreenToClient(APoint);
|
---|
2260 | MouseMove([], APoint.X, APoint.Y); // assume nothing in ShiftState for now
|
---|
2261 | end;
|
---|
2262 |
|
---|
2263 | procedure TORListBox.Click;
|
---|
2264 | begin
|
---|
2265 | inherited Click;
|
---|
2266 | DoChange;
|
---|
2267 | end;
|
---|
2268 |
|
---|
2269 | procedure TORListBox.DoChange;
|
---|
2270 | { call the OnChange Event if ItemIndex is changed }
|
---|
2271 | begin
|
---|
2272 | if ItemIndex <> FLastItemIndex then
|
---|
2273 | begin
|
---|
2274 | FLastItemIndex := ItemIndex;
|
---|
2275 | if (not isPartOfComboBox) and (ItemIndex <> -1) then
|
---|
2276 | SetFocusIndex(ItemIndex);
|
---|
2277 | if Assigned(FOnChange) then FOnChange(Self);
|
---|
2278 | end;
|
---|
2279 | end;
|
---|
2280 |
|
---|
2281 | procedure TORListBox.DoEnter;
|
---|
2282 | { display the item tip window when the listbox gets keyboard focus - if itemtip enabled }
|
---|
2283 | begin
|
---|
2284 | //if Items.Count > 0 then SetFocusIndex(TopIndex); // this seems to cause problems
|
---|
2285 | //Fix For ClearQuest: HDS00001576
|
---|
2286 | //This fix has been commented out, becuase it causes problems
|
---|
2287 | { if (Items.Count > 0) and (Not IsAMouseButtonDown()) and (ItemIndex = -1) then
|
---|
2288 | SetFocusIndex(TopIndex);//ItemIndex := TopIndex; }
|
---|
2289 | if FHideSelection and (ItemIndex < 0) and (FFocusIndex >= 0) then
|
---|
2290 | ItemIndex := FFocusIndex;
|
---|
2291 | inherited DoEnter;
|
---|
2292 | end;
|
---|
2293 |
|
---|
2294 | procedure TORListBox.DoExit;
|
---|
2295 | var
|
---|
2296 | SaveIndex: integer;
|
---|
2297 | { make sure item tip is hidden for this listbox when focus shifts to something else }
|
---|
2298 | begin
|
---|
2299 | if FHideSelection then
|
---|
2300 | begin
|
---|
2301 | SaveIndex := ItemIndex;
|
---|
2302 | ItemIndex := -1;
|
---|
2303 | FFocusIndex := SaveIndex;
|
---|
2304 | end;
|
---|
2305 |
|
---|
2306 | uItemTip.Hide;
|
---|
2307 | FItemTipActive := False;
|
---|
2308 | inherited DoExit;
|
---|
2309 | end;
|
---|
2310 |
|
---|
2311 | procedure TORListBox.DestroyItems;
|
---|
2312 | var
|
---|
2313 | ItemCount,i: Integer;
|
---|
2314 | ItemRec: PItemRec;
|
---|
2315 |
|
---|
2316 | begin
|
---|
2317 | if(not FItemsDestroyed) then
|
---|
2318 | begin
|
---|
2319 | ItemCount := Perform(LB_GETCOUNT, 0, 0);
|
---|
2320 | for i := 0 to ItemCount - 1 do
|
---|
2321 | begin
|
---|
2322 | FFromSelf := True;
|
---|
2323 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, i, 0));
|
---|
2324 | FFromSelf := False;
|
---|
2325 | if Assigned(ItemRec) then
|
---|
2326 | Dispose(ItemRec);
|
---|
2327 | end;
|
---|
2328 | FItemsDestroyed := TRUE;
|
---|
2329 |
|
---|
2330 | end;
|
---|
2331 | end;
|
---|
2332 |
|
---|
2333 | procedure TORListBox.ToggleCheckBox(idx: integer);
|
---|
2334 | var
|
---|
2335 | ItemRec: PItemRec;
|
---|
2336 | OldFromSelf: boolean;
|
---|
2337 | Rect: TRect;
|
---|
2338 |
|
---|
2339 | begin
|
---|
2340 | if(not FCheckBoxes) or (idx < 0) or (idx >= Items.Count) then exit;
|
---|
2341 | OldFromSelf := FFromSelf;
|
---|
2342 | FFromSelf := True;
|
---|
2343 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, idx, 0));
|
---|
2344 | FFromSelf := OldFromSelf;
|
---|
2345 | if(assigned(ItemRec)) then
|
---|
2346 | begin
|
---|
2347 | if(FAllowGrayed) then
|
---|
2348 | begin
|
---|
2349 | case ItemRec^.CheckedState of
|
---|
2350 | cbUnchecked: ItemRec^.CheckedState := cbGrayed;
|
---|
2351 | cbGrayed: ItemRec^.CheckedState := cbChecked;
|
---|
2352 | cbChecked: ItemRec^.CheckedState := cbUnchecked;
|
---|
2353 | end;
|
---|
2354 | end
|
---|
2355 | else
|
---|
2356 | begin
|
---|
2357 | if(ItemRec^.CheckedState = cbUnchecked) then
|
---|
2358 | ItemRec^.CheckedState := cbChecked
|
---|
2359 | else
|
---|
2360 | ItemRec^.CheckedState := cbUnChecked;
|
---|
2361 | end;
|
---|
2362 | end;
|
---|
2363 | Rect := ItemRect(Idx);
|
---|
2364 | InvalidateRect(Handle, @Rect, FALSE);
|
---|
2365 | if(assigned(FOnClickCheck)) then
|
---|
2366 | FOnClickCheck(Self, idx);
|
---|
2367 | if(assigned(FParentCombo)) then
|
---|
2368 | FParentCombo.UpdateCheckEditBoxText;
|
---|
2369 | end;
|
---|
2370 |
|
---|
2371 | procedure TORListBox.KeyPress(var Key: Char);
|
---|
2372 | begin
|
---|
2373 | {inherited KeyPress is changing the ' ' into #0, had to move conditional before inherited.}
|
---|
2374 | if (Key = ' ') then begin
|
---|
2375 | ToggleCheckBox(ItemIndex);
|
---|
2376 | {The space bar causes the focus to jump to an item in the list that starts with
|
---|
2377 | a space. Disable that function.}
|
---|
2378 | Key := #0;
|
---|
2379 | end;
|
---|
2380 | inherited;
|
---|
2381 | end;
|
---|
2382 |
|
---|
2383 | procedure TORListBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
2384 | { hide the item tip window whenever an item is clicked - ignored if itemtip not enabled}
|
---|
2385 | var
|
---|
2386 | idx: integer;
|
---|
2387 |
|
---|
2388 | begin
|
---|
2389 | uItemTip.Hide;
|
---|
2390 | inherited MouseDown(Button, Shift, X, Y);
|
---|
2391 | if(FCheckBoxes) and (X >= 0) and (X <= Width) and (Y >= 0) and (Y <= Height) then
|
---|
2392 | begin
|
---|
2393 | idx := GetIndexFromY(Y);
|
---|
2394 | if(idx >= 0) then
|
---|
2395 | begin
|
---|
2396 | if(FCheckEntireLine) then
|
---|
2397 | ToggleCheckBox(idx)
|
---|
2398 | else
|
---|
2399 | if(X < CheckWidth) then ToggleCheckBox(idx);
|
---|
2400 | end;
|
---|
2401 | end;
|
---|
2402 | end;
|
---|
2403 |
|
---|
2404 | procedure TORListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
|
---|
2405 | { hide and show the appropriate item tip window as the mouse moves through the listbox }
|
---|
2406 | const
|
---|
2407 | CATCH_MOUSE = True;
|
---|
2408 | var
|
---|
2409 | AnItem: Integer;
|
---|
2410 | TrueOffset :integer;
|
---|
2411 | TipPos: TPoint;
|
---|
2412 | begin
|
---|
2413 | inherited MouseMove(Shift, X, Y);
|
---|
2414 | if (not FItemTipEnable) or (not Application.Active) then Exit;
|
---|
2415 | { Make sure mouse really moved before continuing. For some reason, MouseMove gets called
|
---|
2416 | every time a navigation key is pressed. If FItemTipActive is true, mouse is pausing
|
---|
2417 | over the list.}
|
---|
2418 | if (not FItemTipActive) and (X = FLastMouseX) and (Y = FLastMouseY) then Exit;
|
---|
2419 | FLastMouseX := X;
|
---|
2420 | FLastMouseY := Y;
|
---|
2421 | // when captured mouse moving outside listbox
|
---|
2422 | if not PtInRect(ClientRect, Point(X, Y)) then
|
---|
2423 | begin
|
---|
2424 | uItemTip.Hide;
|
---|
2425 | FItemTipActive := False;
|
---|
2426 | FTipItem := -1;
|
---|
2427 | Exit;
|
---|
2428 | end;
|
---|
2429 | // borrow hint timer to delay first ItemTip
|
---|
2430 | if ShowHint and not FItemTipActive then Exit;
|
---|
2431 | // when mouse moving within listbox
|
---|
2432 | AnItem := GetIndexFromY(Y);
|
---|
2433 | TrueOffset := (Y div ItemHeight) + TopIndex;
|
---|
2434 | if AnItem <> FTipItem then
|
---|
2435 | begin
|
---|
2436 | if (AnItem < Items.Count) and ((TrueOffset - TopIndex + 1) * ItemHeight < Height) then
|
---|
2437 | begin
|
---|
2438 | TipPos := ClientToScreen(Point(0, (TrueOffset - TopIndex) * ItemHeight));
|
---|
2439 | uItemTip.Show(Self, AnItem, TipPos, CATCH_MOUSE);
|
---|
2440 | FTipItem := AnItem;
|
---|
2441 | end else
|
---|
2442 | begin
|
---|
2443 | uItemTip.Hide;
|
---|
2444 | FTipItem := -1;
|
---|
2445 | end;
|
---|
2446 | end;
|
---|
2447 | end;
|
---|
2448 |
|
---|
2449 | procedure TORListBox.MeasureItem(Index: Integer; var Height: Integer);
|
---|
2450 | var
|
---|
2451 | Txt:string;
|
---|
2452 |
|
---|
2453 | begin
|
---|
2454 | if(FHideSynonyms) and (fSynonymChars <> '') then
|
---|
2455 | begin
|
---|
2456 | if(FCreatingItem) then
|
---|
2457 | Txt := FCreatingText
|
---|
2458 | else
|
---|
2459 | Txt := Items[Index];
|
---|
2460 | if(IsSynonym(Txt)) then Height := 0;
|
---|
2461 | end;
|
---|
2462 | inherited MeasureItem(Index, Height);
|
---|
2463 | end;
|
---|
2464 |
|
---|
2465 | procedure TORListBox.WMDestroy(var Message: TWMDestroy);
|
---|
2466 | begin
|
---|
2467 | if(assigned(Owner)) and (csDestroying in Owner.ComponentState) then
|
---|
2468 | DestroyItems;
|
---|
2469 | inherited;
|
---|
2470 | end;
|
---|
2471 |
|
---|
2472 | procedure TORListBox.CNDrawItem(var Message: TWMDrawItem);
|
---|
2473 | begin
|
---|
2474 | if(FCheckBoxes) then
|
---|
2475 | with Message.DrawItemStruct^ do
|
---|
2476 | inc(rcItem.Left, CheckWidth);
|
---|
2477 | inherited;
|
---|
2478 | end;
|
---|
2479 |
|
---|
2480 | procedure TORListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
|
---|
2481 | var
|
---|
2482 | Flags: Longint;
|
---|
2483 | ItemRec: PItemRec;
|
---|
2484 | OldFromSelf :boolean;
|
---|
2485 | BMap: TBitMap;
|
---|
2486 | i, DY: integer;
|
---|
2487 | TmpR: TRect;
|
---|
2488 | Neg: boolean;
|
---|
2489 | ShowText: string;
|
---|
2490 | begin
|
---|
2491 | if(assigned(FOnBeforeDraw)) then
|
---|
2492 | FOnBeforeDraw(Self, Index, Rect, State);
|
---|
2493 | if Assigned(OnDrawItem) then OnDrawItem(Self, Index, Rect, State)
|
---|
2494 | else
|
---|
2495 | begin
|
---|
2496 | Canvas.FillRect(Rect);
|
---|
2497 | if Index < Items.Count then
|
---|
2498 | begin
|
---|
2499 | Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER);
|
---|
2500 | if not UseRightToLeftAlignment then
|
---|
2501 | Inc(Rect.Left, 2)
|
---|
2502 | else
|
---|
2503 | Dec(Rect.Right, 2);
|
---|
2504 | OldFromSelf := FFromSelf;
|
---|
2505 | FFromSelf := True;
|
---|
2506 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0)); // WParam: list index
|
---|
2507 | FFromSelf := OldFromSelf;
|
---|
2508 |
|
---|
2509 | if(FCheckBoxes) then
|
---|
2510 | begin
|
---|
2511 | if(assigned(ItemRec)) then
|
---|
2512 | begin
|
---|
2513 | case ItemRec^.CheckedState of
|
---|
2514 | cbUnchecked:
|
---|
2515 | begin
|
---|
2516 | if(FFlatCheckBoxes) then
|
---|
2517 | BMap := GetORCBBitmap(iiFlatUnChecked, FBlackColorMode)
|
---|
2518 | else
|
---|
2519 | BMap := GetORCBBitmap(iiUnchecked, FBlackColorMode);
|
---|
2520 | end;
|
---|
2521 | cbChecked:
|
---|
2522 | begin
|
---|
2523 | if(FFlatCheckBoxes) then
|
---|
2524 | BMap := GetORCBBitmap(iiFlatChecked, FBlackColorMode)
|
---|
2525 | else
|
---|
2526 | BMap := GetORCBBitmap(iiChecked, FBlackColorMode);
|
---|
2527 | end;
|
---|
2528 | else // cbGrayed:
|
---|
2529 | begin
|
---|
2530 | if(FFlatCheckBoxes) then
|
---|
2531 | BMap := GetORCBBitmap(iiFlatGrayed, FBlackColorMode)
|
---|
2532 | else
|
---|
2533 | BMap := GetORCBBitmap(iiGrayed, FBlackColorMode);
|
---|
2534 | end;
|
---|
2535 | end;
|
---|
2536 | end
|
---|
2537 | else
|
---|
2538 | begin
|
---|
2539 | if(FFlatCheckBoxes) then
|
---|
2540 | BMap := GetORCBBitmap(iiFlatGrayed, FBlackColorMode)
|
---|
2541 | else
|
---|
2542 | BMap := GetORCBBitmap(iiGrayed, FBlackColorMode);
|
---|
2543 | end;
|
---|
2544 | TmpR := Rect;
|
---|
2545 | TmpR.Right := TmpR.Left;
|
---|
2546 | dec(TmpR.Left, CheckWidth+1);
|
---|
2547 | DY := ((TmpR.Bottom - TmpR.Top) - BMap.Height) div 2;
|
---|
2548 | Canvas.Draw(TmpR.Left, TmpR.Top + DY, BMap);
|
---|
2549 | end;
|
---|
2550 |
|
---|
2551 | if(FTabPos[0] > 0) then
|
---|
2552 | Flags := (FTabPos[1] * 256) or Flags or DT_TABSTOP or DT_EXPANDTABS;
|
---|
2553 |
|
---|
2554 | ShowText := GetDisplayText(Index);
|
---|
2555 | if(Style <> lbStandard) and (FTabPos[0] > 0) then
|
---|
2556 | begin
|
---|
2557 | for i := 1 to FTabPix[0] do
|
---|
2558 | begin
|
---|
2559 | Neg := (FTabPix[i] < 0);
|
---|
2560 | if Neg then FTabPix[i] := -FTabPix[i];
|
---|
2561 | inc(FTabPix[i],Rect.Left-1);
|
---|
2562 | if Neg then FTabPix[i] := -FTabPix[i];
|
---|
2563 | end;
|
---|
2564 | TabbedTextOut(Canvas.Handle, Rect.Left, Rect.Top+1, PChar(ShowText), Length(ShowText),
|
---|
2565 | FTabPix[0], FTabPix[1], -1);
|
---|
2566 | for i := 1 to FTabPix[0] do
|
---|
2567 | begin
|
---|
2568 | Neg := (FTabPix[i] < 0);
|
---|
2569 | if Neg then FTabPix[i] := -FTabPix[i];
|
---|
2570 | dec(FTabPix[i],Rect.Left-1);
|
---|
2571 | if Neg then FTabPix[i] := -FTabPix[i];
|
---|
2572 | end;
|
---|
2573 | end
|
---|
2574 | else
|
---|
2575 | DrawText(Canvas.Handle, PChar(ShowText), Length(ShowText), Rect, Flags);
|
---|
2576 | end;
|
---|
2577 | end;
|
---|
2578 | end;
|
---|
2579 |
|
---|
2580 | function TORListBox.GetIndexFromY(YPos :integer) :integer;
|
---|
2581 | begin
|
---|
2582 | if(FHideSynonyms) then
|
---|
2583 | begin
|
---|
2584 | Result := TopIndex-1;
|
---|
2585 | repeat
|
---|
2586 | inc(Result);
|
---|
2587 | if(Perform(LB_GETITEMHEIGHT, Result, 0) > 0) then
|
---|
2588 | dec(YPos,ItemHeight);
|
---|
2589 | until((YPos < 0) or (Result >= Items.Count));
|
---|
2590 | end
|
---|
2591 | else
|
---|
2592 | Result := (YPos div ItemHeight) + TopIndex;
|
---|
2593 | end;
|
---|
2594 |
|
---|
2595 | procedure TORListBox.SetFocusIndex(Value: Integer);
|
---|
2596 | { move the focus rectangle to an item and show the item tip window if enabled
|
---|
2597 | in the case of a LongList, scroll the list so that new items are loaded appropriately }
|
---|
2598 | const
|
---|
2599 | CATCH_MOUSE = True;
|
---|
2600 | NO_CATCH_MOUSE = False;
|
---|
2601 | var
|
---|
2602 | ScrollCount, ScrollPos, InitialTop, i: Integer;
|
---|
2603 | begin
|
---|
2604 | if FLongList then // -- special long list processing - begin
|
---|
2605 | begin
|
---|
2606 | if (Value = SFI_TOP) or (Value = SFI_END) then // scroll to top or bottom
|
---|
2607 | begin
|
---|
2608 | if Value = SFI_TOP then ScrollPos := 0 else ScrollPos := 100;
|
---|
2609 | ScrollTo(Self, scPosition, ScrollPos); // ScrollTo is scrollbar event
|
---|
2610 | FScrollBar.Position := ScrollPos;
|
---|
2611 | if ScrollPos = 0 then Value := FFocusIndex else Value := FFocusIndex + FLargeChange;
|
---|
2612 | end else
|
---|
2613 | begin
|
---|
2614 | InitialTop := TopIndex;
|
---|
2615 | ScrollCount := Value - InitialTop;
|
---|
2616 | ScrollPos := 50; // arbitrary, can be anything from 1-99
|
---|
2617 | if ScrollCount < 0 then // scroll backwards
|
---|
2618 | begin
|
---|
2619 | if ScrollCount = -FLargeChange then ScrollTo(Self, scPageUp, ScrollPos) else
|
---|
2620 | for i := 1 to Abs(ScrollCount) do ScrollTo(Self, scLineUp, ScrollPos);
|
---|
2621 | FScrollBar.Position := ScrollPos;
|
---|
2622 | Value := Value + (FCurrentTop - InitialTop);
|
---|
2623 | end;
|
---|
2624 | if ScrollCount > FLargeChange then // scroll forwards
|
---|
2625 | begin
|
---|
2626 | if ScrollCount = (FLargeChange * 2) then ScrollTo(Self, scPageDown, ScrollPos) else
|
---|
2627 | for i := FLargeChange + 1 to ScrollCount do ScrollTo(Self, scLineDown, ScrollPos);
|
---|
2628 | FScrollBar.Position := ScrollPos;
|
---|
2629 | end;
|
---|
2630 | if(FHideSynonyms) then
|
---|
2631 | begin
|
---|
2632 | while((Perform(LB_GETITEMHEIGHT, Value, 0) = 0) and (Value >= 0) and (value < Items.Count)) do
|
---|
2633 | begin
|
---|
2634 | if(Value < FFocusIndex) then
|
---|
2635 | dec(Value)
|
---|
2636 | else
|
---|
2637 | inc(Value);
|
---|
2638 | end;
|
---|
2639 | end;
|
---|
2640 | end;
|
---|
2641 | end; // -- special long list processing - end
|
---|
2642 | if (Value = SFI_END) or (not (Value < Items.Count)) then Value := Items.Count - 1;
|
---|
2643 | if (Value = SFI_TOP) or (Value < 0) then Value := 0;
|
---|
2644 | FFocusIndex := Value;
|
---|
2645 | if Focused or (not FHideSelection) then
|
---|
2646 | ItemIndex := Value;
|
---|
2647 | if MultiSelect then Perform(LB_SETCARETINDEX, FFocusIndex, 0) // LPARAM=0, scrolls into view
|
---|
2648 | else
|
---|
2649 | begin
|
---|
2650 | // LB_SETCARETINDEX doesn't scroll with single select so we have to do it ourselves
|
---|
2651 | // ( a LongList should always come through here - it should never be MultiSelect )
|
---|
2652 | if FocusIndex < TopIndex
|
---|
2653 | then TopIndex := FocusIndex
|
---|
2654 | else if FocusIndex > (TopIndex + FLargeChange)
|
---|
2655 | then TopIndex := HigherOf(FocusIndex - FLargeChange, 0);
|
---|
2656 | end;
|
---|
2657 | // need to have a way to move the focus rectangle for single select listboxs w/o itemtips
|
---|
2658 | // if FItemTipEnable or not MultiSelect then ... Show: if not ItemTipEnable then AWidth := 0?
|
---|
2659 | //
|
---|
2660 | // can't show the item tip from keyboard input for dropdown combo without causing problems
|
---|
2661 | // with mouse capture, post the message to allow the selected attribute to be posted
|
---|
2662 | if FItemTipEnable {and (FParentCombo = nil)}
|
---|
2663 | then PostMessage(Self.Handle, UM_SHOWTIP, Value, 0);
|
---|
2664 | end;
|
---|
2665 |
|
---|
2666 | procedure TORListBox.UMShowTip(var Message: TMessage);
|
---|
2667 | { show item tip, Tip Position in parameters: wParam=X and lParam=Y }
|
---|
2668 | const
|
---|
2669 | NO_CATCH_MOUSE = False;
|
---|
2670 | var
|
---|
2671 | TipPos: TPoint;
|
---|
2672 | TrueOffset :integer;
|
---|
2673 | TmpIdx :integer;
|
---|
2674 | begin
|
---|
2675 | // if listbox is dropdown combo but control is not focused -
|
---|
2676 | if (Parent is TORComboBox) and (FParentCombo <> nil) and (Screen.ActiveControl <> Parent)
|
---|
2677 | then Exit;
|
---|
2678 | // if listbox is dropdown combo and list is not dropped down -
|
---|
2679 | if (FParentCombo <> nil) and (FParentCombo.DroppedDown = False) then Exit;
|
---|
2680 | // if control is not focused -
|
---|
2681 | if (Screen.ActiveControl <> Self) and (Screen.ActiveControl <> Parent) then Exit;
|
---|
2682 | if(FHideSynonyms) then
|
---|
2683 | begin
|
---|
2684 | TrueOffset := TopIndex;
|
---|
2685 | TmpIdx := TopIndex;
|
---|
2686 | while((TmpIdx < Message.wParam) and (TmpIdx < Items.Count)) do
|
---|
2687 | begin
|
---|
2688 | if(Perform(LB_GETITEMHEIGHT, TmpIdx, 0) > 0) then
|
---|
2689 | inc(TrueOffset);
|
---|
2690 | inc(TmpIdx);
|
---|
2691 | end;
|
---|
2692 | end
|
---|
2693 | else
|
---|
2694 | TrueOffset := Message.wParam;
|
---|
2695 | TipPos := ClientToScreen(Point(0, (TrueOffset - TopIndex) * ItemHeight));
|
---|
2696 | //uItemTip.Show(Self, FFocusIndex, TipPos, NO_CATCH_MOUSE);
|
---|
2697 | uItemTip.Show(Self, FFocusIndex, TipPos, FParentCombo = nil); // if DropDown, no mousecapture
|
---|
2698 | end;
|
---|
2699 |
|
---|
2700 | function TORListBox.GetIEN(AnIndex: Integer): Int64;
|
---|
2701 | { return as an integer the first piece of the Item identified by AnIndex }
|
---|
2702 | begin
|
---|
2703 | if (AnIndex < Items.Count) and (AnIndex > -1)
|
---|
2704 | then Result := StrToInt64Def(Piece(Items[AnIndex], FDelimiter, 1), 0)
|
---|
2705 | else Result := 0;
|
---|
2706 | end;
|
---|
2707 |
|
---|
2708 | function TORListBox.GetItemIEN: Int64;
|
---|
2709 | { return as an integer the first piece of the currently selected item }
|
---|
2710 | begin
|
---|
2711 | if ItemIndex > -1
|
---|
2712 | then Result := StrToInt64Def(Piece(Items[ItemIndex], FDelimiter, 1), 0)
|
---|
2713 | else Result := 0;
|
---|
2714 | end;
|
---|
2715 |
|
---|
2716 | function TORListBox.SelectByIEN(AnIEN: Int64): Integer;
|
---|
2717 | { cause the item where the first piece = AnIEN to be selected (sets ItemIndex) }
|
---|
2718 | var
|
---|
2719 | i: Integer;
|
---|
2720 | begin
|
---|
2721 | Result := -1;
|
---|
2722 | for i := 0 to Items.Count - 1 do
|
---|
2723 | if GetIEN(i) = AnIEN then
|
---|
2724 | begin
|
---|
2725 | ItemIndex := i;
|
---|
2726 | Result := i;
|
---|
2727 | break;
|
---|
2728 | end;
|
---|
2729 | end;
|
---|
2730 |
|
---|
2731 | function TORListBox.SetExactByIEN(AnIEN: Int64; const AnItem: string): Integer;
|
---|
2732 | { finds an exact entry (matches IEN) in a list or a long list and returns ItemIndex }
|
---|
2733 | var
|
---|
2734 | ItemFound: Boolean;
|
---|
2735 | i, ListEnd: Integer;
|
---|
2736 | begin
|
---|
2737 | ItemFound := False;
|
---|
2738 | Result := -1;
|
---|
2739 | if FLongList then ListEnd := FWaterMark - 1 else ListEnd := Items.Count - 1;
|
---|
2740 | for i := 0 to ListEnd do if (GetIEN(i) = AnIEN) and (GetDisplayText(i) = AnItem) then
|
---|
2741 | begin
|
---|
2742 | ItemIndex := i;
|
---|
2743 | Result := i;
|
---|
2744 | ItemFound := True;
|
---|
2745 | break;
|
---|
2746 | end;
|
---|
2747 | if FLongList and not ItemFound then
|
---|
2748 | begin
|
---|
2749 | InitLongList(AnItem);
|
---|
2750 | Result := SelectByIEN(AnIEN);
|
---|
2751 | end;
|
---|
2752 | end;
|
---|
2753 |
|
---|
2754 | function TORListBox.GetItemID: Variant;
|
---|
2755 | { return as a variant the first piece of the currently selected item }
|
---|
2756 | begin
|
---|
2757 | if ItemIndex > -1 then Result := Piece(Items[ItemIndex], FDelimiter, 1) else Result := '';
|
---|
2758 | end;
|
---|
2759 |
|
---|
2760 | function TORListBox.SelectByID(const AnID: string): Integer;
|
---|
2761 | { cause the item where the first piece = AnID to be selected (sets ItemIndex) }
|
---|
2762 | var
|
---|
2763 | i: Integer;
|
---|
2764 | begin
|
---|
2765 | Result := -1;
|
---|
2766 | for i := 0 to Items.Count - 1 do
|
---|
2767 | if Piece(Items[i], FDelimiter, 1) = AnID then
|
---|
2768 | begin
|
---|
2769 | ItemIndex := i;
|
---|
2770 | Result := i;
|
---|
2771 | break;
|
---|
2772 | end;
|
---|
2773 | end;
|
---|
2774 |
|
---|
2775 | function TORListBox.GetReference(Index: Integer): Variant;
|
---|
2776 | { retrieves a variant value that is associated with an item in a listbox }
|
---|
2777 | var
|
---|
2778 | ItemRec: PItemRec;
|
---|
2779 | begin
|
---|
2780 | if (Index < 0) or (Index >= Items.Count) then
|
---|
2781 | raise Exception.Create('List Index Out of Bounds');
|
---|
2782 | FFromSelf := True;
|
---|
2783 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0));
|
---|
2784 | FFromSelf := False;
|
---|
2785 | if(assigned(ItemRec)) then
|
---|
2786 | Result := ItemRec^.Reference
|
---|
2787 | else
|
---|
2788 | Result := Null;
|
---|
2789 | end;
|
---|
2790 |
|
---|
2791 | procedure TORListBox.SetReference(Index: Integer; AReference: Variant);
|
---|
2792 | { stores a variant value that is associated with an item in a listbox }
|
---|
2793 | var
|
---|
2794 | ItemRec: PItemRec;
|
---|
2795 | begin
|
---|
2796 | if (Index < 0) or (Index >= Items.Count) then
|
---|
2797 | raise Exception.Create('List Index Out of Bounds');
|
---|
2798 | FFromSelf := True;
|
---|
2799 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0));
|
---|
2800 | FFromSelf := False;
|
---|
2801 | if(assigned(ItemRec)) then
|
---|
2802 | ItemRec^.Reference := AReference;
|
---|
2803 | end;
|
---|
2804 |
|
---|
2805 | function TORListBox.AddReference(const S: string; AReference: Variant): Integer;
|
---|
2806 | { adds a string to a listbox, along with a variant value to be associated with the string }
|
---|
2807 | begin
|
---|
2808 | Result := Items.Add(S);
|
---|
2809 | SetReference(Result, AReference);
|
---|
2810 | end;
|
---|
2811 |
|
---|
2812 | procedure TORListBox.InsertReference(Index: Integer; const S: string; AReference: Variant);
|
---|
2813 | { inserts a string at a position into a listbox, along with its associated variant value }
|
---|
2814 | begin
|
---|
2815 | Items.Insert(Index, S);
|
---|
2816 | SetReference(Index, AReference);
|
---|
2817 | end;
|
---|
2818 |
|
---|
2819 | function TORListBox.IndexOfReference(AReference: Variant): Integer;
|
---|
2820 | { looks through the list of References (variants) and returns the index of the first match }
|
---|
2821 | var
|
---|
2822 | i: Integer;
|
---|
2823 | begin
|
---|
2824 | Result := -1;
|
---|
2825 | for i := 0 to Items.Count - 1 do
|
---|
2826 | if GetReference(i) = AReference then
|
---|
2827 | begin
|
---|
2828 | Result := i;
|
---|
2829 | Break;
|
---|
2830 | end;
|
---|
2831 | end;
|
---|
2832 |
|
---|
2833 | function TORListBox.GetTabPositions: string;
|
---|
2834 | { returns the character based tab stops that are currently set, if any }
|
---|
2835 | begin
|
---|
2836 | if(FTabPosInPixels) then
|
---|
2837 | Result := IntArrayToString(FTabPix)
|
---|
2838 | else
|
---|
2839 | Result := IntArrayToString(FTabPos);
|
---|
2840 | end;
|
---|
2841 |
|
---|
2842 | procedure TORListBox.SetTabPositions(const Value: string);
|
---|
2843 | { converts a string of character position tab stops to an array of integer & sets now tabs }
|
---|
2844 | var
|
---|
2845 | TabTmp: array[0..MAX_TABS] of Integer;
|
---|
2846 | i: Integer;
|
---|
2847 | begin
|
---|
2848 | StringToIntArray(Value, TabTmp, TRUE);
|
---|
2849 | for i := 2 to TabTmp[0] do
|
---|
2850 | if (abs(TabTmp[i]) < abs(TabTmp[i - 1])) or
|
---|
2851 | (TabTmp[i] = TabTmp[i - 1]) then
|
---|
2852 | raise Exception.Create('Tab positions must be in ascending order');
|
---|
2853 | if(FTabPosInPixels) then
|
---|
2854 | begin
|
---|
2855 | for i := 0 to TabTmp[0] do FTabPix[i] := TabTmp[i];
|
---|
2856 | end
|
---|
2857 | else
|
---|
2858 | begin
|
---|
2859 | for i := 0 to TabTmp[0] do FTabPos[i] := TabTmp[i];
|
---|
2860 | end;
|
---|
2861 | SetTabStops;
|
---|
2862 | if FTabPos[0] > 0 then FWhiteSpace := #9 else FWhiteSpace := ' ';
|
---|
2863 | ResetItems;
|
---|
2864 | end;
|
---|
2865 |
|
---|
2866 | procedure TORListBox.SetTabPosInPixels(const Value: boolean);
|
---|
2867 | begin
|
---|
2868 | if(FTabPosInPixels <> Value) then
|
---|
2869 | begin
|
---|
2870 | FTabPosInPixels := Value;
|
---|
2871 | SetTabStops;
|
---|
2872 | end;
|
---|
2873 | end;
|
---|
2874 |
|
---|
2875 | procedure TORListBox.SetTabStops;
|
---|
2876 | { sets new tabs stops based on dialog units, FTabPix array also used by ItemTip }
|
---|
2877 | var
|
---|
2878 | TabDlg: array[0..MAX_TABS] of Integer;
|
---|
2879 | i, AveWidth: Integer;
|
---|
2880 | begin
|
---|
2881 | FillChar(TabDlg, SizeOf(TabDlg), 0);
|
---|
2882 | AveWidth := FontWidthPixel(Self.Font.Handle);
|
---|
2883 | if(FTabPosInPixels) then
|
---|
2884 | begin
|
---|
2885 | FillChar(FTabPos, SizeOf(FTabPos), 0);
|
---|
2886 | FTabPos[0] := FTabPix[0];
|
---|
2887 | for i := 1 to FTabPix[0] do
|
---|
2888 | begin
|
---|
2889 | FTabPos[i] := FTabPix[i] div AveWidth;
|
---|
2890 | TabDlg[i] := (FTabPix[i] * 4) div AveWidth;
|
---|
2891 | end;
|
---|
2892 | end
|
---|
2893 | else
|
---|
2894 | begin
|
---|
2895 | FillChar(FTabPix, SizeOf(FTabPix), 0);
|
---|
2896 | FTabPix[0] := FTabPos[0];
|
---|
2897 | for i := 1 to FTabPos[0] do
|
---|
2898 | begin
|
---|
2899 | // do dialog units first so that pixels gets the same rounding error
|
---|
2900 | TabDlg[i] := FTabPos[i] * 4; // 4 dialog units per character
|
---|
2901 | FTabPix[i] := (TabDlg[i] * AveWidth) div 4;
|
---|
2902 | end;
|
---|
2903 | end;
|
---|
2904 | TabDlg[0] := FTabPos[0];
|
---|
2905 | Perform(LB_SETTABSTOPS, TabDlg[0], Integer(@TabDlg[1]));
|
---|
2906 | Refresh;
|
---|
2907 | end;
|
---|
2908 |
|
---|
2909 | function TORListBox.SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
2910 | begin
|
---|
2911 | Result := (PropertyID = DynaPropAccesibilityCaption);
|
---|
2912 | end;
|
---|
2913 |
|
---|
2914 | procedure TORListBox.SetHideSynonyms(Value :boolean);
|
---|
2915 | var
|
---|
2916 | TmpIH :integer;
|
---|
2917 |
|
---|
2918 | begin
|
---|
2919 | if(FHideSynonyms <> Value) then
|
---|
2920 | begin
|
---|
2921 | if((Value) and (not FLongList)) then
|
---|
2922 | raise Exception.Create('Hide Synonyms only allowed on Long Lists');
|
---|
2923 | FHideSynonyms := Value;
|
---|
2924 | if(not FHideSynonyms) then
|
---|
2925 | begin
|
---|
2926 | Style := lbStandard;
|
---|
2927 | end
|
---|
2928 | else
|
---|
2929 | begin
|
---|
2930 | if(FSynonymChars = '') then
|
---|
2931 | FSynonymChars := '<>';
|
---|
2932 | TmpIH := ItemHeight;
|
---|
2933 | Style := lbOwnerDrawVariable;
|
---|
2934 | ItemHeight := TmpIH;
|
---|
2935 | end;
|
---|
2936 | end;
|
---|
2937 | end;
|
---|
2938 |
|
---|
2939 | procedure TORListBox.SetSynonymChars(Value :string);
|
---|
2940 | begin
|
---|
2941 | if(FSynonymChars <> Value) then
|
---|
2942 | begin
|
---|
2943 | FSynonymChars := Value;
|
---|
2944 | if((Value = '') and (FHideSynonyms)) then
|
---|
2945 | SetHideSynonyms(FALSE);
|
---|
2946 | if(FHideSynonyms) then
|
---|
2947 | begin
|
---|
2948 | SetHideSynonyms(FALSE);
|
---|
2949 | SetHideSynonyms(TRUE);
|
---|
2950 | end;
|
---|
2951 | end;
|
---|
2952 | end;
|
---|
2953 |
|
---|
2954 | function TORListBox.GetStyle: TListBoxStyle;
|
---|
2955 | begin
|
---|
2956 | Result := inherited Style;
|
---|
2957 | end;
|
---|
2958 |
|
---|
2959 | procedure TORListBox.SetStyle(Value: TListBoxStyle);
|
---|
2960 | begin
|
---|
2961 | if(Value <> lbOwnerDrawVariable) and (FHideSynonyms) then
|
---|
2962 | FHideSynonyms := FALSE;
|
---|
2963 | if(FCheckBoxes) and (Value = lbStandard) then
|
---|
2964 | FCheckBoxes := FALSE;
|
---|
2965 | inherited Style := Value;
|
---|
2966 | end;
|
---|
2967 |
|
---|
2968 | procedure TORListBox.SetDelimiter(Value: Char);
|
---|
2969 | { change the delimiter used in conjunction with the pieces property (default = '^') }
|
---|
2970 | begin
|
---|
2971 | FDelimiter := Value;
|
---|
2972 | ResetItems;
|
---|
2973 | end;
|
---|
2974 |
|
---|
2975 | function TORListBox.GetPieces: string;
|
---|
2976 | { returns the pieces of an item currently selected for display }
|
---|
2977 | begin
|
---|
2978 | Result := IntArrayToString(FPieces);
|
---|
2979 | end;
|
---|
2980 |
|
---|
2981 | procedure TORListBox.SetPieces(const Value: string);
|
---|
2982 | { converts a string of comma-delimited integers into an array of string pieces to display }
|
---|
2983 | begin
|
---|
2984 | StringToIntArray(Value, FPieces);
|
---|
2985 | ResetItems;
|
---|
2986 | end;
|
---|
2987 |
|
---|
2988 | procedure TORListBox.ResetItems;
|
---|
2989 | { saves listbox objects then rebuilds listbox including references and user objects }
|
---|
2990 | var
|
---|
2991 | SaveItems: TList;
|
---|
2992 | Strings: TStringList;
|
---|
2993 | i, Pos: Integer;
|
---|
2994 | ItemRec, ItemRec2: PItemRec;
|
---|
2995 | SaveListMode: Boolean;
|
---|
2996 | RealVerify: Boolean;
|
---|
2997 | begin
|
---|
2998 | SaveListMode := False;
|
---|
2999 | Strings := nil;
|
---|
3000 | SaveItems := nil;
|
---|
3001 | RealVerify := TORStrings(Items).Verification;
|
---|
3002 | try
|
---|
3003 | TORStrings(Items).Verification := False;
|
---|
3004 | HandleNeeded; // ensures that Items is valid if in the middle of RecreateWnd
|
---|
3005 | SaveListMode := FLongList;
|
---|
3006 | Strings := TStringList.Create;
|
---|
3007 | SaveItems := TList.Create;
|
---|
3008 | FLongList := False; // so don't have to track WaterMark
|
---|
3009 | FFromSelf := True;
|
---|
3010 | for i := 0 to Items.Count - 1 do // put pointers to TItemRec in SaveItems
|
---|
3011 | begin
|
---|
3012 | ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, i, 0));
|
---|
3013 | SaveItems.Add(ItemRec);
|
---|
3014 | end;
|
---|
3015 | Strings.Assign(Items);
|
---|
3016 | Items.Clear; // still FromSelf so don't dispose recs
|
---|
3017 | FFromSelf := False;
|
---|
3018 | for i := 0 to SaveItems.Count - 1 do // use saved ItemRecs to rebuild listbox
|
---|
3019 | begin
|
---|
3020 | ItemRec := SaveItems[i];
|
---|
3021 | if(assigned(ItemRec)) then
|
---|
3022 | begin
|
---|
3023 | Pos := Items.AddObject(Strings[i], ItemRec^.UserObject);
|
---|
3024 | // CQ 11491 - Changing TabPositions, etc. was wiping out check box status.
|
---|
3025 | FFromSelf := True;
|
---|
3026 | ItemRec2 := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Pos, 0));
|
---|
3027 | FFromSelf := False;
|
---|
3028 | if(assigned(ItemRec2)) then
|
---|
3029 | begin
|
---|
3030 | ItemRec2^.Reference := ItemRec^.Reference;
|
---|
3031 | ItemRec2^.CheckedState := ItemRec^.CheckedState;
|
---|
3032 | end;
|
---|
3033 | end;
|
---|
3034 | end;
|
---|
3035 | finally
|
---|
3036 | SaveItems.Free;
|
---|
3037 | Strings.Free;
|
---|
3038 | TORStrings(Items).Verification := RealVerify;
|
---|
3039 | FLongList := SaveListMode;
|
---|
3040 | end;
|
---|
3041 | end;
|
---|
3042 |
|
---|
3043 | procedure TORListBox.SetLongList(Value: Boolean);
|
---|
3044 | { changes the list box so that it runs in LongList mode (calls OnNeedData) }
|
---|
3045 | begin
|
---|
3046 | if Value <> FLongList then
|
---|
3047 | begin
|
---|
3048 | if Value = True then
|
---|
3049 | CreateScrollBar
|
---|
3050 | else
|
---|
3051 | begin
|
---|
3052 | FreeScrollBar;
|
---|
3053 | if(FHideSynonyms) then
|
---|
3054 | SetHideSynonyms(FALSE);
|
---|
3055 | end;
|
---|
3056 | end;
|
---|
3057 | end;
|
---|
3058 |
|
---|
3059 | procedure TORListBox.AdjustScrollBar;
|
---|
3060 | { ensures that the scrollbar used for a long list is placed properly within the listbox }
|
---|
3061 | var
|
---|
3062 | L, T, W, H, OffsetLT, OffsetWH: Integer;
|
---|
3063 | begin
|
---|
3064 | if uNewStyle then begin OffsetLT := 2; OffsetWH := 4; end // Win95
|
---|
3065 | else begin OffsetLT := 0; OffsetWH := 0; end; // Win3.1
|
---|
3066 | W := GetSystemMetrics(SM_CXVSCROLL);
|
---|
3067 | L := Left + Width - W - OffsetLT;
|
---|
3068 | T := Top + OffsetLT;
|
---|
3069 | H := Height - OffsetWH;
|
---|
3070 | FScrollBar.SetBounds(L, T, W, H);
|
---|
3071 | FScrollBar.Invalidate;
|
---|
3072 | end;
|
---|
3073 |
|
---|
3074 | procedure TORListBox.CreateScrollBar;
|
---|
3075 | { a long list uses it's own scrollbar (mapped to APLHA_DISTRIBUTION, rather than the listbox's }
|
---|
3076 | begin
|
---|
3077 | FLongList := True;
|
---|
3078 | if MultiSelect then MultiSelect := False; // LongLists do not support multiple selections
|
---|
3079 | FScrollBar := TScrollBar.Create(Self);
|
---|
3080 | FScrollBar.Kind := sbVertical;
|
---|
3081 | FScrollBar.TabStop := False;
|
---|
3082 | FScrollBar.ControlStyle := FScrollBar.ControlStyle - [csCaptureMouse];
|
---|
3083 | AdjustScrollBar;
|
---|
3084 | FScrollBar.OnScroll := ScrollTo;
|
---|
3085 | if FParentCombo = nil
|
---|
3086 | then FScrollBar.Parent := Parent
|
---|
3087 | else FScrollBar.Parent := FParentCombo.FDropPanel;
|
---|
3088 | end;
|
---|
3089 |
|
---|
3090 | procedure TORListBox.FreeScrollBar;
|
---|
3091 | { frees the scrollbar for a longlist (called when LongList property becomes false) }
|
---|
3092 | begin
|
---|
3093 | FLongList := False;
|
---|
3094 | FScrollBar.Free; // don't call from destroy because scrollbar may already be free
|
---|
3095 | FScrollBar := nil;
|
---|
3096 | end;
|
---|
3097 |
|
---|
3098 | procedure TORListBox.ForDataUse(Strings: TStrings);
|
---|
3099 | { adds or inserts items into a list box after determining the proper collating sequence }
|
---|
3100 | var
|
---|
3101 | Ascend: Boolean;
|
---|
3102 | FirstItem, LastItem: string;
|
---|
3103 | i: Integer;
|
---|
3104 | begin
|
---|
3105 | if Strings.Count = 0 then Exit;
|
---|
3106 | { To prevent the problem where the initial list item(s) are returned repeatedly because the
|
---|
3107 | DisplayText is longer than the subscript in a cross-reference, compare the last item
|
---|
3108 | returned with the first item in the long list. If they are the same, assume the long
|
---|
3109 | list is already scrolled to the first item. }
|
---|
3110 | if (FDirection = LL_REVERSE) and (FWaterMark < Items.Count) and
|
---|
3111 | (CompareText(Strings[Strings.Count - 1], Items[FWaterMark]) = 0) then Exit;
|
---|
3112 |
|
---|
3113 | FirstItem := TextToShow(Strings[0]);
|
---|
3114 | LastItem := TextToShow(Strings[Strings.Count-1]);
|
---|
3115 | Ascend := True;
|
---|
3116 | case FDirection of
|
---|
3117 | LL_REVERSE: if CompareText(FirstItem, LastItem) < 0 then Ascend := False;
|
---|
3118 | LL_FORWARD: if CompareText(FirstItem, LastItem) > 0 then Ascend := False;
|
---|
3119 | end;
|
---|
3120 | case Ascend of // should call AddObject & InsertObject instead?
|
---|
3121 | False: case FDirection of
|
---|
3122 | LL_REVERSE: for i := Strings.Count - 1 downto 0 do Items.Insert(FInsertAt, Strings[i]);
|
---|
3123 | LL_FORWARD: for i := Strings.Count - 1 downto 0 do Items.Add(Strings[i]);
|
---|
3124 | end;
|
---|
3125 | True: case FDirection of
|
---|
3126 | LL_REVERSE: for i := 0 to Strings.Count - 1 do Items.Insert(FInsertAt, Strings[i]);
|
---|
3127 | LL_FORWARD: for i := 0 to Strings.Count - 1 do Items.Add(Strings[i]);
|
---|
3128 | end;
|
---|
3129 | end;
|
---|
3130 | end;
|
---|
3131 |
|
---|
3132 | procedure TORListBox.InitLongList(S: string);
|
---|
3133 | { clears the listbox starting at FWaterMark and makes the initial NeedData call }
|
---|
3134 | var
|
---|
3135 | index: integer;
|
---|
3136 | begin
|
---|
3137 | if FLongList then
|
---|
3138 | begin
|
---|
3139 | if LookUpPiece <> 0 then
|
---|
3140 | begin
|
---|
3141 | index := GetStringIndex(S);
|
---|
3142 | if index > -1 then
|
---|
3143 | S := Piece(Items[index],Delimiter,LookUpPiece);
|
---|
3144 | end;
|
---|
3145 | if CaseChanged then
|
---|
3146 | S := UpperCase(S);
|
---|
3147 | // decrement last char & concat '~' for $ORDER
|
---|
3148 | if Length(S) > 0 then S := Copy(S, 1, Length(S) - 1) + Pred(S[Length(S)]) + '~';
|
---|
3149 | NeedData(LL_POSITION, S);
|
---|
3150 | if S = '' then TopIndex := 0 else TopIndex := FWaterMark;
|
---|
3151 | FScrollBar.Position := PositionThumb;
|
---|
3152 | end;
|
---|
3153 | end;
|
---|
3154 |
|
---|
3155 | procedure TORListBox.InsertSeparator;
|
---|
3156 | begin
|
---|
3157 | if FWaterMark > 0 then
|
---|
3158 | begin
|
---|
3159 | Items.Insert(FWaterMark,LLS_LINE);
|
---|
3160 | Items.Insert(FWaterMark,LLS_SPACE);
|
---|
3161 | end;
|
---|
3162 | end;
|
---|
3163 |
|
---|
3164 | procedure TORListBox.ClearTop;
|
---|
3165 | { clears a long listbox up to FWaterMark (doesn't clear long list) }
|
---|
3166 | var
|
---|
3167 | i: Integer;
|
---|
3168 | begin
|
---|
3169 | SendMessage(Handle, WM_SETREDRAW, NOREDRAW, 0);
|
---|
3170 | for i := FWaterMark - 1 downto 0 do Items.Delete(i);
|
---|
3171 | SendMessage(Handle, WM_SETREDRAW, DOREDRAW, 0);
|
---|
3172 | Invalidate;
|
---|
3173 | end;
|
---|
3174 |
|
---|
3175 | procedure TORListBox.NeedData(Direction: Integer; StartFrom: string);
|
---|
3176 | { called whenever the longlist needs more data inserted at a certain point into the listbox }
|
---|
3177 | var
|
---|
3178 | CtrlPos, CharPos, index: Integer;
|
---|
3179 |
|
---|
3180 | procedure ClearLong;
|
---|
3181 | { clears a portion or all of the longlist to conserve the memory it occupies }
|
---|
3182 | var
|
---|
3183 | i: Integer;
|
---|
3184 | begin
|
---|
3185 | case FDirection of
|
---|
3186 | LL_REVERSE: for i := Items.Count - 1 downto
|
---|
3187 | HigherOf(FCurrentTop + FLargeChange, FWaterMark) do Items.Delete(i);
|
---|
3188 | LL_POSITION: for i := Items.Count - 1 downto FWaterMark do Items.Delete(i);
|
---|
3189 | LL_FORWARD: for i := FCurrentTop - 1 downto FWaterMark do Items.Delete(i);
|
---|
3190 | end;
|
---|
3191 | end;
|
---|
3192 |
|
---|
3193 | begin {NeedData}
|
---|
3194 | FFromNeedData := True;
|
---|
3195 | FFirstLoad := False;
|
---|
3196 | FDataAdded := False;
|
---|
3197 | FDirection := Direction;
|
---|
3198 | SendMessage(Handle, WM_SETREDRAW, NOREDRAW, 0);
|
---|
3199 | if Items.Count > 1000 then ClearLong;
|
---|
3200 | case FDirection of
|
---|
3201 | LL_REVERSE: if FWaterMark < Items.Count then StartFrom := DisplayText[FWaterMark];
|
---|
3202 | LL_POSITION: begin
|
---|
3203 | ClearLong;
|
---|
3204 | if StartFrom = #127#127#127 then
|
---|
3205 | begin
|
---|
3206 | FDirection := LL_REVERSE;
|
---|
3207 | StartFrom := '';
|
---|
3208 | end
|
---|
3209 | else FDirection := LL_FORWARD;
|
---|
3210 | end;
|
---|
3211 | LL_FORWARD: if (FWaterMark < Items.Count) and (Items.Count > 0)
|
---|
3212 | then StartFrom := DisplayText[Items.Count - 1];
|
---|
3213 | end;
|
---|
3214 | if LookupPiece <> 0 then
|
---|
3215 | begin
|
---|
3216 | index := GetStringIndex(StartFrom);
|
---|
3217 | if index > -1 then
|
---|
3218 | StartFrom := Piece(Items[index],Delimiter,LookUpPiece);
|
---|
3219 | end;
|
---|
3220 | if CaseChanged then
|
---|
3221 | StartFrom := Uppercase(StartFrom);
|
---|
3222 | StartFrom := Copy(StartFrom, 1, 128); // limit length to 128 characters
|
---|
3223 | CtrlPos := 0; // make sure no ctrl characters
|
---|
3224 | for CharPos := 1 to Length(StartFrom) do if StartFrom[CharPos] in [#0..#31] then
|
---|
3225 | begin
|
---|
3226 | CtrlPos := CharPos;
|
---|
3227 | break;
|
---|
3228 | end;
|
---|
3229 | if CtrlPos > 0 then StartFrom := Copy(StartFrom, 1, CtrlPos - 1);
|
---|
3230 | if FDirection = LL_FORWARD then FInsertAt := Items.Count else FInsertAt := FWaterMark;
|
---|
3231 | if Assigned(FOnNeedData) then FOnNeedData(Self, copy(StartFrom, 1, MaxNeedDataLen), FDirection, FInsertAt);
|
---|
3232 | SendMessage(Handle, WM_SETREDRAW, DOREDRAW, 0);
|
---|
3233 | FFromNeedData := False;
|
---|
3234 | Invalidate;
|
---|
3235 | end;
|
---|
3236 |
|
---|
3237 | function TORListBox.PositionThumb: Integer;
|
---|
3238 | { returns the proper thumb position for the TopIndex item relative to ALPHA_DISTRIBUTION }
|
---|
3239 | var
|
---|
3240 | x: string;
|
---|
3241 | begin
|
---|
3242 | Result := 1;
|
---|
3243 | x := DisplayText[TopIndex];
|
---|
3244 | if (FWaterMark > 0) and (TopIndex < FWaterMark)
|
---|
3245 | then Result := 0 // short list visible
|
---|
3246 | else while (CompareText(ALPHA_DISTRIBUTION[Result], x) < 0) and (Result < 100) do
|
---|
3247 | Inc(Result); // only long list visible
|
---|
3248 | end;
|
---|
3249 |
|
---|
3250 | procedure TORListBox.ScrollTo(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
|
---|
3251 | { event code for the longlist scrollbar, adjusts TopIndex & calls OnNeedData as necessary }
|
---|
3252 | var
|
---|
3253 | Count, Goal, Dir :integer;
|
---|
3254 | Done :boolean;
|
---|
3255 |
|
---|
3256 | begin
|
---|
3257 | uItemTip.Hide;
|
---|
3258 | FCurrentTop := TopIndex;
|
---|
3259 | if(ScrollCode = scPosition) then
|
---|
3260 | begin
|
---|
3261 | NeedData(LL_POSITION, ALPHA_DISTRIBUTION[ScrollPos]);
|
---|
3262 | case ScrollPos of
|
---|
3263 | 0: TopIndex := 0;
|
---|
3264 | 1..99: TopIndex := FWaterMark;
|
---|
3265 | 100: TopIndex := HigherOf(Items.Count - FLargeChange, 0);
|
---|
3266 | end;
|
---|
3267 | FFocusIndex := TopIndex;
|
---|
3268 | end
|
---|
3269 | else
|
---|
3270 | if(HideSynonyms) then
|
---|
3271 | begin
|
---|
3272 | Count := 0;
|
---|
3273 | case ScrollCode of
|
---|
3274 | scLineUp: begin Dir := -1; Goal := 1; end;
|
---|
3275 | scLineDown: begin Dir := 1; Goal := 1; end;
|
---|
3276 | scPageUp: begin Dir := -1; Goal := FLargeChange; end;
|
---|
3277 | scPageDown: begin Dir := 1; Goal := FLargeChange; end;
|
---|
3278 | else
|
---|
3279 | exit;
|
---|
3280 | end;
|
---|
3281 | repeat
|
---|
3282 | Done := FALSE;
|
---|
3283 | if(Dir > 0) then
|
---|
3284 | begin
|
---|
3285 | if (FCurrentTop + (FLargeChange * 2)) > (Items.Count - 1) then
|
---|
3286 | NeedData(LL_FORWARD, '');
|
---|
3287 | if(FCurrentTop >= Items.Count - 1) then
|
---|
3288 | begin
|
---|
3289 | FCurrentTop := Items.Count - 1;
|
---|
3290 | Done := TRUE;
|
---|
3291 | end;
|
---|
3292 | end
|
---|
3293 | else
|
---|
3294 | begin
|
---|
3295 | if (FCurrentTop - FLargeChange) < FWaterMark then NeedData(LL_REVERSE, '');
|
---|
3296 | if(FCurrentTop <= 0) then
|
---|
3297 | begin
|
---|
3298 | FCurrentTop := 0;
|
---|
3299 | Done := TRUE;
|
---|
3300 | end;
|
---|
3301 | end;
|
---|
3302 | if(not Done) then
|
---|
3303 | begin
|
---|
3304 | FCurrentTop := FCurrentTop + Dir;
|
---|
3305 | if(Perform(LB_GETITEMHEIGHT, FCurrentTop, 0) > 0) then
|
---|
3306 | begin
|
---|
3307 | inc(Count);
|
---|
3308 | Done := (Count >= Goal);
|
---|
3309 | end;
|
---|
3310 | end;
|
---|
3311 | until Done;
|
---|
3312 | TopIndex := FCurrentTop;
|
---|
3313 | end
|
---|
3314 | else
|
---|
3315 | begin
|
---|
3316 | case ScrollCode of
|
---|
3317 | scLineUp: begin
|
---|
3318 | if (FCurrentTop - FLargeChange) < FWaterMark then NeedData(LL_REVERSE, '');
|
---|
3319 | TopIndex := HigherOf(FCurrentTop - 1, 0);
|
---|
3320 | end;
|
---|
3321 | scLineDown: begin
|
---|
3322 | if (FCurrentTop + (FLargeChange * 2)) > (Items.Count - 1)
|
---|
3323 | then NeedData(LL_FORWARD, '');
|
---|
3324 | TopIndex := LowerOf(FCurrentTop + 1, Items.Count - 1);
|
---|
3325 | end;
|
---|
3326 | scPageUp: begin
|
---|
3327 | if (FCurrentTop - FLargeChange) < FWaterMark then NeedData(LL_REVERSE, '');
|
---|
3328 | TopIndex := HigherOf(FCurrentTop - FLargeChange, 0);
|
---|
3329 | end;
|
---|
3330 | scPageDown: begin
|
---|
3331 | if (FCurrentTop + (FLargeChange * 2)) > (Items.Count - 1)
|
---|
3332 | then NeedData(LL_FORWARD, '');
|
---|
3333 | TopIndex := LowerOf(FCurrentTop + FLargeChange, Items.Count - 1);
|
---|
3334 | end;
|
---|
3335 | end;
|
---|
3336 | end;
|
---|
3337 | if (ScrollPos > 0) and (ScrollPos < 100) then ScrollPos := PositionThumb;
|
---|
3338 | end;
|
---|
3339 |
|
---|
3340 | function TORListBox.GetStringIndex(const AString: string): Integer;
|
---|
3341 | {returns the index of the first string that partially matches AString}
|
---|
3342 | var
|
---|
3343 | i: Integer;
|
---|
3344 | begin
|
---|
3345 | Result := -1;
|
---|
3346 | if Length(AString) > 0 then {*KCM*}
|
---|
3347 | begin
|
---|
3348 | if not FLongList then // Normal List
|
---|
3349 | begin
|
---|
3350 | Result := SendMessage(Handle, LB_FINDSTRING, -1, Longint(PChar(AString)));
|
---|
3351 | if Result = LB_ERR then Result := -1;
|
---|
3352 | end else // Long List
|
---|
3353 | begin
|
---|
3354 | if FScrollBar.Position = 0 then for i := 0 to FWatermark - 1 do
|
---|
3355 | begin
|
---|
3356 | if CompareText(AString, Copy(DisplayText[i], 1, Length(AString))) = 0 then
|
---|
3357 | begin
|
---|
3358 | Result := i;
|
---|
3359 | break;
|
---|
3360 | end;
|
---|
3361 | end;
|
---|
3362 | if Result < 0 then
|
---|
3363 | begin
|
---|
3364 | Result := SendMessage(Handle, LB_FINDSTRING, FWaterMark - 1, Longint(PChar(AString)));
|
---|
3365 | if Result < FWaterMark then Result := -1;
|
---|
3366 | end; {if Result}
|
---|
3367 | end; {if not FLongList}
|
---|
3368 | end; {if Length(AString)}
|
---|
3369 | end;
|
---|
3370 |
|
---|
3371 | function TORListBox.SelectString(const AString: string): Integer;
|
---|
3372 | { causes the first string that partially matches AString to be selected & returns the index }
|
---|
3373 | var
|
---|
3374 | x: string;
|
---|
3375 | i: Integer;
|
---|
3376 | index: integer;
|
---|
3377 | begin
|
---|
3378 | Result := -1;
|
---|
3379 | if Length(AString) > 0 then {*KCM*}
|
---|
3380 | begin
|
---|
3381 | if not FLongList then // Normal List
|
---|
3382 | begin
|
---|
3383 | Result := SendMessage(Handle, LB_FINDSTRING, -1, Longint(PChar(AString)));
|
---|
3384 | if Result = LB_ERR then Result := -1;
|
---|
3385 | // use FFocusIndex instead of FocusIndex to reduce flashing
|
---|
3386 | FFocusIndex := Result;
|
---|
3387 | end else // Long List
|
---|
3388 | begin
|
---|
3389 | if FScrollBar.Position = 0 then for i := 0 to FWatermark - 1 do
|
---|
3390 | begin
|
---|
3391 | if CompareText(AString, Copy(DisplayText[i], 1, Length(AString))) = 0 then
|
---|
3392 | begin
|
---|
3393 | Result := i;
|
---|
3394 | break;
|
---|
3395 | end;
|
---|
3396 | end;
|
---|
3397 | if not StringBetween(AString, DisplayText[FWaterMark], DisplayText[Items.Count - 1]) then
|
---|
3398 | begin
|
---|
3399 | x := AString;
|
---|
3400 | if LookupPiece <> 0 then
|
---|
3401 | begin
|
---|
3402 | index := GetStringIndex(x);
|
---|
3403 | if index > -1 then
|
---|
3404 | x := Piece(Items[index],Delimiter,LookUpPiece);
|
---|
3405 | end;
|
---|
3406 | if CaseChanged then
|
---|
3407 | x := UpperCase(x);
|
---|
3408 | // decrement last char & concat '~' for $ORDER
|
---|
3409 | if Length(x) > 0 then x := Copy(x, 1, Length(x) - 1) + Pred(x[Length(x)]) + '~';
|
---|
3410 | NeedData(LL_POSITION, x);
|
---|
3411 | end;
|
---|
3412 | if Result < 0 then
|
---|
3413 | begin
|
---|
3414 | Result := SendMessage(Handle, LB_FINDSTRING, FWaterMark - 1, Longint(PChar(AString)));
|
---|
3415 | if Result < FWaterMark then Result := -1;
|
---|
3416 | if Result >= FWatermark then FocusIndex := Result;
|
---|
3417 | uItemTip.Hide;
|
---|
3418 | end; {if Result}
|
---|
3419 | end; {if not FLongList}
|
---|
3420 | end; {if Length(AString)}
|
---|
3421 | ItemIndex := Result;
|
---|
3422 | FFocusIndex := Result;
|
---|
3423 | if Result > -1 then TopIndex := Result; // will scroll item into view
|
---|
3424 | if FLongList then FScrollBar.Position := PositionThumb; // done after topindex set
|
---|
3425 | end;
|
---|
3426 |
|
---|
3427 | procedure TORListBox.SetCheckBoxes(const Value: boolean);
|
---|
3428 | begin
|
---|
3429 | if(FCheckBoxes <> Value) then
|
---|
3430 | begin
|
---|
3431 | FCheckBoxes := Value;
|
---|
3432 | if(Value) then
|
---|
3433 | begin
|
---|
3434 | if(GetStyle = lbStandard) then
|
---|
3435 | SetStyle(lbOwnerDrawFixed);
|
---|
3436 | if(inherited MultiSelect) then
|
---|
3437 | SetMultiSelect(FALSE);
|
---|
3438 | end;
|
---|
3439 | invalidate;
|
---|
3440 | end;
|
---|
3441 | end;
|
---|
3442 |
|
---|
3443 | procedure TORListBox.SetFlatCheckBoxes(const Value: boolean);
|
---|
3444 | begin
|
---|
3445 | if(FFlatCheckBoxes <> Value) then
|
---|
3446 | begin
|
---|
3447 | FFlatCheckBoxes := Value;
|
---|
3448 | invalidate;
|
---|
3449 | end;
|
---|
3450 | end;
|
---|
3451 |
|
---|
3452 | function TORListBox.GetChecked(Index: Integer): Boolean;
|
---|
3453 | var
|
---|
3454 | ItemRec: PItemRec;
|
---|
3455 |
|
---|
3456 | begin
|
---|
3457 | Result := False;
|
---|
3458 | if Index < 0 then exit;
|
---|
3459 | FFromSelf := True;
|
---|
3460 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0));
|
---|
3461 | FFromSelf := FALSE;
|
---|
3462 | if(assigned(ItemRec)) then
|
---|
3463 | Result := (ItemRec^.CheckedState = cbChecked)
|
---|
3464 | else
|
---|
3465 | Result := False;
|
---|
3466 | end;
|
---|
3467 |
|
---|
3468 | procedure TORListBox.SetChecked(Index: Integer; const Value: Boolean);
|
---|
3469 | var
|
---|
3470 | ItemRec: PItemRec;
|
---|
3471 | Rect: TRect;
|
---|
3472 |
|
---|
3473 | begin
|
---|
3474 | FFromSelf := True;
|
---|
3475 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0));
|
---|
3476 | FFromSelf := False;
|
---|
3477 | if (assigned(ItemRec)) and (Value <> (ItemRec^.CheckedState = cbChecked)) then
|
---|
3478 | begin
|
---|
3479 | if(Value) then
|
---|
3480 | ItemRec^.CheckedState := cbChecked
|
---|
3481 | else
|
---|
3482 | ItemRec^.CheckedState := cbUnChecked;
|
---|
3483 | Rect := ItemRect(Index);
|
---|
3484 | InvalidateRect(Handle, @Rect, FALSE);
|
---|
3485 | if(assigned(FOnClickCheck)) then
|
---|
3486 | FOnClickCheck(Self, Index);
|
---|
3487 | end;
|
---|
3488 | end;
|
---|
3489 |
|
---|
3490 | function TORListBox.GetCheckedState(Index: Integer): TCheckBoxState;
|
---|
3491 | var
|
---|
3492 | ItemRec: PItemRec;
|
---|
3493 |
|
---|
3494 | begin
|
---|
3495 | FFromSelf := True;
|
---|
3496 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0));
|
---|
3497 | FFromSelf := FALSE;
|
---|
3498 | if(assigned(ItemRec)) then
|
---|
3499 | Result := ItemRec^.CheckedState
|
---|
3500 | else
|
---|
3501 | Result := cbGrayed;
|
---|
3502 | end;
|
---|
3503 |
|
---|
3504 | procedure TORListBox.SetCheckedState(Index: Integer;
|
---|
3505 | const Value: TCheckBoxState);
|
---|
3506 | var
|
---|
3507 | ItemRec: PItemRec;
|
---|
3508 | Rect: TRect;
|
---|
3509 |
|
---|
3510 | begin
|
---|
3511 | FFromSelf := True;
|
---|
3512 | ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0));
|
---|
3513 | FFromSelf := False;
|
---|
3514 | if (assigned(ItemRec)) and (Value <> ItemRec^.CheckedState) then
|
---|
3515 | begin
|
---|
3516 | ItemRec^.CheckedState := Value;
|
---|
3517 | Rect := ItemRect(Index);
|
---|
3518 | InvalidateRect(Handle, @Rect, FALSE);
|
---|
3519 | if(assigned(FOnClickCheck)) then
|
---|
3520 | FOnClickCheck(Self, Index);
|
---|
3521 | end;
|
---|
3522 | end;
|
---|
3523 |
|
---|
3524 | function TORListBox.GetMultiSelect: boolean;
|
---|
3525 | begin
|
---|
3526 | result := inherited MultiSelect;
|
---|
3527 | end;
|
---|
3528 |
|
---|
3529 | procedure TORListBox.SetMultiSelect(Value: boolean);
|
---|
3530 | begin
|
---|
3531 | inherited SetMultiSelect(Value);
|
---|
3532 | if(Value) then SetCheckBoxes(FALSE);
|
---|
3533 | end;
|
---|
3534 |
|
---|
3535 | function TORListBox.GetCheckedString: string;
|
---|
3536 | var
|
---|
3537 | i: integer;
|
---|
3538 |
|
---|
3539 | begin
|
---|
3540 | Result := '';
|
---|
3541 | if(FCheckBoxes) then
|
---|
3542 | begin
|
---|
3543 | for i := 0 to Items.Count-1 do
|
---|
3544 | Result := Result + Char(ord('0') + Ord(GetCheckedState(i)));
|
---|
3545 | end;
|
---|
3546 | end;
|
---|
3547 |
|
---|
3548 | procedure TORListBox.SetCheckedString(const Value: string);
|
---|
3549 | var
|
---|
3550 | i: integer;
|
---|
3551 |
|
---|
3552 | begin
|
---|
3553 | for i := 0 to Items.Count-1 do
|
---|
3554 | SetCheckedState(i, TCheckBoxState(StrToIntDef(copy(Value,i+1,1),0)));
|
---|
3555 | end;
|
---|
3556 |
|
---|
3557 | function TORListBox.GetMItems: TStrings;
|
---|
3558 | begin
|
---|
3559 | if not Assigned(FMItems) then
|
---|
3560 | FMItems := TORStrings.Create(Tlistbox(Self).Items,TextToShow);
|
---|
3561 | result := FMItems;
|
---|
3562 | end;
|
---|
3563 |
|
---|
3564 | procedure TORListBox.SetMItems( Value: TStrings);
|
---|
3565 | begin
|
---|
3566 | if not Assigned(FMItems) then
|
---|
3567 | FMItems := TORStrings.Create(Tlistbox(Self).Items,TextToShow);
|
---|
3568 | FMItems.Assign( Value );
|
---|
3569 | end;
|
---|
3570 |
|
---|
3571 | procedure TORListBox.Clear;
|
---|
3572 | begin
|
---|
3573 | Items.Clear;
|
---|
3574 | inherited;
|
---|
3575 | end;
|
---|
3576 |
|
---|
3577 | procedure TORListBox.SetBlackColorMode(Value: boolean);
|
---|
3578 | begin
|
---|
3579 | FBlackColorMode := Value;
|
---|
3580 | end;
|
---|
3581 |
|
---|
3582 | procedure TORListBox.SetCaption(const Value: string);
|
---|
3583 | begin
|
---|
3584 | if not Assigned(FCaption) then begin
|
---|
3585 | FCaption := TStaticText.Create(self);
|
---|
3586 | FCaption.AutoSize := False;
|
---|
3587 | FCaption.Height := 0;
|
---|
3588 | FCaption.Width := 0;
|
---|
3589 | FCaption.Visible := True;
|
---|
3590 | if Assigned (FParentCombo) then
|
---|
3591 | FCaption.Parent := FParentCombo
|
---|
3592 | else
|
---|
3593 | FCaption.Parent := Parent;
|
---|
3594 | FCaption.BringToFront;
|
---|
3595 | end;
|
---|
3596 | FCaption.Caption := Value;
|
---|
3597 | end;
|
---|
3598 |
|
---|
3599 | function TORListBox.GetCaption: string;
|
---|
3600 | begin
|
---|
3601 | result := FCaption.Caption;
|
---|
3602 | end;
|
---|
3603 |
|
---|
3604 | // In Delphi 2006, hint windows will cause the TORComboBox drop down list to
|
---|
3605 | // move behind a Stay on Top form. Hints are also problematic with item tips in
|
---|
3606 | // the drop down list, so we disable them when ever a drop down list is open,
|
---|
3607 | // on all forms, not just stay on top forms.
|
---|
3608 | var
|
---|
3609 | uDropPanelOpenCount: integer = 0;
|
---|
3610 | uOldShowHintsSetting: boolean;
|
---|
3611 |
|
---|
3612 | procedure DropDownPanelOpened;
|
---|
3613 | begin
|
---|
3614 | if uDropPanelOpenCount=0 then
|
---|
3615 | uOldShowHintsSetting := Application.ShowHint;
|
---|
3616 | Application.ShowHint := FALSE;
|
---|
3617 | inc(uDropPanelOpenCount);
|
---|
3618 | end;
|
---|
3619 |
|
---|
3620 | procedure DropDownPanelClosed;
|
---|
3621 | begin
|
---|
3622 | dec(uDropPanelOpenCount);
|
---|
3623 | if uDropPanelOpenCount<=0 then
|
---|
3624 | begin
|
---|
3625 | uDropPanelOpenCount := 0;
|
---|
3626 | if not Application.ShowHint then
|
---|
3627 | Application.ShowHint := uOldShowHintsSetting
|
---|
3628 | end;
|
---|
3629 | end;
|
---|
3630 |
|
---|
3631 | { TORDropPanel ----------------------------------------------------------------------------- }
|
---|
3632 | const
|
---|
3633 | OKBtnTag = 1;
|
---|
3634 | CancelBtnTag = 2;
|
---|
3635 |
|
---|
3636 | procedure TORDropPanel.BtnClicked(Sender: TObject);
|
---|
3637 | begin
|
---|
3638 | (Owner as TORComboBox).DropPanelBtnPressed((Sender as TSpeedButton).Tag = OKBtnTag, TRUE);
|
---|
3639 | end;
|
---|
3640 |
|
---|
3641 | constructor TORDropPanel.Create(AOwner: TComponent);
|
---|
3642 | { Creates a panel the contains the listbox portion of a combobox when the combobox style is
|
---|
3643 | orcsDropDown. This is necessary for the combobox to scroll the list properly. The panel
|
---|
3644 | acts as the parent for the list, which recieves the scroll events. If the panel is not
|
---|
3645 | used, the scroll events to the the Desktop and are not received by the application }
|
---|
3646 | begin
|
---|
3647 | inherited Create(AOwner);
|
---|
3648 | BevelInner := bvNone;
|
---|
3649 | BevelOuter := bvNone;
|
---|
3650 | BorderStyle := bsNone;
|
---|
3651 | Caption :='';
|
---|
3652 | Ctl3D := False;
|
---|
3653 | Visible := False;
|
---|
3654 | UpdateButtons;
|
---|
3655 | end;
|
---|
3656 |
|
---|
3657 | procedure TORDropPanel.CreateParams(var Params: TCreateParams);
|
---|
3658 | { changes parent of panel to desktop so when list is dropped it can overlap other windows }
|
---|
3659 | begin
|
---|
3660 | inherited CreateParams(Params);
|
---|
3661 | if not (csDesigning in ComponentState) then with Params do
|
---|
3662 | begin
|
---|
3663 | if uNewStyle then Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW;
|
---|
3664 | Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST; // - incompatible with ItemTip
|
---|
3665 | WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
|
---|
3666 | WndParent := GetDesktopWindow;
|
---|
3667 | end;
|
---|
3668 | end;
|
---|
3669 |
|
---|
3670 | function TORDropPanel.GetButton(OKBtn: boolean): TSpeedButton;
|
---|
3671 | var
|
---|
3672 | i: integer;
|
---|
3673 |
|
---|
3674 | begin
|
---|
3675 | Result := nil;
|
---|
3676 | if(FButtons) then
|
---|
3677 | begin
|
---|
3678 | for i := 0 to ControlCount-1 do
|
---|
3679 | if(Controls[i] is TSpeedButton) then
|
---|
3680 | begin
|
---|
3681 | if((OKBtn and ((Controls[i] as TSpeedButton).Tag = OKBtnTag)) or
|
---|
3682 | ((not OKBtn) and ((Controls[i] as TSpeedButton).Tag = CancelBtnTag))) then
|
---|
3683 | begin
|
---|
3684 | Result := TSpeedButton(Controls[i]);
|
---|
3685 | break;
|
---|
3686 | end;
|
---|
3687 | end;
|
---|
3688 | end;
|
---|
3689 | end;
|
---|
3690 |
|
---|
3691 | procedure TORDropPanel.ResetButtons;
|
---|
3692 | var
|
---|
3693 | sb: TSpeedButton;
|
---|
3694 |
|
---|
3695 | begin
|
---|
3696 | sb := GetButton(TRUE);
|
---|
3697 | if(assigned(sb)) then sb.Down := FALSE;
|
---|
3698 | sb := GetButton(FALSE);
|
---|
3699 | if(assigned(sb)) then sb.Down := FALSE;
|
---|
3700 | end;
|
---|
3701 |
|
---|
3702 | procedure TORDropPanel.Resize;
|
---|
3703 | var
|
---|
3704 | half: integer;
|
---|
3705 | btn: TSpeedButton;
|
---|
3706 |
|
---|
3707 | begin
|
---|
3708 | inherited;
|
---|
3709 | if(FButtons) then
|
---|
3710 | begin
|
---|
3711 | btn := GetButton(TRUE);
|
---|
3712 | if(assigned(btn)) then
|
---|
3713 | begin
|
---|
3714 | half := width div 2;
|
---|
3715 | btn.Left := 0;
|
---|
3716 | btn.Width := Half;
|
---|
3717 | btn.Top := Height-btn.Height;
|
---|
3718 | btn := GetButton(FALSE);
|
---|
3719 | btn.Left := Half;
|
---|
3720 | btn.Width := Width - Half;
|
---|
3721 | btn.Top := Height-btn.Height;
|
---|
3722 | end;
|
---|
3723 | end;
|
---|
3724 | end;
|
---|
3725 |
|
---|
3726 | procedure TORDropPanel.UpdateButtons;
|
---|
3727 | var
|
---|
3728 | btn: TSpeedButton;
|
---|
3729 | cbo: TORComboBox;
|
---|
3730 | i:integer;
|
---|
3731 |
|
---|
3732 | begin
|
---|
3733 | cbo := (Owner as TORComboBox);
|
---|
3734 | if(cbo.FListBox.FCheckBoxes) then
|
---|
3735 | begin
|
---|
3736 | if(not FButtons) then
|
---|
3737 | begin
|
---|
3738 | btn := TSpeedButton.Create(Self);
|
---|
3739 | btn.Parent := Self;
|
---|
3740 | btn.Caption := 'OK';
|
---|
3741 | btn.Height := CheckComboBtnHeight;
|
---|
3742 | btn.Tag := OKBtnTag;
|
---|
3743 | btn.AllowAllUp := TRUE;
|
---|
3744 | btn.GroupIndex := 1;
|
---|
3745 | btn.OnClick := BtnClicked;
|
---|
3746 | btn := TSpeedButton.Create(Self);
|
---|
3747 | btn.Parent := Self;
|
---|
3748 | btn.Caption := 'Cancel';
|
---|
3749 | btn.Height := CheckComboBtnHeight;
|
---|
3750 | btn.Tag := CancelBtnTag;
|
---|
3751 | btn.AllowAllUp := TRUE;
|
---|
3752 | btn.GroupIndex := 1;
|
---|
3753 | btn.OnClick := BtnClicked;
|
---|
3754 | FButtons := TRUE;
|
---|
3755 | Resize;
|
---|
3756 | end;
|
---|
3757 | end
|
---|
3758 | else
|
---|
3759 | if(FButtons) then
|
---|
3760 | begin
|
---|
3761 | for i := ControlCount-1 downto 0 do
|
---|
3762 | if(Controls[i] is TButton) then
|
---|
3763 | Controls[i].Free;
|
---|
3764 | FButtons := FALSE;
|
---|
3765 | Resize;
|
---|
3766 | end;
|
---|
3767 | end;
|
---|
3768 |
|
---|
3769 | procedure TORDropPanel.WMActivateApp(var Message: TMessage);
|
---|
3770 | { causes drop down list to be hidden when another application is activated (i.e., Alt-Tab) }
|
---|
3771 | begin
|
---|
3772 | if BOOL(Message.wParam) = False then with Owner as TORComboBox do DroppedDown := False;
|
---|
3773 | end;
|
---|
3774 |
|
---|
3775 | { TORComboEdit ----------------------------------------------------------------------------- }
|
---|
3776 | const
|
---|
3777 | ComboBoxImages: array[boolean] of string = ('BMP_CBODOWN_DISABLED', 'BMP_CBODOWN');
|
---|
3778 | BlackComboBoxImages: array[boolean] of string = ('BLACK_BMP_CBODOWN_DISABLED', 'BLACK_BMP_CBODOWN');
|
---|
3779 |
|
---|
3780 | procedure TORComboEdit.CreateParams(var Params: TCreateParams);
|
---|
3781 | { sets a one line edit box to multiline style so the editing rectangle can be changed }
|
---|
3782 | begin
|
---|
3783 | inherited CreateParams(Params);
|
---|
3784 | Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
|
---|
3785 | end;
|
---|
3786 |
|
---|
3787 | procedure TORComboEdit.WMKillFocus(var Message: TWMKillFocus);
|
---|
3788 | begin
|
---|
3789 | inherited;
|
---|
3790 | with (Owner as TORComboBox) do
|
---|
3791 | begin
|
---|
3792 | if (FListBox.FCheckBoxes) and assigned(FEditPanel) and
|
---|
3793 | (Message.FocusedWnd <> FListBox.Handle) and
|
---|
3794 | ((not assigned(FDropBtn)) or (Message.FocusedWnd <> FDropBtn.Handle)) then
|
---|
3795 | begin
|
---|
3796 | FEditPanel.FFocused := FALSE;
|
---|
3797 | FEditPanel.Invalidate;
|
---|
3798 | end;
|
---|
3799 | end;
|
---|
3800 | end;
|
---|
3801 |
|
---|
3802 | procedure TORComboEdit.WMSetFocus(var Message: TWMSetFocus);
|
---|
3803 | begin
|
---|
3804 | inherited;
|
---|
3805 | with (Owner as TORComboBox) do
|
---|
3806 | begin
|
---|
3807 | if FListBox.FCheckBoxes and assigned(FEditPanel) then
|
---|
3808 | begin
|
---|
3809 | HideCaret(Self.Handle);
|
---|
3810 | FEditPanel.FFocused := TRUE;
|
---|
3811 | FEditPanel.Invalidate;
|
---|
3812 | end;
|
---|
3813 | end;
|
---|
3814 | end;
|
---|
3815 |
|
---|
3816 | { TORComboBox ------------------------------------------------------------------------------ }
|
---|
3817 |
|
---|
3818 | constructor TORComboBox.Create(AOwner: TComponent);
|
---|
3819 | { create the editbox and listbox used for the combobox - the default style is Simple }
|
---|
3820 | begin
|
---|
3821 | inherited Create(AOwner);
|
---|
3822 | Width := 121;
|
---|
3823 | Height := 97;
|
---|
3824 | FLastInput := '';
|
---|
3825 | FDropDownCount := 8;
|
---|
3826 | FStyle := orcsSimple;
|
---|
3827 | FCheckBoxEditColor := clBtnFace;
|
---|
3828 | FListBox := TORListBox.Create(Self);
|
---|
3829 | FListBox.isPartOfComboBox := True;
|
---|
3830 | FListBox.Parent := Self;
|
---|
3831 | FListBox.TabStop := False;
|
---|
3832 | FListBox.OnClick := FwdClick;
|
---|
3833 | FListBox.OnDblClick := FwdDblClick;
|
---|
3834 | FListBox.OnMouseUp := FwdMouseUp;
|
---|
3835 | FListBox.OnNeedData := FwdNeedData;
|
---|
3836 | FListBox.OnClickCheck := CheckBoxSelected;
|
---|
3837 | FListBox.Visible := True;
|
---|
3838 | FItems := FListBox.Items;
|
---|
3839 | FMItems := FListBox.MItems;
|
---|
3840 | FEditBox := TORComboEdit.Create(Self);
|
---|
3841 | FEditBox.Parent := Self;
|
---|
3842 | FEditBox.OnChange := FwdChange;
|
---|
3843 | FEditBox.OnKeyDown := FwdKeyDown;
|
---|
3844 | FEditBox.OnKeyPress := FwdKeyPress;
|
---|
3845 | FEditBox.OnKeyUp := FwdKeyUp;
|
---|
3846 | FEditBox.Visible := True;
|
---|
3847 | fCharsNeedMatch := 1;
|
---|
3848 | end;
|
---|
3849 |
|
---|
3850 | procedure TORComboBox.WMDestroy(var Message: TWMDestroy);
|
---|
3851 | begin
|
---|
3852 | if(assigned(Owner)) and (csDestroying in Owner.ComponentState) then
|
---|
3853 | FListBox.DestroyItems;
|
---|
3854 | inherited;
|
---|
3855 | end;
|
---|
3856 |
|
---|
3857 | procedure TORComboBox.CMFontChanged(var Message: TMessage);
|
---|
3858 | { resize the edit portion of the combobox to match the font }
|
---|
3859 | begin
|
---|
3860 | inherited;
|
---|
3861 | AdjustSizeOfSelf;
|
---|
3862 | end;
|
---|
3863 |
|
---|
3864 | procedure TORComboBox.WMMove(var Message: TWMMove);
|
---|
3865 | { for DropDown style, need to hide listbox whenever control moves (since listbox isn't child) }
|
---|
3866 | begin
|
---|
3867 | inherited;
|
---|
3868 | DroppedDown := False;
|
---|
3869 | end;
|
---|
3870 |
|
---|
3871 | procedure TORComboBox.WMSize(var Message: TWMSize);
|
---|
3872 | { whenever control is resized, adjust the components (edit, list, button) within it }
|
---|
3873 | begin
|
---|
3874 | inherited;
|
---|
3875 | AdjustSizeOfSelf;
|
---|
3876 | end;
|
---|
3877 |
|
---|
3878 | procedure TORComboBox.WMTimer(var Message: TWMTimer);
|
---|
3879 | begin
|
---|
3880 | inherited;
|
---|
3881 | if (Message.TimerID = KEY_TIMER_ID) then
|
---|
3882 | begin
|
---|
3883 | StopKeyTimer;
|
---|
3884 | if FListBox.LongList and FChangePending then FwdChangeDelayed;
|
---|
3885 | if Assigned(FOnKeyPause) then FOnKeyPause(Self);
|
---|
3886 | end;
|
---|
3887 | end;
|
---|
3888 |
|
---|
3889 | function TORComboBox.EditControl: TWinControl;
|
---|
3890 | begin
|
---|
3891 | if(assigned(FEditPanel)) then
|
---|
3892 | Result := FEditPanel
|
---|
3893 | else
|
---|
3894 | Result := FEditBox;
|
---|
3895 | end;
|
---|
3896 |
|
---|
3897 | procedure TORComboBox.AdjustSizeOfSelf;
|
---|
3898 | { adjusts the components of the combobox to fit within the control boundaries }
|
---|
3899 | var
|
---|
3900 | FontHeight: Integer;
|
---|
3901 | cboBtnX,cboBtnY: integer;
|
---|
3902 | cboYMargin: integer;
|
---|
3903 |
|
---|
3904 | begin
|
---|
3905 | DroppedDown := False;
|
---|
3906 | FontHeight := FontHeightPixel(Self.Font.Handle);
|
---|
3907 | if FTemplateField then
|
---|
3908 | begin
|
---|
3909 | cboYMargin := 0;
|
---|
3910 | cboBtnX := 1;
|
---|
3911 | cboBtnY := 1;
|
---|
3912 | end
|
---|
3913 | else
|
---|
3914 | begin
|
---|
3915 | cboYMargin := CBO_CYMARGIN;
|
---|
3916 | cboBtnX := CBO_CXFRAME;
|
---|
3917 | cboBtnY := CBO_CXFRAME;
|
---|
3918 | end;
|
---|
3919 | Height := HigherOf(FontHeight + cboYMargin, Height); // must be at least as high as text
|
---|
3920 | EditControl.SetBounds(0, 0, Width, FontHeight + cboYMargin);
|
---|
3921 | if(assigned(FEditPanel)) then
|
---|
3922 | FEditBox.SetBounds(2, 3, FEditPanel.Width - 4, FEditPanel.Height - 5);
|
---|
3923 | if FStyle = orcsDropDown then
|
---|
3924 | begin
|
---|
3925 | Height := FontHeight + cboYMargin; // DropDown can only be text height
|
---|
3926 | FDropBtn.SetBounds(EditControl.Width - CBO_CXBTN - cboBtnX, 0,
|
---|
3927 | CBO_CXBTN, EditControl.Height - cboBtnY);
|
---|
3928 | end else
|
---|
3929 | begin
|
---|
3930 | FListBox.SetBounds(0, FontHeight + CBO_CYMARGIN,
|
---|
3931 | Width, Height - FontHeight - CBO_CYMARGIN);
|
---|
3932 | end;
|
---|
3933 | SetEditRect;
|
---|
3934 | end;
|
---|
3935 |
|
---|
3936 | procedure TORComboBox.DropButtonDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
|
---|
3937 | X, Y: Integer);
|
---|
3938 | { display the listbox for a DropDown style combobox whenever the drop down button is pressed }
|
---|
3939 | begin
|
---|
3940 | if (Button = mbLeft) then
|
---|
3941 | begin
|
---|
3942 | FFromDropBtn := True;
|
---|
3943 | DroppedDown := not FDroppedDown;
|
---|
3944 | FFromDropBtn := False;
|
---|
3945 | end;
|
---|
3946 | end;
|
---|
3947 |
|
---|
3948 | procedure TORComboBox.DropButtonUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
|
---|
3949 | X, Y: Integer);
|
---|
3950 | { shift the focus back to the editbox so the focus rectangle doesn't clutter the button }
|
---|
3951 | begin
|
---|
3952 | if FDroppedDown then FListBox.MouseCapture := True; // do here so 1st buttonup not captured
|
---|
3953 | FEditBox.SetFocus;
|
---|
3954 | end;
|
---|
3955 |
|
---|
3956 | procedure TORComboBox.DropDownStatusChanged(opened: boolean);
|
---|
3957 | begin
|
---|
3958 | if opened then
|
---|
3959 | begin
|
---|
3960 | if not FDropPanel.Visible then
|
---|
3961 | begin
|
---|
3962 | if FDropDownStatusChangedCount = 0 then
|
---|
3963 | begin
|
---|
3964 | FDisableHints := TRUE;
|
---|
3965 | DropDownPanelOpened;
|
---|
3966 | end;
|
---|
3967 | inc(FDropDownStatusChangedCount);
|
---|
3968 | end;
|
---|
3969 | end
|
---|
3970 | else
|
---|
3971 | begin
|
---|
3972 | dec(FDropDownStatusChangedCount);
|
---|
3973 | if FDropDownStatusChangedCount <= 0 then
|
---|
3974 | begin
|
---|
3975 | if FDisableHints then
|
---|
3976 | begin
|
---|
3977 | DropDownPanelClosed;
|
---|
3978 | FDisableHints := FALSE;
|
---|
3979 | end;
|
---|
3980 | FDropDownStatusChangedCount := 0;
|
---|
3981 | end;
|
---|
3982 | end;
|
---|
3983 | end;
|
---|
3984 |
|
---|
3985 | procedure TORComboBox.ClearDropDownStatus;
|
---|
3986 | begin
|
---|
3987 | FDropDownStatusChangedCount := 1;
|
---|
3988 | DropDownStatusChanged(FALSE);
|
---|
3989 | end;
|
---|
3990 |
|
---|
3991 | destructor TORComboBox.Destroy;
|
---|
3992 | begin
|
---|
3993 | ClearDropDownStatus;
|
---|
3994 | inherited;
|
---|
3995 | end;
|
---|
3996 |
|
---|
3997 | procedure TORComboBox.DoEnter;
|
---|
3998 | {var
|
---|
3999 | key : word;}
|
---|
4000 | { select all the text in the editbox when recieve focus - done first so OnEnter can deselect }
|
---|
4001 | begin
|
---|
4002 | //FEditBox.SelectAll;
|
---|
4003 | //Fix For ClearQuest: HDS00001576
|
---|
4004 | //This fix has been commented out, becuase it causes problems
|
---|
4005 | { with FListBox do
|
---|
4006 | if (Items.Count > 0) and (Not IsAMouseButtonDown()) and (ItemIndex = -1) then
|
---|
4007 | begin
|
---|
4008 | key := VK_UP;
|
---|
4009 | FwdKeyDown(Self,key,[]);
|
---|
4010 | //Calling keyUp after key down creates a better mimic of a Keystroke.
|
---|
4011 | FwdKeyUp(Self,key,[]); //fixes clearquest: HDS00001418
|
---|
4012 | end; }
|
---|
4013 | inherited DoEnter;
|
---|
4014 | PostMessage(Handle, UM_GOTFOCUS, 0, 0)
|
---|
4015 | end;
|
---|
4016 |
|
---|
4017 | procedure TORComboBox.UMGotFocus(var Message: TMessage);
|
---|
4018 | begin
|
---|
4019 | FEditBox.SetFocus;
|
---|
4020 | if AutoSelect then FEditBox.SelectAll;
|
---|
4021 | end;
|
---|
4022 |
|
---|
4023 | procedure TORComboBox.DoExit;
|
---|
4024 | { make sure DropDown list is raised when losing focus }
|
---|
4025 | begin
|
---|
4026 | DroppedDown := False;
|
---|
4027 | if FKeyTimerActive then
|
---|
4028 | begin
|
---|
4029 | StopKeyTimer;
|
---|
4030 | if FListBox.LongList and FChangePending then FwdChangeDelayed;
|
---|
4031 | end;
|
---|
4032 | inherited DoExit;
|
---|
4033 | end;
|
---|
4034 |
|
---|
4035 | procedure TORComboBox.LoadComboBoxImage;
|
---|
4036 | var
|
---|
4037 | imageName: string;
|
---|
4038 | begin
|
---|
4039 | if assigned(FDropBtn) then
|
---|
4040 | begin
|
---|
4041 | if FBlackColorMode then
|
---|
4042 | imageName := BlackComboBoxImages[inherited Enabled]
|
---|
4043 | else
|
---|
4044 | imageName := ComboBoxImages[inherited Enabled];
|
---|
4045 | FDropBtn.Glyph.LoadFromResourceName(hInstance, imageName);
|
---|
4046 | end;
|
---|
4047 | end;
|
---|
4048 |
|
---|
4049 | procedure TORComboBox.Loaded;
|
---|
4050 | { we need to call the loaded method for the listbox child (it's not called automatically) }
|
---|
4051 | begin
|
---|
4052 | inherited Loaded;
|
---|
4053 | FListBox.Loaded;
|
---|
4054 | end;
|
---|
4055 |
|
---|
4056 | procedure TORComboBox.FwdChange(Sender: TObject);
|
---|
4057 | { allow timer to call FwdChangeDelayed if long list, otherwise call directly }
|
---|
4058 | begin
|
---|
4059 | if FFromSelf then Exit;
|
---|
4060 | FChangePending := True;
|
---|
4061 | if FListBox.LongList and FKeyIsDown then Exit;
|
---|
4062 | FwdChangeDelayed;
|
---|
4063 | end;
|
---|
4064 |
|
---|
4065 | procedure TORComboBox.FwdChangeDelayed;
|
---|
4066 | { when user types in the editbox, find a partial match in the listbox & set into editbox }
|
---|
4067 | var
|
---|
4068 | SelectIndex: Integer;
|
---|
4069 | x: string;
|
---|
4070 | begin
|
---|
4071 | FChangePending := False;
|
---|
4072 | if (not FListItemsOnly) and (Length(FEditBox.Text) > 0) and (FEditBox.SelStart = 0) then Exit; // **KCM** test this!
|
---|
4073 | with FEditBox do x := Copy(Text, 1, SelStart);
|
---|
4074 | FLastInput := x;
|
---|
4075 | SelectIndex := -1;
|
---|
4076 | if Length(x) >= CharsNeedMatch then
|
---|
4077 | SelectIndex := FListBox.SelectString(x);
|
---|
4078 | if (Length(x) < CharsNeedMatch) and (FListBox.ItemIndex > -1) then
|
---|
4079 | SelectIndex := FListBox.SelectString(x);
|
---|
4080 | if UniqueAutoComplete then
|
---|
4081 | SelectIndex := FListBox.VerifyUnique(SelectIndex,x);
|
---|
4082 | if FListItemsOnly and (SelectIndex < 0) and (x <> '') then
|
---|
4083 | begin
|
---|
4084 | FFromSelf := True;
|
---|
4085 | x := FLastFound;
|
---|
4086 | SelectIndex := FListBox.SelectString(x);
|
---|
4087 | FEditBox.Text := GetEditBoxText(SelectIndex);
|
---|
4088 | if(not FListBox.FCheckBoxes) then
|
---|
4089 | SendMessage(FEditBox.Handle, EM_SETSEL, Length(FEditBox.Text), Length(x));
|
---|
4090 | FFromSelf := False;
|
---|
4091 | Exit; // OnChange not called in this case
|
---|
4092 | end;
|
---|
4093 | FFromSelf := True;
|
---|
4094 | if SelectIndex > -1 then
|
---|
4095 | begin
|
---|
4096 | FEditBox.Text := GetEditBoxText(SelectIndex);
|
---|
4097 | FLastFound := x;
|
---|
4098 | if(not FListBox.FCheckBoxes) then
|
---|
4099 | SendMessage(FEditBox.Handle, EM_SETSEL, Length(FEditBox.Text), Length(x));
|
---|
4100 | end else
|
---|
4101 | begin
|
---|
4102 | if(FListBox.CheckBoxes) then
|
---|
4103 | FEditBox.Text := GetEditBoxText(SelectIndex)
|
---|
4104 | else
|
---|
4105 | FEditBox.Text := x; // no match, so don't set FLastFound
|
---|
4106 | FEditBox.SelStart := Length(x);
|
---|
4107 | end;
|
---|
4108 | FFromSelf := False;
|
---|
4109 | if(not FListBox.FCheckBoxes) then
|
---|
4110 | if Assigned(FOnChange) then FOnChange(Self);
|
---|
4111 | end;
|
---|
4112 |
|
---|
4113 | (*
|
---|
4114 | procedure TORComboBox.FwdChangeDelayed;
|
---|
4115 | { when user types in the editbox, find a partial match in the listbox & set into editbox }
|
---|
4116 | var
|
---|
4117 | SelectIndex: Integer;
|
---|
4118 | x: string;
|
---|
4119 | begin
|
---|
4120 | FChangePending := False;
|
---|
4121 | with FEditBox do x := Copy(Text, 1, SelStart);
|
---|
4122 | if x = FLastInput then Exit; // this change event is just removing the selected text
|
---|
4123 | FLastInput := x;
|
---|
4124 | SelectIndex := FListBox.SelectString(x);
|
---|
4125 | FFromSelf := True;
|
---|
4126 | if SelectIndex > -1 then
|
---|
4127 | begin
|
---|
4128 | FEditBox.Text := GetEditBoxText(SelectIndex);
|
---|
4129 | if(not FListBox.FCheckBoxes) then
|
---|
4130 | SendMessage(FEditBox.Handle, EM_SETSEL, Length(FEditBox.Text), Length(x));
|
---|
4131 | end else
|
---|
4132 | begin
|
---|
4133 | FEditBox.Text := x;
|
---|
4134 | FEditBox.SelStart := Length(x);
|
---|
4135 | end;
|
---|
4136 | FFromSelf := False;
|
---|
4137 | if(not FListBox.FCheckBoxes) then
|
---|
4138 | if Assigned(FOnChange) then FOnChange(Self);
|
---|
4139 | end;
|
---|
4140 | *)
|
---|
4141 |
|
---|
4142 | procedure TORComboBox.FwdClick(Sender: TObject);
|
---|
4143 | { places the text of the item that was selected from the listbox into the editbox }
|
---|
4144 | begin
|
---|
4145 | if FListBox.ItemIndex > -1 then
|
---|
4146 | begin
|
---|
4147 | FFromSelf := True;
|
---|
4148 | FListBox.FFocusIndex := FListBox.ItemIndex; // FFocusIndex used so ItemTip doesn't flash
|
---|
4149 | FEditBox.Text := GetEditBoxText(FListBox.ItemIndex);
|
---|
4150 | FLastFound := FEditBox.Text;
|
---|
4151 | FFromSelf := False;
|
---|
4152 | // not sure why this must be posted (put at the back of the message queue), but for some
|
---|
4153 | // reason FEditBox.SelectAll selects successfully then deselects on exiting this procedure
|
---|
4154 | if(not FListBox.FCheckBoxes) then
|
---|
4155 | PostMessage(FEditBox.Handle, EM_SETSEL, 0, Length(FEditBox.Text));
|
---|
4156 | FEditBox.SetFocus;
|
---|
4157 | end;
|
---|
4158 | if Assigned(FOnClick) then FOnClick(Self);
|
---|
4159 | if(not FListBox.FCheckBoxes) then
|
---|
4160 | if Assigned(FOnChange) then FOnChange(Self); // click causes both click & change events
|
---|
4161 | end;
|
---|
4162 |
|
---|
4163 | procedure TORComboBox.FwdDblClick(Sender: TObject);
|
---|
4164 | { surfaces the double click event from the listbox so it is available as a combobox property }
|
---|
4165 | begin
|
---|
4166 | if Assigned(FOnDblClick) then FOnDblClick(Self);
|
---|
4167 | end;
|
---|
4168 |
|
---|
4169 | procedure TORComboBox.FwdKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
---|
4170 | { passed selected navigation keys to listbox, applies special handling to backspace and F4 }
|
---|
4171 | var
|
---|
4172 | i,iPos: Integer;
|
---|
4173 | x,AString: string;
|
---|
4174 | begin
|
---|
4175 | // special case: when default action taken (RETURN) make sure FwdChangeDelayed is called first
|
---|
4176 | if (Key = VK_RETURN) and FListBox.LongList and FChangePending then FwdChangeDelayed;
|
---|
4177 | StopKeyTimer; // stop timer after control keys so in case an exit event is triggered
|
---|
4178 | if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift);
|
---|
4179 | if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then // navigation
|
---|
4180 | begin
|
---|
4181 | if (FStyle = orcsDropDown) and not DroppedDown then DroppedDown := True;
|
---|
4182 | // handle special case of FocusIndex, WM_KEYDOWN will increment from -1 to 0
|
---|
4183 | if FListBox.ItemIndex = -1 then
|
---|
4184 | begin
|
---|
4185 | FListBox.FFocusIndex := -1;
|
---|
4186 | //Move to correct position when Unique AutoComplete is on.
|
---|
4187 | if UniqueAutoComplete then
|
---|
4188 | begin
|
---|
4189 | AString := Copy(FEditBox.Text, 1, SelStart);
|
---|
4190 | iPos := SendMessage(FListBox.Handle, LB_FINDSTRING, -1, Longint(PChar(AString)));
|
---|
4191 | if iPos = LB_ERR then iPos := -1;
|
---|
4192 | if iPos > -1 then
|
---|
4193 | begin
|
---|
4194 | FListBox.FFocusIndex := iPos-1;
|
---|
4195 | FListBox.ItemIndex := FListBox.FFocusIndex;
|
---|
4196 | end;
|
---|
4197 | end;
|
---|
4198 | end;
|
---|
4199 | FListBox.Perform(WM_KEYDOWN, Key, 1);
|
---|
4200 | end;
|
---|
4201 | if Key in [VK_LBUTTON, VK_RETURN, VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then // select item
|
---|
4202 | begin
|
---|
4203 | FListBox.Perform(WM_KEYDOWN, VK_LBUTTON, 1);
|
---|
4204 | FFromSelf := True;
|
---|
4205 | if FListBox.ItemIndex > -1 then
|
---|
4206 | begin
|
---|
4207 | FEditBox.Text := GetEditBoxText(FListBox.ItemIndex);
|
---|
4208 | FLastFound := FEditBox.Text; //kcm
|
---|
4209 | end;
|
---|
4210 | FFromSelf := False;
|
---|
4211 | end;
|
---|
4212 | // tell parent about RETURN, ESCAPE so that the default action is taken
|
---|
4213 | if Key in [VK_RETURN, VK_ESCAPE, VK_TAB] then SendMessage(Parent.Handle, CN_KEYDOWN, Key, 0);
|
---|
4214 | if Key = VK_BACK then // backspace
|
---|
4215 | begin
|
---|
4216 | FFromSelf := True;
|
---|
4217 | x := FEditBox.Text;
|
---|
4218 | i := FEditBox.SelStart;
|
---|
4219 | Delete(x, i + 1, Length(x));
|
---|
4220 | if(FListBox.FCheckBoxes) then
|
---|
4221 | FEditBox.Text := GetEditBoxText(ItemIndex)
|
---|
4222 | else
|
---|
4223 | FEditBox.Text := x;
|
---|
4224 | FLastFound := x;
|
---|
4225 | FEditBox.SelStart := i;
|
---|
4226 | FFromSelf := False;
|
---|
4227 | end;
|
---|
4228 | if (FStyle = orcsDropDown) and (Key = VK_F4) then DroppedDown := not DroppedDown; // drop
|
---|
4229 |
|
---|
4230 | if (Key = VK_SPACE) and (FListBox.FCheckBoxes) and (FListBox.ItemIndex > -1) then
|
---|
4231 | FListBox.ToggleCheckBox(FListBox.ItemIndex);
|
---|
4232 |
|
---|
4233 | if (FStyle = orcsDropDown) and (FListBox.FCheckBoxes) then
|
---|
4234 | begin
|
---|
4235 | if Key = VK_RETURN then DropPanelBtnPressed(TRUE, TRUE);
|
---|
4236 | if Key = VK_ESCAPE then DropPanelBtnPressed(FALSE, TRUE);
|
---|
4237 | end;
|
---|
4238 |
|
---|
4239 | FKeyIsDown := True;
|
---|
4240 | end;
|
---|
4241 |
|
---|
4242 | procedure TORComboBox.FwdKeyPress(Sender: TObject; var Key: Char);
|
---|
4243 | var
|
---|
4244 | KeyCode: integer;
|
---|
4245 | { prevents return from being used by editbox (otherwise sends a newline & text vanishes) }
|
---|
4246 | begin
|
---|
4247 | KeyCode := ord(Key);
|
---|
4248 | if (KeyCode = VK_RETURN) and (Style = orcsDropDown) and DroppedDown then
|
---|
4249 | begin
|
---|
4250 | DroppedDown := FALSE;
|
---|
4251 | Key := #0;
|
---|
4252 | end
|
---|
4253 | else
|
---|
4254 | begin
|
---|
4255 | // may want to make the tab beep if tab key (#9) - can't tab until list raised
|
---|
4256 | if (KeyCode = VK_RETURN) or (KeyCode = VK_TAB) or (FListBox.FCheckBoxes and (KeyCode = VK_SPACE)) then
|
---|
4257 | begin
|
---|
4258 | Key := #0;
|
---|
4259 | Exit;
|
---|
4260 | end;
|
---|
4261 | if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key);
|
---|
4262 | end;
|
---|
4263 | end;
|
---|
4264 |
|
---|
4265 | procedure TORComboBox.FwdKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
---|
4266 | { surfaces the key up event from the editbox so it is available as a combobox property }
|
---|
4267 | begin
|
---|
4268 | FKeyIsDown := False;
|
---|
4269 | // tell parent about RETURN, ESCAPE so that the default action is taken
|
---|
4270 | if Key in [VK_RETURN, VK_ESCAPE, VK_TAB] then SendMessage(Parent.Handle, CN_KEYUP, Key, 0);
|
---|
4271 | if Assigned(FOnKeyUp) then FOnKeyUp(Self, Key, Shift);
|
---|
4272 | StartKeyTimer;
|
---|
4273 | end;
|
---|
4274 |
|
---|
4275 | procedure TORComboBox.FwdMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
|
---|
4276 | X, Y: Integer);
|
---|
4277 | begin
|
---|
4278 | if Assigned(FOnMouseClick) then FOnMouseClick(Self);
|
---|
4279 | end;
|
---|
4280 |
|
---|
4281 | procedure TORComboBox.FwdNeedData(Sender: TObject; const StartFrom: string;
|
---|
4282 | Direction, InsertAt: Integer);
|
---|
4283 | { surfaces the need data event from the (long) listbox so it is available as a property }
|
---|
4284 | begin
|
---|
4285 | if Assigned(FOnNeedData) then FOnNeedData(Self, copy(StartFrom, 1, MaxNeedDataLen), Direction, InsertAt);
|
---|
4286 | end;
|
---|
4287 |
|
---|
4288 | procedure TORComboBox.SetDropDownCount(Value: Integer);
|
---|
4289 | { when the listbox is dropped, it's sized according to Value (ItemHeight * DropDownCount) }
|
---|
4290 | begin
|
---|
4291 | if Value > 0 then FDropDownCount := Value;
|
---|
4292 | end;
|
---|
4293 |
|
---|
4294 | procedure TORComboBox.SetDroppedDown(Value: Boolean);
|
---|
4295 | { for DropDown combo, display the listbox at the appropriate full screen coordinates }
|
---|
4296 | const
|
---|
4297 | MIN_ITEMS = 3; // minimum visible items for long list
|
---|
4298 | var
|
---|
4299 | ScreenPoint: TPoint;
|
---|
4300 | DropDownCnt: Integer;
|
---|
4301 | PnlHeight: integer;
|
---|
4302 | begin
|
---|
4303 | if (Value = FDroppedDown) or (FStyle <> orcsDropDown) then Exit;
|
---|
4304 | FDroppedDown := Value;
|
---|
4305 | if FDroppedDown = True then
|
---|
4306 | begin
|
---|
4307 | if Assigned(FOnDropDown) then FOnDropDown(Self);
|
---|
4308 | if FListBox.LongList
|
---|
4309 | then DropDownCnt := HigherOf(FDropDownCount, MIN_ITEMS)
|
---|
4310 | else DropDownCnt := LowerOf(FDropDownCount, FListBox.Items.Count);
|
---|
4311 | FListBox.SetBounds(0, 0, Width, (FListBox.ItemHeight * DropDownCnt) + CBO_CXFRAME);
|
---|
4312 | // need to make this smart enough to drop the list UP when necessary ***
|
---|
4313 | ScreenPoint := Self.ClientToScreen(Point(0, EditControl.Height));
|
---|
4314 |
|
---|
4315 | PnlHeight := FListBox.Height;
|
---|
4316 | if(FListBox.FCheckBoxes) then
|
---|
4317 | inc(PnlHeight, CheckComboBtnHeight);
|
---|
4318 | FDropPanel.SetBounds(ScreenPoint.X, ScreenPoint.Y, FListBox.Width, PnlHeight);
|
---|
4319 | if(FListBox.FCheckBoxes) then
|
---|
4320 | begin
|
---|
4321 | FDropPanel.ResetButtons;
|
---|
4322 | FCheckedState := FListBox.GetCheckedString;
|
---|
4323 | end;
|
---|
4324 | DropDownStatusChanged(TRUE);
|
---|
4325 | FDropPanel.Visible := True;
|
---|
4326 | FDropPanel.BringToFront;
|
---|
4327 | if FListBox.FScrollBar <> nil then FListBox.FScrollBar.BringToFront;
|
---|
4328 | if not FFromDropBtn then FListBox.MouseCapture := True; // otherwise ButtonUp captures
|
---|
4329 | end else
|
---|
4330 | begin
|
---|
4331 | if Assigned(FOnDropDownClose) then FOnDropDownClose(Self);
|
---|
4332 | FListBox.MouseCapture := False;
|
---|
4333 | uItemTip.Hide;
|
---|
4334 | FDropPanel.Hide;
|
---|
4335 | DropDownStatusChanged(FALSE);
|
---|
4336 | if(FListBox.FCheckBoxes) and (assigned(FOnChange)) and
|
---|
4337 | (FCheckedState <> FListBox.GetCheckedString) then
|
---|
4338 | FOnChange(Self);
|
---|
4339 | end;
|
---|
4340 | end;
|
---|
4341 |
|
---|
4342 | procedure TORComboBox.SetEditRect;
|
---|
4343 | { change the edit rectangle to not hide the dropdown button - taken from SPIN.PAS sample }
|
---|
4344 | var
|
---|
4345 | Loc: TRect;
|
---|
4346 | begin
|
---|
4347 | SendMessage(FEditBox.Handle, EM_GETRECT, 0, LongInt(@Loc));
|
---|
4348 | Loc.Bottom := ClientHeight + 1; // +1 is workaround for windows paint bug
|
---|
4349 | if FStyle = orcsDropDown then
|
---|
4350 | begin
|
---|
4351 | Loc.Right := ClientWidth - FDropBtn.Width - CBO_CXFRAME; // edit up to button
|
---|
4352 | if(FTemplateField) then
|
---|
4353 | inc(Loc.Right,3);
|
---|
4354 | end
|
---|
4355 | else
|
---|
4356 | Loc.Right := ClientWidth - CBO_CXFRAME; // edit in full edit box
|
---|
4357 | Loc.Top := 0;
|
---|
4358 | if(FTemplateField) then
|
---|
4359 | Loc.Left := 2
|
---|
4360 | else
|
---|
4361 | Loc.Left := 0;
|
---|
4362 | SendMessage(FEditBox.Handle, EM_SETRECTNP, 0, LongInt(@Loc));
|
---|
4363 | end;
|
---|
4364 |
|
---|
4365 | procedure TORComboBox.SetEditText(const Value: string);
|
---|
4366 | { allows the text to change when ItemIndex is changed without triggering a change event }
|
---|
4367 | begin
|
---|
4368 | FFromSelf := True;
|
---|
4369 | FEditBox.Text := Value;
|
---|
4370 | FLastFound := FEditBox.Text;
|
---|
4371 | FFromSelf := False;
|
---|
4372 | PostMessage(FEditBox.Handle, EM_SETSEL, 0, Length(FEditBox.Text));
|
---|
4373 | end;
|
---|
4374 |
|
---|
4375 | procedure TORComboBox.SetItemIndex(Value: Integer);
|
---|
4376 | { set the ItemIndex in the listbox and update the editbox to show the DisplayText }
|
---|
4377 | begin
|
---|
4378 | with FListBox do
|
---|
4379 | begin
|
---|
4380 | ItemIndex := Value;
|
---|
4381 | { should Value = -1 be handled in the SetFocusIndex procedure itself? or should it be
|
---|
4382 | handled by the setting of the ItemIndex property? }
|
---|
4383 | if Value = -1 then FFocusIndex := -1 else FocusIndex := Value;
|
---|
4384 | uItemTip.Hide;
|
---|
4385 | if(FListBox.CheckBoxes) then
|
---|
4386 | SetEditText(GetEditBoxText(ItemIndex))
|
---|
4387 | else
|
---|
4388 | begin
|
---|
4389 | if ItemIndex > -1 then SetEditText(GetEditBoxText(ItemIndex)) else SetEditText('');
|
---|
4390 | end;
|
---|
4391 | end;
|
---|
4392 | end;
|
---|
4393 |
|
---|
4394 | function TORComboBox.SelectByIEN(AnIEN: Int64): Integer;
|
---|
4395 | begin
|
---|
4396 | Result := FListBox.SelectByIEN(AnIEN);
|
---|
4397 | SetItemIndex(Result);
|
---|
4398 | end;
|
---|
4399 |
|
---|
4400 | function TORComboBox.SelectByID(const AnID: string): Integer;
|
---|
4401 | begin
|
---|
4402 | Result := FListBox.SelectByID(AnID);
|
---|
4403 | SetItemIndex(Result);
|
---|
4404 | end;
|
---|
4405 |
|
---|
4406 | function TORComboBox.SetExactByIEN(AnIEN: Int64; const AnItem: string): Integer;
|
---|
4407 | begin
|
---|
4408 | Result := FListBox.SetExactByIEN(AnIEN, AnItem);
|
---|
4409 | SetItemIndex(Result);
|
---|
4410 | end;
|
---|
4411 |
|
---|
4412 | procedure TORComboBox.SetStyle(Value: TORComboStyle);
|
---|
4413 | { Simple: get rid of dropdown button & panel, make combobox parent of listbox
|
---|
4414 | DropDown: create dropdown button & panel, transfer listbox parent to dropdown panel
|
---|
4415 | this allows the dropped list to overlap other windows }
|
---|
4416 | begin
|
---|
4417 | if Value <> FStyle then
|
---|
4418 | begin
|
---|
4419 | FStyle := Value;
|
---|
4420 | if FStyle = orcsSimple then
|
---|
4421 | begin
|
---|
4422 | if FDropBtn <> nil then FDropBtn.Free;
|
---|
4423 | if FDropPanel <> nil then
|
---|
4424 | begin
|
---|
4425 | ClearDropDownStatus;
|
---|
4426 | FDropPanel.Free;
|
---|
4427 | end;
|
---|
4428 | FDropBtn := nil;
|
---|
4429 | FDropPanel := nil;
|
---|
4430 | FListBox.FParentCombo := nil;
|
---|
4431 | FListBox.Parent := Self;
|
---|
4432 | if FListBox.FScrollBar <> nil then FListBox.FScrollBar.Parent := Self; // if long
|
---|
4433 | FListBox.Visible := True;
|
---|
4434 | end else
|
---|
4435 | begin
|
---|
4436 | FDropBtn := TBitBtn.Create(Self);
|
---|
4437 | if(assigned(FEditPanel) and (csDesigning in ComponentState)) then
|
---|
4438 | FEditPanel.ControlStyle := FEditPanel.ControlStyle + [csAcceptsControls];
|
---|
4439 | FDropBtn.Parent := FEditBox;
|
---|
4440 | if(assigned(FEditPanel) and (csDesigning in ComponentState)) then
|
---|
4441 | FEditPanel.ControlStyle := FEditPanel.ControlStyle - [csAcceptsControls];
|
---|
4442 | LoadComboBoxImage;
|
---|
4443 | // FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[inherited Enabled]);
|
---|
4444 | FDropBtn.OnMouseDown := DropButtonDown;
|
---|
4445 | FDropBtn.OnMouseUp := DropButtonUp;
|
---|
4446 | FDropBtn.TabStop := False;
|
---|
4447 | FDropBtn.Visible := True;
|
---|
4448 | FDropBtn.BringToFront;
|
---|
4449 | if not (csDesigning in ComponentState) then
|
---|
4450 | begin
|
---|
4451 | FDropPanel := TORDropPanel.Create(Self);
|
---|
4452 | FDropPanel.Parent := Self; // parent is really the desktop - see CreateParams
|
---|
4453 | FListBox.FParentCombo := Self;
|
---|
4454 | FListBox.Parent := FDropPanel;
|
---|
4455 | ClearDropDownStatus;
|
---|
4456 | if FListBox.FScrollBar <> nil then FListBox.FScrollBar.Parent := FDropPanel; // if long
|
---|
4457 | end else
|
---|
4458 | begin
|
---|
4459 | FListBox.Visible := False;
|
---|
4460 | end;
|
---|
4461 | Height := EditControl.Height;
|
---|
4462 | end;
|
---|
4463 | AdjustSizeOfSelf;
|
---|
4464 | end;
|
---|
4465 | end;
|
---|
4466 |
|
---|
4467 | procedure TORComboBox.StartKeyTimer;
|
---|
4468 | { start (or restart) a timer (done on keyup to delay before calling OnKeyPause) }
|
---|
4469 | var
|
---|
4470 | ATimerID: Integer;
|
---|
4471 | begin
|
---|
4472 | if FListBox.LongList or Assigned(FOnKeyPause) then
|
---|
4473 | begin
|
---|
4474 | StopKeyTimer;
|
---|
4475 | ATimerID := SetTimer(Handle, KEY_TIMER_ID, KEY_TIMER_DELAY, nil);
|
---|
4476 | FKeyTimerActive := ATimerID > 0;
|
---|
4477 | // if can't get a timer, just call the OnKeyPause event immediately
|
---|
4478 | if not FKeyTimerActive then Perform(WM_TIMER, KEY_TIMER_ID, 0);
|
---|
4479 | end;
|
---|
4480 | end;
|
---|
4481 |
|
---|
4482 | procedure TORComboBox.StopKeyTimer;
|
---|
4483 | { stop the timer (done whenever a key is pressed or the combobox no longer has focus) }
|
---|
4484 | begin
|
---|
4485 | if FKeyTimerActive then
|
---|
4486 | begin
|
---|
4487 | KillTimer(Handle, KEY_TIMER_ID);
|
---|
4488 | FKeyTimerActive := False;
|
---|
4489 | end;
|
---|
4490 | end;
|
---|
4491 |
|
---|
4492 | function TORComboBox.SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
4493 | begin
|
---|
4494 | Result := (PropertyID = DynaPropAccesibilityCaption);
|
---|
4495 | end;
|
---|
4496 |
|
---|
4497 | // Since TORComboBox is composed of several controls (FEditBox, FListBox, FDropBtn), the
|
---|
4498 | // following functions and procedures map public and published properties to their related
|
---|
4499 | // subcomponents.
|
---|
4500 |
|
---|
4501 | function TORComboBox.AddReference(const S: string; AReference: Variant): Integer;
|
---|
4502 | begin
|
---|
4503 | Result := FListBox.AddReference(S, AReference);
|
---|
4504 | end;
|
---|
4505 |
|
---|
4506 | procedure TORComboBox.Clear;
|
---|
4507 | begin
|
---|
4508 | FListBox.Clear;
|
---|
4509 | FEditBox.Clear;
|
---|
4510 | end;
|
---|
4511 |
|
---|
4512 | procedure TORComboBox.ClearTop;
|
---|
4513 | begin
|
---|
4514 | FListBox.ClearTop;
|
---|
4515 | end;
|
---|
4516 |
|
---|
4517 | procedure TORComboBox.ForDataUse(Strings: TStrings);
|
---|
4518 | begin
|
---|
4519 | FListBox.ForDataUse(Strings);
|
---|
4520 | end;
|
---|
4521 |
|
---|
4522 | procedure TORComboBox.InitLongList(S: string);
|
---|
4523 | begin
|
---|
4524 | FListBox.InitLongList(S);
|
---|
4525 | end;
|
---|
4526 |
|
---|
4527 | function TORComboBox.IndexOfReference(AReference: Variant): Integer;
|
---|
4528 | begin
|
---|
4529 | Result := FListBox.IndexOfReference(AReference);
|
---|
4530 | end;
|
---|
4531 |
|
---|
4532 | procedure TORComboBox.InsertReference(Index: Integer; const S: string; AReference: Variant);
|
---|
4533 | begin
|
---|
4534 | FListBox.InsertReference(Index, S, AReference);
|
---|
4535 | end;
|
---|
4536 |
|
---|
4537 | procedure TORComboBox.InsertSeparator;
|
---|
4538 | begin
|
---|
4539 | FListBox.InsertSeparator;
|
---|
4540 | end;
|
---|
4541 |
|
---|
4542 | procedure TORComboBox.Invalidate;
|
---|
4543 | begin
|
---|
4544 | inherited;
|
---|
4545 | FEditBox.Invalidate;
|
---|
4546 | FListBox.Invalidate;
|
---|
4547 | if assigned(FEditPanel) then
|
---|
4548 | FEditPanel.Invalidate;
|
---|
4549 | if assigned(FDropBtn) then
|
---|
4550 | FDropBtn.Invalidate;
|
---|
4551 | if assigned(FDropPanel) then
|
---|
4552 | FDropPanel.Invalidate;
|
---|
4553 | end;
|
---|
4554 |
|
---|
4555 | function TORComboBox.GetAutoSelect: Boolean;
|
---|
4556 | begin
|
---|
4557 | Result := FEditBox.AutoSelect;
|
---|
4558 | end;
|
---|
4559 |
|
---|
4560 | function TORComboBox.GetColor: TColor;
|
---|
4561 | begin
|
---|
4562 | Result := FListBox.Color;
|
---|
4563 | end;
|
---|
4564 |
|
---|
4565 | function TORComboBox.GetDelimiter: Char;
|
---|
4566 | begin
|
---|
4567 | Result := FListBox.Delimiter;
|
---|
4568 | end;
|
---|
4569 |
|
---|
4570 | function TORComboBox.GetDisplayText(Index: Integer): string;
|
---|
4571 | begin
|
---|
4572 | Result := FListBox.DisplayText[Index];
|
---|
4573 | end;
|
---|
4574 |
|
---|
4575 | function TORComboBox.GetDynamicProperty(PropertyID: integer): string;
|
---|
4576 | begin
|
---|
4577 | if PropertyID = DynaPropAccesibilityCaption then
|
---|
4578 | Result := GetCaption
|
---|
4579 | else
|
---|
4580 | Result := '';
|
---|
4581 | end;
|
---|
4582 |
|
---|
4583 | function TORComboBox.GetItemHeight: Integer;
|
---|
4584 | begin
|
---|
4585 | Result := FListBox.ItemHeight;
|
---|
4586 | end;
|
---|
4587 |
|
---|
4588 | function TORComboBox.GetIEN(AnIndex: Integer): Int64;
|
---|
4589 | begin
|
---|
4590 | Result := FListBox.GetIEN(AnIndex);
|
---|
4591 | end;
|
---|
4592 |
|
---|
4593 | function TORComboBox.GetItemID: Variant;
|
---|
4594 | begin
|
---|
4595 | Result := FListBox.ItemID;
|
---|
4596 | end;
|
---|
4597 |
|
---|
4598 | function TORComboBox.GetItemIEN: Int64;
|
---|
4599 | begin
|
---|
4600 | Result := FListBox.ItemIEN;
|
---|
4601 | end;
|
---|
4602 |
|
---|
4603 | function TORComboBox.GetItemIndex: Integer;
|
---|
4604 | begin
|
---|
4605 | Result := FListBox.ItemIndex;
|
---|
4606 | end;
|
---|
4607 |
|
---|
4608 | function TORComboBox.GetItemTipEnable: Boolean;
|
---|
4609 | begin
|
---|
4610 | Result := FListBox.ItemTipEnable;
|
---|
4611 | end;
|
---|
4612 |
|
---|
4613 | function TORComboBox.GetItemTipColor: TColor;
|
---|
4614 | begin
|
---|
4615 | Result := FListBox.ItemTipColor;
|
---|
4616 | end;
|
---|
4617 |
|
---|
4618 | function TORComboBox.GetLongList: Boolean;
|
---|
4619 | begin
|
---|
4620 | Result := FListBox.LongList;
|
---|
4621 | end;
|
---|
4622 |
|
---|
4623 | function TORComboBox.GetMaxLength: Integer;
|
---|
4624 | begin
|
---|
4625 | Result := FEditBox.MaxLength;
|
---|
4626 | end;
|
---|
4627 |
|
---|
4628 | function TORComboBox.GetPieces: string;
|
---|
4629 | begin
|
---|
4630 | Result := FListBox.Pieces;
|
---|
4631 | end;
|
---|
4632 |
|
---|
4633 | function TORComboBox.GetReference(Index: Integer): Variant;
|
---|
4634 | begin
|
---|
4635 | Result := FListBox.References[Index];
|
---|
4636 | end;
|
---|
4637 |
|
---|
4638 | function TORComboBox.GetSelLength: Integer;
|
---|
4639 | begin
|
---|
4640 | Result := FEditBox.SelLength;
|
---|
4641 | end;
|
---|
4642 |
|
---|
4643 | function TORComboBox.GetSelStart: Integer;
|
---|
4644 | begin
|
---|
4645 | Result := FEditBox.SelStart;
|
---|
4646 | end;
|
---|
4647 |
|
---|
4648 | function TORComboBox.GetSelText: string;
|
---|
4649 | begin
|
---|
4650 | Result := FEditBox.SelText;
|
---|
4651 | end;
|
---|
4652 |
|
---|
4653 | function TORComboBox.GetShortCount: Integer;
|
---|
4654 | begin
|
---|
4655 | Result := FListBox.ShortCount;
|
---|
4656 | end;
|
---|
4657 |
|
---|
4658 | function TORComboBox.GetSorted: Boolean;
|
---|
4659 | begin
|
---|
4660 | Result := FListBox.Sorted;
|
---|
4661 | end;
|
---|
4662 |
|
---|
4663 | function TORComboBox.GetHideSynonyms: boolean;
|
---|
4664 | begin
|
---|
4665 | Result := FListBox.HideSynonyms;
|
---|
4666 | end;
|
---|
4667 |
|
---|
4668 | function TORComboBox.GetSynonymChars: string;
|
---|
4669 | begin
|
---|
4670 | result := FListBox.SynonymChars;
|
---|
4671 | end;
|
---|
4672 |
|
---|
4673 | procedure TORComboBox.SetHideSynonyms(Value: boolean);
|
---|
4674 | begin
|
---|
4675 | FListBox.HideSynonyms := Value;
|
---|
4676 | end;
|
---|
4677 |
|
---|
4678 | procedure TORComboBox.SetSynonymChars(Value: string);
|
---|
4679 | begin
|
---|
4680 | FListBox.SynonymChars := Value;
|
---|
4681 | end;
|
---|
4682 |
|
---|
4683 | function TORComboBox.GetTabPositions: string;
|
---|
4684 | begin
|
---|
4685 | Result := FListBox.TabPositions;
|
---|
4686 | end;
|
---|
4687 |
|
---|
4688 | function TORComboBox.GetTabPosInPixels: boolean;
|
---|
4689 | begin
|
---|
4690 | Result := FListBox.TabPosInPixels;
|
---|
4691 | end;
|
---|
4692 |
|
---|
4693 | function TORComboBox.GetText: string;
|
---|
4694 | begin
|
---|
4695 | Result := FEditBox.Text;
|
---|
4696 | end;
|
---|
4697 |
|
---|
4698 | procedure TORComboBox.SelectAll;
|
---|
4699 | begin
|
---|
4700 | FEditBox.SelectAll;
|
---|
4701 | end;
|
---|
4702 |
|
---|
4703 | procedure TORComboBox.SetAutoSelect(Value: Boolean);
|
---|
4704 | begin
|
---|
4705 | FEditBox.AutoSelect := Value;
|
---|
4706 | end;
|
---|
4707 |
|
---|
4708 | procedure TORComboBox.SetBlackColorMode(Value: boolean);
|
---|
4709 | begin
|
---|
4710 | if FBlackColorMode <> Value then
|
---|
4711 | begin
|
---|
4712 | FBlackColorMode := Value;
|
---|
4713 | FListBox.SetBlackColorMode(Value);
|
---|
4714 | LoadComboBoxImage;
|
---|
4715 | end;
|
---|
4716 | end;
|
---|
4717 |
|
---|
4718 | procedure TORComboBox.SetColor(Value: TColor);
|
---|
4719 | begin
|
---|
4720 | if(not FListBox.CheckBoxes) then
|
---|
4721 | FEditBox.Color := Value;
|
---|
4722 | FListBox.Color := Value;
|
---|
4723 | end;
|
---|
4724 |
|
---|
4725 | procedure TORComboBox.SetDelimiter(Value: Char);
|
---|
4726 | begin
|
---|
4727 | FListBox.Delimiter := Value;
|
---|
4728 | end;
|
---|
4729 |
|
---|
4730 | procedure TORComboBox.SetItemHeight(Value: Integer);
|
---|
4731 | begin
|
---|
4732 | FListBox.ItemHeight := Value;
|
---|
4733 | end;
|
---|
4734 |
|
---|
4735 | procedure TORComboBox.SetItemTipEnable(Value: Boolean);
|
---|
4736 | begin
|
---|
4737 | FListBox.ItemTipEnable := Value;
|
---|
4738 | end;
|
---|
4739 |
|
---|
4740 | procedure TORComboBox.SetItemTipColor(Value: TColor);
|
---|
4741 | begin
|
---|
4742 | FListBox.ItemTipColor := Value;
|
---|
4743 | end;
|
---|
4744 |
|
---|
4745 | procedure TORComboBox.SetLongList(Value: Boolean);
|
---|
4746 | begin
|
---|
4747 | FListBox.LongList := Value;
|
---|
4748 | end;
|
---|
4749 |
|
---|
4750 | procedure TORComboBox.SetMaxLength(Value: Integer);
|
---|
4751 | begin
|
---|
4752 | FEditBox.MaxLength := Value;
|
---|
4753 | end;
|
---|
4754 |
|
---|
4755 | procedure TORComboBox.SetPieces(const Value: string);
|
---|
4756 | begin
|
---|
4757 | FListBox.Pieces := Value;
|
---|
4758 | end;
|
---|
4759 |
|
---|
4760 | procedure TORComboBox.SetReference(Index: Integer; AReference: Variant);
|
---|
4761 | begin
|
---|
4762 | FListBox.References[Index] := AReference;
|
---|
4763 | end;
|
---|
4764 |
|
---|
4765 | procedure TORComboBox.SetSelLength(Value: Integer);
|
---|
4766 | begin
|
---|
4767 | FEditBox.SelLength := Value;
|
---|
4768 | end;
|
---|
4769 |
|
---|
4770 | procedure TORComboBox.SetSelStart(Value: Integer);
|
---|
4771 | begin
|
---|
4772 | FEditBox.SelStart := Value;
|
---|
4773 | end;
|
---|
4774 |
|
---|
4775 | procedure TORComboBox.SetSelText(const Value: string);
|
---|
4776 | begin
|
---|
4777 | FEditBox.SelText := Value;
|
---|
4778 | end;
|
---|
4779 |
|
---|
4780 | procedure TORComboBox.SetSorted(Value: Boolean);
|
---|
4781 | begin
|
---|
4782 | FListBox.Sorted := Value;
|
---|
4783 | end;
|
---|
4784 |
|
---|
4785 | procedure TORComboBox.SetTabPositions(const Value: string);
|
---|
4786 | begin
|
---|
4787 | FListBox.TabPositions := Value;
|
---|
4788 | end;
|
---|
4789 |
|
---|
4790 | procedure TORComboBox.SetTabPosInPixels(const Value: boolean);
|
---|
4791 | begin
|
---|
4792 | FListBox.TabPosInPixels := Value;
|
---|
4793 | end;
|
---|
4794 |
|
---|
4795 | procedure TORComboBox.SetText(const Value: string);
|
---|
4796 | begin
|
---|
4797 | FEditBox.Text := Value; // kcm ???
|
---|
4798 | end;
|
---|
4799 |
|
---|
4800 | procedure TORComboBox.SetItems(const Value: TStrings);
|
---|
4801 | begin
|
---|
4802 | FItems.Assign(Value);
|
---|
4803 | end;
|
---|
4804 |
|
---|
4805 | function TORComboBox.GetCheckBoxes: boolean;
|
---|
4806 | begin
|
---|
4807 | Result := FListBox.FCheckBoxes;
|
---|
4808 | end;
|
---|
4809 |
|
---|
4810 | function TORComboBox.GetChecked(Index: Integer): Boolean;
|
---|
4811 | begin
|
---|
4812 | Result := FListBox.GetChecked(Index);
|
---|
4813 | end;
|
---|
4814 |
|
---|
4815 | function TORComboBox.GetCheckEntireLine: boolean;
|
---|
4816 | begin
|
---|
4817 | Result := FListBox.FCheckEntireLine;
|
---|
4818 | end;
|
---|
4819 |
|
---|
4820 | function TORComboBox.GetFlatCheckBoxes: boolean;
|
---|
4821 | begin
|
---|
4822 | Result := FListBox.FFlatCheckBoxes;
|
---|
4823 | end;
|
---|
4824 |
|
---|
4825 | procedure TORComboBox.SetCheckBoxes(const Value: boolean);
|
---|
4826 | begin
|
---|
4827 | if(FListBox.FCheckBoxes <> Value) then
|
---|
4828 | begin
|
---|
4829 | FListBox.SetCheckBoxes(Value);
|
---|
4830 | if(assigned(FDropPanel)) then
|
---|
4831 | FDropPanel.UpdateButtons;
|
---|
4832 | FEditBox.Visible := FALSE;
|
---|
4833 | try
|
---|
4834 | if(Value) then
|
---|
4835 | begin
|
---|
4836 | SetListItemsOnly(TRUE);
|
---|
4837 | SetAutoSelect(FALSE);
|
---|
4838 | FEditBox.Color := FCheckBoxEditColor;
|
---|
4839 | FEditBox.Text := GetEditBoxText(-1);
|
---|
4840 | FEditBox.BorderStyle := bsNone;
|
---|
4841 | FEditPanel := TORComboPanelEdit.Create(Self);
|
---|
4842 | FEditPanel.Parent := Self;
|
---|
4843 | FEditPanel.BevelOuter := bvRaised;
|
---|
4844 | FEditPanel.BorderWidth := 1;
|
---|
4845 | FEditBox.Parent := FEditPanel;
|
---|
4846 | if(csDesigning in ComponentState) then
|
---|
4847 | FEditPanel.ControlStyle := FEditPanel.ControlStyle - [csAcceptsControls];
|
---|
4848 | end
|
---|
4849 | else
|
---|
4850 | begin
|
---|
4851 | FEditBox.Parent := Self;
|
---|
4852 | FEditBox.Color := FListBox.Color;
|
---|
4853 | FEditBox.BorderStyle := bsSingle;
|
---|
4854 | FEditPanel.Free;
|
---|
4855 | FEditPanel := nil;
|
---|
4856 | end;
|
---|
4857 | finally
|
---|
4858 | FEditBox.Visible := TRUE;
|
---|
4859 | end;
|
---|
4860 | AdjustSizeOfSelf;
|
---|
4861 | end;
|
---|
4862 | end;
|
---|
4863 |
|
---|
4864 | procedure TORComboBox.SetChecked(Index: Integer; const Value: Boolean);
|
---|
4865 | begin
|
---|
4866 | FListBox.SetChecked(Index, Value);
|
---|
4867 | if(assigned(FDropPanel)) then
|
---|
4868 | FDropPanel.UpdateButtons;
|
---|
4869 | if(Value) then
|
---|
4870 | SetListItemsOnly(TRUE);
|
---|
4871 | end;
|
---|
4872 |
|
---|
4873 | procedure TORComboBox.SetCheckEntireLine(const Value: boolean);
|
---|
4874 | begin
|
---|
4875 | FListBox.FCheckEntireLine := Value;
|
---|
4876 | end;
|
---|
4877 |
|
---|
4878 | procedure TORComboBox.SetFlatCheckBoxes(const Value: boolean);
|
---|
4879 | begin
|
---|
4880 | FListBox.SetFlatCheckBoxes(Value);
|
---|
4881 | end;
|
---|
4882 |
|
---|
4883 | procedure TORComboBox.DropPanelBtnPressed(OKBtn, AutoClose: boolean);
|
---|
4884 | var
|
---|
4885 | btn: TSpeedButton;
|
---|
4886 |
|
---|
4887 | begin
|
---|
4888 | if(assigned(FDropPanel)) then
|
---|
4889 | begin
|
---|
4890 | btn := FDropPanel.GetButton(OKBtn);
|
---|
4891 | if(assigned(Btn)) then
|
---|
4892 | Btn.Down := TRUE;
|
---|
4893 | end;
|
---|
4894 | if(not OKBtn) then FListBox.SetCheckedString(FCheckedState);
|
---|
4895 | if(AutoClose) then
|
---|
4896 | begin
|
---|
4897 | FListBox.FDontClose := FALSE;
|
---|
4898 | DroppedDown := False;
|
---|
4899 | end;
|
---|
4900 | UpdateCheckEditBoxText;
|
---|
4901 | end;
|
---|
4902 |
|
---|
4903 | function TORComboBox.GetCheckedString: string;
|
---|
4904 | begin
|
---|
4905 | Result := FListBox.GetCheckedString;
|
---|
4906 | end;
|
---|
4907 |
|
---|
4908 | procedure TORComboBox.SetCheckedString(const Value: string);
|
---|
4909 | begin
|
---|
4910 | FListBox.SetCheckedString(Value);
|
---|
4911 | end;
|
---|
4912 |
|
---|
4913 | procedure TORComboBox.SetCheckBoxEditColor(const Value: TColor);
|
---|
4914 | begin
|
---|
4915 | if(FCheckBoxEditColor <> Value) then
|
---|
4916 | begin
|
---|
4917 | FCheckBoxEditColor := Value;
|
---|
4918 | if(FListBox.FCheckBoxes) then
|
---|
4919 | FEditBox.Color := FCheckBoxEditColor;
|
---|
4920 | end;
|
---|
4921 | end;
|
---|
4922 |
|
---|
4923 | procedure TORComboBox.SetListItemsOnly(const Value: Boolean);
|
---|
4924 | begin
|
---|
4925 | if(FListItemsOnly <> Value) then
|
---|
4926 | begin
|
---|
4927 | FListItemsOnly := Value;
|
---|
4928 | if(not Value) then
|
---|
4929 | SetCheckBoxes(FALSE);
|
---|
4930 | end;
|
---|
4931 | end;
|
---|
4932 |
|
---|
4933 | procedure TORComboBox.SetOnCheckedText(const Value: TORCheckComboTextEvent);
|
---|
4934 | begin
|
---|
4935 | FOnCheckedText := Value;
|
---|
4936 | FEditBox.Text := GetEditBoxText(-1);
|
---|
4937 | end;
|
---|
4938 |
|
---|
4939 | procedure TORComboBox.SetTemplateField(const Value: boolean);
|
---|
4940 | begin
|
---|
4941 | if(FTemplateField <> Value) then
|
---|
4942 | begin
|
---|
4943 | FTemplateField := Value;
|
---|
4944 | if(Value) then
|
---|
4945 | begin
|
---|
4946 | SetStyle(orcsDropDown);
|
---|
4947 | FEditBox.BorderStyle := bsNone
|
---|
4948 | end
|
---|
4949 | else
|
---|
4950 | FEditBox.BorderStyle := bsSingle;
|
---|
4951 | AdjustSizeOfSelf;
|
---|
4952 | end;
|
---|
4953 | end;
|
---|
4954 |
|
---|
4955 | function TORComboBox.GetOnSynonymCheck: TORSynonymCheckEvent;
|
---|
4956 | begin
|
---|
4957 | Result := FListBox.FOnSynonymCheck;
|
---|
4958 | end;
|
---|
4959 |
|
---|
4960 | procedure TORComboBox.SetOnSynonymCheck(const Value: TORSynonymCheckEvent);
|
---|
4961 | begin
|
---|
4962 | FListBox.FOnSynonymCheck := Value;
|
---|
4963 | end;
|
---|
4964 |
|
---|
4965 | function TORComboBox.GetEnabled: boolean;
|
---|
4966 | begin
|
---|
4967 | Result := inherited GetEnabled;
|
---|
4968 | end;
|
---|
4969 |
|
---|
4970 | procedure TORComboBox.SetEnabled(Value: boolean);
|
---|
4971 | begin
|
---|
4972 | if (inherited GetEnabled <> Value) then
|
---|
4973 | begin
|
---|
4974 | DroppedDown := FALSE;
|
---|
4975 | inherited SetEnabled(Value);
|
---|
4976 | if assigned(FDropBtn) then
|
---|
4977 | LoadComboBoxImage;
|
---|
4978 | // FDropBtn.Glyph.LoadFromResourceName(hInstance, ComboBoxImages[Value]);
|
---|
4979 | end;
|
---|
4980 | end;
|
---|
4981 |
|
---|
4982 | function TORComboBox.GetEditBoxText(Index: Integer): string;
|
---|
4983 | var
|
---|
4984 | i, cnt: integer;
|
---|
4985 |
|
---|
4986 | begin
|
---|
4987 | if(FListBox.FCheckBoxes) then
|
---|
4988 | begin
|
---|
4989 | Result := '';
|
---|
4990 | cnt := 0;
|
---|
4991 | for i := 0 to FListBox.Items.Count-1 do
|
---|
4992 | begin
|
---|
4993 | if(FListBox.Checked[i]) then
|
---|
4994 | begin
|
---|
4995 | inc(cnt);
|
---|
4996 | if(Result <> '') then
|
---|
4997 | Result := Result + ', ';
|
---|
4998 | Result := Result + FListBox.GetDisplayText(i);
|
---|
4999 | end;
|
---|
5000 | end;
|
---|
5001 | if(assigned(FOnCheckedText)) then
|
---|
5002 | FOnCheckedText(FListBox, cnt, Result);
|
---|
5003 | end
|
---|
5004 | else
|
---|
5005 | Result := FListBox.GetDisplayText(Index);
|
---|
5006 | end;
|
---|
5007 |
|
---|
5008 | procedure TORComboBox.UpdateCheckEditBoxText;
|
---|
5009 | begin
|
---|
5010 | if(FListBox.FCheckBoxes) then
|
---|
5011 | begin
|
---|
5012 | FFromSelf := TRUE;
|
---|
5013 | FEditBox.Text := GetEditBoxText(-1);
|
---|
5014 | FEditBox.SelLength := 0;
|
---|
5015 | FFromSelf := FALSE;
|
---|
5016 | end;
|
---|
5017 | end;
|
---|
5018 |
|
---|
5019 | procedure TORComboBox.CheckBoxSelected(Sender: TObject; Index: integer);
|
---|
5020 | begin
|
---|
5021 | UpdateCheckEditBoxText;
|
---|
5022 | if(FStyle <> orcsDropDown) and (assigned(FOnChange)) then
|
---|
5023 | FOnChange(Self);
|
---|
5024 | end;
|
---|
5025 |
|
---|
5026 | function TORComboBox.GetMItems: TStrings;
|
---|
5027 | begin
|
---|
5028 | result := FMItems;
|
---|
5029 | end;
|
---|
5030 |
|
---|
5031 | procedure TORComboBox.SetCaption(const Value: string);
|
---|
5032 | begin
|
---|
5033 | FListBox.Caption := Value;
|
---|
5034 | end;
|
---|
5035 |
|
---|
5036 | function TORComboBox.GetCaption: string;
|
---|
5037 | begin
|
---|
5038 | result := FListBox.Caption;
|
---|
5039 | end;
|
---|
5040 |
|
---|
5041 | function TORComboBox.GetCaseChanged: boolean;
|
---|
5042 | begin
|
---|
5043 | result := FListBox.CaseChanged;
|
---|
5044 | end;
|
---|
5045 |
|
---|
5046 | procedure TORComboBox.SetCaseChanged(const Value: boolean);
|
---|
5047 | begin
|
---|
5048 | FListBox.CaseChanged := Value;
|
---|
5049 | end;
|
---|
5050 |
|
---|
5051 | function TORComboBox.GetLookupPiece: integer;
|
---|
5052 | begin
|
---|
5053 | result := FListBox.LookupPiece;
|
---|
5054 | end;
|
---|
5055 |
|
---|
5056 | procedure TORComboBox.SetLookupPiece(const Value: integer);
|
---|
5057 | begin
|
---|
5058 | FListBox.LookupPiece := Value;
|
---|
5059 | end;
|
---|
5060 |
|
---|
5061 | { TSizeRatio methods }
|
---|
5062 |
|
---|
5063 | constructor TSizeRatio.Create(ALeft, ATop, AWidth, AHeight: Extended);
|
---|
5064 | { creates an object that records the initial relative size & position of a control }
|
---|
5065 | begin
|
---|
5066 | CLeft := ALeft; CTop := ATop; CWidth := AWidth; CHeight := AHeight;
|
---|
5067 | end;
|
---|
5068 |
|
---|
5069 | { TORAutoPanel ----------------------------------------------------------------------------- }
|
---|
5070 |
|
---|
5071 | destructor TORAutoPanel.Destroy;
|
---|
5072 | { destroy objects used to record size and position information for controls }
|
---|
5073 | var
|
---|
5074 | SizeRatio: TSizeRatio;
|
---|
5075 | i: Integer;
|
---|
5076 | begin
|
---|
5077 | if FSizes <> nil then with FSizes do for i := 0 to Count - 1 do
|
---|
5078 | begin
|
---|
5079 | SizeRatio := Items[i];
|
---|
5080 | SizeRatio.Free;
|
---|
5081 | end;
|
---|
5082 | FSizes.Free;
|
---|
5083 | inherited Destroy;
|
---|
5084 | end;
|
---|
5085 |
|
---|
5086 | procedure TORAutoPanel.BuildSizes( Control: TWinControl);
|
---|
5087 | var
|
---|
5088 | i,H,W: Integer;
|
---|
5089 | SizeRatio: TSizeRatio;
|
---|
5090 | Child: TControl;
|
---|
5091 | begin
|
---|
5092 | H := ClientHeight;
|
---|
5093 | W := ClientWidth;
|
---|
5094 | if (H = 0) or (W = 0) then exit;
|
---|
5095 | for i := 0 to Control.ControlCount - 1 do
|
---|
5096 | begin
|
---|
5097 | Child := Control.Controls[i];
|
---|
5098 | with Child do
|
---|
5099 | SizeRatio := TSizeRatio.Create(Left/W, Top/H, Width/W, Height/H);
|
---|
5100 | FSizes.Add(SizeRatio); //FSizes is in tree traversal order.
|
---|
5101 | //TGroupBox is currently the only type of container that is having these
|
---|
5102 | //resize problems
|
---|
5103 | if Child is TGroupBox then
|
---|
5104 | BuildSizes(TWinControl(Child));
|
---|
5105 | end;
|
---|
5106 | end;
|
---|
5107 |
|
---|
5108 | procedure TORAutoPanel.Loaded;
|
---|
5109 | { record initial size & position info for resizing logic }
|
---|
5110 | begin
|
---|
5111 | inherited Loaded;
|
---|
5112 | if csDesigning in ComponentState then Exit; // only want auto-resizing at run time
|
---|
5113 | FSizes := TList.Create;
|
---|
5114 | BuildSizes(Self);
|
---|
5115 | end;
|
---|
5116 |
|
---|
5117 | procedure TORAutoPanel.DoResize( Control: TWinControl; var CurrentIndex: Integer);
|
---|
5118 | var
|
---|
5119 | i,H,W: Integer;
|
---|
5120 | SizeRatio: TSizeRatio;
|
---|
5121 | Child: TControl;
|
---|
5122 | begin
|
---|
5123 | H := ClientHeight;
|
---|
5124 | W := ClientWidth;
|
---|
5125 | for i := 0 to Control.ControlCount - 1 do
|
---|
5126 | begin
|
---|
5127 | Child := Control.Controls[i];
|
---|
5128 | if CurrentIndex = FSizes.Count then break;
|
---|
5129 | // raise Exception.Create('Error while Sizing Auto-Size Panel');
|
---|
5130 | SizeRatio := FSizes[CurrentIndex];
|
---|
5131 | inc(CurrentIndex);
|
---|
5132 | with SizeRatio do begin
|
---|
5133 | if (Child is TLabel) or (Child is TStaticText) then
|
---|
5134 | Child.SetBounds(Round(CLeft*W), Round(CTop*H), Child.Width, Child.Height)
|
---|
5135 | else
|
---|
5136 | Child.SetBounds(Round(CLeft*W), Round(CTop*H), Round(CWidth*W), Round(CHeight*H));
|
---|
5137 | end;
|
---|
5138 | if Child is TGroupBox then
|
---|
5139 | DoResize(TwinControl(Child), CurrentIndex);
|
---|
5140 | end;
|
---|
5141 | end;
|
---|
5142 |
|
---|
5143 | procedure TORAutoPanel.Resize;
|
---|
5144 | { resize child controls using their design time proportions }
|
---|
5145 | var
|
---|
5146 | i: Integer;
|
---|
5147 | begin
|
---|
5148 | inherited Resize;
|
---|
5149 | if csDesigning in ComponentState then Exit; // only want auto-resizing at run time
|
---|
5150 | i := 0;
|
---|
5151 | DoResize( Self, i);
|
---|
5152 | end;
|
---|
5153 |
|
---|
5154 | { TOROffsetLabel --------------------------------------------------------------------------- }
|
---|
5155 |
|
---|
5156 | constructor TOROffsetLabel.Create(AOwner: TComponent);
|
---|
5157 | { create the label with the default of Transparent = False and Offset = 2}
|
---|
5158 | begin
|
---|
5159 | inherited Create(AOwner);
|
---|
5160 | ControlStyle := ControlStyle + [csOpaque];
|
---|
5161 | FHorzOffset := 2;
|
---|
5162 | FVertOffset := 2;
|
---|
5163 | end;
|
---|
5164 |
|
---|
5165 | procedure TOROffsetLabel.CMTextChanged(var Message: TMessage);
|
---|
5166 | { resize whenever the label caption changes }
|
---|
5167 | begin
|
---|
5168 | inherited;
|
---|
5169 | AdjustSizeOfSelf;
|
---|
5170 | end;
|
---|
5171 |
|
---|
5172 | procedure TOROffsetLabel.CMFontChanged(var Message: TMessage);
|
---|
5173 | { resize whenever the label font changes }
|
---|
5174 | begin
|
---|
5175 | inherited;
|
---|
5176 | AdjustSizeOfSelf;
|
---|
5177 | end;
|
---|
5178 |
|
---|
5179 | procedure TOROffsetLabel.AdjustSizeOfSelf;
|
---|
5180 | { using the current font, call DrawText to calculate the rectangle size for the label }
|
---|
5181 | var
|
---|
5182 | DC: HDC;
|
---|
5183 | Flags: Word;
|
---|
5184 | ARect: TRect;
|
---|
5185 | begin
|
---|
5186 | if not (csReading in ComponentState) then
|
---|
5187 | begin
|
---|
5188 | DC := GetDC(0);
|
---|
5189 | Canvas.Handle := DC;
|
---|
5190 | ARect := ClientRect;
|
---|
5191 | Flags := DT_EXPANDTABS or DT_CALCRECT;
|
---|
5192 | if FWordWrap then Flags := Flags or DT_WORDBREAK;
|
---|
5193 | DoDrawText(ARect, Flags); // returns size of text rect
|
---|
5194 | Canvas.Handle := 0;
|
---|
5195 | ReleaseDC(0, DC);
|
---|
5196 | // add alignment property later?
|
---|
5197 | SetBounds(Left, Top, ARect.Right + FHorzOffset, ARect.Bottom + FVertOffset); // add offsets
|
---|
5198 | end;
|
---|
5199 | end;
|
---|
5200 |
|
---|
5201 | procedure TOROffsetLabel.DoDrawText(var Rect: TRect; Flags: Word);
|
---|
5202 | { call drawtext to paint or calculate the size of the text in the caption property }
|
---|
5203 | var
|
---|
5204 | Text: string;
|
---|
5205 | begin
|
---|
5206 | Text := Caption;
|
---|
5207 | Canvas.Font := Font;
|
---|
5208 | if not Enabled then Canvas.Font.Color := clGrayText;
|
---|
5209 | DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
|
---|
5210 | end;
|
---|
5211 |
|
---|
5212 | procedure TOROffsetLabel.Paint;
|
---|
5213 | { set the background characterictics, add the offsets, and paint the text }
|
---|
5214 | var
|
---|
5215 | ARect: TRect;
|
---|
5216 | Flags: Word;
|
---|
5217 | begin
|
---|
5218 | with Canvas do
|
---|
5219 | begin
|
---|
5220 | if not Transparent then
|
---|
5221 | begin
|
---|
5222 | Brush.Color := Self.Color;
|
---|
5223 | Brush.Style := bsSolid;
|
---|
5224 | FillRect(ClientRect);
|
---|
5225 | end;
|
---|
5226 | Brush.Style := bsClear;
|
---|
5227 | ARect := ClientRect;
|
---|
5228 | Inc(ARect.Left, FHorzOffset);
|
---|
5229 | Inc(ARect.Top, FVertOffset);
|
---|
5230 | Flags := DT_EXPANDTABS or DT_NOPREFIX or DT_LEFT;
|
---|
5231 | if FWordWrap then Flags := Flags or DT_WORDBREAK;
|
---|
5232 | DoDrawText(ARect, Flags);
|
---|
5233 | end;
|
---|
5234 | end;
|
---|
5235 |
|
---|
5236 | function TOROffsetLabel.GetTransparent: Boolean;
|
---|
5237 | { returns true if the control style is not opaque }
|
---|
5238 | begin
|
---|
5239 | if csOpaque in ControlStyle then Result := False else Result := True;
|
---|
5240 | end;
|
---|
5241 |
|
---|
5242 | procedure TOROffsetLabel.SetTransparent(Value: Boolean);
|
---|
5243 | { if true, removes Opaque from the control style }
|
---|
5244 | begin
|
---|
5245 | if Value <> Transparent then
|
---|
5246 | begin
|
---|
5247 | if Value
|
---|
5248 | then ControlStyle := ControlStyle - [csOpaque] // transparent = true
|
---|
5249 | else ControlStyle := ControlStyle + [csOpaque]; // transparent = false
|
---|
5250 | Invalidate;
|
---|
5251 | end;
|
---|
5252 | end;
|
---|
5253 |
|
---|
5254 | procedure TOROffsetLabel.SetVertOffset(Value: Integer);
|
---|
5255 | { adjusts the size of the label whenever the vertical offset of the label changes }
|
---|
5256 | begin
|
---|
5257 | FVertOffset := Value;
|
---|
5258 | AdjustSizeOfSelf;
|
---|
5259 | end;
|
---|
5260 |
|
---|
5261 | procedure TOROffsetLabel.SetHorzOffset(Value: Integer);
|
---|
5262 | { adjusts the size of the label whenever the horizontal offset of the label changes }
|
---|
5263 | begin
|
---|
5264 | FHorzOffset := Value;
|
---|
5265 | AdjustSizeOfSelf;
|
---|
5266 | end;
|
---|
5267 |
|
---|
5268 | procedure TOROffsetLabel.SetWordWrap(Value: Boolean);
|
---|
5269 | { adjusts the size of the label whenever the word wrap property changes }
|
---|
5270 | begin
|
---|
5271 | if FWordWrap <> Value then
|
---|
5272 | begin
|
---|
5273 | FWordWrap := Value;
|
---|
5274 | AdjustSizeOfSelf;
|
---|
5275 | end;
|
---|
5276 | end;
|
---|
5277 |
|
---|
5278 | (*
|
---|
5279 | { TORCalendar }
|
---|
5280 |
|
---|
5281 | procedure TORCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
|
---|
5282 | { uses the Calendar that is part of Samples and highlights the current date }
|
---|
5283 | var
|
---|
5284 | TheText: string;
|
---|
5285 | CurMonth, CurYear, CurDay: Word;
|
---|
5286 | begin
|
---|
5287 | TheText := CellText[ACol, ARow];
|
---|
5288 | with ARect, Canvas do
|
---|
5289 | begin
|
---|
5290 | DecodeDate(Date, CurYear, CurMonth, CurDay);
|
---|
5291 | if (CurYear = Year) and (CurMonth = Month) and (IntToStr(CurDay) = TheText) then
|
---|
5292 | begin
|
---|
5293 | TheText := '[' + TheText + ']';
|
---|
5294 | Font.Style := [fsBold];
|
---|
5295 | end;
|
---|
5296 | TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
|
---|
5297 | Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
|
---|
5298 | end;
|
---|
5299 | end;
|
---|
5300 | *)
|
---|
5301 |
|
---|
5302 | { TORAlignButton }
|
---|
5303 |
|
---|
5304 | constructor TORAlignButton.Create(AOwner: TComponent);
|
---|
5305 | begin
|
---|
5306 | inherited;
|
---|
5307 | FAlignment := taCenter;
|
---|
5308 | FLayout := tlCenter;
|
---|
5309 | FWordWrap := FALSE;
|
---|
5310 | end;
|
---|
5311 |
|
---|
5312 | procedure TORAlignButton.CreateParams(var Params: TCreateParams);
|
---|
5313 | const
|
---|
5314 | ButtonAlignment: array[TAlignment] of DWORD = (BS_LEFT, BS_RIGHT, BS_CENTER);
|
---|
5315 | ButtonWordWrap: array[boolean] of DWORD = (0, BS_MULTILINE);
|
---|
5316 | ButtonLayout: array[TTextLayout] of DWORD = (BS_TOP, BS_VCENTER, BS_BOTTOM);
|
---|
5317 | begin
|
---|
5318 | inherited CreateParams(Params);
|
---|
5319 | Params.Style := Params.Style or ButtonAlignment[FAlignment] or
|
---|
5320 | ButtonLayout[FLayout] or
|
---|
5321 | ButtonWordWrap[FWordWrap];
|
---|
5322 | end;
|
---|
5323 |
|
---|
5324 | procedure TORAlignButton.SetAlignment(const Value: TAlignment);
|
---|
5325 | begin
|
---|
5326 | if(FAlignment <> Value) then
|
---|
5327 | begin
|
---|
5328 | FAlignment := Value;
|
---|
5329 | RecreateWnd;
|
---|
5330 | end;
|
---|
5331 | end;
|
---|
5332 |
|
---|
5333 | procedure TORAlignButton.SetLayout(const Value: TTextLayout);
|
---|
5334 | begin
|
---|
5335 | if(FLayout <> Value) then
|
---|
5336 | begin
|
---|
5337 | FLayout := Value;
|
---|
5338 | RecreateWnd;
|
---|
5339 | end;
|
---|
5340 | end;
|
---|
5341 |
|
---|
5342 | procedure TORAlignButton.SetWordWrap(const Value: boolean);
|
---|
5343 | begin
|
---|
5344 | if(FWordWrap <> Value) then
|
---|
5345 | begin
|
---|
5346 | FWordWrap := Value;
|
---|
5347 | RecreateWnd;
|
---|
5348 | end;
|
---|
5349 | end;
|
---|
5350 |
|
---|
5351 | { TORTreeNode }
|
---|
5352 |
|
---|
5353 | procedure TORTreeNode.EnsureVisible;
|
---|
5354 | var
|
---|
5355 | R: TRect;
|
---|
5356 | DY, LH: integer;
|
---|
5357 |
|
---|
5358 | begin
|
---|
5359 | MakeVisible;
|
---|
5360 | R := DisplayRect(FALSE);
|
---|
5361 | if(R.Top < 0) then
|
---|
5362 | TreeView.TopItem := Self
|
---|
5363 | else
|
---|
5364 | if(R.Bottom > TreeView.ClientHeight) then
|
---|
5365 | begin
|
---|
5366 | DY := R.Bottom - TreeView.ClientHeight;
|
---|
5367 | LH := R.Bottom - R.Top + 1;
|
---|
5368 | DY := (DY div LH) + 1;
|
---|
5369 | GetORTreeView.SetVertScrollPos(GetORTreeView.GetVertScrollPos + DY);
|
---|
5370 | end;
|
---|
5371 | end;
|
---|
5372 |
|
---|
5373 | function TORTreeNode.GetBold: boolean;
|
---|
5374 | var
|
---|
5375 | Item: TTVItem;
|
---|
5376 | begin
|
---|
5377 | Result := False;
|
---|
5378 | with Item do
|
---|
5379 | begin
|
---|
5380 | mask := TVIF_STATE;
|
---|
5381 | hItem := ItemId;
|
---|
5382 | if TreeView_GetItem(Handle, Item) then
|
---|
5383 | Result := (state and TVIS_BOLD) <> 0;
|
---|
5384 | end;
|
---|
5385 | end;
|
---|
5386 |
|
---|
5387 | function TORTreeNode.GetORTreeView: TORTreeView;
|
---|
5388 | begin
|
---|
5389 | Result := ((inherited TreeView) as TORTreeView);
|
---|
5390 | end;
|
---|
5391 |
|
---|
5392 | function TORTreeNode.GetParent: TORTreeNode;
|
---|
5393 | begin
|
---|
5394 | Result := ((inherited Parent) as TORTreeNode);
|
---|
5395 | end;
|
---|
5396 |
|
---|
5397 | function TORTreeNode.GetText: string;
|
---|
5398 | begin
|
---|
5399 | Result := Inherited Text;
|
---|
5400 | end;
|
---|
5401 |
|
---|
5402 | procedure TORTreeNode.SetBold(const Value: boolean);
|
---|
5403 | var
|
---|
5404 | Item: TTVItem;
|
---|
5405 | Template: DWORD;
|
---|
5406 |
|
---|
5407 | begin
|
---|
5408 | if Value then Template := DWORD(-1)
|
---|
5409 | else Template := 0;
|
---|
5410 | with Item do
|
---|
5411 | begin
|
---|
5412 | mask := TVIF_STATE;
|
---|
5413 | hItem := ItemId;
|
---|
5414 | stateMask := TVIS_BOLD;
|
---|
5415 | state := stateMask and Template;
|
---|
5416 | end;
|
---|
5417 | TreeView_SetItem(Handle, Item);
|
---|
5418 | end;
|
---|
5419 |
|
---|
5420 | procedure TORTreeNode.SetPiece(PieceNum: Integer; const NewPiece: string);
|
---|
5421 | begin
|
---|
5422 | with GetORTreeView do
|
---|
5423 | begin
|
---|
5424 | ORCtrls.SetPiece(FStringData, FDelim, PieceNum, NewPiece);
|
---|
5425 | if(PieceNum = FPiece) then
|
---|
5426 | Text := NewPiece;
|
---|
5427 | end;
|
---|
5428 | end;
|
---|
5429 |
|
---|
5430 | procedure TORTreeNode.SetStringData(const Value: string);
|
---|
5431 | begin
|
---|
5432 | if(FStringData <> Value) then
|
---|
5433 | begin
|
---|
5434 | FStringData := Value;
|
---|
5435 | with GetORTreeView do
|
---|
5436 | if (FDelim <> #0) and (FPiece > 0) then
|
---|
5437 | inherited Text := Piece(FStringData, FDelim, FPiece);
|
---|
5438 | end;
|
---|
5439 | Caption := Text;
|
---|
5440 | end;
|
---|
5441 |
|
---|
5442 | procedure TORTreeNode.SetText(const Value: string);
|
---|
5443 | begin
|
---|
5444 | UpdateText(Value, TRUE);
|
---|
5445 | end;
|
---|
5446 |
|
---|
5447 | procedure TORTreeNode.UpdateText(const Value: string; UpdateData: boolean);
|
---|
5448 | begin
|
---|
5449 | Inherited Text := Value;
|
---|
5450 | Caption := Text;
|
---|
5451 | if(UpdateData) then
|
---|
5452 | with GetORTreeView do
|
---|
5453 | begin
|
---|
5454 | if (FDelim <> #0) and (FPiece > 0) then
|
---|
5455 | ORCtrls.SetPiece(FStringData, FDelim, FPiece, Value);
|
---|
5456 | end;
|
---|
5457 | end;
|
---|
5458 |
|
---|
5459 | function CalcShortName( LongName: string; PrevLongName: string): string;
|
---|
5460 | var
|
---|
5461 | WordBorder: integer;
|
---|
5462 | j: integer;
|
---|
5463 | begin
|
---|
5464 | WordBorder := 1;
|
---|
5465 | for j := 1 to Length(LongName) do
|
---|
5466 | begin
|
---|
5467 | if (LongName[j] = ' ') or ((j > 1) and (LongName[j-1] = ' ')) or
|
---|
5468 | ((j = Length(LongName)) and (j = Length(PrevLongName)) and (LongName[j] = PrevLongName[j])) then
|
---|
5469 | WordBorder := j;
|
---|
5470 | if (j > Length(PrevLongName)) or (LongName[j] <> PrevLongName[j]) then
|
---|
5471 | break;
|
---|
5472 | end;
|
---|
5473 | if WordBorder = 1 then
|
---|
5474 | result := LongName
|
---|
5475 | else if WordBorder = Length(LongName) then
|
---|
5476 | result := 'Same as above ('+LongName+')'
|
---|
5477 | else
|
---|
5478 | result := Copy(LongName,WordBorder,Length(LongName)) + ' ('+Trim(Copy(LongName,1,WordBorder -1)) + ')';
|
---|
5479 | end;
|
---|
5480 |
|
---|
5481 | procedure TORTreeNode.SetCaption(const Value: string);
|
---|
5482 | var
|
---|
5483 | TheCaption: string;
|
---|
5484 | begin
|
---|
5485 | TheCaption := Value;
|
---|
5486 | with GetORTreeView do
|
---|
5487 | begin
|
---|
5488 | if assigned(OnNodeCaptioning) then
|
---|
5489 | OnNodeCaptioning(self, TheCaption);
|
---|
5490 | if ShortNodeCaptions and (Self.GetPrevSibling <> nil) then
|
---|
5491 | TheCaption := CalcShortName( TheCaption, Self.GetPrevSibling.Text);
|
---|
5492 | end;
|
---|
5493 | FCaption := TheCaption;
|
---|
5494 | end;
|
---|
5495 |
|
---|
5496 | { TORTreeView }
|
---|
5497 |
|
---|
5498 | procedure TORTreeView.CNNotify(var Message: TWMNotify);
|
---|
5499 | var
|
---|
5500 | DNode: TTreeNode;
|
---|
5501 | DoInh: boolean;
|
---|
5502 |
|
---|
5503 | begin
|
---|
5504 | DoInh := TRUE;
|
---|
5505 | if(assigned(FOnDragging)) then
|
---|
5506 | begin
|
---|
5507 | with Message do
|
---|
5508 | begin
|
---|
5509 | case NMHdr^.code of
|
---|
5510 | TVN_BEGINDRAG:
|
---|
5511 | begin
|
---|
5512 | with PNMTreeView(Message.NMHdr)^.ItemNew do
|
---|
5513 | begin
|
---|
5514 | if (state and TVIF_PARAM) <> 0 then DNode := Pointer(lParam)
|
---|
5515 | else DNode := Items.GetNode(hItem);
|
---|
5516 | end;
|
---|
5517 | FOnDragging(Self, DNode, DoInh);
|
---|
5518 | if(not DoInh) then
|
---|
5519 | begin
|
---|
5520 | Message.Result := 1;
|
---|
5521 | Selected := DNode;
|
---|
5522 | end;
|
---|
5523 | end;
|
---|
5524 | end;
|
---|
5525 | end;
|
---|
5526 | end;
|
---|
5527 | if(DoInh) then inherited;
|
---|
5528 | end;
|
---|
5529 |
|
---|
5530 | constructor TORTreeView.Create(AOwner: TComponent);
|
---|
5531 | begin
|
---|
5532 | inherited;
|
---|
5533 | FDelim := '^';
|
---|
5534 | end;
|
---|
5535 |
|
---|
5536 | function TORTreeView.CreateNode: TTreeNode;
|
---|
5537 | begin
|
---|
5538 | Result := TORTreeNode.Create(Items);
|
---|
5539 | if Assigned( OnAddition ) then
|
---|
5540 | OnAddition(self, Result);
|
---|
5541 | end;
|
---|
5542 |
|
---|
5543 | function TORTreeView.FindPieceNode(Value: string;
|
---|
5544 | ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode;
|
---|
5545 | begin
|
---|
5546 | Result := FindPieceNode(Value, FPiece, ParentDelim, StartNode);
|
---|
5547 | end;
|
---|
5548 |
|
---|
5549 | function TORTreeView.FindPieceNode(Value: string; APiece: integer;
|
---|
5550 | ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode;
|
---|
5551 | var
|
---|
5552 | StartIdx, i: integer;
|
---|
5553 | Node: TORTreeNode;
|
---|
5554 |
|
---|
5555 | begin
|
---|
5556 | if assigned(StartNode) then
|
---|
5557 | StartIdx := StartNode.AbsoluteIndex+1
|
---|
5558 | else
|
---|
5559 | StartIdx := 0;
|
---|
5560 | Result := nil;
|
---|
5561 | for i := StartIdx to Items.Count-1 do
|
---|
5562 | begin
|
---|
5563 | Node := (Items[i] as TORTreeNode);
|
---|
5564 | if(GetNodeID(Node, APiece, ParentDelim) = Value) then
|
---|
5565 | begin
|
---|
5566 | Result := Node;
|
---|
5567 | break;
|
---|
5568 | end;
|
---|
5569 | end;
|
---|
5570 | end;
|
---|
5571 |
|
---|
5572 | function TORTreeView.GetExpandedIDStr(APiece: integer; ParentDelim: char = #0): string;
|
---|
5573 | var
|
---|
5574 | i: integer;
|
---|
5575 |
|
---|
5576 | begin
|
---|
5577 | Result := '';
|
---|
5578 | for i := 0 to Items.Count-1 do
|
---|
5579 | begin
|
---|
5580 | with (Items[i] as TORTreeNode) do
|
---|
5581 | begin
|
---|
5582 | if(Expanded) then
|
---|
5583 | begin
|
---|
5584 | if(Result <> '') then
|
---|
5585 | Result := Result + FDelim;
|
---|
5586 | Result := Result + GetNodeID(TORTreeNode(Items[i]), APiece, ParentDelim);
|
---|
5587 | end;
|
---|
5588 | end;
|
---|
5589 | end;
|
---|
5590 | end;
|
---|
5591 |
|
---|
5592 | procedure TORTreeView.SetExpandedIDStr(APiece: integer; const Value: string);
|
---|
5593 | begin
|
---|
5594 | SetExpandedIDStr(APiece, #0, Value);
|
---|
5595 | end;
|
---|
5596 |
|
---|
5597 | procedure TORTreeView.SetExpandedIDStr(APiece: integer; ParentDelim: char;
|
---|
5598 | const Value: string);
|
---|
5599 | var
|
---|
5600 | i: integer;
|
---|
5601 | Top, Sel: TTreeNode;
|
---|
5602 | Node: TORTreeNode;
|
---|
5603 | NList: string;
|
---|
5604 | Srch: string;
|
---|
5605 |
|
---|
5606 | begin
|
---|
5607 | Items.BeginUpdate;
|
---|
5608 | try
|
---|
5609 | Top := TopItem;
|
---|
5610 | Sel := Selected;
|
---|
5611 | FullCollapse;
|
---|
5612 | Selected := Sel;
|
---|
5613 | NList := Value;
|
---|
5614 | repeat
|
---|
5615 | i := pos(FDelim, NList);
|
---|
5616 | if(i = 0) then i := length(NList)+1;
|
---|
5617 | Srch := copy(NList,1,i-1);
|
---|
5618 | Node := FindPieceNode(Srch, APiece, ParentDelim);
|
---|
5619 | if(assigned(Node)) then
|
---|
5620 | Node.Expand(FALSE);
|
---|
5621 | Nlist := copy(NList,i+1,MaxInt);
|
---|
5622 | until(NList = '');
|
---|
5623 | TopItem := Top;
|
---|
5624 | Selected := Sel;
|
---|
5625 | finally
|
---|
5626 | Items.EndUpdate;
|
---|
5627 | end;
|
---|
5628 | end;
|
---|
5629 |
|
---|
5630 | function TORTreeView.GetHorzScrollPos: integer;
|
---|
5631 | begin
|
---|
5632 | Result := GetScrollPos(Handle, SB_HORZ);
|
---|
5633 | end;
|
---|
5634 |
|
---|
5635 | function TORTreeView.GetVertScrollPos: integer;
|
---|
5636 | begin
|
---|
5637 | Result := GetScrollPos(Handle, SB_VERT);
|
---|
5638 | end;
|
---|
5639 |
|
---|
5640 | procedure TORTreeView.RenameNodes;
|
---|
5641 | var
|
---|
5642 | i:integer;
|
---|
5643 |
|
---|
5644 | begin
|
---|
5645 | if(FDelim <> #0) and (FPiece > 0) then
|
---|
5646 | begin
|
---|
5647 | for i := 0 to Items.Count-1 do
|
---|
5648 | with (Items[i] as TORTreeNode) do
|
---|
5649 | UpdateText(Piece(FStringData, FDelim, FPiece), FALSE);
|
---|
5650 | end;
|
---|
5651 | end;
|
---|
5652 |
|
---|
5653 | procedure TORTreeView.SetNodeDelim(const Value: Char);
|
---|
5654 | begin
|
---|
5655 | if(FDelim <> Value) then
|
---|
5656 | begin
|
---|
5657 | FDelim := Value;
|
---|
5658 | RenameNodes;
|
---|
5659 | end;
|
---|
5660 | end;
|
---|
5661 |
|
---|
5662 | procedure TORTreeView.SetHorzScrollPos(Value: integer);
|
---|
5663 | begin
|
---|
5664 | if(Value < 0) then Value := 0;
|
---|
5665 | Perform(WM_HSCROLL,MakeWParam(SB_THUMBPOSITION, Value),0);
|
---|
5666 | end;
|
---|
5667 |
|
---|
5668 | procedure TORTreeView.SetNodePiece(const Value: integer);
|
---|
5669 | begin
|
---|
5670 | if(FPiece <> Value) then
|
---|
5671 | begin
|
---|
5672 | FPiece := Value;
|
---|
5673 | RenameNodes;
|
---|
5674 | end;
|
---|
5675 | end;
|
---|
5676 |
|
---|
5677 | procedure TORTreeView.SetVertScrollPos(Value: integer);
|
---|
5678 | begin
|
---|
5679 | if(Value < 0) then Value := 0;
|
---|
5680 | Perform(WM_VSCROLL,MakeWParam(SB_THUMBPOSITION, Value),0);
|
---|
5681 | end;
|
---|
5682 |
|
---|
5683 | function TORTreeView.GetNodeID(Node: TORTreeNode;
|
---|
5684 | ParentDelim: Char): string;
|
---|
5685 | begin
|
---|
5686 | Result := GetNodeID(Node, FPiece, ParentDelim);
|
---|
5687 | end;
|
---|
5688 |
|
---|
5689 | function TORTreeView.GetNodeID(Node: TORTreeNode; APiece: integer;
|
---|
5690 | ParentDelim: Char): string;
|
---|
5691 | begin
|
---|
5692 | if(assigned(Node)) then
|
---|
5693 | begin
|
---|
5694 | Result := Piece(Node.FStringData, FDelim, APiece);
|
---|
5695 | if((ParentDelim <> #0) and (ParentDelim <> FDelim) and (assigned(Node.Parent))) then
|
---|
5696 | Result := Result + ParentDelim + GetNodeID(Node.Parent, APiece, ParentDelim);
|
---|
5697 | end
|
---|
5698 | else
|
---|
5699 | Result := '';
|
---|
5700 | end;
|
---|
5701 |
|
---|
5702 | procedure TORTreeView.SetShortNodeCaptions(const Value: boolean);
|
---|
5703 | begin
|
---|
5704 | FShortNodeCaptions := Value;
|
---|
5705 | RenameNodes;
|
---|
5706 | end;
|
---|
5707 |
|
---|
5708 | { TORCBImageIndexes }
|
---|
5709 |
|
---|
5710 | constructor TORCBImageIndexes.Create(AOwner: TComponent);
|
---|
5711 | begin
|
---|
5712 | inherited;
|
---|
5713 | FCheckedEnabledIndex := -1;
|
---|
5714 | FCheckedDisabledIndex := -1;
|
---|
5715 | FGrayedEnabledIndex := -1;
|
---|
5716 | FGrayedDisabledIndex := -1;
|
---|
5717 | FUncheckedEnabledIndex := -1;
|
---|
5718 | FUncheckedDisabledIndex := -1;
|
---|
5719 | FImageChangeLink := TChangeLink.Create;
|
---|
5720 | FImageChangeLink.OnChange := ImageListChanged;
|
---|
5721 | end;
|
---|
5722 |
|
---|
5723 | destructor TORCBImageIndexes.Destroy;
|
---|
5724 | begin
|
---|
5725 | FImageChangeLink.Free;
|
---|
5726 | inherited;
|
---|
5727 | end;
|
---|
5728 |
|
---|
5729 | procedure TORCBImageIndexes.SetImages(const Value: TCustomImageList);
|
---|
5730 | begin
|
---|
5731 | if FImages <> nil then FImages.UnRegisterChanges(FImageChangeLink);
|
---|
5732 | FImages := Value;
|
---|
5733 | if FImages <> nil then
|
---|
5734 | begin
|
---|
5735 | FImages.RegisterChanges(FImageChangeLink);
|
---|
5736 | FImages.FreeNotification(Self);
|
---|
5737 | end;
|
---|
5738 | ImageListChanged(Self);
|
---|
5739 | end;
|
---|
5740 |
|
---|
5741 | function TORCBImageIndexes.IdxString: string;
|
---|
5742 | function RStr(Value: integer): string;
|
---|
5743 | begin
|
---|
5744 | if(Value <> -1) then
|
---|
5745 | Result := IntToStr(Value)
|
---|
5746 | else
|
---|
5747 | Result := '';
|
---|
5748 | Result := Result + ',';
|
---|
5749 | end;
|
---|
5750 |
|
---|
5751 | begin
|
---|
5752 | Result := RStr(FCheckedEnabledIndex) +
|
---|
5753 | RStr(FGrayedEnabledIndex) +
|
---|
5754 | RStr(FUncheckedEnabledIndex) +
|
---|
5755 | RStr(FCheckedDisabledIndex) +
|
---|
5756 | RStr(FGrayedDisabledIndex) +
|
---|
5757 | RStr(FUncheckedDisabledIndex);
|
---|
5758 | delete(Result,length(Result),1);
|
---|
5759 | if(Result = ',,,,,') then Result := '';
|
---|
5760 | end;
|
---|
5761 |
|
---|
5762 | procedure TORCBImageIndexes.SetIdxString(Value: string);
|
---|
5763 | var
|
---|
5764 | i,j,v: integer;
|
---|
5765 | Sub: String;
|
---|
5766 |
|
---|
5767 | begin
|
---|
5768 | if(Value = '') then
|
---|
5769 | begin
|
---|
5770 | FCheckedEnabledIndex := -1;
|
---|
5771 | FGrayedEnabledIndex := -1;
|
---|
5772 | FUncheckedEnabledIndex := -1;
|
---|
5773 | FCheckedDisabledIndex := -1;
|
---|
5774 | FGrayedDisabledIndex := -1;
|
---|
5775 | FUncheckedDisabledIndex := -1;
|
---|
5776 | end
|
---|
5777 | else
|
---|
5778 | begin
|
---|
5779 | i := 0;
|
---|
5780 | Sub := Value;
|
---|
5781 | repeat
|
---|
5782 | j := pos(',',Sub);
|
---|
5783 | if(j = 0) then j := length(Sub)+1;
|
---|
5784 | v := StrToIntDef(copy(Sub,1,j-1),-1);
|
---|
5785 | case i of
|
---|
5786 | 0: FCheckedEnabledIndex := v;
|
---|
5787 | 1: FGrayedEnabledIndex := v;
|
---|
5788 | 2: FUncheckedEnabledIndex := v;
|
---|
5789 | 3: FCheckedDisabledIndex := v;
|
---|
5790 | 4: FGrayedDisabledIndex := v;
|
---|
5791 | 5: FUncheckedDisabledIndex := v;
|
---|
5792 | end;
|
---|
5793 | inc(i);
|
---|
5794 | Sub := copy(Sub,j+1,MaxInt);
|
---|
5795 | until(Sub = '');
|
---|
5796 | end;
|
---|
5797 | end;
|
---|
5798 |
|
---|
5799 | procedure TORCBImageIndexes.ImageListChanged(Sender: TObject);
|
---|
5800 | begin
|
---|
5801 | if(Owner is TWinControl) then
|
---|
5802 | (Owner as TWinControl).Invalidate;
|
---|
5803 | end;
|
---|
5804 |
|
---|
5805 | procedure TORCBImageIndexes.Notification(AComponent: TComponent; Operation: TOperation);
|
---|
5806 | begin
|
---|
5807 | inherited Notification(AComponent, Operation);
|
---|
5808 | if (AComponent = FImages) and (Operation = opRemove) then SetImages(nil);
|
---|
5809 | end;
|
---|
5810 |
|
---|
5811 | procedure TORCBImageIndexes.SetCheckedDisabledIndex(const Value: integer);
|
---|
5812 | begin
|
---|
5813 | if(FCheckedDisabledIndex <> Value) then
|
---|
5814 | begin
|
---|
5815 | FCheckedDisabledIndex := Value;
|
---|
5816 | ImageListChanged(Self);
|
---|
5817 | end;
|
---|
5818 | end;
|
---|
5819 |
|
---|
5820 | procedure TORCBImageIndexes.SetCheckedEnabledIndex(const Value: integer);
|
---|
5821 | begin
|
---|
5822 | if(FCheckedEnabledIndex <> Value) then
|
---|
5823 | begin
|
---|
5824 | FCheckedEnabledIndex := Value;
|
---|
5825 | ImageListChanged(Self);
|
---|
5826 | end;
|
---|
5827 | end;
|
---|
5828 |
|
---|
5829 | procedure TORCBImageIndexes.SetGrayedDisabledIndex(const Value: integer);
|
---|
5830 | begin
|
---|
5831 | if(FGrayedDisabledIndex <> Value) then
|
---|
5832 | begin
|
---|
5833 | FGrayedDisabledIndex := Value;
|
---|
5834 | ImageListChanged(Self);
|
---|
5835 | end;
|
---|
5836 | end;
|
---|
5837 |
|
---|
5838 | procedure TORCBImageIndexes.SetGrayedEnabledIndex(const Value: integer);
|
---|
5839 | begin
|
---|
5840 | if(FGrayedEnabledIndex <> Value) then
|
---|
5841 | begin
|
---|
5842 | FGrayedEnabledIndex := Value;
|
---|
5843 | ImageListChanged(Self);
|
---|
5844 | end;
|
---|
5845 | end;
|
---|
5846 |
|
---|
5847 | procedure TORCBImageIndexes.SetUncheckedDisabledIndex(const Value: integer);
|
---|
5848 | begin
|
---|
5849 | if(FUncheckedDisabledIndex <> Value) then
|
---|
5850 | begin
|
---|
5851 | FUncheckedDisabledIndex := Value;
|
---|
5852 | ImageListChanged(Self);
|
---|
5853 | end;
|
---|
5854 | end;
|
---|
5855 |
|
---|
5856 | procedure TORCBImageIndexes.SetUncheckedEnabledIndex(const Value: integer);
|
---|
5857 | begin
|
---|
5858 | if(FUncheckedEnabledIndex <> Value) then
|
---|
5859 | begin
|
---|
5860 | FUncheckedEnabledIndex := Value;
|
---|
5861 | ImageListChanged(Self);
|
---|
5862 | end;
|
---|
5863 | end;
|
---|
5864 |
|
---|
5865 | { TORCheckBox }
|
---|
5866 |
|
---|
5867 | constructor TORCheckBox.Create(AOwner: TComponent);
|
---|
5868 | begin
|
---|
5869 | CreateCommon(AOwner);
|
---|
5870 | FCustomImages := TORCBImageIndexes.Create(Self);
|
---|
5871 | FCustomImagesOwned := TRUE;
|
---|
5872 | FAllowAllUnchecked := TRUE;
|
---|
5873 | end;
|
---|
5874 |
|
---|
5875 | constructor TORCheckBox.ListViewCreate(AOwner: TComponent; ACustomImages: TORCBImageIndexes);
|
---|
5876 | begin
|
---|
5877 | CreateCommon(AOwner);
|
---|
5878 | FCustomImages := ACustomImages;
|
---|
5879 | FCustomImagesOwned := FALSE;
|
---|
5880 | end;
|
---|
5881 |
|
---|
5882 | procedure TORCheckBox.CreateCommon(AOwner: TComponent);
|
---|
5883 | begin
|
---|
5884 | inherited Create(AOwner);
|
---|
5885 | FGrayedToChecked := TRUE;
|
---|
5886 | FCanvas := TCanvas.Create;
|
---|
5887 | end;
|
---|
5888 |
|
---|
5889 | destructor TORCheckBox.Destroy;
|
---|
5890 | begin
|
---|
5891 | if(FCustomImagesOwned) then FCustomImages.Free;
|
---|
5892 | FCanvas.Free;
|
---|
5893 | inherited;
|
---|
5894 | end;
|
---|
5895 |
|
---|
5896 |
|
---|
5897 | function TORCheckBox.GetImageIndexes: string;
|
---|
5898 | begin
|
---|
5899 | Result := FCustomImages.IdxString;
|
---|
5900 | end;
|
---|
5901 |
|
---|
5902 | function TORCheckBox.GetImageList: TCustomImageList;
|
---|
5903 | begin
|
---|
5904 | Result := FCustomImages.FImages;
|
---|
5905 | end;
|
---|
5906 |
|
---|
5907 | procedure TORCheckBox.SetImageIndexes(const Value: string);
|
---|
5908 | begin
|
---|
5909 | FCustomImages.SetIdxString(Value);
|
---|
5910 | end;
|
---|
5911 |
|
---|
5912 | procedure TORCheckBox.SetImageList(const Value: TCustomImageList);
|
---|
5913 | begin
|
---|
5914 | FCustomImages.SetImages(Value);
|
---|
5915 | end;
|
---|
5916 |
|
---|
5917 | procedure TORCheckBox.Toggle;
|
---|
5918 | begin
|
---|
5919 | if(FGrayedToChecked) then
|
---|
5920 | begin
|
---|
5921 | case State of
|
---|
5922 | cbUnchecked:
|
---|
5923 | if AllowGrayed then State := cbGrayed else State := cbChecked;
|
---|
5924 | cbChecked: State := cbUnchecked;
|
---|
5925 | cbGrayed: State := cbChecked;
|
---|
5926 | end;
|
---|
5927 | end
|
---|
5928 | else
|
---|
5929 | begin
|
---|
5930 | case State of
|
---|
5931 | cbUnchecked: State := cbChecked;
|
---|
5932 | cbChecked: if AllowGrayed then State := cbGrayed else State := cbUnchecked;
|
---|
5933 | cbGrayed: State := cbUnchecked;
|
---|
5934 | end;
|
---|
5935 | end;
|
---|
5936 | end;
|
---|
5937 |
|
---|
5938 | procedure TORCheckBox.CreateParams(var Params: TCreateParams);
|
---|
5939 | begin
|
---|
5940 | inherited CreateParams(Params);
|
---|
5941 | Params.Style := (Params.Style and (not BS_3STATE)) or BS_OWNERDRAW;
|
---|
5942 | end;
|
---|
5943 |
|
---|
5944 | procedure TORCheckBox.CMEnabledChanged(var Message: TMessage);
|
---|
5945 | begin
|
---|
5946 | inherited;
|
---|
5947 | Invalidate;
|
---|
5948 | end;
|
---|
5949 |
|
---|
5950 | procedure TORCheckBox.CMFontChanged(var Message: TMessage);
|
---|
5951 | begin
|
---|
5952 | inherited;
|
---|
5953 | Invalidate;
|
---|
5954 | end;
|
---|
5955 |
|
---|
5956 | procedure TORCheckBox.CNDrawItem(var Message: TWMDrawItem);
|
---|
5957 | begin
|
---|
5958 | DrawItem(Message.DrawItemStruct^);
|
---|
5959 | end;
|
---|
5960 |
|
---|
5961 | procedure TORCheckBox.CNMeasureItem(var Message: TWMMeasureItem);
|
---|
5962 | begin
|
---|
5963 | with Message.MeasureItemStruct^ do
|
---|
5964 | begin
|
---|
5965 | itemWidth := Width;
|
---|
5966 | itemHeight := Height;
|
---|
5967 | end;
|
---|
5968 | end;
|
---|
5969 |
|
---|
5970 | procedure TORCheckBox.GetDrawData(CanvasHandle: HDC; var Bitmap: TBitmap;
|
---|
5971 | var FocRect, Rect: TRect;
|
---|
5972 | var DrawOptions: UINT;
|
---|
5973 | var TempBitMap: boolean);
|
---|
5974 | var
|
---|
5975 | i, l, TxtHeight, TxtWidth, AWidth: Integer;
|
---|
5976 | ImgIdx: TORCBImgIdx;
|
---|
5977 | CustomImgIdx: integer;
|
---|
5978 |
|
---|
5979 | begin
|
---|
5980 | BitMap := nil;
|
---|
5981 | TempBitMap := FALSE;
|
---|
5982 | DrawOptions := DT_LEFT;
|
---|
5983 | FSingleLine := TRUE;
|
---|
5984 |
|
---|
5985 | if(not (csDestroying in ComponentState)) then
|
---|
5986 | begin
|
---|
5987 | with FCustomImages do
|
---|
5988 | begin
|
---|
5989 | FCanvas.Handle := CanvasHandle;
|
---|
5990 | try
|
---|
5991 | Rect := ClientRect;
|
---|
5992 | with FCanvas do
|
---|
5993 | begin
|
---|
5994 | CustomImgIdx := -1;
|
---|
5995 | if(assigned(FImages)) then
|
---|
5996 | begin
|
---|
5997 | if(Enabled or (csDesigning in ComponentState)) then
|
---|
5998 | begin
|
---|
5999 | case State of
|
---|
6000 | cbChecked: CustomImgIdx := FCheckedEnabledIndex;
|
---|
6001 | cbUnChecked: CustomImgIdx := FUncheckedEnabledIndex;
|
---|
6002 | cbGrayed: CustomImgIdx := FGrayedEnabledIndex;
|
---|
6003 | end;
|
---|
6004 | end
|
---|
6005 | else
|
---|
6006 | begin
|
---|
6007 | case State of
|
---|
6008 | cbChecked: CustomImgIdx := FCheckedDisabledIndex;
|
---|
6009 | cbUnChecked: CustomImgIdx := FUncheckedDisabledIndex;
|
---|
6010 | cbGrayed: CustomImgIdx := FGrayedDisabledIndex;
|
---|
6011 | end;
|
---|
6012 | end;
|
---|
6013 | if((CustomImgIdx < 0) or (CustomImgIdx >= FImages.Count)) then
|
---|
6014 | CustomImgIdx := -1;
|
---|
6015 | end;
|
---|
6016 | if(CustomImgIdx < 0) then
|
---|
6017 | begin
|
---|
6018 | ImgIdx := iiChecked;
|
---|
6019 | if(Enabled or (csDesigning in ComponentState)) then
|
---|
6020 | begin
|
---|
6021 | if(FRadioStyle) then
|
---|
6022 | begin
|
---|
6023 | if State = cbChecked then
|
---|
6024 | ImgIdx := iiRadioChecked
|
---|
6025 | else
|
---|
6026 | ImgIdx := iiRadioUnchecked;
|
---|
6027 | end
|
---|
6028 | else
|
---|
6029 | begin
|
---|
6030 | case State of
|
---|
6031 | cbChecked: ImgIdx := iiChecked;
|
---|
6032 | cbUnChecked: ImgIdx := iiUnchecked;
|
---|
6033 | cbGrayed:
|
---|
6034 | begin
|
---|
6035 | case FGrayedStyle of
|
---|
6036 | gsNormal: ImgIdx := iiGrayed;
|
---|
6037 | gsQuestionMark: ImgIdx := iiQMark;
|
---|
6038 | gsBlueQuestionMark: ImgIdx := iiBlueQMark;
|
---|
6039 | end;
|
---|
6040 | end;
|
---|
6041 | end;
|
---|
6042 | end;
|
---|
6043 | end
|
---|
6044 | else
|
---|
6045 | begin
|
---|
6046 | if(FRadioStyle) then
|
---|
6047 | begin
|
---|
6048 | if State = cbChecked then
|
---|
6049 | ImgIdx := iiRadioDisChecked
|
---|
6050 | else
|
---|
6051 | ImgIdx := iiRadioDisUnchecked;
|
---|
6052 | end
|
---|
6053 | else
|
---|
6054 | begin
|
---|
6055 | case State of
|
---|
6056 | cbChecked: ImgIdx := iiDisChecked;
|
---|
6057 | cbUnChecked: ImgIdx := iiDisUnchecked;
|
---|
6058 | cbGrayed:
|
---|
6059 | begin
|
---|
6060 | if(FGrayedStyle = gsNormal) then
|
---|
6061 | ImgIdx := iiDisGrayed
|
---|
6062 | else
|
---|
6063 | ImgIdx := iiDisQMark;
|
---|
6064 | end;
|
---|
6065 | end;
|
---|
6066 | end;
|
---|
6067 | end;
|
---|
6068 | Bitmap := GetORCBBitmap(ImgIdx, FBlackColorMode);
|
---|
6069 | end
|
---|
6070 | else
|
---|
6071 | begin
|
---|
6072 | Bitmap := TBitmap.Create;
|
---|
6073 | FImages.GetBitmap(CustomImgIdx, Bitmap);
|
---|
6074 | TempBitMap := TRUE;
|
---|
6075 | end;
|
---|
6076 | Brush.Style := bsClear;
|
---|
6077 | Font := Self.Font;
|
---|
6078 |
|
---|
6079 | if Alignment = taLeftJustify then
|
---|
6080 | Rect.Left := 2
|
---|
6081 | else
|
---|
6082 | Rect.Left := Bitmap.Width + 5;
|
---|
6083 |
|
---|
6084 | if(FWordWrap) then
|
---|
6085 | DrawOptions := DrawOptions or DT_WORDBREAK
|
---|
6086 | else
|
---|
6087 | DrawOptions := DrawOptions or DT_VCENTER or DT_SINGLELINE;
|
---|
6088 |
|
---|
6089 | if(FWordWrap) then
|
---|
6090 | begin
|
---|
6091 | if Alignment = taLeftJustify then
|
---|
6092 | Rect.Right := Width - Bitmap.Width - 3
|
---|
6093 | else
|
---|
6094 | Rect.Right := Width;
|
---|
6095 | Rect.Top := 1;
|
---|
6096 | Rect.Bottom := Height+1;
|
---|
6097 | dec(Rect.Right);
|
---|
6098 | FocRect := Rect;
|
---|
6099 | TxtHeight := DrawText(Handle, PChar(Caption), Length(Caption), FocRect,
|
---|
6100 | DrawOptions or DT_CALCRECT);
|
---|
6101 | FSingleLine := (TxtHeight = TextHeight(Caption));
|
---|
6102 | Rect.Bottom := Rect.Top + TxtHeight + 1;
|
---|
6103 | FocRect := Rect;
|
---|
6104 | end
|
---|
6105 | else
|
---|
6106 | begin
|
---|
6107 | TxtWidth := TextWidth(Caption);
|
---|
6108 | //Get rid of ampersands that turn into underlines
|
---|
6109 | i := 0;
|
---|
6110 | l := length(Caption);
|
---|
6111 | AWidth := TextWidth('&');
|
---|
6112 | while(i < l) do
|
---|
6113 | begin
|
---|
6114 | inc(i);
|
---|
6115 | // '&&' is an escape char that should display one '&' wide.
|
---|
6116 | // This next part preserves the first '&' but drops all the others
|
---|
6117 | if (Copy(Caption,i,2)<>'&&') and (Copy(Caption,i,1)='&') then
|
---|
6118 | dec(TxtWidth,AWidth);
|
---|
6119 | end;
|
---|
6120 | Rect.Right := Rect.Left + TxtWidth;
|
---|
6121 | TxtHeight := TextHeight(Caption);
|
---|
6122 | if(TxtHeight < Bitmap.Height) then
|
---|
6123 | TxtHeight := Bitmap.Height;
|
---|
6124 | Rect.Top := ((((ClientHeight - TxtHeight) * 5) - 5) div 10);
|
---|
6125 | Rect.Bottom := Rect.Top + TxtHeight + 1;
|
---|
6126 | IntersectRect(FocRect, Rect, ClientRect);
|
---|
6127 | end;
|
---|
6128 | end;
|
---|
6129 | finally
|
---|
6130 | FCanvas.Handle := 0;
|
---|
6131 | end;
|
---|
6132 | end;
|
---|
6133 | end;
|
---|
6134 | end;
|
---|
6135 |
|
---|
6136 | procedure TORCheckBox.DrawItem(const DrawItemStruct: TDrawItemStruct);
|
---|
6137 | var
|
---|
6138 | R, FocusRect, TempRect: TRect;
|
---|
6139 | Bitmap: TBitmap;
|
---|
6140 | OldColor: TColor;
|
---|
6141 | DrawOptions: UINT;
|
---|
6142 | TempBitMap: boolean;
|
---|
6143 |
|
---|
6144 | begin
|
---|
6145 | if(not (csDestroying in ComponentState)) then
|
---|
6146 | begin
|
---|
6147 | GetDrawData(DrawItemStruct.hDC, Bitmap, FocusRect, R, DrawOptions, TempBitMap);
|
---|
6148 | try
|
---|
6149 | FCanvas.Handle := DrawItemStruct.hDC;
|
---|
6150 | try
|
---|
6151 | with FCanvas do
|
---|
6152 | begin
|
---|
6153 | Brush.Color := Self.Color;
|
---|
6154 | Brush.Style := bsSolid;
|
---|
6155 | InflateRect(R, 1, 1);
|
---|
6156 | FillRect(R);
|
---|
6157 | InflateRect(R, -1, -1);
|
---|
6158 |
|
---|
6159 | Brush.Style := bsClear;
|
---|
6160 | Font := Self.Font;
|
---|
6161 |
|
---|
6162 | if(Enabled or (csDesigning in ComponentState)) then
|
---|
6163 | begin
|
---|
6164 | DrawText(Handle, PChar(Caption), Length(Caption), FocusRect, DrawOptions);
|
---|
6165 | end
|
---|
6166 | else
|
---|
6167 | begin
|
---|
6168 | OldColor:=Font.Color;
|
---|
6169 | try
|
---|
6170 | if Ctl3D then
|
---|
6171 | begin
|
---|
6172 | OffsetRect(FocusRect, 1, 1);
|
---|
6173 | Font.Color := clBtnHighlight;
|
---|
6174 | DrawText(Handle, PChar(Caption), Length(Caption), FocusRect, DrawOptions);
|
---|
6175 | OffsetRect(FocusRect, -1, -1);
|
---|
6176 | end;
|
---|
6177 | Font.Color:=clGrayText;
|
---|
6178 | DrawText(Handle, PChar(Caption), Length(Caption), FocusRect, DrawOptions);
|
---|
6179 | finally
|
---|
6180 | Font.Color:=OldColor;
|
---|
6181 | end;
|
---|
6182 |
|
---|
6183 | Brush.Color := Self.Color;
|
---|
6184 | Brush.Style := bsSolid;
|
---|
6185 | end;
|
---|
6186 |
|
---|
6187 | if((DrawItemStruct.itemState and ODS_FOCUS) <> 0) then
|
---|
6188 | begin
|
---|
6189 | InflateRect(FocusRect, 1, 1);
|
---|
6190 | if(FFocusOnBox) then
|
---|
6191 | //TempRect := Rect(0, 0, CheckWidth - 1, CheckWidth - 1)
|
---|
6192 | TempRect := Rect(0, 0, CheckWidth + 2, CheckWidth + 5)
|
---|
6193 | else
|
---|
6194 | TempRect := FocusRect;
|
---|
6195 | //UnionRect(Temp2Rect,ClipRect,TempRect);
|
---|
6196 | //ClipRect := Temp2Rect;
|
---|
6197 | Pen.Color := clWindowFrame;
|
---|
6198 | Brush.Color := clBtnFace;
|
---|
6199 | DrawFocusRect(TempRect);
|
---|
6200 | InflateRect(FocusRect, -1, -1);
|
---|
6201 | end;
|
---|
6202 |
|
---|
6203 | if Alignment = taLeftJustify then
|
---|
6204 | R.Left := ClientWidth - Bitmap.Width
|
---|
6205 | else
|
---|
6206 | R.Left := 0;
|
---|
6207 | if(FWordWrap) then
|
---|
6208 | R.Top:= FocusRect.Top
|
---|
6209 | else
|
---|
6210 | begin
|
---|
6211 | R.Top:= ((ClientHeight - Bitmap.Height + 1) div 2) - 1;
|
---|
6212 | if R.Top < 0 then R.Top := 0
|
---|
6213 | end;
|
---|
6214 | Draw(R.Left, R.Top, Bitmap);
|
---|
6215 | end;
|
---|
6216 | finally
|
---|
6217 | FCanvas.Handle := 0;
|
---|
6218 | end;
|
---|
6219 | finally
|
---|
6220 | if(TempBitMap) then
|
---|
6221 | Bitmap.Free;
|
---|
6222 | end;
|
---|
6223 | end;
|
---|
6224 | end;
|
---|
6225 |
|
---|
6226 | procedure TORCheckBox.SetGrayedStyle(Value: TGrayedStyle);
|
---|
6227 | begin
|
---|
6228 | if(FGrayedStyle <> Value) then
|
---|
6229 | begin
|
---|
6230 | FGrayedStyle := Value;
|
---|
6231 | if(State = cbGrayed) then Invalidate;
|
---|
6232 | end;
|
---|
6233 | end;
|
---|
6234 |
|
---|
6235 | procedure TORCheckBox.WMLButtonDblClk(var Message: TWMLButtonDblClk);
|
---|
6236 | begin
|
---|
6237 | Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
|
---|
6238 | end;
|
---|
6239 |
|
---|
6240 | procedure TORCheckBox.WMSize(var Message: TWMSize);
|
---|
6241 | begin
|
---|
6242 | inherited;
|
---|
6243 | if(FSizable) and (csDesigning in ComponentState) then
|
---|
6244 | AutoAdjustSize;
|
---|
6245 | end;
|
---|
6246 |
|
---|
6247 | procedure TORCheckBox.BMSETCHECK(var Message: TMessage);
|
---|
6248 | var
|
---|
6249 | cnt, i: integer;
|
---|
6250 | cb: TORCheckBox;
|
---|
6251 | Chk: boolean;
|
---|
6252 |
|
---|
6253 | begin
|
---|
6254 | Message.Result := 0;
|
---|
6255 |
|
---|
6256 | if(assigned(Parent) and (FGroupIndex <> 0)) then
|
---|
6257 | begin
|
---|
6258 | Chk := Checked;
|
---|
6259 | if(Chk or (not FAllowAllUnchecked)) then
|
---|
6260 | begin
|
---|
6261 | cnt := 0;
|
---|
6262 | for i := 0 to Parent.ControlCount-1 do
|
---|
6263 | begin
|
---|
6264 | if(Parent.Controls[i] is TORCheckBox) then
|
---|
6265 | begin
|
---|
6266 | cb := TORCheckBox(Parent.Controls[i]);
|
---|
6267 | if(cb <> Self) then
|
---|
6268 | begin
|
---|
6269 | if(cb.Checked and (cb.FGroupIndex = FGroupIndex)) then
|
---|
6270 | begin
|
---|
6271 | if Chk then
|
---|
6272 | cb.Checked := FALSE
|
---|
6273 | else
|
---|
6274 | inc(cnt);
|
---|
6275 | end;
|
---|
6276 | end;
|
---|
6277 | end;
|
---|
6278 | end;
|
---|
6279 | if(not Chk) and (Cnt = 0) then
|
---|
6280 | Checked := TRUE;
|
---|
6281 | end;
|
---|
6282 | end;
|
---|
6283 | UpdateAssociate;
|
---|
6284 | Invalidate;
|
---|
6285 | end;
|
---|
6286 |
|
---|
6287 | procedure TORCheckBox.SetWordWrap(const Value: boolean);
|
---|
6288 | begin
|
---|
6289 | if(FWordWrap <> Value) then
|
---|
6290 | begin
|
---|
6291 | FWordWrap := Value;
|
---|
6292 | AutoAdjustSize;
|
---|
6293 | invalidate;
|
---|
6294 | end;
|
---|
6295 | end;
|
---|
6296 |
|
---|
6297 | procedure TORCheckBox.SetAutoSize(Value: boolean);
|
---|
6298 | begin
|
---|
6299 | if(FAutoSize <> Value) then
|
---|
6300 | begin
|
---|
6301 | FAutoSize := Value;
|
---|
6302 | AutoAdjustSize;
|
---|
6303 | invalidate;
|
---|
6304 | end;
|
---|
6305 | end;
|
---|
6306 |
|
---|
6307 | procedure TORCheckBox.SetBlackColorMode(Value: boolean);
|
---|
6308 | begin
|
---|
6309 | if FBlackColorMode <> Value then
|
---|
6310 | begin
|
---|
6311 | FBlackColorMode := Value;
|
---|
6312 | Invalidate;
|
---|
6313 | end;
|
---|
6314 | end;
|
---|
6315 |
|
---|
6316 | procedure TORCheckBox.AutoAdjustSize;
|
---|
6317 | var
|
---|
6318 | R, FocusRect: TRect;
|
---|
6319 | Bitmap: TBitmap;
|
---|
6320 | DrawOptions: UINT;
|
---|
6321 | TempBitMap: boolean;
|
---|
6322 | DC: HDC;
|
---|
6323 | SaveFont: HFont;
|
---|
6324 |
|
---|
6325 | begin
|
---|
6326 | if(FAutoSize and (([csDestroying, csLoading] * ComponentState) = [])) then
|
---|
6327 | begin
|
---|
6328 | FSizable := TRUE;
|
---|
6329 | DC := GetDC(0);
|
---|
6330 | try
|
---|
6331 | SaveFont := SelectObject(DC, Font.Handle);
|
---|
6332 | try
|
---|
6333 | GetDrawData(DC, Bitmap, FocusRect, R, DrawOptions, TempBitMap);
|
---|
6334 | finally
|
---|
6335 | SelectObject(DC, SaveFont);
|
---|
6336 | end;
|
---|
6337 | finally
|
---|
6338 | ReleaseDC(0, DC);
|
---|
6339 | end;
|
---|
6340 | if(FocusRect.Left <> R.Left ) or
|
---|
6341 | (FocusRect.Right <> R.Right ) or
|
---|
6342 | (FocusRect.Top <> R.Top ) or
|
---|
6343 | (FocusRect.Bottom <> R.Bottom) or
|
---|
6344 | (R.Right <> ClientRect.Right) or
|
---|
6345 | (R.Bottom <> ClientRect.Bottom) then
|
---|
6346 | begin
|
---|
6347 | FocusRect := R;
|
---|
6348 | if Alignment = taLeftJustify then
|
---|
6349 | begin
|
---|
6350 | dec(R.Left,2);
|
---|
6351 | inc(R.Right,Bitmap.Width + 3);
|
---|
6352 | end
|
---|
6353 | else
|
---|
6354 | dec(R.Left,Bitmap.Width + 5);
|
---|
6355 | Width := R.Right-R.Left+1;
|
---|
6356 | Height := R.Bottom-R.Top+2;
|
---|
6357 | end;
|
---|
6358 | end;
|
---|
6359 | end;
|
---|
6360 |
|
---|
6361 | function TORCheckBox.GetCaption: TCaption;
|
---|
6362 | begin
|
---|
6363 | Result := inherited Caption;
|
---|
6364 | end;
|
---|
6365 |
|
---|
6366 | procedure TORCheckBox.SetCaption(const Value: TCaption);
|
---|
6367 | begin
|
---|
6368 | if(inherited Caption <> Value) then
|
---|
6369 | begin
|
---|
6370 | inherited Caption := Value;
|
---|
6371 | AutoAdjustSize;
|
---|
6372 | invalidate;
|
---|
6373 | end;
|
---|
6374 | end;
|
---|
6375 |
|
---|
6376 | procedure TORCheckBox.SetAllowAllUnchecked(const Value: boolean);
|
---|
6377 | begin
|
---|
6378 | FAllowAllUnchecked := Value;
|
---|
6379 | SyncAllowAllUnchecked;
|
---|
6380 | end;
|
---|
6381 |
|
---|
6382 | procedure TORCheckBox.SetGroupIndex(const Value: integer);
|
---|
6383 | begin
|
---|
6384 | FGroupIndex := Value;
|
---|
6385 | if(Value <> 0) and (csDesigning in ComponentState) and (not (csLoading in ComponentState)) then
|
---|
6386 | SetRadioStyle(TRUE);
|
---|
6387 | SyncAllowAllUnchecked;
|
---|
6388 | end;
|
---|
6389 |
|
---|
6390 | procedure TORCheckBox.SyncAllowAllUnchecked;
|
---|
6391 | var
|
---|
6392 | i: integer;
|
---|
6393 | cb: TORCheckBox;
|
---|
6394 |
|
---|
6395 | begin
|
---|
6396 | if(assigned(Parent) and (FGroupIndex <> 0)) then
|
---|
6397 | begin
|
---|
6398 | for i := 0 to Parent.ControlCount-1 do
|
---|
6399 | begin
|
---|
6400 | if(Parent.Controls[i] is TORCheckBox) then
|
---|
6401 | begin
|
---|
6402 | cb := TORCheckBox(Parent.Controls[i]);
|
---|
6403 | if((cb <> Self) and (cb.FGroupIndex = FGroupIndex)) then
|
---|
6404 | cb.FAllowAllUnchecked := FAllowAllUnchecked;
|
---|
6405 | end;
|
---|
6406 | end;
|
---|
6407 | end;
|
---|
6408 | end;
|
---|
6409 |
|
---|
6410 | procedure TORCheckBox.SetParent(AParent: TWinControl);
|
---|
6411 | begin
|
---|
6412 | inherited;
|
---|
6413 | SyncAllowAllUnchecked;
|
---|
6414 | end;
|
---|
6415 |
|
---|
6416 | procedure TORCheckBox.SetRadioStyle(const Value: boolean);
|
---|
6417 | begin
|
---|
6418 | FRadioStyle := Value;
|
---|
6419 | Invalidate;
|
---|
6420 | end;
|
---|
6421 |
|
---|
6422 | procedure TORCheckBox.SetAssociate(const Value: TControl);
|
---|
6423 | begin
|
---|
6424 | if(FAssociate <> Value) then
|
---|
6425 | begin
|
---|
6426 | if(assigned(FAssociate)) then
|
---|
6427 | FAssociate.RemoveFreeNotification(Self);
|
---|
6428 | FAssociate := Value;
|
---|
6429 | if(assigned(FAssociate)) then
|
---|
6430 | begin
|
---|
6431 | FAssociate.FreeNotification(Self);
|
---|
6432 | UpdateAssociate;
|
---|
6433 | end;
|
---|
6434 | end;
|
---|
6435 | end;
|
---|
6436 |
|
---|
6437 | procedure TORCheckBox.UpdateAssociate;
|
---|
6438 |
|
---|
6439 | procedure EnableCtrl(Ctrl: TControl; DoCtrl: boolean);
|
---|
6440 | var
|
---|
6441 | i: integer;
|
---|
6442 | DoIt: boolean;
|
---|
6443 |
|
---|
6444 | begin
|
---|
6445 | if DoCtrl then
|
---|
6446 | Ctrl.Enabled := Checked;
|
---|
6447 |
|
---|
6448 | // added (csAcceptsControls in Ctrl.ControlStyle) below to prevent disabling of
|
---|
6449 | // child sub controls, like the TBitBtn in the TORComboBox. If the combo box is
|
---|
6450 | // already disabled, we don't want to disable the button as well - when we do, we
|
---|
6451 | // lose the disabled glyph that is stored on that button for the combo box.
|
---|
6452 |
|
---|
6453 | if(Ctrl is TWinControl) and (csAcceptsControls in Ctrl.ControlStyle) then
|
---|
6454 | begin
|
---|
6455 | for i := 0 to TWinControl(Ctrl).ControlCount-1 do
|
---|
6456 | begin
|
---|
6457 | if DoCtrl then
|
---|
6458 | DoIt := TRUE
|
---|
6459 | else
|
---|
6460 | DoIt := (TWinControl(Ctrl).Controls[i] is TWinControl);
|
---|
6461 | if DoIt then
|
---|
6462 | EnableCtrl(TWinControl(Ctrl).Controls[i], TRUE);
|
---|
6463 | end;
|
---|
6464 | end;
|
---|
6465 | end;
|
---|
6466 |
|
---|
6467 | begin
|
---|
6468 | if(assigned(FAssociate)) then
|
---|
6469 | EnableCtrl(FAssociate, FALSE);
|
---|
6470 | end;
|
---|
6471 |
|
---|
6472 | procedure TORCheckBox.Notification(AComponent: TComponent;
|
---|
6473 | Operation: TOperation);
|
---|
6474 | begin
|
---|
6475 | inherited;
|
---|
6476 | if(AComponent = FAssociate) and (Operation = opRemove) then
|
---|
6477 | FAssociate := nil;
|
---|
6478 | end;
|
---|
6479 |
|
---|
6480 | procedure TORCheckBox.SetFocusOnBox(value: boolean);
|
---|
6481 | begin
|
---|
6482 | FFocusOnBox := value;
|
---|
6483 | invalidate;
|
---|
6484 | end;
|
---|
6485 |
|
---|
6486 | procedure TORCheckBox.BMGetCheck(var Message: TMessage);
|
---|
6487 | begin
|
---|
6488 | {This Allows JAWS to report the state when tabbed into or using the read object
|
---|
6489 | keys (Ins+Tab)}
|
---|
6490 | {if Self.GrayedStyle = gsBlueQuestionMark then
|
---|
6491 | Message.Result := BST_INDETERMINATE
|
---|
6492 | else}
|
---|
6493 | if Self.Checked then
|
---|
6494 | Message.Result := BST_CHECKED
|
---|
6495 | else
|
---|
6496 | Message.Result := BST_UNCHECKED;
|
---|
6497 | end;
|
---|
6498 |
|
---|
6499 | procedure TORCheckBox.BMGetState(var Message: TMessage);
|
---|
6500 | begin
|
---|
6501 | //This gives JAWS ability to read state when spacebar is pressed.
|
---|
6502 | //Commented out because JAWS reads states, but inversly. Working with freedom...
|
---|
6503 | { if Self.Checked then
|
---|
6504 | Message.Result := BST_CHECKED
|
---|
6505 | else
|
---|
6506 | Message.Result := BST_UNCHECKED;}
|
---|
6507 | end;
|
---|
6508 |
|
---|
6509 | { TORListView }
|
---|
6510 |
|
---|
6511 | procedure TORListView.WMNotify(var Message: TWMNotify);
|
---|
6512 | begin
|
---|
6513 | inherited;
|
---|
6514 | with Message.NMHdr^ do
|
---|
6515 | case code of
|
---|
6516 | HDN_BEGINTRACK, HDN_TRACK, HDN_ENDTRACK:
|
---|
6517 | with PHDNotify(Pointer(Message.NMHdr))^, PItem^ do
|
---|
6518 | if (Mask and HDI_WIDTH) <> 0 then
|
---|
6519 | begin
|
---|
6520 | if(Column[Item].MinWidth > 0) and (cxy < Column[Item].MinWidth) then
|
---|
6521 | cxy := Column[Item].MinWidth;
|
---|
6522 | if(Column[Item].MaxWidth > 0) and (cxy > Column[Item].MaxWidth) then
|
---|
6523 | cxy := Column[Item].MaxWidth;
|
---|
6524 | Column[Item].Width := cxy;
|
---|
6525 | end;
|
---|
6526 | end;
|
---|
6527 | end;
|
---|
6528 |
|
---|
6529 | procedure TORListView.LVMSetColumn(var Message: TMessage);
|
---|
6530 | var
|
---|
6531 | Changed: boolean;
|
---|
6532 | NewW, idx: integer;
|
---|
6533 |
|
---|
6534 | begin
|
---|
6535 | Changed := FALSE;
|
---|
6536 | NewW := 0;
|
---|
6537 | idx := 0;
|
---|
6538 | with Message, TLVColumn(pointer(LParam)^) do
|
---|
6539 | begin
|
---|
6540 | if(cx < Column[WParam].MinWidth) then
|
---|
6541 | begin
|
---|
6542 | NewW := Column[WParam].MinWidth;
|
---|
6543 | Changed := TRUE;
|
---|
6544 | idx := WParam;
|
---|
6545 | end;
|
---|
6546 | if(cx > Column[WParam].MaxWidth) then
|
---|
6547 | begin
|
---|
6548 | NewW := Column[WParam].MaxWidth;
|
---|
6549 | Changed := TRUE;
|
---|
6550 | idx := WParam;
|
---|
6551 | end;
|
---|
6552 | end;
|
---|
6553 | inherited;
|
---|
6554 | if(Changed) then
|
---|
6555 | Column[idx].Width := NewW;
|
---|
6556 | end;
|
---|
6557 |
|
---|
6558 | procedure TORListView.LVMSetColumnWidth(var Message: TMessage);
|
---|
6559 | var
|
---|
6560 | Changed: boolean;
|
---|
6561 | NewW, idx: integer;
|
---|
6562 |
|
---|
6563 | begin
|
---|
6564 | Changed := FALSE;
|
---|
6565 | NewW := 0;
|
---|
6566 | idx := 0;
|
---|
6567 | with Message do
|
---|
6568 | begin
|
---|
6569 | if(LParam < Column[WParam].MinWidth) then
|
---|
6570 | begin
|
---|
6571 | LParam := Column[WParam].MinWidth;
|
---|
6572 | Changed := TRUE;
|
---|
6573 | NewW := LParam;
|
---|
6574 | idx := WParam;
|
---|
6575 | end;
|
---|
6576 | if(LParam > Column[WParam].MaxWidth) then
|
---|
6577 | begin
|
---|
6578 | LParam := Column[WParam].MaxWidth;
|
---|
6579 | Changed := TRUE;
|
---|
6580 | NewW := LParam;
|
---|
6581 | idx := WParam;
|
---|
6582 | end;
|
---|
6583 | end;
|
---|
6584 | inherited;
|
---|
6585 | if(Changed) then
|
---|
6586 | Column[idx].Width := NewW;
|
---|
6587 | end;
|
---|
6588 |
|
---|
6589 | { TORComboPanelEdit }
|
---|
6590 |
|
---|
6591 | destructor TORComboPanelEdit.Destroy;
|
---|
6592 | begin
|
---|
6593 | if(assigned(FCanvas)) then
|
---|
6594 | FCanvas.Free;
|
---|
6595 | inherited;
|
---|
6596 | end;
|
---|
6597 |
|
---|
6598 | procedure TORComboPanelEdit.Paint;
|
---|
6599 | var
|
---|
6600 | DC: HDC;
|
---|
6601 | R: TRect;
|
---|
6602 |
|
---|
6603 | begin
|
---|
6604 | inherited;
|
---|
6605 | if(FFocused) then
|
---|
6606 | begin
|
---|
6607 | if(not assigned(FCanvas)) then
|
---|
6608 | FCanvas := TControlCanvas.Create;
|
---|
6609 | DC := GetWindowDC(Handle);
|
---|
6610 | try
|
---|
6611 | FCanvas.Handle := DC;
|
---|
6612 | R := ClientRect;
|
---|
6613 | InflateRect(R, -1, -1);
|
---|
6614 | FCanvas.DrawFocusRect(R);
|
---|
6615 | finally
|
---|
6616 | ReleaseDC(Handle, DC);
|
---|
6617 | end;
|
---|
6618 | end;
|
---|
6619 | end;
|
---|
6620 |
|
---|
6621 | { TKeyClickPanel ----------------------------------------------------------------------------- }
|
---|
6622 | procedure TKeyClickPanel.KeyDown(var Key: Word; Shift: TShiftState);
|
---|
6623 | begin
|
---|
6624 | case Key of
|
---|
6625 | VK_LBUTTON, VK_RETURN, VK_SPACE:
|
---|
6626 | Click;
|
---|
6627 | end;
|
---|
6628 | end;
|
---|
6629 |
|
---|
6630 | { TKeyClickRadioGroup }
|
---|
6631 |
|
---|
6632 | procedure TKeyClickRadioGroup.Click;
|
---|
6633 | begin
|
---|
6634 | inherited;
|
---|
6635 | TabStop := Enabled and Visible and (ItemIndex = -1);
|
---|
6636 | end;
|
---|
6637 |
|
---|
6638 | constructor TKeyClickRadioGroup.Create(AOwner: TComponent);
|
---|
6639 | begin
|
---|
6640 | inherited;
|
---|
6641 | TabStop := Enabled and Visible and (ItemIndex = -1);
|
---|
6642 | end;
|
---|
6643 |
|
---|
6644 | procedure TKeyClickRadioGroup.KeyDown(var Key: Word; Shift: TShiftState);
|
---|
6645 | begin
|
---|
6646 | inherited;
|
---|
6647 | case Key of
|
---|
6648 | VK_RETURN, VK_SPACE:
|
---|
6649 | if ItemIndex = -1 then begin
|
---|
6650 | ItemIndex := 0;
|
---|
6651 | Click;
|
---|
6652 | if ControlCount > 0 then begin
|
---|
6653 | TWinControl(Controls[0]).SetFocus;
|
---|
6654 | end;
|
---|
6655 | Key := 0;
|
---|
6656 | end;
|
---|
6657 | end;
|
---|
6658 | end;
|
---|
6659 |
|
---|
6660 | { TCaptionListBox }
|
---|
6661 |
|
---|
6662 | procedure TCaptionListBox.DoEnter;
|
---|
6663 | begin
|
---|
6664 | inherited;
|
---|
6665 | if HintOnItem then
|
---|
6666 | FHoverItemPos := -1; //CQ: 7178 & 9911 - used as last item index for ListBox
|
---|
6667 | end;
|
---|
6668 |
|
---|
6669 | function TCaptionListBox.GetCaption: string;
|
---|
6670 | begin
|
---|
6671 | if not Assigned(FCaptionComponent) then
|
---|
6672 | result := ''
|
---|
6673 | else
|
---|
6674 | result := FCaptionComponent.Caption;
|
---|
6675 | end;
|
---|
6676 |
|
---|
6677 | function TCaptionListBox.GetDynamicProperty(PropertyID: integer): string;
|
---|
6678 | begin
|
---|
6679 | if PropertyID = DynaPropAccesibilityCaption then
|
---|
6680 | Result := GetCaption
|
---|
6681 | else
|
---|
6682 | Result := '';
|
---|
6683 | end;
|
---|
6684 |
|
---|
6685 |
|
---|
6686 | procedure TCaptionListBox.MoveFocusUp;
|
---|
6687 | begin
|
---|
6688 | if ItemIndex > 0 then
|
---|
6689 | Perform(LB_SETCARETINDEX, ItemIndex - 1, 0);
|
---|
6690 | end;
|
---|
6691 |
|
---|
6692 | procedure TCaptionListBox.MoveFocusDown;
|
---|
6693 | begin
|
---|
6694 | if ItemIndex < (Items.Count-1) then
|
---|
6695 | Perform(LB_SETCARETINDEX, ItemIndex + 1, 0);
|
---|
6696 | end;
|
---|
6697 |
|
---|
6698 | procedure TCaptionListBox.SetCaption(const Value: string);
|
---|
6699 | begin
|
---|
6700 | if not Assigned(FCaptionComponent) then begin
|
---|
6701 | FCaptionComponent := TStaticText.Create(self);
|
---|
6702 | FCaptionComponent.AutoSize := False;
|
---|
6703 | FCaptionComponent.Height := 0;
|
---|
6704 | FCaptionComponent.Width := 0;
|
---|
6705 | FCaptionComponent.Visible := True;
|
---|
6706 | FCaptionComponent.Parent := Parent;
|
---|
6707 | FCaptionComponent.BringToFront;
|
---|
6708 | end;
|
---|
6709 | FCaptionComponent.Caption := Value;
|
---|
6710 | end;
|
---|
6711 |
|
---|
6712 | function TCaptionListBox.SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
6713 | begin
|
---|
6714 | Result := (PropertyID = DynaPropAccesibilityCaption);
|
---|
6715 | end;
|
---|
6716 |
|
---|
6717 | procedure TCaptionListBox.WMKeyDown(var Message: TWMKeyDown);
|
---|
6718 | var
|
---|
6719 | IsSelected: LongBool;
|
---|
6720 | begin
|
---|
6721 | if Boolean(Hi(GetKeyState(VK_CONTROL))) and MultiSelect then
|
---|
6722 | case Message.CharCode of
|
---|
6723 | VK_SPACE:
|
---|
6724 | begin
|
---|
6725 | IsSelected := LongBool(Perform(LB_GETSEL, ItemIndex, 0));
|
---|
6726 | Perform(LB_SETSEL, Longint(not IsSelected), ItemIndex);
|
---|
6727 | end;
|
---|
6728 | VK_LEFT, VK_UP: MoveFocusUp;
|
---|
6729 | VK_RIGHT, VK_DOWN: MoveFocusDown;
|
---|
6730 | else inherited;
|
---|
6731 | end
|
---|
6732 | else inherited;
|
---|
6733 | end;
|
---|
6734 |
|
---|
6735 | procedure TCaptionListBox.WMMouseMove(var Message: TWMMouseMove);
|
---|
6736 | var
|
---|
6737 | i : integer;
|
---|
6738 | begin
|
---|
6739 | inherited;
|
---|
6740 | //CQ: 7178 & 9911 - FHoverItemPos should be set to -1 in OnEnter
|
---|
6741 | //Make the TListBox's hint contain the contents of the listbox Item the mouse is currently over
|
---|
6742 | if HintOnItem then
|
---|
6743 | begin
|
---|
6744 | i := ItemAtPos(Point(Message.XPos, Message.YPos), true);
|
---|
6745 | if i <> FHoverItemPos then
|
---|
6746 | Application.CancelHint;
|
---|
6747 | if i = -1 then
|
---|
6748 | Hint := ''
|
---|
6749 | else
|
---|
6750 | Hint := Items[i];
|
---|
6751 | FHoverItemPos := i;
|
---|
6752 | end;
|
---|
6753 | end;
|
---|
6754 |
|
---|
6755 | procedure TCaptionListBox.WMRButtonUp(var Message: TWMRButtonUp);
|
---|
6756 | { When the RightClickSelect property is true, this routine is used to select an item }
|
---|
6757 | var
|
---|
6758 | APoint: TPoint;
|
---|
6759 | i: integer;
|
---|
6760 | begin
|
---|
6761 | if FRightClickSelect then with Message do
|
---|
6762 | begin
|
---|
6763 | APoint := Point(XPos, YPos);
|
---|
6764 | // if the mouse was clicked in the client area set ItemIndex...
|
---|
6765 | if PtInRect(ClientRect, APoint) then
|
---|
6766 | begin
|
---|
6767 | ItemIndex := ItemAtPos(APoint,True);
|
---|
6768 | // ...but not if its just going to deselect the current item
|
---|
6769 | if ItemIndex > -1 then
|
---|
6770 | begin
|
---|
6771 | Items.BeginUpdate;
|
---|
6772 | try
|
---|
6773 | if not Selected[ItemIndex] then
|
---|
6774 | for i := 0 to Items.Count-1 do
|
---|
6775 | Selected[i] := False;
|
---|
6776 | Selected[ItemIndex] := True;
|
---|
6777 | finally
|
---|
6778 | Items.EndUpdate;
|
---|
6779 | end;
|
---|
6780 | end;
|
---|
6781 | end;
|
---|
6782 | end;
|
---|
6783 | inherited;
|
---|
6784 | end;
|
---|
6785 |
|
---|
6786 | { TCaptionCheckListBox }
|
---|
6787 |
|
---|
6788 | function TCaptionCheckListBox.GetCaption: string;
|
---|
6789 | begin
|
---|
6790 | if not Assigned(FCaptionComponent) then
|
---|
6791 | result := ''
|
---|
6792 | else
|
---|
6793 | result := FCaptionComponent.Caption;
|
---|
6794 | end;
|
---|
6795 |
|
---|
6796 | function TCaptionCheckListBox.GetDynamicProperty(PropertyID: integer): string;
|
---|
6797 | begin
|
---|
6798 | if PropertyID = DynaPropAccesibilityCaption then
|
---|
6799 | Result := GetCaption
|
---|
6800 | else
|
---|
6801 | Result := '';
|
---|
6802 | end;
|
---|
6803 |
|
---|
6804 | procedure TCaptionCheckListBox.SetCaption(const Value: string);
|
---|
6805 | begin
|
---|
6806 | if not Assigned(FCaptionComponent) then begin
|
---|
6807 | FCaptionComponent := TStaticText.Create(self);
|
---|
6808 | FCaptionComponent.AutoSize := False;
|
---|
6809 | FCaptionComponent.Height := 0;
|
---|
6810 | FCaptionComponent.Width := 0;
|
---|
6811 | FCaptionComponent.Visible := True;
|
---|
6812 | FCaptionComponent.Parent := Parent;
|
---|
6813 | FCaptionComponent.BringToFront;
|
---|
6814 | end;
|
---|
6815 | FCaptionComponent.Caption := Value;
|
---|
6816 | end;
|
---|
6817 |
|
---|
6818 | function TCaptionCheckListBox.SupportsDynamicProperty(
|
---|
6819 | PropertyID: integer): boolean;
|
---|
6820 | begin
|
---|
6821 | Result := (PropertyID = DynaPropAccesibilityCaption);
|
---|
6822 | end;
|
---|
6823 |
|
---|
6824 | { TCaptionMemo }
|
---|
6825 |
|
---|
6826 | function TCaptionMemo.GetCaption: string;
|
---|
6827 | begin
|
---|
6828 | if not Assigned(FCaptionComponent) then
|
---|
6829 | result := ''
|
---|
6830 | else
|
---|
6831 | result := FCaptionComponent.Caption;
|
---|
6832 | end;
|
---|
6833 |
|
---|
6834 | function TCaptionMemo.GetDynamicProperty(PropertyID: integer): string;
|
---|
6835 | begin
|
---|
6836 | if PropertyID = DynaPropAccesibilityCaption then
|
---|
6837 | Result := GetCaption
|
---|
6838 | else
|
---|
6839 | Result := '';
|
---|
6840 | end;
|
---|
6841 |
|
---|
6842 | procedure TCaptionMemo.SetCaption(const Value: string);
|
---|
6843 | begin
|
---|
6844 | if not Assigned(FCaptionComponent) then begin
|
---|
6845 | FCaptionComponent := TStaticText.Create(self);
|
---|
6846 | FCaptionComponent.AutoSize := False;
|
---|
6847 | FCaptionComponent.Height := 0;
|
---|
6848 | FCaptionComponent.Width := 0;
|
---|
6849 | FCaptionComponent.Visible := True;
|
---|
6850 | FCaptionComponent.Parent := Parent;
|
---|
6851 | FCaptionComponent.BringToFront;
|
---|
6852 | end;
|
---|
6853 | FCaptionComponent.Caption := Value;
|
---|
6854 | end;
|
---|
6855 |
|
---|
6856 | function TCaptionMemo.SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
6857 | begin
|
---|
6858 | Result := (PropertyID = DynaPropAccesibilityCaption);
|
---|
6859 | end;
|
---|
6860 |
|
---|
6861 | { TCaptionEdit }
|
---|
6862 |
|
---|
6863 | function TCaptionEdit.GetCaption: string;
|
---|
6864 | begin
|
---|
6865 | if not Assigned(FCaptionComponent) then
|
---|
6866 | result := ''
|
---|
6867 | else
|
---|
6868 | result := FCaptionComponent.Caption;
|
---|
6869 | end;
|
---|
6870 |
|
---|
6871 | function TCaptionEdit.GetDynamicProperty(PropertyID: integer): string;
|
---|
6872 | begin
|
---|
6873 | if PropertyID = DynaPropAccesibilityCaption then
|
---|
6874 | Result := GetCaption
|
---|
6875 | else
|
---|
6876 | Result := '';
|
---|
6877 | end;
|
---|
6878 |
|
---|
6879 | procedure TCaptionEdit.SetCaption(const Value: string);
|
---|
6880 | begin
|
---|
6881 | if not Assigned(FCaptionComponent) then begin
|
---|
6882 | FCaptionComponent := TStaticText.Create(self);
|
---|
6883 | FCaptionComponent.AutoSize := False;
|
---|
6884 | FCaptionComponent.Height := 0;
|
---|
6885 | FCaptionComponent.Width := 0;
|
---|
6886 | FCaptionComponent.Visible := True;
|
---|
6887 | FCaptionComponent.Parent := Parent;
|
---|
6888 | FCaptionComponent.BringToFront;
|
---|
6889 | end;
|
---|
6890 | FCaptionComponent.Caption := Value;
|
---|
6891 | end;
|
---|
6892 |
|
---|
6893 | function TCaptionEdit.SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
6894 | begin
|
---|
6895 | Result := (PropertyID = DynaPropAccesibilityCaption);
|
---|
6896 | end;
|
---|
6897 |
|
---|
6898 | { TCaptionRichEdit }
|
---|
6899 |
|
---|
6900 | function TCaptionRichEdit.GetDynamicProperty(PropertyID: integer): string;
|
---|
6901 | begin
|
---|
6902 | if PropertyID = DynaPropAccesibilityCaption then
|
---|
6903 | Result := FCaption
|
---|
6904 | else
|
---|
6905 | Result := '';
|
---|
6906 | end;
|
---|
6907 |
|
---|
6908 |
|
---|
6909 | function TCaptionRichEdit.SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
6910 | begin
|
---|
6911 | Result := (PropertyID = DynaPropAccesibilityCaption);
|
---|
6912 | end;
|
---|
6913 |
|
---|
6914 | { TCaptionTreeView}
|
---|
6915 |
|
---|
6916 | function TCaptionTreeView.GetCaption: string;
|
---|
6917 | begin
|
---|
6918 | result := inherited Caption;
|
---|
6919 | end;
|
---|
6920 |
|
---|
6921 | function TCaptionTreeView.GetDynamicProperty(PropertyID: integer): string;
|
---|
6922 | begin
|
---|
6923 | if PropertyID = DynaPropAccesibilityCaption then
|
---|
6924 | Result := GetCaption
|
---|
6925 | else
|
---|
6926 | Result := '';
|
---|
6927 | end;
|
---|
6928 |
|
---|
6929 | procedure TCaptionTreeView.SetCaption(const Value: string);
|
---|
6930 | begin
|
---|
6931 | if not Assigned(FCaptionComponent) then begin
|
---|
6932 | FCaptionComponent := TStaticText.Create(self);
|
---|
6933 | FCaptionComponent.AutoSize := False;
|
---|
6934 | FCaptionComponent.Height := 0;
|
---|
6935 | FCaptionComponent.Width := 0;
|
---|
6936 | FCaptionComponent.Visible := True;
|
---|
6937 | FCaptionComponent.Parent := Parent;
|
---|
6938 | FCaptionComponent.BringToFront;
|
---|
6939 | end;
|
---|
6940 | FCaptionComponent.Caption := Value;
|
---|
6941 | inherited Caption := Value;
|
---|
6942 | end;
|
---|
6943 |
|
---|
6944 | function TCaptionTreeView.SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
6945 | begin
|
---|
6946 | Result := (PropertyID = DynaPropAccesibilityCaption);
|
---|
6947 | end;
|
---|
6948 |
|
---|
6949 | { TCaptionComboBox }
|
---|
6950 |
|
---|
6951 | function TCaptionComboBox.GetCaption: string;
|
---|
6952 | begin
|
---|
6953 | if not Assigned(FCaptionComponent) then
|
---|
6954 | result := ''
|
---|
6955 | else
|
---|
6956 | result := FCaptionComponent.Caption;
|
---|
6957 | end;
|
---|
6958 |
|
---|
6959 | function TCaptionComboBox.GetDynamicProperty(PropertyID: integer): string;
|
---|
6960 | begin
|
---|
6961 | if PropertyID = DynaPropAccesibilityCaption then
|
---|
6962 | Result := GetCaption
|
---|
6963 | else
|
---|
6964 | Result := '';
|
---|
6965 | end;
|
---|
6966 |
|
---|
6967 | procedure TCaptionComboBox.SetCaption(const Value: string);
|
---|
6968 | begin
|
---|
6969 | if not Assigned(FCaptionComponent) then begin
|
---|
6970 | FCaptionComponent := TStaticText.Create(self);
|
---|
6971 | FCaptionComponent.AutoSize := False;
|
---|
6972 | FCaptionComponent.Height := 0;
|
---|
6973 | FCaptionComponent.Width := 0;
|
---|
6974 | FCaptionComponent.Visible := True;
|
---|
6975 | FCaptionComponent.Parent := Parent;
|
---|
6976 | FCaptionComponent.BringToFront;
|
---|
6977 | end;
|
---|
6978 | FCaptionComponent.Caption := Value;
|
---|
6979 | end;
|
---|
6980 |
|
---|
6981 | function TCaptionComboBox.SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
6982 | begin
|
---|
6983 | Result := (PropertyID = DynaPropAccesibilityCaption);
|
---|
6984 | end;
|
---|
6985 |
|
---|
6986 | { TORAlignSpeedButton }
|
---|
6987 |
|
---|
6988 | procedure TORAlignSpeedButton.Paint;
|
---|
6989 | var
|
---|
6990 | Rect: TRect;
|
---|
6991 | begin
|
---|
6992 | inherited;
|
---|
6993 | if (Parent <> nil) and (Parent is TKeyClickPanel) and TKeyClickPanel(Parent).Focused then
|
---|
6994 | begin
|
---|
6995 | Rect := ClientRect;
|
---|
6996 | InflateRect(Rect, -3, -3);
|
---|
6997 | Canvas.Brush.Color := Color;
|
---|
6998 | Canvas.DrawFocusRect(Rect);
|
---|
6999 | end;
|
---|
7000 | end;
|
---|
7001 |
|
---|
7002 | { TCaptionStringGrid }
|
---|
7003 |
|
---|
7004 | {I may have messed up my Windows.pas file, but mine defines NotifyWinEvent without a stdcall.}
|
---|
7005 | procedure GoodNotifyWinEvent; external user32 name 'NotifyWinEvent';
|
---|
7006 |
|
---|
7007 | function TCaptionStringGrid.ColRowToIndex(Col, Row: Integer): integer;
|
---|
7008 | begin
|
---|
7009 | result := (ColCount - FixedCols) * (Row - FixedRows) +
|
---|
7010 | (Col - FixedCols) + 1;
|
---|
7011 | end;
|
---|
7012 |
|
---|
7013 | function TCaptionStringGrid.GetDynamicProperty(PropertyID: integer): string;
|
---|
7014 | begin
|
---|
7015 | if PropertyID = DynaPropAccesibilityCaption then
|
---|
7016 | Result := FCaption
|
---|
7017 | else
|
---|
7018 | Result := '';
|
---|
7019 | end;
|
---|
7020 |
|
---|
7021 | procedure TCaptionStringGrid.IndexToColRow(index: integer; var Col,
|
---|
7022 | Row: integer);
|
---|
7023 | begin
|
---|
7024 | Row := (index-1) div (ColCount - FixedCols) + FixedRows;
|
---|
7025 | Col := (index-1) mod (ColCount - FixedCols) + FixedCols;
|
---|
7026 | end;
|
---|
7027 |
|
---|
7028 | procedure TCaptionStringGrid.KeyUp(var Key: Word; Shift: TShiftState);
|
---|
7029 | begin
|
---|
7030 | inherited;
|
---|
7031 | {Look for all of the grid navigation keys}
|
---|
7032 | if (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN]) and (Shift = []) or
|
---|
7033 | (Key = VK_TAB) and (Shift <= [ssShift]) then
|
---|
7034 | GoodNotifyWinEvent(EVENT_OBJECT_FOCUS, Handle, integer(OBJID_CLIENT),
|
---|
7035 | ColRowToIndex(Col,Row));
|
---|
7036 | end;
|
---|
7037 |
|
---|
7038 |
|
---|
7039 | function TCaptionStringGrid.SupportsDynamicProperty(
|
---|
7040 | PropertyID: integer): boolean;
|
---|
7041 | begin
|
---|
7042 | Result := (PropertyID = DynaPropAccesibilityCaption);
|
---|
7043 | end;
|
---|
7044 |
|
---|
7045 | function IsAMouseButtonDown : boolean;
|
---|
7046 | begin
|
---|
7047 | if Boolean(Hi(GetKeyState(VK_MBUTTON))) or
|
---|
7048 | Boolean(Hi(GetKeyState(VK_LBUTTON))) or
|
---|
7049 | Boolean(Hi(GetKeyState(VK_RBUTTON))) then
|
---|
7050 | Result := true
|
---|
7051 | else
|
---|
7052 | Result := false;
|
---|
7053 | end;
|
---|
7054 |
|
---|
7055 | procedure TORComboBox.SetNumForMatch(const NumberForMatch: integer);
|
---|
7056 | begin
|
---|
7057 | if NumberForMatch < 1 then
|
---|
7058 | FCharsNeedMatch := 1
|
---|
7059 | else if NumberForMatch > 15 then
|
---|
7060 | FCharsNeedMatch := 15
|
---|
7061 | else
|
---|
7062 | FCharsNeedMatch := NumberForMatch;
|
---|
7063 | end;
|
---|
7064 |
|
---|
7065 | procedure TORComboBox.SetUniqueAutoComplete(const Value: Boolean);
|
---|
7066 | begin
|
---|
7067 | FUniqueAutoComplete := Value;
|
---|
7068 | end;
|
---|
7069 |
|
---|
7070 | function TORListBox.VerifyUnique(SelectIndex: Integer; iText: String): integer;
|
---|
7071 | var
|
---|
7072 | i : integer;
|
---|
7073 | counter : integer;
|
---|
7074 | begin
|
---|
7075 | Result := SelectIndex;
|
---|
7076 | if LongList then
|
---|
7077 | begin
|
---|
7078 | //Implemented for CQ: 10092, PSI-04-057
|
---|
7079 | //asume long lists are alphabetically ordered...
|
---|
7080 | if CompareText(iText, Copy(DisplayText[SelectIndex+1], 1, Length(iText))) = 0 then
|
---|
7081 | Result := -1;
|
---|
7082 | end
|
---|
7083 | else //Not a LongList
|
---|
7084 | begin
|
---|
7085 | counter := 0;
|
---|
7086 | for i := 0 to Items.Count-1 do
|
---|
7087 | if CompareText(iText, Copy(DisplayText[i], 1, Length(iText))) = 0 then
|
---|
7088 | Inc(counter);
|
---|
7089 | if counter > 1 then
|
---|
7090 | Result := -1;
|
---|
7091 | end;
|
---|
7092 | FFocusIndex := Result;
|
---|
7093 | ItemIndex := Result;
|
---|
7094 | end;
|
---|
7095 |
|
---|
7096 | //This procedure sets the Text property equal to the TextToMatch parameter, then calls
|
---|
7097 | //FwdChangeDelayed which will perform an auto-completion on the text.
|
---|
7098 | procedure TORComboBox.SetTextAutoComplete(TextToMatch: String);
|
---|
7099 | begin
|
---|
7100 | Text := TextToMatch;
|
---|
7101 | SelStart := Length(Text);
|
---|
7102 | FwdChangeDelayed;
|
---|
7103 | end;
|
---|
7104 |
|
---|
7105 | { TCaptionListView }
|
---|
7106 |
|
---|
7107 | function TCaptionListView.GetDynamicProperty(PropertyID: integer): string;
|
---|
7108 | begin
|
---|
7109 | if PropertyID = DynaPropAccesibilityCaption then
|
---|
7110 | Result := Caption
|
---|
7111 | else
|
---|
7112 | Result := '';
|
---|
7113 | end;
|
---|
7114 |
|
---|
7115 | function TCaptionListView.SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
7116 | begin
|
---|
7117 | Result := (PropertyID = DynaPropAccesibilityCaption);
|
---|
7118 | end;
|
---|
7119 |
|
---|
7120 | initialization
|
---|
7121 | //uItemTip := TItemTip.Create(Application); // all listboxes share a single ItemTip window
|
---|
7122 | uItemTipCount := 0;
|
---|
7123 | uNewStyle := Lo(GetVersion) >= 4; // True = Win95 interface, otherwise old interface
|
---|
7124 | FillChar(ORCBImages, SizeOf(ORCBImages), 0);
|
---|
7125 |
|
---|
7126 | finalization
|
---|
7127 | //uItemTip.Free; // don't seem to need this - called by Application
|
---|
7128 | DestroyORCBBitmaps;
|
---|
7129 |
|
---|
7130 | end.
|
---|