(* HLINKA-SOFT, (c) March 2000 *)
(* only for Delphi 3 and C++ Builder 3 and later*)
(* Contributor(s):
     Heinisch Jiri <deis@deis.cz>
*)

unit AddTransl;

interface
{$IFDEF VER80}        {Delphi 1.0}
 {$DEFINE BADVER}
{$ENDIF}
{$IFDEF VER90}        {Delphi 2.0}
 {$DEFINE BADVER}
{$ENDIF}
{$IFDEF VER93}        {BCB 1.0}
 {$DEFINE BADVER}
{$ENDIF}

{$IFNDEF VER80}       {Delphi 1.0}
 {$IFNDEF VER90}      {Delphi 2.0}
  {$IFNDEF VER93}     {BCB 1.0}
   {$DEFINE DVER3}    {Delphi 3.0 or BCB 3.0}
   {$UNDEF BADVER}
  {$ENDIF}
 {$ENDIF}
{$ENDIF}

{$IFDEF DVER3}
 {$IFNDEF VER100}     {Delphi 3}
  {$IFNDEF VER110}    {BCB 3}
   {$DEFINE DVER4}    {Delphi 4.0 or higher}
   {$UNDEF DVER3}
  {$ENDIF}
 {$ENDIF}
{$ENDIF}

{$IFDEF DVER4}
 {$IFNDEF VER120}     {Delphi 4}
  {$IFNDEF VER125}    {BCB 4}
   {$DEFINE DVER5}    {Delphi 5.0 or higher}
  {$ENDIF}
 {$ENDIF}
{$ENDIF}

uses
  Windows, SysUtils, Classes, Controls, Forms, Dialogs,
  Menus, Registry;

type
  TLoadInit = procedure of object;
  TAfterEvent = procedure(Sender: TObject) of object;
  TBeforeEvent = procedure(Sender: TObject; var Continue: Boolean) of object;

type
  TAddTransl = class(TComponent)
  private
    FFirstLoad: boolean;
  protected
    FLangMenu: TMenuItem;
    FLoadInit: TLoadInit;
    FOnAfterTrans: TAfterEvent;
    FOnBeforeTrans: TBeforeEvent;
    function BeforeEvent(Sender: TObject): Boolean;
    procedure Loaded; override;
    procedure SetLangMenu(const Value: TMenuItem);
    procedure TranslatesAdd;
  public
    procedure Click(Sender: TObject);
  published
    property LangMenu: TMenuItem read FLangMenu write SetLangMenu;
    property OnAfterTrans: TAfterEvent read FOnAfterTrans write FOnAfterTrans;
    property OnBeforeEventTrans: TBeforeEvent read FOnBeforeTrans write FOnBeforeTrans;
  end;



procedure Register;

implementation

resourcestring
{$IFDEF DVER3}
  RestartProgram = 'Restart this program';
{$ENDIF}
  Dflt = '[default]';

const
  DfltName = 'Dflt';
{$IFDEF BADVER}
  LocaleOverrideKey = '';
{$ENDIF}
{$IFDEF DVER4}
  LocaleOverrideKey = 'Software\Borland\Locales';
{$ELSE}
{$IFDEF DVER3}
  LocaleOverrideKey = 'Software\Borland\Delphi\Locales';
{$ENDIF}
{$ENDIF}
     //see LocaleOverrideKey from System.pas
     //and System.LoadResourceModule

procedure Register;
begin
  RegisterComponents('Localizator', [TAddTransl]);
end;

{$IFDEF DVER4}
type
  TAsInheritedReader = class(TReader)
  public
    procedure ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer); override;
  end;


procedure TAsInheritedReader.ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer);
begin
  inherited ReadPrefix(Flags, AChildPos);
  Include(Flags, ffInherited);
end;

function SetResourceHInstance(NewInstance: LongWord): LongWord;
var
  CurModule: PLibModule;
begin
  CurModule := LibModuleList;
  Result := 0;
  while CurModule <> nil do
  begin
    if CurModule.Instance = HInstance then
    begin
      if CurModule.ResInstance <> CurModule.Instance then
        FreeLibrary(CurModule.ResInstance);
      CurModule.ResInstance := NewInstance;
      Result := NewInstance;
      Exit;
    end;
    CurModule := CurModule.Next;
  end;
end;

function LoadNewResourceModule(Locale: string): LongWord;
var
  NewInst: HModule;
begin
  Result := 0;
  NewInst := LoadLibraryEx(PChar(Locale), 0, LOAD_LIBRARY_AS_DATAFILE);
  if NewInst <> 0 then
    Result := SetResourceHInstance(NewInst);
end;

function InternalReloadComponentRes(const ResName: string; HInst: THandle;
  var Instance: TComponent): Boolean;
var
  HRsrc: THandle;
  ResStream: TResourceStream;
  AsInheritedReader: TAsInheritedReader;
begin                   { avoid possible EResNotFound exception }
  if HInst = 0 then HInst := HInstance;
  HRsrc := FindResource(HInst, PChar(ResName), RT_RCDATA);
  Result := HRsrc <> 0;
  if not Result then Exit;
  ResStream := TResourceStream.Create(HInst, ResName, RT_RCDATA);
  try
    AsInheritedReader := TAsInheritedReader.Create(ResStream, 4096);
    try
      Instance := AsInheritedReader.ReadRootComponent(Instance);
    finally
      AsInheritedReader.Free;
    end;
  finally
    ResStream.Free;
  end;
  Result := True;
end;

function ReloadInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;

  function InitComponent(ClassType: TClass): Boolean;
  begin
    Result := False;
    if (ClassType = TComponent) or (ClassType = RootAncestor) then Exit;
    Result := InitComponent(ClassType.ClassParent);
    Result := InternalReloadComponentRes(ClassType.ClassName, FindResourceHInstance(
      FindClassHInstance(ClassType)), Instance) or Result;
  end;

begin
  Result := InitComponent(Instance.ClassType);
end;

procedure ReinitializeForms;
var
  Count: Integer;
  I: Integer;
  Form: TForm;
  Module: TDataModule;
begin
  Count := Screen.FormCount;
  for I := 0 to Count - 1 do
  begin
    Form := Screen.Forms[I];
    ReloadInheritedComponent(Form, TForm);
  end;
  Count := Screen.DataModuleCount;
  for I := 0 to Count - 1 do
  begin
    Module := Screen.DataModules[I];
    ReloadInheritedComponent(Module, TDataModule);
  end;
end;

{$ENDIF}

function TAddTransl.BeforeEvent(Sender: TObject): Boolean;
begin
  if not (csDesigning in ComponentState) then
  begin
    Result := true;
    if Assigned(FOnBeforeTrans) then
         FOnBeforeTrans(Sender, Result);
  end;
end;

procedure TAddTransl.Click(Sender: TObject);
var
  Reg: TRegIniFile;
  s: string;
begin
  if not BeforeEvent(Sender) then Exit;
  with (Sender as TMenuItem) do
  begin
    s := System.Copy(Name, 1, Length(Name)-1);
    if s = DfltName then
{$IFDEF DVER4}
     s := 'exe';
{$ELSE}
{$IFDEF DVER3}
     s := '';
{$ENDIF}
{$ENDIF}
    Reg := TRegIniFile.Create('');
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.WriteString(LocaleOverrideKey, Application.ExeName, s);
    Reg.Free;
{$IFDEF DVER4}
    if LoadNewResourceModule(ChangeFileExt(Application.ExeName, '.' + s)) <> 0 then
     ReinitializeForms;
{$ELSE}
{$IFDEF DVER3}
    ShowMessage(RestartProgram);
{$ENDIF}
{$ENDIF}
  end;
  if Assigned(FOnAfterTrans) then FOnAfterTrans(Sender);
end;

procedure TAddTransl.Loaded;
begin
  inherited Loaded;
  TranslatesAdd;
end;

procedure TAddTransl.SetLangMenu(const Value: TMenuItem);
begin
  if FLangMenu <> Value then
  begin
    FLangMenu := Value;
  end;
end;

procedure TAddTransl.TranslatesAdd;
var
  i, j, k, Sub: integer;
  c: array[0..255] of char;
  s, s1: string;
  ExeFile: string;
  List: TStringList;
begin
{$IFDEF BADVER}
  Exit;
{$ENDIF}
  if (FLangMenu = nil) or FFirstLoad then Exit;

  ExeFile := Application.ExeName;
  while ExeFile[Length(ExeFile)] <> '.' do
   System.Delete(ExeFile, Length(ExeFile), 1);
  List := TStringList.Create;
  for i := 1 to $7F do
  begin
    Sub := 0;
    j := GetLocaleInfo(i, 3, c, SizeOf(c));
    while j > 0 do
    begin
      if Sub = 0 then c[2] := #0;
      s := c;
      if FileExists(ExeFile+s) and (List.IndexOf(s) = -1) then
      begin
        List.Add(s);
        GetLocaleInfo(i, 2, c, SizeOf(c));
        s1 := c;
        k := Pos('(', s1);
        if k > 0 then System.Delete(s1, k, Length(s1));
        s1 := Trim(s1);
        if Sub > 0 then
        begin
          GetLocaleInfo((Sub shl 10) + i, 6, c, SizeOf(c));
          s1 := s1 + ' (' + c + ')';
        end;
        FLangMenu.Add(NewItem(s1, 0, false, true, Click, 0, s + '1'));
      end;
      Inc(Sub);
      j := GetLocaleInfo((Sub shl 10) + i, 3, c, SizeOf(c));
    end;
  end;
  if List.Count = 0 then FLangMenu.Enabled := false else
   FLangMenu.Insert(0, NewItem(Dflt, 0, false, true, Click, 0, DfltName + '1'));
  List.Free;
  FFirstLoad := true;
end;

end.
