1 {
2 /***************************************************************************
3 inputfiledialog.pas
4 -------------------
5 TInputFileDialog is a dialog to let the user set some filenames.
6
7
8 ***************************************************************************/
9
10 Author: Mattias Gaertner
11
12 *****************************************************************************
13 See the file COPYING.modifiedLGPL.txt, included in this distribution,
14 for details about the license.
15 *****************************************************************************
16 }
17 unit InputFileDialog;
18
19 {$mode objfpc}{$H+}
20
21 interface
22
23 uses
24 Classes, SysUtils, Math,
25 // LCL
26 Forms, Controls, Dialogs, StdCtrls, LResources,
27 // LazUtils
28 LazFileUtils, LazFileCache,
29 // IdeIntf
30 IDEDialogs,
31 // IDE
32 LazarusIDEStrConsts, TransferMacros, InputHistory;
33
34 type
35 TInputFileFlag = (iftDirectory, iftFilename, iftCmdLine,
36 iftNotEmpty, iftMustExist);
37 TInputFileFlags = set of TInputFileFlag;
38
39 TInputFileDialog = class(TForm)
40 OkButton: TButton;
41 CancelButton: TButton;
42 OpenDialog: TOpenDialog;
43 procedure OkButtonClick(Sender: TObject);
44 procedure CancelButtonClick(Sender: TObject);
45 procedure FormResize(Sender: TObject);
46 procedure InputFileDlgButtonClick(Sender: TObject);
47 private
48 FFileCount: integer;
49 FFileTitles: TStringList;
50 FFileDescs: TStringList;
51 FFileNames: TStringList;
52 FFileFlags: ^TInputFileFlags;
53 FInputGroupboxes: TList; // list TGroupBox
54 FInputLabels: TList; // list of list of TLabel
55 FInputDescs: TStringList;
56 FInputEdits: TList; // list of TEdit
57 FInputFileDlgButtons: TList; // list of TButton
58 FTransferMacros: TTransferMacroList;
59 FUpdateCount: integer;
60 FForceUpdate: boolean;
GetFileDescriptionsnull61 function GetFileDescriptions(Index: integer): string;
GetFileTitlesnull62 function GetFileTitles(Index: integer): string;
GetFileFlagsnull63 function GetFileFlags(Index: integer): TInputFileFlags;
GetFilenamesnull64 function GetFilenames(Index: integer): string;
65 procedure SetFileCount(const AValue: integer);
66 procedure SetFileDescriptions(Index: integer; const AValue: string);
67 procedure SetFileTitles(Index: integer; const AValue: string);
68 procedure SetFileFlags(Index: integer; const AValue: TInputFileFlags);
69 procedure SetFilenames(Index: integer; const AValue: string);
70 procedure SetTransferMacros(const AValue: TTransferMacroList);
UpdateNeedednull71 function UpdateNeeded: boolean;
GetInputEditnull72 function GetInputEdit(Index: integer): TEdit;
GetInputFileDlgButtonnull73 function GetInputFileDlgButton(Index: integer): TButton;
GetLabelListnull74 function GetLabelList(Index: integer): TList;
GetLabelnull75 function GetLabel(Index, Line: integer): TLabel;
GetGroupBoxnull76 function GetGroupBox(Index: integer): TGroupBox;
LabelListCountnull77 function LabelListCount(Index: integer): integer;
FileIndexOfFileDlgBtnnull78 function FileIndexOfFileDlgBtn(Button: TButton): integer;
79 procedure CreateInputComponents;
80 procedure CreateMissingGroupBoxes;
81 procedure CreateEditComponents;
82 procedure CreateFileDlgButtonComponents;
83 procedure CreateLabelComponents;
84 procedure DeleteUnusedGroupBoxes;
85 procedure DeleteLabelList(Index: integer);
86 procedure DeleteAllLabels;
87 procedure ResizeComponents;
88 public
89 constructor Create(TheOwner: TComponent); override;
90 destructor Destroy; override;
91 procedure BeginUpdate;
92 procedure EndUpdate;
93 procedure UpdateDlg;
FilenameIsValidForFileIndexnull94 function FilenameIsValidForFileIndex(Filename: string;
95 Index: integer): boolean;
96 public
97 property FileCount: integer read FFileCount write SetFileCount;
98 property FileTitles[Index: integer]: string
99 read GetFileTitles write SetFileTitles;
100 property FileNames[Index: integer]: string
101 read GetFileNames write SetFileNames;
102 property FileDescs[Index: integer]: string
103 read GetFileDescriptions write SetFileDescriptions;
104 property FileFlags[Index: integer]: TInputFileFlags
105 read GetFileFlags write SetFileFlags;
106 property Macros: TTransferMacroList
107 read FTransferMacros write SetTransferMacros;
108 end;
109
GetInputFileDialognull110 function GetInputFileDialog: TInputFileDialog;
111
112
113 implementation
114
115
116 var InputFileDlg: TInputFileDialog;
117
GetInputFileDialognull118 function GetInputFileDialog: TInputFileDialog;
119 begin
120 if InputFileDlg=nil then
121 InputFileDlg:=TInputFileDialog.Create(nil);
122 Result:=InputFileDlg;
123 end;
124
125 { TInputFileDialog }
126
127 procedure TInputFileDialog.OkButtonClick(Sender: TObject);
128 var i: integer;
129 CurEdit: TEdit;
130 begin
131 for i:=0 to FileCount-1 do begin
132 CurEdit:=GetInputEdit(i);
133 CurEdit.Text:=CurEdit.Text;
134 if not FilenameIsValidForFileIndex(CurEdit.Text,i) then begin
135 if IDEMessageDialog(lisA2PInvalidFile,
136 Format(lisCodeToolsDefsValueIsInvalid,
137 [GetGroupBox(i).Caption, LineEnding, CurEdit.Text]),
138 mtInformation, [mbCancel,mbAbort])=mrAbort
139 then
140 ModalResult:=mrCancel
141 else
142 exit;
143 end;
144 FFileNames[i]:=CurEdit.Text;
145 end;
146 ModalResult:=mrOk
147 end;
148
149 procedure TInputFileDialog.CancelButtonClick(Sender: TObject);
150 begin
151 ModalResult:=mrCancel;
152 end;
153
154 procedure TInputFileDialog.FormResize(Sender: TObject);
155 begin
156 ResizeComponents;
157 end;
158
159 procedure TInputFileDialog.InputFileDlgButtonClick(Sender: TObject);
160 var
161 FileIndex: integer;
162 AFilename: string;
163 begin
164 FileIndex:=FileIndexOfFileDlgBtn(TButton(Sender));
165 if FileIndex<0 then exit;
166 if OpenDialog=nil then OpenDialog:=IDEOpenDialogClass.Create(Self);
167 with OpenDialog do begin
168 InputHistories.ApplyFileDialogSettings(OpenDialog);
169 Title:=GetGroupBox(FileIndex).Caption;
170 if (not Execute) then exit;
171 InputHistories.StoreFileDialogSettings(OpenDialog);
172 AFilename:=Filename;
173 if not FilenameIsValidForFileIndex(AFilename,FileIndex) then exit;
174 GetInputEdit(FileIndex).Text:=AFilename;
175 end;
176 end;
177
GetFileDescriptionsnull178 function TInputFileDialog.GetFileDescriptions(Index: integer): string;
179 begin
180 Result:=FFileDescs[Index];
181 end;
182
GetFileTitlesnull183 function TInputFileDialog.GetFileTitles(Index: integer): string;
184 begin
185 Result:=FFileTitles[Index];
186 end;
187
GetFileFlagsnull188 function TInputFileDialog.GetFileFlags(Index: integer): TInputFileFlags;
189 begin
190 Result:=FFileFlags[Index];
191 end;
192
GetFilenamesnull193 function TInputFileDialog.GetFilenames(Index: integer): string;
194 begin
195 Result:=FFileNames[Index];
196 end;
197
198 procedure TInputFileDialog.SetFileCount(const AValue: integer);
199
200 procedure SetStringListCount(sl: TStringlist);
201 begin
202 while sl.Count>AValue do
203 sl.Delete(sl.Count-1);
204 while sl.Count<AValue do
205 sl.Add('');
206 end;
207
208 var i: integer;
209 begin
210 if FFileCount=AValue then exit;
211 BeginUpdate;
212 SetStringListCount(FFileNames);
213 SetStringListCount(FFileDescs);
214 SetStringListCount(FFileTitles);
215 if FFileFlags<>nil then begin
216 FreeMem(FFileFlags);
217 FFileFlags:=nil;
218 end;
219 if AValue>0 then begin
220 Getmem(FFileFlags,SizeOf(TInputFileFlags)*AValue);
221 for i:=0 to AValue-1 do FFileFlags[i]:=[iftDirectory,iftNotEmpty];
222 end;
223 FFileCount:=AValue;
224 EndUpdate;
225 end;
226
227 procedure TInputFileDialog.SetFileDescriptions(Index: integer;
228 const AValue: string);
229 begin
230 FFileDescs[Index]:=AValue;
231 UpdateDlg;
232 end;
233
234 procedure TInputFileDialog.SetFileTitles(Index: integer; const AValue: string);
235 begin
236 FFileTitles[Index]:=AValue;
237 UpdateDlg;
238 end;
239
240 procedure TInputFileDialog.SetFileFlags(Index: integer;
241 const AValue: TInputFileFlags);
242 begin
243 FFileFlags[Index]:=AValue;
244 UpdateDlg;
245 end;
246
247 procedure TInputFileDialog.SetFilenames(Index: integer; const AValue: string);
248 begin
249 FFileNames[Index]:=AValue;
250 UpdateDlg;
251 end;
252
253 procedure TInputFileDialog.SetTransferMacros(const AValue: TTransferMacroList);
254 begin
255 FTransferMacros:=AValue;
256 end;
257
258 procedure TInputFileDialog.UpdateDlg;
259 begin
260 if (FUpdateCount<>0) or (not UpdateNeeded) then exit;
261 CreateInputComponents;
262 FormResize(Self);
263 end;
264
TInputFileDialog.FilenameIsValidForFileIndexnull265 function TInputFileDialog.FilenameIsValidForFileIndex(Filename: string;
266 Index: integer): boolean;
267 var CurFileFlags: TInputFileFlags;
268 begin
269 Result:=false;
270 CurFileFlags:=FileFlags[Index];
271 if (iftNotEmpty in CurFileFlags) and (Filename='') then exit;
272 if ([iftMustExist,iftCmdLine]*CurFileFlags=[iftMustExist])
273 and (Filename<>'') then begin
274 if FTransferMacros<>nil then
275 Macros.SubstituteStr(Filename);
276 Filename:=ExpandFileNameUTF8(Filename);
277 if (not (iftDirectory in CurFileFlags)) and DirPathExistsCached(Filename)
278 then
279 exit;
280 if (not (iftFilename in CurFileFlags)) and FileExistsUTF8(Filename)
281 and (not DirPathExistsCached(Filename))
282 then
283 exit;
284 end;
285 Result:=true;
286 end;
287
UpdateNeedednull288 function TInputFileDialog.UpdateNeeded: boolean;
289 var i: integer;
290 begin
291 Result:=true;
292 if FForceUpdate then exit;
293 FForceUpdate:=true;
294
295 // check file count
296 if FileCount<>FInputEdits.Count then exit;
297
298 // check files
299 for i:=0 to FileCount-1 do begin
300 if FFileTitles[i]<>GetGroupBox(I).Caption then exit;
301 if FFileNames[i]<>GetInputEdit(I).Text then exit;
302 if FFileDescs[i]<>FInputDescs[i] then exit;
303 end;
304
305 FForceUpdate:=false;
306 Result:=false;
307 end;
308
TInputFileDialog.GetInputEditnull309 function TInputFileDialog.GetInputEdit(Index: integer): TEdit;
310 begin
311 Result:=TEdit(FInputEdits[Index]);
312 end;
313
GetInputFileDlgButtonnull314 function TInputFileDialog.GetInputFileDlgButton(Index: integer): TButton;
315 begin
316 Result:=TButton(FInputFileDlgButtons[Index]);
317 end;
318
TInputFileDialog.GetLabelListnull319 function TInputFileDialog.GetLabelList(Index: integer): TList;
320 begin
321 Result:=TList(FInputLabels[Index]);
322 end;
323
GetLabelnull324 function TInputFileDialog.GetLabel(Index, Line: integer): TLabel;
325 begin
326 Result:=TLabel(GetLabelList(Index)[Line]);
327 end;
328
GetGroupBoxnull329 function TInputFileDialog.GetGroupBox(Index: integer): TGroupBox;
330 begin
331 Result:=TGroupBox(FInputGroupboxes[Index]);
332 end;
333
TInputFileDialog.LabelListCountnull334 function TInputFileDialog.LabelListCount(Index: integer): integer;
335 begin
336 Result:=GetLabelList(Index).Count;
337 end;
338
TInputFileDialog.FileIndexOfFileDlgBtnnull339 function TInputFileDialog.FileIndexOfFileDlgBtn(Button: TButton): integer;
340 begin
341 for Result:=0 to FInputFileDlgButtons.Count-1 do
342 if GetInputFileDlgButton(Result)=Button then exit;
343 Result:=-1;
344 end;
345
346 procedure TInputFileDialog.CreateInputComponents;
347 begin
348 CreateMissingGroupBoxes;
349 CreateEditComponents;
350 CreateFileDlgButtonComponents;
351 CreateLabelComponents;
352 DeleteUnusedGroupBoxes;
353 end;
354
355 procedure TInputFileDialog.CreateMissingGroupBoxes;
356 var
357 NewGroupBox: TGroupBox;
358 begin
359 // add new TGroupBoxes
360 while FInputGroupboxes.Count<FFileCount do begin
361 NewGroupBox:=TGroupBox.Create(Self);
362 with NewGroupBox do begin
363 Name:='InputGroupBox'+IntToStr(FInputGroupboxes.Count);
364 Parent:=Self;
365 Visible:=true;
366 end;
367 FInputGroupboxes.Add(NewGroupBox);
368 end;
369 end;
370
371 procedure TInputFileDialog.CreateEditComponents;
372 var
373 NewEdit: TEdit;
374 i: integer;
375 begin
376 // add new TEdits
377 while FInputEdits.Count<FFileCount do begin
378 i:=FInputEdits.Count;
379 NewEdit:=TEdit.Create(Self);
380 with NewEdit do begin
381 Name:='InputEdit'+IntToStr(i);
382 Parent:=GetGroupBox(i);
383 Visible:=true;
384 end;
385 FInputEdits.Add(NewEdit);
386 end;
387 // remove old unused TEdits
388 while FInputEdits.Count>FFileCount do begin
389 GetInputEdit(FInputEdits.Count-1).Free;
390 FInputEdits.Delete(FInputEdits.Count-1);
391 end;
392 // upadte existing TEdits
393 for i:=0 to FInputEdits.Count-1 do
394 GetInputEdit(i).Text:=FFileNames[i];
395 end;
396
397 procedure TInputFileDialog.CreateFileDlgButtonComponents;
398 var NewButton: TButton;
399 i: integer;
400 begin
401 // add new TButtons
402 while FInputFileDlgButtons.Count<FFileCount do begin
403 i:=FInputFileDlgButtons.Count;
404 NewButton:=TButton.Create(Self);
405 with NewButton do begin
406 Name:='InputFileDlgButtin'+IntToStr(i);
407 Parent:=GetGroupBox(i);
408 Caption:='...';
409 OnClick:=@InputFileDlgButtonClick;
410 Visible:=true;
411 end;
412 FInputFileDlgButtons.Add(NewButton);
413 end;
414 // remove unused TButtons
415 while FInputFileDlgButtons.Count>FFileCount do begin
416 GetInputFileDlgButton(FInputFileDlgButtons.Count-1).Free;
417 FInputFileDlgButtons.Delete(FInputFileDlgButtons.Count-1);
418 end;
419 end;
420
421 procedure TInputFileDialog.CreateLabelComponents;
422 var
423 NewLabelList: TList;
424 LabelsAsText: TStringList;
425 ListIndex, i: integer;
426 NewLabel: TLabel;
427 begin
428 LabelsAsText:=TStringList.Create;
429 // add new TLabels
430 for ListIndex:=0 to FFileCount-1 do begin
431 // create TLabel list
432 if FInputLabels.Count<=ListIndex then begin
433 NewLabelList:=TList.Create;
434 FInputLabels.Add(NewLabelList);
435 end else
436 NewLabelList:=GetLabelList(ListIndex);
437 LabelsAsText.Text:=FFileDescs[ListIndex];
438 // create one TLabel for every line
439 for i:=0 to LabelsAsText.Count-1 do begin
440 // create TLabel
441 if NewLabelList.Count<=i then begin
442 NewLabel:=TLabel.Create(Self);
443 NewLabelList.Add(NewLabel);
444 end else
445 NewLabel:=GetLabel(ListIndex,i);
446 with NewLabel do begin
447 Name:='NewLabel'+IntToStr(ListIndex)+'_'+IntToStr(i);
448 Parent:=GetGroupBox(ListIndex);
449 Visible:=true;
450 end;
451 end;
452 // remove unused TLabels
453 while NewLabelList.Count>LabelsAsText.Count do begin
454 GetLabel(ListIndex,NewLabelList.Count-1).Free;
455 NewLabelList.Delete(NewLabelList.Count-1);
456 end;
457 end;
458 // remove unused LabelLists
459 while FInputLabels.Count>FFileCount do begin
460 DeleteLabelList(FInputLabels.Count-1);
461 end;
462 // update label text
463 for ListIndex:=0 to FInputLabels.Count-1 do begin
464 // split description into lines
465 LabelsAsText.Text:=FFileDescs[ListIndex];
466 for i:=0 to LabelListCount(ListIndex)-1 do begin
467 GetLabel(ListIndex,i).Caption:=LabelsAsText[i];
468 end;
469 end;
470 LabelsAsText.Free;
471 end;
472
473 procedure TInputFileDialog.DeleteUnusedGroupBoxes;
474 var
475 i: integer;
476 begin
477 // remove old unused TGroupBoxes
478 while FInputGroupboxes.Count>FFileCount do begin
479 GetGroupBox(FInputGroupboxes.Count-1).Free;
480 FInputGroupboxes.Delete(FInputGroupboxes.Count-1);
481 end;
482 // update existing TGroupBoxes
483 for i:=0 to FInputGroupboxes.Count-1 do
484 GetGroupBox(i).Caption:=FFileTitles[i];
485 end;
486
487 procedure TInputFileDialog.DeleteLabelList(Index: integer);
488 var i: integer;
489 LabelList: TList;
490 begin
491 LabelList:=GetLabelList(Index);
492 for i:=LabelList.Count-1 downto 0 do begin
493 GetLabel(Index,i).Free;
494 LabelList.Delete(i);
495 end;
496 LabelList.Free;
497 FInputLabels.Delete(Index);
498 end;
499
500 procedure TInputFileDialog.ResizeComponents;
501 var
502 y, GroupBoxWidth, GroupBoxLeft, GroupBoxHeight, FileIndex,
503 LabelIndex, LabelLeft, LabelHeight, GroupBoxSpacing, LabelTop, LabelWidth,
504 ButtonWidth, ButtonHeight: integer;
505 CurLabel: TLabel;
506 CurEdit: TEdit;
507 CurButton: TButton;
508 begin
509 GroupBoxSpacing:=10;
510 GroupBoxLeft:=GroupBoxSpacing;
511 GroupBoxWidth:=ClientWidth-GroupBoxLeft*2;
512 y:=GroupBoxSpacing;
513 LabelHeight:=25;
514 // resize input components
515 for FileIndex:=0 to FileCount-1 do begin
516 GroupBoxHeight:=60+LabelListCount(FileIndex)*LabelHeight;
517 GetGroupBox(FileIndex).SetBounds(
518 GroupBoxLeft,y,GroupBoxWidth,GroupBoxHeight);
519 LabelTop:=7;
520 LabelLeft:=10;
521 LabelWidth:=GroupBoxWidth-LabelLeft*2;
522 for LabelIndex:=0 to LabelListCount(FileIndex)-1 do begin
523 CurLabel:=GetLabel(FileIndex,LabelIndex);
524 CurLabel.SetBounds(LabelLeft,LabelTop,LabelWidth,CurLabel.Height);
525 inc(LabelTop,LabelHeight);
526 end;
527 CurButton:=GetInputFileDlgButton(FileIndex);
528 ButtonWidth:=CurButton.Height;
529 ButtonHeight:=CurButton.Height;
530 CurEdit:=GetInputEdit(FileIndex);
531 CurEdit.SetBounds(LabelLeft,LabelTop,
532 LabelWidth-10-ButtonWidth,CurEdit.Height);
533 CurButton.SetBounds(CurEdit.Left+CurEdit.Width+3,LabelTop,
534 ButtonWidth,ButtonHeight);
535 inc(y,GroupBoxHeight+GroupBoxSpacing);
536 end;
537 inc(y,GroupBoxSpacing);
538 // resize ok and cancel button
539 OkButton.SetBounds(Max(GroupBoxLeft,GroupBoxLeft+GroupBoxWidth-250),y,
540 120,OkButton.Height);
541 CancelButton.SetBounds(OkButton.Left+OkButton.Width+10,OkButton.Top,
542 OkButton.Width,OkButton.Height);
543 inc(y,OkButton.Height+GroupBoxSpacing);
544 Height:=y;
545 end;
546
547 procedure TInputFileDialog.DeleteAllLabels;
548 var i: integer;
549 begin
550 for i:=FInputLabels.Count-1 downto 0 do
551 DeleteLabelList(i);
552 end;
553
554 constructor TInputFileDialog.Create(TheOwner: TComponent);
555 begin
556 inherited CreateNew(TheOwner, 1);
557 Position:=poScreenCenter;
558 Width:=500;
559
560 OnResize:=@FormResize;
561
562 OkButton:=TButton.Create(Self);
563 with OkButton do begin
564 Name:='OkButton';
565 Parent:=Self;
566 Caption:=lisMenuOk;
567 OnClick:=@OkButtonClick;
568 Visible:=true;
569 end;
570
571 CancelButton:=TButton.Create(Self);
572 with CancelButton do begin
573 Name:='CancelButton';
574 Parent:=Self;
575 Caption:=lisCancel;
576 OnClick:=@CancelButtonClick;
577 Visible:=true;
578 end;
579
580 FFileCount:=0;
581 FFileTitles:=TStringList.Create;
582 FFileDescs:=TStringList.Create;
583 FFileNames:=TStringList.Create;
584 FInputGroupboxes:=TList.Create;
585 FInputLabels:=TList.Create;
586 FInputDescs:=TStringList.Create;
587 FInputEdits:=TList.Create;
588 FInputFileDlgButtons:=TList.Create;
589 FUpdateCount:=0;
590 end;
591
592 destructor TInputFileDialog.Destroy;
593 begin
594 DeleteAllLabels;
595 FFileTitles.Free;
596 FFileDescs.Free;
597 FFileNames.Free;
598 if FFileFlags<>nil then FreeMem(FFileFlags);
599 FInputGroupboxes.Free;
600 FInputLabels.Free;
601 FInputDescs.Free;
602 FInputEdits.Free;
603 FInputFileDlgButtons.Free;
604 inherited Destroy;
605 end;
606
607 procedure TInputFileDialog.BeginUpdate;
608 begin
609 inc(FUpdateCount);
610 end;
611
612 procedure TInputFileDialog.EndUpdate;
613 begin
614 if FUpdateCount<=0 then exit;
615 dec(FUpdateCount);
616 if FUpdateCount=0 then
617 UpdateDlg;
618 end;
619
620 end.
621
622