unmain.pas

来自「将Delphi程序中的标准控件批量转换到相应用的TNT控件」· PAS 代码 · 共 410 行

unit unMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, FileCtrl, StrUtils, TntStdCtrls, Menus,
  TntMenus, ActnList, TntActnList, ComCtrls, TntComCtrls, ToolWin, Grids,
  DBGrids, TntDBGrids, Buttons, TntButtons, TntExtCtrls, CheckLst,
  TntCheckLst;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    edBackupDir: TEdit;
    btBackupDir: TButton;
    Button1: TButton;
    Button2: TButton;
    rgType: TRadioGroup;
    Button3: TButton;
    Button4: TButton;
    OpenDialog1: TOpenDialog;
    TntButton1: TTntButton;
    lbHint: TLabel;
    TntCheckListBox1: TTntCheckListBox;
    procedure btBackupDirClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure TntButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function translateDir(const Dir: string; transtype: byte): boolean;
    function translateFile(const filename: string; transtype: byte): boolean;
    function IsBinDfm(const ADfmFileName: string): Boolean;
    procedure DfmBinToTxt(ADfmFileName: string);
    procedure TxtToDfmBin(ADfmFileName: string);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.IsBinDfm(const ADfmFileName: string): Boolean;
Var
  mBinStream:TMemoryStream;
  mBuff : array [0..2] of byte;
begin
  mBinStream := TMemoryStream.Create;
  try
    mBinStream.LoadFromFile(ADfmFileName);
    mBinStream.Read(mBuff, 3);
    //前三字节: $FF, $0A, $00
    if (mBuff[0] = $FF) and (mBuff[1] = $0A) and (mBuff[2]= $00) then
      Result := True
    else
      Result := False;
  finally
    mBinStream.Free;
  end;
end;

procedure TForm1.DfmBinToTxt(ADfmFileName: string);
Var
  inFileStream: TMemoryStream;
  outFileStream: TFileStream;
  //newADfmFileName: string;
begin
  inFileStream := TMemoryStream.Create;
  inFileStream.LoadFromFile(ADfmFileName);
  //newADfmFileName := ChangeFileExt( ADfmFileName, '.dfmbak');
  try
    outFileStream := TFileStream.Create(ADfmFileName, fmCreate);
    try
      try
        inFileStream.Seek(0, soFromBeginning);
        ObjectResourceToText(inFileStream, outFileStream);
      except
        Raise Exception.Create('This dfm is bin, error on trans bin to txt.');
      end;
    finally
      outFileStream.Free;
    end;
  finally
    inFileStream.Free;
  end;
end;



procedure TForm1.btBackupDirClick(Sender: TObject);
var
  Dir: string;
begin
  if SelectDirectory('请选择你的Delphi工程目录', '', Dir) then
  begin
    edBackupDir.Text := Dir;
  end;

end;

function TForm1.translateDir(const Dir: string; transtype: byte): boolean;
var
  sFile: string;
  Sr: TSearchRec;
begin
  sFile := Dir + '\*.*';

  if FindFirst(sFile, faAnyFile, Sr) = 0 then
  begin
    repeat
      if (Sr.Attr and faDirectory = faDirectory) then//目录
      begin
        if (Sr.Name <> '.') and (Sr.Name <> '..') then
        begin
          translateDir(Dir+'\'+ Sr.Name, transtype);
        end;
      end
      else
      begin
        if (uppercase(ExtractFileExt( Dir+'\'+Sr.Name ))='.DFM')
          or (uppercase(ExtractFileExt( Dir+'\'+Sr.Name ))='.PAS') then
        begin
          translateFile( Dir+'\'+Sr.Name , transtype );
        end;
      end;

    until FindNext(Sr) <> 0;
    FindClose(Sr);
  end;

end;

function TForm1.translateFile(const filename: string;
  transtype: byte): boolean;
var

  oldFile: TextFile;
  newFile: TextFile;
  bakfilename: string;
  s: string;
  isBin, BakisBin :boolean;
  i: integer;
begin
  result := false;

  lbHint.Caption := filename;
  application.ProcessMessages;
  
  bakfilename := copy(filename, 1, length(filename)-3)+'~'+ rightstr(filename, 3);

  copyfile(pchar(filename), pchar(bakfilename), false);

  if IsBinDfm(bakfilename) then
  begin
    BakisBin := true;
    DfmBinToTxt(bakfilename);
  end
  else
  begin
    BakisBin := false;
  end;

  isBin := false;
  if (uppercase(ExtractFileExt(filename ))='.DFM') then
  begin
    isBin := true;
  end;

  AssignFile(oldFile, bakfilename);
  AssignFile(newFile, filename);

  Reset(oldFile);
  ReWrite(newFile);
  i:=0;
  while true do
  begin
    inc(i);
    Readln(oldFile, S);                        { Read first line of file }

    if s<>'' then
    begin
      if transtype=0 then
      begin
        s := AnsiReplaceText(s, 'class(TForm)', 'class(TTntForm)');
        s := AnsiReplaceText(s, 'TMainMenu', 'TTntMainMenu');
        s := AnsiReplaceText(s, 'TMenuItem', 'TTntMenuItem');
        s := AnsiReplaceText(s, 'TPopupMenu', 'TTntPopupMenu');
        s := AnsiReplaceText(s, 'TLabel', 'TTntLabel');
        s := AnsiReplaceText(s, 'TEdit', 'TTntEdit');
        s := AnsiReplaceText(s, 'TMemo', 'TTntMemo');
        s := AnsiReplaceText(s, 'TButton', 'TTntButton');
        s := AnsiReplaceText(s, 'TCheckBox', 'TTntCheckBox');
        s := AnsiReplaceText(s, 'TListBox', 'TTntListBox');
        s := AnsiReplaceText(s, 'TComboBox', 'TTntComboBox');
        s := AnsiReplaceText(s, 'TScrollBar', 'TTntScrollBar');
        s := AnsiReplaceText(s, 'TGroupBox', 'TTntGroupBox');
        s := AnsiReplaceText(s, 'TRadioGroup', 'TTntRadioGroup');
        s := AnsiReplaceText(s, 'TPanel', 'TTntPanel');
        s := AnsiReplaceText(s, 'TActionList', 'TTntActionList');
        s := AnsiReplaceText(s, 'TAction', 'TTntAction');

        s := AnsiReplaceText(s, 'TBitBtn', 'TTntBitBtn');
        s := AnsiReplaceText(s, 'TSpeedButton', 'TTntSpeedButton');
        s := AnsiReplaceText(s, 'TStringGrid', 'TTntStringGrid');
        s := AnsiReplaceText(s, 'TDrawGrid', 'TTntDrawGrid');
        //s := AnsiReplaceText(s, 'TImage', 'TTntImage');
        s := AnsiReplaceText(s, 'TShape', 'TTntShape');
        s := AnsiReplaceText(s, 'TBevel', 'TTntBevel');
        s := AnsiReplaceText(s, 'TScrollBox', 'TTntScrollBox');
        s := AnsiReplaceText(s, 'TCheckListBox', 'TTntCheckListBox');
        s := AnsiReplaceText(s, 'TStaticText', 'TTntStaticText');
        s := AnsiReplaceText(s, 'TControlBar', 'TTntControlBar');
        s := AnsiReplaceText(s, 'TPaintBox', 'TTntPaintBox');

        s := AnsiReplaceText(s, 'TTabControl', 'TTntTabControl');
        s := AnsiReplaceText(s, 'TPageControl', 'TTntPageControl');
        s := AnsiReplaceText(s, 'TTabSheet', 'TTntTabSheet');
        s := AnsiReplaceText(s, 'TRichEdit', 'TTntRichEdit');
        s := AnsiReplaceText(s, 'TTrackBar', 'TTntTrackBar');
        s := AnsiReplaceText(s, 'TProgressBar', 'TTntProgressBar');
        s := AnsiReplaceText(s, 'TUpDown', 'TTntUpDown');
        s := AnsiReplaceText(s, 'TDateTimePicker', 'TTntDateTimePicker');
        s := AnsiReplaceText(s, 'TMonthCalendar', 'TTntMonthCalendar');
        s := AnsiReplaceText(s, 'TTreeView', 'TTntTreeView');
        s := AnsiReplaceText(s, 'TListView', 'TTntListView');
        s := AnsiReplaceText(s, 'TStatusBar', 'TTntStatusBar');
        s := AnsiReplaceText(s, 'TToolBar', 'TTntToolBar');
        s := AnsiReplaceText(s, 'TToolButton', 'TTntToolButton');
        s := AnsiReplaceText(s, 'TPageScroller', 'TTntPageScroller');

        //s := AnsiReplaceText(s, 'TDBGrid', 'TTntDBGrid');
        //s := AnsiReplaceText(s, 'TDBText', 'TTntDBText');
        //s := AnsiReplaceText(s, 'TDBEdit', 'TTntDBEdit');
        //s := AnsiReplaceText(s, 'TDBMemo', 'TTntDBMemo');
        //s := AnsiReplaceText(s, 'TDBComboBox', 'TTntDBComboBox');
        //s := AnsiReplaceText(s, 'TDBCheckBox', 'TTntDBCheckBox');
        //s := AnsiReplaceText(s, 'TDBRadioGroup', 'TTntDBRadioGroup');
        //s := AnsiReplaceText(s, 'TDBRichEdit', 'TTntDBRichEdit');

        s := AnsiReplaceText(s, 'TOpenDialog', 'TTntOpenDialog');
        s := AnsiReplaceText(s, 'TSaveDialog', 'TTntSaveDialog');
        s := AnsiReplaceText(s, 'TOpenPictureDialog', 'TTntOpenPictureDialog');
        s := AnsiReplaceText(s, 'TSavePictureDialog', 'TTntSavePictureDialog');

        s := AnsiReplaceText(s, 'PasswordChar =', 'PasswordCharW =');
        s := AnsiReplaceText(s, 'TTreeNode', 'TTntTreeNode');
        s := AnsiReplaceText(s, 'TDataSeTTntEdit', 'TDataSeTEdit');

      end
      else
      begin
        s := AnsiReplaceText(s, 'class(TTntForm)', 'class(TForm)');
        s := AnsiReplaceText(s, 'TTntMainMenu', 'TMainMenu');
        s := AnsiReplaceText(s, 'TTntMenuItem', 'TMenuItem');
        s := AnsiReplaceText(s, 'TTntPopupMenu', 'TPopupMenu');
        s := AnsiReplaceText(s, 'TTntLabel', 'TLabel');
        s := AnsiReplaceText(s, 'TTntEdit', 'TEdit');
        s := AnsiReplaceText(s, 'TTntMemo', 'TMemo');
        s := AnsiReplaceText(s, 'TTntButton', 'TButton');
        s := AnsiReplaceText(s, 'TTntCheckBox', 'TCheckBox');
        s := AnsiReplaceText(s, 'TTntListBox', 'TListBox');
        s := AnsiReplaceText(s, 'TTntComboBox', 'TComboBox');
        s := AnsiReplaceText(s, 'TTntScrollBar', 'TScrollBar');
        s := AnsiReplaceText(s, 'TTntGroupBox', 'TGroupBox');
        s := AnsiReplaceText(s, 'TTntRadioGroup', 'TRadioGroup');
        s := AnsiReplaceText(s, 'TTntPanel', 'TPanel');
        s := AnsiReplaceText(s, 'TTntActionList', 'TActionList');
        s := AnsiReplaceText(s, 'TTntAction', 'TAction');

        s := AnsiReplaceText(s, 'TTntBitBtn', 'TBitBtn');
        s := AnsiReplaceText(s, 'TTntSpeedButton', 'TSpeedButton');
        s := AnsiReplaceText(s, 'TTntStringGrid', 'TStringGrid');
        s := AnsiReplaceText(s, 'TTntDrawGrid', 'TDrawGrid');
        //s := AnsiReplaceText(s, 'TTntImage', 'TImage');
        s := AnsiReplaceText(s, 'TTntShape', 'TShape');
        s := AnsiReplaceText(s, 'TTntBevel', 'TBevel');
        s := AnsiReplaceText(s, 'TTntScrollBox', 'TScrollBox');
        s := AnsiReplaceText(s, 'TTntCheckListBox', 'TCheckListBox');
        s := AnsiReplaceText(s, 'TTntStaticText', 'TStaticText');
        s := AnsiReplaceText(s, 'TTntControlBar', 'TControlBar');
        s := AnsiReplaceText(s, 'TTntPaintBox', 'TPaintBox');

        s := AnsiReplaceText(s, 'TTntTabControl', 'TTabControl');
        s := AnsiReplaceText(s, 'TTntPageControl', 'TPageControl');
        s := AnsiReplaceText(s, 'TTntTabSheet', 'TTabSheet');
        s := AnsiReplaceText(s, 'TTntRichEdit', 'TRichEdit');
        s := AnsiReplaceText(s, 'TTntTrackBar', 'TTrackBar');
        s := AnsiReplaceText(s, 'TTntProgressBar', 'TProgressBar');
        s := AnsiReplaceText(s, 'TTntUpDown', 'TUpDown');
        s := AnsiReplaceText(s, 'TTntDateTimePicker', 'TDateTimePicker');
        s := AnsiReplaceText(s, 'TTntMonthCalendar', 'TMonthCalendar');
        s := AnsiReplaceText(s, 'TTntTreeView', 'TTreeView');
        s := AnsiReplaceText(s, 'TTntListView', 'TListView');
        s := AnsiReplaceText(s, 'TTntStatusBar', 'TStatusBar');
        s := AnsiReplaceText(s, 'TTntToolBar', 'TToolBar');
        s := AnsiReplaceText(s, 'TTntToolButton', 'TToolButton');
        s := AnsiReplaceText(s, 'TTntPageScroller', 'TPageScroller');

        //s := AnsiReplaceText(s, 'TTntDBGrid', 'TDBGrid');
        //s := AnsiReplaceText(s, 'TTntDBText', 'TDBText');
        //s := AnsiReplaceText(s, 'TTntDBEdit', 'TDBEdit');
        //s := AnsiReplaceText(s, 'TTntDBMemo', 'TDBMemo');
        //s := AnsiReplaceText(s, 'TTntDBComboBox', 'TDBComboBox');
        //s := AnsiReplaceText(s, 'TTntDBCheckBox', 'TDBCheckBox');
        //s := AnsiReplaceText(s, 'TTntDBRadioGroup', 'TDBRadioGroup');
        //s := AnsiReplaceText(s, 'TTntDBRichEdit', 'TDBRichEdit');

        s := AnsiReplaceText(s, 'TTntOpenDialog', 'TOpenDialog');
        s := AnsiReplaceText(s, 'TTntSaveDialog', 'TSaveDialog');
        s := AnsiReplaceText(s, 'TTntOpenPictureDialog', 'TOpenPictureDialog');
        s := AnsiReplaceText(s, 'TTntSavePictureDialog', 'TSavePictureDialog');

        s := AnsiReplaceText(s, 'PasswordCharW =', 'PasswordChar =');
        s := AnsiReplaceText(s, 'TTntTreeNode', 'TTreeNode');
      end;
    end;

    Writeln(newFile, s);

    if s='end.' then  break;
    if s='end' then break;

  end;

  CloseFile(newFile);
  CloseFile(oldFile);

  if BakIsBin then
    TxtToDfmBin(bakFileName);

  if isBin then
    TxtToDfmBin(fileName);

  result := true;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  dir : string;
begin
  Dir := edBackupDir.Text;
  if AnsiLastChar(Dir)^ = '\' then
  begin
    Dir := copy(dir, 1, length(dir)-1);
  end;

  translateDir(edBackupDir.Text, rgType.ItemIndex );

  lbHint.Caption := '转换完成';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if opendialog1.Execute then
    edBackupDir.Text:=opendialog1.FileName;
  
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  if IsBinDfm( edBackupDir.Text) then
  begin
    DfmBinToTxt( edBackupDir.Text);
  end
  else
  begin
    TxtToDfmBin( edBackupDir.Text);
  end;
end;

procedure TForm1.TxtToDfmBin(ADfmFileName: string);
Var
  inFileStream: TMemoryStream;
  outFileStream: TFileStream;
  //newADfmFileName: string;
begin
  inFileStream := TMemoryStream.Create;
  inFileStream.LoadFromFile(ADfmFileName);
  //newADfmFileName := ChangeFileExt( ADfmFileName, '.dfmbak');
  try
    outFileStream := TFileStream.Create(ADfmFileName, fmCreate);
    try
      try
        inFileStream.Seek(0, soFromBeginning);
        ObjectTextToResource(inFileStream, outFileStream);
      except
        Raise Exception.Create('This dfm is bin, error on trans Txt to Bin.');
      end;
    finally
      outFileStream.Free;
    end;
  finally
    inFileStream.Free;
  end;
end;

procedure TForm1.TntButton1Click(Sender: TObject);
begin
  translatefile(edBackupDir.Text, rgType.ItemIndex );
end;

end.