ComboEdit.pas 27 KB

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