ComboEdit.pas 27 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048
  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. FAcceptFiles: Boolean;
  133. FOnBeforeDialog: TExecOpenDialogEvent;
  134. FOnAfterDialog: TExecOpenDialogEvent;
  135. procedure SetDragAccept(Value: Boolean);
  136. procedure SetAcceptFiles(Value: Boolean);
  137. procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  138. protected
  139. procedure CreateHandle; override;
  140. procedure DestroyWindowHandle; override;
  141. procedure DoAfterDialog(var FileName: string; var Action: Boolean); dynamic;
  142. procedure DoBeforeDialog(var FileName: string; var Action: Boolean); dynamic;
  143. procedure ReceptFileDir(const AFileName: string); virtual; abstract;
  144. procedure ClearFileList; virtual;
  145. property MaxLength;
  146. published
  147. property AcceptFiles: Boolean read FAcceptFiles write SetAcceptFiles default False;
  148. property OnBeforeDialog: TExecOpenDialogEvent read FOnBeforeDialog
  149. write FOnBeforeDialog;
  150. property OnAfterDialog: TExecOpenDialogEvent read FOnAfterDialog
  151. write FOnAfterDialog;
  152. property OnButtonClick;
  153. end;
  154. { TFilenameEdit }
  155. TFileDialogKind = (dkOpen, dkSave , dkOpenPicture,
  156. dkSavePicture);
  157. TFilenameEdit = class(TFileDirEdit)
  158. private
  159. FDialog: TOpenDialog;
  160. FDialogKind: TFileDialogKind;
  161. procedure CreateEditDialog;
  162. function GetFileName: string;
  163. function GetDefaultExt: TFileExt;
  164. function GetFileEditStyle: TFileEditStyle;
  165. function GetFilter: string;
  166. function GetFilterIndex: Integer;
  167. function GetInitialDir: string;
  168. function GetHistoryList: TStrings;
  169. function GetOptions: TOpenOptions;
  170. function GetDialogTitle: string;
  171. function GetDialogFiles: TStrings;
  172. procedure SetDialogKind(Value: TFileDialogKind);
  173. procedure SetFileName(const Value: string);
  174. procedure SetDefaultExt(Value: TFileExt);
  175. procedure SetFileEditStyle(Value: TFileEditStyle);
  176. procedure SetFilter(const Value: string);
  177. procedure SetFilterIndex(Value: Integer);
  178. procedure SetInitialDir(const Value: string);
  179. procedure SetHistoryList(Value: TStrings);
  180. procedure SetOptions(Value: TOpenOptions);
  181. procedure SetDialogTitle(const Value: string);
  182. function IsCustomTitle: Boolean;
  183. function IsCustomFilter: Boolean;
  184. protected
  185. procedure ButtonClick; override;
  186. procedure ReceptFileDir(const AFileName: string); override;
  187. procedure ClearFileList; override;
  188. public
  189. constructor Create(AOwner: TComponent); override;
  190. property Dialog: TOpenDialog read FDialog;
  191. property DialogFiles: TStrings read GetDialogFiles;
  192. published
  193. property DialogKind: TFileDialogKind read FDialogKind write SetDialogKind
  194. default dkOpen;
  195. property DefaultExt: TFileExt read GetDefaultExt write SetDefaultExt;
  196. property FileEditStyle: TFileEditStyle read GetFileEditStyle write SetFileEditStyle
  197. default fsEdit;
  198. property FileName: string read GetFileName write SetFileName stored False;
  199. property Filter: string read GetFilter write SetFilter stored IsCustomFilter;
  200. property FilterIndex: Integer read GetFilterIndex write SetFilterIndex default 1;
  201. property InitialDir: string read GetInitialDir write SetInitialDir;
  202. property HistoryList: TStrings read GetHistoryList write SetHistoryList;
  203. property DialogOptions: TOpenOptions read GetOptions write SetOptions
  204. default [ofHideReadOnly];
  205. property DialogTitle: string read GetDialogTitle write SetDialogTitle
  206. stored IsCustomTitle;
  207. property AutoSelect;
  208. property ButtonHint;
  209. property BorderStyle;
  210. property CharCase;
  211. property ClickKey;
  212. property Color;
  213. property Ctl3D;
  214. property DragCursor;
  215. property DragMode;
  216. property Enabled;
  217. property Font;
  218. property ButtonWidth;
  219. property HideSelection;
  220. property Anchors;
  221. property BiDiMode;
  222. property Constraints;
  223. property DragKind;
  224. property ParentBiDiMode;
  225. property ImeMode;
  226. property ImeName;
  227. property ParentColor;
  228. property ParentCtl3D;
  229. property ParentFont;
  230. property ParentShowHint;
  231. property PopupMenu;
  232. property ShowHint;
  233. property TabOrder;
  234. property TabStop;
  235. property Text;
  236. property Visible;
  237. property OnChange;
  238. property OnClick;
  239. property OnDblClick;
  240. property OnDragDrop;
  241. property OnDragOver;
  242. property OnEndDrag;
  243. property OnEnter;
  244. property OnExit;
  245. property OnKeyDown;
  246. property OnKeyPress;
  247. property OnKeyUp;
  248. property OnMouseDown;
  249. property OnMouseMove;
  250. property OnMouseUp;
  251. property OnStartDrag;
  252. property OnContextPopup;
  253. property OnEndDock;
  254. property OnStartDock;
  255. end;
  256. { TDirectoryEdit }
  257. TDirectoryEdit = class(TFileDirEdit)
  258. private
  259. FInitialDir: string;
  260. FDialogText: string;
  261. protected
  262. procedure ButtonClick; override;
  263. procedure ReceptFileDir(const AFileName: string); override;
  264. public
  265. constructor Create(AOwner: TComponent); override;
  266. published
  267. property DialogText: string read FDialogText write FDialogText;
  268. property InitialDir: string read FInitialDir write FInitialDir;
  269. property AutoSelect;
  270. property ButtonHint;
  271. property BorderStyle;
  272. property CharCase;
  273. property ClickKey;
  274. property Color;
  275. property Ctl3D;
  276. property DragCursor;
  277. property DragMode;
  278. property Enabled;
  279. property Font;
  280. property ButtonWidth;
  281. property HideSelection;
  282. property Anchors;
  283. property BiDiMode;
  284. property Constraints;
  285. property DragKind;
  286. property ParentBiDiMode;
  287. property ImeMode;
  288. property ImeName;
  289. property ParentColor;
  290. property ParentCtl3D;
  291. property ParentFont;
  292. property ParentShowHint;
  293. property PopupMenu;
  294. property ShowHint;
  295. property TabOrder;
  296. property TabStop;
  297. property Text;
  298. property Visible;
  299. property OnChange;
  300. property OnClick;
  301. property OnDblClick;
  302. property OnDragDrop;
  303. property OnDragOver;
  304. property OnEndDrag;
  305. property OnEnter;
  306. property OnExit;
  307. property OnKeyDown;
  308. property OnKeyPress;
  309. property OnKeyUp;
  310. property OnMouseDown;
  311. property OnMouseMove;
  312. property OnMouseUp;
  313. property OnStartDrag;
  314. property OnContextPopup;
  315. property OnEndDock;
  316. property OnStartDock;
  317. end;
  318. EComboEditError = class(Exception);
  319. procedure Register;
  320. function SelectDirectory(var Directory: string; Prompt: string): Boolean;
  321. implementation
  322. uses
  323. ShellAPI, Consts, ExtDlgs, Variants, PasTools, UITypes, StrUtils;
  324. procedure Register;
  325. begin
  326. RegisterComponents('Martin', [TComboEdit, TFilenameEdit, TDirectoryEdit]);
  327. end;
  328. function SelectDirectory(var Directory: string; Prompt: string): Boolean;
  329. var
  330. Folders: TArray<string>;
  331. begin
  332. // Prompt was originally used with old-style SHBrowseForFolder directory browsing dialog,
  333. // where it is displayed as instructions on a label. Hence it had a dot at the end.
  334. // Now it is used in window title, so we are removing the trailing dot.
  335. if EndsStr('.', Prompt) then
  336. SetLength(Prompt, Length(Prompt) - 1);
  337. Folders := [];
  338. Result :=
  339. FileCtrl.SelectDirectory(Directory, Folders, [], Prompt) and
  340. (Length(Folders) > 0);
  341. if Result then
  342. Directory := Folders[0];
  343. end;
  344. { Utility functions }
  345. function ValidFileName(const FileName: string): Boolean;
  346. function HasAny(const Str, Substr: string): Boolean;
  347. var
  348. I: Integer;
  349. begin
  350. Result := False;
  351. for I := 1 to Length(Substr) do begin
  352. if Pos(Substr[I], Str) > 0 then begin
  353. Result := True;
  354. Break;
  355. end;
  356. end;
  357. end;
  358. begin
  359. Result := (FileName <> '') and (not HasAny(FileName, '<>"[]|'));
  360. if Result then Result := Pos('\', ExtractFileName(FileName)) = 0;
  361. end;
  362. { TCustomComboEdit }
  363. constructor TCustomComboEdit.Create(AOwner: TComponent);
  364. begin
  365. inherited Create(AOwner);
  366. ControlStyle := ControlStyle + [csCaptureMouse];
  367. AutoSize := False;
  368. FClickKey := scCtrlEnter;
  369. FBtnControl := TWinControl.Create(Self);
  370. with FBtnControl do
  371. begin
  372. ControlStyle := ControlStyle + [csReplicatable];
  373. Width := DefEditBtnWidth;
  374. Height := 17;
  375. Visible := True;
  376. Parent := Self;
  377. end;
  378. FButton := TButton.Create(Self);
  379. with FButton do
  380. begin
  381. SetBounds(0, 0, FBtnControl.Width, FBtnControl.Height);
  382. ControlStyle := ControlStyle + [csReplicatable];
  383. ParentShowHint := True;
  384. Caption := DefButtonCaption;
  385. Visible := True;
  386. Parent := FBtnControl;
  387. OnClick := EditButtonClick;
  388. end;
  389. Height := 21;
  390. end;
  391. destructor TCustomComboEdit.Destroy;
  392. begin
  393. FButton.OnClick := nil;
  394. inherited Destroy;
  395. end;
  396. procedure TCustomComboEdit.CreateParams(var Params: TCreateParams);
  397. begin
  398. inherited CreateParams(Params);
  399. Params.Style := Params.Style or WS_CLIPCHILDREN;
  400. end;
  401. procedure TCustomComboEdit.CreateWnd;
  402. begin
  403. inherited CreateWnd;
  404. SetEditRect;
  405. end;
  406. procedure TCustomComboEdit.KeyDown(var Key: Word; Shift: TShiftState);
  407. begin
  408. inherited KeyDown(Key, Shift);
  409. if (FClickKey = ShortCut(Key, Shift)) and (ButtonWidth > 0) then
  410. begin
  411. EditButtonClick(Self);
  412. Key := 0;
  413. end;
  414. end;
  415. function TCustomComboEdit.GetButtonWidth: Integer;
  416. begin
  417. Result := FButton.Width;
  418. end;
  419. procedure TCustomComboEdit.SetButtonWidth(Value: Integer);
  420. begin
  421. if ButtonWidth <> Value then
  422. begin
  423. FBtnControl.Visible := Value > 1;
  424. if (csCreating in ControlState) then
  425. begin
  426. FBtnControl.Width := Value;
  427. FButton.Width := Value;
  428. with FButton do
  429. ControlStyle := ControlStyle - [csFixedWidth];
  430. end
  431. else if (Value <> ButtonWidth) then
  432. begin
  433. FButton.Width := Value;
  434. with FButton do
  435. ControlStyle := ControlStyle - [csFixedWidth];
  436. if HandleAllocated then UpdateBtnBounds;
  437. end;
  438. end;
  439. end;
  440. function TCustomComboEdit.GetButtonCaption: string;
  441. begin
  442. Result := FButton.Caption;
  443. end;
  444. procedure TCustomComboEdit.SetButtonCaption(Value: string);
  445. begin
  446. FButton.Caption := Value;
  447. end;
  448. function TCustomComboEdit.ButtonCaptionStored: Boolean;
  449. begin
  450. Result := (FButton.Caption <> DefButtonCaption);
  451. end;
  452. function TCustomComboEdit.GetButtonHint: string;
  453. begin
  454. Result := FButton.Hint;
  455. end;
  456. procedure TCustomComboEdit.SetButtonHint(const Value: string);
  457. begin
  458. FButton.Hint := Value;
  459. end;
  460. function TCustomComboEdit.GetButtonTabStop: Boolean;
  461. begin
  462. Result := FButton.TabStop;
  463. end;
  464. procedure TCustomComboEdit.SetButtonTabStop(Value: Boolean);
  465. begin
  466. FButton.TabStop := Value;
  467. end;
  468. procedure TCustomComboEdit.SetEditRect;
  469. var
  470. RMargin: Integer;
  471. begin
  472. RMargin := FBtnControl.Width + ScaleByTextHeight(Self, 2);
  473. SendMessage(Handle, EM_SETMARGINS, EC_RIGHTMARGIN, MakeLong(0, RMargin));
  474. end;
  475. procedure TCustomComboEdit.UpdateBtnBounds;
  476. var
  477. BtnRect: TRect;
  478. begin
  479. if NewStyleControls then begin
  480. if Ctl3D and (BorderStyle = bsSingle) then
  481. BtnRect := Bounds(Width - FButton.Width - 4, 0,
  482. FButton.Width, Height - 4)
  483. else begin
  484. if BorderStyle = bsSingle then
  485. BtnRect := Bounds(Width - FButton.Width - 2, 2,
  486. FButton.Width, Height - 4)
  487. else
  488. BtnRect := Bounds(Width - FButton.Width, 0,
  489. FButton.Width, Height);
  490. end;
  491. end
  492. else
  493. BtnRect := Bounds(Width - FButton.Width, 0, FButton.Width, Height);
  494. with BtnRect do
  495. FBtnControl.SetBounds(Left, Top, Right - Left, Bottom - Top);
  496. FButton.Height := FBtnControl.Height;
  497. if HandleAllocated then SetEditRect;
  498. end;
  499. procedure TCustomComboEdit.CMCtl3DChanged(var Message: TMessage);
  500. begin
  501. inherited;
  502. UpdateBtnBounds;
  503. end;
  504. procedure TCustomComboEdit.WMSize(var Message: TWMSize);
  505. var
  506. MinHeight: Integer;
  507. begin
  508. inherited;
  509. if not (csLoading in ComponentState) then
  510. begin
  511. MinHeight := GetMinHeight;
  512. { text edit bug: if size to less than MinHeight, then edit ctrl does
  513. not display the text }
  514. if Height < MinHeight then
  515. begin
  516. Height := MinHeight;
  517. Exit;
  518. end;
  519. end;
  520. UpdateBtnBounds;
  521. end;
  522. function TCustomComboEdit.GetTextHeight: Integer;
  523. var
  524. DC: HDC;
  525. SaveFont: HFont;
  526. SysMetrics, Metrics: TTextMetric;
  527. begin
  528. DC := GetDC(0);
  529. try
  530. GetTextMetrics(DC, SysMetrics);
  531. SaveFont := SelectObject(DC, Font.Handle);
  532. GetTextMetrics(DC, Metrics);
  533. SelectObject(DC, SaveFont);
  534. finally
  535. ReleaseDC(0, DC);
  536. end;
  537. if SysMetrics.tmHeight < Metrics.tmHeight then Result := SysMetrics.tmHeight
  538. else Result := Metrics.tmHeight;
  539. end;
  540. function TCustomComboEdit.GetMinHeight: Integer;
  541. var
  542. I: Integer;
  543. begin
  544. I := GetTextHeight;
  545. Result := I + GetSystemMetricsForControl(Self, SM_CYBORDER) * 4 + 1;
  546. end;
  547. procedure TCustomComboEdit.CMFontChanged(var Message: TMessage);
  548. begin
  549. inherited;
  550. // Among other, this counters the EM_SETMARGINS call in TCustomEdit.WMSetFont.
  551. // Equivalent to TCustomButtonedEdit.WndProc.
  552. if HandleAllocated then UpdateBtnBounds;
  553. end;
  554. procedure TCustomComboEdit.CMEnabledChanged(var Message: TMessage);
  555. begin
  556. inherited;
  557. FButton.Enabled := Enabled;
  558. end;
  559. procedure TCustomComboEdit.CNCtlColor(var Message: TMessage);
  560. var
  561. TextColor: Longint;
  562. begin
  563. inherited;
  564. if NewStyleControls then begin
  565. TextColor := ColorToRGB(Font.Color);
  566. if not Enabled and (ColorToRGB(Color) <> ColorToRGB(clGrayText)) then
  567. TextColor := ColorToRGB(clGrayText);
  568. SetTextColor(Message.WParam, TextColor);
  569. end;
  570. end;
  571. procedure TCustomComboEdit.EditButtonClick(Sender: TObject);
  572. begin
  573. ButtonClick;
  574. end;
  575. procedure TCustomComboEdit.DoClick;
  576. begin
  577. EditButtonClick(Self);
  578. end;
  579. procedure TCustomComboEdit.ButtonClick;
  580. begin
  581. if Assigned(FOnButtonClick) then FOnButtonClick(Self);
  582. end;
  583. function TCustomComboEdit.BtnWidthStored: Boolean;
  584. begin
  585. Result := ButtonWidth <> DefEditBtnWidth;
  586. end;
  587. { TFileDirEdit }
  588. procedure TFileDirEdit.DoBeforeDialog(var FileName: string;
  589. var Action: Boolean);
  590. begin
  591. if Assigned(FOnBeforeDialog) then FOnBeforeDialog(Self, FileName, Action);
  592. end;
  593. procedure TFileDirEdit.DoAfterDialog(var FileName: string;
  594. var Action: Boolean);
  595. begin
  596. if Assigned(FOnAfterDialog) then FOnAfterDialog(Self, FileName, Action);
  597. end;
  598. procedure TFileDirEdit.CreateHandle;
  599. begin
  600. inherited CreateHandle;
  601. if FAcceptFiles then SetDragAccept(True);
  602. end;
  603. procedure TFileDirEdit.DestroyWindowHandle;
  604. begin
  605. SetDragAccept(False);
  606. inherited DestroyWindowHandle;
  607. end;
  608. procedure TFileDirEdit.SetDragAccept(Value: Boolean);
  609. begin
  610. if not (csDesigning in ComponentState) and (Handle <> 0) then
  611. DragAcceptFiles(Handle, Value);
  612. end;
  613. procedure TFileDirEdit.SetAcceptFiles(Value: Boolean);
  614. begin
  615. if FAcceptFiles <> Value then begin
  616. SetDragAccept(Value);
  617. FAcceptFiles := Value;
  618. end;
  619. end;
  620. procedure TFileDirEdit.WMDropFiles(var Msg: TWMDropFiles);
  621. var
  622. AFileName: array[0..255] of Char;
  623. Num: Cardinal;
  624. begin
  625. Msg.Result := 0;
  626. try
  627. Num := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0);
  628. if Num > 0 then
  629. begin
  630. ClearFileList;
  631. DragQueryFile(Msg.Drop, 0, PChar(@AFileName), Pred(SizeOf(AFileName)));
  632. ReceptFileDir(StrPas(AFileName));
  633. end;
  634. finally
  635. DragFinish(Msg.Drop);
  636. end;
  637. end;
  638. procedure TFileDirEdit.ClearFileList;
  639. begin
  640. end;
  641. { TFilenameEdit }
  642. function StrPAlloc(const S: string): PChar;
  643. begin
  644. Result := StrPCopy(StrAlloc(Length(S) + 1), S);
  645. end;
  646. function GetParamStr(P: PChar; var Param: string): PChar;
  647. var
  648. Len: Integer;
  649. Buffer: array[Byte] of Char;
  650. begin
  651. while True do
  652. begin
  653. while (P[0] <> #0) and (P[0] <= ' ') do Inc(P);
  654. if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
  655. end;
  656. Len := 0;
  657. while P[0] > ' ' do
  658. if P[0] = '"' then
  659. begin
  660. Inc(P);
  661. while (P[0] <> #0) and (P[0] <> '"') do
  662. begin
  663. Buffer[Len] := P[0];
  664. Inc(Len);
  665. Inc(P);
  666. end;
  667. if P[0] <> #0 then Inc(P);
  668. end else
  669. begin
  670. Buffer[Len] := P[0];
  671. Inc(Len);
  672. Inc(P);
  673. end;
  674. SetString(Param, Buffer, Len);
  675. Result := P;
  676. end;
  677. function ParamCountFromCommandLine(CmdLine: PChar): Integer;
  678. var
  679. S: string;
  680. P: PChar;
  681. begin
  682. P := CmdLine;
  683. Result := 0;
  684. while True do
  685. begin
  686. P := GetParamStr(P, S);
  687. if S = '' then Break;
  688. Inc(Result);
  689. end;
  690. end;
  691. function ParamStrFromCommandLine(CmdLine: PChar; Index: Integer): string;
  692. var
  693. P: PChar;
  694. begin
  695. P := CmdLine;
  696. while True do
  697. begin
  698. P := GetParamStr(P, Result);
  699. if (Index = 0) or (Result = '') then Break;
  700. Dec(Index);
  701. end;
  702. end;
  703. procedure SplitCommandLine(const CmdLine: string; var ExeName,
  704. Params: string);
  705. var
  706. Buffer: PChar;
  707. Cnt, I: Integer;
  708. S: string;
  709. begin
  710. ExeName := '';
  711. Params := '';
  712. Buffer := StrPAlloc(CmdLine);
  713. try
  714. Cnt := ParamCountFromCommandLine(Buffer);
  715. if Cnt > 0 then begin
  716. ExeName := ParamStrFromCommandLine(Buffer, 0);
  717. for I := 1 to Cnt - 1 do begin
  718. S := ParamStrFromCommandLine(Buffer, I);
  719. if Pos(' ', S) > 0 then S := '"' + S + '"';
  720. Params := Params + S;
  721. if I < Cnt - 1 then Params := Params + ' ';
  722. end;
  723. end;
  724. finally
  725. StrDispose(Buffer);
  726. end;
  727. end;
  728. constructor TFilenameEdit.Create(AOwner: TComponent);
  729. begin
  730. inherited Create(AOwner);
  731. CreateEditDialog;
  732. end;
  733. procedure TFilenameEdit.CreateEditDialog;
  734. var
  735. NewDialog: TOpenDialog;
  736. begin
  737. case FDialogKind of
  738. dkOpen: NewDialog := TOpenDialog.Create(Self);
  739. dkOpenPicture: NewDialog := TOpenPictureDialog.Create(Self);
  740. dkSavePicture: NewDialog := TSavePictureDialog.Create(Self);
  741. else {dkSave} NewDialog := TSaveDialog.Create(Self);
  742. end;
  743. try
  744. if FDialog <> nil then begin
  745. with NewDialog do begin
  746. DefaultExt := FDialog.DefaultExt;
  747. FileEditStyle := FDialog.FileEditStyle;
  748. FileName := FDialog.FileName;
  749. Filter := FDialog.Filter;
  750. FilterIndex := FDialog.FilterIndex;
  751. InitialDir := FDialog.InitialDir;
  752. HistoryList := FDialog.HistoryList;
  753. Files.Assign(FDialog.Files);
  754. Options := FDialog.Options;
  755. Title := FDialog.Title;
  756. end;
  757. FDialog.Free;
  758. end
  759. else begin
  760. NewDialog.Title := SBrowse;
  761. NewDialog.Filter := SDefaultFilter;
  762. NewDialog.Options := [ofHideReadOnly];
  763. end;
  764. finally
  765. FDialog := NewDialog;
  766. end;
  767. end;
  768. function TFilenameEdit.IsCustomTitle: Boolean;
  769. begin
  770. Result := CompareStr(SBrowse, FDialog.Title) <> 0;
  771. end;
  772. function TFilenameEdit.IsCustomFilter: Boolean;
  773. begin
  774. Result := CompareStr(SDefaultFilter, FDialog.Filter) <> 0;
  775. end;
  776. procedure TFilenameEdit.ButtonClick;
  777. var
  778. Temp: string;
  779. Action: Boolean;
  780. begin
  781. inherited ButtonClick;
  782. Temp := inherited Text;
  783. Action := True;
  784. DoBeforeDialog(Temp, Action);
  785. if not Action then Exit;
  786. if ValidFileName(Temp) then
  787. try
  788. if DirectoryExists(ExtractFilePath(Temp)) then
  789. SetInitialDir(ExtractFilePath(Temp));
  790. if (ExtractFileName(Temp) = '') or
  791. not ValidFileName(ExtractFileName(Temp)) then Temp := '';
  792. FDialog.FileName := Temp;
  793. except
  794. { ignore any exceptions }
  795. end;
  796. FDialog.HelpContext := Self.HelpContext;
  797. Action := FDialog.Execute;
  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. Action := SelectDirectory(Temp, FDialogText);
  926. if CanFocus then SetFocus;
  927. DoAfterDialog(Temp, Action);
  928. if Action then
  929. begin
  930. SelText := '';
  931. Text := Temp;
  932. if (Temp <> '') and DirectoryExists(Temp) then InitialDir := Temp;
  933. end;
  934. end;
  935. procedure TDirectoryEdit.ReceptFileDir(const AFileName: string);
  936. begin
  937. if FileExists(ApiPath(AFileName)) then Text := ExtractFilePath(AFileName)
  938. else Text := AFileName;
  939. end;
  940. initialization
  941. end.