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

IDEIntf: added custom lfm unit resource file format

Browse Source 
git-svn-id: trunk@45658 -
This commit is contained in:
mattias 2014-06-25 08:16:06 +00:00
parent 15cadf6352
commit 305b0df023
2 changed files with 64 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
components/ideintf/unitresources.pas
View File

@ -19,7 +19,7 @@ unit UnitResources;
interface
uses
Classes, SysUtils, LCLMemManager, Forms;
Classes, SysUtils, LCLMemManager, Forms, LResources;
type
@ -30,11 +30,12 @@ type
class function FindResourceDirective(Source: TObject): boolean; virtual; abstract;
class function GetUnitResourceFilename(AUnitFilename: string; Loading: boolean): string; virtual; abstract;
class procedure TextStreamToBinStream(ATxtStream, ABinStream: TExtMemoryStream); virtual; abstract;
class procedure BinStreamToTextStream(ABinStream, ATextStream: TExtMemoryStream); virtual; abstract;
class procedure BinStreamToTextStream(ABinStream, ATxtStream: TExtMemoryStream); virtual; abstract;
class function GetClassNameFromStream(s: TStream; out IsInherited: Boolean): shortstring; virtual; abstract;
class function CreateReader(s: TStream; var DestroyDriver: boolean): TReader; virtual; abstract;
class function CreateWriter(s: TStream; var DestroyDriver: boolean): TWriter; virtual; abstract;
class function QuickCheckResourceBuffer(PascalBuffer, LFMBuffer: TObject; // TCodeBuffer
class function QuickCheckResourceBuffer(
PascalBuffer, LFMBuffer: TObject; // TCodeBuffer
out LFMType, LFMComponentName, LFMClassName: string;
out LCLVersion: string;
out MissingClasses: TStrings// e.g. MyFrame2:TMyFrame
@ -44,6 +45,19 @@ type
TUnitResourcefileFormatClass = class of TUnitResourcefileFormat;
TUnitResourcefileFormatArr = array of TUnitResourcefileFormatClass;
{ TCustomLFMUnitResourceFileFormat }
TCustomLFMUnitResourceFileFormat = class(TUnitResourcefileFormat)
public
class function ResourceDirectiveFilename: string; virtual;
class function GetUnitResourceFilename(AUnitFilename: string; {%H-}Loading: boolean): string; override;
class procedure TextStreamToBinStream(ATxtStream, ABinStream: TExtMemoryStream); override;
class procedure BinStreamToTextStream(ABinStream, ATxtStream: TExtMemoryStream); override;
class function GetClassNameFromStream(s: TStream; out IsInherited: Boolean): shortstring; override;
class function CreateReader(s: TStream; var DestroyDriver: boolean): TReader; override;
class function CreateWriter(s: TStream; var DestroyDriver: boolean): TWriter; override;
end;
var
LFMUnitResourceFileFormat: TUnitResourcefileFormatClass = nil;// set by IDE
@ -79,6 +93,52 @@ begin
Result := GUnitResourcefileFormats;
end;
{ TCustomLFMUnitResourceFileFormat }
class function TCustomLFMUnitResourceFileFormat.ResourceDirectiveFilename: string;
// Note: $R uses fpcres, which supports only a few formats like dfm and lfm.
// In other words: If you want other formats you need to extend fpcres or use
// other storages like include files (e.g. like the old lrs format).
begin
Result := '*.lfm';
end;
class function TCustomLFMUnitResourceFileFormat.GetUnitResourceFilename(
AUnitFilename: string; Loading: boolean): string;
begin
Result := ChangeFileExt(AUnitFilename,'.lfm');
end;
class procedure TCustomLFMUnitResourceFileFormat.TextStreamToBinStream(ATxtStream,
ABinStream: TExtMemoryStream);
begin
LRSObjectTextToBinary(ATxtStream,ABinStream);
end;
class procedure TCustomLFMUnitResourceFileFormat.BinStreamToTextStream(ABinStream,
ATxtStream: TExtMemoryStream);
begin
LRSObjectBinaryToText(ABinStream,ATxtStream);
end;
class function TCustomLFMUnitResourceFileFormat.GetClassNameFromStream(s: TStream;
out IsInherited: Boolean): shortstring;
begin
Result := GetClassNameFromLRSStream(s,IsInherited);
end;
class function TCustomLFMUnitResourceFileFormat.CreateReader(s: TStream;
var DestroyDriver: boolean): TReader;
begin
Result := CreateLRSReader(s,DestroyDriver);
end;
class function TCustomLFMUnitResourceFileFormat.CreateWriter(s: TStream;
var DestroyDriver: boolean): TWriter;
begin
Result := CreateLRSWriter(s, DestroyDriver);
end;
{ TUnitResourcefileFormat }
class function TUnitResourcefileFormat.Priority: integer;

43
ide/lfmunitresource.pas
View File

@ -42,19 +42,13 @@ type
{ TLFMUnitResourcefileFormat }
TLFMUnitResourcefileFormat = class(TUnitResourcefileFormat)
TLFMUnitResourcefileFormat = class(TCustomLFMUnitResourceFileFormat)
public
class function FindResourceDirective(Source: TObject): boolean; override;
class function ResourceDirectiveFilename: string;
class function GetUnitResourceFilename(AUnitFilename: string; {%H-}Loading: boolean): string; override;
class procedure TextStreamToBinStream(ATxtStream, ABinStream: TExtMemoryStream); override;
class procedure BinStreamToTextStream(ABinStream, ATextStream: TExtMemoryStream); override;
class function GetClassNameFromStream(s: TStream; out IsInherited: Boolean): shortstring; override;
class function CreateReader(s: TStream; var DestroyDriver: boolean): TReader; override;
class function QuickCheckResourceBuffer(PascalBuffer, LFMBuffer: TObject; out
LFMType, LFMComponentName, LFMClassName: string; out LCLVersion: string;
out MissingClasses: TStrings): TModalResult; override;
class function CreateWriter(s: TStream; var DestroyDriver: boolean): TWriter; override;
end;
implementation
@ -131,11 +125,6 @@ begin
Result:=Cache.ResourceDirective<>'';
end;
class function TLFMUnitResourcefileFormat.ResourceDirectiveFilename: string;
begin
Result := '*.lfm';
end;
class function TLFMUnitResourcefileFormat.GetUnitResourceFilename(
AUnitFilename: string; Loading: boolean): string;
var
@ -151,30 +140,6 @@ begin
end;
end;
class procedure TLFMUnitResourcefileFormat.TextStreamToBinStream(ATxtStream,
ABinStream: TExtMemoryStream);
begin
LRSObjectTextToBinary(ATxtStream,ABinStream);
end;
class procedure TLFMUnitResourcefileFormat.BinStreamToTextStream(ABinStream,
ATextStream: TExtMemoryStream);
begin
LRSObjectBinaryToText(ABinStream,ATextStream);
end;
class function TLFMUnitResourcefileFormat.GetClassNameFromStream(s: TStream;
out IsInherited: Boolean): shortstring;
begin
Result := GetClassNameFromLRSStream(s,IsInherited);
end;
class function TLFMUnitResourcefileFormat.CreateReader(s: TStream;
var DestroyDriver: boolean): TReader;
begin
Result := CreateLRSReader(s,DestroyDriver);
end;
class function TLFMUnitResourcefileFormat.QuickCheckResourceBuffer(PascalBuffer,
LFMBuffer: TObject; out LFMType, LFMComponentName, LFMClassName: string; out
LCLVersion: string; out MissingClasses: TStrings): TModalResult;
@ -184,12 +149,6 @@ begin
LCLVersion, MissingClasses);
end;
class function TLFMUnitResourcefileFormat.CreateWriter(s: TStream;
var DestroyDriver: boolean): TWriter;
begin
Result := CreateLRSWriter(s, DestroyDriver);
end;
initialization
RegisterUnitResourcefileFormat(TLFMUnitResourcefileFormat);
LFMUnitResourceFileFormat:=TLFMUnitResourcefileFormat;