← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to tools/chmmaker/unit1.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
tools/chmmaker/unit1.pas
6
6
 
7
7
uses
8
8
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
9
 
  Buttons, chmwriter, ComCtrls, chmsitemap, SynEdit, Menus, ExtCtrls, CheckLst,
10
 
  EditBtn, chmfilewriter;
 
9
  Buttons, ComCtrls, chmsitemap, SynEdit, LazFileUtils, LazLogger, Menus,
 
10
  ExtCtrls, EditBtn, LCLProc, chmfilewriter;
11
11
 
12
12
type
13
13
 
23
23
    ChmFileNameEdit: TFileNameEdit;
24
24
    FollowLinksCheck: TCheckBox;
25
25
    CreateSearchableCHMCheck: TCheckBox;
26
 
    Label3: TLabel;
27
 
    Label4: TLabel;
28
 
    Label5: TLabel;
29
 
    Label6: TLabel;
 
26
    CompileTimeOptionsLabel: TLabel;
 
27
    FilesNoteLabel: TLabel;
 
28
    DefaultPageLabel: TLabel;
 
29
    CHMFilenameLabel: TLabel;
30
30
    OpenDialog2: TOpenDialog;
31
31
    RemoveFilesBtn: TButton;
32
32
    TOCEditBtn: TButton;
34
34
    IndexEdit: TFileNameEdit;
35
35
    GroupBox1: TGroupBox;
36
36
    FileListBox: TListBox;
37
 
    Label1: TLabel;
38
 
    Label2: TLabel;
 
37
    TableOfContentsLabel: TLabel;
 
38
    IndexLabel: TLabel;
39
39
    MainMenu1: TMainMenu;
40
40
    MenuItem1: TMenuItem;
41
41
    ProjSaveItem: TMenuItem;
54
54
    ProjOpenItem: TMenuItem;
55
55
    MenuItem9: TMenuItem;
56
56
    OpenDialog1: TOpenDialog;
57
 
    Panel1: TPanel;
 
57
    MainPanel: TPanel;
58
58
    Panel2: TPanel;
59
59
    SaveDialog1: TSaveDialog;
60
60
    StatusBar1: TStatusBar;
67
67
    procedure ChmFileNameEditAcceptFileName(Sender: TObject; var Value: String);
68
68
    procedure CompileBtnClick(Sender: TObject);
69
69
    procedure CompileViewBtnClick(Sender: TObject);
70
 
    procedure FileListBoxDrawItem(Control: TWinControl; Index: Integer;
71
 
      ARect: TRect; State: TOwnerDrawState);
 
70
    procedure FileListBoxDrawItem({%H-}Control: TWinControl; Index: Integer;
 
71
      ARect: TRect; {%H-}State: TOwnerDrawState);
72
72
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
73
73
    procedure FormCreate(Sender: TObject);
74
74
    procedure IndexEditAcceptFileName(Sender: TObject; var Value: String);
84
84
    procedure TOCEditBtnClick(Sender: TObject);
85
85
  private
86
86
    FModified: Boolean;
87
 
    procedure AddItems(AParentItem: TTreeNode; ChmItems: TChmSiteMapItems);
 
87
    procedure AddItems({%H-}AParentItem: TTreeNode; {%H-}ChmItems: TChmSiteMapItems);
88
88
 
89
89
    function GetModified: Boolean;
90
90
    procedure Save(aAs: Boolean);
91
91
    procedure CloseProject;
92
92
 
93
93
    procedure AddFilesToProject(Strings: TStrings);
 
94
    procedure InitFileDialog(Dlg: TFileDialog);
 
95
    procedure ProjectDirChanged;
 
96
    function CreateRelativeProjectFile(Filename: string): string;
 
97
    function CreateAbsoluteProjectFile(Filename: string): string;
94
98
  public
95
99
    Project: TChmProject;
96
100
    procedure OpenProject(AFileName: String);
101
105
  CHMForm: TCHMForm;
102
106
 
103
107
implementation
 
108
 
 
109
{$R *.lfm}
 
110
 
104
111
uses CHMSiteMapEditor, LHelpControl, Process;
 
112
 
105
113
{ TCHMForm }
106
114
 
107
115
procedure TCHMForm.AddItems(AParentItem: TTreeNode; ChmItems: TChmSiteMapItems);
108
 
  var
109
 
    Item: TTreeNode;
110
 
    I: Integer;
111
116
  begin
112
117
{    for I := 0 to ChmItems.Count-1 do begin
113
118
      Item := TreeView1.Items.AddChild(AParentItem, ChmItems.Item[I].Text);
116
121
 } end;
117
122
 
118
123
procedure TCHMForm.Button1Click(Sender: TObject);
119
 
var
120
 
  SiteMap: TChmSiteMap;
121
 
  Stream: TMemoryStream;
122
124
begin
123
125
  {SiteMap := TChmSiteMap.Create(stTOC);
124
126
  OpenDialog1.InitialDir := GetCurrentDir;
138
140
 
139
141
procedure TCHMForm.AddFilesBtnClick(Sender: TObject);
140
142
begin
 
143
  InitFileDialog(OpenDialog2);
141
144
  if OpenDialog2.Execute = False then exit;
142
145
  Modified := True;
143
146
  AddFilesToProject(OpenDialog2.Files);
186
189
end;
187
190
 
188
191
procedure TCHMForm.Button2Click(Sender: TObject);
189
 
var
190
 
  OutStream: TFileStream;
191
 
  CHM: TChmWriter;
192
 
  I: Integer;
193
192
begin
194
193
    {
195
194
  if OpenDialog1.Execute = False then Exit;
341
340
 
342
341
procedure TCHMForm.ProjNewItemClick(Sender: TObject);
343
342
begin
 
343
  InitFileDialog(SaveDialog1);
344
344
  If SaveDialog1.Execute then begin
345
345
    if FileExists(SaveDialog1.FileName)
346
346
    and (MessageDlg('File Already Exists! Ovewrite?', mtWarning, [mbYes, mbNo],0) = mrNo) then Exit;
347
347
    OpenProject(SaveDialog1.FileName);
348
348
    Project.SaveToFile(SaveDialog1.FileName);
349
349
  end;
350
 
 
351
350
end;
352
351
 
353
352
procedure TCHMForm.ProjOpenItemClick(Sender: TObject);
354
353
begin
 
354
  InitFileDialog(OpenDialog1);
355
355
  if OpenDialog1.Execute then begin
356
356
    CloseProject;
357
357
    OpenProject(OpenDialog1.FileName);
422
422
end;
423
423
 
424
424
procedure TCHMForm.Save(aAs: Boolean);
425
 
var
426
 
  SaveName: String;
427
425
begin
428
426
  if aAs or (Project.FileName = '') then
429
 
    if  SaveDialog1.Execute then
 
427
  begin
 
428
    InitFileDialog(SaveDialog1);
 
429
    if SaveDialog1.Execute then
 
430
    begin
430
431
      Project.FileName := ChangeFileExt(SaveDialog1.FileName,'.hfp');
 
432
      ProjectDirChanged;
 
433
    end;
 
434
  end;
431
435
  Project.Files.Assign(FileListBox.Items);
432
 
  Project.TableOfContentsFileName := TOCEdit.FileName;
433
 
  Project.IndexFileName           := IndexEdit.FileName;
 
436
  Project.TableOfContentsFileName := CreateRelativeProjectFile(TOCEdit.FileName);
 
437
  Project.IndexFileName           := CreateRelativeProjectFile(IndexEdit.FileName);
434
438
  Project.DefaultPage             := DefaultPageCombo.Text;
435
439
  Project.AutoFollowLinks         := FollowLinksCheck.Checked;
436
440
  Project.MakeSearchable          := CreateSearchableCHMCheck.Checked;
437
 
  Project.OutputFileName          := ChmFileNameEdit.FileName;
 
441
  Project.OutputFileName          := CreateRelativeProjectFile(ChmFileNameEdit.FileName);
438
442
 
439
443
  Project.SaveToFile(Project.FileName);
440
444
  Modified := False;
447
451
  TOCEdit.Clear;
448
452
  IndexEdit.Clear;
449
453
  GroupBox1.Enabled      := False;
450
 
  Panel1.Enabled         := False;
 
454
  MainPanel.Enabled         := False;
451
455
  CompileItem.Enabled    := False;
452
456
  ProjSaveAsItem.Enabled := False;
453
457
  ProjSaveItem.Enabled   := False;
463
467
  if not Assigned(Project) then Project := TChmProject.Create;
464
468
  Project.LoadFromFile(AFileName);
465
469
  GroupBox1.Enabled      := True;
466
 
  Panel1.Enabled         := True;
 
470
  MainPanel.Enabled         := True;
467
471
  CompileItem.Enabled    := True;
468
472
  ProjSaveAsItem.Enabled := True;
469
473
  ProjSaveItem.Enabled   := True;
470
474
  ProjCloseItem.Enabled  := True;
471
 
  
 
475
 
472
476
  FileListBox.Items.AddStrings(Project.Files);
473
477
  TOCEdit.FileName := Project.TableOfContentsFileName;
474
478
  IndexEdit.FileName := Project.IndexFileName;
477
481
  FollowLinksCheck.Checked := Project.AutoFollowLinks;
478
482
  CreateSearchableCHMCheck.Checked := Project.MakeSearchable;
479
483
  ChmFileNameEdit.FileName := Project.OutputFileName;
 
484
 
 
485
  ProjectDirChanged;
480
486
end;
481
487
 
482
488
procedure TCHMForm.AddFilesToProject(Strings: TStrings);
483
489
var
484
 
  ADir, BDir: String;
 
490
  BDir: String;
485
491
  I: Integer;
486
492
  RelativePath: String;
487
493
  FileName: String;
488
 
  NewFileName: String;
489
494
begin
490
495
  Modified := True;
491
496
  BDir := ExtractFilePath(Project.FileName);
500
505
      FileListBox.Items.AddObject(RelativePath, TObject(0));
501
506
  end;
502
507
  DefaultPageCombo.Items.Assign(FileListBox.Items);
503
 
 
504
 
end;
505
 
 
506
 
initialization
507
 
  {$I unit1.lrs}
 
508
end;
 
509
 
 
510
procedure TCHMForm.InitFileDialog(Dlg: TFileDialog);
 
511
var
 
512
  Dir: String;
 
513
begin
 
514
  Dir:='';
 
515
  if (Project<>nil) then
 
516
    Dir:=ExtractFilePath(Project.FileName);
 
517
  if not DirPathExists(Dir) then
 
518
    Dir:=GetCurrentDirUTF8;
 
519
  Dlg.InitialDir:=Dir;
 
520
end;
 
521
 
 
522
procedure TCHMForm.ProjectDirChanged;
 
523
var
 
524
  Dir: String;
 
525
begin
 
526
  if Project=nil then exit;
 
527
  Dir:=ExtractFilePath(Project.FileName);
 
528
 
 
529
  TOCEdit.InitialDir:=Dir;
 
530
  IndexEdit.InitialDir:=Dir;
 
531
  ChmFileNameEdit.InitialDir:=Dir;
 
532
end;
 
533
 
 
534
function TCHMForm.CreateRelativeProjectFile(Filename: string): string;
 
535
begin
 
536
  Result:=Filename;
 
537
  if (Project=nil) or (not FilenameIsAbsolute(Project.FileName)) then exit;
 
538
  Result:=CreateRelativePath(Filename,ExtractFilePath(Project.FileName));
 
539
end;
 
540
 
 
541
function TCHMForm.CreateAbsoluteProjectFile(Filename: string): string;
 
542
begin
 
543
  Result:=Filename;
 
544
  if FilenameIsAbsolute(Result) then exit;
 
545
  if (Project=nil) or (not FilenameIsAbsolute(Project.FileName)) then exit;
 
546
  Result:=ExtractFilePath(Project.FileName)+Filename;
 
547
end;
508
548
 
509
549
end.
510
550