InraPorc

unit reinit;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;

procedure ReinitializeForms;

function LoadNewResourceModule(Locale: LCID): Longint;

implementation

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: Longint): Longint;

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: LCID): Longint;

var

  FileName: array [0..260] of char;

  P: PChar;

  LocaleName: array[0..4] of Char;

  NewInst: Longint;

begin

  GetModuleFileName(HInstance, FileName, SizeOf(FileName));

  GetLocaleInfo(Locale, LOCALE_SABBREVLANGNAME, LocaleName, SizeOf(LocaleName));

  P := PChar(@FileName) + lstrlen(FileName);

  while (P^ <> '.') and (P <> @FileName) do Dec(P);

  NewInst := 0;

  Result := 0;

  if P <> @FileName then

  begin

    Inc(P);

    if LocaleName[0] <> #0 then

    begin

      // Then look for a potential language/country translation

      lstrcpy(P, LocaleName);

      NewInst := LoadLibraryEx(FileName, 0, LOAD_LIBRARY_AS_DATAFILE);

      if NewInst = 0 then

      begin

        // Finally look for a language only translation

        LocaleName[2] := #0;

        lstrcpy(P, LocaleName);

        NewInst := LoadLibraryEx(FileName, 0, LOAD_LIBRARY_AS_DATAFILE);

      end;

    end;

  end;

  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: TTntForm;

begin

  Count := Screen.FormCount;

  for I := 0 to Count - 1 do

  begin

    Form := Screen.Forms[I];

    ReloadInheritedComponent(Form, TForm);

  end;

end;

end.