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