Delphi Programming Forum
C++Builder  |  Delphi  |  FireMonkey  |  C/C++  |  Free Pascal  |  Firebird
볼랜드포럼 BorlandForum
 경고! 게시물 작성자의 사전 허락없는 메일주소 추출행위 절대 금지
델파이 포럼
Q & A
FAQ
팁&트릭
강좌/문서
자료실
컴포넌트/라이브러리
FreePascal/Lazarus
볼랜드포럼 홈
헤드라인 뉴스
IT 뉴스
공지사항
자유게시판
해피 브레이크
공동 프로젝트
구인/구직
회원 장터
건의사항
운영진 게시판
회원 메뉴
북마크
델마당
볼랜드포럼 광고 모집

델파이 팁&트릭
Delphi Programming Tip&Tricks
[366] 스킨을 이용하여 폼의 모양 바꾸기 - 8
첫눈 [hadugo] 537 읽음    2017-01-04 14:51
그럼 지금까지 만들어 놓은 함수들을 모두 정리하여 하나의 유닛으로 만들어 보겠습니다.

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); 이 프로시져입니다.

제가 실력이 워낙 미천하여 이것을 위해 문자열을 하나씩 검사했습니다.

제 생각에서는 좀 더 합리적인 방법이 있을 것이고
델파이 제작사에서도 분명 저 처럼 이렇게 무지막지한 방법을 사용하지는 않을 것 같은데요.

좀 더 효과적이고 체계적인 방법을 제시해 주시면 감사하겠습니다.

그럼 다음 시간에 뵙겠습니다.

+ -

관련 글 리스트
366 스킨을 이용하여 폼의 모양 바꾸기 - 8 첫눈 537 2017-01-04
Google
Copyright © 1999-2015, borlandforum.com. All right reserved.