Index: cprs/trunk/CPRS-Lib/ORCtrls.pas =================================================================== --- cprs/trunk/CPRS-Lib/ORCtrls.pas (revision 829) +++ cprs/trunk/CPRS-Lib/ORCtrls.pas (revision 1679) @@ -1,32 +1,32 @@ -unit ORCtrls; // Oct 26, 1997 @ 10:00am +unit ORCtrls; // Oct 26, 1997 @ 10:00am // To Do: eliminate topindex itemtip on mousedown (seen when choosing clinic pts) -interface // -------------------------------------------------------------------------------- +interface // -------------------------------------------------------------------------------- uses Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Forms, - ComCtrls, Commctrl, Buttons, ExtCtrls, Grids, ImgList, Menus, CheckLst, - Variants, VAClasses; + ComCtrls, Commctrl, Buttons, ExtCtrls, Grids, ImgList, Menus, CheckLst, + Variants, VAClasses, typinfo; const - UM_SHOWTIP = (WM_USER + 9436); // message id to display item tip **was 300 - UM_GOTFOCUS = (WM_USER + 9437); // message to post when combo gets focus **was 301 - MAX_TABS = 40; // maximum number of tab stops or pieces - LL_REVERSE = -1; // long list scrolling in reverse direction - LL_POSITION = 0; // long list thumb moved - LL_FORWARD = 1; // long list scrolling in forward direction - LLS_LINE = '^____________________________________________________________________________'; - LLS_DASH = '^----------------------------------------------------------------------------'; + UM_SHOWTIP = (WM_USER + 9436); // message id to display item tip **was 300 + UM_GOTFOCUS = (WM_USER + 9437); // message to post when combo gets focus **was 301 + MAX_TABS = 40; // maximum number of tab stops or pieces + LL_REVERSE = -1; // long list scrolling in reverse direction + LL_POSITION = 0; // long list thumb moved + LL_FORWARD = 1; // long list scrolling in forward direction + LLS_LINE = '^____________________________________________________________________________'; + LLS_DASH = '^----------------------------------------------------------------------------'; LLS_SPACE = '^ '; type IORBlackColorModeCompatible = interface(IInterface) - ['{3554985C-F524-45FA-8C27-4CDD8357DB08}'] + ['{3554985C-F524-45FA-8C27-4CDD8357DB08}'] procedure SetBlackColorMode(Value: boolean); end; - TORComboBox = class; // forward declaration for FParentCombo - - TTranslator = function (MString: string): string of object; + TORComboBox = class; // forward declaration for FParentCombo + + TTranslator = function(MString: string): string of object; TORStrings = class(TStrings) @@ -38,10 +38,10 @@ procedure Verify; protected - function Get( index:integer): string; override; + function Get(index: integer): string; override; function GetCount: integer; override; - function GetObject(index:integer): TObject; override; + function GetObject(index: integer): TObject; override; procedure Put(Index: Integer; const S: string); override; - procedure PutObject(index:integer; Value: TObject); override; - procedure SetUpdateState( Value: boolean); override; + procedure PutObject(index: integer; Value: TObject); override; + procedure SetUpdateState(Value: boolean); override; public function Add(const S: string): integer; override; @@ -49,5 +49,5 @@ destructor Destroy; override; procedure Clear; override; - procedure Delete( index: integer); override; + procedure Delete(index: integer); override; procedure Insert(Index: Integer; const S: string); override; function IndexOf(const S: string): Integer; override; @@ -57,69 +57,74 @@ end; - TORDirection = -1..1; // for compatibility, type is now integer - TORNeedDataEvent = procedure(Sender: TObject; const StartFrom: string; - Direction, InsertAt: Integer) of object; - TORBeforeDrawEvent = procedure(Sender: TObject; Index: Integer; Rect: TRect; - State: TOwnerDrawState) of object; - TORItemNotifyEvent = procedure(Sender: TObject; Index: integer) of object; + TORDirection = -1..1; // for compatibility, type is now integer + TORNeedDataEvent = procedure(Sender: TObject; const StartFrom: string; + Direction, InsertAt: Integer) of object; + TORBeforeDrawEvent = procedure(Sender: TObject; Index: Integer; Rect: TRect; + State: TOwnerDrawState) of object; + TORItemNotifyEvent = procedure(Sender: TObject; Index: integer) of object; TORCheckComboTextEvent = procedure(Sender: TObject; NumChecked: integer; var Text: string) of object; - TORSynonymCheckEvent = procedure(Sender: TObject; const Text: string; - var IsSynonym: boolean) of object; + TORSynonymCheckEvent = procedure(Sender: TObject; const Text: string; + var IsSynonym: boolean) of object; PItemRec = ^TItemRec; TItemRec = record - Reference: Variant; // variant value associated with item - UserObject: TObject; // Objects[n] property of listbox item - CheckedState: TCheckBoxState; // Used to indicate check box values + Reference: Variant; // variant value associated with item + UserObject: TObject; // Objects[n] property of listbox item + CheckedState: TCheckBoxState; // Used to indicate check box values + end; + + THintRecords = record + ObjectName: string; + ObjectHint: string; end; TORListBox = class(TListBox, IVADynamicProperty, IORBlackColorModeCompatible) private - FFocusIndex: Integer; // item with focus when using navigation keys - FLargeChange: Integer; // visible items less one - FTipItem: Integer; // item currently displaying ItemTip - FItemTipActive: Boolean; // used to delay appearance of the ItemTip - FItemTipColor: TColor; // background color for ItemTip window - FItemTipEnable: Boolean; // allows display of ItemTips over items - FLastMouseX: Integer; // mouse X position on last MouseMove event - FLastMouseY: Integer; // mouse Y position on last MouseMove event - FLastItemIndex: Integer; // used for the OnChange event - FFromSelf: Boolean; // true if listbox message sent from this unit - FDelimiter: Char; // delimiter used by Pieces property - FWhiteSpace: Char; // may be space or tab (between pieces) - FTabPosInPixels: boolean; // determines if TabPosition is Pixels or Chars - FTabPos: array[0..MAX_TABS] of Integer; // character based positions of tab stops - FTabPix: array[0..MAX_TABS] of Integer; // pixel positions of tab stops - FPieces: array[0..MAX_TABS] of Integer; // pieces that should be displayed for item - FLongList: Boolean; // if true, enables special LongList properties - FScrollBar: TScrollBar; // scrollbar used when in LongList mode - FFirstLoad: Boolean; // true if NeedData has never been called - FFromNeedData: Boolean; // true means items added to LongList part - FDataAdded: Boolean; // true if items added during NeedData call - FCurrentTop: Integer; // TopIndex, changes when inserting to LongList - FWaterMark: Integer; // first LongList item after the short list - FDirection: Integer; // direction of the current NeedData call - FInsertAt: Integer; // insert point for the current NeedData call - FParentCombo: TORComboBox; // used when listbox is part of dropdown combo - FOnChange: TNotifyEvent; // event called when ItemIndex changes - FOnNeedData: TORNeedDataEvent; // event called when LongList needs more items - FHideSynonyms: boolean; // Hides Synonyms from the list - FSynonymChars: string; // Chars a string must contain to be considered a synonym - FOnSynonymCheck: TORSynonymCheckEvent; // Event that allows for custom synonym checking - FCreatingItem: boolean; // Used by Synonyms to prevent errors when adding new items - FCreatingText: string; // Used by Synonyms to prevent errors when adding new items - FOnBeforeDraw: TORBeforeDrawEvent; // event called prior to drawing an item - FRightClickSelect: boolean; // When true, a right click selects teh item - FCheckBoxes: boolean; // When true, list box contains check boxes - FFlatCheckBoxes: boolean; // When true, list box check boxes are flat - FCheckEntireLine: boolean; // When checked, clicking anywhere on the line checks the checkbox - FOnClickCheck: TORItemNotifyEvent; // Event notifying of checkbox change - FDontClose: boolean; // Used to keep drop down open when checkboxes - FItemsDestroyed: boolean; // Used to make sure items are not destroyed multiple times + FFocusIndex: Integer; // item with focus when using navigation keys + FLargeChange: Integer; // visible items less one + FTipItem: Integer; // item currently displaying ItemTip + FItemTipActive: Boolean; // used to delay appearance of the ItemTip + FItemTipColor: TColor; // background color for ItemTip window + FItemTipEnable: Boolean; // allows display of ItemTips over items + FLastMouseX: Integer; // mouse X position on last MouseMove event + FLastMouseY: Integer; // mouse Y position on last MouseMove event + FLastItemIndex: Integer; // used for the OnChange event + FFromSelf: Boolean; // true if listbox message sent from this unit + FDelimiter: Char; // delimiter used by Pieces property + FWhiteSpace: Char; // may be space or tab (between pieces) + FTabPosInPixels: boolean; // determines if TabPosition is Pixels or Chars + FTabPos: array[0..MAX_TABS] of Integer; // character based positions of tab stops + FTabPix: array[0..MAX_TABS] of Integer; // pixel positions of tab stops + FPieces: array[0..MAX_TABS] of Integer; // pieces that should be displayed for item + FLongList: Boolean; // if true, enables special LongList properties + FScrollBar: TScrollBar; // scrollbar used when in LongList mode + FFirstLoad: Boolean; // true if NeedData has never been called + FFromNeedData: Boolean; // true means items added to LongList part + FDataAdded: Boolean; // true if items added during NeedData call + FCurrentTop: Integer; // TopIndex, changes when inserting to LongList + FWaterMark: Integer; // first LongList item after the short list + FDirection: Integer; // direction of the current NeedData call + FInsertAt: Integer; // insert point for the current NeedData call + FParentCombo: TORComboBox; // used when listbox is part of dropdown combo + FOnChange: TNotifyEvent; // event called when ItemIndex changes + FOnNeedData: TORNeedDataEvent; // event called when LongList needs more items + FHideSynonyms: boolean; // Hides Synonyms from the list + FSynonymChars: string; // Chars a string must contain to be considered a synonym + FOnSynonymCheck: TORSynonymCheckEvent; // Event that allows for custom synonym checking + FCreatingItem: boolean; // Used by Synonyms to prevent errors when adding new items + FCreatingText: string; // Used by Synonyms to prevent errors when adding new items + FOnBeforeDraw: TORBeforeDrawEvent; // event called prior to drawing an item + FRightClickSelect: boolean; // When true, a right click selects teh item + FCheckBoxes: boolean; // When true, list box contains check boxes + FFlatCheckBoxes: boolean; // When true, list box check boxes are flat + FCheckEntireLine: boolean; // When checked, clicking anywhere on the line checks the checkbox + FOnClickCheck: TORItemNotifyEvent; // Event notifying of checkbox change + FDontClose: boolean; // Used to keep drop down open when checkboxes + FItemsDestroyed: boolean; // Used to make sure items are not destroyed multiple times FAllowGrayed: boolean; - FMItems: TORStrings; // Used to save corresponding M strings ("the pieces") - FCaption: TStaticText; // Used to supply a title to IAccessible interface - FCaseChanged: boolean; // If true, the names are stored in the database as all caps, but loaded and displayed in mixed-case - 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 + FMItems: TORStrings; // Used to save corresponding M strings ("the pieces") + FCaption: TStaticText; // Used to supply a title to IAccessible interface + FCaseChanged: boolean; // If true, the names are stored in the database as all caps, but loaded and displayed in mixed-case + 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 FIsPartOfComboBox: boolean; FBlackColorMode: boolean; @@ -156,27 +161,27 @@ function IsSynonym(const TestStr: string): boolean; function TextToShow(S: string): string; - procedure LBGetText (var Message: TMessage); message LB_GETTEXT; - procedure LBGetTextLen (var Message: TMessage); message LB_GETTEXTLEN; - procedure LBGetItemData (var Message: TMessage); message LB_GETITEMDATA; - procedure LBSetItemData (var Message: TMessage); message LB_SETITEMDATA; - procedure LBAddString (var Message: TMessage); message LB_ADDSTRING; - procedure LBInsertString (var Message: TMessage); message LB_INSERTSTRING; - procedure LBDeleteString (var Message: TMessage); message LB_DELETESTRING; - procedure LBResetContent (var Message: TMessage); message LB_RESETCONTENT; - procedure LBSetCurSel (var Message: TMessage); message LB_SETCURSEL; - procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED; - procedure CNDrawItem (var Message: TWMDrawItem); message CN_DRAWITEM; - procedure WMDestroy (var Message: TWMDestroy); message WM_DESTROY; - procedure WMKeyDown (var Message: TWMKeyDown); message WM_KEYDOWN; - procedure WMLButtonDown (var Message: TWMLButtonDown); message WM_LBUTTONDOWN; - procedure WMLButtonUp (var Message: TWMLButtonUp); message WM_LBUTTONUP; - procedure WMRButtonUp (var Message: TWMRButtonUp); message WM_RBUTTONUP; + procedure LBGetText(var Message: TMessage); message LB_GETTEXT; + procedure LBGetTextLen(var Message: TMessage); message LB_GETTEXTLEN; + procedure LBGetItemData(var Message: TMessage); message LB_GETITEMDATA; + procedure LBSetItemData(var Message: TMessage); message LB_SETITEMDATA; + procedure LBAddString(var Message: TMessage); message LB_ADDSTRING; + procedure LBInsertString(var Message: TMessage); message LB_INSERTSTRING; + procedure LBDeleteString(var Message: TMessage); message LB_DELETESTRING; + procedure LBResetContent(var Message: TMessage); message LB_RESETCONTENT; + procedure LBSetCurSel(var Message: TMessage); message LB_SETCURSEL; + procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; + procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; + procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY; + procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; + procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; + procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP; + procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP; procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; - procedure WMCancelMode (var Message: TMessage); message WM_CANCELMODE; - procedure WMMove (var Message: TWMMove); message WM_MOVE; - procedure WMSize (var Message: TWMSize); message WM_SIZE; - procedure WMVScroll (var Message: TWMVScroll); message WM_VSCROLL; - procedure CMHintShow (var Message: TMessage); message CM_HINTSHOW; - procedure UMShowTip (var Message: TMessage); message UM_SHOWTIP; + procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE; + procedure WMMove(var Message: TWMMove); message WM_MOVE; + procedure WMSize(var Message: TWMSize); message WM_SIZE; + procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; + procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW; + procedure UMShowTip(var Message: TMessage); message UM_SHOWTIP; function GetChecked(Index: Integer): Boolean; procedure SetChecked(Index: Integer; const Value: Boolean); @@ -187,5 +192,5 @@ procedure SetCheckedState(Index: Integer; const Value: TCheckBoxState); function GetMItems: TStrings; - procedure SetMItems( Value: TStrings); + procedure SetMItems(Value: TStrings); procedure SetCaption(const Value: string); function GetCaption: string; @@ -207,5 +212,5 @@ procedure MeasureItem(Index: Integer; var Height: Integer); override; procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; - function GetIndexFromY(YPos :integer) :integer; + function GetIndexFromY(YPos: integer): integer; property isPartOfComboBox: boolean read FIsPartOfComboBox write FIsPartOfComboBox default False; property HideSynonyms: boolean read FHideSynonyms write SetHideSynonyms default FALSE; @@ -236,8 +241,9 @@ property CheckedState[Index: Integer]: TCheckBoxState read GetCheckedState write SetCheckedState; property MItems: TStrings read GetMItems write SetMItems; - function VerifyUnique(SelectIndex: Integer; iText: String): integer; + function VerifyUnique(SelectIndex: Integer; iText: string): integer; procedure SetBlackColorMode(Value: boolean); function SupportsDynamicProperty(PropertyID: integer): boolean; function GetDynamicProperty(PropertyID: integer): string; + procedure SetHintProperties(Restore: Boolean; MainForm: TComponent); property HideSelection: boolean read FHideSelection write FHideSelection; published @@ -303,42 +309,43 @@ TORComboBox = class(TWinControl, IVADynamicProperty, IORBlackColorModeCompatible) private - FItems: TStrings; // points to Items in FListBox - FMItems: TStrings; // points to MItems in FListBox - FListBox: TORListBox; // listbox control for the combobox - FEditBox: TORComboEdit; // edit control for the combobox - FEditPanel: TORComboPanelEdit; // Used to enable Multi-Select Combo Boxes - FDropBtn: TBitBtn; // drop down button for dropdown combo - FDropPanel: TORDropPanel; // panel for dropdown combo (parent=desktop) - FDroppedDown: Boolean; // true if the list part is dropped down - FStyle: TORComboStyle; // style is simple or dropdown for combo - FDropDownCount: Integer; // number of items to display when list appears - FFromSelf: Boolean; // prevents recursive calls to change event - FFromDropBtn: Boolean; // determines when to capture mouse on drop - FKeyTimerActive: Boolean; // true when timer running for OnKeyPause - FKeyIsDown: Boolean; // true between KeyDown & KeyUp events + FItems: TStrings; // points to Items in FListBox + FMItems: TStrings; // points to MItems in FListBox + FListBox: TORListBox; // listbox control for the combobox + FEditBox: TORComboEdit; // edit control for the combobox + FEditPanel: TORComboPanelEdit; // Used to enable Multi-Select Combo Boxes + FDropBtn: TBitBtn; // drop down button for dropdown combo + FDropPanel: TORDropPanel; // panel for dropdown combo (parent=desktop) + FDroppedDown: Boolean; // true if the list part is dropped down + FStyle: TORComboStyle; // style is simple or dropdown for combo + FDropDownCount: Integer; // number of items to display when list appears + FFromSelf: Boolean; // prevents recursive calls to change event + FFromDropBtn: Boolean; // determines when to capture mouse on drop + FKeyTimerActive: Boolean; // true when timer running for OnKeyPause + FKeyIsDown: Boolean; // true between KeyDown & KeyUp events FChangePending: Boolean; FListItemsOnly: Boolean; FLastFound: string; - FLastInput: string; // last thing the user typed into the edit box - FOnChange: TNotifyEvent; // maps to editbox change event - FOnClick: TNotifyEvent; // maps to listbox click event - FOnDblClick: TNotifyEvent; // maps to listbox double click event - FOnDropDown: TNotifyEvent; // event called when listbox appears - FOnDropDownClose: TNotifyEvent; // event called when listbox disappears - FOnKeyDown: TKeyEvent; // maps to editbox keydown event - FOnKeyPress: TKeyPressEvent; // maps to editbox keypress event - FOnKeyUp: TKeyEvent; // maps to editbox keyup event - FOnKeyPause: TNotifyEvent; // delayed change event when using keyboard - FOnMouseClick: TNotifyEvent; // called when click event triggered by mouse - FOnNeedData: TORNeedDataEvent; // called for longlist when more items needed - FCheckedState: string; // Used to refresh checkboxes when combo box cancel is pressed - FOnCheckedText: TORCheckComboTextEvent; // Used to modify the edit box display text when using checkboxes - FCheckBoxEditColor: TColor; // Edit Box color for Check Box Combo List, when not in Focus + FLastInput: string; // last thing the user typed into the edit box + FOnChange: TNotifyEvent; // maps to editbox change event + FOnClick: TNotifyEvent; // maps to listbox click event + FOnDblClick: TNotifyEvent; // maps to listbox double click event + FOnDropDown: TNotifyEvent; // event called when listbox appears + FOnDropDownClose: TNotifyEvent; // event called when listbox disappears + FOnKeyDown: TKeyEvent; // maps to editbox keydown event + FOnKeyPress: TKeyPressEvent; // maps to editbox keypress event + FOnKeyUp: TKeyEvent; // maps to editbox keyup event + FOnKeyPause: TNotifyEvent; // delayed change event when using keyboard + FOnMouseClick: TNotifyEvent; // called when click event triggered by mouse + FOnNeedData: TORNeedDataEvent; // called for longlist when more items needed + FCheckedState: string; // Used to refresh checkboxes when combo box cancel is pressed + FOnCheckedText: TORCheckComboTextEvent; // Used to modify the edit box display text when using checkboxes + FCheckBoxEditColor: TColor; // Edit Box color for Check Box Combo List, when not in Focus FTemplateField: boolean; - FCharsNeedMatch: integer; // how many text need to be matched for auto selection - FUniqueAutoComplete: Boolean; // If true only perform autocomplete for unique list items. + FCharsNeedMatch: integer; // how many text need to be matched for auto selection + FUniqueAutoComplete: Boolean; // If true only perform autocomplete for unique list items. FBlackColorMode: boolean; - FDisableHints: boolean; // true if hints have been disabled because drop down window was opened - FDropDownStatusChangedCount: integer; // prevents multiple calls to disabling hint window + FDisableHints: boolean; // true if hints have been disabled because drop down window was opened + FDropDownStatusChangedCount: integer; // prevents multiple calls to disabling hint window + fRpcCall: String; procedure DropDownStatusChanged(opened: boolean); procedure ClearDropDownStatus; @@ -413,10 +420,10 @@ procedure StartKeyTimer; procedure StopKeyTimer; - procedure WMDestroy (var Message: TWMDestroy); message WM_DESTROY; - procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED; - procedure WMMove (var Message: TWMMove); message WM_MOVE; - procedure WMSize (var Message: TWMSize); message WM_SIZE; - procedure WMTimer (var Message: TWMTimer); message WM_TIMER; - procedure UMGotFocus (var Message: TMessage); message UM_GOTFOCUS; + procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY; + procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; + procedure WMMove(var Message: TWMMove); message WM_MOVE; + procedure WMSize(var Message: TWMSize); message WM_SIZE; + procedure WMTimer(var Message: TWMTimer); message WM_TIMER; + procedure UMGotFocus(var Message: TMessage); message UM_GOTFOCUS; function GetCheckBoxes: boolean; function GetChecked(Index: Integer): Boolean; @@ -464,5 +471,5 @@ procedure InsertSeparator; procedure Invalidate; override; - procedure SetTextAutoComplete(TextToMatch : String); + procedure SetTextAutoComplete(TextToMatch: string); function GetIEN(AnIndex: Integer): Int64; function SelectByIEN(AnIEN: Int64): Integer; @@ -490,4 +497,5 @@ property MItems: TStrings read GetMItems; published + Property RpcCall :String read fRpcCall write fRpcCall; property Anchors; property CaseChanged: boolean read GetCaseChanged write SetCaseChanged default TRUE; @@ -548,5 +556,5 @@ property OnResize; property OnSynonymCheck: TORSynonymCheckEvent read GetOnSynonymCheck write SetOnSynonymCheck; - property CharsNeedMatch: integer read FCharsNeedMatch write SetNumForMatch; + property CharsNeedMatch: integer read FCharsNeedMatch write SetNumForMatch; {UniqueAutoComplete Was added as a result of the following defects: 7293 - PTM 85: Backspace and Dosage: Desired dosage does not populate if dosage is not in local dosage field @@ -560,6 +568,6 @@ private FSizes: TList; - procedure BuildSizes( Control: TWinControl); - procedure DoResize( Control: TWinControl; var CurrentIndex: Integer); + procedure BuildSizes(Control: TWinControl); + procedure DoResize(Control: TWinControl; var CurrentIndex: Integer); protected procedure Loaded; override; @@ -569,9 +577,9 @@ end; - TOROffsetLabel = class(TGraphicControl) // see TCustomLabel in the VCL + TOROffsetLabel = class(TGraphicControl) // see TCustomLabel in the VCL private - FHorzOffset: Integer; // offset from left of label in pixels - FVertOffset: Integer; // offset from top of label in pixels - FWordWrap: Boolean; // true if word wrap should occur + FHorzOffset: Integer; // offset from left of label in pixels + FVertOffset: Integer; // offset from top of label in pixels + FWordWrap: Boolean; // true if word wrap should occur function GetTransparent: Boolean; procedure AdjustSizeOfSelf; @@ -648,5 +656,5 @@ end; - TORAlignEdit = class(TEdit) //Depricated -- Use TCaptionEdit instead + TORAlignEdit = class(TEdit) //Depricated -- Use TCaptionEdit instead published property Align; @@ -722,12 +730,12 @@ constructor Create(AOwner: TComponent); override; function FindPieceNode(Value: string; - ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; overload; + ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; overload; function FindPieceNode(Value: string; APiece: integer; - ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; overload; + ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; overload; procedure RenameNodes; function GetExpandedIDStr(APiece: integer; ParentDelim: char = #0): string; procedure SetExpandedIDStr(APiece: integer; const Value: string); overload; procedure SetExpandedIDStr(APiece: integer; ParentDelim: char; - const Value: string); overload; + const Value: string); overload; function GetNodeID(Node: TORTreeNode; ParentDelim: Char = #0): string; overload; function GetNodeID(Node: TORTreeNode; APiece: integer; ParentDelim: Char = #0): string; overload; @@ -770,9 +778,9 @@ destructor Destroy; override; published - property CheckedEnabledIndex: integer read FCheckedEnabledIndex write SetCheckedEnabledIndex; - property CheckedDisabledIndex: integer read FCheckedDisabledIndex write SetCheckedDisabledIndex; - property GrayedEnabledIndex: integer read FGrayedEnabledIndex write SetGrayedEnabledIndex; - property GrayedDisabledIndex: integer read FGrayedDisabledIndex write SetGrayedDisabledIndex; - property UncheckedEnabledIndex: integer read FUncheckedEnabledIndex write SetUncheckedEnabledIndex; + property CheckedEnabledIndex: integer read FCheckedEnabledIndex write SetCheckedEnabledIndex; + property CheckedDisabledIndex: integer read FCheckedDisabledIndex write SetCheckedDisabledIndex; + property GrayedEnabledIndex: integer read FGrayedEnabledIndex write SetGrayedEnabledIndex; + property GrayedDisabledIndex: integer read FGrayedDisabledIndex write SetGrayedDisabledIndex; + property UncheckedEnabledIndex: integer read FUncheckedEnabledIndex write SetUncheckedEnabledIndex; property UncheckedDisabledIndex: integer read FUncheckedDisabledIndex write SetUncheckedDisabledIndex; end; @@ -799,13 +807,13 @@ FBlackColorMode: boolean; procedure SetFocusOnBox(value: boolean); - procedure CNMeasureItem (var Message: TWMMeasureItem); message CN_MEASUREITEM; - procedure CNDrawItem (var Message: TWMDrawItem); message CN_DRAWITEM; - procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED; - procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED; - procedure WMLButtonDblClk (var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; - procedure WMSize (var Message: TWMSize); message WM_SIZE; - procedure BMSetCheck (var Message: TMessage); message BM_SETCHECK; - procedure BMGetCheck (var Message: TMessage); message BM_GETCHECK; - procedure BMGetState (var Message: TMessage); message BM_GETSTATE; + procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM; + procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; + procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; + procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; + procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; + procedure WMSize(var Message: TWMSize); message WM_SIZE; + procedure BMSetCheck(var Message: TMessage); message BM_SETCHECK; + procedure BMGetCheck(var Message: TMessage); message BM_GETCHECK; + procedure BMGetState(var Message: TMessage); message BM_GETSTATE; function GetImageList: TCustomImageList; function GetImageIndexes: string; @@ -823,7 +831,7 @@ procedure SetAutoSize(Value: boolean); override; procedure GetDrawData(CanvasHandle: HDC; var Bitmap: TBitmap; - var FocRect, Rect: TRect; - var DrawOptions: UINT; - var TempBitMap: boolean); + var FocRect, Rect: TRect; + var DrawOptions: UINT; + var TempBitMap: boolean); procedure DrawItem(const DrawItemStruct: TDrawItemStruct); dynamic; procedure Toggle; override; @@ -908,5 +916,5 @@ private FHoverItemPos: integer; - FRightClickSelect: boolean; // When true, a right click selects teh item + FRightClickSelect: boolean; // When true, a right click selects teh item FHintOnItem: boolean; procedure SetCaption(const Value: string); @@ -941,4 +949,5 @@ published property Caption: string read GetCaption write SetCaption; + Property CheckWidth: integer Read GetCheckWidth; end; @@ -1010,6 +1019,6 @@ procedure KeyUp(var Key: Word; Shift: TShiftState); override; public - procedure IndexToColRow( index: integer; var Col: integer; var Row: integer); - function ColRowToIndex( Col: integer; Row: Integer): integer; + procedure IndexToColRow(index: integer; var Col: integer; var Row: integer); + function ColRowToIndex(Col: integer; Row: Integer): integer; function SupportsDynamicProperty(PropertyID: integer): boolean; function GetDynamicProperty(PropertyID: integer): string; @@ -1026,10 +1035,10 @@ procedure GoodNotifyWinEvent(event: DWORD; hwnd: HWND; idObject, idChild: Longint); stdcall; -function CalcShortName( LongName: string; PrevLongName: string): string; +function CalcShortName(LongName: string; PrevLongName: string): string; {Returns True if any one of 3 mouse buttons are down left, right, or middle} -function IsAMouseButtonDown : boolean; - -implementation // --------------------------------------------------------------------------- +function IsAMouseButtonDown: boolean; + +implementation // --------------------------------------------------------------------------- {$R ORCTRLS} @@ -1037,32 +1046,32 @@ uses VAUtils; - + const - ALPHA_DISTRIBUTION: array[0..100] of string[3] = ('',' ','ACE','ADG','ALA','AMI','ANA','ANT', - 'ARE','ASU','AZO','BCP','BIC','BOO','BST','CAF','CAR','CD6','CHE','CHO','CMC','CON','CPD', - 'CVI','DAA','DEF','DEP','DIA','DIH','DIP','DP ','EAR','EM ','EPI','ETH','F2G','FIB','FML', - 'FUM','GEL','GLU','GPQ','HAL','HEM','HIS','HUN','HYL','IDS','IND','INT','ISO','KEX','LAN', - 'LEV','LOY','MAG','MAX','MER','MET','MIC','MON','MUD','NAI','NEU','NIT','NUC','OMP','OTH', - 'P42','PAR','PEN','PHA','PHO','PLA','POL','PRA','PRO','PSE','PYR','RAN','REP','RIB','SAA', - 'SCL','SFL','SMO','SPO','STR','SUL','TAG','TET','THI','TOL','TRI','TRY','UNC','VAR','VIT', - 'WRO','ZYM',#127#127#127); - - CBO_CYMARGIN = 8; // vertical whitespace in the edit portion of combobox - CBO_CXBTN = 13; // width of drop down button in combobox - CBO_CXFRAME = 5; // offset to account for frame around the edit part of combobox - - NOREDRAW = 0; // suspend screen updates - DOREDRAW = 1; // allow screen updates - - KEY_TIMER_DELAY = 500; // 500 ms delay after key up before OnKeyPause called - KEY_TIMER_ID = 5800; // arbitrary, use high number in case TListBox uses timers + ALPHA_DISTRIBUTION: array[0..100] of string[3] = ('', ' ', 'ACE', 'ADG', 'ALA', 'AMI', 'ANA', 'ANT', + 'ARE', 'ASU', 'AZO', 'BCP', 'BIC', 'BOO', 'BST', 'CAF', 'CAR', 'CD6', 'CHE', 'CHO', 'CMC', 'CON', 'CPD', + 'CVI', 'DAA', 'DEF', 'DEP', 'DIA', 'DIH', 'DIP', 'DP ', 'EAR', 'EM ', 'EPI', 'ETH', 'F2G', 'FIB', 'FML', + 'FUM', 'GEL', 'GLU', 'GPQ', 'HAL', 'HEM', 'HIS', 'HUN', 'HYL', 'IDS', 'IND', 'INT', 'ISO', 'KEX', 'LAN', + 'LEV', 'LOY', 'MAG', 'MAX', 'MER', 'MET', 'MIC', 'MON', 'MUD', 'NAI', 'NEU', 'NIT', 'NUC', 'OMP', 'OTH', + 'P42', 'PAR', 'PEN', 'PHA', 'PHO', 'PLA', 'POL', 'PRA', 'PRO', 'PSE', 'PYR', 'RAN', 'REP', 'RIB', 'SAA', + 'SCL', 'SFL', 'SMO', 'SPO', 'STR', 'SUL', 'TAG', 'TET', 'THI', 'TOL', 'TRI', 'TRY', 'UNC', 'VAR', 'VIT', + 'WRO', 'ZYM', #127#127#127); + + CBO_CYMARGIN = 8; // vertical whitespace in the edit portion of combobox + CBO_CXBTN = 13; // width of drop down button in combobox + CBO_CXFRAME = 5; // offset to account for frame around the edit part of combobox + + NOREDRAW = 0; // suspend screen updates + DOREDRAW = 1; // allow screen updates + + KEY_TIMER_DELAY = 500; // 500 ms delay after key up before OnKeyPause called + KEY_TIMER_ID = 5800; // arbitrary, use high number in case TListBox uses timers { use high word to pass positioning flags since listbox is limited to 32767 items } //SFI_TOP = $80000000; // top of listbox (decimal value: -2147483648) //SFI_END = $90000000; // end of listbox (decimal value: -1879048192) - SFI_TOP = -2147483646; // top of listbox (hex value: $80000001) - SFI_END = -1879048192; // end of listbox (hex value: $90000000) - - CheckWidth = 15; // CheckBox Width space to reserve for TORListBox + SFI_TOP = -2147483646; // top of listbox (hex value: $80000001) + SFI_END = -1879048192; // end of listbox (hex value: $90000000) + + CheckWidth = 15; // CheckBox Width space to reserve for TORListBox CheckComboBtnHeight = 21; MaxNeedDataLen = 64; @@ -1071,10 +1080,10 @@ TItemTip = class(TCustomControl) private - FShowing: Boolean; // true when itemtip is visible - FListBox: TORListBox; // current listbox displaying itemtips + FShowing: Boolean; // true when itemtip is visible + FListBox: TORListBox; // current listbox displaying itemtips FListItem: integer; FPoint: TPoint; FSelected: boolean; - FTabs: array[0..MAX_TABS] of Integer; // Holds the pixel offsets for tabs + FTabs: array[0..MAX_TABS] of Integer; // Holds the pixel offsets for tabs procedure GetTabSettings; protected @@ -1088,5 +1097,5 @@ end; - TSizeRatio = class // relative sizes and positions for resizing + TSizeRatio = class // relative sizes and positions for resizing CLeft: Extended; CTop: Extended; @@ -1097,9 +1106,9 @@ var - uKeyHookHandle: HHOOK; // handle to capture key events & hide ItemTip window - uItemTip: TItemTip; // ItemTip window - uItemTipCount: Integer; // number of ItemTip clients - uNewStyle: Boolean; // True if using Windows 95 interface - + uKeyHookHandle: HHOOK; // handle to capture key events & hide ItemTip window + uItemTip: TItemTip; // ItemTip window + uItemTipCount: Integer; // number of ItemTip clients + uNewStyle: Boolean; // True if using Windows 95 interface + HintArray: array of THintRecords; { General functions and procedures --------------------------------------------------------- } @@ -1130,5 +1139,6 @@ try GetTextExtentPoint32(DC, 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz', 52, Extent); - Result := Trunc((Extent.cx / 26 + 1) / 2); // Round() doesn't line up with dialog units + //Find the average of the width then round up + Result := Trunc(Extent.cx / 52 ) + 1; finally SelectObject(DC, SaveFont); @@ -1205,5 +1215,5 @@ if i < PieceNum then x := x + StringOfChar(Delim, PieceNum - i) + NewPiece - else x := Copy(x, 1, Strt - PChar(x)) + NewPiece + StrPas(Next); + else x := Copy(x, 1, Strt - PChar(x)) + NewPiece + StrPas(Next); end; @@ -1236,5 +1246,5 @@ end; ANum := StrToIntDef(Trim(APiece), 0); - if(ANum > 0) or (AllowNeg and (ANum < 0)) then + if (ANum > 0) or (AllowNeg and (ANum < 0)) then begin Inc(IntArray[0]); @@ -1262,11 +1272,11 @@ { TItemTip --------------------------------------------------------------------------------- } -procedure AddItemTipRef; // kcm -begin - if uItemTipCount = 0 then uItemTip := TItemTip.Create(Application); // all listboxes share a single ItemTip window +procedure AddItemTipRef; // kcm +begin + if uItemTipCount = 0 then uItemTip := TItemTip.Create(Application); // all listboxes share a single ItemTip window Inc(uItemTipCount); end; -procedure RemoveItemTipRef; // kcm +procedure RemoveItemTipRef; // kcm begin Dec(uItemTipCount); @@ -1295,5 +1305,5 @@ Params.Style := WS_POPUP or WS_DISABLED or WS_BORDER; if uNewStyle then Params.ExStyle := WS_EX_TOOLWINDOW; - Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST; // - test this!! + Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST; // - test this!! end; @@ -1314,5 +1324,5 @@ // WARNING - Do NOT change the X pos or the tab starting pos - this will cause a missmatch // between the hint window and what the control displayes - TabbedTextOut(Handle, 0, y, PChar(AString), Length(AString), MAX_TABS+1, FTabs[0], 0); + TabbedTextOut(Handle, 0, y, PChar(AString), Length(AString), MAX_TABS + 1, FTabs[0], 0); end; end; @@ -1335,9 +1345,9 @@ var DX, X, i, count: integer; - + begin Count := FListBox.FTabPix[0]; - FTabs[0] := 1; // Set first tab stop to location 1 for display purposes - if(Count = 1) then + FTabs[0] := 1; // Set first tab stop to location 1 for display purposes + if (Count = 1) then begin DX := FListBox.FTabPix[1]; @@ -1353,5 +1363,5 @@ for i := 1 to MAX_TABS do begin - if(i <= Count) then + if (i <= Count) then FTabs[i] := FListBox.FTabPix[i] - 1 else @@ -1375,5 +1385,5 @@ Canvas.Brush.Color := clHighlight; Canvas.Font.Color := clHighlightText; - end else // the item is not selected + end else // the item is not selected begin Canvas.Brush.Color := FListBox.ItemTipColor; @@ -1381,16 +1391,16 @@ end; Caption := #9 + FListBox.DisplayText[FListItem]; - if Copy(Caption, 1, 2) = '__' then Caption := ' '; // so separators don't extend past window + if Copy(Caption, 1, 2) = '__' then Caption := ' '; // so separators don't extend past window GetTabSettings; AWidth := LOWORD(GetTabbedTextExtent(Canvas.Handle, PChar(Caption), Length(Caption), - MAX_TABS+1, FTabs[0])); + MAX_TABS + 1, FTabs[0])); // inherent scrollbar may not always be visible in a long list if FListBox.LongList then ListClientWidth := ClientWidthOfList(FListBox) - else ListClientWidth := FListBox.ClientWidth; + else ListClientWidth := FListBox.ClientWidth; X := FPoint.X; - if(FListBox.FCheckBoxes) then + if (FListBox.FCheckBoxes) then begin dec(ListClientWidth, CheckWidth); @@ -1414,5 +1424,5 @@ if (GetCaptureControl = nil) and CatchMouse then FListBox.MouseCapture := True; SetWindowPos(Handle, HWND_TOP, X, FPoint.Y, AWidth, FListBox.ItemHeight, - SWP_SHOWWINDOW or SWP_NOACTIVATE); + SWP_SHOWWINDOW or SWP_NOACTIVATE); Invalidate; end; @@ -1422,5 +1432,5 @@ { sets the canvas properties and window size and text depending on the item in the listbox } begin - if not AListBox.Visible then Exit; // added to support DropDown lists + if not AListBox.Visible then Exit; // added to support DropDown lists FListBox := AListBox; FListItem := AnItem; @@ -1432,7 +1442,7 @@ type TORCBImgIdx = (iiUnchecked, iiChecked, iiGrayed, iiQMark, iiBlueQMark, - iiDisUnchecked, iiDisChecked, iiDisGrayed, iiDisQMark, - iiFlatUnChecked, iiFlatChecked, iiFlatGrayed, - iiRadioUnchecked, iiRadioChecked, iiRadioDisUnchecked, iiRadioDisChecked); + iiDisUnchecked, iiDisChecked, iiDisGrayed, iiDisQMark, + iiFlatUnChecked, iiFlatChecked, iiFlatGrayed, + iiRadioUnchecked, iiRadioChecked, iiRadioDisUnchecked, iiRadioDisChecked); const @@ -1445,5 +1455,5 @@ 'ORCB_RADIO_DISABLED_UNCHECKED', 'ORCB_RADIO_DISABLED_CHECKED'); - BlackCheckBoxImageResNames: array[TORCBImgIdx] of PChar = ( + BlackCheckBoxImageResNames: array[TORCBImgIdx] of PChar = ( 'BLACK_ORLB_FLAT_UNCHECKED', 'BLACK_ORLB_FLAT_CHECKED', 'BLACK_ORLB_FLAT_GRAYED', 'BLACK_ORCB_QUESTIONMARK', 'BLACK_ORCB_BLUEQUESTIONMARK', @@ -1453,5 +1463,5 @@ 'BLACK_ORCB_RADIO_UNCHECKED', 'BLACK_ORCB_RADIO_CHECKED', 'BLACK_ORCB_RADIO_DISABLED_UNCHECKED', 'BLACK_ORCB_RADIO_DISABLED_CHECKED'); - + var ORCBImages: array[TORCBImgIdx, Boolean] of TBitMap; @@ -1461,5 +1471,5 @@ ResName: string; begin - if(not assigned(ORCBImages[Idx, BlackMode])) then + if (not assigned(ORCBImages[Idx, BlackMode])) then begin ORCBImages[Idx, BlackMode] := TBitMap.Create; @@ -1483,5 +1493,5 @@ for Mode := false to true do begin - if(assigned(ORCBImages[i, Mode])) then + if (assigned(ORCBImages[i, Mode])) then ORCBImages[i, Mode].Free; end; @@ -1491,5 +1501,5 @@ { TORStrings } -function TORStrings.Add(const S: string): integer; +function TORStrings.Add(const S: string): integer; var RealVerification: Boolean; @@ -1580,5 +1590,5 @@ var RealVerification: Boolean; -begin //If this method weren't overridden, the listbox would forget which item was selected. +begin //If this method weren't overridden, the listbox would forget which item was selected. MList[Index] := S; RealVerification := Verification; @@ -1611,13 +1621,13 @@ if Verification then begin if not Assigned(FPlainText) then - raise Exception.Create( 'ORStrings is missing PlainText property.'); + raise Exception.Create('ORStrings is missing PlainText property.'); if not Assigned(FTranslator) then - raise Exception.Create( 'ORStrings is missing Translator property.'); + raise Exception.Create('ORStrings is missing Translator property.'); Errors := TStringList.Create; try TotalCount := MList.Count; if MList.Count <> PlainText.Count then begin - Errors.Add('M string count:'+IntToStr(MList.Count)); - Errors.Add('Plain string count:'+IntToStr(PlainText.Count)); + Errors.Add('M string count:' + IntToStr(MList.Count)); + Errors.Add('Plain string count:' + IntToStr(PlainText.Count)); if PlainText.Count > TotalCount then TotalCount := PlainText.Count; @@ -1625,12 +1635,12 @@ for i := 0 to TotalCount - 1 do begin if i >= MList.Count then - Errors.Add('PlainText['+IntToStr(i)+']: '+PlainText[i]) + Errors.Add('PlainText[' + IntToStr(i) + ']: ' + PlainText[i]) else if i >= PlainText.Count then - Errors.Add('ORStrings['+IntToStr(i)+']: '+Translator(MList[i])) + Errors.Add('ORStrings[' + IntToStr(i) + ']: ' + Translator(MList[i])) else begin M := Translator(MList[i]); Plain := PlainText[i]; if M <> Plain then begin - if UpperCase(M) = UpperCase(Plain) then //Listboxes don't always sort cases right, so we give them a little help here. + if UpperCase(M) = UpperCase(Plain) then //Listboxes don't always sort cases right, so we give them a little help here. begin PlainText[i] := M; @@ -1638,6 +1648,6 @@ else begin - Errors.Add('PlainText['+IntToStr(i)+']: '+Plain); - Errors.Add('ORStrings['+IntToStr(i)+']: '+M); + Errors.Add('PlainText[' + IntToStr(i) + ']: ' + Plain); + Errors.Add('ORStrings[' + IntToStr(i) + ']: ' + M); end; end; @@ -1645,6 +1655,6 @@ end; if Errors.Count > 0 then begin - Errors.Insert( 0, 'OR strings are out of sync with plain text strings :'); - raise Exception.Create( Errors.Text); + Errors.Insert(0, 'OR strings are out of sync with plain text strings :'); + raise Exception.Create(Errors.Text); end; finally @@ -1691,5 +1701,5 @@ if uItemTip <> nil then uItemTip.Hide; DestroyItems; - RemoveItemTipRef; //kcm + RemoveItemTipRef; //kcm inherited Destroy; end; @@ -1711,5 +1721,5 @@ FFromSelf := True; RealVerification := True; - if Assigned( FMItems ) then + if Assigned(FMItems) then begin RealVerification := FMItems.Verification; @@ -1717,5 +1727,5 @@ end; inherited CreateWnd; - if Assigned( FMItems ) then + if Assigned(FMItems) then begin FMItems.Verification := RealVerification; @@ -1763,15 +1773,15 @@ function TORListBox.IsSynonym(const TestStr: string): boolean; var - i,cnt,len :integer; + i, cnt, len: integer; begin Result := FALSE; - if((FHideSynonyms) and (FSynonymChars <> '')) then + if ((FHideSynonyms) and (FSynonymChars <> '')) then begin len := length(FSynonymChars); cnt := 0; for i := 1 to len do - if(pos(FSynonymChars[i], TestStr)>0) then inc(cnt); - if(cnt = len) then Result := TRUE; + if (pos(FSynonymChars[i], TestStr) > 0) then inc(cnt); + if (cnt = len) then Result := TRUE; if assigned(FOnSynonymCheck) then FOnSynonymCheck(Self, TestStr, Result); @@ -1787,5 +1797,5 @@ Result := ''; FFromSelf := True; - Len := SendMessage(Handle,LB_GETTEXT, Index, Integer(@Buf)); + Len := SendMessage(Handle, LB_GETTEXT, Index, Integer(@Buf)); FFromSelf := False; if Len > 0 then @@ -1818,11 +1828,11 @@ inherited; if not FFromSelf then with Message do - begin - ItemRec := PItemRec(Result); - if(assigned(ItemRec)) then - Result := Integer(ItemRec^.UserObject) - else - Result := 0; - end; + begin + ItemRec := PItemRec(Result); + if (assigned(ItemRec)) then + Result := Integer(ItemRec^.UserObject) + else + Result := 0; + end; end; @@ -1833,14 +1843,14 @@ begin if not FFromSelf then with Message do - begin - FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, WParam, 0)); // WParam: list index - FFromSelf := False; - if(assigned(ItemRec)) then - ItemRec^.UserObject := TObject(LParam); - LParam := Integer(ItemRec); - if uItemTip.FShowing and (uItemTip.FListBox = Self) and (uItemTip.FListItem = WParam) then - uItemTip.UpdateText(FALSE); - end; + begin + FFromSelf := True; + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, WParam, 0)); // WParam: list index + FFromSelf := False; + if (assigned(ItemRec)) then + ItemRec^.UserObject := TObject(LParam); + LParam := Integer(ItemRec); + if uItemTip.FShowing and (uItemTip.FListBox = Self) and (uItemTip.FListItem = WParam) then + uItemTip.UpdateText(FALSE); + end; inherited; end; @@ -1854,23 +1864,24 @@ inherited; if (not FFromSelf) and (Message.Result <> LB_ERR) then with Message do - begin - FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, WParam, 0)); // WParam: list index - FFromSelf := False; - if(assigned(ItemRec)) then begin FFromSelf := True; - Text := TListBox(self).Items[WParam]; - StrCopy(PChar(LParam), PChar(Text)); // LParam: points string buffer - Result := Length(Text); // Result: length of string + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, WParam, 0)); // WParam: list index FFromSelf := False; - end - else - begin - StrPCopy(PChar(LParam),''); - Result := 0; - end; - end; -end; + if (assigned(ItemRec)) then + begin + FFromSelf := True; + Text := TListBox(self).Items[WParam]; + StrCopy(PChar(LParam), PChar(Text)); // LParam: points string buffer + Result := Length(Text); // Result: length of string + FFromSelf := False; + end + else + begin + StrPCopy(PChar(LParam), ''); + Result := 0; + end; + end; +end; + procedure TORListBox.LBGetTextLen(var Message: TMessage); { intercept LB_GETTEXTLEN and return true length of ItemRec^.FullText } @@ -1881,13 +1892,13 @@ inherited; if (not FFromSelf) and (Message.Result <> LB_ERR) then with Message do - begin - FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, WParam, 0)); - if(assigned(ItemRec)) then - Result := Length(TListBox(self).Items[WParam]) // Result:length of string - else - Result := 0; - FFromSelf := False; - end; + begin + FFromSelf := True; + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, WParam, 0)); + if (assigned(ItemRec)) then + Result := Length(TListBox(self).Items[WParam]) // Result:length of string + else + Result := 0; + FFromSelf := False; + end; end; @@ -1900,13 +1911,13 @@ if not FFromSelf then begin - if FLongList then // -- special long list processing - begin + if FLongList then // -- special long list processing - begin begin if FFromNeedData then FDataAdded := True else with Message do - begin - WParam := FWaterMark; - Result := Perform(LB_INSERTSTRING, WParam, LParam); // always insert into short list - Exit; - end; - end; // -- special long list processing - end + begin + WParam := FWaterMark; + Result := Perform(LB_INSERTSTRING, WParam, LParam); // always insert into short list + Exit; + end; + end; // -- special long list processing - end New(ItemRec); with ItemRec^, Message do @@ -1922,10 +1933,10 @@ DoChange; with Message do if Result <> LB_ERR then - begin - FFromSelf := True; - SendMessage(Handle,LB_SETITEMDATA, Result, Integer(ItemRec)); // Result: new item index - FFromSelf := False; - end - else Dispose(ItemRec); + begin + FFromSelf := True; + SendMessage(Handle, LB_SETITEMDATA, Result, Integer(ItemRec)); // Result: new item index + FFromSelf := False; + end + else Dispose(ItemRec); end else inherited; @@ -1939,5 +1950,5 @@ if not FFromSelf then begin - if FLongList then // -- special long list processing - begin + if FLongList then // -- special long list processing - begin begin if FFromNeedData then @@ -1947,13 +1958,13 @@ end else with Message do - begin - if WParam > FWaterMark then - begin // make sure insert above watermark - FMItems.MList.Move(WParam,FWaterMark); - WParam := FWaterMark; + begin + if WParam > FWaterMark then + begin // make sure insert above watermark + FMItems.MList.Move(WParam, FWaterMark); + WParam := FWaterMark; + end; + Inc(FWaterMark); end; - Inc(FWaterMark); - end; - end; // -- special long list processing - end + end; // -- special long list processing - end New(ItemRec); with ItemRec^, Message do @@ -1968,10 +1979,10 @@ DoChange; with Message do if Result <> LB_ERR then - begin - FFromSelf := True; - SendMessage(Handle,LB_SETITEMDATA, Result, Integer(ItemRec)); // Result: new item index - FFromSelf := False; - end - else Dispose(ItemRec); + begin + FFromSelf := True; + SendMessage(Handle, LB_SETITEMDATA, Result, Integer(ItemRec)); // Result: new item index + FFromSelf := False; + end + else Dispose(ItemRec); end else inherited; @@ -1986,7 +1997,7 @@ begin FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, WParam, 0)); // WParam: list index + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, WParam, 0)); // WParam: list index FFromSelf := False; - if(assigned(ItemRec)) then + if (assigned(ItemRec)) then begin if FLongList and not FFromNeedData then @@ -1995,7 +2006,7 @@ end; end; - FFromSelf := True; // FFromSelf is set here because, under NT, LBResetContent is called - inherited; // when deleting the last string from the listbox. Since ItemRec is - FFromSelf := False; // already disposed, it shouldn't be disposed again. + FFromSelf := True; // FFromSelf is set here because, under NT, LBResetContent is called + inherited; // when deleting the last string from the listbox. Since ItemRec is + FFromSelf := False; // already disposed, it shouldn't be disposed again. DoChange; end; @@ -2013,5 +2024,5 @@ begin FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, i, 0)); + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, i, 0)); FFromSelf := False; Dispose(ItemRec); @@ -2049,15 +2060,15 @@ case Message.CharCode of VK_LBUTTON, VK_RETURN, VK_SPACE: - begin - if (FocusIndex < 0) and (CheckBoxes or MultiSelect) and (Count > 0) then // JNM - 508 compliance - SetFocusIndex(0); - if FocusIndex > -1 then begin - if MultiSelect then + if (FocusIndex < 0) and (CheckBoxes or MultiSelect) and (Count > 0) then // JNM - 508 compliance + SetFocusIndex(0); + if FocusIndex > -1 then begin - IsSelected := LongBool(Perform(LB_GETSEL, FocusIndex, 0)); - Perform(LB_SETSEL, Longint(not IsSelected), FocusIndex); - end - else Perform(LB_SETCURSEL, FocusIndex, 0); + if MultiSelect then + begin + IsSelected := LongBool(Perform(LB_GETSEL, FocusIndex, 0)); + Perform(LB_SETSEL, Longint(not IsSelected), FocusIndex); + end + else Perform(LB_SETCURSEL, FocusIndex, 0); // Send WM_COMMAND here because LBN_SELCHANGE not triggered by LB_SETSEL // and LBN_SELCHANGE is what eventually triggers the Click event. @@ -2067,17 +2078,17 @@ //PostMessage() not SendMessage() is Required here for checkboxes, SendMessage() doesn't //Allow the Checkbox state on the control to be updated - if CheckBoxes then - PostMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle)) - else - SendMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle)); + if CheckBoxes then + PostMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle)) + else + SendMessage(Parent.Handle, WM_COMMAND, MAKELONG(FocusIndex, LBN_SELCHANGE), LPARAM(Handle)); + end; end; - end; - VK_PRIOR: SetFocusIndex(FocusIndex - FLargeChange); - VK_NEXT: SetFocusIndex(FocusIndex + FLargeChange); - VK_END: SetFocusIndex(SFI_END); - VK_HOME: SetFocusIndex(SFI_TOP); - VK_LEFT, VK_UP: SetFocusIndex(FocusIndex - 1); + VK_PRIOR: SetFocusIndex(FocusIndex - FLargeChange); + VK_NEXT: SetFocusIndex(FocusIndex + FLargeChange); + VK_END: SetFocusIndex(SFI_END); + VK_HOME: SetFocusIndex(SFI_TOP); + VK_LEFT, VK_UP: SetFocusIndex(FocusIndex - 1); VK_RIGHT, VK_DOWN: SetFocusIndex(FocusIndex + 1); - else inherited; + else inherited; end; Message.Result := 0; @@ -2094,53 +2105,53 @@ begin if FParentCombo <> nil then with Message do - begin - FDontClose := FALSE; - ListRect := ClientRect; //+ - if FLongList then ListRect.Right := ListRect.Left + ClientWidthOfList(Self); //+ + begin + FDontClose := FALSE; + ListRect := ClientRect; //+ + if FLongList then ListRect.Right := ListRect.Left + ClientWidthOfList(Self); //+ // if the mouse was clicked in the client area set ItemIndex ourselves - if PtInRect(ListRect, Point(XPos, YPos)) then //~ - begin - AnItem := GetIndexFromY(YPos); - if AnItem < Items.Count then ItemIndex := AnItem; - FParentCombo.FwdClick(FParentCombo); - FDontClose := TRUE; - end; + if PtInRect(ListRect, Point(XPos, YPos)) then //~ + begin + AnItem := GetIndexFromY(YPos); + if AnItem < Items.Count then ItemIndex := AnItem; + FParentCombo.FwdClick(FParentCombo); + FDontClose := TRUE; + end; // if the mouse was clicked on the scrollbar, send a message to make the scrolling happen // this is done with WM_NCLBUTTONDOWN, which is ignored if mousecapture is on, so we have // to turn mousecapture off, then back on since it's needed to hide the listbox - with ListRect do ScrollRect := Rect(Right + 1, Top, Self.Width - 2, Bottom); //~ - if {(Items.Count > (FLargeChange + 1)) and} PtInRect(ScrollRect, Point(XPos, YPos)) then //~ - begin - if FLongList then // for long lists + with ListRect do ScrollRect := Rect(Right + 1, Top, Self.Width - 2, Bottom); //~ + if {(Items.Count > (FLargeChange + 1)) and} PtInRect(ScrollRect, Point(XPos, YPos)) then //~ begin - ScreenPoint := PointToSmallPoint(FScrollBar.ScreenToClient( - Self.ClientToScreen(Point(XPos, YPos)))); - MouseCapture := False; - SendMessage(FScrollBar.Handle, WM_LBUTTONDOWN, Message.Keys, - MakeLParam(ScreenPoint.X, ScreenPoint.Y)); - MouseCapture := True; - end else // for normal lists - begin - ScreenPoint := PointToSmallPoint(Self.ClientToScreen(Point(XPos, YPos))); - MouseCapture := False; - SendMessage(Self.Handle, WM_NCLBUTTONDOWN, HTVSCROLL, - MakeLParam(ScreenPoint.X, ScreenPoint.Y)); - MouseCapture := True; - end; - end - else - if(FCheckBoxes) then - begin - TmpRect := ListRect; - TmpRect.Top := TmpRect.Bottom; - TmpRect.Right := TmpRect.Left + Width; - inc(TmpRect.Bottom, CheckComboBtnHeight); - if PtInRect(TmpRect, Point(XPos, YPos)) then - begin - inc(TmpRect.Left, (TmpRect.right - TmpRect.Left) div 2); - FParentCombo.DropPanelBtnPressed(XPos <= TmpRect.Left, FALSE); - end; - end; - end; + if FLongList then // for long lists + begin + ScreenPoint := PointToSmallPoint(FScrollBar.ScreenToClient( + Self.ClientToScreen(Point(XPos, YPos)))); + MouseCapture := False; + SendMessage(FScrollBar.Handle, WM_LBUTTONDOWN, Message.Keys, + MakeLParam(ScreenPoint.X, ScreenPoint.Y)); + MouseCapture := True; + end else // for normal lists + begin + ScreenPoint := PointToSmallPoint(Self.ClientToScreen(Point(XPos, YPos))); + MouseCapture := False; + SendMessage(Self.Handle, WM_NCLBUTTONDOWN, HTVSCROLL, + MakeLParam(ScreenPoint.X, ScreenPoint.Y)); + MouseCapture := True; + end; + end + else + if (FCheckBoxes) then + begin + TmpRect := ListRect; + TmpRect.Top := TmpRect.Bottom; + TmpRect.Right := TmpRect.Left + Width; + inc(TmpRect.Bottom, CheckComboBtnHeight); + if PtInRect(TmpRect, Point(XPos, YPos)) then + begin + inc(TmpRect.Left, (TmpRect.right - TmpRect.Left) div 2); + FParentCombo.DropPanelBtnPressed(XPos <= TmpRect.Left, FALSE); + end; + end; + end; inherited; end; @@ -2162,18 +2173,18 @@ begin - if(FRightClickSelect and (FParentCombo = nil)) then with Message do // List Boxes only, not Combo Boxes - begin - ListRect := ClientRect; //+ - if FLongList then ListRect.Right := ListRect.Left + ClientWidthOfList(Self); //+ + if (FRightClickSelect and (FParentCombo = nil)) then with Message do // List Boxes only, not Combo Boxes + begin + ListRect := ClientRect; //+ + if FLongList then ListRect.Right := ListRect.Left + ClientWidthOfList(Self); //+ // if the mouse was clicked in the client area set ItemIndex ourselves - if PtInRect(ListRect, Point(XPos, YPos)) then //~ - begin - AnItem := GetIndexFromY(YPos); - if AnItem >= Items.Count then AnItem := -1; - end - else - AnItem := -1; - ItemIndex := AnItem; - end; + if PtInRect(ListRect, Point(XPos, YPos)) then //~ + begin + AnItem := GetIndexFromY(YPos); + if AnItem >= Items.Count then AnItem := -1; + end + else + AnItem := -1; + ItemIndex := AnItem; + end; inherited; end; @@ -2186,30 +2197,30 @@ begin if FParentCombo <> nil then with Message do - begin - if(FCheckBoxes) then FDontClose := TRUE; + begin + if (FCheckBoxes) then FDontClose := TRUE; // if the mouse was clicked on the scrollbar, send a message to make the scrolling happen // this is done with WM_NCLBUTTONDOWN, which is ignored if mousecapture is on, so we have // to turn mousecapture off, then back on since it's needed to hide the listbox - with ClientRect do ScrollRect := Rect(Right + 1, Top, Self.Width - 2, Bottom); - if (Items.Count > (FLargeChange + 1)) and PtInRect(ScrollRect, Point(XPos, YPos)) then - begin - if FLongList then // for long lists + with ClientRect do ScrollRect := Rect(Right + 1, Top, Self.Width - 2, Bottom); + if (Items.Count > (FLargeChange + 1)) and PtInRect(ScrollRect, Point(XPos, YPos)) then begin - ScreenPoint := PointToSmallPoint(FScrollBar.ScreenToClient( - Self.ClientToScreen(Point(XPos, YPos)))); - MouseCapture := False; - SendMessage(FScrollBar.Handle, WM_LBUTTONDOWN, Message.Keys, - MakeLParam(ScreenPoint.X, ScreenPoint.Y)); - MouseCapture := True; - end else // for normal lists - begin - ScreenPoint := PointToSmallPoint(Self.ClientToScreen(Point(XPos, YPos))); - MouseCapture := False; - SendMessage(Self.Handle, WM_NCLBUTTONDOWN, HTVSCROLL, - MakeLParam(ScreenPoint.X, ScreenPoint.Y)); - MouseCapture := True; - end; {if FLongList} - end; {if (Items.Count)} - end; {if FParentCombo} + if FLongList then // for long lists + begin + ScreenPoint := PointToSmallPoint(FScrollBar.ScreenToClient( + Self.ClientToScreen(Point(XPos, YPos)))); + MouseCapture := False; + SendMessage(FScrollBar.Handle, WM_LBUTTONDOWN, Message.Keys, + MakeLParam(ScreenPoint.X, ScreenPoint.Y)); + MouseCapture := True; + end else // for normal lists + begin + ScreenPoint := PointToSmallPoint(Self.ClientToScreen(Point(XPos, YPos))); + MouseCapture := False; + SendMessage(Self.Handle, WM_NCLBUTTONDOWN, HTVSCROLL, + MakeLParam(ScreenPoint.X, ScreenPoint.Y)); + MouseCapture := True; + end; {if FLongList} + end; {if (Items.Count)} + end; {if FParentCombo} inherited; end; @@ -2258,5 +2269,5 @@ GetCursorPos(APoint); APoint := ScreenToClient(APoint); - MouseMove([], APoint.X, APoint.Y); // assume nothing in ShiftState for now + MouseMove([], APoint.X, APoint.Y); // assume nothing in ShiftState for now end; @@ -2311,9 +2322,9 @@ procedure TORListBox.DestroyItems; var - ItemCount,i: Integer; + ItemCount, i: Integer; ItemRec: PItemRec; begin - if(not FItemsDestroyed) then + if (not FItemsDestroyed) then begin ItemCount := Perform(LB_GETCOUNT, 0, 0); @@ -2321,5 +2332,5 @@ begin FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, i, 0)); + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, i, 0)); FFromSelf := False; if Assigned(ItemRec) then @@ -2338,22 +2349,22 @@ begin - if(not FCheckBoxes) or (idx < 0) or (idx >= Items.Count) then exit; + if (not FCheckBoxes) or (idx < 0) or (idx >= Items.Count) then exit; OldFromSelf := FFromSelf; FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, idx, 0)); + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, idx, 0)); FFromSelf := OldFromSelf; - if(assigned(ItemRec)) then - begin - if(FAllowGrayed) then + if (assigned(ItemRec)) then + begin + if (FAllowGrayed) then begin case ItemRec^.CheckedState of cbUnchecked: ItemRec^.CheckedState := cbGrayed; - cbGrayed: ItemRec^.CheckedState := cbChecked; - cbChecked: ItemRec^.CheckedState := cbUnchecked; + cbGrayed: ItemRec^.CheckedState := cbChecked; + cbChecked: ItemRec^.CheckedState := cbUnchecked; end; end else begin - if(ItemRec^.CheckedState = cbUnchecked) then + if (ItemRec^.CheckedState = cbUnchecked) then ItemRec^.CheckedState := cbChecked else @@ -2363,7 +2374,7 @@ Rect := ItemRect(Idx); InvalidateRect(Handle, @Rect, FALSE); - if(assigned(FOnClickCheck)) then + if (assigned(FOnClickCheck)) then FOnClickCheck(Self, idx); - if(assigned(FParentCombo)) then + if (assigned(FParentCombo)) then FParentCombo.UpdateCheckEditBoxText; end; @@ -2389,14 +2400,68 @@ uItemTip.Hide; inherited MouseDown(Button, Shift, X, Y); - if(FCheckBoxes) and (X >= 0) and (X <= Width) and (Y >= 0) and (Y <= Height) then + if (FCheckBoxes) and (X >= 0) and (X <= Width) and (Y >= 0) and (Y <= Height) then begin idx := GetIndexFromY(Y); - if(idx >= 0) then - begin - if(FCheckEntireLine) then + if (idx >= 0) then + begin + if (FCheckEntireLine) then ToggleCheckBox(idx) else - if(X < CheckWidth) then ToggleCheckBox(idx); - end; + if (X < CheckWidth) then ToggleCheckBox(idx); + end; + end; +end; + +procedure TORListBox.SetHintProperties(Restore: Boolean; MainForm: TComponent); +var + i, x: integer; + Component: TComponent; +begin + //Clear the array if we are not restoring it + if not restore then SetLength(HintArray, 0); + + //Loop through all the components on the form + for i := 0 to TForm(MainForm).ComponentCount - 1 do begin + Component := TForm(MainForm).Components[i]; + if (Component is TControl) then begin + if not restore then begin + //Increase our array and set our record + SetLength(HintArray, Length(HintArray) + 1); + HintArray[high(HintArray)].ObjectName := Component.Name; + HintArray[high(HintArray)].ObjectHint := GetStrProp(Component, 'Hint'); + //Now clear out the component's hint + SetStrProp(Component, 'Hint', ''); + end else begin + //Loop through the array and find this component's hint + for x := Low(HintArray) to High(HintArray) do begin + if Component.Name = HintArray[x].ObjectName then begin + //Once found reset the hint and break out of the loop + SetStrProp(Component, 'Hint', HintArray[x].ObjectHint); + break; + end; + end; + end; + end; + end; + + //Now deal with the form itself + if not restore then begin + //Increase our array and set our record + SetLength(HintArray, Length(HintArray) + 1); + HintArray[high(HintArray)].ObjectName := TForm(MainForm).Name; + HintArray[high(HintArray)].ObjectHint := TForm(MainForm).Hint; + //Now clear out the Forms's hint + TForm(MainForm).Hint := ''; + end else begin + //Loop through the array and find this Forms's hint + for x := Low(HintArray) to High(HintArray) do begin + if TForm(MainForm).Name = HintArray[x].ObjectName then begin + //Once found reset the hint and break out of the loop + TForm(MainForm).Hint := HintArray[x].ObjectHint; + break; + end; + end; + //Now clear the arrau since we are done using it + SetLength(HintArray, 0); end; end; @@ -2408,8 +2473,19 @@ var AnItem: Integer; - TrueOffset :integer; + TrueOffset: integer; TipPos: TPoint; begin inherited MouseMove(Shift, X, Y); + + //If the drop down is visible and the hint hasn't been changed then clear the hint and save the original hint + if assigned(FParentCombo) then begin + //agp change + //if (FParentCombo.FDropPanel.Visible) and (TForm(self.Owner.Owner).Hint <> '') then begin + if (FParentCombo.FDropPanel.Visible) and ((GetParentForm(self) <> nil) and (Length(HintArray) = 0)) then begin + SetHintProperties(False, GetParentForm(Self)); + end; + end; + + if (not FItemTipEnable) or (not Application.Active) then Exit; { Make sure mouse really moved before continuing. For some reason, MouseMove gets called @@ -2422,4 +2498,5 @@ if not PtInRect(ClientRect, Point(X, Y)) then begin + If FParentCombo = nil then MouseCapture := False; uItemTip.Hide; FItemTipActive := False; @@ -2449,14 +2526,14 @@ procedure TORListBox.MeasureItem(Index: Integer; var Height: Integer); var - Txt:string; - -begin - if(FHideSynonyms) and (fSynonymChars <> '') then - begin - if(FCreatingItem) then + Txt: string; + +begin + if (FHideSynonyms) and (fSynonymChars <> '') then + begin + if (FCreatingItem) then Txt := FCreatingText else - Txt := Items[Index]; - if(IsSynonym(Txt)) then Height := 0; + Txt := Items[Index]; + if (IsSynonym(Txt)) then Height := 0; end; inherited MeasureItem(Index, Height); @@ -2465,5 +2542,5 @@ procedure TORListBox.WMDestroy(var Message: TWMDestroy); begin - if(assigned(Owner)) and (csDestroying in Owner.ComponentState) then + if (assigned(Owner)) and (csDestroying in Owner.ComponentState) then DestroyItems; inherited; @@ -2472,5 +2549,5 @@ procedure TORListBox.CNDrawItem(var Message: TWMDrawItem); begin - if(FCheckBoxes) then + if (FCheckBoxes) then with Message.DrawItemStruct^ do inc(rcItem.Left, CheckWidth); @@ -2482,5 +2559,5 @@ Flags: Longint; ItemRec: PItemRec; - OldFromSelf :boolean; + OldFromSelf: boolean; BMap: TBitMap; i, DY: integer; @@ -2489,5 +2566,5 @@ ShowText: string; begin - if(assigned(FOnBeforeDraw)) then + if (assigned(FOnBeforeDraw)) then FOnBeforeDraw(Self, Index, Rect, State); if Assigned(OnDrawItem) then OnDrawItem(Self, Index, Rect, State) @@ -2504,15 +2581,15 @@ OldFromSelf := FFromSelf; FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0)); // WParam: list index + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, Index, 0)); // WParam: list index FFromSelf := OldFromSelf; - if(FCheckBoxes) then + if (FCheckBoxes) then begin - if(assigned(ItemRec)) then + if (assigned(ItemRec)) then begin case ItemRec^.CheckedState of cbUnchecked: begin - if(FFlatCheckBoxes) then + if (FFlatCheckBoxes) then BMap := GetORCBBitmap(iiFlatUnChecked, FBlackColorMode) else @@ -2521,21 +2598,21 @@ cbChecked: begin - if(FFlatCheckBoxes) then + if (FFlatCheckBoxes) then BMap := GetORCBBitmap(iiFlatChecked, FBlackColorMode) else BMap := GetORCBBitmap(iiChecked, FBlackColorMode); end; - else // cbGrayed: - begin - if(FFlatCheckBoxes) then - BMap := GetORCBBitmap(iiFlatGrayed, FBlackColorMode) - else - BMap := GetORCBBitmap(iiGrayed, FBlackColorMode); - end; + else // cbGrayed: + begin + if (FFlatCheckBoxes) then + BMap := GetORCBBitmap(iiFlatGrayed, FBlackColorMode) + else + BMap := GetORCBBitmap(iiGrayed, FBlackColorMode); + end; end; end else begin - if(FFlatCheckBoxes) then + if (FFlatCheckBoxes) then BMap := GetORCBBitmap(iiFlatGrayed, FBlackColorMode) else @@ -2544,14 +2621,14 @@ TmpR := Rect; TmpR.Right := TmpR.Left; - dec(TmpR.Left, CheckWidth+1); + dec(TmpR.Left, CheckWidth + 1); DY := ((TmpR.Bottom - TmpR.Top) - BMap.Height) div 2; Canvas.Draw(TmpR.Left, TmpR.Top + DY, BMap); end; - if(FTabPos[0] > 0) then + if (FTabPos[0] > 0) then Flags := (FTabPos[1] * 256) or Flags or DT_TABSTOP or DT_EXPANDTABS; ShowText := GetDisplayText(Index); - if(Style <> lbStandard) and (FTabPos[0] > 0) then + if (Style <> lbStandard) and (FTabPos[0] > 0) then begin for i := 1 to FTabPix[0] do @@ -2559,8 +2636,8 @@ Neg := (FTabPix[i] < 0); if Neg then FTabPix[i] := -FTabPix[i]; - inc(FTabPix[i],Rect.Left-1); + inc(FTabPix[i], Rect.Left - 1); if Neg then FTabPix[i] := -FTabPix[i]; end; - TabbedTextOut(Canvas.Handle, Rect.Left, Rect.Top+1, PChar(ShowText), Length(ShowText), + TabbedTextOut(Canvas.Handle, Rect.Left, Rect.Top + 1, PChar(ShowText), Length(ShowText), FTabPix[0], FTabPix[1], -1); for i := 1 to FTabPix[0] do @@ -2568,5 +2645,5 @@ Neg := (FTabPix[i] < 0); if Neg then FTabPix[i] := -FTabPix[i]; - dec(FTabPix[i],Rect.Left-1); + dec(FTabPix[i], Rect.Left - 1); if Neg then FTabPix[i] := -FTabPix[i]; end; @@ -2578,14 +2655,14 @@ end; -function TORListBox.GetIndexFromY(YPos :integer) :integer; -begin - if(FHideSynonyms) then - begin - Result := TopIndex-1; +function TORListBox.GetIndexFromY(YPos: integer): integer; +begin + if (FHideSynonyms) then + begin + Result := TopIndex - 1; repeat inc(Result); - if(Perform(LB_GETITEMHEIGHT, Result, 0) > 0) then - dec(YPos,ItemHeight); - until((YPos < 0) or (Result >= Items.Count)); + if (Perform(LB_GETITEMHEIGHT, Result, 0) > 0) then + dec(YPos, ItemHeight); + until ((YPos < 0) or (Result >= Items.Count)); end else @@ -2602,10 +2679,10 @@ ScrollCount, ScrollPos, InitialTop, i: Integer; begin - if FLongList then // -- special long list processing - begin - begin - if (Value = SFI_TOP) or (Value = SFI_END) then // scroll to top or bottom + if FLongList then // -- special long list processing - begin + begin + if (Value = SFI_TOP) or (Value = SFI_END) then // scroll to top or bottom begin if Value = SFI_TOP then ScrollPos := 0 else ScrollPos := 100; - ScrollTo(Self, scPosition, ScrollPos); // ScrollTo is scrollbar event + ScrollTo(Self, scPosition, ScrollPos); // ScrollTo is scrollbar event FScrollBar.Position := ScrollPos; if ScrollPos = 0 then Value := FFocusIndex else Value := FFocusIndex + FLargeChange; @@ -2614,6 +2691,6 @@ InitialTop := TopIndex; ScrollCount := Value - InitialTop; - ScrollPos := 50; // arbitrary, can be anything from 1-99 - if ScrollCount < 0 then // scroll backwards + ScrollPos := 50; // arbitrary, can be anything from 1-99 + if ScrollCount < 0 then // scroll backwards begin if ScrollCount = -FLargeChange then ScrollTo(Self, scPageUp, ScrollPos) else @@ -2622,5 +2699,5 @@ Value := Value + (FCurrentTop - InitialTop); end; - if ScrollCount > FLargeChange then // scroll forwards + if ScrollCount > FLargeChange then // scroll forwards begin if ScrollCount = (FLargeChange * 2) then ScrollTo(Self, scPageDown, ScrollPos) else @@ -2628,9 +2705,9 @@ FScrollBar.Position := ScrollPos; end; - if(FHideSynonyms) then + if (FHideSynonyms) then begin - while((Perform(LB_GETITEMHEIGHT, Value, 0) = 0) and (Value >= 0) and (value < Items.Count)) do + while ((Perform(LB_GETITEMHEIGHT, Value, 0) = 0) and (Value >= 0) and (value < Items.Count)) do begin - if(Value < FFocusIndex) then + if (Value < FFocusIndex) then dec(Value) else @@ -2639,5 +2716,5 @@ end; end; - end; // -- special long list processing - end + end; // -- special long list processing - end if (Value = SFI_END) or (not (Value < Items.Count)) then Value := Items.Count - 1; if (Value = SFI_TOP) or (Value < 0) then Value := 0; @@ -2670,6 +2747,6 @@ var TipPos: TPoint; - TrueOffset :integer; - TmpIdx :integer; + TrueOffset: integer; + TmpIdx: integer; begin // if listbox is dropdown combo but control is not focused - @@ -2680,11 +2757,11 @@ // if control is not focused - if (Screen.ActiveControl <> Self) and (Screen.ActiveControl <> Parent) then Exit; - if(FHideSynonyms) then + if (FHideSynonyms) then begin TrueOffset := TopIndex; TmpIdx := TopIndex; - while((TmpIdx < Message.wParam) and (TmpIdx < Items.Count)) do - begin - if(Perform(LB_GETITEMHEIGHT, TmpIdx, 0) > 0) then + while ((TmpIdx < Message.wParam) and (TmpIdx < Items.Count)) do + begin + if (Perform(LB_GETITEMHEIGHT, TmpIdx, 0) > 0) then inc(TrueOffset); inc(TmpIdx); @@ -2695,5 +2772,5 @@ TipPos := ClientToScreen(Point(0, (TrueOffset - TopIndex) * ItemHeight)); //uItemTip.Show(Self, FFocusIndex, TipPos, NO_CATCH_MOUSE); - uItemTip.Show(Self, FFocusIndex, TipPos, FParentCombo = nil); // if DropDown, no mousecapture + uItemTip.Show(Self, FFocusIndex, TipPos, FParentCombo = nil); // if DropDown, no mousecapture end; @@ -2703,5 +2780,5 @@ if (AnIndex < Items.Count) and (AnIndex > -1) then Result := StrToInt64Def(Piece(Items[AnIndex], FDelimiter, 1), 0) - else Result := 0; + else Result := 0; end; @@ -2711,5 +2788,5 @@ if ItemIndex > -1 then Result := StrToInt64Def(Piece(Items[ItemIndex], FDelimiter, 1), 0) - else Result := 0; + else Result := 0; end; @@ -2739,10 +2816,10 @@ if FLongList then ListEnd := FWaterMark - 1 else ListEnd := Items.Count - 1; for i := 0 to ListEnd do if (GetIEN(i) = AnIEN) and (GetDisplayText(i) = AnItem) then - begin - ItemIndex := i; - Result := i; - ItemFound := True; - break; - end; + begin + ItemIndex := i; + Result := i; + ItemFound := True; + break; + end; if FLongList and not ItemFound then begin @@ -2781,7 +2858,7 @@ raise Exception.Create('List Index Out of Bounds'); FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0)); + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, Index, 0)); FFromSelf := False; - if(assigned(ItemRec)) then + if (assigned(ItemRec)) then Result := ItemRec^.Reference else @@ -2797,7 +2874,7 @@ raise Exception.Create('List Index Out of Bounds'); FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0)); + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, Index, 0)); FFromSelf := False; - if(assigned(ItemRec)) then + if (assigned(ItemRec)) then ItemRec^.Reference := AReference; end; @@ -2834,5 +2911,5 @@ { returns the character based tab stops that are currently set, if any } begin - if(FTabPosInPixels) then + if (FTabPosInPixels) then Result := IntArrayToString(FTabPix) else @@ -2849,7 +2926,7 @@ for i := 2 to TabTmp[0] do if (abs(TabTmp[i]) < abs(TabTmp[i - 1])) or - (TabTmp[i] = TabTmp[i - 1]) then + (TabTmp[i] = TabTmp[i - 1]) then raise Exception.Create('Tab positions must be in ascending order'); - if(FTabPosInPixels) then + if (FTabPosInPixels) then begin for i := 0 to TabTmp[0] do FTabPix[i] := TabTmp[i]; @@ -2866,5 +2943,5 @@ procedure TORListBox.SetTabPosInPixels(const Value: boolean); begin - if(FTabPosInPixels <> Value) then + if (FTabPosInPixels <> Value) then begin FTabPosInPixels := Value; @@ -2879,7 +2956,7 @@ i, AveWidth: Integer; begin - FillChar(TabDlg, SizeOf(TabDlg), 0); + FillChar(TabDlg, SizeOf(TabDlg), 0); AveWidth := FontWidthPixel(Self.Font.Handle); - if(FTabPosInPixels) then + if (FTabPosInPixels) then begin FillChar(FTabPos, SizeOf(FTabPos), 0); @@ -2888,5 +2965,5 @@ begin FTabPos[i] := FTabPix[i] div AveWidth; - TabDlg[i] := (FTabPix[i] * 4) div AveWidth; + TabDlg[i] := (FTabPix[i] * 4) div AveWidth; end; end @@ -2898,9 +2975,9 @@ begin // do dialog units first so that pixels gets the same rounding error - TabDlg[i] := FTabPos[i] * 4; // 4 dialog units per character + TabDlg[i] := FTabPos[i] * 4; // 4 dialog units per character FTabPix[i] := (TabDlg[i] * AveWidth) div 4; end; end; - TabDlg[0] := FTabPos[0]; + TabDlg[0] := FTabPos[0]; Perform(LB_SETTABSTOPS, TabDlg[0], Integer(@TabDlg[1])); Refresh; @@ -2912,15 +2989,15 @@ end; -procedure TORListBox.SetHideSynonyms(Value :boolean); -var - TmpIH :integer; - -begin - if(FHideSynonyms <> Value) then - begin - if((Value) and (not FLongList)) then +procedure TORListBox.SetHideSynonyms(Value: boolean); +var + TmpIH: integer; + +begin + if (FHideSynonyms <> Value) then + begin + if ((Value) and (not FLongList)) then raise Exception.Create('Hide Synonyms only allowed on Long Lists'); FHideSynonyms := Value; - if(not FHideSynonyms) then + if (not FHideSynonyms) then begin Style := lbStandard; @@ -2928,5 +3005,5 @@ else begin - if(FSynonymChars = '') then + if (FSynonymChars = '') then FSynonymChars := '<>'; TmpIH := ItemHeight; @@ -2937,12 +3014,12 @@ end; -procedure TORListBox.SetSynonymChars(Value :string); -begin - if(FSynonymChars <> Value) then +procedure TORListBox.SetSynonymChars(Value: string); +begin + if (FSynonymChars <> Value) then begin FSynonymChars := Value; - if((Value = '') and (FHideSynonyms)) then + if ((Value = '') and (FHideSynonyms)) then SetHideSynonyms(FALSE); - if(FHideSynonyms) then + if (FHideSynonyms) then begin SetHideSynonyms(FALSE); @@ -2959,7 +3036,7 @@ procedure TORListBox.SetStyle(Value: TListBoxStyle); begin - if(Value <> lbOwnerDrawVariable) and (FHideSynonyms) then + if (Value <> lbOwnerDrawVariable) and (FHideSynonyms) then FHideSynonyms := FALSE; - if(FCheckBoxes) and (Value = lbStandard) then + if (FCheckBoxes) and (Value = lbStandard) then FCheckBoxes := FALSE; inherited Style := Value; @@ -3002,11 +3079,11 @@ try TORStrings(Items).Verification := False; - HandleNeeded; // ensures that Items is valid if in the middle of RecreateWnd + HandleNeeded; // ensures that Items is valid if in the middle of RecreateWnd SaveListMode := FLongList; Strings := TStringList.Create; SaveItems := TList.Create; - FLongList := False; // so don't have to track WaterMark + FLongList := False; // so don't have to track WaterMark FFromSelf := True; - for i := 0 to Items.Count - 1 do // put pointers to TItemRec in SaveItems + for i := 0 to Items.Count - 1 do // put pointers to TItemRec in SaveItems begin ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, i, 0)); @@ -3014,17 +3091,17 @@ end; Strings.Assign(Items); - Items.Clear; // still FromSelf so don't dispose recs + Items.Clear; // still FromSelf so don't dispose recs FFromSelf := False; - for i := 0 to SaveItems.Count - 1 do // use saved ItemRecs to rebuild listbox + for i := 0 to SaveItems.Count - 1 do // use saved ItemRecs to rebuild listbox begin ItemRec := SaveItems[i]; - if(assigned(ItemRec)) then + if (assigned(ItemRec)) then begin Pos := Items.AddObject(Strings[i], ItemRec^.UserObject); // CQ 11491 - Changing TabPositions, etc. was wiping out check box status. FFromSelf := True; - ItemRec2 := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Pos, 0)); + ItemRec2 := PItemRec(SendMessage(Handle, LB_GETITEMDATA, Pos, 0)); FFromSelf := False; - if(assigned(ItemRec2)) then + if (assigned(ItemRec2)) then begin ItemRec2^.Reference := ItemRec^.Reference; @@ -3051,5 +3128,5 @@ begin FreeScrollBar; - if(FHideSynonyms) then + if (FHideSynonyms) then SetHideSynonyms(FALSE); end; @@ -3062,6 +3139,6 @@ L, T, W, H, OffsetLT, OffsetWH: Integer; begin - if uNewStyle then begin OffsetLT := 2; OffsetWH := 4; end // Win95 - else begin OffsetLT := 0; OffsetWH := 0; end; // Win3.1 + if uNewStyle then begin OffsetLT := 2; OffsetWH := 4; end // Win95 + else begin OffsetLT := 0; OffsetWH := 0; end; // Win3.1 W := GetSystemMetrics(SM_CXVSCROLL); L := Left + Width - W - OffsetLT; @@ -3076,5 +3153,5 @@ begin FLongList := True; - if MultiSelect then MultiSelect := False; // LongLists do not support multiple selections + if MultiSelect then MultiSelect := False; // LongLists do not support multiple selections FScrollBar := TScrollBar.Create(Self); FScrollBar.Kind := sbVertical; @@ -3085,5 +3162,5 @@ if FParentCombo = nil then FScrollBar.Parent := Parent - else FScrollBar.Parent := FParentCombo.FDropPanel; + else FScrollBar.Parent := FParentCombo.FDropPanel; end; @@ -3092,5 +3169,5 @@ begin FLongList := False; - FScrollBar.Free; // don't call from destroy because scrollbar may already be free + FScrollBar.Free; // don't call from destroy because scrollbar may already be free FScrollBar := nil; end; @@ -3112,19 +3189,19 @@ FirstItem := TextToShow(Strings[0]); - LastItem := TextToShow(Strings[Strings.Count-1]); + LastItem := TextToShow(Strings[Strings.Count - 1]); Ascend := True; case FDirection of - LL_REVERSE: if CompareText(FirstItem, LastItem) < 0 then Ascend := False; - LL_FORWARD: if CompareText(FirstItem, LastItem) > 0 then Ascend := False; - end; - case Ascend of // should call AddObject & InsertObject instead? - False: case FDirection of - LL_REVERSE: for i := Strings.Count - 1 downto 0 do Items.Insert(FInsertAt, Strings[i]); - LL_FORWARD: for i := Strings.Count - 1 downto 0 do Items.Add(Strings[i]); - end; - True: case FDirection of - LL_REVERSE: for i := 0 to Strings.Count - 1 do Items.Insert(FInsertAt, Strings[i]); - LL_FORWARD: for i := 0 to Strings.Count - 1 do Items.Add(Strings[i]); - end; + LL_REVERSE: if CompareText(FirstItem, LastItem) < 0 then Ascend := False; + LL_FORWARD: if CompareText(FirstItem, LastItem) > 0 then Ascend := False; + end; + case Ascend of // should call AddObject & InsertObject instead? + False: case FDirection of + LL_REVERSE: for i := Strings.Count - 1 downto 0 do Items.Insert(FInsertAt, Strings[i]); + LL_FORWARD: for i := Strings.Count - 1 downto 0 do Items.Add(Strings[i]); + end; + True: case FDirection of + LL_REVERSE: for i := 0 to Strings.Count - 1 do Items.Insert(FInsertAt, Strings[i]); + LL_FORWARD: for i := 0 to Strings.Count - 1 do Items.Add(Strings[i]); + end; end; end; @@ -3141,5 +3218,5 @@ index := GetStringIndex(S); if index > -1 then - S := Piece(Items[index],Delimiter,LookUpPiece); + S := Piece(Items[index], Delimiter, LookUpPiece); end; if CaseChanged then @@ -3157,6 +3234,6 @@ if FWaterMark > 0 then begin - Items.Insert(FWaterMark,LLS_LINE); - Items.Insert(FWaterMark,LLS_SPACE); + Items.Insert(FWaterMark, LLS_LINE); + Items.Insert(FWaterMark, LLS_SPACE); end; end; @@ -3184,8 +3261,8 @@ begin case FDirection of - LL_REVERSE: for i := Items.Count - 1 downto - HigherOf(FCurrentTop + FLargeChange, FWaterMark) do Items.Delete(i); - LL_POSITION: for i := Items.Count - 1 downto FWaterMark do Items.Delete(i); - LL_FORWARD: for i := FCurrentTop - 1 downto FWaterMark do Items.Delete(i); + LL_REVERSE: for i := Items.Count - 1 downto + HigherOf(FCurrentTop + FLargeChange, FWaterMark) do Items.Delete(i); + LL_POSITION: for i := Items.Count - 1 downto FWaterMark do Items.Delete(i); + LL_FORWARD: for i := FCurrentTop - 1 downto FWaterMark do Items.Delete(i); end; end; @@ -3199,16 +3276,16 @@ if Items.Count > 1000 then ClearLong; case FDirection of - LL_REVERSE: if FWaterMark < Items.Count then StartFrom := DisplayText[FWaterMark]; - LL_POSITION: begin - ClearLong; - if StartFrom = #127#127#127 then - begin - FDirection := LL_REVERSE; - StartFrom := ''; - end - else FDirection := LL_FORWARD; - end; - LL_FORWARD: if (FWaterMark < Items.Count) and (Items.Count > 0) - then StartFrom := DisplayText[Items.Count - 1]; + LL_REVERSE: if FWaterMark < Items.Count then StartFrom := DisplayText[FWaterMark]; + LL_POSITION: begin + ClearLong; + if StartFrom = #127#127#127 then + begin + FDirection := LL_REVERSE; + StartFrom := ''; + end + else FDirection := LL_FORWARD; + end; + LL_FORWARD: if (FWaterMark < Items.Count) and (Items.Count > 0) + then StartFrom := DisplayText[Items.Count - 1]; end; if LookupPiece <> 0 then @@ -3216,15 +3293,15 @@ index := GetStringIndex(StartFrom); if index > -1 then - StartFrom := Piece(Items[index],Delimiter,LookUpPiece); + StartFrom := Piece(Items[index], Delimiter, LookUpPiece); end; if CaseChanged then StartFrom := Uppercase(StartFrom); - StartFrom := Copy(StartFrom, 1, 128); // limit length to 128 characters - CtrlPos := 0; // make sure no ctrl characters + StartFrom := Copy(StartFrom, 1, 128); // limit length to 128 characters + CtrlPos := 0; // make sure no ctrl characters for CharPos := 1 to Length(StartFrom) do if StartFrom[CharPos] in [#0..#31] then - begin - CtrlPos := CharPos; - break; - end; + begin + CtrlPos := CharPos; + break; + end; if CtrlPos > 0 then StartFrom := Copy(StartFrom, 1, CtrlPos - 1); if FDirection = LL_FORWARD then FInsertAt := Items.Count else FInsertAt := FWaterMark; @@ -3243,7 +3320,7 @@ x := DisplayText[TopIndex]; if (FWaterMark > 0) and (TopIndex < FWaterMark) - then Result := 0 // short list visible - else while (CompareText(ALPHA_DISTRIBUTION[Result], x) < 0) and (Result < 100) do - Inc(Result); // only long list visible + then Result := 0 // short list visible + else while (CompareText(ALPHA_DISTRIBUTION[Result], x) < 0) and (Result < 100) do + Inc(Result); // only long list visible end; @@ -3251,88 +3328,96 @@ { event code for the longlist scrollbar, adjusts TopIndex & calls OnNeedData as necessary } var - Count, Goal, Dir :integer; - Done :boolean; - -begin + Count, Goal, Dir: integer; + Done: boolean; + DropDownPanel: TORListBox; +begin + If Length(HintArray) > 0 then begin + DropDownPanel := TORListBox.Create(nil); + try + DropDownPanel.SetHintProperties(True, GetParentForm(Self)); + finally + DropDownPanel.Free; + end; + end; uItemTip.Hide; FCurrentTop := TopIndex; - if(ScrollCode = scPosition) then + if (ScrollCode = scPosition) then begin NeedData(LL_POSITION, ALPHA_DISTRIBUTION[ScrollPos]); case ScrollPos of - 0: TopIndex := 0; - 1..99: TopIndex := FWaterMark; - 100: TopIndex := HigherOf(Items.Count - FLargeChange, 0); + 0: TopIndex := 0; + 1..99: TopIndex := FWaterMark; + 100: TopIndex := HigherOf(Items.Count - FLargeChange, 0); end; FFocusIndex := TopIndex; end else - if(HideSynonyms) then - begin - Count := 0; - case ScrollCode of - scLineUp: begin Dir := -1; Goal := 1; end; - scLineDown: begin Dir := 1; Goal := 1; end; - scPageUp: begin Dir := -1; Goal := FLargeChange; end; - scPageDown: begin Dir := 1; Goal := FLargeChange; end; + if (HideSynonyms) then + begin + Count := 0; + case ScrollCode of + scLineUp: begin Dir := -1; Goal := 1; end; + scLineDown: begin Dir := 1; Goal := 1; end; + scPageUp: begin Dir := -1; Goal := FLargeChange; end; + scPageDown: begin Dir := 1; Goal := FLargeChange; end; else exit; - end; - repeat - Done := FALSE; - if(Dir > 0) then - begin - if (FCurrentTop + (FLargeChange * 2)) > (Items.Count - 1) then - NeedData(LL_FORWARD, ''); - if(FCurrentTop >= Items.Count - 1) then + end; + repeat + Done := FALSE; + if (Dir > 0) then begin - FCurrentTop := Items.Count - 1; - Done := TRUE; + if (FCurrentTop + (FLargeChange * 2)) > (Items.Count - 1) then + NeedData(LL_FORWARD, ''); + if (FCurrentTop >= Items.Count - 1) then + begin + FCurrentTop := Items.Count - 1; + Done := TRUE; + end; + end + else + begin + if (FCurrentTop - FLargeChange) < FWaterMark then NeedData(LL_REVERSE, ''); + if (FCurrentTop <= 0) then + begin + FCurrentTop := 0; + Done := TRUE; + end; end; - end - else - begin - if (FCurrentTop - FLargeChange) < FWaterMark then NeedData(LL_REVERSE, ''); - if(FCurrentTop <= 0) then + if (not Done) then begin - FCurrentTop := 0; - Done := TRUE; + FCurrentTop := FCurrentTop + Dir; + if (Perform(LB_GETITEMHEIGHT, FCurrentTop, 0) > 0) then + begin + inc(Count); + Done := (Count >= Goal); + end; end; + until Done; + TopIndex := FCurrentTop; + end + else + begin + case ScrollCode of + scLineUp: begin + if (FCurrentTop - FLargeChange) < FWaterMark then NeedData(LL_REVERSE, ''); + TopIndex := HigherOf(FCurrentTop - 1, 0); + end; + scLineDown: begin + if (FCurrentTop + (FLargeChange * 2)) > (Items.Count - 1) + then NeedData(LL_FORWARD, ''); + TopIndex := LowerOf(FCurrentTop + 1, Items.Count - 1); + end; + scPageUp: begin + if (FCurrentTop - FLargeChange) < FWaterMark then NeedData(LL_REVERSE, ''); + TopIndex := HigherOf(FCurrentTop - FLargeChange, 0); + end; + scPageDown: begin + if (FCurrentTop + (FLargeChange * 2)) > (Items.Count - 1) + then NeedData(LL_FORWARD, ''); + TopIndex := LowerOf(FCurrentTop + FLargeChange, Items.Count - 1); + end; end; - if(not Done) then - begin - FCurrentTop := FCurrentTop + Dir; - if(Perform(LB_GETITEMHEIGHT, FCurrentTop, 0) > 0) then - begin - inc(Count); - Done := (Count >= Goal); - end; - end; - until Done; - TopIndex := FCurrentTop; - end - else - begin - case ScrollCode of - scLineUp: begin - if (FCurrentTop - FLargeChange) < FWaterMark then NeedData(LL_REVERSE, ''); - TopIndex := HigherOf(FCurrentTop - 1, 0); - end; - scLineDown: begin - if (FCurrentTop + (FLargeChange * 2)) > (Items.Count - 1) - then NeedData(LL_FORWARD, ''); - TopIndex := LowerOf(FCurrentTop + 1, Items.Count - 1); - end; - scPageUp: begin - if (FCurrentTop - FLargeChange) < FWaterMark then NeedData(LL_REVERSE, ''); - TopIndex := HigherOf(FCurrentTop - FLargeChange, 0); - end; - scPageDown: begin - if (FCurrentTop + (FLargeChange * 2)) > (Items.Count - 1) - then NeedData(LL_FORWARD, ''); - TopIndex := LowerOf(FCurrentTop + FLargeChange, Items.Count - 1); - end; - end; - end; + end; if (ScrollPos > 0) and (ScrollPos < 100) then ScrollPos := PositionThumb; end; @@ -3344,20 +3429,20 @@ begin Result := -1; - if Length(AString) > 0 then {*KCM*} - begin - if not FLongList then // Normal List + if Length(AString) > 0 then {*KCM*} + begin + if not FLongList then // Normal List begin Result := SendMessage(Handle, LB_FINDSTRING, -1, Longint(PChar(AString))); if Result = LB_ERR then Result := -1; - end else // Long List + end else // Long List begin if FScrollBar.Position = 0 then for i := 0 to FWatermark - 1 do - begin - if CompareText(AString, Copy(DisplayText[i], 1, Length(AString))) = 0 then begin - Result := i; - break; + if CompareText(AString, Copy(DisplayText[i], 1, Length(AString))) = 0 then + begin + Result := i; + break; + end; end; - end; if Result < 0 then begin @@ -3377,7 +3462,7 @@ begin Result := -1; - if Length(AString) > 0 then {*KCM*} - begin - if not FLongList then // Normal List + if Length(AString) > 0 then {*KCM*} + begin + if not FLongList then // Normal List begin Result := SendMessage(Handle, LB_FINDSTRING, -1, Longint(PChar(AString))); @@ -3385,14 +3470,14 @@ // use FFocusIndex instead of FocusIndex to reduce flashing FFocusIndex := Result; - end else // Long List + end else // Long List begin if FScrollBar.Position = 0 then for i := 0 to FWatermark - 1 do - begin - if CompareText(AString, Copy(DisplayText[i], 1, Length(AString))) = 0 then begin - Result := i; - break; + if CompareText(AString, Copy(DisplayText[i], 1, Length(AString))) = 0 then + begin + Result := i; + break; + end; end; - end; if not StringBetween(AString, DisplayText[FWaterMark], DisplayText[Items.Count - 1]) then begin @@ -3402,5 +3487,5 @@ index := GetStringIndex(x); if index > -1 then - x := Piece(Items[index],Delimiter,LookUpPiece); + x := Piece(Items[index], Delimiter, LookUpPiece); end; if CaseChanged then @@ -3421,18 +3506,18 @@ ItemIndex := Result; FFocusIndex := Result; - if Result > -1 then TopIndex := Result; // will scroll item into view - if FLongList then FScrollBar.Position := PositionThumb; // done after topindex set + if Result > -1 then TopIndex := Result; // will scroll item into view + if FLongList then FScrollBar.Position := PositionThumb; // done after topindex set end; procedure TORListBox.SetCheckBoxes(const Value: boolean); begin - if(FCheckBoxes <> Value) then + if (FCheckBoxes <> Value) then begin FCheckBoxes := Value; - if(Value) then - begin - if(GetStyle = lbStandard) then + if (Value) then + begin + if (GetStyle = lbStandard) then SetStyle(lbOwnerDrawFixed); - if(inherited MultiSelect) then + if (inherited MultiSelect) then SetMultiSelect(FALSE); end; @@ -3443,5 +3528,5 @@ procedure TORListBox.SetFlatCheckBoxes(const Value: boolean); begin - if(FFlatCheckBoxes <> Value) then + if (FFlatCheckBoxes <> Value) then begin FFlatCheckBoxes := Value; @@ -3458,7 +3543,7 @@ if Index < 0 then exit; FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0)); + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, Index, 0)); FFromSelf := FALSE; - if(assigned(ItemRec)) then + if (assigned(ItemRec)) then Result := (ItemRec^.CheckedState = cbChecked) else @@ -3473,9 +3558,9 @@ begin FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0)); + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, Index, 0)); FFromSelf := False; if (assigned(ItemRec)) and (Value <> (ItemRec^.CheckedState = cbChecked)) then begin - if(Value) then + if (Value) then ItemRec^.CheckedState := cbChecked else @@ -3483,5 +3568,5 @@ Rect := ItemRect(Index); InvalidateRect(Handle, @Rect, FALSE); - if(assigned(FOnClickCheck)) then + if (assigned(FOnClickCheck)) then FOnClickCheck(Self, Index); end; @@ -3494,7 +3579,7 @@ begin FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0)); + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, Index, 0)); FFromSelf := FALSE; - if(assigned(ItemRec)) then + if (assigned(ItemRec)) then Result := ItemRec^.CheckedState else @@ -3510,5 +3595,5 @@ begin FFromSelf := True; - ItemRec := PItemRec(SendMessage(Handle,LB_GETITEMDATA, Index, 0)); + ItemRec := PItemRec(SendMessage(Handle, LB_GETITEMDATA, Index, 0)); FFromSelf := False; if (assigned(ItemRec)) and (Value <> ItemRec^.CheckedState) then @@ -3517,5 +3602,5 @@ Rect := ItemRect(Index); InvalidateRect(Handle, @Rect, FALSE); - if(assigned(FOnClickCheck)) then + if (assigned(FOnClickCheck)) then FOnClickCheck(Self, Index); end; @@ -3530,5 +3615,5 @@ begin inherited SetMultiSelect(Value); - if(Value) then SetCheckBoxes(FALSE); + if (Value) then SetCheckBoxes(FALSE); end; @@ -3539,7 +3624,7 @@ begin Result := ''; - if(FCheckBoxes) then - begin - for i := 0 to Items.Count-1 do + if (FCheckBoxes) then + begin + for i := 0 to Items.Count - 1 do Result := Result + Char(ord('0') + Ord(GetCheckedState(i))); end; @@ -3551,6 +3636,6 @@ begin - for i := 0 to Items.Count-1 do - SetCheckedState(i, TCheckBoxState(StrToIntDef(copy(Value,i+1,1),0))); + for i := 0 to Items.Count - 1 do + SetCheckedState(i, TCheckBoxState(StrToIntDef(copy(Value, i + 1, 1), 0))); end; @@ -3558,13 +3643,13 @@ begin if not Assigned(FMItems) then - FMItems := TORStrings.Create(Tlistbox(Self).Items,TextToShow); + FMItems := TORStrings.Create(Tlistbox(Self).Items, TextToShow); result := FMItems; end; -procedure TORListBox.SetMItems( Value: TStrings); +procedure TORListBox.SetMItems(Value: TStrings); begin if not Assigned(FMItems) then - FMItems := TORStrings.Create(Tlistbox(Self).Items,TextToShow); - FMItems.Assign( Value ); + FMItems := TORStrings.Create(Tlistbox(Self).Items, TextToShow); + FMItems.Assign(Value); end; @@ -3588,5 +3673,5 @@ FCaption.Width := 0; FCaption.Visible := True; - if Assigned (FParentCombo) then + if Assigned(FParentCombo) then FCaption.Parent := FParentCombo else @@ -3612,7 +3697,7 @@ procedure DropDownPanelOpened; begin - if uDropPanelOpenCount=0 then + if uDropPanelOpenCount = 0 then uOldShowHintsSetting := Application.ShowHint; - Application.ShowHint := FALSE; + // Application.ShowHint := FALSE; inc(uDropPanelOpenCount); end; @@ -3621,9 +3706,9 @@ begin dec(uDropPanelOpenCount); - if uDropPanelOpenCount<=0 then + if uDropPanelOpenCount <= 0 then begin uDropPanelOpenCount := 0; if not Application.ShowHint then - Application.ShowHint := uOldShowHintsSetting + // Application.ShowHint := uOldShowHintsSetting end; end; @@ -3649,5 +3734,5 @@ BevelOuter := bvNone; BorderStyle := bsNone; - Caption :=''; + Caption := ''; Ctl3D := False; Visible := False; @@ -3660,10 +3745,10 @@ inherited CreateParams(Params); if not (csDesigning in ComponentState) then with Params do - begin - if uNewStyle then Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW; - Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST; // - incompatible with ItemTip - WindowClass.Style := WindowClass.Style or CS_SAVEBITS; - WndParent := GetDesktopWindow; - end; + begin + if uNewStyle then Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW; + Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST; // - incompatible with ItemTip + WindowClass.Style := WindowClass.Style or CS_SAVEBITS; + WndParent := GetDesktopWindow; + end; end; @@ -3674,11 +3759,11 @@ begin Result := nil; - if(FButtons) then - begin - for i := 0 to ControlCount-1 do - if(Controls[i] is TSpeedButton) then + if (FButtons) then + begin + for i := 0 to ControlCount - 1 do + if (Controls[i] is TSpeedButton) then begin - if((OKBtn and ((Controls[i] as TSpeedButton).Tag = OKBtnTag)) or - ((not OKBtn) and ((Controls[i] as TSpeedButton).Tag = CancelBtnTag))) then + if ((OKBtn and ((Controls[i] as TSpeedButton).Tag = OKBtnTag)) or + ((not OKBtn) and ((Controls[i] as TSpeedButton).Tag = CancelBtnTag))) then begin Result := TSpeedButton(Controls[i]); @@ -3695,7 +3780,7 @@ begin sb := GetButton(TRUE); - if(assigned(sb)) then sb.Down := FALSE; + if (assigned(sb)) then sb.Down := FALSE; sb := GetButton(FALSE); - if(assigned(sb)) then sb.Down := FALSE; + if (assigned(sb)) then sb.Down := FALSE; end; @@ -3707,17 +3792,17 @@ begin inherited; - if(FButtons) then + if (FButtons) then begin btn := GetButton(TRUE); - if(assigned(btn)) then + if (assigned(btn)) then begin half := width div 2; btn.Left := 0; btn.Width := Half; - btn.Top := Height-btn.Height; + btn.Top := Height - btn.Height; btn := GetButton(FALSE); btn.Left := Half; btn.Width := Width - Half; - btn.Top := Height-btn.Height; + btn.Top := Height - btn.Height; end; end; @@ -3728,11 +3813,11 @@ btn: TSpeedButton; cbo: TORComboBox; - i:integer; + i: integer; begin cbo := (Owner as TORComboBox); - if(cbo.FListBox.FCheckBoxes) then - begin - if(not FButtons) then + if (cbo.FListBox.FCheckBoxes) then + begin + if (not FButtons) then begin btn := TSpeedButton.Create(Self); @@ -3757,12 +3842,12 @@ end else - if(FButtons) then - begin - for i := ControlCount-1 downto 0 do - if(Controls[i] is TButton) then - Controls[i].Free; - FButtons := FALSE; - Resize; - end; + if (FButtons) then + begin + for i := ControlCount - 1 downto 0 do + if (Controls[i] is TButton) then + Controls[i].Free; + FButtons := FALSE; + Resize; + end; end; @@ -3782,5 +3867,11 @@ begin inherited CreateParams(Params); - Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN; +// JM - removed multi-line - broke lookup when MaxLength is set, besides, it didn't really +// seem to have an effect on the editing rectangle anyway. +// agp change cause tab characters to show on meds and lab order dialogs +// Params.Style := Params.Style {or ES_MULTILINE} or WS_CLIPCHILDREN; + if TForm(self.Owner.Owner) <> nil then Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN + else Params.Style := Params.Style {or ES_MULTILINE} or WS_CLIPCHILDREN; + end; @@ -3791,6 +3882,6 @@ begin if (FListBox.FCheckBoxes) and assigned(FEditPanel) and - (Message.FocusedWnd <> FListBox.Handle) and - ((not assigned(FDropBtn)) or (Message.FocusedWnd <> FDropBtn.Handle)) then + (Message.FocusedWnd <> FListBox.Handle) and + ((not assigned(FDropBtn)) or (Message.FocusedWnd <> FDropBtn.Handle)) then begin FEditPanel.FFocused := FALSE; @@ -3845,10 +3936,10 @@ FEditBox.OnKeyUp := FwdKeyUp; FEditBox.Visible := True; - fCharsNeedMatch := 1; + fCharsNeedMatch := 1; end; procedure TORComboBox.WMDestroy(var Message: TWMDestroy); begin - if(assigned(Owner)) and (csDestroying in Owner.ComponentState) then + if (assigned(Owner)) and (csDestroying in Owner.ComponentState) then FListBox.DestroyItems; inherited; @@ -3889,5 +3980,5 @@ function TORComboBox.EditControl: TWinControl; begin - if(assigned(FEditPanel)) then + if (assigned(FEditPanel)) then Result := FEditPanel else @@ -3899,5 +3990,5 @@ var FontHeight: Integer; - cboBtnX,cboBtnY: integer; + cboBtnX, cboBtnY: integer; cboYMargin: integer; @@ -3917,17 +4008,17 @@ cboBtnY := CBO_CXFRAME; end; - Height := HigherOf(FontHeight + cboYMargin, Height); // must be at least as high as text + Height := HigherOf(FontHeight + cboYMargin, Height); // must be at least as high as text EditControl.SetBounds(0, 0, Width, FontHeight + cboYMargin); - if(assigned(FEditPanel)) then + if (assigned(FEditPanel)) then FEditBox.SetBounds(2, 3, FEditPanel.Width - 4, FEditPanel.Height - 5); if FStyle = orcsDropDown then begin - Height := FontHeight + cboYMargin; // DropDown can only be text height + Height := FontHeight + cboYMargin; // DropDown can only be text height FDropBtn.SetBounds(EditControl.Width - CBO_CXBTN - cboBtnX, 0, - CBO_CXBTN, EditControl.Height - cboBtnY); + CBO_CXBTN, EditControl.Height - cboBtnY); end else begin FListBox.SetBounds(0, FontHeight + CBO_CYMARGIN, - Width, Height - FontHeight - CBO_CYMARGIN); + Width, Height - FontHeight - CBO_CYMARGIN); end; SetEditRect; @@ -3950,34 +4041,45 @@ { shift the focus back to the editbox so the focus rectangle doesn't clutter the button } begin - if FDroppedDown then FListBox.MouseCapture := True; // do here so 1st buttonup not captured + if FDroppedDown then FListBox.MouseCapture := True; // do here so 1st buttonup not captured FEditBox.SetFocus; end; procedure TORComboBox.DropDownStatusChanged(opened: boolean); -begin - if opened then - begin - if not FDropPanel.Visible then - begin - if FDropDownStatusChangedCount = 0 then +var + DropDownPanel: TORListBox; +begin + DropDownPanel := TORListBox.Create(nil); + try + if opened then + begin + if not FDropPanel.Visible then begin - FDisableHints := TRUE; - DropDownPanelOpened; + if FDropDownStatusChangedCount = 0 then + begin + FDisableHints := TRUE; + DropDownPanelOpened; + end; + inc(FDropDownStatusChangedCount); end; - inc(FDropDownStatusChangedCount); - end; - end - else - begin - dec(FDropDownStatusChangedCount); - if FDropDownStatusChangedCount <= 0 then - begin - if FDisableHints then + end + else + begin + dec(FDropDownStatusChangedCount); + if FDropDownStatusChangedCount <= 0 then begin - DropDownPanelClosed; - FDisableHints := FALSE; + //agp change + //if FDisableHints then + if (FDisableHints) and (Self.Owner <> nil) then + begin + DropDownPanelClosed; + FDisableHints := FALSE; + If (GetParentForm(Self) <> nil) then + DropDownPanel.SetHintProperties(True, GetParentForm(Self)); + end; + FDropDownStatusChangedCount := 0; end; - FDropDownStatusChangedCount := 0; - end; + end; + finally + DropDownPanel.Free; end; end; @@ -4070,5 +4172,5 @@ begin FChangePending := False; - if (not FListItemsOnly) and (Length(FEditBox.Text) > 0) and (FEditBox.SelStart = 0) then Exit; // **KCM** test this! + if (not FListItemsOnly) and (Length(FEditBox.Text) > 0) and (FEditBox.SelStart = 0) then Exit; // **KCM** test this! with FEditBox do x := Copy(Text, 1, SelStart); FLastInput := x; @@ -4079,5 +4181,5 @@ SelectIndex := FListBox.SelectString(x); if UniqueAutoComplete then - SelectIndex := FListBox.VerifyUnique(SelectIndex,x); + SelectIndex := FListBox.VerifyUnique(SelectIndex, x); if FListItemsOnly and (SelectIndex < 0) and (x <> '') then begin @@ -4086,8 +4188,8 @@ SelectIndex := FListBox.SelectString(x); FEditBox.Text := GetEditBoxText(SelectIndex); - if(not FListBox.FCheckBoxes) then + if (not FListBox.FCheckBoxes) then SendMessage(FEditBox.Handle, EM_SETSEL, Length(FEditBox.Text), Length(x)); FFromSelf := False; - Exit; // OnChange not called in this case + Exit; // OnChange not called in this case end; FFromSelf := True; @@ -4096,16 +4198,16 @@ FEditBox.Text := GetEditBoxText(SelectIndex); FLastFound := x; - if(not FListBox.FCheckBoxes) then + if (not FListBox.FCheckBoxes) then SendMessage(FEditBox.Handle, EM_SETSEL, Length(FEditBox.Text), Length(x)); end else begin - if(FListBox.CheckBoxes) then + if (FListBox.CheckBoxes) then FEditBox.Text := GetEditBoxText(SelectIndex) else - FEditBox.Text := x; // no match, so don't set FLastFound + FEditBox.Text := x; // no match, so don't set FLastFound FEditBox.SelStart := Length(x); end; FFromSelf := False; - if(not FListBox.FCheckBoxes) then + if (not FListBox.FCheckBoxes) then if Assigned(FOnChange) then FOnChange(Self); end; @@ -4146,5 +4248,5 @@ begin FFromSelf := True; - FListBox.FFocusIndex := FListBox.ItemIndex; // FFocusIndex used so ItemTip doesn't flash + FListBox.FFocusIndex := FListBox.ItemIndex; // FFocusIndex used so ItemTip doesn't flash FEditBox.Text := GetEditBoxText(FListBox.ItemIndex); FLastFound := FEditBox.Text; @@ -4152,11 +4254,11 @@ // not sure why this must be posted (put at the back of the message queue), but for some // reason FEditBox.SelectAll selects successfully then deselects on exiting this procedure - if(not FListBox.FCheckBoxes) then + if (not FListBox.FCheckBoxes) then PostMessage(FEditBox.Handle, EM_SETSEL, 0, Length(FEditBox.Text)); FEditBox.SetFocus; end; if Assigned(FOnClick) then FOnClick(Self); - if(not FListBox.FCheckBoxes) then - if Assigned(FOnChange) then FOnChange(Self); // click causes both click & change events + if (not FListBox.FCheckBoxes) then + if Assigned(FOnChange) then FOnChange(Self); // click causes both click & change events end; @@ -4170,12 +4272,12 @@ { passed selected navigation keys to listbox, applies special handling to backspace and F4 } var - i,iPos: Integer; - x,AString: string; + i, iPos: Integer; + x, AString: string; begin // special case: when default action taken (RETURN) make sure FwdChangeDelayed is called first if (Key = VK_RETURN) and FListBox.LongList and FChangePending then FwdChangeDelayed; - StopKeyTimer; // stop timer after control keys so in case an exit event is triggered + StopKeyTimer; // stop timer after control keys so in case an exit event is triggered if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift); - if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then // navigation + if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then // navigation begin if (FStyle = orcsDropDown) and not DroppedDown then DroppedDown := True; @@ -4192,5 +4294,5 @@ if iPos > -1 then begin - FListBox.FFocusIndex := iPos-1; + FListBox.FFocusIndex := iPos - 1; FListBox.ItemIndex := FListBox.FFocusIndex; end; @@ -4199,5 +4301,5 @@ FListBox.Perform(WM_KEYDOWN, Key, 1); end; - if Key in [VK_LBUTTON, VK_RETURN, VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then // select item + if Key in [VK_LBUTTON, VK_RETURN, VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then // select item begin FListBox.Perform(WM_KEYDOWN, VK_LBUTTON, 1); @@ -4206,5 +4308,5 @@ begin FEditBox.Text := GetEditBoxText(FListBox.ItemIndex); - FLastFound := FEditBox.Text; //kcm + FLastFound := FEditBox.Text; //kcm end; FFromSelf := False; @@ -4212,5 +4314,5 @@ // tell parent about RETURN, ESCAPE so that the default action is taken if Key in [VK_RETURN, VK_ESCAPE, VK_TAB] then SendMessage(Parent.Handle, CN_KEYDOWN, Key, 0); - if Key = VK_BACK then // backspace + if Key = VK_BACK then // backspace begin FFromSelf := True; @@ -4218,5 +4320,5 @@ i := FEditBox.SelStart; Delete(x, i + 1, Length(x)); - if(FListBox.FCheckBoxes) then + if (FListBox.FCheckBoxes) then FEditBox.Text := GetEditBoxText(ItemIndex) else @@ -4295,5 +4397,5 @@ { for DropDown combo, display the listbox at the appropriate full screen coordinates } const - MIN_ITEMS = 3; // minimum visible items for long list + MIN_ITEMS = 3; // minimum visible items for long list var ScreenPoint: TPoint; @@ -4308,5 +4410,5 @@ if FListBox.LongList then DropDownCnt := HigherOf(FDropDownCount, MIN_ITEMS) - else DropDownCnt := LowerOf(FDropDownCount, FListBox.Items.Count); + else DropDownCnt := LowerOf(FDropDownCount, FListBox.Items.Count); FListBox.SetBounds(0, 0, Width, (FListBox.ItemHeight * DropDownCnt) + CBO_CXFRAME); // need to make this smart enough to drop the list UP when necessary *** @@ -4314,8 +4416,8 @@ PnlHeight := FListBox.Height; - if(FListBox.FCheckBoxes) then + if (FListBox.FCheckBoxes) then inc(PnlHeight, CheckComboBtnHeight); FDropPanel.SetBounds(ScreenPoint.X, ScreenPoint.Y, FListBox.Width, PnlHeight); - if(FListBox.FCheckBoxes) then + if (FListBox.FCheckBoxes) then begin FDropPanel.ResetButtons; @@ -4326,5 +4428,5 @@ FDropPanel.BringToFront; if FListBox.FScrollBar <> nil then FListBox.FScrollBar.BringToFront; - if not FFromDropBtn then FListBox.MouseCapture := True; // otherwise ButtonUp captures + if not FFromDropBtn then FListBox.MouseCapture := True; // otherwise ButtonUp captures end else begin @@ -4334,5 +4436,5 @@ FDropPanel.Hide; DropDownStatusChanged(FALSE); - if(FListBox.FCheckBoxes) and (assigned(FOnChange)) and + if (FListBox.FCheckBoxes) and (assigned(FOnChange)) and (FCheckedState <> FListBox.GetCheckedString) then FOnChange(Self); @@ -4346,15 +4448,15 @@ begin SendMessage(FEditBox.Handle, EM_GETRECT, 0, LongInt(@Loc)); - Loc.Bottom := ClientHeight + 1; // +1 is workaround for windows paint bug + Loc.Bottom := ClientHeight + 1; // +1 is workaround for windows paint bug if FStyle = orcsDropDown then begin - Loc.Right := ClientWidth - FDropBtn.Width - CBO_CXFRAME; // edit up to button - if(FTemplateField) then - inc(Loc.Right,3); + Loc.Right := ClientWidth - FDropBtn.Width - CBO_CXFRAME; // edit up to button + if (FTemplateField) then + inc(Loc.Right, 3); end else - Loc.Right := ClientWidth - CBO_CXFRAME; // edit in full edit box + Loc.Right := ClientWidth - CBO_CXFRAME; // edit in full edit box Loc.Top := 0; - if(FTemplateField) then + if (FTemplateField) then Loc.Left := 2 else @@ -4383,5 +4485,5 @@ if Value = -1 then FFocusIndex := -1 else FocusIndex := Value; uItemTip.Hide; - if(FListBox.CheckBoxes) then + if (FListBox.CheckBoxes) then SetEditText(GetEditBoxText(ItemIndex)) else @@ -4430,13 +4532,13 @@ FListBox.FParentCombo := nil; FListBox.Parent := Self; - if FListBox.FScrollBar <> nil then FListBox.FScrollBar.Parent := Self; // if long + if FListBox.FScrollBar <> nil then FListBox.FScrollBar.Parent := Self; // if long FListBox.Visible := True; end else begin FDropBtn := TBitBtn.Create(Self); - if(assigned(FEditPanel) and (csDesigning in ComponentState)) then + if (assigned(FEditPanel) and (csDesigning in ComponentState)) then FEditPanel.ControlStyle := FEditPanel.ControlStyle + [csAcceptsControls]; FDropBtn.Parent := FEditBox; - if(assigned(FEditPanel) and (csDesigning in ComponentState)) then + if (assigned(FEditPanel) and (csDesigning in ComponentState)) then FEditPanel.ControlStyle := FEditPanel.ControlStyle - [csAcceptsControls]; LoadComboBoxImage; @@ -4454,5 +4556,5 @@ FListBox.Parent := FDropPanel; ClearDropDownStatus; - if FListBox.FScrollBar <> nil then FListBox.FScrollBar.Parent := FDropPanel; // if long + if FListBox.FScrollBar <> nil then FListBox.FScrollBar.Parent := FDropPanel; // if long end else begin @@ -4718,5 +4820,5 @@ procedure TORComboBox.SetColor(Value: TColor); begin - if(not FListBox.CheckBoxes) then + if (not FListBox.CheckBoxes) then FEditBox.Color := Value; FListBox.Color := Value; @@ -4795,5 +4897,5 @@ procedure TORComboBox.SetText(const Value: string); begin - FEditBox.Text := Value; // kcm ??? + FEditBox.Text := Value; // kcm ??? end; @@ -4825,12 +4927,12 @@ procedure TORComboBox.SetCheckBoxes(const Value: boolean); begin - if(FListBox.FCheckBoxes <> Value) then + if (FListBox.FCheckBoxes <> Value) then begin FListBox.SetCheckBoxes(Value); - if(assigned(FDropPanel)) then + if (assigned(FDropPanel)) then FDropPanel.UpdateButtons; FEditBox.Visible := FALSE; try - if(Value) then + if (Value) then begin SetListItemsOnly(TRUE); @@ -4844,5 +4946,5 @@ FEditPanel.BorderWidth := 1; FEditBox.Parent := FEditPanel; - if(csDesigning in ComponentState) then + if (csDesigning in ComponentState) then FEditPanel.ControlStyle := FEditPanel.ControlStyle - [csAcceptsControls]; end @@ -4865,7 +4967,7 @@ begin FListBox.SetChecked(Index, Value); - if(assigned(FDropPanel)) then + if (assigned(FDropPanel)) then FDropPanel.UpdateButtons; - if(Value) then + if (Value) then SetListItemsOnly(TRUE); end; @@ -4886,12 +4988,12 @@ begin - if(assigned(FDropPanel)) then + if (assigned(FDropPanel)) then begin btn := FDropPanel.GetButton(OKBtn); - if(assigned(Btn)) then + if (assigned(Btn)) then Btn.Down := TRUE; end; - if(not OKBtn) then FListBox.SetCheckedString(FCheckedState); - if(AutoClose) then + if (not OKBtn) then FListBox.SetCheckedString(FCheckedState); + if (AutoClose) then begin FListBox.FDontClose := FALSE; @@ -4913,8 +5015,8 @@ procedure TORComboBox.SetCheckBoxEditColor(const Value: TColor); begin - if(FCheckBoxEditColor <> Value) then + if (FCheckBoxEditColor <> Value) then begin FCheckBoxEditColor := Value; - if(FListBox.FCheckBoxes) then + if (FListBox.FCheckBoxes) then FEditBox.Color := FCheckBoxEditColor; end; @@ -4923,8 +5025,8 @@ procedure TORComboBox.SetListItemsOnly(const Value: Boolean); begin - if(FListItemsOnly <> Value) then + if (FListItemsOnly <> Value) then begin FListItemsOnly := Value; - if(not Value) then + if (not Value) then SetCheckBoxes(FALSE); end; @@ -4939,8 +5041,8 @@ procedure TORComboBox.SetTemplateField(const Value: boolean); begin - if(FTemplateField <> Value) then + if (FTemplateField <> Value) then begin FTemplateField := Value; - if(Value) then + if (Value) then begin SetStyle(orcsDropDown); @@ -4985,19 +5087,19 @@ begin - if(FListBox.FCheckBoxes) then + if (FListBox.FCheckBoxes) then begin Result := ''; cnt := 0; - for i := 0 to FListBox.Items.Count-1 do - begin - if(FListBox.Checked[i]) then + for i := 0 to FListBox.Items.Count - 1 do + begin + if (FListBox.Checked[i]) then begin inc(cnt); - if(Result <> '') then + if (Result <> '') then Result := Result + ', '; Result := Result + FListBox.GetDisplayText(i); end; end; - if(assigned(FOnCheckedText)) then + if (assigned(FOnCheckedText)) then FOnCheckedText(FListBox, cnt, Result); end @@ -5008,5 +5110,5 @@ procedure TORComboBox.UpdateCheckEditBoxText; begin - if(FListBox.FCheckBoxes) then + if (FListBox.FCheckBoxes) then begin FFromSelf := TRUE; @@ -5020,5 +5122,5 @@ begin UpdateCheckEditBoxText; - if(FStyle <> orcsDropDown) and (assigned(FOnChange)) then + if (FStyle <> orcsDropDown) and (assigned(FOnChange)) then FOnChange(Self); end; @@ -5076,15 +5178,15 @@ begin if FSizes <> nil then with FSizes do for i := 0 to Count - 1 do - begin - SizeRatio := Items[i]; - SizeRatio.Free; - end; + begin + SizeRatio := Items[i]; + SizeRatio.Free; + end; FSizes.Free; inherited Destroy; end; -procedure TORAutoPanel.BuildSizes( Control: TWinControl); -var - i,H,W: Integer; +procedure TORAutoPanel.BuildSizes(Control: TWinControl); +var + i, H, W: Integer; SizeRatio: TSizeRatio; Child: TControl; @@ -5097,6 +5199,6 @@ Child := Control.Controls[i]; with Child do - SizeRatio := TSizeRatio.Create(Left/W, Top/H, Width/W, Height/H); - FSizes.Add(SizeRatio); //FSizes is in tree traversal order. + SizeRatio := TSizeRatio.Create(Left / W, Top / H, Width / W, Height / H); + FSizes.Add(SizeRatio); //FSizes is in tree traversal order. //TGroupBox is currently the only type of container that is having these //resize problems @@ -5110,12 +5212,12 @@ begin inherited Loaded; - if csDesigning in ComponentState then Exit; // only want auto-resizing at run time + if csDesigning in ComponentState then Exit; // only want auto-resizing at run time FSizes := TList.Create; BuildSizes(Self); end; -procedure TORAutoPanel.DoResize( Control: TWinControl; var CurrentIndex: Integer); -var - i,H,W: Integer; +procedure TORAutoPanel.DoResize(Control: TWinControl; var CurrentIndex: Integer); +var + i, H, W: Integer; SizeRatio: TSizeRatio; Child: TControl; @@ -5132,7 +5234,7 @@ with SizeRatio do begin if (Child is TLabel) or (Child is TStaticText) then - Child.SetBounds(Round(CLeft*W), Round(CTop*H), Child.Width, Child.Height) + Child.SetBounds(Round(CLeft * W), Round(CTop * H), Child.Width, Child.Height) else - Child.SetBounds(Round(CLeft*W), Round(CTop*H), Round(CWidth*W), Round(CHeight*H)); + Child.SetBounds(Round(CLeft * W), Round(CTop * H), Round(CWidth * W), Round(CHeight * H)); end; if Child is TGroupBox then @@ -5147,7 +5249,7 @@ begin inherited Resize; - if csDesigning in ComponentState then Exit; // only want auto-resizing at run time + if csDesigning in ComponentState then Exit; // only want auto-resizing at run time i := 0; - DoResize( Self, i); + DoResize(Self, i); end; @@ -5191,5 +5293,5 @@ Flags := DT_EXPANDTABS or DT_CALCRECT; if FWordWrap then Flags := Flags or DT_WORDBREAK; - DoDrawText(ARect, Flags); // returns size of text rect + DoDrawText(ARect, Flags); // returns size of text rect Canvas.Handle := 0; ReleaseDC(0, DC); @@ -5227,5 +5329,5 @@ ARect := ClientRect; Inc(ARect.Left, FHorzOffset); - Inc(ARect.Top, FVertOffset); + Inc(ARect.Top, FVertOffset); Flags := DT_EXPANDTABS or DT_NOPREFIX or DT_LEFT; if FWordWrap then Flags := Flags or DT_WORDBREAK; @@ -5246,6 +5348,6 @@ begin if Value - then ControlStyle := ControlStyle - [csOpaque] // transparent = true - else ControlStyle := ControlStyle + [csOpaque]; // transparent = false + then ControlStyle := ControlStyle - [csOpaque] // transparent = true + else ControlStyle := ControlStyle + [csOpaque]; // transparent = false Invalidate; end; @@ -5318,11 +5420,11 @@ inherited CreateParams(Params); Params.Style := Params.Style or ButtonAlignment[FAlignment] or - ButtonLayout[FLayout] or - ButtonWordWrap[FWordWrap]; + ButtonLayout[FLayout] or + ButtonWordWrap[FWordWrap]; end; procedure TORAlignButton.SetAlignment(const Value: TAlignment); begin - if(FAlignment <> Value) then + if (FAlignment <> Value) then begin FAlignment := Value; @@ -5333,5 +5435,5 @@ procedure TORAlignButton.SetLayout(const Value: TTextLayout); begin - if(FLayout <> Value) then + if (FLayout <> Value) then begin FLayout := Value; @@ -5342,5 +5444,5 @@ procedure TORAlignButton.SetWordWrap(const Value: boolean); begin - if(FWordWrap <> Value) then + if (FWordWrap <> Value) then begin FWordWrap := Value; @@ -5359,14 +5461,14 @@ MakeVisible; R := DisplayRect(FALSE); - if(R.Top < 0) then + if (R.Top < 0) then TreeView.TopItem := Self else - if(R.Bottom > TreeView.ClientHeight) then - begin - DY := R.Bottom - TreeView.ClientHeight; - LH := R.Bottom - R.Top + 1; - DY := (DY div LH) + 1; - GetORTreeView.SetVertScrollPos(GetORTreeView.GetVertScrollPos + DY); - end; + if (R.Bottom > TreeView.ClientHeight) then + begin + DY := R.Bottom - TreeView.ClientHeight; + LH := R.Bottom - R.Top + 1; + DY := (DY div LH) + 1; + GetORTreeView.SetVertScrollPos(GetORTreeView.GetVertScrollPos + DY); + end; end; @@ -5397,5 +5499,5 @@ function TORTreeNode.GetText: string; begin - Result := Inherited Text; + Result := inherited Text; end; @@ -5423,5 +5525,5 @@ begin ORCtrls.SetPiece(FStringData, FDelim, PieceNum, NewPiece); - if(PieceNum = FPiece) then + if (PieceNum = FPiece) then Text := NewPiece; end; @@ -5430,5 +5532,5 @@ procedure TORTreeNode.SetStringData(const Value: string); begin - if(FStringData <> Value) then + if (FStringData <> Value) then begin FStringData := Value; @@ -5447,7 +5549,7 @@ procedure TORTreeNode.UpdateText(const Value: string; UpdateData: boolean); begin - Inherited Text := Value; + inherited Text := Value; Caption := Text; - if(UpdateData) then + if (UpdateData) then with GetORTreeView do begin @@ -5457,5 +5559,5 @@ end; -function CalcShortName( LongName: string; PrevLongName: string): string; +function CalcShortName(LongName: string; PrevLongName: string): string; var WordBorder: integer; @@ -5465,5 +5567,5 @@ for j := 1 to Length(LongName) do begin - if (LongName[j] = ' ') or ((j > 1) and (LongName[j-1] = ' ')) or + if (LongName[j] = ' ') or ((j > 1) and (LongName[j - 1] = ' ')) or ((j = Length(LongName)) and (j = Length(PrevLongName)) and (LongName[j] = PrevLongName[j])) then WordBorder := j; @@ -5474,7 +5576,7 @@ result := LongName else if WordBorder = Length(LongName) then - result := 'Same as above ('+LongName+')' + result := 'Same as above (' + LongName + ')' else - result := Copy(LongName,WordBorder,Length(LongName)) + ' ('+Trim(Copy(LongName,1,WordBorder -1)) + ')'; + result := Copy(LongName, WordBorder, Length(LongName)) + ' (' + Trim(Copy(LongName, 1, WordBorder - 1)) + ')'; end; @@ -5489,5 +5591,5 @@ OnNodeCaptioning(self, TheCaption); if ShortNodeCaptions and (Self.GetPrevSibling <> nil) then - TheCaption := CalcShortName( TheCaption, Self.GetPrevSibling.Text); + TheCaption := CalcShortName(TheCaption, Self.GetPrevSibling.Text); end; FCaption := TheCaption; @@ -5503,5 +5605,5 @@ begin DoInh := TRUE; - if(assigned(FOnDragging)) then + if (assigned(FOnDragging)) then begin with Message do @@ -5516,5 +5618,5 @@ end; FOnDragging(Self, DNode, DoInh); - if(not DoInh) then + if (not DoInh) then begin Message.Result := 1; @@ -5525,5 +5627,5 @@ end; end; - if(DoInh) then inherited; + if (DoInh) then inherited; end; @@ -5537,10 +5639,10 @@ begin Result := TORTreeNode.Create(Items); - if Assigned( OnAddition ) then + if Assigned(OnAddition) then OnAddition(self, Result); end; function TORTreeView.FindPieceNode(Value: string; - ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; + ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; begin Result := FindPieceNode(Value, FPiece, ParentDelim, StartNode); @@ -5548,5 +5650,5 @@ function TORTreeView.FindPieceNode(Value: string; APiece: integer; - ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; + ParentDelim: Char = #0; StartNode: TTreeNode = nil): TORTreeNode; var StartIdx, i: integer; @@ -5555,12 +5657,12 @@ begin if assigned(StartNode) then - StartIdx := StartNode.AbsoluteIndex+1 + StartIdx := StartNode.AbsoluteIndex + 1 else StartIdx := 0; Result := nil; - for i := StartIdx to Items.Count-1 do + for i := StartIdx to Items.Count - 1 do begin Node := (Items[i] as TORTreeNode); - if(GetNodeID(Node, APiece, ParentDelim) = Value) then + if (GetNodeID(Node, APiece, ParentDelim) = Value) then begin Result := Node; @@ -5576,11 +5678,11 @@ begin Result := ''; - for i := 0 to Items.Count-1 do + for i := 0 to Items.Count - 1 do begin with (Items[i] as TORTreeNode) do begin - if(Expanded) then + if (Expanded) then begin - if(Result <> '') then + if (Result <> '') then Result := Result + FDelim; Result := Result + GetNodeID(TORTreeNode(Items[i]), APiece, ParentDelim); @@ -5596,5 +5698,5 @@ procedure TORTreeView.SetExpandedIDStr(APiece: integer; ParentDelim: char; - const Value: string); + const Value: string); var i: integer; @@ -5614,11 +5716,11 @@ repeat i := pos(FDelim, NList); - if(i = 0) then i := length(NList)+1; - Srch := copy(NList,1,i-1); + if (i = 0) then i := length(NList) + 1; + Srch := copy(NList, 1, i - 1); Node := FindPieceNode(Srch, APiece, ParentDelim); - if(assigned(Node)) then + if (assigned(Node)) then Node.Expand(FALSE); - Nlist := copy(NList,i+1,MaxInt); - until(NList = ''); + Nlist := copy(NList, i + 1, MaxInt); + until (NList = ''); TopItem := Top; Selected := Sel; @@ -5640,10 +5742,10 @@ procedure TORTreeView.RenameNodes; var - i:integer; - -begin - if(FDelim <> #0) and (FPiece > 0) then - begin - for i := 0 to Items.Count-1 do + i: integer; + +begin + if (FDelim <> #0) and (FPiece > 0) then + begin + for i := 0 to Items.Count - 1 do with (Items[i] as TORTreeNode) do UpdateText(Piece(FStringData, FDelim, FPiece), FALSE); @@ -5653,5 +5755,5 @@ procedure TORTreeView.SetNodeDelim(const Value: Char); begin - if(FDelim <> Value) then + if (FDelim <> Value) then begin FDelim := Value; @@ -5662,11 +5764,11 @@ procedure TORTreeView.SetHorzScrollPos(Value: integer); begin - if(Value < 0) then Value := 0; - Perform(WM_HSCROLL,MakeWParam(SB_THUMBPOSITION, Value),0); + if (Value < 0) then Value := 0; + Perform(WM_HSCROLL, MakeWParam(SB_THUMBPOSITION, Value), 0); end; procedure TORTreeView.SetNodePiece(const Value: integer); begin - if(FPiece <> Value) then + if (FPiece <> Value) then begin FPiece := Value; @@ -5677,6 +5779,6 @@ procedure TORTreeView.SetVertScrollPos(Value: integer); begin - if(Value < 0) then Value := 0; - Perform(WM_VSCROLL,MakeWParam(SB_THUMBPOSITION, Value),0); + if (Value < 0) then Value := 0; + Perform(WM_VSCROLL, MakeWParam(SB_THUMBPOSITION, Value), 0); end; @@ -5690,8 +5792,8 @@ ParentDelim: Char): string; begin - if(assigned(Node)) then + if (assigned(Node)) then begin Result := Piece(Node.FStringData, FDelim, APiece); - if((ParentDelim <> #0) and (ParentDelim <> FDelim) and (assigned(Node.Parent))) then + if ((ParentDelim <> #0) and (ParentDelim <> FDelim) and (assigned(Node.Parent))) then Result := Result + ParentDelim + GetNodeID(Node.Parent, APiece, ParentDelim); end @@ -5742,5 +5844,5 @@ function RStr(Value: integer): string; begin - if(Value <> -1) then + if (Value <> -1) then Result := IntToStr(Value) else @@ -5751,26 +5853,26 @@ begin Result := RStr(FCheckedEnabledIndex) + - RStr(FGrayedEnabledIndex) + - RStr(FUncheckedEnabledIndex) + - RStr(FCheckedDisabledIndex) + - RStr(FGrayedDisabledIndex) + - RStr(FUncheckedDisabledIndex); - delete(Result,length(Result),1); - if(Result = ',,,,,') then Result := ''; + RStr(FGrayedEnabledIndex) + + RStr(FUncheckedEnabledIndex) + + RStr(FCheckedDisabledIndex) + + RStr(FGrayedDisabledIndex) + + RStr(FUncheckedDisabledIndex); + delete(Result, length(Result), 1); + if (Result = ',,,,,') then Result := ''; end; procedure TORCBImageIndexes.SetIdxString(Value: string); var - i,j,v: integer; - Sub: String; - -begin - if(Value = '') then - begin - FCheckedEnabledIndex := -1; - FGrayedEnabledIndex := -1; - FUncheckedEnabledIndex := -1; - FCheckedDisabledIndex := -1; - FGrayedDisabledIndex := -1; + i, j, v: integer; + Sub: string; + +begin + if (Value = '') then + begin + FCheckedEnabledIndex := -1; + FGrayedEnabledIndex := -1; + FUncheckedEnabledIndex := -1; + FCheckedDisabledIndex := -1; + FGrayedDisabledIndex := -1; FUncheckedDisabledIndex := -1; end @@ -5780,18 +5882,18 @@ Sub := Value; repeat - j := pos(',',Sub); - if(j = 0) then j := length(Sub)+1; - v := StrToIntDef(copy(Sub,1,j-1),-1); + j := pos(',', Sub); + if (j = 0) then j := length(Sub) + 1; + v := StrToIntDef(copy(Sub, 1, j - 1), -1); case i of - 0: FCheckedEnabledIndex := v; - 1: FGrayedEnabledIndex := v; - 2: FUncheckedEnabledIndex := v; - 3: FCheckedDisabledIndex := v; - 4: FGrayedDisabledIndex := v; + 0: FCheckedEnabledIndex := v; + 1: FGrayedEnabledIndex := v; + 2: FUncheckedEnabledIndex := v; + 3: FCheckedDisabledIndex := v; + 4: FGrayedDisabledIndex := v; 5: FUncheckedDisabledIndex := v; end; inc(i); - Sub := copy(Sub,j+1,MaxInt); - until(Sub = ''); + Sub := copy(Sub, j + 1, MaxInt); + until (Sub = ''); end; end; @@ -5799,5 +5901,5 @@ procedure TORCBImageIndexes.ImageListChanged(Sender: TObject); begin - if(Owner is TWinControl) then + if (Owner is TWinControl) then (Owner as TWinControl).Invalidate; end; @@ -5811,5 +5913,5 @@ procedure TORCBImageIndexes.SetCheckedDisabledIndex(const Value: integer); begin - if(FCheckedDisabledIndex <> Value) then + if (FCheckedDisabledIndex <> Value) then begin FCheckedDisabledIndex := Value; @@ -5820,5 +5922,5 @@ procedure TORCBImageIndexes.SetCheckedEnabledIndex(const Value: integer); begin - if(FCheckedEnabledIndex <> Value) then + if (FCheckedEnabledIndex <> Value) then begin FCheckedEnabledIndex := Value; @@ -5829,5 +5931,5 @@ procedure TORCBImageIndexes.SetGrayedDisabledIndex(const Value: integer); begin - if(FGrayedDisabledIndex <> Value) then + if (FGrayedDisabledIndex <> Value) then begin FGrayedDisabledIndex := Value; @@ -5838,5 +5940,5 @@ procedure TORCBImageIndexes.SetGrayedEnabledIndex(const Value: integer); begin - if(FGrayedEnabledIndex <> Value) then + if (FGrayedEnabledIndex <> Value) then begin FGrayedEnabledIndex := Value; @@ -5847,5 +5949,5 @@ procedure TORCBImageIndexes.SetUncheckedDisabledIndex(const Value: integer); begin - if(FUncheckedDisabledIndex <> Value) then + if (FUncheckedDisabledIndex <> Value) then begin FUncheckedDisabledIndex := Value; @@ -5856,5 +5958,5 @@ procedure TORCBImageIndexes.SetUncheckedEnabledIndex(const Value: integer); begin - if(FUncheckedEnabledIndex <> Value) then + if (FUncheckedEnabledIndex <> Value) then begin FUncheckedEnabledIndex := Value; @@ -5889,5 +5991,5 @@ destructor TORCheckBox.Destroy; begin - if(FCustomImagesOwned) then FCustomImages.Free; + if (FCustomImagesOwned) then FCustomImages.Free; FCanvas.Free; inherited; @@ -5917,5 +6019,5 @@ procedure TORCheckBox.Toggle; begin - if(FGrayedToChecked) then + if (FGrayedToChecked) then begin case State of @@ -5969,7 +6071,7 @@ procedure TORCheckBox.GetDrawData(CanvasHandle: HDC; var Bitmap: TBitmap; - var FocRect, Rect: TRect; - var DrawOptions: UINT; - var TempBitMap: boolean); + var FocRect, Rect: TRect; + var DrawOptions: UINT; + var TempBitMap: boolean); var i, l, TxtHeight, TxtWidth, AWidth: Integer; @@ -5983,5 +6085,5 @@ FSingleLine := TRUE; - if(not (csDestroying in ComponentState)) then + if (not (csDestroying in ComponentState)) then begin with FCustomImages do @@ -5993,12 +6095,12 @@ begin CustomImgIdx := -1; - if(assigned(FImages)) then + if (assigned(FImages)) then begin - if(Enabled or (csDesigning in ComponentState)) then + if (Enabled or (csDesigning in ComponentState)) then begin case State of - cbChecked: CustomImgIdx := FCheckedEnabledIndex; + cbChecked: CustomImgIdx := FCheckedEnabledIndex; cbUnChecked: CustomImgIdx := FUncheckedEnabledIndex; - cbGrayed: CustomImgIdx := FGrayedEnabledIndex; + cbGrayed: CustomImgIdx := FGrayedEnabledIndex; end; end @@ -6006,18 +6108,18 @@ begin case State of - cbChecked: CustomImgIdx := FCheckedDisabledIndex; + cbChecked: CustomImgIdx := FCheckedDisabledIndex; cbUnChecked: CustomImgIdx := FUncheckedDisabledIndex; - cbGrayed: CustomImgIdx := FGrayedDisabledIndex; + cbGrayed: CustomImgIdx := FGrayedDisabledIndex; end; end; - if((CustomImgIdx < 0) or (CustomImgIdx >= FImages.Count)) then + if ((CustomImgIdx < 0) or (CustomImgIdx >= FImages.Count)) then CustomImgIdx := -1; end; - if(CustomImgIdx < 0) then + if (CustomImgIdx < 0) then begin ImgIdx := iiChecked; - if(Enabled or (csDesigning in ComponentState)) then + if (Enabled or (csDesigning in ComponentState)) then begin - if(FRadioStyle) then + if (FRadioStyle) then begin if State = cbChecked then @@ -6029,11 +6131,11 @@ begin case State of - cbChecked: ImgIdx := iiChecked; + cbChecked: ImgIdx := iiChecked; cbUnChecked: ImgIdx := iiUnchecked; cbGrayed: begin case FGrayedStyle of - gsNormal: ImgIdx := iiGrayed; - gsQuestionMark: ImgIdx := iiQMark; + gsNormal: ImgIdx := iiGrayed; + gsQuestionMark: ImgIdx := iiQMark; gsBlueQuestionMark: ImgIdx := iiBlueQMark; end; @@ -6044,5 +6146,5 @@ else begin - if(FRadioStyle) then + if (FRadioStyle) then begin if State = cbChecked then @@ -6054,9 +6156,9 @@ begin case State of - cbChecked: ImgIdx := iiDisChecked; + cbChecked: ImgIdx := iiDisChecked; cbUnChecked: ImgIdx := iiDisUnchecked; cbGrayed: begin - if(FGrayedStyle = gsNormal) then + if (FGrayedStyle = gsNormal) then ImgIdx := iiDisGrayed else @@ -6082,10 +6184,10 @@ Rect.Left := Bitmap.Width + 5; - if(FWordWrap) then + if (FWordWrap) then DrawOptions := DrawOptions or DT_WORDBREAK else DrawOptions := DrawOptions or DT_VCENTER or DT_SINGLELINE; - if(FWordWrap) then + if (FWordWrap) then begin if Alignment = taLeftJustify then @@ -6094,9 +6196,9 @@ Rect.Right := Width; Rect.Top := 1; - Rect.Bottom := Height+1; + Rect.Bottom := Height + 1; dec(Rect.Right); FocRect := Rect; TxtHeight := DrawText(Handle, PChar(Caption), Length(Caption), FocRect, - DrawOptions or DT_CALCRECT); + DrawOptions or DT_CALCRECT); FSingleLine := (TxtHeight = TextHeight(Caption)); Rect.Bottom := Rect.Top + TxtHeight + 1; @@ -6110,15 +6212,15 @@ l := length(Caption); AWidth := TextWidth('&'); - while(i < l) do + while (i < l) do begin inc(i); // '&&' is an escape char that should display one '&' wide. // This next part preserves the first '&' but drops all the others - if (Copy(Caption,i,2)<>'&&') and (Copy(Caption,i,1)='&') then - dec(TxtWidth,AWidth); + if (Copy(Caption, i, 2) <> '&&') and (Copy(Caption, i, 1) = '&') then + dec(TxtWidth, AWidth); end; Rect.Right := Rect.Left + TxtWidth; TxtHeight := TextHeight(Caption); - if(TxtHeight < Bitmap.Height) then + if (TxtHeight < Bitmap.Height) then TxtHeight := Bitmap.Height; Rect.Top := ((((ClientHeight - TxtHeight) * 5) - 5) div 10); @@ -6143,5 +6245,5 @@ begin - if(not (csDestroying in ComponentState)) then + if (not (csDestroying in ComponentState)) then begin GetDrawData(DrawItemStruct.hDC, Bitmap, FocusRect, R, DrawOptions, TempBitMap); @@ -6160,5 +6262,5 @@ Font := Self.Font; - if(Enabled or (csDesigning in ComponentState)) then + if (Enabled or (csDesigning in ComponentState)) then begin DrawText(Handle, PChar(Caption), Length(Caption), FocusRect, DrawOptions); @@ -6166,5 +6268,5 @@ else begin - OldColor:=Font.Color; + OldColor := Font.Color; try if Ctl3D then @@ -6175,8 +6277,8 @@ OffsetRect(FocusRect, -1, -1); end; - Font.Color:=clGrayText; + Font.Color := clGrayText; DrawText(Handle, PChar(Caption), Length(Caption), FocusRect, DrawOptions); finally - Font.Color:=OldColor; + Font.Color := OldColor; end; @@ -6185,8 +6287,8 @@ end; - if((DrawItemStruct.itemState and ODS_FOCUS) <> 0) then + if ((DrawItemStruct.itemState and ODS_FOCUS) <> 0) then begin InflateRect(FocusRect, 1, 1); - if(FFocusOnBox) then + if (FFocusOnBox) then //TempRect := Rect(0, 0, CheckWidth - 1, CheckWidth - 1) TempRect := Rect(0, 0, CheckWidth + 2, CheckWidth + 5) @@ -6205,10 +6307,10 @@ else R.Left := 0; - if(FWordWrap) then - R.Top:= FocusRect.Top + if (FWordWrap) then + R.Top := FocusRect.Top else begin - R.Top:= ((ClientHeight - Bitmap.Height + 1) div 2) - 1; - if R.Top < 0 then R.Top := 0 + R.Top := ((ClientHeight - Bitmap.Height + 1) div 2) - 1; + if R.Top < 0 then R.Top := 0 end; Draw(R.Left, R.Top, Bitmap); @@ -6218,5 +6320,5 @@ end; finally - if(TempBitMap) then + if (TempBitMap) then Bitmap.Free; end; @@ -6226,8 +6328,8 @@ procedure TORCheckBox.SetGrayedStyle(Value: TGrayedStyle); begin - if(FGrayedStyle <> Value) then + if (FGrayedStyle <> Value) then begin FGrayedStyle := Value; - if(State = cbGrayed) then Invalidate; + if (State = cbGrayed) then Invalidate; end; end; @@ -6241,5 +6343,5 @@ begin inherited; - if(FSizable) and (csDesigning in ComponentState) then + if (FSizable) and (csDesigning in ComponentState) then AutoAdjustSize; end; @@ -6254,18 +6356,18 @@ Message.Result := 0; - if(assigned(Parent) and (FGroupIndex <> 0)) then + if (assigned(Parent) and (FGroupIndex <> 0)) then begin Chk := Checked; - if(Chk or (not FAllowAllUnchecked)) then + if (Chk or (not FAllowAllUnchecked)) then begin cnt := 0; - for i := 0 to Parent.ControlCount-1 do + for i := 0 to Parent.ControlCount - 1 do begin - if(Parent.Controls[i] is TORCheckBox) then + if (Parent.Controls[i] is TORCheckBox) then begin cb := TORCheckBox(Parent.Controls[i]); - if(cb <> Self) then + if (cb <> Self) then begin - if(cb.Checked and (cb.FGroupIndex = FGroupIndex)) then + if (cb.Checked and (cb.FGroupIndex = FGroupIndex)) then begin if Chk then @@ -6277,5 +6379,5 @@ end; end; - if(not Chk) and (Cnt = 0) then + if (not Chk) and (Cnt = 0) then Checked := TRUE; end; @@ -6287,5 +6389,5 @@ procedure TORCheckBox.SetWordWrap(const Value: boolean); begin - if(FWordWrap <> Value) then + if (FWordWrap <> Value) then begin FWordWrap := Value; @@ -6297,5 +6399,5 @@ procedure TORCheckBox.SetAutoSize(Value: boolean); begin - if(FAutoSize <> Value) then + if (FAutoSize <> Value) then begin FAutoSize := Value; @@ -6324,5 +6426,5 @@ begin - if(FAutoSize and (([csDestroying, csLoading] * ComponentState) = [])) then + if (FAutoSize and (([csDestroying, csLoading] * ComponentState) = [])) then begin FSizable := TRUE; @@ -6338,7 +6440,7 @@ ReleaseDC(0, DC); end; - if(FocusRect.Left <> R.Left ) or - (FocusRect.Right <> R.Right ) or - (FocusRect.Top <> R.Top ) or + if (FocusRect.Left <> R.Left) or + (FocusRect.Right <> R.Right) or + (FocusRect.Top <> R.Top) or (FocusRect.Bottom <> R.Bottom) or (R.Right <> ClientRect.Right) or @@ -6348,11 +6450,11 @@ if Alignment = taLeftJustify then begin - dec(R.Left,2); - inc(R.Right,Bitmap.Width + 3); + dec(R.Left, 2); + inc(R.Right, Bitmap.Width + 3); end else - dec(R.Left,Bitmap.Width + 5); - Width := R.Right-R.Left+1; - Height := R.Bottom-R.Top+2; + dec(R.Left, Bitmap.Width + 5); + Width := R.Right - R.Left + 1; + Height := R.Bottom - R.Top + 2; end; end; @@ -6366,5 +6468,5 @@ procedure TORCheckBox.SetCaption(const Value: TCaption); begin - if(inherited Caption <> Value) then + if (inherited Caption <> Value) then begin inherited Caption := Value; @@ -6383,5 +6485,5 @@ begin FGroupIndex := Value; - if(Value <> 0) and (csDesigning in ComponentState) and (not (csLoading in ComponentState)) then + if (Value <> 0) and (csDesigning in ComponentState) and (not (csLoading in ComponentState)) then SetRadioStyle(TRUE); SyncAllowAllUnchecked; @@ -6394,12 +6496,12 @@ begin - if(assigned(Parent) and (FGroupIndex <> 0)) then - begin - for i := 0 to Parent.ControlCount-1 do - begin - if(Parent.Controls[i] is TORCheckBox) then + if (assigned(Parent) and (FGroupIndex <> 0)) then + begin + for i := 0 to Parent.ControlCount - 1 do + begin + if (Parent.Controls[i] is TORCheckBox) then begin cb := TORCheckBox(Parent.Controls[i]); - if((cb <> Self) and (cb.FGroupIndex = FGroupIndex)) then + if ((cb <> Self) and (cb.FGroupIndex = FGroupIndex)) then cb.FAllowAllUnchecked := FAllowAllUnchecked; end; @@ -6422,10 +6524,10 @@ procedure TORCheckBox.SetAssociate(const Value: TControl); begin - if(FAssociate <> Value) then - begin - if(assigned(FAssociate)) then + if (FAssociate <> Value) then + begin + if (assigned(FAssociate)) then FAssociate.RemoveFreeNotification(Self); FAssociate := Value; - if(assigned(FAssociate)) then + if (assigned(FAssociate)) then begin FAssociate.FreeNotification(Self); @@ -6451,7 +6553,7 @@ // lose the disabled glyph that is stored on that button for the combo box. - if(Ctrl is TWinControl) and (csAcceptsControls in Ctrl.ControlStyle) then - begin - for i := 0 to TWinControl(Ctrl).ControlCount-1 do + if (Ctrl is TWinControl) and (csAcceptsControls in Ctrl.ControlStyle) then + begin + for i := 0 to TWinControl(Ctrl).ControlCount - 1 do begin if DoCtrl then @@ -6466,5 +6568,5 @@ begin - if(assigned(FAssociate)) then + if (assigned(FAssociate)) then EnableCtrl(FAssociate, FALSE); end; @@ -6474,5 +6576,5 @@ begin inherited; - if(AComponent = FAssociate) and (Operation = opRemove) then + if (AComponent = FAssociate) and (Operation = opRemove) then FAssociate := nil; end; @@ -6518,7 +6620,7 @@ if (Mask and HDI_WIDTH) <> 0 then begin - if(Column[Item].MinWidth > 0) and (cxy < Column[Item].MinWidth) then + if (Column[Item].MinWidth > 0) and (cxy < Column[Item].MinWidth) then cxy := Column[Item].MinWidth; - if(Column[Item].MaxWidth > 0) and (cxy > Column[Item].MaxWidth) then + if (Column[Item].MaxWidth > 0) and (cxy > Column[Item].MaxWidth) then cxy := Column[Item].MaxWidth; Column[Item].Width := cxy; @@ -6538,5 +6640,5 @@ with Message, TLVColumn(pointer(LParam)^) do begin - if(cx < Column[WParam].MinWidth) then + if (cx < Column[WParam].MinWidth) then begin NewW := Column[WParam].MinWidth; @@ -6544,5 +6646,5 @@ idx := WParam; end; - if(cx > Column[WParam].MaxWidth) then + if (cx > Column[WParam].MaxWidth) then begin NewW := Column[WParam].MaxWidth; @@ -6552,5 +6654,5 @@ end; inherited; - if(Changed) then + if (Changed) then Column[idx].Width := NewW; end; @@ -6567,5 +6669,5 @@ with Message do begin - if(LParam < Column[WParam].MinWidth) then + if (LParam < Column[WParam].MinWidth) then begin LParam := Column[WParam].MinWidth; @@ -6574,5 +6676,5 @@ idx := WParam; end; - if(LParam > Column[WParam].MaxWidth) then + if (LParam > Column[WParam].MaxWidth) then begin LParam := Column[WParam].MaxWidth; @@ -6583,5 +6685,5 @@ end; inherited; - if(Changed) then + if (Changed) then Column[idx].Width := NewW; end; @@ -6591,5 +6693,5 @@ destructor TORComboPanelEdit.Destroy; begin - if(assigned(FCanvas)) then + if (assigned(FCanvas)) then FCanvas.Free; inherited; @@ -6603,7 +6705,7 @@ begin inherited; - if(FFocused) then - begin - if(not assigned(FCanvas)) then + if (FFocused) then + begin + if (not assigned(FCanvas)) then FCanvas := TControlCanvas.Create; DC := GetWindowDC(Handle); @@ -6620,4 +6722,5 @@ { TKeyClickPanel ----------------------------------------------------------------------------- } + procedure TKeyClickPanel.KeyDown(var Key: Word; Shift: TShiftState); begin @@ -6692,5 +6795,5 @@ procedure TCaptionListBox.MoveFocusDown; begin - if ItemIndex < (Items.Count-1) then + if ItemIndex < (Items.Count - 1) then Perform(LB_SETCARETINDEX, ItemIndex + 1, 0); end; @@ -6728,5 +6831,5 @@ VK_LEFT, VK_UP: MoveFocusUp; VK_RIGHT, VK_DOWN: MoveFocusDown; - else inherited; + else inherited; end else inherited; @@ -6735,5 +6838,5 @@ procedure TCaptionListBox.WMMouseMove(var Message: TWMMouseMove); var - i : integer; + i: integer; begin inherited; @@ -6760,25 +6863,25 @@ begin if FRightClickSelect then with Message do - begin - APoint := Point(XPos, YPos); + begin + APoint := Point(XPos, YPos); // if the mouse was clicked in the client area set ItemIndex... - if PtInRect(ClientRect, APoint) then - begin - ItemIndex := ItemAtPos(APoint,True); + if PtInRect(ClientRect, APoint) then + begin + ItemIndex := ItemAtPos(APoint, True); // ...but not if its just going to deselect the current item - if ItemIndex > -1 then - begin - Items.BeginUpdate; - try - if not Selected[ItemIndex] then - for i := 0 to Items.Count-1 do - Selected[i] := False; - Selected[ItemIndex] := True; - finally - Items.EndUpdate; + if ItemIndex > -1 then + begin + Items.BeginUpdate; + try + if not Selected[ItemIndex] then + for i := 0 to Items.Count - 1 do + Selected[i] := False; + Selected[ItemIndex] := True; + finally + Items.EndUpdate; + end; end; end; end; - end; inherited; end; @@ -6916,5 +7019,5 @@ function TCaptionTreeView.GetCaption: string; begin - result := inherited Caption; + result := inherited Caption; end; @@ -7008,5 +7111,5 @@ begin result := (ColCount - FixedCols) * (Row - FixedRows) + - (Col - FixedCols) + 1; + (Col - FixedCols) + 1; end; @@ -7022,6 +7125,6 @@ Row: integer); begin - Row := (index-1) div (ColCount - FixedCols) + FixedRows; - Col := (index-1) mod (ColCount - FixedCols) + FixedCols; + Row := (index - 1) div (ColCount - FixedCols) + FixedRows; + Col := (index - 1) mod (ColCount - FixedCols) + FixedCols; end; @@ -7033,5 +7136,5 @@ (Key = VK_TAB) and (Shift <= [ssShift]) then GoodNotifyWinEvent(EVENT_OBJECT_FOCUS, Handle, integer(OBJID_CLIENT), - ColRowToIndex(Col,Row)); + ColRowToIndex(Col, Row)); end; @@ -7043,9 +7146,9 @@ end; -function IsAMouseButtonDown : boolean; +function IsAMouseButtonDown: boolean; begin if Boolean(Hi(GetKeyState(VK_MBUTTON))) or - Boolean(Hi(GetKeyState(VK_LBUTTON))) or - Boolean(Hi(GetKeyState(VK_RBUTTON))) then + Boolean(Hi(GetKeyState(VK_LBUTTON))) or + Boolean(Hi(GetKeyState(VK_RBUTTON))) then Result := true else @@ -7068,33 +7171,34 @@ end; -function TORListBox.VerifyUnique(SelectIndex: Integer; iText: String): integer; -var - i : integer; - counter : integer; +function TORListBox.VerifyUnique(SelectIndex: Integer; iText: string): integer; +var + i: integer; + counter: integer; begin Result := SelectIndex; - if LongList then - begin + if LongList then + begin //Implemented for CQ: 10092, PSI-04-057 //asume long lists are alphabetically ordered... - if CompareText(iText, Copy(DisplayText[SelectIndex+1], 1, Length(iText))) = 0 then - Result := -1; - end - else //Not a LongList - begin - counter := 0; - for i := 0 to Items.Count-1 do - if CompareText(iText, Copy(DisplayText[i], 1, Length(iText))) = 0 then - Inc(counter); - if counter > 1 then - Result := -1; - end; + if CompareText(iText, Copy(DisplayText[SelectIndex + 1], 1, Length(iText))) = 0 then + Result := -1; + end + else //Not a LongList + begin + counter := 0; + for i := 0 to Items.Count - 1 do + if CompareText(iText, Copy(DisplayText[i], 1, Length(iText))) = 0 then + Inc(counter); + if counter > 1 then + Result := -1; + end; FFocusIndex := Result; - ItemIndex := Result; + ItemIndex := Result; end; //This procedure sets the Text property equal to the TextToMatch parameter, then calls //FwdChangeDelayed which will perform an auto-completion on the text. -procedure TORComboBox.SetTextAutoComplete(TextToMatch: String); + +procedure TORComboBox.SetTextAutoComplete(TextToMatch: string); begin Text := TextToMatch; @@ -7121,5 +7225,5 @@ //uItemTip := TItemTip.Create(Application); // all listboxes share a single ItemTip window uItemTipCount := 0; - uNewStyle := Lo(GetVersion) >= 4; // True = Win95 interface, otherwise old interface + uNewStyle := Lo(GetVersion) >= 4; // True = Win95 interface, otherwise old interface FillChar(ORCBImages, SizeOf(ORCBImages), 0); @@ -7129,2 +7233,3 @@ end. + Index: cprs/trunk/CPRS-Lib/ORDateLib2006.dpk =================================================================== --- cprs/trunk/CPRS-Lib/ORDateLib2006.dpk (revision 829) +++ cprs/trunk/CPRS-Lib/ORDateLib2006.dpk (revision 1679) @@ -34,5 +34,5 @@ tee, ORCtrlLib2006, - XWB_R10; + XWB_R2007; contains Index: cprs/trunk/CPRS-Lib/ORDateLib2006.drc =================================================================== --- cprs/trunk/CPRS-Lib/ORDateLib2006.drc (revision 829) +++ cprs/trunk/CPRS-Lib/ORDateLib2006.drc (revision 1679) @@ -1,4 +1,4 @@ -/* VER180 - Generated by the Borland Delphi Pascal Compiler +/* VER185 + Generated by the CodeGear Delphi Pascal Compiler because -GD or --drc was supplied to the compiler. @@ -13,2 +13,10 @@ END +/* OR2006Compatibility.dfm */ +/* ORDtTm.DFM */ +/* ORDtTm.RES */ +/* ORDtTmRng.DFM */ +/* E:\Vista_30_28\OR_SRC_CREATION\CPRS-Lib\ORDateLib2006.res */ +/* E:\Vista_30_28\OR_SRC_CREATION\CPRS-Lib\ORDtTm.dcr */ +/* E:\Vista_30_28\OR_SRC_CREATION\CPRS-Lib\ORDtTmRng.dcr */ +/* E:\Vista_30_28\OR_SRC_CREATION\CPRS-Lib\ORDateLib2006.drf */ Index: cprs/trunk/CPRS-Lib/ORDtTm.pas =================================================================== --- cprs/trunk/CPRS-Lib/ORDtTm.pas (revision 829) +++ cprs/trunk/CPRS-Lib/ORDtTm.pas (revision 1679) @@ -99,4 +99,5 @@ FCaption: TStaticText; FBlackColorMode: boolean; + FOnDateDialogClosed : TNotifyEvent; procedure ButtonClick(Sender: TObject); function GetFMDateTime: TFMDateTime; @@ -115,4 +116,5 @@ procedure KeyDown(var Key: Word; Shift: TShiftState); override; property DateButton: TORDateButton read FButton; + procedure SetEnabled(Value: Boolean); override; //wat v28 when disabling TORDateBox, button still appears active, this addresses that public constructor Create(AOwner: TComponent); override; @@ -130,4 +132,5 @@ property RequireTime: Boolean read FRequireTime write SetRequireTime; property Caption: string read GetCaption write SetCaption; + property OnDateDialogClosed: TNotifyEvent read FOnDateDialogClosed write FOnDateDialogClosed; end; @@ -646,4 +649,5 @@ end; DateDialog.Free; + if Assigned(OnDateDialogClosed) then OnDateDialogClosed(Self); if Visible and Enabled then //Some events may hide the component SetFocus; @@ -740,4 +744,10 @@ if Length(Text) > 0 then begin + { +!!!!!! THIS HAS BEEN REMOVED AS IT CAUSED PROBLEMS WITH REMINDER DIALOGS - VHAISPBELLC !!!!!! + //We need to make sure that there is a date entered before parse + if FRequireTime and ((Pos('@', Text) = 0) or (Length(Piece(Text, '@', 1)) = 0)) then + ErrMsg := 'Date Required'; + } FFMDateTime := ServerParseFMDate(Text); if FFMDateTime <= 0 then Errmsg := 'Invalid Date/Time'; @@ -777,4 +787,10 @@ end; FCaption.Caption := Value; +end; + +procedure TORDateBox.SetEnabled(Value: Boolean); +begin + FButton.Enabled := Value; + inherited; end; Index: cprs/trunk/CPRS-Lib/ORFn.pas =================================================================== --- cprs/trunk/CPRS-Lib/ORFn.pas (revision 829) +++ cprs/trunk/CPRS-Lib/ORFn.pas (revision 1679) @@ -36,4 +36,5 @@ function LowerOf(i, j: Integer): Integer; function StrToFloatDef(const S: string; ADefault: Extended): Extended; +function RectContains(Rect: TRect; Point: TPoint): boolean; { String functions } @@ -41,4 +42,5 @@ function ContainsAlpha(const x: string): Boolean; function ContainsVisibleChar(const x: string): Boolean; +function ContainsUpCarretChar(const x: string): Boolean; function ConvertSpecialStrings(const x: string): String; function CRCForFile(AFileName: string): DWORD; @@ -118,4 +120,5 @@ { Misc functions } +function CPRSInstances: integer; { You MUST pass an address to an object variable to get KillObj to work } procedure KillObj(ptr: Pointer; KillObjects: boolean = FALSE); @@ -124,8 +127,10 @@ procedure CallWhenIdle(CallProc: TORIdleCallProc; Msg: String); procedure CallWhenIdleNotifyWhenDone(CallProc, DoneProc: TORIdleCallProc; Msg: String); + procedure menuHideAllBut(aMenuItem: tMenuItem; butItems: array of tMenuItem); function TabIsPressed : Boolean; function ShiftTabIsPressed : Boolean; function EnterIsPressed : Boolean; +procedure ScrollControl(Window: TScrollingWinControl; ScrollingUp: boolean; Amount: integer = 40); implementation // --------------------------------------------------------------------------- @@ -387,4 +392,12 @@ end; +function RectContains(Rect: TRect; Point: TPoint): boolean; +begin + Result := ((Point.X >= Rect.Left) and + (Point.X <= Rect.Right) and + (Point.Y >= Rect.Top) and + (Point.Y <= Rect.Bottom)); +end; + { String functions } @@ -415,4 +428,17 @@ Result := False; for i := 1 to Length(x) do if x[i] in ['!'..'~'] then // ordinal values 33..126 + begin + Result := True; + break; + end; +end; + +function ContainsUpCarretChar(const x: string): Boolean; +{ returns true if the string contains the ^ character } +var + i: Integer; +begin + Result := False; + for i := 1 to Length(x) do if x[i] = '^' then // ordinal values 33..126 begin Result := True; @@ -2022,4 +2048,31 @@ *) +function CPRSInstances: integer; +// returns the number of CPRS sessions open +var + AHandle: hWnd; + LengthText, LengthConst, counter: Integer; + CharText: array [0..254] of Char; + TitleText, TitleCompare: string; +const + TX_IN_USE = 'VistA CPRS in use by: '; // use same as in fFrame +begin + counter := 0; + LengthConst := length(TX_IN_USE); + AHandle := FindWindow(nil, nil); + while AHandle <> 0 do begin + LengthText := GetWindowText(AHandle, CharText, 255); + if LengthText > 0 then + begin + TitleText := CharText; + TitleCompare := copy(TitleText, 1, LengthConst); + if TitleCompare = TX_IN_USE then + counter := counter + 1; + end; + AHandle := GetWindow(AHandle, GW_HWNDNEXT); + end; + Result := counter; +end; + { You MUST pass an address to an object variable to get KillObj to work } procedure KillObj(ptr: Pointer; KillObjects: boolean = FALSE); @@ -2197,4 +2250,46 @@ end; +procedure ScrollControl(Window: TScrollingWinControl; ScrollingUp: boolean; Amount: integer = 40); +var + Delta: integer; + + // This is needed to tell the child components that they are moving, + // The TORCombo box, for example, needs to close a dropped down window when it moves. + // If Delphi had used standard scroll bars, instead of the customized flat ones, this + // code wouldn't be needed + procedure SendMoveMessage(Ctrl: TWinControl); + var + i: integer; + begin + for i := 0 to Ctrl.ControlCount - 1 do + begin + if Ctrl.Controls[i] is TWinControl then with TWinControl(Ctrl.Controls[i]) do + begin + SendMessage(Handle, WM_MOVE, 0, (Top * 65536) + Left); + SendMoveMessage(TWinControl(Ctrl.Controls[i])); + end; + end; + end; + +begin + Delta := Amount; + if ScrollingUp then + begin + if Window.VertScrollBar.Position < Delta then + Delta := Window.VertScrollBar.Position; + Delta := - Delta; + end + else + begin + if (Window.VertScrollBar.Range - Window.VertScrollBar.Position) < Delta then + Delta := Window.VertScrollBar.Range - Window.VertScrollBar.Position; + end; + if Delta <> 0 then + begin + Window.VertScrollBar.Position := Window.VertScrollBar.Position + Delta; + SendMoveMessage(Window); + end; +end; + initialization FBaseFont := TFont.Create; Index: cprs/trunk/CPRS-Lib/ORNet.pas =================================================================== --- cprs/trunk/CPRS-Lib/ORNet.pas (revision 829) +++ cprs/trunk/CPRS-Lib/ORNet.pas (revision 1679) @@ -1,10 +1,10 @@ unit ORNet; -{$DEFINE CCOWBROKER} +//{$DEFINE CCOWBROKER} interface -uses SysUtils, Windows, Classes, Forms, Controls, ORFn, TRPCB, RPCConf1, Dialogs -{$IFDEF CCOWBROKER}, CCOWRPCBroker {$ENDIF} ; //, SharedRPCBroker; +uses SysUtils, Windows, Classes, Forms, Controls, ORFn, TRPCB, RPCConf1, Dialogs + ; //, SharedRPCBroker; @@ -26,4 +26,5 @@ function DottedIPStr: string; procedure CallRPCWhenIdle(CallProc: TORIdleCallProc; Msg: String); +function ShowRPCList: Boolean; procedure EnsureBroker; @@ -36,10 +37,5 @@ var -{$IFDEF CCOWBROKER} - RPCBrokerV: TCCOWRPCBroker; -{$ELSE} RPCBrokerV: TRPCBroker; - //RPCBrokerV: TSharedRPCBroker; -{$ENDIF} RPCLastCall: string; @@ -69,10 +65,5 @@ if RPCBrokerV = nil then begin -{$IFDEF CCOWBROKER} - RPCBrokerV := TCCOWRPCBroker.Create(Application); -{$ELSE} RPCBrokerV := TRPCBroker.Create(Application); - //RPCBrokerV := TSharedRPCBroker.Create(Application); -{$ENDIF} with RPCBrokerV do begin @@ -512,9 +503,16 @@ end; +function ShowRPCList: Boolean; +begin + if uShowRPCS then Result := True + else Result := False; +end; + + initialization RPCBrokerV := nil; RPCLastCall := 'No RPCs called'; uCallList := TList.Create; - uMaxCalls := 10; + uMaxCalls := 100; uShowRPCs := False; Index: cprs/trunk/CPRS-Lib/VA10.drc =================================================================== --- cprs/trunk/CPRS-Lib/VA10.drc (revision 829) +++ cprs/trunk/CPRS-Lib/VA10.drc (revision 1679) @@ -1,4 +1,4 @@ -/* VER140 - Generated by the Borland Delphi Pascal Compiler +/* VER185 + Generated by the CodeGear Delphi Pascal Compiler because -GD or --drc was supplied to the compiler. @@ -13,2 +13,4 @@ END +/* E:\Vista_30_28\OR_SRC_CREATION\CPRS-Lib\VA10.res */ +/* E:\Vista_30_28\OR_SRC_CREATION\CPRS-Lib\VA10.drf */