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