You've already forked lazarus-ccr
20070415 revision of XDev Toolkit - initial commit to SVN.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@179 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
macpgmr
282
components/xdev_toolkit/CvtHelp.pas
Normal file
282
components/xdev_toolkit/CvtHelp.pas
Normal file
@@ -0,0 +1,282 @@
|
|||||||
|
program CvtHelp;
|
||||||
|
|
||||||
|
{
|
||||||
|
|
||||||
|
Input files: HTML file created from WinHelp .rtf file by saving it
|
||||||
|
in Word's "Web Page, Filtered" format. Also looks for WinHelp .hpj
|
||||||
|
file with same name as HTML input file.
|
||||||
|
|
||||||
|
Output file: HTML file that can be used with LCL apps that use
|
||||||
|
HelpUtil unit's THelpUtilManager class.
|
||||||
|
|
||||||
|
Author: Phil Hess.
|
||||||
|
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
|
||||||
|
License: Modified LGPL.
|
||||||
|
}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils,
|
||||||
|
Classes;
|
||||||
|
|
||||||
|
const
|
||||||
|
ProgramName = 'CvtHelp';
|
||||||
|
ProgramVersion = '0.01';
|
||||||
|
|
||||||
|
var
|
||||||
|
OldFileName : string;
|
||||||
|
HpjFileName : string;
|
||||||
|
NewFileName : string;
|
||||||
|
OldFileVar : TextFile;
|
||||||
|
HpjFileVar : TextFile;
|
||||||
|
NewFileVar : TextFile;
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
MatchFound : TFilenameCaseMatch;
|
||||||
|
{$ENDIF}
|
||||||
|
MapSection : TStringList;
|
||||||
|
TitleStr : string;
|
||||||
|
CopyrightStr: string;
|
||||||
|
Footnotes : TStringList;
|
||||||
|
InStr : string;
|
||||||
|
FnStr : string;
|
||||||
|
FnPos : Integer;
|
||||||
|
FnRef : string;
|
||||||
|
PrevInStr : string;
|
||||||
|
TopicStr : string;
|
||||||
|
TopicMapped : Boolean;
|
||||||
|
FootIdx : Integer;
|
||||||
|
LinkPos : Integer;
|
||||||
|
UnlinkPos : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
if ParamCount < 2 then {List program useage?}
|
||||||
|
begin
|
||||||
|
WriteLn(ProgramName, ', version ', ProgramVersion,
|
||||||
|
' - converts WinHelp/RTF-based HTML file to help HTML file.');
|
||||||
|
WriteLn('Usage: ', ProgramName, ' infile outfile');
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{Get name of HTML file to convert from command line}
|
||||||
|
OldFileName := ParamStr(1);
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
OldFileName := ExpandFileNameCase(OldFileName, MatchFound);
|
||||||
|
{$ELSE}
|
||||||
|
OldFileName := ExpandFileName(OldFileName);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
HpjFileName := ChangeFileExt(OldFileName, '.hpj');
|
||||||
|
|
||||||
|
{Get name of HTML file to create from command line}
|
||||||
|
NewFileName := ParamStr(2);
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
NewFileName := ExpandFileNameCase(NewFileName, MatchFound);
|
||||||
|
{$ELSE}
|
||||||
|
NewFileName := ExpandFileName(NewFileName);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
if (OldFileName = NewFileName) or
|
||||||
|
(HpjFileName = NewFileName) then
|
||||||
|
begin
|
||||||
|
WriteLn('Can''t use input file name for output file');
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{Open input HTML file}
|
||||||
|
AssignFile(OldFileVar, OldFileName);
|
||||||
|
try
|
||||||
|
Reset(OldFileVar);
|
||||||
|
except
|
||||||
|
on EInOutError do
|
||||||
|
begin
|
||||||
|
WriteLn('Can''t open input file ', OldFileName);
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{Open WinHelp project file}
|
||||||
|
AssignFile(HpjFileVar, HpjFileName);
|
||||||
|
try
|
||||||
|
Reset(HpjFileVar);
|
||||||
|
except
|
||||||
|
on EInOutError do
|
||||||
|
begin
|
||||||
|
WriteLn('Can''t open WinHelp project file ', HpjFileName);
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
MapSection := TStringList.Create;
|
||||||
|
while not Eof(HpjFileVar) do
|
||||||
|
begin
|
||||||
|
ReadLn(HpjFileVar, InStr);
|
||||||
|
if CompareText(InStr, '[OPTIONS]') = 0 then
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
ReadLn(HpjFileVar, InStr);
|
||||||
|
if CompareText(Copy(InStr, 1, 6), 'TITLE=') = 0 then
|
||||||
|
TitleStr := Copy(InStr, 7, MaxInt)
|
||||||
|
else if CompareText(Copy(InStr, 1, 10), 'COPYRIGHT=') = 0 then
|
||||||
|
CopyrightStr := Copy(InStr, 11, MaxInt);
|
||||||
|
until Copy(InStr, 1, 1) = '[';
|
||||||
|
end
|
||||||
|
else if CompareText(InStr, '[MAP]') = 0 then
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
ReadLn(HpjFileVar, InStr);
|
||||||
|
if (InStr <> '') and (Copy(InStr, 1, 1) <> '[') then
|
||||||
|
MapSection.Add(Copy(InStr, 1, Pos(' ', InStr)-1) + '=' +
|
||||||
|
Trim(Copy(InStr, Pos(' ', InStr), MaxInt)));
|
||||||
|
until Eof(HpjFileVar) or (Copy(InStr, 1, 1) = '[');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
CloseFile(HpjFileVar);
|
||||||
|
|
||||||
|
{Create output HTML file}
|
||||||
|
AssignFile(NewFileVar, NewFileName);
|
||||||
|
try
|
||||||
|
Rewrite(NewFileVar);
|
||||||
|
except
|
||||||
|
on EInOutError do
|
||||||
|
begin
|
||||||
|
WriteLn('Can''t create output file ', NewFileName);
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Footnotes := TStringList.Create;
|
||||||
|
|
||||||
|
{Read through entire file, saving footnote topic references and names}
|
||||||
|
while not Eof(OldFileVar) do
|
||||||
|
begin
|
||||||
|
ReadLn(OldFileVar, InStr);
|
||||||
|
if CompareText(InStr, '<div><br clear=all>') = 0 then {Found footnotes?}
|
||||||
|
begin
|
||||||
|
while not Eof(OldFileVar) do
|
||||||
|
begin
|
||||||
|
ReadLn(OldFileVar, InStr);
|
||||||
|
if Pos('MsoFootnoteText', InStr) > 0 then {Found a footnote?}
|
||||||
|
begin
|
||||||
|
FnStr := InStr;
|
||||||
|
repeat
|
||||||
|
ReadLn(OldFileVar, InStr);
|
||||||
|
if InStr <> '' then
|
||||||
|
FnStr := FnStr + ' ' + InStr;
|
||||||
|
until InStr = '';
|
||||||
|
TopicStr := Copy(FnStr, Pos('</a>', FnStr) + 5, MaxInt);
|
||||||
|
TopicStr := Copy(TopicStr, 1, Length(TopicStr)-4);
|
||||||
|
if Pos('_', TopicStr) > 0 then
|
||||||
|
begin
|
||||||
|
FnPos := Pos('name=', FnStr) + 6;
|
||||||
|
FnRef := '';
|
||||||
|
repeat
|
||||||
|
FnRef := FnRef + FnStr[FnPos];
|
||||||
|
Inc(FnPos);
|
||||||
|
until FnStr[FnPos] = '"';
|
||||||
|
Footnotes.Add(FnRef + '=' + TopicStr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Reset(OldFileVar);
|
||||||
|
{Process input file}
|
||||||
|
while not Eof(OldFileVar) do
|
||||||
|
begin
|
||||||
|
ReadLn(OldFileVar, InStr);
|
||||||
|
if CompareText(Copy(InStr, 1, 7), '<title>') = 0 then {Found title?}
|
||||||
|
begin {Replace with title from .hpj file}
|
||||||
|
WriteLn(NewFileVar, '<title>', TitleStr, '</title>');
|
||||||
|
{Include AppleTitle line so file can be registered as help book on OS X.}
|
||||||
|
Write(NewFileVar, '<meta name="AppleTitle" content="');
|
||||||
|
if CompareText(Copy(TitleStr, Length(TitleStr)-4, 5), ' Help') = 0 then
|
||||||
|
Write(NewFileVar, Copy(TitleStr, 1, Length(TitleStr)-5)) {Don't include}
|
||||||
|
else
|
||||||
|
Write(NewFileVar, TitleStr);
|
||||||
|
WriteLn(NewFileVar, '">');
|
||||||
|
{Include copyright statement from .hpj file}
|
||||||
|
WriteLn(NewFileVar, '<!--');
|
||||||
|
WriteLn(NewFileVar, CopyrightStr);
|
||||||
|
WriteLn(NewFileVar, '-->');
|
||||||
|
end
|
||||||
|
|
||||||
|
else if Pos('class=Topictitle', InStr) > 0 then {Found a topic?}
|
||||||
|
begin
|
||||||
|
{Get footnote number _ftnXX}
|
||||||
|
FnPos := Pos('#_', InStr) + 1;
|
||||||
|
FnRef := '';
|
||||||
|
repeat
|
||||||
|
FnRef := FnRef + InStr[FnPos];
|
||||||
|
Inc(FnPos);
|
||||||
|
until InStr[FnPos] = '"';
|
||||||
|
{Insert anchor}
|
||||||
|
TopicStr := Footnotes.Values[FnRef];
|
||||||
|
if TopicStr <> '' then
|
||||||
|
begin
|
||||||
|
TopicMapped := False;
|
||||||
|
if MapSection.Values[TopicStr] <> '' then
|
||||||
|
begin
|
||||||
|
WriteLn(NewFileVar, '<a name="', MapSection.Values[TopicStr],
|
||||||
|
'"></a>');
|
||||||
|
TopicMapped := True;
|
||||||
|
end;
|
||||||
|
if not TopicMapped then {No mapping in project file for topic?}
|
||||||
|
begin {Just use topic name in anchor}
|
||||||
|
Write(NewFileVar, '<a name="', TopicStr, '"></a>');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Write(NewFileVar, Copy(InStr, 1, 20)); {Save part of 1st topic line}
|
||||||
|
repeat {Skip over rest of topic lines}
|
||||||
|
PrevInStr := InStr;
|
||||||
|
ReadLn(OldFileVar, InStr);
|
||||||
|
until InStr = '';
|
||||||
|
WriteLn(NewFileVar, Copy(PrevInStr, 36, MaxInt)); {Save part of last topic line}
|
||||||
|
end
|
||||||
|
|
||||||
|
else if CompareText(InStr, '<div><br clear=all>') = 0 then {Found footnotes?}
|
||||||
|
begin
|
||||||
|
repeat {Skip over footnotes}
|
||||||
|
ReadLn(OldFileVar, InStr);
|
||||||
|
until CompareText(InStr, '</body>') = 0;
|
||||||
|
WriteLn(NewFileVar, InStr);
|
||||||
|
end
|
||||||
|
|
||||||
|
else {Found normal line}
|
||||||
|
begin {See if it contains link to topic}
|
||||||
|
LinkPos := Pos('<u>', InStr);
|
||||||
|
if LinkPos > 0 then {Line contains link?}
|
||||||
|
begin
|
||||||
|
PrevInStr := InStr;
|
||||||
|
ReadLn(OldFileVar, InStr); {Get next line too}
|
||||||
|
InStr := PrevInStr + ' ' + InStr; {Combine}
|
||||||
|
for FootIdx := 0 to Footnotes.Count -1 do
|
||||||
|
begin
|
||||||
|
TopicStr := Footnotes.ValueFromIndex[FootIdx];
|
||||||
|
if Pos(TopicStr, InStr) > 0 then
|
||||||
|
begin
|
||||||
|
UnlinkPos := Pos('</u>', InStr);
|
||||||
|
Write(NewFileVar, Copy(InStr, 1, LinkPos-1),
|
||||||
|
'<a href="#');
|
||||||
|
if MapSection.Values[TopicStr] <> '' then
|
||||||
|
Write(NewFileVar, MapSection.Values[TopicStr])
|
||||||
|
else
|
||||||
|
Write(NewFileVar, TopicStr);
|
||||||
|
WriteLn(NewFileVar, '">',
|
||||||
|
Copy(InStr, LinkPos+3, UnlinkPos-LinkPos-3), '</a>',
|
||||||
|
Copy(InStr, UnlinkPos+4, MaxInt));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
WriteLn(NewFileVar, InStr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
MapSection.Free;
|
||||||
|
Footnotes.Free;
|
||||||
|
CloseFile(OldFileVar);
|
||||||
|
CloseFile(NewFileVar);
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
107
components/xdev_toolkit/DfmToLfm.ini
Normal file
107
components/xdev_toolkit/DfmToLfm.ini
Normal file
@@ -0,0 +1,107 @@
|
|||||||
|
|
||||||
|
; DfmToLfm program configuration file.
|
||||||
|
; Be sure to add "=" after each key you add. The key's value can be omitted
|
||||||
|
; as it has no meaning to DfmToLfm.
|
||||||
|
|
||||||
|
; DfmToLfm deletes these .dfm properties when creating .lfm file.
|
||||||
|
; Note: If no class is specified, deletes that property from all classes.
|
||||||
|
|
||||||
|
[DeleteProps]
|
||||||
|
IsControl=
|
||||||
|
;NumGlyphs=
|
||||||
|
OldCreateOrder=
|
||||||
|
WantReturns=
|
||||||
|
Ctl3D=
|
||||||
|
ParentCtl3D=
|
||||||
|
OnClickCheck=
|
||||||
|
Flat=
|
||||||
|
IntegralHeight=
|
||||||
|
DesignSize=
|
||||||
|
AutoSelect=
|
||||||
|
BiDiMode=
|
||||||
|
ParentBiDiMode=
|
||||||
|
HideSelection=
|
||||||
|
ImeMode=
|
||||||
|
ImeName=
|
||||||
|
OEMConvert=
|
||||||
|
TRadioGroup.TabOrder=
|
||||||
|
TBitBtn.ParentFont=
|
||||||
|
TCheckBox.Font.Charset=
|
||||||
|
TCheckBox.Font.Color=
|
||||||
|
TCheckBox.Font.Height=
|
||||||
|
TCheckBox.Font.Name=
|
||||||
|
TCheckBox.Font.Style=
|
||||||
|
TCheckBox.ParentFont=
|
||||||
|
TCheckGroup.Font.Charset=
|
||||||
|
TCheckGroup.Font.Color=
|
||||||
|
TCheckGroup.Font.Height=
|
||||||
|
TCheckGroup.Font.Name=
|
||||||
|
TCheckGroup.Font.Style=
|
||||||
|
TCheckGroup.ParentFont=
|
||||||
|
TCheckListBox.Font.Charset=
|
||||||
|
TCheckListBox.Font.Color=
|
||||||
|
TCheckListBox.Font.Height=
|
||||||
|
TCheckListBox.Font.Name=
|
||||||
|
TCheckListBox.Font.Style=
|
||||||
|
TCheckListBox.ParentFont=
|
||||||
|
TRadioButton.Font.Charset=
|
||||||
|
TRadioButton.Font.Color=
|
||||||
|
TRadioButton.Font.Height=
|
||||||
|
TRadioButton.Font.Name=
|
||||||
|
TRadioButton.Font.Style=
|
||||||
|
TRadioButton.ParentFont=
|
||||||
|
TRadioGroup.Font.Charset=
|
||||||
|
TRadioGroup.Font.Color=
|
||||||
|
TRadioGroup.Font.Height=
|
||||||
|
TRadioGroup.Font.Name=
|
||||||
|
TRadioGroup.Font.Style=
|
||||||
|
TRadioGroup.ParentFont=
|
||||||
|
TBevel.Font.Charset=
|
||||||
|
TBevel.Font.Color=
|
||||||
|
TBevel.Font.Height=
|
||||||
|
TBevel.Font.Name=
|
||||||
|
TBevel.Font.Style=
|
||||||
|
TTabSheet.Font.Charset=
|
||||||
|
TTabSheet.Font.Color=
|
||||||
|
TTabSheet.Font.Height=
|
||||||
|
TTabSheet.Font.Name=
|
||||||
|
TTabSheet.Font.Style=
|
||||||
|
TNotebook.Font.Charset=
|
||||||
|
TNotebook.Font.Color=
|
||||||
|
TNotebook.Font.Height=
|
||||||
|
TNotebook.Font.Name=
|
||||||
|
TNotebook.Font.Style=
|
||||||
|
TNotebook.ParentFont=
|
||||||
|
TLabeledEdit.Font.Charset=
|
||||||
|
TLabeledEdit.Font.Color=
|
||||||
|
TLabeledEdit.Font.Height=
|
||||||
|
TLabeledEdit.Font.Name=
|
||||||
|
TLabeledEdit.Font.Style=
|
||||||
|
|
||||||
|
|
||||||
|
; When -p switch is used with DfmToLfm, don't try to add parent's font
|
||||||
|
; properties to these classes since they don't have font in LCL.
|
||||||
|
|
||||||
|
[NoFont]
|
||||||
|
TMainMenu=
|
||||||
|
TMenuItem=
|
||||||
|
TScrollBar=
|
||||||
|
TImage=
|
||||||
|
TTabSheet=
|
||||||
|
TCheckBox=
|
||||||
|
TCheckGroup=
|
||||||
|
TCheckListBox=
|
||||||
|
TRadioButton=
|
||||||
|
TRadioGroup=
|
||||||
|
TActionList=
|
||||||
|
TShape=
|
||||||
|
TBevel=
|
||||||
|
TNotebook=
|
||||||
|
TLabeledEdit=
|
||||||
|
TSplitter=
|
||||||
|
TOvcController=
|
||||||
|
TOvcSpinner=
|
||||||
|
TOvcTCCheckBox=
|
||||||
|
TOvcTCBitmap=
|
||||||
|
TOvcTCGlyphs=
|
||||||
|
TOvcTCIcon=
|
||||||
318
components/xdev_toolkit/DfmToLfm.pas
Normal file
318
components/xdev_toolkit/DfmToLfm.pas
Normal file
@@ -0,0 +1,318 @@
|
|||||||
|
program DfmToLfm;
|
||||||
|
|
||||||
|
{
|
||||||
|
Converts Delphi form design file to a Lazarus form file by
|
||||||
|
deleting properties that are not supported by LCL and
|
||||||
|
optionally making changes to font properties. The resulting
|
||||||
|
Lazarus form file can then be converted to a Lazarus resource
|
||||||
|
file with LazRes.
|
||||||
|
Note that the Delphi form file must be a text file.
|
||||||
|
List of properties to delete and other configuration settings
|
||||||
|
are read from DfmToLfm.ini.
|
||||||
|
This utility (and Lazarus LazRes) can be used whenever design
|
||||||
|
changes are made to the form in Delphi.
|
||||||
|
Note: Use MakePasX to make the form's code file cross-platform
|
||||||
|
(a one-time conversion).
|
||||||
|
|
||||||
|
Author: Phil Hess.
|
||||||
|
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
|
||||||
|
License: Modified LGPL.
|
||||||
|
}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils,
|
||||||
|
IniFiles;
|
||||||
|
|
||||||
|
const
|
||||||
|
ProgramName = 'DfmToLfm';
|
||||||
|
ProgramVersion = '0.01';
|
||||||
|
|
||||||
|
DfmFileExt = '.dfm'; {Delphi form file extension}
|
||||||
|
LfmFileExt = '.lfm'; {Lazarus form file extension}
|
||||||
|
CfgFileExt = '.ini'; {Extension for file with same name as program
|
||||||
|
containing configuration settings}
|
||||||
|
|
||||||
|
NoFontChanges = 0; {No font switch on command line}
|
||||||
|
UseParentFont = 1; {-p font switch on command line}
|
||||||
|
DeleteFontName = 2; {-d font switch on command line}
|
||||||
|
|
||||||
|
MaxNestedObjs = 20; {Maximum depth of nested controls on form}
|
||||||
|
MaxFontProps = 5; {Maximum font properties that can be saved}
|
||||||
|
|
||||||
|
type
|
||||||
|
TStackRec = record {Info about form objects}
|
||||||
|
ClassName : string;
|
||||||
|
FontPropCnt : Integer;
|
||||||
|
FontAdded : Boolean;
|
||||||
|
FontProps : array [1..MaxFontProps] of string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
CfgFileName : string;
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
MatchFound : TFilenameCaseMatch;
|
||||||
|
{$ENDIF}
|
||||||
|
FontSwitch : Integer;
|
||||||
|
CfgFileObj : TMemIniFile;
|
||||||
|
DfmFileName : string;
|
||||||
|
LfmFileName : string;
|
||||||
|
DfmFileVar : TextFile;
|
||||||
|
LfmFileVar : TextFile;
|
||||||
|
StackLevel : Integer;
|
||||||
|
StackRec : array [1..MaxNestedObjs] of TStackRec;
|
||||||
|
DeleteLine : Boolean;
|
||||||
|
InStr : string;
|
||||||
|
StripStr : string;
|
||||||
|
SkipStr : string;
|
||||||
|
ParentLevel : Integer;
|
||||||
|
FontPropNum : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
{Base configuration file name on program file location and program name}
|
||||||
|
CfgFileName := ExtractFilePath(ParamStr(0)) + ProgramName + CfgFileExt;
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
CfgFileName := ExpandFileNameCase(CfgFileName, MatchFound);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
if ParamCount = 0 then {List program syntax and exit?}
|
||||||
|
begin
|
||||||
|
WriteLn(ProgramName, ', version ', ProgramVersion,
|
||||||
|
' - converts a Delphi form file to a Lazarus form file.');
|
||||||
|
WriteLn('Usage: ', ProgramName, ' filename', DfmFileExt, ' [-p|-d]');
|
||||||
|
WriteLn('Switches:');
|
||||||
|
WriteLn(' -p Add parent''s font to controls with no font ',
|
||||||
|
'(useful with Windows).');
|
||||||
|
WriteLn(' -d Delete font name from controls ',
|
||||||
|
'(useful with OS X and Linux).');
|
||||||
|
WriteLn('Looks for configuration data in file ', CfgFileName);
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{Check for command line switches}
|
||||||
|
FontSwitch := NoFontChanges;
|
||||||
|
if FindCmdLineSwitch('p', ['-'], True) then
|
||||||
|
FontSwitch := UseParentFont
|
||||||
|
else if FindCmdLineSwitch('d', ['-'], True) then
|
||||||
|
FontSwitch := DeleteFontName;
|
||||||
|
|
||||||
|
{Load configuration file}
|
||||||
|
if not FileExists(CfgFileName) then
|
||||||
|
begin
|
||||||
|
WriteLn('Can''t load program configuration file ', CfgFileName);
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
CfgFileObj := TMemIniFile.Create(CfgFileName);
|
||||||
|
|
||||||
|
{Get name of Delphi form file from command line}
|
||||||
|
DfmFileName := ParamStr(1);
|
||||||
|
if ExtractFileExt(DfmFileName) = '' then
|
||||||
|
DfmFileName := DfmFileName + DfmFileExt;
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
DfmFileName := ExpandFileNameCase(DfmFileName, MatchFound);
|
||||||
|
{$ELSE}
|
||||||
|
DfmFileName := ExpandFileName(DfmFileName);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{Base Lazarus form file name on Delphi form file name}
|
||||||
|
LfmFileName := ChangeFileExt(DfmFileName, LfmFileExt);
|
||||||
|
|
||||||
|
{Open Delphi form file}
|
||||||
|
AssignFile(DfmFileVar, DfmFileName);
|
||||||
|
try
|
||||||
|
Reset(DfmFileVar);
|
||||||
|
except
|
||||||
|
on EInOutError do
|
||||||
|
begin
|
||||||
|
WriteLn('Can''t open Delphi form file ', DfmFileName);
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{Create Lazarus form file}
|
||||||
|
AssignFile(LfmFileVar, LfmFileName);
|
||||||
|
try
|
||||||
|
Rewrite(LfmFileVar);
|
||||||
|
except
|
||||||
|
on EInOutError do
|
||||||
|
begin
|
||||||
|
WriteLn('Can''t create Lazarus form file ', LfmFileName);
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
StackLevel := 0;
|
||||||
|
while not Eof(DfmFileVar) do {Read and process Delphi form file}
|
||||||
|
begin
|
||||||
|
DeleteLine := False;
|
||||||
|
ReadLn(DfmFileVar, InStr); {Read property from form file}
|
||||||
|
StripStr := StringReplace(InStr, ' ', '', [rfReplaceAll]); {Strip spaces}
|
||||||
|
|
||||||
|
if ((CompareText('object ', Copy(Trim(InStr), 1, 7)) = 0) or
|
||||||
|
(CompareText('end', StripStr) = 0)) and {End of object's props reached?}
|
||||||
|
(StackLevel > 1) and {Object is nested?}
|
||||||
|
(not CfgFileObj.ValueExists(
|
||||||
|
'NoFont', StackRec[StackLevel].ClassName)) and {Class has font?}
|
||||||
|
(StackRec[StackLevel].FontPropCnt = 0) and {Object has no font?}
|
||||||
|
(FontSwitch = UseParentFont) and {Okay to insert parent font in object?}
|
||||||
|
(not StackRec[StackLevel].FontAdded) then {Font not inserted yet?}
|
||||||
|
begin
|
||||||
|
ParentLevel := StackLevel;
|
||||||
|
repeat
|
||||||
|
Dec(ParentLevel);
|
||||||
|
until (ParentLevel = 0) or
|
||||||
|
(StackRec[ParentLevel].FontPropCnt > 0);
|
||||||
|
if ParentLevel > 0 then {A parent has font?}
|
||||||
|
begin {Add font properties to current object}
|
||||||
|
for FontPropNum := 1 to StackRec[ParentLevel].FontPropCnt do
|
||||||
|
begin
|
||||||
|
WriteLn(LfmFileVar, StringOfChar(' ', (StackLevel-ParentLevel)*2),
|
||||||
|
StackRec[ParentLevel].FontProps[FontPropNum]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
StackRec[StackLevel].FontAdded := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if CompareText('object ', Copy(Trim(InStr), 1, 7)) = 0 then
|
||||||
|
begin {Push object's class name on stack}
|
||||||
|
Inc(StackLevel);
|
||||||
|
if Pos(': ', InStr) > 0 then {Named control?}
|
||||||
|
StackRec[StackLevel].ClassName :=
|
||||||
|
Trim(Copy(InStr, Pos(': ', InStr)+2, MaxInt))
|
||||||
|
else {Unnamed control}
|
||||||
|
StackRec[StackLevel].ClassName := Trim(Copy(Trim(InStr), 7, MaxInt));
|
||||||
|
StackRec[StackLevel].FontPropCnt := 0;
|
||||||
|
StackRec[StackLevel].FontAdded := False;
|
||||||
|
end
|
||||||
|
|
||||||
|
else if CompareText('end', StripStr) = 0 then
|
||||||
|
begin {Pop current class from stack}
|
||||||
|
Dec(StackLevel);
|
||||||
|
end
|
||||||
|
|
||||||
|
else if CompareText('font.', Copy(Trim(InStr), 1, 5)) = 0 then
|
||||||
|
begin {Font property}
|
||||||
|
if FontSwitch <> NoFontChanges then
|
||||||
|
begin
|
||||||
|
if FontSwitch = UseParentFont then
|
||||||
|
begin {Save font property in case need it for child objects}
|
||||||
|
if StackRec[StackLevel].FontPropCnt < MaxFontProps then
|
||||||
|
begin
|
||||||
|
Inc(StackRec[StackLevel].FontPropCnt);
|
||||||
|
StackRec[StackLevel].FontProps[StackRec[StackLevel].FontPropCnt] :=
|
||||||
|
InStr;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else {FontSwitch = DeleteFontName}
|
||||||
|
begin
|
||||||
|
if CompareText('font.name', Copy(Trim(InStr), 1, 9)) = 0 then
|
||||||
|
DeleteLine := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{Check if font property should be deleted from current object}
|
||||||
|
if CfgFileObj.ValueExists('DeleteProps',
|
||||||
|
StackRec[StackLevel].ClassName + '.' +
|
||||||
|
Copy(StripStr, 1, Pos('=', StripStr)-1)) then
|
||||||
|
DeleteLine := True;
|
||||||
|
end
|
||||||
|
|
||||||
|
else {Other property}
|
||||||
|
begin {Check if property should be deleted from current object}
|
||||||
|
if CfgFileObj.ValueExists('DeleteProps',
|
||||||
|
Copy(StripStr, 1, Pos('=', StripStr)-1)) or
|
||||||
|
CfgFileObj.ValueExists('DeleteProps',
|
||||||
|
StackRec[StackLevel].ClassName + '.' +
|
||||||
|
Copy(StripStr, 1, Pos('=', StripStr)-1)) then
|
||||||
|
begin {Property or class.property in list of props to delete?}
|
||||||
|
DeleteLine := True;
|
||||||
|
if Copy(StripStr, Length(StripStr), 1) = '(' then {Delete > 1 line?}
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
ReadLn(DfmFileVar, SkipStr);
|
||||||
|
SkipStr := Trim(SkipStr);
|
||||||
|
until Copy(SkipStr, Length(SkipStr), 1) = ')';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not DeleteLine then {Include line in Lazarus form file?}
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
{If Delphi form file does have Height and Width, reduce
|
||||||
|
to size of its ClientHeight or ClientWidth.}
|
||||||
|
if ((StackLevel = 1) and
|
||||||
|
(CompareText('Height=', Copy(StripStr, 1, 7)) = 0)) then
|
||||||
|
WriteLn(LfmFileVar,
|
||||||
|
' Height = ',
|
||||||
|
IntToStr(StrToInt(Copy(StripStr, 8, MaxInt)) - 34))
|
||||||
|
else if ((StackLevel = 1) and
|
||||||
|
(CompareText('Width=', Copy(StripStr, 1, 6)) = 0)) then
|
||||||
|
WriteLn(LfmFileVar,
|
||||||
|
' Width = ',
|
||||||
|
IntToStr(StrToInt(Copy(StripStr, 7, MaxInt)) - 8))
|
||||||
|
|
||||||
|
{LCL TGroupBox child controls' Top measures from a lower position
|
||||||
|
within group box than with VCL, so reduce Top value}
|
||||||
|
else if (StackLevel > 1) and
|
||||||
|
(CompareText('Top=', Copy(StripStr, 1, 4)) = 0) and
|
||||||
|
(CompareText('TGroupBox',
|
||||||
|
StackRec[Pred(StackLevel)].ClassName) = 0) then
|
||||||
|
WriteLn(LfmFileVar,
|
||||||
|
Copy(InStr, 1, Succ(Pos('=', InStr))),
|
||||||
|
IntToStr(StrToInt(Copy(StripStr, 5, MaxInt)) - 16))
|
||||||
|
|
||||||
|
{Lazarus IDE appears to swap Top and Left properties for non-visual
|
||||||
|
controls, so swap them for Orpheus table cell controls.}
|
||||||
|
else if ((CompareText('Top=', Copy(StripStr, 1, 4)) = 0) or
|
||||||
|
(CompareText('Left=', Copy(StripStr, 1, 5)) = 0)) and
|
||||||
|
((CompareText('TOvcTC',
|
||||||
|
Copy(StackRec[StackLevel].ClassName, 1, 6)) = 0) or
|
||||||
|
(CompareText('TO32TC',
|
||||||
|
Copy(StackRec[StackLevel].ClassName, 1, 6)) = 0) or
|
||||||
|
(CompareText('TOvcController',
|
||||||
|
StackRec[StackLevel].ClassName) = 0)) then
|
||||||
|
begin
|
||||||
|
if CompareText('Top=', Copy(StripStr, 1, 4)) = 0 then
|
||||||
|
WriteLn(LfmFileVar,
|
||||||
|
StringReplace(InStr, 'Top', 'Left', [rfIgnoreCase]))
|
||||||
|
else
|
||||||
|
WriteLn(LfmFileVar,
|
||||||
|
StringReplace(InStr, 'Left', 'Top', [rfIgnoreCase]));
|
||||||
|
end
|
||||||
|
|
||||||
|
else {No change to property}
|
||||||
|
WriteLn(LfmFileVar, InStr);
|
||||||
|
|
||||||
|
{Delphi form files don't always include Height or Width properties,
|
||||||
|
which are required by Lazarus, so add them based on ClientHeight
|
||||||
|
and ClientWidth properties, which apparently act the same as
|
||||||
|
Height and Width in Lazarus (unlike Delphi).}
|
||||||
|
if (CompareText('ClientHeight=', Copy(StripStr, 1, 13)) = 0) or
|
||||||
|
(CompareText('ClientWidth=', Copy(StripStr, 1, 12)) = 0) then
|
||||||
|
WriteLn(LfmFileVar,
|
||||||
|
StringReplace(InStr, 'Client', '', [rfIgnoreCase]));
|
||||||
|
except
|
||||||
|
on EInOutError do
|
||||||
|
begin
|
||||||
|
WriteLn('Can''t write to Lazarus form file ', LfmFileName);
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end; {while not Eof}
|
||||||
|
|
||||||
|
CloseFile(DfmFileVar);
|
||||||
|
try
|
||||||
|
CloseFile(LfmFileVar);
|
||||||
|
except
|
||||||
|
on EInOutError do
|
||||||
|
begin
|
||||||
|
WriteLn('Can''t close Lazarus form file ', LfmFileName);
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
CfgFileObj.Free;
|
||||||
|
WriteLn(LfmFileName, ' successfully created');
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
154
components/xdev_toolkit/HelpUtil.pas
Normal file
154
components/xdev_toolkit/HelpUtil.pas
Normal file
@@ -0,0 +1,154 @@
|
|||||||
|
unit HelpUtil;
|
||||||
|
|
||||||
|
{
|
||||||
|
|
||||||
|
Isolates platform-specific help access for Lazarus LCL.
|
||||||
|
|
||||||
|
Assumes Application.HelpFile is set.
|
||||||
|
|
||||||
|
Create THelpUtilManager object in main form's FormCreate handler and
|
||||||
|
call its Free method in main form's FormDestroy handler.
|
||||||
|
|
||||||
|
Display help topic by calling Application.HelpContext.
|
||||||
|
|
||||||
|
Author: Phil Hess.
|
||||||
|
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
|
||||||
|
License: Modified LGPL. This means you can link your code to this
|
||||||
|
compiled unit (statically in a standalone executable or
|
||||||
|
dynamically in a library) without releasing your code. Only
|
||||||
|
changes to this unit need to be made publicly available.
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils,
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Windows,
|
||||||
|
{$ELSE}
|
||||||
|
Unix,
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
FileUtil,
|
||||||
|
{$ENDIF}
|
||||||
|
Forms,
|
||||||
|
Dialogs,
|
||||||
|
HelpIntfs;
|
||||||
|
|
||||||
|
type
|
||||||
|
THelpUtilManager = class(THelpManager)
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure ShowError( ShowResult : TShowHelpResult;
|
||||||
|
const ErrMsg : string); override;
|
||||||
|
function ShowHelpForQuery( Query : THelpQuery;
|
||||||
|
AutoFreeQuery : Boolean;
|
||||||
|
var ErrMsg : string): TShowHelpResult; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
HELP_CONTEXT = 1;
|
||||||
|
HELP_QUIT = 2;
|
||||||
|
|
||||||
|
function DoHelpCommand(Command : Word;
|
||||||
|
Data : LongInt) : Boolean;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS} {LCL doesn't have TApplication.HelpCommand, so call Win API}
|
||||||
|
Result := WinHelp(Application.MainForm.Handle,
|
||||||
|
PChar(Application.HelpFile),
|
||||||
|
Command, Data);
|
||||||
|
{$ENDIF}
|
||||||
|
end; {DoHelpCommand}
|
||||||
|
|
||||||
|
|
||||||
|
{THelpUtilManager}
|
||||||
|
|
||||||
|
destructor THelpUtilManager.Destroy;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
DoHelpCommand(HELP_QUIT, 0);
|
||||||
|
{Shut down help application if running and not in use
|
||||||
|
by another instance of program}
|
||||||
|
{$ENDIF}
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure THelpUtilManager.ShowError( ShowResult : TShowHelpResult;
|
||||||
|
const ErrMsg : string);
|
||||||
|
begin
|
||||||
|
if ShowResult = shrHelpNotFound then
|
||||||
|
MessageDlg('Help not implemented.', mtError, [mbOK], 0)
|
||||||
|
else if ShowResult = shrViewerNotFound then
|
||||||
|
MessageDlg('Help viewer not found.', mtError, [mbOK], 0)
|
||||||
|
else if ShowResult = shrViewerError then
|
||||||
|
MessageDlg('Unable to start help viewer.', mtError, [mbOK], 0)
|
||||||
|
else if ShowResult <> shrSuccess then
|
||||||
|
MessageDlg(ErrMsg, mtError, [mbOK], 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function THelpUtilManager.ShowHelpForQuery( Query : THelpQuery;
|
||||||
|
AutoFreeQuery : Boolean;
|
||||||
|
var ErrMsg : string): TShowHelpResult;
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
function SearchForBrowser(const BrowserFileName : string) : string;
|
||||||
|
begin
|
||||||
|
Result :=
|
||||||
|
SearchFileInPath(BrowserFileName, '', GetEnvironmentVariable('PATH'),
|
||||||
|
PathSeparator, [sffDontSearchInBasePath]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetBrowserPath : string;
|
||||||
|
begin
|
||||||
|
Result := SearchForBrowser('firefox');
|
||||||
|
if Result = '' then
|
||||||
|
Result := SearchForBrowser('konqueror'); {KDE browser}
|
||||||
|
if Result = '' then
|
||||||
|
Result := SearchForBrowser('epiphany'); {GNOME browser}
|
||||||
|
if Result = '' then
|
||||||
|
Result := SearchForBrowser('mozilla');
|
||||||
|
if Result = '' then
|
||||||
|
Result := SearchForBrowser('opera');
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Query is THelpQueryContext then {Is a help context request?}
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
DoHelpCommand(HELP_CONTEXT, THelpQueryContext(Query).Context);
|
||||||
|
Result := shrSuccess;
|
||||||
|
{$ELSE}
|
||||||
|
{$IFDEF DARWIN}
|
||||||
|
if Shell('Open -a "Help Viewer" "' + Application.HelpFile + '"') = 127 then
|
||||||
|
// Note: With OS X earlier than 10.4 (Tiger), if connected to network
|
||||||
|
// but not connected to Internet, takes Help Viewer 1-2 minutes to
|
||||||
|
// recover and turn off rotating ball! Can comment out previous Shell
|
||||||
|
// and uncomment next line to use default browser instead.
|
||||||
|
// if Shell('Open "' + Application.HelpFile + '"') = 127 then
|
||||||
|
Result := shrViewerError
|
||||||
|
else
|
||||||
|
Result := shrSuccess;
|
||||||
|
{$ELSE} {For now, shell to first browser found, passing help file name}
|
||||||
|
if GetBrowserPath <> '' then {Found a browser?}
|
||||||
|
begin
|
||||||
|
if Shell(GetBrowserPath + ' ' + Application.HelpFile) = 127 then
|
||||||
|
Result := shrViewerError
|
||||||
|
else
|
||||||
|
Result := shrSuccess;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := shrViewerNotFound;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
end
|
||||||
|
else {Not a help context request?}
|
||||||
|
Result := inherited ShowHelpForQuery(Query, AutoFreeQuery, ErrMsg);
|
||||||
|
end; {THelpUtilManager.ShowHelpForQuery}
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
220
components/xdev_toolkit/MakePasX.pas
Normal file
220
components/xdev_toolkit/MakePasX.pas
Normal file
@@ -0,0 +1,220 @@
|
|||||||
|
program MakePasX;
|
||||||
|
|
||||||
|
{
|
||||||
|
Makes Delphi form code file or project file cross-platform
|
||||||
|
so it can be compiled by both Delphi and Lazarus/FPC.
|
||||||
|
Note that this is a one-time conversion.
|
||||||
|
Note: Use DfmToLfm to convert form's design file to LCL
|
||||||
|
whenever changes are made to form in Delphi.
|
||||||
|
|
||||||
|
Author: Phil Hess.
|
||||||
|
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
|
||||||
|
License: Modified LGPL.
|
||||||
|
}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils;
|
||||||
|
|
||||||
|
const
|
||||||
|
ProgramName = 'MakePasX';
|
||||||
|
ProgramVersion = '0.01';
|
||||||
|
|
||||||
|
PasFileExt = '.pas'; {Pascal code file extension}
|
||||||
|
DelProjFileExt = '.dpr'; {Delphi project file extension}
|
||||||
|
TmpFileExt = '.tmp'; {Create converted file with this extension}
|
||||||
|
BakFileExt = '.bak'; {Rename original file with this extension}
|
||||||
|
|
||||||
|
var
|
||||||
|
OldFileName : string;
|
||||||
|
NewFileName : string;
|
||||||
|
OldFileVar : TextFile;
|
||||||
|
NewFileVar : TextFile;
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
MatchFound : TFilenameCaseMatch;
|
||||||
|
{$ENDIF}
|
||||||
|
IsProject : Boolean;
|
||||||
|
InStr : string;
|
||||||
|
FoundUses : Boolean;
|
||||||
|
Done : Boolean;
|
||||||
|
UnitPos : Integer;
|
||||||
|
HasAppInit : Boolean;
|
||||||
|
HasForm : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
if ParamCount = 0 then {List program useage?}
|
||||||
|
begin
|
||||||
|
WriteLn(ProgramName, ', version ', ProgramVersion,
|
||||||
|
' - makes Delphi code file cross-platform.');
|
||||||
|
WriteLn('Usage: ', ProgramName, ' filename[', PasFileExt, '|',
|
||||||
|
DelProjFileExt, ']');
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{Get name of Pascal code file to convert from command line}
|
||||||
|
OldFileName := ParamStr(1);
|
||||||
|
if ExtractFileExt(OldFileName) = '' then {No extension?}
|
||||||
|
OldFileName := OldFileName + PasFileExt; {Assume it's not a project file}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
OldFileName := ExpandFileNameCase(OldFileName, MatchFound);
|
||||||
|
{$ELSE}
|
||||||
|
OldFileName := ExpandFileName(OldFileName);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
IsProject := CompareText(ExtractFileExt(OldFileName), DelProjFileExt) = 0;
|
||||||
|
|
||||||
|
NewFileName := ChangeFileExt(OldFileName, TmpFileExt);
|
||||||
|
|
||||||
|
{Open code file}
|
||||||
|
AssignFile(OldFileVar, OldFileName);
|
||||||
|
try
|
||||||
|
Reset(OldFileVar);
|
||||||
|
except
|
||||||
|
on EInOutError do
|
||||||
|
begin
|
||||||
|
WriteLn('Can''t open Pascal code file ', OldFileName);
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{Create new code file}
|
||||||
|
AssignFile(NewFileVar, NewFileName);
|
||||||
|
try
|
||||||
|
Rewrite(NewFileVar);
|
||||||
|
except
|
||||||
|
on EInOutError do
|
||||||
|
begin
|
||||||
|
WriteLn('Can''t create new code file ', NewFileName);
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FoundUses := False;
|
||||||
|
HasAppInit := False;
|
||||||
|
HasForm := False;
|
||||||
|
while not Eof(OldFileVar) do {Read and convert Pascal code file}
|
||||||
|
begin
|
||||||
|
ReadLn(OldFileVar, InStr); {Read line of code}
|
||||||
|
|
||||||
|
if not IsProject then {Form code file?}
|
||||||
|
begin
|
||||||
|
if (CompareText(InStr, 'uses') = 0) and {Found uses section?}
|
||||||
|
(not FoundUses) then {And in interface section?}
|
||||||
|
begin {Note assumes "uses" appears on separate line from list of units}
|
||||||
|
FoundUses := True;
|
||||||
|
WriteLn(NewFileVar, InStr);
|
||||||
|
WriteLn(NewFileVar,
|
||||||
|
' {$IFNDEF LCL} Windows, Messages, ',
|
||||||
|
'{$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}');
|
||||||
|
ReadLn(OldFileVar, InStr);
|
||||||
|
repeat
|
||||||
|
UnitPos := Pos('WINDOWS,', UpperCase(InStr));
|
||||||
|
if UnitPos > 0 then
|
||||||
|
Delete(InStr, UnitPos, 8);
|
||||||
|
if Copy(InStr, UnitPos, 1) = ' ' then
|
||||||
|
Delete(InStr, UnitPos, 1);
|
||||||
|
UnitPos := Pos('MESSAGES,', UpperCase(InStr));
|
||||||
|
if UnitPos > 0 then
|
||||||
|
Delete(InStr, UnitPos, 9);
|
||||||
|
if Copy(InStr, UnitPos, 1) = ' ' then
|
||||||
|
Delete(InStr, UnitPos, 1);
|
||||||
|
UnitPos := Pos('WINTYPES,', UpperCase(InStr)); {Synonym for Windows}
|
||||||
|
if UnitPos > 0 then
|
||||||
|
Delete(InStr, UnitPos, 9);
|
||||||
|
if Copy(InStr, UnitPos, 1) = ' ' then
|
||||||
|
Delete(InStr, UnitPos, 1);
|
||||||
|
UnitPos := Pos('WINPROCS,', UpperCase(InStr)); {Synonym for Windows}
|
||||||
|
if UnitPos > 0 then
|
||||||
|
Delete(InStr, UnitPos, 9);
|
||||||
|
if Copy(InStr, UnitPos, 1) = ' ' then
|
||||||
|
Delete(InStr, UnitPos, 1);
|
||||||
|
WriteLn(NewFileVar, InStr);
|
||||||
|
Done := Pos(';', InStr) > 0;
|
||||||
|
if not Done then
|
||||||
|
ReadLn(OldFileVar, InStr);
|
||||||
|
until Done;
|
||||||
|
end {uses section}
|
||||||
|
|
||||||
|
else if CompareText(Copy(Trim(InStr), 1, 10),
|
||||||
|
'{$R *.dfm}') = 0 then {Form's resource file?}
|
||||||
|
begin
|
||||||
|
WriteLn(NewFileVar, '{$IFNDEF LCL}');
|
||||||
|
WriteLn(NewFileVar, InStr);
|
||||||
|
WriteLn(NewFileVar, '{$ENDIF}');
|
||||||
|
HasForm := True;
|
||||||
|
end
|
||||||
|
|
||||||
|
else if (CompareText(InStr, 'end.') = 0) and HasForm then {End of unit?}
|
||||||
|
begin
|
||||||
|
{Note: Make sure IFDEF goes after initialization since Delphi
|
||||||
|
inserts new event handlers immediately before initialization line.}
|
||||||
|
WriteLn(NewFileVar, 'initialization');
|
||||||
|
WriteLn(NewFileVar, '{$IFDEF LCL}');
|
||||||
|
WriteLn(NewFileVar, '{$I ', ChangeFileExt(ExtractFileName(OldFileName),
|
||||||
|
'.lrs} {Include form''s resource file}'));
|
||||||
|
WriteLn(NewFileVar, '{$ENDIF}');
|
||||||
|
WriteLn(NewFileVar);
|
||||||
|
WriteLn(NewFileVar, InStr);
|
||||||
|
end
|
||||||
|
|
||||||
|
else {Nothing to change with this line}
|
||||||
|
WriteLn(NewFileVar, InStr);
|
||||||
|
end
|
||||||
|
|
||||||
|
else {Delphi project file}
|
||||||
|
begin
|
||||||
|
if (CompareText(InStr, 'uses') = 0) and {Found uses section?}
|
||||||
|
(not FoundUses) then {And in interface section?}
|
||||||
|
begin {Note assumes "uses" appears on separate line from list of units}
|
||||||
|
FoundUses := True;
|
||||||
|
WriteLn(NewFileVar, InStr);
|
||||||
|
WriteLn(NewFileVar, '{$IFDEF LCL}');
|
||||||
|
WriteLn(NewFileVar, ' Interfaces,');
|
||||||
|
WriteLn(NewFileVar, '{$ENDIF}');
|
||||||
|
end
|
||||||
|
else if (CompareText(Copy(Trim(InStr), 1, 10), '{$R *.res}') = 0) or
|
||||||
|
(CompareText(Copy(Trim(InStr), 1, 10), '{$R *.r32}') = 0) or
|
||||||
|
(CompareText(Copy(Trim(InStr), 1, 10), '{$R *.r16}') = 0) then
|
||||||
|
begin {Program's resource file}
|
||||||
|
WriteLn(NewFileVar, '{$IFDEF MSWINDOWS}');
|
||||||
|
WriteLn(NewFileVar, InStr);
|
||||||
|
WriteLn(NewFileVar, '{$ENDIF}');
|
||||||
|
end
|
||||||
|
else if CompareText(Copy(Trim(InStr), 1, 3), '{$R') = 0 then
|
||||||
|
begin {Might be a type library or XP manifest resource file}
|
||||||
|
WriteLn(NewFileVar, '{$IFNDEF FPC}');
|
||||||
|
WriteLn(NewFileVar, InStr);
|
||||||
|
WriteLn(NewFileVar, '{$ENDIF}');
|
||||||
|
end
|
||||||
|
else if Pos('APPLICATION.INITIALIZE', UpperCase(InStr)) > 0 then
|
||||||
|
begin
|
||||||
|
HasAppInit := True;
|
||||||
|
WriteLn(NewFileVar, InStr);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (not HasAppInit) and
|
||||||
|
((Pos('APPLICATION.CREATEFORM', UpperCase(InStr)) > 0) or
|
||||||
|
(Pos('APPLICATION.RUN', UpperCase(InStr)) > 0)) then
|
||||||
|
begin
|
||||||
|
WriteLn(NewFileVar, ' Application.Initialize;'); {Laz needs this}
|
||||||
|
HasAppInit := True;
|
||||||
|
end;
|
||||||
|
WriteLn(NewFileVar, InStr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end; {while not Eof}
|
||||||
|
|
||||||
|
DeleteFile(ChangeFileExt(OldFileName, BakFileExt));
|
||||||
|
CloseFile(OldFileVar);
|
||||||
|
RenameFile(OldFileName, ChangeFileExt(OldFileName, BakFileExt));
|
||||||
|
CloseFile(NewFileVar);
|
||||||
|
if not IsProject then
|
||||||
|
RenameFile(NewFileName, ChangeFileExt(NewFileName, PasFileExt))
|
||||||
|
else
|
||||||
|
RenameFile(NewFileName, ChangeFileExt(NewFileName, DelProjFileExt));
|
||||||
|
WriteLn(OldFileName, ' successfully converted.');
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
79
components/xdev_toolkit/MakeVer.pas
Normal file
79
components/xdev_toolkit/MakeVer.pas
Normal file
@@ -0,0 +1,79 @@
|
|||||||
|
program MakeVer;
|
||||||
|
|
||||||
|
{
|
||||||
|
Makes INI-style version file from Delphi .dof file.
|
||||||
|
|
||||||
|
Author: Phil Hess.
|
||||||
|
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
|
||||||
|
License: Modified LGPL.
|
||||||
|
}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils,
|
||||||
|
Classes,
|
||||||
|
IniFiles;
|
||||||
|
|
||||||
|
const
|
||||||
|
ProgramName = 'MakeVer';
|
||||||
|
ProgramVersion = '0.01';
|
||||||
|
|
||||||
|
DofFileExt = '.dof'; {Delphi project options file extension}
|
||||||
|
VerFileExt = '.version'; {Linux/Mac version info file extension}
|
||||||
|
|
||||||
|
VersionSection = 'Version Info Keys';
|
||||||
|
|
||||||
|
var
|
||||||
|
DofFileName : string;
|
||||||
|
VerFileName : string;
|
||||||
|
DofIniFile : TIniFile;
|
||||||
|
VerIniFile : TIniFile;
|
||||||
|
VerStrList : TStringList;
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
MatchFound : TFilenameCaseMatch;
|
||||||
|
{$ENDIF}
|
||||||
|
ItemNum : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
if ParamCount = 0 then {List program useage?}
|
||||||
|
begin
|
||||||
|
WriteLn(ProgramName, ', version ', ProgramVersion,
|
||||||
|
' - makes INI-style version file from Delphi .dof file.');
|
||||||
|
WriteLn('Usage: ', ProgramName, ' filename', DofFileExt);
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{Get name of Delphi project options file from command line}
|
||||||
|
DofFileName := ParamStr(1);
|
||||||
|
if ExtractFileExt(DofFileName) = '' then
|
||||||
|
DofFileName := DofFileName + DofFileExt;
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
DofFileName := ExpandFileNameCase(DofFileName, MatchFound);
|
||||||
|
{$ELSE}
|
||||||
|
DofFileName := ExpandFileName(DofFileName);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
VerFileName := ChangeFileExt(DofFileName, VerFileExt);
|
||||||
|
|
||||||
|
if not FileExists(DofFileName) then
|
||||||
|
begin
|
||||||
|
WriteLn(DofFileName, ' does not exist');
|
||||||
|
Halt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
DofIniFile := TIniFile.Create(DofFileName);
|
||||||
|
VerStrList := TStringList.Create;
|
||||||
|
DofIniFile.ReadSectionValues(VersionSection, VerStrList); {Load vers strings}
|
||||||
|
VerIniFile := TIniFile.Create(VerFileName);
|
||||||
|
for ItemNum := 0 to Pred(VerStrList.Count) do {Write to version file}
|
||||||
|
begin
|
||||||
|
VerIniFile.WriteString(VersionSection, VerStrList.Names[ItemNum],
|
||||||
|
VerStrList.Values[VerStrList.Names[ItemNum]]);
|
||||||
|
end;
|
||||||
|
VerIniFile.UpdateFile; {Save to file}
|
||||||
|
VerIniFile.Free;
|
||||||
|
DofIniFile.Free;
|
||||||
|
WriteLn(VerFileName, ' successfully created');
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
5
components/xdev_toolkit/ReadMe.txt
Normal file
5
components/xdev_toolkit/ReadMe.txt
Normal file
@@ -0,0 +1,5 @@
|
|||||||
|
|
||||||
|
This is the XDev Toolkit.
|
||||||
|
|
||||||
|
See XDevStatus.html for more information.
|
||||||
|
|
||||||
256
components/xdev_toolkit/RtfDoc.pas
Normal file
256
components/xdev_toolkit/RtfDoc.pas
Normal file
@@ -0,0 +1,256 @@
|
|||||||
|
unit RtfDoc;
|
||||||
|
|
||||||
|
{
|
||||||
|
Class for creating RTF document.
|
||||||
|
|
||||||
|
Author: Phil Hess.
|
||||||
|
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
|
||||||
|
License: Modified LGPL. This means you can link your code to this
|
||||||
|
compiled unit (statically in a standalone executable or
|
||||||
|
dynamically in a library) without releasing your code. Only
|
||||||
|
changes to this unit need to be made publicly available.
|
||||||
|
}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils,
|
||||||
|
RtfPars;
|
||||||
|
|
||||||
|
type
|
||||||
|
TRtfDoc = class(TObject)
|
||||||
|
private
|
||||||
|
FParser : TRTFParser;
|
||||||
|
procedure DoGroup;
|
||||||
|
procedure DoCtrl;
|
||||||
|
procedure DoText;
|
||||||
|
{$IFDEF FPC}
|
||||||
|
procedure HandleError(s : ShortString);
|
||||||
|
{$ELSE} {Delphi}
|
||||||
|
procedure HandleError(s : string);
|
||||||
|
{$ENDIF}
|
||||||
|
protected
|
||||||
|
FFileName : string;
|
||||||
|
FFileVar : TextFile;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
property Parser : TRTFParser read FParser;
|
||||||
|
property FileName : string read FFileName;
|
||||||
|
procedure Start(const FileName : string); virtual;
|
||||||
|
procedure Done; virtual;
|
||||||
|
procedure OutDefaultFontTable(DefFont : Integer); virtual;
|
||||||
|
procedure OutToken( AClass : Integer;
|
||||||
|
Major : Integer;
|
||||||
|
Minor : Integer;
|
||||||
|
Param : Integer;
|
||||||
|
const Text : string); virtual;
|
||||||
|
procedure OutCtrl(Major : Integer;
|
||||||
|
Minor : Integer;
|
||||||
|
Param : Integer); virtual;
|
||||||
|
procedure OutText(const Text : string); virtual;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
constructor TRtfDoc.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FParser := TRTFParser.Create(nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TRtfDoc.Destroy;
|
||||||
|
begin
|
||||||
|
Parser.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TRtfDoc.Start(const FileName : string);
|
||||||
|
var
|
||||||
|
CurYear : Word;
|
||||||
|
CurMonth : Word;
|
||||||
|
CurDay : Word;
|
||||||
|
CurHour : Word;
|
||||||
|
CurMinute : Word;
|
||||||
|
CurSecond : Word;
|
||||||
|
CurSec100 : Word;
|
||||||
|
begin
|
||||||
|
FFileName := FileName;
|
||||||
|
AssignFile(FFileVar, FFileName);
|
||||||
|
Rewrite(FFileVar);
|
||||||
|
|
||||||
|
Parser.ResetParser;
|
||||||
|
|
||||||
|
Parser.ClassCallbacks[rtfGroup] := DoGroup;
|
||||||
|
Parser.ClassCallbacks[rtfText] := DoText;
|
||||||
|
Parser.ClassCallbacks[rtfControl] := DoCtrl;
|
||||||
|
Parser.DestinationCallbacks[rtfFontTbl] := nil;
|
||||||
|
Parser.DestinationCallbacks[rtfColorTbl] := nil;
|
||||||
|
Parser.DestinationCallbacks[rtfInfo] := nil;
|
||||||
|
Parser.OnRTFError := HandleError;
|
||||||
|
|
||||||
|
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
|
||||||
|
OutCtrl(rtfVersion, -1, 1);
|
||||||
|
OutCtrl(rtfCharSet, rtfAnsiCharSet, rtfNoParam);
|
||||||
|
|
||||||
|
{Output document creation date and time}
|
||||||
|
DecodeDate(Now, CurYear, CurMonth, CurDay);
|
||||||
|
DecodeTime(Now, CurHour, CurMinute, CurSecond, CurSec100);
|
||||||
|
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
|
||||||
|
OutCtrl(rtfDestination, rtfInfo, rtfNoParam);
|
||||||
|
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
|
||||||
|
OutCtrl(rtfSpecialChar, rtfICreateTime, rtfNoParam);
|
||||||
|
OutCtrl(rtfSpecialChar, rtfIYear, CurYear);
|
||||||
|
OutCtrl(rtfSpecialChar, rtfIMonth, CurMonth);
|
||||||
|
OutCtrl(rtfSpecialChar, rtfIDay, CurDay);
|
||||||
|
OutCtrl(rtfSpecialChar, rtfIHour, CurHour);
|
||||||
|
OutCtrl(rtfSpecialChar, rtfIMinute, CurMinute);
|
||||||
|
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
|
||||||
|
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
|
||||||
|
WriteLn(FFileVar);
|
||||||
|
|
||||||
|
end; {TRtfDoc.Start}
|
||||||
|
|
||||||
|
|
||||||
|
procedure TRtfDoc.OutDefaultFontTable(DefFont : Integer);
|
||||||
|
begin
|
||||||
|
{Output default font number}
|
||||||
|
OutCtrl(rtfDefFont, -1, DefFont);
|
||||||
|
{Output font table}
|
||||||
|
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
|
||||||
|
OutCtrl(rtfDestination, rtfFontTbl, rtfNoParam);
|
||||||
|
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
|
||||||
|
OutCtrl(rtfCharAttr, rtfFontNum, 0);
|
||||||
|
OutToken(rtfControl, rtfFontFamily, rtfFFModern, rtfNoParam,
|
||||||
|
'Courier New;');
|
||||||
|
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
|
||||||
|
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
|
||||||
|
OutCtrl(rtfCharAttr, rtfFontNum, 1);
|
||||||
|
OutToken(rtfControl, rtfFontFamily, rtfFFRoman, rtfNoParam,
|
||||||
|
'Times New Roman;');
|
||||||
|
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
|
||||||
|
OutToken(rtfGroup, rtfBeginGroup, -1, rtfNoParam, '');
|
||||||
|
OutCtrl(rtfCharAttr, rtfFontNum, 2);
|
||||||
|
OutToken(rtfControl, rtfFontFamily, rtfFFSwiss, rtfNoParam,
|
||||||
|
'Arial;');
|
||||||
|
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
|
||||||
|
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
|
||||||
|
WriteLn(FFileVar);
|
||||||
|
end; {TRtfDoc.OutDefaultFontTable}
|
||||||
|
|
||||||
|
|
||||||
|
procedure TRtfDoc.Done;
|
||||||
|
begin
|
||||||
|
WriteLn(FFileVar);
|
||||||
|
OutToken(rtfGroup, rtfEndGroup, -1, rtfNoParam, '');
|
||||||
|
CloseFile(FFileVar);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TRtfDoc.OutToken( AClass : Integer;
|
||||||
|
Major : Integer;
|
||||||
|
Minor : Integer;
|
||||||
|
Param : Integer;
|
||||||
|
const Text : string);
|
||||||
|
begin
|
||||||
|
Parser.SetToken(AClass, Major, Minor, Param, Text);
|
||||||
|
Parser.RouteToken;
|
||||||
|
if Text <> '' then
|
||||||
|
Write(FFileVar, Text);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TRtfDoc.OutCtrl(Major : Integer;
|
||||||
|
Minor : Integer;
|
||||||
|
Param : Integer);
|
||||||
|
begin
|
||||||
|
OutToken(rtfControl, Major, Minor, Param, '');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TRtfDoc.OutText(const Text : string);
|
||||||
|
var
|
||||||
|
CharNum : Integer;
|
||||||
|
begin
|
||||||
|
for CharNum := 1 to Length(Text) do
|
||||||
|
OutToken(rtfText, Ord(Text[CharNum]), 0, rtfNoParam, '');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TRtfDoc.DoGroup;
|
||||||
|
begin
|
||||||
|
if Parser.rtfMajor = rtfBeginGroup then
|
||||||
|
Write(FFileVar, '{')
|
||||||
|
else
|
||||||
|
Write(FFileVar, '}');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TRtfDoc.DoCtrl;
|
||||||
|
var
|
||||||
|
RtfIdx : Integer;
|
||||||
|
begin
|
||||||
|
if (Parser.rtfMajor = rtfSpecialChar) and
|
||||||
|
(Parser.rtfMinor = rtfPar) then
|
||||||
|
WriteLn(FFileVar); {Make RTF file more human readable}
|
||||||
|
RtfIdx := 0;
|
||||||
|
while rtfKey[RtfIdx].rtfKStr <> '' do
|
||||||
|
begin
|
||||||
|
if (Parser.rtfMajor = rtfKey[RtfIdx].rtfKMajor) and
|
||||||
|
(Parser.rtfMinor = rtfKey[RtfIdx].rtfKMinor) then
|
||||||
|
begin
|
||||||
|
Write(FFileVar, '\');
|
||||||
|
Write(FFileVar, rtfKey[RtfIdx].rtfKStr);
|
||||||
|
if Parser.rtfParam <> rtfNoParam then
|
||||||
|
Write(FFileVar, IntToStr(Parser.rtfParam));
|
||||||
|
if rtfKey[RtfIdx].rtfKStr <> '*' then
|
||||||
|
Write(FFileVar, ' ');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
Inc(RtfIdx);
|
||||||
|
end;
|
||||||
|
end; {TRtfDoc.DoCtrl}
|
||||||
|
|
||||||
|
|
||||||
|
procedure TRtfDoc.DoText;
|
||||||
|
var
|
||||||
|
AChar : Char;
|
||||||
|
begin
|
||||||
|
{rtfMajor contains the character ASCII code,
|
||||||
|
so just output it for now, preceded by \
|
||||||
|
if special char.}
|
||||||
|
AChar := Chr(Parser.rtfMajor);
|
||||||
|
case AChar of
|
||||||
|
'\' : Write(FFileVar, '\\');
|
||||||
|
'{' : Write(FFileVar, '\{');
|
||||||
|
'}' : Write(FFileVar, '\}');
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if AChar > #127 then {8-bit ANSI character?}
|
||||||
|
Write(FFileVar, '\''' + IntToHex(Ord(AChar), 2)) {Encode using 7-bit chars}
|
||||||
|
else {7-bit ANSI character}
|
||||||
|
Write(FFileVar, AChar);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end; {TRtfDoc.DoText}
|
||||||
|
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
procedure TRtfDoc.HandleError(s : ShortString);
|
||||||
|
begin
|
||||||
|
WriteLn(StdErr, s);
|
||||||
|
end;
|
||||||
|
{$ELSE} {Delphi}
|
||||||
|
procedure TRtfDoc.HandleError(s : string);
|
||||||
|
begin
|
||||||
|
WriteLn(ErrOutput, S);
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
45
components/xdev_toolkit/TestRtfDoc.pas
Normal file
45
components/xdev_toolkit/TestRtfDoc.pas
Normal file
@@ -0,0 +1,45 @@
|
|||||||
|
program TestRtfDoc;
|
||||||
|
|
||||||
|
{
|
||||||
|
Test program for RtfDoc unit.
|
||||||
|
}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils,
|
||||||
|
RtfPars, {Free Pascal unit with TRtfParser class and rtf constants}
|
||||||
|
RtfDoc; {Descendant class used in this program}
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
with TRtfDoc.Create do {Create TRtfDoc object}
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
|
||||||
|
try
|
||||||
|
Start('test.rtf'); {Create RTF file}
|
||||||
|
except
|
||||||
|
on EInOutError do {File read-only or some other I/O error}
|
||||||
|
begin
|
||||||
|
WriteLn('Can''t create file');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
OutDefaultFontTable(2); {Select font 2 (Arial) as default}
|
||||||
|
|
||||||
|
OutCtrl(rtfParAttr, rtfQuadCenter, rtfNoParam); {Center line}
|
||||||
|
OutCtrl(rtfCharAttr, rtfBold, 1); {Turn on bolding}
|
||||||
|
OutText('Hello'); {Output some text}
|
||||||
|
OutCtrl(rtfCharAttr, rtfBold, 0); {Turn off bolding}
|
||||||
|
OutText(' there!'); {Output some more text}
|
||||||
|
OutCtrl(rtfSpecialChar, rtfPar, rtfNoParam); {End of paragraph}
|
||||||
|
|
||||||
|
Done; {Close RTF file}
|
||||||
|
|
||||||
|
finally
|
||||||
|
Free; {Free TRtfDoc object}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
391
components/xdev_toolkit/ViewDoc.pas
Normal file
391
components/xdev_toolkit/ViewDoc.pas
Normal file
@@ -0,0 +1,391 @@
|
|||||||
|
unit ViewDoc;
|
||||||
|
|
||||||
|
{
|
||||||
|
|
||||||
|
Unit of functions for viewing documents with a word processor.
|
||||||
|
|
||||||
|
Author: Phil Hess.
|
||||||
|
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
|
||||||
|
License: Modified LGPL. This means you can link your code to this
|
||||||
|
compiled unit (statically in a standalone executable or
|
||||||
|
dynamically in a library) without releasing your code. Only
|
||||||
|
changes to this unit need to be made publicly available.
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils,
|
||||||
|
Classes,
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Windows,
|
||||||
|
Registry,
|
||||||
|
ShellApi;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF DARWIN} {OS X}
|
||||||
|
BaseUnix,
|
||||||
|
Unix;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
FileUtil,
|
||||||
|
Unix;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
type
|
||||||
|
TViewerOptions = set of (ovwUseAsTemplate, ovwAddToDeleteList);
|
||||||
|
|
||||||
|
function GetViewerCount : Integer;
|
||||||
|
|
||||||
|
function GetViewerName(Viewer : Integer) : string;
|
||||||
|
|
||||||
|
function ViewDocument(const FileName : string;
|
||||||
|
Viewer : Integer;
|
||||||
|
Options : TViewerOptions;
|
||||||
|
var ErrorMsg : string) : Boolean;
|
||||||
|
|
||||||
|
function DeleteViewedDocs : Boolean;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
MaxViewers = 3; {Number of supported word processors}
|
||||||
|
|
||||||
|
{Names of word processors}
|
||||||
|
ViewerName : array [1..MaxViewers] of string =
|
||||||
|
('Microsoft Word',
|
||||||
|
'OpenOffice',
|
||||||
|
'AbiWord');
|
||||||
|
|
||||||
|
{Executable files}
|
||||||
|
ViewerExe : array [1..MaxViewers] of string =
|
||||||
|
('WINWORD.EXE',
|
||||||
|
'SOFFICE.EXE',
|
||||||
|
'AbiWord.exe');
|
||||||
|
|
||||||
|
{Command line startup switches.
|
||||||
|
If non-blank, start word processor with a new document
|
||||||
|
based on the specified template. If blank, open document
|
||||||
|
read-only to force user to save under different name.}
|
||||||
|
ViewerSwitch : array [1..MaxViewers] of string =
|
||||||
|
('/t',
|
||||||
|
'-n ',
|
||||||
|
'');
|
||||||
|
|
||||||
|
ViewerRegKey : array [1..MaxViewers] of string =
|
||||||
|
('',
|
||||||
|
'',
|
||||||
|
'SOFTWARE\Classes\AbiSuite.AbiWord\shell\open\command');
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF DARWIN} {OS X}
|
||||||
|
MaxViewers = 4;
|
||||||
|
|
||||||
|
ViewerName : array [1..MaxViewers] of string =
|
||||||
|
('Microsoft Word',
|
||||||
|
'Pages',
|
||||||
|
'NeoOffice',
|
||||||
|
'AbiWord');
|
||||||
|
|
||||||
|
{OS X Open command doesn't support passing switches to app}
|
||||||
|
ViewerSwitch : array [1..MaxViewers] of string =
|
||||||
|
('',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
'');
|
||||||
|
|
||||||
|
MaxViewerFolders = 7;
|
||||||
|
|
||||||
|
ViewerFolders : array [1..MaxViewerFolders] of string =
|
||||||
|
('Microsoft Word',
|
||||||
|
'Microsoft Office 2004/Microsoft Word',
|
||||||
|
'Microsoft Office X/Microsoft Word',
|
||||||
|
'Pages.app',
|
||||||
|
'iWork ''06/Pages.app',
|
||||||
|
'NeoOffice.app',
|
||||||
|
'AbiWord.app');
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
MaxViewers = 2;
|
||||||
|
|
||||||
|
ViewerName : array [1..MaxViewers] of string =
|
||||||
|
('OpenOffice',
|
||||||
|
'AbiWord');
|
||||||
|
|
||||||
|
ViewerExe : array [1..MaxViewers] of string =
|
||||||
|
('soffice.bin',
|
||||||
|
'abiword');
|
||||||
|
|
||||||
|
ViewerSwitch : array [1..MaxViewers] of string =
|
||||||
|
('-n ',
|
||||||
|
'');
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
var
|
||||||
|
DeleteList : TStringList; {List of files to delete when program exits;
|
||||||
|
object is created and destroyed in unit's
|
||||||
|
initialization and finalization sections}
|
||||||
|
|
||||||
|
|
||||||
|
function GetViewerCount : Integer;
|
||||||
|
{Return number of viewers defined.}
|
||||||
|
begin
|
||||||
|
Result := MaxViewers;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function GetViewerName(Viewer : Integer) : string;
|
||||||
|
{Return viewer's name.}
|
||||||
|
begin
|
||||||
|
Result := ViewerName[Viewer];
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function LocateViewer(Viewer : Integer) : string;
|
||||||
|
{Return path to viewer's executable file,
|
||||||
|
or blank string if can't locate viewer.}
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
var
|
||||||
|
Reg : TRegistry;
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
{With Windows, installed programs usually have Registry entries
|
||||||
|
under the App Paths section, including complete path to program.}
|
||||||
|
Reg := TRegistry.Create;
|
||||||
|
try
|
||||||
|
Reg.RootKey := HKEY_LOCAL_MACHINE;
|
||||||
|
if ViewerRegKey[Viewer] = '' then
|
||||||
|
begin
|
||||||
|
if Reg.OpenKeyReadOnly(
|
||||||
|
'\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\' +
|
||||||
|
ViewerExe[Viewer]) then
|
||||||
|
begin {Found key, so assume program is installed}
|
||||||
|
try
|
||||||
|
if Reg.ReadString('') <> '' then {Key has (Default) registry entry?}
|
||||||
|
Result := Reg.ReadString('');
|
||||||
|
except {Trap exception if registry entry does not contain a string}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else {Non-standard registry key}
|
||||||
|
begin
|
||||||
|
if Reg.OpenKeyReadOnly(ViewerRegKey[Viewer]) then
|
||||||
|
begin {Found key, so assume program is installed}
|
||||||
|
try
|
||||||
|
if Reg.ReadString('') <> '' then {Key as (Default) registry entry?}
|
||||||
|
begin
|
||||||
|
Result := Reg.ReadString('');
|
||||||
|
if Copy(Result, 1, 1) = '"' then {Strip first quoted item?}
|
||||||
|
Result := Copy(Result, 2, Pos('"', Copy(Result, 2, MaxInt))-1);
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
Reg.Free;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF DARWIN} //TODO: Search for app like OS X LaunchServices does.
|
||||||
|
var
|
||||||
|
FolderIdx : Integer;
|
||||||
|
LocIdx : Integer;
|
||||||
|
PathPrefix : string;
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
FolderIdx := 0;
|
||||||
|
while (FolderIdx < MaxViewerFolders) and (Result = '') do
|
||||||
|
begin
|
||||||
|
Inc(FolderIdx);
|
||||||
|
if Pos(LowerCase(ViewerName[Viewer]),
|
||||||
|
LowerCase(ViewerFolders[FolderIdx])) > 0 then
|
||||||
|
begin
|
||||||
|
LocIdx := 0;
|
||||||
|
while (LocIdx < 4) and (Result = '') do
|
||||||
|
begin
|
||||||
|
Inc(LocIdx);
|
||||||
|
case LocIdx of
|
||||||
|
1 : PathPrefix := '/Applications/';
|
||||||
|
2 : PathPrefix := '~/Applications/';
|
||||||
|
3 : PathPrefix := '~/Desktop/';
|
||||||
|
4 : PathPrefix := '~/'
|
||||||
|
end;
|
||||||
|
if FileExists(PathPrefix + ViewerFolders[FolderIdx]) then
|
||||||
|
Result := PathPrefix + ViewerFolders[FolderIdx];
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
begin
|
||||||
|
{Search path for specified file name, returning its
|
||||||
|
expanded file name that includes path to it.}
|
||||||
|
Result := SearchFileInPath(
|
||||||
|
ViewerExe[Viewer], '', GetEnvironmentVariable('PATH'),
|
||||||
|
PathSeparator, [sffDontSearchInBasePath]);
|
||||||
|
{$ENDIF}
|
||||||
|
end; {LocateViewer}
|
||||||
|
|
||||||
|
|
||||||
|
function LaunchViewer(const ProgPath : string;
|
||||||
|
const Params : string;
|
||||||
|
const DefaultDir : string) : Integer;
|
||||||
|
{Start viewer program with specified command line parameters
|
||||||
|
by shelling to it, returning shell's code.}
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
var
|
||||||
|
ProgPathBuf : array [0..MAX_PATH] of Char;
|
||||||
|
ParamsBuf : array [0..MAX_PATH] of Char;
|
||||||
|
DefaultDirBuf : array [0..MAX_PATH] of Char;
|
||||||
|
begin
|
||||||
|
StrPCopy(ProgPathBuf, ProgPath);
|
||||||
|
StrPCopy(ParamsBuf, Params);
|
||||||
|
StrPCopy(DefaultDirBuf, DefaultDir);
|
||||||
|
Result := ShellExecute(0, nil, ProgPathBuf, ParamsBuf, DefaultDirBuf,
|
||||||
|
SW_SHOWNORMAL);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF DARWIN}
|
||||||
|
begin
|
||||||
|
Result := Shell('Open -a ' + ProgPath + ' ' + Params);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
begin
|
||||||
|
Result := Shell(ProgPath + ' ' + Params);
|
||||||
|
{$ENDIF}
|
||||||
|
end; {LaunchViewer}
|
||||||
|
|
||||||
|
|
||||||
|
function ViewDocument(const FileName : string;
|
||||||
|
Viewer : Integer;
|
||||||
|
Options : TViewerOptions;
|
||||||
|
var ErrorMsg : string) : Boolean;
|
||||||
|
{View FileName with Viewer. If successful, return True; if
|
||||||
|
error, return False and error message in ErrorMsg.}
|
||||||
|
var
|
||||||
|
ProgPath : string;
|
||||||
|
Switches : string;
|
||||||
|
ShellStatus : Integer;
|
||||||
|
{$IFDEF DARWIN}
|
||||||
|
FileInfo : Stat;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
ErrorMsg := 'Unexpected error';
|
||||||
|
|
||||||
|
if not FileExists(FileName) then
|
||||||
|
begin
|
||||||
|
ErrorMsg := 'File does not exist.';
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if ovwAddToDeleteList in Options then
|
||||||
|
DeleteList.Add(FileName);
|
||||||
|
|
||||||
|
if Viewer = 0 then {Use first word processor found?}
|
||||||
|
begin
|
||||||
|
ProgPath := '';
|
||||||
|
while (Viewer < MaxViewers) and (ProgPath = '') do
|
||||||
|
begin
|
||||||
|
Inc(Viewer);
|
||||||
|
ProgPath := LocateViewer(Viewer);
|
||||||
|
end;
|
||||||
|
if ProgPath = '' then
|
||||||
|
begin
|
||||||
|
ErrorMsg := 'Unable to locate a word processor.';
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else {Use specified word processor}
|
||||||
|
begin
|
||||||
|
ProgPath := LocateViewer(Viewer);
|
||||||
|
if ProgPath = '' then
|
||||||
|
begin
|
||||||
|
ErrorMsg := ViewerName[Viewer] + ' does not appear to be installed.';
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Switches := '';
|
||||||
|
if ovwUseAsTemplate in Options then
|
||||||
|
begin
|
||||||
|
Switches := ViewerSwitch[Viewer];
|
||||||
|
if Switches = '' then {No "template" switch to pass?}
|
||||||
|
{Set file read-only so user has to save under different name}
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
FileSetAttr(FileName, faReadOnly);
|
||||||
|
{$ELSE} {OS X and Linux}
|
||||||
|
begin
|
||||||
|
FpStat(FileName, FileInfo);
|
||||||
|
FpChmod(FileName, FileInfo.st_mode and ($FFFF XOR S_IWUSR));
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
ShellStatus := LaunchViewer('"' + ProgPath + '"',
|
||||||
|
Switches + '"' + FileName + '"', '');
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
if ShellStatus <= 32 then {Windows shell error?}
|
||||||
|
{$ELSE}
|
||||||
|
if ShellStatus = 127 then {Unix shell error?}
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
ErrorMsg := 'Shell error ' + IntToStr(ShellStatus) +
|
||||||
|
' attempting to start ' + ViewerName[Viewer] + '.';
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
ErrorMsg := '';
|
||||||
|
Result := True;
|
||||||
|
end; {ViewDocument}
|
||||||
|
|
||||||
|
|
||||||
|
function DeleteViewedDocs : Boolean;
|
||||||
|
{Attempt to delete documents in deletion list, returning
|
||||||
|
True if all documents deleted or False if unable to
|
||||||
|
delete all documents.}
|
||||||
|
var
|
||||||
|
DocNum : Integer;
|
||||||
|
{$IFDEF DARWIN}
|
||||||
|
FileInfo : Stat;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
for DocNum := DeleteList.Count - 1 downto 0 do
|
||||||
|
begin
|
||||||
|
if FileExists(DeleteList.Strings[DocNum]) then
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
if (FileGetAttr(DeleteList.Strings[DocNum]) and faReadOnly) <> 0 then
|
||||||
|
FileSetAttr(DeleteList.Strings[DocNum],
|
||||||
|
FileGetAttr(DeleteList.Strings[DocNum]) - faReadOnly);
|
||||||
|
{$ELSE} {OS X and Linux}
|
||||||
|
FpStat(DeleteList.Strings[DocNum], FileInfo);
|
||||||
|
if (FileInfo.st_Mode or S_IWUSR) = 0 then {File read-only?}
|
||||||
|
FpChmod(DeleteList.Strings[DocNum], FileInfo.st_Mode or S_IWUSR);
|
||||||
|
{$ENDIF}
|
||||||
|
if SysUtils.DeleteFile(DeleteList.Strings[DocNum]) then
|
||||||
|
DeleteList.Delete(DocNum)
|
||||||
|
else
|
||||||
|
Result := False; {At least one doc not deleted}
|
||||||
|
end;
|
||||||
|
end; {for DocNum}
|
||||||
|
end; {DeleteViewedDocs}
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
DeleteList := TStringList.Create;
|
||||||
|
|
||||||
|
finalization
|
||||||
|
DeleteViewedDocs;
|
||||||
|
DeleteList.Free;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
66
components/xdev_toolkit/ViewWith.pas
Normal file
66
components/xdev_toolkit/ViewWith.pas
Normal file
@@ -0,0 +1,66 @@
|
|||||||
|
program ViewWith;
|
||||||
|
|
||||||
|
{
|
||||||
|
Test program for ViewDoc unit.
|
||||||
|
}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils,
|
||||||
|
ViewDoc;
|
||||||
|
|
||||||
|
var
|
||||||
|
VwrIdx : Integer;
|
||||||
|
Viewer : Integer;
|
||||||
|
Options : TViewerOptions;
|
||||||
|
InStr : string;
|
||||||
|
ErrorMsg : string;
|
||||||
|
Done : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
if ParamCount < 2 then
|
||||||
|
begin
|
||||||
|
WriteLn('Usage: ViewWith viewername docfilename [-t] [-d]');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Viewer := 0;
|
||||||
|
for VwrIdx := 1 to GetViewerCount do
|
||||||
|
begin
|
||||||
|
if SameText(ParamStr(1), GetViewerName(VwrIdx)) then
|
||||||
|
Viewer := VwrIdx;
|
||||||
|
end;
|
||||||
|
if Viewer = 0 then
|
||||||
|
WriteLn('Specified viewer not supported - using first viewer found');
|
||||||
|
|
||||||
|
Options := [];
|
||||||
|
if FindCmdLineSwitch('t', ['-'], True) then {Treat file as template?}
|
||||||
|
Options := Options + [ovwUseAsTemplate];
|
||||||
|
|
||||||
|
if FindCmdLineSwitch('d', ['-'], True) then {Delete file before exiting?}
|
||||||
|
begin
|
||||||
|
Options := Options + [ovwAddToDeleteList];
|
||||||
|
Write('File will be deleted when done viewing - is this okay (Y/N)? ');
|
||||||
|
ReadLn(InStr);
|
||||||
|
if CompareText(InStr, 'y') <> 0 then
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not ViewDocument(ParamStr(2), Viewer, Options, ErrorMsg) then
|
||||||
|
begin
|
||||||
|
WriteLn(ErrorMsg);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FindCmdLineSwitch('d', ['-'], True) and FileExists(ParamStr(2)) then
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
Write('Press Enter when ready to delete file (or Ctrl+C to exit): ');
|
||||||
|
ReadLn(InStr);
|
||||||
|
Done := DeleteViewedDocs;
|
||||||
|
if not Done then
|
||||||
|
WriteLn(' Unable to delete file - may still be open in viewer');
|
||||||
|
until Done;
|
||||||
|
end;
|
||||||
|
end.
|
||||||
|
|
||||||
286
components/xdev_toolkit/XDevStatus.html
Normal file
286
components/xdev_toolkit/XDevStatus.html
Normal file
@@ -0,0 +1,286 @@
|
|||||||
|
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
|
||||||
|
<!--Copyright 2007 Phil Hess-->
|
||||||
|
<HTML>
|
||||||
|
|
||||||
|
<HEAD>
|
||||||
|
|
||||||
|
<TITLE>Status of XDev Toolkit</TITLE>
|
||||||
|
|
||||||
|
<META NAME="AUTHOR" CONTENT="Phil Hess">
|
||||||
|
</HEAD>
|
||||||
|
|
||||||
|
<BODY>
|
||||||
|
|
||||||
|
<CENTER>
|
||||||
|
<H1>Status of XDev Toolkit</H1>
|
||||||
|
</CENTER>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<H3>Contents</H3>
|
||||||
|
<A HREF="#Introduction">Introduction</A><BR>
|
||||||
|
<A HREF="#Installation">Installation</A><BR>
|
||||||
|
<A HREF="#CodeConverters">MakePasX & DfmToLfm: Delphi converters</A><BR>
|
||||||
|
<A HREF="#VersionInfo">MakeVer: Create a version info file</A><BR>
|
||||||
|
<A HREF="#HelpConverter">CvtHelp & HelpUtil: Convert WinHelp RTF to HTML</A><BR>
|
||||||
|
<A HREF="#OSXscripts">OS X scripts: Create an app bundle</A><BR>
|
||||||
|
<A HREF="#RTF">RtfDoc & ViewDoc: RTF document creation and viewing</A><BR>
|
||||||
|
<A HREF="#To_Do">To Do</A><BR>
|
||||||
|
<A HREF="#Other_Resources">Other Resources</A><P>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Introduction"></A><H3>Introduction</H3>
|
||||||
|
|
||||||
|
These notes describe the status of the XDev Toolkit, a set of utilities for
|
||||||
|
cross-platform development with <A HREF="http://www.lazarus.freepascal.org">Lazarus</A>
|
||||||
|
and <A HREF="http://www.freepascal.org">Free Pascal</A>. Please send your bug
|
||||||
|
reports, suggestions and comments to:<P>
|
||||||
|
|
||||||
|
MacPgmr (at) fastermac (dot) net<P>
|
||||||
|
|
||||||
|
<I>Note:</I> You can also post to the Lazarus forum if you want your bug reports
|
||||||
|
and suggestions to be seen by the entire Lazarus community.<P>
|
||||||
|
|
||||||
|
The XDev Toolkit source code is here: <A HREF="http://web.fastermac.net/~MacPgmr/XDev/downloads">http://web.fastermac.net/~MacPgmr/XDev/downloads</A><P>
|
||||||
|
|
||||||
|
All source code included in the XDev Toolkit is released under the Modified LGPL license.
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Installation"></A><H3>Installation</H3>
|
||||||
|
|
||||||
|
<OL>
|
||||||
|
<LI>Unzip the source files into their own folder.<P>
|
||||||
|
<LI>Open a terminal window and compile each utility and test program with FPC.
|
||||||
|
For example:<P>
|
||||||
|
|
||||||
|
fpc -Sd DfmToLfm.pas
|
||||||
|
|
||||||
|
<LI>To see a utility's syntax, simply run it in a terminal window
|
||||||
|
without any parameters or switches. For example:<P>
|
||||||
|
|
||||||
|
dfmtolfm
|
||||||
|
|
||||||
|
</OL>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="CodeConverters"></A><H3>MakePasX & DfmToLfm: Delphi converters</H3>
|
||||||
|
|
||||||
|
These two utilities are provided for converting Delphi projects to Lazarus
|
||||||
|
and optionally maintaining the project's forms on both Delphi and Lazarus.
|
||||||
|
The MakePasX utility is used to make Delphi code files cross-platform (.dpr
|
||||||
|
and .pas). The DfmToLfm utility is used to create Lazarus form design files
|
||||||
|
(.lfm) from Delphi form design files (.dfm).<p>
|
||||||
|
|
||||||
|
Once you've converted a Delphi app to Lazarus you can continue to
|
||||||
|
develop the app with Delphi on Windows and use Lazarus to compile
|
||||||
|
the app on other platforms. This type of app can provide the best of both
|
||||||
|
worlds: taking advantage of the Windows-specific features of Delphi while
|
||||||
|
utilizing Free Pascal and Lazarus to add cross-platform capability to the app.
|
||||||
|
|
||||||
|
<OL>
|
||||||
|
<LI>Use the MakePasX utility to make the Delphi project file (.dpr) and form
|
||||||
|
code files (.pas) cross-platform. This is a one-time conversion that results
|
||||||
|
in a set of source files that can be compiled by both Delphi and Lazarus.<P>
|
||||||
|
<LI>Use the DfmToLfm utility to create Lazarus form files (.lfm) from the Delphi
|
||||||
|
form files (.dfm).<P>
|
||||||
|
<LI>Use the Lazarus lazres utility to create the Lazarus resource file (.lrs)
|
||||||
|
from the form file (.lfm) Repeat steps 2 and 3 whenever you make changes
|
||||||
|
to the Delphi form files. If your project has a number of forms, run these
|
||||||
|
utilities for each form in a batch or shell file to automate the conversion.<P>
|
||||||
|
<LI>Compile the resulting files with Lazarus on Windows
|
||||||
|
to test the converted code and form files.<P>
|
||||||
|
<LI>Move the Lazarus project's files over to OS X or Linux and compile and
|
||||||
|
test them there with that platform's version of Lazarus.
|
||||||
|
</OL>
|
||||||
|
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="VersionInfo"></A><H3>MakeVer: Create a version info file</H3>
|
||||||
|
|
||||||
|
This simple utility extracts version information from a Delphi .dof file and
|
||||||
|
creates an INI-style .version file that can be distributed with a Lazarus app.<BR><BR>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="HelpConverter"></A><H3>CvtHelp & HelpUtil: Convert WinHelp RTF to HTML</H3>
|
||||||
|
|
||||||
|
The CvtHelp utility can be used to convert a WinHelp RTF help file
|
||||||
|
to an HTML file that can be used in a Lazarus app that uses the HelpUtil unit.
|
||||||
|
|
||||||
|
<OL>
|
||||||
|
<LI>Use Word to save the WinHelp RTF file to a "Web Page, Filtered" HTML file.
|
||||||
|
For example, open myapp.rtf and save it as myapp.htm.<P>
|
||||||
|
<LI>Run CvtHelp on the resulting HTML file and the WinHelp help project (.hpj)
|
||||||
|
file. For example:<P>
|
||||||
|
cvthelp myapp.htm myapp.html
|
||||||
|
<LI>Add the HelpUtil unit to the uses section of your Lazarus app's main form.<P>
|
||||||
|
<LI>In your main form's FormCreate handler:<P>
|
||||||
|
Application.HelpFile := ChangeFileExt(ParamStr(0), '.html');<P>
|
||||||
|
HelpManager := THelpUtilManager.Create;
|
||||||
|
<LI>In your main form's FormDestroy handler:<P>
|
||||||
|
HelpManager.Free;
|
||||||
|
<LI>To invoke help, add something like this to a menu command or button OnClick
|
||||||
|
handler:<P>
|
||||||
|
Application.HelpContext(1);
|
||||||
|
</OL>
|
||||||
|
|
||||||
|
For more information, refer to the CvtHelp and HelpUtil source code.<BR><BR>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="OSXscripts"></A><H3>OS X scripts: Create an app bundle</H3>
|
||||||
|
|
||||||
|
This script (create_app_mac.sh) creates an .app bundle (folder) for an executable
|
||||||
|
created with Lazarus and its Carbon widgetset so you can double-click the app
|
||||||
|
to start it or drag and drop the app on the dock.<P>
|
||||||
|
|
||||||
|
<UL>
|
||||||
|
<LI>Before using this script, make sure you've made it executable:<P>
|
||||||
|
|
||||||
|
chmod +x create_app_mac.sh<P>
|
||||||
|
|
||||||
|
<LI>Example: Your executable is file myapp and you want to create an .app bundle
|
||||||
|
for it named My Application.app:<P>
|
||||||
|
|
||||||
|
./create_app_mac.sh myapp "My Application"<P>
|
||||||
|
</UL>
|
||||||
|
|
||||||
|
For more information or to customize this script for a specific app,
|
||||||
|
open it in a text editor and read the comments.<P>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="RTF"></A><H3>RtfDoc & ViewDoc: RTF document creation and viewing</H3>
|
||||||
|
|
||||||
|
With Delphi, you can use a TRichEdit control to create, display and allow the
|
||||||
|
user to edit simple documents in Rich Text Format (RTF). TRichEdit is a wrapper
|
||||||
|
around the Windows RICHED32.DLL library that's also used by Windows WordPad
|
||||||
|
to create and edit RTF files. RTF is a well-documented text format that's
|
||||||
|
fully supported by Microsoft Word and OpenOffice.org.<P>
|
||||||
|
|
||||||
|
TRichEdit is a handy control for creating or displaying simple reports,
|
||||||
|
but if you try to use it for more than that you will be quickly disappointed
|
||||||
|
because TRichEdit has serious limitations. For one thing, Borland never added
|
||||||
|
support to TRichEdit for newer versions of the Rich Edit library (RICHED20.DLL).
|
||||||
|
And although it's possible to hack the Delphi ComCtrls unit to add support
|
||||||
|
for RICHED20.DLL, Microsoft never fixed some of the bugs in this library
|
||||||
|
or supported more than just a subset of RTF.<P>
|
||||||
|
|
||||||
|
Since Lazarus is a cross-platform tool, it doesn't provide a TRichEdit control.
|
||||||
|
And even if it did, this type of control might not meet your needs. After all,
|
||||||
|
TRichEdit is trying to be a word processor, something the creators of Word
|
||||||
|
and OpenOffice.org have spent many years developing. Wouldn't it make more
|
||||||
|
sense just to use an actual word processor to create and display reports?
|
||||||
|
|
||||||
|
<H4>Using TRtfParser to create RTF documents</H4>
|
||||||
|
|
||||||
|
With Windows, the easiest way to control a word processor externally from
|
||||||
|
another program is to start the Word or OpenOffice.org Automation server
|
||||||
|
and use the server to create, manipulate and display documents. But this
|
||||||
|
is a Windows-only solution; OS X and Linux don't have an equivalent to
|
||||||
|
Windows Automation.<P>
|
||||||
|
|
||||||
|
Fortunately Free Pascal includes a unit named RtfPars that includes the
|
||||||
|
TRtfParser class. While this class was designed to parse and proof existing
|
||||||
|
RTF documents, you can also run it "backwards" to create RTF documents as well.<P>
|
||||||
|
|
||||||
|
To simplify use of the TRtfParser class, the XDev Toolkit includes unit RtfDoc,
|
||||||
|
which introduces a TRtfParser descendant, TRtfDoc, which can be used
|
||||||
|
to create RTF files without knowing how TRtfParser works. For information
|
||||||
|
on how to use it, look at the RtfDoc.pas file and TestRtfDoc.pas example
|
||||||
|
program. You'll also want to look at the Free Pascal rtfdata.inc file for
|
||||||
|
a list of constants that you'll need to use with TRtfDoc.<P>
|
||||||
|
|
||||||
|
For more information on the RTF specification, refer to Microsoft's documentation.<P>
|
||||||
|
|
||||||
|
<H4>Using Word and OpenOffice.org to display RTF documents</H4>
|
||||||
|
|
||||||
|
Assuming you can create your RTF report document as described in the previous
|
||||||
|
section, you now need a way to display it with a word processor. With Windows,
|
||||||
|
you would probably start the Word or OpenOffice.org Automation server, load
|
||||||
|
the report document, then make the program visible so the user can browse,
|
||||||
|
edit, print or save the report. To do this in a cross-platform way, you can
|
||||||
|
instead shell to the word processor and pass the report file name on the
|
||||||
|
command line. Here are the steps:
|
||||||
|
|
||||||
|
<UL>
|
||||||
|
<LI>Determine that the word processor exists and the location of its executable.
|
||||||
|
<LI>Start the word processor by shelling to it, passing it the name of the RTF
|
||||||
|
report document.
|
||||||
|
<LI>Clean up.
|
||||||
|
</UL>
|
||||||
|
|
||||||
|
The XDev Toolkit includes unit ViewDoc, which takes care of most of the details.
|
||||||
|
The first two steps are handled by its ViewDocument function, to which you pass
|
||||||
|
the document name and which word processor to use (Word or OO) and let it
|
||||||
|
determine the word processor's location and launch it. The clean-up step is
|
||||||
|
handled by the unit's DeleteViewedDocs function. For more information on how
|
||||||
|
to use these functions, look at file ViewDoc.pas and ViewWith.pas, a test
|
||||||
|
program that uses the ViewDoc unit.<P>
|
||||||
|
|
||||||
|
Why would you need to clean up after launching the word processor? Usually
|
||||||
|
this step is necessary because the report document will be a temporary file
|
||||||
|
that you'll want to delete. You probably shouldn't require your users to name
|
||||||
|
each report document that your program creates. This will quickly annoy them;
|
||||||
|
it also forces your users to clean up the clutter of saved report documents.
|
||||||
|
Instead, you should use the GetTempFilename function (in the Lazarus FileUtil
|
||||||
|
unit) to get a file name to use for your temporary file, then delete this file
|
||||||
|
yourself at some point after launching the word processor. (Don't use the same
|
||||||
|
file name for all reports since this will restrict your users to viewing only
|
||||||
|
one report at a time.)<P>
|
||||||
|
|
||||||
|
But how can you delete a file if it's open in another program? Remember, your
|
||||||
|
word processor is running externally to your program and locks the file as
|
||||||
|
long as it's open. The file and the word processor won't be closed until the
|
||||||
|
user decides to close them. And even if the file has already been closed,
|
||||||
|
are you sure you want to delete it? What if your user made changes to the
|
||||||
|
report and saved it?<P>
|
||||||
|
|
||||||
|
The solution that ViewDocument uses is to start the word processor with
|
||||||
|
a switch that tells it to create a new document based on the report file
|
||||||
|
(that is, using it as a template). ViewDocument can also add the report file
|
||||||
|
to a list of temporary files to be deleted when your program shuts down. Even
|
||||||
|
though your program still can't delete the temporary file as long as the new
|
||||||
|
document based on it is open in the word processor, this does mean that if
|
||||||
|
the user saves the new document, it won't be with the report file's name.<P>
|
||||||
|
|
||||||
|
To delete the temporary files created by your program, call the DeleteViewedDocs
|
||||||
|
function in your main form's FormCloseQuery handler. If DeleteViewedDocs
|
||||||
|
returns False, you can remind your user to save or close any reports still
|
||||||
|
open in the word processor. DeleteViewedDocs is also called by the ViewDoc
|
||||||
|
unit's finalization code to clean up whatever it can when the program finally
|
||||||
|
does shut down.<P>
|
||||||
|
|
||||||
|
One final note: With OS X, the normal way to start a program from a terminal
|
||||||
|
command line or when shelling is to use the Open command. Unfortunately, the
|
||||||
|
only parameter that Open passes along to the program is the name of the file
|
||||||
|
to open, so there's no way to pass any switches to Word or NeoOffice. With OS X,
|
||||||
|
ViewDocument instead sets the temporary report file to read-only, thus forcing
|
||||||
|
the user to use a different name when saving the report. A disadvantage of this
|
||||||
|
approach is that the word processor shows the name of the temporary file in
|
||||||
|
the title bar (for example, rpt1.tmp) rather than Document1 or Untitled1 as it
|
||||||
|
normally does with a new document. ViewDocument also uses this approach with
|
||||||
|
AbiWord, which doesn't appear to support a command line template switch.
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="To_Do"></A><H3>To Do</H3>
|
||||||
|
<OL>
|
||||||
|
<LI>Generalize MakeVer so it can use a Delphi .bdsproj file as input and
|
||||||
|
also be able to output version information to a Lazarus .lpi file.<P>
|
||||||
|
<LI>Review Free Pascal's rtfdata.inc file for additional bugs.
|
||||||
|
</OL>
|
||||||
|
|
||||||
|
<HR>
|
||||||
|
<A name="Other_Resources"></A><H3>Other Resources</H3>
|
||||||
|
|
||||||
|
<A HREF="http://wiki.lazarus.freepascal.org/The_Power_of_Proper_Planning_and_Practices">http://wiki.lazarus.freepascal.org/The_Power_of_Proper_Planning_and_Practices</A><P>
|
||||||
|
|
||||||
|
<A HREF="http://wiki.lazarus.freepascal.org/Multiplatform_Programming_Guide">http://wiki.lazarus.freepascal.org/Multiplatform_Programming_Guide</A><P>
|
||||||
|
|
||||||
|
<A HREF="http://wiki.lazarus.freepascal.org/OS_X_Programming_Tips">http://wiki.lazarus.freepascal.org/OS_X_Programming_Tips</A><P>
|
||||||
|
|
||||||
|
<A HREF="http://wiki.lazarus.freepascal.org/Deploying_Your_Application">http://wiki.lazarus.freepascal.org/Deploying_Your_Application</A><P>
|
||||||
|
<P>
|
||||||
|
<HR>
|
||||||
|
Last updated: April 15, 2007
|
||||||
|
<P>
|
||||||
|
|
||||||
|
</BODY>
|
||||||
|
|
||||||
|
</HTML>
|
||||||
83
components/xdev_toolkit/create_app_mac.sh
Executable file
83
components/xdev_toolkit/create_app_mac.sh
Executable file
@@ -0,0 +1,83 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
# Force Bourne shell in case tcsh is default.
|
||||||
|
#
|
||||||
|
# Author: Phil Hess
|
||||||
|
# Revisions: 2007-03-17 - initial release.
|
||||||
|
# 2007-04-09 - added support for .icns file.
|
||||||
|
#
|
||||||
|
exename=$1
|
||||||
|
appname=$2
|
||||||
|
if [ "$appname" = "" ]
|
||||||
|
then
|
||||||
|
appname=$exename
|
||||||
|
fi
|
||||||
|
appfolder=$appname.app
|
||||||
|
plistfile=$appfolder/Contents/Info.plist
|
||||||
|
#
|
||||||
|
if [ "$exename" = "" ]
|
||||||
|
then
|
||||||
|
echo "Usage: $0 executable_file [app_name]"
|
||||||
|
echo "Creates .app bundle (folder) for specified executable file"
|
||||||
|
elif ! [ -e $exename ]
|
||||||
|
then
|
||||||
|
echo "$exename does not exist"
|
||||||
|
elif [ -e "$appfolder" ]
|
||||||
|
then
|
||||||
|
echo "$appfolder already exists"
|
||||||
|
else
|
||||||
|
echo "Creating $appfolder..."
|
||||||
|
mkdir "$appfolder"
|
||||||
|
mkdir "$appfolder/Contents"
|
||||||
|
mkdir "$appfolder/Contents/MacOS"
|
||||||
|
mkdir "$appfolder/Contents/Resources"
|
||||||
|
#
|
||||||
|
# Instead of copying executable into .app folder after each compile,
|
||||||
|
# simply create a symbolic link to executable.
|
||||||
|
# Tip: When you're ready to distribute your .app, delete the link
|
||||||
|
# and copy the executable into the .app folder.
|
||||||
|
ln -s ../../../$exename "$appfolder/Contents/MacOS/$exename"
|
||||||
|
#
|
||||||
|
# Create PkgInfo file using first 4 chars of application name.
|
||||||
|
echo "APPL"${appname:0:4} >$appfolder/Contents/PkgInfo
|
||||||
|
#
|
||||||
|
# If it exists, copy icons file with same name.
|
||||||
|
if [ -e "$exename.icns" ]
|
||||||
|
then
|
||||||
|
cp -p $exename.icns "$appfolder/Contents/Resources"
|
||||||
|
fi
|
||||||
|
#
|
||||||
|
# Create information property list file (Info.plist).
|
||||||
|
# Tip: By customizing this script for a specific app, you can set
|
||||||
|
# additional properties such as CFBundleGetInfoString for copyright
|
||||||
|
# info, CFBundleIconFile for name of icon file (.icns) in Resources,
|
||||||
|
# and CFBundleIdentifier (example: com.myorganization.myapp), as well
|
||||||
|
# as more precise CFBundleSignature (change PkgInfo file too) and
|
||||||
|
# CFBundleVersion strings.
|
||||||
|
echo '<?xml version="1.0" encoding="UTF-8"?>' >$plistfile
|
||||||
|
echo '<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">' >>$plistfile
|
||||||
|
echo '<plist version="1.0">' >>$plistfile
|
||||||
|
echo '<dict>' >>$plistfile
|
||||||
|
echo ' <key>CFBundleDevelopmentRegion</key>' >>$plistfile
|
||||||
|
echo ' <string>English</string>' >>$plistfile
|
||||||
|
echo ' <key>CFBundleExecutable</key>' >>$plistfile
|
||||||
|
echo ' <string>'$exename'</string>' >>$plistfile
|
||||||
|
if [ -e "$exename.icns" ]
|
||||||
|
then
|
||||||
|
echo ' <key>CFBundleIconFile</key>' >>$plistfile
|
||||||
|
echo ' <string>'$exename'.icns</string>' >>$plistfile
|
||||||
|
fi
|
||||||
|
echo ' <key>CFBundleInfoDictionaryVersion</key>' >>$plistfile
|
||||||
|
echo ' <string>6.0</string>' >>$plistfile
|
||||||
|
echo ' <key>CFBundleName</key>' >>$plistfile
|
||||||
|
echo ' <string>'$appname'</string>' >>$plistfile
|
||||||
|
echo ' <key>CFBundlePackageType</key>' >>$plistfile
|
||||||
|
echo ' <string>APPL</string>' >>$plistfile
|
||||||
|
echo ' <key>CFBundleSignature</key>' >>$plistfile
|
||||||
|
echo ' <string>'${appname:0:4}'</string>' >>$plistfile
|
||||||
|
echo ' <key>CFBundleVersion</key>' >>$plistfile
|
||||||
|
echo ' <string>1.0</string>' >>$plistfile
|
||||||
|
echo ' <key>CSResourcesFileMapped</key>' >>$plistfile
|
||||||
|
echo ' <true/>' >>$plistfile
|
||||||
|
echo '</dict>' >>$plistfile
|
||||||
|
echo '</plist>' >>$plistfile
|
||||||
|
fi
|
||||||
Reference in New Issue
Block a user