base_dfm.pas

来自「Delphi脚本控件」· PAS 代码 · 共 2,003 行 · 第 1/4 页

          Delete(S, Length(S), 1);
          Output.Add(Indent + AP + S + AP + ';');
          if SaveObject <> '' then
            Output.Add(Indent + '_AssignBmp(' + SaveObject+ ', _S);');
          continue;
        end
        else if StartStringData(S) then
        begin
          SaveObject := Copy(S, 1, Pos('.', S) - 1);
          continue;
        end
        else if EndStringData(S) then
        begin
          Delete(S, Length(S), 1);
          Output.Add(Indent + SaveObject + '.Add(' + S + ');');
          continue;
        end
        else if ContinueStringData(S) then
        begin
          if (Length(S) > 0) then
            if S[Length(S)] = '+' then
               S := Copy(S, 1, Length(S) - 1);

          Output.Add(Indent + SaveObject + '.Add(' + S + ');');
          continue;
        end
        else if StartCollectionItem(S) then
        begin
          Output.Add(Indent + 'with ' + ObjName + '.' + S + '.Add do');
          Output.Add(Indent + 'begin');
          continue;
        end
        else if EndCollectionItem(S) then
        begin
          Output.Add(Indent + 'end;');
          if Pos('>', S) > 0 then
            Output.Add('end;');
          continue;
        end
        else if ContinueObjectData(S) then
        begin
//          continue;
        end
        else if StartObjectData(S) then
        begin
          continue;
        end
        else if EndObjectData(S) then
        begin
          continue;
        end;

        S := InsAssignment(S, Failure);

        if not Failure then
        begin
          IsEvent := StrEql('On', Copy(S, 1, 2));

          Failure := IsEvent and (Src = nil);

          if IsEvent and (Src <> nil) then
          begin
            searchStr := UpperCase(ClassName + '.' + Trim(Copy(S, Pos('=', S) + 1, Length(S))) + '(');
            for J:=0 to Src.Count - 1 do
              if Pos(searchStr, UpperCase(Src[J])) > 0 then
              begin
                headerStr := Src[J];

                J1 := Pos(ClassName + '.', headerStr);
                Delete(headerStr, J1, Length(ClassName) + 1);

                HeaderList.Add('    ' + headerStr);

                for J1 := J to Src.Count - 1 do
                begin
                  EventHandlerList.Add(Src[J1]);
                  if StrEql('end;', Copy(Src[J1], 1, 4)) then
                    break;
                end;
              end;
          end;
        end;

        if not Failure then
        begin
          if K = 1 then
            MainPropList.Add(Indent + S + ';')
          else
            Output.Add(Indent + S + ';');
        end;
      end;
    end;

    for I:=0 to MainPropList.Count - 1 do
      Output.Add(MainPropList[I]);

    Output.Add('end;');

    if Need_S then
      Output.Insert(Pos_S, 'var _S: String;');

    for J:=HeaderList.Count - 1 downto 0 do
      Output.Insert(PosConstructor, HeaderList[J]);

    for J:=0 to EventHandlerList.Count - 1 do
      Output.Add(EventHandlerList[J]);

    if AsUnit then
      Output.Add('end.');

  finally
    EventHandlerList.Free;
    MainPropList.Free;
    InputList.Free;
    HeaderList.Free;
  end;
end;

////////////////  PAX C //////////////////////////////////

procedure ConvDFMToPaxCScript(const DfmFileName: String; ms: TStream; UsedUnits, Output: TStrings;
                              AsUnit: Boolean = true;
                              Src: TStrings = nil);
var
  I, J, J1: Integer;
  InputList: TStringList;
  S, ClassName, FormName, Indent,
  AnObject, AClass, SaveObject: String;
  Failure: boolean;
  C: TClass;
  MainPropList: TStringList;

  K: Integer;
  StackObj, StackCls: array[1..100] of String;
  Pos_S: Integer;
  Need_S: Boolean;
  UnitName: String;

  searchStr, headerStr: String;
  IsEvent: Boolean;
  EventHandlerList: TStringList;
  HeaderList: TStringList;

  P: Integer;

  AncestorClassName: String;
  IsInherited: Boolean;
begin
  IsInherited := false;
  
  P := 0;
  UnitName := DfmFileName;
  I := Pos('.', DfmFileName);
  if I > 0 then
    UnitName := Copy(UnitName, 1, I - 1);

  RegisterUsedClasses;

  InputList := TStringList.Create;
  MainPropList := TStringList.Create;
  EventHandlerList := TStringList.Create;
  HeaderList := TStringList.Create;

  Need_S := false;

  try
    ms.Seek(0, 0);
    InputList.LoadFromStream(ms);

    for I:=0 to InputList.Count - 1 do
    begin
      S := TrimLeft(InputList[I]) + ' ';
      if StrEql('object ', Copy(S, 1, 7)) then
      begin
        S := TrimRight(Copy(S, Pos(':', S) + 1, 100));
        ClassName := Trim(S);
        break;
      end;
    end;

    for I:=UsedUnits.Count - 1 downto 0 do
    begin
      S := Trim(UsedUnits[I]);
      if S = '' then
        UsedUnits.Delete(I);
    end;

    if UsedUnits.Count > 0 then
    begin
      Output.Add('using');
      for I:=0 to UsedUnits.Count - 1 do
      begin
        S := Trim(UsedUnits[I]);
        if I = UsedUnits.Count - 1 then
          Output.Add('  ' + S + ';')
        else
          Output.Add('  ' + S + ',');
      end;
    end;

    K := 0;

    Indent := '  ';

    for I:=0 to InputList.Count - 1 do
    begin
      S := TrimLeft(InputList[I]) + ' ';

      if      StartObjectData(TrimRight(S)) then
        continue
      else if EndObjectData(TrimRight(S)) then
        continue
      else if ContinueObjectData(TrimRight(S)) then
        continue
      else if StrEql('object ', Copy(S, 1, 7)) or StrEql('inherited ', Copy(S, 1, 10)) then
      begin
        AncestorClassName := 'TForm';

        if Pos('inherited ', S) = 1 then
        begin
          S := StringReplace(S, 'inherited ', 'object ', []);
          AncestorClassName := Copy(S, Pos(':', S) + 1, Length(S));
          AncestorClassName := Trim(AncestorClassName);
          C := GetClass(AncestorClassName);
          if C <> nil then
          begin
            C := C.ClassParent;
            AncestorClassName := C.ClassName;
          end
          else
            AncestorClassName := 'TForm';
        end;

        if AncestorClassName = 'TForm' then
          AncestorClassName := ExtractAncestorClassName(src);

        Inc(K);

        if K = 1 then
        begin
          FormName := Copy(S, 1, Pos(':', S) - 1);
          Delete(FormName, 1, 7);
          FormName := TrimLeft(FormName);
          S := TrimLeft(Copy(S, Pos(':', S) + 1, 100));
          ClassName := TrimRight(S);

          if AsUnit then
          begin
            Output.Add('namespace '  + UnitName);
            Output.Add('{');
          end;

          Output.Add('class '  + ClassName + ' :' + AncestorClassName);
          Output.Add('{');

          P := Output.Count;
        end
        else
        begin
          Delete(S, 1, 7);
          S := TrimLeft(S);
          S := TrimRight(S);
        end;
      end
      else if (StrEql('end ', Copy(S, 1, 4))) and (not OBJECT_SWITCH) then
      begin
        Dec(K);
      end;
    end;

    OBJECT_SWITCH := false;

    Output.Add('');
    Output.Add('  void ' + ClassName + '(TComponent AOwner)');
    Pos_S := Output.Add('  {');
    Output.Add('    this = base.Create(AOwner);');

  // constructor's body

    K := 0;
    Indent := '  ';

//    for I:=0 to InputList.Count - 1 do
    I := -1;
    while I < InputList.Count - 2 do
    begin
      Inc(I);

      S := TrimLeft(InputList[I]) + ' ';

      if StrEql('object ', Copy(S, 1, 7)) or StrEql('inherited ', Copy(S, 1, 10)) then
      begin
        if Pos('inherited ', S) = 1 then
        begin
          S := StringReplace(S, 'inherited ', 'object ', []);
        end;

        Inc(K);

        if K = 1 then
        begin
          StackObj[K] := 'this';
          StackCls[K] := 'TForm';
        end
        else
        begin

          Delete(S, 1, 7);
          S := Trim(S);
          AnObject := Copy(S, 1, Pos(':', S) - 1);
          AClass := TrimLeft(Copy(S, Pos(':', S) + 1, 100));

          if anObject = '' then
            anObject := '_' + AClass;

          if (FindGlobalComponent(AnObject) = nil) and (IsInherited = false) then
            Output.Add(Indent + AnObject + ' = new ' + AClass +  '(' + StackObj[K-1] + ');');

          HeaderList.Add('  ' + AClass + ' ' + AnObject + ';');


          Output.Add(Indent + AnObject + '.Name = ' + AP + AnObject + AP + ';');
          C := GetClass(AClass);
          if Assigned(C) then
          begin
            if _InheritsFrom(C.ClassName, 'TControl') then
              Output.Add(Indent + AnObject + '.Parent = ' + StackObj[K-1] + ';');

            if HasPublishedProperty(C, 'caption', nil) then
              Output.Add(Indent + AnObject + '.Caption = ' + AP + AP + ';');
            if HasPublishedProperty(C, 'text', nil) then
              Output.Add(Indent + AnObject + '.Text = ' + AP + AP + ';');
            if HasPublishedProperty(C, 'lines', nil) then
              Output.Add(Indent + AnObject + '.Lines.Text = ' + AP + AP + ';');

            if _InheritsFrom(C.ClassName, 'TMenuItem') then
            begin
              if StrEql('TMainMenu', StackCls[K-1]) then
                Output.Add(Indent + StackObj[K-1] + '.Items.Add(' + AnObject + ');')
              else if StrEql('TPopUpMenu', StackCls[K-1]) then
                Output.Add(Indent + StackObj[K-1] + '.Items.Add(' + AnObject + ');')
              else
                Output.Add(Indent + StackObj[K-1] + '.Add(' + AnObject + ');');
            end;
          end;

          Output.Add(Indent + 'with (' + AnObject + ')');
          Output.Add(Indent + '{');

          StackObj[K] := AnObject;
          StackCls[K] := AClass;
        end;

        Indent := Indent + '  ';
      end
      else if (StrEql('end ', Copy(S, 1, 4))) and (not OBJECT_SWITCH) then
      begin
        Dec(K);
        Delete(Indent, 1, 2);

        if K > 0 then
          Output.Add(Indent + '}');
      end
      else
      begin
        if StrEql('TextHeight ', Copy(S, 1, 11)) then
          continue;
        if StrEql('TextWidth ', Copy(S, 1, 10)) then
          continue;

        S := TrimRight(S);

        if      StartBinData(S) then
        begin
          Need_S := true;

          SaveObject := Copy(S, 1, Pos('.', S) - 1);
          Output.Add(Indent + '_S = ');
          continue;
        end
        else if ContinueBinData(S) then
        begin
          Output.Add(Indent + AP + S + AP + '+');
          continue;
        end
        else if EndBinData(S) then
        begin
          Delete(S, Length(S), 1);
          Output.Add(Indent + AP + S + AP + ';');
          if SaveObject <> '' then
            Output.Add(Indent + '_AssignBmp(' + SaveObject+ ', _S);');
          continue;
        end
        else if StartStringData(S) then
        begin
          SaveObject := Copy(S, 1, Pos('.', S) - 1);
          continue;
        end
        else if ContinueStringData(S) then
        begin
          if (Length(S) > 0) then
            if S[Length(S)] = '+' then
               S := Copy(S, 1, Length(S) - 1);

          Output.Add(Indent + SaveObject + '.Add(' + S + ');');
          continue;
        end
        else if EndStringData(S) then
        begin
          Delete(S, Length(S), 1);
          Output.Add(Indent + SaveObject + '.Add(' + S + ');');
          continue;
        end
        else if StartObjectData(S) then
        begin
          continue;
        end
        else if EndObjectData(S) then
        begin
          continue;
        end
        else if ContinueObjectData(S) then
        begin
          continue;
        end;

        S := StringReplace(S, ' False', 'false', [rfIgnoreCase]);

        IsEvent := StrEql('On', Copy(S, 1, 2));

        Failure := IsEvent and (Src = nil);

        if IsEvent and (Src <> nil) then
        begin
          searchStr := UpperCase(ClassName + '.' + Trim(Copy(S, Pos('=', S) + 1, Length(S))) + '(');
          for J:=0 to Src.Count - 1 do
            if Pos(searchStr, UpperCase(Src[J])) > 0 then
            begin
              headerStr := Src[J];

              J1 := Pos(ClassName + '.', headerStr);
              Delete(headerStr, J1, Length(ClassName) + 1);

              HeaderList.Add('    ' + headerStr);

              for J1 := J to Src.Count - 1 do
              begin
                EventHandlerList.Add(Src[J1]);
                if StrEql('end;', Copy(Src[J1], 1, 4)) then
                  break;
              end;
            end;
        end;

        if not Failure then
        begin
          if K = 1 then
            MainPropList.Add(Indent + S + ';')
          else
            Output.Add(Indent + S + ';');
        end;
      end;
    end;

    for I:=0 to MainPropList.Count - 1 do
      Output.Add(MainPropList[I]);

    Output.Add('  }');
    Output.Add('}');

    if Need_S then
      Output.Insert(Pos_S, 'String _S;');

    for J:=HeaderList.Count - 1 downto 0 do
      Output.Insert(P, HeaderList[J]);

    Output.Add('');
    Output.Add(ClassName + ' ' + FormName + ';');

    if AsUnit then
      Output.Add('}');

    for J:=0 to EventHandlerList.Count - 1 do
      Output.Add(EventHandlerList[J]);

  finally
    EventHandlerList.Free;
    MainPropList.Free;
    InputList.Free;
    HeaderList.Free;
  end;
end;

////////////////  PAX BASIC //////////////////////////////////

procedure ConvDFMToPaxBasicScript(const DfmFileName: String; ms: TStream; UsedUnits, Output: TStrings;
                              AsUnit: Boolean = true;
                              Src: TStrings = nil);
var
  I, J, J1: Integer;
  InputList: TStringList;