unistreamexpert.pas

万能流化单元,可以反向完美流化任何TComponent组件,并不单单是TForm

{Delphi流操作终极篇}
{易延松版权所有,翻录必究}
unit UniStreamExpert;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, cxStyles, cxCustomData, cxGraphics,
  cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData,
  cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
  cxClasses, cxControls, cxGridCustomView, cxGrid, DBTables,
  cxInplaceContainer, cxVGrid, cxDBVGrid,cxGridBandedTableView,cxGridDBBandedTableView;

  procedure CloneColumnsFromcxGridToVGrid(OwnerForm: TForm; cxGrid: TcxGrid; vGrid: TcxDBVerticalGrid);
  function ReadComponentResExpert(const ResName: string; SubFormName: string; Instance: TComponent): TComponent;
  function CloneComponent(AComponent:TComponent):TComponent;  

implementation

{
procedure TForm1.Button1Click(Sender: TObject);
var
  fff: TcxGrid;
begin
  //  ReadComponentRes('Memo1',Memo2);
//  RegisterClass(TMemo);
//  RegisterClass(TPanel);
  fff := TcxGrid.Create(nil);
  cxGrid1.Left := 400;
  cxGrid1.Top := 400;
  cxGrid1.Visible := false;
  ReadComponentResEx('TForm2', 'cxGrid1', cxGrid1);
  if cxGrid1.Levels[0].GridView is TcxGridDBTableView  then
  (cxGrid1.Levels[0].GridView as TcxGridDBTableView).DataController.DataSource := DataSource1;
  if cxGrid1.Levels[0].GridView is TcxGridDBBandedTableView then
  (cxGrid1.Levels[0].GridView as TcxGridDBBandedTableView).DataController.DataSource := DataSource1;
  CloneColumnsFromcxGridToVGrid(self, cxGrid1, cxDBVerticalGrid1);
  fff.Free;
  //  fff.ShowModal;
    //  fff.Parent:=self;
end;
}

const
  SResNotFound = 'Resource %s not found';

function ComponentToString(Component: TComponent): string;

var
  BinStream: TMemoryStream;
  StrStream: TStringStream;
  s: string;
begin
  BinStream := TMemoryStream.Create;
  try
    StrStream := TStringStream.Create(s);
    try
      BinStream.WriteComponent(Component);
      BinStream.Seek(0, soFromBeginning);
      ObjectBinaryToText(BinStream, StrStream);
      StrStream.Seek(0, soFromBeginning);
      Result := StrStream.DataString;
    finally
      StrStream.Free;

    end;
  finally
    BinStream.Free
  end;
end;

function StringToComponent(Value: string): TComponent;
var
  StrStream: TStringStream;
  BinStream: TMemoryStream;
begin
  StrStream := TStringStream.Create(Value);
  try
    BinStream := TMemoryStream.Create;
    try
      ObjectTextToBinary(StrStream, BinStream);
      BinStream.Seek(0, soFromBeginning);
      Result := BinStream.ReadComponent(nil);

    finally
      BinStream.Free;
    end;
  finally
    StrStream.Free;
  end;

end;

procedure WriteComponentResCloneFile(const FileName: string; Instance: TComponent);
var
  Stream: TStream;
  StrStream: TStringStream;
  s: string;
begin
  StrStream := TStringStream.Create(s);
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    Stream.WriteComponentRes(Instance.ClassName, Instance);
    ObjectBinaryToText(Stream, StrStream);
    ShowMessage(StrStream.DataString);
  finally
    Stream.Free;
    StrStream.Free;
  end;

end;

function StringReplaceSpe(S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;
var
  i:integer;
  lll:integer;
  nlll:integer;
  function IfInQuote(sub,s:string):boolean;
  var
    I: Integer;
    po:integer;
    prefind:boolean;
    posfind:boolean;
  begin
    result:=false;
    prefind:=false;
    posfind:=false;
    Po:=Pos(sub,s);
    if Po=0 then exit;
    for I := Po downto 1 do    // Iterate
    begin
      if s[i]='''' then
      begin
        prefind:=true;
        break;
      end;
    end;    // for
    for I := Po+Length(sub) to Length(s) do    // Iterate
    begin
      if s[i]='''' then
      begin
        posfind:=true;
        break;
      end;
    end;    // for
    if prefind and posfind then
      result:=true;

  end;
begin
  lll:=Length(OldPattern);
  nlll:=Length(NewPattern);
  i:=1;
  while i<=Length(s) do
  begin
    if Copy(s,i,lll)=OldPattern then
      if Copy(s,i-2,2)<>' T' then
        if not IfInQuote(OldPattern,s) then
        begin
          Delete(s,i,lll);
          Insert(NewPattern,s,i);
          inc(i,nlll-lll);
        end;
    inc(i);
  end;    // while
  result:=s;
end;

function MarkCloneInString(s: string): string;
var
  I,j: Integer;
  OldI:integer;
  IDs:TStrings;
  sStrlst:TStrings;
  sss:string;
  tmpStr:string;
begin
  IDs:=TStringList.Create;
  sStrlst:=TStringList.Create;
  OldI:=1;
  I := 1;
  while i <= Length(s) do
  begin
    if ((Copy(s, i, 7) = 'object ') and (not (s[i - 1] in ['0'..'9'] + ['a'..'z'] + ['A'..'Z'] + ['_'])) and (i > 1))
      or
      (((Copy(s, i, 7) = 'object ')) and (i = 1)) then
    begin
      i := i + 6;
      oldI:=i+1;
      while s[i] <> ':' do
      begin
        i := i + 1;
      end; // while
      //Insert('C_', s, OldI);
      sss:=Copy(s,OldI,I-Oldi);
      if Ids.IndexOf(sss)=-1 then
        IDs.Add(sss);
      i:=i+6;
    end;
    inc(i);
  end; // while

  for I := 0 to IDs.Count - 1 do    // Iterate
  begin
    //s:= StringReplaceSpe(s,IDs.Strings[i],IDs.Strings[i]+'_clone',[rfReplaceAll]);
    sStrLst.Text:=s;
    for j := 0 to sStrLst.Count - 1 do    // Iterate
    begin
      if Pos('On',Trim(sStrLst.Strings[j]))=0 then
      begin
//        tmpStr:=sStrLst.Strings[j];
        sStrLst.Strings[j]:=StringReplaceSpe(sStrLst.Strings[j],IDs.Strings[i],IDs.Strings[i]+'_clone',[rfReplaceAll]);
      end;

    end;    // for
    s:=sStrLst.Text;
  end;    // for
  sStrlst.Free;
  IDs.Free;
  result:=s;
end;

function CloneComponent(AComponent:TComponent):TComponent;
var
  sss:string;
begin
  sss := ComponentToString(AComponent);
  result:=StringToComponent(MarkCloneInString(sss));
end;

function ParseSubFormStr(FormStr, SubFormName: string): string;
var
  i: integer;
  startPos, EndPos: integer;
  Count: integer;
  Debugstr:string;
  DestPchar:Pchar;
begin
  Count := 0;
  if Copy(FormStr,StartPos-4,4)='ect ' then
    StartPos := Pos(' '+SubFormName+':', FormStr) - 7
  else
    StartPos := Pos(' '+SubFormName+':', FormStr) - 10;
  for i := StartPos to Length(FormStr) do
  begin
    DebugStr:=Copy(FormStr,i,Length(FormStr)-i);
    if (not (FormStr[i - 6] in ['0'..'9'] + ['a'..'z'] + ['A'..'Z'] + ['_']))
      and
      (not (FormStr[i + 1] in ['0'..'9'] + ['a'..'z'] + ['A'..'Z'] + ['_']))
      {
      and (FormStr[i - 5] = 'o') and (FormStr[i - 4] = 'b') and (FormStr[i - 3] = 'j') and (FormStr[i - 2] = 'e') and
        (FormStr[i - 1] = 'c') and
      (FormStr[i] = 't')
      }
      and (Copy(FormStr,i-5,6)='object')
      then
    begin
      Count := Count + 1;
    end;

    if (not (FormStr[i - 9] in ['0'..'9'] + ['a'..'z'] + ['A'..'Z'] + ['_']))
      and
      (not (FormStr[i + 1] in ['0'..'9'] + ['a'..'z'] + ['A'..'Z'] + ['_']))

      {
      (FormStr[i - 8] = 'i') and
      (FormStr[i - 7] = 'n') and (FormStr[i - 6] = 'h') and
      (FormStr[i - 5] = 'e') and (FormStr[i - 4] = 'r') and (FormStr[i - 3] = 'i') and (FormStr[i - 2] = 't') and
      (FormStr[i - 1] = 'e') and (FormStr[i] = 'd')
      }
      and (Copy(FormStr,i-8,9)='inherited')
      then
    begin
      Count := Count + 1;
    end;


    if (not (FormStr[i - 4] in ['0'..'9'] + ['a'..'z'] + ['A'..'Z'] + ['_']))
      and
      (not (FormStr[i + 1] in ['0'..'9'] + ['a'..'z'] + ['A'..'Z'] + ['_']))
      {
      and (FormStr[i - 3] = 'i') and (FormStr[i - 2] = 't') and
        (FormStr[i - 1] = 'e') and (FormStr[i] = 'm')
      }
      and (Copy(FormStr,i-3,4)='item')
      then
    begin
      Count := Count + 1;
    end;


    if (not (FormStr[i - 3] in ['0'..'9'] + ['a'..'z'] + ['A'..'Z'] + ['_']))
      and
      (not (FormStr[i + 1] in ['0'..'9'] + ['a'..'z'] + ['A'..'Z'] + ['_']))
      {
      and (FormStr[i - 2] = 'e') and (FormStr[i - 1] = 'n') and (FormStr[i] = 'd')
      }
      and (Copy(FormStr,i-2,3)='end')
      then
    begin
      Count := Count - 1;
      if Count = 0 then
      begin
        EndPos := i - 2;
        break;
      end;
    end;
  end;

  Result := Copy(FormStr, StartPos, EndPos - StartPos + 3);
  {
  DestPchar:=StrAlloc(EndPos - StartPos + 3);
  DestPchar:=StrMove(DestPchar,Pchar(FormStr),EndPos - StartPos + 3);
  result:=string(DestPchar);
  StrDisPose(DestPchar);
  }
end;

function FilterEventStr(sss: string): string;
var
  i, tmpi: integer;
  strlst: TStrings;
begin
  strlst := TStringList.Create;
  strlst.Text := sss;
  for i := 0 to strlst.Count - 1 do
  begin
    if Pos('.On',strlst[i])>0 then
    begin
      strlst.Delete(i);
      tmpi := i - 1;
      asm
       push eax
       mov eax,tmpi
       mov i,eax
       pop eax
      end;
    end;
    if Copy(trim(strlst[i]), 1, 2) = 'On' then
    begin
      strlst.Delete(i);
      tmpi := i - 1;
      asm
       push eax
       mov eax,tmpi
       mov i,eax
       pop eax
      end;
    end;
  end;
  result := strlst.Text;
  strlst.Free;
end;

function StreamReadComponent(AStream:TStream;Instance: TComponent): TComponent;
var
  Reader: TReader;
begin
  Reader := TReader.Create(AStream, 4096);
  try
    Result := Reader.ReadRootComponent(Instance);
  finally
    Reader.Free;
  end;
end;

function InternalReadComponentRes(const ResName: string; SubFormName: string; HInst: THandle; var Instance: TComponent):
  Boolean;
var
  HRsrc: THandle;
  ResStream: TResourceStream;
  BinStream: TMemoryStream;
  StrStream: TStringStream;
  SubStrStream: TStringStream;
  s: string;
  DFMStr: string;
  subDFMstr: string;
begin { avoid possible EResNotFound exception }
  try
    StrStream := TStringStream.Create(s);

    if HInst = 0 then HInst := HInstance;
    HRsrc := FindResource(HInst, PChar(ResName), RT_RCDATA);
    Result := HRsrc <> 0;
    if not Result then Exit;
    ResStream := TResourceStream.Create(HInst, ResName, RT_RCDATA);
    with ResStream do
    try
      ObjectBinaryToText(ResStream, StrStream); //
      StrStream.Seek(0, soFromBeginning);
      DFMStr := StrStream.DataString;
      //ShowMessage(DFMStr);
      SubDFMstr := ParseSubFormStr(DFMStr, SubFormName);
      SubDFMstr := FilterEventStr(SubDFMstr);

      //new add
      if Pos('inherited',SubDFMstr)>0 then
      begin
        //ShowMessage(TFormClass(FindClass(ResName)).ClassParent.ClassName);
        InternalReadComponentRes(TFormClass(FindClass(ResName)).ClassParent.ClassName,SubFormName,HInst,Instance);
      end;
      //end new add

      //ShowMessage(SubDFMStr);
      //
      {
        FrmCoolHintForm:=TFrmCoolHintForm.Create(nil);
        FrmCoolHintForm.memMsg.Properties.ReadOnly:=false;
        FrmCoolHintForm.memMsg.Lines.Text:=SubDFMStr;
        FrmCoolHintForm.ShowModal;
        SubDFMstr:=FrmCoolHintForm.memMsg.Lines.Text;
        FrmCoolHintForm.Free;
      }
      //

      try
        SubStrStream := TStringStream.Create(SubDFMStr);
        try
          BinStream := TMemoryStream.Create;
          ObjectTextToBinary(SubStrStream, BinStream);
          BinStream.Seek(0, soFromBeginning);
          //BinStream.ReadComponent(Instance);
          StreamReadComponent(BinStream,Instance);
        finally
          BinStream.Free;
        end;
      finally
        SubStrStream.Free;
      end;
      //ShowMessage(ParseSubFormStr(DFMStr,SubFormName));
      //StrStream.DataString:=ParseSubFormStr(DFMStr,SubFormName);
      //    ResStream.Seek(0, soFromBeginning);
      //    Instance := ReadComponent(Instance);
    finally
      Free;
    end;
  finally
    StrStream.Free;
  end;
  Result := True;
end;

function ReadComponentResExpert(const ResName: string;
  SubFormName: string; Instance: TComponent): TComponent;
var
  HInstance: THandle;
begin
  if Instance <> nil then
    HInstance := FindResourceHInstance(FindClassHInstance(Instance.ClassType))
  else
    HInstance := 0;
  if InternalReadComponentRes(ResName, SubFormName, HInstance, Instance) then
    Result := Instance
  else
    raise EResNotFound.CreateFmt(SResNotFound, [ResName]);
end;

procedure CloneColumnsFromcxGridToVGrid(OwnerForm: TForm; cxGrid: TcxGrid; vGrid: TcxDBVerticalGrid);
var
  i, j: integer;
  Nrow: TcxDBEditorRow;
  DebugColumnCount:integer;
begin
  if (cxGrid.Levels[0].GridView is TcxGridDBTableView) then
  begin
    VGrid.ClearRows;
    VGrid.DataController.CreateAllItems;
    for i := 0 to VGrid.Rows.Count - 1 do
    begin
      Nrow := VGrid.Rows[i] as TcxDBEditorRow;
      Nrow.Visible:=false;
      DebugColumnCount:=(cxGrid.Levels[0].GridView as TcxGridDBTableView).ColumnCount;
      for j := 0 to (cxGrid.Levels[0].GridView as TcxGridDBTableView).ColumnCount - 1 do
      begin
        if (cxGrid.Levels[0].GridView as TcxGridDBTableView).Columns[j].DataBinding.FieldName =
          Nrow.Properties.DataBinding.FieldName then
        begin
          Nrow.Properties.Caption:=(cxGrid.Levels[0].GridView as TcxGridDBTableView).Columns[j].Caption;
          Nrow.Visible:=true;//(cxGrid.Levels[0].GridView as TcxGridDBTableView).Columns[j].Visible;
          Nrow.Properties.EditPropertiesClass:=(cxGrid.Levels[0].GridView as TcxGridDBTableView).Columns[j].PropertiesClass;
          Nrow.Properties.EditProperties:=(cxGrid.Levels[0].GridView as TcxGridDBTableView).Columns[j].Properties;
          break;
        end;
      end;
    end;
  end;

  if (cxGrid.Levels[0].GridView is TcxGridDBBandedTableView) then
  begin
    VGrid.ClearRows;
    VGrid.DataController.CreateAllItems;
    for i := 0 to VGrid.Rows.Count - 1 do
    begin
      Nrow := VGrid.Rows[i] as TcxDBEditorRow;
      Nrow.Visible:=false;
      for j := 0 to (cxGrid.Levels[0].GridView as TcxGridDBBandedTableView).ColumnCount - 1 do
      begin
        if (cxGrid.Levels[0].GridView as TcxGridDBBandedTableView).Columns[j].DataBinding.FieldName =
          Nrow.Properties.DataBinding.FieldName then
        begin
          Nrow.Properties.Caption:=(cxGrid.Levels[0].GridView as TcxGridDBBandedTableView).Columns[j].Caption;
          Nrow.Visible:=true;//(cxGrid.Levels[0].GridView as TcxGridDBBandedTableView).Columns[j].Visible;
          Nrow.Properties.EditPropertiesClass:=(cxGrid.Levels[0].GridView as TcxGridDBBandedTableView).Columns[j].PropertiesClass;
          Nrow.Properties.EditProperties:=(cxGrid.Levels[0].GridView as TcxGridDBBandedTableView).Columns[j].Properties;
          break;
        end;
      end;
    end;
  end;

end;

end.