|
From: Maxim M. <max...@us...> - 2005-02-28 08:24:14
|
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))); |
