FreeLaunch

1
{
2
  ##########################################################################
3
  #  FreeLaunch is a free links manager for Microsoft Windows              #
4
  #                                                                        #
5
  #  Copyright (C) 2022 Alexey Tatuyko <feedback@ta2i4.ru>                 #
6
  #  Copyright (C) 2019 Mykola Petrivskiy                                  #
7
  #  Copyright (C) 2010 Joker-jar <joker-jar@yandex.ru>                    #
8
  #                                                                        #
9
  #  This file is part of FreeLaunch.                                      #
10
  #                                                                        #
11
  #  FreeLaunch is free software: you can redistribute it and/or modify    #
12
  #  it under the terms of the GNU General Public License as published by  #
13
  #  the Free Software Foundation, either version 3 of the License, or     #
14
  #  (at your option) any later version.                                   #
15
  #                                                                        #
16
  #  FreeLaunch is distributed in the hope that it will be useful,         #
17
  #  but WITHOUT ANY WARRANTY; without even the implied warranty of        #
18
  #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         #
19
  #  GNU General Public License for more details.                          #
20
  #                                                                        #
21
  #  You should have received a copy of the GNU General Public License     #
22
  #  along with FreeLaunch. If not, see <http://www.gnu.org/licenses/>.    #
23
  ##########################################################################
24
}
25

26
unit FLDialogs;
27

28
interface
29

30
function ProgramSelect(AFileName: string): string;
31
function FileOrDirSelect(AFileName: string): string;
32

33
implementation
34

35
uses
36
  System.SysUtils, VCL.Dialogs, Vcl.Forms, Winapi.Windows, Winapi.Messages,
37
  Winapi.ShlObj, Winapi.ActiveX, System.Win.ComObj, FLLanguage, FLFunctions;
38

39
type
40
  TFileOrDirDialog = class
41
    FOpenDialog: TFileOpenDialog;
42
    FFileName: string;
43
    procedure OpenDialogFolderChange(Sender: TObject);
44
    function BrowseDialog(Handle: HWnd; Title: string; var OutDir: string): boolean;
45
  public
46
    property FileName: string read FFileName;
47
    function Execute: Boolean;
48
    constructor Create(AFileName: string);
49
    destructor Destroy; override;
50
  end;
51

52
function ProgramSelect(AFileName: string): string;
53
var
54
  Dialog: TOpenDialog;
55
  CurrentFile: string;
56
begin
57
  Dialog := TOpenDialog.Create(Nil);
58
  try
59
    Dialog.Filter := Language.Properties.ProgramFilter + '|*.exe;*.bat';
60
    Dialog.Options := Dialog.Options + [ofFileMustExist, ofNoDereferenceLinks];
61

62
    CurrentFile := GetAbsolutePath(AFileName);
63
    if FileExists(CurrentFile) then
64
    begin
65
      Dialog.FileName := CurrentFile;
66
      Dialog.InitialDir := ExtractFilePath(CurrentFile);
67
    end;
68

69
    if Dialog.Execute then
70
    begin
71
      Result := Dialog.FileName;
72

73
      if IsPortable then
74
        Result := PathToPortable(Dialog.FileName);
75
    end
76
    else
77
      Result := AFileName;
78
  finally
79
    Dialog.Free;
80
  end;
81
end;
82

83
function BffCallBackF(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer; stdcall;
84
begin
85
  if (uMsg = BFFM_INITIALIZED) then
86
    begin
87
      if (lpData <> 0) then
88
        begin
89
          SendMessage(Wnd, BFFM_SETSELECTION, 1, lpData);
90
        end;
91
    end;
92
  result := 0;
93
end;
94

95
function TFileOrDirDialog.BrowseDialog(Handle: HWnd; Title: string;
96
  var OutDir: string): boolean;
97
var
98
  lpItemID: PItemIDList;
99
  BrowseInfo: TBrowseInfo;
100
  DisplayName, CurDir: array [0..MAX_PATH] of char;
101
begin
102
  Result := false;
103
  FillChar(DisplayName, sizeof(DisplayName), #0);
104
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
105
  StrPCopy(CurDir, OutDir);
106
  with BrowseInfo do
107
  begin
108
    hwndOwner := Handle;
109
    pszDisplayName := @DisplayName;
110
    lpszTitle := PChar(Title);
111
    lParam := Winapi.Windows.LPARAM(@CurDir);
112
    lpfn := @BffCallBackF;  //BrowseCallbackProc
113
    ulFlags := BIF_SHAREABLE or BIF_BROWSEINCLUDEFILES or BIF_USENEWUI or
114
      BIF_RETURNONLYFSDIRS;
115
  end;
116
  lpItemID := SHBrowseForFolder(BrowseInfo);
117
  if lpItemId <> nil then
118
  begin
119
    SHGetPathFromIDList(lpItemID, CurDir);
120
    OutDir := CurDir;
121
    Result := true;
122
    GlobalFreePtr(lpItemID);
123
  end;
124
end;
125

126
constructor TFileOrDirDialog.Create(AFileName: string);
127
begin
128
  FFileName := AFileName;
129
  FOpenDialog := TFileOpenDialog.Create(Nil);
130
  FOpenDialog.Options := [fdoNoValidate, fdoPathMustExist];
131
end;
132

133
destructor TFileOrDirDialog.Destroy;
134
begin
135
  FOpenDialog.Free;
136
  inherited;
137
end;
138

139
function TFileOrDirDialog.Execute: Boolean;
140
var
141
  FilePath: string;
142
begin
143
  FilePath := ExtractFilePath(FFileName);
144
  if DirectoryExists(FilePath) then
145
    FOpenDialog.DefaultFolder := FilePath;
146
    FOpenDialog.FileName := 'Select file or directory';
147
    Result := FOpenDialog.Execute;
148
    if Result then
149
    begin
150
      if FileExists(FOpenDialog.FileName) then
151
        FFileName := FOpenDialog.FileName
152
      else
153
        FFileName := ExtractFilePath(FOpenDialog.FileName);
154
    end;
155
end;
156

157
procedure TFileOrDirDialog.OpenDialogFolderChange(Sender: TObject);
158
var
159
  DialogWnd: IOleWindow;
160
  DialogHandle, ComboHandle: HWND;
161
begin
162
  DialogWnd := FOpenDialog.Dialog as IOleWindow;
163
  OleCheck(DialogWnd.GetWindow(DialogHandle));
164
  ComboHandle := FindWindowEx(DialogHandle, 0, 'ComboBoxEx32', nil);
165
  if ComboHandle <> 0 then
166
    SendMessage(ComboHandle, WM_SETTEXT, 0, LPARAM(PChar('Select file or directory')));
167
end;
168

169
function FileOrDirSelect(AFileName: string): string;
170
var
171
  FileOrDirDialog: TFileOrDirDialog;
172
begin
173
  FileOrDirDialog := TFileOrDirDialog.Create(GetAbsolutePath(AFileName));
174
  try
175
    if FileOrDirDialog.Execute then
176
    begin
177
      Result := FileOrDirDialog.FileName;
178

179
      if IsPortable then
180
        Result := PathToPortable(FileOrDirDialog.FileName);
181
    end
182
    else
183
      Result := AFileName;
184
  finally
185
    FileOrDirDialog.Free;
186
  end;
187
end;
188

189
end.
190