Project Structure

• VclToClx.dpr
• VclToClxForm.pas
• VclToClxForm.dfm

program VclToClx;

uses
  QForms,
  VclToClxForm in 'VclToClxForm.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit VclToClxForm;

interface

uses
  SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,
  QStdCtrls, QComCtrls {$IFDEF LINUX}, Libc{$ENDIF}  ;

type
  TForm1 = class(TForm)
    lbFiles: TListBox;
    btnSource: TButton;
    btnReplace: TButton;
    lvReplace: TListView;
    cbRecurse: TCheckBox;
    procedure btnSourceClick(Sender: TObject);
    procedure btnReplaceClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    ReplaceMap: TStringList;
    CurrentDir: string;
  public
    procedure AddFilesToList (Filter, Folder: string; Recurse: Boolean);
  end;

var
  Form1: TForm1;

procedure GetSubDirs (Folder: string; sList: TStringList);

implementation

{$R *.xfm}

procedure TForm1.AddFilesToList(Filter, Folder: string; Recurse: Boolean);
var
  sr: TSearchRec;
  sDirList: TStringList;
  i: Integer;
begin
  if FindFirst (Folder + Filter, faAnyFile, sr) = 0 then
  repeat
    lbFiles.Items.Add (Folder + sr.Name);
  until FindNext(sr) <> 0;
  FindClose(sr);
  if Recurse then
  begin
    sDirList := TStringList.Create;
    try
      GetSubDirs (Folder, sDirList);
      for i := 0 to sDirList.Count - 1 do
        if (sDirList[i] <> '.') and (sDirList[i] <> '..') then
        begin
          Application.ProcessMessages;
          AddFilesToList (Filter,
            IncludeTrailingPathDelimiter (Folder + sDirList[i]),
            Recurse);
        end;
    finally
      sDirList.Free;
    end;
  end;
end;

procedure TForm1.btnSourceClick(Sender: TObject);
var
  Dir: string;
begin
  if SelectDirectory ('Choose Folder', '', Dir) then
  begin
    {$IFDEF LINUX}
      if Dir [1] <> '/' then
        Dir := '/' + Dir;
    {$ENDIF}
    CurrentDir := Dir; // change current
    Dir := IncludeTrailingPathDelimiter(Dir);
    AddFilesToList ('*.dpr', Dir, cbRecurse.Checked);
    AddFilesToList ('*.pas', Dir, cbRecurse.Checked);
    AddFilesToList ('*.dfm', Dir, cbRecurse.Checked);
      end;
end;

procedure TForm1.btnReplaceClick(Sender: TObject);
var
  StrFile: TStringList;
  i, j: Integer;
  FindStr, ReplaceStr: string;
begin
  strFile := TStringList.Create;
  for i := 0 to lbFiles.Items.Count - 1 do
  begin
    // convert DFM to xfm
    if SameText (ExtractFileExt(lbFiles.Items[i]), '.DFM') then
      RenameFile (lbFiles.Items[i],
        ChangeFileExt(lbFiles.Items[i], '.xfm'))
    else
    begin
      strFile.LoadFromFile(lbFiles.Items[i]);
      // for every string the the replace map
      for j := 0 to ReplaceMap.Count - 1 do
      begin
        // replace units inside uses (followed by ',')
        FindStr := ' ' + ReplaceMap.Names [j] + ',';
        ReplaceStr := ReplaceMap.Values [ReplaceMap.Names [j]];
        if ReplaceStr <> '' then
          ReplaceStr := ' ' + ReplaceStr + ',';
        strFile.Text := StringReplace (strFile.Text,
          FindStr, ReplaceStr, [rfReplaceAll]);
        // replace units at the end of uses (followed by ';')
        FindStr := ' ' + ReplaceMap.Names [j] + ';';
        ReplaceStr := ReplaceMap.Values [ReplaceMap.Names [j]];
        if ReplaceStr <> '' then
          ReplaceStr := ' ' + ReplaceStr + ';';
        strFile.Text := StringReplace (strFile.Text,
          FindStr, ReplaceStr, [rfReplaceAll]);
      end;
      // change DFM to xfm (lowercase)
      strFile.Text := StringReplace (strFile.Text,
        '.DFM', '.xfm', [rfReplaceAll]);
      // change RES to res (lowercase)
      strFile.Text := StringReplace (strFile.Text,
        '.RES', '.res', [rfReplaceAll]);
      strFile.SaveToFile(lbFiles.Items[i]);
    end;
  end;
  strFile.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  Item: TListItem;
begin
  ReplaceMap := TStringList.Create;
  ReplaceMap.LoadFromFile (ExtractFilePath(Application.ExeName) + 'remap.conf');

  for i := 0 to ReplaceMap.Count - 1 do
  begin
    Item := lvReplace.Items.Add;
    Item.Caption := ReplaceMap.Names [i];
    Item.SubItems.Add (
      ReplaceMap.Values [ReplaceMap.Names [i]]);
  end;

  {$IFDEF LINUX}
  CurrentDir := '$HOME';
  {$ESLEIF}
  CurrentDir := 'C:\';
  {$ENDIF}
end;

{$IFDEF LINUX}
procedure GetSubDirs (Folder: string; sList: TStringList);
var
  p: Pointer;
  Scratch: TDirEnt;
  StatBuf: TStatBuf;
  PtrDirEnt: PDirEnt;
  Mode: mode_t;
  FName: string;
begin
  p := opendir(pChar(Folder));
  if p = nil then
    Exit;
  try
    readdir_r(p, @Scratch, PtrDirEnt);
    while PtrDirEnt <> nil do
    begin
      FName := Folder + string(PtrDirEnt.d_name);
      if lstat(PChar(FName), StatBuf) = 0 then
      begin
        Mode := StatBuf.st_mode;
        if Mode and S_IFDIR <> 0 then
          sList.Add (PtrDirEnt.d_name)
      end;
      readdir_r(p, @Scratch, PtrDirEnt);
    end;
  finally
    closedir(p);
  end;
end;
{$ENDIF}

{$IFDEF MSWINDOWS}
procedure GetSubDirs (Folder: string; sList: TStringList);
var
  sr: TSearchRec;
begin
  if FindFirst (Folder + '*.*', faDirectory, sr) = 0 then
  try
    repeat
      if (sr.Attr and faDirectory) = faDirectory then
        sList.Add (sr.Name);
    until FindNext(sr) <> 0;
  finally
    FindClose(sr);
  end;
end;
{$ENDIF}

end.

object Form1: TForm1
  Left = 259
  Top = 107
  Width = 469
  Height = 488
  VertScrollBar.Range = 473
  HorzScrollBar.Range = 457
  ActiveControl = lbFiles
  Caption = 'DelphiToKylix'
  Color = clBackground
  OnCreate = FormCreate
  PixelsPerInch = 75
  TextHeight = 13
  TextWidth = 6
  object lbFiles: TListBox
    Left = 8
    Top = 48
    Width = 449
    Height = 177
    TabOrder = 0
  end
  object btnSource: TButton
    Left = 120
    Top = 16
    Width = 129
    Height = 25
    Caption = 'Find Source Files'
    TabOrder = 1
    OnClick = btnSourceClick
  end
  object btnReplace: TButton
    Left = 152
    Top = 240
    Width = 153
    Height = 25
    Caption = 'Do Replace / Rename'
    TabOrder = 2
    OnClick = btnReplaceClick
  end
  object lvReplace: TListView
    Left = 8
    Top = 272
    Width = 449
    Height = 201
    ColumnClick = False
    ColumnMove = False
    Columns = <
      item
        AllowClick = False
        Caption = 'Old'
        MinWidth = 50
        Width = 140
      end
      item
        AllowClick = False
        Caption = 'New'
        MinWidth = 50
        Width = 140
      end>
    RowSelect = True
    TabOrder = 3
    ViewStyle = vsReport
  end
  object cbRecurse: TCheckBox
    Left = 264
    Top = 16
    Width = 100
    Height = 25
    Caption = 'Recurse'
    TabOrder = 4
  end
end