paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 13:38:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: LCL and lazres is now able to convert delphi forms to text

Browse Source 
git-svn-id: trunk@1805 -
This commit is contained in:
lazarus 2002-07-31 14:23:43 +00:00
parent aa8b6f0237
commit 195c4d2a20
2 changed files with 59 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
lcl/lresources.pp
View File

@ -75,7 +75,13 @@ type
procedure DelphiObjectBinaryToText(Input, Output: TStream);
procedure DelphiObjectToText(Input, Output: TStream;
var OriginalFormat: TDelphiStreamOriginalFormat);
function TestDelphiStreamFormat(Stream: TStream): TDelphiStreamOriginalFormat;
procedure DelphiObjectResourceToText(Input, Output: TStream);
procedure DelphiObjectResToText(Input, Output: TStream;
var OriginalFormat: TDelphiStreamOriginalFormat);
function TestFormStreamFormat(Stream: TStream): TDelphiStreamOriginalFormat;
procedure FormDataToText(FormStream, TextStream: TStream);
var LazarusResources:TLResourceList;
@ -1156,7 +1162,7 @@ begin
end;
end;
function TestDelphiStreamFormat(Stream: TStream): TDelphiStreamOriginalFormat;
function TestFormStreamFormat(Stream: TStream): TDelphiStreamOriginalFormat;
var
Pos: Integer;
Signature: Integer;
@ -1231,6 +1237,33 @@ begin
@DelphiObjectBinaryToText, Integer(FilerSignature), sizeof(Integer));
end;
procedure DelphiObjectResToText(Input, Output: TStream;
var OriginalFormat: TDelphiStreamOriginalFormat);
begin
InternalDelphiBinaryToText(Input, Output, OriginalFormat,
@DelphiObjectResourceToText, $FF, 1);
end;
procedure DelphiObjectResourceToText(Input, Output: TStream);
begin
Input.ReadResHeader;
DelphiObjectBinaryToText(Input, Output);
end;
procedure FormDataToText(FormStream, TextStream: TStream);
begin
case TestFormStreamFormat(FormStream) of
sofBinary:
DelphiObjectResourceToText(FormStream, TextStream);
sofText:
TextStream.CopyFrom(FormStream,FormStream.Size);
else
raise Exception.Create('invalid Form object stream');
end;
end;
//------------------------------------------------------------------------------
initialization
LazarusResources:=TLResourceList.Create;

35
tools/lazres.pp
View File

@ -62,6 +62,23 @@ begin
Stream.Position:=OldPos;
end;
procedure ConvertFormToText(Stream: TMemoryStream);
var TextStream: TMemoryStream;
begin
try
TextStream:=TMemoryStream.Create;
FormDataToText(Stream,TextStream);
TextStream.Position:=0;
Stream.Clear;
Stream.CopyFrom(TextStream,TextStream.Size);
Stream.Position:=0;
except
on E: Exception do begin
writeln('ERROR: unable to convert Delphi form to text: '+E.Message);
end;
end;
end;
var
ResourceFilename,BinFilename,BinExt,ResourceName,ResourceType:String;
a:integer;
@ -94,19 +111,15 @@ begin
BinExt:=uppercase(ExtractFileExt(BinFilename));
if (BinExt='.LFM') or (BinExt='.DFM') or (BinExt='.XFM') then begin
ResourceType:='FORMDATA';
if StreamIsFormInTextFormat(BinMemStream) then begin
ResourceName:=FindLFMClassName(BinMemStream);
if ResourceName='' then begin
writeln(' ERROR: no resourcename');
halt(2);
end;
write(' ResourceName='''+ResourceName
+''' Type='''+ResourceType+'''');
LFMtoLRSstream(BinMemStream,ResMemStream);
end else begin
writeln(' ERROR: form data is not in text format.');
ConvertFormToText(BinMemStream);
ResourceName:=FindLFMClassName(BinMemStream);
if ResourceName='' then begin
writeln(' ERROR: no resourcename');
halt(2);
end;
write(' ResourceName='''+ResourceName
+''' Type='''+ResourceType+'''');
LFMtoLRSstream(BinMemStream,ResMemStream);
end else begin
ResourceType:=copy(BinExt,2,length(BinExt)-1);
ResourceName:=ExtractFileName(BinFilename);