home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / ToolEdit.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  72KB  |  2,611 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997, 1998 Master-Bank          }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit ToolEdit;
  11.  
  12. interface
  13.  
  14. {$I RX.INC}
  15.  
  16. uses Windows, RTLConsts, Variants, Classes,
  17.   StdCtrls, Controls, Messages, SysUtils, Forms, Graphics, Menus, Buttons,
  18.   Dialogs, RxCtrls, FileCtrl, Mask, DateUtil;
  19.  
  20. const
  21.   scAltDown = scAlt + vk_Down;
  22.   DefEditBtnWidth = 21;
  23.  
  24. type
  25. {$IFDEF WIN32}
  26.   TFileExt = type string;
  27. {$ENDIF}
  28.  
  29. { TPopupWindow }
  30.  
  31.   TCloseUpEvent = procedure (Sender: TObject; Accept: Boolean) of object;
  32.   TPopupAlign = (epaRight, epaLeft);
  33.  
  34.   TPopupWindow = class(TCustomControl)
  35.   private
  36.     FEditor: TWinControl;
  37.     FCloseUp: TCloseUpEvent;
  38.     procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
  39.   protected
  40.     procedure CreateParams(var Params: TCreateParams); override;
  41. {$IFDEF WIN32}
  42.     function GetValue: Variant; virtual; abstract;
  43.     procedure SetValue(const Value: Variant); virtual; abstract;
  44. {$ELSE}
  45.     procedure CreateWnd; override;
  46.     function GetValue: string; virtual; abstract;
  47.     procedure SetValue(const Value: string); virtual; abstract;
  48. {$ENDIF}
  49.     procedure InvalidateEditor;
  50.     procedure PopupMouseUp(Sender: TObject; Button: TMouseButton;
  51.       Shift: TShiftState; X, Y: Integer);
  52.     procedure CloseUp(Accept: Boolean); virtual;
  53.   public
  54.     constructor Create(AOwner: TComponent); override;
  55.     function GetPopupText: string; virtual;
  56.     procedure Hide;
  57.     procedure Show(Origin: TPoint);
  58.     property OnCloseUp: TCloseUpEvent read FCloseUp write FCloseUp;
  59.   end;
  60.  
  61. { TCustomComboEdit }
  62.  
  63.   TEditButton = class(TRxSpeedButton)
  64.   private
  65.     FNoAction: Boolean;
  66.   protected
  67.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  68.       X, Y: Integer); override;
  69. {$IFDEF WIN32}
  70.     procedure Paint; override;
  71. {$ENDIF WIN32}
  72.   public
  73.     constructor Create(AOwner: TComponent); override;
  74.     procedure Click; override;
  75.   end;
  76.  
  77.   TGlyphKind = (gkCustom, gkDefault, gkDropDown, gkEllipsis);
  78.  
  79.   TCustomComboEdit = class(TCustomMaskEdit)
  80.   private
  81.     FButton: TEditButton;
  82.     FBtnControl: TWinControl;
  83.     FOnButtonClick: TNotifyEvent;
  84.     FClickKey: TShortCut;
  85.     FReadOnly: Boolean;
  86.     FDirectInput: Boolean;
  87.     FAlwaysEnable: Boolean;
  88.     FAlignment: TAlignment;
  89.     FPopupVisible: Boolean;
  90.     FFocused: Boolean;
  91.     FPopupAlign: TPopupAlign;
  92.     FGlyphKind: TGlyphKind;
  93.     procedure SetEditRect;
  94.     procedure RecreateGlyph;
  95.     procedure UpdateBtnBounds;
  96.     procedure EditButtonClick(Sender: TObject);
  97.     function GetMinHeight: Integer;
  98.     function GetTextHeight: Integer;
  99.     procedure SetShowCaret;
  100.     function GetGlyph: TBitmap;
  101.     procedure SetGlyph(Value: TBitmap);
  102.     function GetPopupVisible: Boolean;
  103.     function GetNumGlyphs: TNumGlyphs;
  104.     procedure SetNumGlyphs(Value: TNumGlyphs);
  105.     function GetButtonWidth: Integer;
  106.     procedure SetButtonWidth(Value: Integer);
  107.     function GetButtonHint: string;
  108.     procedure SetButtonHint(const Value: string);
  109.     function GetDirectInput: Boolean;
  110.     procedure SetDirectInput(Value: Boolean);
  111.     procedure SetReadOnly(Value: Boolean);
  112.     procedure SetAlignment(Value: TAlignment);
  113.     function IsCustomGlyph: Boolean;
  114.     function BtnWidthStored: Boolean;
  115.     procedure SetGlyphKind(Value: TGlyphKind);
  116.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  117.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  118.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  119.     procedure CMEnter(var Message: TMessage); message CM_ENTER;
  120.     procedure CNCtlColor(var Message: TMessage); message
  121.       {$IFDEF WIN32} CN_CTLCOLOREDIT {$ELSE} CN_CTLCOLOR {$ENDIF};
  122.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  123.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  124.     procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
  125.     procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
  126.     procedure WMCut(var Message: TWMCut); message WM_CUT;
  127. {$IFDEF WIN32}
  128.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  129. {$ENDIF}
  130. {$IFDEF RX_D4}
  131.     procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
  132. {$ENDIF}
  133.   protected
  134.     FPopup: TCustomControl;
  135.     FDefNumGlyphs: TNumGlyphs;
  136.     function GetDefaultBitmap(var DestroyNeeded: Boolean): TBitmap; virtual;
  137.     procedure PopupDropDown(DisableEdit: Boolean); virtual;
  138.     procedure PopupCloseUp(Sender: TObject; Accept: Boolean);
  139.     procedure ShowPopup(Origin: TPoint); virtual;
  140.     procedure HidePopup; virtual;
  141.     procedure UpdatePopupVisible;
  142.     procedure DoChange;
  143. {$IFDEF WIN32}
  144.     function AcceptPopup(var Value: Variant): Boolean; virtual;
  145.     procedure AcceptValue(const Value: Variant); virtual;
  146.     procedure SetPopupValue(const Value: Variant); virtual;
  147.     function GetPopupValue: Variant; virtual;
  148. {$ELSE}
  149.     function AcceptPopup(var Value: string): Boolean; virtual;
  150.     procedure AcceptValue(const Value: string); virtual;
  151.     procedure SetPopupValue(const Value: string); virtual;
  152.     function GetPopupValue: string; virtual;
  153. {$ENDIF}
  154.     procedure Change; override;
  155.     procedure PopupChange; virtual;
  156.     procedure CreateParams(var Params: TCreateParams); override;
  157.     procedure CreateWnd; override;
  158.     function EditCanModify: Boolean; override;
  159.     function GetReadOnly: Boolean; virtual;
  160.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  161.     procedure KeyPress(var Key: Char); override;
  162.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  163.       X, Y: Integer); override;
  164.     procedure ButtonClick; dynamic;
  165.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  166.     property AlwaysEnable: Boolean read FAlwaysEnable write FAlwaysEnable default False;
  167.     property Button: TEditButton read FButton;
  168.     property ClickKey: TShortCut read FClickKey write FClickKey
  169.       default scAltDown;
  170.     property Glyph: TBitmap read GetGlyph write SetGlyph stored IsCustomGlyph;
  171.     property GlyphKind: TGlyphKind read FGlyphKind write SetGlyphKind default gkCustom;
  172.     property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth
  173.       stored BtnWidthStored;
  174.     property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs;
  175.     property ButtonHint: string read GetButtonHint write SetButtonHint;
  176.     property DirectInput: Boolean read GetDirectInput write SetDirectInput default True;
  177.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  178.     property PopupAlign: TPopupAlign read FPopupAlign write FPopupAlign default epaRight;
  179.     property PopupVisible: Boolean read GetPopupVisible;
  180.     property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
  181.   public
  182.     constructor Create(AOwner: TComponent); override;
  183.     destructor Destroy; override;
  184.     procedure DoClick;
  185.     procedure SelectAll;
  186.   end;
  187.  
  188. { TComboEdit }
  189.  
  190.   TComboEdit = class(TCustomComboEdit)
  191.   public
  192.     property Button;
  193.   published
  194.     property Alignment;
  195.     property AutoSelect;
  196.     property BorderStyle;
  197.     property ButtonHint;
  198.     property CharCase;
  199.     property ClickKey;
  200.     property Color;
  201.     property Ctl3D;
  202.     property DirectInput;
  203.     property DragCursor;
  204.     property DragMode;
  205.     property EditMask;
  206.     property Enabled;
  207.     property Font;
  208.     property GlyphKind;
  209.     { Ensure GlyphKind is published before Glyph and ButtonWidth }
  210.     property Glyph;
  211.     property ButtonWidth;
  212.     property HideSelection;
  213. {$IFDEF RX_D4}
  214.     property Anchors;
  215.     property BiDiMode;
  216.     property Constraints;
  217.     property DragKind;
  218.     property ParentBiDiMode;
  219. {$ENDIF}
  220. {$IFDEF WIN32}
  221.   {$IFNDEF VER90}
  222.     property ImeMode;
  223.     property ImeName;
  224.   {$ENDIF}
  225. {$ENDIF}
  226.     property MaxLength;
  227.     property NumGlyphs;
  228.     property OEMConvert;
  229.     property ParentColor;
  230.     property ParentCtl3D;
  231.     property ParentFont;
  232.     property ParentShowHint;
  233.     property PopupMenu;
  234.     property ReadOnly;
  235.     property ShowHint;
  236.     property TabOrder;
  237.     property TabStop;
  238.     property Text;
  239.     property Visible;
  240.     property OnButtonClick;
  241.     property OnChange;
  242.     property OnClick;
  243.     property OnDblClick;
  244.     property OnDragDrop;
  245.     property OnDragOver;
  246.     property OnEndDrag;
  247.     property OnEnter;
  248.     property OnExit;
  249.     property OnKeyDown;
  250.     property OnKeyPress;
  251.     property OnKeyUp;
  252.     property OnMouseDown;
  253.     property OnMouseMove;
  254.     property OnMouseUp;
  255. {$IFDEF WIN32}
  256.     property OnStartDrag;
  257. {$ENDIF}
  258. {$IFDEF RX_D5}
  259.     property OnContextPopup;
  260. {$ENDIF}
  261. {$IFDEF RX_D4}
  262.     property OnEndDock;
  263.     property OnStartDock;
  264. {$ENDIF}
  265.   end;
  266.  
  267. { TFileDirEdit }
  268. { The common parent of TFilenameEdit and TDirectoryEdit          }
  269. { For internal use only; it's not intended to be used separately }
  270.  
  271. {$IFNDEF WIN32}
  272. const
  273.   MaxFileLength = SizeOf(TFileName) - 1;
  274. {$ENDIF}
  275.  
  276. type
  277.   TExecOpenDialogEvent = procedure(Sender: TObject; var Name: string;
  278.     var Action: Boolean) of object;
  279.  
  280.   TFileDirEdit = class(TCustomComboEdit)
  281.   private
  282.     FErrMode: Cardinal;
  283.     FAcceptFiles: Boolean;
  284.     FMultipleDirs: Boolean;
  285.     FOnDropFiles: TNotifyEvent;
  286.     FOnBeforeDialog: TExecOpenDialogEvent;
  287.     FOnAfterDialog: TExecOpenDialogEvent;
  288.     procedure SetDragAccept(Value: Boolean);
  289.     procedure SetAcceptFiles(Value: Boolean);
  290.     procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  291.   protected
  292.     procedure CreateHandle; override;
  293.     procedure DestroyWindowHandle; override;
  294.     function GetDefaultBitmap(var DestroyNeeded: Boolean): TBitmap; override;
  295. {$IFDEF WIN32}
  296.     function GetLongName: string; virtual; abstract;
  297.     function GetShortName: string; virtual; abstract;
  298. {$ENDIF}
  299.     procedure DoAfterDialog(var FileName: string; var Action: Boolean); dynamic;
  300.     procedure DoBeforeDialog(var FileName: string; var Action: Boolean); dynamic;
  301.     procedure ReceptFileDir(const AFileName: string); virtual; abstract;
  302.     procedure ClearFileList; virtual;
  303.     procedure DisableSysErrors;
  304.     procedure EnableSysErrors;
  305.     property GlyphKind default gkDefault;
  306.     property MaxLength {$IFNDEF WIN32} default MaxFileLength {$ENDIF};
  307.   public
  308.     constructor Create(AOwner: TComponent); override;
  309. {$IFDEF WIN32}
  310.     property LongName: string read GetLongName;
  311.     property ShortName: string read GetShortName;
  312. {$ENDIF}
  313.   published
  314.     property AcceptFiles: Boolean read FAcceptFiles write SetAcceptFiles default False;
  315.     property OnBeforeDialog: TExecOpenDialogEvent read FOnBeforeDialog
  316.       write FOnBeforeDialog;
  317.     property OnAfterDialog: TExecOpenDialogEvent read FOnAfterDialog
  318.       write FOnAfterDialog;
  319.     property OnDropFiles: TNotifyEvent read FOnDropFiles write FOnDropFiles;
  320.     property OnButtonClick;
  321.   end;
  322.  
  323. { TFilenameEdit }
  324.  
  325.   TFileDialogKind = (dkOpen, dkSave {$IFDEF RX_D3}, dkOpenPicture,
  326.     dkSavePicture {$ENDIF});
  327.  
  328.   TFilenameEdit = class(TFileDirEdit)
  329.   private
  330.     FDialog: TOpenDialog;
  331.     FDialogKind: TFileDialogKind;
  332.     procedure CreateEditDialog;
  333.     function GetFileName: string;
  334.     function GetDefaultExt: TFileExt;
  335.     function GetFileEditStyle: TFileEditStyle;
  336.     function GetFilter: string;
  337.     function GetFilterIndex: Integer;
  338.     function GetInitialDir: string;
  339.     function GetHistoryList: TStrings;
  340.     function GetOptions: TOpenOptions;
  341.     function GetDialogTitle: string;
  342.     function GetDialogFiles: TStrings;
  343.     procedure SetDialogKind(Value: TFileDialogKind);
  344.     procedure SetFileName(const Value: string);
  345.     procedure SetDefaultExt(Value: TFileExt);
  346.     procedure SetFileEditStyle(Value: TFileEditStyle);
  347.     procedure SetFilter(const Value: string);
  348.     procedure SetFilterIndex(Value: Integer);
  349.     procedure SetInitialDir(const Value: string);
  350.     procedure SetHistoryList(Value: TStrings);
  351.     procedure SetOptions(Value: TOpenOptions);
  352.     procedure SetDialogTitle(const Value: string);
  353.     function IsCustomTitle: Boolean;
  354.     function IsCustomFilter: Boolean;
  355.   protected
  356.     procedure ButtonClick; override;
  357.     procedure ReceptFileDir(const AFileName: string); override;
  358.     procedure ClearFileList; override;
  359. {$IFDEF WIN32}
  360.     function GetLongName: string; override;
  361.     function GetShortName: string; override;
  362. {$ENDIF}
  363.   public
  364.     constructor Create(AOwner: TComponent); override;
  365.     property Dialog: TOpenDialog read FDialog;
  366.     property DialogFiles: TStrings read GetDialogFiles;
  367.   published
  368.     property DialogKind: TFileDialogKind read FDialogKind write SetDialogKind
  369.       default dkOpen;
  370.     property DefaultExt: TFileExt read GetDefaultExt write SetDefaultExt;
  371.     property FileEditStyle: TFileEditStyle read GetFileEditStyle write SetFileEditStyle
  372.       default fsEdit;
  373.     property FileName: string read GetFileName write SetFileName stored False;
  374.     property Filter: string read GetFilter write SetFilter stored IsCustomFilter;
  375.     property FilterIndex: Integer read GetFilterIndex write SetFilterIndex default 1;
  376.     property InitialDir: string read GetInitialDir write SetInitialDir;
  377.     property HistoryList: TStrings read GetHistoryList write SetHistoryList;
  378.     property DialogOptions: TOpenOptions read GetOptions write SetOptions
  379.       default [ofHideReadOnly];
  380.     property DialogTitle: string read GetDialogTitle write SetDialogTitle
  381.       stored IsCustomTitle;
  382.     property AutoSelect;
  383.     property ButtonHint;
  384.     property BorderStyle;
  385.     property CharCase;
  386.     property ClickKey;
  387.     property Color;
  388.     property Ctl3D;
  389.     property DirectInput;
  390.     property DragCursor;
  391.     property DragMode;
  392.     property EditMask;
  393.     property Enabled;
  394.     property Font;
  395.     property GlyphKind;
  396.     { Ensure GlyphKind is declared before Glyph and ButtonWidth }
  397.     property Glyph;
  398.     property ButtonWidth;
  399.     property HideSelection;
  400. {$IFDEF RX_D4}
  401.     property Anchors;
  402.     property BiDiMode;
  403.     property Constraints;
  404.     property DragKind;
  405.     property ParentBiDiMode;
  406. {$ENDIF}
  407. {$IFDEF WIN32}
  408.   {$IFNDEF VER90}
  409.     property ImeMode;
  410.     property ImeName;
  411.   {$ENDIF}
  412. {$ENDIF}
  413.     property NumGlyphs;
  414.     property ParentColor;
  415.     property ParentCtl3D;
  416.     property ParentFont;
  417.     property ParentShowHint;
  418.     property PopupMenu;
  419.     property ReadOnly;
  420.     property ShowHint;
  421.     property TabOrder;
  422.     property TabStop;
  423.     property Text;
  424.     property Visible;
  425.     property OnChange;
  426.     property OnClick;
  427.     property OnDblClick;
  428.     property OnDragDrop;
  429.     property OnDragOver;
  430.     property OnEndDrag;
  431.     property OnEnter;
  432.     property OnExit;
  433.     property OnKeyDown;
  434.     property OnKeyPress;
  435.     property OnKeyUp;
  436.     property OnMouseDown;
  437.     property OnMouseMove;
  438.     property OnMouseUp;
  439. {$IFDEF WIN32}
  440.     property OnStartDrag;
  441. {$ENDIF}
  442. {$IFDEF RX_D5}
  443.     property OnContextPopup;
  444. {$ENDIF}
  445. {$IFDEF RX_D4}
  446.     property OnEndDock;
  447.     property OnStartDock;
  448. {$ENDIF}
  449.   end;
  450.  
  451. { TDirectoryEdit }
  452.  
  453. {$IFDEF WIN32}
  454.   TDirDialogKind = (dkVCL, dkWin32);
  455. {$ENDIF}
  456.  
  457.   TDirectoryEdit = class(TFileDirEdit)
  458.   private
  459.     FOptions: TSelectDirOpts;
  460.     FInitialDir: string;
  461. {$IFDEF WIN32}
  462.     FDialogText: string;
  463.     FDialogKind: TDirDialogKind;
  464. {$ENDIF}
  465.   protected
  466.     procedure ButtonClick; override;
  467.     procedure ReceptFileDir(const AFileName: string); override;
  468. {$IFDEF WIN32}
  469.     function GetLongName: string; override;
  470.     function GetShortName: string; override;
  471. {$ENDIF}
  472.   public
  473.     constructor Create(AOwner: TComponent); override;
  474.   published
  475. {$IFDEF WIN32}
  476.     property DialogKind: TDirDialogKind read FDialogKind write FDialogKind
  477.       default dkVCL;
  478.     property DialogText: string read FDialogText write FDialogText;
  479. {$ENDIF}
  480.     property DialogOptions: TSelectDirOpts read FOptions write FOptions default [];
  481.     property InitialDir: string read FInitialDir write FInitialDir;
  482.     property MultipleDirs: Boolean read FMultipleDirs write FMultipleDirs default False;
  483.     property AutoSelect;
  484.     property ButtonHint;
  485.     property BorderStyle;
  486.     property CharCase;
  487.     property ClickKey;
  488.     property Color;
  489.     property Ctl3D;
  490.     property DirectInput;
  491.     property DragCursor;
  492.     property DragMode;
  493.     property EditMask;
  494.     property Enabled;
  495.     property Font;
  496.     property GlyphKind;
  497.     { Ensure GlyphKind is declared before Glyph and ButtonWidth }
  498.     property Glyph;
  499.     property NumGlyphs;
  500.     property ButtonWidth;
  501.     property HideSelection;
  502. {$IFDEF RX_D4}
  503.     property Anchors;
  504.     property BiDiMode;
  505.     property Constraints;
  506.     property DragKind;
  507.     property ParentBiDiMode;
  508. {$ENDIF}
  509. {$IFDEF WIN32}
  510.   {$IFNDEF VER90}
  511.     property ImeMode;
  512.     property ImeName;
  513.   {$ENDIF}
  514. {$ENDIF}
  515.     property ParentColor;
  516.     property ParentCtl3D;
  517.     property ParentFont;
  518.     property ParentShowHint;
  519.     property PopupMenu;
  520.     property ReadOnly;
  521.     property ShowHint;
  522.     property TabOrder;
  523.     property TabStop;
  524.     property Text;
  525.     property Visible;
  526.     property OnChange;
  527.     property OnClick;
  528.     property OnDblClick;
  529.     property OnDragDrop;
  530.     property OnDragOver;
  531.     property OnEndDrag;
  532.     property OnEnter;
  533.     property OnExit;
  534.     property OnKeyDown;
  535.     property OnKeyPress;
  536.     property OnKeyUp;
  537.     property OnMouseDown;
  538.     property OnMouseMove;
  539.     property OnMouseUp;
  540. {$IFDEF WIN32}
  541.     property OnStartDrag;
  542. {$ENDIF}
  543. {$IFDEF RX_D5}
  544.     property OnContextPopup;
  545. {$ENDIF}
  546. {$IFDEF RX_D4}
  547.     property OnEndDock;
  548.     property OnStartDock;
  549. {$ENDIF}
  550.   end;
  551.  
  552. { TCustomDateEdit }
  553.  
  554.   TCalendarStyle = (csPopup, csDialog);
  555.   TYearDigits = (dyDefault, dyFour, dyTwo);
  556.  
  557. const
  558. {$IFDEF DEFAULT_POPUP_CALENDAR}
  559.   dcsDefault = csPopup;
  560. {$ELSE}
  561.   dcsDefault = csDialog;
  562. {$ENDIF DEFAULT_POPUP_CALENDAR}
  563.  
  564. type
  565.   TExecDateDialog = procedure(Sender: TObject; var ADate: TDateTime;
  566.     var Action: Boolean) of object;
  567.  
  568.   TCustomDateEdit = class(TCustomComboEdit)
  569.   private
  570.     FTitle: PString;
  571.     FOnAcceptDate: TExecDateDialog;
  572.     FDefaultToday: Boolean;
  573.     FHooked: Boolean;
  574.     FPopupColor: TColor;
  575.     FCheckOnExit: Boolean;
  576.     FBlanksChar: Char;
  577.     FCalendarHints: TStrings;
  578.     FStartOfWeek: TDayOfWeekName;
  579.     FWeekends: TDaysOfWeek;
  580.     FWeekendColor: TColor;
  581.     FYearDigits: TYearDigits;
  582.     FDateFormat: string[10];
  583.     FFormatting: Boolean;
  584.     function GetDate: TDateTime;
  585.     procedure SetDate(Value: TDateTime);
  586.     procedure SetYearDigits(Value: TYearDigits);
  587.     function GetPopupColor: TColor;
  588.     procedure SetPopupColor(Value: TColor);
  589.     function GetDialogTitle: string;
  590.     procedure SetDialogTitle(const Value: string);
  591.     function IsCustomTitle: Boolean;
  592.     function GetCalendarStyle: TCalendarStyle;
  593.     procedure SetCalendarStyle(Value: TCalendarStyle);
  594.     procedure SetCalendarHints(Value: TStrings);
  595.     procedure CalendarHintsChanged(Sender: TObject);
  596.     procedure SetWeekendColor(Value: TColor);
  597.     procedure SetWeekends(Value: TDaysOfWeek);
  598.     procedure SetStartOfWeek(Value: TDayOfWeekName);
  599.     procedure SetBlanksChar(Value: Char);
  600.     function TextStored: Boolean;
  601.     function FourDigitYear: Boolean;
  602.     function FormatSettingsChange(var Message: TMessage): Boolean;
  603.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  604.   protected
  605.     procedure Change; override;
  606.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  607.     procedure KeyPress(var Key: Char); override;
  608.     procedure CreateWindowHandle(const Params: TCreateParams); override;
  609.     procedure DestroyWindowHandle; override;
  610. {$IFDEF WIN32}
  611.     function AcceptPopup(var Value: Variant): Boolean; override;
  612.     procedure AcceptValue(const Value: Variant); override;
  613.     procedure SetPopupValue(const Value: Variant); override;
  614. {$ELSE}
  615.     function AcceptPopup(var Value: string): Boolean; override;
  616. {$ENDIF}
  617.     function GetDateFormat: string;
  618.     procedure ApplyDate(Value: TDateTime); virtual;
  619.     function GetDefaultBitmap(var DestroyNeeded: Boolean): TBitmap; override;
  620.     procedure UpdateFormat;
  621.     procedure UpdatePopup;
  622.     procedure ButtonClick; override;
  623.     property BlanksChar: Char read FBlanksChar write SetBlanksChar default ' ';
  624.     property CalendarHints: TStrings read FCalendarHints write SetCalendarHints;
  625.     property CheckOnExit: Boolean read FCheckOnExit write FCheckOnExit default False;
  626.     property DefaultToday: Boolean read FDefaultToday write FDefaultToday
  627.       default False;
  628.     property DialogTitle: string read GetDialogTitle write SetDialogTitle
  629.       stored IsCustomTitle;
  630.     property EditMask stored False;
  631.     property Formatting: Boolean read FFormatting;
  632.     property GlyphKind default gkDefault;
  633.     property PopupColor: TColor read GetPopupColor write SetPopupColor
  634.       default clBtnFace;
  635.     property CalendarStyle: TCalendarStyle read GetCalendarStyle
  636.       write SetCalendarStyle default dcsDefault;
  637.     property StartOfWeek: TDayOfWeekName read FStartOfWeek write SetStartOfWeek default Mon;
  638.     property Weekends: TDaysOfWeek read FWeekends write SetWeekends default [Sun];
  639.     property WeekendColor: TColor read FWeekendColor write SetWeekendColor default clRed;
  640.     property YearDigits: TYearDigits read FYearDigits write SetYearDigits default dyDefault;
  641.     property OnAcceptDate: TExecDateDialog read FOnAcceptDate write FOnAcceptDate;
  642.     property MaxLength stored False;
  643.     property Text stored TextStored;
  644.   public
  645.     constructor Create(AOwner: TComponent); override;
  646.     destructor Destroy; override;
  647.     procedure CheckValidDate;
  648.     function GetDateMask: string;
  649.     procedure UpdateMask; virtual;
  650.     property Date: TDateTime read GetDate write SetDate;
  651.     property PopupVisible;
  652.   end;
  653.  
  654. { TDateEdit }
  655.  
  656.   TDateEdit = class(TCustomDateEdit)
  657.   public
  658.     constructor Create(AOwner: TComponent); override;
  659.     property EditMask;
  660.   published
  661.     property AutoSelect;
  662.     property BlanksChar;
  663.     property BorderStyle;
  664.     property ButtonHint;
  665.     property CalendarHints;
  666.     property CheckOnExit;
  667.     property ClickKey;
  668.     property Color;
  669.     property Ctl3D;
  670.     property DefaultToday;
  671.     property DialogTitle;
  672.     property DirectInput;
  673.     property DragCursor;
  674.     property DragMode;
  675.     property Enabled;
  676.     property Font;
  677.     property GlyphKind;
  678.     { Ensure GlyphKind is declared before Glyph and ButtonWidth }
  679.     property Glyph;
  680.     property ButtonWidth;
  681.     property HideSelection;
  682. {$IFDEF RX_D4}
  683.     property Anchors;
  684.     property BiDiMode;
  685.     property Constraints;
  686.     property DragKind;
  687.     property ParentBiDiMode;
  688. {$ENDIF}
  689. {$IFDEF WIN32}
  690.   {$IFNDEF VER90}
  691.     property ImeMode;
  692.     property ImeName;
  693.   {$ENDIF}
  694. {$ENDIF}
  695.     property MaxLength;
  696.     property NumGlyphs;
  697.     property ParentColor;
  698.     property ParentCtl3D;
  699.     property ParentFont;
  700.     property ParentShowHint;
  701.     property PopupAlign;
  702.     property PopupColor;
  703.     property PopupMenu;
  704.     property ReadOnly;
  705.     property ShowHint;
  706.     property CalendarStyle;
  707.     property StartOfWeek;
  708.     property Weekends;
  709.     property WeekendColor;
  710.     property YearDigits;
  711.     property TabOrder;
  712.     property TabStop;
  713.     property Text;
  714.     property Visible;
  715.     property OnAcceptDate;
  716.     property OnButtonClick;
  717.     property OnChange;
  718.     property OnClick;
  719.     property OnDblClick;
  720.     property OnDragDrop;
  721.     property OnDragOver;
  722.     property OnEndDrag;
  723.     property OnEnter;
  724.     property OnExit;
  725.     property OnKeyDown;
  726.     property OnKeyPress;
  727.     property OnKeyUp;
  728.     property OnMouseDown;
  729.     property OnMouseMove;
  730.     property OnMouseUp;
  731. {$IFDEF WIN32}
  732.     property OnStartDrag;
  733. {$ENDIF}
  734. {$IFDEF RX_D5}
  735.     property OnContextPopup;
  736. {$ENDIF}
  737. {$IFDEF RX_D4}
  738.     property OnEndDock;
  739.     property OnStartDock;
  740. {$ENDIF}
  741.   end;
  742.  
  743.   EComboEditError = class(Exception);
  744.  
  745. { Utility routines }
  746.  
  747. procedure DateFormatChanged;
  748.  
  749. function EditorTextMargins(Editor: TCustomComboEdit): TPoint;
  750. function PaintComboEdit(Editor: TCustomComboEdit; const AText: string;
  751.   AAlignment: TAlignment; StandardPaint: Boolean;
  752.   var ACanvas: TControlCanvas; var Message: TWMPaint): Boolean;
  753.  
  754. implementation
  755.  
  756. uses ShellAPI, Consts, {$IFDEF RX_D3} ExtDlgs, {$ENDIF} RXCConst, VCLUtils,
  757.   rxStrUtils, FileUtil, PickDate, MaxMin;
  758.  
  759. {$IFDEF WIN32}
  760.  {$R *.R32}
  761. {$ELSE}
  762.  {$R *.R16}
  763. {$ENDIF}
  764.  
  765. const
  766.   sFileBmp = 'FEDITBMP'; { Filename and directory editor button glyph }
  767.   sDateBmp = 'DEDITBMP'; { Date editor button glyph }
  768.  
  769. { Utility routines }
  770.  
  771. function EditorTextMargins(Editor: TCustomComboEdit): TPoint;
  772. var
  773.   DC: HDC;
  774.   SaveFont: HFont;
  775.   I: Integer;
  776.   SysMetrics, Metrics: TTextMetric;
  777. begin
  778.   with Editor do begin
  779. {$IFDEF WIN32}
  780.     if NewStyleControls then begin
  781.       if BorderStyle = bsNone then I := 0
  782.       else if Ctl3D then I := 1
  783.       else I := 2;
  784.       Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I;
  785.       Result.Y := I;
  786.     end
  787.     else begin
  788. {$ENDIF}
  789.       if BorderStyle = bsNone then I := 0
  790.       else begin
  791.         DC := GetDC(0);
  792.         GetTextMetrics(DC, SysMetrics);
  793.         SaveFont := SelectObject(DC, Font.Handle);
  794.         GetTextMetrics(DC, Metrics);
  795.         SelectObject(DC, SaveFont);
  796.         ReleaseDC(0, DC);
  797.         I := SysMetrics.tmHeight;
  798.         if I > Metrics.tmHeight then I := Metrics.tmHeight;
  799.         I := I div 4;
  800.       end;
  801.       Result.X := I;
  802.       Result.Y := I;
  803. {$IFDEF WIN32}
  804.     end;
  805. {$ENDIF}
  806.   end;
  807. end;
  808.  
  809. function PaintComboEdit(Editor: TCustomComboEdit; const AText: string;
  810.   AAlignment: TAlignment; StandardPaint: Boolean;
  811.   var ACanvas: TControlCanvas; var Message: TWMPaint): Boolean;
  812. var
  813.   AWidth, ALeft: Integer;
  814.   Margins: TPoint;
  815.   R: TRect;
  816.   DC: HDC;
  817.   PS: TPaintStruct;
  818.   S: string;
  819. {$IFDEF RX_D4}
  820.   ExStyle: DWORD;
  821. const
  822.   AlignStyle: array[Boolean, TAlignment] of DWORD =
  823.    ((WS_EX_LEFT, WS_EX_RIGHT, WS_EX_LEFT),
  824.     (WS_EX_RIGHT, WS_EX_LEFT, WS_EX_LEFT));
  825. {$ENDIF}
  826. begin
  827.   Result := True;
  828.   with Editor do begin
  829. {$IFDEF RX_D4}
  830.     if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
  831. {$ENDIF}
  832.     if StandardPaint {$IFDEF WIN32} and not
  833.       (csPaintCopy in ControlState) {$ENDIF} then
  834.     begin
  835. {$IFDEF RX_D4}
  836.       if SysLocale.MiddleEast and HandleAllocated and (IsRightToLeft) then
  837.       begin { This keeps the right aligned text, right aligned }
  838.         ExStyle := DWORD(GetWindowLong(Handle, GWL_EXSTYLE)) and (not WS_EX_RIGHT) and
  839.           (not WS_EX_RTLREADING) and (not WS_EX_LEFTSCROLLBAR);
  840.         if UseRightToLeftReading then
  841.           ExStyle := ExStyle or WS_EX_RTLREADING;
  842.         if UseRightToLeftScrollbar then
  843.           ExStyle := ExStyle or WS_EX_LEFTSCROLLBAR;
  844.         ExStyle := ExStyle or
  845.           AlignStyle[UseRightToLeftAlignment, AAlignment];
  846.         if DWORD(GetWindowLong(Handle, GWL_EXSTYLE)) <> ExStyle then
  847.           SetWindowLong(Handle, GWL_EXSTYLE, ExStyle);
  848.       end;
  849. {$ENDIF RX_D4}
  850.       Result := False;
  851.       { return false if we need to use standard paint handler }
  852.       Exit;
  853.     end;
  854.     { Since edit controls do not handle justification unless multi-line (and
  855.       then only poorly) we will draw right and center justify manually unless
  856.       the edit has the focus. }
  857.     if ACanvas = nil then begin
  858.       ACanvas := TControlCanvas.Create;
  859.       ACanvas.Control := Editor;
  860.     end;
  861.     DC := Message.DC;
  862.     if DC = 0 then DC := BeginPaint(Handle, PS);
  863.     ACanvas.Handle := DC;
  864.     try
  865.       ACanvas.Font := Font;
  866.       if not Enabled and NewStyleControls and not
  867.         (csDesigning in ComponentState) and
  868.         (ColorToRGB(Color) <> ColorToRGB(clGrayText)) then
  869.         ACanvas.Font.Color := clGrayText;
  870.       with ACanvas do begin
  871.         R := ClientRect;
  872.         if {$IFDEF WIN32} not (NewStyleControls and Ctl3D) and {$ENDIF}
  873.           (BorderStyle = bsSingle) then
  874.         begin
  875.           Brush.Color := clWindowFrame;
  876.           FrameRect(R);
  877.           InflateRect(R, -1, -1);
  878.         end;
  879.         Brush.Color := Color;
  880.         S := AText;
  881.         AWidth := TextWidth(S);
  882.         Margins := EditorTextMargins(Editor);
  883.         if PopupVisible then ALeft := Margins.X
  884.         else begin
  885.           if ButtonWidth > 0 then Inc(AWidth);
  886.           case AAlignment of
  887.             taLeftJustify:
  888.               ALeft := Margins.X;
  889.             taRightJustify:
  890.               ALeft := ClientWidth - ButtonWidth - AWidth - Margins.X - 2;
  891.             else
  892.               ALeft := (ClientWidth - ButtonWidth - AWidth) div 2;
  893.           end;
  894.         end;
  895. {$IFDEF RX_D4}
  896.         if SysLocale.MiddleEast then UpdateTextFlags;
  897. {$ENDIF}
  898.         TextRect(R, ALeft, Margins.Y, S);
  899.       end;
  900.     finally
  901.       ACanvas.Handle := 0;
  902.       if Message.DC = 0 then EndPaint(Handle, PS);
  903.     end;
  904.   end;
  905. end;
  906.  
  907. { TEditButton }
  908.  
  909. constructor TEditButton.Create(AOwner: TComponent);
  910. begin
  911.   inherited Create(AOwner);
  912. {$IFDEF WIN32}
  913.   ControlStyle := ControlStyle + [csReplicatable];
  914. {$ELSE}
  915.   Style := bsWin31;
  916. {$ENDIF}
  917.   ParentShowHint := True;
  918. end;
  919.  
  920. {$IFDEF WIN32}
  921.  
  922. procedure TEditButton.Paint;
  923. begin
  924.   inherited Paint;
  925.   if (FState <> rbsDown) then
  926.     with Canvas do begin
  927.       if NewStyleControls then Pen.Color := clBtnFace
  928.       else Pen.Color := clBtnShadow;
  929.       MoveTo(0, 0);
  930.       LineTo(0, Self.Height - 1);
  931.       Pen.Color := clBtnHighlight;
  932.       MoveTo(1, 1);
  933.       LineTo(1, Self.Height - 2);
  934.     end;
  935. end;
  936.  
  937. {$ENDIF WIN32}
  938.  
  939. procedure TEditButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  940.   X, Y: Integer);
  941. begin
  942.   if (Button = mbLeft) then
  943.     with TCustomComboEdit(Owner) do begin
  944.       FNoAction := (FPopup <> nil) and FPopupVisible;
  945.       if not FPopupVisible then begin
  946.         if TabStop and CanFocus and (GetFocus <> Handle) then SetFocus;
  947.       end
  948.       else PopupCloseUp(FPopup, True);
  949.     end;
  950.   inherited MouseDown(Button, Shift, X, Y);
  951. end;
  952.  
  953. procedure TEditButton.Click;
  954. begin
  955.   if not FNoAction then inherited Click else FNoAction := False;
  956. end;
  957.  
  958. { TPopupWindow }
  959.  
  960. constructor TPopupWindow.Create(AOwner: TComponent);
  961. begin
  962.   inherited Create(AOwner);
  963.   FEditor := TWinControl(AOwner);
  964. {$IFDEF WIN32}
  965.   ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
  966.     csAcceptsControls];
  967. {$ELSE}
  968.   ControlStyle := ControlStyle + [csAcceptsControls];
  969. {$ENDIF}
  970.   Ctl3D := False;
  971.   ParentCtl3D := False;
  972.   Visible := False;
  973.   Parent := FEditor;
  974.   OnMouseUp := PopupMouseUp;
  975. end;
  976.  
  977. procedure TPopupWindow.CreateParams(var Params: TCreateParams);
  978. begin
  979.   inherited CreateParams(Params);
  980.   with Params do begin
  981.     Style := WS_POPUP or WS_BORDER or WS_CLIPCHILDREN;
  982. {$IFDEF WIN32}
  983.     ExStyle := WS_EX_TOOLWINDOW;
  984. {$ENDIF}
  985.     WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
  986.   end;
  987. end;
  988.  
  989. {$IFNDEF WIN32}
  990. procedure TPopupWindow.CreateWnd;
  991. begin
  992.   inherited CreateWnd;
  993.   if (csDesigning in ComponentState) then SetParent(nil);
  994. end;
  995. {$ENDIF}
  996.  
  997. procedure TPopupWindow.WMMouseActivate(var Message: TMessage);
  998. begin
  999.   Message.Result := MA_NOACTIVATE;
  1000. end;
  1001.  
  1002. function TPopupWindow.GetPopupText: string;
  1003. begin
  1004.   Result := '';
  1005. end;
  1006.  
  1007. procedure TPopupWindow.InvalidateEditor;
  1008. var
  1009.   R: TRect;
  1010. begin
  1011.   if (FEditor is TCustomComboEdit) then begin
  1012.     with TCustomComboEdit(FEditor) do
  1013.       SetRect(R, 0, 0, ClientWidth - FBtnControl.Width - 2, ClientHeight + 1);
  1014.   end
  1015.   else R := FEditor.ClientRect;
  1016.   InvalidateRect(FEditor.Handle, @R, False);
  1017.   UpdateWindow(FEditor.Handle);
  1018. end;
  1019.  
  1020. procedure TPopupWindow.PopupMouseUp(Sender: TObject; Button: TMouseButton;
  1021.   Shift: TShiftState; X, Y: Integer);
  1022. begin
  1023.   if Button = mbLeft then CloseUp(PtInRect(Self.ClientRect, Point(X, Y)));
  1024. end;
  1025.  
  1026. procedure TPopupWindow.CloseUp(Accept: Boolean);
  1027. begin
  1028.   if Assigned(FCloseUp) then FCloseUp(Self, Accept);
  1029. end;
  1030.  
  1031. procedure TPopupWindow.Hide;
  1032. begin
  1033.   SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
  1034.     SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
  1035.   Visible := False;
  1036. end;
  1037.  
  1038. procedure TPopupWindow.Show(Origin: TPoint);
  1039. begin
  1040.   SetWindowPos(Handle, HWND_TOP, Origin.X, Origin.Y, 0, 0,
  1041.     SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);
  1042.   Visible := True;
  1043. end;
  1044.  
  1045. { TCustomComboEdit }
  1046.  
  1047. constructor TCustomComboEdit.Create(AOwner: TComponent);
  1048. begin
  1049.   inherited Create(AOwner);
  1050. {$IFDEF RX_D3}
  1051.   ControlStyle := ControlStyle + [csCaptureMouse];
  1052. {$ENDIF}
  1053.   AutoSize := False;
  1054.   FDirectInput := True;
  1055.   FClickKey := scAltDown;
  1056.   FPopupAlign := epaRight;
  1057.   FBtnControl := TWinControl.Create(Self);
  1058. {$IFDEF WIN32}
  1059.   with FBtnControl do
  1060.     ControlStyle := ControlStyle + [csReplicatable];
  1061. {$ENDIF}
  1062.   FBtnControl.Width := DefEditBtnWidth;
  1063.   FBtnControl.Height := 17;
  1064.   FBtnControl.Visible := True;
  1065.   FBtnControl.Parent := Self;
  1066.   FButton := TEditButton.Create(Self);
  1067.   FButton.SetBounds(0, 0, FBtnControl.Width, FBtnControl.Height);
  1068.   FButton.Visible := True;
  1069.   FButton.Parent := FBtnControl;
  1070.   TEditButton(FButton).OnClick := EditButtonClick;
  1071.   Height := 21;
  1072.   FDefNumGlyphs := 1;
  1073.   FGlyphKind := gkCustom;
  1074. end;
  1075.  
  1076. destructor TCustomComboEdit.Destroy;
  1077. begin
  1078.   FButton.OnClick := nil;
  1079.   inherited Destroy;
  1080. end;
  1081.  
  1082. procedure TCustomComboEdit.CreateParams(var Params: TCreateParams);
  1083. const
  1084.   Alignments: array[TAlignment] of Longword = (ES_LEFT, ES_RIGHT, ES_CENTER);
  1085. begin
  1086.   inherited CreateParams(Params);
  1087.   Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN
  1088.     or Alignments[FAlignment];
  1089. end;
  1090.  
  1091. procedure TCustomComboEdit.CreateWnd;
  1092. begin
  1093.   inherited CreateWnd;
  1094.   SetEditRect;
  1095. end;
  1096.  
  1097. procedure TCustomComboEdit.HidePopup;
  1098. begin
  1099.   TPopupWindow(FPopup).Hide;
  1100. end;
  1101.  
  1102. procedure TCustomComboEdit.ShowPopup(Origin: TPoint);
  1103. begin
  1104.   TPopupWindow(FPopup).Show(Origin);
  1105. end;
  1106.  
  1107. procedure TCustomComboEdit.PopupDropDown(DisableEdit: Boolean);
  1108. var
  1109.   P: TPoint;
  1110.   Y: Integer;
  1111. begin
  1112.   if (FPopup <> nil) and not (ReadOnly or FPopupVisible) then begin
  1113.     P := Parent.ClientToScreen(Point(Left, Top));
  1114.     Y := P.Y + Height;
  1115.     if Y + FPopup.Height > Screen.Height then
  1116.       Y := P.Y - FPopup.Height;
  1117.     case FPopupAlign of
  1118.       epaRight:
  1119.         begin
  1120.           Dec(P.X, FPopup.Width - Width);
  1121.           if P.X < 0 then Inc(P.X, FPopup.Width - Width);
  1122.         end;
  1123.       epaLeft:
  1124.         begin
  1125.           if P.X + FPopup.Width > Screen.Width then
  1126.             Dec(P.X, FPopup.Width - Width);
  1127.         end;
  1128.     end;
  1129.     if P.X < 0 then P.X := 0
  1130.     else if P.X + FPopup.Width > Screen.Width then
  1131.       P.X := Screen.Width - FPopup.Width;
  1132. {$IFDEF WIN32}
  1133.     if Text <> '' then SetPopupValue(Text)
  1134.     else SetPopupValue(Null);
  1135. {$ELSE}
  1136.     SetPopupValue(Text);
  1137. {$ENDIF}
  1138.     if CanFocus then SetFocus;
  1139.     ShowPopup(Point(P.X, Y));
  1140.     FPopupVisible := True;
  1141.     if DisableEdit then begin
  1142.       inherited ReadOnly := True;
  1143.       HideCaret(Handle);
  1144.     end;
  1145.   end;
  1146. end;
  1147.  
  1148. procedure TCustomComboEdit.PopupCloseUp(Sender: TObject; Accept: Boolean);
  1149. var
  1150. {$IFDEF WIN32}
  1151.   AValue: Variant;
  1152. {$ELSE}
  1153.   AValue: string;
  1154. {$ENDIF}
  1155. begin
  1156.   if (FPopup <> nil) and FPopupVisible then begin
  1157.     if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  1158.     AValue := GetPopupValue;
  1159.     HidePopup;
  1160.     try
  1161.       try
  1162.         if CanFocus then begin
  1163.           SetFocus;
  1164.           if GetFocus = Handle then SetShowCaret;
  1165.         end;
  1166.       except
  1167.         { ignore exceptions }
  1168.       end;
  1169.       SetDirectInput(DirectInput);
  1170.       Invalidate;
  1171.       if Accept and AcceptPopup(AValue) and EditCanModify then begin
  1172.         AcceptValue(AValue);
  1173.         if FFocused then inherited SelectAll;
  1174.       end;
  1175.     finally
  1176.       FPopupVisible := False;
  1177.     end;
  1178.   end;
  1179. end;
  1180.  
  1181. procedure TCustomComboEdit.DoChange;
  1182. begin
  1183.   inherited Change;
  1184. end;
  1185.  
  1186. {$IFDEF WIN32}
  1187. function TCustomComboEdit.GetPopupValue: Variant;
  1188. {$ELSE}
  1189. function TCustomComboEdit.GetPopupValue: string;
  1190. {$ENDIF}
  1191. begin
  1192.   if FPopup <> nil then Result := TPopupWindow(FPopup).GetValue
  1193.   else Result := '';
  1194. end;
  1195.  
  1196. {$IFDEF WIN32}
  1197. procedure TCustomComboEdit.SetPopupValue(const Value: Variant);
  1198. {$ELSE}
  1199. procedure TCustomComboEdit.SetPopupValue(const Value: string);
  1200. {$ENDIF}
  1201. begin
  1202.   if FPopup <> nil then TPopupWindow(FPopup).SetValue(Value);
  1203. end;
  1204.  
  1205. {$IFDEF WIN32}
  1206. procedure TCustomComboEdit.AcceptValue(const Value: Variant);
  1207. begin
  1208.   if Text <> VarToStr(Value) then begin
  1209. {$ELSE}
  1210. procedure TCustomComboEdit.AcceptValue(const Value: string);
  1211. begin
  1212.   if Text <> Value then begin
  1213. {$ENDIF}
  1214.     Text := Value;
  1215.     Modified := True;
  1216.     UpdatePopupVisible;
  1217.     DoChange;
  1218.   end;
  1219. end;
  1220.  
  1221. {$IFDEF WIN32}
  1222. function TCustomComboEdit.AcceptPopup(var Value: Variant): Boolean;
  1223. {$ELSE}
  1224. function TCustomComboEdit.AcceptPopup(var Value: string): Boolean;
  1225. {$ENDIF}
  1226. begin
  1227.   Result := True;
  1228. end;
  1229.  
  1230. function TCustomComboEdit.EditCanModify: Boolean;
  1231. begin
  1232.   Result := not FReadOnly;
  1233. end;
  1234.  
  1235. procedure TCustomComboEdit.Change;
  1236. begin
  1237.   if not PopupVisible then DoChange
  1238.   else PopupChange;
  1239. end;
  1240.  
  1241. procedure TCustomComboEdit.PopupChange;
  1242. begin
  1243. end;
  1244.  
  1245. procedure TCustomComboEdit.KeyDown(var Key: Word; Shift: TShiftState);
  1246. begin
  1247.   inherited KeyDown(Key, Shift);
  1248.   if (FClickKey = ShortCut(Key, Shift)) and (ButtonWidth > 0) then begin
  1249.     EditButtonClick(Self);
  1250.     Key := 0;
  1251.   end;
  1252. end;
  1253.  
  1254. procedure TCustomComboEdit.KeyPress(var Key: Char);
  1255. begin
  1256.   if (Key = Char(VK_RETURN)) or (Key = Char(VK_ESCAPE)) then
  1257.   begin
  1258.     if PopupVisible then begin
  1259.       PopupCloseUp(FPopup, Key = Char(VK_RETURN));
  1260.       Key := #0;
  1261.     end
  1262.     else begin
  1263.       { must catch and remove this, since is actually multi-line }
  1264.       GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
  1265.       if Key = Char(VK_RETURN) then begin
  1266.         inherited KeyPress(Key);
  1267.         Key := #0;
  1268.         Exit;
  1269.       end;
  1270.     end;
  1271.   end;
  1272.   inherited KeyPress(Key);
  1273. end;
  1274.  
  1275. procedure TCustomComboEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
  1276.   X, Y: Integer);
  1277. begin
  1278.   if (FPopup <> nil) and (Button = mbLeft) then begin
  1279.     if CanFocus then SetFocus;
  1280.     if not FFocused then Exit;
  1281.     if FPopupVisible then PopupCloseUp(FPopup, False);
  1282.     {else if (not ReadOnly or AlwaysEnable) and (not DirectInput) then
  1283.       PopupDropDown(True);}
  1284.   end;
  1285.   inherited MouseDown(Button, Shift, X, Y);
  1286. end;
  1287.  
  1288. function TCustomComboEdit.GetButtonWidth: Integer;
  1289. begin
  1290.   Result := FButton.Width;
  1291. end;
  1292.  
  1293. procedure TCustomComboEdit.SetButtonWidth(Value: Integer);
  1294. begin
  1295.   if ButtonWidth <> Value then begin
  1296.     FBtnControl.Visible := Value > 1;
  1297.     if (csCreating in ControlState) then begin
  1298.       FBtnControl.Width := Value;
  1299.       FButton.Width := Value;
  1300.       with FButton do
  1301.         ControlStyle := ControlStyle - [csFixedWidth];
  1302.       RecreateGlyph;
  1303.     end
  1304.     else if (Value <> ButtonWidth) and (Value < ClientWidth) then begin
  1305.       FButton.Width := Value;
  1306.       with FButton do
  1307.         ControlStyle := ControlStyle - [csFixedWidth];
  1308.       if HandleAllocated then RecreateWnd;
  1309.       RecreateGlyph;
  1310.     end;
  1311.   end;
  1312. end;
  1313.  
  1314. function TCustomComboEdit.GetButtonHint: string;
  1315. begin
  1316.   Result := FButton.Hint;
  1317. end;
  1318.  
  1319. procedure TCustomComboEdit.SetButtonHint(const Value: string);
  1320. begin
  1321.   FButton.Hint := Value;
  1322. end;
  1323.  
  1324. function TCustomComboEdit.GetGlyph: TBitmap;
  1325. begin
  1326.   Result := FButton.Glyph;
  1327. end;
  1328.  
  1329. procedure TCustomComboEdit.SetGlyph(Value: TBitmap);
  1330. begin
  1331.   FButton.Glyph := Value;
  1332.   FGlyphKind := gkCustom;
  1333. end;
  1334.  
  1335. function TCustomComboEdit.GetNumGlyphs: TNumGlyphs;
  1336. begin
  1337.   Result := FButton.NumGlyphs;
  1338. end;
  1339.  
  1340. procedure TCustomComboEdit.SetNumGlyphs(Value: TNumGlyphs);
  1341. begin
  1342.   if FGlyphKind in [gkDropDown, gkEllipsis] then FButton.NumGlyphs := 1
  1343.   else if FGlyphKind = gkDefault then FButton.NumGlyphs := FDefNumGlyphs
  1344.   else FButton.NumGlyphs := Value;
  1345. end;
  1346.  
  1347. procedure TCustomComboEdit.SetEditRect;
  1348. var
  1349.   Loc: TRect;
  1350. begin
  1351.   SetRect(Loc, 0, 0, ClientWidth - FBtnControl.Width - 2, ClientHeight + 1);
  1352.   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
  1353. end;
  1354.  
  1355. procedure TCustomComboEdit.UpdateBtnBounds;
  1356. var
  1357.   BtnRect: TRect;
  1358. begin
  1359. {$IFDEF WIN32}
  1360.   if NewStyleControls then begin
  1361.     if Ctl3D and (BorderStyle = bsSingle) then
  1362.       BtnRect := Bounds(Width - FButton.Width - 4, 0,
  1363.         FButton.Width, Height - 4)
  1364.     else begin
  1365.       if BorderStyle = bsSingle then
  1366.         BtnRect := Bounds(Width - FButton.Width - 2, 2,
  1367.           FButton.Width, Height - 4)
  1368.       else
  1369.         BtnRect := Bounds(Width - FButton.Width, 0,
  1370.           FButton.Width, Height);
  1371.     end;
  1372.   end
  1373.   else
  1374.     BtnRect := Bounds(Width - FButton.Width, 0, FButton.Width, Height);
  1375. {$ELSE}
  1376.   BtnRect := Bounds(Width - FButton.Width, 0, FButton.Width, Height);
  1377. {$ENDIF}
  1378.   with BtnRect do
  1379.     FBtnControl.SetBounds(Left, Top, Right - Left, Bottom - Top);
  1380.   FButton.Height := FBtnControl.Height;
  1381.   SetEditRect;
  1382. end;
  1383.  
  1384. {$IFDEF WIN32}
  1385. procedure TCustomComboEdit.CMCtl3DChanged(var Message: TMessage);
  1386. begin
  1387.   inherited;
  1388.   UpdateBtnBounds;
  1389. end;
  1390. {$ENDIF}
  1391.  
  1392. procedure TCustomComboEdit.WMSize(var Message: TWMSize);
  1393. var
  1394.   MinHeight: Integer;
  1395. begin
  1396.   inherited;
  1397.   if not (csLoading in ComponentState) then begin
  1398.     MinHeight := GetMinHeight;
  1399.     { text edit bug: if size to less than MinHeight, then edit ctrl does
  1400.       not display the text }
  1401.     if Height < MinHeight then begin
  1402.       Height := MinHeight;
  1403.       Exit;
  1404.     end;
  1405.   end
  1406.   else begin
  1407.     if (FPopup <> nil) and (csDesigning in ComponentState) then
  1408.       FPopup.SetBounds(0, Height + 1, 10, 10);
  1409.   end;
  1410.   UpdateBtnBounds;
  1411. end;
  1412.  
  1413. function TCustomComboEdit.GetTextHeight: Integer;
  1414. var
  1415.   DC: HDC;
  1416.   SaveFont: HFont;
  1417.   SysMetrics, Metrics: TTextMetric;
  1418. begin
  1419.   DC := GetDC(0);
  1420.   try
  1421.     GetTextMetrics(DC, SysMetrics);
  1422.     SaveFont := SelectObject(DC, Font.Handle);
  1423.     GetTextMetrics(DC, Metrics);
  1424.     SelectObject(DC, SaveFont);
  1425.   finally
  1426.     ReleaseDC(0, DC);
  1427.   end;
  1428.   Result := Min(SysMetrics.tmHeight, Metrics.tmHeight);
  1429. end;
  1430.  
  1431. function TCustomComboEdit.GetMinHeight: Integer;
  1432. var
  1433.   I: Integer;
  1434. begin
  1435.   I := GetTextHeight;
  1436.   Result := I + GetSystemMetrics(SM_CYBORDER) * 4 +
  1437.     1 {$IFNDEF WIN32} + (I div 4) {$ENDIF};
  1438. end;
  1439.  
  1440. procedure TCustomComboEdit.UpdatePopupVisible;
  1441. begin
  1442.   FPopupVisible := (FPopup <> nil) and FPopup.Visible;
  1443. end;
  1444.  
  1445. function TCustomComboEdit.GetPopupVisible: Boolean;
  1446. begin
  1447.   Result := (FPopup <> nil) and FPopupVisible;
  1448. end;
  1449.  
  1450. procedure TCustomComboEdit.CMFontChanged(var Message: TMessage);
  1451. begin
  1452.   inherited;
  1453.   if HandleAllocated then SetEditRect;
  1454. end;
  1455.  
  1456. procedure TCustomComboEdit.CMEnabledChanged(var Message: TMessage);
  1457. begin
  1458.   inherited;
  1459.   FButton.Enabled := Enabled;
  1460. end;
  1461.  
  1462. procedure TCustomComboEdit.CMCancelMode(var Message: TCMCancelMode);
  1463. begin
  1464.   if (Message.Sender <> Self) and (Message.Sender <> FPopup) and
  1465.     (Message.Sender <> FButton) and ((FPopup <> nil) and
  1466.     not FPopup.ContainsControl(Message.Sender)) then
  1467.     PopupCloseUp(FPopup, False);
  1468. end;
  1469.  
  1470. procedure TCustomComboEdit.CMEnter(var Message: TMessage);
  1471. begin
  1472.   if AutoSelect and not (csLButtonDown in ControlState) then SelectAll;
  1473.   inherited;
  1474. end;
  1475.  
  1476. procedure TCustomComboEdit.CNCtlColor(var Message: TMessage);
  1477. var
  1478.   TextColor: Longint;
  1479. begin
  1480.   inherited;
  1481.   if NewStyleControls then begin
  1482.     TextColor := ColorToRGB(Font.Color);
  1483.     if not Enabled and (ColorToRGB(Color) <> ColorToRGB(clGrayText)) then
  1484.       TextColor := ColorToRGB(clGrayText);
  1485.     SetTextColor(Message.WParam, TextColor);
  1486.   end;
  1487. end;
  1488.  
  1489. procedure TCustomComboEdit.WMKillFocus(var Message: TWMKillFocus);
  1490. begin
  1491.   inherited;
  1492.   FFocused := False;
  1493.   PopupCloseUp(FPopup, False);
  1494. end;
  1495.  
  1496. procedure TCustomComboEdit.WMSetFocus(var Message: TMessage);
  1497. begin
  1498.   inherited;
  1499.   FFocused := True;
  1500.   SetShowCaret;
  1501. end;
  1502.  
  1503. {$IFDEF RX_D4}
  1504. procedure TCustomComboEdit.CMBiDiModeChanged(var Message: TMessage);
  1505. begin
  1506.   inherited;
  1507.   if FPopup <> nil then FPopup.BiDiMode := BiDiMode;
  1508. end;
  1509. {$ENDIF}
  1510.  
  1511. procedure TCustomComboEdit.SetShowCaret;
  1512. const
  1513.   CaretWidth: array[Boolean] of Byte = (1, 2);
  1514. begin
  1515.   CreateCaret(Handle, 0, CaretWidth[fsBold in Font.Style], GetTextHeight);
  1516.   ShowCaret(Handle);
  1517. end;
  1518.  
  1519. procedure TCustomComboEdit.EditButtonClick(Sender: TObject);
  1520. begin
  1521.   if (not FReadOnly) or AlwaysEnable then ButtonClick;
  1522. end;
  1523.  
  1524. procedure TCustomComboEdit.DoClick;
  1525. begin
  1526.   EditButtonClick(Self);
  1527. end;
  1528.  
  1529. procedure TCustomComboEdit.ButtonClick;
  1530. begin
  1531.   if Assigned(FOnButtonClick) then FOnButtonClick(Self);
  1532.   if FPopup <> nil then begin
  1533.     if FPopupVisible then PopupCloseUp(FPopup, True) else PopupDropDown(True);
  1534.   end;
  1535. end;
  1536.  
  1537. procedure TCustomComboEdit.SelectAll;
  1538. begin
  1539.   if DirectInput then inherited SelectAll;
  1540. end;
  1541.  
  1542. function TCustomComboEdit.GetDirectInput: Boolean;
  1543. begin
  1544.   Result := FDirectInput;
  1545. end;
  1546.  
  1547. procedure TCustomComboEdit.SetDirectInput(Value: Boolean);
  1548. begin
  1549.   inherited ReadOnly := not Value or FReadOnly;
  1550.   FDirectInput := Value;
  1551. end;
  1552.  
  1553. procedure TCustomComboEdit.WMPaste(var Message: TWMPaste);
  1554. begin
  1555.   if not FDirectInput or ReadOnly then Exit;
  1556.   inherited;
  1557. end;
  1558.  
  1559. procedure TCustomComboEdit.WMCut(var Message: TWMCut);
  1560. begin
  1561.   if not FDirectInput or ReadOnly then Exit;
  1562.   inherited;
  1563. end;
  1564.  
  1565. function TCustomComboEdit.GetReadOnly: Boolean;
  1566. begin
  1567.   Result := FReadOnly;
  1568. end;
  1569.  
  1570. procedure TCustomComboEdit.SetReadOnly(Value: Boolean);
  1571. begin
  1572.   if Value <> FReadOnly then begin
  1573.     FReadOnly := Value;
  1574.     inherited ReadOnly := Value or not FDirectInput;
  1575.   end;
  1576. end;
  1577.  
  1578. procedure TCustomComboEdit.SetAlignment(Value: TAlignment);
  1579. begin
  1580.   if FAlignment <> Value then begin
  1581.     FAlignment := Value;
  1582.     RecreateWnd;
  1583.   end;
  1584. end;
  1585.  
  1586. function TCustomComboEdit.BtnWidthStored: Boolean;
  1587. begin
  1588.   if (FGlyphKind = gkDefault) and (Glyph <> nil) then
  1589.     Result := ButtonWidth <> Max(Glyph.Width div FButton.NumGlyphs + 6,
  1590.       DefEditBtnWidth)
  1591.   else if FGlyphKind = gkDropDown then
  1592.     Result := ButtonWidth <> GetSystemMetrics(SM_CXVSCROLL)
  1593.       {$IFNDEF WIN32} + 1{$ENDIF}
  1594.   else Result := ButtonWidth <> DefEditBtnWidth;
  1595. end;
  1596.  
  1597. function TCustomComboEdit.IsCustomGlyph: Boolean;
  1598. begin
  1599.   Result := FGlyphKind = gkCustom;
  1600. end;
  1601.  
  1602. procedure TCustomComboEdit.SetGlyphKind(Value: TGlyphKind);
  1603. begin
  1604.   if FGlyphKind <> Value then begin
  1605.     FGlyphKind := Value;
  1606.     if (FGlyphKind = gkCustom) and (csReading in ComponentState) then begin
  1607.       Glyph := nil;
  1608.     end;
  1609.     RecreateGlyph;
  1610.     if (FGlyphKind = gkDefault) and (Glyph <> nil) then
  1611.       ButtonWidth := Max(Glyph.Width div FButton.NumGlyphs + 6, FButton.Width)
  1612.     else if FGlyphKind = gkDropDown then begin
  1613.       ButtonWidth := GetSystemMetrics(SM_CXVSCROLL){$IFNDEF WIN32} + 1{$ENDIF};
  1614.       with FButton do
  1615.         ControlStyle := ControlStyle + [csFixedWidth];
  1616.     end;
  1617.   end;
  1618. end;
  1619.  
  1620. function TCustomComboEdit.GetDefaultBitmap(var DestroyNeeded: Boolean): TBitmap;
  1621. begin
  1622.   Result := nil;
  1623. end;
  1624.  
  1625. procedure TCustomComboEdit.RecreateGlyph;
  1626.  
  1627.   function CreateEllipsisGlyph: TBitmap;
  1628.   var
  1629.     W, G, I: Integer;
  1630.   begin
  1631.     Result := TBitmap.Create;
  1632.     with Result do
  1633.     try
  1634.       Monochrome := True;
  1635.       Width := Max(1, FButton.Width - 6);
  1636.       Height := 4;
  1637.       W := 2;
  1638.       G := (Result.Width - 3 * W) div 2;
  1639.       if G <= 0 then G := 1;
  1640.       if G > 3 then G := 3;
  1641.       I := (Width - 3 * W - 2 * G) div 2;
  1642.       PatBlt(Canvas.Handle, I, 1, W, W, BLACKNESS);
  1643.       PatBlt(Canvas.Handle, I + G + W, 1, W, W, BLACKNESS);
  1644.       PatBlt(Canvas.Handle, I + 2 * G + 2 * W, 1, W, W, BLACKNESS);
  1645.     except
  1646.       Free;
  1647.       raise;
  1648.     end;
  1649.   end;
  1650.  
  1651. var
  1652.   NewGlyph: TBitmap;
  1653.   DestroyNeeded: Boolean;
  1654. begin
  1655.   case FGlyphKind of
  1656.     gkDefault:
  1657.       begin
  1658.         DestroyNeeded := False;
  1659.         NewGlyph := GetDefaultBitmap(DestroyNeeded);
  1660.         try
  1661.           FButton.Glyph.Assign(NewGlyph);
  1662.           NumGlyphs := FDefNumGlyphs;
  1663.         finally
  1664.           if DestroyNeeded then NewGlyph.Destroy;
  1665.         end;
  1666.       end;
  1667.     gkDropDown:
  1668.       begin
  1669.         FButton.Glyph.Handle := LoadBitmap(0, PChar(32738));
  1670.         NumGlyphs := 1;
  1671.       end;
  1672.     gkEllipsis:
  1673.       begin
  1674.         NewGlyph := CreateEllipsisGlyph;
  1675.         try
  1676.           FButton.Glyph := NewGlyph;
  1677.           NumGlyphs := 1;
  1678.         finally
  1679.           NewGlyph.Destroy;
  1680.         end;
  1681.       end;
  1682.   end;
  1683. end;
  1684.  
  1685. const
  1686.   FileBitmap: TBitmap = nil;
  1687.   DateBitmap: TBitmap = nil;
  1688.  
  1689. { TFileDirEdit }
  1690.  
  1691. constructor TFileDirEdit.Create(AOwner: TComponent);
  1692. begin
  1693.   inherited Create(AOwner);
  1694.   OEMConvert := True;
  1695. {$IFNDEF WIN32}
  1696.   MaxLength := MaxFileLength;
  1697. {$ENDIF}
  1698.   ControlState := ControlState + [csCreating];
  1699.   try
  1700.     GlyphKind := gkDefault; { force update }
  1701.   finally
  1702.     ControlState := ControlState - [csCreating];
  1703.   end;
  1704. end;
  1705.  
  1706. function TFileDirEdit.GetDefaultBitmap(var DestroyNeeded: Boolean): TBitmap;
  1707. begin
  1708.   DestroyNeeded := False;
  1709.   if FileBitmap = nil then begin
  1710.     FileBitmap := TBitmap.Create;
  1711.     FileBitmap.Handle := LoadBitmap(hInstance, sFileBmp);
  1712.   end;
  1713.   Result := FileBitmap;
  1714. end;
  1715.  
  1716. procedure TFileDirEdit.DoBeforeDialog(var FileName: string;
  1717.   var Action: Boolean);
  1718. begin
  1719.   if Assigned(FOnBeforeDialog) then FOnBeforeDialog(Self, FileName, Action);
  1720. end;
  1721.  
  1722. procedure TFileDirEdit.DoAfterDialog(var FileName: string;
  1723.   var Action: Boolean);
  1724. begin
  1725.   if Assigned(FOnAfterDialog) then FOnAfterDialog(Self, FileName, Action);
  1726. end;
  1727.  
  1728. procedure TFileDirEdit.CreateHandle;
  1729. begin
  1730.   inherited CreateHandle;
  1731.   if FAcceptFiles then SetDragAccept(True);
  1732. end;
  1733.  
  1734. procedure TFileDirEdit.DestroyWindowHandle;
  1735. begin
  1736.   SetDragAccept(False);
  1737.   inherited DestroyWindowHandle;
  1738. end;
  1739.  
  1740. procedure TFileDirEdit.SetDragAccept(Value: Boolean);
  1741. begin
  1742.   if not (csDesigning in ComponentState) and (Handle <> 0) then
  1743.     DragAcceptFiles(Handle, Value);
  1744. end;
  1745.  
  1746. procedure TFileDirEdit.SetAcceptFiles(Value: Boolean);
  1747. begin
  1748.   if FAcceptFiles <> Value then begin
  1749.     SetDragAccept(Value);
  1750.     FAcceptFiles := Value;
  1751.   end;
  1752. end;
  1753.  
  1754. procedure TFileDirEdit.DisableSysErrors;
  1755. begin
  1756.   FErrMode := SetErrorMode(SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS);
  1757. end;
  1758.  
  1759. procedure TFileDirEdit.EnableSysErrors;
  1760. begin
  1761.   SetErrorMode(FErrMode);
  1762.   FErrMode := 0;
  1763. end;
  1764.  
  1765. procedure TFileDirEdit.WMDropFiles(var Msg: TWMDropFiles);
  1766. var
  1767.   AFileName: array[0..255] of Char;
  1768.   I, Num: Cardinal;
  1769. begin
  1770.   Msg.Result := 0;
  1771.   try
  1772. {$IFDEF WIN32}
  1773.     Num := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0);
  1774. {$ELSE}
  1775.     Num := DragQueryFile(Msg.Drop, $FFFF, nil, 0);
  1776. {$ENDIF}
  1777.     if Num > 0 then begin
  1778.       ClearFileList;
  1779.       for I := 0 to Num - 1 do begin
  1780.         DragQueryFile(Msg.Drop, I, PChar(@AFileName), Pred(SizeOf(AFileName)));
  1781.         ReceptFileDir(StrPas(AFileName));
  1782.         if not FMultipleDirs then Break;
  1783.       end;
  1784.       if Assigned(FOnDropFiles) then FOnDropFiles(Self);
  1785.     end;
  1786.   finally
  1787.     DragFinish(Msg.Drop);
  1788.   end;
  1789. end;
  1790.  
  1791. procedure TFileDirEdit.ClearFileList;
  1792. begin
  1793. end;
  1794.  
  1795. { TFilenameEdit }
  1796.  
  1797. function ClipFilename(const FileName: string): string;
  1798. var
  1799.   Params: string;
  1800. begin
  1801.   if FileExists(FileName) then Result := FileName
  1802.   else SplitCommandLine(FileName, Result, Params);
  1803. end;
  1804.  
  1805. function ExtFilename(const FileName: string): string;
  1806. begin
  1807.   if (Pos(' ', FileName) > 0) and (FileName[1] <> '"') then
  1808.     Result := Format('"%s"', [FileName])
  1809.   else Result := FileName;
  1810. end;
  1811.  
  1812. constructor TFilenameEdit.Create(AOwner: TComponent);
  1813. begin
  1814.   inherited Create(AOwner);
  1815.   CreateEditDialog;
  1816. end;
  1817.  
  1818. procedure TFilenameEdit.CreateEditDialog;
  1819. var
  1820.   NewDialog: TOpenDialog;
  1821. begin
  1822.   case FDialogKind of
  1823.     dkOpen: NewDialog := TOpenDialog.Create(Self);
  1824. {$IFDEF RX_D3}
  1825.     dkOpenPicture: NewDialog := TOpenPictureDialog.Create(Self);
  1826.     dkSavePicture: NewDialog := TSavePictureDialog.Create(Self);
  1827. {$ENDIF}
  1828.     else {dkSave} NewDialog := TSaveDialog.Create(Self);
  1829.   end;
  1830.   try
  1831.     if FDialog <> nil then begin
  1832.       with NewDialog do begin
  1833.         DefaultExt := FDialog.DefaultExt;
  1834.         FileEditStyle := FDialog.FileEditStyle;
  1835.         FileName := FDialog.FileName;
  1836.         Filter := FDialog.Filter;
  1837.         FilterIndex := FDialog.FilterIndex;
  1838.         InitialDir := FDialog.InitialDir;
  1839.         HistoryList := FDialog.HistoryList;
  1840.         Files.Assign(FDialog.Files);
  1841.         Options := FDialog.Options;
  1842.         Title := FDialog.Title;
  1843.       end;
  1844.       FDialog.Free;
  1845.     end
  1846.     else begin
  1847.       NewDialog.Title := LoadStr(SBrowse);
  1848.       NewDialog.Filter := LoadStr(SDefaultFilter);
  1849.       NewDialog.Options := [ofHideReadOnly];
  1850.     end;
  1851.   finally
  1852.     FDialog := NewDialog;
  1853.   end;
  1854. end;
  1855.  
  1856. function TFilenameEdit.IsCustomTitle: Boolean;
  1857. begin
  1858.   Result := CompareStr(LoadStr(SBrowse), FDialog.Title) <> 0;
  1859. end;
  1860.  
  1861. function TFilenameEdit.IsCustomFilter: Boolean;
  1862. begin
  1863.   Result := CompareStr(LoadStr(SDefaultFilter), FDialog.Filter) <> 0;
  1864. end;
  1865.  
  1866. procedure TFilenameEdit.ButtonClick;
  1867. var
  1868.   Temp: string;
  1869.   Action: Boolean;
  1870. begin
  1871.   inherited ButtonClick;
  1872.   Temp := inherited Text;
  1873.   Action := True;
  1874.   Temp := ClipFilename(Temp);
  1875.   DoBeforeDialog(Temp, Action);
  1876.   if not Action then Exit;
  1877.   if ValidFileName(Temp) then
  1878.     try
  1879.       if DirExists(ExtractFilePath(Temp)) then
  1880.         SetInitialDir(ExtractFilePath(Temp));
  1881.       if (ExtractFileName(Temp) = '') or
  1882.         not ValidFileName(ExtractFileName(Temp)) then Temp := '';
  1883.       FDialog.FileName := Temp;
  1884.     except
  1885.       { ignore any exceptions }
  1886.     end;
  1887.   FDialog.HelpContext := Self.HelpContext;
  1888.   DisableSysErrors;
  1889.   try
  1890.     Action := FDialog.Execute;
  1891.   finally
  1892.     EnableSysErrors;
  1893.   end;
  1894.   if Action then Temp := FDialog.FileName;
  1895.   if CanFocus then SetFocus;
  1896.   DoAfterDialog(Temp, Action);
  1897.   if Action then begin
  1898.     inherited Text := ExtFilename(Temp);
  1899.     SetInitialDir(ExtractFilePath(FDialog.FileName));
  1900.   end;
  1901. end;
  1902.  
  1903. function TFilenameEdit.GetFileName: string;
  1904. begin
  1905.   Result := ClipFilename(inherited Text);
  1906. end;
  1907.  
  1908. procedure TFilenameEdit.SetFileName(const Value: string);
  1909. begin
  1910.   if (Value = '') or ValidFileName(ClipFilename(Value)) then begin
  1911.     inherited Text := ExtFilename(Value);
  1912.     ClearFileList;
  1913.   end
  1914.   else raise EComboEditError.CreateFmt(ResStr(SInvalidFilename), [Value]);
  1915. end;
  1916.  
  1917. {$IFDEF WIN32}
  1918.  
  1919. function TFilenameEdit.GetLongName: string;
  1920. begin
  1921.   Result := ShortToLongFileName(FileName);
  1922. end;
  1923.  
  1924. function TFilenameEdit.GetShortName: string;
  1925. begin
  1926.   Result := LongToShortFileName(FileName);
  1927. end;
  1928.  
  1929. {$ENDIF WIN32}
  1930.  
  1931. procedure TFilenameEdit.ClearFileList;
  1932. begin
  1933.   FDialog.Files.Clear;
  1934. end;
  1935.  
  1936. procedure TFilenameEdit.ReceptFileDir(const AFileName: string);
  1937. begin
  1938.   if FMultipleDirs then begin
  1939.     if FDialog.Files.Count = 0 then SetFileName(AFileName);
  1940.     FDialog.Files.Add(AFileName);
  1941.   end
  1942.   else SetFileName(AFileName);
  1943. end;
  1944.  
  1945. function TFilenameEdit.GetDialogFiles: TStrings;
  1946. begin
  1947.   Result := FDialog.Files;
  1948. end;
  1949.  
  1950. function TFilenameEdit.GetDefaultExt: TFileExt;
  1951. begin
  1952.   Result := FDialog.DefaultExt;
  1953. end;
  1954.  
  1955. function TFilenameEdit.GetFileEditStyle: TFileEditStyle;
  1956. begin
  1957.   Result := FDialog.FileEditStyle;
  1958. end;
  1959.  
  1960. function TFilenameEdit.GetFilter: string;
  1961. begin
  1962.   Result := FDialog.Filter;
  1963. end;
  1964.  
  1965. function TFilenameEdit.GetFilterIndex: Integer;
  1966. begin
  1967.   Result := FDialog.FilterIndex;
  1968. end;
  1969.  
  1970. function TFilenameEdit.GetInitialDir: string;
  1971. begin
  1972.   Result := FDialog.InitialDir;
  1973. end;
  1974.  
  1975. function TFilenameEdit.GetHistoryList: TStrings;
  1976. begin
  1977.   Result := FDialog.HistoryList;
  1978. end;
  1979.  
  1980. function TFilenameEdit.GetOptions: TOpenOptions;
  1981. begin
  1982.   Result := FDialog.Options;
  1983. end;
  1984.  
  1985. function TFilenameEdit.GetDialogTitle: string;
  1986. begin
  1987.   Result := FDialog.Title;
  1988. end;
  1989.  
  1990. procedure TFilenameEdit.SetDialogKind(Value: TFileDialogKind);
  1991. begin
  1992.   if FDialogKind <> Value then begin
  1993.     FDialogKind := Value;
  1994.     CreateEditDialog;
  1995.   end;
  1996. end;
  1997.  
  1998. procedure TFilenameEdit.SetDefaultExt(Value: TFileExt);
  1999. begin
  2000.   FDialog.DefaultExt := Value;
  2001. end;
  2002.  
  2003. procedure TFilenameEdit.SetFileEditStyle(Value: TFileEditStyle);
  2004. begin
  2005.   FDialog.FileEditStyle := Value;
  2006. end;
  2007.  
  2008. procedure TFilenameEdit.SetFilter(const Value: string);
  2009. begin
  2010.   FDialog.Filter := Value;
  2011. end;
  2012.  
  2013. procedure TFilenameEdit.SetFilterIndex(Value: Integer);
  2014. begin
  2015.   FDialog.FilterIndex := Value;
  2016. end;
  2017.  
  2018. procedure TFilenameEdit.SetInitialDir(const Value: string);
  2019. begin
  2020.   FDialog.InitialDir := Value;
  2021. end;
  2022.  
  2023. procedure TFilenameEdit.SetHistoryList(Value: TStrings);
  2024. begin
  2025.   FDialog.HistoryList := Value;
  2026. end;
  2027.  
  2028. procedure TFilenameEdit.SetOptions(Value: TOpenOptions);
  2029. begin
  2030.   if Value <> FDialog.Options then begin
  2031.     FDialog.Options := Value;
  2032.     FMultipleDirs := ofAllowMultiSelect in FDialog.Options;
  2033.     if not FMultipleDirs then ClearFileList;
  2034.   end;
  2035. end;
  2036.  
  2037. procedure TFilenameEdit.SetDialogTitle(const Value: string);
  2038. begin
  2039.   FDialog.Title := Value;
  2040. end;
  2041.  
  2042. { TDirectoryEdit }
  2043.  
  2044. constructor TDirectoryEdit.Create(AOwner: TComponent);
  2045. begin
  2046.   inherited Create(AOwner);
  2047.   FOptions := [];
  2048. end;
  2049.  
  2050. procedure TDirectoryEdit.ButtonClick;
  2051. var
  2052.   Temp: string;
  2053.   Action: Boolean;
  2054. begin
  2055.   inherited ButtonClick;
  2056.   Temp := Text;
  2057.   Action := True;
  2058.   DoBeforeDialog(Temp, Action);
  2059.   if not Action then Exit;
  2060.   if (Temp = '') then begin
  2061.     if (InitialDir <> '') then Temp := InitialDir
  2062.     else Temp := '\';
  2063.   end;
  2064.   if not DirExists(Temp) then Temp := '\';
  2065.   DisableSysErrors;
  2066.   try
  2067. {$IFDEF WIN32}
  2068.     if NewStyleControls and (DialogKind = dkWin32) then
  2069.       Action := BrowseDirectory(Temp, FDialogText, Self.HelpContext)
  2070.     else Action := SelectDirectory(Temp, FOptions, Self.HelpContext);
  2071. {$ELSE}
  2072.     Action := SelectDirectory(Temp, FOptions, Self.HelpContext);
  2073. {$ENDIF}
  2074.   finally
  2075.     EnableSysErrors;
  2076.   end;
  2077.   if CanFocus then SetFocus;
  2078.   DoAfterDialog(Temp, Action);
  2079.   if Action then begin
  2080.     SelText := '';
  2081.     if (Text = '') or not MultipleDirs then Text := Temp
  2082.     else Text := Text + ';' + Temp;
  2083.     if (Temp <> '') and DirExists(Temp) then InitialDir := Temp;
  2084.   end;
  2085. end;
  2086.  
  2087. procedure TDirectoryEdit.ReceptFileDir(const AFileName: string);
  2088. var
  2089.   Temp: string;
  2090. begin
  2091.   if FileExists(AFileName) then Temp := ExtractFilePath(AFileName)
  2092.   else Temp := AFileName;
  2093.   if (Text = '') or not MultipleDirs then Text := Temp
  2094.   else Text := Text + ';' + Temp;
  2095. end;
  2096.  
  2097. {$IFDEF WIN32}
  2098.  
  2099. function TDirectoryEdit.GetLongName: string;
  2100. var
  2101.   Temp: string;
  2102.   Pos: Integer;
  2103. begin
  2104.   if not MultipleDirs then Result := ShortToLongPath(Text)
  2105.   else begin
  2106.     Result := '';
  2107.     Pos := 1;
  2108.     while Pos <= Length(Text) do begin
  2109.       Temp := ShortToLongPath(ExtractSubstr(Text, Pos, [';']));
  2110.       if (Result <> '') and (Temp <> '') then Result := Result + ';';
  2111.       Result := Result + Temp;
  2112.     end;
  2113.   end;
  2114. end;
  2115.  
  2116. function TDirectoryEdit.GetShortName: string;
  2117. var
  2118.   Temp: string;
  2119.   Pos: Integer;
  2120. begin
  2121.   if not MultipleDirs then Result := LongToShortPath(Text)
  2122.   else begin
  2123.     Result := '';
  2124.     Pos := 1;
  2125.     while Pos <= Length(Text) do begin
  2126.       Temp := LongToShortPath(ExtractSubstr(Text, Pos, [';']));
  2127.       if (Result <> '') and (Temp <> '') then Result := Result + ';';
  2128.       Result := Result + Temp;
  2129.     end;
  2130.   end;
  2131. end;
  2132.  
  2133. {$ENDIF WIN32}
  2134.  
  2135. { TCustomDateEdit }
  2136.  
  2137. function NvlDate(DateValue, DefaultValue: TDateTime): TDateTime;
  2138. begin
  2139.   if DateValue = NullDate then Result := DefaultValue
  2140.   else Result := DateValue;
  2141. end;
  2142.  
  2143. constructor TCustomDateEdit.Create(AOwner: TComponent);
  2144. begin
  2145.   inherited Create(AOwner);
  2146.   FBlanksChar := ' ';
  2147.   FTitle := NewStr(LoadStr(SDateDlgTitle));
  2148.   FPopupColor := clBtnFace;
  2149.   FDefNumGlyphs := 2;
  2150.   FStartOfWeek := Mon;
  2151.   FWeekends := [Sun];
  2152.   FWeekendColor := clRed;
  2153.   FYearDigits := dyDefault;
  2154.   FCalendarHints := TStringList.Create;
  2155.   TStringList(FCalendarHints).OnChange := CalendarHintsChanged;
  2156.   ControlState := ControlState + [csCreating];
  2157.   try
  2158.     UpdateFormat;
  2159. {$IFDEF DEFAULT_POPUP_CALENDAR}
  2160.     FPopup := TPopupWindow(CreatePopupCalendar(Self
  2161.       {$IFDEF RX_D4}, BiDiMode {$ENDIF}));
  2162.     TPopupWindow(FPopup).OnCloseUp := PopupCloseUp;
  2163.     TPopupWindow(FPopup).Color := FPopupColor;
  2164. {$ENDIF DEFAULT_POPUP_CALENDAR}
  2165.     GlyphKind := gkDefault; { force update }
  2166.   finally
  2167.     ControlState := ControlState - [csCreating];
  2168.   end;
  2169. end;
  2170.  
  2171. destructor TCustomDateEdit.Destroy;
  2172. begin
  2173.   if FHooked then begin
  2174.     Application.UnhookMainWindow(FormatSettingsChange);
  2175.     FHooked := False;
  2176.   end;
  2177.   if FPopup <> nil then TPopupWindow(FPopup).OnCloseUp := nil;
  2178.   FPopup.Free;
  2179.   FPopup := nil;
  2180.   TStringList(FCalendarHints).OnChange := nil;
  2181.   FCalendarHints.Free;
  2182.   FCalendarHints := nil;
  2183.   DisposeStr(FTitle);
  2184.   inherited Destroy;
  2185. end;
  2186.  
  2187. procedure TCustomDateEdit.CreateWindowHandle(const Params: TCreateParams);
  2188. begin
  2189.   inherited CreateWindowHandle(Params);
  2190.   if Handle <> 0 then begin
  2191.     UpdateMask;
  2192.     if not (csDesigning in ComponentState) and not (IsLibrary or FHooked) then
  2193.     begin
  2194.       Application.HookMainWindow(FormatSettingsChange);
  2195.       FHooked := True;
  2196.     end;
  2197.   end;
  2198. end;
  2199.  
  2200. procedure TCustomDateEdit.DestroyWindowHandle;
  2201. begin
  2202.   if FHooked then begin
  2203.     Application.UnhookMainWindow(FormatSettingsChange);
  2204.     FHooked := False;
  2205.   end;
  2206.   inherited DestroyWindowHandle;
  2207. end;
  2208.  
  2209. procedure TCustomDateEdit.UpdateFormat;
  2210. begin
  2211.   FDateFormat := DefDateFormat(FourDigitYear);
  2212. end;
  2213.  
  2214. function TCustomDateEdit.GetDateFormat: string;
  2215. begin
  2216.   Result := FDateFormat;
  2217. end;
  2218.  
  2219. function TCustomDateEdit.TextStored: Boolean;
  2220. begin
  2221.   Result := not IsEmptyStr(Text, [#0, ' ', DateSeparator, FBlanksChar]);
  2222. end;
  2223.  
  2224. procedure TCustomDateEdit.CheckValidDate;
  2225. begin
  2226.   if TextStored then
  2227.     try
  2228.       FFormatting := True;
  2229.       try
  2230.         SetDate(StrToDateFmt(FDateFormat, Text));
  2231.       finally
  2232.         FFormatting := False;
  2233.       end;
  2234.     except
  2235.       if CanFocus then SetFocus;
  2236.       raise;
  2237.     end;
  2238. end;
  2239.  
  2240. procedure TCustomDateEdit.Change;
  2241. begin
  2242.   if not FFormatting then inherited Change;
  2243. end;
  2244.  
  2245. procedure TCustomDateEdit.CMExit(var Message: TCMExit);
  2246. begin
  2247.   if not (csDesigning in ComponentState) and CheckOnExit then
  2248.     CheckValidDate;
  2249.   inherited;
  2250. end;
  2251.  
  2252. function TCustomDateEdit.GetDefaultBitmap(var DestroyNeeded: Boolean): TBitmap;
  2253. begin
  2254.   DestroyNeeded := False;
  2255.   if DateBitmap = nil then begin
  2256.     DateBitmap := TBitmap.Create;
  2257.     DateBitmap.Handle := LoadBitmap(hInstance, sDateBmp);
  2258.   end;
  2259.   Result := DateBitmap;
  2260. end;
  2261.  
  2262. procedure TCustomDateEdit.SetBlanksChar(Value: Char);
  2263. begin
  2264.   if Value <> FBlanksChar then begin
  2265.     if (Value < ' ') then Value := ' ';
  2266.     FBlanksChar := Value;
  2267.     UpdateMask;
  2268.   end;
  2269. end;
  2270.  
  2271. procedure TCustomDateEdit.UpdateMask;
  2272. var
  2273.   DateValue: TDateTime;
  2274.   OldFormat: string[10];
  2275. begin
  2276.   DateValue := GetDate;
  2277.   OldFormat := FDateFormat;
  2278.   UpdateFormat;
  2279.   if (GetDateMask <> EditMask) or (OldFormat <> FDateFormat) then begin
  2280.     { force update }
  2281.     EditMask := '';
  2282.     EditMask := GetDateMask;
  2283.   end;
  2284.   UpdatePopup;
  2285.   SetDate(DateValue);
  2286. end;
  2287.  
  2288. function TCustomDateEdit.FormatSettingsChange(var Message: TMessage): Boolean;
  2289. begin
  2290.   Result := False;
  2291.   if (Message.Msg = WM_WININICHANGE)
  2292.     {$IFDEF WIN32} and Application.UpdateFormatSettings {$ENDIF} then
  2293.     UpdateMask;
  2294. end;
  2295.  
  2296. function TCustomDateEdit.FourDigitYear: Boolean;
  2297. begin
  2298.   Result := (FYearDigits = dyFour) or ((FYearDigits = dyDefault) and
  2299.     (DateUtil.FourDigitYear));
  2300. end;
  2301.  
  2302. function TCustomDateEdit.GetDateMask: string;
  2303. begin
  2304.   Result := DefDateMask(FBlanksChar, FourDigitYear);
  2305. end;
  2306.  
  2307. function TCustomDateEdit.GetDate: TDateTime;
  2308. begin
  2309.   if DefaultToday then Result := SysUtils.Date
  2310.   else Result := NullDate;
  2311.   Result := StrToDateFmtDef(FDateFormat, Text, Result);
  2312. end;
  2313.  
  2314. procedure TCustomDateEdit.SetDate(Value: TDateTime);
  2315. var
  2316.   D: TDateTime;
  2317. begin
  2318.   if not ValidDate(Value) or (Value = NullDate) then begin
  2319.     if DefaultToday then Value := SysUtils.Date
  2320.     else Value := NullDate;
  2321.   end;
  2322.   D := Date;
  2323.   if Value = NullDate then Text := ''
  2324.   else Text := FormatDateTime(FDateFormat, Value);
  2325.   Modified := D <> Date;
  2326. end;
  2327.  
  2328. procedure TCustomDateEdit.ApplyDate(Value: TDateTime);
  2329. begin
  2330.   SetDate(Value);
  2331.   SelectAll;
  2332. end;
  2333.  
  2334. function TCustomDateEdit.GetDialogTitle: string;
  2335. begin
  2336.   Result := FTitle^;
  2337. end;
  2338.  
  2339. procedure TCustomDateEdit.SetDialogTitle(const Value: string);
  2340. begin
  2341.   AssignStr(FTitle, Value);
  2342. end;
  2343.  
  2344. function TCustomDateEdit.IsCustomTitle: Boolean;
  2345. begin
  2346.   Result := (CompareStr(LoadStr(SDateDlgTitle), DialogTitle) <> 0) and
  2347.     (FTitle <> NullStr);
  2348. end;
  2349.  
  2350. procedure TCustomDateEdit.UpdatePopup;
  2351. begin
  2352.   if FPopup <> nil then SetupPopupCalendar(FPopup, FStartOfWeek,
  2353.     FWeekends, FWeekendColor, FCalendarHints, FourDigitYear);
  2354. end;
  2355.  
  2356. procedure TCustomDateEdit.SetYearDigits(Value: TYearDigits);
  2357. begin
  2358.   if FYearDigits <> Value then begin
  2359.     FYearDigits := Value;
  2360.     UpdateMask;
  2361.   end;
  2362. end;
  2363.  
  2364. function TCustomDateEdit.GetPopupColor: TColor;
  2365. begin
  2366.   if FPopup <> nil then Result := TPopupWindow(FPopup).Color
  2367.   else Result := FPopupColor;
  2368. end;
  2369.  
  2370. procedure TCustomDateEdit.SetPopupColor(Value: TColor);
  2371. begin
  2372.   if Value <> PopupColor then begin
  2373.     if FPopup <> nil then TPopupWindow(FPopup).Color := Value;
  2374.     FPopupColor := Value;
  2375.   end;
  2376. end;
  2377.  
  2378. function TCustomDateEdit.GetCalendarStyle: TCalendarStyle;
  2379. begin
  2380.   if FPopup <> nil then Result := csPopup
  2381.   else Result := csDialog;
  2382. end;
  2383.  
  2384. procedure TCustomDateEdit.SetCalendarStyle(Value: TCalendarStyle);
  2385. begin
  2386.   if Value <> CalendarStyle then begin
  2387.     case Value of
  2388.       csPopup:
  2389.         begin
  2390.           if FPopup = nil then
  2391.             FPopup := TPopupWindow(CreatePopupCalendar(Self
  2392.               {$IFDEF RX_D4}, BiDiMode {$ENDIF}));
  2393.           TPopupWindow(FPopup).OnCloseUp := PopupCloseUp;
  2394.           TPopupWindow(FPopup).Color := FPopupColor;
  2395.           UpdatePopup;
  2396.         end;
  2397.       csDialog:
  2398.         begin
  2399.           FPopup.Free;
  2400.           FPopup := nil;
  2401.         end;
  2402.     end;
  2403.   end;
  2404. end;
  2405.  
  2406. procedure TCustomDateEdit.SetCalendarHints(Value: TStrings);
  2407. begin
  2408.   FCalendarHints.Assign(Value);
  2409. end;
  2410.  
  2411. procedure TCustomDateEdit.CalendarHintsChanged(Sender: TObject);
  2412. begin
  2413.   TStringList(FCalendarHints).OnChange := nil;
  2414.   try
  2415.     while (FCalendarHints.Count > 4) do
  2416.       FCalendarHints.Delete(FCalendarHints.Count - 1);
  2417.   finally
  2418.     TStringList(FCalendarHints).OnChange := CalendarHintsChanged;
  2419.   end;
  2420.   if not (csDesigning in ComponentState) then UpdatePopup;
  2421. end;
  2422.  
  2423. procedure TCustomDateEdit.SetWeekendColor(Value: TColor);
  2424. begin
  2425.   if Value <> FWeekendColor then begin
  2426.     FWeekendColor := Value;
  2427.     UpdatePopup;
  2428.   end;
  2429. end;
  2430.  
  2431. procedure TCustomDateEdit.SetWeekends(Value: TDaysOfWeek);
  2432. begin
  2433.   if Value <> FWeekends then begin
  2434.     FWeekends := Value;
  2435.     UpdatePopup;
  2436.   end;
  2437. end;
  2438.  
  2439. procedure TCustomDateEdit.SetStartOfWeek(Value: TDayOfWeekName);
  2440. begin
  2441.   if Value <> FStartOfWeek then begin
  2442.     FStartOfWeek := Value;
  2443.     UpdatePopup;
  2444.   end;
  2445. end;
  2446.  
  2447. procedure TCustomDateEdit.KeyDown(var Key: Word; Shift: TShiftState);
  2448. begin
  2449.   if (Key in [VK_PRIOR, VK_NEXT, VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN,
  2450.     VK_ADD, VK_SUBTRACT]) and
  2451.     PopupVisible then
  2452.   begin
  2453.     TPopupWindow(FPopup).KeyDown(Key, Shift);
  2454.     Key := 0;
  2455.   end
  2456.   else if (Shift = []) and DirectInput then begin
  2457.     case Key of
  2458.       VK_ADD:
  2459.         begin
  2460.           ApplyDate(NvlDate(Date, Now) + 1);
  2461.           Key := 0;
  2462.         end;
  2463.       VK_SUBTRACT:
  2464.         begin
  2465.           ApplyDate(NvlDate(Date, Now) - 1);
  2466.           Key := 0;
  2467.         end;
  2468.     end;
  2469.   end;
  2470.   inherited KeyDown(Key, Shift);
  2471. end;
  2472.  
  2473. procedure TCustomDateEdit.KeyPress(var Key: Char);
  2474. begin
  2475.   if (Key in ['T', 't', '+', '-']) and PopupVisible then begin
  2476.     TPopupWindow(FPopup).KeyPress(Key);
  2477.     Key := #0;
  2478.   end
  2479.   else if DirectInput then begin
  2480.     case Key of
  2481.       'T', 't':
  2482.         begin
  2483.           ApplyDate(Trunc(Now));
  2484.           Key := #0;
  2485.         end;
  2486.       '+', '-':
  2487.         begin
  2488.           Key := #0;
  2489.         end;
  2490.     end;
  2491.   end;
  2492.   inherited KeyPress(Key);
  2493. end;
  2494.  
  2495. procedure TCustomDateEdit.ButtonClick;
  2496. var
  2497.   D: TDateTime;
  2498.   Action: Boolean;
  2499. begin
  2500.   inherited ButtonClick;
  2501.   if CalendarStyle = csDialog then begin
  2502.     D := Self.Date;
  2503.     Action := SelectDate(D, DialogTitle, FStartOfWeek, FWeekends,
  2504.       FWeekendColor, FCalendarHints);
  2505.     if CanFocus then SetFocus;
  2506.     if Action then begin
  2507.       if Assigned(FOnAcceptDate) then FOnAcceptDate(Self, D, Action);
  2508.       if Action then begin
  2509.         Self.Date := D;
  2510.         if FFocused then inherited SelectAll;
  2511.       end;
  2512.     end;
  2513.   end;
  2514. end;
  2515.  
  2516. {$IFDEF WIN32}
  2517. function TCustomDateEdit.AcceptPopup(var Value: Variant): Boolean;
  2518. {$ELSE}
  2519. function TCustomDateEdit.AcceptPopup(var Value: string): Boolean;
  2520. {$ENDIF}
  2521. var
  2522.   D: TDateTime;
  2523. begin
  2524.   Result := True;
  2525.   if Assigned(FOnAcceptDate) then begin
  2526. {$IFDEF WIN32}
  2527.     if VarIsNull(Value) or VarIsEmpty(Value) then D := NullDate
  2528.     else
  2529.       try
  2530.         D := VarToDateTime(Value);
  2531.       except
  2532.         if DefaultToday then D := SysUtils.Date else D := NullDate;
  2533.       end;
  2534. {$ELSE}
  2535.     if DefaultToday then D := SysUtils.Date else D := NullDate;
  2536.     D := StrToDateDef(Value, D);
  2537. {$ENDIF}
  2538.     FOnAcceptDate(Self, D, Result);
  2539. {$IFDEF WIN32}
  2540.     if Result then Value := VarFromDateTime(D);
  2541. {$ELSE}
  2542.     if Result then Value := FormatDateTime(FDateFormat, D);
  2543. {$ENDIF}
  2544.   end;
  2545. end;
  2546.  
  2547. {$IFDEF WIN32}
  2548. procedure TCustomDateEdit.SetPopupValue(const Value: Variant);
  2549. begin
  2550.   inherited SetPopupValue(StrToDateFmtDef(FDateFormat, VarToStr(Value),
  2551.     SysUtils.Date));
  2552. end;
  2553.  
  2554. procedure TCustomDateEdit.AcceptValue(const Value: Variant);
  2555. begin
  2556.   SetDate(VarToDateTime(Value));
  2557.   UpdatePopupVisible;
  2558.   if Modified then inherited Change;
  2559. end;
  2560. {$ENDIF}
  2561.  
  2562. { TDateEdit }
  2563.  
  2564. constructor TDateEdit.Create(AOwner: TComponent);
  2565. begin
  2566.   inherited Create(AOwner);
  2567.   UpdateMask;
  2568. end;
  2569.  
  2570. { Utility routines }
  2571.  
  2572. procedure DateFormatChanged;
  2573.  
  2574.   procedure IterateControls(AControl: TWinControl);
  2575.   var
  2576.     I: Integer;
  2577.   begin
  2578.     with AControl do
  2579.       for I := 0 to ControlCount - 1 do begin
  2580.         if Controls[I] is TCustomDateEdit then
  2581.           TCustomDateEdit(Controls[I]).UpdateMask
  2582.         else if Controls[I] is TWinControl then
  2583.           IterateControls(TWinControl(Controls[I]));
  2584.       end;
  2585.   end;
  2586.  
  2587. var
  2588.   I: Integer;
  2589. begin
  2590.   if Screen <> nil then
  2591.     for I := 0 to Screen.FormCount - 1 do
  2592.       IterateControls(Screen.Forms[I]);
  2593. end;
  2594.  
  2595. procedure DestroyLocals; far;
  2596. begin
  2597.   FileBitmap.Free;
  2598.   FileBitmap := nil;
  2599.   DateBitmap.Free;
  2600.   DateBitmap := nil;
  2601. end;
  2602.  
  2603. {$IFDEF WIN32}
  2604. initialization
  2605. finalization
  2606.   DestroyLocals;
  2607. {$ELSE}
  2608. initialization
  2609.   AddExitProc(DestroyLocals);
  2610. {$ENDIF}
  2611. end.