Changeset 457
- Timestamp:
- Nov 28, 2012, 7:49:20 AM (12 years ago)
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
CoolStreaming/UStreamHelper.pas
r360 r457 6 6 7 7 uses 8 Classes, DateUtils, syncobjs,SysUtils;8 Classes, DateUtils, SysUtils; 9 9 10 10 type … … 22 22 procedure SetEndianness(const AValue: TEndianness); 23 23 procedure SetItem(Index: Integer; const AValue: Byte); 24 procedure SetStream(AValue: TStream); 24 25 public 25 26 procedure Assign(Source: TStreamHelper); … … 62 63 function Write(const Buffer; Count: Longint): Longint; override; 63 64 property Endianness: TEndianness read FEndianness write SetEndianness; 64 property Stream: TStream read FStream write FStream;65 property Stream: TStream read FStream write SetStream; 65 66 property Items[Index: Integer]: Byte read GetItem write SetItem; default; 67 property OwnStream: Boolean read FOwnStream write FOwnStream; 66 68 end; 67 69 … … 74 76 StringLength: Longint; 75 77 begin 78 StringLength := 0; 76 79 FStream.ReadBuffer(StringLength, SizeOf(StringLength)); 77 80 Result := ReadString(StringLength); … … 103 106 function TStreamHelper.ReadByte: Byte; 104 107 begin 108 Result := 0; 105 109 FStream.ReadBuffer(Result, SizeOf(Byte)); 106 110 end; … … 108 112 function TStreamHelper.ReadCardinal: Cardinal; 109 113 begin 114 Result := 0; 110 115 FStream.ReadBuffer(Result, SizeOf(Cardinal)); 111 116 if SwapData then Result := Swap(Result); … … 114 119 function TStreamHelper.ReadInt64: Int64; 115 120 begin 121 Result := 0; 116 122 FStream.ReadBuffer(Result, SizeOf(Int64)); 117 123 if SwapData then Result := Swap(Result); … … 130 136 Count: Byte; 131 137 begin 138 Count := 0; 132 139 FStream.ReadBuffer(Count, 1); 133 140 Result := ReadString(Count); … … 135 142 136 143 procedure TStreamHelper.ReadStream(AStream: TStream; Count: Integer); 137 var 138 Buffer: array of Byte; 139 begin 140 if Count > 0 then begin 144 //var 145 // Buffer: array of Byte; 146 begin 147 AStream.Position := 0; 148 AStream.CopyFrom(Self, Count); 149 (*if Count > 0 then begin 141 150 SetLength(Buffer, Count); 142 151 FStream.ReadBuffer(Buffer[0], Count); … … 144 153 AStream.Position := 0; 145 154 AStream.Write(Buffer[0], Count); 146 end; 155 end;*) 147 156 end; 148 157 … … 259 268 function TStreamHelper.ReadDouble: Double; 260 269 begin 270 Result := 0; 261 271 FStream.ReadBuffer(Result, SizeOf(Double)); 262 272 end; … … 264 274 function TStreamHelper.ReadSingle: Single; 265 275 begin 276 Result := 0; 266 277 FStream.ReadBuffer(Result, SizeOf(Single)); 267 278 end; … … 285 296 function TStreamHelper.ReadWord: Word; 286 297 begin 298 Result := 0; 287 299 FStream.ReadBuffer(Result, SizeOf(Word)); 288 300 if SwapData then Result := Swap(Result); … … 311 323 end; 312 324 325 procedure TStreamHelper.SetStream(AValue: TStream); 326 begin 327 if FStream = AValue then Exit; 328 if FOwnStream and Assigned(FStream) then FStream.Free; 329 FStream := AValue; 330 FOwnStream := False; 331 end; 332 313 333 procedure TStreamHelper.Assign(Source: TStreamHelper); 314 334 var … … 361 381 362 382 procedure TStreamHelper.WriteStream(AStream: TStream; Count: Integer); 363 var 364 Buffer: array of Byte; 365 begin 366 if Count > AStream.Size then Count := AStream.Size; // Limit max. stream size 383 //var 384 // Buffer: array of Byte; 385 begin 386 AStream.Position := 0; 387 CopyFrom(AStream, Count); 388 (*if Count > AStream.Size then Count := AStream.Size; // Limit max. stream size 367 389 AStream.Position := 0; 368 390 if Count > 0 then begin … … 370 392 AStream.Read(Buffer[0], Count); 371 393 FStream.Write(Buffer[0], Count); 372 end; 394 end;*) 373 395 end; 374 396 -
CoolStreaming/UVarBlockSerializer.pas
r405 r457 12 12 uses 13 13 Classes, DateUtils, UStreamHelper, Math, SysUtils, USubStream, 14 Contnrs,SpecializedList, LCLProc;14 SpecializedList, LCLProc; 15 15 16 16 const … … 40 40 procedure WriteVarList(List: TListByte); 41 41 procedure ReadVarList(List: TListByte); 42 procedure WriteVarBuffer(var Buffer; Count: Integer); 43 procedure ReadVarBuffer(var Buffer; Count: Integer); 42 44 function GetVarSize: Integer; 43 45 function GetVarCount: Integer; … … 51 53 procedure WriteVarString(Value: string); 52 54 function ReadVarString: string; 55 procedure WriteVarDouble(Value: Double); 56 function ReadVarDouble: Double; 53 57 54 58 // Misc methods … … 70 74 private 71 75 public 72 Items: T ObjectList; // TObjectList<TVarBlockSerializer>76 Items: TListObject; // TListObject<TVarBlockSerializer> 73 77 Enclose: Boolean; 74 78 procedure CheckItem(Index: Integer); … … 86 90 procedure WriteVarIndexedBlock(Index: Integer; Block: TVarBlockIndexed); 87 91 procedure ReadVarIndexedBlock(Index: Integer; Block: TVarBlockIndexed); 92 procedure WriteVarBuffer(Index: Integer; var Buffer; Count: Integer); 93 procedure ReadVarBuffer(Index: Integer; var Buffer; Count: Integer); 88 94 89 95 // Advanced data types … … 92 98 procedure WriteVarFloat(Index: Integer; Value: Double; Base: Integer = 2); 93 99 function ReadVarFloat(Index: Integer; Base: Integer = 2): Double; 100 procedure WriteVarDouble(Index: Integer; Value: Double); 101 function ReadVarDouble(Index: Integer): Double; 94 102 procedure WriteVarString(Index: Integer; Value: string); 95 103 function ReadVarString(Index: Integer): string; … … 324 332 Block.Free; 325 333 end; 334 end; 335 336 procedure TVarBlockSerializer.WriteVarDouble(Value: Double); 337 begin 338 WriteVarBuffer(Value, 8); 339 end; 340 341 function TVarBlockSerializer.ReadVarDouble: Double; 342 begin 343 Result := 0; 344 ReadVarBuffer(Result, 8); 326 345 end; 327 346 … … 428 447 WriteVarStream(Mem); 429 448 finally 430 Mem.Free 449 Mem.Free; 431 450 end; 432 451 end; … … 439 458 Mem := TMemoryStream.Create; 440 459 ReadVarStream(Mem); 460 Mem.Position := 0; 441 461 List.Count := Mem.Size; 442 462 List.ReplaceStream(Mem); 443 463 finally 444 Mem.Free 464 Mem.Free; 465 end; 466 end; 467 468 procedure TVarBlockSerializer.WriteVarBuffer(var Buffer; Count: Integer); 469 var 470 Mem: TMemoryStream; 471 begin 472 try 473 Mem := TMemoryStream.Create; 474 Mem.WriteBuffer(Buffer, Count); 475 WriteVarStream(Mem); 476 finally 477 Mem.Free; 478 end; 479 end; 480 481 procedure TVarBlockSerializer.ReadVarBuffer(var Buffer; Count: Integer); 482 var 483 Mem: TMemoryStream; 484 begin 485 try 486 Mem := TMemoryStream.Create; 487 ReadVarStream(Mem); 488 Mem.Position := 0; 489 Mem.ReadBuffer(Buffer, Count); 490 finally 491 Mem.Free; 445 492 end; 446 493 end; … … 542 589 I: Integer; 543 590 StreamHelper: TStreamHelper; 544 RequestedSize: Integer;545 591 begin 546 592 try … … 552 598 I := 0; 553 599 while (Stream.Position < Stream.Size) and (I < Index) do begin 554 if TestMask(Mask, I) then Stream.Position := Stream.Position + GetVarSize; 600 if TestMask(Mask, I) then 601 Stream.Position := Stream.Position + GetVarSize; 555 602 Inc(I); 556 603 end; … … 738 785 procedure TVarBlockIndexed.ReadVarList(Index: Integer; List: TListByte); 739 786 begin 787 TVarBlockSerializer(Items[Index]).Stream.Position := 0; 740 788 TVarBlockSerializer(Items[Index]).ReadVarList(List); 741 789 end; … … 771 819 end; 772 820 821 procedure TVarBlockIndexed.WriteVarBuffer(Index: Integer; var Buffer; 822 Count: Integer); 823 begin 824 CheckItem(Index); 825 TVarBlockSerializer(Items[Index]).WriteVarBuffer(Buffer, Count); 826 end; 827 828 procedure TVarBlockIndexed.ReadVarBuffer(Index: Integer; var Buffer; 829 Count: Integer); 830 begin 831 CheckItem(Index); 832 TVarBlockSerializer(Items[Index]).ReadVarBuffer(Buffer, Count); 833 end; 834 773 835 procedure TVarBlockIndexed.WriteVarSInt(Index: Integer; Value:Int64); 774 836 begin … … 793 855 TVarBlockSerializer(Items[Index]).Stream.Position := 0; 794 856 Result := TVarBlockSerializer(Items[Index]).ReadVarFloat(Base); 857 end; 858 859 procedure TVarBlockIndexed.WriteVarDouble(Index: Integer; Value: Double); 860 begin 861 CheckItem(Index); 862 TVarBlockSerializer(Items[Index]).WriteVarDouble(Value); 863 end; 864 865 function TVarBlockIndexed.ReadVarDouble(Index: Integer): Double; 866 begin 867 TVarBlockSerializer(Items[Index]).Stream.Position := 0; 868 Result := TVarBlockSerializer(Items[Index]).ReadVarDouble; 795 869 end; 796 870 … … 892 966 I: Integer; 893 967 StreamHelper: TStreamHelper; 894 begin 895 try 896 StreamHelper := TStreamHelper.Create(VarBlock.Stream); 897 VarBlock.Stream.Size := 0; 968 Temp: TVarBlockSerializer; 969 Output: TVarBlockSerializer; 970 begin 971 try 972 if Enclose then begin 973 Temp := TVarBlockSerializer.Create; 974 Output := Temp; 975 end else begin 976 Temp := nil; 977 Output := VarBlock; 978 end; 979 StreamHelper := TStreamHelper.Create(Output.Stream); 980 981 Output.Stream.Size := 0; 898 982 Mask := 0; 899 983 for I := 0 to Items.Count - 1 do 900 984 if Assigned(Items[I]) then Mask := Mask or (1 shl I); 901 VarBlock.WriteVarUInt(Mask);985 Output.WriteVarUInt(Mask); 902 986 for I := 0 to Items.Count - 1 do 903 if Assigned(Items[I]) then StreamHelper.WriteStream(TVarBlockSerializer(Items[I]).Stream, 987 if Assigned(Items[I]) then 988 StreamHelper.WriteStream(TVarBlockSerializer(Items[I]).Stream, 904 989 TVarBlockSerializer(Items[I]).Stream.Size); 905 if Enclose then VarBlock.BlockEnclose; 906 finally 990 991 if Enclose then VarBlock.WriteVarBlock(Temp); 992 finally 993 if Assigned(Temp) then Temp.Free; 907 994 StreamHelper.Free; 908 995 end; … … 913 1000 Mask: Integer; 914 1001 I: Integer; 915 begin 916 if Enclose then VarBlock.BlockUnclose; 917 VarBlock.Stream.Position := 0; 918 Mask := VarBlock.ReadVarUInt; 1002 Temp: TVarBlockSerializer; 1003 Input: TVarBlockSerializer; 1004 StreamHelper: TStreamHelper; 1005 begin 1006 try 1007 StreamHelper := TStreamHelper.Create; 1008 if Enclose then begin 1009 Temp := TVarBlockSerializer.Create; 1010 Temp.ReadVarBlock(VarBlock); 1011 Input := Temp; 1012 end else begin 1013 Temp := nil; 1014 Input := VarBlock; 1015 end; 1016 StreamHelper.Stream := Input.Stream; 1017 1018 Input.Stream.Position := 0; 1019 Mask := Input.ReadVarUInt; 919 1020 Items.Clear; 920 1021 I := 0; 921 while Mask <> 0 do begin 922 if VarBlock.TestMask(Mask, I) then begin 923 if Items.Count <= I then Items.Count := I + 1; 924 Items[I] := TVarBlockSerializer.Create; 925 VarBlock.ReadItemByMaskIndex(I, TVarBlockSerializer(Items[I])); 1022 while (Mask <> 0) and (Input.Stream.Position < Input.Stream.Size) do begin 1023 if Input.TestMask(Mask, I) then begin 1024 CheckItem(I); 1025 TVarBlockSerializer(Items[I]).Stream.Size := 0; 1026 StreamHelper.ReadStream(TVarBlockSerializer(Items[I]).Stream, Input.GetVarSize); 1027 //Input.ReadItemByMaskIndex(I, TVarBlockSerializer(Items[I])); 926 1028 Mask := Mask xor (1 shl I); // Clear bit on current index 927 1029 end; 928 1030 Inc(I); 1031 end; 1032 finally 1033 if Assigned(Temp) then Temp.Free; 1034 StreamHelper.Free; 929 1035 end; 930 1036 end; … … 988 1094 constructor TVarBlockIndexed.Create; 989 1095 begin 990 Items := T ObjectList.Create;1096 Items := TListObject.Create; 991 1097 Enclose := True; 992 1098 end; … … 994 1100 destructor TVarBlockIndexed.Destroy; 995 1101 begin 996 Items.Free;997 inherited Destroy;1102 FreeAndNil(Items); 1103 inherited; 998 1104 end; 999 1105 -
CoolTranslator/Demo/Languages/TranslatorDemo.cs.po
r286 r457 10 10 "Content-Transfer-Encoding: 8bit\n" 11 11 12 #: TFORM1.FORM1.CAPTION12 #: tform1.form1.caption 13 13 msgctxt "TFORM1.FORM1.CAPTION" 14 14 msgid "Translator Demo" 15 15 msgstr "Ukázka Translatoru" 16 16 17 #: TMAINFORM.BUTTON1.CAPTION17 #: tmainform.button1.caption 18 18 msgid "Show MainForm.Name" 19 19 msgstr "Ukázat MainForm.Name" 20 20 21 #: TMAINFORM.CAPTION21 #: tmainform.caption 22 22 msgctxt "TMAINFORM.CAPTION" 23 23 msgid "Translator Demo" 24 24 msgstr "Ukázka Translatoru" 25 25 26 #: TMAINFORM.LABEL1.CAPTION26 #: tmainform.label1.caption 27 27 msgid "MainForm" 28 28 msgstr "HlavníFormulář" 29 29 30 #: TMAINFORM.LABEL2.CAPTION30 #: tmainform.label2.caption 31 31 msgid "Form name as label caption:" 32 32 msgstr "Jméno formuláře jako titulek textu:" 33 33 34 #: TMAINFORM.LABEL3.CAPTION34 #: tmainform.label3.caption 35 35 msgid "Language list:" 36 36 msgstr "" 37 37 38 #: TMAINFORM.LABEL4.CAPTION38 #: tmainform.label4.caption 39 39 msgid "Excludes:" 40 40 msgstr "" -
CoolTranslator/Demo/Languages/TranslatorDemo.de.po
r286 r457 2 2 msgstr "Content-Type: text/plain; charset=UTF-8" 3 3 4 #: TFORM1.FORM1.CAPTION4 #: tform1.form1.caption 5 5 msgctxt "TFORM1.FORM1.CAPTION" 6 6 msgid "Translator Demo" 7 7 msgstr "" 8 8 9 #: TMAINFORM.BUTTON1.CAPTION9 #: tmainform.button1.caption 10 10 msgid "Show MainForm.Name" 11 11 msgstr "" 12 12 13 #: TMAINFORM.CAPTION13 #: tmainform.caption 14 14 msgctxt "TMAINFORM.CAPTION" 15 15 msgid "Translator Demo" 16 16 msgstr "" 17 17 18 #: TMAINFORM.LABEL1.CAPTION18 #: tmainform.label1.caption 19 19 msgid "MainForm" 20 20 msgstr "" 21 21 22 #: TMAINFORM.LABEL2.CAPTION22 #: tmainform.label2.caption 23 23 msgid "Form name as label caption:" 24 24 msgstr "" 25 25 26 #: TMAINFORM.LABEL3.CAPTION26 #: tmainform.label3.caption 27 27 msgid "Language list:" 28 28 msgstr "" 29 29 30 #: TMAINFORM.LABEL4.CAPTION30 #: tmainform.label4.caption 31 31 msgid "Excludes:" 32 32 msgstr "" -
CoolTranslator/Demo/Languages/TranslatorDemo.po
r286 r457 2 2 msgstr "Content-Type: text/plain; charset=UTF-8" 3 3 4 #: TFORM1.FORM1.CAPTION4 #: tform1.form1.caption 5 5 msgctxt "TFORM1.FORM1.CAPTION" 6 6 msgid "Translator Demo" 7 7 msgstr "" 8 8 9 #: TMAINFORM.BUTTON1.CAPTION9 #: tmainform.button1.caption 10 10 msgid "Show MainForm.Name" 11 11 msgstr "" 12 12 13 #: TMAINFORM.CAPTION13 #: tmainform.caption 14 14 msgctxt "TMAINFORM.CAPTION" 15 15 msgid "Translator Demo" 16 16 msgstr "" 17 17 18 #: TMAINFORM.LABEL1.CAPTION18 #: tmainform.label1.caption 19 19 msgid "MainForm" 20 20 msgstr "" 21 21 22 #: TMAINFORM.LABEL2.CAPTION22 #: tmainform.label2.caption 23 23 msgid "Form name as label caption:" 24 24 msgstr "" 25 25 26 #: TMAINFORM.LABEL3.CAPTION26 #: tmainform.label3.caption 27 27 msgid "Language list:" 28 28 msgstr "" 29 29 30 #: TMAINFORM.LABEL4.CAPTION30 #: tmainform.label4.caption 31 31 msgid "Excludes:" 32 32 msgstr "" -
CoolTranslator/Demo/TranslatorDemo.lpi
r287 r457 51 51 <IsPartOfProject Value="True"/> 52 52 <ComponentName Value="MainForm"/> 53 <HasResources Value="True"/> 53 54 <ResourceBaseClass Value="Form"/> 54 55 <UnitName Value="UMainForm"/> 56 <IsVisibleTab Value="True"/> 55 57 <EditorIndex Value="0"/> 56 58 <WindowIndex Value="0"/> … … 79 81 <Filename Value="..\UCoolTranslator.pas"/> 80 82 <UnitName Value="UCoolTranslator"/> 81 <IsVisibleTab Value="True"/>82 83 <EditorIndex Value="1"/> 83 84 <WindowIndex Value="0"/> 84 85 <TopLine Value="274"/> 85 <CursorPos X=" 1" Y="286"/>86 <CursorPos X="33" Y="288"/> 86 87 <UsageCount Value="11"/> 87 88 <Loaded Value="True"/> … … 265 266 </ProjectOptions> 266 267 <CompilerOptions> 267 <Version Value="1 0"/>268 <Version Value="11"/> 268 269 <PathDelim Value="\"/> 269 270 <Target> … … 275 276 </SearchPaths> 276 277 <Linking> 277 <Debugging>278 <GenerateDebugInfo Value="True"/>279 <DebugInfoType Value="dsAuto"/>280 </Debugging>281 278 <Options> 282 279 <Win32> … … 305 302 </Exceptions> 306 303 </Debugging> 304 <EditorMacros Count="0"/> 307 305 </CONFIG> -
CoolTranslator/Demo/UMainForm.lfm
r286 r457 8 8 ClientWidth = 466 9 9 OnCreate = FormCreate 10 LCLVersion = ' 0.9.31'10 LCLVersion = '1.1' 11 11 object ListBox1: TListBox 12 12 Left = 171 … … 29 29 object Label1: TLabel 30 30 Left = 10 31 Height = 1 431 Height = 13 32 32 Top = 24 33 Width = 4 733 Width = 46 34 34 Caption = 'MainForm' 35 35 ParentColor = False … … 37 37 object Label2: TLabel 38 38 Left = 10 39 Height = 1 439 Height = 13 40 40 Top = 6 41 Width = 13 541 Width = 134 42 42 Caption = 'Form name as label caption:' 43 43 ParentColor = False … … 45 45 object Label3: TLabel 46 46 Left = 171 47 Height = 1 447 Height = 13 48 48 Top = 8 49 Width = 6 849 Width = 67 50 50 Caption = 'Language list:' 51 51 ParentColor = False … … 61 61 object Label4: TLabel 62 62 Left = 321 63 Height = 1 463 Height = 13 64 64 Top = 10 65 Width = 4 765 Width = 46 66 66 Caption = 'Excludes:' 67 67 ParentColor = False … … 69 69 object CoolTranslator1: TCoolTranslator 70 70 POFilesFolder = 'Languages' 71 left = 6472 top = 4071 left = 72 72 top = 72 73 73 end 74 74 end -
CoolTranslator/UCoolTranslator.pas
r402 r457 6 6 7 7 uses 8 Classes, SysUtils, Forms, StdCtrls, ExtCtrls, StrUtils, Controls, Contnrs,8 Classes, SysUtils, Forms, ExtCtrls, Controls, Contnrs, 9 9 Translations, TypInfo, Dialogs, FileUtil, LCLProc, ULanguages, LCLType; 10 10 … … 223 223 var 224 224 PropType: PTypeInfo; 225 Parent: TObject;226 225 Obj: TObject; 227 226 I: Integer; … … 415 414 var 416 415 T: string; 417 I: Integer;418 416 Lang: string; 419 417 begin
Note:
See TracChangeset
for help on using the changeset viewer.