home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d456 / DCSLIB25.ZIP / DCChoice.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-29  |  208KB  |  7,426 lines
  1. {
  2.  BUSINESS CONSULTING
  3.  s a i n t - p e t e r s b u r g
  4.  
  5.          Components Library for Borland Delphi 4.x, 5.x
  6.          Copyright (c) 1998-2001 Alex'EM
  7.  
  8. }
  9. unit DCChoice;
  10.  
  11. interface
  12. {$I DCConst.inc}
  13.  
  14. uses
  15.   Windows, SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, ImgList,
  16.   {$IFDEF DELPHI_V6}
  17.     Variants,
  18.   {$ENDIF}
  19.   Controls, Dialogs, Forms, StdCtrls, Buttons, ExtCtrls, ComCtrls, DB,
  20.   DBTables, DCEditButton, DCEditTools, DCPopupWindow, DCCalendar, DCDBGrids,
  21.   DCConst, DCCalculator, DCMaskTools;
  22.  
  23. type
  24.   TKillFocusEvent  = procedure (Sender: TObject; var StayOnControl: boolean) of object;
  25.   TCheckGridEvent  = procedure (Sender: TObject; DataValue: string; DataType: TFieldType;
  26.         var Exist: boolean; var KeyValue: variant) of object;
  27.   TGetErrorHint    = procedure (Sender: TObject; ErrorCode: integer; var ErrorHint: string) of object;
  28.   TThreadEvent     = procedure (Sender: TObject) of object;
  29.   TTEInitTreeEvent = procedure (Sender: TObject; TreeView: TTreeView) of object;
  30.   TGridAppendEvent = procedure (Sender: TObject; var KeyValue: variant; var Apply: boolean) of object;
  31.  
  32.   TDCCustomMaskEdit = class;
  33.  
  34.   TFloatDataType = class(TPersistent)
  35.   private
  36.     FEdit: TDCCustomMaskEdit;
  37.     FKind: TEditDataType;
  38.     FPrecision: integer;
  39.     FDigits: integer;
  40.     procedure SetDigits(const Value: integer);
  41.     procedure SetKind(const Value: TEditDataType);
  42.     procedure SetPrecision(const Value: integer);
  43.     procedure UpdateMask;
  44.   public
  45.     constructor Create(AEdit: TDCCustomMaskEdit);
  46.     procedure Assign(Source: TPersistent); override;
  47.   published
  48.     property Kind: TEditDataType read FKind write SetKind;
  49.     property Precision: integer read FPrecision write SetPrecision;
  50.     property Digits: integer read FDigits write SetDigits;
  51.   end;
  52.  
  53.   TDCCustomEdit = class(TCustomEdit)
  54.   private
  55.     FCanEmpty: boolean;
  56.     FErrorHint: string;
  57.     FShowError: boolean;
  58.     FOnKillFocus: TKillFocusEvent;
  59.     FOnShowError: TNotifyEvent;
  60.     FAlignment: TAlignment;
  61.     FErrorCode: integer;
  62.     FMouseActivate: boolean;
  63.     FOnGetErrorHint: TGetErrorHint;
  64.     FDBObject: TDCDBObject;
  65.     FUpdateCount: integer;
  66.     FChanged: boolean;
  67.     FHookChanges: boolean;
  68.     FData: Pointer;
  69.     FOnCreateData: TNotifyEvent;
  70.     FOnDestroyData: TNotifyEvent;
  71.     FOnCloseUp: TNotifyEvent;
  72.     procedure SetAlignment(Value: TAlignment);
  73.     function GetDBObject: TDCDBObject;
  74.     procedure SetDBObject(const Value: TDCDBObject);
  75.     function CanModified: boolean; virtual;
  76.     procedure SetData(const Value: Pointer);
  77.     procedure CreateData;
  78.     procedure DestroyData;
  79.   protected
  80.     procedure GetHintOnError; virtual;
  81.     procedure SetEditRect; virtual;
  82.     procedure CreateParams(var Params: TCreateParams); override;
  83.     procedure CreateWnd; override;
  84.     procedure Change; override;
  85.     procedure DoShowError(AErrorWindow: TDCMessageWindow); virtual;
  86.     function GetHintTimeOut: integer; virtual;
  87.     procedure CloseUp(State: Byte; bPerform: boolean = False); virtual;
  88.     procedure WMMouseActivate(var Message: TWMActivate); message WM_MOUSEACTIVATE;
  89.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  90.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  91.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  92.     procedure CMErrorMessage(var Message: TMessage); message CM_ERRORMESSAGE;
  93.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  94.     procedure DoCloseUp; virtual;
  95.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  96.     property CanEmpty: boolean read FCanEmpty write FCanEmpty default True;
  97.     property OnKillFocus: TKillFocusEvent read FOnKillFocus write FOnKillFocus;
  98.     property OnShowError: TNotifyEvent read FOnShowError write FOnShowError;
  99.     property OnGetErrorHint: TGetErrorHint read FOnGetErrorHint write FOnGetErrorHint;
  100.     property DBObject: TDCDBObject read GetDBObject write SetDBObject;
  101.     property OnCloseUp: TNotifyEvent read FonCloseUp write FOnCloseUp;
  102.   public
  103.     constructor Create(AOwner: TComponent); override;
  104.     destructor Destroy; override;
  105.     procedure KeyPress(var Key: Char);override;
  106.     function ValueCorrect: boolean;
  107.     procedure Deselect;
  108.     procedure KillFocus(var Value: boolean); dynamic;
  109.     procedure ShowErrorMessage;
  110.     procedure HideErrorMessage;
  111.     procedure BeginUpdate(HookChanges: boolean = True); virtual;
  112.     procedure EndUpdate; virtual;
  113.     property ShowError: boolean read FShowError write FShowError;
  114.     property ErrorCode: integer read FErrorCode write FErrorCode;
  115.     property ErrorHint: string read FErrorHint write FErrorHint;
  116.     property Data: Pointer read FData write SetData;
  117.     property OnCreateData: TNotifyEvent read FOnCreateData write FOnCreateData;
  118.     property OnDestroyData: TNotifyEvent read FOnDestroyData write FOnDestroyData;
  119.   end;
  120.  
  121.   TDCCustomMaskEdit = class(TDCCustomEdit)
  122.   private
  123.     FEditMask: string;
  124.     FMaskStruct: TEditMask;
  125.     procedure SetEditMask(const Value: string);
  126.     procedure SetSel(SelStart: Integer; SelEnd: Integer);
  127.     procedure DeleteKey(Key: Word);
  128.     procedure InsertString(Insert: string);
  129.     procedure CompleteChars;
  130.   protected
  131.     function IsMasked: boolean; virtual;
  132.     property EditMask: string read FEditMask write SetEditMask;
  133.     procedure WMCut(var Message: TMessage); message WM_CUT;
  134.     procedure WMPaste(var Message: TMessage); message WM_PASTE;
  135.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  136.     function MaskMatched: boolean;
  137.     procedure GetHintOnError; override;
  138.     function GetHintTimeOut: integer; override;
  139.     procedure EditMaskChanged; virtual;
  140.   public
  141.     destructor Destroy; override;
  142.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  143.     procedure KeyPress(var Key: Char); override;
  144.     procedure KillFocus(var Value: boolean); override;
  145.   end;
  146.  
  147.   TDCEdit = class(TDCCustomMaskEdit)
  148.   published
  149.     property PasswordChar;
  150.     property Anchors;
  151.     property AutoSelect;
  152.     property AutoSize;
  153.     property BiDiMode;
  154.     property CharCase;
  155.     property Color;
  156.     property Constraints;
  157.     property Ctl3D;
  158.     property DragCursor;
  159.     property DragKind;
  160.     property DragMode;
  161.     property Enabled;
  162.     property Font;
  163.     property HideSelection;
  164.     property ImeMode;
  165.     property ImeName;
  166.     property MaxLength;
  167.     property OEMConvert;
  168.     property ParentBiDiMode;
  169.     property ParentColor;
  170.     property ParentCtl3D;
  171.     property ParentFont;
  172.     property ParentShowHint;
  173.     property PopupMenu;
  174.     property ReadOnly;
  175.     property ShowHint;
  176.     property TabOrder;
  177.     property TabStop;
  178.     property Text;
  179.     property Visible;
  180.     property OnChange;
  181.     property OnClick;
  182.     property OnDblClick;
  183.     property OnDragDrop;
  184.     property OnDragOver;
  185.     property OnEndDock;
  186.     property OnEndDrag;
  187.     property OnEnter;
  188.     property OnExit;
  189.     property OnKeyDown;
  190.     property OnKeyPress;
  191.     property OnKeyUp;
  192.     property OnMouseDown;
  193.     property OnMouseMove;
  194.     property OnMouseUp;
  195.     property OnStartDock;
  196.     property OnStartDrag;
  197.     property Alignment;
  198.     property CanEmpty;
  199.     property OnKillFocus;
  200.     property OnShowError;
  201.     property OnGetErrorHint;
  202.     property DBObject;
  203.     property EditMask;
  204.   end;
  205.  
  206.   TDCParentEdit = class(TDCCustomMaskEdit)
  207.   published
  208.     property Anchors;
  209.     property AutoSelect;
  210.     property AutoSize;
  211.     property BiDiMode;
  212.     property CharCase;
  213.     property Color;
  214.     property Constraints;
  215.     property DragCursor;
  216.     property DragKind;
  217.     property DragMode;
  218.     property Enabled;
  219.     property Font;
  220.     property HideSelection;
  221.     property ImeMode;
  222.     property ImeName;
  223.     property MaxLength;
  224.     property OEMConvert;
  225.     property ParentBiDiMode;
  226.     property ParentColor;
  227.     property ParentCtl3D;
  228.     property ParentFont;
  229.     property ParentShowHint;
  230.     property PopupMenu;
  231.     property ShowHint;
  232.     property TabOrder;
  233.     property TabStop;
  234.     property Text;
  235.     property Visible;
  236.     property OnChange;
  237.     property OnClick;
  238.     property OnDblClick;
  239.     property OnDragDrop;
  240.     property OnDragOver;
  241.     property OnEndDock;
  242.     property OnEndDrag;
  243.     property OnEnter;
  244.     property OnExit;
  245.     property OnKeyDown;
  246.     property OnKeyPress;
  247.     property OnKeyUp;
  248.     property OnMouseDown;
  249.     property OnMouseMove;
  250.     property OnMouseUp;
  251.     property OnStartDock;
  252.     property OnStartDrag;
  253.     property Alignment;
  254.     property CanEmpty;
  255.     property OnKillFocus;
  256.     property OnShowError;
  257.     property OnGetErrorHint;
  258.     property DBObject;
  259.   end;
  260.  
  261.   TDCCustomChoiceEdit = class(TDCParentEdit)
  262.   private
  263.     FBtnChoice: TDCEditButton;
  264.     FBtnChoiceStyle: TChoiceBtnStyle;
  265.     FOnButtonClick: TNotifyEvent;
  266.     FButtonExist: Boolean;
  267.     FMouseDown: Boolean;
  268.     FCheckWidth: integer;
  269.     FDrawStyle: TControlStyle;
  270.     FMouseInControl: boolean;
  271.     FChoiceButtonWidth: integer;
  272.     FCheckGlyph: TBitmap;
  273.     FCheckTag: integer;
  274.     FInCheckArea: boolean;
  275.     FOnCheckClick: TNotifyEvent;
  276.     FInButtonArea: boolean;
  277.     FImage: TBitmap;
  278.     FShowCheckBox: boolean;
  279.     FHintShow: boolean;
  280.     FDisableButtons: boolean;
  281.     FLinkControl: TWinControl;
  282.     FMargins: TRect;
  283.     FMultiLine: boolean;
  284.     FPerformCloseUp: boolean;
  285.     FWordWrap: boolean;
  286.     procedure SetBtnChoiceStyle(Value: TChoiceBtnStyle);
  287.     procedure SetCanChoice (Value: Boolean); virtual;
  288.     procedure SetGlyph(Value: TBitmap);
  289.     procedure SetStyle(Value: TControlStyle);
  290.     procedure UpdateMouseInControl(Value: boolean);
  291.     procedure SetChoiceButtonWidth(Value: integer);
  292.     function GetButtonStyle: TEventStyle;
  293.     procedure SetButtonStyle(Value: TEventStyle);
  294.     function GetButtonState: TButtonState;
  295.     procedure SetButtonState(Value: TButtonState);
  296.     procedure SetCheckGlyph(Value: TBitmap);
  297.     procedure SetButtonEnabled(Value: boolean);
  298.     function GetButtonEnabled: boolean;
  299.     function UpdateButtonsOnClick(X, Y: integer): boolean;
  300.     procedure SetShowCheckBox(Value: boolean);
  301.     procedure SetDisableButtons(const Value: boolean);
  302.     procedure SetCaret;
  303.     procedure SetLinkControl(const Value: TWinControl);
  304.     function GetButtonWidth: integer;
  305.     function IsGlyphStored: boolean;
  306.     function IsButtonWidthStored: boolean;
  307.     function CanModified: boolean; override;
  308.     procedure SetWordWrap(const Value: Boolean);
  309.   protected
  310.     procedure AdjustClientRect(var Rect: TRect); override;
  311.     function BtnChoiceAssigned: boolean;
  312.     procedure CheckClick(Sender:TObject); virtual;
  313.     procedure ChoiceButtonDown;
  314.     procedure CloseUp(State: Byte; bPerform: boolean = False); override;
  315.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  316.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  317.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  318.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  319.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  320.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  321.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  322.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  323.     procedure CreateWnd; override;
  324.     procedure DefineBtnChoice(BtnStyle: TChoiceBtnStyle);
  325.     procedure DefineBtnChoiceStyle; virtual;
  326.     procedure DoDrawMargins(DC: HDC); virtual;
  327.     function DropDownWindow(Message: TWMKillFocus): boolean; virtual;
  328.     procedure EMSetReadOnly(var Message: TMessage); message EM_SETREADONLY;
  329.     function GetDropDownVisible: boolean; virtual;
  330.     function GetGlyph: TBitmap;
  331.     procedure Loaded; override;
  332.     function MinControlWidthBitmap: integer; virtual;
  333.     procedure MouseUp(Button: TMouseButton; ShiftState: TShiftState; X, Y: Integer); override;
  334.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  335.     function PaintCheckGlyph: boolean; virtual;
  336.     procedure PaintWindow(DC: HDC); override;
  337.     procedure RedrawBorder(DrawBorder: boolean; Clip: HRGN); virtual;
  338.     procedure SetEditRect; override;
  339.     procedure SetMargins(var LeftMargin: integer; var RightMargin: integer); virtual;
  340.     procedure SetParent(AParent: TWinControl); override;
  341.     procedure ShowDropDown; virtual;
  342.     procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
  343.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  344.     procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
  345.     procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  346.     procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
  347.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  348.     procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  349.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  350.     procedure WMSize(var message: TWMSize); message WM_SIZE;
  351.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  352.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  353.     procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  354.     procedure WndProc(var Message: TMessage); override;
  355.  
  356.     property ButtonChoiceStyle: TChoiceBtnStyle  read FBtnChoiceStyle
  357.        write SetBtnChoiceStyle  default btsForm;
  358.     property ButtonEnabled: boolean read GetButtonEnabled write SetButtonEnabled;
  359.     property ButtonExist: Boolean read FButtonExist write SetCanChoice  default True;
  360.     property ButtonStyle: TEventStyle read GetButtonStyle write SetButtonStyle default esNormal;
  361.     property ButtonState: TButtonState read GetButtonState write SetButtonState;
  362.     property ButtonChoice: TDCEditButton read FBtnChoice write FBtnChoice;
  363.     property CheckGlyph: TBitmap read FCheckGlyph write SetCheckGlyph;
  364.     property CheckTag: integer read FCheckTag write FCheckTag default 0;
  365.     property Glyph: TBitmap read GetGlyph write SetGlyph stored IsGlyphStored;
  366.     property MultiLine: boolean read FMultiLine write FMultiLine default False;
  367.     property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
  368.     property PerformCloseUp: boolean read FPerformCloseUp write FPerformCloseUp;
  369.     property ShowCheckBox: boolean read FShowCheckBox write SetShowCheckBox;
  370.     property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
  371.   public
  372.     procedure ChoiceClick(Sender:TObject); virtual;
  373.     constructor Create(AOwner: TComponent); override;
  374.     procedure CreateParams(var Params: TCreateParams); override;
  375.     destructor Destroy; override;
  376.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  377.     procedure KeyPress(var Key: Char);override;
  378.     procedure KillFocus(var Value: boolean); override;
  379.     property ButtonWidth: integer read GetButtonWidth;
  380.     property DisableButtons: boolean read FDisableButtons write SetDisableButtons;
  381.     property DropDownVisible: boolean read GetDropDownVisible;
  382.   published
  383.     property LinkControl: TWinControl read FLinkControl write SetLinkControl;
  384.     property DrawStyle: TControlStyle read FDrawStyle write SetStyle default fcsNormal;
  385.     property ChoiceButtonWidth: integer read FChoiceButtonWidth write SetChoiceButtonWidth
  386.       stored IsButtonWidthStored default DEFAULT_BTN_WIDTH;
  387.     property OnCheckClick: TNotifyEvent read FOnCheckClick write FOnCheckClick;
  388.     property ReadOnly;
  389.   end;
  390.  
  391.   TDCChoiceEdit = class(TDCCustomChoiceEdit)
  392.   public
  393.     property CheckTag;
  394.     property ButtonEnabled;
  395.   published
  396.     property MultiLine;
  397.     property ButtonChoiceStyle;
  398.     property Glyph;
  399.     property ButtonExist;
  400.     property DrawStyle;
  401.     property ButtonStyle;
  402.     property CheckGlyph;
  403.     property OnButtonClick;
  404.     property EditMask;
  405.     property WordWrap;
  406.    end;
  407.  
  408.   TDCCustomDateEdit = class(TDCCustomChoiceEdit)
  409.   private
  410.     FCalendar: TDCCustomCalendar;
  411.     FCalendarVisible: boolean;
  412.     FChecked: boolean;
  413.     FFontColor: integer;
  414.     FDateText: string;
  415.     FUndoDate: TDateTime;
  416.     FStartPos: integer;
  417.     FEndPos: integer;
  418.     FOnChecked: TNotifyEvent;
  419.     FKind: TDateEditKind;
  420.     FShowWeekDay: boolean;
  421.     FReadOnly: boolean;
  422.     FInCheckProc: boolean;
  423.     procedure GetDateText;
  424.     procedure SetDateText;
  425.     procedure SetText(var Key: char);
  426.     procedure DeleteChar(DeleteType: TDeleteType);
  427.     procedure SetChecked(Value: boolean);
  428.     procedure SetShowCheckBox(Value: boolean);
  429.     function GetShowCheckBox: boolean;
  430.     function GetDate: TDateTime;
  431.     procedure SetDate(const Value: TDateTime);
  432.     procedure SetKind(const Value: TDateEditKind);
  433.     procedure SetFontColor(Value: TColor);
  434.     procedure SetUndoDate(const Value: TDateTime);
  435.     procedure SetShowWeekDay(const Value: boolean);
  436.     function GetEmpty: boolean;
  437.     procedure SetCheckGlyph;
  438.   protected
  439.     procedure SetMargins(var LeftMargin: integer; var RightMargin: integer); override;
  440.     procedure CloseUp(State: Byte; bPerform: boolean = False); override;
  441.     procedure GetHintOnError; override;
  442.     procedure Loaded; override;
  443.     function GetDropDownVisible: boolean; override;
  444.     procedure DefineBtnChoiceStyle; override;
  445.     procedure DoDrawMargins(DC: HDC); override;
  446.     procedure EMSetReadOnly(var Message: TMessage); message EM_SETREADONLY;
  447.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  448.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  449.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  450.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  451.     procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
  452.     function IsMasked: boolean; override;
  453.     procedure ShowDropDown; override;
  454.  
  455.     property ShowCheckBox: boolean read GetShowCheckBox write SetShowCheckBox default False;
  456.     property Checked: boolean read FChecked write SetChecked;
  457.     property Date: TDateTime read GetDate write SetDate;
  458.     property OnChecked: TNotifyevent read FOnChecked write FOnChecked;
  459.     property Kind: TDateEditKind read FKind write SetKind;
  460.     property UndoDate: TDateTime read FUndoDate write SetUndoDate;
  461.     property ShowWeekDay: boolean read FShowWeekDay write SetShowWeekDay;
  462.   public
  463.     constructor Create(AOwner: TComponent); override;
  464.     procedure KeyPress(var Key: Char);override;
  465.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  466.     procedure KillFocus(var Value: boolean); override;
  467.     procedure CheckClick(Sender:TObject); override;
  468.     procedure ChoiceClick(Sender:TObject); override;
  469.     property Empty: boolean read GetEmpty;
  470.     property PerformCloseUp;
  471.   end;
  472.  
  473.   TDCDateEdit = class(TDCCustomDateEdit)
  474.   public
  475.     property ButtonEnabled;
  476.     property UndoDate;
  477.   published
  478.     property DrawStyle;
  479.     property ReadOnly;
  480.     property ShowCheckBox;
  481.     property Checked;
  482.     property ButtonExist;
  483.     property Date;
  484.     property Kind;
  485.     property ShowWeekDay;
  486.     property OnChecked;
  487.   end;
  488.  
  489.   TDCCustomFloatEdit = class(TDCCustomChoiceEdit)
  490.   private
  491.     FCalculator: TDCCustomCalculator;
  492.     FCalculatorVisible: boolean;
  493.     FDataType: TFloatDataType;
  494.     FMasked: boolean;
  495.     function GetValue: Extended;
  496.     function GetEditValue(EditText: string): string;
  497.     procedure SetValue(const Value: Extended);
  498.     procedure SetDataType(const Value: TFloatDataType);
  499.   protected
  500.     procedure CloseUp(State: Byte; bPerform: boolean = False); override;
  501.     procedure GetHintOnError; override;
  502.     function GetDropDownVisible: boolean; override;
  503.     procedure DefineBtnChoiceStyle; override;
  504.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  505.     procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
  506.     function IsMasked: boolean; override;
  507.     procedure ShowDropDown; override;
  508.     procedure EditMaskChanged; override;
  509.     property DataType: TFloatDataType read FDataType write SetDataType;
  510.     property Value: Extended read GetValue write SetValue;
  511.   public
  512.     constructor Create(AOwner: TComponent); override;
  513.     destructor Destroy; override;
  514.     procedure KeyPress(var Key: Char);override;
  515.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  516.     procedure KillFocus(var Value: boolean); override;
  517.     procedure ChoiceClick(Sender:TObject); override;
  518.     property PerformCloseUp;
  519.   published
  520.     property Masked: boolean read FMasked write FMasked;
  521.   end;
  522.  
  523.   TDCFloatEdit = class(TDCCustomFloatEdit)
  524.   public
  525.     property ButtonEnabled;
  526.   published
  527.     property DrawStyle;
  528.     property ReadOnly;
  529.     property ButtonExist;
  530.     property DataType;
  531.     property Value;
  532.   end;
  533.  
  534.   TDrawBitmapEvent = procedure(Control: TWinControl; R: TRect; Index: Integer;
  535.      Bitmap: TBitmap) of object;
  536.   TDCDrawItemEvent = procedure(ACanvas: TCanvas; Control: TWinControl; Index: Integer;
  537.      Rect: TRect;  State: TOwnerDrawState) of object;
  538.  
  539.   TDCCustomComboBox = class(TDCCustomChoiceEdit)
  540.   private
  541.     FListBox: TDCPopupListBox;
  542.     FListBoxVisible: boolean;
  543.     FStyle: TComboBoxStyle;
  544.     FItems: TStrings;
  545.     FOnDrawItem: TDrawItemEvent;
  546.     FOnDrawText: TDCDrawItemEvent;
  547.     FOnMeasureItem:TMeasureItemEvent;
  548.     FItemHeight: integer;
  549.     FLastText: string;
  550.     FLastIndex: integer;
  551.     FOnDrawBitmap: TDrawBitmapEvent;
  552.     FItemIndex: integer;
  553.     FOnIndexChange: TNotifyEvent;
  554.     FDropDownWidth: integer;
  555.     FEditing: boolean;
  556.     FOnDropDown: TNotifyEvent;
  557.     FDropDownCount: integer;
  558.     FCachedIndex: integer;
  559.     FCachedText: string;
  560.     procedure SetComboBoxStyle(Value: TComboBoxStyle);
  561.     procedure SetItems(Value: TStrings);
  562.     function GetFirstEntry(PartWord: boolean ): integer;
  563.     procedure SetText(Value: string; ItemIndex: integer; ASelStart, ASelLen: integer);
  564.     procedure SetItemIndex(Value: integer);
  565.     procedure GetEntryText;
  566.     procedure PaintListItem(bFocused: boolean);
  567.     function NotEditControl: boolean;
  568.     procedure FindNextItem(cFirstChar: char);
  569.     procedure SetEditing(const Value: boolean);
  570.   protected
  571.     procedure CloseUp(State: Byte; bPerform: boolean = False); override;
  572.     procedure GetHintOnError; override;
  573.     function MinControlWidthBitmap: integer; override;
  574.     procedure DrawBitmap(Index: integer); virtual;
  575.     function GetDropDownVisible: boolean; override;
  576.     function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  577.       MousePos: TPoint): Boolean; override;
  578.     procedure EMGetSel(var Message: TMessage); message EM_GETSEL;
  579.     procedure WMChar(var Message: TWMChar); message WM_CHAR;
  580.     procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
  581.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  582.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  583.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  584.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  585.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  586.     procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
  587.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  588.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  589.     procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
  590.     procedure ListMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  591.     function GetCanvas: TCanvas;
  592.     procedure CheckClick(Sender:TObject); override;
  593.     procedure WndProc(var Message: TMessage); override;
  594.     procedure DropDown; dynamic;
  595.     procedure DefineBtnChoiceStyle; override;
  596.     procedure ShowDropDown; override;
  597.     property Style: TComboBoxStyle read FStyle write SetComboBoxStyle;
  598.     property Items: TStrings read FItems write SetItems;
  599.     property ItemHeight: integer read FItemHeight write FItemHeight;
  600.     property OnDrawBitmap: TDrawBitmapEvent read FOnDrawBitmap write FOnDrawBitmap;
  601.     property OnIndexChange: TNotifyEvent read FOnIndexChange write FOnIndexChange;
  602.     property OnDrawItem: TDrawItemEvent read  FOnDrawItem write FOnDrawItem;
  603.     property OnDrawText: TDCDrawItemEvent read  FOnDrawText write FOnDrawText;
  604.     property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  605.     property DropDownWidth: integer read FDropDownWidth write FDropDownWidth default 0;
  606.     property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
  607.     property DropDownCount: Integer read FDropDownCount write FDropDownCount default 8;
  608.     procedure CreateWnd; override;
  609.   public
  610.     procedure CreateParams(var Params: TCreateParams); override;
  611.     constructor Create(AOwner: TComponent); override;
  612.     destructor Destroy; override;
  613.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  614.     procedure KeyPress(var Key: Char);override;
  615.     procedure KillFocus(var Value: boolean); override;
  616.     procedure Clear; override;
  617.     procedure ChoiceClick(Sender:TObject); override;
  618.     property ItemIndex: integer read FItemIndex write SetItemIndex;
  619.     property Canvas: TCanvas read GetCanvas;
  620.     property Editing: boolean read FEditing write SetEditing;
  621.     property PerformCloseUp;
  622.   end;
  623.  
  624.   TDCComboBox = class(TDCCustomComboBox)
  625.   public
  626.     property ButtonEnabled;
  627.   published
  628.     property Alignment;
  629.     property DrawStyle;
  630.     property CheckGlyph;
  631.     property CheckTag;
  632.     property Items;
  633.     property ItemHeight;
  634.     property OnDrawBitmap;
  635.     property OnIndexChange;
  636.     property DropDownWidth default 0;
  637.     property OnDrawItem;
  638.     property OnDrawText;
  639.     property OnMeasureItem;
  640.     property Style;
  641.     property ShowCheckBox;
  642.     property ReadOnly;
  643.     property OnDropDown;
  644.     property DropDownCount;
  645.     property EditMask;
  646.     property OnCloseUp;
  647.   end;
  648.  
  649.   TThreadMode =(tmFind, tmStop, tmIdle);
  650.   TGridEditThread = class;
  651.   TDCCustomGridEdit = class;
  652.  
  653.   TGridValue  = class(TCollectionItem)
  654.   private
  655.      FFieldName: string;
  656.      FValue: variant;
  657.      FFieldType: TFieldType;
  658.      function GetAsString: string;
  659.      procedure SetAsString(Value: string);
  660.   public
  661.     constructor Create(AOwner: TCollection); override;
  662.     property FieldName: string read FFieldName write FFieldName;
  663.     property Value: variant read FValue write FValue;
  664.     property FieldType: TFieldType read FFieldType write FFieldType;
  665.     property AsString: string read GetAsString write SetAsString;
  666.   end;
  667.  
  668.   TGridValues = class(TCollection)
  669.   private
  670.     FLoaded: boolean;
  671.     FIndex: integer;
  672.     function GetItem(Field: string): TGridValue;
  673.     procedure SetItem(Field: string; Value: TGridValue);
  674.   public
  675.     constructor Create(AOwner: TComponent);
  676.     function Add: TGridValue;
  677.     property Fields[Field: string]: TGridValue read GetItem write SetItem;
  678.   end;
  679.  
  680.   TGetGridEvent   = procedure (Sender: TObject; KeyValue: string; DataType: TFieldType;
  681.         var Exist: boolean; GridValues: TGridValues) of object;
  682.  
  683.   TDCCustomGridEdit = class(TDCCustomChoiceEdit)
  684.   private
  685.     FGrid: TDCPopupDBGrid;
  686.     FGridVisible: boolean;
  687.     FColumns: TDBGridColumns;
  688.     FDataSet: TDataSet;
  689.     FImages: TImageList;
  690.     FImageChangeLink: TChangeLink;
  691.     FDropDownWidth: integer;
  692.     FValues: TGridValues;
  693.     FKeyField: string;
  694.     FKeyValue: variant;
  695.     FDataField: string;
  696.     FCloseDataSet: boolean;
  697.     FThreadInUse: boolean;
  698.     GridEditThread: TGridEditThread;
  699.     FOnValueChange: TNotifyEvent;
  700.     FOnCheckDataValue: TCheckGridEvent;
  701.     FOnGetDataValue: TGetGridEvent;
  702.     FDataValueSelected: boolean;
  703.     FPopupFindEnabled: boolean;
  704.     FListBox: TDCPopupListBox;
  705.     FListBoxVisible: boolean;
  706.     FListBoxEnabled: boolean;
  707.     FListBoxColumns: TDBGridColumns;
  708.     FListBoxWidth: integer;
  709.     FThreadMode: TThreadMode;
  710.     FOnThreadStart: TThreadEvent;
  711.     FOnThreadStop : TThreadEvent;
  712.     FPaintBox: integer;
  713.     FOnGridTitleClick: TDBGridClickEvent;
  714.     FQuery: TDataSet;
  715.     FQueryDataSet: boolean;
  716.     FSQLText: string;
  717.     FSQLDataField: string;
  718.     FSQLKeyField: string;
  719.     FSQLOrderBy: string;
  720.     FFullQuery: boolean;
  721.     FInfoField: string;
  722.     FInfoFieldWidth: integer;
  723.     FOnDrawInfoText: TDrawInfoText;
  724.     FCanAppend: boolean;
  725.     FValueChanged: boolean;
  726.     FSingleClickToSelect: boolean;
  727.     FColumnsOrder: TStringList;
  728.     FOnAppendRecord: TGridAppendEvent;
  729.     FNeedLocate: boolean;
  730.     FShowInfoHint: boolean;
  731.     FInHintInfo: boolean;
  732.     FInfoHintWindow: TDCMessageWindow;
  733.     procedure ListBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  734.       State: TOwnerDrawState);
  735.     procedure ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
  736.       Shift: TShiftState; X, Y: Integer);
  737.  
  738.     procedure SetKeyValue(const Value: variant);
  739.     procedure SetKeyValueEx(Value: variant; NeedLocate: boolean = True);
  740.     procedure SetDataSet(const Value: TDataSet);
  741.     procedure LocateDataSet;
  742.     function FieldExists(Value: string): boolean;
  743.     function CheckDataValue: boolean;
  744.     procedure GridDblClick(Sender: TObject);
  745.     procedure GridCellClick(Columns: TColumn);
  746.     procedure GetEntryText;
  747.     procedure ClearValue(ClearText: boolean);
  748.     procedure BeginPaintListBox;
  749.     procedure EndPaintListBox;
  750.     procedure GridTitleClick(Column: TColumn); virtual;
  751.     function GetSQLText: string;
  752.     procedure SetSQLText(const Value: string);
  753.     procedure SetListBoxEnabled(const Value: boolean);
  754.     procedure SetDataValues(ADataSet: TDataSet);
  755.     procedure SetDataField(const Value: string);
  756.     procedure SetKeyField(const Value: string);
  757.     procedure SetSQLDataField(const Value: string);
  758.     procedure SetSQLKeyField(const Value: string);
  759.     procedure SetInfoField(const Value: string);
  760.     procedure SetInfoFieldWidth(const Value: integer);
  761.     function ExistInfo: boolean;
  762.     procedure SetCanAppend(const Value: boolean);
  763.     procedure SetQueryDataSet(const Value: boolean);
  764.     function ActivateDataSet: boolean;
  765.     procedure CloseDataSet;
  766.     function GetGridOrderBy: string;
  767.     procedure InitColumnsOrder;
  768.     procedure ImageListChange(Sender: TObject);
  769.     function GetInfoRect: TRect;
  770.     procedure ShowInfoHint;
  771.     procedure HideInfoHint;
  772.     procedure SendControlMessage(Message, WParam, LParam: integer);
  773.     procedure SetImages(const Value: TImageList);
  774.   protected
  775.     procedure SetSQLTextPermanet(const Value: string);
  776.     procedure SetInternalDataSet(const Value: TDataSet;
  777.       var DataSet: TDataSet); virtual; abstract;
  778.     procedure SetInternalSQLText(const Value: string; var SQLText: string); virtual; abstract;
  779.     function SetGridValues: boolean;
  780.     procedure CloseUp(State: Byte; bPerform: boolean = False); override;
  781.     procedure WndProc(var Message: TMessage); override;
  782.     procedure GetHintOnError; override;
  783.     procedure Loaded; override;
  784.     function GetDropDownVisible: boolean; override;
  785.     function CreateQuery: TDataSet; virtual; abstract;
  786.     procedure DoInitQuery(Mode: integer); virtual; abstract;
  787.     procedure OpenQuery(Mode: integer);
  788.     function GetPreparedQueryText(Mode: integer; SQLText: string): string;
  789.     function GetQueryText: string ; virtual; abstract;
  790.     procedure PrepareDataSet; virtual; abstract;
  791.     procedure KeyValueChanged; virtual;
  792.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  793.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  794.     function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  795.     procedure WMChar(var Message: TWMChar); message WM_CHAR;
  796.     procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
  797.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  798.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  799.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  800.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  801.     procedure CMThreadStart(var Message: TMessage); message CM_THREAD_START;
  802.     procedure CMThreadTerminate(var Message: TMessage); message CM_THREAD_TERMINATE;
  803.     procedure CMThreadItemClr(var Message: TMessage); message CM_THREAD_ITEMCLR;
  804.     procedure CMThreadItemAdd(var Message: TMessage); message CM_THREAD_ITEMADD;
  805.     procedure CMThreadShowBox(var Message: TMessage); message CM_THREAD_SHOWBOX;
  806.     procedure CMThreadHideBox(var Message: TMessage); message CM_THREAD_HIDEBOX;
  807.     procedure CMThreadLocated(var Message: TMessage); message CM_THREAD_LOCATED;
  808.     procedure CMThreadFindCmplt(var Message: TMessage); message CM_THREAD_FINDCMPLT;
  809.     procedure CMThreadFreeBox(var Message: TMessage); message CM_THREAD_FREEBOX;
  810.     procedure CMThreadError(var Message: TMessage); message CM_THREAD_ERROR;
  811.     procedure CMThreadSetMode(var Message: TMessage); message CM_THREAD_SETMODE;
  812.     procedure CMThreadStop(var Message: TMessage); message CM_THREAD_STOP;
  813.     procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
  814.     procedure CMPopupHintInfo(var Message: TMessage); message CM_POPUPHINTINFO;
  815.     procedure CMAppendrecord(var Message: TMessage); message CM_APPENDRECORD;
  816.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  817.     procedure WaitForThreadTerminate(Count: DWORD = 10);
  818.     procedure DoGridTitleClick(IndexChanged: boolean; Column: TColumn); virtual;
  819.     procedure DefineBtnChoiceStyle; override;
  820.     procedure SetMargins(var LeftMargin: integer; var RightMargin: integer); override;
  821.     function FullQuery: boolean;
  822.     procedure ShowDropDown; override;
  823.     property Query: TDataSet read FQuery;
  824.   public
  825.     constructor Create(AOwner: TComponent); override;
  826.     destructor Destroy; override;
  827.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  828.     procedure KeyPress(var Key: Char);override;
  829.     property Values: TGridValues read FValues write FValues;
  830.     property KeyValue: variant read FKeyValue write SetKeyValue;
  831.     procedure KillFocus(var Value: boolean); override;
  832.     procedure ChoiceClick(Sender:TObject); override;
  833.     procedure DoDrawMargins(DC: HDC); override;
  834.     procedure AppendRecord;
  835.     procedure BeginUpdate(HookChanges: boolean = True); override;
  836.     procedure EndUpdate; override;
  837.     procedure ValidateValue;
  838.     property PerformCloseUp;
  839.     procedure LocateFirstValue;
  840.     property ColumnsOrder: TStringList read FColumnsOrder;
  841.   published
  842.     property Columns: TDBGridColumns read FColumns write FColumns;
  843.     property DataSet: TDataSet read FDataSet write SetDataSet;
  844.     property Images: TImageList read FImages write SetImages;
  845.     property DropDownWidth: integer read FDropDownWidth write FDropDownWidth default 0;
  846.     property KeyField: string read FKeyField write SetKeyField;
  847.     property DataField: string read FDataField write SetDataField;
  848.     property OnValueChange: TNotifyEvent read FOnValueChange write FOnValueChange;
  849.     property OnCheckDataValue: TCheckGridEvent read FOnCheckDataValue write FOnCheckDataValue;
  850.     property OnGetDataValue: TGetGridEvent read FOnGetDataValue write FOnGetDataValue;
  851.     property ListBoxEnabled: boolean read FListBoxEnabled write SetListBoxEnabled default False;
  852.     property ListBoxColumns: TDBGridColumns read FListBoxColumns write FListBoxColumns;
  853.     property OnThreadStart: TThreadEvent read FOnThreadStart write FOnThreadStart;
  854.     property OnThreadStop : TThreadEvent read FOnThreadStop write FOnThreadStop;
  855.     property OnGridTitleClick: TDBGridClickEvent read FOnGridTitleClick write FOnGridTitleClick;
  856.     property ListBoxWidth: integer read FListBoxWidth write FListBoxWidth default 0;
  857.     property SQLText: string read GetSQLText write SetSQLText;
  858.     property SQLDataField: string read FSQLDataField write SetSQLDataField;
  859.     property SQLKeyField: string read FSQLKeyField write SetSQLKeyField;
  860.     property SQLOrderBy:string read FSQLOrderBy write FSQLOrderBy;
  861.     property InfoField: string read FInfoField write SetInfoField;
  862.     property InfoFieldWidth: integer read FInfoFieldWidth write SetInfoFieldWidth;
  863.     property OnDrawInfoText: TDrawInfoText read FOnDrawInfoText write FOnDrawInfoText;
  864.     property CanAppend: boolean read FCanAppend write SetCanAppend default False;
  865.     property QueryDataSet: boolean read FQueryDataSet write SetQueryDataSet;
  866.     property SingleClickToSelect: boolean read FSingleClickToSelect write FSingleClickToSelect;
  867.     property OnAppendRecord: TGridAppendEvent read FOnAppendRecord write FOnAppendRecord;
  868.   end;
  869.  
  870.   TDCBDEGridEdit = class(TDCCustomGridEdit)
  871.   private
  872.     function GetDatabaseName: string;
  873.     function GetParams: TParams;
  874.     procedure SetDatabaseName(const Value: string);
  875.     procedure SetParams(const Value: TParams);
  876.   protected
  877.     function CreateQuery: TDataSet; override;
  878.     function GetQueryText: string; override;
  879.     procedure DoInitQuery(Mode: integer); override;
  880.     procedure PrepareDataSet; override;
  881.     procedure SetInternalDataSet(const Value: TDataSet;
  882.       var DataSet: TDataSet); override;
  883.     procedure SetInternalSQLText(const Value: string; var SQLText: string); override;
  884.   public
  885.     property ButtonEnabled;
  886.   published
  887.     property DrawStyle;
  888.     property CheckGlyph;
  889.     property CheckTag;
  890.     property ReadOnly;
  891.     property DatabaseName: string read GetDatabaseName write SetDatabaseName;
  892.     property Params: TParams read GetParams write SetParams;
  893.     property EditMask;
  894.   end;
  895.  
  896.   TDCGridEdit = class(TDCBDEGridEdit)
  897.   end;
  898.  
  899.   TGridEditThread = class(TThread)
  900.     FGridEdit: TDCCustomGridEdit;
  901.     FMode: TThreadMode;
  902.     FFindValue: string;
  903.     FStoped: boolean;
  904.   private
  905.     procedure SetFindValue(const Value: string);
  906.     procedure FindDataSet;
  907.     procedure AddValue;
  908.   protected
  909.     procedure Execute; override;
  910.   public
  911.     property FindValue: string read FFindValue write SetFindValue;
  912.     property Mode: TThreadMode read FMode;
  913.     constructor Create(GridEdit: TDCCustomGridEdit; Mode: TThreadMode);
  914.   end;
  915.  
  916.   TTreeGetTextEvent   = procedure (Sender: TObject; Node: TTreeNode;
  917.         var AText: string) of object;
  918.   TTreeClearIteamEvent = procedure (Sender: TObject; TreeView: TTreeView) of object;
  919.   TTreeSelectNodeEvent = procedure (Sender: TObject; Node: TTreeNode; var AllowSelect: boolean) of object;
  920.  
  921.   TDCCustomTreeEdit = class(TDCCustomChoiceEdit)
  922.   private
  923.     FTreeView: TDCPopupTreeView;
  924.     FTreeVisible: boolean;
  925.     FDropDownWidth: integer;
  926.     FImages: TImageList;
  927.     FImageChangeLink: TChangeLink;
  928.     FOnChange: TTVChangedEvent;
  929.     FOnInitTree: TTEInitTreeEvent;
  930.     FOnCollapsed: TTVExpandedEvent;
  931.     FOnExpanded: TTVExpandedEvent;
  932.     FOnCollapsing: TTVExpandingEvent;
  933.     FOnExpanding: TTVExpandingEvent;
  934.     FOnSetText: TNotifyEvent;
  935.     FOnGetText: TTreeGetTextEvent;
  936.     FTreeInitialized: boolean;
  937.     FOnDrawText: TDCDrawItemEvent;
  938.     FStyle: TTreeEditStyle;
  939.     FNodeSelected: boolean;
  940.     FOnCustomDrawItem: TTVCustomDrawItemEvent;
  941.     FOnClearItems: TTreeClearIteamEvent;
  942.     FOnSelectNode: TTreeSelectNodeEvent;
  943.     function GetSelected: TTreeNode;
  944.     procedure SetSelected(const Value: TTreeNode);
  945.     procedure SetTreeView(const Value: TTreeView);
  946.     procedure PaintListItem(bFocused: boolean);
  947.     procedure SetStyle(const Value: TTreeEditStyle);
  948.     procedure ImageListChange(Sender: TObject);
  949.     procedure SetImages(const Value: TImageList);
  950.   protected
  951.     procedure Loaded; override;
  952.     procedure GetHintOnError; override;
  953.     procedure Change; override;
  954.     function GetDropDownVisible: boolean; override;
  955.     procedure Expanded(Sender: TObject; Node: TTreeNode); virtual;
  956.     procedure Expanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); virtual;
  957.     procedure Collapsed(Sender: TObject; Node: TTreeNode); virtual;
  958.     procedure Collapsing(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); virtual;
  959.     procedure CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode;
  960.        State: TCustomDrawState; var DefaultDraw: Boolean); virtual;
  961.     procedure WndProc(var Message: TMessage); override;
  962.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  963.     procedure EMGetSel(var Message: TMessage); message EM_GETSEL;
  964.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  965.     procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
  966.     procedure WMPaint (var Message: TWMPaint); message WM_PAINT;
  967.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  968.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  969.     procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
  970.     procedure WMChar(var Message: TWMChar); message WM_CHAR;
  971.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  972.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  973.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  974.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  975.     procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
  976.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  977.     function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  978.     function CanSelectNode(Node: TTreeNode): boolean; virtual;
  979.     procedure TreeViewDblClick(Sender: TObject); virtual;
  980.     procedure TreeViewKeyPress(Sender: TObject; var Key: Char); virtual;
  981.     procedure DefineBtnChoiceStyle; override;
  982.     function GetTreeView: TTreeView;
  983.     procedure SetText(Value: string); virtual;
  984.     procedure ClearTreeItems; virtual;
  985.     procedure CloseUp(State: Byte; bPerform: boolean = False); override;
  986.     procedure ShowDropDown; override;
  987.     property OnDrawText: TDCDrawItemEvent read  FOnDrawText write FOnDrawText;
  988.     property Images: TImageList read FImages write SetImages;
  989.     property Style: TTreeEditStyle read FStyle write SetStyle default teDropDownList;
  990.     property OnClearItems: TTreeClearIteamEvent read FOnClearItems write FOnClearItems;
  991.   public
  992.     procedure CreateParams(var Params: TCreateParams); override;
  993.     constructor Create(AOwner: TComponent); override;
  994.     destructor Destroy; override;
  995.     procedure ChoiceClick(Sender:TObject); override;
  996.     procedure InitTree; virtual;
  997.     procedure ChangeSelected(Sender: TObject; Node: TTreeNode); virtual;
  998.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  999.     procedure KeyPress(var Key: Char);override;
  1000.     procedure KillFocus(var Value: boolean); override;
  1001.     function GetNode(Value: string; var Node: TTreeNode; var ErrorCode: integer): boolean; virtual;
  1002.     property TreeView: TTreeView read GetTreeView write SetTreeView;
  1003.     property Selected: TTreeNode read GetSelected write SetSelected;
  1004.     property PerformCloseUp;
  1005.     property TreeInitialized: boolean read FTreeInitialized;
  1006.   published
  1007.     property DropDownWidth: integer read FDropDownWidth write FDropDownWidth default 0;
  1008.     property OnChange: TTVChangedEvent read FOnChange write FOnChange;
  1009.     property OnInitTree: TTEInitTreeEvent read FOnInitTree write FOnInitTree;
  1010.     property OnCollapsed: TTVExpandedEvent read FOnCollapsed write FOnCollapsed;
  1011.     property OnExpanded: TTVExpandedEvent read FOnExpanded write FOnExpanded;
  1012.     property OnCollapsing: TTVExpandingEvent read FOnCollapsing write FOnCollapsing;
  1013.     property OnExpanding: TTVExpandingEvent read FOnExpanding write FOnExpanding;
  1014.     property OnSetText: TNotifyEvent read FOnSetText write FOnSetText;
  1015.     property OnGetText: TTreeGetTextEvent read FOnGetText write FOnGetText;
  1016.     property OnCustomDrawItem: TTVCustomDrawItemEvent read FOnCustomDrawItem write FOnCustomDrawItem;
  1017.     property OnSelectNode: TTreeSelectNodeEvent read FOnSelectNode write FOnSelectNode;
  1018.   end;
  1019.  
  1020.   TDCTreeEdit = class(TDCCustomTreeEdit)
  1021.   public
  1022.     property ButtonEnabled;
  1023.   published
  1024.     property DrawStyle;
  1025.     property CheckGlyph;
  1026.     property OnDrawText;
  1027.     property ReadOnly;
  1028.     property Images;
  1029.     property Style;
  1030.     property OnClearItems;
  1031.     property EditMask;
  1032.   end;
  1033.  
  1034.   TCustomEditForm = class(TCustomForm)
  1035.     {}
  1036.   end;
  1037.  
  1038.   TCreateEditFormEvent = procedure (Sender:TObject; var EditForm: TCustomForm) of object;
  1039.   TDCCustomFormEdit = class(TDCCustomChoiceEdit)
  1040.   private
  1041.     FEditForm: TCustomForm;
  1042.     FOnCreateEditForm: TCreateEditFormEvent;
  1043.     FEFNewWndProc, FPFNewWndProc: Pointer;
  1044.     FEFDefWndProc, FPFDefWndProc: Pointer;
  1045.     FInfoFieldWidth: integer;
  1046.     FOnDrawInfoText: TDrawInfoText;
  1047.     procedure EFWndProc(var Message: TMessage);
  1048.     procedure PFWndProc(var Message: TMessage);
  1049.     procedure SetInfoFieldWidth(const Value: integer);
  1050.     function ExistInfo: boolean;
  1051.   protected
  1052.     function CreateEditForm(var EditForm: TCustomForm): boolean; virtual;
  1053.     function GetDropDownVisible: boolean; override;
  1054.     procedure CloseUp(State: Byte; bPerform: boolean = False); override;
  1055.     procedure GetFormResult(AEditForm: TCustomForm); virtual;
  1056.     procedure InitEditFromParams(AEditForm: TCustomForm); virtual;
  1057.     procedure DefineBtnChoiceStyle; override;
  1058.     procedure SetMargins(var LeftMargin: integer; var RightMargin: integer); override;
  1059.     function DropDownWindow(Message: TWMKillFocus): boolean; override;
  1060.     procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
  1061.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  1062.     procedure DoDrawMargins(DC: HDC); override;
  1063.     procedure WndProcAction(Action: integer);
  1064.     procedure ShowDropDown; override;
  1065.  public
  1066.     constructor Create(AOwner: TComponent); override;
  1067.     destructor Destroy; override;
  1068.     procedure ChoiceClick(Sender:TObject); override;
  1069.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  1070.     procedure KeyPress(var Key: Char);override;
  1071.   published
  1072.     property OnCreateEditForm: TCreateEditFormEvent read FOnCreateEditForm write FOnCreateEditForm;
  1073.     property InfoFieldWidth: integer read FInfoFieldWidth write SetInfoFieldWidth;
  1074.     property OnDrawInfoText: TDrawInfoText read FOnDrawInfoText write FOnDrawInfoText;
  1075.   end;
  1076.  
  1077. implementation
  1078. uses DCResource, Clipbrd;
  1079.  
  1080. type
  1081.   TPrivateWinControl = class(TWinControl)
  1082.   end;
  1083.  
  1084. const
  1085.   MIN_CMPSTR_LENGTH = 3;
  1086.  
  1087.   Digits: TCharSet  = ['0'..'9'];
  1088.   SetDateEdit: TCharSet = ['0'..'9', #8, #13, #9];
  1089.  
  1090. var
  1091.   ErrorHook: HHOOK;
  1092.   ErrorWindow: TDCMessageWindow;
  1093.   ErrorControl: TWinControl;
  1094.   TempBitmap: TBitmap;
  1095.  
  1096. function ErrorGetMsgHook(nCode: Integer; wParam: Longint; var Msg: TMsg): Longint; stdcall;
  1097. begin
  1098.   Result := CallNextHookEx(ErrorHook, nCode, wParam, Longint(@Msg));
  1099.   if (nCode >= 0) and (Application <> nil) and (ErrorWindow <> nil)then
  1100.   with Msg do
  1101.   begin
  1102.     if (Message <> CM_CANCELMODE) and (Message = WM_CHAR) or
  1103.        (Message = CM_ACTIVATE) or (Message = CM_DEACTIVATE) or
  1104.        (Message = CM_APPKEYDOWN) or (Message = CM_APPSYSCOMMAND) or
  1105.        (Message = WM_COMMAND) then
  1106.       PostMessage(ErrorControl.Handle, CM_ERRORMESSAGE, 0, 0);
  1107.   end;
  1108. end;
  1109.  
  1110. procedure HookErrorHooks;
  1111. begin
  1112.   if ErrorHook = 0 then
  1113.      ErrorHook := SetWindowsHookEx(WH_GETMESSAGE, @ErrorGetMsgHook, 0, GetCurrentThreadID);
  1114. end;
  1115.  
  1116. procedure UnHookErrorHooks;
  1117. begin
  1118.   if ErrorHook <> 0 then UnhookWindowsHookEx(ErrorHook);
  1119.   ErrorHook := 0;
  1120. end;
  1121.  
  1122. constructor TDCCustomChoiceEdit.Create(AOwner: TComponent);
  1123. begin
  1124.   inherited Create(AOwner);
  1125.  
  1126.   ControlStyle:= ControlStyle + [csSetCaption, csCaptureMouse, csClickEvents];
  1127.   Ctl3D := False;
  1128.   FBtnChoiceStyle:= btsForm;
  1129.   FButtonExist:= True;
  1130.   FMouseDown := False;
  1131.   FChoiceButtonWidth := DEFAULT_BTN_WIDTH;
  1132.   FCheckGlyph := TBitmap.Create;
  1133.   FCanEmpty := True;
  1134.   FShowCheckBox := True;
  1135.   FDisableButtons:= False;
  1136.   FMultiLine := False;
  1137.  
  1138.   FImage :=  TBitmap.Create;
  1139.   FImage.Transparent := True;
  1140.  
  1141.   SetRectEmpty(FMargins);
  1142.   FCheckGlyph.Transparent := True;
  1143.   PerformCloseUp := False;
  1144. end;
  1145.  
  1146. procedure TDCCustomChoiceEdit.CreateParams(var Params: TCreateParams);
  1147.  const
  1148.   WordWraps: array[Boolean] of DWORD = (0, ES_AUTOHSCROLL);
  1149. begin
  1150.   inherited CreateParams(Params);
  1151.   with Params do
  1152.   begin
  1153.     Style := Style or ES_MULTILINE or WS_CLIPCHILDREN;
  1154.     Style := Style and not WordWraps[FWordWrap];
  1155.     if FDrawStyle = fsNone then
  1156.       ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
  1157.     if FDrawStyle = fsSingle then
  1158.       Style := Style or WS_BORDER;
  1159.   end;
  1160. end;
  1161.  
  1162. procedure TDCCustomChoiceEdit.CreateWnd;
  1163. begin
  1164.   inherited CreateWnd;
  1165.   SetEditRect;
  1166. end;
  1167.  
  1168. destructor TDCCustomChoiceEdit.Destroy;
  1169. begin
  1170.   Hide;
  1171.   if Assigned(FBtnChoice)
  1172.   then begin
  1173.     FBtnChoice.Free;
  1174.     FBtnChoice := nil;
  1175.   end;
  1176.   FCheckGlyph.Free;
  1177.   FImage.Free;
  1178.   inherited Destroy;
  1179. end;
  1180.  
  1181. procedure TDCCustomChoiceEdit.CloseUp(State: Byte; bPerform: boolean);
  1182.  var
  1183.   ParentForm: TCustomForm;
  1184.   lDropDown: boolean;
  1185. begin
  1186.   lDropDown := DropDownVisible;
  1187.   if bPerform then
  1188.     Perform(CM_POPUPWINDOW, 0, 0)
  1189.   else
  1190.     PostMessage(Handle, CM_POPUPWINDOW, 0, 0);
  1191.  
  1192.   if lDropDown <> DropDownVisible then
  1193.   begin
  1194.     ParentForm := GetParentForm(Self);
  1195.     if (ParentForm <> nil) and ParentForm.HandleAllocated then
  1196.       UpdateWindow(ParentForm.Handle);
  1197.   end;
  1198.  
  1199.   if BtnChoiceAssigned then FBtnChoice.ResetProperties;
  1200. end;
  1201.  
  1202. procedure TDCCustomChoiceEdit.CMEnabledChanged(var Message: TMessage);
  1203. begin
  1204.   if BtnChoiceAssigned then
  1205.   begin
  1206.     FBtnChoice.Enabled := Enabled;
  1207.     FBtnChoice.Paint;
  1208.   end;
  1209.   Invalidate;
  1210.   inherited;
  1211. end;
  1212.  
  1213. procedure TDCCustomChoiceEdit.WMSize(var Message: TWMSize);
  1214. begin
  1215.   inherited;
  1216.   if FButtonExist then DefineBtnChoice(FBtnChoiceStyle);
  1217.   SetEditRect;
  1218. end;
  1219.  
  1220. procedure TDCCustomChoiceEdit.DefineBtnChoice(BtnStyle: TChoiceBtnStyle);
  1221.  var
  1222.   R: TRect;
  1223. begin
  1224.   if not Assigned(Parent) then Exit;
  1225.   if not FButtonExist then Exit;
  1226.   if not Assigned(FBtnChoice) then
  1227.   begin
  1228.     FButtonExist := True;
  1229.     FBtnChoice := TDCEditButton.Create(Self);
  1230.     with FBtnChoice do
  1231.     begin
  1232.       SetBounds(Rect(0, 2, Self.ClientHeight, Self.ClientHeight+2));
  1233.       BrushColor := clBtnFace;
  1234.       Allignment := abCenter;
  1235.       OnClick    := ChoiceClick;
  1236.     end;
  1237.   end;
  1238.   with FBtnChoice do
  1239.   begin
  1240.     Enabled := Self.Enabled and ButtonEnabled;
  1241.     Height := Self.ClientHeight;
  1242.     Top := 2;
  1243.     case BtnStyle of
  1244.       btsForm:
  1245.        begin
  1246.          Glyph.LoadFromResourceName(HInstance, 'DC_FLATCHOICE');
  1247.          Width := DEFAULT_BTN_WIDTH;
  1248.          SimpleStyle := False;
  1249.        end;
  1250.       btsCombo :
  1251.        begin
  1252.          Glyph.LoadFromResourceName(HInstance, 'DC_BTNCOMBO');
  1253.          Width := DEFAULT_BTN_WIDTH - 1;
  1254.          SimpleStyle := True;
  1255.        end;
  1256.       btsEllipsis:
  1257.        begin
  1258.          Glyph.LoadFromResourceName(HInstance, 'DC_BTNELLIPSIS');
  1259.          Width := DEFAULT_BTN_WIDTH;
  1260.          SimpleStyle := True;
  1261.        end;
  1262.       btsCustom:
  1263.        begin
  1264.          Width := FChoiceButtonWidth;
  1265.          Left  := Width - FBtnChoice.Width - 2;
  1266.        end;
  1267.     end;
  1268.     Left  := Self.Width - Width - 2;
  1269.     case FDrawStyle of
  1270.       fcsNormal: Style := stNormal;
  1271.       fsFlat:
  1272.         begin
  1273.           Style := stControlFlat;
  1274.         end;
  1275.       fsNone:
  1276.         begin
  1277.           Style := stNormal;
  1278.           Top := Top - 2;
  1279.           Left := Left + 2;
  1280.         end;
  1281.       fsSingle:
  1282.         begin
  1283.           Style := stSingle;
  1284.           Width := Width - 2;
  1285.           Height := Height + 2;
  1286.           Left := Left + 2;
  1287.           R := GetBounds;
  1288.           InflateRect(R, 1, 1);
  1289.           R.Right := R.Right - R.Left;
  1290.           R.Bottom := R.Bottom - R.Top;
  1291.           SetBounds(R);
  1292.         end;
  1293.     end;
  1294.     if ButtonWidth > 0 then Paint;
  1295.   end;
  1296.   Invalidate;
  1297. end;
  1298.  
  1299. procedure TDCCustomChoiceEdit.SetGlyph(Value: TBitmap);
  1300. begin
  1301.   if Assigned(FBtnChoice) then
  1302.   begin
  1303.     FBtnChoiceStyle  := btsCustom;
  1304.     FBtnChoice.Glyph := Value;
  1305.     if not Assigned(Value) then
  1306.       SetChoiceButtonWidth(Value.Width+6)
  1307.     else
  1308.       SetChoiceButtonWidth(DEFAULT_BTN_WIDTH);
  1309.  
  1310.     FBtnChoice.Width := FChoiceButtonWidth;
  1311.   end;
  1312. end;
  1313.  
  1314. function TDCCustomChoiceEdit.GetGlyph: TBitmap;
  1315. begin
  1316.   if Assigned(FBtnChoice)
  1317.     then begin
  1318.       Result := FBtnChoice.Glyph;
  1319.     end
  1320.     else  Result := nil;
  1321. end;
  1322.  
  1323. procedure TDCCustomChoiceEdit.SetEditRect;
  1324.  var
  1325.   TextMargin, TopMargin, RightMargin, LeftMargin: integer;
  1326.   R: TRect;
  1327.   WMargins: DWord;
  1328. begin
  1329.  if HandleAllocated then
  1330.  begin
  1331.    TextMargin   := 0;
  1332.    TopMargin    := 0;
  1333.  
  1334.    case FDrawStyle of
  1335.      fsNone  :
  1336.       begin
  1337.         TopMargin    := 1;
  1338.         TextMargin   := 2;
  1339.       end;
  1340.      fsSingle  :
  1341.       begin
  1342.         TopMargin    := -1;
  1343.         TextMargin   := -1;
  1344.       end;
  1345.      fcsNormal,
  1346.      fsFlat:
  1347.       begin
  1348.         TopMargin    := 0;
  1349.         TextMargin   := 0;
  1350.      end;
  1351.    end;
  1352.  
  1353.    SetMargins(LeftMargin, RightMargin);
  1354.    
  1355.    if PaintCheckGlyph then TextMargin := 0;
  1356.    if FWordWrap then Inc(RightMargin);
  1357.  
  1358.    R := Rect(LeftMargin+TextMargin, TopMargin, Width-RightMargin, Height+1);
  1359.  
  1360.    WMargins := SendMessage(Handle, EM_GETMARGINS, 0, 0);
  1361.    SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  1362.    SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN , MakeLong(WMargins and $0000FFFF, 0));
  1363.    SendMessage(Handle, EM_SETMARGINS, EC_RIGHTMARGIN, MakeLong(0, WMargins shr 16));
  1364.    SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  1365.  
  1366.    FMargins   := R;
  1367.    FCheckWidth:= LeftMargin;
  1368.    DefineBtnChoiceStyle;
  1369.  end;
  1370. end;
  1371.  
  1372. procedure TDCCustomChoiceEdit.SetBtnChoiceStyle(Value : TChoiceBtnStyle);
  1373. begin
  1374.   if Value<>FBtnChoiceStyle
  1375.   then begin
  1376.     FBtnChoiceStyle := value;
  1377.     if Parent <> nil then
  1378.     begin
  1379.       DefineBtnChoice(value);
  1380.     end;
  1381.     SetEditRect;
  1382.   end;
  1383. end;
  1384.  
  1385. procedure TDCCustomChoiceEdit.KeyDown(var Key: Word; Shift: TShiftState);
  1386. begin
  1387.   inherited KeyDown(Key, Shift);
  1388.   if (Key = VK_F2) and (Shift=[]) then ChoiceButtonDown;
  1389. end;
  1390.  
  1391. procedure TDCCustomChoiceEdit.MouseUp(Button: TMouseButton; ShiftState: TShiftState; X, Y: Integer);
  1392. begin
  1393.   inherited MouseUp(Button, ShiftState, X, Y);
  1394. end;
  1395.  
  1396.  
  1397. procedure TDCCustomChoiceEdit.SetCanChoice( Value : Boolean );
  1398. begin
  1399.   if FButtonExist <> Value
  1400.   then begin
  1401.     FButtonExist := Value;
  1402.     if FButtonExist then DefineBtnChoice(FBtnChoiceStyle)
  1403.     else begin
  1404.       if Assigned(FBtnChoice)
  1405.       then begin
  1406.         FBtnChoice.Free;
  1407.         FBtnChoice:= nil;
  1408.       end;
  1409.     end;
  1410.     Update;
  1411.     SetEditRect;
  1412.     Invalidate;
  1413.   end;
  1414. end;
  1415.  
  1416. procedure TDCCustomChoiceEdit.ChoiceClick(Sender:TObject);
  1417. begin
  1418.    if ((Sender <> nil) and (Sender is TDCEditButton)) or (ButtonStyle <> esDropDown) then
  1419.    begin
  1420.      HideErrorMessage;
  1421.      if Assigned(FOnButtonClick) then FOnButtonClick(Self);
  1422.    end
  1423.    else
  1424.      ChoiceButtonDown;
  1425. end;
  1426.  
  1427. procedure TDCCustomChoiceEdit.CMFontChanged(var Message: TMessage);
  1428. begin
  1429.   inherited;
  1430.   SetEditRect;
  1431. end;
  1432.  
  1433. procedure TDCCustomChoiceEdit.WMPaint(var Message: TWMPaint);
  1434. begin
  1435.   inherited;
  1436.   RedrawBorder(True, 0)
  1437. end;
  1438.  
  1439. procedure TDCCustomChoiceEdit.WMEraseBkGnd(var Message: TWMEraseBkGnd);
  1440.  var
  1441.   ARect: TRect;
  1442. begin
  1443.   ARect := ClientRect;
  1444.   if BtnChoiceAssigned then
  1445.   begin
  1446.     ARect.Right := FBtnChoice.Left;
  1447.     if FDrawStyle in [fsFlat, fsSingle] then Dec(ARect.Right, 3);
  1448.   end;
  1449.   if PaintCheckGlyph then ARect.Left  := ARect.Left+FCheckGlyph.Width;
  1450.   
  1451.   FillRect(TWMEraseBkGnd(Message).DC, ARect, Brush.Handle);
  1452.   Message.Result := 0;
  1453. end;
  1454.  
  1455. procedure TDCCustomChoiceEdit.WMNCPaint (var Message: TMessage);
  1456. begin
  1457.   RedrawBorder(True, 0);
  1458. end;
  1459.  
  1460. procedure TDCCustomChoiceEdit.WMMouseMove(var Message: TWMMouseMove);
  1461.  var
  1462.   lInherited: boolean;
  1463. begin
  1464.   Inherited;
  1465.   lInherited := True;
  1466.   if not(csDesigning in ComponentState) and (FDrawStyle = fsFlat) then
  1467.     UpdateMouseInControl(True);
  1468.   if BtnChoiceAssigned then
  1469.   begin
  1470.     with Message do FBtnChoice.UpdateButtonState( XPos, YPos, FMouseDown, True);
  1471.     if FInButtonArea then lInherited := False;
  1472.   end;
  1473.   if lInherited then inherited;
  1474. end;
  1475.  
  1476. procedure TDCCustomChoiceEdit.WMSetCursor(var Message: TWMSetCursor);
  1477. begin
  1478.   if FInButtonArea
  1479.   then
  1480.     SetCursor(LoadCursor(0, IDC_ARROW))
  1481.   else
  1482.     if FInCheckArea then
  1483.        SetCursor(LoadCursor(0, IDC_ARROW))
  1484.     else
  1485.        inherited;
  1486. end;
  1487.  
  1488. procedure TDCCustomChoiceEdit.WMSetFocus(var Message: TWMSetFocus);
  1489. begin
  1490.   inherited;
  1491.   SetCaret;
  1492.   if not(csDesigning in ComponentState) and (FDrawStyle = fsFlat) then
  1493.     UpdateMouseInControl(True);
  1494. end;
  1495.  
  1496. procedure TDCCustomChoiceEdit.CMCancelMode(var Message: TCMCancelMode);
  1497. begin
  1498.   inherited;
  1499.   if (Message.Sender <> Self) then
  1500.   begin
  1501.     CloseUp(0, True);
  1502.     FMouseDown := False;
  1503.   end;
  1504. end;
  1505.  
  1506. procedure TDCCustomChoiceEdit.CMMouseEnter(var Message: TMessage);
  1507.  var
  1508.   APoint: TPoint;
  1509.   XPos, YPos: LongInt;
  1510. begin
  1511.   inherited;
  1512.   if IsExistDragging then Exit;
  1513.   GetCursorPos(APoint);
  1514.   APoint := Self.ScreenToClient(APoint);
  1515.   XPos := APoint.X;
  1516.   YPos := APoint.Y;
  1517.   if FMouseDown then
  1518.   begin
  1519.     FMouseDown := FMouseDown and (GetAsyncKeyState(VK_LBUTTON)<0);
  1520.     if not FMouseDown and BtnChoiceAssigned then
  1521.         FBtnChoice.UpdateButtonState( XPos, YPos, FMouseDown, False);
  1522.   end;
  1523.   inherited;
  1524.   if not FMouseInControl and (FDrawStyle = fsFlat) then UpdateMouseInControl(True);
  1525. end;
  1526.  
  1527. procedure TDCCustomChoiceEdit.CMMouseLeave(var Message: TMessage);
  1528. begin
  1529.   inherited;
  1530.   if IsExistDragging then Exit;
  1531.   if BtnChoiceAssigned then FBtnChoice.UpdateButtonState( -1, -1, False, True);
  1532.   if not Focused then UpdateMouseInControl(False);
  1533. end;
  1534.  
  1535. procedure TDCCustomComboBox.WMEraseBkGnd(var Message: TWMEraseBkGnd);
  1536. begin
  1537.   if FStyle = csDropDownList then
  1538.     Message.Result := 0
  1539.   else
  1540.    inherited;
  1541. end;
  1542.  
  1543. procedure TDCCustomChoiceEdit.WMLButtonDown(var Message: TWMLButtonDown);
  1544. begin
  1545.   FMouseDown := True;
  1546.   if FInCheckArea then
  1547.   begin
  1548.      SetFocus;
  1549.      if Focused then CheckClick(Self);
  1550.      inherited;
  1551.      Exit;
  1552.   end;
  1553.   if not UpdateButtonsOnClick(Message.Pos.X, Message.Pos.Y) then
  1554.     inherited;
  1555. end;
  1556.  
  1557. procedure TDCCustomChoiceEdit.WMLButtonDblClk(var Message: TWMLButtonDown);
  1558. begin
  1559.   FMouseDown := True;
  1560.   if FInCheckArea then
  1561.   begin
  1562.     SetFocus;
  1563.     if not DisableButtons and Focused then CheckClick(Self);
  1564.     Exit;
  1565.   end;
  1566.   if not UpdateButtonsOnClick(Message.Pos.X, Message.Pos.Y) then
  1567.   begin
  1568.     if Focused and BtnChoiceAssigned and not FInButtonArea then
  1569.       if ButtonEnabled and (ButtonStyle=esDropDown) then
  1570.       begin
  1571.         if Message.Result = $AE then
  1572.           Message.Result := 0
  1573.         else begin
  1574.           with FBtnChoice do UpdateButtonState(Left+1, Top+1, True, False);
  1575.           Exit;
  1576.         end;
  1577.       end;
  1578.   end;
  1579.   if not FInButtonArea then inherited;
  1580. end;
  1581.  
  1582. procedure TDCCustomChoiceEdit.WMLButtonUp(var Message: TWMLButtonUp);
  1583. begin
  1584.   FMouseDown := False;
  1585.   if Focused then UpdateButtonsOnClick(Message.Pos.X, Message.Pos.Y);
  1586.   inherited;
  1587. end;
  1588.  
  1589. procedure TDCCustomChoiceEdit.RedrawBorder(DrawBorder: boolean; Clip: HRGN);
  1590.  var
  1591.   DC: HDC;
  1592.   R: TRect;
  1593.   BtnFaceBrush, WindowBrush: HBRUSH;
  1594.   TopLeft, Offset: TPoint;
  1595. begin
  1596.   DC := GetWindowDC(Handle);
  1597.   WindowBrush := 0;
  1598.   if (Clip <> 0) then SelectClipRgn(DC, Clip);
  1599.  
  1600.   try
  1601.     GetWindowRect(Handle, R);  OffsetRect(R, -R.Left, -R.Top);
  1602.     BtnFaceBrush:= GetSysColorBrush(COLOR_BTNFACE);
  1603.     WindowBrush := CreateSolidBrush(ColorToRGB(Color)); //GetSysColorBrush(COLOR_WINDOW);
  1604.  
  1605.     if PaintCheckGlyph then
  1606.     begin
  1607.       if FCheckWidth = 0 then SetEditRect;
  1608.       Offset.X := (Width  - ClientWidth)  div 2;
  1609.       Offset.Y := (Height - ClientHeight) div 2;
  1610.  
  1611.       FImage.Width  := FCheckGlyph.Width+2;
  1612.       FImage.Height := ClientHeight;
  1613.       with FImage, FImage.Canvas do
  1614.       begin
  1615.         Brush.Color := Self.Color;
  1616.         FillRect(Rect(0, 0, Width, Height));
  1617.         TopLeft.X := 1;
  1618.         if ClientHeight > FCheckGlyph.Height then
  1619.           TopLeft.Y := (ClientHeight-FCheckGlyph.Height) shr 1
  1620.         else
  1621.           TopLeft.Y := 0;
  1622.         StretchDraw(Rect(TopLeft.X, TopLeft.Y, Width-1,
  1623.                          TopLeft.Y+FCheckGlyph.Height),
  1624.                     FCheckGlyph);
  1625.       end;
  1626.       if not Enabled then  TransformBitmap(FImage, FImage, tsDisable);
  1627.       BitBlt(DC, Offset.X, Offset.Y, FImage.Width,
  1628.         _intMin(FImage.Height, Height - Offset.Y), FImage.Canvas.Handle, 0, 0, SRCCOPY);
  1629.     end;
  1630.  
  1631.     DoDrawMargins(DC);
  1632.  
  1633.     if DrawBorder then
  1634.     begin
  1635.       if BtnChoiceAssigned then with FBtnChoice do
  1636.       begin
  1637.         Paint;
  1638.         ExcludeClipRect(DC, Left, Top, Left+Width, Top+Height);
  1639.       end;
  1640.       case FDrawStyle of
  1641.        fsFlat:
  1642.          begin
  1643.            if ((csDesigning in ComponentState) and Enabled) or
  1644.                (not(csDesigning in ComponentState) and
  1645.                (Focused or FMouseInControl))
  1646.            then begin
  1647.              DrawEdge(DC, R, BDR_SUNKENOUTER, BF_RECT or BF_ADJUST);
  1648.              with R do begin
  1649.                FillRect(DC, Rect(Left, Top, Left+1, Bottom-1), BtnFaceBrush);
  1650.                FillRect(DC, Rect(Left, Top, Right-1, Top+1), BtnFaceBrush);
  1651.              end;
  1652.              DrawEdge(DC, R, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
  1653.              InflateRect(R, -1, -1);
  1654.              if BtnChoiceAssigned then
  1655.                with R do
  1656.                  FillRect(DC, Rect(FBtnChoice.Left - 1,Top - 1,FBtnChoice.Left,Bottom+1), BtnFaceBrush);
  1657.            end
  1658.            else begin
  1659.              if BtnChoiceAssigned then
  1660.                with R do
  1661.                 FillRect(DC, Rect(FBtnChoice.Left-1,Top-1,FBtnChoice.Left,Bottom+1), WindowBrush);
  1662.              DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT);
  1663.              DrawEdge(DC, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
  1664.              InflateRect(R,-1,-1);
  1665.              FrameRect(DC, R, WindowBrush);
  1666.              InflateRect(R,-1,-1);
  1667.              FrameRect(DC, R, WindowBrush);
  1668.            end;
  1669.          end;
  1670.        fcsNormal:
  1671.          begin
  1672.            DrawEdge(DC, R, BDR_SUNKENOUTER, BF_RECT);
  1673.            InflateRect(R,-1,-1);
  1674.            DrawEdge(DC, R, BDR_SUNKENINNER, BF_RECT);
  1675.          end;
  1676.        fsNone:
  1677.          begin
  1678.            {}
  1679.          end;
  1680.        fsSingle:
  1681.          begin
  1682.            DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT);
  1683.            DrawEdge(DC, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
  1684.            InflateRect(R,-1,-1);
  1685.            FrameRect(DC, R, WindowBrush);
  1686.            InflateRect(R,-1,-1);
  1687.            FrameRect(DC, R, WindowBrush);
  1688.            R := FBtnChoice.GetBounds;
  1689.            InflateRect(R, 1, 0);
  1690.            DrawEdge(DC, R, BDR_SUNKENOUTER, BF_LEFT);
  1691.          end;
  1692.       end;
  1693.     end;
  1694.   finally
  1695.     ReleaseDC(Handle, DC);
  1696.     DeleteObject(WindowBrush);
  1697.   end;
  1698. end;
  1699.  
  1700. procedure TDCCustomChoiceEdit.SetStyle(Value: TControlStyle);
  1701. begin
  1702.   if FDrawStyle <> Value then
  1703.   begin
  1704.     FDrawStyle := Value;
  1705.     DefineBtnChoice(FBtnChoiceStyle);
  1706.     SetEditRect;
  1707.     RecreateWnd;
  1708.   end;
  1709. end;
  1710.  
  1711. procedure TDCCustomChoiceEdit.UpdateMouseInControl(Value: boolean);
  1712. begin
  1713.   if (FMouseInControl <> Value) then
  1714.   begin
  1715.     FMouseInControl := Value;
  1716.     if BtnChoiceAssigned then FBtnChoice.MouseInControl := Value;
  1717.     if FDrawStyle = fsFlat then RedrawBorder(True, 0);
  1718.   end;  
  1719. end;
  1720.  
  1721. procedure TDCCustomChoiceEdit.SetChoiceButtonWidth(Value: integer);
  1722. begin
  1723.   if FChoiceButtonWidth <> Value then
  1724.   begin
  1725.     ButtonChoiceStyle  := btsCustom;
  1726.     FChoiceButtonWidth := Value;
  1727.     RedrawBorder(True, 0);
  1728.     DefineBtnChoice(FBtnChoiceStyle);
  1729.     SetEditRect;
  1730.     if BtnChoiceAssigned then FBtnChoice.Paint;
  1731.   end;
  1732. end;
  1733.  
  1734. function TDCCustomChoiceEdit.GetButtonStyle: TEventStyle;
  1735. begin
  1736.   if Assigned(FBtnChoice) then Result := FBtnChoice.EventStyle
  1737.   else Result := esNormal
  1738. end;
  1739.  
  1740. procedure TDCCustomChoiceEdit.SetButtonStyle(Value: TEventStyle);
  1741. begin
  1742.   if Value <> GetButtonStyle then
  1743.   begin
  1744.     if Assigned(FBtnChoice) then
  1745.     begin
  1746.        FBtnChoice.EventStyle := Value;
  1747.        if ButtonWidth > 0 then FBtnChoice.Paint;
  1748.     end
  1749.   end;
  1750. end;
  1751.  
  1752. function TDCCustomChoiceEdit.GetButtonState: TButtonState;
  1753. begin
  1754.   if Assigned(FBtnChoice) then Result := FBtnChoice.ButtonState
  1755.   else Result := btRest
  1756. end;
  1757.  
  1758. procedure TDCCustomChoiceEdit.SetButtonState(Value: TButtonState);
  1759. begin
  1760.   if Value <> GetButtonState then
  1761.   begin
  1762.     if Assigned(FBtnChoice) then FBtnChoice.ButtonState := Value;
  1763.   end;
  1764. end;
  1765.  
  1766. procedure TDCCustomChoiceEdit.SetCheckGlyph(Value: TBitmap);
  1767. begin
  1768.   if Value <> FCheckGlyph then
  1769.   begin
  1770.     FCheckGlyph.Assign(Value);
  1771.     SetEditRect;
  1772.     Invalidate;
  1773.   end;
  1774. end;
  1775.  
  1776. procedure TDCCustomChoiceEdit.Loaded;
  1777. begin
  1778.   inherited;
  1779.   SetEditRect;
  1780. end;
  1781.  
  1782. procedure TDCCustomChoiceEdit.WMNCHitTest(var Message: TWMNCHitTest);
  1783.  var
  1784.   P: TPoint;
  1785. begin
  1786.   P := Self.ScreenToClient(Point(Message.XPos, Message.YPos));
  1787.  
  1788.   if FShowCheckBox and Assigned(FCheckGlyph) and (P.X < FCheckGlyph.Width) and
  1789.      ((Width-FCheckGlyph.Width) >= MinControlWidthBitmap) then
  1790.     FInCheckArea := True
  1791.   else
  1792.     FInCheckArea := False;
  1793.  
  1794.   if BtnChoiceAssigned and (P.X >= (Width - ButtonWidth - 2)) then
  1795.     FInButtonArea := True
  1796.   else
  1797.     FInButtonArea := False;
  1798.  
  1799.   inherited;
  1800. end;
  1801.  
  1802. procedure TDCCustomChoiceEdit.CheckClick(Sender: TObject);
  1803. begin
  1804.    HideCaret(Handle);
  1805.    HideErrorMessage;
  1806.    if FDisableButtons then Exit;
  1807.    if not Focused then SetFocus;
  1808.    if Focused and Assigned(FOnCheckClick) then FOnCheckClick(Self);
  1809.    SetCaret;
  1810. end;
  1811.  
  1812. function TDCCustomChoiceEdit.UpdateButtonsOnClick(X, Y: integer): boolean;
  1813.  var
  1814.   ButtonUpdate: boolean;
  1815. begin
  1816.   Result := False;
  1817.   if BtnChoiceAssigned and FInButtonArea then
  1818.   begin
  1819.     if not Focused then SetFocus;
  1820.     if Focused then
  1821.       ButtonUpdate :=FBtnChoice.UpdateButtonState(X, Y, FMouseDown, False)
  1822.     else
  1823.       ButtonUpdate := False;
  1824.     if ButtonUpdate and FBtnChoice.MouseInRect(X, Y) then Result := True;
  1825.   end;
  1826. end;
  1827.  
  1828. procedure TDCCustomChoiceEdit.SetParent(AParent: TWinControl);
  1829. begin
  1830.   inherited;
  1831.   if AParent <> nil then begin
  1832.      DefineBtnChoice(FBtnChoiceStyle);
  1833.      SetEditRect;
  1834.      if BtnChoiceAssigned then FBtnChoice.Paint;
  1835.   end;
  1836. end;
  1837.  
  1838. function TDCCustomChoiceEdit.GetButtonEnabled: boolean;
  1839. begin
  1840.   if Assigned(FBtnChoice) then Result := FBtnChoice.Enabled
  1841.   else Result := True
  1842. end;
  1843.  
  1844. procedure TDCCustomChoiceEdit.SetButtonEnabled(Value: boolean);
  1845. begin
  1846.   if Assigned(FBtnChoice) and (Value <> FBtnChoice.Enabled) then
  1847.     FBtnChoice.Enabled := Value;
  1848. end;
  1849.  
  1850. procedure TDCCustomChoiceEdit.SetShowCheckBox(Value: boolean);
  1851. begin
  1852.   if FShowCheckBox <> Value then
  1853.   begin
  1854.     FShowCheckBox := Value;
  1855.     SetEditRect;
  1856.     Invalidate;
  1857.   end;
  1858. end;
  1859.  
  1860. procedure TDCCustomChoiceEdit.KeyPress(var Key: Char);
  1861. begin
  1862.   case Key of
  1863.     Char(VK_RETURN),
  1864.     Char(VK_ESCAPE):
  1865.      begin
  1866.        if (Key <> #0) and (ErrorWindow <> nil) and (ErrorWindow.Buttons.Count > 0) then
  1867.        begin
  1868.          HideErrorMessage;
  1869.          Key := #0;
  1870.        end
  1871.        else begin
  1872.          inherited KeyPress(Key);
  1873.          if (Key <> #0) and not FMultiLine then
  1874.          begin
  1875.            if Perform(CM_WANTSPECIALKEY, Byte(Key), 0) = 0 then
  1876.              GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
  1877.            Key := #0;
  1878.          end;
  1879.        end;
  1880.      end;
  1881.     else inherited KeyPress(Key);
  1882.  end;
  1883. end;
  1884.  
  1885. procedure TDCCustomChoiceEdit.CMExit(var Message: TCMExit);
  1886. begin
  1887.   CloseUp(0, True);
  1888.   if not(csDesigning in ComponentState) and (FDrawStyle = fsFlat)  and
  1889.      not FShowError then UpdateMouseInControl(False);
  1890.   inherited;
  1891. end;
  1892.  
  1893. procedure TDCCustomChoiceEdit.CMEnter(var Message: TCMEnter);
  1894. begin
  1895.   inherited;
  1896. end;
  1897.  
  1898. procedure TDCCustomChoiceEdit.KillFocus(var Value: boolean);
  1899. begin
  1900.   if not Value and CanModified and not FCanEmpty and (Trim(Text) = '')
  1901.   then begin
  1902.     Value := True;
  1903.     FErrorCode := ERR_EDIT_EMPTYVALUE;
  1904.   end;
  1905.   inherited;
  1906. end;
  1907.  
  1908. procedure TDCCustomChoiceEdit.PaintWindow(DC: HDC);
  1909. begin
  1910.   inherited PaintWindow(DC);
  1911. end;
  1912.  
  1913. function TDCCustomChoiceEdit.MinControlWidthBitmap: integer;
  1914.  var
  1915.   CharWidth: integer;
  1916. begin
  1917.   CharWidth := GetCharWidth(Handle, Font)+2;
  1918.   if Assigned(FBtnChoice) then
  1919.     Result := FBtnChoice.Width+5+CharWidth
  1920.   else
  1921.     Result := 5+CharWidth;
  1922. end;
  1923.  
  1924. function TDCCustomChoiceEdit.BtnChoiceAssigned: boolean;
  1925. begin
  1926.   Result := Assigned(FBtnChoice);
  1927. end;
  1928.  
  1929. procedure TDCCustomChoiceEdit.EMSetReadOnly(var Message: TMessage);
  1930. begin
  1931.   inherited;
  1932.   //DisableButtons := boolean(Message.wParam);
  1933. end;
  1934.  
  1935. procedure TDCCustomChoiceEdit.SetDisableButtons(const Value: boolean);
  1936. begin
  1937.   if FDisableButtons <> Value then
  1938.   begin
  1939.     FDisableButtons := Value;
  1940.     SetButtonEnabled(not FDisableButtons);
  1941.     RedrawBorder(False, 0);
  1942.   end;
  1943. end;
  1944.  
  1945. { TDCComboBox }
  1946.  
  1947. procedure TDCCustomComboBox.ChoiceClick(Sender: TObject);
  1948. begin
  1949.   inherited;
  1950.   if DropDownVisible then
  1951.     CloseUp(0, True)
  1952.   else
  1953.     Perform(CM_POPUPWINDOW, 1, 0);
  1954. end;
  1955.  
  1956. procedure TDCCustomComboBox.CloseUp(State: Byte; bPerform: boolean = False);
  1957.  var
  1958.   AText: string;
  1959.   AItemIndex: integer;
  1960. begin
  1961.   case State of
  1962.      0:
  1963.        begin
  1964.          SelLength := 0;
  1965.          if DropDownVisible then SetText(FCachedText, FCachedIndex, 0, -1);
  1966.          inherited;
  1967.        end;
  1968.      1:
  1969.        begin
  1970.          AText := Text;
  1971.          AItemIndex := -1;
  1972.          if DropDownVisible then with FListBox do
  1973.          begin
  1974.            if ItemIndex >= 0 then
  1975.            begin
  1976.              AText := Items[ItemIndex];
  1977.              AItemIndex := ItemIndex;
  1978.            end;
  1979.          end;
  1980.          inherited;
  1981.          SetText(AText, AItemIndex, 0, -1);
  1982.          FLastText := Text;
  1983.          FLastIndex := FItemIndex;
  1984.          DoCloseUp;
  1985.        end;
  1986.   end;
  1987. end;
  1988.  
  1989. procedure TDCCustomComboBox.CMCancelMode(var Message: TCMCancelMode);
  1990. begin
  1991.   if (Message.Sender <> Self) and
  1992.      (Message.Sender <> FListBox) and
  1993.      not FListBox.ContainsControl(Message.Sender) then
  1994.   begin
  1995.     inherited;
  1996.   end;
  1997. end;
  1998.  
  1999. constructor TDCCustomComboBox.Create(AOwner: TComponent);
  2000. begin
  2001.   inherited Create(AOwner);
  2002.   FItems := TStringList.Create;
  2003.   FListBoxVisible := False;
  2004.   FItemIndex := -1;
  2005.   FEditing   := False;
  2006.   FDropDownCount := 8;
  2007. end;
  2008.  
  2009. procedure TDCCustomComboBox.CreateParams(var Params: TCreateParams);
  2010. begin
  2011.   inherited;
  2012.   if NotEditControl then
  2013.   begin
  2014.     with Params do
  2015.     begin
  2016.       Text  := Name;
  2017.       Style := WS_CHILD or WS_CLIPSIBLINGS;
  2018.       AddBiDiModeExStyle(ExStyle);
  2019.       if csAcceptsControls in ControlStyle then
  2020.       begin
  2021.         Style := Style or WS_CLIPCHILDREN;
  2022.         ExStyle := ExStyle or WS_EX_CONTROLPARENT;
  2023.       end;
  2024.       if FDrawStyle = fsNone then
  2025.         ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
  2026.       if FDrawStyle = fsSingle then
  2027.         Style := Style or WS_BORDER;
  2028.       if not (csDesigning in ComponentState) and not Enabled then
  2029.         Style := Style or WS_DISABLED;
  2030.       if TabStop then Style := Style or WS_TABSTOP;
  2031.       if Parent <> nil then
  2032.         WndParent := Parent.Handle else
  2033.         WndParent := ParentWindow;
  2034.       WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS;
  2035.       WindowClass.lpfnWndProc := @DefWindowProc;
  2036.       WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
  2037.       WindowClass.hbrBackground := 0;
  2038.       WindowClass.hInstance := HInstance;
  2039.       StrPCopy(WinClassName, ClassName);
  2040.     end;
  2041.   end
  2042. end;
  2043.  
  2044. destructor TDCCustomComboBox.Destroy;
  2045. begin
  2046.   FItems.Free;
  2047.   FItems := nil;
  2048.   inherited;
  2049. end;
  2050.  
  2051. procedure TDCCustomComboBox.DrawBitmap(Index: integer);
  2052.  var
  2053.   R: TRect;
  2054.   AWidth, AHeight: integer;
  2055. begin
  2056.   if Assigned(FOnDrawBitmap) and Assigned(FCheckGlyph) then
  2057.   begin
  2058.  
  2059.     with FCheckGlyph, FCheckGlyph.Canvas do
  2060.     begin
  2061.       R := Rect(0,0, Width, Height);
  2062.       FillRect(R);
  2063.     end;
  2064.     AWidth  := FCheckGlyph.Width;
  2065.     AHeight := FCheckGlyph.Height;
  2066.     FOnDrawBitmap(Self, R, Index, FCheckGlyph);
  2067.     if (AWidth  <> FCheckGlyph.Width)  or
  2068.        (AHeight <> FCheckGlyph.Height)
  2069.     then
  2070.       SetEditRect;
  2071.   end;
  2072. end;
  2073.  
  2074. function TDCCustomComboBox.GetCanvas: TCanvas;
  2075. begin
  2076.   if FListBoxVisible then
  2077.      Result := FListBox.Canvas
  2078.   else
  2079.      Result := nil;
  2080. end;
  2081.  
  2082. procedure TDCCustomComboBox.GetEntryText;
  2083.  var
  2084.    TextLen, Index: integer;
  2085. begin
  2086.   if (Length(Text) >= MIN_CMPSTR_LENGTH) and not ReadOnly then
  2087.   begin
  2088.     TextLen := Length(Text);
  2089.     Index   := GetFirstEntry(True);
  2090.     if Index <> -1 then
  2091.     begin
  2092.       SetText(Items[Index], Index, Length(Items[Index]), TextLen );
  2093.       Invalidate;
  2094.     end;
  2095.   end;
  2096. end;
  2097.  
  2098. function TDCCustomComboBox.GetFirstEntry(PartWord: boolean): integer;
  2099.  var
  2100.   i, j: integer;
  2101.   Value, ItemString: string;
  2102.   Found: boolean;
  2103. begin
  2104.     Value := Text;
  2105.     i := 0;
  2106.     Found := False;
  2107.     while (i <= Items.Count-1) and not(Found) do
  2108.     begin
  2109.       ItemString := Items[i];
  2110.       j := 1;
  2111.       if Length(Value) > Length(ItemString) then
  2112.       begin
  2113.         Inc(i);
  2114.         continue;
  2115.       end;
  2116.       while (j <= Length(Value)) and (j <= Length(ItemString)) and
  2117.             (AnsiUpperCase(Value[j]) = AnsiUpperCase(ItemString[j]) ) do
  2118.       begin
  2119.         Inc(j);
  2120.       end;
  2121.  
  2122.       if (j > Length(Value)) and
  2123.          (PartWord or (Length(Value) = Length(ItemString)))
  2124.       then
  2125.         Found := True
  2126.       else
  2127.         Inc(i);
  2128.     end;
  2129.     if Found then Result := i else Result := -1;
  2130. end;
  2131.  
  2132. procedure TDCCustomComboBox.KeyDown(var Key: Word; Shift: TShiftState);
  2133.  var
  2134.   Index: integer;
  2135.   KeyDownEvent: TKeyEvent;
  2136. begin
  2137.   KeyDownEvent := OnKeyDown;
  2138.   if FListBoxVisible and (FListBox<>nil) then
  2139.     case Key of
  2140.       VK_PRIOR,
  2141.       VK_NEXT ,
  2142.       VK_UP   ,
  2143.       VK_DOWN   :
  2144.         begin
  2145.           if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  2146.           if FListBox.ItemIndex = -1 then
  2147.             FListBox.ItemIndex := 0
  2148.           else
  2149.             SendMessage(FListBox.Handle, WM_KEYDOWN, Key, 0);
  2150.           if (FListBox.Items.Count > FListBox.ItemIndex) and (FListBox.ItemIndex <> -1) then
  2151.             SetText(FListBox.Items[FListBox.ItemIndex], FListBox.ItemIndex, 0, -1);
  2152.           Key := 0;
  2153.         end;
  2154.     end
  2155.   else begin
  2156.     if [ssAlt]*Shift = [ssAlt] then
  2157.       case Key of
  2158.         VK_DOWN:
  2159.           if FStyle <> csSimple then
  2160.           begin
  2161.             if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  2162.             if Key <> 0 then ChoiceButtonDown;
  2163.             Key := 0;
  2164.           end;
  2165.       end
  2166.     else begin
  2167.       case Key of
  2168.          VK_UP, VK_DOWN:
  2169.            begin
  2170.              if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  2171.              if (not ReadOnly) and (Key <>0) then
  2172.              begin
  2173.                if FItemIndex = -1 then
  2174.                   Index := GetFirstEntry(False)
  2175.                else
  2176.                   Index := FItemIndex;
  2177.                if Key = VK_UP then Dec(Index) else Inc(Index);
  2178.                if Index < 0 then Index := 0;
  2179.                if (Index + 1) <= FItems.Count then SetText(Items[Index], Index, 0, -1);
  2180.                Key := 0;
  2181.              end;
  2182.            end;
  2183.          VK_DELETE:
  2184.            begin
  2185.              if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  2186.              if (Key <> 0) and not ReadOnly then
  2187.              begin
  2188.                FItemIndex := -1;
  2189.              end;
  2190.            end;
  2191.       end;
  2192.     end;
  2193.   end;
  2194.   if Key <> 0 then inherited;
  2195. end;
  2196.  
  2197. procedure TDCCustomComboBox.KeyPress(var Key: Char);
  2198. begin
  2199.   if FListBoxVisible  and (FListBox<>nil) then
  2200.   begin
  2201.     case Key of
  2202.       Char(VK_RETURN):
  2203.         begin
  2204.           CloseUp(1, True);
  2205.           if not PerformCloseUp then Key := #0;
  2206.         end;
  2207.       Char(VK_ESCAPE): begin CloseUp(0, True); Key := #0; end;
  2208.     end;
  2209.   end
  2210.   else begin
  2211.     case Key of
  2212.       Char(VK_ESCAPE): SetText(FLastText, FLastIndex, -1, 0);
  2213.     end;
  2214.   end;
  2215.   inherited KeyPress(Key);
  2216. end;
  2217.  
  2218. procedure TDCCustomComboBox.KillFocus(var Value: boolean);
  2219. begin
  2220.  if CanModified and not Value and not FCanEmpty and (Trim(Text) = '')
  2221.  then begin
  2222.    Value := True;
  2223.    FErrorCode := ERR_EDIT_EMPTYVALUE;
  2224.  end;
  2225.  if CanModified and not Value and (FStyle = csDropDownList) and
  2226.     (FItemIndex = -1) and (Trim(Text) <> '')
  2227.  then begin
  2228.    Value := True;
  2229.    FErrorCode := ERR_COMBO_ILLIGALVALUE;
  2230.  end;
  2231.  inherited KillFocus(Value);
  2232. end;
  2233.  
  2234. procedure TDCCustomComboBox.ListMouseUp(Sender: TObject;
  2235.    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2236. begin
  2237.   inherited;
  2238.   if Button = mbLeft then CloseUp(1, True);
  2239. end;
  2240.  
  2241. procedure TDCCustomComboBox.SetItemIndex(Value: integer);
  2242.  var
  2243.   sText: string;
  2244. begin
  2245.   if (FItems.Count > 0) and (Value > -1) and (Value < FItems.Count)
  2246.     then
  2247.       sText := FItems.Strings[Value]
  2248.     else
  2249.       sText := '';
  2250.  
  2251.   if (FItemIndex <> Value) or (Text <> sText) then
  2252.   begin
  2253.     FItemIndex := Value;
  2254.     Text := sText;
  2255.     if Assigned(FOnIndexChange) then FOnIndexChange(Self);
  2256.     Invalidate;
  2257.   end;
  2258. end;
  2259.  
  2260. procedure TDCCustomComboBox.SetItems(Value: TStrings);
  2261. begin
  2262.   FItems.Assign(Value);
  2263. end;
  2264.  
  2265. procedure TDCCustomComboBox.SetComboBoxStyle(Value: TComboBoxStyle);
  2266. begin
  2267.   if FStyle <> Value then
  2268.   begin
  2269.     FStyle := Value;
  2270.     case FStyle of
  2271.        csDropDown:
  2272.          ButtonExist := True;
  2273.        csSimple:
  2274.          ButtonExist := False;
  2275.        csDropDownList:
  2276.          begin
  2277.            ButtonExist := True;
  2278.            Text := ''
  2279.          end;
  2280.        csOwnerDrawFixed:
  2281.          ButtonExist := True;
  2282.        csOwnerDrawVariable:
  2283.          ButtonExist := True;
  2284.     end;
  2285.     RecreateWnd;
  2286.   end;
  2287. end;
  2288.  
  2289. procedure TDCCustomComboBox.SetText(Value: string; ItemIndex: integer;
  2290.   ASelStart, ASelLen: integer);
  2291. begin
  2292.   if (Text <> Value) or (Self.ItemIndex <> ItemIndex) then
  2293.   begin
  2294.     Self.ItemIndex := ItemIndex;
  2295.     Text := Value;
  2296.     SendMessage(Handle, EM_SETSEL, ASelLen, ASelStart);
  2297.     if (FStyle = csDropDownList) then Change;
  2298.   end;
  2299. end;
  2300.  
  2301. procedure TDCCustomComboBox.FindNextItem(cFirstChar: char);
  2302.  var
  2303.   ItemPos, i: integer;
  2304.   Found: boolean;
  2305. begin
  2306.   if ReadOnly then Exit;
  2307.   ItemPos := FItemIndex;
  2308.   i := ItemPos+1;
  2309.   Found := False;
  2310.   while i<=(FItems.Count-1) do
  2311.   begin
  2312.     if i < 0 then
  2313.     begin
  2314.       Inc(i);
  2315.       continue;
  2316.     end;
  2317.     if FItems.Strings[i][1] = cFirstChar then
  2318.     begin
  2319.       Found := True;
  2320.       break;
  2321.     end;
  2322.     Inc(i);
  2323.   end;
  2324.  
  2325.   if Found then
  2326.     SetText(Items[i], i, 0, 0 )
  2327.   else begin
  2328.     i := 0;
  2329.     Found := False;
  2330.     while i<=(ItemPos-1) do
  2331.     begin
  2332.       if FItems.Strings[i][1] = cFirstChar then
  2333.       begin
  2334.         Found := True;
  2335.         break;
  2336.       end;
  2337.       Inc(i);
  2338.     end;
  2339.   end;
  2340.  
  2341.   if Found then
  2342.   begin
  2343.     SetText(Items[i], i, 0, 0 );
  2344.     if FListBoxVisible then FListBox.ItemIndex := i;
  2345.   end;
  2346. end;
  2347.  
  2348. procedure TDCCustomComboBox.WMChar(var Message: TWMChar);
  2349. begin
  2350.   if not NotEditControl then
  2351.   begin
  2352.     if not (Message.CharCode in [0, 13, 27]) then
  2353.       FItemIndex := -1;
  2354.     inherited;
  2355.     if not (Message.CharCode in [0, 8, 13, 27]) then GetEntryText;
  2356.     if FListBoxVisible then FListBox.ItemIndex := ItemIndex;
  2357.   end
  2358.   else begin
  2359.      FindNextItem(Char(Message.CharCode));
  2360.     inherited;
  2361.   end;
  2362. end;
  2363.  
  2364. procedure TDCCustomComboBox.WMGetDlgCode(var Message: TWMGetDlgCode);
  2365. begin
  2366.   Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_WANTALLKEYS;
  2367. end;
  2368.  
  2369. procedure TDCCustomComboBox.WMKillFocus(var Message: TWMKillFocus);
  2370. begin
  2371.   if Assigned(FItems) and (FItemIndex =-1) then FItemIndex := GetFirstEntry(False);
  2372.   inherited;
  2373.   if Assigned(FItems) then PaintListItem(False);
  2374. end;
  2375.  
  2376. procedure TDCCustomComboBox.PaintListItem(bFocused: boolean);
  2377. const
  2378.   Alignments: array[Boolean, TAlignment] of DWORD =
  2379.     ((DT_LEFT, DT_RIGHT, DT_CENTER),(DT_RIGHT, DT_LEFT, DT_CENTER));
  2380.  var
  2381.   DC: HDC;
  2382.   R: TRect;
  2383.   ACanvas: TCanvas;
  2384. begin
  2385.   if not NotEditControl then Exit;
  2386.  
  2387.   ACanvas := TControlCanvas.Create;
  2388.  
  2389.   DC := GetWindowDC(Handle);
  2390.  
  2391.   GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  2392.   if PaintCheckGlyph  then R.Left := R.Left + FCheckGlyph.Width + 2;
  2393.   if ButtonWidth > 0 then
  2394.   begin
  2395.     R.Right := R.Right - ButtonWidth;
  2396.     if FDrawStyle = fsFlat then R.Right := R.Right - 1
  2397.   end;
  2398.   case FDrawStyle of
  2399.     fsNone  :
  2400.      begin
  2401.        InflateRect(R, -1, -1);
  2402.        R.Left := R.Left -1;
  2403.      end;
  2404.     fsSingle  :
  2405.      begin
  2406.        InflateRect(R, -2, -2);
  2407.        R.Right := R.Right -1;
  2408.      end;
  2409.     fcsNormal,
  2410.     fsFlat  :
  2411.      InflateRect(R, -3, -3);
  2412.   end;
  2413.  
  2414.   ACanvas.Handle := DC;
  2415.   ACanvas.Font         := Font;
  2416.   ACanvas.Brush.Color  := Color;
  2417.   InflateRect(R, 1, 1);
  2418.   FillRect(ACanvas.Handle, R, ACanvas.Brush.Handle);
  2419.   InflateRect(R, -1, -1);
  2420.  
  2421.   if bFocused then
  2422.   begin
  2423.     ACanvas.Brush.Color := clHighlight;
  2424.     ACanvas.Font.Color  := clHighlightText;
  2425.   end;
  2426.  
  2427.   try
  2428.     if FDrawStyle = fsNone then
  2429.       R.Left  := R.Left  +1;
  2430.     FillRect(ACanvas.Handle, R, ACanvas.Brush.Handle);
  2431.     if bFocused then DrawFocusRect(ACanvas.Handle, R);
  2432.     InflateRect(R, -1, -1);
  2433.     SetBkMode(ACanvas.Handle, TRANSPARENT);
  2434.     case FDrawStyle of
  2435.       fcsNormal,
  2436.       fsFlat  ,
  2437.       fsNone  : R.Top  := R.Top  -1;
  2438.     end;
  2439.     if (FItems.Count > 0) and (FItemIndex > -1) and (FItemIndex < FItems.Count)
  2440.       then
  2441.         Text := FItems.Strings[FItemIndex]
  2442.       else
  2443.         Text := '';
  2444.  
  2445.     if Assigned(FOnDrawText) then
  2446.       FOnDrawText(ACanvas, Self, FItemIndex, R, [])
  2447.     else
  2448.       DrawText(ACanvas.Handle, PChar(Text), Length(Text), R,
  2449.         Alignments[UseRightToLeftAlignment, FAlignment]);
  2450.   finally
  2451.     ReleaseDC(Handle, DC);
  2452.     ACanvas.Handle := 0;
  2453.     ACanvas.Free;
  2454.   end;
  2455. end;
  2456.  
  2457. procedure TDCCustomComboBox.WMPaint(var Message: TWMPaint);
  2458.  var
  2459.   PS: TPaintStruct;
  2460. begin
  2461.   DrawBitmap(FItemIndex);
  2462.   if not NotEditControl then
  2463.     inherited
  2464.   else begin
  2465.    BeginPaint(Handle, PS);
  2466.    RedrawBorder(True, 0);
  2467.    PaintListItem(Focused and not FListBoxVisible);
  2468.    EndPaint(Handle, PS);
  2469.  end;
  2470. end;
  2471.  
  2472. procedure TDCCustomComboBox.WMSetFocus(var Message: TWMSetFocus);
  2473. begin
  2474.   FLastText := Text;
  2475.   FLastIndex:= FItemIndex;
  2476.   inherited;
  2477.   if NotEditControl then HideCaret(Handle);
  2478. end;
  2479.  
  2480. procedure TDCCustomComboBox.WndProc(var Message: TMessage);
  2481.  var
  2482.    lFocused: boolean;
  2483. begin
  2484.   lFocused := Focused;
  2485.   inherited WndProc(Message);
  2486.   if csDesigning in ComponentState then Exit;
  2487.   case Message.Msg of
  2488.     WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  2489.       begin
  2490.         if NotEditControl and not(FInButtonArea or FInCheckArea)
  2491.         then begin
  2492.           if not Focused then SetFocus;
  2493.           if Focused then
  2494.             with FBtnChoice do UpdateButtonState(Left+1, Top+1, True, False);
  2495.         end;
  2496.         if not NotEditControl and not lFocused then SelectAll;
  2497.       end;
  2498.   end;
  2499. end;
  2500.  
  2501. procedure TDCCustomComboBox.CMEnter(var Message: TCMEnter);
  2502. begin
  2503.   inherited;
  2504.   PaintListItem(Focused);
  2505. end;
  2506.  
  2507. function TDCCustomComboBox.NotEditControl: boolean;
  2508. begin
  2509.   Result := (FStyle = csDropDownList) and not FEditing;
  2510. end;
  2511.  
  2512. { TDCCustomEdit }
  2513.  
  2514. procedure TDCCustomEdit.BeginUpdate(HookChanges: boolean = True);
  2515. begin
  2516.   if FUpdateCount = 0 then FChanged := False;
  2517.   Inc(FUpdateCount);
  2518.   FHookChanges := HookChanges;
  2519. end;
  2520.  
  2521. function TDCCustomEdit.CanModified: boolean;
  2522. begin
  2523.   Result := not ReadOnly;;
  2524. end;
  2525.  
  2526. procedure TDCCustomEdit.Change;
  2527. begin
  2528.   if not(csLoading in ComponentState) then
  2529.   begin
  2530.     if FUpdateCount = 0 then inherited;
  2531.     FChanged := True;
  2532.   end;
  2533. end;
  2534.  
  2535. procedure TDCCustomEdit.CloseUp(State: Byte; bPerform: boolean);
  2536. begin
  2537.   if bPerform then
  2538.     Perform(CM_POPUPWINDOW, 0, 0)
  2539.   else
  2540.     PostMessage(Handle, CM_POPUPWINDOW, 0, 0);
  2541. end;
  2542.  
  2543. procedure TDCCustomEdit.CMCancelMode(var Message: TCMCancelMode);
  2544. begin
  2545.   inherited;
  2546.   if ErrorWindow <> nil then
  2547.   begin
  2548.     if not((Message.Sender = ErrorWindow) and (ErrorWindow.Buttons.Count > 0)) then
  2549.     begin
  2550.       if Message.Sender = ErrorWindow then
  2551.         HideErrorMessage
  2552.       else
  2553.         Perform(CM_ERRORMESSAGE, 0, 0);
  2554.     end;
  2555.   end;
  2556. end;
  2557.  
  2558. procedure TDCCustomEdit.CMDialogChar(var Message: TCMDialogChar);
  2559.  var
  2560.   Button: TDCEditButton;
  2561. begin
  2562.   if (ErrorWindow <> nil) and (ErrorControl = Self) and
  2563.      ErrorWindow.Buttons.IsButtonAccel(Message.CharCode, Button) then
  2564.   begin
  2565.     Message.Result := 1;
  2566.     Button.Click;
  2567.   end
  2568.   else
  2569.     inherited;
  2570. end;
  2571.  
  2572. procedure TDCCustomEdit.CMEnter(var Message: TCMEnter);
  2573. begin
  2574.   inherited;
  2575.   if not FMouseActivate then SendMessage(Handle, EM_SETSEL, 0, -1);
  2576.   FMouseActivate := False;
  2577. end;
  2578.  
  2579. procedure TDCCustomEdit.CMErrorMessage(var Message: TMessage);
  2580. begin
  2581.   case Message.WParam of
  2582.     0: {Hide}
  2583.      if ErrorWindow <> nil then
  2584.      begin
  2585.        UnHookErrorHooks;
  2586.        ErrorWindow.Hide;
  2587.        ErrorWindow.Free;
  2588.        ErrorControl:= nil;
  2589.        ErrorWindow := nil;
  2590.        FShowError   := False;
  2591.      end;
  2592.     1: {Show}
  2593.      begin
  2594.        CloseUp(0, True);
  2595.        if Message.LParam <> 0 then FErrorCode := Message.LParam;
  2596.        GetHintOnError;
  2597.        if Trim(FErrorHint) <> '' then
  2598.        begin
  2599.           if ErrorWindow <> nil then
  2600.           begin
  2601.             if ErrorWindow.Caption = FErrorHint then Exit;
  2602.             ErrorWindow.Hide;
  2603.           end
  2604.           else begin
  2605.             ErrorControl := Self;
  2606.             ErrorWindow  := TDCMessageWindow.Create(Self);
  2607.             with ErrorWindow do
  2608.             begin
  2609.               Parent := Self;
  2610.               Hide;
  2611.               AutoHide := True;
  2612.               TimeOut  := GetHintTimeOut;
  2613.               DialogStyle := dsInvalidValue;
  2614.               PopupAlignment := wpOffset;
  2615.               MessageStyle   := msTail;
  2616.               Left := 5;
  2617.               Top  := Self.Height - 9;
  2618.             end;
  2619.           end;
  2620.           DoShowError(ErrorWindow);
  2621.           with ErrorWindow do
  2622.           begin
  2623.             Caption    := FErrorHint;
  2624.             FShowError := True;
  2625.             Show;
  2626.             HookErrorHooks;
  2627.           end;
  2628.        end;
  2629.      end;
  2630.   end;
  2631. end;
  2632.  
  2633. procedure TDCCustomEdit.CMExit(var Message: TCMExit);
  2634.  var
  2635.   Value: boolean;
  2636. begin
  2637.   Value := False;
  2638.   if Visible then
  2639.   begin
  2640.     FErrorCode := ERR_EDIT_NONE;
  2641.     KillFocus(Value);
  2642.     FShowError := Value;
  2643.     if FShowError then
  2644.     begin
  2645.       SetFocus;
  2646.       ShowErrorMessage;
  2647.     end
  2648.     else begin
  2649.       SelStart  := 1;
  2650.       SelLength := 0;
  2651.       inherited;
  2652.     end;
  2653.   end
  2654.   else
  2655.     inherited;
  2656. end;
  2657.  
  2658. constructor TDCCustomEdit.Create(AOwner: TComponent);
  2659. begin
  2660.   inherited;
  2661.   ControlStyle:= ControlStyle - [csFixedHeight];
  2662.   FErrorHint := '';
  2663.   FMouseActivate := False;
  2664.   FDBObject := TDCDBObject.Create;
  2665.   FUpdateCount := 0;
  2666.   FCanEmpty := True;
  2667.   CreateData;
  2668. end;
  2669.  
  2670. procedure TDCCustomEdit.CreateData;
  2671. begin
  2672.   if Assigned(FOnCreateData) then FOnCreateData(Self);
  2673. end;
  2674.  
  2675. procedure TDCCustomEdit.CreateParams(var Params: TCreateParams);
  2676. const
  2677.   aAlignments: array[Boolean, TAlignment] of DWORD =
  2678.     ((ES_LEFT, ES_RIGHT, ES_CENTER),(ES_RIGHT, ES_LEFT, ES_CENTER));
  2679. begin
  2680.   inherited CreateParams(Params);
  2681.   with Params do
  2682.   begin
  2683.     Style := Style or aAlignments[UseRightToLeftAlignment, FAlignment];
  2684.     ControlStyle := ControlStyle + [csOpaque];
  2685.   end;
  2686. end;
  2687.  
  2688. procedure TDCCustomEdit.CreateWnd;
  2689. begin
  2690.   inherited CreateWnd;
  2691. end;
  2692.  
  2693. procedure TDCCustomEdit.DeSelect;
  2694. begin
  2695.   SendMessage(Handle, EM_SETSEL, $7FFFFFFF, Longint($FFFFFFFF));
  2696. end;
  2697.  
  2698. destructor TDCCustomEdit.Destroy;
  2699. begin
  2700.   Perform(CM_ERRORMESSAGE, 0, 0);
  2701.   FDBObject.Free;
  2702.   FDBObject := nil;
  2703.   DestroyData;
  2704.   inherited;
  2705. end;
  2706.  
  2707. procedure TDCCustomEdit.DestroyData;
  2708. begin
  2709.   if Assigned(FOnDestroyData) then FOnDestroyData(Self);
  2710. end;
  2711.  
  2712. procedure TDCCustomEdit.DoCloseUp;
  2713. begin
  2714.   if Assigned(FOnCloseUp) then FOnCloseUp(Self);
  2715. end;
  2716.  
  2717. procedure TDCCustomEdit.DoShowError(AErrorWindow: TDCMessageWindow);
  2718. begin
  2719.   if Assigned(FOnShowError) then FOnShowError(ErrorWindow);
  2720. end;
  2721.  
  2722. procedure TDCCustomEdit.EndUpdate;
  2723. begin
  2724.   if FUpdateCount > 0 then
  2725.   begin
  2726.     Dec(FUpdateCount);
  2727.     if (FUpdateCount = 0) and FChanged then
  2728.     begin
  2729.       if FHookChanges then Change;
  2730.       FChanged := False;
  2731.     end;
  2732.   end;
  2733. end;
  2734.  
  2735. function TDCCustomEdit.GetDBObject: TDCDBObject;
  2736. begin
  2737.   Result := FDBObject;
  2738. end;
  2739.  
  2740. procedure TDCCustomEdit.GetHintOnError;
  2741. begin
  2742.   case FErrorCode of
  2743.     ERR_EDIT_EMPTYVALUE: FErrorHint := LoadStr(RES_EDIT_ERR_EMPTY);
  2744.   end;
  2745.   if Assigned(FOnGetErrorHint) then FOnGetErrorHint(Self, FErrorCode, FErrorHint);
  2746. end;
  2747.  
  2748. function TDCCustomEdit.GetHintTimeOut: integer;
  2749. begin
  2750.   Result := 2500;
  2751. end;
  2752.  
  2753. procedure TDCCustomEdit.HideErrorMessage;
  2754. begin
  2755.   PostMessage(Handle, CM_ERRORMESSAGE, 0, 0);
  2756. end;
  2757.  
  2758. procedure TDCCustomEdit.KeyPress(var Key: Char);
  2759. begin
  2760.   case Key of
  2761.     Char(VK_ESCAPE):
  2762.        SendMessage(Handle, EM_UNDO, 0, 0);
  2763.     Char(VK_RETURN):
  2764.       if (Key <> #0) and (ErrorWindow <> nil) and (ErrorWindow.Buttons.Count > 0) then
  2765.       begin
  2766.         HideErrorMessage;
  2767.         Key := #0;
  2768.       end;
  2769.   end;
  2770.   inherited KeyPress(Key);
  2771. end;
  2772.  
  2773. procedure TDCCustomEdit.KillFocus(var Value: boolean);
  2774.  var
  2775.   Form: TCustomForm;
  2776. begin
  2777.   if CanModified and not Value then
  2778.   begin
  2779.     if not FCanEmpty and (Trim(Text) = '')
  2780.     then begin
  2781.       Value := True;
  2782.       FErrorCode := ERR_EDIT_EMPTYVALUE;
  2783.     end
  2784.     else
  2785.       FErrorCode := ERR_EDIT_NONE;
  2786.   end;
  2787.  
  2788.   if Assigned(FOnKillFocus) then FOnKillFocus(Self, Value);
  2789.   if Value then
  2790.   begin
  2791.     if (Parent <> nil) then
  2792.     begin
  2793.        Form  := GetParentForm(Parent);
  2794.        Value := not (Boolean(SendMessage(Form.Handle, CM_INVALIDVALUE, Integer(Self), 0)) or
  2795.                      Boolean(SendMessage(Parent.Handle, CM_INVALIDVALUE, Integer(Self), 0)));
  2796.     end
  2797.   end;
  2798.   if not Value then Perform(CM_ERRORMESSAGE, 0, 0);
  2799. end;
  2800.  
  2801. procedure TDCCustomEdit.SetAlignment(Value: TAlignment);
  2802.  var
  2803.   sText: string;
  2804. begin
  2805.   if FAlignment <> Value then
  2806.   begin
  2807.     sText := Text;
  2808.     FAlignment := Value;
  2809.     RecreateWnd;
  2810.     SetEditRect;
  2811.     Text := sText;
  2812.   end;
  2813. end;
  2814.  
  2815. procedure TDCCustomEdit.SetData(const Value: Pointer);
  2816. begin
  2817.   FData := Value;
  2818. end;
  2819.  
  2820. procedure TDCCustomEdit.SetDBObject(const Value: TDCDBObject);
  2821. begin
  2822.   FDBObject.Assign(Value);
  2823. end;
  2824.  
  2825. procedure TDCCustomEdit.SetEditRect;
  2826. begin
  2827.   {}
  2828. end;
  2829.  
  2830. procedure TDCCustomEdit.ShowErrorMessage;
  2831. begin
  2832.   PostMessage(Handle, CM_ERRORMESSAGE, 1, 0);
  2833. end;
  2834.  
  2835. function TDCCustomEdit.ValueCorrect: boolean;
  2836.  var
  2837.   isError: boolean;
  2838. begin
  2839.   isError := False;
  2840.   FErrorCode := ERR_EDIT_NONE;
  2841.   if Visible then KillFocus(isError);
  2842.   Result  := not isError;
  2843. end;
  2844.  
  2845. procedure TDCCustomEdit.WMMouseActivate(var Message: TWMActivate);
  2846. begin
  2847.   inherited;
  2848.   FMouseActivate := True;
  2849. end;
  2850.  
  2851. { TDCCustomDateEdit }
  2852.  
  2853. procedure TDCCustomDateEdit.ChoiceClick(Sender: TObject);
  2854. begin
  2855.   inherited;
  2856.   if DropDownVisible then
  2857.     CloseUp(0, True)
  2858.   else
  2859.     Perform(CM_POPUPWINDOW, 1, 0);
  2860. end;
  2861.  
  2862. procedure TDCCustomDateEdit.CMFontChanged(var Message: TMessage);
  2863. begin
  2864.   inherited;
  2865.   if FShowCheckBox and FChecked then FFontColor := Font.Color;
  2866. end;
  2867.  
  2868. procedure TDCCustomDateEdit.Loaded;
  2869. begin
  2870.   inherited;
  2871.   FFontColor := Font.Color;
  2872. end;
  2873.  
  2874. procedure TDCCustomDateEdit.SetChecked(Value: boolean);
  2875. begin
  2876.   if csDesigning in ComponentState then Value := True;
  2877.  
  2878.   if FShowCheckBox and (FChecked <> Value) and not FReadOnly
  2879.   then begin
  2880.     FChecked := Value;
  2881.     FInCheckProc := True;
  2882.     ReadOnly := not FChecked;
  2883.     FInCheckProc := False;
  2884.     SetCheckGlyph;
  2885.     if Assigned(FOnChecked) then FOnChecked(Self);
  2886.     Invalidate;
  2887.   end;
  2888. end;
  2889.  
  2890. procedure TDCCustomDateEdit.SetShowCheckBox(Value: boolean);
  2891. begin
  2892.   if FShowCheckBox <> Value then
  2893.   begin
  2894.     FShowCheckBox := Value;
  2895.     if FShowCheckBox then
  2896.       SetCheckGlyph
  2897.     else begin
  2898.       FChecked := True;
  2899.       SetCheckGlyph;
  2900.       SetFontColor(FFontColor);
  2901.     end;
  2902.     SetEditRect;
  2903.     Invalidate;
  2904.   end;
  2905. end;
  2906.  
  2907. procedure TDCCustomDateEdit.CloseUp(State: Byte; bPerform: boolean = False);
  2908.  var
  2909.   xDate: string;
  2910. begin
  2911.   case State of
  2912.      0:;
  2913.      1:
  2914.       if not FReadOnly and DateToStrY2K(FCalendar.Date, xDate, Kind) then
  2915.       begin
  2916.         UndoDate := FCalendar.Date;
  2917.         Text     := xDate;
  2918.         if FChecked then SendMessage(Handle, EM_SETSEL, 0, -1);
  2919.       end;
  2920.   end;
  2921.   inherited;
  2922. end;
  2923.  
  2924. procedure TDCCustomDateEdit.GetDateText;
  2925.  var
  2926.   i, j: integer;
  2927.   pText: PChar;
  2928.   nSelStart,nSelEnd: integer;
  2929.   DateFormatStr: string;
  2930. begin
  2931.   {╙ßΦ≡ασ∞ Φτ ≥σΩ±≥α DateSeparator}
  2932.   nSelStart := SelStart;
  2933.   nSelEnd   := nSelStart+SelLength;
  2934.   if nSelEnd = nSelStart then inc(nSelEnd,1);
  2935.  
  2936.   FStartPos := nSelStart;
  2937.   FEndPos   := nSelEnd;
  2938.   FDateText := '';
  2939.   pText     := PChar(Text);
  2940.  
  2941.   case FKind of
  2942.     dkDate    :
  2943.       DateFormatStr := Format(EDIT_FMT_DEDATE, [DateSeparator]);
  2944.     dkDateTime:
  2945.       DateFormatStr := Format(EDIT_FMT_DETIME, [DateSeparator, TimeSeparator]);
  2946.   end;
  2947.  
  2948.   j := 1; i := 0;
  2949.   while pText^ <> #0 do
  2950.   begin
  2951.     if (j <= Length(DateFormatStr)) and (DateFormatStr[j] = '|') then
  2952.     begin
  2953.       inc(j);
  2954.       if pText^ = DateFormatStr[j] then
  2955.       begin
  2956.         if i < nSelStart then Dec(FStartPos);
  2957.         if i < nSelEnd  then Dec(FEndPos);
  2958.       end
  2959.       else
  2960.         case DateFormatStr[j] of
  2961.          'a':
  2962.            begin
  2963.              inc(j);
  2964.              continue;
  2965.            end;
  2966.         end;
  2967.     end
  2968.     else
  2969.       FDateText := FDateText + pText^;
  2970.     inc(i);
  2971.     inc(j);
  2972.     inc(pText);
  2973.   end;
  2974. end;
  2975.  
  2976. procedure TDCCustomDateEdit.SetDateText;
  2977.  var
  2978.   i, j: integer;
  2979.   nSelStart: integer;
  2980.   sText, DateFormatStr: string;
  2981.   pText: PChar;
  2982.   AutoComplete: boolean;
  2983.  
  2984.   procedure AddToText(cText: Char; Mode: Byte);
  2985.   begin
  2986.     sText := sText + cText;
  2987.     if (Mode = 1) and (FStartPos > i) then Inc(nSelStart,1);
  2988.   end;
  2989.  
  2990. begin
  2991.   sText := '';
  2992.   pText := PChar(FDateText);
  2993.  
  2994.   case FKind of
  2995.     dkDate    :
  2996.       DateFormatStr := Format(EDIT_FMT_DEDATE, [DateSeparator]);
  2997.     dkDateTime:
  2998.       DateFormatStr := Format(EDIT_FMT_DETIME, [DateSeparator, TimeSeparator]);
  2999.   end;
  3000.  
  3001.   nSelStart    := FStartPos;
  3002.   AutoComplete := False;
  3003.  
  3004.   i := 0; j := 1;
  3005.   if (j <= Length(DateFormatStr)) and (DateFormatStr[j] = '|') then
  3006.   begin
  3007.     inc(j);
  3008.     if DateFormatStr[j] in [DateSeparator, TimeSeparator] then
  3009.       AddToText(DateFormatStr[j], 1)
  3010.     else
  3011.       case DateFormatStr[j] of
  3012.        'a':
  3013.          begin
  3014.            AutoComplete := True;
  3015.            inc(j);
  3016.          end;
  3017.       else
  3018.         AddToText(DateFormatStr[j], 1)
  3019.       end;
  3020.   end;
  3021.  
  3022.   while pText^ <> #0 do
  3023.   begin
  3024.     if DateFormatStr[j] <> '|' then inc(j);
  3025.     if (j <= Length(DateFormatStr)) and (DateFormatStr[j] = '|') then
  3026.     begin
  3027.       inc(j);
  3028.       if DateFormatStr[j] in [DateSeparator, TimeSeparator] then
  3029.       begin
  3030.         AddToText(pText^, 0);
  3031.         AddToText(DateFormatStr[j], 1)
  3032.       end
  3033.       else
  3034.         case DateFormatStr[j] of
  3035.          'a':
  3036.           begin
  3037.            AutoComplete := True;
  3038.            inc(j);
  3039.            continue;
  3040.           end;
  3041.         else begin
  3042.           AddToText(pText^, 0);
  3043.           AddToText(DateFormatStr[j], 1)
  3044.         end;  
  3045.         end;
  3046.       if DateFormatStr[j] <> '|' then inc(j);
  3047.     end
  3048.     else
  3049.       AddToText(pText^, 0);
  3050.     inc(i);
  3051.     inc(pText);
  3052.   end;
  3053.  
  3054.   if AutoComplete  then
  3055.   begin
  3056.     while j <= Length(DateFormatStr) do
  3057.     begin
  3058.       if DateFormatStr[j] <> '|' then
  3059.         AddToText(DateFormatStr[j], 1)
  3060.       else begin
  3061.         inc(j);
  3062.         AddToText(DateFormatStr[j], 1)
  3063.       end;
  3064.       inc(j);
  3065.       inc(i);
  3066.     end;
  3067.   end;
  3068.  
  3069.   Text     := sText;
  3070.   SelStart := nSelStart;
  3071. end;
  3072.  
  3073. procedure TDCCustomDateEdit.SetText(var Key: char);
  3074.  var
  3075.   MaxTextLength: integer;
  3076. begin
  3077.   GetDateText;
  3078.   case Key of
  3079.     Char(VK_BACK): {BACKSPACE}
  3080.       begin
  3081.         DeleteChar(dtBackSpace);
  3082.         Key := #0;
  3083.       end;
  3084.   end;
  3085.  
  3086.   case FKind of
  3087.     dkDate    :
  3088.       MaxTextLength := 8;
  3089.     dkDateTime:
  3090.       MaxTextLength := 14;
  3091.     else
  3092.       MaxTextLength := 8;
  3093.   end;
  3094.  
  3095.   if Key in SetDateEdit then
  3096.   begin
  3097.     if (FStartPos+1 <> FEndPos) or (SelLength>0) then DeleteChar(dtDelete);
  3098.     if Length(FDateText) < MaxTextLength then
  3099.        FDateText := Copy(FDateText,1,FStartPos) + Key +
  3100.                     Copy(FDateText,FStartPos+1,Length(FDateText)-FStartPos)
  3101.     else begin
  3102.      if FStartPos >= MaxTextLength then FStartPos := MaxTextLength-1;
  3103.       if Key in Digits then
  3104.         FDateText := Copy(FDateText,1,FStartPos) + Key +
  3105.                      Copy(FDateText,FStartPos+2,Length(FDateText)-FStartPos-1);
  3106.     end;
  3107.     Inc(FStartPos,1);
  3108.   end;
  3109.   SetDateText;
  3110.  
  3111.   Key := #0;
  3112. end;
  3113.  
  3114. procedure TDCCustomDateEdit.DeleteChar(DeleteType: TDeleteType);
  3115. begin
  3116.   case DeleteType of
  3117.     dtBackSpace:
  3118.       begin
  3119.         if FStartPos+1 = FEndPos then
  3120.            FDateText := Copy(FDateText,1,FStartPos-1)+
  3121.                         Copy(FDateText,FEndPos,Length(FDateText)-FEndPos+1)
  3122.         else
  3123.            FDateText := Copy(FDateText,1,FStartPos)+
  3124.                         Copy(FDateText,FEndPos+1,Length(FDateText)-FEndPos+2);
  3125.         Dec(FStartPos,1);
  3126.       end;
  3127.     dtDelete   :
  3128.       begin
  3129.         FDateText := Copy(FDateText,1,FStartPos)+
  3130.                      Copy(FDateText,FEndPos+1,Length(FDateText)-FEndPos+2);
  3131.       end;
  3132.   end;
  3133. end;
  3134.  
  3135. procedure TDCCustomDateEdit.KeyPress(var Key: Char);
  3136. begin
  3137.   if FCalendarVisible and (FCalendar<>nil) then
  3138.   begin
  3139.     case Key of
  3140.       Char(VK_RETURN):
  3141.         begin
  3142.           CloseUp(1, True);
  3143.           if not PerformCloseUp then Key := #0;
  3144.         end;
  3145.       Char(VK_ESCAPE): begin CloseUp(0, True); Key := #0; end;
  3146.     end;
  3147.   end;
  3148.   if not (Key in SetDateEdit) or ReadOnly
  3149.   then begin
  3150.     if Key <> Chr(VK_ESCAPE) then Key := #0;
  3151.     inherited KeyPress(Key);
  3152.   end
  3153.   else begin
  3154.     if Key = Chr(VK_RETURN) then
  3155.     begin
  3156.       inherited KeyPress(Key);
  3157.       Key := #0;
  3158.     end
  3159.     else begin
  3160.       if Key >= Chr(VK_SPACE) then SetText(Key);
  3161.       inherited KeyPress(Key)
  3162.     end;
  3163.   end;
  3164. end;
  3165.  
  3166. procedure TDCCustomDateEdit.KeyDown(var Key: Word; Shift: TShiftState);
  3167.  var
  3168.   KeyDownEvent: TKeyEvent;
  3169. begin
  3170.   KeyDownEvent := OnKeyDown;
  3171.   if FCalendarVisible and (FCalendar<>nil) then
  3172.   begin
  3173.     case Key of
  3174.       VK_HOME ,
  3175.       VK_END  ,
  3176.       VK_PRIOR,
  3177.       VK_NEXT ,
  3178.       VK_LEFT ,
  3179.       VK_UP   ,
  3180.       VK_RIGHT,
  3181.       VK_DOWN :
  3182.         if Shift = [] then
  3183.         begin
  3184.           if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  3185.           FCalendar.KeyDown(Key, Shift);
  3186.           Key := 0;
  3187.         end
  3188.       else
  3189.         CloseUp(0);
  3190.     end;
  3191.   end
  3192.   else begin
  3193.     case Key of
  3194.       VK_DOWN   :
  3195.         if [ssAlt]*Shift = [ssAlt] then
  3196.         begin
  3197.           if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  3198.           if Key <> 0 then ChoiceButtonDown;
  3199.           Key := 0;
  3200.         end;
  3201.       VK_DELETE :
  3202.         if not ReadOnly then
  3203.         begin
  3204.           if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  3205.           if Key <> 0 then
  3206.           begin
  3207.             GetDateText;
  3208.             DeleteChar(dtDelete);
  3209.             SetDateText;
  3210.             Key := 0;
  3211.           end;
  3212.         end;
  3213.     end;
  3214.   end;
  3215.   if Key <> 0 then inherited;
  3216. end;
  3217.  
  3218. function TDCCustomDateEdit.GetShowCheckBox: boolean;
  3219. begin
  3220.   Result := FShowCheckBox;
  3221. end;
  3222.  
  3223. procedure TDCCustomDateEdit.CheckClick(Sender: TObject);
  3224. begin
  3225.   HideCaret(Handle);
  3226.   HideErrorMessage;
  3227.   if FDisableButtons then
  3228.   begin
  3229.     SetCaret;
  3230.     Exit;
  3231.   end;
  3232.   if not Focused then SetFocus;
  3233.   if Focused then
  3234.   begin
  3235.     if DropDownVisible then CloseUp(0, True);
  3236.     Checked := not Checked;
  3237.     if Assigned(FOnCheckClick) then FOnCheckClick(Self);
  3238.   end;
  3239.   SetCaret;
  3240. end;
  3241.  
  3242. procedure TDCCustomDateEdit.CMCancelMode(var Message: TCMCancelMode);
  3243. begin
  3244.   if (Message.Sender <> Self) and
  3245.      (Message.Sender <> FCalendar) and
  3246.      not FCalendar.ContainsControl(Message.Sender) then
  3247.   begin
  3248.     inherited;
  3249.   end;
  3250. end;
  3251.  
  3252. procedure TDCCustomDateEdit.KillFocus(var Value: boolean);
  3253.  var
  3254.   xDate: string;
  3255. begin
  3256.   if CanModified and not Value and not DateToStrY2K(Text, xDate, Kind) and
  3257.      not(Trim(Text) = '') then
  3258.   begin
  3259.     Value := True;
  3260.     xDate := Text;
  3261.     FErrorCode := ERR_DATE_INCORRECTDATE;
  3262.   end;
  3263.   if CanModified and not Value and not FCanEmpty and Empty then
  3264.   begin
  3265.     Value := True;
  3266.     FErrorCode := ERR_EDIT_EMPTYVALUE;
  3267.   end;
  3268.   if not Value and CanModified then
  3269.   begin
  3270.     Text := xDate;
  3271.     if FShowWeekDay then invalidate;
  3272.   end;
  3273.   inherited KillFocus(Value);
  3274. end;
  3275.  
  3276. constructor TDCCustomDateEdit.Create(AOwner: TComponent);
  3277. begin
  3278.   inherited;
  3279.   FShowCheckBox := False;
  3280.   FShowWeekDay  := True;
  3281.   FChecked      := True;
  3282.   FKind         := dkDate;
  3283.   FReadOnly     := ReadOnly;
  3284.   FInCheckProc  := False;
  3285. end;
  3286.  
  3287. function TDCCustomChoiceEdit.PaintCheckGlyph: boolean;
  3288. begin
  3289.   Result := FShowCheckBox and Assigned(FCheckGlyph) and not FCheckGlyph.Empty and
  3290.      ((Width-FCheckGlyph.Width) >= MinControlWidthBitmap);
  3291. end;
  3292.  
  3293. procedure TDCCustomDateEdit.EMSetReadOnly(var Message: TMessage);
  3294. begin
  3295.   inherited;
  3296.   if not FInCheckProc then FReadOnly := ReadOnly;
  3297. end;
  3298.  
  3299. procedure TDCCustomDateEdit.GetHintOnError;
  3300. begin
  3301.   case FErrorCode of
  3302.     ERR_DATE_INCORRECTDATE: FErrorHint := LoadStr(RES_DATE_ERR_WRONG);
  3303.    else
  3304.     FErrorHint := '';
  3305.   end;
  3306.   inherited;
  3307. end;
  3308.  
  3309. function TDCCustomDateEdit.GetDate: TDateTime;
  3310.  var
  3311.   xDate: string;
  3312. begin
  3313.   if DateToStrY2K(Text, xDate, Kind) then
  3314.     Result := StrToDateTime(xDate)
  3315.   else
  3316.     Result := 0;
  3317. end;
  3318.  
  3319. procedure TDCCustomDateEdit.SetDate(const Value: TDateTime);
  3320.  var
  3321.   xDate: string;
  3322. begin
  3323.   if DateToStrY2K(Value, xDate, Kind) then
  3324.   begin
  3325.     Text     := xDate;
  3326.     UndoDate := Value;
  3327.   end;
  3328. end;
  3329.  
  3330. function TDCCustomDateEdit.GetDropDownVisible: boolean;
  3331. begin
  3332.   Result := FCalendarVisible;
  3333. end;
  3334.  
  3335. procedure TDCCustomDateEdit.DefineBtnChoiceStyle;
  3336. begin
  3337.   if BtnChoiceAssigned then
  3338.   begin
  3339.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNPOPUP');
  3340.     ButtonStyle := esDropDown;
  3341.     ButtonChoiceStyle := btsCustom;
  3342.     ButtonChoice.SimpleStyle := True;
  3343.   end;
  3344. end;
  3345.  
  3346. procedure TDCCustomDateEdit.CMPopupWindow(var Message: TMessage);
  3347.  var
  3348.   xDate: string;
  3349. begin
  3350.   case Message.WParam of
  3351.     0:
  3352.      if FCalendarVisible then
  3353.      begin
  3354.        FCalendarVisible := False;
  3355.        FCalendar.Free;
  3356.        FCalendar := nil;
  3357.        ShowHint  := FHintShow;
  3358.      end;
  3359.     1:
  3360.      begin
  3361.        SetChecked(True);
  3362.        FHintShow := ShowHint;
  3363.        ShowHint  := False;
  3364.        FCalendar := TDCCustomCalendar.Create(Self);
  3365.        with FCalendar do
  3366.        begin
  3367.          OnCloseUp := CloseUp;
  3368.        end;
  3369.        try
  3370.         if Trim(Text) = ''
  3371.         then FCalendar.Date := SysUtils.Date
  3372.         else begin
  3373.           if DateToStrY2K(Text, xDate, Kind)
  3374.             then FCalendar.Date := StrToDateTime(xDate)
  3375.             else FCalendar.Date := SysUtils.Date;
  3376.         end;
  3377.        except
  3378.         FCalendar.Date := SysUtils.Date;
  3379.        end;
  3380.        ShowDropDown;
  3381.        FCalendarVisible := True;
  3382.      end;
  3383.   end;
  3384. end;
  3385.  
  3386. procedure TDCCustomDateEdit.SetMargins(var LeftMargin: integer;
  3387.   var RightMargin: integer);
  3388. begin
  3389.   inherited SetMargins(LeftMargin, RightMargin);
  3390.   if ShowWeekDay then
  3391.   begin
  3392.     if PaintCheckGlyph then
  3393.       LeftMargin := FCheckGlyph.Width + 2
  3394.     else
  3395.       LeftMargin := 0;
  3396.     LeftMargin := LeftMargin + Length(ShortDayNames[1])*GetDCTextWidth(Font, 'W');
  3397.   end;
  3398. end;
  3399.  
  3400. procedure TDCCustomDateEdit.SetKind(const Value: TDateEditKind);
  3401. begin
  3402.   FKind := Value;
  3403.   Date  := Date;
  3404. end;
  3405.  
  3406. procedure TDCCustomDateEdit.DoDrawMargins(DC: HDC);
  3407.  var
  3408.   R: TRect;
  3409. begin
  3410.   inherited;
  3411.   if FShowWeekDay then
  3412.   begin
  3413.     SelectObject(DC, Font.Handle);
  3414.     if not Enabled and not(csDesigning in ComponentState) then
  3415.       SetTextColor(DC, ColorToRGB(clInactiveCaption))
  3416.     else
  3417.       SetTextColor(DC, ColorToRGB(Font.Color));
  3418.     SetBkColor(DC, ColorToRGB(Color));
  3419.  
  3420.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  3421.  
  3422.     if PaintCheckGlyph then R.Left := R.Left + FCheckGlyph.Width + 2;
  3423.     case FDrawStyle of
  3424.       fsNone  :
  3425.        begin
  3426.          InflateRect(R, -1, -1);
  3427.          R.Left := R.Left -1;
  3428.        end;
  3429.       fsSingle  :
  3430.        InflateRect(R, -3, -3);
  3431.       fcsNormal,
  3432.       fsFlat  :
  3433.        InflateRect(R, -3, -3);
  3434.     end;
  3435.  
  3436.     if FUndoDate <> 0 then
  3437.       DrawText(DC, PChar(ShortDayNames[DayOfWeek(FUndoDate)]),
  3438.         Length(ShortDayNames[DayOfWeek(FUndoDate)]), R, DT_LEFT);
  3439.   end;
  3440. end;
  3441.  
  3442. procedure TDCCustomDateEdit.SetFontColor(Value: TColor);
  3443. begin
  3444.   if [csDesigning, csLoading]*ComponentState = [] then Font.Color := Value;
  3445. end;
  3446.  
  3447. procedure TDCCustomDateEdit.CMEnter(var Message: TCMEnter);
  3448. begin
  3449.   inherited;
  3450.   UndoDate := GetDate;
  3451. end;
  3452.  
  3453. procedure TDCCustomDateEdit.CMExit(var Message: TCMExit);
  3454. begin
  3455.   inherited;
  3456.   UndoDate := GetDate;
  3457. end;
  3458.  
  3459. procedure TDCCustomDateEdit.SetUndoDate(const Value: TDateTime);
  3460. begin
  3461.   if Value <> FUndoDate then
  3462.   begin
  3463.     FUndoDate := Value;
  3464.   end;
  3465. end;
  3466.  
  3467.  
  3468. procedure TDCCustomDateEdit.SetShowWeekDay(const Value: boolean);
  3469. begin
  3470.   FShowWeekDay := Value;
  3471.   SetEditRect;
  3472. end;
  3473.  
  3474. function TDCCustomDateEdit.IsMasked: boolean;
  3475. begin
  3476.   Result := False;
  3477. end;
  3478.  
  3479. procedure TDCCustomDateEdit.ShowDropDown;
  3480. begin
  3481.   FCalendar.Show;
  3482. end;
  3483.  
  3484. function TDCCustomDateEdit.GetEmpty: boolean;
  3485. begin
  3486.   Result := (ShowCheckBox and not Checked) or (Date = 0); 
  3487. end;
  3488.  
  3489. procedure TDCCustomDateEdit.SetCheckGlyph;
  3490. begin
  3491.   if FChecked then
  3492.   begin
  3493.     if not FReadOnly then
  3494.       ETGetBitmap(DCGIM_SMALLICON, nsiNormalCheck1, FCheckGlyph)
  3495.     else
  3496.       ETGetBitmap(DCGIM_SMALLICON, nsiShadowCheck1, FCheckGlyph);
  3497.     SetFontColor(FFontColor);
  3498.   end
  3499.   else begin
  3500.     if not FReadOnly then
  3501.       ETGetBitmap(DCGIM_SMALLICON, nsiNormalCheck0, FCheckGlyph)
  3502.     else
  3503.       ETGetBitmap(DCGIM_SMALLICON, nsiShadowCheck0, FCheckGlyph);
  3504.     SetFontColor(clInactiveCaption);
  3505.   end;
  3506. end;
  3507.  
  3508. { TDCCustomGridEdit }
  3509. procedure TDCCustomGridEdit.BeginPaintListBox;
  3510. begin
  3511.   inc(FPaintBox);
  3512. end;
  3513.  
  3514. function TDCCustomGridEdit.CheckDataValue: boolean;
  3515.  var
  3516.   Found: boolean;
  3517.   AKeyValue: variant;
  3518.   ACursor: TCursor;
  3519. begin
  3520.   if not FQueryDataSet and (DataSet = nil) then
  3521.   begin
  3522.     Result := True;
  3523.     Exit;
  3524.   end;
  3525.  
  3526.   if not FValues.FLoaded then SetGridValues;
  3527.  
  3528.   if FErrorCode <> ERR_EDIT_NONE then
  3529.   begin
  3530.     Result := False;
  3531.     Exit;
  3532.   end;
  3533.  
  3534.   if not FQueryDataSet then FDataSet.DisableControls;
  3535.  
  3536.   ACursor := Screen.Cursor;
  3537.   Screen.Cursor := crHourGlass;
  3538.  
  3539.   try
  3540.   try
  3541.     if Assigned(FOnCheckDataValue) then
  3542.     begin
  3543.       if not FDataValueSelected then
  3544.       begin
  3545.         FOnCheckDataValue(Self, Text, FValues.Fields[FDataField].FieldType, Found, AKeyValue);
  3546.         if Found then
  3547.           SetKeyValue(AKeyValue)
  3548.         else
  3549.           ClearValue(False);
  3550.       end
  3551.       else Found := True;
  3552.       Result := Found;
  3553.     end
  3554.     else begin
  3555.       if not FDataValueSelected then
  3556.       begin
  3557.         if FQueryDataSet then
  3558.         begin
  3559.           try
  3560.             OpenQuery(0);
  3561.             if FQuery.RecordCount > 0 then
  3562.             begin
  3563.               Text      := FQuery.FieldByName(FDataField).AsString;
  3564.               AKeyValue := FQuery.FieldByName(FKeyField).AsVariant;
  3565.               SetKeyValueEx(AKeyValue, FNeedLocate);
  3566.               Result := True;
  3567.             end
  3568.             else begin
  3569.               ClearValue(False);
  3570.               Result := False;
  3571.             end;
  3572.             FQuery.Close;
  3573.           except
  3574.             Result := False;
  3575.           end;
  3576.         end
  3577.         else begin
  3578.           if DataSet.Active and DataSet.Locate(FDataField,Text, [loCaseInsensitive]) then
  3579.           begin
  3580.             AKeyValue := DataSet.FieldByName(FKeyField).AsVariant;
  3581.             SetKeyValueEx(AKeyValue, FNeedLocate);
  3582.             Result := True;
  3583.           end
  3584.           else begin
  3585.             ClearValue(False);
  3586.             Result := False;
  3587.           end
  3588.         end;
  3589.       end
  3590.       else Result := True;
  3591.     end;
  3592.   except
  3593.     Result := False;
  3594.   end
  3595.   finally
  3596.     if not FQueryDataSet then
  3597.       while FDataSet.ControlsDisabled do FDataSet.EnableControls;
  3598.     Screen.Cursor :=  ACursor;
  3599.   end;
  3600. end;
  3601.  
  3602. procedure TDCCustomGridEdit.ChoiceClick(Sender: TObject);
  3603. begin
  3604.   inherited;
  3605.   if DropDownVisible then
  3606.     CloseUp(0, True)
  3607.   else begin
  3608.     if FThreadInUse then begin
  3609.       PostMessage(Handle, CM_THREAD_STOP, 0, 0);
  3610.     end
  3611.     else if FListBoxVisible then
  3612.      PostMessage(Handle, CM_THREAD_FREEBOX, 0, 0);
  3613.  
  3614.     Perform(CM_POPUPWINDOW, 1, 0);
  3615.   end;
  3616. end;
  3617.  
  3618. procedure TDCCustomGridEdit.ClearValue(ClearText: boolean);
  3619.  var
  3620.   i: integer;
  3621. begin
  3622.   if ClearText then Text := '';
  3623.   FKeyValue  := null;
  3624.   if not FValues.FLoaded then SetGridValues;
  3625.   for i := 0 to Values.Count-1 do TGridValue(Values.Items[i]).AsString := '';
  3626.   invalidate;
  3627. end;
  3628.  
  3629. procedure TDCCustomGridEdit.CloseUp(State: Byte; bPerform: boolean = False);
  3630.  var
  3631.   i: integer;
  3632. begin
  3633.   FNeedLocate := True;
  3634.   case State of
  3635.      0:
  3636.        begin
  3637.          if FListBoxVisible then
  3638.          begin
  3639.            FListBoxVisible := False;
  3640.            if FThreadInUse then
  3641.            begin
  3642.              PostMessage(Handle, CM_THREAD_STOP, 0, 0);
  3643.            end
  3644.            else PostMessage(Handle, CM_THREAD_FREEBOX, 0, 0);
  3645.            ShowHint  := FHintShow;
  3646.          end;
  3647.      end;
  3648.      1:
  3649.        begin
  3650.          if FGridVisible and FieldExists(KeyField) then
  3651.          begin
  3652.            FDataValueSelected := True;
  3653.            if FQueryDataSet then
  3654.            begin
  3655.              FKeyValue := FQuery.FieldByName(KeyField).AsVariant;
  3656.              SetDataValues(FQuery);
  3657.            end
  3658.            else begin
  3659.              FKeyValue := FDataSet.FieldByName(KeyField).AsVariant;
  3660.              SetDataValues(FDataSet);
  3661.            end;
  3662.            SendControlMessage(CM_THREAD_LOCATED, 0, 0);
  3663.            FNeedLocate := False;
  3664.          end;
  3665.  
  3666.          if FListBoxVisible then
  3667.          begin
  3668.           FListBoxVisible := False;
  3669.           with FListBox do
  3670.           begin
  3671.             if ItemIndex >= 0 then
  3672.             begin
  3673.               FDataValueSelected := True;
  3674.               FKeyValue := TGridValues(Items.Objects[ItemIndex]).Fields[FKeyField].Value;
  3675.               Text      := TGridValues(Items.Objects[ItemIndex]).Fields[FDataField].AsString;
  3676.  
  3677.               with TGridValues(Items.Objects[ItemIndex]) do
  3678.                 for i := 0 to Count-1 do
  3679.                   TGridValue(FValues.Items[i]).AsString := TGridValue(Items[i]).AsString;
  3680.  
  3681.               SendControlMessage(CM_THREAD_LOCATED, 0, 0);
  3682.               FNeedLocate := False;
  3683.             end;
  3684.           end;
  3685.           if FThreadInUse then
  3686.           begin
  3687.             PostMessage(Handle, CM_THREAD_STOP, 0, 0);
  3688.           end
  3689.           else
  3690.             PostMessage(Handle, CM_THREAD_FREEBOX, 0, 0);
  3691.           ShowHint  := FHintShow;
  3692.          end;
  3693.       end;
  3694.   end;
  3695.   inherited;
  3696.   FFullQuery := True;
  3697. end;
  3698.  
  3699. procedure TDCCustomGridEdit.CMCancelMode(var Message: TCMCancelMode);
  3700. begin
  3701.   if (Message.Sender <> Self) and
  3702.      (Message.Sender <> FGrid) and
  3703.      not FGrid.ContainsControl(Message.Sender) and
  3704.      (Message.Sender <> FListBox) and
  3705.      not FListBox.ContainsControl(Message.Sender)
  3706.      then
  3707.   begin
  3708.     inherited;
  3709.   end;
  3710. end;
  3711.  
  3712. procedure TDCCustomGridEdit.CMExit(var Message: TCMExit);
  3713. begin
  3714.   if (Text = '') and CanEmpty then ClearValue(True);
  3715.   inherited;
  3716. end;
  3717.  
  3718. procedure TDCCustomGridEdit.CMPopupWindow(var Message: TMessage);
  3719.  var
  3720.   i: integer;
  3721.   ACursor: TCursor;
  3722. begin
  3723.   case Message.WParam of
  3724.     0:
  3725.      begin
  3726.        if FGridVisible then
  3727.        begin
  3728.          FGridVisible := False;
  3729.          FGrid.Hide;
  3730.          FGrid.Free;
  3731.          FGrid := nil;
  3732.          ShowHint  := FHintShow;
  3733.        end;
  3734.        if FQueryDataSet then
  3735.        begin
  3736.          if FQuery.Active then FQuery.Close
  3737.        end;
  3738.      end;
  3739.     1:
  3740.      begin
  3741.        FHintShow := ShowHint;
  3742.        ShowHint  := False;
  3743.        if not FGridVisible then
  3744.        begin
  3745.          HideInfoHint;
  3746.          FColumnsOrder.Clear;
  3747.          FGrid := TDCPopupDBGrid.Create(Self);
  3748.          with FGrid do
  3749.          begin
  3750.            Font  := Self.Font;
  3751.            Color := Self.Color;
  3752.            OptionsEx := OptionsEx - [dgeShadowSelection];
  3753.            CanAppend  := FCanAppend;
  3754.            Parent:= Self;
  3755.            PopupAlignment := wpBottomLeft;
  3756.            case DrawStyle of
  3757.              fcsNormal,
  3758.              fsNone   : FGrid.PopupBorderStyle := brRaised;
  3759.              fsSingle : FGrid.PopupBorderStyle := brRaised;
  3760.              fsFlat   : FGrid.PopupBorderStyle := brRaised;
  3761.            end;
  3762.            if FDropDownWidth = 0 then Width := Self.Width
  3763.              else Width :=FDropDownWidth;
  3764.            DropDownRows := 6;
  3765.            Images  := FImages;
  3766.            Columns := FColumns;
  3767.            for i := 0 to FColumns.Count-1 do
  3768.              Columns[i].ItemIndex := FColumns[i].ItemIndex;
  3769.            InitColumnsOrder;
  3770.         end;
  3771.        end;
  3772.  
  3773.        ACursor := Screen.Cursor;
  3774.        try
  3775.          with FGrid do
  3776.          begin
  3777.            if FQueryDataSet then
  3778.            begin
  3779.              Screen.Cursor := crHourGlass;
  3780.              OpenQuery(1);
  3781.              DataSet := FQuery;
  3782.            end
  3783.            else begin
  3784.              DataSet := FDataSet;
  3785.              ActivateDataSet;
  3786.            end;
  3787.            AdjustNewHeight;
  3788.            if SingleClickToSelect then
  3789.              OnCellClick  := GridCellClick
  3790.            else
  3791.              OnDblClick   := GridDblClick;
  3792.            OnTitleClick := GridTitleClick;
  3793.            Screen.Cursor := ACursor;
  3794.            if not FGridVisible then ShowDropDown;
  3795.          end;
  3796.        except
  3797.          on E: Exception do
  3798.          begin
  3799.            Screen.Cursor := ACursor;
  3800.            FErrorCode := ERR_GRID_EXCEPTONOPEN;
  3801.            FErrorHint := E.Message;
  3802.            CloseUp(0, True);
  3803.            ShowErrorMessage;
  3804.            Exit;
  3805.          end;
  3806.        end;
  3807.        FGridVisible := True;
  3808.      end;
  3809.   end;
  3810. end;
  3811.  
  3812. procedure TDCCustomGridEdit.CMThreadError(var Message: TMessage);
  3813. begin
  3814.   ShowErrorMessage;
  3815. end;
  3816.  
  3817. procedure TDCCustomGridEdit.CMThreadFindCmplt(var Message: TMessage);
  3818. begin
  3819.   {}
  3820. end;
  3821.  
  3822. procedure TDCCustomGridEdit.CMThreadFreeBox(var Message: TMessage);
  3823.  var
  3824.   i: Integer;
  3825. begin
  3826.   while FPaintBox > 0 do Sleep(10);
  3827.   FListBoxVisible := False;
  3828.   if FListBox <> nil then
  3829.   begin
  3830.     for i:= 0 to FListBox.Items.Count-1 do
  3831.        FListBox.Items.Objects[i].Free;
  3832.     FListBox.Free;
  3833.     FListBox := nil;
  3834.   end;
  3835. end;
  3836.  
  3837. procedure TDCCustomGridEdit.CMThreadHideBox(var Message: TMessage);
  3838. begin
  3839.   if FListBoxVisible and (FListBox <> nil) then FListBox.Hide;
  3840. end;
  3841.  
  3842. procedure TDCCustomGridEdit.CMThreadItemAdd(var Message: TMessage);
  3843.  var
  3844.   GridValues: TGridValues;
  3845. begin
  3846.   GridValues := TGridValues(Message.LParam);
  3847.   if (FListBox <> nil) and (GridValues.Count>0) then
  3848.   begin
  3849.     FListBox.SetListHeight(1);
  3850.     FListBox.Items.AddObject(GridValues.Fields[FDataField].AsString, GridValues);
  3851.   end;
  3852. end;
  3853.  
  3854. procedure TDCCustomGridEdit.CMThreadItemClr(var Message: TMessage);
  3855.  var
  3856.   i: integer;
  3857. begin
  3858.   if FListBoxVisible and (FListBox <> nil) then
  3859.   begin
  3860.     for i:= 0 to FListBox.Items.Count-1 do
  3861.        FListBox.Items.Objects[i].Free;
  3862.     FListBox.Items.Clear;
  3863.   end;
  3864. end;
  3865.  
  3866. procedure TDCCustomGridEdit.CMThreadLocated(var Message: TMessage);
  3867. begin
  3868.   if (FUpdateCount = 0) and Assigned(FOnValueChange) then FOnValueChange(Self);
  3869.   FValueChanged := True;
  3870. end;
  3871.  
  3872. procedure TDCCustomGridEdit.CMThreadSetMode(var Message: TMessage);
  3873. begin
  3874.   FThreadMode := TThreadMode(Message.WParam);
  3875.   PostThreadMessage(GridEditThread.ThreadID, Message.Msg, Message.WParam, Message.LParam);
  3876. end;
  3877.  
  3878. procedure TDCCustomGridEdit.CMThreadShowBox(var Message: TMessage);
  3879. begin
  3880.   FListBox.Show;
  3881. end;
  3882.  
  3883. procedure TDCCustomGridEdit.CMThreadStart(var Message: TMessage);
  3884. begin
  3885.   FThreadInUse := True;
  3886.   if Assigned(FOnThreadStart) then FOnThreadStart(Self);
  3887. end;
  3888.  
  3889. procedure TDCCustomGridEdit.CMThreadStop(var Message: TMessage);
  3890. begin
  3891.   FThreadMode := tmStop;
  3892.   PostThreadMessage(GridEditThread.ThreadID, Message.Msg, Message.WParam, Message.LParam)
  3893. end;
  3894.  
  3895. procedure TDCCustomGridEdit.CMThreadTerminate(var Message: TMessage);
  3896. begin
  3897.   try
  3898.     GridEditThread.Free;
  3899.     GridEditThread := nil;
  3900.     FThreadInUse := False;
  3901.   finally
  3902.     if Assigned(FOnThreadStop) then FOnThreadStop(Self);
  3903.   end;
  3904. end;
  3905.  
  3906. constructor TDCCustomGridEdit.Create(AOwner: TComponent);
  3907. begin
  3908.   inherited Create(AOwner);
  3909.   FColumns        := TDBGridColumns.Create(nil, TColumn);
  3910.   FListBoxColumns := TDBGridColumns.Create(nil, TColumn);
  3911.   FValues  := TGridValues.Create(Self);
  3912.   FKeyValue:= null;
  3913.   FCloseDataSet:= False;
  3914.   FThreadInUse := False;
  3915.   FDataValueSelected := False;
  3916.   FPopupFindEnabled  := True;
  3917.   FListBoxVisible    := False;
  3918.   FThreadMode        := tmIdle;
  3919.   FListBoxEnabled    := False;
  3920.   FQueryDataSet      := False;
  3921.   FFullQuery         := True;
  3922.  
  3923.   FPaintBox := 0;
  3924.   FQuery := CreateQuery;
  3925.   FCanAppend := False;
  3926.  
  3927.   FSingleClickToSelect := False;
  3928.   FColumnsOrder := TStringList.Create;
  3929.  
  3930.   FImageChangeLink :=  TChangeLink.Create;
  3931.   FImageChangeLink.OnChange := ImageListChange;
  3932.   FShowInfoHint := False;
  3933. end;
  3934.  
  3935. procedure TDCCustomGridEdit.DefineBtnChoiceStyle;
  3936. begin
  3937.   if BtnChoiceAssigned then
  3938.   begin
  3939.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNGRID');
  3940.     ButtonStyle := esDropDown;
  3941.     ButtonChoiceStyle := btsCustom;
  3942.     ButtonChoice.SimpleStyle := False;
  3943.   end;
  3944. end;
  3945.  
  3946. destructor TDCCustomGridEdit.Destroy;
  3947. begin
  3948.   if FThreadInUse then
  3949.   begin
  3950.     PostMessage(Handle, CM_THREAD_TERMINATE, 0, 0);
  3951.     WaitForThreadTerminate(50);
  3952.   end;
  3953.  
  3954.   FImageChangeLink.Free;
  3955.   FColumnsOrder.Free;
  3956.   FValues.Free;
  3957.   FColumns.Free;
  3958.   FListBoxColumns.Free;
  3959.   FQuery.Free;
  3960.  
  3961.   CloseDataSet;
  3962.   inherited;
  3963. end;
  3964.  
  3965. procedure TDCCustomGridEdit.GridTitleClick(Column: TColumn);
  3966.  var
  3967.   i, AIndex: integer;
  3968.   IndexChanged: boolean;
  3969. begin
  3970.   IndexChanged := False;
  3971.   if FGridVisible then with FGrid.Columns do
  3972.   begin
  3973.     for i := 0 to Count - 1 do
  3974.     begin
  3975.       AIndex := FColumnsOrder.IndexOf(Items[i].FieldName);
  3976.       if (Column.FieldName <> Items[i].FieldName) and (AIndex > -1) and
  3977.          (Items[i].IndexStyle = idxNone) then
  3978.         FColumnsOrder.Delete(AIndex)
  3979.     end;
  3980.   end;
  3981.   AIndex := FColumnsOrder.IndexOf(Column.FieldName);
  3982.   if (AIndex >=0) then
  3983.   begin
  3984.     if Column.IndexStyle = idxNone then
  3985.       FColumnsOrder.Delete(AIndex)
  3986.     else
  3987.       FColumnsOrder.Objects[AIndex] := TObject(Column.IndexStyle);
  3988.     IndexChanged := True;
  3989.   end
  3990.   else if Column.IndexStyle <> idxNone then
  3991.   begin
  3992.     AIndex := FColumnsOrder.Add(Column.FieldName);
  3993.     FColumnsOrder.Objects[AIndex] := TObject(Column.IndexStyle);
  3994.     IndexChanged := True;
  3995.   end;
  3996.   DoGridTitleClick(IndexChanged, Column);
  3997. end;
  3998.  
  3999. procedure TDCCustomGridEdit.EndPaintListBox;
  4000. begin
  4001.   dec(FPaintBox);
  4002. end;
  4003.  
  4004. function TDCCustomGridEdit.FieldExists(Value: string): boolean;
  4005. begin
  4006.   if FQueryDataSet then
  4007.     Result := (FQuery.FindField(Value) <> nil)
  4008.   else
  4009.     Result := (FDataSet <> nil) and (FDataSet.FindField(Value) <> nil);
  4010. end;
  4011.  
  4012. function TDCCustomGridEdit.GetDropDownVisible: boolean;
  4013. begin
  4014.   Result := FGridVisible or FListBoxVisible;
  4015. end;
  4016.  
  4017. procedure TDCCustomGridEdit.GetEntryText;
  4018. begin
  4019.   {╧εΦ±Ω ∩ε Ωδ■≈σΓε∞≤ ±δεΓ≤}
  4020.   FDataValueSelected := False;
  4021.   if (FPopupFindEnabled) and not FGridVisible and FListBoxEnabled and
  4022.      Assigned(FDataSet) and not ReadOnly and not FQueryDataSet
  4023.   then begin
  4024.     if (Length(Text) >= MIN_CMPSTR_LENGTH) then
  4025.     begin
  4026.       if not FListBoxVisible then
  4027.       begin
  4028.         FHintShow := ShowHint;
  4029.         ShowHint  := False;
  4030.         FListBox := TDCPopupListBox.Create(Self);
  4031.         with FListBox do
  4032.         begin
  4033.           Font  := Self.Font;
  4034.           Color := Self.Color;
  4035.           Parent := Self;
  4036.           Top  := Self.Height-2;
  4037.           if FListBoxWidth = 0 then
  4038.             Width := Self.Width
  4039.           else
  4040.             Width := FListBoxWidth;
  4041.  
  4042.           PopupAlignment := wpOffset;
  4043.           if PaintCheckGlyph then
  4044.           begin
  4045.             Left := FCheckGlyph.Width;
  4046.             Width := Width - FCheckWidth;
  4047.           end
  4048.           else Left := -2;
  4049.  
  4050.           PopupBorderStyle := brSingle;
  4051.           DropDownRows := 5;
  4052.           OnDrawItem := ListBoxDrawItem;
  4053.           OnMouseUp  := ListBoxMouseUp;
  4054.           FListBoxVisible := True;
  4055.         end
  4056.       end;
  4057.       if not FValues.FLoaded then SetGridValues;
  4058.       if FThreadInUse then
  4059.       begin
  4060.         SendMessage(Handle, CM_THREAD_SETMODE, Integer(tmFind), 0)
  4061.       end
  4062.       else
  4063.         GridEditThread := TGridEditThread.Create(Self, tmFind);
  4064.     end
  4065.     else begin
  4066.       if FThreadInUse then
  4067.          PostMessage(Handle, CM_THREAD_STOP, 0, 0);
  4068.       PostMessage(Handle, CM_THREAD_FREEBOX, 0, 0);
  4069.     end;
  4070.   end;
  4071. end;
  4072.  
  4073. procedure TDCCustomGridEdit.GetHintOnError;
  4074. begin
  4075.   case FErrorCode of
  4076.     ERR_GRID_ILLIGALVALUE   : FErrorHint := LoadStr(RES_GRID_ERR_WRONG);
  4077.     ERR_GRID_EXCEPTONLOCATE :
  4078.       if FErrorHint <> '' then
  4079.         FErrorHint := Format('/b%s/b0'#10#13'/oh{3}/{%s/}',[LoadStr(RES_GRID_ERR_OPEN), FErrorHint])
  4080.       else
  4081.         FErrorHint := LoadStr(RES_GRID_ERR_LOCATE);
  4082.     ERR_GRID_EXCEPTONFIND   : FErrorHint := LoadStr(RES_GRID_ERR_FIND);
  4083.     ERR_GRID_EXCEPTONOPEN   :
  4084.       if FErrorHint <> '' then
  4085.         FErrorHint := Format('/b%s/b0'#10#13'/oh{3}/{%s/}',[LoadStr(RES_GRID_ERR_OPEN), FErrorHint])
  4086.       else
  4087.         FErrorHint := LoadStr(RES_GRID_ERR_OPEN);
  4088.    else
  4089.     FErrorHint := '';
  4090.   end;
  4091.   inherited;
  4092. end;
  4093.  
  4094. procedure TDCCustomGridEdit.GridDblClick(Sender: TObject);
  4095. begin
  4096.   CloseUp(1);
  4097. end;
  4098.  
  4099. procedure TDCCustomGridEdit.KeyDown(var Key: Word; Shift: TShiftState);
  4100.  var
  4101.   KeyDownEvent: TKeyEvent;
  4102. begin
  4103.   KeyDownEvent := OnKeyDown;
  4104.   if FGridVisible and (FGrid<>nil) then
  4105.     case Key of
  4106.       VK_PRIOR,
  4107.       VK_NEXT ,
  4108.       VK_UP   ,
  4109.       VK_DOWN ,
  4110.       VK_LEFT ,
  4111.       VK_RIGHT,
  4112.       VK_HOME ,
  4113.       VK_END  :
  4114.         begin
  4115.           if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  4116.           SendMessage(FGrid.Handle, WM_KEYDOWN, Key, 0);
  4117.           Key := 0;
  4118.         end;
  4119.       VK_DELETE  : FDataValueSelected := False;
  4120.       VK_F2:
  4121.         if (Shift=[]) and FQueryDataSet then
  4122.         begin
  4123.           if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  4124.           if Key <> 0 then
  4125.           begin
  4126.             FFullQuery := False;
  4127.             Perform(CM_POPUPWINDOW, 1, 0);
  4128.             Key := 0;
  4129.           end;
  4130.         end;
  4131.     end
  4132.   else begin
  4133.     if [ssAlt]*Shift = [ssAlt] then
  4134.     begin
  4135.       case Key of
  4136.         VK_DOWN:
  4137.           begin
  4138.             if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  4139.             if Key <> 0 then
  4140.             begin
  4141.               ChoiceButtonDown;
  4142.               Key := 0;
  4143.             end;
  4144.           end;
  4145.       end;
  4146.       Exit;
  4147.     end;
  4148.     if FListBoxVisible and (FListBox<>nil) then
  4149.       case Key of
  4150.         VK_PRIOR,
  4151.         VK_NEXT ,
  4152.         VK_UP   ,
  4153.         VK_DOWN   :
  4154.           begin
  4155.             if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  4156.             SendMessage(FListBox.Handle, WM_KEYDOWN, Key, 0);
  4157.             Key := 0;
  4158.           end;
  4159.         VK_DELETE  : GetEntryText;
  4160.       end
  4161.     else
  4162.       case Key of
  4163.         VK_UP, VK_DOWN:
  4164.           begin
  4165.             if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  4166.             if (Key <> 0) and not ReadOnly then
  4167.             begin
  4168.               if not FQueryDataSet then
  4169.               begin
  4170.                 if FDataSet <> nil then
  4171.                 begin
  4172.                   if ActivateDataSet then
  4173.                   begin
  4174.                     if VarType(KeyValue) <> varNull then
  4175.                     begin
  4176.                       if Key = VK_UP then FDataSet.Prior else FDataSet.Next;
  4177.                     end
  4178.                     else
  4179.                       FDataSet.First;
  4180.                     if FieldExists(KeyField) then
  4181.                        SetKeyValue(FDataSet.FieldByName(KeyField).AsVariant);
  4182.                   end;
  4183.                 end;
  4184.               end
  4185.               else begin
  4186.                 FFullQuery := False;
  4187.                 ChoiceButtonDown;
  4188.               end;
  4189.             end;
  4190.             Key := 0;
  4191.           end;
  4192.         VK_DELETE  : if not ReadOnly then FDataValueSelected := False;
  4193.       end;
  4194.   end;
  4195.   if Key <> 0 then inherited;
  4196. end;
  4197.  
  4198. procedure TDCCustomGridEdit.KeyPress(var Key: Char);
  4199. begin
  4200.   if (FGridVisible and (FGrid<>nil)) or
  4201.      (FListBoxVisible and (FListBox<>nil) and (FListBox.ListVisible))then
  4202.   begin
  4203.     case Key of
  4204.       Char(VK_RETURN):
  4205.         begin
  4206.           CloseUp(1, True);
  4207.           if not PerformCloseUp then Key := #0;
  4208.         end;
  4209.       Char(VK_ESCAPE): begin CloseUp(0, True); Key := #0; end;
  4210.       else begin
  4211.         if FGridVisible and (FGrid<>nil) then
  4212.         begin
  4213.           FGrid.KeyPress(Key);
  4214.           Key := #0;
  4215.         end
  4216.         else
  4217.           inherited KeyPress(Key);
  4218.       end;
  4219.     end;
  4220.   end
  4221.   else begin
  4222.     case Key of
  4223.       Char(VK_ESCAPE):;
  4224.     end;
  4225.   end;
  4226.   inherited KeyPress(Key);
  4227. end;
  4228.  
  4229. procedure TDCCustomGridEdit.KeyValueChanged;
  4230.  var
  4231.   i: integer;
  4232. begin
  4233.   if FKeyValue <> null then
  4234.     LocateDataSet
  4235.   else begin
  4236.     if not FValues.FLoaded then SetGridValues;
  4237.     Text := '';
  4238.     for i := 0 to Values.Count-1 do TGridValue(Values.Items[i]).AsString := '';
  4239.     SendControlMessage(CM_THREAD_LOCATED, 0, 0);
  4240.   end;
  4241. end;
  4242.  
  4243. procedure TDCCustomGridEdit.KillFocus(var Value: boolean);
  4244. begin
  4245.   if CanModified and not Value and not((Text='') and CanEmpty) and
  4246.      not CheckDataValue then
  4247.   begin
  4248.     Value := True;
  4249.     if FErrorCode = ERR_EDIT_NONE then FErrorCode := ERR_GRID_ILLIGALVALUE;
  4250.   end;
  4251.   if (FErrorCode = ERR_EDIT_NONE) and (Text = '') and not FDataValueSelected then
  4252.     KeyValue := null;
  4253.   inherited KillFocus(Value);
  4254.   if not Value and not FQueryDataSet then CloseDataSet;
  4255. end;
  4256.  
  4257. procedure TDCCustomGridEdit.ListBoxDrawItem(Control: TWinControl;
  4258.   Index: Integer; Rect: TRect; State: TOwnerDrawState);
  4259.  const
  4260.   Alignments: array[Boolean, TAlignment] of DWORD =
  4261.     ((ES_LEFT, ES_RIGHT, ES_CENTER),(ES_RIGHT, ES_LEFT, ES_CENTER));
  4262.  var
  4263.   i: integer;
  4264.   sFieldValue: string;
  4265.   CurrRect: TRect;
  4266.   Column: TColumn;
  4267.   GridValue: TGridValue;
  4268. begin
  4269.   try
  4270.     BeginPaintListBox;
  4271.     if FListBoxColumns.Count > 0 then
  4272.     begin
  4273.       if FListBox <> nil then
  4274.         with FListBox do
  4275.         begin
  4276.           Canvas.FillRect(Rect);
  4277.           CurrRect := Rect;
  4278.           CurrRect.Right := CurrRect.Left;
  4279.           {Draw Info line}
  4280.           for i := 0 to FListBoxColumns.Count-1 do
  4281.           begin
  4282.             Column := FListBoxColumns.Items[i];
  4283.             if i = FListBoxColumns.Count-1 then
  4284.               CurrRect.Right := Rect.Right
  4285.             else
  4286.               CurrRect.Right := CurrRect.Right + Column.Width;
  4287.             Canvas.Font := Column.Font;
  4288.             if odSelected in State then
  4289.             begin
  4290.               Canvas.Brush.Color := clHighLight;
  4291.               Canvas.Font.Color := clHighLightText;
  4292.             end
  4293.             else begin
  4294.               Canvas.Brush.Color := Column.Color;
  4295.               Canvas.FillRect(CurrRect);
  4296.             end;
  4297.             CurrRect.Left := CurrRect.Left + 2;
  4298.             GridValue := TGridValues(Items.Objects[Index]).Fields[Column.FieldName];
  4299.             if GridValue <> nil then
  4300.             begin
  4301.               sFieldValue := GridValue.AsString;
  4302.               DrawText(Canvas.Handle, PChar(sFieldValue), -1,
  4303.                   CurrRect, Alignments[UseRightToLeftAlignment, Column.Alignment]);
  4304.               CurrRect.Left := CurrRect.Right;
  4305.               Canvas.Pen.Color := clBtnShadow;
  4306.               if i < FListBoxColumns.Count-1 then begin
  4307.                 Canvas.MoveTo(CurrRect.Left, CurrRect.Top-1);
  4308.                 Canvas.LineTo(CurrRect.Left, CurrRect.Bottom);
  4309.               end;
  4310.               CurrRect.Left := CurrRect.Left + 2;
  4311.               if Rect.Left > Width then break;
  4312.             end
  4313.             else break;
  4314.           end;
  4315.         end;
  4316.     end
  4317.     else
  4318.       if (FListBox <> nil) and (FListBox.Items.Count>Index)then
  4319.         with FListBox do
  4320.         begin
  4321.           Canvas.FillRect(Rect);
  4322.           Rect.Left := Rect.Left + 2;
  4323.           DrawText(Canvas.Handle, PChar(Items[Index]), Length(Items[Index]), Rect, 0);
  4324.         end;
  4325.   finally
  4326.     EndPaintListBox;  
  4327.   end;
  4328. end;
  4329.  
  4330. procedure TDCCustomGridEdit.ListBoxMouseUp(Sender: TObject;
  4331.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  4332. begin
  4333.   CloseUp(1);
  4334. end;
  4335.  
  4336. procedure TDCCustomGridEdit.Loaded;
  4337. begin
  4338.   inherited;
  4339. end;
  4340.  
  4341. procedure TDCCustomGridEdit.LocateDataSet;
  4342.  var
  4343.   Found: boolean;
  4344. begin
  4345.   if Assigned(FOnGetDataValue) then
  4346.   begin
  4347.      FOnGetDataValue(Self, FKeyValue, FValues.Fields[FKeyField].FieldType, Found, FValues);
  4348.      if FErrorCode <> ERR_EDIT_NONE then SendMessage(Handle, CM_THREAD_ERROR, 0, 0);
  4349.   end
  4350.   else begin
  4351.     if FQueryDataSet then
  4352.     begin
  4353.       try
  4354.         OpenQuery(2);
  4355.         if FQuery.RecordCount > 0 then
  4356.         begin
  4357.           Found := True;
  4358.           SetDataValues(FQuery);
  4359.         end
  4360.         else
  4361.           Found := False;
  4362.         FQuery.Close;
  4363.       except
  4364.         FErrorCode := ERR_GRID_EXCEPTONLOCATE;
  4365.         FErrorHint := GetQueryText;
  4366.         SendMessage(Handle, CM_THREAD_ERROR, 0, 0);
  4367.       end;
  4368.     end
  4369.     else if FDataSet <> nil then
  4370.     begin
  4371.       try
  4372.         if ActivateDataSet then
  4373.         begin
  4374.           DataSet.DisableControls;
  4375.  
  4376.           if not FValues.FLoaded then SetGridValues;
  4377.  
  4378.           if FieldExists(FDataField) and
  4379.              (DataSet.FieldByName(FKeyField).AsString = VarToStr(FKeyValue)) or
  4380.              (DataSet.Locate(FKeyField,FKeyValue,[])) then
  4381.           begin
  4382.             Found := True;
  4383.             SetDataValues(FDataSet);
  4384.           end
  4385.           else
  4386.             Found := False;
  4387.           while DataSet.ControlsDisabled do DataSet.EnableControls;
  4388.         end;
  4389.       except
  4390.         FErrorCode := ERR_GRID_EXCEPTONLOCATE;
  4391.         SendMessage(Handle, CM_THREAD_ERROR, 0, 0);
  4392.       end;
  4393.     end;
  4394.   end;
  4395.   if not Found then ClearValue(True);
  4396.   SendControlMessage(CM_THREAD_LOCATED, 0, 0);
  4397. end;
  4398.  
  4399. procedure TDCCustomGridEdit.SetDataSet(const Value: TDataSet);
  4400. begin
  4401.   SetInternalDataSet(Value, FDataSet);
  4402. end;
  4403.  
  4404. procedure TDCCustomGridEdit.SetKeyValue(const Value: variant);
  4405. begin
  4406.   try
  4407.     FKeyValue := Value;
  4408.     FDataValueSelected := True;
  4409.     KeyValueChanged;
  4410.   except
  4411.     FErrorCode := ERR_GRID_ILLIGALVALUE;
  4412.     ShowErrorMessage;
  4413.   end;
  4414. end;
  4415.  
  4416. procedure TDCCustomGridEdit.SetKeyValueEx(Value: variant; NeedLocate: boolean);
  4417. begin
  4418.   try
  4419.     FKeyValue := Value;
  4420.     FDataValueSelected := True;
  4421.     if NeedLocate or (FQueryDataSet and not FQuery.Active) or
  4422.      (not FQueryDataSet and ((FDataSet = nil) or not FDataSet.Active)) then
  4423.       KeyValueChanged
  4424.     else begin
  4425.       if FQueryDataSet then SetDataValues(FQuery) else SetDataValues(FDataSet)
  4426.     end;
  4427.   except
  4428.     FErrorCode := ERR_GRID_ILLIGALVALUE;
  4429.     ShowErrorMessage;
  4430.   end;
  4431. end;
  4432.  
  4433. procedure TDCCustomGridEdit.WaitForThreadTerminate(Count: DWORD);
  4434. begin                                                                                           
  4435.   while FThreadinUse do begin
  4436.     Sleep(Count);
  4437.     Application.ProcessMessages;
  4438.   end;
  4439. end;
  4440.  
  4441. procedure TDCCustomGridEdit.WMChar(var Message: TWMChar);
  4442. begin
  4443.   inherited;
  4444.   if not (Message.CharCode in [0, 13, 27]) and not ReadOnly then GetEntryText;
  4445. end;
  4446.  
  4447. procedure TDCCustomGridEdit.WMPaste(var Message: TWMPaste);
  4448. begin
  4449.   inherited;
  4450.   FDataValueSelected := False;
  4451. end;
  4452.  
  4453. function TDCCustomGridEdit.GetSQLText: string;
  4454. begin
  4455.   Result := FSQLText;
  4456. end;
  4457.  
  4458. procedure TDCCustomGridEdit.SetSQLText(const Value: string);
  4459.  var
  4460.   i: integer;
  4461.   SOrderBy: string;
  4462. begin
  4463.   SOrderBy := 'ORDER BY ';
  4464.   i := Pos(SOrderBy, AnsiUpperCase(Value));
  4465.   if i = 0 then
  4466.     FSQLText := Value
  4467.   else begin
  4468.     FSQLText    := Copy(Value, 1, i-1);
  4469.     FSQLOrderBy := Copy(Value, i + Length(SOrderBy), Length(Value));
  4470.   end;
  4471.   FValues.Clear;
  4472.   FValues.FLoaded := False;
  4473.   SetInternalSQLText(Value, FSQLTExt);
  4474. end;
  4475.  
  4476. procedure TDCCustomGridEdit.SetListBoxEnabled(const Value: boolean);
  4477. begin
  4478.   FListBoxEnabled := Value
  4479. end;
  4480.  
  4481. function TDCCustomGridEdit.SetGridValues: boolean;
  4482.  var
  4483.   i: integer;
  4484.   GridValue: TGridValue;
  4485. begin
  4486.   Result := True;
  4487.   FValues.Clear;
  4488.   if FQueryDataSet then
  4489.     for i := 0 to FQuery.FieldCount-1 do
  4490.     begin
  4491.       GridValue := TGridValue.Create(nil);
  4492.       try
  4493.         with GridValue do
  4494.         begin
  4495.           FieldName := FQuery.Fields[i].FieldName;
  4496.           FieldType := FQuery.Fields[i].DataType;
  4497.         end;
  4498.         FValues.Fields[GridValue.FieldName] := GridValue;
  4499.       finally
  4500.         GridValue.Free;
  4501.       end;
  4502.       FValues.FLoaded := True;
  4503.     end
  4504.   else begin
  4505.     if ActivateDataSet then
  4506.     begin
  4507.       for i := 0 to DataSet.FieldCount-1 do
  4508.       begin
  4509.         GridValue := TGridValue.Create(nil);
  4510.         try
  4511.           with GridValue do
  4512.           begin
  4513.             FieldName := DataSet.Fields[i].FieldName;
  4514.             FieldType := DataSet.Fields[i].DataType;
  4515.           end;
  4516.           FValues.Fields[GridValue.FieldName] := GridValue;
  4517.         finally
  4518.           GridValue.Free;
  4519.         end;
  4520.       end;
  4521.       FValues.FLoaded := True;
  4522.     end
  4523.     else Result := False;
  4524.   end;
  4525. end;
  4526.  
  4527. procedure TDCCustomGridEdit.SetDataField(const Value: string);
  4528. begin
  4529.   FDataField := Value;
  4530.   if FSQLDataField = '' then FSQLDataField := FDataField;
  4531. end;
  4532.  
  4533. procedure TDCCustomGridEdit.SetKeyField(const Value: string);
  4534. begin
  4535.   FKeyField := Value;
  4536.   if FSQLKeyField = '' then FSQLKeyField := FKeyField;
  4537. end;
  4538.  
  4539. procedure TDCCustomGridEdit.SetSQLDataField(const Value: string);
  4540. begin
  4541.   FSQLDataField := Value;
  4542. end;
  4543.  
  4544. procedure TDCCustomGridEdit.SetSQLKeyField(const Value: string);
  4545. begin
  4546.   FSQLKeyField := Value;
  4547. end;
  4548.  
  4549. procedure TDCCustomGridEdit.SetDataValues(ADataSet: TDataSet);
  4550.  var
  4551.   i: integer;
  4552. begin
  4553.   if not FValues.FLoaded then SetGridValues;
  4554.  
  4555.   Text := ADataSet.FieldByName(FDataField).AsString;
  4556.  
  4557.   for i := 0 to Values.Count-1 do
  4558.     TGridValue(Values.Items[i]).AsString :=
  4559.       ADataSet.FieldByName(TGridValue(Values.Items[i]).FieldName).AsString;
  4560.  
  4561.   if ExistInfo and HandleAllocated then
  4562.   begin
  4563.     Invalidate;
  4564.     HideInfoHint;
  4565.   end;
  4566.   
  4567. end;
  4568.  
  4569. procedure TDCCustomGridEdit.SetMargins(var LeftMargin, RightMargin: integer);
  4570.  var
  4571.   CharWidth: integer;
  4572. begin
  4573.   inherited;
  4574.   if ExistInfo and (RightMargin > 0) then
  4575.   begin
  4576.     RightMargin := RightMargin + FInfoFieldWidth;
  4577.     CharWidth := GetCharWidth(Handle, Font);
  4578.     if (ClientWidth - RightMargin - LeftMargin - CharWidth) < 0 then
  4579.       RightMargin := ClientWidth - LeftMargin - CharWidth;
  4580.   end;
  4581. end;
  4582.  
  4583. procedure TDCCustomGridEdit.SetInfoField(const Value: string);
  4584. begin
  4585.   if AnsiCompareText(FInfoField, Value) <> 0 then
  4586.   begin
  4587.     FInfoField := Value;
  4588.     SetEditRect;
  4589.   end;
  4590. end;
  4591.  
  4592. procedure TDCCustomGridEdit.SetInfoFieldWidth(const Value: integer);
  4593. begin
  4594.   if (Value >= 0) and (FInfoFieldWidth <> Value) then
  4595.   begin
  4596.     FInfoFieldWidth := Value;
  4597.     SetEditRect;
  4598.   end;
  4599. end;
  4600.  
  4601. function TDCCustomGridEdit.ExistInfo: boolean;
  4602. begin
  4603.   Result := (FInfoField <> '') and (FInfoFieldWidth > 0)
  4604. end;
  4605.  
  4606. procedure TDCCustomGridEdit.DoDrawMargins(DC: HDC);
  4607.  var
  4608.   RightMargin: integer;
  4609.   R, CalcRect: TRect;
  4610.   OldPos: TPoint;
  4611.   Value: string;
  4612.   GridValue: TGridValue;
  4613.   Pen: HPEN;
  4614.   Brush: HBRUSH;
  4615.   ADefault: boolean;
  4616. begin
  4617.   inherited;
  4618.   RightMargin := Width - FMargins.Right;
  4619.   if ExistInfo and (RightMargin > 0) then
  4620.   begin
  4621.     GridValue := FValues.Fields[FInfoField];
  4622.     if GridValue <> nil then
  4623.       Value := FValues.Fields[FInfoField].AsString
  4624.     else
  4625.       Value := '';
  4626.  
  4627.     SelectObject(DC, Font.Handle);
  4628.     if not Enabled and not(csDesigning in ComponentState) then
  4629.       SetTextColor(DC, ColorToRGB(clInactiveCaption))
  4630.     else
  4631.       SetTextColor(DC, ColorToRGB(Font.Color));
  4632.     SetBkColor(DC, ColorToRGB(Color));
  4633.  
  4634.     R := GetInfoRect;
  4635.  
  4636.     ADefault := True;
  4637.     if Assigned(FOnDrawInfoText) then FOnDrawInfoText(Self, DC, R, Value, ADefault);
  4638.  
  4639.     if ADefault then
  4640.     begin
  4641.       if ColorToRGB(Color) = ColorToRGB(clBtnFace) then
  4642.         Pen := CreatePen(PS_SOLID, 1, ColorToRGB(clBtnShadow))
  4643.       else
  4644.         Pen := CreatePen(PS_SOLID, 1, ColorToRGB(clBtnFace));
  4645.       Brush := CreateSolidBrush(ColorToRGB(Color));
  4646.      try
  4647.         SelectObject(DC, Pen);
  4648.         MoveToEx(DC, R.Left, R.Top, @OldPos);
  4649.         LineTo(DC, R.Left, R.Bottom);
  4650.         R.Left  := R.Left + 4;
  4651.         R.Right := R.Right + 1;
  4652.         FillRect(DC, R, Brush);
  4653.         R.Right := R.Right - 1;
  4654.         CalcRect := R;
  4655.         DrawText(DC, PChar(Value), Length(Value), CalcRect, DT_LEFT or DT_CALCRECT);
  4656.         if CalcRect.Right > R.Right then
  4657.         begin
  4658.           CalcRect := R;
  4659.           DrawText(DC, PChar(Value), Length(Value), CalcRect, DT_LEFT);
  4660.           FShowInfoHint := True;
  4661.         end
  4662.         else begin
  4663.           DrawText(DC, PChar(Value), Length(Value), R, DT_LEFT);
  4664.           FShowInfoHint := False;
  4665.         end;
  4666.       finally
  4667.         DeleteObject(Pen);
  4668.         DeleteObject(Brush);
  4669.       end
  4670.     end;
  4671.   end;
  4672. end;
  4673.  
  4674. procedure TDCCustomGridEdit.SetCanAppend(const Value: boolean);
  4675. begin
  4676.   if FCanAppend <> Value then
  4677.   begin
  4678.     FCanAppend := Value;
  4679.     if FGridVisible then CloseUp(0, True);
  4680.   end;
  4681. end;
  4682.  
  4683. procedure TDCCustomGridEdit.AppendRecord;
  4684.  var
  4685.   AKeyValue: variant;
  4686.   AApply: boolean;
  4687. begin
  4688.   {Append New Record}
  4689.   CloseUp(0, True);
  4690.   if Assigned(FOnAppendRecord) then
  4691.   begin
  4692.     AKeyValue := KeyValue;
  4693.     AApply    := True;
  4694.     FOnAppendRecord(Self, AKeyValue, AApply);
  4695.     if AApply and (AKeyValue <> KeyValue) then KeyValue := AKeyValue;
  4696.   end;
  4697. end;
  4698.  
  4699. procedure TDCCustomGridEdit.BeginUpdate(HookChanges: boolean = True);
  4700. begin
  4701.   if FUpdateCount = 0 then FValueChanged := False;
  4702.   inherited;
  4703. end;
  4704.  
  4705. procedure TDCCustomGridEdit.EndUpdate;
  4706.  var
  4707.   ValueChangeEvent: TNotifyEvent;
  4708. begin
  4709.   if FUpdateCount > 0 then
  4710.   begin
  4711.     Dec(FUpdateCount);
  4712.     ValueChangeEvent := OnValueChange;
  4713.     if (FUpdateCount = 0) and FChanged then
  4714.     begin
  4715.       if FHookChanges then Change;
  4716.       FChanged := False;
  4717.     end;
  4718.     if (FUpdateCount = 0) and FValueChanged then
  4719.     begin
  4720.       if Assigned(ValueChangeEvent) and FHookChanges then ValueChangeEvent(Self);
  4721.       FChanged := False;
  4722.     end;
  4723.   end;
  4724. end;
  4725.  
  4726. procedure TDCCustomGridEdit.WndProc(var Message: TMessage);
  4727. begin
  4728.   inherited;
  4729. end;
  4730.  
  4731. function TDCCustomGridEdit.FullQuery: boolean;
  4732. begin
  4733.   Result := FFullQuery;
  4734. end;
  4735.  
  4736. procedure TDCCustomGridEdit.SetSQLTextPermanet(const Value: string);
  4737. begin
  4738.   FSQLText := Value;
  4739. end;
  4740.  
  4741. procedure TDCCustomGridEdit.SetQueryDataSet(const Value: boolean);
  4742. begin
  4743.   FQueryDataSet := Value;
  4744. end;
  4745.  
  4746. function TDCCustomGridEdit.ActivateDataSet: boolean;
  4747. begin
  4748.   if (FDataSet <> nil) and (not FDataSet.Active) then
  4749.   begin
  4750.     try
  4751.       FDataSet.Open;
  4752.       SetGridValues;
  4753.       FCloseDataSet:= True;
  4754.     except
  4755.       on E: Exception do
  4756.       begin
  4757.         FErrorCode := ERR_GRID_EXCEPTONOPEN;
  4758.         FErrorHint := E.Message;
  4759.       end;
  4760.     end;
  4761.   end;
  4762.   Result := (FDataSet <> nil) and (FDataSet.Active);
  4763. end;
  4764.  
  4765. function TDCCustomGridEdit.DoMouseWheelDown(Shift: TShiftState;
  4766.   MousePos: TPoint): Boolean;
  4767.  var
  4768.   Key: Word;
  4769. begin
  4770.   Result := inherited DoMouseWheelDown(Shift, MousePos);
  4771.   if not Result then
  4772.   begin
  4773.     Key := VK_DOWN;
  4774.     KeyDown(Key,  Shift);
  4775.     Result := True;
  4776.   end;
  4777. end;
  4778.  
  4779. function TDCCustomGridEdit.DoMouseWheelUp(Shift: TShiftState;
  4780.   MousePos: TPoint): Boolean;
  4781.  var
  4782.   Key: Word;
  4783. begin
  4784.   Result := inherited DoMouseWheelUp(Shift, MousePos);
  4785.   if not Result then
  4786.   begin
  4787.     Key := VK_UP;
  4788.     KeyDown(Key,  Shift);
  4789.     Result := True;
  4790.   end;
  4791. end;
  4792.  
  4793. procedure TDCCustomGridEdit.GridCellClick(Columns: TColumn);
  4794. begin
  4795.   CloseUp(1);
  4796. end;
  4797.  
  4798. procedure TDCCustomGridEdit.ValidateValue;
  4799. begin
  4800.   FDataValueSelected := False;
  4801. end;
  4802.  
  4803. function TDCCustomGridEdit.GetGridOrderBy: string;
  4804.  var
  4805.   i: integer;
  4806. begin
  4807.   if FQueryDataSet then
  4808.   begin
  4809.     Result := FSQLOrderBy;
  4810.     for i := 0 to FColumnsOrder.Count - 1 do begin
  4811.       case TColumnIndexStyle(FColumnsOrder.Objects[i]) of
  4812.         idxNone:
  4813.           ;
  4814.         idxAscending:
  4815.           begin
  4816.             if Result <> '' then
  4817.             begin
  4818.               if Pos(AnsiUpperCase(FColumnsOrder.Strings[i]), AnsiUpperCase(Result)) = 0 then
  4819.                  Result := Format('%s, %s', [Result, FColumnsOrder.Strings[i]])
  4820.             end
  4821.             else
  4822.               Result := Format(' %s', [FColumnsOrder.Strings[i]])
  4823.           end;
  4824.         idxDescending:
  4825.           begin
  4826.             if Result <> '' then
  4827.             begin
  4828.               if Pos(AnsiUpperCase(FColumnsOrder.Strings[i]), AnsiUpperCase(Result)) = 0 then
  4829.                 Result := Format('%s, %s DESC', [Result, FColumnsOrder.Strings[i]])
  4830.             end
  4831.             else
  4832.               Result := Format(' %s DESC', [FColumnsOrder.Strings[i]])
  4833.           end;
  4834.       end;
  4835.     end
  4836.   end;
  4837. end;
  4838.  
  4839. procedure TDCCustomGridEdit.WMNCHitTest(var Message: TWMNCHitTest);
  4840.  var
  4841.   R: TRect;
  4842.   P: TPoint;
  4843. begin
  4844.   inherited;
  4845.   if FShowInfoHint and not DropDownVisible then
  4846.   begin
  4847.     R := GetInfoRect;
  4848.     P := ScreenToClient(Point(Message.XPos, Message.YPos));
  4849.     FInHintInfo := PtInRect(R, P);
  4850.   end
  4851.   else
  4852.     FInHintInfo := False;
  4853.  
  4854.   if FInHintInfo then
  4855.     ShowInfoHint
  4856.   else
  4857.     HideInfoHint
  4858.  
  4859. end;
  4860.  
  4861. procedure TDCCustomGridEdit.CMAppendrecord(var Message: TMessage);
  4862. begin
  4863.   AppendRecord;
  4864. end;
  4865.  
  4866. procedure TDCCustomGridEdit.LocateFirstValue;
  4867.  var
  4868.   ACursor: TCursor;
  4869. begin
  4870.   ACursor := Screen.Cursor;
  4871.   Screen.Cursor := crHourGlass;
  4872.   try
  4873.     try
  4874.       if FQueryDataSet then
  4875.       begin
  4876.         OpenQuery(1);
  4877.         if (FQuery <> nil) and FQuery.Active then
  4878.         begin
  4879.           FQuery.First;
  4880.           FKeyValue := FQuery.FieldByName(FKeyField).AsVariant;
  4881.           SetDataValues(FQuery);
  4882.           FQuery.Close;
  4883.           FDataValueSelected := True;
  4884.         end
  4885.         else
  4886.           KeyValue := null;
  4887.       end
  4888.       else begin
  4889.         if ActivateDataSet then
  4890.         begin
  4891.           DataSet.DisableControls;
  4892.           DataSet.First;
  4893.           FKeyValue := DataSet.FieldByName(FKeyField).AsVariant;
  4894.           SetDataValues(DataSet);
  4895.           while DataSet.ControlsDisabled do DataSet.EnableControls;
  4896.           FDataValueSelected := True;
  4897.         end
  4898.         else
  4899.           KeyValue := null;
  4900.       end;
  4901.     except
  4902.       KeyValue := null;
  4903.     end;
  4904.   finally
  4905.     Screen.Cursor := ACursor;
  4906.   end;
  4907. end;
  4908.  
  4909. procedure TDCCustomGridEdit.InitColumnsOrder;
  4910.  var
  4911.   i, AIndex: integer;
  4912. begin
  4913.   if FGrid = nil then Exit;
  4914.   with FGrid.Columns do
  4915.   begin
  4916.     for i := 0 to Count - 1 do
  4917.     begin
  4918.       AIndex := FColumnsOrder.IndexOf(Items[i].FieldName);
  4919.       if (AIndex > -1) and (Items[i].IndexStyle = idxNone) then
  4920.         FColumnsOrder.Delete(AIndex)
  4921.     end;
  4922.     for i := 0 to Count - 1 do
  4923.     begin
  4924.       if Items[i].Indexed and (Items[i].IndexStyle <> idxNone)then
  4925.       begin
  4926.         AIndex := FColumnsOrder.Add(Items[i].FieldName);
  4927.         FColumnsOrder.Objects[AIndex] := TObject(Items[i].IndexStyle);
  4928.       end;
  4929.     end;
  4930.   end;
  4931. end;
  4932.  
  4933. procedure TDCCustomGridEdit.Notification(AComponent: TComponent;
  4934.   Operation: TOperation);
  4935. begin
  4936.   inherited Notification(AComponent, Operation);
  4937.   if (Operation = opRemove) and (AComponent = FDataSet) then FDataSet := nil;
  4938.   if (Operation = opRemove) and (AComponent = FImages) then FImages := nil;
  4939. end;
  4940.  
  4941. procedure TDCCustomGridEdit.ImageListChange(Sender: TObject);
  4942. begin
  4943.   Invalidate;
  4944. end;
  4945.  
  4946. function TDCCustomGridEdit.GetInfoRect: TRect;
  4947.  var
  4948.   R: TRect;
  4949. begin
  4950.  GetWindowRect(Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  4951.   R.Left  := FMargins.Right + 2;
  4952.   R.Right := R.Right - GetButtonWidth - 2;
  4953.  
  4954.   case FDrawStyle of
  4955.     fsNone  :
  4956.      begin
  4957.        InflateRect(R, -1, -1);
  4958.        R.Left := R.Left -1;
  4959.      end;
  4960.     fsSingle  :
  4961.      InflateRect(R, -3, -3);
  4962.     fcsNormal,
  4963.     fsFlat  :
  4964.      InflateRect(R, -3, -3);
  4965.   end;
  4966.   Result := R;
  4967. end;
  4968.  
  4969. procedure TDCCustomGridEdit.WMSetCursor(var Message: TWMSetCursor);
  4970. begin
  4971.   if FInHintInfo then
  4972.     SetCursor(LoadCursor(0, IDC_ARROW))
  4973.   else
  4974.    inherited;
  4975. end;
  4976.  
  4977. procedure TDCCustomGridEdit.HideInfoHint;
  4978.  var
  4979.   pHintWindow: PHintWindowParam_tag;
  4980. begin
  4981.   if (FInfoHintWindow <> nil) and HandleAllocated then
  4982.   begin
  4983.     GetMem(pHintWindow, SizeOf(THintWindowParam));
  4984.     with pHintWindow^ do
  4985.     begin
  4986.       HMode := 0;
  4987.       PHint := nil;
  4988.     end;
  4989.     SendMessage(Handle, CM_POPUPHINTINFO, Integer(pHintWindow), 0);
  4990.   end;
  4991. end;
  4992.  
  4993. procedure TDCCustomGridEdit.ShowInfoHint;
  4994.  var
  4995.   pHintWindow: PHintWindowParam_tag;
  4996.   R: TRect;
  4997.   Value: string;
  4998.   GridValue: TGridValue;
  4999. begin
  5000.   if (FInfoHintWindow = nil) and HandleAllocated then
  5001.   begin
  5002.     GridValue := FValues.Fields[FInfoField];
  5003.     if GridValue <> nil then
  5004.       Value := FValues.Fields[FInfoField].AsString
  5005.     else
  5006.       Value := '';
  5007.     GetMem(pHintWindow, SizeOf(THintWindowParam));
  5008.     R := GetInfoRect;
  5009.     case FDrawStyle of
  5010.       fsNone: OffsetRect(R, 2, 2);
  5011.       fsSingle: OffsetRect(R, -1, -1);
  5012.     end;
  5013.     with pHintWindow^ do
  5014.     begin
  5015.       HMode := 1;
  5016.       HLeft := R.Left - 5;
  5017.       HTop  := R.Top - 4;
  5018.       HOff  := 3;
  5019.       GetMem(PHint, (Length(Value) + 1) * SizeOf(Char));
  5020.       StrPCopy(PHint, Value);
  5021.     end;
  5022.     SendMessage(Handle, CM_POPUPHINTINFO, Integer(pHintWindow), 1);
  5023.   end;
  5024. end;
  5025.  
  5026. procedure TDCCustomGridEdit.CMPopupHintInfo(var Message: TMessage);
  5027.  var
  5028.   pHintWindow: PHintWindowParam_tag;
  5029. begin
  5030.   pHintWindow := PHintWindowParam_tag(Message.WParam);
  5031.   with pHintWindow^ do
  5032.   begin
  5033.     case HMode of
  5034.       0:
  5035.        begin
  5036.          FInfoHintWindow.Free;
  5037.          FInfoHintWindow := nil;
  5038.        end;
  5039.       1:
  5040.        begin
  5041.          if not Assigned(FInfoHintWindow) then
  5042.          begin
  5043.            FInfoHintWindow := TDCMessageWindow.Create(Self);
  5044.            with FInfoHintWindow do
  5045.            begin
  5046.              Parent := Self;
  5047.              DialogStyle := dsSimple;
  5048.              PopupAlignment := wpOffset;
  5049.            end;
  5050.          end
  5051.          else
  5052.            FInfoHintWindow.Hide;
  5053.  
  5054.          with FInfoHintWindow do
  5055.          begin
  5056.            BeginUpdate;
  5057.            Font := Self.Font;
  5058.            Caption := PHint;
  5059.            Left := HLeft+ HOff;
  5060.            Top := HTop;
  5061.            MaxTextWidth := 400;
  5062.            EndUpdate;
  5063.            Show;
  5064.          end;
  5065.        end;
  5066.     end;
  5067.   end;
  5068.   if Assigned(pHintWindow^.PHint) then FreeMem(pHintWindow^.PHint);
  5069.   FreeMem(pHintWindow);
  5070. end;
  5071.  
  5072. procedure TDCCustomGridEdit.CMMouseLeave(var Message: TMessage);
  5073. begin
  5074.   inherited;
  5075.   HideInfoHint;
  5076. end;
  5077.  
  5078. procedure TDCCustomGridEdit.CloseDataSet;
  5079. begin
  5080.   if FCloseDataSet and (FDataSet <> nil) and (FDataSet.Active) then
  5081.   begin
  5082.     FDataSet.Active := False;
  5083.     FCloseDataSet   := False;
  5084.   end;
  5085. end;
  5086.  
  5087. procedure TDCCustomGridEdit.ShowDropDown;
  5088. begin
  5089.   FGrid.Show;
  5090. end;
  5091.  
  5092. function TDCCustomGridEdit.GetPreparedQueryText(Mode: integer;
  5093.   SQLText: string): string;
  5094.  var
  5095.   AOrderBy: string;
  5096.  
  5097.  function GetLexemPos(ALexem, AText: string): integer;
  5098.   const
  5099.    stDelim: set of char = [' ', #10, #13];
  5100.   var
  5101.    i: integer;
  5102.  begin
  5103.    Result := Pos(AnsiUpperCase(ALexem), AnsiUpperCase(AText));
  5104.    if (Result > 0) and
  5105.      not((AText[Result-1] in stDelim) and (AText[Result+Length(ALexem)] in stDelim)) then
  5106.    begin
  5107.      i := GetLexemPos(ALexem, Copy(AText, Result+Length(ALexem), MaxInt));
  5108.      if i > 0 then
  5109.        Result := Result + i - 1 + Length(ALexem)
  5110.      else
  5111.        Result := 0;
  5112.   end;
  5113.  end;
  5114.  function InsertWhereValue(ASQLText, AText, SQLField: string; Mode: integer; Quota: boolean): string;
  5115.   var
  5116.    i: integer;
  5117.    BSQLText1, BSQLText2: string;
  5118.  begin
  5119.    i := GetLexemPos(EDIT_STR_UNION, ASQLText);
  5120.    if i = 0 then
  5121.    begin
  5122.      case Mode of
  5123.        0:
  5124.          if GetLexemPos(EDIT_STR_WHERE, ASQLText) = 0 then
  5125.          begin
  5126.            if Quota then
  5127.              Result := ASQLText + ' '+ Format(EDIT_FQW_LOCATE, [SQLField, AText])
  5128.            else
  5129.              Result := ASQLText + ' '+ Format(EDIT_FNW_LOCATE, [SQLField, AText])
  5130.          end
  5131.          else begin
  5132.            if Quota then
  5133.              Result := ASQLText + ' '+ Format(EDIT_FQA_LOCATE, [SQLField, AText])
  5134.            else
  5135.              Result := ASQLText + ' '+ Format(EDIT_FNA_LOCATE, [SQLField, AText]);
  5136.          end;
  5137.        1:
  5138.           if GetLexemPos(EDIT_STR_WHERE, ASQLText) = 0 then
  5139.             Result := ASQLText + ' '+  Format(EDIT_FQW_LIKE, [SQLField, AText])
  5140.           else
  5141.             Result := ASQLText + ' '+  Format(EDIT_FQA_LIKE, [SQLField, AText]);
  5142.      end;
  5143.    end
  5144.    else begin
  5145.      BSQLText1 := (Copy(ASQLText, 1, i-1));
  5146.      BSQLText2 := (Copy(ASQLText, i+Length(EDIT_STR_UNION), maxInt));
  5147.      Result := InsertWhereValue(BSQLText1, AText, SQLField, Mode, Quota) + #13#10 + 
  5148.        EDIT_STR_UNION + InsertWhereValue(BSQLText2, AText, SQLField, Mode, Quota);
  5149.    end;
  5150.  end;
  5151.  
  5152. begin
  5153.   case Mode of
  5154.     0: {locate}
  5155.       SQLText := InsertWhereValue(SQLText, Self.Text, FSQLDataField, 0, True);
  5156.     1: {like}
  5157.       begin
  5158.         if (Length(Self.Text) >= 0) and not FFullQuery then
  5159.           SQLText := InsertWhereValue(SQLText, Self.Text, FSQLDataField, 1, True);
  5160.         AOrderBy := GetGridOrderBy;
  5161.         if AOrderBy <> '' then begin
  5162.           if GetLexemPos('ORDER BY', SQLText) = 0 then
  5163.             SQLText := SQLText + ' '+ Format('ORDER BY %s', [AOrderBy])
  5164.           else
  5165.             SQLText := SQLText + ' '+ Format(', %s', [AOrderBy])
  5166.         end;
  5167.       end;
  5168.      2: {set KeyValue}
  5169.        begin
  5170.         SQLText := InsertWhereValue(SQLText, VarToStr(FKeyValue), FSQLKeyField, 0,
  5171.           not(VarType(FKeyValue) in [varSmallint, varInteger, varSingle, varDouble, varCurrency, varByte]));
  5172.        end;
  5173.   end;
  5174.   Result := SQLText;
  5175. end;
  5176.  
  5177. procedure TDCCustomGridEdit.OpenQuery(Mode: integer);
  5178. begin
  5179.   Query.DisableControls;
  5180.   try
  5181.     PrepareDataSet;
  5182.     DoInitQuery(Mode);
  5183.     if not FDataValueSelected then SetGridValues;
  5184.   finally
  5185.     Query.EnableControls;
  5186.   end;
  5187. end;
  5188.  
  5189. procedure TDCCustomGridEdit.SendControlMessage(Message, WParam, LParam: integer);
  5190. begin
  5191.   if (Parent <> nil) and (Handle <> 0) then SendMessage(Handle, Message, WParam, LParam);
  5192. end;
  5193.  
  5194. procedure TDCCustomGridEdit.DoGridTitleClick(IndexChanged: boolean; Column: TColumn);
  5195. begin
  5196.   if Assigned(FOnGridTitleClick) then
  5197.     FOnGridTitleClick(Column)
  5198.   else
  5199.     if FQueryDataSet and IndexChanged then  Perform(CM_POPUPWINDOW, 1, 0)
  5200. end;
  5201.  
  5202. procedure TDCCustomGridEdit.SetImages(const Value: TImageList);
  5203. begin
  5204.   if Images <> nil then
  5205.     Images.UnRegisterChanges(FImageChangeLink);
  5206.   FImages := Value;
  5207.   if Images <> nil then
  5208.   begin
  5209.     Images.RegisterChanges(FImageChangeLink);
  5210.     Images.FreeNotification(Self);
  5211.   end;
  5212.   if DropDownVisible then invalidate;
  5213. end;
  5214.  
  5215. { TGridEditThread }
  5216.  
  5217. procedure TGridEditThread.AddValue;
  5218.  var
  5219.   i: integer;
  5220.   GridValues: TGridValues;
  5221.   GridValue: TGridValue;
  5222. begin
  5223.   with FGridEdit, FGridEdit.DataSet do
  5224.   begin
  5225.     if not Assigned(FListBox) then Exit;
  5226.     if not FListBox.ListVisible then
  5227.         SendMessage(FGridEdit.Handle, CM_THREAD_SHOWBOX, 0, 0);
  5228.     GridValues := TGridValues.Create(nil);
  5229.     for i := 0 to Values.Count-1 do
  5230.     begin
  5231.       GridValue := TGridValue.Create(nil);
  5232.       with GridValue do
  5233.       begin
  5234.         FieldName := TGridValue(Values.Items[i]).FieldName;
  5235.         FieldType := TGridValue(Values.Items[i]).FieldType;
  5236.       end;
  5237.       GridValues.Fields[GridValue.FieldName] := GridValue;
  5238.       GridValue.Free;
  5239.     end;
  5240.     for i := 0 to GridValues.Count-1 do
  5241.       TGridValue(GridValues.Items[i]).AsString :=
  5242.         DataSet.FieldByName(TGridValue(GridValues.Items[i]).FieldName).AsString;
  5243.  
  5244.     SendMessage(FGridEdit.Handle, CM_THREAD_ITEMADD, 0, LongInt(GridValues));
  5245.   end;
  5246. end;
  5247.  
  5248. constructor TGridEditThread.Create(GridEdit: TDCCustomGridEdit; Mode: TTHreadMode);
  5249. begin
  5250.   FGridEdit := GridEdit;
  5251.   Priority := tpHighest    ;
  5252.   FMode := Mode;
  5253.   FGridEdit.FThreadMode  := tmIdle;
  5254.   FGridEdit.FThreadInUse := True;
  5255.   inherited Create(False);
  5256. end;
  5257.  
  5258. procedure TGridEditThread.Execute;
  5259. begin
  5260.   PostMessage(FGridEdit.Handle, CM_THREAD_START, 0, 0);
  5261.   FStoped := False;
  5262.   while not FStoped do
  5263.     case FMode of
  5264.      tmFind   : FindDataSet;
  5265.      tmStop   : FStoped := True;
  5266.     end;
  5267.   PostMessage(FGridEdit.Handle, CM_THREAD_TERMINATE, 0, 0);
  5268. end;
  5269.  
  5270. procedure TGridEditThread.FindDataSet;
  5271.  var
  5272.   Msg: TMsg;
  5273. begin
  5274.   SendMessage(FGridEdit.Handle, CM_THREAD_HIDEBOX, 0, 0);
  5275.   SendMessage(FGridEdit.Handle, CM_THREAD_ITEMCLR, 0, 0);
  5276.   with FGridEdit, FGridEdit.DataSet do
  5277.   begin
  5278.     DataSet.DisableControls;
  5279.     try
  5280.     try
  5281.       First;
  5282.       while not Eof do
  5283.       begin
  5284.         if PeekMessage(Msg, 0, 0, 0, PM_REMOVE)
  5285.         then begin
  5286.           FGridEdit.FThreadMode := tmIdle;
  5287.           case Msg.Message of
  5288.             CM_THREAD_STOP:
  5289.               begin
  5290.                 SendMessage(FGridEdit.Handle, CM_THREAD_FREEBOX, 0, 0);
  5291.                 FMode := tmStop;
  5292.                 while DataSet.ControlsDisabled do DataSet.EnableControls;
  5293.                 Exit;
  5294.               end;
  5295.             CM_THREAD_SETMODE:
  5296.               begin
  5297.                 FMode := TThreadMode(Msg.WParam);
  5298.                 while DataSet.ControlsDisabled do DataSet.EnableControls;
  5299.                 Exit;
  5300.               end;
  5301.           end;
  5302.         end
  5303.         else begin
  5304.           if FGridEdit.FThreadMode <> tmIdle then
  5305.           begin
  5306.             FMode := FGridEdit.FThreadMode;
  5307.             PeekMessage(Msg, 0, 0, 0, PM_REMOVE);
  5308.             FGridEdit.FThreadMode := tmIdle;
  5309.             case FMode of
  5310.               tmStop:
  5311.                 begin
  5312.                   SendMessage(FGridEdit.Handle, CM_THREAD_FREEBOX, 0, 0);
  5313.                   while DataSet.ControlsDisabled do DataSet.EnableControls;
  5314.                   Exit;
  5315.                 end;
  5316.               tmFind:
  5317.                 begin
  5318.                   while DataSet.ControlsDisabled do DataSet.EnableControls;
  5319.                   Exit;
  5320.                 end;
  5321.             end;
  5322.           end;
  5323.         end;
  5324.         if Pos(AnsiUpperCase(Text),
  5325.                AnsiUpperCase(FieldByName(FDataField).AsString)) = 1 then
  5326.         begin
  5327.           AddValue;
  5328.         end;
  5329.         Next;
  5330.         Application.ProcessMessages;
  5331.       end;
  5332.     except
  5333.       FErrorCode := ERR_GRID_EXCEPTONFIND;
  5334.       SendMessage(FGridEdit.Handle, CM_THREAD_ERROR, 0, 0);
  5335.     end;
  5336.     finally
  5337.       while DataSet.ControlsDisabled do DataSet.EnableControls;
  5338.     end;
  5339.   end;
  5340.   FStoped := True;
  5341.   SendMessage(FGridEdit.Handle, CM_THREAD_FINDCMPLT, 0, 0);
  5342. end;
  5343.  
  5344. procedure TGridEditThread.SetFindValue(const Value: string);
  5345. begin
  5346.   FFindValue := Value;
  5347. end;
  5348.  
  5349. { TGridValue }
  5350.  
  5351. constructor TGridValue.Create(AOwner: TCollection);
  5352. begin
  5353.   inherited Create(AOwner);
  5354. end;
  5355.  
  5356. function TGridValue.GetAsString: string;
  5357. begin
  5358.   Result := VarToStr(FValue);
  5359. end;
  5360.  
  5361. procedure TGridValue.SetAsString(Value: string);
  5362. begin
  5363.   FValue := VarAsType(Value, varString);
  5364. end;
  5365.  
  5366. { TGridValues }
  5367.  
  5368. function TGridValues.Add: TGridValue;
  5369. begin
  5370.   Result := TGridValue(inherited Add);
  5371. end;
  5372.  
  5373. constructor TGridValues.Create(AOwner: TComponent);
  5374. begin
  5375.   inherited Create(TGridValue);
  5376.   FIndex  := -1;
  5377.   FLoaded := False;
  5378. end;
  5379.  
  5380. function TGridValues.GetItem(Field: string): TGridValue;
  5381.  var
  5382.   Index: integer;
  5383.   GridValue: TGridValue;
  5384. begin
  5385.   FIndex := -1;
  5386.   Result := nil;
  5387.   for Index := 0 to Count-1 do
  5388.   begin
  5389.     GridValue := TGridValue(inherited GetItem(Index));
  5390.     if AnsiUpperCase(GridValue.FFieldName) = AnsiUpperCase(Field) then
  5391.     begin
  5392.       Result := GridValue;
  5393.       FIndex := Index;
  5394.       Break;
  5395.     end
  5396.   end;
  5397. end;
  5398.  
  5399. procedure TGridValues.SetItem(Field: string; Value: TGridValue);
  5400.  var
  5401.   GridValue: TGridValue;
  5402. begin
  5403.   GridValue := GetItem(Field);
  5404.   if FIndex = -1 then begin
  5405.     GridValue := TGridValue(Add);
  5406.   end;
  5407.   GridValue.FieldName:= Value.FieldName;
  5408.   GridValue.Value    := Value.Value;
  5409.   GridValue.FieldType:= Value.FieldType;
  5410. end;
  5411.  
  5412. procedure TDCCustomComboBox.GetHintOnError;
  5413. begin
  5414.   case FErrorCode of
  5415.     ERR_COMBO_ILLIGALVALUE  : FErrorHint := LoadStr(RES_COMB_ERR_WRONG);
  5416.    else
  5417.     FErrorHint := '';
  5418.   end;
  5419.   inherited;
  5420. end;
  5421.  
  5422. procedure TDCCustomComboBox.WMSetCursor(var Message: TWMSetCursor);
  5423. begin
  5424.   if NotEditControl then SetCursor(LoadCursor(0, IDC_ARROW)) else inherited;
  5425. end;
  5426.  
  5427. procedure TDCCustomComboBox.SetEditing(const Value: boolean);
  5428.  var
  5429.   sText: string;
  5430. begin
  5431.   if FEditing <> Value and (FStyle = csDropDownList) then
  5432.   begin
  5433.     FEditing := Value;
  5434.     sText := Text;
  5435.     RecreateWnd;
  5436.     Text := sText;
  5437.   end;
  5438. end;
  5439.  
  5440. procedure TDCCustomComboBox.Clear;
  5441. begin
  5442.   FItems.Clear;
  5443.   FItemIndex := -1;
  5444. end;
  5445.  
  5446. procedure TDCCustomChoiceEdit.SetCaret;
  5447.  var
  5448.   CaretHeight: integer;
  5449. begin
  5450.   inherited;
  5451.   CaretHeight := GetCharHeight(Handle, Font);
  5452.   CreateCaret(Handle, 0, 1, CaretHeight) ;
  5453.   ShowCaret(Handle);
  5454. end;
  5455.  
  5456. { TDCCustomTreeEdit }
  5457.  
  5458. procedure TDCCustomTreeEdit.ChangeSelected(Sender: TObject; Node: TTreeNode);
  5459. begin
  5460.   if not (csDestroying in ComponentState) then
  5461.   begin
  5462.     if (Selected <> nil) and (Selected.Text <> '') then  SetText(Selected.Text)
  5463.   end;
  5464. end;
  5465.  
  5466. procedure TDCCustomTreeEdit.ChoiceClick(Sender: TObject);
  5467. begin
  5468.   inherited;
  5469.   if FTreeVisible then
  5470.     CloseUp(0, True)
  5471.   else
  5472.     Perform(CM_POPUPWINDOW, 1, 0);
  5473. end;
  5474.  
  5475. procedure TDCCustomTreeEdit.CMCancelMode(var Message: TCMCancelMode);
  5476. begin
  5477.   if (Message.Sender <> Self) and
  5478.      (Message.Sender <> FTreeView) and
  5479.      not FTreeView.ContainsControl(Message.Sender) then
  5480.   begin
  5481.     inherited;
  5482.   end;
  5483. end;
  5484.  
  5485. procedure TDCCustomTreeEdit.CMEnter(var Message: TCMEnter);
  5486. begin
  5487.   inherited;
  5488.   if FStyle = teDropDownList then PaintListItem(Focused and not FTreeVisible);
  5489. end;
  5490.  
  5491. constructor TDCCustomTreeEdit.Create(AOwner: TComponent);
  5492. begin
  5493.   inherited;
  5494.   FTreeVisible := False;
  5495.   FTreeView    := TDCPopupTreeView.Create(Self);
  5496.   ControlStyle:= ControlStyle - [csSetCaption, csFixedHeight];
  5497.   with FTreeView do
  5498.   begin
  5499.     Parent := Self;
  5500.     OnChange     := ChangeSelected;
  5501.     OnKeyPress   := TreeViewKeyPress;
  5502.     OnDblClick   := TreeViewDblClick;
  5503.     OnExpanded   := Expanded;
  5504.     OnExpanding  := Expanding;
  5505.     OnCollapsed  := Collapsed;
  5506.     OnCollapsing := Collapsing;
  5507.     OnCustomDrawItem := CustomDrawItem;
  5508.     case DrawStyle of
  5509.       fcsNormal: PopupBorderStyle := brRaised;
  5510.       fsNone   : PopupBorderStyle  := brRaised;
  5511.       fsSingle : PopupBorderStyle  := brRaised;
  5512.       fsFlat   : PopupBorderStyle  := brRaised;
  5513.     end;
  5514.   end;
  5515.   FTreeInitialized := False;
  5516.   FStyle := teDropDownList;
  5517.   FNodeSelected := True;
  5518.  
  5519.   FImageChangeLink :=  TChangeLink.Create;
  5520.   FImageChangeLink.OnChange := ImageListChange;
  5521. end;
  5522.  
  5523. procedure TDCCustomTreeEdit.CreateParams(var Params: TCreateParams);
  5524. begin
  5525.   inherited;
  5526.   if FStyle = teDropDownList then
  5527.   begin
  5528.     with Params do
  5529.     begin
  5530.       Style := WS_CHILD or WS_CLIPSIBLINGS;
  5531.       AddBiDiModeExStyle(ExStyle);
  5532.       if csAcceptsControls in ControlStyle then
  5533.       begin
  5534.         Style := Style or WS_CLIPCHILDREN;
  5535.         ExStyle := ExStyle or WS_EX_CONTROLPARENT;
  5536.       end;
  5537.       if not (csDesigning in ComponentState) and not Enabled then
  5538.         Style := Style or WS_DISABLED;
  5539.       if TabStop then Style := Style or WS_TABSTOP;
  5540.       if Parent <> nil then
  5541.         WndParent := Parent.Handle else
  5542.         WndParent := ParentWindow;
  5543.       WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS;
  5544.       WindowClass.lpfnWndProc := @DefWindowProc;
  5545.       WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
  5546.       WindowClass.hbrBackground := 0;
  5547.       WindowClass.hInstance := HInstance;
  5548.       StrPCopy(WinClassName, ClassName);
  5549.     end;
  5550.   end;
  5551. end;
  5552.  
  5553. destructor TDCCustomTreeEdit.Destroy;
  5554. begin
  5555.   FImageChangeLink.Free;
  5556.   ClearTreeItems;
  5557.   FTreeView.Free;
  5558.   inherited;
  5559. end;
  5560.  
  5561. function TDCCustomTreeEdit.GetSelected: TTreeNode;
  5562. begin
  5563.   Result := FTreeView.Selected;
  5564. end;
  5565.  
  5566. function TDCCustomTreeEdit.GetTreeView: TTreeView;
  5567. begin
  5568.   Result := TTreeView(FTreeView);
  5569. end;
  5570.  
  5571. procedure TDCCustomTreeEdit.InitTree;
  5572. begin
  5573.   if Assigned(FOnInitTree) then FOnInitTree(Self, TTreeView(FTreeView));
  5574.   FTreeInitialized := True;
  5575. end;
  5576.  
  5577. procedure TDCCustomTreeEdit.KeyDown(var Key: Word; Shift: TShiftState);
  5578.  var
  5579.   KeyDownEvent: TKeyEvent;
  5580. begin
  5581.   KeyDownEvent := OnKeyDown;
  5582.   if FTreeVisible and (FTreeView<>nil) then
  5583.     case Key of
  5584.       VK_PRIOR,
  5585.       VK_NEXT ,
  5586.       VK_UP   ,
  5587.       VK_DOWN ,
  5588.       VK_LEFT ,
  5589.       VK_RIGHT :
  5590.         begin
  5591.           if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  5592.           SendMessage(FTreeView.Handle, WM_KEYDOWN, Key, 0);
  5593.           Key := 0;
  5594.         end;
  5595.     end
  5596.   else begin
  5597.     if [ssAlt]*Shift = [ssAlt] then
  5598.     begin
  5599.       case Key of
  5600.         VK_DOWN:
  5601.           begin
  5602.             if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  5603.             if Key <> 0 then ChoiceButtonDown;
  5604.             Key := 0;
  5605.           end;
  5606.       end;
  5607.       Exit;
  5608.     end;
  5609.     case Key of
  5610.       VK_DOWN:
  5611.         begin
  5612.           if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  5613.           if Key <> 0 then ChoiceButtonDown;
  5614.           Key := 0;
  5615.         end;
  5616.     end;
  5617.   end;
  5618.   case Key of
  5619.     VK_DELETE:
  5620.       if not ReadOnly then FNodeSelected := False;
  5621.   end;
  5622.   if Key <> 0 then inherited;
  5623. end;
  5624.  
  5625. procedure TDCCustomTreeEdit.KeyPress(var Key: Char);
  5626. begin
  5627.   if FTreeVisible  and (FTreeView <>nil) then
  5628.   begin
  5629.     case Key of
  5630.       Char(VK_RETURN):
  5631.         begin
  5632.           CloseUp(1, True);
  5633.           if not PerformCloseUp then Key := #0;
  5634.         end;
  5635.       Char(VK_ESCAPE): begin CloseUp(0, True); Key := #0; end;
  5636.       else begin
  5637.         FTreeView.KeyPress(Key);
  5638.         Key := #0;
  5639.       end;
  5640.     end;
  5641.   end;
  5642.   inherited KeyPress(Key);
  5643. end;
  5644.  
  5645. procedure TDCCustomTreeEdit.Loaded;
  5646. begin
  5647.   inherited;
  5648.   if csDesigning in ComponentState then
  5649.     Text := Name
  5650.   else begin
  5651.     if Assigned(Selected) then
  5652.       SetText(Selected.Text)
  5653.     else
  5654.       SetText('');
  5655.   end;
  5656. end;
  5657.  
  5658. procedure TDCCustomTreeEdit.PaintListItem(bFocused: boolean);
  5659. const
  5660.   Alignments: array[Boolean, TAlignment] of DWORD =
  5661.     ((DT_LEFT, DT_RIGHT, DT_CENTER),(DT_RIGHT, DT_LEFT, DT_CENTER));
  5662.  var
  5663.   DC: HDC;
  5664.   R: TRect;
  5665.   ACanvas: TCanvas;
  5666.   ANodeIndex: integer;
  5667. begin
  5668.   if not(FStyle = teDropDownList) or (Parent = nil) then Exit;
  5669.  
  5670.   bFocused := bFocused and not FTreeVisible;
  5671.  
  5672.   ACanvas := TControlCanvas.Create;
  5673.   DC := GetWindowDC(Handle);
  5674.  
  5675.   GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  5676.   if PaintCheckGlyph  then R.Left := R.Left + FCheckGlyph.Width + 2;
  5677.   if ButtonWidth > 0 then
  5678.   begin
  5679.     R.Right := R.Right - ButtonWidth;
  5680.     if FDrawStyle = fsFlat then R.Right := R.Right - 1
  5681.   end;
  5682.   case FDrawStyle of
  5683.     fsNone  :
  5684.      begin
  5685.        InflateRect(R, -1, -1);
  5686.        R.Left := R.Left -1;
  5687.      end;
  5688.     fsSingle  :
  5689.      begin
  5690.        InflateRect(R, -2, -2);
  5691.        R.Right := R.Right -1;
  5692.      end;
  5693.     fcsNormal,
  5694.     fsFlat  :
  5695.      InflateRect(R, -3, -3);
  5696.   end;
  5697.  
  5698.   ACanvas.Handle := DC;
  5699.   ACanvas.Font         := Font;
  5700.   ACanvas.Brush.Color  := Color;
  5701.   InflateRect(R, 1, 1);
  5702.   FillRect(ACanvas.Handle, R, ACanvas.Brush.Handle);
  5703.   InflateRect(R, -1, -1);
  5704.  
  5705.   if bFocused then
  5706.   begin
  5707.     ACanvas.Brush.Color := clHighlight;
  5708.     ACanvas.Font.Color  := clHighlightText;
  5709.   end;
  5710.  
  5711.   try
  5712.     if (Selected <> nil) and Assigned(FImages) and (Selected.ImageIndex <> -1)
  5713.     then begin
  5714.       R.Left := R.Left + 1;
  5715.       if bFocused then
  5716.         FImages.DrawingStyle := dsTransparent
  5717.       else
  5718.         FImages.DrawingStyle := dsTransparent;
  5719.  
  5720.       FImages.Draw(ACanvas, R.Left, R.Top, Selected.ImageIndex, True);
  5721.       R.Left := R.Left + FImages.Width + 1;
  5722.     end;
  5723.     if FDrawStyle = fsNone then
  5724.       R.Left  := R.Left  +1;
  5725.     FillRect(ACanvas.Handle, R, ACanvas.Brush.Handle);
  5726.     if bFocused then DrawFocusRect(ACanvas.Handle, R);
  5727.     InflateRect(R, -1, -1);
  5728.     SetBkMode(ACanvas.Handle, TRANSPARENT);
  5729.     case FDrawStyle of
  5730.       fcsNormal,
  5731.       fsFlat  ,
  5732.       fsNone  : R.Top := R.Top -1;
  5733.     end;
  5734.  
  5735.     R.Left := R.Left + 2;
  5736.     if Assigned(FOnDrawText) then
  5737.     begin
  5738.       if Assigned(Selected) then
  5739.         ANodeIndex := Selected.Index
  5740.       else
  5741.         ANodeIndex := -1;
  5742.       FOnDrawText(ACanvas, Self, ANodeIndex, R, []);
  5743.     end
  5744.     else
  5745.       DrawText(ACanvas.Handle, PChar(Text), Length(Text), R,
  5746.         Alignments[UseRightToLeftAlignment, FAlignment]);
  5747.   finally
  5748.     ReleaseDC(Handle, DC);
  5749.     ACanvas.Handle := 0;
  5750.     ACanvas.Free;
  5751.   end;
  5752. end;
  5753.  
  5754.  
  5755. procedure TDCCustomTreeEdit.SetSelected(const Value: TTreeNode);
  5756. begin
  5757.   FTreeView.Selected := Value;
  5758.   FNodeSelected := True;
  5759. end;
  5760.  
  5761. procedure TDCCustomTreeEdit.SetText(Value: string);
  5762. begin
  5763.   if Assigned(FOnSetText) then
  5764.     FOnSetText(Self)
  5765.   else
  5766.     Text := Value;
  5767.   if (Style = teDropDownList) and Assigned(FOnChange) then
  5768.      FOnChange(Self, Selected);
  5769. end;
  5770.  
  5771. procedure TDCCustomTreeEdit.SetTreeView(const Value: TTreeView);
  5772. begin
  5773.   FTreeView.Items.Assign(Value.Items);
  5774.   FImages := TImageList(Value.Images); 
  5775. end;
  5776.  
  5777. procedure TDCCustomTreeEdit.TreeViewDblClick(Sender: TObject);
  5778. begin
  5779.   CloseUp(1);
  5780. end;
  5781.  
  5782. procedure TDCCustomTreeEdit.TreeViewKeyPress(Sender: TObject; var Key: Char);
  5783. begin
  5784.   inherited;
  5785. end;
  5786.  
  5787. procedure TDCCustomTreeEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
  5788. begin
  5789.   inherited;
  5790.   Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_WANTALLKEYS;
  5791. end;
  5792.  
  5793. procedure TDCCustomTreeEdit.WMLButtonDblClk(var Message: TWMLButtonDown);
  5794. begin
  5795.   if (FTreeVisible) and (TMessage(Message).WParam = $AE) then CloseUp(1)
  5796.   else begin
  5797.     if FStyle = teDropDownList then Message.Result := $AE;
  5798.     inherited WMLButtonDblClk(Message);
  5799.   end;
  5800. end;
  5801.  
  5802. procedure TDCCustomTreeEdit.WMPaint(var Message: TWMPaint);
  5803.  var
  5804.   PS: TPaintStruct;
  5805. begin
  5806.   if FStyle = teDropDownList then
  5807.   begin
  5808.     BeginPaint(Handle, PS);
  5809.     RedrawBorder(True, 0);
  5810.     PaintListItem(Focused and not FTreeVisible);
  5811.     EndPaint(Handle, PS);
  5812.   end
  5813.   else
  5814.     inherited;
  5815. end;
  5816.  
  5817. procedure TDCCustomTreeEdit.WMSetCursor(var Message: TWMSetCursor);
  5818. begin
  5819. //  inherited;
  5820.   SetCursor(LoadCursor(0, IDC_ARROW));
  5821. end;
  5822.  
  5823. procedure TDCCustomTreeEdit.WMSetFocus(var Message: TWMSetFocus);
  5824. begin
  5825.   inherited;
  5826.   if FStyle = teDropDownList then HideCaret(Handle);
  5827. end;
  5828.  
  5829. procedure TDCCustomTreeEdit.WndProc(var Message: TMessage);
  5830. begin
  5831.   inherited WndProc(Message);
  5832.   if csDesigning in ComponentState then Exit;
  5833.   case Message.Msg of
  5834.     WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  5835.       if (not FInButtonArea and not FInCheckArea) and (Message.WParam <> $AE) and
  5836.          (FStyle = teDropDownList)
  5837.       then begin
  5838.         if not Focused then SetFocus;
  5839.         if Focused then
  5840.           with FBtnChoice do UpdateButtonState(Left+1, Top+1, True, False);
  5841.       end;
  5842.   end;
  5843. end;
  5844.  
  5845. procedure TDCCustomComboBox.CheckClick(Sender: TObject);
  5846. begin
  5847.   inherited;
  5848.   if NotEditControl then HideCaret(Handle);
  5849. end;
  5850.  
  5851. procedure TDCCustomComboBox.CreateWnd;
  5852. begin
  5853.   inherited;
  5854. end;
  5855.  
  5856. procedure TDCCustomTreeEdit.CMTextChanged(var Message: TMessage);
  5857. begin
  5858.   inherited;
  5859.   if (FStyle = teDropDownList) then PaintListItem(Focused and not FTreeVisible);
  5860. end;
  5861.  
  5862. procedure TDCCustomTreeEdit.Notification(AComponent: TComponent;
  5863.   Operation: TOperation);
  5864. begin
  5865.   inherited;
  5866.   if (Operation = opRemove) and (AComponent = FImages) then FImages := nil;
  5867. end;
  5868.  
  5869. procedure TDCCustomTreeEdit.CMExit(var Message: TCMExit);
  5870. begin
  5871.   inherited;
  5872.   if FStyle = teDropDownList then
  5873.   begin
  5874.     if not ShowError then
  5875.       PaintListItem(False)
  5876.     else
  5877.       PaintListItem(True)
  5878.   end;
  5879. end;
  5880.  
  5881. function TDCCustomComboBox.MinControlWidthBitmap: integer;
  5882. begin
  5883.   if Style <> csDropDownList then
  5884.     Result := inherited MinControlWidthBitmap
  5885.   else
  5886.     Result := 2;
  5887. end;
  5888.  
  5889. procedure TDCCustomChoiceEdit.SetLinkControl(const Value: TWinControl);
  5890. begin
  5891.   FLinkControl := Value;
  5892.   if Value <> nil then Value.FreeNotification(Self);
  5893. end;
  5894.  
  5895. procedure TDCCustomChoiceEdit.Notification(AComponent: TComponent;
  5896.   Operation: TOperation);
  5897. begin
  5898.   inherited Notification(AComponent, Operation);
  5899.   if (Operation = opRemove) and (AComponent = FLinkControl) then FLinkControl := nil;
  5900. end;
  5901.  
  5902. procedure TDCCustomComboBox.EMGetSel(var Message: TMessage);
  5903. begin
  5904.   if FStyle = csDropDownList then
  5905.   with Message do
  5906.   begin
  5907.     lParam := 0;
  5908.     wParam := GetTextLen;
  5909.   end
  5910.   else
  5911.     inherited
  5912. end;
  5913.  
  5914. procedure TDCCustomTreeEdit.EMGetSel(var Message: TMessage);
  5915. begin
  5916.   with Message do
  5917.   begin
  5918.     lParam := 0;
  5919.     wParam := GetTextLen;
  5920.   end
  5921. end;
  5922.  
  5923. function TDCCustomChoiceEdit.GetDropDownVisible: boolean;
  5924. begin
  5925.   Result := False;
  5926. end;
  5927.  
  5928. function TDCCustomComboBox.GetDropDownVisible: boolean;
  5929. begin
  5930.   Result := FListBoxVisible;
  5931. end;
  5932.  
  5933. function TDCCustomTreeEdit.GetDropDownVisible: boolean;
  5934. begin
  5935.   Result := FTreeVisible;
  5936. end;
  5937.  
  5938. function TDCCustomChoiceEdit.GetButtonWidth: integer;
  5939. begin
  5940.   if BtnChoiceAssigned then
  5941.     Result := FBtnChoice.Width
  5942.   else
  5943.     Result := 0
  5944. end;
  5945.  
  5946. procedure TDCCustomTreeEdit.Collapsed(Sender: TObject; Node: TTreeNode);
  5947. begin
  5948.   if Assigned(FOnCollapsed) then FOnCollapsed(Sender, Node);
  5949. end;
  5950.  
  5951. procedure TDCCustomTreeEdit.Collapsing(Sender: TObject; Node: TTreeNode;
  5952.   var AllowExpansion: Boolean);
  5953. begin
  5954.   if Assigned(FOnCollapsing) then FOnCollapsing(Sender, Node, AllowExpansion);
  5955. end;
  5956.  
  5957. procedure TDCCustomTreeEdit.Expanded(Sender: TObject; Node: TTreeNode);
  5958. begin
  5959.   if Assigned(FOnExpanded) then FOnExpanded(Sender, Node);
  5960. end;
  5961.  
  5962. procedure TDCCustomTreeEdit.Expanding(Sender: TObject; Node: TTreeNode;
  5963.   var AllowExpansion: Boolean);
  5964. begin
  5965.   if Assigned(FOnExpanding) then FOnExpanding(Sender, Node, AllowExpansion);
  5966. end;
  5967.  
  5968. procedure TDCCustomChoiceEdit.AdjustClientRect(var Rect: TRect);
  5969. begin
  5970.   inherited;
  5971.   Rect.Right := Rect.Right-ButtonWidth;
  5972. end;
  5973.  
  5974. procedure TDCCustomChoiceEdit.DefineBtnChoiceStyle;
  5975. begin
  5976.   {}
  5977. end;
  5978.  
  5979. procedure TDCCustomComboBox.DefineBtnChoiceStyle;
  5980. begin
  5981.   if BtnChoiceAssigned then
  5982.   begin
  5983.     ButtonChoiceStyle := btsCombo;
  5984.     ButtonStyle := esDropDown;
  5985.   end;
  5986. end;
  5987.  
  5988. procedure TDCCustomTreeEdit.DefineBtnChoiceStyle;
  5989. begin
  5990.   if BtnChoiceAssigned then
  5991.   begin
  5992.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNTREE');
  5993.     ButtonStyle := esDropDown;
  5994.     ButtonChoiceStyle := btsCustom;
  5995.     if (FStyle = teDropDownList) and (FDrawStyle = fsSingle) then
  5996.       ButtonChoice.Height := ClientHeight;
  5997.     ButtonChoice.SimpleStyle := False;
  5998.   end;
  5999. end;
  6000.  
  6001. procedure TDCCustomComboBox.CMPopupWindow(var Message: TMessage);
  6002. begin
  6003.   case Message.WParam of
  6004.     0:
  6005.      if FListBoxVisible then
  6006.      begin
  6007.        FListBoxVisible := False;
  6008.        FListBox.Free;
  6009.        FListBox := nil;
  6010.        ShowHint  := FHintShow;
  6011.        PaintListItem(Focused);
  6012.      end;
  6013.     1:
  6014.      begin
  6015.        PaintListItem(False);
  6016.        FHintShow := ShowHint;
  6017.        ShowHint  := False;
  6018.        DropDown;
  6019.        FListBox := TDCPopupListBox.Create(Self);
  6020.        FCachedIndex := FItemIndex;
  6021.        FCachedText  := Text;
  6022.        with FListBox do
  6023.        begin
  6024.          //Color := Self.Color;
  6025.          Parent := Self;
  6026.          PopupAlignment := wpBottomLeft;
  6027.          DropDownRows := DropDownCount;
  6028.          case DrawStyle of
  6029.            fcsNormal,
  6030.            fsNone   : FListBox.PopupBorderStyle := brSingle;
  6031.            fsSingle : FListBox.PopupBorderStyle := brRaised;
  6032.            fsFlat   : FListBox.PopupBorderStyle := brRaised;
  6033.          end;
  6034.          if FDropDownWidth = 0 then Width := Self.Width
  6035.            else Width :=FDropDownWidth;
  6036.          OnMeasureItem := FOnMeasureItem;
  6037.          ItemHeight := FItemHeight;
  6038.          Items := Self.Items;
  6039.          OnDrawItem := FOnDrawItem;
  6040.          OnMouseUp  := ListMouseUp;
  6041.          if not( (FItemIndex < Self.Items.Count-1) and
  6042.                  (FItemIndex> -1) and
  6043.                  (AnsiCompareText(Self.Items.Strings[FItemIndex],Text)=0) ) then
  6044.            FItemIndex := GetFirstEntry(False);
  6045.          ItemIndex  := FItemIndex;
  6046.          SelectAll;
  6047.          ShowDropDown;
  6048.          FListBoxVisible := True;
  6049.        end
  6050.      end;
  6051.   end;
  6052. end;
  6053.  
  6054. procedure TDCCustomTreeEdit.CMPopupWindow(var Message: TMessage);
  6055. begin
  6056.   case Message.WParam of
  6057.     0:
  6058.       if FTreeVisible then
  6059.       begin
  6060.         FTreeView.Hide;
  6061.         FTreeVisible := False;
  6062.         ShowHint  := FHintShow;
  6063.         if FStyle = teDropDownList then PaintListItem(Focused);
  6064.       end;
  6065.     1:
  6066.      begin
  6067.        if FStyle = teDropDownList then PaintListItem(Focused and not FTreeVisible);
  6068.        FHintShow := ShowHint;
  6069.        ShowHint  := False;
  6070.        with FTreeView do
  6071.        begin
  6072.          Color  := Self.Color;
  6073.          PopupAlignment := wpBottomLeft;
  6074.          Images  := FImages;
  6075.          Caption := DBObject.Caption;
  6076.          if FDropDownWidth = 0 then Width := Self.Width
  6077.            else Width :=FDropDownWidth;
  6078.  
  6079.          FTreeVisible := True;
  6080.          PaintListItem(Focused and not FTreeVisible);
  6081.          if not(csDesigning in ComponentState) then Buttons.SetWndProc;
  6082.          if not FTreeInitialized then InitTree;
  6083.          SetScrollPos(Handle, SB_HORZ, 0, True);
  6084.          ShowDropDown;
  6085.        end
  6086.      end;
  6087.   end;
  6088. end;
  6089.  
  6090. procedure TDCCustomChoiceEdit.SetMargins(var LeftMargin: integer;
  6091.   var RightMargin: integer);
  6092.  var
  6093.   CharWidth, ABorderWidth: integer;
  6094. begin
  6095.   if PaintCheckGlyph then
  6096.   begin
  6097.     CharWidth := GetCharWidth(Handle, Font);
  6098.     LeftMargin    := FCheckGlyph.Width;
  6099.     if LeftMargin < CharWidth then
  6100.       LeftMargin := CharWidth + 5
  6101.     else
  6102.       Inc(LeftMargin, 2);
  6103.   end
  6104.   else
  6105.     LeftMargin := 0;
  6106.  
  6107.   ABorderWidth := 0;
  6108.  
  6109.   case FDrawStyle of
  6110.     fsNone   : ABorderWidth := 0;
  6111.     fsSingle,
  6112.     fcsNormal,
  6113.     fsFlat   : ABorderWidth := 6;
  6114.   end;
  6115.   if Assigned(FBtnChoice) then
  6116.   begin
  6117.     if (Width < MinControlWidthBitmap) then
  6118.     begin
  6119.        RightMargin  := 0;
  6120.        FBtnChoice.Free;
  6121.        FBtnChoice   := nil;
  6122.      end
  6123.      else begin
  6124.        RightMargin  := FBtnChoice.Width;
  6125.        if (Alignment = taRightJustify) or  (Alignment = taCenter) then
  6126.        begin
  6127.          Inc(RightMargin, 4);
  6128.        end;
  6129.      end;
  6130.   end
  6131.   else RightMargin := 0;
  6132.  
  6133.   Inc(RightMargin, ABorderWidth);
  6134. end;
  6135.  
  6136. procedure TDCCustomChoiceEdit.DoDrawMargins(DC: HDC);
  6137. begin
  6138.   {}
  6139. end;
  6140.  
  6141. procedure TDCCustomTreeEdit.SetStyle(const Value: TTreeEditStyle);
  6142. begin
  6143.   FStyle := Value;
  6144.   RecreateWnd;
  6145. end;
  6146.  
  6147. procedure TDCCustomTreeEdit.KillFocus(var Value: boolean);
  6148.  var
  6149.   Node: TTreeNode;
  6150.   AErrorCode: integer;
  6151. begin
  6152.   if CanModified and not FNodeSelected then
  6153.   begin
  6154.     if Trim(Text) <> '' then
  6155.     begin
  6156.       AErrorCode := 0;
  6157.       if not GetNode(Text, Node, AErrorCode) then
  6158.       begin
  6159.         Value := True;
  6160.         if AErrorCode = 0 then
  6161.           FErrorCode := ERR_TREE_ILLIGALVALUE
  6162.         else
  6163.           FErrorCode := AErrorCode;
  6164.       end
  6165.       else if Assigned(Node) then SetSelected(Node)
  6166.     end;
  6167.   end;
  6168.   inherited;
  6169. end;
  6170.  
  6171. function TDCCustomTreeEdit.GetNode(Value: string;
  6172.   var Node: TTreeNode; var ErrorCode: integer): boolean;
  6173.  var
  6174.   ANode: TTreeNode;
  6175.   AValue, AText: string;
  6176. begin
  6177.   ANode := FTreeView.Items.GetFirstNode;
  6178.   AValue := AnsiUpperCase(Value);
  6179.   while ANode <> nil do
  6180.   begin
  6181.     if Assigned(FOnGetText) then
  6182.       FOnGetText(Self, ANode, AText)
  6183.     else
  6184.       AText := AnsiUpperCase(ANode.Text);
  6185.     if (CompareText(AValue, AText) = 0) and CanSelectNode(ANode) then
  6186.     begin
  6187.       Result := True;
  6188.       Node   := ANode;
  6189.       Exit;
  6190.     end;
  6191.     if ANode.HasChildren and not ANode.Expanded then
  6192.     begin
  6193.       ANode.Expand(False);
  6194.       ANode.Collapse(False);
  6195.     end;
  6196.     ANode := ANode.GetNext;
  6197.   end;
  6198.  
  6199.   Result := False;
  6200. end;
  6201.  
  6202. procedure TDCCustomTreeEdit.GetHintOnError;
  6203. begin
  6204.   case FErrorCode of
  6205.     ERR_TREE_ILLIGALVALUE: FErrorHint := LoadStr(RES_TREE_ERR_WRONG);
  6206.   else
  6207.     FErrorHint := '';
  6208.   end;
  6209.   inherited;
  6210. end;
  6211.  
  6212. procedure TDCCustomTreeEdit.WMPaste(var Message: TWMPaste);
  6213. begin
  6214.   inherited;
  6215.   FNodeSelected := False;
  6216. end;
  6217.  
  6218. procedure TDCCustomTreeEdit.WMChar(var Message: TWMChar);
  6219. begin
  6220.   if not (Message.CharCode in [0, 13, 27]) and (Message.KeyData <> 0) and not ReadOnly then
  6221.     FNodeSelected := False;
  6222.   inherited;
  6223. end;
  6224.  
  6225. function TDCCustomTreeEdit.DoMouseWheelDown(Shift: TShiftState;
  6226.   MousePos: TPoint): Boolean;
  6227.  var
  6228.   Key: Word;
  6229. begin
  6230.   Result := inherited DoMouseWheelDown(Shift, MousePos);
  6231.   if not Result then
  6232.   begin
  6233.     Key := VK_DOWN;
  6234.     KeyDown(Key,  Shift);
  6235.     Result := True;
  6236.   end;
  6237. end;
  6238.  
  6239. function TDCCustomTreeEdit.DoMouseWheelUp(Shift: TShiftState;
  6240.   MousePos: TPoint): Boolean;
  6241.  var
  6242.   Key: Word;
  6243. begin
  6244.   Result := inherited DoMouseWheelUp(Shift, MousePos);
  6245.   if not Result then
  6246.   begin
  6247.     Key := VK_UP;
  6248.     KeyDown(Key,  Shift);
  6249.     Result := True;
  6250.   end;
  6251. end;
  6252.  
  6253. procedure TDCCustomTreeEdit.Change;
  6254. begin
  6255.   inherited Changed;
  6256.   if Assigned(FOnChange) then FOnChange(Self, Selected);
  6257. end;
  6258.  
  6259. procedure TDCCustomTreeEdit.CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode;
  6260.        State: TCustomDrawState; var DefaultDraw: Boolean);
  6261. begin
  6262.   if Assigned(FOnCustomDrawItem) then FOnCustomDrawItem(Sender, Node, State, DefaultDraw);
  6263. end;
  6264.  
  6265. procedure TDCCustomTreeEdit.ClearTreeItems;
  6266. begin
  6267.   if Assigned(FOnClearItems) then FOnClearItems(Self, TreeView);
  6268.   TreeView.Items.Clear;
  6269.   FTreeInitialized := False;
  6270. end;
  6271.  
  6272. procedure TDCCustomTreeEdit.ImageListChange(Sender: TObject);
  6273. begin
  6274.   invalidate;
  6275. end;
  6276.  
  6277. procedure TDCCustomTreeEdit.CloseUp(State: Byte; bPerform: boolean);
  6278.  var
  6279.   lCanSelected: boolean;
  6280. begin
  6281.   if FTreeVisible then
  6282.   begin
  6283.     lCanSelected := CanSelectNode(Selected);
  6284.     if (State = 0) or lCanSelected then inherited;
  6285.     FNodeSelected := (State = 1) and lCanSelected;
  6286.   end
  6287. end;
  6288.  
  6289. function TDCCustomTreeEdit.CanSelectNode(Node: TTreeNode): boolean;
  6290. begin
  6291.   Result := True;
  6292.   if Assigned(FOnSelectNode) then FOnSelectNode(Self, Node, Result);
  6293. end;
  6294.  
  6295. procedure TDCCustomTreeEdit.ShowDropDown;
  6296. begin
  6297.   FTreeView.Show;
  6298. end;
  6299.  
  6300. procedure TDCCustomTreeEdit.SetImages(const Value: TImageList);
  6301. begin
  6302.   if Images <> nil then
  6303.     Images.UnRegisterChanges(FImageChangeLink);
  6304.   FImages := Value;
  6305.   if Images <> nil then
  6306.   begin
  6307.     Images.RegisterChanges(FImageChangeLink);
  6308.     Images.FreeNotification(Self);
  6309.   end;
  6310.   if DropDownVisible then invalidate;
  6311. end;
  6312.  
  6313. { TDCCustomFloatEdit }
  6314.  
  6315. procedure TDCCustomFloatEdit.ChoiceClick(Sender: TObject);
  6316. begin
  6317.   inherited;
  6318.   if FCalculatorVisible then
  6319.     CloseUp(0, True)
  6320.   else
  6321.     Perform(CM_POPUPWINDOW, 1, 0);
  6322. end;
  6323.  
  6324. procedure TDCCustomFloatEdit.CloseUp(State: Byte; bPerform: boolean = False);
  6325. begin
  6326.   case State of
  6327.      0:;
  6328.      1:
  6329.       with FCalculator do
  6330.       begin
  6331.         if (ErrorCode = 0) and IsValidFloat(VisibleParam) then
  6332.         begin
  6333.           Value := StrToFloat(VisibleParam);
  6334.           SendMessage(Self.Handle, EM_SETSEL, 0, -1);
  6335.         end;
  6336.       end;
  6337.   end;
  6338.   inherited;
  6339. end;
  6340.  
  6341. procedure TDCCustomFloatEdit.CMCancelMode(var Message: TCMCancelMode);
  6342. begin
  6343.   if (Message.Sender <> Self) and
  6344.      (Message.Sender <> FCalculator) and
  6345.      not FCalculator.ContainsControl(Message.Sender) then
  6346.   begin
  6347.     inherited;
  6348.   end;
  6349. end;
  6350.  
  6351. procedure TDCCustomFloatEdit.CMPopupWindow(var Message: TMessage);
  6352. begin
  6353.   case Message.WParam of
  6354.     0:
  6355.      if FCalculatorVisible then
  6356.      begin
  6357.        FCalculatorVisible := False;
  6358.        FCalculator.Free;
  6359.        FCalculator := nil;
  6360.        ShowHint  := FHintShow;
  6361.        ShowCaret(Handle);
  6362.      end;
  6363.     1:
  6364.      begin
  6365.        FHintShow  := ShowHint;
  6366.        ShowHint   := False;
  6367.        FCalculator:= TDCCustomCalculator.Create(Self);
  6368.        HideCaret(Handle);
  6369.        with FCalculator do
  6370.        begin
  6371.          OnCloseUp := CloseUp;
  6372.          if IsValidFloat(Self.Text) then VisibleParam := Self.Text;
  6373.          VisibleParamToFloat;
  6374.          ShowDropDown;
  6375.        end;
  6376.        FCalculatorVisible := True;
  6377.      end;
  6378.   end;
  6379. end;
  6380.  
  6381. constructor TDCCustomFloatEdit.Create(AOwner: TComponent);
  6382. begin
  6383.   inherited;
  6384.   Alignment := taRightJustify;
  6385.   FDataType := TFloatDataType.Create(Self);
  6386.   FMasked := False;  
  6387. end;
  6388.  
  6389. procedure TDCCustomFloatEdit.DefineBtnChoiceStyle;
  6390. begin
  6391.   if BtnChoiceAssigned then
  6392.   begin
  6393.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNCALC');
  6394.     ButtonStyle  := esDropDown;
  6395.     ButtonChoiceStyle := btsCustom;
  6396.     ButtonChoice.SimpleStyle := False;
  6397.   end;
  6398. end;
  6399.  
  6400. destructor TDCCustomFloatEdit.Destroy;
  6401. begin
  6402.   Perform(CM_ERRORMESSAGE, 0, 0);
  6403.   FDataType.Free;
  6404.   inherited;
  6405. end;
  6406.  
  6407. procedure TDCCustomFloatEdit.EditMaskChanged;
  6408. begin
  6409.   if not CanEmpty or (Text <> '') then Text := GetEditValue(Text);
  6410. end;
  6411.  
  6412. function TDCCustomFloatEdit.GetDropDownVisible: boolean;
  6413. begin
  6414.   Result := FCalculatorVisible;
  6415. end;
  6416.  
  6417. function TDCCustomFloatEdit.GetEditValue(EditText: string): string;
  6418. begin
  6419.   Result := EditText;
  6420.   with DataType do
  6421.   begin
  6422.     case Kind of
  6423.       deFloat:
  6424.         if not CheckFloat(Result, Precision, Digits) then
  6425.         begin
  6426.           Result := '0';
  6427.           CheckFloat(Result, Precision, Digits);
  6428.         end;
  6429.       deCurrency:
  6430.         if not CheckCurrency(Result, CurrencyDecimals, Digits) then
  6431.         begin
  6432.           Result := '0';
  6433.           CheckCurrency(Result, CurrencyDecimals, Digits);
  6434.         end;
  6435.       deInteger:
  6436.         if not CheckInteger(Result, Digits) then Result := '0'
  6437.     end;
  6438.   end;
  6439. end;
  6440.  
  6441. procedure TDCCustomFloatEdit.GetHintOnError;
  6442. begin
  6443.   case FErrorCode of
  6444.     ERR_EDIT_INCORRECTFLOAT: FErrorHint := LoadStr(RES_EDIT_ERR_FLOAT);
  6445.     ERR_EDIT_INCORRECTCURR : FErrorHint := LoadStr(RES_EDIT_ERR_CURR);
  6446.     ERR_EDIT_INCORRECTDEC  : FErrorHint := LoadStr(RES_EDIT_ERR_DEC);
  6447.    else
  6448.     FErrorHint := '';
  6449.   end;
  6450.   inherited;
  6451. end;
  6452.  
  6453. function TDCCustomFloatEdit.GetValue: Extended;
  6454. begin
  6455.   Result := StrToFloat(GetEditValue(Text));
  6456. end;
  6457.  
  6458. function TDCCustomFloatEdit.IsMasked: boolean;
  6459. begin
  6460.   Result :=  FMasked and inherited IsMasked;
  6461. end;
  6462.  
  6463. procedure TDCCustomFloatEdit.KeyDown(var Key: Word; Shift: TShiftState);
  6464.  var
  6465.   KeyDownEvent: TKeyEvent;
  6466. begin
  6467.   KeyDownEvent := OnKeyDown;
  6468.   if FCalculatorVisible and (FCalculator<>nil) then
  6469.   begin
  6470.     if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  6471.     FCalculator.KeyDown(Key, Shift);
  6472.     Key := 0;
  6473.   end
  6474.   else
  6475.     case Key of
  6476.       VK_DOWN:
  6477.         if [ssAlt] * Shift = [ssAlt] then
  6478.         begin
  6479.           if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  6480.           if Key <> 0 then ChoiceButtonDown;
  6481.           Key := 0;
  6482.         end;
  6483.     end;
  6484.   if Key <> 0 then inherited;
  6485. end;
  6486.  
  6487. procedure TDCCustomFloatEdit.KeyPress(var Key: Char);
  6488. begin
  6489.   if FCalculatorVisible and (FCalculator<>nil) and not PerformCloseUp then Key := #0;
  6490.   inherited KeyPress(Key);
  6491. end;
  6492.  
  6493. procedure TDCCustomFloatEdit.KillFocus(var Value: boolean);
  6494.  var
  6495.   EditText: string;
  6496.  
  6497.  function CheckValue(AText: string): string;
  6498.  begin
  6499.    Result := AText;
  6500.    with DataType do
  6501.    begin
  6502.      case Kind of
  6503.        deFloat:
  6504.          if not CheckFloat(Result, Precision, Digits) then
  6505.          begin
  6506.            Value := True;
  6507.            FErrorCode := ERR_EDIT_INCORRECTFLOAT;
  6508.          end;
  6509.        deCurrency:
  6510.          if not CheckCurrency(Result, CurrencyDecimals, Digits) then
  6511.          begin
  6512.            Value := True;
  6513.            FErrorCode := ERR_EDIT_INCORRECTCURR;
  6514.          end;
  6515.        deInteger:
  6516.          if not CheckInteger(Result, Digits) then
  6517.          begin
  6518.            Value := True;
  6519.            FErrorCode := ERR_EDIT_INCORRECTDEC;
  6520.          end;
  6521.      end;
  6522.    end;
  6523.  end;
  6524.  
  6525. begin
  6526.  if CanModified and not Value and not(Trim(Text) = '') and not MaskMatched then
  6527.  begin
  6528.    EditText := CheckValue(Text);
  6529.    if not Value then Text := EditText;
  6530.  end
  6531.  else
  6532.    if not(Trim(Text) = '') then
  6533.    begin
  6534.      EditText := CheckValue(Text);
  6535.      if not Value then Self.Value := StrToFloat(EditText);
  6536.    end;
  6537.  inherited KillFocus(Value);
  6538. end;
  6539.  
  6540. procedure TDCCustomChoiceEdit.WMSysCommand(var Message: TWMSysCommand);
  6541. begin
  6542.   inherited;
  6543. end;
  6544.  
  6545. procedure TDCCustomChoiceEdit.WndProc(var Message: TMessage);
  6546. begin
  6547.   case Message.Msg of
  6548.     WM_KILLFOCUS: if not DropDownWindow(TWMKillFocus(Message)) and not DropDownMoving then CloseUp(0, True);
  6549.   end;
  6550.   inherited;
  6551. end;
  6552.  
  6553. procedure TDCCustomChoiceEdit.ChoiceButtonDown;
  6554. begin
  6555.   if BtnChoiceAssigned and (ButtonStyle=esDropDown) then
  6556.     with FBtnChoice do UpdateButtonState(Left+1, Top+1, True, False);
  6557. end;
  6558.  
  6559. procedure TDCCustomFloatEdit.SetDataType(const Value: TFloatDataType);
  6560. begin
  6561.   FDataType.Assign(Value);
  6562. end;
  6563.  
  6564. procedure TDCCustomFloatEdit.SetValue(const Value: Extended);
  6565. begin
  6566.   Text := GetEditValue(FloatToStr(Value));
  6567. end;
  6568.  
  6569. procedure TDCCustomFloatEdit.ShowDropDown;
  6570. begin
  6571.    FCalculator.Show;
  6572. end;
  6573.  
  6574. { TFloatDataType }
  6575.  
  6576. procedure TFloatDataType.Assign(Source: TPersistent);
  6577. begin
  6578.   FKind      := TFloatDataType(Source).Kind;
  6579.   FPrecision := TFloatDataType(Source).Precision;
  6580.   FDigits    := TFloatDataType(Source).Digits;
  6581.   UpdateMask;
  6582. end;
  6583.  
  6584. constructor TFloatDataType.Create(AEdit: TDCCustomMaskEdit);
  6585. begin
  6586.   inherited Create;
  6587.   FEdit := AEdit;
  6588.   FKind := deFloat;
  6589.   FPrecision := -1;
  6590.   FDigits    := -1;
  6591. end;
  6592.  
  6593. procedure TFloatDataType.SetDigits(const Value: integer);
  6594. begin
  6595.   FDigits := Value;
  6596.   UpdateMask;
  6597. end;
  6598.  
  6599. procedure TFloatDataType.SetKind(const Value: TEditDataType);
  6600. begin
  6601.   FKind := Value;
  6602.   case Value of
  6603.     deFloat:;
  6604.     deInteger:
  6605.       Precision := 0;
  6606.     deCurrency:
  6607.       Precision := 0;
  6608.   end;
  6609.   UpdateMask;
  6610. end;
  6611.  
  6612. procedure TFloatDataType.SetPrecision(const Value: integer);
  6613. begin
  6614.   FPrecision := Value;
  6615.   UpdateMask;
  6616. end;
  6617.  
  6618. function TDCCustomChoiceEdit.IsGlyphStored: boolean;
  6619. begin
  6620.   Result := (FBtnChoiceStyle = btsCustom);
  6621. end;
  6622.  
  6623. function TDCCustomChoiceEdit.IsButtonWidthStored: boolean;
  6624. begin
  6625.   Result := (FBtnChoiceStyle = btsCustom);
  6626. end;
  6627.  
  6628. procedure TDCCustomComboBox.WMLButtonDblClk(var Message: TWMLButtonDown);
  6629. begin
  6630.   if ButtonEnabled and (FStyle = csDropDownList) then
  6631.   begin
  6632.     Message.Result := $AE;
  6633.     inherited WMLButtonDblClk(Message);
  6634.   end
  6635.   else inherited;
  6636. end;
  6637.  
  6638. function TDCCustomChoiceEdit.CanModified: boolean;
  6639. begin
  6640.   Result := inherited CanModified or (ButtonExist and ButtonEnabled);
  6641. end;
  6642.  
  6643. function TDCCustomComboBox.DoMouseWheel(Shift: TShiftState;
  6644.   WheelDelta: Integer; MousePos: TPoint): Boolean;
  6645.  var
  6646.   ADelta, AIndex: integer;
  6647.   AMessage: TCMMouseWheel;
  6648. begin
  6649.   Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  6650.   if not Result then
  6651.   begin
  6652.     if not FListBoxVisible then
  6653.     begin
  6654.       ADelta := WheelDelta div WHEEL_DELTA;
  6655.       AIndex := ItemIndex - ADelta;
  6656.       if (AIndex >= 0) and (AIndex < FItems.Count) then ItemIndex := AIndex;
  6657.       Result := True;
  6658.     end
  6659.     else begin
  6660.       AMessage.WheelDelta := WheelDelta;
  6661.       AMessage.ShiftState := Shift;
  6662.       AMessage.XPos        := MousePos.X;
  6663.       AMessage.YPos        := MousePos.Y;
  6664.       with TMessage(AMessage) do
  6665.         FListBox.Perform(CM_MOUSEWHEEL, WParam, LParam);
  6666.       Result := True;
  6667.     end;
  6668.   end;
  6669. end;
  6670.  
  6671. procedure TFloatDataType.UpdateMask;
  6672.  var
  6673.   sFormat: string;
  6674. begin
  6675.   sFormat := '';
  6676.   if FDigits > 0 then
  6677.   begin
  6678.     if FPrecision > 0 then
  6679.       sFormat := Format('9{%d}!(.,%1:s)%1:s9{%d}', [FDigits - FPrecision, DecimalSeparator, FPrecision])
  6680.     else
  6681.       sFormat := Format('9{%d}', [FDigits])
  6682.   end;
  6683.   if FEdit <> nil then FEdit.EditMask := sFormat;
  6684. end;
  6685.  
  6686. { TDCBDEGridEdit }
  6687.  
  6688. function TDCBDEGridEdit.CreateQuery: TDataSet;
  6689. begin
  6690.   Result := TQuery.Create(self);
  6691. end;
  6692.  
  6693. procedure TDCBDEGridEdit.DoInitQuery(Mode: integer);
  6694. begin
  6695.   with TQuery(FQuery) do
  6696.   begin
  6697.     SQL.Text := GetPreparedQueryText(Mode, SQL.Text);
  6698.     Prepare;
  6699.     Open;
  6700.   end;
  6701. end;
  6702.  
  6703. function TDCBDEGridEdit.GetDatabaseName: string;
  6704. begin
  6705.   Result := TQuery(FQuery).DatabaseName;
  6706. end;
  6707.  
  6708. function TDCBDEGridEdit.GetParams: TParams;
  6709. begin
  6710.   Result := TQuery(FQuery).Params;
  6711. end;
  6712.  
  6713. function TDCBDEGridEdit.GetQueryText: string;
  6714.  var
  6715.   i: integer;
  6716. begin
  6717.   Result := '';
  6718.   for i := 0 to TQuery(Query).SQL.Count -1 do
  6719.   begin
  6720.     if Result <> '' then Result := Result+ #10;
  6721.     Result := Result + TQuery(Query).SQL.Strings[i];
  6722.   end;
  6723. end;
  6724.  
  6725. procedure TDCBDEGridEdit.PrepareDataSet;
  6726.  var
  6727.   AParams: TParams;
  6728. begin
  6729.   AParams := TParams.Create;
  6730.   try
  6731.     AParams.Assign(Params);
  6732.     with TQuery(FQuery) do
  6733.     begin
  6734.       Close;
  6735.       UnPrepare;
  6736.       SQL.Clear;
  6737.       SQL.Text := SQLText;
  6738.       Params.Assign(AParams);
  6739.     end;
  6740.   finally
  6741.     AParams.Free;
  6742.   end;
  6743. end;
  6744.  
  6745. procedure TDCBDEGridEdit.SetDatabaseName(const Value: string);
  6746. begin
  6747.   TQuery(FQuery).DatabaseName := Value;
  6748. end;
  6749.  
  6750. procedure TDCBDEGridEdit.SetInternalDataSet(const Value: TDataSet;
  6751.   var DataSet: TDataSet);
  6752. begin
  6753.   DataSet := Value;
  6754.   if FQuery.Active then FQuery.Close;
  6755.   if (FDataSet is TQuery) and not ListBoxEnabled then
  6756.   begin
  6757.     DatabaseName := TQuery(FDataSet).DatabaseName;
  6758.     SQLText      := TQuery(FDataSet).SQL.Text;
  6759.   end
  6760.   else
  6761.     if not FQueryDataSet then SQLText := '';
  6762.  
  6763.   if not FQueryDataSet then
  6764.   begin
  6765.     if (DataSet <> nil) and DataSet.Active then
  6766.       SetGridValues
  6767.     else if FValues.FLoaded then
  6768.     begin
  6769.       FValues.Clear;
  6770.       FValues.FLoaded := False;
  6771.     end;
  6772.   end
  6773. end;
  6774.  
  6775. procedure TDCBDEGridEdit.SetInternalSQLText(const Value: string;
  6776.   var SQLText: string);
  6777. begin
  6778.   if FQuery.Active then FQuery.Close;
  6779.   if Value <> '' then TQuery(FQuery).SQL.Text := SQLText;
  6780. end;
  6781.  
  6782. procedure TDCBDEGridEdit.SetParams(const Value: TParams);
  6783. begin
  6784.   TQuery(FQuery).Params.AssignValues(Value);
  6785. end;
  6786.  
  6787. procedure TDCCustomComboBox.DropDown;
  6788. begin
  6789.   if Assigned(FOnDropDown) then FOnDropDown(Self);
  6790. end;
  6791.  
  6792. { TDCCustomFormEdit }
  6793.  
  6794. procedure TDCCustomFormEdit.ChoiceClick(Sender: TObject);
  6795. begin
  6796.   inherited;
  6797.   if DropDownVisible then
  6798.     CloseUp(0, True)
  6799.   else
  6800.     Perform(CM_POPUPWINDOW, 1, 0);
  6801. end;
  6802.  
  6803. procedure TDCCustomFormEdit.CloseUp(State: Byte; bPerform: boolean);
  6804. begin
  6805.   case State of
  6806.      0:;
  6807.      1: if DropDownVisible then GetFormResult(FEditForm);
  6808.   end;
  6809.   inherited;
  6810. end;
  6811.  
  6812. procedure TDCCustomFormEdit.CMCancelMode(var Message: TCMCancelMode);
  6813. begin
  6814.   inherited;
  6815. end;
  6816.  
  6817. procedure TDCCustomFormEdit.CMPopupWindow(var Message: TMessage);
  6818. begin
  6819.   case Message.WParam of
  6820.     0:
  6821.      begin
  6822.        if DropDownVisible then
  6823.        begin
  6824.          WndProcAction(0);
  6825.          FEditForm.Hide;
  6826.        end;
  6827.        ShowHint  := FHintShow;
  6828.        ShowCaret(Handle);
  6829.      end;
  6830.     1:
  6831.      begin
  6832.        if FEditForm = nil then CreateEditForm(TCustomForm(FEditForm));
  6833.        if FEditForm <> nil then begin
  6834.          FHintShow  := ShowHint;
  6835.          ShowHint   := False;
  6836.          HideCaret(Handle);
  6837.          with TCustomEditForm(FEditForm) do
  6838.          begin
  6839.            BorderIcons := [];
  6840.            BevelKind   := bkNone;
  6841.            FormStyle   := fsStayOnTop;
  6842.          end;
  6843.          with FEditForm do
  6844.          begin
  6845.            Caption := DBObject.Caption;
  6846.            BorderStyle := bsSizeToolWin;
  6847.            with TCustomEditForm(FEditForm) do
  6848.            begin
  6849.              AutoScroll  := False;
  6850.            end;
  6851.            InitEditFromParams(FEditForm);
  6852.            ShowDropDown;
  6853.          end;
  6854.        end;
  6855.      end;
  6856.   end;
  6857. end;
  6858.  
  6859. constructor TDCCustomFormEdit.Create(AOwner: TComponent);
  6860. begin
  6861.   inherited;
  6862.   FEditForm := nil;
  6863.   {$IFDEF DELPHI_V6}
  6864.     FEFNewWndProc := Classes.MakeObjectInstance(EFWndProc);
  6865.     FPFNewWndProc := Classes.MakeObjectInstance(PFWndProc);
  6866.   {$ELSE}
  6867.     FEFNewWndProc := MakeObjectInstance(EFWndProc);
  6868.     FPFNewWndProc := MakeObjectInstance(PFWndProc);
  6869.   {$ENDIF}
  6870. end;
  6871.  
  6872. function TDCCustomFormEdit.CreateEditForm(var EditForm: TCustomForm): boolean;
  6873. begin
  6874.   if Assigned(FOnCreateEditForm) then FOnCreateEditForm(Self, EditForm);
  6875.   Result := EditForm <> nil;
  6876. end;
  6877.  
  6878. procedure TDCCustomFormEdit.DefineBtnChoiceStyle;
  6879. begin
  6880.   if BtnChoiceAssigned then
  6881.   begin
  6882.     ButtonStyle := esDropDown;
  6883.     ButtonChoiceStyle := btsCustom;
  6884.   end;
  6885. end;
  6886.  
  6887. destructor TDCCustomFormEdit.Destroy;
  6888. begin
  6889.   if (FEditForm <> nil) then
  6890.   begin
  6891.     FEditForm.Free;
  6892.     FEditForm := nil
  6893.   end;
  6894.   {$IFDEF DELPHI_V6}
  6895.     Classes.FreeObjectInstance(FEFNewWndProc);
  6896.     Classes.FreeObjectInstance(FPFNewWndProc);
  6897.   {$ELSE}
  6898.     FreeObjectInstance(FEFNewWndProc);
  6899.     FreeObjectInstance(FPFNewWndProc);
  6900.   {$ENDIF}
  6901.   inherited;
  6902. end;
  6903.  
  6904. function TDCCustomFormEdit.DropDownWindow(Message: TWMKillFocus): boolean;
  6905.  var
  6906.   Parent: HWND;
  6907. begin
  6908.   if FEditForm <> nil then
  6909.   begin
  6910.     Result := (Message.FocusedWnd = FEditForm.Handle) ;
  6911.     if not Result then
  6912.     begin
  6913.       Parent := GetParent(Message.FocusedWnd);
  6914.       while (Parent <> 0) do
  6915.       begin
  6916.         if Parent = FEditForm.Handle then
  6917.         begin
  6918.           Result := True;
  6919.           Exit;
  6920.         end;
  6921.         Parent := GetParent(Parent);
  6922.       end;
  6923.     end;
  6924.   end
  6925.   else
  6926.     Result := inherited DropDownWindow(Message);
  6927. end;
  6928.  
  6929. procedure TDCCustomFormEdit.EFWndProc(var Message: TMessage);
  6930.  var
  6931.   ParentForm: TCustomForm;
  6932.   ParentWnd: HWND;
  6933. begin
  6934.   try
  6935.     with Message do
  6936.     begin
  6937.       case Msg of
  6938.         CM_DEACTIVATE:
  6939.           begin
  6940.             ParentForm := GetParentForm(Self);
  6941.             if not((Screen.ActiveCustomForm = ParentForm) and (ParentForm <> nil) and
  6942.                    (ParentForm.ActiveControl = Self))
  6943.             then
  6944.                CloseUp(0, True);
  6945.             with FEditForm do if Visible then
  6946.               SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  6947.           end;
  6948.         CM_CLOSEUP: CloseUp(WParam, True);
  6949.         WM_KILLFOCUS:
  6950.            with TWMKillFocus(Message) do
  6951.              if (FocusedWnd <> Handle) and (FEditForm <> nil) then
  6952.              begin
  6953.                ParentWnd := GetParent(FocusedWnd);
  6954.                while (ParentWnd <> 0) and (ParentWnd <> FEditForm.Handle) do
  6955.                  ParentWnd := GetParent(ParentWnd);
  6956.                if ParentWnd = 0 then CloseUp(0, True);
  6957.              end;
  6958.       end;
  6959.       Result := CallWindowProc(FEFDefWndProc, FEditForm.Handle, Msg, WParam, LParam);
  6960.     end;
  6961.   except
  6962.     {}
  6963.   end;
  6964. end;
  6965.  
  6966. function TDCCustomFormEdit.GetDropDownVisible: boolean;
  6967. begin
  6968.   Result := (FEditForm <> nil) and (FEditForm.Visible);
  6969. end;
  6970.  
  6971. procedure TDCCustomFormEdit.GetFormResult(AEditForm: TCustomForm);
  6972. begin
  6973.   {}
  6974. end;
  6975.  
  6976. procedure TDCCustomFormEdit.InitEditFromParams(AEditForm: TCustomForm);
  6977.  var
  6978.   P: TPoint;
  6979. begin
  6980.   P := Point((ClientWidth - Width) div 2,
  6981.              ClientHeight + (Height - ClientHeight) shr 1);
  6982.   P := ClientToScreen(P);
  6983.   SetRectInDesktop(P, AEditForm.Width, AEditForm.Height,
  6984.      Point(0, (Screen.DesktopTop+Screen.DesktopHeight) - P.Y + Height));
  6985.  
  6986.   AEditForm.Left := P.X;
  6987.   AEditForm.Top  := P.Y;
  6988. end;
  6989.  
  6990. function TDCCustomChoiceEdit.DropDownWindow(Message: TWMKillFocus): boolean;
  6991. begin
  6992.   Result := False;
  6993. end;
  6994.  
  6995. procedure TDCCustomFormEdit.WndProcAction(Action: integer);
  6996.  var
  6997.   ParentForm: TCustomForm;
  6998. begin
  6999.   if (FEditForm <> nil) and not (csDesigning in ComponentState) then
  7000.   begin
  7001.     ParentForm := GetParentForm(Self);
  7002.     case Action of
  7003.       0:
  7004.         begin
  7005.           SetWindowLong(FEditForm.Handle, GWL_WNDPROC, LongInt(FEFDefWndProc));
  7006.           if (ParentForm <> nil) and ParentForm.HandleAllocated then
  7007.             SetWindowLong(ParentForm.Handle, GWL_WNDPROC, LongInt(FPFDefWndProc));
  7008.         end;
  7009.       1:
  7010.         begin
  7011.           FEFDefWndProc := Pointer(GetWindowLong(FEditForm.Handle, GWL_WNDPROC));
  7012.           SetWindowLong(FEditForm.Handle, GWL_WNDPROC, LongInt(FEFNewWndProc));
  7013.           if (ParentForm <> nil) and ParentForm.HandleAllocated then
  7014.           begin
  7015.             FPFDefWndProc := Pointer(GetWindowLong(ParentForm.Handle, GWL_WNDPROC));
  7016.             SetWindowLong(ParentForm.Handle, GWL_WNDPROC, LongInt(FPFNewWndProc));
  7017.           end;
  7018.         end;
  7019.     end;
  7020.   end;
  7021. end;
  7022.  
  7023. procedure TDCCustomFormEdit.PFWndProc(var Message: TMessage);
  7024.  var
  7025.   ParentForm: TCustomForm;
  7026. begin
  7027.   try
  7028.     ParentForm := GetParentForm(Self);
  7029.     with Message do
  7030.     begin
  7031.       case Msg of
  7032.         WM_NCLBUTTONDOWN:
  7033.           with TWMNCLButtonDown(Message) do begin
  7034.             if (HitTest = HTCAPTION) and not IsIconic(ParentForm.Handle) then CloseUp(0, True);
  7035.           end
  7036.       end;
  7037.       Result := CallWindowProc(FPFDefWndProc, ParentForm.Handle, Msg, WParam, LParam);
  7038.     end;
  7039.   except
  7040.     {}
  7041.   end;
  7042. end;
  7043.  
  7044. procedure TDCCustomFormEdit.SetInfoFieldWidth(const Value: integer);
  7045. begin
  7046.   if (Value >= 0) and (FInfoFieldWidth <> Value) then
  7047.   begin
  7048.     FInfoFieldWidth := Value;
  7049.     SetEditRect;
  7050.   end;
  7051. end;
  7052.  
  7053. procedure TDCCustomFormEdit.SetMargins(var LeftMargin,
  7054.   RightMargin: integer);
  7055.  var
  7056.   CharWidth: integer;
  7057. begin
  7058.   inherited;
  7059.   if ExistInfo and (RightMargin > 0) then
  7060.   begin
  7061.     RightMargin := RightMargin + FInfoFieldWidth;
  7062.     CharWidth := GetCharWidth(Handle, Font);
  7063.     if (ClientWidth - RightMargin - LeftMargin - CharWidth) < 0 then
  7064.       RightMargin := ClientWidth - LeftMargin - CharWidth;
  7065.   end;
  7066. end;
  7067.  
  7068. function TDCCustomFormEdit.ExistInfo: boolean;
  7069. begin
  7070.   Result := FInfoFieldWidth > 0;
  7071. end;
  7072.  
  7073. procedure TDCCustomFormEdit.DoDrawMargins(DC: HDC);
  7074.  var
  7075.   RightMargin: integer;
  7076.   R: TRect;
  7077.   OldPos: TPoint;
  7078.   Value: string;
  7079.   Pen: HPEN;
  7080.   Brush: HBRUSH;
  7081.   ADefault: boolean;
  7082. begin
  7083.   inherited;
  7084.   RightMargin := Width - FMargins.Right;
  7085.   if ExistInfo and (RightMargin > 0) then
  7086.   begin
  7087.     SelectObject(DC, Font.Handle);
  7088.     if not Enabled and not(csDesigning in ComponentState) then
  7089.       SetTextColor(DC, ColorToRGB(clInactiveCaption))
  7090.     else
  7091.       SetTextColor(DC, ColorToRGB(Font.Color));
  7092.     SetBkColor(DC, ColorToRGB(Color));
  7093.  
  7094.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  7095.  
  7096.     R.Left  := FMargins.Right + 2;
  7097.     R.Right := R.Right - GetButtonWidth - 2;
  7098.  
  7099.     case FDrawStyle of
  7100.       fsNone  :
  7101.        begin
  7102.          InflateRect(R, -1, -1);
  7103.          R.Left := R.Left -1;
  7104.        end;
  7105.       fsSingle  :
  7106.        InflateRect(R, -3, -3);
  7107.       fcsNormal,
  7108.       fsFlat  :
  7109.        InflateRect(R, -3, -3);
  7110.     end;
  7111.  
  7112.     ADefault := True;
  7113.     Value    := '';
  7114.  
  7115.     if Assigned(FOnDrawInfoText) then FOnDrawInfoText(Self, DC, R, Value, ADefault);
  7116.  
  7117.     if ADefault then
  7118.     begin
  7119.       if ColorToRGB(Color) = ColorToRGB(clBtnFace) then
  7120.         Pen := CreatePen(PS_SOLID, 1, ColorToRGB(clBtnShadow))
  7121.       else
  7122.         Pen := CreatePen(PS_SOLID, 1, ColorToRGB(clBtnFace));
  7123.       Brush := CreateSolidBrush(ColorToRGB(Color));
  7124.       try
  7125.         SelectObject(DC, Pen);
  7126.         MoveToEx(DC, R.Left, R.Top, @OldPos);
  7127.         LineTo(DC, R.Left, R.Bottom);
  7128.         R.Left := R.Left + 4;
  7129.         FillRect(DC, R, Brush);
  7130.         DrawText(DC, PChar(Value),  Length(Value), R, DT_LEFT);
  7131.       finally
  7132.         DeleteObject(Pen);
  7133.         DeleteObject(Brush);
  7134.       end
  7135.     end;
  7136.   end;
  7137. end;
  7138.  
  7139. procedure TDCCustomFormEdit.KeyDown(var Key: Word; Shift: TShiftState);
  7140.  var
  7141.   KeyDownEvent: TKeyEvent;
  7142. begin
  7143.   KeyDownEvent := OnKeyDown;
  7144.   if not DropDownVisible then
  7145.   begin
  7146.     if [ssAlt]*Shift = [ssAlt] then
  7147.     begin
  7148.       case Key of
  7149.         VK_DOWN:
  7150.           begin
  7151.             if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  7152.             if Key <> 0 then
  7153.             begin
  7154.               ChoiceButtonDown;
  7155.               Key := 0;
  7156.             end;
  7157.           end;
  7158.       end;
  7159.     end;
  7160.   end;
  7161.   if Key <> 0 then inherited;
  7162. end;
  7163.  
  7164. procedure TDCCustomFormEdit.KeyPress(var Key: Char);
  7165. begin
  7166.   if DropDownVisible then
  7167.   begin
  7168.     case Key of
  7169.       Char(VK_RETURN):
  7170.         begin
  7171.           CloseUp(1, True);
  7172.           if not PerformCloseUp then Key := #0;
  7173.         end;
  7174.       Char(VK_ESCAPE):
  7175.         begin
  7176.           CloseUp(0, True);
  7177.           Key := #0;
  7178.         end;
  7179.       else begin
  7180.         if Assigned(FEditForm) then TPrivateWinControl(FEditForm).KeyPress(Key);
  7181.       end;
  7182.     end;
  7183.   end;
  7184.   inherited KeyPress(Key);
  7185. end;
  7186.  
  7187. procedure TDCCustomFormEdit.ShowDropDown;
  7188. begin
  7189.   WndProcAction(1);
  7190.   FEditForm.Show;
  7191. end;
  7192.  
  7193. { TDCCustomMaskEdit }
  7194.  
  7195. procedure TDCCustomMaskEdit.CMTextChanged(var Message: TMessage);
  7196. begin
  7197.   inherited;
  7198.   if IsMasked and (Text = '') then CompleteChars;
  7199. end;
  7200.  
  7201. procedure TDCCustomMaskEdit.CompleteChars;
  7202.  var
  7203.   ASelStart, ASelEnd, MaskEnd: integer;
  7204.   S: string;
  7205. begin
  7206.   with FMaskStruct do
  7207.   begin
  7208.     ASelStart := SelStart;
  7209.     MaskEnd := 0;
  7210.     S := '';
  7211.     EMCompeteChar(S, FMaskStruct, MaskEnd, ASelStart, ASelEnd);
  7212.     Text := S;
  7213.     SetSel(ASelStart, ASelStart);
  7214.   end;
  7215. end;
  7216.  
  7217. procedure TDCCustomMaskEdit.DeleteKey(Key: Word);
  7218.  var
  7219.   S: string;
  7220.   ASelStart, ASelEnd, MaskEnd: integer;
  7221. begin
  7222.   if Key <> 0 then
  7223.   begin
  7224.     ASelStart := SelStart;
  7225.     ASelEnd   := 0;
  7226.     S := Text;
  7227.     if (Key = VK_DELETE) or (SelLength > 0) then
  7228.     begin
  7229.       MaskEnd := EMDeleteChar(S, FMaskStruct, SelStart, SelStart + SelLength);
  7230.       EMCompeteChar(S, FMaskStruct, MaskEnd, ASelStart, ASelEnd);
  7231.     end
  7232.     else if SelStart > 0 then begin
  7233.       MaskEnd := EMDeleteChar(S, FMaskStruct, SelStart - 1, SelStart);
  7234.       EMCompeteChar(S, FMaskStruct, MaskEnd, ASelStart, ASelEnd);
  7235.       EMClearSymbols(S, FMaskStruct, MaskEnd, ASelStart);
  7236.       Dec(ASelStart);
  7237.     end;
  7238.  
  7239.     Text := S;
  7240.     SetSel(ASelStart, ASelStart);
  7241.   end;
  7242. end;
  7243.  
  7244. destructor TDCCustomMaskEdit.Destroy;
  7245. begin
  7246.   if IsMasked then EMClear(FMaskStruct);
  7247.   inherited;
  7248. end;
  7249.  
  7250. procedure TDCCustomMaskEdit.EditMaskChanged;
  7251. begin
  7252.   Text := '';
  7253.   CompleteChars;
  7254. end;
  7255.  
  7256. procedure TDCCustomMaskEdit.GetHintOnError;
  7257. begin
  7258.   case FErrorCode of
  7259.     ERR_MASK_MATCH:
  7260.       FErrorHint := Format('%s /{%s/}',[LoadStr(RES_MASK_ERR_WRONG), FEditMask]);
  7261.   end;
  7262.   inherited;
  7263. end;
  7264.  
  7265. function TDCCustomMaskEdit.GetHintTimeOut: integer;
  7266. begin
  7267.   if FErrorCode = ERR_MASK_MATCH then
  7268.     Result := 4000
  7269.   else
  7270.     Result := inherited GetHintTimeOut;
  7271. end;
  7272.  
  7273. procedure TDCCustomMaskEdit.InsertString(Insert: string);
  7274.  var
  7275.   S: string;
  7276.   ASelStart, ASelEnd: integer;
  7277. begin
  7278.   ASelStart := SelStart;
  7279.   ASelEnd   := ASelStart + SelLength;
  7280.   S := Text;
  7281.   EMInsertChar(S, Insert, FMaskStruct, ASelStart, ASelEnd);
  7282.   Text := S;
  7283.   SelStart  := ASelStart;
  7284.   SelLength := 0;
  7285. end;
  7286.  
  7287. function TDCCustomMaskEdit.IsMasked: boolean;
  7288. begin
  7289.   Result := FMaskStruct.Count > 0;
  7290. end;
  7291.  
  7292. procedure TDCCustomMaskEdit.KeyDown(var Key: Word; Shift: TShiftState);
  7293.  var
  7294.   KeyDownEvent: TKeyEvent;
  7295. begin
  7296.   if Key = VK_DELETE then Perform(CM_ERRORMESSAGE, 0, 0);
  7297.   if IsMasked then
  7298.   begin
  7299.     KeyDownEvent := OnKeyDown;
  7300.     case Key of
  7301.       VK_DELETE, VK_BACK:
  7302.         if not ReadOnly then
  7303.         begin
  7304.           if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  7305.           DeleteKey(Key);
  7306.           Key := 0;
  7307.         end;
  7308.     end;
  7309.     if Key <> 0 then inherited;
  7310.   end
  7311.   else
  7312.     inherited
  7313. end;
  7314.  
  7315. procedure TDCCustomMaskEdit.KeyPress(var Key: Char);
  7316. begin
  7317.   if IsMasked and not ReadOnly then
  7318.   begin
  7319.     if (Key >= Chr(VK_SPACE)) then
  7320.     begin
  7321.       InsertString(string(Key));
  7322.       Key := #0;
  7323.     end;
  7324.     if Key = Chr(VK_BACK) then Key := #0;
  7325.   end;
  7326.   inherited;
  7327. end;
  7328.  
  7329. procedure TDCCustomMaskEdit.KillFocus(var Value: boolean);
  7330. begin
  7331.   if not Value and CanModified and not FCanEmpty and (Trim(Text) = '')
  7332.   then begin
  7333.     Value := True;
  7334.     FErrorCode := ERR_EDIT_EMPTYVALUE;
  7335.   end;
  7336.   if not Value and CanModified and (Trim(Text) <> '') and not MaskMatched then
  7337.   begin
  7338.     Value := True;
  7339.     FErrorCode := ERR_MASK_MATCH;
  7340.   end;
  7341.   inherited KillFocus(Value);
  7342. end;
  7343.  
  7344. function TDCCustomMaskEdit.MaskMatched: boolean;
  7345.  var
  7346.   MaskStart, SymbolsCount, MaskEnd: integer;
  7347.   AText: string;
  7348. begin
  7349.   if IsMasked then
  7350.   begin
  7351.    AText := Text;
  7352.    MaskStart := EMMatches(AText, FMaskStruct, False, SymbolsCount, True, MaskEnd);
  7353.    Result := MaskStart > -1;
  7354.    if Result and (CompareStr(Text, AText) <> 0) then Text := AText;
  7355.   end
  7356.   else
  7357.     Result := True;
  7358. end;
  7359.  
  7360. procedure TDCCustomMaskEdit.SetEditMask(const Value: string);
  7361. begin
  7362.   FEditMask := Value;
  7363.   EMInitStruct(Value, FMaskStruct);
  7364.   EditMaskChanged;
  7365. end;
  7366.  
  7367. procedure TDCCustomMaskEdit.SetSel(SelStart, SelEnd: Integer);
  7368. begin
  7369.   SendMessage(Handle, EM_SETSEL, SelStart, SelEnd);
  7370. end;
  7371.  
  7372. procedure TDCCustomMaskEdit.WMCut(var Message: TMessage);
  7373. begin
  7374.   if not IsMasked then
  7375.     inherited
  7376.   else
  7377.     DeleteKey(VK_DELETE);
  7378. end;
  7379.  
  7380. procedure TDCCustomMaskEdit.WMPaste(var Message: TMessage);
  7381.  var
  7382.   Value: string;
  7383. begin
  7384.   if not IsMasked then
  7385.     inherited
  7386.   else begin
  7387.     Clipboard.Open;
  7388.     Value := Clipboard.AsText;
  7389.     Clipboard.Close;
  7390.     InsertString(Value);
  7391.   end;
  7392. end;
  7393.  
  7394. procedure TDCCustomChoiceEdit.CMColorChanged(var Message: TMessage);
  7395. begin
  7396.   inherited;
  7397.   InvalidateRect(Handle, nil, True);
  7398. end;
  7399.  
  7400. procedure TDCCustomChoiceEdit.ShowDropDown;
  7401. begin
  7402.   {}
  7403. end;
  7404.  
  7405. procedure TDCCustomComboBox.ShowDropDown;
  7406. begin
  7407.   FListBox.Show;
  7408. end;
  7409.  
  7410. procedure TDCCustomChoiceEdit.SetWordWrap(const Value: Boolean);
  7411. begin
  7412.   if Value <> FWordWrap then
  7413.   begin
  7414.     FWordWrap := Value;
  7415.     RecreateWnd;
  7416.   end;
  7417. end;
  7418.  
  7419. initialization
  7420.   TempBitmap := TBitmap.Create;
  7421.  
  7422. finalization
  7423.   TempBitmap.Free;
  7424.  
  7425. end.
  7426.