home *** CD-ROM | disk | FTP | other *** search
- {
- BUSINESS CONSULTING
- s a i n t - p e t e r s b u r g
-
- Components Library for Borland Delphi 4.x, 5.x
- Copyright (c) 1998-2001 Alex'EM
-
- }
- unit DCChoice;
-
- interface
- {$I DCConst.inc}
-
- uses
- Windows, SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, ImgList,
- {$IFDEF DELPHI_V6}
- Variants,
- {$ENDIF}
- Controls, Dialogs, Forms, StdCtrls, Buttons, ExtCtrls, ComCtrls, DB,
- DBTables, DCEditButton, DCEditTools, DCPopupWindow, DCCalendar, DCDBGrids,
- DCConst, DCCalculator, DCMaskTools;
-
- type
- TKillFocusEvent = procedure (Sender: TObject; var StayOnControl: boolean) of object;
- TCheckGridEvent = procedure (Sender: TObject; DataValue: string; DataType: TFieldType;
- var Exist: boolean; var KeyValue: variant) of object;
- TGetErrorHint = procedure (Sender: TObject; ErrorCode: integer; var ErrorHint: string) of object;
- TThreadEvent = procedure (Sender: TObject) of object;
- TTEInitTreeEvent = procedure (Sender: TObject; TreeView: TTreeView) of object;
- TGridAppendEvent = procedure (Sender: TObject; var KeyValue: variant; var Apply: boolean) of object;
-
- TDCCustomMaskEdit = class;
-
- TFloatDataType = class(TPersistent)
- private
- FEdit: TDCCustomMaskEdit;
- FKind: TEditDataType;
- FPrecision: integer;
- FDigits: integer;
- procedure SetDigits(const Value: integer);
- procedure SetKind(const Value: TEditDataType);
- procedure SetPrecision(const Value: integer);
- procedure UpdateMask;
- public
- constructor Create(AEdit: TDCCustomMaskEdit);
- procedure Assign(Source: TPersistent); override;
- published
- property Kind: TEditDataType read FKind write SetKind;
- property Precision: integer read FPrecision write SetPrecision;
- property Digits: integer read FDigits write SetDigits;
- end;
-
- TDCCustomEdit = class(TCustomEdit)
- private
- FCanEmpty: boolean;
- FErrorHint: string;
- FShowError: boolean;
- FOnKillFocus: TKillFocusEvent;
- FOnShowError: TNotifyEvent;
- FAlignment: TAlignment;
- FErrorCode: integer;
- FMouseActivate: boolean;
- FOnGetErrorHint: TGetErrorHint;
- FDBObject: TDCDBObject;
- FUpdateCount: integer;
- FChanged: boolean;
- FHookChanges: boolean;
- FData: Pointer;
- FOnCreateData: TNotifyEvent;
- FOnDestroyData: TNotifyEvent;
- FOnCloseUp: TNotifyEvent;
- procedure SetAlignment(Value: TAlignment);
- function GetDBObject: TDCDBObject;
- procedure SetDBObject(const Value: TDCDBObject);
- function CanModified: boolean; virtual;
- procedure SetData(const Value: Pointer);
- procedure CreateData;
- procedure DestroyData;
- protected
- procedure GetHintOnError; virtual;
- procedure SetEditRect; virtual;
- procedure CreateParams(var Params: TCreateParams); override;
- procedure CreateWnd; override;
- procedure Change; override;
- procedure DoShowError(AErrorWindow: TDCMessageWindow); virtual;
- function GetHintTimeOut: integer; virtual;
- procedure CloseUp(State: Byte; bPerform: boolean = False); virtual;
- procedure WMMouseActivate(var Message: TWMActivate); message WM_MOUSEACTIVATE;
- procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
- procedure CMErrorMessage(var Message: TMessage); message CM_ERRORMESSAGE;
- procedure CMExit(var Message: TCMExit); message CM_EXIT;
- procedure DoCloseUp; virtual;
- property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
- property CanEmpty: boolean read FCanEmpty write FCanEmpty default True;
- property OnKillFocus: TKillFocusEvent read FOnKillFocus write FOnKillFocus;
- property OnShowError: TNotifyEvent read FOnShowError write FOnShowError;
- property OnGetErrorHint: TGetErrorHint read FOnGetErrorHint write FOnGetErrorHint;
- property DBObject: TDCDBObject read GetDBObject write SetDBObject;
- property OnCloseUp: TNotifyEvent read FonCloseUp write FOnCloseUp;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure KeyPress(var Key: Char);override;
- function ValueCorrect: boolean;
- procedure Deselect;
- procedure KillFocus(var Value: boolean); dynamic;
- procedure ShowErrorMessage;
- procedure HideErrorMessage;
- procedure BeginUpdate(HookChanges: boolean = True); virtual;
- procedure EndUpdate; virtual;
- property ShowError: boolean read FShowError write FShowError;
- property ErrorCode: integer read FErrorCode write FErrorCode;
- property ErrorHint: string read FErrorHint write FErrorHint;
- property Data: Pointer read FData write SetData;
- property OnCreateData: TNotifyEvent read FOnCreateData write FOnCreateData;
- property OnDestroyData: TNotifyEvent read FOnDestroyData write FOnDestroyData;
- end;
-
- TDCCustomMaskEdit = class(TDCCustomEdit)
- private
- FEditMask: string;
- FMaskStruct: TEditMask;
- procedure SetEditMask(const Value: string);
- procedure SetSel(SelStart: Integer; SelEnd: Integer);
- procedure DeleteKey(Key: Word);
- procedure InsertString(Insert: string);
- procedure CompleteChars;
- protected
- function IsMasked: boolean; virtual;
- property EditMask: string read FEditMask write SetEditMask;
- procedure WMCut(var Message: TMessage); message WM_CUT;
- procedure WMPaste(var Message: TMessage); message WM_PASTE;
- procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
- function MaskMatched: boolean;
- procedure GetHintOnError; override;
- function GetHintTimeOut: integer; override;
- procedure EditMaskChanged; virtual;
- public
- destructor Destroy; override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
- procedure KillFocus(var Value: boolean); override;
- end;
-
- TDCEdit = class(TDCCustomMaskEdit)
- published
- property PasswordChar;
- property Anchors;
- property AutoSelect;
- property AutoSize;
- property BiDiMode;
- property CharCase;
- property Color;
- property Constraints;
- property Ctl3D;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- property HideSelection;
- property ImeMode;
- property ImeName;
- property MaxLength;
- property OEMConvert;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ReadOnly;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Text;
- property Visible;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
- property Alignment;
- property CanEmpty;
- property OnKillFocus;
- property OnShowError;
- property OnGetErrorHint;
- property DBObject;
- property EditMask;
- end;
-
- TDCParentEdit = class(TDCCustomMaskEdit)
- published
- property Anchors;
- property AutoSelect;
- property AutoSize;
- property BiDiMode;
- property CharCase;
- property Color;
- property Constraints;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- property HideSelection;
- property ImeMode;
- property ImeName;
- property MaxLength;
- property OEMConvert;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Text;
- property Visible;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
- property Alignment;
- property CanEmpty;
- property OnKillFocus;
- property OnShowError;
- property OnGetErrorHint;
- property DBObject;
- end;
-
- TDCCustomChoiceEdit = class(TDCParentEdit)
- private
- FBtnChoice: TDCEditButton;
- FBtnChoiceStyle: TChoiceBtnStyle;
- FOnButtonClick: TNotifyEvent;
- FButtonExist: Boolean;
- FMouseDown: Boolean;
- FCheckWidth: integer;
- FDrawStyle: TControlStyle;
- FMouseInControl: boolean;
- FChoiceButtonWidth: integer;
- FCheckGlyph: TBitmap;
- FCheckTag: integer;
- FInCheckArea: boolean;
- FOnCheckClick: TNotifyEvent;
- FInButtonArea: boolean;
- FImage: TBitmap;
- FShowCheckBox: boolean;
- FHintShow: boolean;
- FDisableButtons: boolean;
- FLinkControl: TWinControl;
- FMargins: TRect;
- FMultiLine: boolean;
- FPerformCloseUp: boolean;
- FWordWrap: boolean;
- procedure SetBtnChoiceStyle(Value: TChoiceBtnStyle);
- procedure SetCanChoice (Value: Boolean); virtual;
- procedure SetGlyph(Value: TBitmap);
- procedure SetStyle(Value: TControlStyle);
- procedure UpdateMouseInControl(Value: boolean);
- procedure SetChoiceButtonWidth(Value: integer);
- function GetButtonStyle: TEventStyle;
- procedure SetButtonStyle(Value: TEventStyle);
- function GetButtonState: TButtonState;
- procedure SetButtonState(Value: TButtonState);
- procedure SetCheckGlyph(Value: TBitmap);
- procedure SetButtonEnabled(Value: boolean);
- function GetButtonEnabled: boolean;
- function UpdateButtonsOnClick(X, Y: integer): boolean;
- procedure SetShowCheckBox(Value: boolean);
- procedure SetDisableButtons(const Value: boolean);
- procedure SetCaret;
- procedure SetLinkControl(const Value: TWinControl);
- function GetButtonWidth: integer;
- function IsGlyphStored: boolean;
- function IsButtonWidthStored: boolean;
- function CanModified: boolean; override;
- procedure SetWordWrap(const Value: Boolean);
- protected
- procedure AdjustClientRect(var Rect: TRect); override;
- function BtnChoiceAssigned: boolean;
- procedure CheckClick(Sender:TObject); virtual;
- procedure ChoiceButtonDown;
- procedure CloseUp(State: Byte; bPerform: boolean = False); override;
- procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
- procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
- procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
- procedure CMExit(var Message: TCMExit); message CM_EXIT;
- procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
- procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
- procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
- procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
- procedure CreateWnd; override;
- procedure DefineBtnChoice(BtnStyle: TChoiceBtnStyle);
- procedure DefineBtnChoiceStyle; virtual;
- procedure DoDrawMargins(DC: HDC); virtual;
- function DropDownWindow(Message: TWMKillFocus): boolean; virtual;
- procedure EMSetReadOnly(var Message: TMessage); message EM_SETREADONLY;
- function GetDropDownVisible: boolean; virtual;
- function GetGlyph: TBitmap;
- procedure Loaded; override;
- function MinControlWidthBitmap: integer; virtual;
- procedure MouseUp(Button: TMouseButton; ShiftState: TShiftState; X, Y: Integer); override;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- function PaintCheckGlyph: boolean; virtual;
- procedure PaintWindow(DC: HDC); override;
- procedure RedrawBorder(DrawBorder: boolean; Clip: HRGN); virtual;
- procedure SetEditRect; override;
- procedure SetMargins(var LeftMargin: integer; var RightMargin: integer); virtual;
- procedure SetParent(AParent: TWinControl); override;
- procedure ShowDropDown; virtual;
- procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
- procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
- procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
- procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
- procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
- procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
- procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
- procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
- procedure WMSize(var message: TWMSize); message WM_SIZE;
- procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
- procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
- procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
- procedure WndProc(var Message: TMessage); override;
-
- property ButtonChoiceStyle: TChoiceBtnStyle read FBtnChoiceStyle
- write SetBtnChoiceStyle default btsForm;
- property ButtonEnabled: boolean read GetButtonEnabled write SetButtonEnabled;
- property ButtonExist: Boolean read FButtonExist write SetCanChoice default True;
- property ButtonStyle: TEventStyle read GetButtonStyle write SetButtonStyle default esNormal;
- property ButtonState: TButtonState read GetButtonState write SetButtonState;
- property ButtonChoice: TDCEditButton read FBtnChoice write FBtnChoice;
- property CheckGlyph: TBitmap read FCheckGlyph write SetCheckGlyph;
- property CheckTag: integer read FCheckTag write FCheckTag default 0;
- property Glyph: TBitmap read GetGlyph write SetGlyph stored IsGlyphStored;
- property MultiLine: boolean read FMultiLine write FMultiLine default False;
- property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
- property PerformCloseUp: boolean read FPerformCloseUp write FPerformCloseUp;
- property ShowCheckBox: boolean read FShowCheckBox write SetShowCheckBox;
- property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
- public
- procedure ChoiceClick(Sender:TObject); virtual;
- constructor Create(AOwner: TComponent); override;
- procedure CreateParams(var Params: TCreateParams); override;
- destructor Destroy; override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char);override;
- procedure KillFocus(var Value: boolean); override;
- property ButtonWidth: integer read GetButtonWidth;
- property DisableButtons: boolean read FDisableButtons write SetDisableButtons;
- property DropDownVisible: boolean read GetDropDownVisible;
- published
- property LinkControl: TWinControl read FLinkControl write SetLinkControl;
- property DrawStyle: TControlStyle read FDrawStyle write SetStyle default fcsNormal;
- property ChoiceButtonWidth: integer read FChoiceButtonWidth write SetChoiceButtonWidth
- stored IsButtonWidthStored default DEFAULT_BTN_WIDTH;
- property OnCheckClick: TNotifyEvent read FOnCheckClick write FOnCheckClick;
- property ReadOnly;
- end;
-
- TDCChoiceEdit = class(TDCCustomChoiceEdit)
- public
- property CheckTag;
- property ButtonEnabled;
- published
- property MultiLine;
- property ButtonChoiceStyle;
- property Glyph;
- property ButtonExist;
- property DrawStyle;
- property ButtonStyle;
- property CheckGlyph;
- property OnButtonClick;
- property EditMask;
- property WordWrap;
- end;
-
- TDCCustomDateEdit = class(TDCCustomChoiceEdit)
- private
- FCalendar: TDCCustomCalendar;
- FCalendarVisible: boolean;
- FChecked: boolean;
- FFontColor: integer;
- FDateText: string;
- FUndoDate: TDateTime;
- FStartPos: integer;
- FEndPos: integer;
- FOnChecked: TNotifyEvent;
- FKind: TDateEditKind;
- FShowWeekDay: boolean;
- FReadOnly: boolean;
- FInCheckProc: boolean;
- procedure GetDateText;
- procedure SetDateText;
- procedure SetText(var Key: char);
- procedure DeleteChar(DeleteType: TDeleteType);
- procedure SetChecked(Value: boolean);
- procedure SetShowCheckBox(Value: boolean);
- function GetShowCheckBox: boolean;
- function GetDate: TDateTime;
- procedure SetDate(const Value: TDateTime);
- procedure SetKind(const Value: TDateEditKind);
- procedure SetFontColor(Value: TColor);
- procedure SetUndoDate(const Value: TDateTime);
- procedure SetShowWeekDay(const Value: boolean);
- function GetEmpty: boolean;
- procedure SetCheckGlyph;
- protected
- procedure SetMargins(var LeftMargin: integer; var RightMargin: integer); override;
- procedure CloseUp(State: Byte; bPerform: boolean = False); override;
- procedure GetHintOnError; override;
- procedure Loaded; override;
- function GetDropDownVisible: boolean; override;
- procedure DefineBtnChoiceStyle; override;
- procedure DoDrawMargins(DC: HDC); override;
- procedure EMSetReadOnly(var Message: TMessage); message EM_SETREADONLY;
- procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
- procedure CMExit(var Message: TCMExit); message CM_EXIT;
- procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
- procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
- procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
- function IsMasked: boolean; override;
- procedure ShowDropDown; override;
-
- property ShowCheckBox: boolean read GetShowCheckBox write SetShowCheckBox default False;
- property Checked: boolean read FChecked write SetChecked;
- property Date: TDateTime read GetDate write SetDate;
- property OnChecked: TNotifyevent read FOnChecked write FOnChecked;
- property Kind: TDateEditKind read FKind write SetKind;
- property UndoDate: TDateTime read FUndoDate write SetUndoDate;
- property ShowWeekDay: boolean read FShowWeekDay write SetShowWeekDay;
- public
- constructor Create(AOwner: TComponent); override;
- procedure KeyPress(var Key: Char);override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KillFocus(var Value: boolean); override;
- procedure CheckClick(Sender:TObject); override;
- procedure ChoiceClick(Sender:TObject); override;
- property Empty: boolean read GetEmpty;
- property PerformCloseUp;
- end;
-
- TDCDateEdit = class(TDCCustomDateEdit)
- public
- property ButtonEnabled;
- property UndoDate;
- published
- property DrawStyle;
- property ReadOnly;
- property ShowCheckBox;
- property Checked;
- property ButtonExist;
- property Date;
- property Kind;
- property ShowWeekDay;
- property OnChecked;
- end;
-
- TDCCustomFloatEdit = class(TDCCustomChoiceEdit)
- private
- FCalculator: TDCCustomCalculator;
- FCalculatorVisible: boolean;
- FDataType: TFloatDataType;
- FMasked: boolean;
- function GetValue: Extended;
- function GetEditValue(EditText: string): string;
- procedure SetValue(const Value: Extended);
- procedure SetDataType(const Value: TFloatDataType);
- protected
- procedure CloseUp(State: Byte; bPerform: boolean = False); override;
- procedure GetHintOnError; override;
- function GetDropDownVisible: boolean; override;
- procedure DefineBtnChoiceStyle; override;
- procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
- procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
- function IsMasked: boolean; override;
- procedure ShowDropDown; override;
- procedure EditMaskChanged; override;
- property DataType: TFloatDataType read FDataType write SetDataType;
- property Value: Extended read GetValue write SetValue;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure KeyPress(var Key: Char);override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KillFocus(var Value: boolean); override;
- procedure ChoiceClick(Sender:TObject); override;
- property PerformCloseUp;
- published
- property Masked: boolean read FMasked write FMasked;
- end;
-
- TDCFloatEdit = class(TDCCustomFloatEdit)
- public
- property ButtonEnabled;
- published
- property DrawStyle;
- property ReadOnly;
- property ButtonExist;
- property DataType;
- property Value;
- end;
-
- TDrawBitmapEvent = procedure(Control: TWinControl; R: TRect; Index: Integer;
- Bitmap: TBitmap) of object;
- TDCDrawItemEvent = procedure(ACanvas: TCanvas; Control: TWinControl; Index: Integer;
- Rect: TRect; State: TOwnerDrawState) of object;
-
- TDCCustomComboBox = class(TDCCustomChoiceEdit)
- private
- FListBox: TDCPopupListBox;
- FListBoxVisible: boolean;
- FStyle: TComboBoxStyle;
- FItems: TStrings;
- FOnDrawItem: TDrawItemEvent;
- FOnDrawText: TDCDrawItemEvent;
- FOnMeasureItem:TMeasureItemEvent;
- FItemHeight: integer;
- FLastText: string;
- FLastIndex: integer;
- FOnDrawBitmap: TDrawBitmapEvent;
- FItemIndex: integer;
- FOnIndexChange: TNotifyEvent;
- FDropDownWidth: integer;
- FEditing: boolean;
- FOnDropDown: TNotifyEvent;
- FDropDownCount: integer;
- FCachedIndex: integer;
- FCachedText: string;
- procedure SetComboBoxStyle(Value: TComboBoxStyle);
- procedure SetItems(Value: TStrings);
- function GetFirstEntry(PartWord: boolean ): integer;
- procedure SetText(Value: string; ItemIndex: integer; ASelStart, ASelLen: integer);
- procedure SetItemIndex(Value: integer);
- procedure GetEntryText;
- procedure PaintListItem(bFocused: boolean);
- function NotEditControl: boolean;
- procedure FindNextItem(cFirstChar: char);
- procedure SetEditing(const Value: boolean);
- protected
- procedure CloseUp(State: Byte; bPerform: boolean = False); override;
- procedure GetHintOnError; override;
- function MinControlWidthBitmap: integer; override;
- procedure DrawBitmap(Index: integer); virtual;
- function GetDropDownVisible: boolean; override;
- function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
- MousePos: TPoint): Boolean; override;
- procedure EMGetSel(var Message: TMessage); message EM_GETSEL;
- procedure WMChar(var Message: TWMChar); message WM_CHAR;
- procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
- procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
- procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
- procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
- procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
- procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
- procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
- procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
- procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
- procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
- procedure ListMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- function GetCanvas: TCanvas;
- procedure CheckClick(Sender:TObject); override;
- procedure WndProc(var Message: TMessage); override;
- procedure DropDown; dynamic;
- procedure DefineBtnChoiceStyle; override;
- procedure ShowDropDown; override;
- property Style: TComboBoxStyle read FStyle write SetComboBoxStyle;
- property Items: TStrings read FItems write SetItems;
- property ItemHeight: integer read FItemHeight write FItemHeight;
- property OnDrawBitmap: TDrawBitmapEvent read FOnDrawBitmap write FOnDrawBitmap;
- property OnIndexChange: TNotifyEvent read FOnIndexChange write FOnIndexChange;
- property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
- property OnDrawText: TDCDrawItemEvent read FOnDrawText write FOnDrawText;
- property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
- property DropDownWidth: integer read FDropDownWidth write FDropDownWidth default 0;
- property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
- property DropDownCount: Integer read FDropDownCount write FDropDownCount default 8;
- procedure CreateWnd; override;
- public
- procedure CreateParams(var Params: TCreateParams); override;
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char);override;
- procedure KillFocus(var Value: boolean); override;
- procedure Clear; override;
- procedure ChoiceClick(Sender:TObject); override;
- property ItemIndex: integer read FItemIndex write SetItemIndex;
- property Canvas: TCanvas read GetCanvas;
- property Editing: boolean read FEditing write SetEditing;
- property PerformCloseUp;
- end;
-
- TDCComboBox = class(TDCCustomComboBox)
- public
- property ButtonEnabled;
- published
- property Alignment;
- property DrawStyle;
- property CheckGlyph;
- property CheckTag;
- property Items;
- property ItemHeight;
- property OnDrawBitmap;
- property OnIndexChange;
- property DropDownWidth default 0;
- property OnDrawItem;
- property OnDrawText;
- property OnMeasureItem;
- property Style;
- property ShowCheckBox;
- property ReadOnly;
- property OnDropDown;
- property DropDownCount;
- property EditMask;
- property OnCloseUp;
- end;
-
- TThreadMode =(tmFind, tmStop, tmIdle);
- TGridEditThread = class;
- TDCCustomGridEdit = class;
-
- TGridValue = class(TCollectionItem)
- private
- FFieldName: string;
- FValue: variant;
- FFieldType: TFieldType;
- function GetAsString: string;
- procedure SetAsString(Value: string);
- public
- constructor Create(AOwner: TCollection); override;
- property FieldName: string read FFieldName write FFieldName;
- property Value: variant read FValue write FValue;
- property FieldType: TFieldType read FFieldType write FFieldType;
- property AsString: string read GetAsString write SetAsString;
- end;
-
- TGridValues = class(TCollection)
- private
- FLoaded: boolean;
- FIndex: integer;
- function GetItem(Field: string): TGridValue;
- procedure SetItem(Field: string; Value: TGridValue);
- public
- constructor Create(AOwner: TComponent);
- function Add: TGridValue;
- property Fields[Field: string]: TGridValue read GetItem write SetItem;
- end;
-
- TGetGridEvent = procedure (Sender: TObject; KeyValue: string; DataType: TFieldType;
- var Exist: boolean; GridValues: TGridValues) of object;
-
- TDCCustomGridEdit = class(TDCCustomChoiceEdit)
- private
- FGrid: TDCPopupDBGrid;
- FGridVisible: boolean;
- FColumns: TDBGridColumns;
- FDataSet: TDataSet;
- FImages: TImageList;
- FImageChangeLink: TChangeLink;
- FDropDownWidth: integer;
- FValues: TGridValues;
- FKeyField: string;
- FKeyValue: variant;
- FDataField: string;
- FCloseDataSet: boolean;
- FThreadInUse: boolean;
- GridEditThread: TGridEditThread;
- FOnValueChange: TNotifyEvent;
- FOnCheckDataValue: TCheckGridEvent;
- FOnGetDataValue: TGetGridEvent;
- FDataValueSelected: boolean;
- FPopupFindEnabled: boolean;
- FListBox: TDCPopupListBox;
- FListBoxVisible: boolean;
- FListBoxEnabled: boolean;
- FListBoxColumns: TDBGridColumns;
- FListBoxWidth: integer;
- FThreadMode: TThreadMode;
- FOnThreadStart: TThreadEvent;
- FOnThreadStop : TThreadEvent;
- FPaintBox: integer;
- FOnGridTitleClick: TDBGridClickEvent;
- FQuery: TDataSet;
- FQueryDataSet: boolean;
- FSQLText: string;
- FSQLDataField: string;
- FSQLKeyField: string;
- FSQLOrderBy: string;
- FFullQuery: boolean;
- FInfoField: string;
- FInfoFieldWidth: integer;
- FOnDrawInfoText: TDrawInfoText;
- FCanAppend: boolean;
- FValueChanged: boolean;
- FSingleClickToSelect: boolean;
- FColumnsOrder: TStringList;
- FOnAppendRecord: TGridAppendEvent;
- FNeedLocate: boolean;
- FShowInfoHint: boolean;
- FInHintInfo: boolean;
- FInfoHintWindow: TDCMessageWindow;
- procedure ListBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
- State: TOwnerDrawState);
- procedure ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-
- procedure SetKeyValue(const Value: variant);
- procedure SetKeyValueEx(Value: variant; NeedLocate: boolean = True);
- procedure SetDataSet(const Value: TDataSet);
- procedure LocateDataSet;
- function FieldExists(Value: string): boolean;
- function CheckDataValue: boolean;
- procedure GridDblClick(Sender: TObject);
- procedure GridCellClick(Columns: TColumn);
- procedure GetEntryText;
- procedure ClearValue(ClearText: boolean);
- procedure BeginPaintListBox;
- procedure EndPaintListBox;
- procedure GridTitleClick(Column: TColumn); virtual;
- function GetSQLText: string;
- procedure SetSQLText(const Value: string);
- procedure SetListBoxEnabled(const Value: boolean);
- procedure SetDataValues(ADataSet: TDataSet);
- procedure SetDataField(const Value: string);
- procedure SetKeyField(const Value: string);
- procedure SetSQLDataField(const Value: string);
- procedure SetSQLKeyField(const Value: string);
- procedure SetInfoField(const Value: string);
- procedure SetInfoFieldWidth(const Value: integer);
- function ExistInfo: boolean;
- procedure SetCanAppend(const Value: boolean);
- procedure SetQueryDataSet(const Value: boolean);
- function ActivateDataSet: boolean;
- procedure CloseDataSet;
- function GetGridOrderBy: string;
- procedure InitColumnsOrder;
- procedure ImageListChange(Sender: TObject);
- function GetInfoRect: TRect;
- procedure ShowInfoHint;
- procedure HideInfoHint;
- procedure SendControlMessage(Message, WParam, LParam: integer);
- procedure SetImages(const Value: TImageList);
- protected
- procedure SetSQLTextPermanet(const Value: string);
- procedure SetInternalDataSet(const Value: TDataSet;
- var DataSet: TDataSet); virtual; abstract;
- procedure SetInternalSQLText(const Value: string; var SQLText: string); virtual; abstract;
- function SetGridValues: boolean;
- procedure CloseUp(State: Byte; bPerform: boolean = False); override;
- procedure WndProc(var Message: TMessage); override;
- procedure GetHintOnError; override;
- procedure Loaded; override;
- function GetDropDownVisible: boolean; override;
- function CreateQuery: TDataSet; virtual; abstract;
- procedure DoInitQuery(Mode: integer); virtual; abstract;
- procedure OpenQuery(Mode: integer);
- function GetPreparedQueryText(Mode: integer; SQLText: string): string;
- function GetQueryText: string ; virtual; abstract;
- procedure PrepareDataSet; virtual; abstract;
- procedure KeyValueChanged; virtual;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
- function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
- procedure WMChar(var Message: TWMChar); message WM_CHAR;
- procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
- procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
- procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
- procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
- procedure CMExit(var Message: TCMExit); message CM_EXIT;
- procedure CMThreadStart(var Message: TMessage); message CM_THREAD_START;
- procedure CMThreadTerminate(var Message: TMessage); message CM_THREAD_TERMINATE;
- procedure CMThreadItemClr(var Message: TMessage); message CM_THREAD_ITEMCLR;
- procedure CMThreadItemAdd(var Message: TMessage); message CM_THREAD_ITEMADD;
- procedure CMThreadShowBox(var Message: TMessage); message CM_THREAD_SHOWBOX;
- procedure CMThreadHideBox(var Message: TMessage); message CM_THREAD_HIDEBOX;
- procedure CMThreadLocated(var Message: TMessage); message CM_THREAD_LOCATED;
- procedure CMThreadFindCmplt(var Message: TMessage); message CM_THREAD_FINDCMPLT;
- procedure CMThreadFreeBox(var Message: TMessage); message CM_THREAD_FREEBOX;
- procedure CMThreadError(var Message: TMessage); message CM_THREAD_ERROR;
- procedure CMThreadSetMode(var Message: TMessage); message CM_THREAD_SETMODE;
- procedure CMThreadStop(var Message: TMessage); message CM_THREAD_STOP;
- procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
- procedure CMPopupHintInfo(var Message: TMessage); message CM_POPUPHINTINFO;
- procedure CMAppendrecord(var Message: TMessage); message CM_APPENDRECORD;
- procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
- procedure WaitForThreadTerminate(Count: DWORD = 10);
- procedure DoGridTitleClick(IndexChanged: boolean; Column: TColumn); virtual;
- procedure DefineBtnChoiceStyle; override;
- procedure SetMargins(var LeftMargin: integer; var RightMargin: integer); override;
- function FullQuery: boolean;
- procedure ShowDropDown; override;
- property Query: TDataSet read FQuery;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char);override;
- property Values: TGridValues read FValues write FValues;
- property KeyValue: variant read FKeyValue write SetKeyValue;
- procedure KillFocus(var Value: boolean); override;
- procedure ChoiceClick(Sender:TObject); override;
- procedure DoDrawMargins(DC: HDC); override;
- procedure AppendRecord;
- procedure BeginUpdate(HookChanges: boolean = True); override;
- procedure EndUpdate; override;
- procedure ValidateValue;
- property PerformCloseUp;
- procedure LocateFirstValue;
- property ColumnsOrder: TStringList read FColumnsOrder;
- published
- property Columns: TDBGridColumns read FColumns write FColumns;
- property DataSet: TDataSet read FDataSet write SetDataSet;
- property Images: TImageList read FImages write SetImages;
- property DropDownWidth: integer read FDropDownWidth write FDropDownWidth default 0;
- property KeyField: string read FKeyField write SetKeyField;
- property DataField: string read FDataField write SetDataField;
- property OnValueChange: TNotifyEvent read FOnValueChange write FOnValueChange;
- property OnCheckDataValue: TCheckGridEvent read FOnCheckDataValue write FOnCheckDataValue;
- property OnGetDataValue: TGetGridEvent read FOnGetDataValue write FOnGetDataValue;
- property ListBoxEnabled: boolean read FListBoxEnabled write SetListBoxEnabled default False;
- property ListBoxColumns: TDBGridColumns read FListBoxColumns write FListBoxColumns;
- property OnThreadStart: TThreadEvent read FOnThreadStart write FOnThreadStart;
- property OnThreadStop : TThreadEvent read FOnThreadStop write FOnThreadStop;
- property OnGridTitleClick: TDBGridClickEvent read FOnGridTitleClick write FOnGridTitleClick;
- property ListBoxWidth: integer read FListBoxWidth write FListBoxWidth default 0;
- property SQLText: string read GetSQLText write SetSQLText;
- property SQLDataField: string read FSQLDataField write SetSQLDataField;
- property SQLKeyField: string read FSQLKeyField write SetSQLKeyField;
- property SQLOrderBy:string read FSQLOrderBy write FSQLOrderBy;
- property InfoField: string read FInfoField write SetInfoField;
- property InfoFieldWidth: integer read FInfoFieldWidth write SetInfoFieldWidth;
- property OnDrawInfoText: TDrawInfoText read FOnDrawInfoText write FOnDrawInfoText;
- property CanAppend: boolean read FCanAppend write SetCanAppend default False;
- property QueryDataSet: boolean read FQueryDataSet write SetQueryDataSet;
- property SingleClickToSelect: boolean read FSingleClickToSelect write FSingleClickToSelect;
- property OnAppendRecord: TGridAppendEvent read FOnAppendRecord write FOnAppendRecord;
- end;
-
- TDCBDEGridEdit = class(TDCCustomGridEdit)
- private
- function GetDatabaseName: string;
- function GetParams: TParams;
- procedure SetDatabaseName(const Value: string);
- procedure SetParams(const Value: TParams);
- protected
- function CreateQuery: TDataSet; override;
- function GetQueryText: string; override;
- procedure DoInitQuery(Mode: integer); override;
- procedure PrepareDataSet; override;
- procedure SetInternalDataSet(const Value: TDataSet;
- var DataSet: TDataSet); override;
- procedure SetInternalSQLText(const Value: string; var SQLText: string); override;
- public
- property ButtonEnabled;
- published
- property DrawStyle;
- property CheckGlyph;
- property CheckTag;
- property ReadOnly;
- property DatabaseName: string read GetDatabaseName write SetDatabaseName;
- property Params: TParams read GetParams write SetParams;
- property EditMask;
- end;
-
- TDCGridEdit = class(TDCBDEGridEdit)
- end;
-
- TGridEditThread = class(TThread)
- FGridEdit: TDCCustomGridEdit;
- FMode: TThreadMode;
- FFindValue: string;
- FStoped: boolean;
- private
- procedure SetFindValue(const Value: string);
- procedure FindDataSet;
- procedure AddValue;
- protected
- procedure Execute; override;
- public
- property FindValue: string read FFindValue write SetFindValue;
- property Mode: TThreadMode read FMode;
- constructor Create(GridEdit: TDCCustomGridEdit; Mode: TThreadMode);
- end;
-
- TTreeGetTextEvent = procedure (Sender: TObject; Node: TTreeNode;
- var AText: string) of object;
- TTreeClearIteamEvent = procedure (Sender: TObject; TreeView: TTreeView) of object;
- TTreeSelectNodeEvent = procedure (Sender: TObject; Node: TTreeNode; var AllowSelect: boolean) of object;
-
- TDCCustomTreeEdit = class(TDCCustomChoiceEdit)
- private
- FTreeView: TDCPopupTreeView;
- FTreeVisible: boolean;
- FDropDownWidth: integer;
- FImages: TImageList;
- FImageChangeLink: TChangeLink;
- FOnChange: TTVChangedEvent;
- FOnInitTree: TTEInitTreeEvent;
- FOnCollapsed: TTVExpandedEvent;
- FOnExpanded: TTVExpandedEvent;
- FOnCollapsing: TTVExpandingEvent;
- FOnExpanding: TTVExpandingEvent;
- FOnSetText: TNotifyEvent;
- FOnGetText: TTreeGetTextEvent;
- FTreeInitialized: boolean;
- FOnDrawText: TDCDrawItemEvent;
- FStyle: TTreeEditStyle;
- FNodeSelected: boolean;
- FOnCustomDrawItem: TTVCustomDrawItemEvent;
- FOnClearItems: TTreeClearIteamEvent;
- FOnSelectNode: TTreeSelectNodeEvent;
- function GetSelected: TTreeNode;
- procedure SetSelected(const Value: TTreeNode);
- procedure SetTreeView(const Value: TTreeView);
- procedure PaintListItem(bFocused: boolean);
- procedure SetStyle(const Value: TTreeEditStyle);
- procedure ImageListChange(Sender: TObject);
- procedure SetImages(const Value: TImageList);
- protected
- procedure Loaded; override;
- procedure GetHintOnError; override;
- procedure Change; override;
- function GetDropDownVisible: boolean; override;
- procedure Expanded(Sender: TObject; Node: TTreeNode); virtual;
- procedure Expanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); virtual;
- procedure Collapsed(Sender: TObject; Node: TTreeNode); virtual;
- procedure Collapsing(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); virtual;
- procedure CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode;
- State: TCustomDrawState; var DefaultDraw: Boolean); virtual;
- procedure WndProc(var Message: TMessage); override;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- procedure EMGetSel(var Message: TMessage); message EM_GETSEL;
- procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
- procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
- procedure WMPaint (var Message: TWMPaint); message WM_PAINT;
- procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
- procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
- procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
- procedure WMChar(var Message: TWMChar); message WM_CHAR;
- procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
- procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
- procedure CMExit(var Message: TCMExit); message CM_EXIT;
- procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
- procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
- function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
- function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
- function CanSelectNode(Node: TTreeNode): boolean; virtual;
- procedure TreeViewDblClick(Sender: TObject); virtual;
- procedure TreeViewKeyPress(Sender: TObject; var Key: Char); virtual;
- procedure DefineBtnChoiceStyle; override;
- function GetTreeView: TTreeView;
- procedure SetText(Value: string); virtual;
- procedure ClearTreeItems; virtual;
- procedure CloseUp(State: Byte; bPerform: boolean = False); override;
- procedure ShowDropDown; override;
- property OnDrawText: TDCDrawItemEvent read FOnDrawText write FOnDrawText;
- property Images: TImageList read FImages write SetImages;
- property Style: TTreeEditStyle read FStyle write SetStyle default teDropDownList;
- property OnClearItems: TTreeClearIteamEvent read FOnClearItems write FOnClearItems;
- public
- procedure CreateParams(var Params: TCreateParams); override;
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure ChoiceClick(Sender:TObject); override;
- procedure InitTree; virtual;
- procedure ChangeSelected(Sender: TObject; Node: TTreeNode); virtual;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char);override;
- procedure KillFocus(var Value: boolean); override;
- function GetNode(Value: string; var Node: TTreeNode; var ErrorCode: integer): boolean; virtual;
- property TreeView: TTreeView read GetTreeView write SetTreeView;
- property Selected: TTreeNode read GetSelected write SetSelected;
- property PerformCloseUp;
- property TreeInitialized: boolean read FTreeInitialized;
- published
- property DropDownWidth: integer read FDropDownWidth write FDropDownWidth default 0;
- property OnChange: TTVChangedEvent read FOnChange write FOnChange;
- property OnInitTree: TTEInitTreeEvent read FOnInitTree write FOnInitTree;
- property OnCollapsed: TTVExpandedEvent read FOnCollapsed write FOnCollapsed;
- property OnExpanded: TTVExpandedEvent read FOnExpanded write FOnExpanded;
- property OnCollapsing: TTVExpandingEvent read FOnCollapsing write FOnCollapsing;
- property OnExpanding: TTVExpandingEvent read FOnExpanding write FOnExpanding;
- property OnSetText: TNotifyEvent read FOnSetText write FOnSetText;
- property OnGetText: TTreeGetTextEvent read FOnGetText write FOnGetText;
- property OnCustomDrawItem: TTVCustomDrawItemEvent read FOnCustomDrawItem write FOnCustomDrawItem;
- property OnSelectNode: TTreeSelectNodeEvent read FOnSelectNode write FOnSelectNode;
- end;
-
- TDCTreeEdit = class(TDCCustomTreeEdit)
- public
- property ButtonEnabled;
- published
- property DrawStyle;
- property CheckGlyph;
- property OnDrawText;
- property ReadOnly;
- property Images;
- property Style;
- property OnClearItems;
- property EditMask;
- end;
-
- TCustomEditForm = class(TCustomForm)
- {}
- end;
-
- TCreateEditFormEvent = procedure (Sender:TObject; var EditForm: TCustomForm) of object;
- TDCCustomFormEdit = class(TDCCustomChoiceEdit)
- private
- FEditForm: TCustomForm;
- FOnCreateEditForm: TCreateEditFormEvent;
- FEFNewWndProc, FPFNewWndProc: Pointer;
- FEFDefWndProc, FPFDefWndProc: Pointer;
- FInfoFieldWidth: integer;
- FOnDrawInfoText: TDrawInfoText;
- procedure EFWndProc(var Message: TMessage);
- procedure PFWndProc(var Message: TMessage);
- procedure SetInfoFieldWidth(const Value: integer);
- function ExistInfo: boolean;
- protected
- function CreateEditForm(var EditForm: TCustomForm): boolean; virtual;
- function GetDropDownVisible: boolean; override;
- procedure CloseUp(State: Byte; bPerform: boolean = False); override;
- procedure GetFormResult(AEditForm: TCustomForm); virtual;
- procedure InitEditFromParams(AEditForm: TCustomForm); virtual;
- procedure DefineBtnChoiceStyle; override;
- procedure SetMargins(var LeftMargin: integer; var RightMargin: integer); override;
- function DropDownWindow(Message: TWMKillFocus): boolean; override;
- procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
- procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
- procedure DoDrawMargins(DC: HDC); override;
- procedure WndProcAction(Action: integer);
- procedure ShowDropDown; override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure ChoiceClick(Sender:TObject); override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char);override;
- published
- property OnCreateEditForm: TCreateEditFormEvent read FOnCreateEditForm write FOnCreateEditForm;
- property InfoFieldWidth: integer read FInfoFieldWidth write SetInfoFieldWidth;
- property OnDrawInfoText: TDrawInfoText read FOnDrawInfoText write FOnDrawInfoText;
- end;
-
- implementation
- uses DCResource, Clipbrd;
-
- type
- TPrivateWinControl = class(TWinControl)
- end;
-
- const
- MIN_CMPSTR_LENGTH = 3;
-
- Digits: TCharSet = ['0'..'9'];
- SetDateEdit: TCharSet = ['0'..'9', #8, #13, #9];
-
- var
- ErrorHook: HHOOK;
- ErrorWindow: TDCMessageWindow;
- ErrorControl: TWinControl;
- TempBitmap: TBitmap;
-
- function ErrorGetMsgHook(nCode: Integer; wParam: Longint; var Msg: TMsg): Longint; stdcall;
- begin
- Result := CallNextHookEx(ErrorHook, nCode, wParam, Longint(@Msg));
- if (nCode >= 0) and (Application <> nil) and (ErrorWindow <> nil)then
- with Msg do
- begin
- if (Message <> CM_CANCELMODE) and (Message = WM_CHAR) or
- (Message = CM_ACTIVATE) or (Message = CM_DEACTIVATE) or
- (Message = CM_APPKEYDOWN) or (Message = CM_APPSYSCOMMAND) or
- (Message = WM_COMMAND) then
- PostMessage(ErrorControl.Handle, CM_ERRORMESSAGE, 0, 0);
- end;
- end;
-
- procedure HookErrorHooks;
- begin
- if ErrorHook = 0 then
- ErrorHook := SetWindowsHookEx(WH_GETMESSAGE, @ErrorGetMsgHook, 0, GetCurrentThreadID);
- end;
-
- procedure UnHookErrorHooks;
- begin
- if ErrorHook <> 0 then UnhookWindowsHookEx(ErrorHook);
- ErrorHook := 0;
- end;
-
- constructor TDCCustomChoiceEdit.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
-
- ControlStyle:= ControlStyle + [csSetCaption, csCaptureMouse, csClickEvents];
- Ctl3D := False;
- FBtnChoiceStyle:= btsForm;
- FButtonExist:= True;
- FMouseDown := False;
- FChoiceButtonWidth := DEFAULT_BTN_WIDTH;
- FCheckGlyph := TBitmap.Create;
- FCanEmpty := True;
- FShowCheckBox := True;
- FDisableButtons:= False;
- FMultiLine := False;
-
- FImage := TBitmap.Create;
- FImage.Transparent := True;
-
- SetRectEmpty(FMargins);
- FCheckGlyph.Transparent := True;
- PerformCloseUp := False;
- end;
-
- procedure TDCCustomChoiceEdit.CreateParams(var Params: TCreateParams);
- const
- WordWraps: array[Boolean] of DWORD = (0, ES_AUTOHSCROLL);
- begin
- inherited CreateParams(Params);
- with Params do
- begin
- Style := Style or ES_MULTILINE or WS_CLIPCHILDREN;
- Style := Style and not WordWraps[FWordWrap];
- if FDrawStyle = fsNone then
- ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
- if FDrawStyle = fsSingle then
- Style := Style or WS_BORDER;
- end;
- end;
-
- procedure TDCCustomChoiceEdit.CreateWnd;
- begin
- inherited CreateWnd;
- SetEditRect;
- end;
-
- destructor TDCCustomChoiceEdit.Destroy;
- begin
- Hide;
- if Assigned(FBtnChoice)
- then begin
- FBtnChoice.Free;
- FBtnChoice := nil;
- end;
- FCheckGlyph.Free;
- FImage.Free;
- inherited Destroy;
- end;
-
- procedure TDCCustomChoiceEdit.CloseUp(State: Byte; bPerform: boolean);
- var
- ParentForm: TCustomForm;
- lDropDown: boolean;
- begin
- lDropDown := DropDownVisible;
- if bPerform then
- Perform(CM_POPUPWINDOW, 0, 0)
- else
- PostMessage(Handle, CM_POPUPWINDOW, 0, 0);
-
- if lDropDown <> DropDownVisible then
- begin
- ParentForm := GetParentForm(Self);
- if (ParentForm <> nil) and ParentForm.HandleAllocated then
- UpdateWindow(ParentForm.Handle);
- end;
-
- if BtnChoiceAssigned then FBtnChoice.ResetProperties;
- end;
-
- procedure TDCCustomChoiceEdit.CMEnabledChanged(var Message: TMessage);
- begin
- if BtnChoiceAssigned then
- begin
- FBtnChoice.Enabled := Enabled;
- FBtnChoice.Paint;
- end;
- Invalidate;
- inherited;
- end;
-
- procedure TDCCustomChoiceEdit.WMSize(var Message: TWMSize);
- begin
- inherited;
- if FButtonExist then DefineBtnChoice(FBtnChoiceStyle);
- SetEditRect;
- end;
-
- procedure TDCCustomChoiceEdit.DefineBtnChoice(BtnStyle: TChoiceBtnStyle);
- var
- R: TRect;
- begin
- if not Assigned(Parent) then Exit;
- if not FButtonExist then Exit;
- if not Assigned(FBtnChoice) then
- begin
- FButtonExist := True;
- FBtnChoice := TDCEditButton.Create(Self);
- with FBtnChoice do
- begin
- SetBounds(Rect(0, 2, Self.ClientHeight, Self.ClientHeight+2));
- BrushColor := clBtnFace;
- Allignment := abCenter;
- OnClick := ChoiceClick;
- end;
- end;
- with FBtnChoice do
- begin
- Enabled := Self.Enabled and ButtonEnabled;
- Height := Self.ClientHeight;
- Top := 2;
- case BtnStyle of
- btsForm:
- begin
- Glyph.LoadFromResourceName(HInstance, 'DC_FLATCHOICE');
- Width := DEFAULT_BTN_WIDTH;
- SimpleStyle := False;
- end;
- btsCombo :
- begin
- Glyph.LoadFromResourceName(HInstance, 'DC_BTNCOMBO');
- Width := DEFAULT_BTN_WIDTH - 1;
- SimpleStyle := True;
- end;
- btsEllipsis:
- begin
- Glyph.LoadFromResourceName(HInstance, 'DC_BTNELLIPSIS');
- Width := DEFAULT_BTN_WIDTH;
- SimpleStyle := True;
- end;
- btsCustom:
- begin
- Width := FChoiceButtonWidth;
- Left := Width - FBtnChoice.Width - 2;
- end;
- end;
- Left := Self.Width - Width - 2;
- case FDrawStyle of
- fcsNormal: Style := stNormal;
- fsFlat:
- begin
- Style := stControlFlat;
- end;
- fsNone:
- begin
- Style := stNormal;
- Top := Top - 2;
- Left := Left + 2;
- end;
- fsSingle:
- begin
- Style := stSingle;
- Width := Width - 2;
- Height := Height + 2;
- Left := Left + 2;
- R := GetBounds;
- InflateRect(R, 1, 1);
- R.Right := R.Right - R.Left;
- R.Bottom := R.Bottom - R.Top;
- SetBounds(R);
- end;
- end;
- if ButtonWidth > 0 then Paint;
- end;
- Invalidate;
- end;
-
- procedure TDCCustomChoiceEdit.SetGlyph(Value: TBitmap);
- begin
- if Assigned(FBtnChoice) then
- begin
- FBtnChoiceStyle := btsCustom;
- FBtnChoice.Glyph := Value;
- if not Assigned(Value) then
- SetChoiceButtonWidth(Value.Width+6)
- else
- SetChoiceButtonWidth(DEFAULT_BTN_WIDTH);
-
- FBtnChoice.Width := FChoiceButtonWidth;
- end;
- end;
-
- function TDCCustomChoiceEdit.GetGlyph: TBitmap;
- begin
- if Assigned(FBtnChoice)
- then begin
- Result := FBtnChoice.Glyph;
- end
- else Result := nil;
- end;
-
- procedure TDCCustomChoiceEdit.SetEditRect;
- var
- TextMargin, TopMargin, RightMargin, LeftMargin: integer;
- R: TRect;
- WMargins: DWord;
- begin
- if HandleAllocated then
- begin
- TextMargin := 0;
- TopMargin := 0;
-
- case FDrawStyle of
- fsNone :
- begin
- TopMargin := 1;
- TextMargin := 2;
- end;
- fsSingle :
- begin
- TopMargin := -1;
- TextMargin := -1;
- end;
- fcsNormal,
- fsFlat:
- begin
- TopMargin := 0;
- TextMargin := 0;
- end;
- end;
-
- SetMargins(LeftMargin, RightMargin);
-
- if PaintCheckGlyph then TextMargin := 0;
- if FWordWrap then Inc(RightMargin);
-
- R := Rect(LeftMargin+TextMargin, TopMargin, Width-RightMargin, Height+1);
-
- WMargins := SendMessage(Handle, EM_GETMARGINS, 0, 0);
- SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
- SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN , MakeLong(WMargins and $0000FFFF, 0));
- SendMessage(Handle, EM_SETMARGINS, EC_RIGHTMARGIN, MakeLong(0, WMargins shr 16));
- SendMessage(Handle, EM_SCROLLCARET, 0, 0);
-
- FMargins := R;
- FCheckWidth:= LeftMargin;
- DefineBtnChoiceStyle;
- end;
- end;
-
- procedure TDCCustomChoiceEdit.SetBtnChoiceStyle(Value : TChoiceBtnStyle);
- begin
- if Value<>FBtnChoiceStyle
- then begin
- FBtnChoiceStyle := value;
- if Parent <> nil then
- begin
- DefineBtnChoice(value);
- end;
- SetEditRect;
- end;
- end;
-
- procedure TDCCustomChoiceEdit.KeyDown(var Key: Word; Shift: TShiftState);
- begin
- inherited KeyDown(Key, Shift);
- if (Key = VK_F2) and (Shift=[]) then ChoiceButtonDown;
- end;
-
- procedure TDCCustomChoiceEdit.MouseUp(Button: TMouseButton; ShiftState: TShiftState; X, Y: Integer);
- begin
- inherited MouseUp(Button, ShiftState, X, Y);
- end;
-
-
- procedure TDCCustomChoiceEdit.SetCanChoice( Value : Boolean );
- begin
- if FButtonExist <> Value
- then begin
- FButtonExist := Value;
- if FButtonExist then DefineBtnChoice(FBtnChoiceStyle)
- else begin
- if Assigned(FBtnChoice)
- then begin
- FBtnChoice.Free;
- FBtnChoice:= nil;
- end;
- end;
- Update;
- SetEditRect;
- Invalidate;
- end;
- end;
-
- procedure TDCCustomChoiceEdit.ChoiceClick(Sender:TObject);
- begin
- if ((Sender <> nil) and (Sender is TDCEditButton)) or (ButtonStyle <> esDropDown) then
- begin
- HideErrorMessage;
- if Assigned(FOnButtonClick) then FOnButtonClick(Self);
- end
- else
- ChoiceButtonDown;
- end;
-
- procedure TDCCustomChoiceEdit.CMFontChanged(var Message: TMessage);
- begin
- inherited;
- SetEditRect;
- end;
-
- procedure TDCCustomChoiceEdit.WMPaint(var Message: TWMPaint);
- begin
- inherited;
- RedrawBorder(True, 0)
- end;
-
- procedure TDCCustomChoiceEdit.WMEraseBkGnd(var Message: TWMEraseBkGnd);
- var
- ARect: TRect;
- begin
- ARect := ClientRect;
- if BtnChoiceAssigned then
- begin
- ARect.Right := FBtnChoice.Left;
- if FDrawStyle in [fsFlat, fsSingle] then Dec(ARect.Right, 3);
- end;
- if PaintCheckGlyph then ARect.Left := ARect.Left+FCheckGlyph.Width;
-
- FillRect(TWMEraseBkGnd(Message).DC, ARect, Brush.Handle);
- Message.Result := 0;
- end;
-
- procedure TDCCustomChoiceEdit.WMNCPaint (var Message: TMessage);
- begin
- RedrawBorder(True, 0);
- end;
-
- procedure TDCCustomChoiceEdit.WMMouseMove(var Message: TWMMouseMove);
- var
- lInherited: boolean;
- begin
- Inherited;
- lInherited := True;
- if not(csDesigning in ComponentState) and (FDrawStyle = fsFlat) then
- UpdateMouseInControl(True);
- if BtnChoiceAssigned then
- begin
- with Message do FBtnChoice.UpdateButtonState( XPos, YPos, FMouseDown, True);
- if FInButtonArea then lInherited := False;
- end;
- if lInherited then inherited;
- end;
-
- procedure TDCCustomChoiceEdit.WMSetCursor(var Message: TWMSetCursor);
- begin
- if FInButtonArea
- then
- SetCursor(LoadCursor(0, IDC_ARROW))
- else
- if FInCheckArea then
- SetCursor(LoadCursor(0, IDC_ARROW))
- else
- inherited;
- end;
-
- procedure TDCCustomChoiceEdit.WMSetFocus(var Message: TWMSetFocus);
- begin
- inherited;
- SetCaret;
- if not(csDesigning in ComponentState) and (FDrawStyle = fsFlat) then
- UpdateMouseInControl(True);
- end;
-
- procedure TDCCustomChoiceEdit.CMCancelMode(var Message: TCMCancelMode);
- begin
- inherited;
- if (Message.Sender <> Self) then
- begin
- CloseUp(0, True);
- FMouseDown := False;
- end;
- end;
-
- procedure TDCCustomChoiceEdit.CMMouseEnter(var Message: TMessage);
- var
- APoint: TPoint;
- XPos, YPos: LongInt;
- begin
- inherited;
- if IsExistDragging then Exit;
- GetCursorPos(APoint);
- APoint := Self.ScreenToClient(APoint);
- XPos := APoint.X;
- YPos := APoint.Y;
- if FMouseDown then
- begin
- FMouseDown := FMouseDown and (GetAsyncKeyState(VK_LBUTTON)<0);
- if not FMouseDown and BtnChoiceAssigned then
- FBtnChoice.UpdateButtonState( XPos, YPos, FMouseDown, False);
- end;
- inherited;
- if not FMouseInControl and (FDrawStyle = fsFlat) then UpdateMouseInControl(True);
- end;
-
- procedure TDCCustomChoiceEdit.CMMouseLeave(var Message: TMessage);
- begin
- inherited;
- if IsExistDragging then Exit;
- if BtnChoiceAssigned then FBtnChoice.UpdateButtonState( -1, -1, False, True);
- if not Focused then UpdateMouseInControl(False);
- end;
-
- procedure TDCCustomComboBox.WMEraseBkGnd(var Message: TWMEraseBkGnd);
- begin
- if FStyle = csDropDownList then
- Message.Result := 0
- else
- inherited;
- end;
-
- procedure TDCCustomChoiceEdit.WMLButtonDown(var Message: TWMLButtonDown);
- begin
- FMouseDown := True;
- if FInCheckArea then
- begin
- SetFocus;
- if Focused then CheckClick(Self);
- inherited;
- Exit;
- end;
- if not UpdateButtonsOnClick(Message.Pos.X, Message.Pos.Y) then
- inherited;
- end;
-
- procedure TDCCustomChoiceEdit.WMLButtonDblClk(var Message: TWMLButtonDown);
- begin
- FMouseDown := True;
- if FInCheckArea then
- begin
- SetFocus;
- if not DisableButtons and Focused then CheckClick(Self);
- Exit;
- end;
- if not UpdateButtonsOnClick(Message.Pos.X, Message.Pos.Y) then
- begin
- if Focused and BtnChoiceAssigned and not FInButtonArea then
- if ButtonEnabled and (ButtonStyle=esDropDown) then
- begin
- if Message.Result = $AE then
- Message.Result := 0
- else begin
- with FBtnChoice do UpdateButtonState(Left+1, Top+1, True, False);
- Exit;
- end;
- end;
- end;
- if not FInButtonArea then inherited;
- end;
-
- procedure TDCCustomChoiceEdit.WMLButtonUp(var Message: TWMLButtonUp);
- begin
- FMouseDown := False;
- if Focused then UpdateButtonsOnClick(Message.Pos.X, Message.Pos.Y);
- inherited;
- end;
-
- procedure TDCCustomChoiceEdit.RedrawBorder(DrawBorder: boolean; Clip: HRGN);
- var
- DC: HDC;
- R: TRect;
- BtnFaceBrush, WindowBrush: HBRUSH;
- TopLeft, Offset: TPoint;
- begin
- DC := GetWindowDC(Handle);
- WindowBrush := 0;
- if (Clip <> 0) then SelectClipRgn(DC, Clip);
-
- try
- GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top);
- BtnFaceBrush:= GetSysColorBrush(COLOR_BTNFACE);
- WindowBrush := CreateSolidBrush(ColorToRGB(Color)); //GetSysColorBrush(COLOR_WINDOW);
-
- if PaintCheckGlyph then
- begin
- if FCheckWidth = 0 then SetEditRect;
- Offset.X := (Width - ClientWidth) div 2;
- Offset.Y := (Height - ClientHeight) div 2;
-
- FImage.Width := FCheckGlyph.Width+2;
- FImage.Height := ClientHeight;
- with FImage, FImage.Canvas do
- begin
- Brush.Color := Self.Color;
- FillRect(Rect(0, 0, Width, Height));
- TopLeft.X := 1;
- if ClientHeight > FCheckGlyph.Height then
- TopLeft.Y := (ClientHeight-FCheckGlyph.Height) shr 1
- else
- TopLeft.Y := 0;
- StretchDraw(Rect(TopLeft.X, TopLeft.Y, Width-1,
- TopLeft.Y+FCheckGlyph.Height),
- FCheckGlyph);
- end;
- if not Enabled then TransformBitmap(FImage, FImage, tsDisable);
- BitBlt(DC, Offset.X, Offset.Y, FImage.Width,
- _intMin(FImage.Height, Height - Offset.Y), FImage.Canvas.Handle, 0, 0, SRCCOPY);
- end;
-
- DoDrawMargins(DC);
-
- if DrawBorder then
- begin
- if BtnChoiceAssigned then with FBtnChoice do
- begin
- Paint;
- ExcludeClipRect(DC, Left, Top, Left+Width, Top+Height);
- end;
- case FDrawStyle of
- fsFlat:
- begin
- if ((csDesigning in ComponentState) and Enabled) or
- (not(csDesigning in ComponentState) and
- (Focused or FMouseInControl))
- then begin
- DrawEdge(DC, R, BDR_SUNKENOUTER, BF_RECT or BF_ADJUST);
- with R do begin
- FillRect(DC, Rect(Left, Top, Left+1, Bottom-1), BtnFaceBrush);
- FillRect(DC, Rect(Left, Top, Right-1, Top+1), BtnFaceBrush);
- end;
- DrawEdge(DC, R, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
- InflateRect(R, -1, -1);
- if BtnChoiceAssigned then
- with R do
- FillRect(DC, Rect(FBtnChoice.Left - 1,Top - 1,FBtnChoice.Left,Bottom+1), BtnFaceBrush);
- end
- else begin
- if BtnChoiceAssigned then
- with R do
- FillRect(DC, Rect(FBtnChoice.Left-1,Top-1,FBtnChoice.Left,Bottom+1), WindowBrush);
- DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT);
- DrawEdge(DC, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
- InflateRect(R,-1,-1);
- FrameRect(DC, R, WindowBrush);
- InflateRect(R,-1,-1);
- FrameRect(DC, R, WindowBrush);
- end;
- end;
- fcsNormal:
- begin
- DrawEdge(DC, R, BDR_SUNKENOUTER, BF_RECT);
- InflateRect(R,-1,-1);
- DrawEdge(DC, R, BDR_SUNKENINNER, BF_RECT);
- end;
- fsNone:
- begin
- {}
- end;
- fsSingle:
- begin
- DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT);
- DrawEdge(DC, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
- InflateRect(R,-1,-1);
- FrameRect(DC, R, WindowBrush);
- InflateRect(R,-1,-1);
- FrameRect(DC, R, WindowBrush);
- R := FBtnChoice.GetBounds;
- InflateRect(R, 1, 0);
- DrawEdge(DC, R, BDR_SUNKENOUTER, BF_LEFT);
- end;
- end;
- end;
- finally
- ReleaseDC(Handle, DC);
- DeleteObject(WindowBrush);
- end;
- end;
-
- procedure TDCCustomChoiceEdit.SetStyle(Value: TControlStyle);
- begin
- if FDrawStyle <> Value then
- begin
- FDrawStyle := Value;
- DefineBtnChoice(FBtnChoiceStyle);
- SetEditRect;
- RecreateWnd;
- end;
- end;
-
- procedure TDCCustomChoiceEdit.UpdateMouseInControl(Value: boolean);
- begin
- if (FMouseInControl <> Value) then
- begin
- FMouseInControl := Value;
- if BtnChoiceAssigned then FBtnChoice.MouseInControl := Value;
- if FDrawStyle = fsFlat then RedrawBorder(True, 0);
- end;
- end;
-
- procedure TDCCustomChoiceEdit.SetChoiceButtonWidth(Value: integer);
- begin
- if FChoiceButtonWidth <> Value then
- begin
- ButtonChoiceStyle := btsCustom;
- FChoiceButtonWidth := Value;
- RedrawBorder(True, 0);
- DefineBtnChoice(FBtnChoiceStyle);
- SetEditRect;
- if BtnChoiceAssigned then FBtnChoice.Paint;
- end;
- end;
-
- function TDCCustomChoiceEdit.GetButtonStyle: TEventStyle;
- begin
- if Assigned(FBtnChoice) then Result := FBtnChoice.EventStyle
- else Result := esNormal
- end;
-
- procedure TDCCustomChoiceEdit.SetButtonStyle(Value: TEventStyle);
- begin
- if Value <> GetButtonStyle then
- begin
- if Assigned(FBtnChoice) then
- begin
- FBtnChoice.EventStyle := Value;
- if ButtonWidth > 0 then FBtnChoice.Paint;
- end
- end;
- end;
-
- function TDCCustomChoiceEdit.GetButtonState: TButtonState;
- begin
- if Assigned(FBtnChoice) then Result := FBtnChoice.ButtonState
- else Result := btRest
- end;
-
- procedure TDCCustomChoiceEdit.SetButtonState(Value: TButtonState);
- begin
- if Value <> GetButtonState then
- begin
- if Assigned(FBtnChoice) then FBtnChoice.ButtonState := Value;
- end;
- end;
-
- procedure TDCCustomChoiceEdit.SetCheckGlyph(Value: TBitmap);
- begin
- if Value <> FCheckGlyph then
- begin
- FCheckGlyph.Assign(Value);
- SetEditRect;
- Invalidate;
- end;
- end;
-
- procedure TDCCustomChoiceEdit.Loaded;
- begin
- inherited;
- SetEditRect;
- end;
-
- procedure TDCCustomChoiceEdit.WMNCHitTest(var Message: TWMNCHitTest);
- var
- P: TPoint;
- begin
- P := Self.ScreenToClient(Point(Message.XPos, Message.YPos));
-
- if FShowCheckBox and Assigned(FCheckGlyph) and (P.X < FCheckGlyph.Width) and
- ((Width-FCheckGlyph.Width) >= MinControlWidthBitmap) then
- FInCheckArea := True
- else
- FInCheckArea := False;
-
- if BtnChoiceAssigned and (P.X >= (Width - ButtonWidth - 2)) then
- FInButtonArea := True
- else
- FInButtonArea := False;
-
- inherited;
- end;
-
- procedure TDCCustomChoiceEdit.CheckClick(Sender: TObject);
- begin
- HideCaret(Handle);
- HideErrorMessage;
- if FDisableButtons then Exit;
- if not Focused then SetFocus;
- if Focused and Assigned(FOnCheckClick) then FOnCheckClick(Self);
- SetCaret;
- end;
-
- function TDCCustomChoiceEdit.UpdateButtonsOnClick(X, Y: integer): boolean;
- var
- ButtonUpdate: boolean;
- begin
- Result := False;
- if BtnChoiceAssigned and FInButtonArea then
- begin
- if not Focused then SetFocus;
- if Focused then
- ButtonUpdate :=FBtnChoice.UpdateButtonState(X, Y, FMouseDown, False)
- else
- ButtonUpdate := False;
- if ButtonUpdate and FBtnChoice.MouseInRect(X, Y) then Result := True;
- end;
- end;
-
- procedure TDCCustomChoiceEdit.SetParent(AParent: TWinControl);
- begin
- inherited;
- if AParent <> nil then begin
- DefineBtnChoice(FBtnChoiceStyle);
- SetEditRect;
- if BtnChoiceAssigned then FBtnChoice.Paint;
- end;
- end;
-
- function TDCCustomChoiceEdit.GetButtonEnabled: boolean;
- begin
- if Assigned(FBtnChoice) then Result := FBtnChoice.Enabled
- else Result := True
- end;
-
- procedure TDCCustomChoiceEdit.SetButtonEnabled(Value: boolean);
- begin
- if Assigned(FBtnChoice) and (Value <> FBtnChoice.Enabled) then
- FBtnChoice.Enabled := Value;
- end;
-
- procedure TDCCustomChoiceEdit.SetShowCheckBox(Value: boolean);
- begin
- if FShowCheckBox <> Value then
- begin
- FShowCheckBox := Value;
- SetEditRect;
- Invalidate;
- end;
- end;
-
- procedure TDCCustomChoiceEdit.KeyPress(var Key: Char);
- begin
- case Key of
- Char(VK_RETURN),
- Char(VK_ESCAPE):
- begin
- if (Key <> #0) and (ErrorWindow <> nil) and (ErrorWindow.Buttons.Count > 0) then
- begin
- HideErrorMessage;
- Key := #0;
- end
- else begin
- inherited KeyPress(Key);
- if (Key <> #0) and not FMultiLine then
- begin
- if Perform(CM_WANTSPECIALKEY, Byte(Key), 0) = 0 then
- GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
- Key := #0;
- end;
- end;
- end;
- else inherited KeyPress(Key);
- end;
- end;
-
- procedure TDCCustomChoiceEdit.CMExit(var Message: TCMExit);
- begin
- CloseUp(0, True);
- if not(csDesigning in ComponentState) and (FDrawStyle = fsFlat) and
- not FShowError then UpdateMouseInControl(False);
- inherited;
- end;
-
- procedure TDCCustomChoiceEdit.CMEnter(var Message: TCMEnter);
- begin
- inherited;
- end;
-
- procedure TDCCustomChoiceEdit.KillFocus(var Value: boolean);
- begin
- if not Value and CanModified and not FCanEmpty and (Trim(Text) = '')
- then begin
- Value := True;
- FErrorCode := ERR_EDIT_EMPTYVALUE;
- end;
- inherited;
- end;
-
- procedure TDCCustomChoiceEdit.PaintWindow(DC: HDC);
- begin
- inherited PaintWindow(DC);
- end;
-
- function TDCCustomChoiceEdit.MinControlWidthBitmap: integer;
- var
- CharWidth: integer;
- begin
- CharWidth := GetCharWidth(Handle, Font)+2;
- if Assigned(FBtnChoice) then
- Result := FBtnChoice.Width+5+CharWidth
- else
- Result := 5+CharWidth;
- end;
-
- function TDCCustomChoiceEdit.BtnChoiceAssigned: boolean;
- begin
- Result := Assigned(FBtnChoice);
- end;
-
- procedure TDCCustomChoiceEdit.EMSetReadOnly(var Message: TMessage);
- begin
- inherited;
- //DisableButtons := boolean(Message.wParam);
- end;
-
- procedure TDCCustomChoiceEdit.SetDisableButtons(const Value: boolean);
- begin
- if FDisableButtons <> Value then
- begin
- FDisableButtons := Value;
- SetButtonEnabled(not FDisableButtons);
- RedrawBorder(False, 0);
- end;
- end;
-
- { TDCComboBox }
-
- procedure TDCCustomComboBox.ChoiceClick(Sender: TObject);
- begin
- inherited;
- if DropDownVisible then
- CloseUp(0, True)
- else
- Perform(CM_POPUPWINDOW, 1, 0);
- end;
-
- procedure TDCCustomComboBox.CloseUp(State: Byte; bPerform: boolean = False);
- var
- AText: string;
- AItemIndex: integer;
- begin
- case State of
- 0:
- begin
- SelLength := 0;
- if DropDownVisible then SetText(FCachedText, FCachedIndex, 0, -1);
- inherited;
- end;
- 1:
- begin
- AText := Text;
- AItemIndex := -1;
- if DropDownVisible then with FListBox do
- begin
- if ItemIndex >= 0 then
- begin
- AText := Items[ItemIndex];
- AItemIndex := ItemIndex;
- end;
- end;
- inherited;
- SetText(AText, AItemIndex, 0, -1);
- FLastText := Text;
- FLastIndex := FItemIndex;
- DoCloseUp;
- end;
- end;
- end;
-
- procedure TDCCustomComboBox.CMCancelMode(var Message: TCMCancelMode);
- begin
- if (Message.Sender <> Self) and
- (Message.Sender <> FListBox) and
- not FListBox.ContainsControl(Message.Sender) then
- begin
- inherited;
- end;
- end;
-
- constructor TDCCustomComboBox.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FItems := TStringList.Create;
- FListBoxVisible := False;
- FItemIndex := -1;
- FEditing := False;
- FDropDownCount := 8;
- end;
-
- procedure TDCCustomComboBox.CreateParams(var Params: TCreateParams);
- begin
- inherited;
- if NotEditControl then
- begin
- with Params do
- begin
- Text := Name;
- Style := WS_CHILD or WS_CLIPSIBLINGS;
- AddBiDiModeExStyle(ExStyle);
- if csAcceptsControls in ControlStyle then
- begin
- Style := Style or WS_CLIPCHILDREN;
- ExStyle := ExStyle or WS_EX_CONTROLPARENT;
- end;
- if FDrawStyle = fsNone then
- ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
- if FDrawStyle = fsSingle then
- Style := Style or WS_BORDER;
- if not (csDesigning in ComponentState) and not Enabled then
- Style := Style or WS_DISABLED;
- if TabStop then Style := Style or WS_TABSTOP;
- if Parent <> nil then
- WndParent := Parent.Handle else
- WndParent := ParentWindow;
- WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS;
- WindowClass.lpfnWndProc := @DefWindowProc;
- WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
- WindowClass.hbrBackground := 0;
- WindowClass.hInstance := HInstance;
- StrPCopy(WinClassName, ClassName);
- end;
- end
- end;
-
- destructor TDCCustomComboBox.Destroy;
- begin
- FItems.Free;
- FItems := nil;
- inherited;
- end;
-
- procedure TDCCustomComboBox.DrawBitmap(Index: integer);
- var
- R: TRect;
- AWidth, AHeight: integer;
- begin
- if Assigned(FOnDrawBitmap) and Assigned(FCheckGlyph) then
- begin
-
- with FCheckGlyph, FCheckGlyph.Canvas do
- begin
- R := Rect(0,0, Width, Height);
- FillRect(R);
- end;
- AWidth := FCheckGlyph.Width;
- AHeight := FCheckGlyph.Height;
- FOnDrawBitmap(Self, R, Index, FCheckGlyph);
- if (AWidth <> FCheckGlyph.Width) or
- (AHeight <> FCheckGlyph.Height)
- then
- SetEditRect;
- end;
- end;
-
- function TDCCustomComboBox.GetCanvas: TCanvas;
- begin
- if FListBoxVisible then
- Result := FListBox.Canvas
- else
- Result := nil;
- end;
-
- procedure TDCCustomComboBox.GetEntryText;
- var
- TextLen, Index: integer;
- begin
- if (Length(Text) >= MIN_CMPSTR_LENGTH) and not ReadOnly then
- begin
- TextLen := Length(Text);
- Index := GetFirstEntry(True);
- if Index <> -1 then
- begin
- SetText(Items[Index], Index, Length(Items[Index]), TextLen );
- Invalidate;
- end;
- end;
- end;
-
- function TDCCustomComboBox.GetFirstEntry(PartWord: boolean): integer;
- var
- i, j: integer;
- Value, ItemString: string;
- Found: boolean;
- begin
- Value := Text;
- i := 0;
- Found := False;
- while (i <= Items.Count-1) and not(Found) do
- begin
- ItemString := Items[i];
- j := 1;
- if Length(Value) > Length(ItemString) then
- begin
- Inc(i);
- continue;
- end;
- while (j <= Length(Value)) and (j <= Length(ItemString)) and
- (AnsiUpperCase(Value[j]) = AnsiUpperCase(ItemString[j]) ) do
- begin
- Inc(j);
- end;
-
- if (j > Length(Value)) and
- (PartWord or (Length(Value) = Length(ItemString)))
- then
- Found := True
- else
- Inc(i);
- end;
- if Found then Result := i else Result := -1;
- end;
-
- procedure TDCCustomComboBox.KeyDown(var Key: Word; Shift: TShiftState);
- var
- Index: integer;
- KeyDownEvent: TKeyEvent;
- begin
- KeyDownEvent := OnKeyDown;
- if FListBoxVisible and (FListBox<>nil) then
- case Key of
- VK_PRIOR,
- VK_NEXT ,
- VK_UP ,
- VK_DOWN :
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if FListBox.ItemIndex = -1 then
- FListBox.ItemIndex := 0
- else
- SendMessage(FListBox.Handle, WM_KEYDOWN, Key, 0);
- if (FListBox.Items.Count > FListBox.ItemIndex) and (FListBox.ItemIndex <> -1) then
- SetText(FListBox.Items[FListBox.ItemIndex], FListBox.ItemIndex, 0, -1);
- Key := 0;
- end;
- end
- else begin
- if [ssAlt]*Shift = [ssAlt] then
- case Key of
- VK_DOWN:
- if FStyle <> csSimple then
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if Key <> 0 then ChoiceButtonDown;
- Key := 0;
- end;
- end
- else begin
- case Key of
- VK_UP, VK_DOWN:
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if (not ReadOnly) and (Key <>0) then
- begin
- if FItemIndex = -1 then
- Index := GetFirstEntry(False)
- else
- Index := FItemIndex;
- if Key = VK_UP then Dec(Index) else Inc(Index);
- if Index < 0 then Index := 0;
- if (Index + 1) <= FItems.Count then SetText(Items[Index], Index, 0, -1);
- Key := 0;
- end;
- end;
- VK_DELETE:
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if (Key <> 0) and not ReadOnly then
- begin
- FItemIndex := -1;
- end;
- end;
- end;
- end;
- end;
- if Key <> 0 then inherited;
- end;
-
- procedure TDCCustomComboBox.KeyPress(var Key: Char);
- begin
- if FListBoxVisible and (FListBox<>nil) then
- begin
- case Key of
- Char(VK_RETURN):
- begin
- CloseUp(1, True);
- if not PerformCloseUp then Key := #0;
- end;
- Char(VK_ESCAPE): begin CloseUp(0, True); Key := #0; end;
- end;
- end
- else begin
- case Key of
- Char(VK_ESCAPE): SetText(FLastText, FLastIndex, -1, 0);
- end;
- end;
- inherited KeyPress(Key);
- end;
-
- procedure TDCCustomComboBox.KillFocus(var Value: boolean);
- begin
- if CanModified and not Value and not FCanEmpty and (Trim(Text) = '')
- then begin
- Value := True;
- FErrorCode := ERR_EDIT_EMPTYVALUE;
- end;
- if CanModified and not Value and (FStyle = csDropDownList) and
- (FItemIndex = -1) and (Trim(Text) <> '')
- then begin
- Value := True;
- FErrorCode := ERR_COMBO_ILLIGALVALUE;
- end;
- inherited KillFocus(Value);
- end;
-
- procedure TDCCustomComboBox.ListMouseUp(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- inherited;
- if Button = mbLeft then CloseUp(1, True);
- end;
-
- procedure TDCCustomComboBox.SetItemIndex(Value: integer);
- var
- sText: string;
- begin
- if (FItems.Count > 0) and (Value > -1) and (Value < FItems.Count)
- then
- sText := FItems.Strings[Value]
- else
- sText := '';
-
- if (FItemIndex <> Value) or (Text <> sText) then
- begin
- FItemIndex := Value;
- Text := sText;
- if Assigned(FOnIndexChange) then FOnIndexChange(Self);
- Invalidate;
- end;
- end;
-
- procedure TDCCustomComboBox.SetItems(Value: TStrings);
- begin
- FItems.Assign(Value);
- end;
-
- procedure TDCCustomComboBox.SetComboBoxStyle(Value: TComboBoxStyle);
- begin
- if FStyle <> Value then
- begin
- FStyle := Value;
- case FStyle of
- csDropDown:
- ButtonExist := True;
- csSimple:
- ButtonExist := False;
- csDropDownList:
- begin
- ButtonExist := True;
- Text := ''
- end;
- csOwnerDrawFixed:
- ButtonExist := True;
- csOwnerDrawVariable:
- ButtonExist := True;
- end;
- RecreateWnd;
- end;
- end;
-
- procedure TDCCustomComboBox.SetText(Value: string; ItemIndex: integer;
- ASelStart, ASelLen: integer);
- begin
- if (Text <> Value) or (Self.ItemIndex <> ItemIndex) then
- begin
- Self.ItemIndex := ItemIndex;
- Text := Value;
- SendMessage(Handle, EM_SETSEL, ASelLen, ASelStart);
- if (FStyle = csDropDownList) then Change;
- end;
- end;
-
- procedure TDCCustomComboBox.FindNextItem(cFirstChar: char);
- var
- ItemPos, i: integer;
- Found: boolean;
- begin
- if ReadOnly then Exit;
- ItemPos := FItemIndex;
- i := ItemPos+1;
- Found := False;
- while i<=(FItems.Count-1) do
- begin
- if i < 0 then
- begin
- Inc(i);
- continue;
- end;
- if FItems.Strings[i][1] = cFirstChar then
- begin
- Found := True;
- break;
- end;
- Inc(i);
- end;
-
- if Found then
- SetText(Items[i], i, 0, 0 )
- else begin
- i := 0;
- Found := False;
- while i<=(ItemPos-1) do
- begin
- if FItems.Strings[i][1] = cFirstChar then
- begin
- Found := True;
- break;
- end;
- Inc(i);
- end;
- end;
-
- if Found then
- begin
- SetText(Items[i], i, 0, 0 );
- if FListBoxVisible then FListBox.ItemIndex := i;
- end;
- end;
-
- procedure TDCCustomComboBox.WMChar(var Message: TWMChar);
- begin
- if not NotEditControl then
- begin
- if not (Message.CharCode in [0, 13, 27]) then
- FItemIndex := -1;
- inherited;
- if not (Message.CharCode in [0, 8, 13, 27]) then GetEntryText;
- if FListBoxVisible then FListBox.ItemIndex := ItemIndex;
- end
- else begin
- FindNextItem(Char(Message.CharCode));
- inherited;
- end;
- end;
-
- procedure TDCCustomComboBox.WMGetDlgCode(var Message: TWMGetDlgCode);
- begin
- Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_WANTALLKEYS;
- end;
-
- procedure TDCCustomComboBox.WMKillFocus(var Message: TWMKillFocus);
- begin
- if Assigned(FItems) and (FItemIndex =-1) then FItemIndex := GetFirstEntry(False);
- inherited;
- if Assigned(FItems) then PaintListItem(False);
- end;
-
- procedure TDCCustomComboBox.PaintListItem(bFocused: boolean);
- const
- Alignments: array[Boolean, TAlignment] of DWORD =
- ((DT_LEFT, DT_RIGHT, DT_CENTER),(DT_RIGHT, DT_LEFT, DT_CENTER));
- var
- DC: HDC;
- R: TRect;
- ACanvas: TCanvas;
- begin
- if not NotEditControl then Exit;
-
- ACanvas := TControlCanvas.Create;
-
- DC := GetWindowDC(Handle);
-
- GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top);
- if PaintCheckGlyph then R.Left := R.Left + FCheckGlyph.Width + 2;
- if ButtonWidth > 0 then
- begin
- R.Right := R.Right - ButtonWidth;
- if FDrawStyle = fsFlat then R.Right := R.Right - 1
- end;
- case FDrawStyle of
- fsNone :
- begin
- InflateRect(R, -1, -1);
- R.Left := R.Left -1;
- end;
- fsSingle :
- begin
- InflateRect(R, -2, -2);
- R.Right := R.Right -1;
- end;
- fcsNormal,
- fsFlat :
- InflateRect(R, -3, -3);
- end;
-
- ACanvas.Handle := DC;
- ACanvas.Font := Font;
- ACanvas.Brush.Color := Color;
- InflateRect(R, 1, 1);
- FillRect(ACanvas.Handle, R, ACanvas.Brush.Handle);
- InflateRect(R, -1, -1);
-
- if bFocused then
- begin
- ACanvas.Brush.Color := clHighlight;
- ACanvas.Font.Color := clHighlightText;
- end;
-
- try
- if FDrawStyle = fsNone then
- R.Left := R.Left +1;
- FillRect(ACanvas.Handle, R, ACanvas.Brush.Handle);
- if bFocused then DrawFocusRect(ACanvas.Handle, R);
- InflateRect(R, -1, -1);
- SetBkMode(ACanvas.Handle, TRANSPARENT);
- case FDrawStyle of
- fcsNormal,
- fsFlat ,
- fsNone : R.Top := R.Top -1;
- end;
- if (FItems.Count > 0) and (FItemIndex > -1) and (FItemIndex < FItems.Count)
- then
- Text := FItems.Strings[FItemIndex]
- else
- Text := '';
-
- if Assigned(FOnDrawText) then
- FOnDrawText(ACanvas, Self, FItemIndex, R, [])
- else
- DrawText(ACanvas.Handle, PChar(Text), Length(Text), R,
- Alignments[UseRightToLeftAlignment, FAlignment]);
- finally
- ReleaseDC(Handle, DC);
- ACanvas.Handle := 0;
- ACanvas.Free;
- end;
- end;
-
- procedure TDCCustomComboBox.WMPaint(var Message: TWMPaint);
- var
- PS: TPaintStruct;
- begin
- DrawBitmap(FItemIndex);
- if not NotEditControl then
- inherited
- else begin
- BeginPaint(Handle, PS);
- RedrawBorder(True, 0);
- PaintListItem(Focused and not FListBoxVisible);
- EndPaint(Handle, PS);
- end;
- end;
-
- procedure TDCCustomComboBox.WMSetFocus(var Message: TWMSetFocus);
- begin
- FLastText := Text;
- FLastIndex:= FItemIndex;
- inherited;
- if NotEditControl then HideCaret(Handle);
- end;
-
- procedure TDCCustomComboBox.WndProc(var Message: TMessage);
- var
- lFocused: boolean;
- begin
- lFocused := Focused;
- inherited WndProc(Message);
- if csDesigning in ComponentState then Exit;
- case Message.Msg of
- WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
- begin
- if NotEditControl and not(FInButtonArea or FInCheckArea)
- then begin
- if not Focused then SetFocus;
- if Focused then
- with FBtnChoice do UpdateButtonState(Left+1, Top+1, True, False);
- end;
- if not NotEditControl and not lFocused then SelectAll;
- end;
- end;
- end;
-
- procedure TDCCustomComboBox.CMEnter(var Message: TCMEnter);
- begin
- inherited;
- PaintListItem(Focused);
- end;
-
- function TDCCustomComboBox.NotEditControl: boolean;
- begin
- Result := (FStyle = csDropDownList) and not FEditing;
- end;
-
- { TDCCustomEdit }
-
- procedure TDCCustomEdit.BeginUpdate(HookChanges: boolean = True);
- begin
- if FUpdateCount = 0 then FChanged := False;
- Inc(FUpdateCount);
- FHookChanges := HookChanges;
- end;
-
- function TDCCustomEdit.CanModified: boolean;
- begin
- Result := not ReadOnly;;
- end;
-
- procedure TDCCustomEdit.Change;
- begin
- if not(csLoading in ComponentState) then
- begin
- if FUpdateCount = 0 then inherited;
- FChanged := True;
- end;
- end;
-
- procedure TDCCustomEdit.CloseUp(State: Byte; bPerform: boolean);
- begin
- if bPerform then
- Perform(CM_POPUPWINDOW, 0, 0)
- else
- PostMessage(Handle, CM_POPUPWINDOW, 0, 0);
- end;
-
- procedure TDCCustomEdit.CMCancelMode(var Message: TCMCancelMode);
- begin
- inherited;
- if ErrorWindow <> nil then
- begin
- if not((Message.Sender = ErrorWindow) and (ErrorWindow.Buttons.Count > 0)) then
- begin
- if Message.Sender = ErrorWindow then
- HideErrorMessage
- else
- Perform(CM_ERRORMESSAGE, 0, 0);
- end;
- end;
- end;
-
- procedure TDCCustomEdit.CMDialogChar(var Message: TCMDialogChar);
- var
- Button: TDCEditButton;
- begin
- if (ErrorWindow <> nil) and (ErrorControl = Self) and
- ErrorWindow.Buttons.IsButtonAccel(Message.CharCode, Button) then
- begin
- Message.Result := 1;
- Button.Click;
- end
- else
- inherited;
- end;
-
- procedure TDCCustomEdit.CMEnter(var Message: TCMEnter);
- begin
- inherited;
- if not FMouseActivate then SendMessage(Handle, EM_SETSEL, 0, -1);
- FMouseActivate := False;
- end;
-
- procedure TDCCustomEdit.CMErrorMessage(var Message: TMessage);
- begin
- case Message.WParam of
- 0: {Hide}
- if ErrorWindow <> nil then
- begin
- UnHookErrorHooks;
- ErrorWindow.Hide;
- ErrorWindow.Free;
- ErrorControl:= nil;
- ErrorWindow := nil;
- FShowError := False;
- end;
- 1: {Show}
- begin
- CloseUp(0, True);
- if Message.LParam <> 0 then FErrorCode := Message.LParam;
- GetHintOnError;
- if Trim(FErrorHint) <> '' then
- begin
- if ErrorWindow <> nil then
- begin
- if ErrorWindow.Caption = FErrorHint then Exit;
- ErrorWindow.Hide;
- end
- else begin
- ErrorControl := Self;
- ErrorWindow := TDCMessageWindow.Create(Self);
- with ErrorWindow do
- begin
- Parent := Self;
- Hide;
- AutoHide := True;
- TimeOut := GetHintTimeOut;
- DialogStyle := dsInvalidValue;
- PopupAlignment := wpOffset;
- MessageStyle := msTail;
- Left := 5;
- Top := Self.Height - 9;
- end;
- end;
- DoShowError(ErrorWindow);
- with ErrorWindow do
- begin
- Caption := FErrorHint;
- FShowError := True;
- Show;
- HookErrorHooks;
- end;
- end;
- end;
- end;
- end;
-
- procedure TDCCustomEdit.CMExit(var Message: TCMExit);
- var
- Value: boolean;
- begin
- Value := False;
- if Visible then
- begin
- FErrorCode := ERR_EDIT_NONE;
- KillFocus(Value);
- FShowError := Value;
- if FShowError then
- begin
- SetFocus;
- ShowErrorMessage;
- end
- else begin
- SelStart := 1;
- SelLength := 0;
- inherited;
- end;
- end
- else
- inherited;
- end;
-
- constructor TDCCustomEdit.Create(AOwner: TComponent);
- begin
- inherited;
- ControlStyle:= ControlStyle - [csFixedHeight];
- FErrorHint := '';
- FMouseActivate := False;
- FDBObject := TDCDBObject.Create;
- FUpdateCount := 0;
- FCanEmpty := True;
- CreateData;
- end;
-
- procedure TDCCustomEdit.CreateData;
- begin
- if Assigned(FOnCreateData) then FOnCreateData(Self);
- end;
-
- procedure TDCCustomEdit.CreateParams(var Params: TCreateParams);
- const
- aAlignments: array[Boolean, TAlignment] of DWORD =
- ((ES_LEFT, ES_RIGHT, ES_CENTER),(ES_RIGHT, ES_LEFT, ES_CENTER));
- begin
- inherited CreateParams(Params);
- with Params do
- begin
- Style := Style or aAlignments[UseRightToLeftAlignment, FAlignment];
- ControlStyle := ControlStyle + [csOpaque];
- end;
- end;
-
- procedure TDCCustomEdit.CreateWnd;
- begin
- inherited CreateWnd;
- end;
-
- procedure TDCCustomEdit.DeSelect;
- begin
- SendMessage(Handle, EM_SETSEL, $7FFFFFFF, Longint($FFFFFFFF));
- end;
-
- destructor TDCCustomEdit.Destroy;
- begin
- Perform(CM_ERRORMESSAGE, 0, 0);
- FDBObject.Free;
- FDBObject := nil;
- DestroyData;
- inherited;
- end;
-
- procedure TDCCustomEdit.DestroyData;
- begin
- if Assigned(FOnDestroyData) then FOnDestroyData(Self);
- end;
-
- procedure TDCCustomEdit.DoCloseUp;
- begin
- if Assigned(FOnCloseUp) then FOnCloseUp(Self);
- end;
-
- procedure TDCCustomEdit.DoShowError(AErrorWindow: TDCMessageWindow);
- begin
- if Assigned(FOnShowError) then FOnShowError(ErrorWindow);
- end;
-
- procedure TDCCustomEdit.EndUpdate;
- begin
- if FUpdateCount > 0 then
- begin
- Dec(FUpdateCount);
- if (FUpdateCount = 0) and FChanged then
- begin
- if FHookChanges then Change;
- FChanged := False;
- end;
- end;
- end;
-
- function TDCCustomEdit.GetDBObject: TDCDBObject;
- begin
- Result := FDBObject;
- end;
-
- procedure TDCCustomEdit.GetHintOnError;
- begin
- case FErrorCode of
- ERR_EDIT_EMPTYVALUE: FErrorHint := LoadStr(RES_EDIT_ERR_EMPTY);
- end;
- if Assigned(FOnGetErrorHint) then FOnGetErrorHint(Self, FErrorCode, FErrorHint);
- end;
-
- function TDCCustomEdit.GetHintTimeOut: integer;
- begin
- Result := 2500;
- end;
-
- procedure TDCCustomEdit.HideErrorMessage;
- begin
- PostMessage(Handle, CM_ERRORMESSAGE, 0, 0);
- end;
-
- procedure TDCCustomEdit.KeyPress(var Key: Char);
- begin
- case Key of
- Char(VK_ESCAPE):
- SendMessage(Handle, EM_UNDO, 0, 0);
- Char(VK_RETURN):
- if (Key <> #0) and (ErrorWindow <> nil) and (ErrorWindow.Buttons.Count > 0) then
- begin
- HideErrorMessage;
- Key := #0;
- end;
- end;
- inherited KeyPress(Key);
- end;
-
- procedure TDCCustomEdit.KillFocus(var Value: boolean);
- var
- Form: TCustomForm;
- begin
- if CanModified and not Value then
- begin
- if not FCanEmpty and (Trim(Text) = '')
- then begin
- Value := True;
- FErrorCode := ERR_EDIT_EMPTYVALUE;
- end
- else
- FErrorCode := ERR_EDIT_NONE;
- end;
-
- if Assigned(FOnKillFocus) then FOnKillFocus(Self, Value);
- if Value then
- begin
- if (Parent <> nil) then
- begin
- Form := GetParentForm(Parent);
- Value := not (Boolean(SendMessage(Form.Handle, CM_INVALIDVALUE, Integer(Self), 0)) or
- Boolean(SendMessage(Parent.Handle, CM_INVALIDVALUE, Integer(Self), 0)));
- end
- end;
- if not Value then Perform(CM_ERRORMESSAGE, 0, 0);
- end;
-
- procedure TDCCustomEdit.SetAlignment(Value: TAlignment);
- var
- sText: string;
- begin
- if FAlignment <> Value then
- begin
- sText := Text;
- FAlignment := Value;
- RecreateWnd;
- SetEditRect;
- Text := sText;
- end;
- end;
-
- procedure TDCCustomEdit.SetData(const Value: Pointer);
- begin
- FData := Value;
- end;
-
- procedure TDCCustomEdit.SetDBObject(const Value: TDCDBObject);
- begin
- FDBObject.Assign(Value);
- end;
-
- procedure TDCCustomEdit.SetEditRect;
- begin
- {}
- end;
-
- procedure TDCCustomEdit.ShowErrorMessage;
- begin
- PostMessage(Handle, CM_ERRORMESSAGE, 1, 0);
- end;
-
- function TDCCustomEdit.ValueCorrect: boolean;
- var
- isError: boolean;
- begin
- isError := False;
- FErrorCode := ERR_EDIT_NONE;
- if Visible then KillFocus(isError);
- Result := not isError;
- end;
-
- procedure TDCCustomEdit.WMMouseActivate(var Message: TWMActivate);
- begin
- inherited;
- FMouseActivate := True;
- end;
-
- { TDCCustomDateEdit }
-
- procedure TDCCustomDateEdit.ChoiceClick(Sender: TObject);
- begin
- inherited;
- if DropDownVisible then
- CloseUp(0, True)
- else
- Perform(CM_POPUPWINDOW, 1, 0);
- end;
-
- procedure TDCCustomDateEdit.CMFontChanged(var Message: TMessage);
- begin
- inherited;
- if FShowCheckBox and FChecked then FFontColor := Font.Color;
- end;
-
- procedure TDCCustomDateEdit.Loaded;
- begin
- inherited;
- FFontColor := Font.Color;
- end;
-
- procedure TDCCustomDateEdit.SetChecked(Value: boolean);
- begin
- if csDesigning in ComponentState then Value := True;
-
- if FShowCheckBox and (FChecked <> Value) and not FReadOnly
- then begin
- FChecked := Value;
- FInCheckProc := True;
- ReadOnly := not FChecked;
- FInCheckProc := False;
- SetCheckGlyph;
- if Assigned(FOnChecked) then FOnChecked(Self);
- Invalidate;
- end;
- end;
-
- procedure TDCCustomDateEdit.SetShowCheckBox(Value: boolean);
- begin
- if FShowCheckBox <> Value then
- begin
- FShowCheckBox := Value;
- if FShowCheckBox then
- SetCheckGlyph
- else begin
- FChecked := True;
- SetCheckGlyph;
- SetFontColor(FFontColor);
- end;
- SetEditRect;
- Invalidate;
- end;
- end;
-
- procedure TDCCustomDateEdit.CloseUp(State: Byte; bPerform: boolean = False);
- var
- xDate: string;
- begin
- case State of
- 0:;
- 1:
- if not FReadOnly and DateToStrY2K(FCalendar.Date, xDate, Kind) then
- begin
- UndoDate := FCalendar.Date;
- Text := xDate;
- if FChecked then SendMessage(Handle, EM_SETSEL, 0, -1);
- end;
- end;
- inherited;
- end;
-
- procedure TDCCustomDateEdit.GetDateText;
- var
- i, j: integer;
- pText: PChar;
- nSelStart,nSelEnd: integer;
- DateFormatStr: string;
- begin
- {╙ßΦ≡ασ∞ Φτ ≥σΩ±≥α DateSeparator}
- nSelStart := SelStart;
- nSelEnd := nSelStart+SelLength;
- if nSelEnd = nSelStart then inc(nSelEnd,1);
-
- FStartPos := nSelStart;
- FEndPos := nSelEnd;
- FDateText := '';
- pText := PChar(Text);
-
- case FKind of
- dkDate :
- DateFormatStr := Format(EDIT_FMT_DEDATE, [DateSeparator]);
- dkDateTime:
- DateFormatStr := Format(EDIT_FMT_DETIME, [DateSeparator, TimeSeparator]);
- end;
-
- j := 1; i := 0;
- while pText^ <> #0 do
- begin
- if (j <= Length(DateFormatStr)) and (DateFormatStr[j] = '|') then
- begin
- inc(j);
- if pText^ = DateFormatStr[j] then
- begin
- if i < nSelStart then Dec(FStartPos);
- if i < nSelEnd then Dec(FEndPos);
- end
- else
- case DateFormatStr[j] of
- 'a':
- begin
- inc(j);
- continue;
- end;
- end;
- end
- else
- FDateText := FDateText + pText^;
- inc(i);
- inc(j);
- inc(pText);
- end;
- end;
-
- procedure TDCCustomDateEdit.SetDateText;
- var
- i, j: integer;
- nSelStart: integer;
- sText, DateFormatStr: string;
- pText: PChar;
- AutoComplete: boolean;
-
- procedure AddToText(cText: Char; Mode: Byte);
- begin
- sText := sText + cText;
- if (Mode = 1) and (FStartPos > i) then Inc(nSelStart,1);
- end;
-
- begin
- sText := '';
- pText := PChar(FDateText);
-
- case FKind of
- dkDate :
- DateFormatStr := Format(EDIT_FMT_DEDATE, [DateSeparator]);
- dkDateTime:
- DateFormatStr := Format(EDIT_FMT_DETIME, [DateSeparator, TimeSeparator]);
- end;
-
- nSelStart := FStartPos;
- AutoComplete := False;
-
- i := 0; j := 1;
- if (j <= Length(DateFormatStr)) and (DateFormatStr[j] = '|') then
- begin
- inc(j);
- if DateFormatStr[j] in [DateSeparator, TimeSeparator] then
- AddToText(DateFormatStr[j], 1)
- else
- case DateFormatStr[j] of
- 'a':
- begin
- AutoComplete := True;
- inc(j);
- end;
- else
- AddToText(DateFormatStr[j], 1)
- end;
- end;
-
- while pText^ <> #0 do
- begin
- if DateFormatStr[j] <> '|' then inc(j);
- if (j <= Length(DateFormatStr)) and (DateFormatStr[j] = '|') then
- begin
- inc(j);
- if DateFormatStr[j] in [DateSeparator, TimeSeparator] then
- begin
- AddToText(pText^, 0);
- AddToText(DateFormatStr[j], 1)
- end
- else
- case DateFormatStr[j] of
- 'a':
- begin
- AutoComplete := True;
- inc(j);
- continue;
- end;
- else begin
- AddToText(pText^, 0);
- AddToText(DateFormatStr[j], 1)
- end;
- end;
- if DateFormatStr[j] <> '|' then inc(j);
- end
- else
- AddToText(pText^, 0);
- inc(i);
- inc(pText);
- end;
-
- if AutoComplete then
- begin
- while j <= Length(DateFormatStr) do
- begin
- if DateFormatStr[j] <> '|' then
- AddToText(DateFormatStr[j], 1)
- else begin
- inc(j);
- AddToText(DateFormatStr[j], 1)
- end;
- inc(j);
- inc(i);
- end;
- end;
-
- Text := sText;
- SelStart := nSelStart;
- end;
-
- procedure TDCCustomDateEdit.SetText(var Key: char);
- var
- MaxTextLength: integer;
- begin
- GetDateText;
- case Key of
- Char(VK_BACK): {BACKSPACE}
- begin
- DeleteChar(dtBackSpace);
- Key := #0;
- end;
- end;
-
- case FKind of
- dkDate :
- MaxTextLength := 8;
- dkDateTime:
- MaxTextLength := 14;
- else
- MaxTextLength := 8;
- end;
-
- if Key in SetDateEdit then
- begin
- if (FStartPos+1 <> FEndPos) or (SelLength>0) then DeleteChar(dtDelete);
- if Length(FDateText) < MaxTextLength then
- FDateText := Copy(FDateText,1,FStartPos) + Key +
- Copy(FDateText,FStartPos+1,Length(FDateText)-FStartPos)
- else begin
- if FStartPos >= MaxTextLength then FStartPos := MaxTextLength-1;
- if Key in Digits then
- FDateText := Copy(FDateText,1,FStartPos) + Key +
- Copy(FDateText,FStartPos+2,Length(FDateText)-FStartPos-1);
- end;
- Inc(FStartPos,1);
- end;
- SetDateText;
-
- Key := #0;
- end;
-
- procedure TDCCustomDateEdit.DeleteChar(DeleteType: TDeleteType);
- begin
- case DeleteType of
- dtBackSpace:
- begin
- if FStartPos+1 = FEndPos then
- FDateText := Copy(FDateText,1,FStartPos-1)+
- Copy(FDateText,FEndPos,Length(FDateText)-FEndPos+1)
- else
- FDateText := Copy(FDateText,1,FStartPos)+
- Copy(FDateText,FEndPos+1,Length(FDateText)-FEndPos+2);
- Dec(FStartPos,1);
- end;
- dtDelete :
- begin
- FDateText := Copy(FDateText,1,FStartPos)+
- Copy(FDateText,FEndPos+1,Length(FDateText)-FEndPos+2);
- end;
- end;
- end;
-
- procedure TDCCustomDateEdit.KeyPress(var Key: Char);
- begin
- if FCalendarVisible and (FCalendar<>nil) then
- begin
- case Key of
- Char(VK_RETURN):
- begin
- CloseUp(1, True);
- if not PerformCloseUp then Key := #0;
- end;
- Char(VK_ESCAPE): begin CloseUp(0, True); Key := #0; end;
- end;
- end;
- if not (Key in SetDateEdit) or ReadOnly
- then begin
- if Key <> Chr(VK_ESCAPE) then Key := #0;
- inherited KeyPress(Key);
- end
- else begin
- if Key = Chr(VK_RETURN) then
- begin
- inherited KeyPress(Key);
- Key := #0;
- end
- else begin
- if Key >= Chr(VK_SPACE) then SetText(Key);
- inherited KeyPress(Key)
- end;
- end;
- end;
-
- procedure TDCCustomDateEdit.KeyDown(var Key: Word; Shift: TShiftState);
- var
- KeyDownEvent: TKeyEvent;
- begin
- KeyDownEvent := OnKeyDown;
- if FCalendarVisible and (FCalendar<>nil) then
- begin
- case Key of
- VK_HOME ,
- VK_END ,
- VK_PRIOR,
- VK_NEXT ,
- VK_LEFT ,
- VK_UP ,
- VK_RIGHT,
- VK_DOWN :
- if Shift = [] then
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- FCalendar.KeyDown(Key, Shift);
- Key := 0;
- end
- else
- CloseUp(0);
- end;
- end
- else begin
- case Key of
- VK_DOWN :
- if [ssAlt]*Shift = [ssAlt] then
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if Key <> 0 then ChoiceButtonDown;
- Key := 0;
- end;
- VK_DELETE :
- if not ReadOnly then
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if Key <> 0 then
- begin
- GetDateText;
- DeleteChar(dtDelete);
- SetDateText;
- Key := 0;
- end;
- end;
- end;
- end;
- if Key <> 0 then inherited;
- end;
-
- function TDCCustomDateEdit.GetShowCheckBox: boolean;
- begin
- Result := FShowCheckBox;
- end;
-
- procedure TDCCustomDateEdit.CheckClick(Sender: TObject);
- begin
- HideCaret(Handle);
- HideErrorMessage;
- if FDisableButtons then
- begin
- SetCaret;
- Exit;
- end;
- if not Focused then SetFocus;
- if Focused then
- begin
- if DropDownVisible then CloseUp(0, True);
- Checked := not Checked;
- if Assigned(FOnCheckClick) then FOnCheckClick(Self);
- end;
- SetCaret;
- end;
-
- procedure TDCCustomDateEdit.CMCancelMode(var Message: TCMCancelMode);
- begin
- if (Message.Sender <> Self) and
- (Message.Sender <> FCalendar) and
- not FCalendar.ContainsControl(Message.Sender) then
- begin
- inherited;
- end;
- end;
-
- procedure TDCCustomDateEdit.KillFocus(var Value: boolean);
- var
- xDate: string;
- begin
- if CanModified and not Value and not DateToStrY2K(Text, xDate, Kind) and
- not(Trim(Text) = '') then
- begin
- Value := True;
- xDate := Text;
- FErrorCode := ERR_DATE_INCORRECTDATE;
- end;
- if CanModified and not Value and not FCanEmpty and Empty then
- begin
- Value := True;
- FErrorCode := ERR_EDIT_EMPTYVALUE;
- end;
- if not Value and CanModified then
- begin
- Text := xDate;
- if FShowWeekDay then invalidate;
- end;
- inherited KillFocus(Value);
- end;
-
- constructor TDCCustomDateEdit.Create(AOwner: TComponent);
- begin
- inherited;
- FShowCheckBox := False;
- FShowWeekDay := True;
- FChecked := True;
- FKind := dkDate;
- FReadOnly := ReadOnly;
- FInCheckProc := False;
- end;
-
- function TDCCustomChoiceEdit.PaintCheckGlyph: boolean;
- begin
- Result := FShowCheckBox and Assigned(FCheckGlyph) and not FCheckGlyph.Empty and
- ((Width-FCheckGlyph.Width) >= MinControlWidthBitmap);
- end;
-
- procedure TDCCustomDateEdit.EMSetReadOnly(var Message: TMessage);
- begin
- inherited;
- if not FInCheckProc then FReadOnly := ReadOnly;
- end;
-
- procedure TDCCustomDateEdit.GetHintOnError;
- begin
- case FErrorCode of
- ERR_DATE_INCORRECTDATE: FErrorHint := LoadStr(RES_DATE_ERR_WRONG);
- else
- FErrorHint := '';
- end;
- inherited;
- end;
-
- function TDCCustomDateEdit.GetDate: TDateTime;
- var
- xDate: string;
- begin
- if DateToStrY2K(Text, xDate, Kind) then
- Result := StrToDateTime(xDate)
- else
- Result := 0;
- end;
-
- procedure TDCCustomDateEdit.SetDate(const Value: TDateTime);
- var
- xDate: string;
- begin
- if DateToStrY2K(Value, xDate, Kind) then
- begin
- Text := xDate;
- UndoDate := Value;
- end;
- end;
-
- function TDCCustomDateEdit.GetDropDownVisible: boolean;
- begin
- Result := FCalendarVisible;
- end;
-
- procedure TDCCustomDateEdit.DefineBtnChoiceStyle;
- begin
- if BtnChoiceAssigned then
- begin
- Glyph.LoadFromResourceName(HInstance, 'DC_BTNPOPUP');
- ButtonStyle := esDropDown;
- ButtonChoiceStyle := btsCustom;
- ButtonChoice.SimpleStyle := True;
- end;
- end;
-
- procedure TDCCustomDateEdit.CMPopupWindow(var Message: TMessage);
- var
- xDate: string;
- begin
- case Message.WParam of
- 0:
- if FCalendarVisible then
- begin
- FCalendarVisible := False;
- FCalendar.Free;
- FCalendar := nil;
- ShowHint := FHintShow;
- end;
- 1:
- begin
- SetChecked(True);
- FHintShow := ShowHint;
- ShowHint := False;
- FCalendar := TDCCustomCalendar.Create(Self);
- with FCalendar do
- begin
- OnCloseUp := CloseUp;
- end;
- try
- if Trim(Text) = ''
- then FCalendar.Date := SysUtils.Date
- else begin
- if DateToStrY2K(Text, xDate, Kind)
- then FCalendar.Date := StrToDateTime(xDate)
- else FCalendar.Date := SysUtils.Date;
- end;
- except
- FCalendar.Date := SysUtils.Date;
- end;
- ShowDropDown;
- FCalendarVisible := True;
- end;
- end;
- end;
-
- procedure TDCCustomDateEdit.SetMargins(var LeftMargin: integer;
- var RightMargin: integer);
- begin
- inherited SetMargins(LeftMargin, RightMargin);
- if ShowWeekDay then
- begin
- if PaintCheckGlyph then
- LeftMargin := FCheckGlyph.Width + 2
- else
- LeftMargin := 0;
- LeftMargin := LeftMargin + Length(ShortDayNames[1])*GetDCTextWidth(Font, 'W');
- end;
- end;
-
- procedure TDCCustomDateEdit.SetKind(const Value: TDateEditKind);
- begin
- FKind := Value;
- Date := Date;
- end;
-
- procedure TDCCustomDateEdit.DoDrawMargins(DC: HDC);
- var
- R: TRect;
- begin
- inherited;
- if FShowWeekDay then
- begin
- SelectObject(DC, Font.Handle);
- if not Enabled and not(csDesigning in ComponentState) then
- SetTextColor(DC, ColorToRGB(clInactiveCaption))
- else
- SetTextColor(DC, ColorToRGB(Font.Color));
- SetBkColor(DC, ColorToRGB(Color));
-
- GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top);
-
- if PaintCheckGlyph then R.Left := R.Left + FCheckGlyph.Width + 2;
- case FDrawStyle of
- fsNone :
- begin
- InflateRect(R, -1, -1);
- R.Left := R.Left -1;
- end;
- fsSingle :
- InflateRect(R, -3, -3);
- fcsNormal,
- fsFlat :
- InflateRect(R, -3, -3);
- end;
-
- if FUndoDate <> 0 then
- DrawText(DC, PChar(ShortDayNames[DayOfWeek(FUndoDate)]),
- Length(ShortDayNames[DayOfWeek(FUndoDate)]), R, DT_LEFT);
- end;
- end;
-
- procedure TDCCustomDateEdit.SetFontColor(Value: TColor);
- begin
- if [csDesigning, csLoading]*ComponentState = [] then Font.Color := Value;
- end;
-
- procedure TDCCustomDateEdit.CMEnter(var Message: TCMEnter);
- begin
- inherited;
- UndoDate := GetDate;
- end;
-
- procedure TDCCustomDateEdit.CMExit(var Message: TCMExit);
- begin
- inherited;
- UndoDate := GetDate;
- end;
-
- procedure TDCCustomDateEdit.SetUndoDate(const Value: TDateTime);
- begin
- if Value <> FUndoDate then
- begin
- FUndoDate := Value;
- end;
- end;
-
-
- procedure TDCCustomDateEdit.SetShowWeekDay(const Value: boolean);
- begin
- FShowWeekDay := Value;
- SetEditRect;
- end;
-
- function TDCCustomDateEdit.IsMasked: boolean;
- begin
- Result := False;
- end;
-
- procedure TDCCustomDateEdit.ShowDropDown;
- begin
- FCalendar.Show;
- end;
-
- function TDCCustomDateEdit.GetEmpty: boolean;
- begin
- Result := (ShowCheckBox and not Checked) or (Date = 0);
- end;
-
- procedure TDCCustomDateEdit.SetCheckGlyph;
- begin
- if FChecked then
- begin
- if not FReadOnly then
- ETGetBitmap(DCGIM_SMALLICON, nsiNormalCheck1, FCheckGlyph)
- else
- ETGetBitmap(DCGIM_SMALLICON, nsiShadowCheck1, FCheckGlyph);
- SetFontColor(FFontColor);
- end
- else begin
- if not FReadOnly then
- ETGetBitmap(DCGIM_SMALLICON, nsiNormalCheck0, FCheckGlyph)
- else
- ETGetBitmap(DCGIM_SMALLICON, nsiShadowCheck0, FCheckGlyph);
- SetFontColor(clInactiveCaption);
- end;
- end;
-
- { TDCCustomGridEdit }
- procedure TDCCustomGridEdit.BeginPaintListBox;
- begin
- inc(FPaintBox);
- end;
-
- function TDCCustomGridEdit.CheckDataValue: boolean;
- var
- Found: boolean;
- AKeyValue: variant;
- ACursor: TCursor;
- begin
- if not FQueryDataSet and (DataSet = nil) then
- begin
- Result := True;
- Exit;
- end;
-
- if not FValues.FLoaded then SetGridValues;
-
- if FErrorCode <> ERR_EDIT_NONE then
- begin
- Result := False;
- Exit;
- end;
-
- if not FQueryDataSet then FDataSet.DisableControls;
-
- ACursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
-
- try
- try
- if Assigned(FOnCheckDataValue) then
- begin
- if not FDataValueSelected then
- begin
- FOnCheckDataValue(Self, Text, FValues.Fields[FDataField].FieldType, Found, AKeyValue);
- if Found then
- SetKeyValue(AKeyValue)
- else
- ClearValue(False);
- end
- else Found := True;
- Result := Found;
- end
- else begin
- if not FDataValueSelected then
- begin
- if FQueryDataSet then
- begin
- try
- OpenQuery(0);
- if FQuery.RecordCount > 0 then
- begin
- Text := FQuery.FieldByName(FDataField).AsString;
- AKeyValue := FQuery.FieldByName(FKeyField).AsVariant;
- SetKeyValueEx(AKeyValue, FNeedLocate);
- Result := True;
- end
- else begin
- ClearValue(False);
- Result := False;
- end;
- FQuery.Close;
- except
- Result := False;
- end;
- end
- else begin
- if DataSet.Active and DataSet.Locate(FDataField,Text, [loCaseInsensitive]) then
- begin
- AKeyValue := DataSet.FieldByName(FKeyField).AsVariant;
- SetKeyValueEx(AKeyValue, FNeedLocate);
- Result := True;
- end
- else begin
- ClearValue(False);
- Result := False;
- end
- end;
- end
- else Result := True;
- end;
- except
- Result := False;
- end
- finally
- if not FQueryDataSet then
- while FDataSet.ControlsDisabled do FDataSet.EnableControls;
- Screen.Cursor := ACursor;
- end;
- end;
-
- procedure TDCCustomGridEdit.ChoiceClick(Sender: TObject);
- begin
- inherited;
- if DropDownVisible then
- CloseUp(0, True)
- else begin
- if FThreadInUse then begin
- PostMessage(Handle, CM_THREAD_STOP, 0, 0);
- end
- else if FListBoxVisible then
- PostMessage(Handle, CM_THREAD_FREEBOX, 0, 0);
-
- Perform(CM_POPUPWINDOW, 1, 0);
- end;
- end;
-
- procedure TDCCustomGridEdit.ClearValue(ClearText: boolean);
- var
- i: integer;
- begin
- if ClearText then Text := '';
- FKeyValue := null;
- if not FValues.FLoaded then SetGridValues;
- for i := 0 to Values.Count-1 do TGridValue(Values.Items[i]).AsString := '';
- invalidate;
- end;
-
- procedure TDCCustomGridEdit.CloseUp(State: Byte; bPerform: boolean = False);
- var
- i: integer;
- begin
- FNeedLocate := True;
- case State of
- 0:
- begin
- if FListBoxVisible then
- begin
- FListBoxVisible := False;
- if FThreadInUse then
- begin
- PostMessage(Handle, CM_THREAD_STOP, 0, 0);
- end
- else PostMessage(Handle, CM_THREAD_FREEBOX, 0, 0);
- ShowHint := FHintShow;
- end;
- end;
- 1:
- begin
- if FGridVisible and FieldExists(KeyField) then
- begin
- FDataValueSelected := True;
- if FQueryDataSet then
- begin
- FKeyValue := FQuery.FieldByName(KeyField).AsVariant;
- SetDataValues(FQuery);
- end
- else begin
- FKeyValue := FDataSet.FieldByName(KeyField).AsVariant;
- SetDataValues(FDataSet);
- end;
- SendControlMessage(CM_THREAD_LOCATED, 0, 0);
- FNeedLocate := False;
- end;
-
- if FListBoxVisible then
- begin
- FListBoxVisible := False;
- with FListBox do
- begin
- if ItemIndex >= 0 then
- begin
- FDataValueSelected := True;
- FKeyValue := TGridValues(Items.Objects[ItemIndex]).Fields[FKeyField].Value;
- Text := TGridValues(Items.Objects[ItemIndex]).Fields[FDataField].AsString;
-
- with TGridValues(Items.Objects[ItemIndex]) do
- for i := 0 to Count-1 do
- TGridValue(FValues.Items[i]).AsString := TGridValue(Items[i]).AsString;
-
- SendControlMessage(CM_THREAD_LOCATED, 0, 0);
- FNeedLocate := False;
- end;
- end;
- if FThreadInUse then
- begin
- PostMessage(Handle, CM_THREAD_STOP, 0, 0);
- end
- else
- PostMessage(Handle, CM_THREAD_FREEBOX, 0, 0);
- ShowHint := FHintShow;
- end;
- end;
- end;
- inherited;
- FFullQuery := True;
- end;
-
- procedure TDCCustomGridEdit.CMCancelMode(var Message: TCMCancelMode);
- begin
- if (Message.Sender <> Self) and
- (Message.Sender <> FGrid) and
- not FGrid.ContainsControl(Message.Sender) and
- (Message.Sender <> FListBox) and
- not FListBox.ContainsControl(Message.Sender)
- then
- begin
- inherited;
- end;
- end;
-
- procedure TDCCustomGridEdit.CMExit(var Message: TCMExit);
- begin
- if (Text = '') and CanEmpty then ClearValue(True);
- inherited;
- end;
-
- procedure TDCCustomGridEdit.CMPopupWindow(var Message: TMessage);
- var
- i: integer;
- ACursor: TCursor;
- begin
- case Message.WParam of
- 0:
- begin
- if FGridVisible then
- begin
- FGridVisible := False;
- FGrid.Hide;
- FGrid.Free;
- FGrid := nil;
- ShowHint := FHintShow;
- end;
- if FQueryDataSet then
- begin
- if FQuery.Active then FQuery.Close
- end;
- end;
- 1:
- begin
- FHintShow := ShowHint;
- ShowHint := False;
- if not FGridVisible then
- begin
- HideInfoHint;
- FColumnsOrder.Clear;
- FGrid := TDCPopupDBGrid.Create(Self);
- with FGrid do
- begin
- Font := Self.Font;
- Color := Self.Color;
- OptionsEx := OptionsEx - [dgeShadowSelection];
- CanAppend := FCanAppend;
- Parent:= Self;
- PopupAlignment := wpBottomLeft;
- case DrawStyle of
- fcsNormal,
- fsNone : FGrid.PopupBorderStyle := brRaised;
- fsSingle : FGrid.PopupBorderStyle := brRaised;
- fsFlat : FGrid.PopupBorderStyle := brRaised;
- end;
- if FDropDownWidth = 0 then Width := Self.Width
- else Width :=FDropDownWidth;
- DropDownRows := 6;
- Images := FImages;
- Columns := FColumns;
- for i := 0 to FColumns.Count-1 do
- Columns[i].ItemIndex := FColumns[i].ItemIndex;
- InitColumnsOrder;
- end;
- end;
-
- ACursor := Screen.Cursor;
- try
- with FGrid do
- begin
- if FQueryDataSet then
- begin
- Screen.Cursor := crHourGlass;
- OpenQuery(1);
- DataSet := FQuery;
- end
- else begin
- DataSet := FDataSet;
- ActivateDataSet;
- end;
- AdjustNewHeight;
- if SingleClickToSelect then
- OnCellClick := GridCellClick
- else
- OnDblClick := GridDblClick;
- OnTitleClick := GridTitleClick;
- Screen.Cursor := ACursor;
- if not FGridVisible then ShowDropDown;
- end;
- except
- on E: Exception do
- begin
- Screen.Cursor := ACursor;
- FErrorCode := ERR_GRID_EXCEPTONOPEN;
- FErrorHint := E.Message;
- CloseUp(0, True);
- ShowErrorMessage;
- Exit;
- end;
- end;
- FGridVisible := True;
- end;
- end;
- end;
-
- procedure TDCCustomGridEdit.CMThreadError(var Message: TMessage);
- begin
- ShowErrorMessage;
- end;
-
- procedure TDCCustomGridEdit.CMThreadFindCmplt(var Message: TMessage);
- begin
- {}
- end;
-
- procedure TDCCustomGridEdit.CMThreadFreeBox(var Message: TMessage);
- var
- i: Integer;
- begin
- while FPaintBox > 0 do Sleep(10);
- FListBoxVisible := False;
- if FListBox <> nil then
- begin
- for i:= 0 to FListBox.Items.Count-1 do
- FListBox.Items.Objects[i].Free;
- FListBox.Free;
- FListBox := nil;
- end;
- end;
-
- procedure TDCCustomGridEdit.CMThreadHideBox(var Message: TMessage);
- begin
- if FListBoxVisible and (FListBox <> nil) then FListBox.Hide;
- end;
-
- procedure TDCCustomGridEdit.CMThreadItemAdd(var Message: TMessage);
- var
- GridValues: TGridValues;
- begin
- GridValues := TGridValues(Message.LParam);
- if (FListBox <> nil) and (GridValues.Count>0) then
- begin
- FListBox.SetListHeight(1);
- FListBox.Items.AddObject(GridValues.Fields[FDataField].AsString, GridValues);
- end;
- end;
-
- procedure TDCCustomGridEdit.CMThreadItemClr(var Message: TMessage);
- var
- i: integer;
- begin
- if FListBoxVisible and (FListBox <> nil) then
- begin
- for i:= 0 to FListBox.Items.Count-1 do
- FListBox.Items.Objects[i].Free;
- FListBox.Items.Clear;
- end;
- end;
-
- procedure TDCCustomGridEdit.CMThreadLocated(var Message: TMessage);
- begin
- if (FUpdateCount = 0) and Assigned(FOnValueChange) then FOnValueChange(Self);
- FValueChanged := True;
- end;
-
- procedure TDCCustomGridEdit.CMThreadSetMode(var Message: TMessage);
- begin
- FThreadMode := TThreadMode(Message.WParam);
- PostThreadMessage(GridEditThread.ThreadID, Message.Msg, Message.WParam, Message.LParam);
- end;
-
- procedure TDCCustomGridEdit.CMThreadShowBox(var Message: TMessage);
- begin
- FListBox.Show;
- end;
-
- procedure TDCCustomGridEdit.CMThreadStart(var Message: TMessage);
- begin
- FThreadInUse := True;
- if Assigned(FOnThreadStart) then FOnThreadStart(Self);
- end;
-
- procedure TDCCustomGridEdit.CMThreadStop(var Message: TMessage);
- begin
- FThreadMode := tmStop;
- PostThreadMessage(GridEditThread.ThreadID, Message.Msg, Message.WParam, Message.LParam)
- end;
-
- procedure TDCCustomGridEdit.CMThreadTerminate(var Message: TMessage);
- begin
- try
- GridEditThread.Free;
- GridEditThread := nil;
- FThreadInUse := False;
- finally
- if Assigned(FOnThreadStop) then FOnThreadStop(Self);
- end;
- end;
-
- constructor TDCCustomGridEdit.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FColumns := TDBGridColumns.Create(nil, TColumn);
- FListBoxColumns := TDBGridColumns.Create(nil, TColumn);
- FValues := TGridValues.Create(Self);
- FKeyValue:= null;
- FCloseDataSet:= False;
- FThreadInUse := False;
- FDataValueSelected := False;
- FPopupFindEnabled := True;
- FListBoxVisible := False;
- FThreadMode := tmIdle;
- FListBoxEnabled := False;
- FQueryDataSet := False;
- FFullQuery := True;
-
- FPaintBox := 0;
- FQuery := CreateQuery;
- FCanAppend := False;
-
- FSingleClickToSelect := False;
- FColumnsOrder := TStringList.Create;
-
- FImageChangeLink := TChangeLink.Create;
- FImageChangeLink.OnChange := ImageListChange;
- FShowInfoHint := False;
- end;
-
- procedure TDCCustomGridEdit.DefineBtnChoiceStyle;
- begin
- if BtnChoiceAssigned then
- begin
- Glyph.LoadFromResourceName(HInstance, 'DC_BTNGRID');
- ButtonStyle := esDropDown;
- ButtonChoiceStyle := btsCustom;
- ButtonChoice.SimpleStyle := False;
- end;
- end;
-
- destructor TDCCustomGridEdit.Destroy;
- begin
- if FThreadInUse then
- begin
- PostMessage(Handle, CM_THREAD_TERMINATE, 0, 0);
- WaitForThreadTerminate(50);
- end;
-
- FImageChangeLink.Free;
- FColumnsOrder.Free;
- FValues.Free;
- FColumns.Free;
- FListBoxColumns.Free;
- FQuery.Free;
-
- CloseDataSet;
- inherited;
- end;
-
- procedure TDCCustomGridEdit.GridTitleClick(Column: TColumn);
- var
- i, AIndex: integer;
- IndexChanged: boolean;
- begin
- IndexChanged := False;
- if FGridVisible then with FGrid.Columns do
- begin
- for i := 0 to Count - 1 do
- begin
- AIndex := FColumnsOrder.IndexOf(Items[i].FieldName);
- if (Column.FieldName <> Items[i].FieldName) and (AIndex > -1) and
- (Items[i].IndexStyle = idxNone) then
- FColumnsOrder.Delete(AIndex)
- end;
- end;
- AIndex := FColumnsOrder.IndexOf(Column.FieldName);
- if (AIndex >=0) then
- begin
- if Column.IndexStyle = idxNone then
- FColumnsOrder.Delete(AIndex)
- else
- FColumnsOrder.Objects[AIndex] := TObject(Column.IndexStyle);
- IndexChanged := True;
- end
- else if Column.IndexStyle <> idxNone then
- begin
- AIndex := FColumnsOrder.Add(Column.FieldName);
- FColumnsOrder.Objects[AIndex] := TObject(Column.IndexStyle);
- IndexChanged := True;
- end;
- DoGridTitleClick(IndexChanged, Column);
- end;
-
- procedure TDCCustomGridEdit.EndPaintListBox;
- begin
- dec(FPaintBox);
- end;
-
- function TDCCustomGridEdit.FieldExists(Value: string): boolean;
- begin
- if FQueryDataSet then
- Result := (FQuery.FindField(Value) <> nil)
- else
- Result := (FDataSet <> nil) and (FDataSet.FindField(Value) <> nil);
- end;
-
- function TDCCustomGridEdit.GetDropDownVisible: boolean;
- begin
- Result := FGridVisible or FListBoxVisible;
- end;
-
- procedure TDCCustomGridEdit.GetEntryText;
- begin
- {╧εΦ±Ω ∩ε Ωδ■≈σΓε∞≤ ±δεΓ≤}
- FDataValueSelected := False;
- if (FPopupFindEnabled) and not FGridVisible and FListBoxEnabled and
- Assigned(FDataSet) and not ReadOnly and not FQueryDataSet
- then begin
- if (Length(Text) >= MIN_CMPSTR_LENGTH) then
- begin
- if not FListBoxVisible then
- begin
- FHintShow := ShowHint;
- ShowHint := False;
- FListBox := TDCPopupListBox.Create(Self);
- with FListBox do
- begin
- Font := Self.Font;
- Color := Self.Color;
- Parent := Self;
- Top := Self.Height-2;
- if FListBoxWidth = 0 then
- Width := Self.Width
- else
- Width := FListBoxWidth;
-
- PopupAlignment := wpOffset;
- if PaintCheckGlyph then
- begin
- Left := FCheckGlyph.Width;
- Width := Width - FCheckWidth;
- end
- else Left := -2;
-
- PopupBorderStyle := brSingle;
- DropDownRows := 5;
- OnDrawItem := ListBoxDrawItem;
- OnMouseUp := ListBoxMouseUp;
- FListBoxVisible := True;
- end
- end;
- if not FValues.FLoaded then SetGridValues;
- if FThreadInUse then
- begin
- SendMessage(Handle, CM_THREAD_SETMODE, Integer(tmFind), 0)
- end
- else
- GridEditThread := TGridEditThread.Create(Self, tmFind);
- end
- else begin
- if FThreadInUse then
- PostMessage(Handle, CM_THREAD_STOP, 0, 0);
- PostMessage(Handle, CM_THREAD_FREEBOX, 0, 0);
- end;
- end;
- end;
-
- procedure TDCCustomGridEdit.GetHintOnError;
- begin
- case FErrorCode of
- ERR_GRID_ILLIGALVALUE : FErrorHint := LoadStr(RES_GRID_ERR_WRONG);
- ERR_GRID_EXCEPTONLOCATE :
- if FErrorHint <> '' then
- FErrorHint := Format('/b%s/b0'#10#13'/oh{3}/{%s/}',[LoadStr(RES_GRID_ERR_OPEN), FErrorHint])
- else
- FErrorHint := LoadStr(RES_GRID_ERR_LOCATE);
- ERR_GRID_EXCEPTONFIND : FErrorHint := LoadStr(RES_GRID_ERR_FIND);
- ERR_GRID_EXCEPTONOPEN :
- if FErrorHint <> '' then
- FErrorHint := Format('/b%s/b0'#10#13'/oh{3}/{%s/}',[LoadStr(RES_GRID_ERR_OPEN), FErrorHint])
- else
- FErrorHint := LoadStr(RES_GRID_ERR_OPEN);
- else
- FErrorHint := '';
- end;
- inherited;
- end;
-
- procedure TDCCustomGridEdit.GridDblClick(Sender: TObject);
- begin
- CloseUp(1);
- end;
-
- procedure TDCCustomGridEdit.KeyDown(var Key: Word; Shift: TShiftState);
- var
- KeyDownEvent: TKeyEvent;
- begin
- KeyDownEvent := OnKeyDown;
- if FGridVisible and (FGrid<>nil) then
- case Key of
- VK_PRIOR,
- VK_NEXT ,
- VK_UP ,
- VK_DOWN ,
- VK_LEFT ,
- VK_RIGHT,
- VK_HOME ,
- VK_END :
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- SendMessage(FGrid.Handle, WM_KEYDOWN, Key, 0);
- Key := 0;
- end;
- VK_DELETE : FDataValueSelected := False;
- VK_F2:
- if (Shift=[]) and FQueryDataSet then
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if Key <> 0 then
- begin
- FFullQuery := False;
- Perform(CM_POPUPWINDOW, 1, 0);
- Key := 0;
- end;
- end;
- end
- else begin
- if [ssAlt]*Shift = [ssAlt] then
- begin
- case Key of
- VK_DOWN:
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if Key <> 0 then
- begin
- ChoiceButtonDown;
- Key := 0;
- end;
- end;
- end;
- Exit;
- end;
- if FListBoxVisible and (FListBox<>nil) then
- case Key of
- VK_PRIOR,
- VK_NEXT ,
- VK_UP ,
- VK_DOWN :
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- SendMessage(FListBox.Handle, WM_KEYDOWN, Key, 0);
- Key := 0;
- end;
- VK_DELETE : GetEntryText;
- end
- else
- case Key of
- VK_UP, VK_DOWN:
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if (Key <> 0) and not ReadOnly then
- begin
- if not FQueryDataSet then
- begin
- if FDataSet <> nil then
- begin
- if ActivateDataSet then
- begin
- if VarType(KeyValue) <> varNull then
- begin
- if Key = VK_UP then FDataSet.Prior else FDataSet.Next;
- end
- else
- FDataSet.First;
- if FieldExists(KeyField) then
- SetKeyValue(FDataSet.FieldByName(KeyField).AsVariant);
- end;
- end;
- end
- else begin
- FFullQuery := False;
- ChoiceButtonDown;
- end;
- end;
- Key := 0;
- end;
- VK_DELETE : if not ReadOnly then FDataValueSelected := False;
- end;
- end;
- if Key <> 0 then inherited;
- end;
-
- procedure TDCCustomGridEdit.KeyPress(var Key: Char);
- begin
- if (FGridVisible and (FGrid<>nil)) or
- (FListBoxVisible and (FListBox<>nil) and (FListBox.ListVisible))then
- begin
- case Key of
- Char(VK_RETURN):
- begin
- CloseUp(1, True);
- if not PerformCloseUp then Key := #0;
- end;
- Char(VK_ESCAPE): begin CloseUp(0, True); Key := #0; end;
- else begin
- if FGridVisible and (FGrid<>nil) then
- begin
- FGrid.KeyPress(Key);
- Key := #0;
- end
- else
- inherited KeyPress(Key);
- end;
- end;
- end
- else begin
- case Key of
- Char(VK_ESCAPE):;
- end;
- end;
- inherited KeyPress(Key);
- end;
-
- procedure TDCCustomGridEdit.KeyValueChanged;
- var
- i: integer;
- begin
- if FKeyValue <> null then
- LocateDataSet
- else begin
- if not FValues.FLoaded then SetGridValues;
- Text := '';
- for i := 0 to Values.Count-1 do TGridValue(Values.Items[i]).AsString := '';
- SendControlMessage(CM_THREAD_LOCATED, 0, 0);
- end;
- end;
-
- procedure TDCCustomGridEdit.KillFocus(var Value: boolean);
- begin
- if CanModified and not Value and not((Text='') and CanEmpty) and
- not CheckDataValue then
- begin
- Value := True;
- if FErrorCode = ERR_EDIT_NONE then FErrorCode := ERR_GRID_ILLIGALVALUE;
- end;
- if (FErrorCode = ERR_EDIT_NONE) and (Text = '') and not FDataValueSelected then
- KeyValue := null;
- inherited KillFocus(Value);
- if not Value and not FQueryDataSet then CloseDataSet;
- end;
-
- procedure TDCCustomGridEdit.ListBoxDrawItem(Control: TWinControl;
- Index: Integer; Rect: TRect; State: TOwnerDrawState);
- const
- Alignments: array[Boolean, TAlignment] of DWORD =
- ((ES_LEFT, ES_RIGHT, ES_CENTER),(ES_RIGHT, ES_LEFT, ES_CENTER));
- var
- i: integer;
- sFieldValue: string;
- CurrRect: TRect;
- Column: TColumn;
- GridValue: TGridValue;
- begin
- try
- BeginPaintListBox;
- if FListBoxColumns.Count > 0 then
- begin
- if FListBox <> nil then
- with FListBox do
- begin
- Canvas.FillRect(Rect);
- CurrRect := Rect;
- CurrRect.Right := CurrRect.Left;
- {Draw Info line}
- for i := 0 to FListBoxColumns.Count-1 do
- begin
- Column := FListBoxColumns.Items[i];
- if i = FListBoxColumns.Count-1 then
- CurrRect.Right := Rect.Right
- else
- CurrRect.Right := CurrRect.Right + Column.Width;
- Canvas.Font := Column.Font;
- if odSelected in State then
- begin
- Canvas.Brush.Color := clHighLight;
- Canvas.Font.Color := clHighLightText;
- end
- else begin
- Canvas.Brush.Color := Column.Color;
- Canvas.FillRect(CurrRect);
- end;
- CurrRect.Left := CurrRect.Left + 2;
- GridValue := TGridValues(Items.Objects[Index]).Fields[Column.FieldName];
- if GridValue <> nil then
- begin
- sFieldValue := GridValue.AsString;
- DrawText(Canvas.Handle, PChar(sFieldValue), -1,
- CurrRect, Alignments[UseRightToLeftAlignment, Column.Alignment]);
- CurrRect.Left := CurrRect.Right;
- Canvas.Pen.Color := clBtnShadow;
- if i < FListBoxColumns.Count-1 then begin
- Canvas.MoveTo(CurrRect.Left, CurrRect.Top-1);
- Canvas.LineTo(CurrRect.Left, CurrRect.Bottom);
- end;
- CurrRect.Left := CurrRect.Left + 2;
- if Rect.Left > Width then break;
- end
- else break;
- end;
- end;
- end
- else
- if (FListBox <> nil) and (FListBox.Items.Count>Index)then
- with FListBox do
- begin
- Canvas.FillRect(Rect);
- Rect.Left := Rect.Left + 2;
- DrawText(Canvas.Handle, PChar(Items[Index]), Length(Items[Index]), Rect, 0);
- end;
- finally
- EndPaintListBox;
- end;
- end;
-
- procedure TDCCustomGridEdit.ListBoxMouseUp(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- CloseUp(1);
- end;
-
- procedure TDCCustomGridEdit.Loaded;
- begin
- inherited;
- end;
-
- procedure TDCCustomGridEdit.LocateDataSet;
- var
- Found: boolean;
- begin
- if Assigned(FOnGetDataValue) then
- begin
- FOnGetDataValue(Self, FKeyValue, FValues.Fields[FKeyField].FieldType, Found, FValues);
- if FErrorCode <> ERR_EDIT_NONE then SendMessage(Handle, CM_THREAD_ERROR, 0, 0);
- end
- else begin
- if FQueryDataSet then
- begin
- try
- OpenQuery(2);
- if FQuery.RecordCount > 0 then
- begin
- Found := True;
- SetDataValues(FQuery);
- end
- else
- Found := False;
- FQuery.Close;
- except
- FErrorCode := ERR_GRID_EXCEPTONLOCATE;
- FErrorHint := GetQueryText;
- SendMessage(Handle, CM_THREAD_ERROR, 0, 0);
- end;
- end
- else if FDataSet <> nil then
- begin
- try
- if ActivateDataSet then
- begin
- DataSet.DisableControls;
-
- if not FValues.FLoaded then SetGridValues;
-
- if FieldExists(FDataField) and
- (DataSet.FieldByName(FKeyField).AsString = VarToStr(FKeyValue)) or
- (DataSet.Locate(FKeyField,FKeyValue,[])) then
- begin
- Found := True;
- SetDataValues(FDataSet);
- end
- else
- Found := False;
- while DataSet.ControlsDisabled do DataSet.EnableControls;
- end;
- except
- FErrorCode := ERR_GRID_EXCEPTONLOCATE;
- SendMessage(Handle, CM_THREAD_ERROR, 0, 0);
- end;
- end;
- end;
- if not Found then ClearValue(True);
- SendControlMessage(CM_THREAD_LOCATED, 0, 0);
- end;
-
- procedure TDCCustomGridEdit.SetDataSet(const Value: TDataSet);
- begin
- SetInternalDataSet(Value, FDataSet);
- end;
-
- procedure TDCCustomGridEdit.SetKeyValue(const Value: variant);
- begin
- try
- FKeyValue := Value;
- FDataValueSelected := True;
- KeyValueChanged;
- except
- FErrorCode := ERR_GRID_ILLIGALVALUE;
- ShowErrorMessage;
- end;
- end;
-
- procedure TDCCustomGridEdit.SetKeyValueEx(Value: variant; NeedLocate: boolean);
- begin
- try
- FKeyValue := Value;
- FDataValueSelected := True;
- if NeedLocate or (FQueryDataSet and not FQuery.Active) or
- (not FQueryDataSet and ((FDataSet = nil) or not FDataSet.Active)) then
- KeyValueChanged
- else begin
- if FQueryDataSet then SetDataValues(FQuery) else SetDataValues(FDataSet)
- end;
- except
- FErrorCode := ERR_GRID_ILLIGALVALUE;
- ShowErrorMessage;
- end;
- end;
-
- procedure TDCCustomGridEdit.WaitForThreadTerminate(Count: DWORD);
- begin
- while FThreadinUse do begin
- Sleep(Count);
- Application.ProcessMessages;
- end;
- end;
-
- procedure TDCCustomGridEdit.WMChar(var Message: TWMChar);
- begin
- inherited;
- if not (Message.CharCode in [0, 13, 27]) and not ReadOnly then GetEntryText;
- end;
-
- procedure TDCCustomGridEdit.WMPaste(var Message: TWMPaste);
- begin
- inherited;
- FDataValueSelected := False;
- end;
-
- function TDCCustomGridEdit.GetSQLText: string;
- begin
- Result := FSQLText;
- end;
-
- procedure TDCCustomGridEdit.SetSQLText(const Value: string);
- var
- i: integer;
- SOrderBy: string;
- begin
- SOrderBy := 'ORDER BY ';
- i := Pos(SOrderBy, AnsiUpperCase(Value));
- if i = 0 then
- FSQLText := Value
- else begin
- FSQLText := Copy(Value, 1, i-1);
- FSQLOrderBy := Copy(Value, i + Length(SOrderBy), Length(Value));
- end;
- FValues.Clear;
- FValues.FLoaded := False;
- SetInternalSQLText(Value, FSQLTExt);
- end;
-
- procedure TDCCustomGridEdit.SetListBoxEnabled(const Value: boolean);
- begin
- FListBoxEnabled := Value
- end;
-
- function TDCCustomGridEdit.SetGridValues: boolean;
- var
- i: integer;
- GridValue: TGridValue;
- begin
- Result := True;
- FValues.Clear;
- if FQueryDataSet then
- for i := 0 to FQuery.FieldCount-1 do
- begin
- GridValue := TGridValue.Create(nil);
- try
- with GridValue do
- begin
- FieldName := FQuery.Fields[i].FieldName;
- FieldType := FQuery.Fields[i].DataType;
- end;
- FValues.Fields[GridValue.FieldName] := GridValue;
- finally
- GridValue.Free;
- end;
- FValues.FLoaded := True;
- end
- else begin
- if ActivateDataSet then
- begin
- for i := 0 to DataSet.FieldCount-1 do
- begin
- GridValue := TGridValue.Create(nil);
- try
- with GridValue do
- begin
- FieldName := DataSet.Fields[i].FieldName;
- FieldType := DataSet.Fields[i].DataType;
- end;
- FValues.Fields[GridValue.FieldName] := GridValue;
- finally
- GridValue.Free;
- end;
- end;
- FValues.FLoaded := True;
- end
- else Result := False;
- end;
- end;
-
- procedure TDCCustomGridEdit.SetDataField(const Value: string);
- begin
- FDataField := Value;
- if FSQLDataField = '' then FSQLDataField := FDataField;
- end;
-
- procedure TDCCustomGridEdit.SetKeyField(const Value: string);
- begin
- FKeyField := Value;
- if FSQLKeyField = '' then FSQLKeyField := FKeyField;
- end;
-
- procedure TDCCustomGridEdit.SetSQLDataField(const Value: string);
- begin
- FSQLDataField := Value;
- end;
-
- procedure TDCCustomGridEdit.SetSQLKeyField(const Value: string);
- begin
- FSQLKeyField := Value;
- end;
-
- procedure TDCCustomGridEdit.SetDataValues(ADataSet: TDataSet);
- var
- i: integer;
- begin
- if not FValues.FLoaded then SetGridValues;
-
- Text := ADataSet.FieldByName(FDataField).AsString;
-
- for i := 0 to Values.Count-1 do
- TGridValue(Values.Items[i]).AsString :=
- ADataSet.FieldByName(TGridValue(Values.Items[i]).FieldName).AsString;
-
- if ExistInfo and HandleAllocated then
- begin
- Invalidate;
- HideInfoHint;
- end;
-
- end;
-
- procedure TDCCustomGridEdit.SetMargins(var LeftMargin, RightMargin: integer);
- var
- CharWidth: integer;
- begin
- inherited;
- if ExistInfo and (RightMargin > 0) then
- begin
- RightMargin := RightMargin + FInfoFieldWidth;
- CharWidth := GetCharWidth(Handle, Font);
- if (ClientWidth - RightMargin - LeftMargin - CharWidth) < 0 then
- RightMargin := ClientWidth - LeftMargin - CharWidth;
- end;
- end;
-
- procedure TDCCustomGridEdit.SetInfoField(const Value: string);
- begin
- if AnsiCompareText(FInfoField, Value) <> 0 then
- begin
- FInfoField := Value;
- SetEditRect;
- end;
- end;
-
- procedure TDCCustomGridEdit.SetInfoFieldWidth(const Value: integer);
- begin
- if (Value >= 0) and (FInfoFieldWidth <> Value) then
- begin
- FInfoFieldWidth := Value;
- SetEditRect;
- end;
- end;
-
- function TDCCustomGridEdit.ExistInfo: boolean;
- begin
- Result := (FInfoField <> '') and (FInfoFieldWidth > 0)
- end;
-
- procedure TDCCustomGridEdit.DoDrawMargins(DC: HDC);
- var
- RightMargin: integer;
- R, CalcRect: TRect;
- OldPos: TPoint;
- Value: string;
- GridValue: TGridValue;
- Pen: HPEN;
- Brush: HBRUSH;
- ADefault: boolean;
- begin
- inherited;
- RightMargin := Width - FMargins.Right;
- if ExistInfo and (RightMargin > 0) then
- begin
- GridValue := FValues.Fields[FInfoField];
- if GridValue <> nil then
- Value := FValues.Fields[FInfoField].AsString
- else
- Value := '';
-
- SelectObject(DC, Font.Handle);
- if not Enabled and not(csDesigning in ComponentState) then
- SetTextColor(DC, ColorToRGB(clInactiveCaption))
- else
- SetTextColor(DC, ColorToRGB(Font.Color));
- SetBkColor(DC, ColorToRGB(Color));
-
- R := GetInfoRect;
-
- ADefault := True;
- if Assigned(FOnDrawInfoText) then FOnDrawInfoText(Self, DC, R, Value, ADefault);
-
- if ADefault then
- begin
- if ColorToRGB(Color) = ColorToRGB(clBtnFace) then
- Pen := CreatePen(PS_SOLID, 1, ColorToRGB(clBtnShadow))
- else
- Pen := CreatePen(PS_SOLID, 1, ColorToRGB(clBtnFace));
- Brush := CreateSolidBrush(ColorToRGB(Color));
- try
- SelectObject(DC, Pen);
- MoveToEx(DC, R.Left, R.Top, @OldPos);
- LineTo(DC, R.Left, R.Bottom);
- R.Left := R.Left + 4;
- R.Right := R.Right + 1;
- FillRect(DC, R, Brush);
- R.Right := R.Right - 1;
- CalcRect := R;
- DrawText(DC, PChar(Value), Length(Value), CalcRect, DT_LEFT or DT_CALCRECT);
- if CalcRect.Right > R.Right then
- begin
- CalcRect := R;
- DrawText(DC, PChar(Value), Length(Value), CalcRect, DT_LEFT);
- FShowInfoHint := True;
- end
- else begin
- DrawText(DC, PChar(Value), Length(Value), R, DT_LEFT);
- FShowInfoHint := False;
- end;
- finally
- DeleteObject(Pen);
- DeleteObject(Brush);
- end
- end;
- end;
- end;
-
- procedure TDCCustomGridEdit.SetCanAppend(const Value: boolean);
- begin
- if FCanAppend <> Value then
- begin
- FCanAppend := Value;
- if FGridVisible then CloseUp(0, True);
- end;
- end;
-
- procedure TDCCustomGridEdit.AppendRecord;
- var
- AKeyValue: variant;
- AApply: boolean;
- begin
- {Append New Record}
- CloseUp(0, True);
- if Assigned(FOnAppendRecord) then
- begin
- AKeyValue := KeyValue;
- AApply := True;
- FOnAppendRecord(Self, AKeyValue, AApply);
- if AApply and (AKeyValue <> KeyValue) then KeyValue := AKeyValue;
- end;
- end;
-
- procedure TDCCustomGridEdit.BeginUpdate(HookChanges: boolean = True);
- begin
- if FUpdateCount = 0 then FValueChanged := False;
- inherited;
- end;
-
- procedure TDCCustomGridEdit.EndUpdate;
- var
- ValueChangeEvent: TNotifyEvent;
- begin
- if FUpdateCount > 0 then
- begin
- Dec(FUpdateCount);
- ValueChangeEvent := OnValueChange;
- if (FUpdateCount = 0) and FChanged then
- begin
- if FHookChanges then Change;
- FChanged := False;
- end;
- if (FUpdateCount = 0) and FValueChanged then
- begin
- if Assigned(ValueChangeEvent) and FHookChanges then ValueChangeEvent(Self);
- FChanged := False;
- end;
- end;
- end;
-
- procedure TDCCustomGridEdit.WndProc(var Message: TMessage);
- begin
- inherited;
- end;
-
- function TDCCustomGridEdit.FullQuery: boolean;
- begin
- Result := FFullQuery;
- end;
-
- procedure TDCCustomGridEdit.SetSQLTextPermanet(const Value: string);
- begin
- FSQLText := Value;
- end;
-
- procedure TDCCustomGridEdit.SetQueryDataSet(const Value: boolean);
- begin
- FQueryDataSet := Value;
- end;
-
- function TDCCustomGridEdit.ActivateDataSet: boolean;
- begin
- if (FDataSet <> nil) and (not FDataSet.Active) then
- begin
- try
- FDataSet.Open;
- SetGridValues;
- FCloseDataSet:= True;
- except
- on E: Exception do
- begin
- FErrorCode := ERR_GRID_EXCEPTONOPEN;
- FErrorHint := E.Message;
- end;
- end;
- end;
- Result := (FDataSet <> nil) and (FDataSet.Active);
- end;
-
- function TDCCustomGridEdit.DoMouseWheelDown(Shift: TShiftState;
- MousePos: TPoint): Boolean;
- var
- Key: Word;
- begin
- Result := inherited DoMouseWheelDown(Shift, MousePos);
- if not Result then
- begin
- Key := VK_DOWN;
- KeyDown(Key, Shift);
- Result := True;
- end;
- end;
-
- function TDCCustomGridEdit.DoMouseWheelUp(Shift: TShiftState;
- MousePos: TPoint): Boolean;
- var
- Key: Word;
- begin
- Result := inherited DoMouseWheelUp(Shift, MousePos);
- if not Result then
- begin
- Key := VK_UP;
- KeyDown(Key, Shift);
- Result := True;
- end;
- end;
-
- procedure TDCCustomGridEdit.GridCellClick(Columns: TColumn);
- begin
- CloseUp(1);
- end;
-
- procedure TDCCustomGridEdit.ValidateValue;
- begin
- FDataValueSelected := False;
- end;
-
- function TDCCustomGridEdit.GetGridOrderBy: string;
- var
- i: integer;
- begin
- if FQueryDataSet then
- begin
- Result := FSQLOrderBy;
- for i := 0 to FColumnsOrder.Count - 1 do begin
- case TColumnIndexStyle(FColumnsOrder.Objects[i]) of
- idxNone:
- ;
- idxAscending:
- begin
- if Result <> '' then
- begin
- if Pos(AnsiUpperCase(FColumnsOrder.Strings[i]), AnsiUpperCase(Result)) = 0 then
- Result := Format('%s, %s', [Result, FColumnsOrder.Strings[i]])
- end
- else
- Result := Format(' %s', [FColumnsOrder.Strings[i]])
- end;
- idxDescending:
- begin
- if Result <> '' then
- begin
- if Pos(AnsiUpperCase(FColumnsOrder.Strings[i]), AnsiUpperCase(Result)) = 0 then
- Result := Format('%s, %s DESC', [Result, FColumnsOrder.Strings[i]])
- end
- else
- Result := Format(' %s DESC', [FColumnsOrder.Strings[i]])
- end;
- end;
- end
- end;
- end;
-
- procedure TDCCustomGridEdit.WMNCHitTest(var Message: TWMNCHitTest);
- var
- R: TRect;
- P: TPoint;
- begin
- inherited;
- if FShowInfoHint and not DropDownVisible then
- begin
- R := GetInfoRect;
- P := ScreenToClient(Point(Message.XPos, Message.YPos));
- FInHintInfo := PtInRect(R, P);
- end
- else
- FInHintInfo := False;
-
- if FInHintInfo then
- ShowInfoHint
- else
- HideInfoHint
-
- end;
-
- procedure TDCCustomGridEdit.CMAppendrecord(var Message: TMessage);
- begin
- AppendRecord;
- end;
-
- procedure TDCCustomGridEdit.LocateFirstValue;
- var
- ACursor: TCursor;
- begin
- ACursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- try
- try
- if FQueryDataSet then
- begin
- OpenQuery(1);
- if (FQuery <> nil) and FQuery.Active then
- begin
- FQuery.First;
- FKeyValue := FQuery.FieldByName(FKeyField).AsVariant;
- SetDataValues(FQuery);
- FQuery.Close;
- FDataValueSelected := True;
- end
- else
- KeyValue := null;
- end
- else begin
- if ActivateDataSet then
- begin
- DataSet.DisableControls;
- DataSet.First;
- FKeyValue := DataSet.FieldByName(FKeyField).AsVariant;
- SetDataValues(DataSet);
- while DataSet.ControlsDisabled do DataSet.EnableControls;
- FDataValueSelected := True;
- end
- else
- KeyValue := null;
- end;
- except
- KeyValue := null;
- end;
- finally
- Screen.Cursor := ACursor;
- end;
- end;
-
- procedure TDCCustomGridEdit.InitColumnsOrder;
- var
- i, AIndex: integer;
- begin
- if FGrid = nil then Exit;
- with FGrid.Columns do
- begin
- for i := 0 to Count - 1 do
- begin
- AIndex := FColumnsOrder.IndexOf(Items[i].FieldName);
- if (AIndex > -1) and (Items[i].IndexStyle = idxNone) then
- FColumnsOrder.Delete(AIndex)
- end;
- for i := 0 to Count - 1 do
- begin
- if Items[i].Indexed and (Items[i].IndexStyle <> idxNone)then
- begin
- AIndex := FColumnsOrder.Add(Items[i].FieldName);
- FColumnsOrder.Objects[AIndex] := TObject(Items[i].IndexStyle);
- end;
- end;
- end;
- end;
-
- procedure TDCCustomGridEdit.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if (Operation = opRemove) and (AComponent = FDataSet) then FDataSet := nil;
- if (Operation = opRemove) and (AComponent = FImages) then FImages := nil;
- end;
-
- procedure TDCCustomGridEdit.ImageListChange(Sender: TObject);
- begin
- Invalidate;
- end;
-
- function TDCCustomGridEdit.GetInfoRect: TRect;
- var
- R: TRect;
- begin
- GetWindowRect(Handle, R); OffsetRect (R, -R.Left, -R.Top);
- R.Left := FMargins.Right + 2;
- R.Right := R.Right - GetButtonWidth - 2;
-
- case FDrawStyle of
- fsNone :
- begin
- InflateRect(R, -1, -1);
- R.Left := R.Left -1;
- end;
- fsSingle :
- InflateRect(R, -3, -3);
- fcsNormal,
- fsFlat :
- InflateRect(R, -3, -3);
- end;
- Result := R;
- end;
-
- procedure TDCCustomGridEdit.WMSetCursor(var Message: TWMSetCursor);
- begin
- if FInHintInfo then
- SetCursor(LoadCursor(0, IDC_ARROW))
- else
- inherited;
- end;
-
- procedure TDCCustomGridEdit.HideInfoHint;
- var
- pHintWindow: PHintWindowParam_tag;
- begin
- if (FInfoHintWindow <> nil) and HandleAllocated then
- begin
- GetMem(pHintWindow, SizeOf(THintWindowParam));
- with pHintWindow^ do
- begin
- HMode := 0;
- PHint := nil;
- end;
- SendMessage(Handle, CM_POPUPHINTINFO, Integer(pHintWindow), 0);
- end;
- end;
-
- procedure TDCCustomGridEdit.ShowInfoHint;
- var
- pHintWindow: PHintWindowParam_tag;
- R: TRect;
- Value: string;
- GridValue: TGridValue;
- begin
- if (FInfoHintWindow = nil) and HandleAllocated then
- begin
- GridValue := FValues.Fields[FInfoField];
- if GridValue <> nil then
- Value := FValues.Fields[FInfoField].AsString
- else
- Value := '';
- GetMem(pHintWindow, SizeOf(THintWindowParam));
- R := GetInfoRect;
- case FDrawStyle of
- fsNone: OffsetRect(R, 2, 2);
- fsSingle: OffsetRect(R, -1, -1);
- end;
- with pHintWindow^ do
- begin
- HMode := 1;
- HLeft := R.Left - 5;
- HTop := R.Top - 4;
- HOff := 3;
- GetMem(PHint, (Length(Value) + 1) * SizeOf(Char));
- StrPCopy(PHint, Value);
- end;
- SendMessage(Handle, CM_POPUPHINTINFO, Integer(pHintWindow), 1);
- end;
- end;
-
- procedure TDCCustomGridEdit.CMPopupHintInfo(var Message: TMessage);
- var
- pHintWindow: PHintWindowParam_tag;
- begin
- pHintWindow := PHintWindowParam_tag(Message.WParam);
- with pHintWindow^ do
- begin
- case HMode of
- 0:
- begin
- FInfoHintWindow.Free;
- FInfoHintWindow := nil;
- end;
- 1:
- begin
- if not Assigned(FInfoHintWindow) then
- begin
- FInfoHintWindow := TDCMessageWindow.Create(Self);
- with FInfoHintWindow do
- begin
- Parent := Self;
- DialogStyle := dsSimple;
- PopupAlignment := wpOffset;
- end;
- end
- else
- FInfoHintWindow.Hide;
-
- with FInfoHintWindow do
- begin
- BeginUpdate;
- Font := Self.Font;
- Caption := PHint;
- Left := HLeft+ HOff;
- Top := HTop;
- MaxTextWidth := 400;
- EndUpdate;
- Show;
- end;
- end;
- end;
- end;
- if Assigned(pHintWindow^.PHint) then FreeMem(pHintWindow^.PHint);
- FreeMem(pHintWindow);
- end;
-
- procedure TDCCustomGridEdit.CMMouseLeave(var Message: TMessage);
- begin
- inherited;
- HideInfoHint;
- end;
-
- procedure TDCCustomGridEdit.CloseDataSet;
- begin
- if FCloseDataSet and (FDataSet <> nil) and (FDataSet.Active) then
- begin
- FDataSet.Active := False;
- FCloseDataSet := False;
- end;
- end;
-
- procedure TDCCustomGridEdit.ShowDropDown;
- begin
- FGrid.Show;
- end;
-
- function TDCCustomGridEdit.GetPreparedQueryText(Mode: integer;
- SQLText: string): string;
- var
- AOrderBy: string;
-
- function GetLexemPos(ALexem, AText: string): integer;
- const
- stDelim: set of char = [' ', #10, #13];
- var
- i: integer;
- begin
- Result := Pos(AnsiUpperCase(ALexem), AnsiUpperCase(AText));
- if (Result > 0) and
- not((AText[Result-1] in stDelim) and (AText[Result+Length(ALexem)] in stDelim)) then
- begin
- i := GetLexemPos(ALexem, Copy(AText, Result+Length(ALexem), MaxInt));
- if i > 0 then
- Result := Result + i - 1 + Length(ALexem)
- else
- Result := 0;
- end;
- end;
- function InsertWhereValue(ASQLText, AText, SQLField: string; Mode: integer; Quota: boolean): string;
- var
- i: integer;
- BSQLText1, BSQLText2: string;
- begin
- i := GetLexemPos(EDIT_STR_UNION, ASQLText);
- if i = 0 then
- begin
- case Mode of
- 0:
- if GetLexemPos(EDIT_STR_WHERE, ASQLText) = 0 then
- begin
- if Quota then
- Result := ASQLText + ' '+ Format(EDIT_FQW_LOCATE, [SQLField, AText])
- else
- Result := ASQLText + ' '+ Format(EDIT_FNW_LOCATE, [SQLField, AText])
- end
- else begin
- if Quota then
- Result := ASQLText + ' '+ Format(EDIT_FQA_LOCATE, [SQLField, AText])
- else
- Result := ASQLText + ' '+ Format(EDIT_FNA_LOCATE, [SQLField, AText]);
- end;
- 1:
- if GetLexemPos(EDIT_STR_WHERE, ASQLText) = 0 then
- Result := ASQLText + ' '+ Format(EDIT_FQW_LIKE, [SQLField, AText])
- else
- Result := ASQLText + ' '+ Format(EDIT_FQA_LIKE, [SQLField, AText]);
- end;
- end
- else begin
- BSQLText1 := (Copy(ASQLText, 1, i-1));
- BSQLText2 := (Copy(ASQLText, i+Length(EDIT_STR_UNION), maxInt));
- Result := InsertWhereValue(BSQLText1, AText, SQLField, Mode, Quota) + #13#10 +
- EDIT_STR_UNION + InsertWhereValue(BSQLText2, AText, SQLField, Mode, Quota);
- end;
- end;
-
- begin
- case Mode of
- 0: {locate}
- SQLText := InsertWhereValue(SQLText, Self.Text, FSQLDataField, 0, True);
- 1: {like}
- begin
- if (Length(Self.Text) >= 0) and not FFullQuery then
- SQLText := InsertWhereValue(SQLText, Self.Text, FSQLDataField, 1, True);
- AOrderBy := GetGridOrderBy;
- if AOrderBy <> '' then begin
- if GetLexemPos('ORDER BY', SQLText) = 0 then
- SQLText := SQLText + ' '+ Format('ORDER BY %s', [AOrderBy])
- else
- SQLText := SQLText + ' '+ Format(', %s', [AOrderBy])
- end;
- end;
- 2: {set KeyValue}
- begin
- SQLText := InsertWhereValue(SQLText, VarToStr(FKeyValue), FSQLKeyField, 0,
- not(VarType(FKeyValue) in [varSmallint, varInteger, varSingle, varDouble, varCurrency, varByte]));
- end;
- end;
- Result := SQLText;
- end;
-
- procedure TDCCustomGridEdit.OpenQuery(Mode: integer);
- begin
- Query.DisableControls;
- try
- PrepareDataSet;
- DoInitQuery(Mode);
- if not FDataValueSelected then SetGridValues;
- finally
- Query.EnableControls;
- end;
- end;
-
- procedure TDCCustomGridEdit.SendControlMessage(Message, WParam, LParam: integer);
- begin
- if (Parent <> nil) and (Handle <> 0) then SendMessage(Handle, Message, WParam, LParam);
- end;
-
- procedure TDCCustomGridEdit.DoGridTitleClick(IndexChanged: boolean; Column: TColumn);
- begin
- if Assigned(FOnGridTitleClick) then
- FOnGridTitleClick(Column)
- else
- if FQueryDataSet and IndexChanged then Perform(CM_POPUPWINDOW, 1, 0)
- end;
-
- procedure TDCCustomGridEdit.SetImages(const Value: TImageList);
- begin
- if Images <> nil then
- Images.UnRegisterChanges(FImageChangeLink);
- FImages := Value;
- if Images <> nil then
- begin
- Images.RegisterChanges(FImageChangeLink);
- Images.FreeNotification(Self);
- end;
- if DropDownVisible then invalidate;
- end;
-
- { TGridEditThread }
-
- procedure TGridEditThread.AddValue;
- var
- i: integer;
- GridValues: TGridValues;
- GridValue: TGridValue;
- begin
- with FGridEdit, FGridEdit.DataSet do
- begin
- if not Assigned(FListBox) then Exit;
- if not FListBox.ListVisible then
- SendMessage(FGridEdit.Handle, CM_THREAD_SHOWBOX, 0, 0);
- GridValues := TGridValues.Create(nil);
- for i := 0 to Values.Count-1 do
- begin
- GridValue := TGridValue.Create(nil);
- with GridValue do
- begin
- FieldName := TGridValue(Values.Items[i]).FieldName;
- FieldType := TGridValue(Values.Items[i]).FieldType;
- end;
- GridValues.Fields[GridValue.FieldName] := GridValue;
- GridValue.Free;
- end;
- for i := 0 to GridValues.Count-1 do
- TGridValue(GridValues.Items[i]).AsString :=
- DataSet.FieldByName(TGridValue(GridValues.Items[i]).FieldName).AsString;
-
- SendMessage(FGridEdit.Handle, CM_THREAD_ITEMADD, 0, LongInt(GridValues));
- end;
- end;
-
- constructor TGridEditThread.Create(GridEdit: TDCCustomGridEdit; Mode: TTHreadMode);
- begin
- FGridEdit := GridEdit;
- Priority := tpHighest ;
- FMode := Mode;
- FGridEdit.FThreadMode := tmIdle;
- FGridEdit.FThreadInUse := True;
- inherited Create(False);
- end;
-
- procedure TGridEditThread.Execute;
- begin
- PostMessage(FGridEdit.Handle, CM_THREAD_START, 0, 0);
- FStoped := False;
- while not FStoped do
- case FMode of
- tmFind : FindDataSet;
- tmStop : FStoped := True;
- end;
- PostMessage(FGridEdit.Handle, CM_THREAD_TERMINATE, 0, 0);
- end;
-
- procedure TGridEditThread.FindDataSet;
- var
- Msg: TMsg;
- begin
- SendMessage(FGridEdit.Handle, CM_THREAD_HIDEBOX, 0, 0);
- SendMessage(FGridEdit.Handle, CM_THREAD_ITEMCLR, 0, 0);
- with FGridEdit, FGridEdit.DataSet do
- begin
- DataSet.DisableControls;
- try
- try
- First;
- while not Eof do
- begin
- if PeekMessage(Msg, 0, 0, 0, PM_REMOVE)
- then begin
- FGridEdit.FThreadMode := tmIdle;
- case Msg.Message of
- CM_THREAD_STOP:
- begin
- SendMessage(FGridEdit.Handle, CM_THREAD_FREEBOX, 0, 0);
- FMode := tmStop;
- while DataSet.ControlsDisabled do DataSet.EnableControls;
- Exit;
- end;
- CM_THREAD_SETMODE:
- begin
- FMode := TThreadMode(Msg.WParam);
- while DataSet.ControlsDisabled do DataSet.EnableControls;
- Exit;
- end;
- end;
- end
- else begin
- if FGridEdit.FThreadMode <> tmIdle then
- begin
- FMode := FGridEdit.FThreadMode;
- PeekMessage(Msg, 0, 0, 0, PM_REMOVE);
- FGridEdit.FThreadMode := tmIdle;
- case FMode of
- tmStop:
- begin
- SendMessage(FGridEdit.Handle, CM_THREAD_FREEBOX, 0, 0);
- while DataSet.ControlsDisabled do DataSet.EnableControls;
- Exit;
- end;
- tmFind:
- begin
- while DataSet.ControlsDisabled do DataSet.EnableControls;
- Exit;
- end;
- end;
- end;
- end;
- if Pos(AnsiUpperCase(Text),
- AnsiUpperCase(FieldByName(FDataField).AsString)) = 1 then
- begin
- AddValue;
- end;
- Next;
- Application.ProcessMessages;
- end;
- except
- FErrorCode := ERR_GRID_EXCEPTONFIND;
- SendMessage(FGridEdit.Handle, CM_THREAD_ERROR, 0, 0);
- end;
- finally
- while DataSet.ControlsDisabled do DataSet.EnableControls;
- end;
- end;
- FStoped := True;
- SendMessage(FGridEdit.Handle, CM_THREAD_FINDCMPLT, 0, 0);
- end;
-
- procedure TGridEditThread.SetFindValue(const Value: string);
- begin
- FFindValue := Value;
- end;
-
- { TGridValue }
-
- constructor TGridValue.Create(AOwner: TCollection);
- begin
- inherited Create(AOwner);
- end;
-
- function TGridValue.GetAsString: string;
- begin
- Result := VarToStr(FValue);
- end;
-
- procedure TGridValue.SetAsString(Value: string);
- begin
- FValue := VarAsType(Value, varString);
- end;
-
- { TGridValues }
-
- function TGridValues.Add: TGridValue;
- begin
- Result := TGridValue(inherited Add);
- end;
-
- constructor TGridValues.Create(AOwner: TComponent);
- begin
- inherited Create(TGridValue);
- FIndex := -1;
- FLoaded := False;
- end;
-
- function TGridValues.GetItem(Field: string): TGridValue;
- var
- Index: integer;
- GridValue: TGridValue;
- begin
- FIndex := -1;
- Result := nil;
- for Index := 0 to Count-1 do
- begin
- GridValue := TGridValue(inherited GetItem(Index));
- if AnsiUpperCase(GridValue.FFieldName) = AnsiUpperCase(Field) then
- begin
- Result := GridValue;
- FIndex := Index;
- Break;
- end
- end;
- end;
-
- procedure TGridValues.SetItem(Field: string; Value: TGridValue);
- var
- GridValue: TGridValue;
- begin
- GridValue := GetItem(Field);
- if FIndex = -1 then begin
- GridValue := TGridValue(Add);
- end;
- GridValue.FieldName:= Value.FieldName;
- GridValue.Value := Value.Value;
- GridValue.FieldType:= Value.FieldType;
- end;
-
- procedure TDCCustomComboBox.GetHintOnError;
- begin
- case FErrorCode of
- ERR_COMBO_ILLIGALVALUE : FErrorHint := LoadStr(RES_COMB_ERR_WRONG);
- else
- FErrorHint := '';
- end;
- inherited;
- end;
-
- procedure TDCCustomComboBox.WMSetCursor(var Message: TWMSetCursor);
- begin
- if NotEditControl then SetCursor(LoadCursor(0, IDC_ARROW)) else inherited;
- end;
-
- procedure TDCCustomComboBox.SetEditing(const Value: boolean);
- var
- sText: string;
- begin
- if FEditing <> Value and (FStyle = csDropDownList) then
- begin
- FEditing := Value;
- sText := Text;
- RecreateWnd;
- Text := sText;
- end;
- end;
-
- procedure TDCCustomComboBox.Clear;
- begin
- FItems.Clear;
- FItemIndex := -1;
- end;
-
- procedure TDCCustomChoiceEdit.SetCaret;
- var
- CaretHeight: integer;
- begin
- inherited;
- CaretHeight := GetCharHeight(Handle, Font);
- CreateCaret(Handle, 0, 1, CaretHeight) ;
- ShowCaret(Handle);
- end;
-
- { TDCCustomTreeEdit }
-
- procedure TDCCustomTreeEdit.ChangeSelected(Sender: TObject; Node: TTreeNode);
- begin
- if not (csDestroying in ComponentState) then
- begin
- if (Selected <> nil) and (Selected.Text <> '') then SetText(Selected.Text)
- end;
- end;
-
- procedure TDCCustomTreeEdit.ChoiceClick(Sender: TObject);
- begin
- inherited;
- if FTreeVisible then
- CloseUp(0, True)
- else
- Perform(CM_POPUPWINDOW, 1, 0);
- end;
-
- procedure TDCCustomTreeEdit.CMCancelMode(var Message: TCMCancelMode);
- begin
- if (Message.Sender <> Self) and
- (Message.Sender <> FTreeView) and
- not FTreeView.ContainsControl(Message.Sender) then
- begin
- inherited;
- end;
- end;
-
- procedure TDCCustomTreeEdit.CMEnter(var Message: TCMEnter);
- begin
- inherited;
- if FStyle = teDropDownList then PaintListItem(Focused and not FTreeVisible);
- end;
-
- constructor TDCCustomTreeEdit.Create(AOwner: TComponent);
- begin
- inherited;
- FTreeVisible := False;
- FTreeView := TDCPopupTreeView.Create(Self);
- ControlStyle:= ControlStyle - [csSetCaption, csFixedHeight];
- with FTreeView do
- begin
- Parent := Self;
- OnChange := ChangeSelected;
- OnKeyPress := TreeViewKeyPress;
- OnDblClick := TreeViewDblClick;
- OnExpanded := Expanded;
- OnExpanding := Expanding;
- OnCollapsed := Collapsed;
- OnCollapsing := Collapsing;
- OnCustomDrawItem := CustomDrawItem;
- case DrawStyle of
- fcsNormal: PopupBorderStyle := brRaised;
- fsNone : PopupBorderStyle := brRaised;
- fsSingle : PopupBorderStyle := brRaised;
- fsFlat : PopupBorderStyle := brRaised;
- end;
- end;
- FTreeInitialized := False;
- FStyle := teDropDownList;
- FNodeSelected := True;
-
- FImageChangeLink := TChangeLink.Create;
- FImageChangeLink.OnChange := ImageListChange;
- end;
-
- procedure TDCCustomTreeEdit.CreateParams(var Params: TCreateParams);
- begin
- inherited;
- if FStyle = teDropDownList then
- begin
- with Params do
- begin
- Style := WS_CHILD or WS_CLIPSIBLINGS;
- AddBiDiModeExStyle(ExStyle);
- if csAcceptsControls in ControlStyle then
- begin
- Style := Style or WS_CLIPCHILDREN;
- ExStyle := ExStyle or WS_EX_CONTROLPARENT;
- end;
- if not (csDesigning in ComponentState) and not Enabled then
- Style := Style or WS_DISABLED;
- if TabStop then Style := Style or WS_TABSTOP;
- if Parent <> nil then
- WndParent := Parent.Handle else
- WndParent := ParentWindow;
- WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS;
- WindowClass.lpfnWndProc := @DefWindowProc;
- WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
- WindowClass.hbrBackground := 0;
- WindowClass.hInstance := HInstance;
- StrPCopy(WinClassName, ClassName);
- end;
- end;
- end;
-
- destructor TDCCustomTreeEdit.Destroy;
- begin
- FImageChangeLink.Free;
- ClearTreeItems;
- FTreeView.Free;
- inherited;
- end;
-
- function TDCCustomTreeEdit.GetSelected: TTreeNode;
- begin
- Result := FTreeView.Selected;
- end;
-
- function TDCCustomTreeEdit.GetTreeView: TTreeView;
- begin
- Result := TTreeView(FTreeView);
- end;
-
- procedure TDCCustomTreeEdit.InitTree;
- begin
- if Assigned(FOnInitTree) then FOnInitTree(Self, TTreeView(FTreeView));
- FTreeInitialized := True;
- end;
-
- procedure TDCCustomTreeEdit.KeyDown(var Key: Word; Shift: TShiftState);
- var
- KeyDownEvent: TKeyEvent;
- begin
- KeyDownEvent := OnKeyDown;
- if FTreeVisible and (FTreeView<>nil) then
- case Key of
- VK_PRIOR,
- VK_NEXT ,
- VK_UP ,
- VK_DOWN ,
- VK_LEFT ,
- VK_RIGHT :
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- SendMessage(FTreeView.Handle, WM_KEYDOWN, Key, 0);
- Key := 0;
- end;
- end
- else begin
- if [ssAlt]*Shift = [ssAlt] then
- begin
- case Key of
- VK_DOWN:
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if Key <> 0 then ChoiceButtonDown;
- Key := 0;
- end;
- end;
- Exit;
- end;
- case Key of
- VK_DOWN:
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if Key <> 0 then ChoiceButtonDown;
- Key := 0;
- end;
- end;
- end;
- case Key of
- VK_DELETE:
- if not ReadOnly then FNodeSelected := False;
- end;
- if Key <> 0 then inherited;
- end;
-
- procedure TDCCustomTreeEdit.KeyPress(var Key: Char);
- begin
- if FTreeVisible and (FTreeView <>nil) then
- begin
- case Key of
- Char(VK_RETURN):
- begin
- CloseUp(1, True);
- if not PerformCloseUp then Key := #0;
- end;
- Char(VK_ESCAPE): begin CloseUp(0, True); Key := #0; end;
- else begin
- FTreeView.KeyPress(Key);
- Key := #0;
- end;
- end;
- end;
- inherited KeyPress(Key);
- end;
-
- procedure TDCCustomTreeEdit.Loaded;
- begin
- inherited;
- if csDesigning in ComponentState then
- Text := Name
- else begin
- if Assigned(Selected) then
- SetText(Selected.Text)
- else
- SetText('');
- end;
- end;
-
- procedure TDCCustomTreeEdit.PaintListItem(bFocused: boolean);
- const
- Alignments: array[Boolean, TAlignment] of DWORD =
- ((DT_LEFT, DT_RIGHT, DT_CENTER),(DT_RIGHT, DT_LEFT, DT_CENTER));
- var
- DC: HDC;
- R: TRect;
- ACanvas: TCanvas;
- ANodeIndex: integer;
- begin
- if not(FStyle = teDropDownList) or (Parent = nil) then Exit;
-
- bFocused := bFocused and not FTreeVisible;
-
- ACanvas := TControlCanvas.Create;
- DC := GetWindowDC(Handle);
-
- GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top);
- if PaintCheckGlyph then R.Left := R.Left + FCheckGlyph.Width + 2;
- if ButtonWidth > 0 then
- begin
- R.Right := R.Right - ButtonWidth;
- if FDrawStyle = fsFlat then R.Right := R.Right - 1
- end;
- case FDrawStyle of
- fsNone :
- begin
- InflateRect(R, -1, -1);
- R.Left := R.Left -1;
- end;
- fsSingle :
- begin
- InflateRect(R, -2, -2);
- R.Right := R.Right -1;
- end;
- fcsNormal,
- fsFlat :
- InflateRect(R, -3, -3);
- end;
-
- ACanvas.Handle := DC;
- ACanvas.Font := Font;
- ACanvas.Brush.Color := Color;
- InflateRect(R, 1, 1);
- FillRect(ACanvas.Handle, R, ACanvas.Brush.Handle);
- InflateRect(R, -1, -1);
-
- if bFocused then
- begin
- ACanvas.Brush.Color := clHighlight;
- ACanvas.Font.Color := clHighlightText;
- end;
-
- try
- if (Selected <> nil) and Assigned(FImages) and (Selected.ImageIndex <> -1)
- then begin
- R.Left := R.Left + 1;
- if bFocused then
- FImages.DrawingStyle := dsTransparent
- else
- FImages.DrawingStyle := dsTransparent;
-
- FImages.Draw(ACanvas, R.Left, R.Top, Selected.ImageIndex, True);
- R.Left := R.Left + FImages.Width + 1;
- end;
- if FDrawStyle = fsNone then
- R.Left := R.Left +1;
- FillRect(ACanvas.Handle, R, ACanvas.Brush.Handle);
- if bFocused then DrawFocusRect(ACanvas.Handle, R);
- InflateRect(R, -1, -1);
- SetBkMode(ACanvas.Handle, TRANSPARENT);
- case FDrawStyle of
- fcsNormal,
- fsFlat ,
- fsNone : R.Top := R.Top -1;
- end;
-
- R.Left := R.Left + 2;
- if Assigned(FOnDrawText) then
- begin
- if Assigned(Selected) then
- ANodeIndex := Selected.Index
- else
- ANodeIndex := -1;
- FOnDrawText(ACanvas, Self, ANodeIndex, R, []);
- end
- else
- DrawText(ACanvas.Handle, PChar(Text), Length(Text), R,
- Alignments[UseRightToLeftAlignment, FAlignment]);
- finally
- ReleaseDC(Handle, DC);
- ACanvas.Handle := 0;
- ACanvas.Free;
- end;
- end;
-
-
- procedure TDCCustomTreeEdit.SetSelected(const Value: TTreeNode);
- begin
- FTreeView.Selected := Value;
- FNodeSelected := True;
- end;
-
- procedure TDCCustomTreeEdit.SetText(Value: string);
- begin
- if Assigned(FOnSetText) then
- FOnSetText(Self)
- else
- Text := Value;
- if (Style = teDropDownList) and Assigned(FOnChange) then
- FOnChange(Self, Selected);
- end;
-
- procedure TDCCustomTreeEdit.SetTreeView(const Value: TTreeView);
- begin
- FTreeView.Items.Assign(Value.Items);
- FImages := TImageList(Value.Images);
- end;
-
- procedure TDCCustomTreeEdit.TreeViewDblClick(Sender: TObject);
- begin
- CloseUp(1);
- end;
-
- procedure TDCCustomTreeEdit.TreeViewKeyPress(Sender: TObject; var Key: Char);
- begin
- inherited;
- end;
-
- procedure TDCCustomTreeEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
- begin
- inherited;
- Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_WANTALLKEYS;
- end;
-
- procedure TDCCustomTreeEdit.WMLButtonDblClk(var Message: TWMLButtonDown);
- begin
- if (FTreeVisible) and (TMessage(Message).WParam = $AE) then CloseUp(1)
- else begin
- if FStyle = teDropDownList then Message.Result := $AE;
- inherited WMLButtonDblClk(Message);
- end;
- end;
-
- procedure TDCCustomTreeEdit.WMPaint(var Message: TWMPaint);
- var
- PS: TPaintStruct;
- begin
- if FStyle = teDropDownList then
- begin
- BeginPaint(Handle, PS);
- RedrawBorder(True, 0);
- PaintListItem(Focused and not FTreeVisible);
- EndPaint(Handle, PS);
- end
- else
- inherited;
- end;
-
- procedure TDCCustomTreeEdit.WMSetCursor(var Message: TWMSetCursor);
- begin
- // inherited;
- SetCursor(LoadCursor(0, IDC_ARROW));
- end;
-
- procedure TDCCustomTreeEdit.WMSetFocus(var Message: TWMSetFocus);
- begin
- inherited;
- if FStyle = teDropDownList then HideCaret(Handle);
- end;
-
- procedure TDCCustomTreeEdit.WndProc(var Message: TMessage);
- begin
- inherited WndProc(Message);
- if csDesigning in ComponentState then Exit;
- case Message.Msg of
- WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
- if (not FInButtonArea and not FInCheckArea) and (Message.WParam <> $AE) and
- (FStyle = teDropDownList)
- then begin
- if not Focused then SetFocus;
- if Focused then
- with FBtnChoice do UpdateButtonState(Left+1, Top+1, True, False);
- end;
- end;
- end;
-
- procedure TDCCustomComboBox.CheckClick(Sender: TObject);
- begin
- inherited;
- if NotEditControl then HideCaret(Handle);
- end;
-
- procedure TDCCustomComboBox.CreateWnd;
- begin
- inherited;
- end;
-
- procedure TDCCustomTreeEdit.CMTextChanged(var Message: TMessage);
- begin
- inherited;
- if (FStyle = teDropDownList) then PaintListItem(Focused and not FTreeVisible);
- end;
-
- procedure TDCCustomTreeEdit.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- inherited;
- if (Operation = opRemove) and (AComponent = FImages) then FImages := nil;
- end;
-
- procedure TDCCustomTreeEdit.CMExit(var Message: TCMExit);
- begin
- inherited;
- if FStyle = teDropDownList then
- begin
- if not ShowError then
- PaintListItem(False)
- else
- PaintListItem(True)
- end;
- end;
-
- function TDCCustomComboBox.MinControlWidthBitmap: integer;
- begin
- if Style <> csDropDownList then
- Result := inherited MinControlWidthBitmap
- else
- Result := 2;
- end;
-
- procedure TDCCustomChoiceEdit.SetLinkControl(const Value: TWinControl);
- begin
- FLinkControl := Value;
- if Value <> nil then Value.FreeNotification(Self);
- end;
-
- procedure TDCCustomChoiceEdit.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if (Operation = opRemove) and (AComponent = FLinkControl) then FLinkControl := nil;
- end;
-
- procedure TDCCustomComboBox.EMGetSel(var Message: TMessage);
- begin
- if FStyle = csDropDownList then
- with Message do
- begin
- lParam := 0;
- wParam := GetTextLen;
- end
- else
- inherited
- end;
-
- procedure TDCCustomTreeEdit.EMGetSel(var Message: TMessage);
- begin
- with Message do
- begin
- lParam := 0;
- wParam := GetTextLen;
- end
- end;
-
- function TDCCustomChoiceEdit.GetDropDownVisible: boolean;
- begin
- Result := False;
- end;
-
- function TDCCustomComboBox.GetDropDownVisible: boolean;
- begin
- Result := FListBoxVisible;
- end;
-
- function TDCCustomTreeEdit.GetDropDownVisible: boolean;
- begin
- Result := FTreeVisible;
- end;
-
- function TDCCustomChoiceEdit.GetButtonWidth: integer;
- begin
- if BtnChoiceAssigned then
- Result := FBtnChoice.Width
- else
- Result := 0
- end;
-
- procedure TDCCustomTreeEdit.Collapsed(Sender: TObject; Node: TTreeNode);
- begin
- if Assigned(FOnCollapsed) then FOnCollapsed(Sender, Node);
- end;
-
- procedure TDCCustomTreeEdit.Collapsing(Sender: TObject; Node: TTreeNode;
- var AllowExpansion: Boolean);
- begin
- if Assigned(FOnCollapsing) then FOnCollapsing(Sender, Node, AllowExpansion);
- end;
-
- procedure TDCCustomTreeEdit.Expanded(Sender: TObject; Node: TTreeNode);
- begin
- if Assigned(FOnExpanded) then FOnExpanded(Sender, Node);
- end;
-
- procedure TDCCustomTreeEdit.Expanding(Sender: TObject; Node: TTreeNode;
- var AllowExpansion: Boolean);
- begin
- if Assigned(FOnExpanding) then FOnExpanding(Sender, Node, AllowExpansion);
- end;
-
- procedure TDCCustomChoiceEdit.AdjustClientRect(var Rect: TRect);
- begin
- inherited;
- Rect.Right := Rect.Right-ButtonWidth;
- end;
-
- procedure TDCCustomChoiceEdit.DefineBtnChoiceStyle;
- begin
- {}
- end;
-
- procedure TDCCustomComboBox.DefineBtnChoiceStyle;
- begin
- if BtnChoiceAssigned then
- begin
- ButtonChoiceStyle := btsCombo;
- ButtonStyle := esDropDown;
- end;
- end;
-
- procedure TDCCustomTreeEdit.DefineBtnChoiceStyle;
- begin
- if BtnChoiceAssigned then
- begin
- Glyph.LoadFromResourceName(HInstance, 'DC_BTNTREE');
- ButtonStyle := esDropDown;
- ButtonChoiceStyle := btsCustom;
- if (FStyle = teDropDownList) and (FDrawStyle = fsSingle) then
- ButtonChoice.Height := ClientHeight;
- ButtonChoice.SimpleStyle := False;
- end;
- end;
-
- procedure TDCCustomComboBox.CMPopupWindow(var Message: TMessage);
- begin
- case Message.WParam of
- 0:
- if FListBoxVisible then
- begin
- FListBoxVisible := False;
- FListBox.Free;
- FListBox := nil;
- ShowHint := FHintShow;
- PaintListItem(Focused);
- end;
- 1:
- begin
- PaintListItem(False);
- FHintShow := ShowHint;
- ShowHint := False;
- DropDown;
- FListBox := TDCPopupListBox.Create(Self);
- FCachedIndex := FItemIndex;
- FCachedText := Text;
- with FListBox do
- begin
- //Color := Self.Color;
- Parent := Self;
- PopupAlignment := wpBottomLeft;
- DropDownRows := DropDownCount;
- case DrawStyle of
- fcsNormal,
- fsNone : FListBox.PopupBorderStyle := brSingle;
- fsSingle : FListBox.PopupBorderStyle := brRaised;
- fsFlat : FListBox.PopupBorderStyle := brRaised;
- end;
- if FDropDownWidth = 0 then Width := Self.Width
- else Width :=FDropDownWidth;
- OnMeasureItem := FOnMeasureItem;
- ItemHeight := FItemHeight;
- Items := Self.Items;
- OnDrawItem := FOnDrawItem;
- OnMouseUp := ListMouseUp;
- if not( (FItemIndex < Self.Items.Count-1) and
- (FItemIndex> -1) and
- (AnsiCompareText(Self.Items.Strings[FItemIndex],Text)=0) ) then
- FItemIndex := GetFirstEntry(False);
- ItemIndex := FItemIndex;
- SelectAll;
- ShowDropDown;
- FListBoxVisible := True;
- end
- end;
- end;
- end;
-
- procedure TDCCustomTreeEdit.CMPopupWindow(var Message: TMessage);
- begin
- case Message.WParam of
- 0:
- if FTreeVisible then
- begin
- FTreeView.Hide;
- FTreeVisible := False;
- ShowHint := FHintShow;
- if FStyle = teDropDownList then PaintListItem(Focused);
- end;
- 1:
- begin
- if FStyle = teDropDownList then PaintListItem(Focused and not FTreeVisible);
- FHintShow := ShowHint;
- ShowHint := False;
- with FTreeView do
- begin
- Color := Self.Color;
- PopupAlignment := wpBottomLeft;
- Images := FImages;
- Caption := DBObject.Caption;
- if FDropDownWidth = 0 then Width := Self.Width
- else Width :=FDropDownWidth;
-
- FTreeVisible := True;
- PaintListItem(Focused and not FTreeVisible);
- if not(csDesigning in ComponentState) then Buttons.SetWndProc;
- if not FTreeInitialized then InitTree;
- SetScrollPos(Handle, SB_HORZ, 0, True);
- ShowDropDown;
- end
- end;
- end;
- end;
-
- procedure TDCCustomChoiceEdit.SetMargins(var LeftMargin: integer;
- var RightMargin: integer);
- var
- CharWidth, ABorderWidth: integer;
- begin
- if PaintCheckGlyph then
- begin
- CharWidth := GetCharWidth(Handle, Font);
- LeftMargin := FCheckGlyph.Width;
- if LeftMargin < CharWidth then
- LeftMargin := CharWidth + 5
- else
- Inc(LeftMargin, 2);
- end
- else
- LeftMargin := 0;
-
- ABorderWidth := 0;
-
- case FDrawStyle of
- fsNone : ABorderWidth := 0;
- fsSingle,
- fcsNormal,
- fsFlat : ABorderWidth := 6;
- end;
- if Assigned(FBtnChoice) then
- begin
- if (Width < MinControlWidthBitmap) then
- begin
- RightMargin := 0;
- FBtnChoice.Free;
- FBtnChoice := nil;
- end
- else begin
- RightMargin := FBtnChoice.Width;
- if (Alignment = taRightJustify) or (Alignment = taCenter) then
- begin
- Inc(RightMargin, 4);
- end;
- end;
- end
- else RightMargin := 0;
-
- Inc(RightMargin, ABorderWidth);
- end;
-
- procedure TDCCustomChoiceEdit.DoDrawMargins(DC: HDC);
- begin
- {}
- end;
-
- procedure TDCCustomTreeEdit.SetStyle(const Value: TTreeEditStyle);
- begin
- FStyle := Value;
- RecreateWnd;
- end;
-
- procedure TDCCustomTreeEdit.KillFocus(var Value: boolean);
- var
- Node: TTreeNode;
- AErrorCode: integer;
- begin
- if CanModified and not FNodeSelected then
- begin
- if Trim(Text) <> '' then
- begin
- AErrorCode := 0;
- if not GetNode(Text, Node, AErrorCode) then
- begin
- Value := True;
- if AErrorCode = 0 then
- FErrorCode := ERR_TREE_ILLIGALVALUE
- else
- FErrorCode := AErrorCode;
- end
- else if Assigned(Node) then SetSelected(Node)
- end;
- end;
- inherited;
- end;
-
- function TDCCustomTreeEdit.GetNode(Value: string;
- var Node: TTreeNode; var ErrorCode: integer): boolean;
- var
- ANode: TTreeNode;
- AValue, AText: string;
- begin
- ANode := FTreeView.Items.GetFirstNode;
- AValue := AnsiUpperCase(Value);
- while ANode <> nil do
- begin
- if Assigned(FOnGetText) then
- FOnGetText(Self, ANode, AText)
- else
- AText := AnsiUpperCase(ANode.Text);
- if (CompareText(AValue, AText) = 0) and CanSelectNode(ANode) then
- begin
- Result := True;
- Node := ANode;
- Exit;
- end;
- if ANode.HasChildren and not ANode.Expanded then
- begin
- ANode.Expand(False);
- ANode.Collapse(False);
- end;
- ANode := ANode.GetNext;
- end;
-
- Result := False;
- end;
-
- procedure TDCCustomTreeEdit.GetHintOnError;
- begin
- case FErrorCode of
- ERR_TREE_ILLIGALVALUE: FErrorHint := LoadStr(RES_TREE_ERR_WRONG);
- else
- FErrorHint := '';
- end;
- inherited;
- end;
-
- procedure TDCCustomTreeEdit.WMPaste(var Message: TWMPaste);
- begin
- inherited;
- FNodeSelected := False;
- end;
-
- procedure TDCCustomTreeEdit.WMChar(var Message: TWMChar);
- begin
- if not (Message.CharCode in [0, 13, 27]) and (Message.KeyData <> 0) and not ReadOnly then
- FNodeSelected := False;
- inherited;
- end;
-
- function TDCCustomTreeEdit.DoMouseWheelDown(Shift: TShiftState;
- MousePos: TPoint): Boolean;
- var
- Key: Word;
- begin
- Result := inherited DoMouseWheelDown(Shift, MousePos);
- if not Result then
- begin
- Key := VK_DOWN;
- KeyDown(Key, Shift);
- Result := True;
- end;
- end;
-
- function TDCCustomTreeEdit.DoMouseWheelUp(Shift: TShiftState;
- MousePos: TPoint): Boolean;
- var
- Key: Word;
- begin
- Result := inherited DoMouseWheelUp(Shift, MousePos);
- if not Result then
- begin
- Key := VK_UP;
- KeyDown(Key, Shift);
- Result := True;
- end;
- end;
-
- procedure TDCCustomTreeEdit.Change;
- begin
- inherited Changed;
- if Assigned(FOnChange) then FOnChange(Self, Selected);
- end;
-
- procedure TDCCustomTreeEdit.CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode;
- State: TCustomDrawState; var DefaultDraw: Boolean);
- begin
- if Assigned(FOnCustomDrawItem) then FOnCustomDrawItem(Sender, Node, State, DefaultDraw);
- end;
-
- procedure TDCCustomTreeEdit.ClearTreeItems;
- begin
- if Assigned(FOnClearItems) then FOnClearItems(Self, TreeView);
- TreeView.Items.Clear;
- FTreeInitialized := False;
- end;
-
- procedure TDCCustomTreeEdit.ImageListChange(Sender: TObject);
- begin
- invalidate;
- end;
-
- procedure TDCCustomTreeEdit.CloseUp(State: Byte; bPerform: boolean);
- var
- lCanSelected: boolean;
- begin
- if FTreeVisible then
- begin
- lCanSelected := CanSelectNode(Selected);
- if (State = 0) or lCanSelected then inherited;
- FNodeSelected := (State = 1) and lCanSelected;
- end
- end;
-
- function TDCCustomTreeEdit.CanSelectNode(Node: TTreeNode): boolean;
- begin
- Result := True;
- if Assigned(FOnSelectNode) then FOnSelectNode(Self, Node, Result);
- end;
-
- procedure TDCCustomTreeEdit.ShowDropDown;
- begin
- FTreeView.Show;
- end;
-
- procedure TDCCustomTreeEdit.SetImages(const Value: TImageList);
- begin
- if Images <> nil then
- Images.UnRegisterChanges(FImageChangeLink);
- FImages := Value;
- if Images <> nil then
- begin
- Images.RegisterChanges(FImageChangeLink);
- Images.FreeNotification(Self);
- end;
- if DropDownVisible then invalidate;
- end;
-
- { TDCCustomFloatEdit }
-
- procedure TDCCustomFloatEdit.ChoiceClick(Sender: TObject);
- begin
- inherited;
- if FCalculatorVisible then
- CloseUp(0, True)
- else
- Perform(CM_POPUPWINDOW, 1, 0);
- end;
-
- procedure TDCCustomFloatEdit.CloseUp(State: Byte; bPerform: boolean = False);
- begin
- case State of
- 0:;
- 1:
- with FCalculator do
- begin
- if (ErrorCode = 0) and IsValidFloat(VisibleParam) then
- begin
- Value := StrToFloat(VisibleParam);
- SendMessage(Self.Handle, EM_SETSEL, 0, -1);
- end;
- end;
- end;
- inherited;
- end;
-
- procedure TDCCustomFloatEdit.CMCancelMode(var Message: TCMCancelMode);
- begin
- if (Message.Sender <> Self) and
- (Message.Sender <> FCalculator) and
- not FCalculator.ContainsControl(Message.Sender) then
- begin
- inherited;
- end;
- end;
-
- procedure TDCCustomFloatEdit.CMPopupWindow(var Message: TMessage);
- begin
- case Message.WParam of
- 0:
- if FCalculatorVisible then
- begin
- FCalculatorVisible := False;
- FCalculator.Free;
- FCalculator := nil;
- ShowHint := FHintShow;
- ShowCaret(Handle);
- end;
- 1:
- begin
- FHintShow := ShowHint;
- ShowHint := False;
- FCalculator:= TDCCustomCalculator.Create(Self);
- HideCaret(Handle);
- with FCalculator do
- begin
- OnCloseUp := CloseUp;
- if IsValidFloat(Self.Text) then VisibleParam := Self.Text;
- VisibleParamToFloat;
- ShowDropDown;
- end;
- FCalculatorVisible := True;
- end;
- end;
- end;
-
- constructor TDCCustomFloatEdit.Create(AOwner: TComponent);
- begin
- inherited;
- Alignment := taRightJustify;
- FDataType := TFloatDataType.Create(Self);
- FMasked := False;
- end;
-
- procedure TDCCustomFloatEdit.DefineBtnChoiceStyle;
- begin
- if BtnChoiceAssigned then
- begin
- Glyph.LoadFromResourceName(HInstance, 'DC_BTNCALC');
- ButtonStyle := esDropDown;
- ButtonChoiceStyle := btsCustom;
- ButtonChoice.SimpleStyle := False;
- end;
- end;
-
- destructor TDCCustomFloatEdit.Destroy;
- begin
- Perform(CM_ERRORMESSAGE, 0, 0);
- FDataType.Free;
- inherited;
- end;
-
- procedure TDCCustomFloatEdit.EditMaskChanged;
- begin
- if not CanEmpty or (Text <> '') then Text := GetEditValue(Text);
- end;
-
- function TDCCustomFloatEdit.GetDropDownVisible: boolean;
- begin
- Result := FCalculatorVisible;
- end;
-
- function TDCCustomFloatEdit.GetEditValue(EditText: string): string;
- begin
- Result := EditText;
- with DataType do
- begin
- case Kind of
- deFloat:
- if not CheckFloat(Result, Precision, Digits) then
- begin
- Result := '0';
- CheckFloat(Result, Precision, Digits);
- end;
- deCurrency:
- if not CheckCurrency(Result, CurrencyDecimals, Digits) then
- begin
- Result := '0';
- CheckCurrency(Result, CurrencyDecimals, Digits);
- end;
- deInteger:
- if not CheckInteger(Result, Digits) then Result := '0'
- end;
- end;
- end;
-
- procedure TDCCustomFloatEdit.GetHintOnError;
- begin
- case FErrorCode of
- ERR_EDIT_INCORRECTFLOAT: FErrorHint := LoadStr(RES_EDIT_ERR_FLOAT);
- ERR_EDIT_INCORRECTCURR : FErrorHint := LoadStr(RES_EDIT_ERR_CURR);
- ERR_EDIT_INCORRECTDEC : FErrorHint := LoadStr(RES_EDIT_ERR_DEC);
- else
- FErrorHint := '';
- end;
- inherited;
- end;
-
- function TDCCustomFloatEdit.GetValue: Extended;
- begin
- Result := StrToFloat(GetEditValue(Text));
- end;
-
- function TDCCustomFloatEdit.IsMasked: boolean;
- begin
- Result := FMasked and inherited IsMasked;
- end;
-
- procedure TDCCustomFloatEdit.KeyDown(var Key: Word; Shift: TShiftState);
- var
- KeyDownEvent: TKeyEvent;
- begin
- KeyDownEvent := OnKeyDown;
- if FCalculatorVisible and (FCalculator<>nil) then
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- FCalculator.KeyDown(Key, Shift);
- Key := 0;
- end
- else
- case Key of
- VK_DOWN:
- if [ssAlt] * Shift = [ssAlt] then
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if Key <> 0 then ChoiceButtonDown;
- Key := 0;
- end;
- end;
- if Key <> 0 then inherited;
- end;
-
- procedure TDCCustomFloatEdit.KeyPress(var Key: Char);
- begin
- if FCalculatorVisible and (FCalculator<>nil) and not PerformCloseUp then Key := #0;
- inherited KeyPress(Key);
- end;
-
- procedure TDCCustomFloatEdit.KillFocus(var Value: boolean);
- var
- EditText: string;
-
- function CheckValue(AText: string): string;
- begin
- Result := AText;
- with DataType do
- begin
- case Kind of
- deFloat:
- if not CheckFloat(Result, Precision, Digits) then
- begin
- Value := True;
- FErrorCode := ERR_EDIT_INCORRECTFLOAT;
- end;
- deCurrency:
- if not CheckCurrency(Result, CurrencyDecimals, Digits) then
- begin
- Value := True;
- FErrorCode := ERR_EDIT_INCORRECTCURR;
- end;
- deInteger:
- if not CheckInteger(Result, Digits) then
- begin
- Value := True;
- FErrorCode := ERR_EDIT_INCORRECTDEC;
- end;
- end;
- end;
- end;
-
- begin
- if CanModified and not Value and not(Trim(Text) = '') and not MaskMatched then
- begin
- EditText := CheckValue(Text);
- if not Value then Text := EditText;
- end
- else
- if not(Trim(Text) = '') then
- begin
- EditText := CheckValue(Text);
- if not Value then Self.Value := StrToFloat(EditText);
- end;
- inherited KillFocus(Value);
- end;
-
- procedure TDCCustomChoiceEdit.WMSysCommand(var Message: TWMSysCommand);
- begin
- inherited;
- end;
-
- procedure TDCCustomChoiceEdit.WndProc(var Message: TMessage);
- begin
- case Message.Msg of
- WM_KILLFOCUS: if not DropDownWindow(TWMKillFocus(Message)) and not DropDownMoving then CloseUp(0, True);
- end;
- inherited;
- end;
-
- procedure TDCCustomChoiceEdit.ChoiceButtonDown;
- begin
- if BtnChoiceAssigned and (ButtonStyle=esDropDown) then
- with FBtnChoice do UpdateButtonState(Left+1, Top+1, True, False);
- end;
-
- procedure TDCCustomFloatEdit.SetDataType(const Value: TFloatDataType);
- begin
- FDataType.Assign(Value);
- end;
-
- procedure TDCCustomFloatEdit.SetValue(const Value: Extended);
- begin
- Text := GetEditValue(FloatToStr(Value));
- end;
-
- procedure TDCCustomFloatEdit.ShowDropDown;
- begin
- FCalculator.Show;
- end;
-
- { TFloatDataType }
-
- procedure TFloatDataType.Assign(Source: TPersistent);
- begin
- FKind := TFloatDataType(Source).Kind;
- FPrecision := TFloatDataType(Source).Precision;
- FDigits := TFloatDataType(Source).Digits;
- UpdateMask;
- end;
-
- constructor TFloatDataType.Create(AEdit: TDCCustomMaskEdit);
- begin
- inherited Create;
- FEdit := AEdit;
- FKind := deFloat;
- FPrecision := -1;
- FDigits := -1;
- end;
-
- procedure TFloatDataType.SetDigits(const Value: integer);
- begin
- FDigits := Value;
- UpdateMask;
- end;
-
- procedure TFloatDataType.SetKind(const Value: TEditDataType);
- begin
- FKind := Value;
- case Value of
- deFloat:;
- deInteger:
- Precision := 0;
- deCurrency:
- Precision := 0;
- end;
- UpdateMask;
- end;
-
- procedure TFloatDataType.SetPrecision(const Value: integer);
- begin
- FPrecision := Value;
- UpdateMask;
- end;
-
- function TDCCustomChoiceEdit.IsGlyphStored: boolean;
- begin
- Result := (FBtnChoiceStyle = btsCustom);
- end;
-
- function TDCCustomChoiceEdit.IsButtonWidthStored: boolean;
- begin
- Result := (FBtnChoiceStyle = btsCustom);
- end;
-
- procedure TDCCustomComboBox.WMLButtonDblClk(var Message: TWMLButtonDown);
- begin
- if ButtonEnabled and (FStyle = csDropDownList) then
- begin
- Message.Result := $AE;
- inherited WMLButtonDblClk(Message);
- end
- else inherited;
- end;
-
- function TDCCustomChoiceEdit.CanModified: boolean;
- begin
- Result := inherited CanModified or (ButtonExist and ButtonEnabled);
- end;
-
- function TDCCustomComboBox.DoMouseWheel(Shift: TShiftState;
- WheelDelta: Integer; MousePos: TPoint): Boolean;
- var
- ADelta, AIndex: integer;
- AMessage: TCMMouseWheel;
- begin
- Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
- if not Result then
- begin
- if not FListBoxVisible then
- begin
- ADelta := WheelDelta div WHEEL_DELTA;
- AIndex := ItemIndex - ADelta;
- if (AIndex >= 0) and (AIndex < FItems.Count) then ItemIndex := AIndex;
- Result := True;
- end
- else begin
- AMessage.WheelDelta := WheelDelta;
- AMessage.ShiftState := Shift;
- AMessage.XPos := MousePos.X;
- AMessage.YPos := MousePos.Y;
- with TMessage(AMessage) do
- FListBox.Perform(CM_MOUSEWHEEL, WParam, LParam);
- Result := True;
- end;
- end;
- end;
-
- procedure TFloatDataType.UpdateMask;
- var
- sFormat: string;
- begin
- sFormat := '';
- if FDigits > 0 then
- begin
- if FPrecision > 0 then
- sFormat := Format('9{%d}!(.,%1:s)%1:s9{%d}', [FDigits - FPrecision, DecimalSeparator, FPrecision])
- else
- sFormat := Format('9{%d}', [FDigits])
- end;
- if FEdit <> nil then FEdit.EditMask := sFormat;
- end;
-
- { TDCBDEGridEdit }
-
- function TDCBDEGridEdit.CreateQuery: TDataSet;
- begin
- Result := TQuery.Create(self);
- end;
-
- procedure TDCBDEGridEdit.DoInitQuery(Mode: integer);
- begin
- with TQuery(FQuery) do
- begin
- SQL.Text := GetPreparedQueryText(Mode, SQL.Text);
- Prepare;
- Open;
- end;
- end;
-
- function TDCBDEGridEdit.GetDatabaseName: string;
- begin
- Result := TQuery(FQuery).DatabaseName;
- end;
-
- function TDCBDEGridEdit.GetParams: TParams;
- begin
- Result := TQuery(FQuery).Params;
- end;
-
- function TDCBDEGridEdit.GetQueryText: string;
- var
- i: integer;
- begin
- Result := '';
- for i := 0 to TQuery(Query).SQL.Count -1 do
- begin
- if Result <> '' then Result := Result+ #10;
- Result := Result + TQuery(Query).SQL.Strings[i];
- end;
- end;
-
- procedure TDCBDEGridEdit.PrepareDataSet;
- var
- AParams: TParams;
- begin
- AParams := TParams.Create;
- try
- AParams.Assign(Params);
- with TQuery(FQuery) do
- begin
- Close;
- UnPrepare;
- SQL.Clear;
- SQL.Text := SQLText;
- Params.Assign(AParams);
- end;
- finally
- AParams.Free;
- end;
- end;
-
- procedure TDCBDEGridEdit.SetDatabaseName(const Value: string);
- begin
- TQuery(FQuery).DatabaseName := Value;
- end;
-
- procedure TDCBDEGridEdit.SetInternalDataSet(const Value: TDataSet;
- var DataSet: TDataSet);
- begin
- DataSet := Value;
- if FQuery.Active then FQuery.Close;
- if (FDataSet is TQuery) and not ListBoxEnabled then
- begin
- DatabaseName := TQuery(FDataSet).DatabaseName;
- SQLText := TQuery(FDataSet).SQL.Text;
- end
- else
- if not FQueryDataSet then SQLText := '';
-
- if not FQueryDataSet then
- begin
- if (DataSet <> nil) and DataSet.Active then
- SetGridValues
- else if FValues.FLoaded then
- begin
- FValues.Clear;
- FValues.FLoaded := False;
- end;
- end
- end;
-
- procedure TDCBDEGridEdit.SetInternalSQLText(const Value: string;
- var SQLText: string);
- begin
- if FQuery.Active then FQuery.Close;
- if Value <> '' then TQuery(FQuery).SQL.Text := SQLText;
- end;
-
- procedure TDCBDEGridEdit.SetParams(const Value: TParams);
- begin
- TQuery(FQuery).Params.AssignValues(Value);
- end;
-
- procedure TDCCustomComboBox.DropDown;
- begin
- if Assigned(FOnDropDown) then FOnDropDown(Self);
- end;
-
- { TDCCustomFormEdit }
-
- procedure TDCCustomFormEdit.ChoiceClick(Sender: TObject);
- begin
- inherited;
- if DropDownVisible then
- CloseUp(0, True)
- else
- Perform(CM_POPUPWINDOW, 1, 0);
- end;
-
- procedure TDCCustomFormEdit.CloseUp(State: Byte; bPerform: boolean);
- begin
- case State of
- 0:;
- 1: if DropDownVisible then GetFormResult(FEditForm);
- end;
- inherited;
- end;
-
- procedure TDCCustomFormEdit.CMCancelMode(var Message: TCMCancelMode);
- begin
- inherited;
- end;
-
- procedure TDCCustomFormEdit.CMPopupWindow(var Message: TMessage);
- begin
- case Message.WParam of
- 0:
- begin
- if DropDownVisible then
- begin
- WndProcAction(0);
- FEditForm.Hide;
- end;
- ShowHint := FHintShow;
- ShowCaret(Handle);
- end;
- 1:
- begin
- if FEditForm = nil then CreateEditForm(TCustomForm(FEditForm));
- if FEditForm <> nil then begin
- FHintShow := ShowHint;
- ShowHint := False;
- HideCaret(Handle);
- with TCustomEditForm(FEditForm) do
- begin
- BorderIcons := [];
- BevelKind := bkNone;
- FormStyle := fsStayOnTop;
- end;
- with FEditForm do
- begin
- Caption := DBObject.Caption;
- BorderStyle := bsSizeToolWin;
- with TCustomEditForm(FEditForm) do
- begin
- AutoScroll := False;
- end;
- InitEditFromParams(FEditForm);
- ShowDropDown;
- end;
- end;
- end;
- end;
- end;
-
- constructor TDCCustomFormEdit.Create(AOwner: TComponent);
- begin
- inherited;
- FEditForm := nil;
- {$IFDEF DELPHI_V6}
- FEFNewWndProc := Classes.MakeObjectInstance(EFWndProc);
- FPFNewWndProc := Classes.MakeObjectInstance(PFWndProc);
- {$ELSE}
- FEFNewWndProc := MakeObjectInstance(EFWndProc);
- FPFNewWndProc := MakeObjectInstance(PFWndProc);
- {$ENDIF}
- end;
-
- function TDCCustomFormEdit.CreateEditForm(var EditForm: TCustomForm): boolean;
- begin
- if Assigned(FOnCreateEditForm) then FOnCreateEditForm(Self, EditForm);
- Result := EditForm <> nil;
- end;
-
- procedure TDCCustomFormEdit.DefineBtnChoiceStyle;
- begin
- if BtnChoiceAssigned then
- begin
- ButtonStyle := esDropDown;
- ButtonChoiceStyle := btsCustom;
- end;
- end;
-
- destructor TDCCustomFormEdit.Destroy;
- begin
- if (FEditForm <> nil) then
- begin
- FEditForm.Free;
- FEditForm := nil
- end;
- {$IFDEF DELPHI_V6}
- Classes.FreeObjectInstance(FEFNewWndProc);
- Classes.FreeObjectInstance(FPFNewWndProc);
- {$ELSE}
- FreeObjectInstance(FEFNewWndProc);
- FreeObjectInstance(FPFNewWndProc);
- {$ENDIF}
- inherited;
- end;
-
- function TDCCustomFormEdit.DropDownWindow(Message: TWMKillFocus): boolean;
- var
- Parent: HWND;
- begin
- if FEditForm <> nil then
- begin
- Result := (Message.FocusedWnd = FEditForm.Handle) ;
- if not Result then
- begin
- Parent := GetParent(Message.FocusedWnd);
- while (Parent <> 0) do
- begin
- if Parent = FEditForm.Handle then
- begin
- Result := True;
- Exit;
- end;
- Parent := GetParent(Parent);
- end;
- end;
- end
- else
- Result := inherited DropDownWindow(Message);
- end;
-
- procedure TDCCustomFormEdit.EFWndProc(var Message: TMessage);
- var
- ParentForm: TCustomForm;
- ParentWnd: HWND;
- begin
- try
- with Message do
- begin
- case Msg of
- CM_DEACTIVATE:
- begin
- ParentForm := GetParentForm(Self);
- if not((Screen.ActiveCustomForm = ParentForm) and (ParentForm <> nil) and
- (ParentForm.ActiveControl = Self))
- then
- CloseUp(0, True);
- with FEditForm do if Visible then
- SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
- end;
- CM_CLOSEUP: CloseUp(WParam, True);
- WM_KILLFOCUS:
- with TWMKillFocus(Message) do
- if (FocusedWnd <> Handle) and (FEditForm <> nil) then
- begin
- ParentWnd := GetParent(FocusedWnd);
- while (ParentWnd <> 0) and (ParentWnd <> FEditForm.Handle) do
- ParentWnd := GetParent(ParentWnd);
- if ParentWnd = 0 then CloseUp(0, True);
- end;
- end;
- Result := CallWindowProc(FEFDefWndProc, FEditForm.Handle, Msg, WParam, LParam);
- end;
- except
- {}
- end;
- end;
-
- function TDCCustomFormEdit.GetDropDownVisible: boolean;
- begin
- Result := (FEditForm <> nil) and (FEditForm.Visible);
- end;
-
- procedure TDCCustomFormEdit.GetFormResult(AEditForm: TCustomForm);
- begin
- {}
- end;
-
- procedure TDCCustomFormEdit.InitEditFromParams(AEditForm: TCustomForm);
- var
- P: TPoint;
- begin
- P := Point((ClientWidth - Width) div 2,
- ClientHeight + (Height - ClientHeight) shr 1);
- P := ClientToScreen(P);
- SetRectInDesktop(P, AEditForm.Width, AEditForm.Height,
- Point(0, (Screen.DesktopTop+Screen.DesktopHeight) - P.Y + Height));
-
- AEditForm.Left := P.X;
- AEditForm.Top := P.Y;
- end;
-
- function TDCCustomChoiceEdit.DropDownWindow(Message: TWMKillFocus): boolean;
- begin
- Result := False;
- end;
-
- procedure TDCCustomFormEdit.WndProcAction(Action: integer);
- var
- ParentForm: TCustomForm;
- begin
- if (FEditForm <> nil) and not (csDesigning in ComponentState) then
- begin
- ParentForm := GetParentForm(Self);
- case Action of
- 0:
- begin
- SetWindowLong(FEditForm.Handle, GWL_WNDPROC, LongInt(FEFDefWndProc));
- if (ParentForm <> nil) and ParentForm.HandleAllocated then
- SetWindowLong(ParentForm.Handle, GWL_WNDPROC, LongInt(FPFDefWndProc));
- end;
- 1:
- begin
- FEFDefWndProc := Pointer(GetWindowLong(FEditForm.Handle, GWL_WNDPROC));
- SetWindowLong(FEditForm.Handle, GWL_WNDPROC, LongInt(FEFNewWndProc));
- if (ParentForm <> nil) and ParentForm.HandleAllocated then
- begin
- FPFDefWndProc := Pointer(GetWindowLong(ParentForm.Handle, GWL_WNDPROC));
- SetWindowLong(ParentForm.Handle, GWL_WNDPROC, LongInt(FPFNewWndProc));
- end;
- end;
- end;
- end;
- end;
-
- procedure TDCCustomFormEdit.PFWndProc(var Message: TMessage);
- var
- ParentForm: TCustomForm;
- begin
- try
- ParentForm := GetParentForm(Self);
- with Message do
- begin
- case Msg of
- WM_NCLBUTTONDOWN:
- with TWMNCLButtonDown(Message) do begin
- if (HitTest = HTCAPTION) and not IsIconic(ParentForm.Handle) then CloseUp(0, True);
- end
- end;
- Result := CallWindowProc(FPFDefWndProc, ParentForm.Handle, Msg, WParam, LParam);
- end;
- except
- {}
- end;
- end;
-
- procedure TDCCustomFormEdit.SetInfoFieldWidth(const Value: integer);
- begin
- if (Value >= 0) and (FInfoFieldWidth <> Value) then
- begin
- FInfoFieldWidth := Value;
- SetEditRect;
- end;
- end;
-
- procedure TDCCustomFormEdit.SetMargins(var LeftMargin,
- RightMargin: integer);
- var
- CharWidth: integer;
- begin
- inherited;
- if ExistInfo and (RightMargin > 0) then
- begin
- RightMargin := RightMargin + FInfoFieldWidth;
- CharWidth := GetCharWidth(Handle, Font);
- if (ClientWidth - RightMargin - LeftMargin - CharWidth) < 0 then
- RightMargin := ClientWidth - LeftMargin - CharWidth;
- end;
- end;
-
- function TDCCustomFormEdit.ExistInfo: boolean;
- begin
- Result := FInfoFieldWidth > 0;
- end;
-
- procedure TDCCustomFormEdit.DoDrawMargins(DC: HDC);
- var
- RightMargin: integer;
- R: TRect;
- OldPos: TPoint;
- Value: string;
- Pen: HPEN;
- Brush: HBRUSH;
- ADefault: boolean;
- begin
- inherited;
- RightMargin := Width - FMargins.Right;
- if ExistInfo and (RightMargin > 0) then
- begin
- SelectObject(DC, Font.Handle);
- if not Enabled and not(csDesigning in ComponentState) then
- SetTextColor(DC, ColorToRGB(clInactiveCaption))
- else
- SetTextColor(DC, ColorToRGB(Font.Color));
- SetBkColor(DC, ColorToRGB(Color));
-
- GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top);
-
- R.Left := FMargins.Right + 2;
- R.Right := R.Right - GetButtonWidth - 2;
-
- case FDrawStyle of
- fsNone :
- begin
- InflateRect(R, -1, -1);
- R.Left := R.Left -1;
- end;
- fsSingle :
- InflateRect(R, -3, -3);
- fcsNormal,
- fsFlat :
- InflateRect(R, -3, -3);
- end;
-
- ADefault := True;
- Value := '';
-
- if Assigned(FOnDrawInfoText) then FOnDrawInfoText(Self, DC, R, Value, ADefault);
-
- if ADefault then
- begin
- if ColorToRGB(Color) = ColorToRGB(clBtnFace) then
- Pen := CreatePen(PS_SOLID, 1, ColorToRGB(clBtnShadow))
- else
- Pen := CreatePen(PS_SOLID, 1, ColorToRGB(clBtnFace));
- Brush := CreateSolidBrush(ColorToRGB(Color));
- try
- SelectObject(DC, Pen);
- MoveToEx(DC, R.Left, R.Top, @OldPos);
- LineTo(DC, R.Left, R.Bottom);
- R.Left := R.Left + 4;
- FillRect(DC, R, Brush);
- DrawText(DC, PChar(Value), Length(Value), R, DT_LEFT);
- finally
- DeleteObject(Pen);
- DeleteObject(Brush);
- end
- end;
- end;
- end;
-
- procedure TDCCustomFormEdit.KeyDown(var Key: Word; Shift: TShiftState);
- var
- KeyDownEvent: TKeyEvent;
- begin
- KeyDownEvent := OnKeyDown;
- if not DropDownVisible then
- begin
- if [ssAlt]*Shift = [ssAlt] then
- begin
- case Key of
- VK_DOWN:
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if Key <> 0 then
- begin
- ChoiceButtonDown;
- Key := 0;
- end;
- end;
- end;
- end;
- end;
- if Key <> 0 then inherited;
- end;
-
- procedure TDCCustomFormEdit.KeyPress(var Key: Char);
- begin
- if DropDownVisible then
- begin
- case Key of
- Char(VK_RETURN):
- begin
- CloseUp(1, True);
- if not PerformCloseUp then Key := #0;
- end;
- Char(VK_ESCAPE):
- begin
- CloseUp(0, True);
- Key := #0;
- end;
- else begin
- if Assigned(FEditForm) then TPrivateWinControl(FEditForm).KeyPress(Key);
- end;
- end;
- end;
- inherited KeyPress(Key);
- end;
-
- procedure TDCCustomFormEdit.ShowDropDown;
- begin
- WndProcAction(1);
- FEditForm.Show;
- end;
-
- { TDCCustomMaskEdit }
-
- procedure TDCCustomMaskEdit.CMTextChanged(var Message: TMessage);
- begin
- inherited;
- if IsMasked and (Text = '') then CompleteChars;
- end;
-
- procedure TDCCustomMaskEdit.CompleteChars;
- var
- ASelStart, ASelEnd, MaskEnd: integer;
- S: string;
- begin
- with FMaskStruct do
- begin
- ASelStart := SelStart;
- MaskEnd := 0;
- S := '';
- EMCompeteChar(S, FMaskStruct, MaskEnd, ASelStart, ASelEnd);
- Text := S;
- SetSel(ASelStart, ASelStart);
- end;
- end;
-
- procedure TDCCustomMaskEdit.DeleteKey(Key: Word);
- var
- S: string;
- ASelStart, ASelEnd, MaskEnd: integer;
- begin
- if Key <> 0 then
- begin
- ASelStart := SelStart;
- ASelEnd := 0;
- S := Text;
- if (Key = VK_DELETE) or (SelLength > 0) then
- begin
- MaskEnd := EMDeleteChar(S, FMaskStruct, SelStart, SelStart + SelLength);
- EMCompeteChar(S, FMaskStruct, MaskEnd, ASelStart, ASelEnd);
- end
- else if SelStart > 0 then begin
- MaskEnd := EMDeleteChar(S, FMaskStruct, SelStart - 1, SelStart);
- EMCompeteChar(S, FMaskStruct, MaskEnd, ASelStart, ASelEnd);
- EMClearSymbols(S, FMaskStruct, MaskEnd, ASelStart);
- Dec(ASelStart);
- end;
-
- Text := S;
- SetSel(ASelStart, ASelStart);
- end;
- end;
-
- destructor TDCCustomMaskEdit.Destroy;
- begin
- if IsMasked then EMClear(FMaskStruct);
- inherited;
- end;
-
- procedure TDCCustomMaskEdit.EditMaskChanged;
- begin
- Text := '';
- CompleteChars;
- end;
-
- procedure TDCCustomMaskEdit.GetHintOnError;
- begin
- case FErrorCode of
- ERR_MASK_MATCH:
- FErrorHint := Format('%s /{%s/}',[LoadStr(RES_MASK_ERR_WRONG), FEditMask]);
- end;
- inherited;
- end;
-
- function TDCCustomMaskEdit.GetHintTimeOut: integer;
- begin
- if FErrorCode = ERR_MASK_MATCH then
- Result := 4000
- else
- Result := inherited GetHintTimeOut;
- end;
-
- procedure TDCCustomMaskEdit.InsertString(Insert: string);
- var
- S: string;
- ASelStart, ASelEnd: integer;
- begin
- ASelStart := SelStart;
- ASelEnd := ASelStart + SelLength;
- S := Text;
- EMInsertChar(S, Insert, FMaskStruct, ASelStart, ASelEnd);
- Text := S;
- SelStart := ASelStart;
- SelLength := 0;
- end;
-
- function TDCCustomMaskEdit.IsMasked: boolean;
- begin
- Result := FMaskStruct.Count > 0;
- end;
-
- procedure TDCCustomMaskEdit.KeyDown(var Key: Word; Shift: TShiftState);
- var
- KeyDownEvent: TKeyEvent;
- begin
- if Key = VK_DELETE then Perform(CM_ERRORMESSAGE, 0, 0);
- if IsMasked then
- begin
- KeyDownEvent := OnKeyDown;
- case Key of
- VK_DELETE, VK_BACK:
- if not ReadOnly then
- begin
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- DeleteKey(Key);
- Key := 0;
- end;
- end;
- if Key <> 0 then inherited;
- end
- else
- inherited
- end;
-
- procedure TDCCustomMaskEdit.KeyPress(var Key: Char);
- begin
- if IsMasked and not ReadOnly then
- begin
- if (Key >= Chr(VK_SPACE)) then
- begin
- InsertString(string(Key));
- Key := #0;
- end;
- if Key = Chr(VK_BACK) then Key := #0;
- end;
- inherited;
- end;
-
- procedure TDCCustomMaskEdit.KillFocus(var Value: boolean);
- begin
- if not Value and CanModified and not FCanEmpty and (Trim(Text) = '')
- then begin
- Value := True;
- FErrorCode := ERR_EDIT_EMPTYVALUE;
- end;
- if not Value and CanModified and (Trim(Text) <> '') and not MaskMatched then
- begin
- Value := True;
- FErrorCode := ERR_MASK_MATCH;
- end;
- inherited KillFocus(Value);
- end;
-
- function TDCCustomMaskEdit.MaskMatched: boolean;
- var
- MaskStart, SymbolsCount, MaskEnd: integer;
- AText: string;
- begin
- if IsMasked then
- begin
- AText := Text;
- MaskStart := EMMatches(AText, FMaskStruct, False, SymbolsCount, True, MaskEnd);
- Result := MaskStart > -1;
- if Result and (CompareStr(Text, AText) <> 0) then Text := AText;
- end
- else
- Result := True;
- end;
-
- procedure TDCCustomMaskEdit.SetEditMask(const Value: string);
- begin
- FEditMask := Value;
- EMInitStruct(Value, FMaskStruct);
- EditMaskChanged;
- end;
-
- procedure TDCCustomMaskEdit.SetSel(SelStart, SelEnd: Integer);
- begin
- SendMessage(Handle, EM_SETSEL, SelStart, SelEnd);
- end;
-
- procedure TDCCustomMaskEdit.WMCut(var Message: TMessage);
- begin
- if not IsMasked then
- inherited
- else
- DeleteKey(VK_DELETE);
- end;
-
- procedure TDCCustomMaskEdit.WMPaste(var Message: TMessage);
- var
- Value: string;
- begin
- if not IsMasked then
- inherited
- else begin
- Clipboard.Open;
- Value := Clipboard.AsText;
- Clipboard.Close;
- InsertString(Value);
- end;
- end;
-
- procedure TDCCustomChoiceEdit.CMColorChanged(var Message: TMessage);
- begin
- inherited;
- InvalidateRect(Handle, nil, True);
- end;
-
- procedure TDCCustomChoiceEdit.ShowDropDown;
- begin
- {}
- end;
-
- procedure TDCCustomComboBox.ShowDropDown;
- begin
- FListBox.Show;
- end;
-
- procedure TDCCustomChoiceEdit.SetWordWrap(const Value: Boolean);
- begin
- if Value <> FWordWrap then
- begin
- FWordWrap := Value;
- RecreateWnd;
- end;
- end;
-
- initialization
- TempBitmap := TBitmap.Create;
-
- finalization
- TempBitmap.Free;
-
- end.
-