1 unit unit1;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, types, chmsitemap, chmfilewriter,
9 Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, Menus, ExtCtrls, EditBtn,
10 LazFileUtils, UTF8Process;
11
12 type
13
14 { TCHMForm }
15
16 TCHMForm = class(TForm)
17 AddFilesBtn: TButton;
18 AutoAddLinksBtn: TButton;
19 AddAllBtn: TButton;
20 CompileViewBtn: TButton;
21 CompileBtn: TButton;
22 DefaultPageCombo: TComboBox;
23 ChmFileNameEdit: TFileNameEdit;
24 FollowLinksCheck: TCheckBox;
25 CreateSearchableCHMCheck: TCheckBox;
26 CompileTimeOptionsLabel: TLabel;
27 FilesNoteLabel: TLabel;
28 DefaultPageLabel: TLabel;
29 CHMFilenameLabel: TLabel;
30 OpenDialog2: TOpenDialog;
31 RemoveFilesBtn: TButton;
32 TOCEditBtn: TButton;
33 IndexEditBtn: TButton;
34 IndexEdit: TFileNameEdit;
35 GroupBox1: TGroupBox;
36 FileListBox: TListBox;
37 TableOfContentsLabel: TLabel;
38 IndexLabel: TLabel;
39 MainMenu1: TMainMenu;
40 MenuItem1: TMenuItem;
41 ProjSaveItem: TMenuItem;
42 ProjSaveAsItem: TMenuItem;
43 MenuItem12: TMenuItem;
44 ProjQuitItem: TMenuItem;
45 CompileItem: TMenuItem;
46 CompileProjItem: TMenuItem;
47 CompileOpenBttn: TMenuItem;
48 ProjCloseItem: TMenuItem;
49 MenuItem3: TMenuItem;
50 HelpHelpItem: TMenuItem;
51 MenuItem5: TMenuItem;
52 HelpAboutItem: TMenuItem;
53 ProjNewItem: TMenuItem;
54 ProjOpenItem: TMenuItem;
55 MenuItem9: TMenuItem;
56 OpenDialog1: TOpenDialog;
57 MainPanel: TPanel;
58 Panel2: TPanel;
59 SaveDialog1: TSaveDialog;
60 StatusBar1: TStatusBar;
61 TOCEdit: TFileNameEdit;
62 procedure AddAllBtnClick(Sender: TObject);
63 procedure AddFilesBtnClick(Sender: TObject);
64 procedure AutoAddLinksBtnClick(Sender: TObject);
65 procedure Button1Click(Sender: TObject);
66 procedure Button2Click(Sender: TObject);
67 procedure ChmFileNameEditAcceptFileName(Sender: TObject; var Value: String);
68 procedure CompileBtnClick(Sender: TObject);
69 procedure CompileViewBtnClick(Sender: TObject);
70 procedure FileListBoxDrawItem({%H-}Control: TWinControl; Index: Integer;
71 ARect: TRect; {%H-}State: TOwnerDrawState);
72 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
73 procedure FormCreate(Sender: TObject);
74 procedure FormDestroy(Sender: TObject);
75 procedure IndexEditAcceptFileName(Sender: TObject; var Value: String);
76 procedure IndexEditBtnClick(Sender: TObject);
77 procedure ProjCloseItemClick(Sender: TObject);
78 procedure ProjNewItemClick(Sender: TObject);
79 procedure ProjOpenItemClick(Sender: TObject);
80 procedure ProjQuitItemClick(Sender: TObject);
81 procedure ProjSaveAsItemClick(Sender: TObject);
82 procedure ProjSaveItemClick(Sender: TObject);
83 procedure RemoveFilesBtnClick(Sender: TObject);
84 procedure TOCEditAcceptFileName(Sender: TObject; var Value: String);
85 procedure TOCEditBtnClick(Sender: TObject);
86 private
87 FModified: Boolean;
88 procedure AddItems({%H-}AParentItem: TTreeNode; {%H-}ChmItems: TChmSiteMapItems);
89
GetModifiednull90 function GetModified: Boolean;
91 procedure Save(aAs: Boolean);
92 procedure CloseProject;
93
94 procedure AddFilesToProject(Strings: TStrings);
95 procedure InitFileDialog(Dlg: TFileDialog);
96 procedure ProjectDirChanged;
CreateRelativeProjectFilenull97 function CreateRelativeProjectFile(Filename: string): string;
CreateAbsoluteProjectFilenull98 function CreateAbsoluteProjectFile(Filename: string): string;
99 public
100 Project: TChmProject;
101 procedure OpenProject(AFileName: String);
102 // Dirty flag: has project been modified since opening?
103 property Modified: Boolean read GetModified write FModified;
104 end;
105
106 var
107 CHMForm: TCHMForm;
108
109 implementation
110
111 {$R *.lfm}
112
113 uses CHMSiteMapEditor, LHelpControl, Process;
114
115 { TCHMForm }
116
117 procedure TCHMForm.AddItems(AParentItem: TTreeNode; ChmItems: TChmSiteMapItems);
118 begin
119 { for I := 0 to ChmItems.Count-1 do begin
120 Item := TreeView1.Items.AddChild(AParentItem, ChmItems.Item[I].Text);
121 AddItems(Item, ChmItems.Item[I].Children);
122 end;
123 } end;
124
125 procedure TCHMForm.Button1Click(Sender: TObject);
126 begin
127 {SiteMap := TChmSiteMap.Create(stTOC);
128 OpenDialog1.InitialDir := GetCurrentDir;
129 if OpenDialog1.Execute = False then Exit;
130 SiteMap.LoadFromFile(OpenDialog1.FileName);
131 AddItems(nil, sitemap.Items);
132
133 Stream := TMemoryStream.Create;
134
135 Sitemap.SaveToStream(Stream);
136 Stream.Position := 0;
137
138 SynEdit1.Lines.LoadFromStream(Stream);
139 Stream.Free;
140 }
141 end;
142
143 procedure TCHMForm.AddFilesBtnClick(Sender: TObject);
144 begin
145 InitFileDialog(OpenDialog2);
146 if OpenDialog2.Execute = False then exit;
147 Modified := True;
148 AddFilesToProject(OpenDialog2.Files);
149 end;
150
151 procedure TCHMForm.AddAllBtnClick(Sender: TObject);
152 var
153 Files: TStrings;
154 procedure AddDir(ADir: String);
155 var
156 SearchRec: TSearchRec;
157 FileName: String;
158 begin
159 // WriteLn('Adding Dir: ', ADir);
160 if FindFirst(ADir+'*', faAnyFile or faDirectory, SearchRec) = 0 then
161 begin
162 repeat
163 if (SearchRec.Attr and faDirectory) <> 0 then
164 begin
165 if Pos('.', SearchRec.Name) = 0 then
166 begin
167 AddDir(IncludeTrailingPathDelimiter(ADir+SearchRec.Name));
168 end;
169 end
170 else
171 begin
172 FileName := ADir+SearchRec.Name;
173 FileName := ExtractRelativepath(Project.ProjectDir, FileName);
174 if Files.IndexOf(FileName) = -1 then
175 Files.Add(FileName);
176 end;
177 until FindNext(SearchRec) <> 0;
178 FindClose(SearchRec);
179 end;
180 end;
181 begin
182 if MessageDlg('This will add all files in the project directory ' + LineEnding +
183 'recursively. Do you want to continue?',
184 mtConfirmation, [mbYes, mbNo],0) = mrNo then exit;
185 Modified := True;
186 Files := TStringList.Create;
187 try
188 Files.AddStrings(FileListBox.Items);
189 AddDir(Project.ProjectDir);
190 FileListBox.Items.Assign(Files);
191 finally
192 Files.Free;
193 end;
194 end;
195
196 procedure TCHMForm.AutoAddLinksBtnClick(Sender: TObject);
197 begin
198 Modified := True;
199 end;
200
201 procedure TCHMForm.Button2Click(Sender: TObject);
202 begin
203 {
204 if OpenDialog1.Execute = False then Exit;
205 OutStream := TFileStream.Create('/home/andrew/test.chm', fmCreate or fmOpenWrite);
206 Chm := TChmWriter.Create(OutStream, False);
207 Chm.FilesToCompress.AddStrings(OpenDialog1.Files);
208 Chm.GetFileData := @GetData;
209 Chm.Title := 'test';
210 Chm.DefaultPage := 'index.html';
211 Chm.Execute;
212 OutStream.Free;
213 Chm.Free;
214 }
215
216
217 end;
218
219 procedure TCHMForm.ChmFileNameEditAcceptFileName(Sender: TObject; var Value: String);
220 begin
221 if ExtractFileExt(Value) = '' then Value := Value+'.chm';
222 end;
223
224 procedure TCHMForm.CompileBtnClick(Sender: TObject);
225 var
226 OutFile: TFileStream;
227 begin
228 if ChmFileNameEdit.FileName = '' then
229 begin
230 MessageDlg('You must set a filename for the output CHM file!', mtError, [mbCancel], 0);
231 Exit;
232 end;
233 Save(False);
234 OutFile := TFileStream.Create(Project.OutputFileName, fmCreate or fmOpenWrite);
235 try
236 Project.WriteChm(OutFile);
237 ShowMessage('CHM file '+ChmFileNameEdit.FileName+' was created.');
238 finally
239 OutFile.Free;
240 end;
241 end;
242
243
244 procedure TCHMForm.CompileViewBtnClick(Sender: TObject);
245 var
246 LHelpName: String;
247 LHelpConn: TLHelpConnection;
248 Proc: TProcessUTF8;
249 ext: String;
250 begin
251 if ChmFileNameEdit.FileName = '' then
252 begin
253 MessageDlg('You must set a filename for the output CHM file!', mtError, [mbCancel], 0);
254 Exit;
255 end;
256 CompileBtnClick(Sender);
257 // open
258 // ...
259 ext := ExtractFileExt(Application.ExeName);
260 LHelpName := '../../components/chmhelp/lhelp/lhelp' + ext;
261 if not FileExists(LHelpName) then
262 begin
263 if MessageDlg('LHelp could not be located at '+ LHelpName +' Try to build using lazbuild?', mtError, [mbCancel, mbYes], 0) = mrYes then
264 begin
265 if not FileExists('../../lazbuild' + ext) then
266 begin
267 MessageDlg('lazbuild coul not be found.', mtError, [mbCancel], 0);
268 Exit;
269 end;
270 Proc := TProcessUTF8.Create(Self);
271 Proc.CommandLine := '../../../lazbuild ./lhelp.lpi';
272 SetCurrentDir('../../components/chmhelp/lhelp/');
273 Proc.Options := [poWaitOnExit];
274 Proc.Execute;
275 SetCurrentDir('../../../tools/chmmaker/');
276 if Proc.ExitStatus <> 0 then
277 begin
278 MessageDlg('lhelp failed to build', mtError, [mbCancel], 0);
279 Exit;
280 end;
281 Proc.Free;
282 end
283 else
284 Exit;
285 end;
286 LHelpConn := TLHelpConnection.Create;
287 try
288 LHelpConn.StartHelpServer('chmmaker', LHelpName);
289 LHelpConn.OpenFile(ChmFileNameEdit.FileName);
290 finally
291 LHelpConn.Free;
292 end;
293 end;
294
295 procedure TCHMForm.FileListBoxDrawItem(Control: TWinControl; Index: Integer;
296 ARect: TRect; State: TOwnerDrawState);
297 begin
298 FileListbox.Canvas.FillRect(ARect);
299 if Pos('..', FileListBox.Items.Strings[Index]) > 0 then
300 begin
301 // These items won't be added to the chm because they are not within the project dir
302 // so mark them with a red rectangle
303 Dec(ARect.Right);
304 Dec(ARect.Bottom);
305 FileListBox.Canvas.Pen.Color := clRed;
306 FileListBox.Canvas.Frame(ARect);
307 end;
308 // Draw item text
309 FileListBox.Canvas.TextRect(ARect,
310 2, (ARect.Top + ARect.Bottom - FileListbox.Canvas.TextHeight('Tg')) div 2,
311 FileListBox.Items[Index]
312 );
313 end;
314
315 procedure TCHMForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
316 var
317 MResult: Integer;
318 begin
319 if Modified then
320 begin
321 MResult := MessageDlg('Project is modified would you like to save the changes?', mtConfirmation,
322 [mbYes, mbNo, mbCancel], 0);
323 case MResult of
324 mrYes: Save(False);
325 mrNo: CloseAction := caFree;
326 mrCancel: CloseAction := caNone;
327 end;
328 end;
329 end;
330
331 procedure TCHMForm.FormCreate(Sender: TObject);
332 begin
333 CloseProject;
334 end;
335
336 procedure TCHMForm.FormDestroy(Sender: TObject);
337 begin
338 CloseProject;
339 end;
340
341 procedure TCHMForm.IndexEditAcceptFileName(Sender: TObject; var Value: String);
342 begin
343 Modified := True;
344 //Value := ExtractRelativepath(Project.ProjectDir, Value);
345 //WriteLn(Value);
346 Project.IndexFileName := Value;
347 end;
348
349 procedure TCHMForm.IndexEditBtnClick(Sender: TObject);
350 var
351 Stream: TStream;
352 FileName: String;
353 begin
354 FileName := IndexEdit.FileName;
355 if FileName = '' then
356 begin
357 FileName := Project.ProjectDir+'_index.hhk'
358 end;
359
360 if FileExists(FileName) then
361 begin
362 Stream := TFileStream.Create(FileName, fmOpenReadWrite);
363 end
364 else
365 begin
366 Stream := TFileStream.Create(FileName, fmCreate or fmOpenReadWrite);
367 end;
368
369 try
370 if SitemapEditForm.Execute(Stream, stIndex, FileListBox.Items) then IndexEdit.FileName := FileName;
371 finally
372 Stream.Free;
373 end;
374 end;
375
376 procedure TCHMForm.ProjCloseItemClick(Sender: TObject);
377 begin
378 CloseProject;
379 end;
380
381 procedure TCHMForm.ProjNewItemClick(Sender: TObject);
382 begin
383 InitFileDialog(SaveDialog1);
384 If SaveDialog1.Execute then
385 begin
386 if FileExists(SaveDialog1.FileName)
387 and (MessageDlg('File Already Exists! Ovewrite?', mtWarning, [mbYes, mbNo],0) = mrNo) then Exit;
388 OpenProject(SaveDialog1.FileName);
389 Project.SaveToFile(SaveDialog1.FileName);
390 end;
391 end;
392
393 procedure TCHMForm.ProjOpenItemClick(Sender: TObject);
394 begin
395 InitFileDialog(OpenDialog1);
396 if OpenDialog1.Execute then
397 begin
398 CloseProject;
399 OpenProject(OpenDialog1.FileName);
400 end;
401 end;
402
403 procedure TCHMForm.ProjQuitItemClick(Sender: TObject);
404 begin
405 Close;
406 end;
407
408 procedure TCHMForm.ProjSaveAsItemClick(Sender: TObject);
409 begin
410 Save(True);
411 end;
412
413 procedure TCHMForm.ProjSaveItemClick(Sender: TObject);
414 begin
415 Save(False);
416 end;
417
418 procedure TCHMForm.RemoveFilesBtnClick(Sender: TObject);
419 var
420 I: Integer;
421 begin
422 Modified := True;
423 for I := FileListBox.Items.Count-1 downto 0 do
424 if FileListBox.Selected[I] then FileListBox.Items.Delete(I);
425 DefaultPageCombo.Items.Assign(FileListBox.Items);
426 end;
427
428 procedure TCHMForm.TOCEditAcceptFileName(Sender: TObject; var Value: String);
429 begin
430 Modified := True;
431 Project.TableOfContentsFileName := Value;
432 end;
433
434 procedure TCHMForm.TOCEditBtnClick(Sender: TObject);
435 var
436 Stream: TStream;
437 FileName: String;
438 BDir: String;
439 begin
440 FileName := TOCEdit.FileName;
441 if FileName = '' then
442 begin
443 FileName := Project.ProjectDir+'_table_of_contents.hhc'
444 end;
445
446 if FileExists(FileName) then
447 begin
448 Stream := TFileStream.Create(FileName, fmOpenReadWrite);
449 end
450 else
451 begin
452 Stream := TFileStream.Create(FileName, fmCreate or fmOpenReadWrite);
453 end;
454
455 try
456 BDir := ExtractFilePath(Project.FileName);
457 FileName := ExtractRelativepath(BDir, FileName);
458 if SitemapEditForm.Execute(Stream, stTOC, FileListBox.Items) then TOCEdit.FileName := FileName;
459 finally
460 Stream.Free;
461 end;
462 end;
463
GetModifiednull464 function TCHMForm.GetModified: Boolean;
465 begin
466 Result := (Project <> nil) and FModified;
467 end;
468
469 procedure TCHMForm.Save(aAs: Boolean);
470 begin
471 if aAs or (Project.FileName = '') then
472 begin
473 InitFileDialog(SaveDialog1);
474 if SaveDialog1.Execute then
475 begin
476 Project.FileName := ChangeFileExt(SaveDialog1.FileName,'.hfp');
477 ProjectDirChanged;
478 end;
479 end;
480 Project.Files.Assign(FileListBox.Items);
481 Project.TableOfContentsFileName := CreateRelativeProjectFile(TOCEdit.FileName);
482 Project.IndexFileName := CreateRelativeProjectFile(IndexEdit.FileName);
483 Project.DefaultPage := DefaultPageCombo.Text;
484 Project.AutoFollowLinks := FollowLinksCheck.Checked;
485 Project.MakeSearchable := CreateSearchableCHMCheck.Checked;
486 Project.OutputFileName := CreateRelativeProjectFile(ChmFileNameEdit.FileName);
487
488 Project.SaveToFile(Project.FileName);
489 Modified := False;
490 end;
491
492 procedure TCHMForm.CloseProject;
493 begin
494 FileListBox.Clear;
495 DefaultPageCombo.Clear;
496 TOCEdit.Clear;
497 IndexEdit.Clear;
498 GroupBox1.Enabled := False;
499 MainPanel.Enabled := False;
500 CompileItem.Enabled := False;
501 ProjSaveAsItem.Enabled := False;
502 ProjSaveItem.Enabled := False;
503 ProjCloseItem.Enabled := False;
504
505 FollowLinksCheck.Checked := False;
506 CreateSearchableCHMCheck.Checked := False;
507 FreeAndNil(Project);
508 end;
509
510 procedure TCHMForm.OpenProject(AFileName: String);
511 begin
512 if not Assigned(Project) then Project := TChmProject.Create;
513 Project.LoadFromFile(AFileName);
514 GroupBox1.Enabled := True;
515 MainPanel.Enabled := True;
516 CompileItem.Enabled := True;
517 ProjSaveAsItem.Enabled := True;
518 ProjSaveItem.Enabled := True;
519 ProjCloseItem.Enabled := True;
520
521 FileListBox.Items.AddStrings(Project.Files);
522 TOCEdit.FileName := Project.TableOfContentsFileName;
523 IndexEdit.FileName := Project.IndexFileName;
524 DefaultPageCombo.Items.Assign(FileListBox.Items);
525 DefaultPageCombo.Text := Project.DefaultPage;
526 FollowLinksCheck.Checked := Project.AutoFollowLinks;
527 CreateSearchableCHMCheck.Checked := Project.MakeSearchable;
528 ChmFileNameEdit.FileName := Project.OutputFileName;
529
530 ProjectDirChanged;
531 end;
532
533 procedure TCHMForm.AddFilesToProject(Strings: TStrings);
534 var
535 BDir: String;
536 I: Integer;
537 RelativePath: String;
538 FileName: String;
539 begin
540 Modified := True;
541 BDir := ExtractFilePath(Project.FileName);
542
543 for I := 0 to Strings.Count-1 do begin
544 FileName := Strings.Strings[I];
545
546 RelativePath := ExtractRelativepath(BDir, FileName);
547 if Pos('..', RelativePath) > 0 then
548 FileListBox.Items.AddObject(RelativePath, TObject(1))
549 else
550 FileListBox.Items.AddObject(RelativePath, TObject(0));
551 end;
552 DefaultPageCombo.Items.Assign(FileListBox.Items);
553 end;
554
555 procedure TCHMForm.InitFileDialog(Dlg: TFileDialog);
556 var
557 Dir: String;
558 begin
559 Dir:='';
560 if (Project<>nil) then
561 Dir:=ExtractFilePath(Project.FileName);
562 if not DirPathExists(Dir) then
563 Dir:=GetCurrentDirUTF8;
564 Dlg.InitialDir:=Dir;
565 end;
566
567 procedure TCHMForm.ProjectDirChanged;
568 var
569 Dir: String;
570 begin
571 if Project=nil then exit;
572 Dir:=ExtractFilePath(Project.FileName);
573
574 TOCEdit.InitialDir:=Dir;
575 IndexEdit.InitialDir:=Dir;
576 ChmFileNameEdit.InitialDir:=Dir;
577 end;
578
CreateRelativeProjectFilenull579 function TCHMForm.CreateRelativeProjectFile(Filename: string): string;
580 begin
581 Result:=Filename;
582 if (Project=nil) or (not FilenameIsAbsolute(Project.FileName)) then exit;
583 Result:=CreateRelativePath(Filename,ExtractFilePath(Project.FileName));
584 end;
585
CreateAbsoluteProjectFilenull586 function TCHMForm.CreateAbsoluteProjectFile(Filename: string): string;
587 begin
588 Result:=Filename;
589 if FilenameIsAbsolute(Result) then exit;
590 if (Project=nil) or (not FilenameIsAbsolute(Project.FileName)) then exit;
591 Result:=ExtractFilePath(Project.FileName)+Filename;
592 end;
593
594 end.
595
596