MultiLanguage

prmas

After analysis I evidenced that the option of Multi Languages does not take care of my necessities.

It would like to have as option a form where the user could translate into its proper language case it did not exist.

This is possible in FR3? How I make?


Regards,


Marcos

AlexTZ

Use the RES\multilang.exe wizard to generate multi-language resource file. It will create the frxMultiLang.pas unit with the following contents:

unit frxMultiLang;

interface

procedure SetEnglishResources;
procedure SetRussianResources;

...

You need to include this unit into your app. To switch the resources, just call one of SetXXXResources methods.

prmas

Alex,

You can liberate the code source of multilang.exe?

Desire of this incorporated procedure inside of mine app.

Tanks,

Marcos

AlexTZ

unit mwMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, CheckLst;

type
  TMainForm = class(TForm)
    LanguageCB: TCheckListBox;
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    FWorkDir: String;
    procedure FillLanguages;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

function NameCase(const s: String): String;
var
  i: Integer;
begin
  Result := AnsiLowercase(s);
  for i := 1 to Length(s) do
    if i = 1 then
      Result[i] := AnsiUpperCase(s[i])[1]
    else if i < Length(s) then
      if s[i] = ' ' then
        Result[i + 1] := AnsiUpperCase(s[i + 1])[1];
end;


{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FWorkDir := ExtractFilePath(Application.ExeName);
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  FillLanguages;
end;

procedure TMainForm.FillLanguages;
var
  sr: TSearchRec;
begin
  LanguageCB.Items.Clear;
  if FindFirst(FWorkDir + '*.*', faDirectory, sr) = 0 then
  begin
    repeat
      if ((sr.Attr and faDirectory) <> 0) and (sr.Name <> '.') and (sr.Name <> '..') then
      begin
        LanguageCB.Items.Add(NameCase(sr.Name));
        LanguageCB.Checked[LanguageCB.Items.Count - 1] := True;
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;

  if LanguageCB.Items.IndexOf('English') = -1 then
    Application.MessageBox('You should run this wizard from ($FR3)\RES folder.',
    'Error', mb_Ok + mb_IconError);
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  outFile: TFileStream;
  i: Integer;

  procedure WriteStr(s: String);
  begin
    s := s + #13#10;
    outFile.Write(s[1], Length(s));
  end;

  procedure GetFileCode(const FileName: String; code: TStrings);
  var
    i: Integer;
  begin
    code.LoadFromFile(FileName);
    while not ((Pos('procedure', AnsiLowerCase(code[0])) = 1) and
      (Pos('begin', AnsiLowerCase(code[1])) = 1)) do
      code.Delete(0);
    code.Delete(0);
    code.Delete(0);

    i := 0;
    while (i < code.Count) and (CompareText(Trim(code[i]), 'end;') <> 0) do
      Inc(i);
    Inc(i);
    while (i < code.Count) do
      Code.Delete(i);
  end;

  procedure GetFileCode1(const FileName: String; code: TStrings);
  var
    i: Integer;
  begin
    code.LoadFromFile(FileName);
    while Pos('initialization', AnsiLowerCase(code[0])) <> 1 do
      code.Delete(0);
    code.Delete(0);

    i := 0;
    while (i < code.Count) and (CompareText(Trim(code[i]), 'end.') <> 0) do
      Inc(i);
    while (i < code.Count) do
      Code.Delete(i);

    i := code.Count - 1;
    while (i >= 0) and (Trim(code[i]) = '') do
    begin
      code.Delete(i);
      Dec(i);
    end;
  end;

  procedure CreateMethod(const resName: String);
  var
    sl: TStringList;
  begin
    WriteStr('{---------------------- ' + resName + ' resources ----------------------}');
    WriteStr('');
    WriteStr('procedure Set' + resName + 'Resources;');
    WriteStr('begin');

    sl := TStringList.Create;
    try
      GetFileCode(FWorkDir + resName + '\frxrcClass.pas', sl);
      WriteStr(sl.Text);
      GetFileCode(FWorkDir + resName + '\frxrcDesgn.pas', sl);
      WriteStr(sl.Text);
      GetFileCode(FWorkDir + resName + '\frxrcExports.pas', sl);
      WriteStr(sl.Text);
      GetFileCode(FWorkDir + resName + '\frxrcInsp.pas', sl);
      WriteStr(sl.Text);
      GetFileCode1(FWorkDir + resName + '\fs_iconst.pas', sl);
      WriteStr(sl.Text);
    except
      Application.MessageBox(PChar('Error in ' + resName + ' resources.'),
        'Error', mb_Ok + mb_IconError);
    end;

    sl.Free;

    WriteStr('end;');
    WriteStr('');
    WriteStr('');
  end;

begin
  outFile := TFileStream.Create(FWorkDir + 'frxMultiLang.pas', fmCreate);
  try
    WriteStr('{******************************************}');
    WriteStr('{                                          }');
    WriteStr('{             FastReport v3.0              }');
    WriteStr('{       Multi-Language resource file       }');
    WriteStr('{                                          }');
    WriteStr('{         Copyright (c) 1998-2004          }');
    WriteStr('{         by Alexander Tzyganenko,         }');
    WriteStr('{            Fast Reports Inc.             }');
    WriteStr('{                                          }');
    WriteStr('{******************************************}');
    WriteStr('');
    WriteStr('unit frxMultiLang;');
    WriteStr('');
    WriteStr('interface');
    WriteStr('');

    for i := 0 to LanguageCB.Items.Count - 1 do
      if LanguageCB.Checked[i] then
        WriteStr('procedure Set' + LanguageCB.Items[i] + 'Resources;');

    WriteStr('');
    WriteStr('implementation');
    WriteStr('');
    WriteStr('uses frxRes, fs_iconst;');
    WriteStr('');

    for i := 0 to LanguageCB.Items.Count - 1 do
      if LanguageCB.Checked[i] then
        CreateMethod(LanguageCB.Items[i]);

    WriteStr('end.');
  finally
    outFile.Free;
  end;

  Application.MessageBox('Resources are in the frxMultiLang.pas file.',
    'Information', mb_Ok + mb_IconInformation);
end;

end.