Monday, September 21, 2009

Multi-Language support update

Today I was reviewing the Blog and found out that that Multi-Language unit had a bug, screenshots also :), it's my fault I was in a hurry and didn't double-check the post, so here's the updated unit(small change to TRadioGroup implemention).
unit uDGLanguage;

interface

uses
  SysUtils,
  Classes,
  Forms,
  TypInfo,
  ExtCtrls;

const
  CCaption = 'Caption';

type
  TDGValue = record
    Hash: Integer;
    StringValue: String;
  end;

  TDGValueArray = array of TDGValue;

  TDGLanguage = class
  private
    FValues: TDGValueArray;
  private
    procedure AddEntry(thisEntry: TDGValue);
    procedure ClearArray;
  public
    function GetEntryValue(Hash: Integer; Default: String): String;
  public
    procedure SaveForm(thisForm: TForm);
    procedure LoadForm(thisForm: TForm);
  public
    procedure SaveLanguage(const FileName: String);
    procedure LoadLanguage(const FileName: String);
  public
    destructor Destroy; override;
  end;

implementation

(* Faster UpperCase *)

function TurboUpperCase(const Value: String): String;
var
  I: Integer;
  C: Char;
begin
  Result := Value;
  I := Length(Result);
  while I > 0 do begin
    C := Result[I];
    if c in [#97..#122] then
      Result[I] := Char(Ord(Result[I]) -32);
    Dec(I);
  end;
end;

(* Hash a string *)

function TurboHash(const theValue: string): Integer;
var
  I: Integer;
  Value: string;
begin
  Result := 0;
  Value := TurboUpperCase(theValue);
  for I := 1 to Length(Value) do
    Result := ((Result shl 7) or (Result shr 25)) + Ord(Value[I]);
end;

{ TDGLanguage }

procedure TDGLanguage.AddEntry(thisEntry: TDGValue);
var
  index: Integer;
begin
  (* Check if value exists *)
  for index := Low(FValues) to High(FValues) do
    if FValues[index].Hash = thisEntry.Hash then
      Exit;
  (* Add a new entry *)
  SetLength(FValues, Length(FValues) +1);
  FValues[High(FValues)] := thisEntry;
end;

destructor TDGLanguage.Destroy;
begin
  (* clear allocated memory *)
  ClearArray;
  FValues := nil;
end;

procedure TDGLanguage.LoadForm(thisForm: TForm);
var
  thisComponent: TComponent;
  Value,
  PreHash: String;
  Hash,
  index,
  RadioIndex: integer;
begin
  (* format a string for hash *)
  PreHash := Format('%s.%s', [thisForm.Name, thisForm.Name]);
  (* then hash it *)
  Hash := TurboHash(PreHash);
  (* get string value of the hash *)
  thisForm.Caption := GetEntryValue(Hash, thisForm.Caption);
  (* loop through all form components *)
  for index := 0 to thisForm.ComponentCount -1 do begin
    (* get component reference a.K.a. address *)
    thisComponent := thisForm.Components[Index];
    (* check if thisComponent has Caption property *)
    if IsPublishedProp(thisComponent, CCaption) then begin
      (* if it does then repeat the hash routine *)
      PreHash := Format('%s.%s', [thisForm.Name, thisComponent.Name]);
      Hash := TurboHash(PreHash);
      Value :=  GetPropValue(thisComponent, CCaption);
      (* get default value *)
      Value := GetEntryValue(Hash, Value);
      (* set value of the caption *)
      SetPropValue(thisComponent, CCaption, Value);
      (* check if it's radio group *)
      if thisComponent is TRadioGroup then begin
        for RadioIndex := 0 to TRadioGroup(thisComponent).Items.Count -1 do begin
          (* pre hash the item *)
          PreHash :=
            Format('%s.%s.%s',
              [thisForm.Name,
               thisComponent.Name,
               (* modified *)
               IntToStr(RadioIndex)]);
          (* now hash it *)
          Hash := TurboHash(PreHash);
          (* get default value *)
          Value := TRadioGroup(thisComponent).Items[RadioIndex];
          (* get value from array *)
          Value := GetEntryValue(Hash, Value);
          (* set new value to item *)
          TRadioGroup(thisComponent).Items[RadioIndex] := Value;
        end;
      end;
          (* else if thisComponent is TCustomType then begin ... *)
          (* this technique can be used for other components
          like VirtualTreeView, ListView's column headers, etc. *)
    end;
  end;
end;

procedure TDGLanguage.SaveForm(thisForm: TForm);
var
  thisComponent: TComponent;
  thisValue: TDGValue;
  PreHash: String;
  index,
  RadioIndex: integer;
begin
  PreHash := Format('%s.%s', [thisForm.Name, thisForm.Name]);
  thisValue.Hash := TurboHash(PreHash);
  thisValue.StringValue := thisForm.Caption;
  AddEntry(thisValue);
  for index := 0 to thisForm.ComponentCount -1 do begin
    thisComponent := thisForm.Components[Index];
    if IsPublishedProp(thisComponent, CCaption) then begin
      PreHash := Format('%s.%s', [thisForm.Name, thisComponent.Name]);
      thisValue.Hash := TurboHash(PreHash);
      thisValue.StringValue := GetPropValue(thisComponent, CCaption);
      (* add an entry to FValues array *)
      AddEntry(thisValue);
      if thisComponent is TRadioGroup then begin
        for RadioIndex := 0 to TRadioGroup(thisComponent).Items.Count -1 do begin
          (* pre hash the item *)
          PreHash :=
            Format('%s.%s.%s',
              [thisForm.Name,
               thisComponent.Name,
               (* modified *)
               IntToStr(RadioIndex)]);
          (* now hash it *)
          thisValue.Hash := TurboHash(PreHash);
          (* get default value *)
          thisValue.StringValue := TRadioGroup(thisComponent).Items[RadioIndex];
          (* get value from array *)
          AddEntry(thisValue);
        end;
      end;(* else if thisComponent is TCustomType then begin ... *)
          (* this technique can be used for other components
          like VirtualTreeView, ListView's column headers, etc. *)
    end;
  end;
end;

function TDGLanguage.GetEntryValue(Hash: Integer; Default: String): String;
var
  index: Integer;
begin
  (* check if hash exists in array *)
  for index := Low(FValues) to High(FValues) do
    (* if it does then *)
    if FValues[index].Hash = Hash then
      (* check if value is not Empty *)
      if FValues[index].StringValue <> '' then begin
        (* return the string value *)
        Result := FValues[index].StringValue;
        Exit;
      end;
  (* blah, no value in the array, return the Default parameter *)
  Result := Default;
end;

procedure TDGLanguage.LoadLanguage(const FileName: String);
var
  List: TStringList;
  index: Integer;
  thisValue: TDGValue;
  s: String;
begin
  (* clear array, we insert new values *)
  ClearArray;
  List := TStringList.Create;
  (* load language file to a TStringList *)
  List.LoadFromFile(FileName);
  (* loop through all lines *)
  (* lines saved as HashValue=StringValue *)
  for index := 0 to List.Count -1 do begin
    (* store line at index pos to "s" variable *)
    s := List[index];
    (* get it's hash value *)
    thisValue.Hash := StrToInt(copy(s, 1, Pos('=', s) -1));
    (* get it's string value *)
    thisValue.StringValue := copy(s, Pos('=', s) +1, MaxInt);
    (* add this entry to FValues array *)
    AddEntry(thisValue);
  end;
  (* clear allocated memory *)
  FreeAndNil(List);
end;

procedure TDGLanguage.SaveLanguage(const FileName: String);
var
  List: TStringList;
  index: Integer;
  thisValue: TDGValue;
  StringValue: String;
begin
  List := TStringList.Create;
  (* loop through all FValues entries *)
  for index := Low(FValues) to High(FValues) do begin
    (* store local *)
    thisValue := FValues[index];
    (* store the string representation of the entry *)
    StringValue := Format('%d=%s', [thisValue.Hash, thisValue.StringValue]);
    (* then add it to the string list *)
    List.Add(StringValue);
  end;
  (* save it to file *)
  List.SaveToFile(FileName);
  (* clear allocated memory *)
  FreeAndNil(List);
end;

procedure TDGLanguage.ClearArray;
begin
  SetLength(FValues, 0);
end;

end.

I've also updated screen shots and downloads, however you can download demo application and/or source code from this page as well.
If you have any suggestions or ideas do not hesitate to comment here.

No comments:

Post a Comment

Blogroll(General programming and Delphi feeds)