Added support to DfmToLfm for converting a Lazarus form file too.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1451 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
macpgmr
2011-01-17 02:33:03 +00:00
parent 6e3fc136ed
commit 29be3030df
3 changed files with 205 additions and 123 deletions

View File

@@ -32,7 +32,21 @@
<A name="Whats_New"></A><H3>What's New</H3> <A name="Whats_New"></A><H3>What's New</H3>
<UL> <UL>
<LI><B>20101230 release:</B> <LI><B>20110116 release:</B>
<UL>
<LI>DfmToLfm now supports converting a Lazarus form file too, as a way
to create more than one version of the same form, for example to conditionally
include a different version based on widgetset target. For example, you could
do this in a form's unit:
<PRE>
{$IFNDEF LCLCarbon}
{$R *.lfm} //include generic form with Windows and Linux
{$ELSE}
{$R *.mac.lfm} //include prettied form with Mac (-m -s switches)
{$ENDIF}
</PRE>
</UL>
<LI>20101230 release:
<UL> <UL>
<LI>Added -s switch to DfmToLfm (substitutes fonts). <LI>Added -s switch to DfmToLfm (substitutes fonts).
</UL> </UL>
@@ -355,7 +369,7 @@ also be able to output version information to a Lazarus .lpi file.<P>
<A HREF="http://wiki.lazarus.freepascal.org/Deploying_Your_Application">http://wiki.lazarus.freepascal.org/Deploying_Your_Application</A><P> <A HREF="http://wiki.lazarus.freepascal.org/Deploying_Your_Application">http://wiki.lazarus.freepascal.org/Deploying_Your_Application</A><P>
<P> <P>
<HR> <HR>
Last updated: Jan 2, 2011 Last updated: Jan 16, 2011
<P> <P>
</BODY> </BODY>

View File

@@ -1,10 +1,12 @@
; DfmToLfm program configuration file. ; DfmToLfm program configuration file.
; Be sure to add "=" after each key you add. The key's value can be omitted ; Be sure to add "=" after each key you add to [DeleteProps], [NoFont] and
; as it has no meaning to DfmToLfm. ; [MacNoFocus]. The key's value can be omitted as it has no meaning to
; DfmToLfm.
; DfmToLfm deletes these .dfm properties when creating .lfm file. ; DfmToLfm deletes these .dfm properties when creating .lfm file.
; Note: If no class is specified, deletes that property from all classes. ; Note: If no class is specified, deletes that property from all classes.
; Commented properties have been added to LCL since converter was written.
[DeleteProps] [DeleteProps]
IsControl= IsControl=
@@ -17,10 +19,10 @@ OnClickCheck=
Flat= Flat=
IntegralHeight= IntegralHeight=
DesignSize= DesignSize=
AutoSelect= ;AutoSelect=
BiDiMode= ;BiDiMode=
ParentBiDiMode= ;ParentBiDiMode=
HideSelection= ;HideSelection=
ImeMode= ImeMode=
ImeName= ImeName=
OEMConvert= OEMConvert=
@@ -62,22 +64,22 @@ TBevel.Font.Color=
TBevel.Font.Height= TBevel.Font.Height=
TBevel.Font.Name= TBevel.Font.Name=
TBevel.Font.Style= TBevel.Font.Style=
TTabSheet.Font.Charset= ;TTabSheet.Font.Charset=
TTabSheet.Font.Color= ;TTabSheet.Font.Color=
TTabSheet.Font.Height= ;TTabSheet.Font.Height=
TTabSheet.Font.Name= ;TTabSheet.Font.Name=
TTabSheet.Font.Style= ;TTabSheet.Font.Style=
TNotebook.Font.Charset= TNotebook.Font.Charset=
TNotebook.Font.Color= TNotebook.Font.Color=
TNotebook.Font.Height= TNotebook.Font.Height=
TNotebook.Font.Name= TNotebook.Font.Name=
TNotebook.Font.Style= TNotebook.Font.Style=
TNotebook.ParentFont= TNotebook.ParentFont=
TLabeledEdit.Font.Charset= ;TLabeledEdit.Font.Charset=
TLabeledEdit.Font.Color= ;TLabeledEdit.Font.Color=
TLabeledEdit.Font.Height= ;TLabeledEdit.Font.Height=
TLabeledEdit.Font.Name= ;TLabeledEdit.Font.Name=
TLabeledEdit.Font.Style= ;TLabeledEdit.Font.Style=
TListBox.ScrollWidth= TListBox.ScrollWidth=
TDBImage.TabOrder= TDBImage.TabOrder=
TScrollBox.HorzScrollBar.Tracking= TScrollBox.HorzScrollBar.Tracking=
@@ -86,6 +88,8 @@ TScrollBox.VertScrollBar.Tracking=
; When -p switch is used with DfmToLfm, don't try to add parent's font ; 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. ; properties to these classes since they don't have font in LCL.
; Commented classes have had font properties added in LCL since converter
; was written.
[NoFont] [NoFont]
TMainMenu= TMainMenu=
@@ -93,7 +97,7 @@ TMenuItem=
TPopupMenu= TPopupMenu=
TScrollBar= TScrollBar=
TImage= TImage=
TTabSheet= ;TTabSheet=
;TCheckBox= ;TCheckBox=
;TCheckGroup= ;TCheckGroup=
;TCheckListBox= ;TCheckListBox=
@@ -103,7 +107,7 @@ TActionList=
TShape= TShape=
TBevel= TBevel=
TNotebook= TNotebook=
TLabeledEdit= ;TLabeledEdit=
TProgressBar= TProgressBar=
TSplitter= TSplitter=
TTimer= TTimer=
@@ -145,6 +149,8 @@ System=Arial
[MacFontSubstitutes] [MacFontSubstitutes]
Arial=Lucida Grande Arial=Lucida Grande
;Arial=Helvetica ;Arial=Helvetica
MS Sans Serif=Lucida Grande
System=Lucida Grande
; These controls cannot receive focus on Mac, so with -m switch ; These controls cannot receive focus on Mac, so with -m switch
@@ -158,3 +164,4 @@ TCheckBox=
TRadioGroup= TRadioGroup=
TListBox= TListBox=
TPageControl= TPageControl=

View File

@@ -3,22 +3,45 @@ program DfmToLfm;
{ {
Converts Delphi form design file to a Lazarus form file by Converts Delphi form design file to a Lazarus form file by
deleting properties that are not supported by LCL and deleting properties that are not supported by LCL and
optionally making changes to font properties. The resulting optionally making changes to font properties. (The resulting
Lazarus form file can then be converted to a Lazarus resource Lazarus form file can then be converted to a Lazarus resource
file with LazRes. file with LazRes, although this second step is only needed
now with Lazarus 0.9.28 and earlier.)
Note that the Delphi form file must be a text file. Note that the Delphi form file must be a text file.
List of properties to delete and other configuration settings List of properties to delete and other configuration settings
are read from DfmToLfm.ini. are read from dfmtolfm.ini.
This utility (and Lazarus LazRes) can be used whenever design
changes are made to the form in Delphi. This utility (and Lazarus LazRes, if needed) can be used whenever
Note: Use MakePasX to make the form's code file cross-platform design changes are made to the form in Delphi.
(a one-time conversion).
Note: You can use MakePasX to make the form's code file
cross-platform (a one-time conversion).
Author: Phil Hess. Author: Phil Hess.
Copyright: Copyright (C) 2007-2010 Phil Hess. All rights reserved. Copyright: Copyright (C) 2007-2011 Phil Hess. All rights reserved.
License: Modified LGPL. License: Modified LGPL.
} }
(*
Note: This converter can also convert a Lazarus form file to
another Lazarus form file (.lfm -->.lfm). This can be useful
if you need to conditionally include a different form depending
on widgetset target. Example:
{$IFNDEF LCLCarbon}
{$R *.lfm} //include generic form with Windows and Linux
{$ELSE}
{$R *.mac.lfm} //include prettied form with Mac (-m -s switches)
{$ENDIF}
In this case, you would make changes in Lazarus only to the
generic form file, then convert it to use with Mac:
dfmtolfm myform.lfm myform.mac.lfm -m -s
*)
{$IFDEF FPC} {$IFDEF FPC}
{$MODE Delphi} {$MODE Delphi}
{$ELSE} {$ELSE}
@@ -32,7 +55,7 @@ uses
const const
ProgramName = 'DfmToLfm'; ProgramName = 'DfmToLfm';
ProgramVersion = '0.03'; ProgramVersion = '0.04';
DfmFileExt = '.dfm'; {Delphi form file extension} DfmFileExt = '.dfm'; {Delphi form file extension}
LfmFileExt = '.lfm'; {Lazarus form file extension} LfmFileExt = '.lfm'; {Lazarus form file extension}
@@ -42,6 +65,7 @@ const
NoFontChanges = 0; {No font switch on command line} NoFontChanges = 0; {No font switch on command line}
UseParentFont = 1; {-p font switch on command line} UseParentFont = 1; {-p font switch on command line}
DeleteFontName = 2; {-d font switch on command line} DeleteFontName = 2; {-d font switch on command line}
SubstFontName = 3; {-s font switch on command line}
MaxNestedObjs = 20; {Maximum depth of nested controls on form} MaxNestedObjs = 20; {Maximum depth of nested controls on form}
MaxFontProps = 5; {Maximum font properties that can be saved} MaxFontProps = 5; {Maximum font properties that can be saved}
@@ -60,13 +84,13 @@ var
MatchFound : TFilenameCaseMatch; MatchFound : TFilenameCaseMatch;
{$ENDIF} {$ENDIF}
FontSwitch : Integer; FontSwitch : Integer;
SubstFonts : Boolean;
MacSwitch : Boolean; MacSwitch : Boolean;
CfgFileObj : TMemIniFile; CfgFileObj : TMemIniFile;
DfmFileName : string; InFileName : string;
LfmFileName : string; IsDfmInFile : Boolean;
DfmFileVar : TextFile; OutFileName : string;
LfmFileVar : TextFile; InFileVar : TextFile;
OutFileVar : TextFile;
StackLevel : Integer; StackLevel : Integer;
StackRec : array [1..MaxNestedObjs] of TStackRec; StackRec : array [1..MaxNestedObjs] of TStackRec;
DeleteLine : Boolean; DeleteLine : Boolean;
@@ -87,18 +111,31 @@ begin
if ParamCount = 0 then {List program syntax and exit?} if ParamCount = 0 then {List program syntax and exit?}
begin begin
WriteLn(ProgramName, ', version ', ProgramVersion, WriteLn(ProgramName, ', version ', ProgramVersion);
' - converts a Delphi form file to a Lazarus form file.'); WriteLn('Converts a Delphi (or Lazarus) form file to a Lazarus form file.');
WriteLn('Usage: ', ProgramName, ' filename', DfmFileExt, WriteLn;
' [-p|-d][-s][-m]'); WriteLn('Usage: ', LowerCase(ProgramName), ' infile[', DfmFileExt, '|',
LfmFileExt, '] [outfile.lfm] [-p|-d|-s][-m]');
WriteLn;
WriteLn('Switches:'); WriteLn('Switches:');
WriteLn(' -p Add parent''s font to controls with no font ', WriteLn(' -p Add parent''s font to controls with no font ',
'(useful with Windows).'); '(useful with Windows).');
WriteLn(' -d Delete font name from controls ', WriteLn(' -d Delete font name from controls ',
'(useful with GTK and GTK2).'); '(useful with GTK and GTK2).');
WriteLn(' -s Substitute font names.'); WriteLn(' -s Substitute font names (useful with non-Windows targets).');
WriteLn(' -m Mac prettifier.'); WriteLn(' -m Mac prettifier.');
WriteLn('Looks for configuration data in file ', CfgFileName); WriteLn;
WriteLn('Example:');
WriteLn(' ', LowerCase(ProgramName),
' MainForm.dfm -s -m (Creates MainForm.lfm, substituting fonts');
WriteLn(' and prettying form for use on Mac.)');
WriteLn;
WriteLn('Notes:');
WriteLn(' ', ProgramName, ' will look for its configuration data here:');
WriteLn(' ', CfgFileName);
WriteLn;
WriteLn(' See also the comments at top of ', LowerCase(ProgramName),
'.pas.');
Halt; Halt;
end; end;
@@ -107,8 +144,9 @@ begin
if FindCmdLineSwitch('p', ['-'], True) then if FindCmdLineSwitch('p', ['-'], True) then
FontSwitch := UseParentFont FontSwitch := UseParentFont
else if FindCmdLineSwitch('d', ['-'], True) then else if FindCmdLineSwitch('d', ['-'], True) then
FontSwitch := DeleteFontName; FontSwitch := DeleteFontName
SubstFonts := FindCmdLineSwitch('s', ['-'], True); else if FindCmdLineSwitch('s', ['-'], True) then
FontSwitch := SubstFontName;
MacSwitch := FindCmdLineSwitch('m', ['-'], True); MacSwitch := FindCmdLineSwitch('m', ['-'], True);
{Load configuration file} {Load configuration file}
@@ -119,52 +157,75 @@ begin
end; end;
CfgFileObj := TMemIniFile.Create(CfgFileName); CfgFileObj := TMemIniFile.Create(CfgFileName);
{Get name of Delphi form file from command line} {Get name of input form file from command line}
DfmFileName := ParamStr(1); InFileName := ParamStr(1);
if ExtractFileExt(DfmFileName) = '' then if ExtractFileExt(InFileName) = '' then {No extension?}
DfmFileName := DfmFileName + DfmFileExt; InFileName := InFileName + DfmFileExt; {Assume it's a Delphi form file}
{$IFNDEF FPC} {$IFNDEF FPC}
DfmFileName := ExpandFileNameCase(DfmFileName, MatchFound); InFileName := ExpandFileNameCase(InFileName, MatchFound);
{$ELSE} {$ELSE}
DfmFileName := ExpandFileName(DfmFileName); InFileName := ExpandFileName(InFileName);
{$ENDIF}
IsDfmInFile := SameText(ExtractFileExt(InFileName), DfmFileExt);
{Get name of output form file from command line or generate it}
OutFileName := '';
if (ParamStr(2) <> '') and (Copy(ParamStr(2), 1, 1) <> '-') then
OutFileName := ParamStr(2) {Output file specified}
else if IsDfmInFile then
OutFileName := ChangeFileExt(InFileName, LfmFileExt);
{Base Lazarus form file name on Delphi form file name}
if OutFileName = '' then
begin
WriteLn('No output file specified');
Halt; {If converting a Lazarus form file, have to specify output file}
end;
{$IFNDEF FPC}
OutFileName := ExpandFileNameCase(OutFileName, MatchFound);
{$ELSE}
OutFileName := ExpandFileName(OutFileName);
{$ENDIF} {$ENDIF}
{Base Lazarus form file name on Delphi form file name} if SameText(InFileName, OutFileName) then
LfmFileName := ChangeFileExt(DfmFileName, LfmFileExt); begin
WriteLn('Output file is same as input file');
Halt;
end;
{Open Delphi form file} {Open input form file}
AssignFile(DfmFileVar, DfmFileName); AssignFile(InFileVar, InFileName);
try try
Reset(DfmFileVar); Reset(InFileVar);
except except
on EInOutError do on EInOutError do
begin begin
WriteLn('Can''t open Delphi form file ', DfmFileName); WriteLn('Can''t open input form file ', InFileName);
Halt; Halt;
end; end;
end; end;
{Create Lazarus form file} {Create output form file}
AssignFile(LfmFileVar, LfmFileName); AssignFile(OutFileVar, OutFileName);
try try
Rewrite(LfmFileVar); Rewrite(OutFileVar);
except except
on EInOutError do on EInOutError do
begin begin
WriteLn('Can''t create Lazarus form file ', LfmFileName); WriteLn('Can''t create output form file ', OutFileName);
Halt; Halt;
end; end;
end; end;
StackLevel := 0; StackLevel := 0;
while not Eof(DfmFileVar) do {Read and process Delphi form file} while not Eof(InFileVar) do {Read and process input form file}
begin begin
DeleteLine := False; DeleteLine := False;
ReadLn(DfmFileVar, InStr); {Read property from form file} ReadLn(InFileVar, InStr); {Read property from form file}
StripStr := StringReplace(InStr, ' ', '', [rfReplaceAll]); {Strip spaces} StripStr := StringReplace(InStr, ' ', '', [rfReplaceAll]); {Strip spaces}
if ((CompareText('object ', Copy(Trim(InStr), 1, 7)) = 0) or if (SameText('object ', Copy(Trim(InStr), 1, 7)) or
(CompareText('end', StripStr) = 0)) and {End of object's props reached?} SameText('end', StripStr)) and {End of object's props reached?}
(StackLevel > 1) and {Object is nested?} (StackLevel > 1) and {Object is nested?}
(not CfgFileObj.ValueExists( (not CfgFileObj.ValueExists(
'NoFont', StackRec[StackLevel].ClassName)) and {Class has font?} 'NoFont', StackRec[StackLevel].ClassName)) and {Class has font?}
@@ -181,14 +242,14 @@ begin
begin {Add font properties to current object} begin {Add font properties to current object}
for FontPropNum := 1 to StackRec[ParentLevel].FontPropCnt do for FontPropNum := 1 to StackRec[ParentLevel].FontPropCnt do
begin begin
WriteLn(LfmFileVar, StringOfChar(' ', (StackLevel-ParentLevel)*2), WriteLn(OutFileVar, StringOfChar(' ', (StackLevel-ParentLevel)*2),
StackRec[ParentLevel].FontProps[FontPropNum]); StackRec[ParentLevel].FontProps[FontPropNum]);
end; end;
end; end;
StackRec[StackLevel].FontAdded := True; StackRec[StackLevel].FontAdded := True;
end; end;
if CompareText('object ', Copy(Trim(InStr), 1, 7)) = 0 then if SameText('object ', Copy(Trim(InStr), 1, 7)) then
begin {Push object's class name on stack} begin {Push object's class name on stack}
Inc(StackLevel); Inc(StackLevel);
if Pos(': ', InStr) > 0 then {Named control?} if Pos(': ', InStr) > 0 then {Named control?}
@@ -200,32 +261,30 @@ begin
StackRec[StackLevel].FontAdded := False; StackRec[StackLevel].FontAdded := False;
end end
else if CompareText('end', StripStr) = 0 then else if SameText('end', StripStr) then
begin {Pop current class from stack} begin {Pop current class from stack}
Dec(StackLevel); Dec(StackLevel);
end end
else if CompareText('font.', Copy(Trim(InStr), 1, 5)) = 0 then else if SameText('font.', Copy(Trim(InStr), 1, 5)) then
begin {Font property} begin {Font property}
if FontSwitch <> NoFontChanges then if FontSwitch = UseParentFont then
begin begin {Save font property in case need it for child objects}
if FontSwitch = UseParentFont then if StackRec[StackLevel].FontPropCnt < MaxFontProps 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 begin
if CompareText('font.name', Copy(Trim(InStr), 1, 9)) = 0 then Inc(StackRec[StackLevel].FontPropCnt);
DeleteLine := True; StackRec[StackLevel].FontProps[StackRec[StackLevel].FontPropCnt] :=
InStr;
end; end;
end
else if FontSwitch = DeleteFontName then
begin
if SameText('font.name', Copy(Trim(InStr), 1, 9)) then
DeleteLine := True;
end; end;
{Check if font property should be deleted from current object} {Check if font property should be deleted from current object}
if CfgFileObj.ValueExists('DeleteProps', if IsDfmInFile and
CfgFileObj.ValueExists('DeleteProps',
StackRec[StackLevel].ClassName + '.' + StackRec[StackLevel].ClassName + '.' +
Copy(StripStr, 1, Pos('=', StripStr)-1)) then Copy(StripStr, 1, Pos('=', StripStr)-1)) then
DeleteLine := True; DeleteLine := True;
@@ -234,53 +293,53 @@ begin
else if Copy(StripStr, Length(StripStr), 1) = '<' then {Skip to end>?} else if Copy(StripStr, Length(StripStr), 1) = '<' then {Skip to end>?}
begin begin
repeat repeat
WriteLn(LfmFileVar, InStr); WriteLn(OutFileVar, InStr);
ReadLn(DfmFileVar, InStr); ReadLn(InFileVar, InStr);
until Trim(InStr) = 'end>'; until Trim(InStr) = 'end>';
end end
else if Pos('=', StripStr) > 0 then {Other property?} else if Pos('=', StripStr) > 0 then {Other property?}
begin {Check if property should be deleted from current object} begin {Check if property should be deleted from current object}
if CfgFileObj.ValueExists('DeleteProps', if IsDfmInFile and
Copy(StripStr, 1, Pos('=', StripStr)-1)) or (CfgFileObj.ValueExists('DeleteProps',
CfgFileObj.ValueExists('DeleteProps', Copy(StripStr, 1, Pos('=', StripStr)-1)) or
StackRec[StackLevel].ClassName + '.' + CfgFileObj.ValueExists('DeleteProps',
Copy(StripStr, 1, Pos('=', StripStr)-1)) then StackRec[StackLevel].ClassName + '.' +
Copy(StripStr, 1, Pos('=', StripStr)-1))) then
begin {Property or class.property in list of props to delete?} begin {Property or class.property in list of props to delete?}
DeleteLine := True; DeleteLine := True;
if Copy(StripStr, Length(StripStr), 1) = '(' then {Delete > 1 line?} if Copy(StripStr, Length(StripStr), 1) = '(' then {Delete > 1 line?}
begin begin
repeat repeat
ReadLn(DfmFileVar, SkipStr); ReadLn(InFileVar, SkipStr);
SkipStr := Trim(SkipStr); SkipStr := Trim(SkipStr);
until Copy(SkipStr, Length(SkipStr), 1) = ')'; until Copy(SkipStr, Length(SkipStr), 1) = ')';
end; end;
end; end;
end; end;
if not DeleteLine then {Include line in Lazarus form file?} if not DeleteLine then {Include line in output form file?}
begin begin
try try
{If Delphi form file does have Height and Width, reduce {If Delphi form file does have Height and Width, reduce
to size of its ClientHeight or ClientWidth.} to size of its ClientHeight or ClientWidth.}
if ((StackLevel = 1) and if IsDfmInFile and (StackLevel = 1) and
(CompareText('Height=', Copy(StripStr, 1, 7)) = 0)) then SameText('Height=', Copy(StripStr, 1, 7)) then
WriteLn(LfmFileVar, WriteLn(OutFileVar,
' Height = ', ' Height = ',
IntToStr(StrToInt(Copy(StripStr, 8, MaxInt)) - 34)) IntToStr(StrToInt(Copy(StripStr, 8, MaxInt)) - 34))
else if ((StackLevel = 1) and else if IsDfmInFile and (StackLevel = 1) and
(CompareText('Width=', Copy(StripStr, 1, 6)) = 0)) then SameText('Width=', Copy(StripStr, 1, 6)) then
WriteLn(LfmFileVar, WriteLn(OutFileVar,
' Width = ', ' Width = ',
IntToStr(StrToInt(Copy(StripStr, 7, MaxInt)) - 8)) IntToStr(StrToInt(Copy(StripStr, 7, MaxInt)) - 8))
{LCL TGroupBox child controls' Top measures from a lower position {LCL TGroupBox child controls' Top measures from a lower position
within group box than with VCL, so reduce Top value} within group box than with VCL, so reduce Top value}
else if (StackLevel > 1) and else if IsDfmInFile and (StackLevel > 1) and
(CompareText('Top=', Copy(StripStr, 1, 4)) = 0) and SameText('Top=', Copy(StripStr, 1, 4)) and
(CompareText('TGroupBox', SameText('TGroupBox', StackRec[Pred(StackLevel)].ClassName) then
StackRec[Pred(StackLevel)].ClassName) = 0) then WriteLn(OutFileVar,
WriteLn(LfmFileVar,
Copy(InStr, 1, Succ(Pos('=', InStr))), Copy(InStr, 1, Succ(Pos('=', InStr))),
IntToStr(StrToInt(Copy(StripStr, 5, MaxInt)) - 16)) IntToStr(StrToInt(Copy(StripStr, 5, MaxInt)) - 16))
@@ -297,32 +356,32 @@ begin
StackRec[StackLevel].ClassName) = 0)) then StackRec[StackLevel].ClassName) = 0)) then
begin begin
if CompareText('Top=', Copy(StripStr, 1, 4)) = 0 then if CompareText('Top=', Copy(StripStr, 1, 4)) = 0 then
WriteLn(LfmFileVar, WriteLn(OutFileVar,
StringReplace(InStr, 'Top', 'Left', [rfIgnoreCase])) StringReplace(InStr, 'Top', 'Left', [rfIgnoreCase]))
else else
WriteLn(LfmFileVar, WriteLn(OutFileVar,
StringReplace(InStr, 'Left', 'Top', [rfIgnoreCase])); StringReplace(InStr, 'Left', 'Top', [rfIgnoreCase]));
end end
*) *)
else if SubstFonts and else if (FontSwitch = SubstFontName) and
SameText('font.name', Copy(StripStr, 1, 9)) then SameText('font.name', Copy(StripStr, 1, 9)) then
begin begin
StripStr := Copy(InStr, Pos('=', InStr)+3, MaxInt); {Name after quote} StripStr := Copy(InStr, Pos('=', InStr)+3, MaxInt); {Name after quote}
Delete(StripStr, Length(StripStr), 1); {Delete closing quote} Delete(StripStr, Length(StripStr), 1); {Delete closing quote}
if MacSwitch and if MacSwitch and
CfgFileObj.ValueExists('MacFontSubstitutes', StripStr) then CfgFileObj.ValueExists('MacFontSubstitutes', StripStr) then
WriteLn(LfmFileVar, WriteLn(OutFileVar,
Copy(InStr, 1, Succ(Pos('=', InStr))), '''', Copy(InStr, 1, Succ(Pos('=', InStr))), '''',
CfgFileObj.ReadString('MacFontSubstitutes', StripStr, ''), CfgFileObj.ReadString('MacFontSubstitutes', StripStr, ''),
'''') '''')
else if CfgFileObj.ValueExists('FontSubstitutes', StripStr) then else if CfgFileObj.ValueExists('FontSubstitutes', StripStr) then
WriteLn(LfmFileVar, WriteLn(OutFileVar,
Copy(InStr, 1, Succ(Pos('=', InStr))), '''', Copy(InStr, 1, Succ(Pos('=', InStr))), '''',
CfgFileObj.ReadString('FontSubstitutes', StripStr, ''), CfgFileObj.ReadString('FontSubstitutes', StripStr, ''),
'''') '''')
else else
WriteLn(LfmFileVar, InStr); WriteLn(OutFileVar, InStr);
end end
else if MacSwitch and else if MacSwitch and
@@ -331,9 +390,10 @@ begin
SameText('TBitBtn', StackRec[StackLevel].ClassName)) and SameText('TBitBtn', StackRec[StackLevel].ClassName)) and
SameText('Height=', Copy(StripStr, 1, 7)) and SameText('Height=', Copy(StripStr, 1, 7)) and
(StrToInt(Copy(StripStr, 8, MaxInt)) > 22) then (StrToInt(Copy(StripStr, 8, MaxInt)) > 22) then
WriteLn(LfmFileVar, WriteLn(OutFileVar,
Copy(InStr, 1, Succ(Pos('=', InStr))), '22') Copy(InStr, 1, Succ(Pos('=', InStr))), '22')
{Reduce button height so it's displayed as oval on Mac} {Reduce button height so it's displayed as oval on Mac.
TODO: TSpeedButton too?}
else if MacSwitch and else if MacSwitch and
(StackLevel > 1) and (StackLevel > 1) and
@@ -341,45 +401,46 @@ begin
CfgFileObj.ValueExists('MacNoFocus', CfgFileObj.ValueExists('MacNoFocus',
StackRec[StackLevel].ClassName) then StackRec[StackLevel].ClassName) then
begin begin
WriteLn(LfmFileVar, InStr); {No change to TabOrder property} WriteLn(OutFileVar, InStr); {No change to TabOrder property}
WriteLn(LfmFileVar, WriteLn(OutFileVar,
Copy(InStr, 1, Length(InStr)-Length(Trim(InStr))), {Spaces} Copy(InStr, 1, Length(InStr)-Length(Trim(InStr))), {Spaces}
'TabStop = False'); {Control can't receive focus} 'TabStop = False'); {Control can't receive focus}
end end
else {No change to property} else {No change to property}
WriteLn(LfmFileVar, InStr); WriteLn(OutFileVar, InStr);
{Delphi form files don't always include Height or Width properties, {Delphi form files don't always include Height or Width properties,
which are required by Lazarus, so add them based on ClientHeight which are required by Lazarus, so add them based on ClientHeight
and ClientWidth properties, which apparently act the same as and ClientWidth properties, which apparently act the same as
Height and Width in Lazarus (unlike Delphi).} Height and Width in Lazarus (unlike Delphi).}
if (CompareText('ClientHeight=', Copy(StripStr, 1, 13)) = 0) or if IsDfmInFile and
(CompareText('ClientWidth=', Copy(StripStr, 1, 12)) = 0) then (SameText('ClientHeight=', Copy(StripStr, 1, 13)) or
WriteLn(LfmFileVar, SameText('ClientWidth=', Copy(StripStr, 1, 12))) then
WriteLn(OutFileVar,
StringReplace(InStr, 'Client', '', [rfIgnoreCase])); StringReplace(InStr, 'Client', '', [rfIgnoreCase]));
except except
on EInOutError do on EInOutError do
begin begin
WriteLn('Can''t write to Lazarus form file ', LfmFileName); WriteLn('Can''t write to output form file ', OutFileName);
Halt; Halt;
end; end;
end; end;
end; end;
end; {while not Eof} end; {while not Eof}
CloseFile(DfmFileVar); CloseFile(InFileVar);
try try
CloseFile(LfmFileVar); CloseFile(OutFileVar);
except except
on EInOutError do on EInOutError do
begin begin
WriteLn('Can''t close Lazarus form file ', LfmFileName); WriteLn('Can''t close output form file ', OutFileName);
Halt; Halt;
end; end;
end; end;
CfgFileObj.Free; CfgFileObj.Free;
WriteLn(LfmFileName, ' successfully created'); WriteLn(OutFileName, ' successfully created');
end. end.