ComboEdit.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050
  1. unit ComboEdit;
  2. {$J+}
  3. {$WARN UNIT_PLATFORM OFF}
  4. interface
  5. uses Windows, Classes, StdCtrls, Controls, Messages, Forms, Graphics,
  6. Menus, Buttons, Dialogs, Mask,
  7. { SysUtils must overload deprecated FileCtrl (implements SelectDirectory) }
  8. FileCtrl, SysUtils;
  9. const
  10. scAltDown = scAlt + vk_Down;
  11. scCtrlEnter = scCtrl + vk_Return;
  12. DefEditBtnWidth = 25;
  13. DefButtonCaption = '...';
  14. resourcestring
  15. SBrowse = 'Browse';
  16. SDefaultFilter = 'All files (*.*)|*.*';
  17. SInvalidFileName = 'Invalid file name - %s';
  18. type
  19. TFileExt = type string;
  20. { TCustomComboEdit }
  21. // Could be replaced by TCustomButtonedEdit
  22. TCustomComboEdit = class(TCustomEdit)
  23. private
  24. FButton: TButton;
  25. FBtnControl: TWinControl;
  26. FOnButtonClick: TNotifyEvent;
  27. FClickKey: TShortCut;
  28. procedure SetEditRect;
  29. procedure UpdateBtnBounds;
  30. procedure EditButtonClick(Sender: TObject);
  31. function GetMinHeight: Integer;
  32. function GetTextHeight: Integer;
  33. function GetButtonWidth: Integer;
  34. procedure SetButtonWidth(Value: Integer);
  35. function BtnWidthStored: Boolean;
  36. function GetButtonCaption: string;
  37. function ButtonCaptionStored: Boolean;
  38. procedure SetButtonCaption(Value: string);
  39. function GetButtonHint: string;
  40. procedure SetButtonHint(const Value: string);
  41. function GetButtonTabStop: Boolean;
  42. procedure SetButtonTabStop(Value: Boolean);
  43. procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  44. procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  45. procedure CNCtlColor(var Message: TMessage); message CN_CTLCOLOREDIT;
  46. procedure WMSize(var Message: TWMSize); message WM_SIZE;
  47. procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  48. protected
  49. procedure CreateParams(var Params: TCreateParams); override;
  50. procedure CreateWnd; override;
  51. procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  52. procedure ButtonClick; dynamic;
  53. property Button: TButton read FButton;
  54. property ClickKey: TShortCut read FClickKey write FClickKey
  55. default scAltDown;
  56. property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth
  57. stored BtnWidthStored;
  58. property ButtonCaption: string read GetButtonCaption write SetButtonCaption stored ButtonCaptionStored;
  59. property ButtonHint: string read GetButtonHint write SetButtonHint;
  60. property ButtonTabStop: Boolean read GetButtonTabStop write SetButtonTabStop default True;
  61. property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
  62. public
  63. constructor Create(AOwner: TComponent); override;
  64. destructor Destroy; override;
  65. procedure DoClick;
  66. end;
  67. type
  68. TComboEdit = class(TCustomComboEdit)
  69. published
  70. property AutoSelect;
  71. property ButtonHint;
  72. property ButtonTabStop;
  73. property ButtonCaption;
  74. property BorderStyle;
  75. property CharCase;
  76. property ClickKey;
  77. property Color;
  78. property Ctl3D;
  79. property DragCursor;
  80. property DragMode;
  81. property Enabled;
  82. property Font;
  83. property ButtonWidth;
  84. property HideSelection;
  85. property Anchors;
  86. property BiDiMode;
  87. property Constraints;
  88. property DragKind;
  89. property ParentBiDiMode;
  90. property ImeMode;
  91. property ImeName;
  92. property ParentColor;
  93. property ParentCtl3D;
  94. property ParentFont;
  95. property ParentShowHint;
  96. property PopupMenu;
  97. property ShowHint;
  98. property TabOrder;
  99. property TabStop;
  100. property Text;
  101. property Visible;
  102. property OnButtonClick;
  103. property OnChange;
  104. property OnClick;
  105. property OnDblClick;
  106. property OnDragDrop;
  107. property OnDragOver;
  108. property OnEndDrag;
  109. property OnEnter;
  110. property OnExit;
  111. property OnKeyDown;
  112. property OnKeyPress;
  113. property OnKeyUp;
  114. property OnMouseDown;
  115. property OnMouseMove;
  116. property OnMouseUp;
  117. property OnStartDrag;
  118. property OnContextPopup;
  119. property OnEndDock;
  120. property OnStartDock;
  121. end;
  122. { TFileDirEdit }
  123. { The common parent of TFilenameEdit and TDirectoryEdit }
  124. { For internal use only; it's not intended to be used separately }
  125. const
  126. MaxFileLength = SizeOf(TFileName) - 1;
  127. type
  128. TExecOpenDialogEvent = procedure(Sender: TObject; var Name: string;
  129. var Action: Boolean) of object;
  130. TFileDirEdit = class(TCustomComboEdit)
  131. private
  132. FErrMode: Cardinal;
  133. FAcceptFiles: Boolean;
  134. FOnBeforeDialog: TExecOpenDialogEvent;
  135. FOnAfterDialog: TExecOpenDialogEvent;
  136. procedure SetDragAccept(Value: Boolean);
  137. procedure SetAcceptFiles(Value: Boolean);
  138. procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  139. protected
  140. procedure CreateHandle; override;
  141. procedure DestroyWindowHandle; override;
  142. procedure DoAfterDialog(var FileName: string; var Action: Boolean); dynamic;
  143. procedure DoBeforeDialog(var FileName: string; var Action: Boolean); dynamic;
  144. procedure ReceptFileDir(const AFileName: string); virtual; abstract;
  145. procedure ClearFileList; virtual;
  146. procedure DisableSysErrors;
  147. procedure EnableSysErrors;
  148. property MaxLength;
  149. published
  150. property AcceptFiles: Boolean read FAcceptFiles write SetAcceptFiles default False;
  151. property OnBeforeDialog: TExecOpenDialogEvent read FOnBeforeDialog
  152. write FOnBeforeDialog;
  153. property OnAfterDialog: TExecOpenDialogEvent read FOnAfterDialog
  154. write FOnAfterDialog;
  155. property OnButtonClick;
  156. end;
  157. { TFilenameEdit }
  158. TFileDialogKind = (dkOpen, dkSave , dkOpenPicture,
  159. dkSavePicture);
  160. TFilenameEdit = class(TFileDirEdit)
  161. private
  162. FDialog: TOpenDialog;
  163. FDialogKind: TFileDialogKind;
  164. procedure CreateEditDialog;
  165. function GetFileName: string;
  166. function GetDefaultExt: TFileExt;
  167. function GetFileEditStyle: TFileEditStyle;
  168. function GetFilter: string;
  169. function GetFilterIndex: Integer;
  170. function GetInitialDir: string;
  171. function GetHistoryList: TStrings;
  172. function GetOptions: TOpenOptions;
  173. function GetDialogTitle: string;
  174. function GetDialogFiles: TStrings;
  175. procedure SetDialogKind(Value: TFileDialogKind);
  176. procedure SetFileName(const Value: string);
  177. procedure SetDefaultExt(Value: TFileExt);
  178. procedure SetFileEditStyle(Value: TFileEditStyle);
  179. procedure SetFilter(const Value: string);
  180. procedure SetFilterIndex(Value: Integer);
  181. procedure SetInitialDir(const Value: string);
  182. procedure SetHistoryList(Value: TStrings);
  183. procedure SetOptions(Value: TOpenOptions);
  184. procedure SetDialogTitle(const Value: string);
  185. function IsCustomTitle: Boolean;
  186. function IsCustomFilter: Boolean;
  187. protected
  188. procedure ButtonClick; override;
  189. procedure ReceptFileDir(const AFileName: string); override;
  190. procedure ClearFileList; override;
  191. public
  192. constructor Create(AOwner: TComponent); override;
  193. property Dialog: TOpenDialog read FDialog;
  194. property DialogFiles: TStrings read GetDialogFiles;
  195. published
  196. property DialogKind: TFileDialogKind read FDialogKind write SetDialogKind
  197. default dkOpen;
  198. property DefaultExt: TFileExt read GetDefaultExt write SetDefaultExt;
  199. property FileEditStyle: TFileEditStyle read GetFileEditStyle write SetFileEditStyle
  200. default fsEdit;
  201. property FileName: string read GetFileName write SetFileName stored False;
  202. property Filter: string read GetFilter write SetFilter stored IsCustomFilter;
  203. property FilterIndex: Integer read GetFilterIndex write SetFilterIndex default 1;
  204. property InitialDir: string read GetInitialDir write SetInitialDir;
  205. property HistoryList: TStrings read GetHistoryList write SetHistoryList;
  206. property DialogOptions: TOpenOptions read GetOptions write SetOptions
  207. default [ofHideReadOnly];
  208. property DialogTitle: string read GetDialogTitle write SetDialogTitle
  209. stored IsCustomTitle;
  210. property AutoSelect;
  211. property ButtonHint;
  212. property BorderStyle;
  213. property CharCase;
  214. property ClickKey;
  215. property Color;
  216. property Ctl3D;
  217. property DragCursor;
  218. property DragMode;
  219. property Enabled;
  220. property Font;
  221. property ButtonWidth;
  222. property HideSelection;
  223. property Anchors;
  224. property BiDiMode;
  225. property Constraints;
  226. property DragKind;
  227. property ParentBiDiMode;
  228. property ImeMode;
  229. property ImeName;
  230. property ParentColor;
  231. property ParentCtl3D;
  232. property ParentFont;
  233. property ParentShowHint;
  234. property PopupMenu;
  235. property ShowHint;
  236. property TabOrder;
  237. property TabStop;
  238. property Text;
  239. property Visible;
  240. property OnChange;
  241. property OnClick;
  242. property OnDblClick;
  243. property OnDragDrop;
  244. property OnDragOver;
  245. property OnEndDrag;
  246. property OnEnter;
  247. property OnExit;
  248. property OnKeyDown;
  249. property OnKeyPress;
  250. property OnKeyUp;
  251. property OnMouseDown;
  252. property OnMouseMove;
  253. property OnMouseUp;
  254. property OnStartDrag;
  255. property OnContextPopup;
  256. property OnEndDock;
  257. property OnStartDock;
  258. end;
  259. { TDirectoryEdit }
  260. TDirectoryEdit = class(TFileDirEdit)
  261. private
  262. FInitialDir: string;
  263. FDialogText: string;
  264. protected
  265. procedure ButtonClick; override;
  266. procedure ReceptFileDir(const AFileName: string); override;
  267. public
  268. constructor Create(AOwner: TComponent); override;
  269. published
  270. property DialogText: string read FDialogText write FDialogText;
  271. property InitialDir: string read FInitialDir write FInitialDir;
  272. property AutoSelect;
  273. property ButtonHint;
  274. property BorderStyle;
  275. property CharCase;
  276. property ClickKey;
  277. property Color;
  278. property Ctl3D;
  279. property DragCursor;
  280. property DragMode;
  281. property Enabled;
  282. property Font;
  283. property ButtonWidth;
  284. property HideSelection;
  285. property Anchors;
  286. property BiDiMode;
  287. property Constraints;
  288. property DragKind;
  289. property ParentBiDiMode;
  290. property ImeMode;
  291. property ImeName;
  292. property ParentColor;
  293. property ParentCtl3D;
  294. property ParentFont;
  295. property ParentShowHint;
  296. property PopupMenu;
  297. property ShowHint;
  298. property TabOrder;
  299. property TabStop;
  300. property Text;
  301. property Visible;
  302. property OnChange;
  303. property OnClick;
  304. property OnDblClick;
  305. property OnDragDrop;
  306. property OnDragOver;
  307. property OnEndDrag;
  308. property OnEnter;
  309. property OnExit;
  310. property OnKeyDown;
  311. property OnKeyPress;
  312. property OnKeyUp;
  313. property OnMouseDown;
  314. property OnMouseMove;
  315. property OnMouseUp;
  316. property OnStartDrag;
  317. property OnContextPopup;
  318. property OnEndDock;
  319. property OnStartDock;
  320. end;
  321. EComboEditError = class(Exception);
  322. procedure Register;
  323. implementation
  324. uses
  325. ShellAPI, Consts, ExtDlgs, Variants, PasTools, UITypes;
  326. procedure Register;
  327. begin
  328. RegisterComponents('Martin', [TComboEdit, TFilenameEdit, TDirectoryEdit]);
  329. end;
  330. { Utility functions }
  331. function ValidFileName(const FileName: string): Boolean;
  332. function HasAny(const Str, Substr: string): Boolean;
  333. var
  334. I: Integer;
  335. begin
  336. Result := False;
  337. for I := 1 to Length(Substr) do begin
  338. if Pos(Substr[I], Str) > 0 then begin
  339. Result := True;
  340. Break;
  341. end;
  342. end;
  343. end;
  344. begin
  345. Result := (FileName <> '') and (not HasAny(FileName, '<>"[]|'));
  346. if Result then Result := Pos('\', ExtractFileName(FileName)) = 0;
  347. end;
  348. { TCustomComboEdit }
  349. constructor TCustomComboEdit.Create(AOwner: TComponent);
  350. begin
  351. inherited Create(AOwner);
  352. ControlStyle := ControlStyle + [csCaptureMouse];
  353. AutoSize := False;
  354. FClickKey := scCtrlEnter;
  355. FBtnControl := TWinControl.Create(Self);
  356. with FBtnControl do
  357. begin
  358. ControlStyle := ControlStyle + [csReplicatable];
  359. Width := DefEditBtnWidth;
  360. Height := 17;
  361. Visible := True;
  362. Parent := Self;
  363. end;
  364. FButton := TButton.Create(Self);
  365. with FButton do
  366. begin
  367. SetBounds(0, 0, FBtnControl.Width, FBtnControl.Height);
  368. ControlStyle := ControlStyle + [csReplicatable];
  369. ParentShowHint := True;
  370. Caption := DefButtonCaption;
  371. Visible := True;
  372. Parent := FBtnControl;
  373. OnClick := EditButtonClick;
  374. end;
  375. Height := 21;
  376. end;
  377. destructor TCustomComboEdit.Destroy;
  378. begin
  379. FButton.OnClick := nil;
  380. inherited Destroy;
  381. end;
  382. procedure TCustomComboEdit.CreateParams(var Params: TCreateParams);
  383. begin
  384. inherited CreateParams(Params);
  385. Params.Style := Params.Style or WS_CLIPCHILDREN;
  386. end;
  387. procedure TCustomComboEdit.CreateWnd;
  388. begin
  389. inherited CreateWnd;
  390. SetEditRect;
  391. end;
  392. procedure TCustomComboEdit.KeyDown(var Key: Word; Shift: TShiftState);
  393. begin
  394. inherited KeyDown(Key, Shift);
  395. if (FClickKey = ShortCut(Key, Shift)) and (ButtonWidth > 0) then
  396. begin
  397. EditButtonClick(Self);
  398. Key := 0;
  399. end;
  400. end;
  401. function TCustomComboEdit.GetButtonWidth: Integer;
  402. begin
  403. Result := FButton.Width;
  404. end;
  405. procedure TCustomComboEdit.SetButtonWidth(Value: Integer);
  406. begin
  407. if ButtonWidth <> Value then
  408. begin
  409. FBtnControl.Visible := Value > 1;
  410. if (csCreating in ControlState) then
  411. begin
  412. FBtnControl.Width := Value;
  413. FButton.Width := Value;
  414. with FButton do
  415. ControlStyle := ControlStyle - [csFixedWidth];
  416. end
  417. else if (Value <> ButtonWidth) then
  418. begin
  419. FButton.Width := Value;
  420. with FButton do
  421. ControlStyle := ControlStyle - [csFixedWidth];
  422. if HandleAllocated then UpdateBtnBounds;
  423. end;
  424. end;
  425. end;
  426. function TCustomComboEdit.GetButtonCaption: string;
  427. begin
  428. Result := FButton.Caption;
  429. end;
  430. procedure TCustomComboEdit.SetButtonCaption(Value: string);
  431. begin
  432. FButton.Caption := Value;
  433. end;
  434. function TCustomComboEdit.ButtonCaptionStored: Boolean;
  435. begin
  436. Result := (FButton.Caption <> DefButtonCaption);
  437. end;
  438. function TCustomComboEdit.GetButtonHint: string;
  439. begin
  440. Result := FButton.Hint;
  441. end;
  442. procedure TCustomComboEdit.SetButtonHint(const Value: string);
  443. begin
  444. FButton.Hint := Value;
  445. end;
  446. function TCustomComboEdit.GetButtonTabStop: Boolean;
  447. begin
  448. Result := FButton.TabStop;
  449. end;
  450. procedure TCustomComboEdit.SetButtonTabStop(Value: Boolean);
  451. begin
  452. FButton.TabStop := Value;
  453. end;
  454. procedure TCustomComboEdit.SetEditRect;
  455. var
  456. RMargin: Integer;
  457. begin
  458. RMargin := FBtnControl.Width + ScaleByTextHeight(Self, 2);
  459. SendMessage(Handle, EM_SETMARGINS, EC_RIGHTMARGIN, MakeLong(0, RMargin));
  460. end;
  461. procedure TCustomComboEdit.UpdateBtnBounds;
  462. var
  463. BtnRect: TRect;
  464. begin
  465. if NewStyleControls then begin
  466. if Ctl3D and (BorderStyle = bsSingle) then
  467. BtnRect := Bounds(Width - FButton.Width - 4, 0,
  468. FButton.Width, Height - 4)
  469. else begin
  470. if BorderStyle = bsSingle then
  471. BtnRect := Bounds(Width - FButton.Width - 2, 2,
  472. FButton.Width, Height - 4)
  473. else
  474. BtnRect := Bounds(Width - FButton.Width, 0,
  475. FButton.Width, Height);
  476. end;
  477. end
  478. else
  479. BtnRect := Bounds(Width - FButton.Width, 0, FButton.Width, Height);
  480. with BtnRect do
  481. FBtnControl.SetBounds(Left, Top, Right - Left, Bottom - Top);
  482. FButton.Height := FBtnControl.Height;
  483. if HandleAllocated then SetEditRect;
  484. end;
  485. procedure TCustomComboEdit.CMCtl3DChanged(var Message: TMessage);
  486. begin
  487. inherited;
  488. UpdateBtnBounds;
  489. end;
  490. procedure TCustomComboEdit.WMSize(var Message: TWMSize);
  491. var
  492. MinHeight: Integer;
  493. begin
  494. inherited;
  495. if not (csLoading in ComponentState) then
  496. begin
  497. MinHeight := GetMinHeight;
  498. { text edit bug: if size to less than MinHeight, then edit ctrl does
  499. not display the text }
  500. if Height < MinHeight then
  501. begin
  502. Height := MinHeight;
  503. Exit;
  504. end;
  505. end;
  506. UpdateBtnBounds;
  507. end;
  508. function TCustomComboEdit.GetTextHeight: Integer;
  509. var
  510. DC: HDC;
  511. SaveFont: HFont;
  512. SysMetrics, Metrics: TTextMetric;
  513. begin
  514. DC := GetDC(0);
  515. try
  516. GetTextMetrics(DC, SysMetrics);
  517. SaveFont := SelectObject(DC, Font.Handle);
  518. GetTextMetrics(DC, Metrics);
  519. SelectObject(DC, SaveFont);
  520. finally
  521. ReleaseDC(0, DC);
  522. end;
  523. if SysMetrics.tmHeight < Metrics.tmHeight then Result := SysMetrics.tmHeight
  524. else Result := Metrics.tmHeight;
  525. end;
  526. function TCustomComboEdit.GetMinHeight: Integer;
  527. var
  528. I: Integer;
  529. begin
  530. I := GetTextHeight;
  531. Result := I + GetSystemMetricsForControl(Self, SM_CYBORDER) * 4 + 1;
  532. end;
  533. procedure TCustomComboEdit.CMFontChanged(var Message: TMessage);
  534. begin
  535. inherited;
  536. // Among other, this counters the EM_SETMARGINS call in TCustomEdit.WMSetFont.
  537. // Equivalent to TCustomButtonedEdit.WndProc.
  538. if HandleAllocated then UpdateBtnBounds;
  539. end;
  540. procedure TCustomComboEdit.CMEnabledChanged(var Message: TMessage);
  541. begin
  542. inherited;
  543. FButton.Enabled := Enabled;
  544. end;
  545. procedure TCustomComboEdit.CNCtlColor(var Message: TMessage);
  546. var
  547. TextColor: Longint;
  548. begin
  549. inherited;
  550. if NewStyleControls then begin
  551. TextColor := ColorToRGB(Font.Color);
  552. if not Enabled and (ColorToRGB(Color) <> ColorToRGB(clGrayText)) then
  553. TextColor := ColorToRGB(clGrayText);
  554. SetTextColor(Message.WParam, TextColor);
  555. end;
  556. end;
  557. procedure TCustomComboEdit.EditButtonClick(Sender: TObject);
  558. begin
  559. ButtonClick;
  560. end;
  561. procedure TCustomComboEdit.DoClick;
  562. begin
  563. EditButtonClick(Self);
  564. end;
  565. procedure TCustomComboEdit.ButtonClick;
  566. begin
  567. if Assigned(FOnButtonClick) then FOnButtonClick(Self);
  568. end;
  569. function TCustomComboEdit.BtnWidthStored: Boolean;
  570. begin
  571. Result := ButtonWidth <> DefEditBtnWidth;
  572. end;
  573. { TFileDirEdit }
  574. procedure TFileDirEdit.DoBeforeDialog(var FileName: string;
  575. var Action: Boolean);
  576. begin
  577. if Assigned(FOnBeforeDialog) then FOnBeforeDialog(Self, FileName, Action);
  578. end;
  579. procedure TFileDirEdit.DoAfterDialog(var FileName: string;
  580. var Action: Boolean);
  581. begin
  582. if Assigned(FOnAfterDialog) then FOnAfterDialog(Self, FileName, Action);
  583. end;
  584. procedure TFileDirEdit.CreateHandle;
  585. begin
  586. inherited CreateHandle;
  587. if FAcceptFiles then SetDragAccept(True);
  588. end;
  589. procedure TFileDirEdit.DestroyWindowHandle;
  590. begin
  591. SetDragAccept(False);
  592. inherited DestroyWindowHandle;
  593. end;
  594. procedure TFileDirEdit.SetDragAccept(Value: Boolean);
  595. begin
  596. if not (csDesigning in ComponentState) and (Handle <> 0) then
  597. DragAcceptFiles(Handle, Value);
  598. end;
  599. procedure TFileDirEdit.SetAcceptFiles(Value: Boolean);
  600. begin
  601. if FAcceptFiles <> Value then begin
  602. SetDragAccept(Value);
  603. FAcceptFiles := Value;
  604. end;
  605. end;
  606. procedure TFileDirEdit.DisableSysErrors;
  607. begin
  608. FErrMode := SetErrorMode(SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS);
  609. end;
  610. procedure TFileDirEdit.EnableSysErrors;
  611. begin
  612. SetErrorMode(FErrMode);
  613. FErrMode := 0;
  614. end;
  615. procedure TFileDirEdit.WMDropFiles(var Msg: TWMDropFiles);
  616. var
  617. AFileName: array[0..255] of Char;
  618. Num: Cardinal;
  619. begin
  620. Msg.Result := 0;
  621. try
  622. Num := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0);
  623. if Num > 0 then
  624. begin
  625. ClearFileList;
  626. DragQueryFile(Msg.Drop, 0, PChar(@AFileName), Pred(SizeOf(AFileName)));
  627. ReceptFileDir(StrPas(AFileName));
  628. end;
  629. finally
  630. DragFinish(Msg.Drop);
  631. end;
  632. end;
  633. procedure TFileDirEdit.ClearFileList;
  634. begin
  635. end;
  636. { TFilenameEdit }
  637. function StrPAlloc(const S: string): PChar;
  638. begin
  639. Result := StrPCopy(StrAlloc(Length(S) + 1), S);
  640. end;
  641. function GetParamStr(P: PChar; var Param: string): PChar;
  642. var
  643. Len: Integer;
  644. Buffer: array[Byte] of Char;
  645. begin
  646. while True do
  647. begin
  648. while (P[0] <> #0) and (P[0] <= ' ') do Inc(P);
  649. if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
  650. end;
  651. Len := 0;
  652. while P[0] > ' ' do
  653. if P[0] = '"' then
  654. begin
  655. Inc(P);
  656. while (P[0] <> #0) and (P[0] <> '"') do
  657. begin
  658. Buffer[Len] := P[0];
  659. Inc(Len);
  660. Inc(P);
  661. end;
  662. if P[0] <> #0 then Inc(P);
  663. end else
  664. begin
  665. Buffer[Len] := P[0];
  666. Inc(Len);
  667. Inc(P);
  668. end;
  669. SetString(Param, Buffer, Len);
  670. Result := P;
  671. end;
  672. function ParamCountFromCommandLine(CmdLine: PChar): Integer;
  673. var
  674. S: string;
  675. P: PChar;
  676. begin
  677. P := CmdLine;
  678. Result := 0;
  679. while True do
  680. begin
  681. P := GetParamStr(P, S);
  682. if S = '' then Break;
  683. Inc(Result);
  684. end;
  685. end;
  686. function ParamStrFromCommandLine(CmdLine: PChar; Index: Integer): string;
  687. var
  688. P: PChar;
  689. begin
  690. P := CmdLine;
  691. while True do
  692. begin
  693. P := GetParamStr(P, Result);
  694. if (Index = 0) or (Result = '') then Break;
  695. Dec(Index);
  696. end;
  697. end;
  698. procedure SplitCommandLine(const CmdLine: string; var ExeName,
  699. Params: string);
  700. var
  701. Buffer: PChar;
  702. Cnt, I: Integer;
  703. S: string;
  704. begin
  705. ExeName := '';
  706. Params := '';
  707. Buffer := StrPAlloc(CmdLine);
  708. try
  709. Cnt := ParamCountFromCommandLine(Buffer);
  710. if Cnt > 0 then begin
  711. ExeName := ParamStrFromCommandLine(Buffer, 0);
  712. for I := 1 to Cnt - 1 do begin
  713. S := ParamStrFromCommandLine(Buffer, I);
  714. if Pos(' ', S) > 0 then S := '"' + S + '"';
  715. Params := Params + S;
  716. if I < Cnt - 1 then Params := Params + ' ';
  717. end;
  718. end;
  719. finally
  720. StrDispose(Buffer);
  721. end;
  722. end;
  723. constructor TFilenameEdit.Create(AOwner: TComponent);
  724. begin
  725. inherited Create(AOwner);
  726. CreateEditDialog;
  727. end;
  728. procedure TFilenameEdit.CreateEditDialog;
  729. var
  730. NewDialog: TOpenDialog;
  731. begin
  732. case FDialogKind of
  733. dkOpen: NewDialog := TOpenDialog.Create(Self);
  734. dkOpenPicture: NewDialog := TOpenPictureDialog.Create(Self);
  735. dkSavePicture: NewDialog := TSavePictureDialog.Create(Self);
  736. else {dkSave} NewDialog := TSaveDialog.Create(Self);
  737. end;
  738. try
  739. if FDialog <> nil then begin
  740. with NewDialog do begin
  741. DefaultExt := FDialog.DefaultExt;
  742. FileEditStyle := FDialog.FileEditStyle;
  743. FileName := FDialog.FileName;
  744. Filter := FDialog.Filter;
  745. FilterIndex := FDialog.FilterIndex;
  746. InitialDir := FDialog.InitialDir;
  747. HistoryList := FDialog.HistoryList;
  748. Files.Assign(FDialog.Files);
  749. Options := FDialog.Options;
  750. Title := FDialog.Title;
  751. end;
  752. FDialog.Free;
  753. end
  754. else begin
  755. NewDialog.Title := SBrowse;
  756. NewDialog.Filter := SDefaultFilter;
  757. NewDialog.Options := [ofHideReadOnly];
  758. end;
  759. finally
  760. FDialog := NewDialog;
  761. end;
  762. end;
  763. function TFilenameEdit.IsCustomTitle: Boolean;
  764. begin
  765. Result := CompareStr(SBrowse, FDialog.Title) <> 0;
  766. end;
  767. function TFilenameEdit.IsCustomFilter: Boolean;
  768. begin
  769. Result := CompareStr(SDefaultFilter, FDialog.Filter) <> 0;
  770. end;
  771. procedure TFilenameEdit.ButtonClick;
  772. var
  773. Temp: string;
  774. Action: Boolean;
  775. begin
  776. inherited ButtonClick;
  777. Temp := inherited Text;
  778. Action := True;
  779. DoBeforeDialog(Temp, Action);
  780. if not Action then Exit;
  781. if ValidFileName(Temp) then
  782. try
  783. if DirectoryExists(ExtractFilePath(Temp)) then
  784. SetInitialDir(ExtractFilePath(Temp));
  785. if (ExtractFileName(Temp) = '') or
  786. not ValidFileName(ExtractFileName(Temp)) then Temp := '';
  787. FDialog.FileName := Temp;
  788. except
  789. { ignore any exceptions }
  790. end;
  791. FDialog.HelpContext := Self.HelpContext;
  792. DisableSysErrors;
  793. try
  794. Action := FDialog.Execute;
  795. finally
  796. EnableSysErrors;
  797. end;
  798. if Action then Temp := FDialog.FileName;
  799. if CanFocus then SetFocus;
  800. DoAfterDialog(Temp, Action);
  801. if Action then begin
  802. inherited Text := Temp;
  803. SetInitialDir(ExtractFilePath(FDialog.FileName));
  804. end;
  805. end;
  806. function TFilenameEdit.GetFileName: string;
  807. begin
  808. Result := inherited Text;
  809. end;
  810. procedure TFilenameEdit.SetFileName(const Value: string);
  811. begin
  812. if (Value = '') or ValidFileName(Value) then begin
  813. inherited Text := Value;
  814. ClearFileList;
  815. end
  816. else raise EComboEditError.CreateFmt(SInvalidFilename, [Value]);
  817. end;
  818. procedure TFilenameEdit.ClearFileList;
  819. begin
  820. FDialog.Files.Clear;
  821. end;
  822. procedure TFilenameEdit.ReceptFileDir(const AFileName: string);
  823. begin
  824. SetFileName(AFileName);
  825. end;
  826. function TFilenameEdit.GetDialogFiles: TStrings;
  827. begin
  828. Result := FDialog.Files;
  829. end;
  830. function TFilenameEdit.GetDefaultExt: TFileExt;
  831. begin
  832. Result := FDialog.DefaultExt;
  833. end;
  834. function TFilenameEdit.GetFileEditStyle: TFileEditStyle;
  835. begin
  836. Result := FDialog.FileEditStyle;
  837. end;
  838. function TFilenameEdit.GetFilter: string;
  839. begin
  840. Result := FDialog.Filter;
  841. end;
  842. function TFilenameEdit.GetFilterIndex: Integer;
  843. begin
  844. Result := FDialog.FilterIndex;
  845. end;
  846. function TFilenameEdit.GetInitialDir: string;
  847. begin
  848. Result := FDialog.InitialDir;
  849. end;
  850. function TFilenameEdit.GetHistoryList: TStrings;
  851. begin
  852. Result := FDialog.HistoryList;
  853. end;
  854. function TFilenameEdit.GetOptions: TOpenOptions;
  855. begin
  856. Result := FDialog.Options;
  857. end;
  858. function TFilenameEdit.GetDialogTitle: string;
  859. begin
  860. Result := FDialog.Title;
  861. end;
  862. procedure TFilenameEdit.SetDialogKind(Value: TFileDialogKind);
  863. begin
  864. if FDialogKind <> Value then begin
  865. FDialogKind := Value;
  866. CreateEditDialog;
  867. end;
  868. end;
  869. procedure TFilenameEdit.SetDefaultExt(Value: TFileExt);
  870. begin
  871. FDialog.DefaultExt := Value;
  872. end;
  873. procedure TFilenameEdit.SetFileEditStyle(Value: TFileEditStyle);
  874. begin
  875. FDialog.FileEditStyle := Value;
  876. end;
  877. procedure TFilenameEdit.SetFilter(const Value: string);
  878. begin
  879. FDialog.Filter := Value;
  880. end;
  881. procedure TFilenameEdit.SetFilterIndex(Value: Integer);
  882. begin
  883. FDialog.FilterIndex := Value;
  884. end;
  885. procedure TFilenameEdit.SetInitialDir(const Value: string);
  886. begin
  887. FDialog.InitialDir := Value;
  888. end;
  889. procedure TFilenameEdit.SetHistoryList(Value: TStrings);
  890. begin
  891. FDialog.HistoryList := Value;
  892. end;
  893. procedure TFilenameEdit.SetOptions(Value: TOpenOptions);
  894. begin
  895. if Value <> FDialog.Options then
  896. begin
  897. FDialog.Options := Value;
  898. ClearFileList;
  899. end;
  900. end;
  901. procedure TFilenameEdit.SetDialogTitle(const Value: string);
  902. begin
  903. FDialog.Title := Value;
  904. end;
  905. { TDirectoryEdit }
  906. constructor TDirectoryEdit.Create(AOwner: TComponent);
  907. begin
  908. inherited Create(AOwner);
  909. end;
  910. procedure TDirectoryEdit.ButtonClick;
  911. var
  912. Temp: string;
  913. Action: Boolean;
  914. begin
  915. inherited ButtonClick;
  916. Temp := Text;
  917. Action := True;
  918. DoBeforeDialog(Temp, Action);
  919. if not Action then Exit;
  920. if (Temp = '') then begin
  921. if (InitialDir <> '') then Temp := InitialDir
  922. else Temp := '\';
  923. end;
  924. if not DirectoryExists(Temp) then Temp := '\';
  925. DisableSysErrors;
  926. try
  927. Action := SelectDirectory(FDialogText, '', Temp);
  928. finally
  929. EnableSysErrors;
  930. end;
  931. if CanFocus then SetFocus;
  932. DoAfterDialog(Temp, Action);
  933. if Action then
  934. begin
  935. SelText := '';
  936. Text := Temp;
  937. if (Temp <> '') and DirectoryExists(Temp) then InitialDir := Temp;
  938. end;
  939. end;
  940. procedure TDirectoryEdit.ReceptFileDir(const AFileName: string);
  941. begin
  942. if FileExists(ApiPath(AFileName)) then Text := ExtractFilePath(AFileName)
  943. else Text := AFileName;
  944. end;
  945. initialization
  946. end.