ComboEdit.pas 28 KB

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