Update of /cvsroot/lngcompiler/lngcompiler
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14774/lngcompiler
Modified Files:
LngForm.dfm LngForm.pas
Log Message:
New section - NAMES
Index: LngForm.dfm
===================================================================
RCS file: /cvsroot/lngcompiler/lngcompiler/LngForm.dfm,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** LngForm.dfm 25 Feb 2005 17:20:12 -0000 1.11
--- LngForm.dfm 28 Feb 2005 08:24:02 -0000 1.12
***************
*** 1,7 ****
object Form1: TForm1
! Left = 90
! Top = 60
! Width = 705
! Height = 445
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
--- 1,7 ----
object Form1: TForm1
! Left = 143
! Top = 112
! Width = 542
! Height = 392
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
***************
*** 31,37 ****
Left = 0
Top = 0
! Width = 697
! Height = 391
! ActivePage = tsGeneral
Align = alClient
TabOrder = 0
--- 31,37 ----
Left = 0
Top = 0
! Width = 534
! Height = 338
! ActivePage = tsNames
Align = alClient
TabOrder = 0
***************
*** 43,48 ****
Left = 0
Top = 193
! Width = 689
! Height = 167
Align = alClient
Caption = '&Languages:'
--- 43,48 ----
Left = 0
Top = 193
! Width = 526
! Height = 114
Align = alClient
Caption = '&Languages:'
***************
*** 52,57 ****
Left = 2
Top = 18
! Width = 556
! Height = 147
Align = alClient
Columns = <
--- 52,57 ----
Left = 2
Top = 18
! Width = 393
! Height = 94
Align = alClient
Columns = <
***************
*** 77,84 ****
end
object Panel5: TPanel
! Left = 558
Top = 18
Width = 129
! Height = 147
Align = alRight
BevelOuter = bvNone
--- 77,84 ----
end
object Panel5: TPanel
! Left = 395
Top = 18
Width = 129
! Height = 94
Align = alRight
BevelOuter = bvNone
***************
*** 115,119 ****
Left = 0
Top = 0
! Width = 689
Height = 193
Align = alTop
--- 115,119 ----
Left = 0
Top = 0
! Width = 526
Height = 193
Align = alTop
***************
*** 121,125 ****
TabOrder = 1
DesignSize = (
! 689
193)
object Label5: TLabel
--- 121,125 ----
TabOrder = 1
DesignSize = (
! 526
193)
object Label5: TLabel
***************
*** 148,152 ****
end
object bBrowse: TButton
! Left = 580
Top = 27
Width = 96
--- 148,152 ----
end
object bBrowse: TButton
! Left = 417
Top = 27
Width = 96
***************
*** 160,164 ****
Left = 20
Top = 30
! Width = 549
Height = 24
Anchors = [akLeft, akTop, akRight]
--- 160,164 ----
Left = 20
Top = 30
! Width = 386
Height = 24
Anchors = [akLeft, akTop, akRight]
***************
*** 168,172 ****
Left = 20
Top = 89
! Width = 549
Height = 25
Anchors = [akLeft, akTop, akRight]
--- 168,172 ----
Left = 20
Top = 89
! Width = 386
Height = 25
Anchors = [akLeft, akTop, akRight]
***************
*** 177,181 ****
end
object bBrowseMaster: TButton
! Left = 580
Top = 86
Width = 96
--- 177,181 ----
end
object bBrowseMaster: TButton
! Left = 417
Top = 86
Width = 96
***************
*** 187,191 ****
end
object bBrowseLng: TButton
! Left = 580
Top = 145
Width = 96
--- 187,191 ----
end
object bBrowseLng: TButton
! Left = 417
Top = 145
Width = 96
***************
*** 199,203 ****
Left = 20
Top = 148
! Width = 549
Height = 24
Anchors = [akLeft, akTop, akRight]
--- 199,203 ----
Left = 20
Top = 148
! Width = 386
Height = 24
Anchors = [akLeft, akTop, akRight]
***************
*** 211,215 ****
Left = 0
Top = 277
! Width = 689
Height = 4
Cursor = crVSplit
--- 211,215 ----
Left = 0
Top = 277
! Width = 526
Height = 4
Cursor = crVSplit
***************
*** 219,223 ****
Left = 0
Top = 0
! Width = 689
Height = 70
Align = alTop
--- 219,223 ----
Left = 0
Top = 0
! Width = 526
Height = 70
Align = alTop
***************
*** 225,229 ****
TabOrder = 0
DesignSize = (
! 689
70)
object Label1: TLabel
--- 225,229 ----
TabOrder = 0
DesignSize = (
! 526
70)
object Label1: TLabel
***************
*** 244,248 ****
Left = 98
Top = 7
! Width = 576
Height = 24
Style = csDropDownList
--- 244,248 ----
Left = 98
Top = 7
! Width = 413
Height = 24
Style = csDropDownList
***************
*** 255,259 ****
Left = 98
Top = 37
! Width = 576
Height = 24
Anchors = [akLeft, akTop, akRight]
--- 255,259 ----
Left = 98
Top = 37
! Width = 413
Height = 24
Anchors = [akLeft, akTop, akRight]
***************
*** 264,268 ****
Left = 0
Top = 70
! Width = 689
Height = 207
Align = alTop
--- 264,268 ----
Left = 0
Top = 70
! Width = 526
Height = 207
Align = alTop
***************
*** 277,282 ****
Left = 0
Top = 281
! Width = 689
! Height = 79
Align = alClient
TabOrder = 2
--- 277,282 ----
Left = 0
Top = 281
! Width = 526
! Height = 26
Align = alClient
TabOrder = 2
***************
*** 284,293 ****
Left = 297
Top = 32
! Height = 46
end
object pnControlName: TPanel
Left = 1
Top = 1
! Width = 687
Height = 31
Align = alTop
--- 284,293 ----
Left = 297
Top = 32
! Height = 1
end
object pnControlName: TPanel
Left = 1
Top = 1
! Width = 524
Height = 31
Align = alTop
***************
*** 299,303 ****
Top = 32
Width = 296
! Height = 46
Align = alLeft
BevelOuter = bvLowered
--- 299,303 ----
Top = 32
Width = 296
! Height = 1
Align = alLeft
BevelOuter = bvLowered
***************
*** 317,321 ****
Top = 22
Width = 294
! Height = 23
Align = alClient
ReadOnly = True
--- 317,321 ----
Top = 22
Width = 294
! Height = 25
Align = alClient
ReadOnly = True
***************
*** 328,333 ****
Left = 300
Top = 32
! Width = 388
! Height = 46
Align = alClient
BevelOuter = bvLowered
--- 328,333 ----
Left = 300
Top = 32
! Width = 225
! Height = 1
Align = alClient
BevelOuter = bvLowered
***************
*** 336,340 ****
Left = 1
Top = 1
! Width = 386
Height = 21
Align = alTop
--- 336,340 ----
Left = 1
Top = 1
! Width = 223
Height = 21
Align = alTop
***************
*** 346,351 ****
Left = 1
Top = 22
! Width = 386
! Height = 23
Align = alClient
ScrollBars = ssVertical
--- 346,351 ----
Left = 1
Top = 22
! Width = 223
! Height = 25
Align = alClient
ScrollBars = ssVertical
***************
*** 362,366 ****
Left = 0
Top = 198
! Width = 689
Height = 4
Cursor = crVSplit
--- 362,366 ----
Left = 0
Top = 198
! Width = 526
Height = 4
Cursor = crVSplit
***************
*** 370,374 ****
Left = 0
Top = 0
! Width = 689
Height = 198
Align = alTop
--- 370,374 ----
Left = 0
Top = 0
! Width = 526
Height = 198
Align = alTop
***************
*** 388,393 ****
Left = 0
Top = 202
! Width = 689
! Height = 158
Align = alClient
TabOrder = 1
--- 388,393 ----
Left = 0
Top = 202
! Width = 526
! Height = 105
Align = alClient
TabOrder = 1
***************
*** 395,404 ****
Left = 297
Top = 32
! Height = 125
end
object pnStringName: TPanel
Left = 1
Top = 1
! Width = 687
Height = 31
Align = alTop
--- 395,404 ----
Left = 297
Top = 32
! Height = 72
end
object pnStringName: TPanel
Left = 1
Top = 1
! Width = 524
Height = 31
Align = alTop
***************
*** 410,414 ****
Top = 32
Width = 296
! Height = 125
Align = alLeft
BevelOuter = bvLowered
--- 410,414 ----
Top = 32
Width = 296
! Height = 72
Align = alLeft
BevelOuter = bvLowered
***************
*** 428,432 ****
Top = 22
Width = 294
! Height = 102
Align = alClient
ReadOnly = True
--- 428,432 ----
Top = 22
Width = 294
! Height = 49
Align = alClient
ReadOnly = True
***************
*** 439,444 ****
Left = 300
Top = 32
! Width = 388
! Height = 125
Align = alClient
BevelOuter = bvLowered
--- 439,444 ----
Left = 300
Top = 32
! Width = 225
! Height = 72
Align = alClient
BevelOuter = bvLowered
***************
*** 447,451 ****
Left = 1
Top = 1
! Width = 386
Height = 21
Align = alTop
--- 447,451 ----
Left = 1
Top = 1
! Width = 223
Height = 21
Align = alTop
***************
*** 457,462 ****
Left = 1
Top = 22
! Width = 386
! Height = 102
Align = alClient
ScrollBars = ssVertical
--- 457,462 ----
Left = 1
Top = 22
! Width = 223
! Height = 49
Align = alClient
ScrollBars = ssVertical
***************
*** 468,471 ****
--- 468,516 ----
end
end
+ object tsNames: TTabSheet
+ Caption = 'Names'
+ ImageIndex = 3
+ object gNames: TStringGrid
+ Left = 0
+ Top = 0
+ Width = 526
+ Height = 266
+ Align = alClient
+ ColCount = 3
+ FixedCols = 0
+ Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing, goEditing]
+ TabOrder = 0
+ ColWidths = (
+ 140
+ 183
+ 181)
+ end
+ object pnNameButtons: TPanel
+ Left = 0
+ Top = 266
+ Width = 526
+ Height = 41
+ Align = alBottom
+ BevelOuter = bvNone
+ TabOrder = 1
+ OnResize = pnNameButtonsResize
+ object bAddName: TButton
+ Left = 80
+ Top = 8
+ Width = 105
+ Height = 25
+ Caption = '&Add'
+ TabOrder = 0
+ end
+ object bDelName: TButton
+ Left = 296
+ Top = 8
+ Width = 99
+ Height = 25
+ Caption = '&Delete'
+ TabOrder = 1
+ end
+ end
+ end
end
object MainMenu1: TMainMenu
Index: LngForm.pas
===================================================================
RCS file: /cvsroot/lngcompiler/lngcompiler/LngForm.pas,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** LngForm.pas 25 Feb 2005 17:20:13 -0000 1.17
--- LngForm.pas 28 Feb 2005 08:24:02 -0000 1.18
***************
*** 95,98 ****
--- 95,139 ----
end;
+ TStrHashRec = packed record
+ Name: Integer;
+ NameLen: Integer;
+ Value: Integer;
+ ValueLen: Integer;
+ Lng: Integer;
+ LngLen: Integer;
+ end;
+
+ TStrHashArray = Array of TStrHashRec;
+
+ TNamedStrIndex = class
+ protected
+ fItems: TStrHashArray;
+ fCount: Integer;
+ fText: PChar;
+ fTextSize: Integer;
+ fTextTop: Integer;
+ fFreeSize: Integer;
+ function AllocStr(const Str: String): Integer;
+ function GetItem(Idx: String): String;
+ function GetName(Idx: Integer): String;
+ function GetValue(Idx: Integer): String;
+ function GetLng(Idx: Integer): String;
+ procedure SetValue(Idx: Integer; V: String);
+ procedure SetLng(Idx: Integer; V: String);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure Compress;
+ procedure Add(AName, AValue, ALng: String);
+ procedure AddValues(const AText: String);
+ function IndexOfName(AName: String; MustExist: Boolean = True): Integer;
+ property Items[Idx: String]: String read GetItem;
+ property Names[Idx: Integer]: String read GetName; default;
+ property Values[Idx: Integer]: String read GetValue write SetValue;
+ property Lng[Idx: Integer]: String read GetLng write SetLng;
+ property Count: Integer read fCount;
+ end;
+
TLngItem = class
Text: TStringList;
***************
*** 105,108 ****
--- 146,150 ----
TLngForm = class
Items, Strings: TStringList;
+ Names: TNamedStrIndex;
Name: String;
Caption: String;
***************
*** 195,198 ****
--- 237,245 ----
Label6: TLabel;
Savechanges1: TMenuItem;
+ tsNames: TTabSheet;
+ gNames: TStringGrid;
+ pnNameButtons: TPanel;
+ bAddName: TButton;
+ bDelName: TButton;
procedure Exit1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
***************
*** 225,231 ****
--- 272,280 ----
procedure mErrorsClick(Sender: TObject);
procedure Savechanges1Click(Sender: TObject);
+ procedure pnNameButtonsResize(Sender: TObject);
private
procedure Decompile;
function GetLng(aID: Integer): String;
+ procedure WMFillForm(var M: TMessage); message WM_User + 78;
public
DefDC: THandle;
***************
*** 241,244 ****
--- 290,294 ----
fMasterFile: String;
CurLng: TLngFile;
+ CurNames: TNamedStrIndex;
ShadowForm: TList;
procedure FillLanguage;
***************
*** 271,274 ****
--- 321,611 ----
{$R *.DFM}
+ { TNamedStrIndex }
+
+ constructor TNamedStrIndex.Create;
+ begin
+ inherited Create;
+ SetLength(fItems, 16);
+ fCount := 0;
+ fTextSize := 512;
+ GetMem(fText, fTextSize);
+ FillChar(fText[0], fTextSize, 0);
+ fTextTop := 1; // SizeOf(Char)
+ fFreeSize := 0;
+ end;
+
+ destructor TNamedStrIndex.Destroy;
+ begin
+ SetLength(fItems, 0);
+ FreeMem(fText);
+ inherited Destroy;
+ end;
+
+ procedure TNamedStrIndex.Clear;
+ begin
+ FillChar(fItems[0], SizeOf(fItems[0]) * Length(fItems), 0);
+ fCount := 0;
+ FillChar(fText[0], fTextSize, 0);
+ fTextTop := 1; // SizeOf(Char);
+ end;
+
+ procedure TNamedStrIndex.Add(AName, AValue, ALng: String);
+ var
+ I, J, VL, LL: Integer;
+ begin
+ VL := Length(AValue);
+ LL := Length(ALng);
+ I := IndexOfName(AName, True);
+ if I >= 0 then
+ begin
+ with fItems[I] do
+ begin
+ if ValueLen >= VL then
+ begin
+ Inc(fFreeSize, ValueLen - VL);
+ if VL > 0 then Move(AValue[1], fText[Value], VL); // SizeOf(Char)
+ fText[Value+VL] := #0;
+ end else
+ begin
+ Inc(fFreeSize, ValueLen);
+ Value := AllocStr(AValue);
+ end;
+ ValueLen := VL;
+ if LngLen >= LL then
+ begin
+ Inc(fFreeSize, LngLen - LL);
+ if LL > 0 then Move(ALng[1], fText[Lng], LL); // SizeOf(Char)
+ fText[Lng+LL] := #0;
+ end else
+ begin
+ Inc(fFreeSize, LngLen);
+ Lng := AllocStr(ALng);
+ end;
+ LngLen := LL;
+ end;
+ end else
+ begin
+ I := Abs(I) - 1;
+ if Length(fItems) <= fCount then
+ SetLength(fItems, Length(fItems)*2);
+ if I < fCount then
+ Move(fItems[I], fItems[I+1], SizeOf(fItems[0]) * (fCount - I));
+ Inc(fCount);
+ with fItems[I] do
+ begin
+ Name := AllocStr(AName);
+ NameLen := Length(AName);
+ Value := AllocStr(AValue);
+ ValueLen := VL;
+ Lng := AllocStr(ALng);
+ LngLen := LL;
+ end;
+ end;
+ end;
+
+ procedure TNamedStrIndex.AddValues(const AText: String);
+ var
+ I, J, K, L: Integer;
+ S, N, V: String;
+ begin
+ S := AdjustLineBreaks(AText);
+ L := Length(S);
+ I := 1;
+ while I < L do
+ begin
+ J := I;
+ while (J <= L) do
+ case S[J] of
+ '=':
+ begin
+ N := Trim(Copy(S, I, J-I));
+ Inc(J);
+ K := J;
+ while (K <= L) and (S[K] <> #13) do Inc(K);
+ if N <> '' then Add(N, Copy(S, J, K-J), '');
+ J := K+2;
+ Break;
+ end;
+ #13:
+ begin
+ Inc(J, 2);
+ Break;
+ end;
+ else Inc(J);
+ end;
+ I := J;
+ end;
+ end;
+
+ function TNamedStrIndex.AllocStr(const Str: String): Integer;
+ var
+ NewSz, N, L: Integer;
+ begin
+ L := Length(Str);
+ if L = 0 then
+ begin
+ Result := 0;
+ Exit;
+ end;
+ Inc(L);
+ if fFreeSize > fTextSize div 2 then
+ Compress;
+ NewSz := fTextTop + L;
+ if NewSz > fTextSize then
+ begin
+ N := fTextSize * 2;
+ while N < NewSz do N := N * 2;
+ ReallocMem(fText, N);
+ fTextSize := N;
+ end;
+ Result := fTextTop;
+ Move(Str[1], fText[Result], L-1); // SizeOf(Char)
+ Inc(fTextTop, L);
+ fText[fTextTop-1] := #0;
+ end;
+
+ function TNamedStrIndex.IndexOfName(AName: String; MustExist: Boolean = True): Integer;
+ var
+ I, H, L: Integer;
+ LL: Integer;
+ E, OK: Boolean;
+
+ function Cmp(Idx: Integer): Integer;
+ begin
+ Result := StrLIComp(PChar(AName), @fText[fItems[Idx].Name], LL);
+ E := Result = 0;
+ if E then IndexOfName := Idx
+ else if Result < 0 then Result := -1 else Result := 1;
+ end;
+
+ begin
+ LL := Length(AName);
+ Result := 0;
+ E := False;
+ case fCount of
+ 0: ;
+ 1: case Cmp(0) of
+ 0: E := True;
+ 1: Result := 1;
+ end;
+ else
+ begin
+ L := 0;
+ H := fCount-1;
+ OK := True;
+ if Cmp(L) = -1 then OK := False;
+ if E then Exit;
+ if Cmp(H) = 1 then
+ begin
+ OK := False;
+ Result := fCount;
+ end;
+ if OK and not E then
+ begin
+ while (L < Pred(H)) do
+ begin
+ I := (L + H) div 2;
+ case Cmp(I) of
+ 0: Break;
+ -1: H := I;
+ else L := I;
+ end;
+ end;
+ if not E then Result := H;
+ end;
+ end;
+ end;
+ if not E and MustExist then Result := - (Result + 1);
+ end;
+
+ function TNamedStrIndex.GetItem(Idx: String): String;
+ var
+ I: Integer;
+ begin
+ I := IndexOfName(Idx, True);
+ if I >= 0 then SetString(Result, PChar(@fText[fItems[I].Value]), fItems[I].ValueLen) // SizeOf(Char);
+ else Result :='';
+ end;
+
+ procedure TNamedStrIndex.Compress;
+ var
+ I, J, L: Integer;
+ A: TStrHashArray;
+ P: PChar;
+ begin
+ SetLength(A, 0);
+ if fFreeSize <= 0 then Exit;
+ A := fItems;
+ L := 0;
+ for I := 0 to fCount-1 do
+ with fItems[I] do
+ Inc(L, NameLen + ValueLen + LngLen + 3);
+ if L < 512 then L := 512;
+ GetMem(P, L);
+ P[0] := #0;
+ J := 1; // SizeOf(Char)
+ for I := 0 to fCount-1 do
+ with fItems[I] do
+ begin
+ if NameLen > 0 then
+ begin
+ Move(fText[Name], P[J], NameLen+1);
+ A[I].Name := J;
+ Inc(J, NameLen+1);
+ end else A[I].Name := 0;
+ if ValueLen > 0 then
+ begin
+ Move(fText[Value], P[J], ValueLen+1);
+ A[I].Value := J;
+ Inc(J, ValueLen+1);
+ end else A[I].Value := 0;
+ if LngLen > 0 then
+ begin
+ Move(fText[Lng], P[J], LngLen+1);
+ A[I].Lng := J;
+ Inc(J, LngLen+1);
+ end else A[I].Lng := 0;
+ end;
+ FreeMem(fText);
+ fText := P;
+ fTextTop := J;
+ fTextSize := L;
+ fItems := A;
+ fFreeSize := 0;
+ end;
+
+ function TNamedStrIndex.GetName(Idx: Integer): String;
+ begin
+ if (Idx >= 0) and (Idx < Length(fItems)) then SetString(Result, PChar(@fText[fItems[Idx].Name]), fItems[Idx].NameLen) // SizeOf(Char)
+ else Result := '';
+ end;
+
+ function TNamedStrIndex.GetValue(Idx: Integer): String;
+ begin
+ if (Idx >= 0) and (Idx < Length(fItems)) then SetString(Result, PChar(@fText[fItems[Idx].Value]), fItems[Idx].ValueLen) // SizeOf(Char)
+ else Result := '';
+ end;
+
+ procedure TNamedStrIndex.SetValue(Idx: Integer; V: String);
+ begin
+ if (Idx >= 0) and (Idx < Length(fItems)) then
+ Add(Names[Idx], V, Lng[Idx]);
+ end;
+
+ function TNamedStrIndex.GetLng(Idx: Integer): String;
+ begin
+ if (Idx >= 0) and (Idx < Length(fItems)) then SetString(Result, PChar(@fText[fItems[Idx].Lng]), fItems[Idx].LngLen) // SizeOf(Char)
+ else Result := '';
+ end;
+
+ procedure TNamedStrIndex.SetLng(Idx: Integer; V: String);
+ begin
+ if (Idx >= 0) and (Idx < Length(fItems)) then
+ Add(Names[Idx], Values[Idx], V);
+ end;
+
+
+ { utility routines }
+
function CutFileDir(const FName, Dir: String): String;
begin
***************
*** 419,427 ****
B: PChar;
BLen, BSize: Integer;
! SL{, XSL}, IDL: TStringList;
T: TLngToken;
Collecting: Integer;
CollectStart: Integer;
QC: Char;
procedure AnalyzeTokens;
--- 756,789 ----
B: PChar;
BLen, BSize: Integer;
! SL{, XSL}, IDL, MIL: TStringList;
T: TLngToken;
Collecting: Integer;
CollectStart: Integer;
QC: Char;
+ NF: TLngForm;
+
+ function GetNameRec: TLngForm;
+ var
+ I: Integer;
+ F: TLngForm;
+ begin
+ F := nil;
+ for I := 0 to AForms.Count-1 do
+ if (TLngForm(AForms[I]).Name = '') and (TLngForm(AForms[I]).Names <> nil) then
+ begin
+ F := AForms[I];
+ Break;
+ end;
+ if F = nil then
+ begin
+ F := TLngForm.Create;
+ F.Name := '';
+ F.Caption := '';
+ F.Names := TNamedStrIndex.Create;
+ AForms.Add(F);
+ end;
+ Result := F;
+ end;
+
procedure AnalyzeTokens;
***************
*** 429,433 ****
procedure GetForm;
var I: Integer;
! F: TLngForm;
LastT, T: TLngToken;
CT: TLngControlType;
--- 791,795 ----
procedure GetForm;
var I: Integer;
! F, NF: TLngForm;
LastT, T: TLngToken;
CT: TLngControlType;
***************
*** 466,469 ****
--- 828,832 ----
end;
F := TLngForm.Create;
+ NF := GetNameRec;
//L := nil;
if T.ID = tidID then
***************
*** 521,525 ****
if LI.Text.Count = 0 then
// Line numbers should start from "1", not from "0" (hence, "+1")
! Errors.Add(Format('Line %5.5d: Warning: no strings defined for the control "%s"', [LLine+1, LI.Name]));
end;
end;
--- 884,892 ----
if LI.Text.Count = 0 then
// Line numbers should start from "1", not from "0" (hence, "+1")
! Errors.Add(Format('Line %5.5d: Warning: no strings defined for the control "%s"', [LLine+1, LI.Name])) else
! if LI.ControlType = ctMenuItem then
! begin
! NF.Names.Add(LI.Name, LI.Text[0], '');
! end;
end;
end;
***************
*** 638,644 ****
end;
begin
! if Collecting = 1 then GetForm
! else GetStrings;
end;
--- 1005,1080 ----
end;
+ procedure GetNames();
+ var
+ I: Integer;
+ F: TLngForm;
+ LastT, T: TLngToken;
+ LLine, LastLine: Integer;
+ LI: TLngString;
+ CP: String;
+
+ function GetNext: TLngToken;
+ var T: TLngToken;
+ begin
+ Result := nil;
+ while I < Tokens.Count do
+ begin
+ T := Tokens[I];
+ Inc(I);
+ if T.ID <> tidChar then
+ begin
+ Result := T;
+ LastLine := T.Line;
+ LastT := T;
+ Break;
+ end;
+ end;
+ end;
+
+ begin
+ F := GetNameRec;
+ repeat
+ T := GetNext;
+ if T <> nil then
+ begin
+ if T.ID = tidID then
+ begin
+ CP := T.S;
+ if (CP <> '') then
+ begin
+ LLine := LastLine;
+ T := GetNext;
+ if T <> nil then
+ begin
+ if T.ID = tidString then
+ begin
+ if F.Names.IndexOfName(CP, True) >= 0 then
+ begin
+ F.Names.Add(CP, T.S, '');
+ end else
+ // Line numbers should start from "1", not from "0" (hence, "+1")
+ Errors.Add(Format('Line %5.5d: ERROR: duplicate identifier "%s"', [LLine+1, CP]));
+ end else
+ // Line numbers should start from "1", not from "0" (hence, "+1")
+ Errors.Add(Format('Line %5.5d: ERROR: an identifier found when a string expected', [LastLine+1]));
+ end else
+ // Line numbers should start from "1", not from "0" (hence, "+1")
+ Errors.Add(Format('Line %5.5d: ERROR: undefined identifier (no corresponding string detected)', [LastLine+1]));
+ end else
+ // Line numbers should start from "1", not from "0" (hence, "+1")
+ Errors.Add(Format('Line %5.5d: ERROR: empty names are not allowed', [T.Line+1]));
+ end else
+ // Line numbers should start from "1", not from "0" (hence, "+1")
+ Errors.Add(Format('Line %5.5d: ERROR: unexpected string "%s" when identifier expected', [T.Line+1, T.S]));
+ end;
+ until T = nil;
+ end;
+
begin
! case Collecting of
! 1: GetForm;
! 2: GetStrings;
! 3: GetNames;
! end;
end;
***************
*** 669,701 ****
if Collecting > 0 then
begin
! if Collecting = 1 then Msg := 'FORM'
! else Msg := 'STRINGS';
case CT of
! ctForm: begin
! // Line numbers should start from "1", not from "0" (hence, "+1")
! Errors.Add(Format('Line %5.5d: WARNING: the %s is not closed before the FORM definition', [aLine+1, Msg]));
! AnalyzeTokens;
! Collecting := 1;
! CollectStart := aLine;
! end;
! ctStrings: begin
! // Line numbers should start from "1", not from "0" (hence, "+1")
! Errors.Add(Format('Line %5.5d: WARNING: the %s is not closed before the STRINGS definition', [aLine+1, Msg]));
! AnalyzeTokens;
! Collecting := 2;
! CollectStart := aLine;
! end;
! // Line numbers should start from "1", not from "0" (hence, "+1")
! ctEndStrings: if Collecting = 1 then Errors.Add(Format('Line %5.5d: WARNING: the ENDSTRINGS found when ENDFORM expected', [aLine+1]))
! else begin
! AnalyzeTokens;
! Collecting := 0;
! end;
// Line numbers should start from "1", not from "0" (hence, "+1")
! ctEndForm: if Collecting = 2 then Errors.Add(Format('Line %5.5d: WARNING: the ENDFORM found when ENDSTRINGS expected', [aLine+1]))
! else begin
! AnalyzeTokens;
! Collecting := 0;
! end;
else begin
T := nil;
--- 1105,1159 ----
if Collecting > 0 then
begin
! case Collecting of
! 1: Msg := 'FORM';
! 2: Msg := 'STRINGS';
! else Msg := 'NAMES';
! end;
case CT of
! ctForm:
! begin
! // Line numbers should start from "1", not from "0" (hence, "+1")
! Errors.Add(Format('Line %5.5d: WARNING: the %s is not closed before the FORM definition', [aLine+1, Msg]));
! AnalyzeTokens;
! Collecting := 1;
! CollectStart := aLine;
! end;
! ctEndForm:
! if Collecting <> 1 then Errors.Add(Format('Line %5.5d: WARNING: the ENDFORM found without the FORM', [aLine+1]))
! else
! begin
! AnalyzeTokens;
! Collecting := 0;
! end;
! ctStrings:
! begin
! // Line numbers should start from "1", not from "0" (hence, "+1")
! Errors.Add(Format('Line %5.5d: WARNING: the %s is not closed before the STRINGS definition', [aLine+1, Msg]));
! AnalyzeTokens;
! Collecting := 2;
! CollectStart := aLine;
! end;
! ctEndStrings:
! if Collecting <> 2 then Errors.Add(Format('Line %5.5d: WARNING: the ENDSTRINGS found without the STRINGS', [aLine+1]))
! else
! begin
! AnalyzeTokens;
! Collecting := 0;
! end;
! ctNames:
! begin
! Errors.Add(Format('Line %5.5d: WARNING: the %s is not closed before the STRINGS definition', [aLine+1, Msg]));
! AnalyzeTokens;
! Collecting := 3;
! CollectStart := aLine;
! end;
// Line numbers should start from "1", not from "0" (hence, "+1")
! ctEndNames:
! if Collecting <> 3 then Errors.Add(Format('Line %5.5d: WARNING: the ENDNAMES found without the NAMES', [aLine+1]))
! else
! begin
! AnalyzeTokens;
! Collecting := 0;
! end;
else begin
T := nil;
***************
*** 741,744 ****
--- 1199,1208 ----
FreeList(Tokens);
end else
+ if CT = ctNames then
+ begin
+ Collecting := 3;
+ CollectStart := aLine;
+ FreeList(Tokens);
+ end else
begin
case aID of
***************
*** 777,780 ****
--- 1241,1245 ----
Tokens := nil;
B := nil;
+ MIL := nil;
BSize := 0;
Collecting := 0;
***************
*** 805,808 ****
--- 1270,1276 ----
IDL.AddObject('ENDSTRINGS', Pointer(ctEndStrings));
IDL.AddObject('ACTION', Pointer(ctAction));
+ IDL.AddObject('NAMES', Pointer(ctNames));
+ IDL.AddObject('ENDNAMES', Pointer(ctEndNames));
+
//XSL := TStringList.Create;
SL := TStringList.Create;
***************
*** 887,890 ****
--- 1355,1381 ----
SL.Free;
IDL.Free;
+ NF := GetNameRec;
+ if NF <> nil then
+ begin
+ I := AForms.IndexOf(NF);
+ if I >= 0 then
+ begin
+ AForms.Delete(I);
+ AForms.Add(NF);
+ end;
+ end;
+ {
+ if NF <> nil then
+ begin
+ MIL := TStringList.Create;
+ for I := 0 to NF.Names.Count-1 do
+ begin
+ MIL.Add(Format(' %-40s %s', [NF.Names[I], MakeStr(NF.Names.Values[I])]));
+ end;
+ MIL.Sorted := True;
+ MIL.SaveToFile('menus.lnc');
+ MIL.Free;
+ end;
+ }
end;
***************
*** 923,926 ****
--- 1414,1433 ----
F: TLngForm;
LS: TLngString;
+ NF, LNF: TLngForm;
+ S, SS: String;
+
+ function FindNames(L: TList): TLngForm;
+ var
+ I: Integer;
+ begin
+ Result := nil;
+ if L = nil then Exit;
+ for I := 0 to L.Count-1 do
+ begin
+ Result := L[I];
+ if (Result.Name = '') and (Result.Names <> nil) then Exit;
+ end;
+ Result := nil;
+ end;
function WorkStrings(L: TStringList): Boolean;
***************
*** 961,964 ****
--- 1468,1474 ----
cbForm.Sorted := True;
gStrings.RowCount := 2;
+ gNames.RowCount := 2;
+ NF := FindNames(FormList);
+ LNF := FindNames(CurLng);
for I := 0 to FormList.Count-1 do
begin
***************
*** 980,984 ****
gStrings.Rows[J][2] := LS.S;
end;
! end;
end;
if cbForm.Items.Count > 0 then
--- 1490,1495 ----
gStrings.Rows[J][2] := LS.S;
end;
! end else
! if F.Names <> nil then NF := F;
end;
if cbForm.Items.Count > 0 then
***************
*** 992,995 ****
--- 1503,1544 ----
if gStrings.RowCount > 1 then gStrings.Col := 2;
CalcRowHeights(gStrings);
+
+ gNames.DefaultRowHeight := gStrings.DefaultRowHeight;
+ if CurNames = nil then CurNames := TNamedStrIndex.Create
+ else CurNames.Clear;
+
+ gNames.Rows[1][0] := '';
+ gNames.Rows[1][1] := '';
+ gNames.Rows[1][2] := '';
+ if NF <> nil then
+ begin
+ for I := 0 to NF.Names.Count-1 do
+ begin
+ S := NF.Names[I];
+ if LNF <> nil then SS := LNF.Names.Items[S] else SS := '';
+ CurNames.Add(S, NF.Names.Values[I], SS);
+ end;
+ end;
+ if LNF <> nil then
+ begin
+ for I := 0 to LNF.Names.Count-1 do
+ begin
+ S := LNF.Names[I];
+ if NF <> nil then J := NF.Names.IndexOfName(S, True)
+ else J := -1;
+ if J < 0 then CurNames.Add(S, '', LNF.Names.Values[I]);
+ end;
+ end;
+ gNames.RowCount := CurNames.Count+1;
+ for I := 0 to CurNames.Count-1 do
+ begin
+ gNames.Rows[I+1][0] := CurNames[I];
+ gNames.Rows[I+1][1] := CurNames.Values[I];
+ gNames.Rows[I+1][2] := CurNames.Lng[I];
+ end;
+ gNames.Rows[0][0] := 'Name ID';
+ gNames.Rows[0][1] := 'English';
+ gNames.Rows[0][2] := 'National';
+
end;
***************
*** 1116,1120 ****
--- 1665,1675 ----
procedure TForm1.cbFormChange(Sender: TObject);
begin
+ PostMessage(Handle, WM_User+78, 0, 0);
+ end;
+
+ procedure TForm1.WMFillForm(var M: TMessage);
+ begin
FillForm;
+ inherited;
end;
***************
*** 1791,1794 ****
--- 2346,2351 ----
if AllowChange and (L <> CurLng) then
begin
+ UpdateForm;
+ CurForm := nil;
CheckLngChange;
CurLng := L;
***************
*** 1804,1807 ****
--- 2361,2365 ----
tsForms.Font.Assign(F);
tsStrings.Font.Assign(F);
+ tsNames.Font.Assign(F);
finally
F.Free;
***************
*** 1809,1813 ****
FillLanguage;
cbForm.ItemIndex := 0;
! FillForm;
gForm.Col := 2;
gStrings.Col := 2;
--- 2367,2371 ----
FillLanguage;
cbForm.ItemIndex := 0;
! PostMessage(Handle, WM_User + 78, 0, 0);
gForm.Col := 2;
gStrings.Col := 2;
***************
*** 2126,2129 ****
--- 2684,2696 ----
end;
WriteLn('ENDSTRINGS'#13#10);
+ end else
+ if LF.Names <> nil then
+ begin
+ WriteLn('NAMES');
+ for I := 0 to LF.Names.Count-1 do
+ begin
+ WriteLn(Format(' %-40s %s', [LF.Names[I], MakeStr(LF.Names.Values[I])]));
+ end;
+ WriteLn('ENDNAMES'#13#10);
end;
end;
***************
*** 2435,2438 ****
--- 3002,3016 ----
end;
+ procedure TForm1.pnNameButtonsResize(Sender: TObject);
+ var
+ X, Y: Integer;
+ begin
+ X := pnNameButtons.Width div 2;
+ Y := (X - bAddName.Width) div 2;
+ if Y < 0 then Y := 0;
+ bAddName.Left := Y;
+ bDelName.Left := X + Y;
+ end;
+
initialization
WDir := ExtractFilePath(ExpandFileName(ParamStr(0)));
|