mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 08:09:33 +02:00
* initial hhp loading in chmproject.
* chmproject now supports #Windows (the CHM feature, not the OS), but doesn't pass it to writer yet.
* Some keys in chmproject moved from files/ to settings/ were they belong.
hopefully with backwards compat loading capability.
Low errorchecking etc, and only initially tested. Not for 2.4.2
git-svn-id: trunk@15444 -
This commit is contained in:
marco
parent
ead5707179
commit
b2ad17dd2a
@ -25,7 +25,7 @@ unit chmfilewriter;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, chmwriter;
|
||||
Classes, SysUtils, chmwriter, inifiles, contnrs;
|
||||
|
||||
type
|
||||
TChmProject = class;
|
||||
@ -49,13 +49,18 @@ type
|
||||
FOutputFileName: String;
|
||||
FTableOfContentsFileName: String;
|
||||
FTitle: String;
|
||||
FWindows : TObjectList;
|
||||
FMergeFiles : TStringlist;
|
||||
fDefaultWindow : string;
|
||||
protected
|
||||
function GetData(const DataName: String; out PathInChm: String; out FileName: String; var Stream: TStream): Boolean;
|
||||
procedure LastFileAdded(Sender: TObject);
|
||||
procedure readIniOptions(keyvaluepairs:tstringlist);
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
procedure LoadFromFile(AFileName: String); virtual;
|
||||
procedure LoadFromhhp (AFileName:String;LeaveInclude:Boolean); virtual;
|
||||
procedure SaveToFile(AFileName: String); virtual;
|
||||
procedure WriteChm(AOutStream: TStream); virtual;
|
||||
function ProjectDir: String;
|
||||
@ -74,8 +79,10 @@ type
|
||||
property MakeSearchable: Boolean read FMakeSearchable write FMakeSearchable;
|
||||
property DefaultPage: String read FDefaultPage write FDefaultPage;
|
||||
property DefaultFont: String read FDefaultFont write FDefaultFont;
|
||||
|
||||
property Windows :TObjectList read FWindows write FWindows;
|
||||
property MergeFiles :TStringlist read FMergeFiles write FMergefiles;
|
||||
property OnProgress: TChmProgressCB read FOnProgress write FOnProgress;
|
||||
property DefaultWindow : String read FDefaultWindow write FDefaultWindow;
|
||||
end;
|
||||
|
||||
TChmContextNode = Class
|
||||
@ -86,7 +93,7 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
uses XmlCfg, chmsitemap;
|
||||
uses XmlCfg, chmsitemap, CHMTypes;
|
||||
|
||||
{ TChmProject }
|
||||
|
||||
@ -153,6 +160,8 @@ end;
|
||||
constructor TChmProject.Create;
|
||||
begin
|
||||
FFiles := TStringList.Create;
|
||||
FWindows:=TObjectList.Create(True);
|
||||
FMergeFiles:=TStringlist.Create;
|
||||
end;
|
||||
|
||||
destructor TChmProject.Destroy;
|
||||
@ -160,16 +169,111 @@ var i : integer;
|
||||
begin
|
||||
for i:=0 to ffiles.count -1 do
|
||||
ffiles.objects[i].free;
|
||||
FMergeFiles.Free;
|
||||
FFiles.Free;
|
||||
FWindows.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
Type
|
||||
TSectionEnum = (secOptions,secWindows,secFiles,secMergeFiles,secAlias,secMap,secInfoTypes,secTextPopups,secUnknown);
|
||||
TOptionEnum = (OPTAUTO_INDEX,OPTAUTO_TOC,OPTBINARY_INDEX,OPTBINARY_TOC,OPTCITATION,
|
||||
OPTCOMPRESS,OPTCOPYRIGHT,OPTCOMPATIBILITY,OPTCOMPILED_FILE,OPTCONTENTS_FILE,
|
||||
OPTCREATE_CHI_FILE,OPTDBCS,OPTDEFAULT_FONT,OPTDEFAULT_WINDOW,OPTDEFAULT_TOPIC,
|
||||
OPTDISPLAY_COMPILE_NOTES,OPTDISPLAY_COMPILE_PROGRESS,OPTENHANCED_DECOMPILATION,OPTERROR_LOG_FILE,OPTFLAT,
|
||||
OPTFULL_TEXT_SEARCH_STOP_LIST,OPTFULL_TEXT_SEARCH,OPTIGNORE,OPTINDEX_FILE,OPTLANGUAGE,OPTPREFIX,
|
||||
OPTSAMPLE_STAGING_PATH,OPTSAMPLE_LIST_FILE,OPTTMPDIR,OPTTITLE,OPTCUSTOM_TAB,OPTUNKNOWN);
|
||||
|
||||
Const
|
||||
SectionNames : Array[TSectionEnum] of String =
|
||||
('OPTIONS','WINDOWS','FILES','MERGE FILES','ALIAS','MAP','INFOTYPES','TEXT POPUPS','UNKNOWN');
|
||||
|
||||
OptionKeys : array [TOptionEnum] of String =
|
||||
('AUTO INDEX','AUTO TOC','BINARY INDEX','BINARY TOC','CITATION',
|
||||
'COMPRESS','COPYRIGHT','COMPATIBILITY','COMPILED FILE','CONTENTS FILE',
|
||||
'CREATE CHI FILE','DBCS','DEFAULT FONT','DEFAULT WINDOW','DEFAULT TOPIC',
|
||||
'DISPLAY COMPILE NOTES','DISPLAY COMPILE PROGRESS','ENHANCED DECOMPILATION','ERROR LOG FILE','FLAT',
|
||||
'FULL-TEXT SEARCH STOP LIST','FULL TEXT SEARCH','IGNORE','INDEX FILE','LANGUAGE','PREFIX',
|
||||
'SAMPLE STAGING PATH','SAMPLE LIST FILE','TMPDIR','TITLE','CUSTOM TAB','UNKNOWN');
|
||||
|
||||
|
||||
|
||||
function FindSectionName (const name:string):TSectionEnum;
|
||||
|
||||
begin
|
||||
result:=low(TSectionEnum);
|
||||
while (result<secUnknown) and (name<>SectionNames[Result]) do
|
||||
inc(result);
|
||||
end;
|
||||
|
||||
function FindOptionName(Const name:string):TOptionEnum;
|
||||
|
||||
begin
|
||||
result:=low(TOptionEnum);
|
||||
while (result<optUnknown) and (name<>OptionKeys[Result]) do
|
||||
inc(result);
|
||||
end;
|
||||
|
||||
procedure TChmProject.readIniOptions(keyvaluepairs:tstringlist);
|
||||
var i : integer;
|
||||
Opt : TOptionEnum;
|
||||
OptVal,
|
||||
OptValUpper : string;
|
||||
begin
|
||||
for i:=0 to keyvaluepairs.count-1 do
|
||||
begin
|
||||
Opt:=findoptionname(uppercase(keyvaluepairs.names[i]));
|
||||
optval :=keyvaluepairs.valuefromindex[i];
|
||||
optvalupper:=uppercase(OptVal);
|
||||
case Opt Of
|
||||
OPTAUTO_INDEX : ;
|
||||
OPTAUTO_TOC : ;
|
||||
OPTBINARY_INDEX : MakeBinaryIndex:=optvalupper='YES';
|
||||
OPTBINARY_TOC : MakeBinaryToc :=optvalupper='YES';
|
||||
OPTCITATION : ;
|
||||
OPTCOMPRESS : ; // Doesn't seem to have effect in workshop
|
||||
OPTCOPYRIGHT : ;
|
||||
OPTCOMPATIBILITY : ;
|
||||
OPTCOMPILED_FILE : OutputFilename:=optval;
|
||||
OPTCONTENTS_FILE : TableOfContentsFileName:=optval;
|
||||
OPTCREATE_CHI_FILE : ;
|
||||
OPTDBCS : ; // What this field makes unicode is not known?
|
||||
OPTDEFAULT_FONT : defaultfont:=optval;
|
||||
OPTDEFAULT_WINDOW : defaultwindow:=optval;
|
||||
OPTDEFAULT_TOPIC : defaultpage:=optval;
|
||||
OPTDISPLAY_COMPILE_NOTES : ;
|
||||
OPTDISPLAY_COMPILE_PROGRESS : ;
|
||||
OPTENHANCED_DECOMPILATION : ;
|
||||
OPTERROR_LOG_FILE : ;
|
||||
OPTFLAT : ;
|
||||
OPTFULL_TEXT_SEARCH_STOP_LIST: ;
|
||||
OPTIGNORE : ;
|
||||
OPTINDEX_FILE : Indexfilename:=optval;
|
||||
OPTLANGUAGE : ;
|
||||
OPTPREFIX : ; // doesn't seem to have effect
|
||||
OPTSAMPLE_STAGING_PATH : ;
|
||||
OPTSAMPLE_LIST_FILE : ;
|
||||
OPTTMPDIR : ;
|
||||
OPTTITLE : Title:=optval;
|
||||
OPTCUSTOM_TAB : ;
|
||||
OPTUNKNOWN : ; // can be used for errors on unknown keys
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TChmProject.LoadFromFile(AFileName: String);
|
||||
var
|
||||
Cfg: TXMLConfig;
|
||||
MergeFileCount,
|
||||
WinCount,
|
||||
FileCount: Integer;
|
||||
I : Integer;
|
||||
nd : TChmContextNode;
|
||||
win: TCHMWindow;
|
||||
s : String;
|
||||
|
||||
begin
|
||||
Cfg := TXMLConfig.Create(nil);
|
||||
Cfg.Filename := AFileName;
|
||||
@ -185,20 +289,257 @@ begin
|
||||
nd.contextname:=Cfg.GetValue('Files/FileName'+IntToStr(I)+'/ContextName','');
|
||||
Files.AddObject(nd.urlname,nd);
|
||||
end;
|
||||
|
||||
WinCount:= Cfg.GetValue('Windows/Count/Value', 0);
|
||||
for i:=0 To WinCount-1 do
|
||||
begin
|
||||
win:=TCHMWindow.Create;
|
||||
win.loadfromxml(cfg,'Windows/item'+inttostr(i)+'/');
|
||||
fwindows.add(win);
|
||||
end;
|
||||
|
||||
Mergefilecount:=Cfg.getValue('MergeFiles/Count/Value', 0);
|
||||
for i:=0 To MergeFileCount-1 do
|
||||
Mergefiles.add(Cfg.getValue('MergeFiles/FileName'+IntToStr(I)+'/value',''));
|
||||
|
||||
// load some values that changed key backwards compatible.
|
||||
|
||||
IndexFileName := Cfg.GetValue('Files/IndexFile/Value','');
|
||||
if IndexFileName='' Then
|
||||
IndexFileName := Cfg.GetValue('Settings/IndexFile/Value','');
|
||||
|
||||
TableOfContentsFileName := Cfg.GetValue('Files/TOCFile/Value','');
|
||||
If TableOfContentsFileName='' then
|
||||
TableOfContentsFileName := Cfg.GetValue('Settings/TOCFile/Value','');
|
||||
|
||||
// For chm file merging, bintoc must be false and binindex true. Change defaults in time?
|
||||
MakeBinaryTOC := Cfg.GetValue('Files/MakeBinaryTOC/Value', True);
|
||||
MakeBinaryIndex:= Cfg.GetValue('Files/MakeBinaryIndex/Value', False);
|
||||
// OTOH, merging will be mostly done for fpdoc files, and that doesn't care about defaults.
|
||||
|
||||
S:=Cfg.GetValue('Files/MakeBinaryTOC/Value', '');
|
||||
if s='' Then
|
||||
MakeBinaryTOC := Cfg.GetValue('Settings/MakeBinaryTOC/Value', True)
|
||||
else
|
||||
MakeBinaryTOC := Cfg.GetValue('Files/MakeBinaryTOC/Value', True);
|
||||
|
||||
S:=Cfg.GetValue('Files/MakeBinaryIndex/Value', '');
|
||||
if s='' Then
|
||||
MakeBinaryIndex := Cfg.GetValue('Settings/MakeBinaryIndex/Value', False)
|
||||
else
|
||||
MakeBinaryIndex := Cfg.GetValue('Files/MakeBinaryIndex/Value', False);
|
||||
|
||||
AutoFollowLinks := Cfg.GetValue('Settings/AutoFollowLinks/Value', False);
|
||||
MakeSearchable := Cfg.GetValue('Settings/MakeSearchable/Value', False);
|
||||
DefaultPage := Cfg.GetValue('Settings/DefaultPage/Value', '');
|
||||
Title := Cfg.GetValue('Settings/Title/Value', '');
|
||||
OutputFileName := Cfg.GetValue('Settings/OutputFileName/Value', '');
|
||||
DefaultFont := Cfg.GetValue('Settings/DefaultFont/Value', '');
|
||||
DefaultFont := Cfg.GetValue('Settings/DefaultFont/Value', '');
|
||||
DefaultWindow:= Cfg.GetValue('Settings/DefaultWindow/Value', '');
|
||||
Cfg.Free;
|
||||
end;
|
||||
|
||||
function cleanupstring(const s:string):string;
|
||||
var
|
||||
i:integer;
|
||||
begin
|
||||
i:=pos(';',s);
|
||||
if i>0 then
|
||||
result:=trim(copy(s,1,i-1))
|
||||
else
|
||||
result:=trim(s);
|
||||
end;
|
||||
|
||||
procedure TChmProject.LoadFromhhp (AFileName:String;LeaveInclude:Boolean);
|
||||
// leaveinclude=true leaves includefiles includefiles.
|
||||
|
||||
procedure addalias(const key,value :string);
|
||||
|
||||
var i,j : integer;
|
||||
node: TCHMContextNode;
|
||||
keyupper : string;
|
||||
begin
|
||||
{$ifdef hhp_debug}
|
||||
writeln('alias entry:',key,'=',value);
|
||||
{$endif}
|
||||
keyupper:=uppercase(value);
|
||||
i:=0; j:=files.count;
|
||||
while (i<j) and (uppercase(TCHMContextnode(files.objects[i]).UrlName)<>keyupper) do
|
||||
inc(i);
|
||||
if i=j then
|
||||
begin
|
||||
{$ifdef hhp_debug}
|
||||
writeln('alias new node:',key);
|
||||
{$endif}
|
||||
node:=TCHMContextNode.create;
|
||||
node.URLName:=value;
|
||||
node.contextname:=key;
|
||||
end
|
||||
else
|
||||
begin
|
||||
node:=TCHMContextNode(Files.objects[i]);
|
||||
node.ContextName:=key;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure processalias(strs:TStringlist);
|
||||
var i,j : integer;
|
||||
s : string;
|
||||
strls2:tstringlist;
|
||||
|
||||
begin
|
||||
for i:=0 to strs.count-1 do
|
||||
begin
|
||||
s:=cleanupstring(strs[i]);
|
||||
if uppercase(copy(s,1,8))='#INCLUDE' then
|
||||
begin
|
||||
delete(s,1,8);
|
||||
s:=trim(s);
|
||||
if fileexists(s) then
|
||||
begin
|
||||
strls2:=TstringList.create;
|
||||
strls2.loadfromfile(s);
|
||||
processalias(strls2);
|
||||
strls2.free;
|
||||
end;
|
||||
|
||||
end
|
||||
else
|
||||
begin
|
||||
s:=cleanupstring(s);
|
||||
j:=pos('=',s);
|
||||
if j>0 then
|
||||
addalias(trim(copy(s,1,j-1)),copy(s,j+1,length(s)-j));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure addmap(const key,value :string);
|
||||
|
||||
var i,j : integer;
|
||||
node: TCHMContextNode;
|
||||
keyupper : string;
|
||||
begin
|
||||
{$ifdef hhp_debug}
|
||||
writeln('map entry:',key,'=',value);
|
||||
{$endif}
|
||||
keyupper:=uppercase(key);
|
||||
i:=0; j:=files.count;
|
||||
while (i<j) and (uppercase(TCHMContextnode(files.objects[i]).contextname)<>keyupper) do
|
||||
inc(i);
|
||||
if i=j then
|
||||
raise Exception.create('context "'+key+'" not found!')
|
||||
else
|
||||
begin
|
||||
node:=TCHMContextNode(Files.objects[i]);
|
||||
node.Contextnumber:=strtointdef(value,0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure processmap(strs:TStringlist);
|
||||
var i,j : integer;
|
||||
s : string;
|
||||
strls2:tstringlist;
|
||||
|
||||
begin
|
||||
for i:=0 to strs.count-1 do
|
||||
begin
|
||||
s:=cleanupstring(strs[i]);
|
||||
{$ifdef hhp_debug}
|
||||
writeln('map item:',s);
|
||||
{$endif}
|
||||
if uppercase(copy(s,1,8))='#INCLUDE' then
|
||||
begin
|
||||
delete(s,1,8);
|
||||
s:=trim(s);
|
||||
if fileexists(s) then
|
||||
begin
|
||||
strls2:=TstringList.create;
|
||||
strls2.loadfromfile(s);
|
||||
processmap(strls2);
|
||||
strls2.free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
s:=cleanupstring(s);
|
||||
if uppercase(copy(s,1,7))='#DEFINE' Then
|
||||
begin
|
||||
delete(s,1,7);
|
||||
s:=trim(s);
|
||||
j:=pos(' ',s);
|
||||
if j>0 then
|
||||
addmap(trim(copy(s,1,j-1)),copy(s,j+1,length(s)-j));
|
||||
end
|
||||
else
|
||||
begin
|
||||
{$ifdef hhp_debug}
|
||||
writeln('map leftover:',s);
|
||||
{$endif}
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
Fini : TMemIniFile; // TMemInifile is more compatible with Delphi. Delphi's API based TIniFile fails on .hhp files.
|
||||
secs,strs : TStringList;
|
||||
i,j : Integer;
|
||||
section : TSectionEnum;
|
||||
nd : TChmContextNode;
|
||||
|
||||
begin
|
||||
Fini:=TMeminiFile.Create(AFileName);
|
||||
secs := TStringList.create;
|
||||
strs := TStringList.create;
|
||||
fini.readsections(secs);
|
||||
|
||||
// Do the files section first so that we can emit errors if
|
||||
// other sections reference unknown files.
|
||||
|
||||
fini.readsectionvalues(SectionNames[secFiles] ,strs);
|
||||
if strs.count>0 then
|
||||
for j:=0 to strs.count-1 do
|
||||
begin
|
||||
nd:=TChmContextNode.Create;
|
||||
nd.urlname:=strs[j];
|
||||
nd.contextnumber:=0;
|
||||
nd.contextname:='';
|
||||
Files.AddObject(nd.urlname,nd);
|
||||
end;
|
||||
|
||||
// aliases also add file nodes.
|
||||
|
||||
fini.readsectionvalues(SectionNames[secAlias] ,strs); // resolve all aliases.
|
||||
if strs.count>0 then
|
||||
processalias(strs);
|
||||
|
||||
// map files only add to existing file nodes.
|
||||
fini.readsectionvalues(SectionNames[secmap] ,strs);
|
||||
if strs.count>0 then
|
||||
processmap(strs);
|
||||
|
||||
|
||||
for i:=0 to secs.count-1 do
|
||||
begin
|
||||
section:=FindSectionName(Uppercase(Secs[i]));
|
||||
if section<>secunknown then
|
||||
fini.readsectionvalues(secs[i] ,strs);
|
||||
case section of
|
||||
secOptions : readinioptions(strs);
|
||||
secWindows : for j:=0 to strs.count-1 do
|
||||
FWindows.add(TCHMWindow.Create(strs[j]));
|
||||
secFiles : ; // already done
|
||||
secMergeFiles: FMergeFiles.Assign(Strs); // just a filelist
|
||||
secAlias : ; // already done
|
||||
secMap : ; // already done
|
||||
secInfoTypes : ; // unused for now.
|
||||
secTextPopups: ; // rarely used.
|
||||
end;
|
||||
end;
|
||||
secs.free;
|
||||
strs.free;
|
||||
fini.free;
|
||||
end;
|
||||
|
||||
procedure TChmProject.AddFileWithContext(contextid:integer;filename:ansistring;contextname:ansistring='');
|
||||
var x : integer;
|
||||
nd : TChmContextNode;
|
||||
@ -247,16 +588,35 @@ begin
|
||||
Cfg.SetValue('Files/FileName'+IntToStr(I)+'/ContextName', nd.contextname);
|
||||
end;
|
||||
end;
|
||||
Cfg.SetValue('Files/IndexFile/Value', IndexFileName);
|
||||
Cfg.SetValue('Files/TOCFile/Value', TableOfContentsFileName);
|
||||
Cfg.SetValue('Files/MakeBinaryTOC/Value',MakeBinaryTOC);
|
||||
Cfg.SetValue('Files/MakeBinaryIndex/Value',MakeBinaryIndex);
|
||||
|
||||
Cfg.SetValue('Windows/Count/Value', FWindows.count);
|
||||
for i:=0 To FWindows.Count-1 do
|
||||
TCHMWindow(FWindows[i]).savetoxml(cfg,'Windows/item'+inttostr(i)+'/');
|
||||
|
||||
Cfg.SetValue('MergeFiles/Count/Value', FMergeFiles.count);
|
||||
for i:=0 To FMergeFiles.Count-1 do
|
||||
Cfg.SetValue('MergeFiles/FileName'+IntToStr(I)+'/value',FMergeFiles[i]);
|
||||
|
||||
// delete legacy keys.
|
||||
Cfg.SetValue('Files/IndexFile/Value','');
|
||||
Cfg.SetValue('Files/TOCFile/Value', '');
|
||||
Cfg.SetValue('Files/MakeBinaryTOC/Value','');
|
||||
Cfg.SetValue('Files/MakeBinaryIndex/Value','');
|
||||
Cfg.SetValue('Settings/IndexFile/Value', IndexFileName);
|
||||
Cfg.SetValue('Settings/TOCFile/Value', TableOfContentsFileName);
|
||||
Cfg.SetValue('Settings/MakeBinaryTOC/Value',MakeBinaryTOC);
|
||||
Cfg.SetValue('Settings/MakeBinaryIndex/Value',MakeBinaryIndex);
|
||||
|
||||
Cfg.SetValue('Settings/AutoFollowLinks/Value', AutoFollowLinks);
|
||||
Cfg.SetValue('Settings/MakeSearchable/Value', MakeSearchable);
|
||||
Cfg.SetValue('Settings/DefaultPage/Value', DefaultPage);
|
||||
Cfg.SetValue('Settings/Title/Value', Title);
|
||||
Cfg.SetValue('Settings/OutputFileName/Value', OutputFileName);
|
||||
Cfg.SetValue('Settings/DefaultFont/Value', DefaultFont);
|
||||
|
||||
Cfg.SetValue('Settings/DefaultWindow/Value', DefaultWindow);
|
||||
|
||||
|
||||
Cfg.Flush;
|
||||
Cfg.Free;
|
||||
end;
|
||||
|
||||
@ -25,7 +25,7 @@ unit chmtypes;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
Classes, SysUtils,xmlcfg;
|
||||
|
||||
type
|
||||
TSectionName = (snMSCompressed, snUnCompressed);
|
||||
@ -91,6 +91,38 @@ type
|
||||
|
||||
end;
|
||||
|
||||
TCHMWindow = Class
|
||||
window_type,
|
||||
Title_bar_text,
|
||||
Toc_file,
|
||||
index_file,
|
||||
Default_File,
|
||||
Home_button_file,
|
||||
Jumpbutton_1_File,
|
||||
Jumpbutton_1_Text,
|
||||
Jumpbutton_2_File,
|
||||
Jumpbutton_2_Text : string;
|
||||
nav_style : integer; // overlay with bitfields (next 2 also)
|
||||
navpanewidth : integer;
|
||||
buttons : integer;
|
||||
left,
|
||||
top,
|
||||
right,
|
||||
bottom : integer;
|
||||
styleflags ,
|
||||
xtdstyleflags,
|
||||
window_show_state,
|
||||
navpane_initially_closed,
|
||||
navpane_default,
|
||||
navpane_location,
|
||||
wm_notify_id : integer;
|
||||
Constructor create(s:string='');
|
||||
procedure load_from_ini(txt:string);
|
||||
procedure savetoxml(cfg:TXMLConfig;key:string);
|
||||
procedure loadfromxml(cfg:TXMLConfig;key:string);
|
||||
end;
|
||||
|
||||
|
||||
TTOCIdxHeader = record
|
||||
BlockSize: DWord; // 4096
|
||||
EntriesOffset: DWord;
|
||||
@ -392,5 +424,144 @@ begin
|
||||
//WriteLn(ChunkLevelCount);
|
||||
end;
|
||||
|
||||
end.
|
||||
function getnext(const s:string;var i: integer;len:integer):string;
|
||||
var
|
||||
ind : integer;
|
||||
|
||||
begin
|
||||
if i>len then exit('');
|
||||
ind:=i;
|
||||
if s[ind]='"' then
|
||||
begin
|
||||
inc(ind);
|
||||
while (ind<=len) and (s[ind]<>'"') do inc(ind);
|
||||
result:=copy(s,i+1,ind-i-1);
|
||||
inc(ind); // skip "
|
||||
end
|
||||
else
|
||||
begin
|
||||
while (ind<=len) and (s[ind]<>',') do inc(ind);
|
||||
result:=copy(s,i,ind-i);
|
||||
end;
|
||||
i:=ind+1; // skip ,
|
||||
end;
|
||||
|
||||
function getnextint(const txt:string;var ind: integer;len:integer):integer;
|
||||
|
||||
var s : string;
|
||||
begin
|
||||
s:=getnext(txt,ind,len);
|
||||
result:=strtointdef(s,0); // I think this does C style hex, if not fixup here.
|
||||
end;
|
||||
|
||||
procedure TCHMWindow.load_from_ini(txt:string);
|
||||
var ind,len,
|
||||
j,k : integer;
|
||||
arr : array[0..3] of integer;
|
||||
s2 : string;
|
||||
begin
|
||||
j:=pos('=',txt);
|
||||
if j>0 then
|
||||
txt[j]:=',';
|
||||
ind:=1; len:=length(txt);
|
||||
window_type :=getnext(txt,ind,len);
|
||||
Title_bar_text :=getnext(txt,ind,len);
|
||||
index_file :=getnext(txt,ind,len);
|
||||
Toc_file :=getnext(txt,ind,len);
|
||||
Default_File :=getnext(txt,ind,len);
|
||||
Home_button_file :=getnext(txt,ind,len);
|
||||
Jumpbutton_1_File :=getnext(txt,ind,len);
|
||||
Jumpbutton_1_Text :=getnext(txt,ind,len);
|
||||
Jumpbutton_2_File :=getnext(txt,ind,len);
|
||||
Jumpbutton_2_Text :=getnext(txt,ind,len);
|
||||
|
||||
nav_style :=getnextint(txt,ind,len);
|
||||
navpanewidth :=getnextint(txt,ind,len);
|
||||
buttons :=getnextint(txt,ind,len);
|
||||
k:=0;
|
||||
repeat
|
||||
s2:=getnext(txt,ind,len);
|
||||
if (length(s2)>0) and (s2[1]='[') then delete(s2,1,1);
|
||||
j:=pos(']',s2);
|
||||
if j>0 then delete(s2,j,1);
|
||||
arr[k]:=strtointdef(s2,0);
|
||||
inc(k);
|
||||
until (j<>0) or (ind>len);
|
||||
left :=arr[0];
|
||||
top :=arr[1];
|
||||
right :=arr[2];
|
||||
bottom:=arr[3];
|
||||
styleflags :=getnextint(txt,ind,len);
|
||||
xtdstyleflags :=getnextint(txt,ind,len);
|
||||
window_show_state :=getnextint(txt,ind,len);
|
||||
navpane_initially_closed :=getnextint(txt,ind,len);
|
||||
navpane_default :=getnextint(txt,ind,len);
|
||||
navpane_location :=getnextint(txt,ind,len);
|
||||
wm_notify_id :=getnextint(txt,ind,len);
|
||||
end;
|
||||
|
||||
procedure TCHMWindow.savetoxml(cfg:TXMLConfig;key:string);
|
||||
begin
|
||||
cfg.setvalue(key+'window_type',window_type);
|
||||
cfg.setvalue(key+'title_bar_text',title_bar_text);
|
||||
cfg.setvalue(key+'toc_file', Toc_file );
|
||||
cfg.setvalue(key+'index_file', index_file );
|
||||
cfg.setvalue(key+'default_file', Default_File );
|
||||
cfg.setvalue(key+'home_button_file', Home_button_file);
|
||||
cfg.setvalue(key+'jumpbutton_1_file', Jumpbutton_1_File );
|
||||
cfg.setvalue(key+'jumpbutton_1_text', Jumpbutton_1_Text );
|
||||
cfg.setvalue(key+'jumpbutton_2_file', Jumpbutton_2_File );
|
||||
cfg.setvalue(key+'jumpbutton_2_text', Jumpbutton_2_Text );
|
||||
cfg.setvalue(key+'nav_style', nav_style );
|
||||
cfg.setvalue(key+'navpanewidth', navpanewidth );
|
||||
cfg.setvalue(key+'buttons', buttons );
|
||||
cfg.setvalue(key+'left', left);
|
||||
cfg.setvalue(key+'top', top );
|
||||
cfg.setvalue(key+'right', right );
|
||||
cfg.setvalue(key+'bottom', bottom );
|
||||
cfg.setvalue(key+'styleflags', styleflags);
|
||||
cfg.setvalue(key+'xtdstyleflags', xtdstyleflags );
|
||||
cfg.setvalue(key+'window_show_state', window_show_state );
|
||||
cfg.setvalue(key+'navpane_initially_closed',navpane_initially_closed );
|
||||
cfg.setvalue(key+'navpane_default',navpane_default);
|
||||
cfg.setvalue(key+'navpane_location',navpane_location );
|
||||
cfg.setvalue(key+'wm_notify_id',wm_notify_id );
|
||||
end;
|
||||
|
||||
procedure TCHMWindow.loadfromxml(cfg:TXMLConfig;key:string);
|
||||
|
||||
begin
|
||||
window_type :=cfg.getvalue(key+'window_type','');
|
||||
Title_bar_text :=cfg.getvalue(key+'title_bar_text','');
|
||||
Toc_file :=cfg.getvalue(key+'toc_file','');
|
||||
Index_file :=cfg.getvalue(key+'index_file','');
|
||||
Default_File :=cfg.getvalue(key+'default_file','');
|
||||
Home_button_file :=cfg.getvalue(key+'home_button_file','');
|
||||
Jumpbutton_1_File :=cfg.getvalue(key+'jumpbutton_1_file','');
|
||||
Jumpbutton_1_Text :=cfg.getvalue(key+'jumpbutton_1_text','');
|
||||
Jumpbutton_2_File :=cfg.getvalue(key+'jumpbutton_2_file','');
|
||||
Jumpbutton_2_Text :=cfg.getvalue(key+'jumpbutton_2_text','');
|
||||
nav_style :=cfg.getvalue(key+'nav_style',0);
|
||||
navpanewidth :=cfg.getvalue(key+'navpanewidth',0);
|
||||
buttons :=cfg.getvalue(key+'buttons',0);
|
||||
left :=cfg.getvalue(key+'left',0);
|
||||
top :=cfg.getvalue(key+'top',0);
|
||||
right :=cfg.getvalue(key+'right',0);
|
||||
bottom :=cfg.getvalue(key+'bottom',0);
|
||||
styleflags :=cfg.getvalue(key+'styleflags',0);
|
||||
xtdstyleflags :=cfg.getvalue(key+'xtdstyleflags',0);
|
||||
window_show_state :=cfg.getvalue(key+'window_show_state',0);
|
||||
navpane_initially_closed :=cfg.getvalue(key+'navpane_initially_closed',0);
|
||||
navpane_default :=cfg.getvalue(key+'navpane_default',0);
|
||||
navpane_location :=cfg.getvalue(key+'navpane_location',0);
|
||||
wm_notify_id :=cfg.getvalue(key+'wm_notify_id',0);
|
||||
end;
|
||||
|
||||
Constructor TCHMWindow.create(s:string='');
|
||||
|
||||
begin
|
||||
if s<>'' then
|
||||
load_from_ini(s);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user