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

IDE: added unitresources

Browse Source 
git-svn-id: trunk@40327 -
This commit is contained in:
mattias 2013-02-16 16:17:15 +00:00
parent f595fb71f7
commit 02953d0b7f
3 changed files with 405 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -4963,6 +4963,7 @@ ide/lazarusmanager.pas svneol=native#text/pascal
ide/lazbuild.lpi svneol=native#text/plain
ide/lazbuild.lpr svneol=native#text/plain
ide/lazconf.pp svneol=native#text/pascal
ide/lfmunitresource.pas svneol=native#text/plain
ide/macropromptdlg.pas svneol=native#text/pascal
ide/main.pp svneol=native#text/pascal
ide/mainbar.pas svneol=native#text/pascal
@ -5172,6 +5173,7 @@ ideintf/stringspropeditdlg.pas svneol=native#text/plain
ideintf/texttools.pas svneol=native#text/pascal
ideintf/treeviewpropedit.lfm svneol=native#text/plain
ideintf/treeviewpropedit.pas svneol=native#text/plain
ideintf/unitresources.pas svneol=native#text/plain
images/LazarusForm.bmp -text svneol=unset#image/bmp
images/LazarusForm.ico -text svneol=unset#image/x-icon
images/LazarusProject.ico -text svneol=unset#image/x-icon

204
ide/lfmunitresource.pas Normal file
View File

@ -0,0 +1,204 @@
unit lfmUnitResource;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
LCLMemManager,
Forms,
UnitResources;
type
{ TLFMUnitResourcefileFormat }
TLFMUnitResourcefileFormat = class(TUnitResourcefileFormat)
public
class function FindResourceDirective(Source: TObject): boolean; override;
class function ResourceDirectiveFilename: string; override;
class function GetUnitResourceFilename(AUnitFilenae: string): 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
uses
LResources,
CodeCache,
CodeToolManager,
CheckLFMDlg;
{ TLFMUnitResourcefileFormat }
class function TLFMUnitResourcefileFormat.FindResourceDirective(Source: TObject): boolean;
var
cb: TCodeBuffer;
nx,ny,nt: integer;
begin
result := CodeToolBoss.FindResourceDirective(Source as TCodeBuffer,1,1,cb,nx,ny,nt, ResourceDirectiveFilename,false);
end;
class function TLFMUnitResourcefileFormat.ResourceDirectiveFilename: string;
begin
result := '*.lfm';
end;
class function TLFMUnitResourcefileFormat.GetUnitResourceFilename(
AUnitFilenae: string): string;
begin
result := ChangeFileExt(AUnitFilenae,'.lfm');
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;
begin
result := QuickCheckLFMBuffer(PascalBuffer as TCodeBuffer, LFMBuffer as TCodeBuffer, LFMType, LFMComponentName, LFMClassName,
LCLVersion, MissingClasses);
end;
class function TLFMUnitResourcefileFormat.CreateWriter(s: TStream;
var DestroyDriver: boolean): TWriter;
begin
result := CreateLRSWriter(s, DestroyDriver);
end;
initialization
RegisterUnitResourcefileFormat(TLFMUnitResourcefileFormat);
end.
unit lfmUnitResource;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
LCLMemManager,
Forms,
UnitResources;
type
{ TLFMUnitResourcefileFormat }
TLFMUnitResourcefileFormat = class(TUnitResourcefileFormat)
public
class function FindResourceDirective(Source: TObject): boolean; override;
class function ResourceDirectiveFilename: string; override;
class function GetUnitResourceFilename(AUnitFilenae: string): 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
uses
LResources,
CodeCache,
CodeToolManager,
CheckLFMDlg;
{ TLFMUnitResourcefileFormat }
class function TLFMUnitResourcefileFormat.FindResourceDirective(Source: TObject): boolean;
var
cb: TCodeBuffer;
nx,ny,nt: integer;
begin
result := CodeToolBoss.FindResourceDirective(Source as TCodeBuffer,1,1,cb,nx,ny,nt, ResourceDirectiveFilename,false);
end;
class function TLFMUnitResourcefileFormat.ResourceDirectiveFilename: string;
begin
result := '*.lfm';
end;
class function TLFMUnitResourcefileFormat.GetUnitResourceFilename(
AUnitFilenae: string): string;
begin
result := ChangeFileExt(AUnitFilenae,'.lfm');
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;
begin
result := QuickCheckLFMBuffer(PascalBuffer as TCodeBuffer, LFMBuffer as TCodeBuffer, LFMType, LFMComponentName, LFMClassName,
LCLVersion, MissingClasses);
end;
class function TLFMUnitResourcefileFormat.CreateWriter(s: TStream;
var DestroyDriver: boolean): TWriter;
begin
result := CreateLRSWriter(s, DestroyDriver);
end;
initialization
RegisterUnitResourcefileFormat(TLFMUnitResourcefileFormat);
end.

199
ideintf/unitresources.pas Normal file
View File

@ -0,0 +1,199 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Author:
Joost van der Sluis
Abstract:
Change the resource type (e.g. .lfm) of forms.
}
unit UnitResources;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLMemManager, Forms;
type
{ TUnitResourcefileFormat }
TUnitResourcefileFormat = class
public
class function FindResourceDirective(Source: TObject): boolean; virtual; abstract;
class function ResourceDirectiveFilename: string; virtual; abstract;
class function GetUnitResourceFilename(AUnitFilename: string): string; virtual; abstract;
class procedure TextStreamToBinStream(ATxtStream, ABinStream: TExtMemoryStream); virtual; abstract;
class procedure BinStreamToTextStream(ABinStream, ATextStream: 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
out LFMType, LFMComponentName, LFMClassName: string;
out LCLVersion: string;
out MissingClasses: TStrings// e.g. MyFrame2:TMyFrame
): TModalResult; virtual; abstract;
end;
TUnitResourcefileFormatClass = class of TUnitResourcefileFormat;
TUnitResourcefileFormatArr = array of TUnitResourcefileFormatClass;
procedure RegisterUnitResourcefileFormat(AResourceFileFormat: TUnitResourcefileFormatClass);
function GetUnitResourcefileFormats: TUnitResourcefileFormatArr;
implementation
var
GUnitResourcefileFormats: TUnitResourcefileFormatArr;
procedure RegisterUnitResourcefileFormat(AResourceFileFormat: TUnitResourcefileFormatClass);
begin
SetLength(GUnitResourcefileFormats, length(GUnitResourcefileFormats)+1);
GUnitResourcefileFormats[high(GUnitResourcefileFormats)] := AResourceFileFormat;
end;
function GetUnitResourcefileFormats: TUnitResourcefileFormatArr;
begin
result := GUnitResourcefileFormats;
end;
end.
unit UnitResources;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLMemManager, Forms;
type
{ TUnitResourcefileFormat }
TUnitResourcefileFormat = class
public
class function FindResourceDirective(Source: TObject): boolean; virtual; abstract;
class function ResourceDirectiveFilename: string; virtual; abstract;
class function GetUnitResourceFilename(AUnitFilenae: string): string; virtual; abstract;
class procedure TextStreamToBinStream(ATxtStream, ABinStream: TExtMemoryStream); virtual; abstract;
class procedure BinStreamToTextStream(ABinStream, ATextStream: 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
out LFMType, LFMComponentName, LFMClassName: string;
out LCLVersion: string;
out MissingClasses: TStrings// e.g. MyFrame2:TMyFrame
): TModalResult; virtual; abstract;
end;
TUnitResourcefileFormatClass = class of TUnitResourcefileFormat;
TUnitResourcefileFormatArr = array of TUnitResourcefileFormatClass;
procedure RegisterUnitResourcefileFormat(AResourceFileFormat: TUnitResourcefileFormatClass);
function GetUnitResourcefileFormats: TUnitResourcefileFormatArr;
implementation
var
GUnitResourcefileFormats: TUnitResourcefileFormatArr;
procedure RegisterUnitResourcefileFormat(AResourceFileFormat: TUnitResourcefileFormatClass);
begin
SetLength(GUnitResourcefileFormats, length(GUnitResourcefileFormats)+1);
GUnitResourcefileFormats[high(GUnitResourcefileFormats)] := AResourceFileFormat;
end;
function GetUnitResourcefileFormats: TUnitResourcefileFormatArr;
begin
result := GUnitResourcefileFormats;
end;
end.
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Abstract:
Every unit can have one resource file. Default is .lfm.
This unit allows to define other formats, like .xib.
}
unit UnitResources;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLMemManager, Forms;
type
{ TUnitResourcefileFormat }
TUnitResourcefileFormat = class
public
class function FindResourceDirective(Source: TObject): boolean; virtual; abstract;
class function ResourceDirectiveFilename: string; virtual; abstract;
class function GetUnitResourceFilename(AUnitFilenae: string): string; virtual; abstract;
class procedure TextStreamToBinStream(ATxtStream, ABinStream: TExtMemoryStream); virtual; abstract;
class procedure BinStreamToTextStream(ABinStream, ATextStream: 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
out LFMType, LFMComponentName, LFMClassName: string;
out LCLVersion: string;
out MissingClasses: TStrings// e.g. MyFrame2:TMyFrame
): TModalResult; virtual; abstract;
end;
TUnitResourcefileFormatClass = class of TUnitResourcefileFormat;
TUnitResourcefileFormatArr = array of TUnitResourcefileFormatClass;
procedure RegisterUnitResourcefileFormat(AResourceFileFormat: TUnitResourcefileFormatClass);
function GetUnitResourcefileFormats: TUnitResourcefileFormatArr;
implementation
var
GUnitResourcefileFormats: TUnitResourcefileFormatArr;
procedure RegisterUnitResourcefileFormat(AResourceFileFormat: TUnitResourcefileFormatClass);
begin
SetLength(GUnitResourcefileFormats, length(GUnitResourcefileFormats)+1);
GUnitResourcefileFormats[high(GUnitResourcefileFormats)] := AResourceFileFormat;
end;
function GetUnitResourcefileFormats: TUnitResourcefileFormatArr;
begin
result := GUnitResourcefileFormats;
end;
end.