{*****************************************************************************
 *
 *  PMLanguage
 *
 *
 *
 *  Copyright (c) 2002 Dick Brandon/Arthur Hoogervorst
 *
 *  Author:     Dick Brandon,
 *              Arthur Hoogervorst
 *  E-mail:     access2k@dds.nl
 *  Homepage:   http://roundabout.sourceforge.net
 *
 *  This program is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU General Public License
 *  as published by the Free Software Foundation;
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
 *
 *----------------------------------------------------------------------------
 *  Notify
 *  When you creating a Custom.INI make sure that all forms are in the project.
 *  How do i this:
 *  Go to the menu Project
 *  Select Options and then the tab Forms.
 *  Place all forms in the left view/window
 *  The build all projects
 *  Place at the first line of your program the following procedure
 *  PMCreateCustomIni;
 *  Run your program and when running will a custom.ini created
 *  See in your program directory and it's done
 *----------------------------------------------------------------------------
 *
 *  Revision history:
 *
 *     DATE     REV                 DESCRIPTION
 *  ----------- ----  --------------------------------------------------------
 *  2002-11-16  1.1   Initial Release of Category editor
 *  2002-12-16  1.11  Small fixes
 *  2002-01-09  1.2   Update to a more object orientated structure (AH)
 *  2002-03-06  1.2.1 Cleanup unused code (AH)
 *****************************************************************************}
unit PMLanguage;

interface

uses
  Windows, SysUtils, Classes, Forms, stdCtrls, typInfo,
  extCtrls, iniFiles, Controls, menus, TB97Ctls, TB97, TB97Tlbr,
  comctrls, ExtListView;

type
  TLNGOnWriteStatusUpdate = procedure (Sender : TObject;
    Current, Total : LongInt) of object;

  TLanguageHolder = class
  private
    FFormList, FMessageList : TStringList; // Holds the form list.
    FLanguage : string;
    FMemIniFile : TMemIniFile;
    FOnStatus : TLNGOnWriteStatusUpdate;
    function GetCount : LongInt;
    function GetStringForm(index : LongInt) : string;
    procedure SetLanguage(Alanguage : string);
    procedure WriteFormData(fIni : TCustomIniFile; AForm : TForm;
      Update : Boolean);
    procedure WriteCaptionHintData(fIni : TCustomIniFile; Section,
      Key : string; AComponent : TComponent; Update : Boolean);
    procedure WriteLinesData(fIni : TCustomIniFile; Section, Key : string;
      AComponent : TComponent; Update : Boolean);
    function GetMessages(index :integer) : string;
    procedure SetMessages(index : integer; st : string);
    procedure InternalTranslation(
      f : TMemIniFile; CompArray : array of TComponent);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function AddCustomClass(AClass : TFormClass; AClassName : string) : integer;
    function GetClassByName(AClassName : string) : TClass;
    function GetClassByIndex(Index : LongInt) : TClass;
    procedure SaveClassNames(afilename : string);
    procedure Translate(CompArray : array of TComponent);
    procedure CreateLanguageFile(aLanguage : string; aOwner : TComponent = nil;
      Update : Boolean = False);
    procedure InstantTranslation(CompArray : array of TComponent;
      aOwner : TComponent = nil);
    property FormNames[index : integer] : string read GetStringForm;
    property MessagesStrings[index : integer] : string read GetMessages
      write SetMessages;
    property FormCount : LongInt read GetCount;
    property Language : string read FLanguage write SetLanguage;
    property OnStatusUpdate : TLNGOnWriteStatusUpdate read fOnStatus
      write fOnStatus;
  end;

//utilities
function  PMGetProperty(comp : TComponent; prop : string) : string;
procedure PMSetProperty(comp : TComponent; prop, value : string);
function  PMHasProperty(comp : TComponent; prop : string) : boolean;

implementation

uses PXStuff;

//Backs up the prop property value of the comp component
function PMGetProperty(comp : TComponent; prop : string) : string;
var ppi : PPropInfo;
begin
  ppi := getPropInfo(comp.classInfo, prop);
  if ppi<>nil then
    result:=getStrProp(comp,ppi)
   else
    result:='';
end;

//Assign the value value to prop property of comp component
procedure PMSetProperty(comp : TComponent; prop, value : string);
var ppi : PPropInfo;
begin
  if value <> '' then
  begin
    ppi := getPropInfo(comp.classInfo, prop);
    if ppi <> nil then setStrProp(comp, ppi, value);
  end;
end;

//True if prop property exists for comp component
function PMHasProperty(comp : TComponent; prop : string):boolean;
begin
  result:=(getPropInfo(comp.classInfo, prop) <> nil) and (comp.name <> '');
end;

constructor TLanguageHolder.Create;
begin
  inherited Create;
  FFormList := TStringList.Create;
  FMessageList := TStringList.Create;
  FMemIniFile := nil;
end;

procedure TLanguageHolder.Clear;
begin
  FFormList.Clear;
end;

function TLanguageHolder.AddCustomClass(AClass : TFormClass; AClassName : string) :
  integer;
begin
  // Make sure that this class doesn't exist yet.
  result := -1;
  if FFormList.IndexOf(AClassName) = -1 then
  begin
    RegisterClass(TFormClass(AClass));
    result := FFormList.AddObject(AClassName, TObject(Aclass));
  end;
end;

function TLanguageHolder.GetClassByIndex(Index : LongInt) : TClass;
begin
  Result := TClass(FFormList.Objects[index]);
end;

function TLanguageHolder.GetClassByName(AClassName : string) : TClass;
begin
  result := nil;
  if FFormList.IndexOf(AClassName) > -1 then
  begin
    Result := TClass(FFormList.Objects[FFormList.IndexOf(AClassName)]);
  end;
end;


procedure TLanguageHolder.SaveClassNames(afilename : string);
begin
  FFormList.SaveToFile(afilename);
end;

function TLanguageHolder.GetCount : LongInt;
begin
  result := FFormList.Count;
end;


//TODO -oMjg:Check the language if exit then write into 'fmessagelist else extract default language
procedure TLanguageHolder.SetLanguage(Alanguage : string);
var i : integer;
begin
  FLanguage := '';
  if (ALanguage <> '') and (ALanguage <> FLanguage) and
    FileExists(sTemplateFolder + ALanguage + '.lng') then
  begin
    if Assigned(FMemIniFIle) then
    begin
      FMemIniFile.Rename(sTemplateFolder + ALanguage + '.lng', True);
    end
    else
    begin
      FMemIniFile := TMemIniFile.Create(sTemplateFolder + ALanguage + '.lng');
    end;

    if FileExists(sTemplateFolder + 'Messages_' + ALanguage + '.txt') then
    begin
      FMessageList.LoadFromFile(sTemplateFolder + 'Messages_' + ALanguage + '.txt');
    end
    else
    begin
      for i := 0 to High(Messages) do
      begin
        FMessageList.Add(Messages[i]);
      end;
      // Write out...
      FMessageList.SaveToFile(sTemplateFolder + 'Messages_' + ALanguage + '.txt');
    end;
    FLanguage := ALanguage;
  end;
end;



//TODO -oMjg:translate the form into default language
procedure TLanguageHolder.InternalTranslation(
  f : TMemIniFile; CompArray : array of TComponent);
var
   i, i2, i3, i4, tab : integer;
   comp, fiche : TComponent;
   s, s1, s2, s3, s4, s5 : string;
begin
  if Assigned(f) then
  begin
    with f do
    for tab := 0 to high(CompArray) do
    begin
      fiche :=CompArray[tab];
      if fiche = nil then continue;
      s := readString(fiche.name, fiche.name + '.Caption','');
      if s <> '' then TForm(fiche).caption := s;
      for i := 0 to fiche.componentCount-1 do
      begin
        comp := fiche.Components[i];
        if (copy(Comp.Name,1,3)='out') or (Comp.Tag = 127) then continue;
        s1 := readString(fiche.name,fiche.name+'.'+comp.name+'.Caption','');
        if s1<>'' then PMSetProperty(comp,'Caption',s1);

        s2:=readString(fiche.name,fiche.name+'.'+comp.name+'.Hint','');
        if s2<>'' then PMSetProperty(comp,'Hint',s2);

        if comp is TCustomMemo then
          for i2:=0 to TCustomMemo(comp).lines.count-1 do
          begin
            s3:=readString(fiche.name,
               fiche.name+'.'+comp.name+'.Lines['+intToStr(i2)+']',
               'fsdef');
              //in TMemo or TRichEdit, you may have to leave some lines empty
             if s3<>'fsdef' then TCustomMemo(comp).lines[i2]:=s3;
          end;

        if comp is TRadioGroup then
          for i3:=0 to TRadioGroup(comp).items.count-1 do
          begin
            s4:=readString(fiche.name,
              fiche.name+'.'+comp.name+'.Items['+intToStr(i3)+']',
              '');
            if s4<>'' then TRadioGroup(comp).items[i3]:=s4;
          end;

        if comp is TComboBox then
          for i4:=0 to TComboBox(comp).Items.count-1 do
          begin
            s5:=readString(fiche.name,
              fiche.name+'.'+comp.name+'.Items['+IntToStr(i4)+']','');
            if s5<>'' then TComboBox(comp).items[i4]:=s5;
          end;

        if comp is TListBox then
          for i4 := 0 to TListBox(comp).Items.Count - 1 do
          begin
            s5 := readstring(fiche.name,
              fiche.name + '.' + comp.name + '.Items[' + IntToStr(i4) + ']',
               '');
            if s5 <> '' then TListBox(comp).Items[i4] := s5;
          end;

        if comp is TTreeView then
          for i4 := 0 to TTreeView(comp).Items.Count - 1 do
          begin
            s5 := readstring(fiche.name,
              fiche.name + '.' + comp.name + '.Items[' + IntToStr(i4) + '].Text',
               '');
            if s5 <> '' then TTreeView(comp).Items[i4].Text := s5;
          end;

        if comp is TListView then
          for i4 := 0 to TListView(comp).Columns.Count - 1 do
          begin
            s5 := readstring(fiche.name,
              fiche.name + '.' + comp.name + '.Column[' + IntToStr(i4) + '].Caption',
               '');
            if s5 <> '' then TListView(comp).Column[i4].Caption := s5;
          end;

        if comp is TdfsExtListView then
          for i4 := 0 to TdfsExtListView(comp).Columns.Count - 1 do
          begin
            s5 := readstring(fiche.name,
              fiche.name + '.' + comp.name + '.Column[' + IntToStr(i4) + '].Caption',
               '');
            if s5 <> '' then TdfsExtListView(comp).Column[i4].Caption := s5;
          end;
      end;
    end;
  end;
end;

procedure TLanguageHolder.Translate(CompArray : array of TComponent);
begin
  InternalTranslation(FMemIniFile, CompArray);
end;

function TLanguageHolder.GetStringForm(index : LongInt) : string;
begin
  result := FFormList.Strings[index];
end;

procedure TLanguageHolder.WriteFormData(fIni : TCustomIniFile; AForm : TForm;
  Update : Boolean);
var clname, namecomp : string;
    j : integer;
    cmpt : TComponent;
begin
  clname := AForm.ClassName;
  Delete(clName, 1, 1); // Remove the T from mister T <g>
  if PMHasProperty(AForm,'Caption') and
    not (AForm.Name=PMGetProperty(AForm,'Caption')) then
  begin
    WriteCaptionHintData(fIni, clName, clName, AForm, Update);
  end;

  for j := 0 to AForm.componentCount-1 do
  begin
    cmpt := AForm.Components[j];
    nameComp:= cmpt.name;
    //use a 'out' prefixed name if you want the component won't appear
    //in the list (ie : outLabel6:TLabel) so as the list won't be too big
    if (copy(nameComp,1,3)='out') or (cmpt.Tag = 127) then continue;
    if PMHasProperty(cmpt,'Caption') and
      not (nameComp=PMGetProperty(cmpt,'Caption')) and
      not (PMGetProperty(cmpt,'Caption')='-') and
      not (PMGetProperty(cmpt,'Caption')='') and
      not (cmpt is TmenuItem) and
      not (cmpt is TToolBarButton97)
      then
    begin
      WriteCaptionHintData(fIni, clName, clName + '.' + nameComp, cmpt, Update);
    end;

    if (cmpt is TMenuItem) then
    begin
      // Don't translate items that have actions or are 'separators'.
      if not assigned(TMenuItem(cmpt).Action) and (TMenuItem(cmpt).Caption
        <> '-') then
      begin
        WriteCaptionHintData(fIni, clName, clName + '.' + nameComp, cmpt,
          Update);
      end;
    end;

    if (cmpt is TToolBarButton97) then
    begin
      if not (TToolBarButton97(cmpt).DisplayMode = dmGlyphOnly) then
      begin
        WriteCaptionHintData(fIni, clName, clName + '.' + nameComp, cmpt,
          Update);
      end;
    end;

    if (cmpt is TToolBar97) then
    begin
      // tlbu_ are user generated toolbars...
      if pos('tlbu', cmpt.Name) <> 1 then
      begin
        WriteCaptionHintData(fIni, clName, clName + '.' + nameComp, cmpt,
          Update);
      end;
    end;
    // And write other data (particularly 'lines/columns/items).
    WriteLinesData(fIni, clName, clName, cmpt, Update);
  end;
end;

procedure TLanguageHolder.WriteCaptionHintData(fIni : TCustomIniFile;
  Section, Key : string; AComponent : TComponent; Update : Boolean);
begin
  if Update then
  begin
    if fIni.ValueExists(Section, Key + '.Caption') then exit;
    WriteCaptionHintData(fIni, 'NEW', Key + '.Caption', AComponent, False);
  end;
  fIni.writeString(Section,
    Key + '.Caption', PMGetProperty(Acomponent,'Caption'));
  // Does this control actually have a hint? And if not, just don't...
  if PMHasProperty(AComponent,'Hint') and
     (PMGetProperty(AComponent,'Hint') <> '') then
    fIni.writeString(Section, Key + '.Hint',
     PMGetProperty(Acomponent, 'Hint'));
end;


function TLanguageHolder.GetMessages(index :integer) : string;
begin
  result := FMessageList.Strings[index];
end;

procedure TLanguageHolder.SetMessages(index : integer; st : string);
begin
  FMessageList.Strings[index] := st;
end;

procedure TLanguageHolder.WriteLinesData(fIni : TCustomIniFile;
  Section, Key : string; AComponent : TComponent; Update : Boolean);
var x  : integer;
    val, comp : string;
begin
  if Acomponent is TMemo then
  begin
    for x := 0 to TMemo(Acomponent).Lines.Count -1 do
    begin
      val := TMemo(Acomponent).Lines[x];
      if val = AComponent.Name then break;
      comp := AComponent.Name + '.Lines[' + intToStr(x) + ']';
      if Update then
      begin
        if fIni.ValueExists(Section, Key + '.' + comp) then exit;
        fIni.WriteString('NEW', Key + '.' + comp, val);
      end;
      fIni.writeString(Section , Key + '.' + comp, val);
    end;
    exit; // No need to continue...
  end;

  if AComponent is TRadioGroup then
  begin
    for x := 0 to TRadioGroup(Acomponent).Items.Count -1 do
    begin
      val := TRadioGroup(Acomponent).Items[x];
      if val = Acomponent.Name then break;
      comp := AComponent.Name + '.Items[' + intToStr(x) + ']';
      if Update then
      begin
        if fIni.ValueExists(Section, Key + '.' + comp) then exit;
        fIni.WriteString('NEW', Key + '.' + comp, val);
      end;
      fIni.writeString(Section , Key + '.' + comp, val);
    end;
    exit;
  end;

  if AComponent is TCustomComboBox then
  begin
    for x := 0 to TCustomComboBox(Acomponent).Items.Count -1 do
    begin
      val := TCustomComboBox(Acomponent).Items[x];
      if val = Acomponent.Name then break;
      comp := AComponent.Name + '.Items[' + intToStr(x) + ']';
      if Update then
      begin
        if fIni.ValueExists(Section, Key + '.' + comp) then exit;
        fIni.WriteString('NEW', Key + '.' + comp, val);
      end;
      fIni.writeString(Section , Key + '.' + comp, val);
    end;
    exit;
  end;

  if AComponent is TListBox then
  begin
    for x := 0 to TListBox(Acomponent).Items.Count -1 do
    begin
      val := TListBox(Acomponent).Items[x];
      if val = Acomponent.Name then break;
      comp := AComponent.Name + '.Items[' + intToStr(x) + ']';
      if Update then
      begin
        if fIni.ValueExists(Section, Key + '.' + comp) then exit;
        fIni.WriteString('NEW', Key + '.' + comp, val);
      end;
      fIni.writeString(Section , Key + '.' + comp, val);
    end;
    exit;
  end;

  if AComponent is TTreeView then
  begin
    for x := 0 to TTreeView(Acomponent).Items.Count -1 do
    begin
      val := TTreeView(Acomponent).Items[x].Text;
      if val = Acomponent.Name then break;
      comp := AComponent.Name + '.Items[' + intToStr(x) + '].Text';
      if Update then
      begin
        if fIni.ValueExists(Section, Key + '.' + comp) then exit;
        fIni.WriteString('NEW', Key + '.' + comp, val);
      end;
      fIni.writeString(Section , Key + '.' + comp, val);
    end;
    exit;
  end;

  if AComponent is TListView then
  begin
    for x := 0 to TListView(Acomponent).Columns.Count -1 do
    begin
      val := TListView(Acomponent).Column[x].Caption;
      if val = Acomponent.Name then break;
      comp := AComponent.Name + '.Column[' + intToStr(x) + '].Caption';
      if Update then
      begin
        if fIni.ValueExists(Section, Key + '.' + comp) then exit;
        fIni.WriteString('NEW', Key + '.' + comp, val);
      end;
      fIni.writeString(Section , Key + '.' + comp, val);
    end;
    exit;
  end;

  if AComponent is TdfsExtListView then
  begin
    for x := 0 to TdfsExtListView(Acomponent).Columns.Count -1 do
    begin
      val := TdfsExtListView(Acomponent).Column[x].Caption;
      if val = Acomponent.Name then break;
      comp := AComponent.Name + '.Column[' + intToStr(x) + '].Caption';
      if Update then
      begin
        if fIni.ValueExists(Section, Key + '.' + comp) then exit;
        fIni.WriteString('NEW', Key + '.' + comp, val);
      end;
      fIni.writeString(Section , Key + '.' + comp, val);
    end;
    exit;
  end
end;

procedure TLanguageHolder.InstantTranslation(CompArray : array of TComponent;
  aOwner : TComponent = nil);
var f : TMemIniFile;
    x : integer;
    clss : string;
    frm : TFormClass;
    pFrm : TForm;
begin
  f := TMemIniFile.Create('DUMMY');
  try
    for x := 0 to High(CompArray) do
    begin
      // Get the classname...
      clss := CompArray[x].ClassName;
      // Verify the class in the Formlist...
      // AHRK108
      if FFormList.IndexOf(clss) > -1 then
      begin
        frm := TFormClass(FindClass(clss));
        pFrm := frm.Create(aOwner);
        try
          WriteFormData(f, pFrm, False);
        finally
          pFrm.Free;
        end;
        // Do the translation job...
        // AHRK108--
        InternalTranslation(f, CompArray[x]);
      end;
    end;
  finally
    f.Free;
  end;
end;

procedure TLanguageHolder.CreateLanguageFile(aLanguage : string;
   aOwner : TComponent = nil; Update : Boolean = False);
var f : TMemIniFile;
    frm : TFormClass;
    pFrm : TForm;
    i,j   : integer;
    clname   : String;
    s : TStringList;
begin
  f := TMemIniFile.Create(GetappPath + alanguage + '.lng');
  f.WriteString('General', 'Modified', DateTimeToStr(Now));
  if Update then
  begin
    f.EraseSection('NEW');
  end
  else
  begin
    f.WriteString('General', 'Author', sXMailer);
    f.WriteString('General', 'Agent', sXMailer);
    f.WriteString('General', 'Messages', 'Messages_' + aLanguage + '.txt');
    f.WriteString('General', 'Comments', 'Autogenerated contents...');
  end;
  // Refresh the NEW section, because it's going to be updated here...
  for i := 0 to FFormList.Count -1 do
  begin
    if Assigned(fOnStatus) then fOnStatus(Self, i, FFormList.Count - 1);
    clname := FFormList.Strings[i];
    frm := TFormClass(FindClass(clname));
    pFrm := frm.Create(aOwner);
    try
      WriteFormData(f, pFrm, Update);
    finally
      f.UpdateFile;
      pfrm.Free;
    end;
    Application.ProcessMessages;
  end;
  f.Free; // Free the IniFile.
  // Create a new Messagesfile...
  if not FileExists('Messages_' + alanguage + '.txt') then
  begin
    s := TStringList.Create;
    for j := 0 to High(MEssages) do
    begin
      s.Add(Messages[j]);
    end;
    s.SaveToFile('Messages_' + aLanguage + '.txt');
    s.Free;
  end;
end;

destructor TLanguageHolder.Destroy;
begin
  FFormList.Free;
  FMessageList.Free;
  if Assigned(FMemIniFile) then
    FMemIniFile.Free;
  inherited Destroy;
end;

end.
