1 {
2 *****************************************************************************
3 See the file COPYING.modifiedLGPL.txt, included in this distribution,
4 for details about the license.
5 *****************************************************************************
6
7 Author:
8 Joost van der Sluis
9
10 Abstract:
11 Change the resource type (e.g. .lfm) of forms.
12 Every unit can have one resource file. Default is .lfm.
13 This unit allows to define other formats, like .xib.
14 }
15 unit UnitResources;
16
17 {$mode objfpc}{$H+}
18
19 interface
20
21 uses
22 Classes, SysUtils, LCLMemManager, Forms, LResources;
23
24 type
25
26 { TUnitResourcefileFormat }
27
28 TUnitResourcefileFormat = class
29 public
FindResourceDirectivenull30 class function FindResourceDirective(Source: TObject): boolean; virtual; abstract;
GetUnitResourceFilenamenull31 class function GetUnitResourceFilename(AUnitFilename: string; Loading: boolean): string; virtual; abstract;
32 class procedure TextStreamToBinStream(ATxtStream, ABinStream: TExtMemoryStream); virtual; abstract;
33 class procedure BinStreamToTextStream(ABinStream, ATxtStream: TExtMemoryStream); virtual; abstract;
GetClassNameFromStreamnull34 class function GetClassNameFromStream(s: TStream; out IsInherited: Boolean): shortstring; virtual; abstract;
CreateReadernull35 class function CreateReader(s: TStream; var DestroyDriver: boolean): TReader; virtual; abstract;
CreateWriternull36 class function CreateWriter(s: TStream; var DestroyDriver: boolean): TWriter; virtual; abstract;
QuickCheckResourceBuffernull37 class function QuickCheckResourceBuffer(
38 PascalBuffer, LFMBuffer: TObject; // TCodeBuffer
39 out LFMType, LFMComponentName, LFMClassName: string;
40 out LCLVersion: string;
41 out MissingClasses: TStrings// e.g. MyFrame2:TMyFrame
42 ): TModalResult; virtual; abstract;
Prioritynull43 class function Priority: integer; virtual; // higher priority is tested first
DefaultComponentClassnull44 class function DefaultComponentClass: TComponentClass; virtual;
FindComponentClassnull45 class function FindComponentClass({%H-}aClassName: string): TComponentClass; virtual;
46 end;
47 TUnitResourcefileFormatClass = class of TUnitResourcefileFormat;
48 TUnitResourcefileFormatArr = array of TUnitResourcefileFormatClass;
49
50 { TCustomLFMUnitResourceFileFormat }
51
52 TCustomLFMUnitResourceFileFormat = class(TUnitResourcefileFormat)
53 public
ResourceDirectiveFilenamenull54 class function ResourceDirectiveFilename: string; virtual;
GetUnitResourceFilenamenull55 class function GetUnitResourceFilename(AUnitFilename: string; {%H-}Loading: boolean): string; override;
56 class procedure TextStreamToBinStream(ATxtStream, ABinStream: TExtMemoryStream); override;
57 class procedure BinStreamToTextStream(ABinStream, ATxtStream: TExtMemoryStream); override;
GetClassNameFromStreamnull58 class function GetClassNameFromStream(s: TStream; out IsInherited: Boolean): shortstring; override;
CreateReadernull59 class function CreateReader(s: TStream; var DestroyDriver: boolean): TReader; override;
CreateWriternull60 class function CreateWriter(s: TStream; var DestroyDriver: boolean): TWriter; override;
DefaultComponentClassnull61 class function DefaultComponentClass: TComponentClass; override;
FindComponentClassnull62 class function FindComponentClass(aClassName: string): TComponentClass; override;
63 end;
64
65 var
66 LFMUnitResourceFileFormat: TUnitResourcefileFormatClass = nil;// set by IDE
67
68 procedure RegisterUnitResourcefileFormat(AResourceFileFormat: TUnitResourcefileFormatClass);
GetUnitResourcefileFormatsnull69 function GetUnitResourcefileFormats: TUnitResourcefileFormatArr;
70
71 implementation
72
73 uses
74 FormEditingIntf;
75
76 var
77 GUnitResourcefileFormats: TUnitResourcefileFormatArr;
78
79 procedure RegisterUnitResourcefileFormat(AResourceFileFormat: TUnitResourcefileFormatClass);
80 var
81 i: Integer;
82 Priority: Integer;
83 l: Integer;
84 begin
85 Priority:=AResourceFileFormat.Priority;
86 i:=0;
87 while (i<length(GUnitResourcefileFormats))
88 and (GUnitResourcefileFormats[i].Priority>=Priority) do
89 inc(i);
90 l:=length(GUnitResourcefileFormats)-i;
91 SetLength(GUnitResourcefileFormats, length(GUnitResourcefileFormats)+1);
92 if l>0 then
93 System.Move(GUnitResourcefileFormats[i],GUnitResourcefileFormats[i+1],
94 l*SizeOf(TUnitResourcefileFormatClass));
95 GUnitResourcefileFormats[high(GUnitResourcefileFormats)] := AResourceFileFormat;
96 end;
97
GetUnitResourcefileFormatsnull98 function GetUnitResourcefileFormats: TUnitResourcefileFormatArr;
99 begin
100 Result := GUnitResourcefileFormats;
101 end;
102
103 { TCustomLFMUnitResourceFileFormat }
104
TCustomLFMUnitResourceFileFormat.ResourceDirectiveFilenamenull105 class function TCustomLFMUnitResourceFileFormat.ResourceDirectiveFilename: string;
106 // Note: $R uses fpcres, which supports only a few formats like dfm and lfm.
107 // In other words: If you want other formats you need to extend fpcres or use
108 // other storages like include files (e.g. like the old lrs format).
109 begin
110 Result := '*.lfm';
111 end;
112
TCustomLFMUnitResourceFileFormat.GetUnitResourceFilenamenull113 class function TCustomLFMUnitResourceFileFormat.GetUnitResourceFilename(
114 AUnitFilename: string; Loading: boolean): string;
115 begin
116 Result := ChangeFileExt(AUnitFilename,'.lfm');
117 end;
118
119 class procedure TCustomLFMUnitResourceFileFormat.TextStreamToBinStream(ATxtStream,
120 ABinStream: TExtMemoryStream);
121 begin
122 LRSObjectTextToBinary(ATxtStream,ABinStream);
123 end;
124
125 class procedure TCustomLFMUnitResourceFileFormat.BinStreamToTextStream(ABinStream,
126 ATxtStream: TExtMemoryStream);
127 begin
128 LRSObjectBinaryToText(ABinStream,ATxtStream);
129 end;
130
TCustomLFMUnitResourceFileFormat.GetClassNameFromStreamnull131 class function TCustomLFMUnitResourceFileFormat.GetClassNameFromStream(s: TStream;
132 out IsInherited: Boolean): shortstring;
133 begin
134 Result := GetClassNameFromLRSStream(s,IsInherited);
135 end;
136
TCustomLFMUnitResourceFileFormat.CreateReadernull137 class function TCustomLFMUnitResourceFileFormat.CreateReader(s: TStream;
138 var DestroyDriver: boolean): TReader;
139 begin
140 Result := CreateLRSReader(s,DestroyDriver);
141 end;
142
TCustomLFMUnitResourceFileFormat.CreateWriternull143 class function TCustomLFMUnitResourceFileFormat.CreateWriter(s: TStream;
144 var DestroyDriver: boolean): TWriter;
145 begin
146 Result := CreateLRSWriter(s, DestroyDriver);
147 end;
148
TCustomLFMUnitResourceFileFormat.DefaultComponentClassnull149 class function TCustomLFMUnitResourceFileFormat.DefaultComponentClass: TComponentClass;
150 begin
151 Result := FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TForm];
152 end;
153
TCustomLFMUnitResourceFileFormat.FindComponentClassnull154 class function TCustomLFMUnitResourceFileFormat.FindComponentClass(
155 aClassName: string): TComponentClass;
156 begin
157 if CompareText(aClassName,'TForm')=0 then
158 Result:=FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TForm]
159 else if CompareText(aClassName,'TFrame')=0 then
160 Result:=FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TFrame]
161 else if CompareText(aClassName,'TDataModule')=0 then
162 Result:=FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TDataModule]
163 else
164 Result:=nil;
165 end;
166
167 { TUnitResourcefileFormat }
168
TUnitResourcefileFormat.Prioritynull169 class function TUnitResourcefileFormat.Priority: integer;
170 begin
171 Result:=0;
172 end;
173
TUnitResourcefileFormat.DefaultComponentClassnull174 class function TUnitResourcefileFormat.DefaultComponentClass: TComponentClass;
175 begin
176 Result:=TForm;
177 end;
178
TUnitResourcefileFormat.FindComponentClassnull179 class function TUnitResourcefileFormat.FindComponentClass(aClassName: string): TComponentClass;
180 begin
181 Result:=nil;
182 end;
183
184 end.
185
186