Context Navigation

ORCtrls.pas@ 1710

Last change on this file since 1710 was 1679, checked in by healthsevak, 9 years ago
Updating the working copy to CPRS version 28
File size: 225.8 KB

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: cprs/trunk/CPRS-Lib/ORCtrls.pas@ 1710

Download in other formats: