그럼 지금까지 만들어 놓은 함수들을 모두 정리하여 하나의 유닛으로 만들어 보겠습니다.
unit SKinLoadU;
interface
Uses
System.Classes;
procedure DFMToBin(DFMFile: String; BinFile: String);
procedure LoadComponentFromBinFile(Component: TComponent; Const FileName: String);
implementation
Uses
System.SysUtils, System.StrUtils, System.RTTI,
Vcl.Controls, VCL.Forms, VCL.Dialogs;
procedure DFMToBin(DFMFile: String; BinFile: String);
var
FileStream : TFileStream;
MemStream : TMemoryStream;
Begin
FileStream := TFileStream.Create(DFMFile, fmOpenRead);
MemStream := TMemoryStream.Create;
ObjectTextToBinary(FileStream, MemStream);
MemStream.SaveToFile(BinFile);
FreeAndNil(MemStream);
FreeAndNil(FileStream);
End;
procedure StringListDuplicatesRemove(const stringList : TStringList) ;
var
buffer: TStringList;
I: Integer;
begin
stringList.Sort;
buffer := TStringList.Create;
try
buffer.Sorted := True;
buffer.Duplicates := dupIgnore;
buffer.BeginUpdate;
for I := 0 to stringList.Count - 1 do buffer.Add(stringList[I]) ;
buffer.EndUpdate;
stringList.Assign(buffer) ;
finally
FreeandNil(buffer) ;
end;
end;
procedure GetClassListFromString(DFMString: String; ClassList: TStringList);
Var
StringList : TStringList;
Str : String;
Posx : Integer;
i : Integer;
Begin
ClassList.Clear;
StringList := TStringList.Create;
StringList.Text := DFMString;
for i := 0 to StringList.Count - 1 do
Begin
Str := StringList[I]; // ' Object Button1: TButton'
IF Pos('OBJECT', UpperCase(Str)) = 0 Then Continue;
Posx := Pos(':', Str);
if Posx = 0 then Continue;
Delete(Str, 1, PosX); // ' TButton'
Str := Trim(Str); // 'TButton'
if (Pos('TFORM', UpperCase(Str)) > 0) or (Pos('TFRM', UpperCase(Str)) > 0) then
Begin
Str := 'TForm';
End;
if (Pos('TFRAME', UpperCase(Str)) > 0) then
Begin
Str := 'TFrame';
End;
ClassList.Add(Str);
End;
FreeAndNil(StringList);
StringListDuplicatesRemove(ClassList);
End;
procedure GetClassListFromBinFile(BinFile: String ; ClassList: TStringList);
Var
MemStream : TMemoryStream;
StringStream : TStringStream;
SrcStrignList : TStringList;
Begin
MemStream := TMemoryStream.Create;
MemStream.LoadFromFile(BinFile);
StringStream := TStringStream.Create;
ObjectBinaryToText(MemStream, StringStream);
FreeAndNil(MemStream);
SrcStrignList := TStringList.Create;
SrcStrignList.Text := StringStream.DataString;
FreeAndNil(StringStream);
ClassList.Clear;
ClassList.Duplicates := dupIgnore;
GetClassListFromString(SrcStrignList.Text, ClassList);
FreeAndNil(SrcStrignList);
End;
function FindAnyClass(const Name: string): TClass;
var
ctx: TRttiContext;
typ: TRttiType;
Typelist: TArray;
begin
Result := nil;
ctx := TRttiContext.Create;
Typelist := ctx.GetTypes;
for typ in Typelist do
begin
if typ.IsInstance and (EndsText(Name, typ.Name)) then
begin
Result := typ.AsInstance.MetaClassType;
break;
end;
end;
ctx.Free;
end;
procedure RegisterComponentFromList(const StringList: TStringList);
Var
AClass : TClass;
PersistanceClass : TPersistentClass;
i: Integer;
Begin
StringListDuplicatesRemove(StringList);
for i := 0 To StringList.Count - 1 do
begin
if StringList[I] = '' then Continue;
AClass := FindAnyClass(StringList[I]);
PersistanceClass := TPersistentClass(AClass);
if PersistanceClass = nil then Continue;
RegisterClass(PersistanceClass);
end;
End;
procedure RegisterComponentFromBin(const BinFile: String);
Var
ClassList : TStringList;
Begin
ClassList := TStringList.Create;
GetClassListFromBinFile(BinFile, ClassList);
RegisterComponentFromList(ClassList);
FreeAndNil(ClassList);
End;
procedure LoadComponentFromBinFile(Component: TComponent; Const FileName: String);
var
MemStream : TMemoryStream;
i: Integer;
begin
if not Assigned(Component) then Exit;
if NOT FileExists(FileName) then Exit;
RegisterComponentFromBin(FileName);
try
MemStream := TMemoryStream.Create;
MemStream.LoadFromFile(FileName);
MemStream.Position := 0;
MemStream.ReadComponent(Component);
Application.InsertComponent(Component);
finally
FreeAndNil(MemStream);
end;
end;
지금까지 만들었던 모든 함수입니다.
다음 시간에는 이것을 어떻게 활용하는지 보여드리겠습니다.
혹시 고수 분들께서 이 글을 보신다면 한가지 당부 드릴 것이 있습니다.
바로 DFM파일의 내용 중에서 TForm, TEdit, TButton....과 같은 객체들의 타입을 ClassList에 담는 부분인데요.
GetClassListFromString(DFMString: String; ClassList: TStringList); 이 프로시져입니다.
제가 실력이 워낙 미천하여 이것을 위해 문자열을 하나씩 검사했습니다.
제 생각에서는 좀 더 합리적인 방법이 있을 것이고
델파이 제작사에서도 분명 저 처럼 이렇게 무지막지한 방법을 사용하지는 않을 것 같은데요.
좀 더 효과적이고 체계적인 방법을 제시해 주시면 감사하겠습니다.
그럼 다음 시간에 뵙겠습니다.