Changeset 34
- Timestamp:
- Nov 25, 2017, 12:27:33 AM (7 years ago)
- Location:
- trunk
- Files:
-
- 9 added
- 1 deleted
- 34 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk
- Property svn:ignore
-
old new 3 3 backup 4 4 tunneler.exe 5 tunneler.dbg 6 tunneler.lps 5 7 heaptrclog.trc 6 tunneler.lps 8 Components/Common/Languages/*.mo 9 Components/CoolTranslator/Demo/lib
-
- Property svn:ignore
-
trunk/Components/Common/Common.lpk
r31 r34 1 <?xml version="1.0" ?>1 <?xml version="1.0" encoding="UTF-8"?> 2 2 <CONFIG> 3 3 <Package Version="4"> 4 4 <PathDelim Value="\"/> 5 5 <Name Value="Common"/> 6 <Type Value="RunAndDesignTime"/> 6 7 <AddToProjectUsesSection Value="True"/> 7 8 <Author Value="Chronos (robie@centrum.cz)"/> … … 12 13 <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 13 14 </SearchPaths> 14 <Other>15 <CompilerMessages>16 <UseMsgFile Value="True"/>17 </CompilerMessages>18 <CompilerPath Value="$(CompPath)"/>19 </Other>20 15 </CompilerOptions> 21 16 <Description Value="Various libraries"/> 22 17 <License Value="GNU/GPL"/> 23 18 <Version Minor="7"/> 24 <Files Count=" 15">19 <Files Count="20"> 25 20 <Item1> 26 21 <Filename Value="StopWatch.pas"/> … … 87 82 <UnitName Value="UApplicationInfo"/> 88 83 </Item15> 84 <Item16> 85 <Filename Value="USyncCounter.pas"/> 86 <UnitName Value="USyncCounter"/> 87 </Item16> 88 <Item17> 89 <Filename Value="UListViewSort.pas"/> 90 <HasRegisterProc Value="True"/> 91 <UnitName Value="UListViewSort"/> 92 </Item17> 93 <Item18> 94 <Filename Value="UPersistentForm.pas"/> 95 <HasRegisterProc Value="True"/> 96 <UnitName Value="UPersistentForm"/> 97 </Item18> 98 <Item19> 99 <Filename Value="UFindFile.pas"/> 100 <HasRegisterProc Value="True"/> 101 <UnitName Value="UFindFile"/> 102 </Item19> 103 <Item20> 104 <Filename Value="UScaleDPI.pas"/> 105 <HasRegisterProc Value="True"/> 106 <UnitName Value="UScaleDPI"/> 107 </Item20> 89 108 </Files> 90 109 <i18n> 91 110 <EnableI18N Value="True"/> 92 111 <OutDir Value="Languages"/> 112 <EnableI18NForLFM Value="True"/> 93 113 </i18n> 94 <Type Value="RunAndDesignTime"/> 95 <RequiredPkgs Count="2"> 114 <RequiredPkgs Count="3"> 96 115 <Item1> 97 <PackageName Value=" TemplateGenerics"/>116 <PackageName Value="LCL"/> 98 117 </Item1> 99 118 <Item2> 119 <PackageName Value="TemplateGenerics"/> 120 </Item2> 121 <Item3> 100 122 <PackageName Value="FCL"/> 101 123 <MinVersion Major="1" Valid="True"/> 102 </Item 2>124 </Item3> 103 125 </RequiredPkgs> 104 126 <UsageOptions> -
trunk/Components/Common/Common.pas
r31 r34 10 10 StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading, 11 11 UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 12 UJobProgressView, UXMLUtils, UApplicationInfo, LazarusPackageIntf; 12 UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 13 UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf; 13 14 14 15 implementation … … 20 21 RegisterUnit('UJobProgressView', @UJobProgressView.Register); 21 22 RegisterUnit('UApplicationInfo', @UApplicationInfo.Register); 23 RegisterUnit('UListViewSort', @UListViewSort.Register); 24 RegisterUnit('UPersistentForm', @UPersistentForm.Register); 25 RegisterUnit('UFindFile', @UFindFile.Register); 26 RegisterUnit('UScaleDPI', @UScaleDPI.Register); 22 27 end; 23 28 -
trunk/Components/Common/Languages/UJobProgressView.po
r31 r34 14 14 msgstr "" 15 15 16 #: ujobprogressview.soperations 17 msgid "Operations" 18 msgstr "" 19 16 20 #: ujobprogressview.spleasewait 17 21 msgid "Please wait..." -
trunk/Components/Common/UApplicationInfo.pas
r31 r34 15 15 private 16 16 FIdentification: Byte; 17 FLicense: string; 17 18 FVersionMajor: Byte; 18 19 FVersionMinor: Byte; … … 47 48 property RegistryKey: string read FRegistryKey write FRegistryKey; 48 49 property RegistryRoot: TRegistryRoot read FRegistryRoot write FRegistryRoot; 50 property License: string read FLicense write FLicense; 49 51 end; 50 52 … … 55 57 procedure Register; 56 58 begin 57 RegisterComponents(' Samples', [TApplicationInfo]);59 RegisterComponents('Common', [TApplicationInfo]); 58 60 end; 59 61 -
trunk/Components/Common/UCommon.pas
r31 r34 6 6 7 7 uses 8 {$IFDEF Windows}Windows,{$ENDIF} 8 {$ifdef Windows}Windows,{$endif} 9 {$ifdef Linux}baseunix,{$endif} 9 10 Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, 10 11 FileUtil; //, ShFolder, ShellAPI; … … 48 49 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 49 50 function SplitString(var Text: string; Count: Word): string; 51 function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer; 50 52 function GetBit(Variable: QWord; Index: Byte): Boolean; 53 procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); overload; 51 54 procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean); overload; 52 55 procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean); overload; … … 62 65 procedure ExecuteProgram(CommandLine: string); 63 66 procedure FreeThenNil(var Obj); 67 function RemoveQuotes(Text: string): string; 68 function ComputerName: string; 69 function OccurenceOfChar(What: Char; Where: string): Integer; 70 function GetDirCount(Dir: string): Integer; 71 function MergeArray(A, B: array of string): TArrayOfString; 72 function LoadFileToStr(const FileName: TFileName): AnsiString; 64 73 65 74 … … 105 114 Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec); 106 115 while Find = 0 do begin 107 DeleteFile UTF8(Path + UTF8Encode(SearchRec.Name));116 DeleteFile(Path + UTF8Encode(SearchRec.Name)); 108 117 109 118 Find := SysUtils.FindNext(SearchRec); … … 284 293 L: LongWord; 285 294 begin 286 287 295 L := MAX_USERNAME_LENGTH + 2; 288 296 SetLength(Result, L); … … 299 307 end; 300 308 end; 301 309 {$endif} 310 311 function ComputerName: string; 312 {$ifdef mswindows} 313 const 314 INFO_BUFFER_SIZE = 32767; 315 var 316 Buffer : array[0..INFO_BUFFER_SIZE] of WideChar; 317 Ret : DWORD; 318 begin 319 Ret := INFO_BUFFER_SIZE; 320 If (GetComputerNameW(@Buffer[0],Ret)) then begin 321 Result := UTF8Encode(WideString(Buffer)); 322 end 323 else begin 324 Result := 'ERROR_NO_COMPUTERNAME_RETURNED'; 325 end; 326 end; 327 {$endif} 328 {$ifdef unix} 329 var 330 Name: UtsName; 331 begin 332 fpuname(Name); 333 Result := Name.Nodename; 334 end; 335 {$endif} 336 337 {$ifdef windows} 302 338 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 303 339 const … … 336 372 end; 337 373 374 function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer; 375 var 376 I: Integer; 377 begin 378 Result := 0; 379 for I := 0 to MaxIndex - 1 do 380 if ((Variable shr I) and 1) = 1 then Inc(Result); 381 end; 382 338 383 function GetBit(Variable:QWord;Index:Byte):Boolean; 339 384 begin … … 341 386 end; 342 387 388 procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); 389 begin 390 Variable := (Variable and ((1 shl Index) xor High(QWord))) or (Int64(State) shl Index); 391 end; 392 343 393 procedure SetBit(var Variable:QWord;Index:Byte;State:Boolean); overload; 344 394 begin 345 Variable := (Variable and ((1 shl Index) xor QWord($ffffffffffffffff))) or (QWord(State) shl Index);395 Variable := (Variable and ((1 shl Index) xor High(QWord))) or (QWord(State) shl Index); 346 396 end; 347 397 348 398 procedure SetBit(var Variable:Cardinal;Index:Byte;State:Boolean); overload; 349 399 begin 350 Variable := (Variable and ((1 shl Index) xor Cardinal($ffffffff))) or (Cardinal(State) shl Index);400 Variable := (Variable and ((1 shl Index) xor High(Cardinal))) or (Cardinal(State) shl Index); 351 401 end; 352 402 353 403 procedure SetBit(var Variable:Word;Index:Byte;State:Boolean); overload; 354 404 begin 355 Variable := (Variable and ((1 shl Index) xor Word($ffff))) or (Word(State) shl Index);405 Variable := (Variable and ((1 shl Index) xor High(Word))) or (Word(State) shl Index); 356 406 end; 357 407 … … 400 450 401 451 procedure OpenWebPage(URL: string); 402 var403 Process: TProcess;404 Browser, Params: string;405 452 begin 406 453 OpenURL(URL); 407 {try 408 Process := TProcess.Create(nil); 409 Browser := ''; 410 //FindDefaultBrowser(Browser, Params); 411 //Process.Executable := Browser; 412 //Process.Parameters.Add(Format(Params, [ApplicationInfo.HomePage]); 413 Process.CommandLine := 'cmd.exe /c start ' + URL; 414 Process.Options := [poNoConsole]; 415 Process.Execute; 454 end; 455 456 procedure OpenFileInShell(FileName: string); 457 begin 458 ExecuteProgram('cmd.exe /c start "' + FileName + '"'); 459 end; 460 461 function RemoveQuotes(Text: string): string; 462 begin 463 Result := Text; 464 if (Pos('"', Text) = 1) and (Text[Length(Text)] = '"') then 465 Result := Copy(Text, 2, Length(Text) - 2); 466 end; 467 468 function OccurenceOfChar(What: Char; Where: string): Integer; 469 var 470 I: Integer; 471 begin 472 Result := 0; 473 for I := 1 to Length(Where) do 474 if Where[I] = What then Inc(Result); 475 end; 476 477 function GetDirCount(Dir: string): Integer; 478 begin 479 Result := OccurenceOfChar(DirectorySeparator, Dir); 480 if Copy(Dir, Length(Dir), 1) = DirectorySeparator then 481 Dec(Result); 482 end; 483 484 function MergeArray(A, B: array of string): TArrayOfString; 485 var 486 I: Integer; 487 begin 488 SetLength(Result, Length(A) + Length(B)); 489 for I := 0 to Length(A) - 1 do 490 Result[I] := A[I]; 491 for I := 0 to Length(B) - 1 do 492 Result[Length(A) + I] := B[I]; 493 end; 494 495 function LoadFileToStr(const FileName: TFileName): AnsiString; 496 var 497 FileStream: TFileStream; 498 Read: Integer; 499 begin 500 Result := ''; 501 FileStream := TFileStream.Create(FileName, fmOpenRead); 502 try 503 if FileStream.Size > 0 then begin 504 SetLength(Result, FileStream.Size); 505 Read := FileStream.Read(Pointer(Result)^, FileStream.Size); 506 SetLength(Result, Read); 507 end; 416 508 finally 417 Process.Free; 418 end;} 419 end; 420 421 procedure OpenFileInShell(FileName: string); 422 begin 423 ExecuteProgram('cmd.exe /c start "' + FileName + '"'); 424 end; 509 FileStream.Free; 510 end; 511 end; 512 513 425 514 426 515 initialization -
trunk/Components/Common/UDebugLog.pas
r31 r34 31 31 Items: TListObject; 32 32 Lock: TCriticalSection; 33 procedure Add( Group: string; Text: string);33 procedure Add(Text: string; Group: string = ''); 34 34 procedure WriteToFile(Text: string); 35 35 constructor Create(AOwner: TComponent); override; … … 52 52 procedure Register; 53 53 begin 54 RegisterComponents(' Samples', [TDebugLog]);54 RegisterComponents('Common', [TDebugLog]); 55 55 end; 56 56 … … 69 69 end; 70 70 71 procedure TDebugLog.Add( Group: string; Text: string);71 procedure TDebugLog.Add(Text: string; Group: string = ''); 72 72 var 73 73 NewItem: TDebugLogItem; … … 103 103 try 104 104 if ExtractFileDir(FileName) <> '' then 105 ForceDirectories UTF8(ExtractFileDir(FileName));106 if FileExists UTF8(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)105 ForceDirectories(ExtractFileDir(FileName)); 106 if FileExists(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite) 107 107 else LogFile := TFileStream.Create(UTF8Decode(FileName), fmCreate); 108 108 LogFile.Seek(0, soFromEnd); -
trunk/Components/Common/UFindFile.pas
r31 r34 55 55 end; 56 56 57 const 58 {$IFDEF WINDOWS} 59 FilterAll = '*.*'; 60 {$ENDIF} 61 {$IFDEF LINUX} 62 FilterAll = '*'; 63 {$ENDIF} 64 57 65 procedure Register; 58 66 … … 64 72 procedure Register; 65 73 begin 66 RegisterComponents(' Samples', [TFindFile]);74 RegisterComponents('Common', [TFindFile]); 67 75 end; 68 76 … … 71 79 inherited Create(AOwner); 72 80 Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir)); 73 FileMask := '*.*';81 FileMask := FilterAll; 74 82 FileAttr := [ffaAnyFile]; 75 83 s := TStringList.Create; … … 127 135 If not InSubFolders then Exit; 128 136 129 if SysUtils.FindFirst(UTF8Decode(inPath + '*.*'), faDirectory, Rec) = 0 then137 if SysUtils.FindFirst(UTF8Decode(inPath + FilterAll), faDirectory, Rec) = 0 then 130 138 try 131 139 repeat -
trunk/Components/Common/UJobProgressView.lfm
r31 r34 14 14 OnDestroy = FormDestroy 15 15 Position = poScreenCenter 16 LCLVersion = '1. 1'16 LCLVersion = '1.6.0.4' 17 17 object PanelOperationsTitle: TPanel 18 18 Left = 0 … … 28 28 object LabelOperation: TLabel 29 29 Left = 8 30 Height = 1 430 Height = 13 31 31 Top = 8 32 Width = 6 732 Width = 66 33 33 Caption = 'Operations:' 34 34 Font.Height = -11 … … 80 80 object LabelEstimatedTimePart: TLabel 81 81 Left = 8 82 Height = 1 482 Height = 13 83 83 Top = -2 84 Width = 7 284 Width = 71 85 85 Caption = 'Estimated time:' 86 86 ParentColor = False … … 132 132 object LabelEstimatedTimeTotal: TLabel 133 133 Left = 8 134 Height = 1 4134 Height = 13 135 135 Top = 0 136 Width = 9 8136 Width = 97 137 137 Caption = 'Total estimated time:' 138 138 ParentColor = False -
trunk/Components/Common/UJobProgressView.lrt
r31 r34 1 T JOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations:2 T JOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time:3 T JOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time:1 TFORMJOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations: 2 TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time: 3 TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time: -
trunk/Components/Common/UJobProgressView.pas
r31 r34 111 111 Finished: Boolean; 112 112 FOnJobFinish: TJobProgressViewMethod; 113 FOnOwnerDraw: TNotifyEvent; 114 FOwnerDraw: Boolean; 113 115 FShowDelay: Integer; 114 116 FTerminate: Boolean; … … 116 118 TotalStartTime: TDateTime; 117 119 Log: TStringList; 118 Form: TFormJobProgressView;119 120 procedure SetTerminate(const AValue: Boolean); 120 121 procedure UpdateProgress; … … 122 123 procedure StartJobs; 123 124 procedure UpdateHeight; 125 procedure JobProgressChange(Sender: TObject); 124 126 public 127 Form: TFormJobProgressView; 125 128 Jobs: TObjectList; // TListObject<TJob> 126 129 CurrentJob: TJob; … … 136 139 property Terminate: Boolean read FTerminate write SetTerminate; 137 140 published 141 property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw; 138 142 property ShowDelay: Integer read FShowDelay write FShowDelay; 139 143 property AutoClose: Boolean read FAutoClose write FAutoClose; 140 144 property OnJobFinish: TJobProgressViewMethod read FOnJobFinish 141 145 write FOnJobFinish; 146 property OnOwnerDraw: TNotifyEvent read FOnOwnerDraw 147 write FOnOwnerDraw; 142 148 end; 143 149 … … 160 166 STotalEstimatedTime = 'Total estimated time: %s'; 161 167 SFinished = 'Finished'; 168 SOperations = 'Operations'; 162 169 163 170 procedure Register; 164 171 begin 165 RegisterComponents(' Samples', [TJobProgressView]);172 RegisterComponents('Common', [TJobProgressView]); 166 173 end; 167 174 … … 196 203 NewJob.Progress.Max := 100; 197 204 NewJob.Progress.Reset; 205 NewJob.Progress.OnChange := JobProgressChange; 198 206 Jobs.Add(NewJob); 199 207 //ReloadJobList; … … 212 220 Terminate := False; 213 221 214 Form.BringToFront;222 if not OwnerDraw then Form.BringToFront; 215 223 216 224 Finished := False; … … 244 252 CurrentJobIndex := I; 245 253 CurrentJob := TJob(Jobs[I]); 254 JobProgressChange(Self); 246 255 StartTime := Now; 247 256 Form.LabelEstimatedTimePart.Caption := Format(SEstimatedTime, ['']); … … 339 348 end; 340 349 350 procedure TJobProgressView.JobProgressChange(Sender: TObject); 351 begin 352 if Assigned(FOnOwnerDraw) then 353 FOnOwnerDraw(Self); 354 end; 355 341 356 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject); 342 357 var … … 357 372 if not Visible then begin 358 373 TimerUpdate.Interval := UpdateInterval; 359 Show;374 if not JobProgressView.OwnerDraw then Show; 360 375 end; 361 376 end; … … 509 524 destructor TJobProgressView.Destroy; 510 525 begin 511 Log.Free;512 Jobs.Free;513 inherited Destroy;526 FreeAndNil(Log); 527 FreeAndNil(Jobs); 528 inherited; 514 529 end; 515 530 … … 519 534 FLock.Acquire; 520 535 FMax := AValue; 536 if FMax < 1 then FMax := 1; 521 537 if FValue >= FMax then FValue := FMax; 522 538 finally … … 610 626 begin 611 627 Progress.Free; 612 inherited Destroy;628 inherited; 613 629 end; 614 630 -
trunk/Components/Common/ULastOpenedList.pas
r31 r34 6 6 7 7 uses 8 Classes, SysUtils, Registry, URegistry, Menus ;8 Classes, SysUtils, Registry, URegistry, Menus, XMLConf; 9 9 10 10 type … … 18 18 procedure SetMaxCount(AValue: Integer); 19 19 procedure LimitMaxCount; 20 procedure ItemsChange(Sender: TObject); 21 procedure DoChange; 20 22 public 21 23 Items: TStringList; … … 25 27 procedure LoadFromRegistry(Context: TRegistryContext); 26 28 procedure SaveToRegistry(Context: TRegistryContext); 29 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string); 30 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string); 27 31 procedure AddItem(FileName: string); 28 32 published … … 38 42 procedure Register; 39 43 begin 40 RegisterComponents(' Samples', [TLastOpenedList]);44 RegisterComponents('Common', [TLastOpenedList]); 41 45 end; 42 46 … … 58 62 end; 59 63 64 procedure TLastOpenedList.ItemsChange(Sender: TObject); 65 begin 66 DoChange; 67 end; 68 69 procedure TLastOpenedList.DoChange; 70 begin 71 if Assigned(FOnChange) then 72 FOnChange(Self); 73 end; 74 60 75 constructor TLastOpenedList.Create(AOwner: TComponent); 61 76 begin 62 77 inherited; 63 78 Items := TStringList.Create; 79 Items.OnChange := ItemsChange; 64 80 MaxCount := 10; 65 81 end; … … 129 145 end; 130 146 147 procedure TLastOpenedList.LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string 148 ); 149 var 150 I: Integer; 151 Value: string; 152 Count: Integer; 153 begin 154 with XMLConfig do begin 155 Count := GetValue(Path + '/Count', 0); 156 if Count > MaxCount then Count := MaxCount; 157 Items.Clear; 158 for I := 0 to Count - 1 do begin 159 Value := GetValue(Path + '/File' + IntToStr(I), ''); 160 if Trim(Value) <> '' then Items.Add(Value); 161 end; 162 if Assigned(FOnChange) then 163 FOnChange(Self); 164 end; 165 end; 166 167 procedure TLastOpenedList.SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string); 168 var 169 I: Integer; 170 begin 171 with XMLConfig do begin 172 SetValue(Path + '/Count', Items.Count); 173 for I := 0 to Items.Count - 1 do 174 SetValue(Path + '/File' + IntToStr(I), Items[I]); 175 Flush; 176 end; 177 end; 178 131 179 procedure TLastOpenedList.AddItem(FileName:string); 132 180 begin … … 134 182 Items.Insert(0, FileName); 135 183 LimitMaxCount; 136 if Assigned(FOnChange) then 137 FOnChange(Self); 184 DoChange; 138 185 end; 139 186 -
trunk/Components/Common/URegistry.pas
r31 r34 17 17 rrKeyDynData = HKEY($80000006)); 18 18 19 { TRegistryContext } 20 19 21 TRegistryContext = record 20 22 RootKey: HKEY; 21 23 Key: string; 24 class operator Equal(A, B: TRegistryContext): Boolean; 22 25 end; 23 26 … … 26 29 TRegistryEx = class(TRegistry) 27 30 private 31 function GetCurrentContext: TRegistryContext; 32 procedure SetCurrentContext(AValue: TRegistryContext); 28 33 public 29 34 function ReadBoolWithDefault(const Name: string; … … 35 40 function DeleteKeyRecursive(const Key: string): Boolean; 36 41 function OpenKey(const Key: string; CanCreate: Boolean): Boolean; 42 property CurrentContext: TRegistryContext read GetCurrentContext write SetCurrentContext; 37 43 end; 38 44 … … 46 52 Result.RootKey := RootKey; 47 53 Result.Key := Key; 54 end; 55 56 { TRegistryContext } 57 58 class operator TRegistryContext.Equal(A, B: TRegistryContext): Boolean; 59 begin 60 Result := (A.Key = B.Key) and (A.RootKey = B.RootKey); 48 61 end; 49 62 … … 106 119 end; 107 120 121 function TRegistryEx.GetCurrentContext: TRegistryContext; 122 begin 123 Result.Key := CurrentPath; 124 Result.RootKey := RootKey; 125 end; 126 127 procedure TRegistryEx.SetCurrentContext(AValue: TRegistryContext); 128 begin 129 RootKey := AValue.RootKey; 130 OpenKey(AValue.Key, True); 131 end; 132 108 133 function TRegistryEx.ReadBoolWithDefault(const Name: string; 109 134 DefaultValue: Boolean): Boolean; -
trunk/Components/Common/UResetableThread.pas
r31 r34 104 104 105 105 procedure TResetableThread.WaitForStart; 106 var107 WaitResult: TWaitResult;106 //var 107 // WaitResult: TWaitResult; 108 108 begin 109 109 //try … … 127 127 128 128 procedure TResetableThread.WaitForStop; 129 var130 WaitState: TWaitResult;129 //var 130 // WaitState: TWaitResult; 131 131 begin 132 132 try -
trunk/Components/Common/UURI.pas
r31 r34 326 326 Drive := Drive + DriveSeparator; 327 327 end else Drive := ''; 328 Directory.AsString := AValue; 328 if (Drive <> '') and (AValue = '') then 329 Directory.AsString := Directory.DirSeparator 330 else Directory.AsString := AValue; 329 331 end; 330 332 -
trunk/Components/Common/UXMLUtils.pas
r31 r34 7 7 uses 8 8 {$IFDEF WINDOWS}Windows,{$ENDIF} 9 Classes, SysUtils, DateUtils ;9 Classes, SysUtils, DateUtils, XMLRead, XMLWrite, DOM; 10 10 11 11 function XMLTimeToDateTime(XMLDateTime: string): TDateTime; 12 12 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString; 13 procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer); 14 procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64); 15 procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean); 16 procedure WriteString(Node: TDOMNode; Name: string; Value: string); 17 procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime); 18 function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer; 19 function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64; 20 function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean; 21 function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string; 22 function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime; 13 23 14 24 … … 66 76 Minute: Integer; 67 77 Second: Integer; 78 SecondFraction: Double; 68 79 Millisecond: Integer; 69 80 begin … … 88 99 if Pos('Z', XMLDateTime) > 0 then 89 100 LeftCutString(XMLDateTime, Part, 'Z'); 90 Millisecond := StrToInt(Part); 101 SecondFraction := StrToFloat('0' + DecimalSeparator + Part); 102 Millisecond := Trunc(SecondFraction * 1000); 91 103 end else begin 92 104 if Pos('+', XMLDateTime) > 0 then … … 123 135 end; 124 136 137 procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer); 138 var 139 NewNode: TDOMNode; 140 begin 141 NewNode := Node.OwnerDocument.CreateElement(Name); 142 NewNode.TextContent := IntToStr(Value); 143 Node.AppendChild(NewNode); 144 end; 145 146 procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64); 147 var 148 NewNode: TDOMNode; 149 begin 150 NewNode := Node.OwnerDocument.CreateElement(Name); 151 NewNode.TextContent := IntToStr(Value); 152 Node.AppendChild(NewNode); 153 end; 154 155 procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean); 156 var 157 NewNode: TDOMNode; 158 begin 159 NewNode := Node.OwnerDocument.CreateElement(Name); 160 NewNode.TextContent := BoolToStr(Value); 161 Node.AppendChild(NewNode); 162 end; 163 164 procedure WriteString(Node: TDOMNode; Name: string; Value: string); 165 var 166 NewNode: TDOMNode; 167 begin 168 NewNode := Node.OwnerDocument.CreateElement(Name); 169 NewNode.TextContent := Value; 170 Node.AppendChild(NewNode); 171 end; 172 173 procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime); 174 var 175 NewNode: TDOMNode; 176 begin 177 NewNode := Node.OwnerDocument.CreateElement(Name); 178 NewNode.TextContent := DateTimeToXMLTime(Value); 179 Node.AppendChild(NewNode); 180 end; 181 182 function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer; 183 var 184 NewNode: TDOMNode; 185 begin 186 Result := DefaultValue; 187 NewNode := Node.FindNode(Name); 188 if Assigned(NewNode) then 189 Result := StrToInt(NewNode.TextContent); 190 end; 191 192 function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64; 193 var 194 NewNode: TDOMNode; 195 begin 196 Result := DefaultValue; 197 NewNode := Node.FindNode(Name); 198 if Assigned(NewNode) then 199 Result := StrToInt64(NewNode.TextContent); 200 end; 201 202 function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean; 203 var 204 NewNode: TDOMNode; 205 begin 206 Result := DefaultValue; 207 NewNode := Node.FindNode(Name); 208 if Assigned(NewNode) then 209 Result := StrToBool(NewNode.TextContent); 210 end; 211 212 function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string; 213 var 214 NewNode: TDOMNode; 215 begin 216 Result := DefaultValue; 217 NewNode := Node.FindNode(Name); 218 if Assigned(NewNode) then 219 Result := NewNode.TextContent; 220 end; 221 222 function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime 223 ): TDateTime; 224 var 225 NewNode: TDOMNode; 226 begin 227 Result := DefaultValue; 228 NewNode := Node.FindNode(Name); 229 if Assigned(NewNode) then 230 Result := XMLTimeToDateTime(NewNode.TextContent); 231 end; 232 125 233 end. 126 234 -
trunk/Components/CoolTranslator/Demo/Languages/TranslatorDemo.cs.po
r30 r34 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 "" -
trunk/Components/CoolTranslator/Demo/Languages/TranslatorDemo.de.po
r30 r34 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 "" -
trunk/Components/CoolTranslator/Demo/Languages/TranslatorDemo.po
r30 r34 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 "" -
trunk/Components/CoolTranslator/Demo/TranslatorDemo.lpi
r30 r34 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> -
trunk/Components/CoolTranslator/Demo/UMainForm.lfm
r30 r34 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 -
trunk/Components/CoolTranslator/UCoolTranslator.pas
r30 r34 6 6 7 7 uses 8 Classes, SysUtils, Forms, StdCtrls, ExtCtrls, StrUtils, Controls, Contnrs,8 Classes, SysUtils, Forms, ExtCtrls, Controls, Contnrs, LazFileUtils, LazUTF8, 9 9 Translations, TypInfo, Dialogs, FileUtil, LCLProc, ULanguages, LCLType; 10 10 … … 46 46 procedure TranslateProperty(Component: TPersistent; PropInfo: PPropInfo); 47 47 function IsExcluded(Component: TPersistent; PropertyName: string): Boolean; 48 function GetLangFileDir: string; 48 49 public 49 50 ComponentExcludes: TComponentExcludesList; … … 150 151 I: Integer; 151 152 LocaleShort: string; 153 SearchMask: string; 152 154 begin 153 155 FPOFiles.Clear; … … 157 159 //ShowMessage(ExtractFileDir(Application.ExeName) + 158 160 // DirectorySeparator + 'Languages' + ' ' + '*.' + LocaleShort + '.po'); 159 FileList := FindAllFiles(ExtractFileDir(UTF8Encode(Application.ExeName)) + 160 DirectorySeparator + FPOFilesFolder, '*.' + LocaleShort + '.po'); 161 SearchMask := '*'; 162 if LocaleShort <> '' then SearchMask := SearchMask + '.' + LocaleShort; 163 SearchMask := SearchMask + '.po'; 164 FileList := FindAllFiles(GetLangFileDir, SearchMask); 161 165 for I := 0 to FileList.Count - 1 do begin 162 166 FileName := FileList[I]; 163 167 //FileName := FindLocaleFileName('.po'); 164 if FileExistsUTF8(FileName) then FPOFiles.Add(TPOFile.Create(FileName)); 168 if FileExists(FileName) and ( 169 ((LocaleShort = '') and (Pos('.', FileName) = Pos('.po', FileName))) or 170 (LocaleShort <> '')) then FPOFiles.Add(TPOFile.Create(FileName)); 165 171 end; 166 172 finally … … 174 180 FPoFilesFolder := AValue; 175 181 ReloadFiles; 182 CheckLanguageFiles; 176 183 end; 177 184 … … 223 230 var 224 231 PropType: PTypeInfo; 225 Parent: TObject;226 232 Obj: TObject; 227 233 I: Integer; … … 285 291 end; 286 292 293 function TCoolTranslator.GetLangFileDir: string; 294 begin 295 Result := FPOFilesFolder; 296 if Copy(Result, 1, 1) <> DirectorySeparator then 297 Result := ExtractFileDir(UTF8Encode(Application.ExeName)) + 298 DirectorySeparator + Result; 299 end; 300 287 301 procedure TCoolTranslator.LanguageListToStrings(Strings: TStrings); 288 302 var … … 317 331 I: Integer; 318 332 begin 333 Result := ''; 319 334 if Text <> '' then begin 320 335 for I := 0 to FPoFiles.Count - 1 do begin … … 343 358 var 344 359 I: Integer; 345 begin 360 LangDir: string; 361 begin 362 LangDir := GetLangFileDir; 346 363 TLanguage(Languages[0]).Available := True; // Automatic 347 364 348 365 for I := 1 to Languages.Count - 1 do 349 366 with TLanguage(Languages[I]) do begin 350 Available := FileExists UTF8(POFilesFolder + DirectorySeparator + ExtractFileNameOnly(Application.ExeName) +367 Available := FileExists(LangDir + DirectorySeparator + ExtractFileNameOnly(Application.ExeName) + 351 368 '.' + Code + ExtensionSeparator + 'po') or (Code = 'en'); 352 369 end; … … 383 400 begin 384 401 // Win32 user may decide to override locale with LANG variable. 385 Lang := GetEnvironmentVariable UTF8('LANG');402 Lang := GetEnvironmentVariable('LANG'); 386 403 387 404 // Use user selected language … … 391 408 if Lang = '' then begin 392 409 for i := 1 to Paramcount - 1 do 393 if (ParamStr UTF8(i) = '--LANG') or (ParamStrUTF8(i) = '-l') or394 (ParamStr UTF8(i) = '--lang') then395 Lang := ParamStr UTF8(i + 1);410 if (ParamStr(i) = '--LANG') or (ParamStr(i) = '-l') or 411 (ParamStr(i) = '--lang') then 412 Lang := ParamStr(i + 1); 396 413 end; 397 414 if Lang = '' then 398 L CLGetLanguageIDs(Lang, T);415 LazGetLanguageIDs(Lang, T); 399 416 400 417 if Assigned(Language) and (Language.Code = '') and Assigned(FOnAutomaticLanguage) then begin … … 402 419 end; 403 420 404 if Lang = 'en' then Lang := ''; // English files are without en code405 406 421 Result := Lang; 407 422 end; … … 415 430 var 416 431 T: string; 417 I: Integer;418 432 Lang: string; 419 433 begin … … 425 439 Exit; 426 440 427 Result := ChangeFileExt(ParamStr UTF8(0), LCExt);441 Result := ChangeFileExt(ParamStr(0), LCExt); 428 442 if FileExistsUTF8(Result) then 429 443 Exit; -
trunk/Components/TemplateGenerics/Generic/GenericMatrix.inc
r29 r34 49 49 function Implode(RowSeparator, ColSeparator: string; Converter: TGMatrixToStringConverter): string; 50 50 procedure Explode(Text, Separator: string; Converter: TGMatrixFromStringConverter; SlicesCount: Integer = -1); 51 function IndexOf(Item: TGMatrixItem; Start: TGMatrixIndex = 0): TGMatrixIndex;52 function IndexOfList(List: TGMatrix; Start: TGMatrixIndex = 0): TGMatrixIndex;51 function IndexOf(Item: TGMatrixItem; Start: TGMatrixIndex): TGMatrixIndex; 52 function IndexOfList(List: TGMatrix; Start: TGMatrixIndex): TGMatrixIndex; 53 53 procedure Insert(Index: TGMatrixIndex; Item: TGMatrixItem); 54 54 procedure InsertList(Index: TGMatrixIndex; List: TGMatrix); -
trunk/Forms/UMainForm.lfm
r31 r34 1 1 object MainForm: TMainForm 2 Left = 4702 Left = 886 3 3 Height = 412 4 Top = 1504 Top = 378 5 5 Width = 514 6 6 Caption = 'Tunneler' 7 ClientHeight = 38 77 ClientHeight = 383 8 8 ClientWidth = 514 9 9 Menu = MainMenu1 … … 15 15 OnKeyUp = FormKeyUp 16 16 OnShow = FormShow 17 LCLVersion = '1. 1'17 LCLVersion = '1.5' 18 18 object StatusBar1: TStatusBar 19 19 Left = 0 20 Height = 2 121 Top = 3 6620 Height = 29 21 Top = 354 22 22 Width = 514 23 23 Panels = < … … 47 47 object Image1: TImage 48 48 Left = 0 49 Height = 3 6649 Height = 354 50 50 Top = 0 51 51 Width = 514 -
trunk/Forms/UMainForm.pas
r33 r34 8 8 Registry, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, 9 9 ComCtrls, Menus, ActnList, UCore, UPlatform, Math, DateUtils, GraphType, 10 UPersistentForm, UApplicationInfo, UCoolTranslator, LCLType ;10 UPersistentForm, UApplicationInfo, UCoolTranslator, LCLType, URegistry; 11 11 12 12 type … … 53 53 procedure TimerDrawTimer(Sender: TObject); 54 54 procedure TimerEngineTickTimer(Sender: TObject); 55 procedure EraseBackground(DC: HDC); override;56 55 private 57 56 OriginalBounds: TRect; … … 64 63 PersistentForm: TPersistentForm; 65 64 Engine: TEngine; 66 end; 65 procedure EraseBackground(DC: HDC); override; 66 end; 67 67 68 68 var … … 89 89 StartTime := NowPrecise; 90 90 //Engine.Draw; 91 DrawDuration := NowPrecise - StartTime;92 91 try 93 92 Engine.Lock.Acquire; … … 95 94 // IntToStr(TPlayer(Engine.Players[0]).Position.Y) + ' ' + 96 95 // IntToStr(TPlayer(Engine.Players[0]).Direction); 97 StatusBar1.Panels[2].Text := FloatToStr(RoundTo( DrawDuration / OneMillisecond, -2));96 StatusBar1.Panels[2].Text := FloatToStr(RoundTo(Engine.DrawDuration / OneMillisecond, -2)); 98 97 StatusBar1.Panels[3].Text := Format(SRound, [IntToStr(Engine.CurrentRound), 99 98 IntToStr(Engine.MaxRound)]); … … 118 117 procedure TMainForm.FormCreate(Sender: TObject); 119 118 begin 120 PersistentForm := TPersistentForm.Create ;121 PersistentForm.Registry Key := ApplicationInfo1.RegistryKey;122 PersistentForm.RegistryRootKey := HKEY(ApplicationInfo1.RegistryRoot);119 PersistentForm := TPersistentForm.Create(nil); 120 PersistentForm.RegistryContext := RegContext(HKEY(ApplicationInfo1.RegistryRoot), 121 ApplicationInfo1.RegistryKey); 123 122 124 123 Application.OnDeactivate := FormDeactivate; … … 130 129 Engine.Active := True; 131 130 Image1Resize(Self); 131 132 Image1.ControlStyle := Image1.ControlStyle + [csOpaque]; 132 133 end; 133 134 … … 172 173 procedure TMainForm.ANewGameExecute(Sender: TObject); 173 174 begin 174 if NewGameForm.ShowModal = mrOk then Engine.NewGame; 175 NewGameForm.LoadData(Engine); 176 if NewGameForm.ShowModal = mrOk then begin 177 NewGameForm.SaveData(Engine); 178 Engine.NewGame; 179 end; 175 180 end; 176 181 … … 212 217 PersistentForm.Load(Self); 213 218 CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode('cs'); 214 DebugForm.Show;215 219 end; 216 220 -
trunk/Forms/UNewGameForm.lfm
r23 r34 1 1 object NewGameForm: TNewGameForm 2 Left = 3123 Height = 3874 Top = 1375 Width = 5602 Left = 579 3 Height = 434 4 Top = 226 5 Width = 677 6 6 Caption = 'New game' 7 ClientHeight = 387 8 ClientWidth = 560 7 ClientHeight = 434 8 ClientWidth = 677 9 OnCreate = FormCreate 10 OnDestroy = FormDestroy 9 11 OnShow = FormShow 10 LCLVersion = ' 0.9.31'12 LCLVersion = '1.8.0.4' 11 13 object ButtonStart: TButton 12 Left = 47614 Left = 592 13 15 Height = 25 14 Top = 35816 Top = 400 15 17 Width = 75 16 18 Anchors = [akRight, akBottom] 17 19 Caption = 'Start' 18 20 ModalResult = 1 19 OnClick = ButtonStartClick20 21 TabOrder = 0 21 22 end 22 23 object ButtonCancel: TButton 23 Left = 38824 Left = 504 24 25 Height = 25 25 Top = 35826 Top = 400 26 27 Width = 75 27 28 Anchors = [akRight, akBottom] … … 32 33 object Label1: TLabel 33 34 Left = 8 34 Height = 1835 Top = 836 Width = 5335 Height = 26 36 Top = 0 37 Width = 66 37 38 Caption = 'Players:' 38 39 ParentColor = False … … 40 41 object ListView1: TListView 41 42 Left = 8 42 Height = 3 2043 Height = 368 43 44 Top = 24 44 45 Width = 368 46 Anchors = [akTop, akLeft, akBottom] 45 47 Checkboxes = True 46 48 Columns = < … … 54 56 item 55 57 Caption = 'Controls' 56 Width = 1 4758 Width = 151 57 59 end> 60 OwnerData = True 58 61 ReadOnly = True 59 62 RowSelect = True … … 61 64 ViewStyle = vsReport 62 65 OnChange = ListView1Change 66 OnData = ListView1Data 67 OnSelectItem = ListView1SelectItem 68 end 69 object ColorButton1: TColorButton 70 Left = 504 71 Height = 25 72 Top = 64 73 Width = 75 74 BorderWidth = 2 75 ButtonColorSize = 16 76 ButtonColor = clBlack 77 OnColorChanged = ColorButton1ColorChanged 78 end 79 object Label2: TLabel 80 Left = 400 81 Height = 26 82 Top = 67 83 Width = 50 84 Caption = 'Color:' 85 ParentColor = False 86 end 87 object GroupBox1: TGroupBox 88 Left = 392 89 Height = 264 90 Top = 104 91 Width = 272 92 Caption = 'Control keys' 93 ClientHeight = 236 94 ClientWidth = 268 95 TabOrder = 3 96 object EditUp: TEdit 97 Left = 86 98 Height = 36 99 Top = 2 100 Width = 80 101 OnChange = EditUpChange 102 OnKeyDown = EditUpKeyDown 103 TabOrder = 0 104 end 105 object Label3: TLabel 106 Left = 6 107 Height = 26 108 Top = 10 109 Width = 29 110 Caption = 'Up:' 111 ParentColor = False 112 end 113 object Label4: TLabel 114 Left = 6 115 Height = 26 116 Top = 42 117 Width = 54 118 Caption = 'Down:' 119 ParentColor = False 120 end 121 object EditDown: TEdit 122 Left = 88 123 Height = 36 124 Top = 32 125 Width = 80 126 OnChange = EditDownChange 127 OnKeyDown = EditDownKeyDown 128 TabOrder = 1 129 end 130 object Label5: TLabel 131 Left = 6 132 Height = 26 133 Top = 74 134 Width = 37 135 Caption = 'Left:' 136 ParentColor = False 137 end 138 object EditLeft: TEdit 139 Left = 86 140 Height = 36 141 Top = 66 142 Width = 80 143 OnChange = EditLeftChange 144 OnKeyDown = EditLeftKeyDown 145 TabOrder = 2 146 end 147 object Label6: TLabel 148 Left = 6 149 Height = 26 150 Top = 106 151 Width = 50 152 Caption = 'Right:' 153 ParentColor = False 154 end 155 object EditRight: TEdit 156 Left = 86 157 Height = 36 158 Top = 98 159 Width = 80 160 OnChange = EditRightChange 161 OnKeyDown = EditRightKeyDown 162 TabOrder = 3 163 end 164 object Label7: TLabel 165 Left = 6 166 Height = 26 167 Top = 138 168 Width = 55 169 Caption = 'Shoot:' 170 ParentColor = False 171 end 172 object EditShoot: TEdit 173 Left = 86 174 Height = 36 175 Top = 130 176 Width = 80 177 OnChange = EditShootChange 178 OnKeyDown = EditShootKeyDown 179 TabOrder = 4 180 end 181 end 182 object EditName: TEdit 183 Left = 480 184 Height = 36 185 Top = 24 186 Width = 176 187 OnChange = EditNameChange 188 OnKeyDown = EditUpKeyDown 189 TabOrder = 4 190 end 191 object Label8: TLabel 192 Left = 400 193 Height = 26 194 Top = 32 195 Width = 56 196 Caption = 'Name:' 197 ParentColor = False 63 198 end 64 199 end -
trunk/Forms/UNewGameForm.lrt
r21 r34 6 6 TNEWGAMEFORM.LISTVIEW1.COLUMNS[1].CAPTION=Color 7 7 TNEWGAMEFORM.LISTVIEW1.COLUMNS[2].CAPTION=Controls 8 TNEWGAMEFORM.LABEL2.CAPTION=Color: 9 TNEWGAMEFORM.GROUPBOX1.CAPTION=Control keys 10 TNEWGAMEFORM.LABEL3.CAPTION=Up: 11 TNEWGAMEFORM.LABEL4.CAPTION=Down: 12 TNEWGAMEFORM.LABEL5.CAPTION=Left: 13 TNEWGAMEFORM.LABEL6.CAPTION=Right: 14 TNEWGAMEFORM.LABEL7.CAPTION=Shoot: 15 TNEWGAMEFORM.LABEL8.CAPTION=Name: -
trunk/Forms/UNewGameForm.pas
r24 r34 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 ComCtrls ;9 ComCtrls, UCore; 10 10 11 11 type … … 16 16 ButtonStart: TButton; 17 17 ButtonCancel: TButton; 18 ColorButton1: TColorButton; 19 EditUp: TEdit; 20 EditDown: TEdit; 21 EditLeft: TEdit; 22 EditRight: TEdit; 23 EditShoot: TEdit; 24 EditName: TEdit; 25 GroupBox1: TGroupBox; 18 26 Label1: TLabel; 27 Label2: TLabel; 28 Label3: TLabel; 29 Label4: TLabel; 30 Label5: TLabel; 31 Label6: TLabel; 32 Label7: TLabel; 33 Label8: TLabel; 19 34 ListView1: TListView; 20 procedure ButtonStartClick(Sender: TObject); 35 procedure ColorButton1ColorChanged(Sender: TObject); 36 procedure EditDownChange(Sender: TObject); 37 procedure EditDownKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState 38 ); 39 procedure EditLeftChange(Sender: TObject); 40 procedure EditLeftKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState 41 ); 42 procedure EditNameChange(Sender: TObject); 43 procedure EditRightChange(Sender: TObject); 44 procedure EditRightKeyDown(Sender: TObject; var Key: Word; 45 Shift: TShiftState); 46 procedure EditShootChange(Sender: TObject); 47 procedure EditShootKeyDown(Sender: TObject; var Key: Word; 48 Shift: TShiftState); 49 procedure EditUpChange(Sender: TObject); 50 procedure EditUpKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 51 procedure FormCreate(Sender: TObject); 52 procedure FormDestroy(Sender: TObject); 21 53 procedure FormShow(Sender: TObject); 22 54 procedure ListView1Change(Sender: TObject; Item: TListItem; 23 55 Change: TItemChange); 56 procedure ListView1Data(Sender: TObject; Item: TListItem); 57 procedure ListView1SelectItem(Sender: TObject; Item: TListItem; 58 Selected: Boolean); 24 59 private 25 { private declarations } 60 Players: TPlayers; 61 procedure ReloadList; 26 62 public 27 { public declarations } 63 procedure LoadData(Engine: TEngine); 64 procedure SaveData(Engine: TEngine); 28 65 end; 29 66 … … 34 71 35 72 uses 36 U Core, UMainForm;73 UMainForm; 37 74 38 75 {$R *.lfm} … … 47 84 end; 48 85 49 procedure TNewGameForm.ButtonStartClick(Sender: TObject); 50 begin 51 86 procedure TNewGameForm.ListView1Data(Sender: TObject; Item: TListItem); 87 begin 88 if Item.Index < Players.Count then 89 with TPlayer(Players[Item.Index]) do begin 90 Item.Caption := Name; 91 Item.SubItems.Add(IntToHex(Color, 6)); 92 Item.SubItems.Add(''); 93 Item.Checked := Enabled; 94 Item.Data := Pointer(Players[Item.Index]); 95 end; 96 end; 97 98 procedure TNewGameForm.ListView1SelectItem(Sender: TObject; Item: TListItem; 99 Selected: Boolean); 100 begin 101 if Assigned(Item) and Selected then 102 with TPlayer(Item.Data) do begin 103 EditName.Text := Name; 104 ColorButton1.ButtonColor := Color; 105 EditDown.Text := IntToStr(Keys.Down); 106 EditUp.Text := IntToStr(Keys.Up); 107 EditLeft.Text := IntToStr(Keys.Left); 108 EditRight.Text := IntToStr(Keys.Right); 109 EditShoot.Text := IntToStr(Keys.Shoot); 110 end; 111 end; 112 113 procedure TNewGameForm.ReloadList; 114 begin 115 ListView1.Items.Count := Players.Count; 116 ListView1.Refresh; 117 end; 118 119 procedure TNewGameForm.LoadData(Engine: TEngine); 120 begin 121 Players.Assign(Engine.PlayerPool); 122 end; 123 124 procedure TNewGameForm.SaveData(Engine: TEngine); 125 begin 126 Engine.PlayerPool.Assign(Players); 127 end; 128 129 procedure TNewGameForm.ColorButton1ColorChanged(Sender: TObject); 130 begin 131 if Assigned(ListView1.Selected) then 132 with TPlayer(ListView1.Selected.Data) do begin 133 Color := ColorButton1.ButtonColor; 134 ReloadList; 135 end; 136 end; 137 138 procedure TNewGameForm.EditDownChange(Sender: TObject); 139 var 140 Value: Integer; 141 begin 142 if Assigned(ListView1.Selected) then 143 with TPlayer(ListView1.Selected.Data) do begin 144 if TryStrToInt(EditDown.Text, Value) then Keys.Down := Value; 145 ReloadList; 146 end; 147 end; 148 149 procedure TNewGameForm.EditDownKeyDown(Sender: TObject; var Key: Word; 150 Shift: TShiftState); 151 begin 152 EditDown.Text := IntToStr(Key); 153 end; 154 155 procedure TNewGameForm.EditLeftChange(Sender: TObject); 156 var 157 Value: Integer; 158 begin 159 if Assigned(ListView1.Selected) then 160 with TPlayer(ListView1.Selected.Data) do begin 161 if TryStrToInt(EditLeft.Text, Value) then Keys.Left := Value; 162 ReloadList; 163 end; 164 end; 165 166 procedure TNewGameForm.EditLeftKeyDown(Sender: TObject; var Key: Word; 167 Shift: TShiftState); 168 begin 169 EditLeft.Text := IntToStr(Key); 170 end; 171 172 procedure TNewGameForm.EditNameChange(Sender: TObject); 173 begin 174 if Assigned(ListView1.Selected) then 175 with TPlayer(ListView1.Selected.Data) do begin 176 Name := EditName.Text; 177 ReloadList; 178 end; 179 end; 180 181 procedure TNewGameForm.EditRightChange(Sender: TObject); 182 var 183 Value: Integer; 184 begin 185 if Assigned(ListView1.Selected) then 186 with TPlayer(ListView1.Selected.Data) do begin 187 if TryStrToInt(EditRight.Text, Value) then Keys.Right := Value; 188 ReloadList; 189 end; 190 end; 191 192 procedure TNewGameForm.EditRightKeyDown(Sender: TObject; var Key: Word; 193 Shift: TShiftState); 194 begin 195 EditRight.Text := IntToStr(Key); 196 end; 197 198 procedure TNewGameForm.EditShootChange(Sender: TObject); 199 var 200 Value: Integer; 201 begin 202 if Assigned(ListView1.Selected) then 203 with TPlayer(ListView1.Selected.Data) do begin 204 if TryStrToInt(EditShoot.Text, Value) then Keys.Shoot := Value; 205 ReloadList; 206 end; 207 end; 208 209 procedure TNewGameForm.EditShootKeyDown(Sender: TObject; var Key: Word; 210 Shift: TShiftState); 211 begin 212 EditShoot.Text := IntToStr(Key); 213 end; 214 215 procedure TNewGameForm.EditUpChange(Sender: TObject); 216 var 217 Value: Integer; 218 begin 219 if Assigned(ListView1.Selected) then 220 with TPlayer(ListView1.Selected.Data) do begin 221 if TryStrToInt(EditUp.Text, Value) then Keys.Up := Value; 222 ReloadList; 223 end; 224 end; 225 226 procedure TNewGameForm.EditUpKeyDown(Sender: TObject; var Key: Word; 227 Shift: TShiftState); 228 begin 229 EditUp.Text := IntToStr(Key); 230 end; 231 232 procedure TNewGameForm.FormCreate(Sender: TObject); 233 begin 234 Players := TPlayers.Create 235 end; 236 237 procedure TNewGameForm.FormDestroy(Sender: TObject); 238 begin 239 FreeAndNil(Players); 52 240 end; 53 241 54 242 procedure TNewGameForm.FormShow(Sender: TObject); 55 var 56 NewItem: TListItem; 57 I: Integer; 58 begin 59 with ListView1 do try 60 BeginUpdate; 61 Clear; 62 for I := 0 to MainForm.Engine.PlayerPool.Count - 1 do 63 with TPlayer(MainForm.Engine.PlayerPool[I]) do begin 64 NewItem := Items.Add; 65 NewItem.Caption := Name; 66 NewItem.SubItems.Add(IntToStr(Color)); 67 NewItem.SubItems.Add(''); 68 NewItem.Checked := Enabled; 69 NewItem.Data := Pointer(Engine.PlayerPool[I]); 70 end; 71 finally 72 EndUpdate; 73 end; 243 begin 244 ReloadList; 74 245 end; 75 246 -
trunk/Languages/tunneler.cs.po
r30 r34 93 93 msgstr "Nová hra" 94 94 95 #: tnewgameform.groupbox1.caption 96 msgid "Control keys" 97 msgstr "" 98 95 99 #: tnewgameform.label1.caption 96 100 msgid "Players:" 97 101 msgstr "HráÄi:" 102 103 #: tnewgameform.label2.caption 104 msgid "Color:" 105 msgstr "" 106 107 #: tnewgameform.label3.caption 108 msgid "Up:" 109 msgstr "" 110 111 #: tnewgameform.label4.caption 112 msgid "Down:" 113 msgstr "" 114 115 #: tnewgameform.label5.caption 116 msgid "Left:" 117 msgstr "" 118 119 #: tnewgameform.label6.caption 120 msgid "Right:" 121 msgstr "" 122 123 #: tnewgameform.label7.caption 124 msgid "Shoot:" 125 msgstr "" 126 127 #: tnewgameform.label8.caption 128 msgid "Name:" 129 msgstr "" 98 130 99 131 #: tnewgameform.listview1.columns[0].caption -
trunk/Languages/tunneler.po
r30 r34 85 85 msgstr "" 86 86 87 #: tnewgameform.groupbox1.caption 88 msgid "Control keys" 89 msgstr "" 90 87 91 #: tnewgameform.label1.caption 88 92 msgid "Players:" 93 msgstr "" 94 95 #: tnewgameform.label2.caption 96 msgid "Color:" 97 msgstr "" 98 99 #: tnewgameform.label3.caption 100 msgid "Up:" 101 msgstr "" 102 103 #: tnewgameform.label4.caption 104 msgid "Down:" 105 msgstr "" 106 107 #: tnewgameform.label5.caption 108 msgid "Left:" 109 msgstr "" 110 111 #: tnewgameform.label6.caption 112 msgid "Right:" 113 msgstr "" 114 115 #: tnewgameform.label7.caption 116 msgid "Shoot:" 117 msgstr "" 118 119 #: tnewgameform.label8.caption 120 msgid "Name:" 89 121 msgstr "" 90 122 -
trunk/UCore.pas
r32 r34 6 6 7 7 uses 8 Dialogs, Classes, SysUtils, Contnrs,Graphics, SpecializedMatrix, SpecializedList,8 Dialogs, Classes, SysUtils, Graphics, SpecializedMatrix, SpecializedList, 9 9 IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType, Math, URectangle, 10 10 Syncobjs, UThreading, Forms, DateUtils, UAudioSystem, UAudioSystemMPlayer; … … 99 99 function DigProc(Item1, Item2: Byte): Byte; 100 100 public 101 Color: TColor; 101 102 Id: Integer; 102 103 Enabled: Boolean; … … 131 132 constructor Create; 132 133 destructor Destroy; override; 134 procedure Assign(Source: TPlayer); 133 135 property Exploded: Boolean read FExploded write SetExploded; 136 end; 137 138 { TPlayers } 139 140 TPlayers = class(TListObject) 141 procedure Assign(Players: TPlayers); 134 142 end; 135 143 … … 207 215 Keyboard: TKeyboard; 208 216 World: TWorld; 209 PlayerPool: T ListObject; // TListObject<TPlayer>210 Players: T ListObject; // TListObject<TPlayer>217 PlayerPool: TPlayers; // TListObject<TPlayer> 218 Players: TPlayers; // TListObject<TPlayer> 211 219 DigMasks: TListObject; // TListObject<TMatrixByte> 212 220 Lock: TCriticalSection; … … 215 223 AudioShot: TMediaPlayer; 216 224 AudioExplode: TMediaPlayer; 225 DrawDuration: TDatetime; 217 226 procedure CheckGameEnd; 218 227 constructor Create; … … 242 251 implementation 243 252 253 uses 254 UPlatform; 255 244 256 resourcestring 245 257 SPlayer = 'Player'; 258 246 259 247 260 … … 252 265 TFastBitmapPixelComponents(Result).R := TFastBitmapPixelComponents(Value).B; 253 266 TFastBitmapPixelComponents(Result).B := TFastBitmapPixelComponents(Value).R; 267 end; 268 269 { TPlayers } 270 271 procedure TPlayers.Assign(Players: TPlayers); 272 var 273 I: Integer; 274 begin 275 while Count < Players.Count do Add(TPlayer.Create); 276 while Count > Players.Count do Delete(Count - 1); 277 for I := 0 to Count - 1 do 278 TPlayer(Items[I]).Assign(TPlayer(Players[I])); 254 279 end; 255 280 … … 708 733 var 709 734 Delta: TPoint; 710 Matter: TMatterIndex;711 735 NewBullet: TBullet; 712 I: Integer;713 Pos: TPoint;714 ColisionState: TColisionState;715 736 begin 716 737 if Exploded then Exit; … … 815 836 P: Integer; 816 837 Pos: TPoint; 817 D: Real;818 838 begin 819 839 // Check energy … … 1181 1201 end; 1182 1202 1203 procedure TPlayer.Assign(Source: TPlayer); 1204 begin 1205 Keys := Source.Keys; 1206 Color := Source.Color; 1207 Energy := Source.Energy; 1208 Shield := Source.Shield; 1209 Name := Source.Name; 1210 Enabled := Source.Enabled; 1211 Position := Source.Position; 1212 Score := Source.Score; 1213 end; 1214 1183 1215 { TEngine } 1184 1216 … … 1230 1262 procedure TEngine.DoDrawToBitmap; 1231 1263 var 1232 I: Integer;1233 1264 X, Y: Integer; 1234 1265 PixelX, PixelY: Integer; … … 1328 1359 NewMask: TMatrixByte; 1329 1360 I: Integer; 1330 X, Y: Integer;1331 1361 begin 1332 1362 DigMasks.Clear; … … 1542 1572 FBitmapLock := TCriticalSection.Create; 1543 1573 IntfImage := TLazIntfImage.Create(1, 1); 1544 PlayerPool := T ListObject.Create;1545 Players := T ListObject.Create;1574 PlayerPool := TPlayers.Create; 1575 Players := TPlayers.Create; 1546 1576 Players.OwnsObjects := False; 1547 1577 Keyboard := TKeyboard.Create; 1548 1578 World := TWorld.Create; 1549 1579 World.Engine := Self; 1550 DefaultAudioSystem := TAudioSystemMPlayer.Create(nil);1580 //DefaultAudioSystem := TAudioSystemMPlayer.Create(nil); 1551 1581 AudioShot := TMediaPlayer.Create(nil); 1552 1582 AudioShot.FileName := 'Audio/GE_KF7_Soviet.wav'; … … 1597 1627 var 1598 1628 I: Integer; 1599 begin 1600 if FRedrawPending then 1601 begin 1629 DrawStart: TDateTime; 1630 begin 1631 if FRedrawPending then begin 1632 DrawStart := NowPrecise; 1602 1633 FRedrawPending := False; 1603 1634 try … … 1611 1642 end; 1612 1643 if not Thread.Terminated then Thread.Synchronize(DoDrawToBitmap); 1644 DrawDuration := NowPrecise - DrawStart; 1613 1645 end; 1614 1646 end; … … 1617 1649 var 1618 1650 I: Integer; 1619 I2: Integer;1620 1651 begin 1621 1652 Active := False; -
trunk/tunneler.lpi
r32 r34 1 <?xml version="1.0" ?>1 <?xml version="1.0" encoding="UTF-8"?> 2 2 <CONFIG> 3 3 <ProjectOptions> 4 <Version Value=" 9"/>4 <Version Value="10"/> 5 5 <General> 6 6 <SessionStorage Value="InProjectDir"/> … … 14 14 <OutDir Value="Languages"/> 15 15 </i18n> 16 <VersionInfo>17 <StringTable ProductVersion=""/>18 </VersionInfo>19 16 <BuildModes Count="2"> 20 17 <Item1 Name="Debug" Default="True"/> … … 65 62 <Other> 66 63 <CompilerMessages> 67 < UseMsgFile Value="True"/>64 <IgnoredMessages idx5024="True"/> 68 65 </CompilerMessages> 69 <CompilerPath Value="$(CompPath)"/>70 66 </Other> 71 67 </CompilerOptions> … … 80 76 <local> 81 77 <FormatVersion Value="1"/> 82 <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>83 78 </local> 84 79 </RunParams> … … 104 99 </Item5> 105 100 </RequiredPackages> 106 <Units Count=" 10">101 <Units Count="9"> 107 102 <Unit0> 108 103 <Filename Value="tunneler.lpr"/> 109 104 <IsPartOfProject Value="True"/> 110 <UnitName Value="tunneler"/>111 105 </Unit0> 112 106 <Unit1> 113 107 <Filename Value="UCore.pas"/> 114 108 <IsPartOfProject Value="True"/> 115 <UnitName Value="UCore"/>116 109 </Unit1> 117 110 <Unit2> 118 111 <Filename Value="UPlatform.pas"/> 119 112 <IsPartOfProject Value="True"/> 120 <UnitName Value="UPlatform"/>121 113 </Unit2> 122 114 <Unit3> 123 115 <Filename Value="Common/URectangle.pas"/> 124 116 <IsPartOfProject Value="True"/> 125 <UnitName Value="URectangle"/>126 117 </Unit3> 127 118 <Unit4> 128 <Filename Value="Common/UPersistentForm.pas"/> 129 <IsPartOfProject Value="True"/> 130 <UnitName Value="UPersistentForm"/> 119 <Filename Value="Forms/UNewGameForm.pas"/> 120 <IsPartOfProject Value="True"/> 121 <ComponentName Value="NewGameForm"/> 122 <HasResources Value="True"/> 123 <ResourceBaseClass Value="Form"/> 131 124 </Unit4> 132 125 <Unit5> 133 <Filename Value="Forms/U NewGameForm.pas"/>134 <IsPartOfProject Value="True"/> 135 <ComponentName Value=" NewGameForm"/>126 <Filename Value="Forms/UMainForm.pas"/> 127 <IsPartOfProject Value="True"/> 128 <ComponentName Value="MainForm"/> 136 129 <HasResources Value="True"/> 137 130 <ResourceBaseClass Value="Form"/> 138 <UnitName Value="UNewGameForm"/>139 131 </Unit5> 140 132 <Unit6> 141 <Filename Value="Forms/UMa inForm.pas"/>142 <IsPartOfProject Value="True"/> 143 <ComponentName Value="Ma inForm"/>133 <Filename Value="Forms/UMapForm.pas"/> 134 <IsPartOfProject Value="True"/> 135 <ComponentName Value="MapForm"/> 144 136 <HasResources Value="True"/> 145 137 <ResourceBaseClass Value="Form"/> 146 <UnitName Value="UMainForm"/>147 138 </Unit6> 148 139 <Unit7> 149 <Filename Value="Forms/UMapForm.pas"/> 150 <IsPartOfProject Value="True"/> 151 <ComponentName Value="MapForm"/> 152 <HasResources Value="True"/> 153 <ResourceBaseClass Value="Form"/> 154 <UnitName Value="UMapForm"/> 140 <Filename Value="Forms/UDebugForm.pas"/> 141 <IsPartOfProject Value="True"/> 142 <ComponentName Value="DebugForm"/> 143 <ResourceBaseClass Value="Form"/> 155 144 </Unit7> 156 145 <Unit8> 157 <Filename Value="Forms/UDebugForm.pas"/> 158 <IsPartOfProject Value="True"/> 159 <ComponentName Value="DebugForm"/> 160 <ResourceBaseClass Value="Form"/> 161 <UnitName Value="UDebugForm"/> 146 <Filename Value="Forms/UGameResultForm.pas"/> 147 <IsPartOfProject Value="True"/> 148 <ComponentName Value="GameResultForm"/> 149 <ResourceBaseClass Value="Form"/> 162 150 </Unit8> 163 <Unit9>164 <Filename Value="Forms/UGameResultForm.pas"/>165 <IsPartOfProject Value="True"/>166 <ComponentName Value="GameResultForm"/>167 <ResourceBaseClass Value="Form"/>168 <UnitName Value="UGameResultForm"/>169 </Unit9>170 151 </Units> 171 152 </ProjectOptions> … … 184 165 <SyntaxMode Value="Delphi"/> 185 166 <CStyleOperator Value="False"/> 167 <IncludeAssertionCode Value="True"/> 186 168 <AllowLabel Value="False"/> 187 169 <CPPInline Value="False"/> … … 200 182 <Debugging> 201 183 <UseHeaptrc Value="True"/> 184 <UseExternalDbgSyms Value="True"/> 202 185 </Debugging> 203 186 <Options> … … 209 192 <Other> 210 193 <CompilerMessages> 211 < UseMsgFile Value="True"/>194 <IgnoredMessages idx5024="True"/> 212 195 </CompilerMessages> 213 196 <CustomOptions Value="-dDEBUG"/> 214 <CompilerPath Value="$(CompPath)"/>215 197 </Other> 216 198 </CompilerOptions> -
trunk/tunneler.lpr
r32 r34 9 9 {$ENDIF}{$ENDIF} 10 10 Interfaces, // this includes the LCL widgetset 11 Forms, UCore, TemplateGenerics, CoolTranslator, UPlatform, FileUtil, SysUtils, Common, URectangle, UPersistentForm, 12 UNewGameForm, UMainForm, UMapForm, UDebugForm, UGameResultForm 11 Forms, TemplateGenerics, CoolTranslator, UPlatform, FileUtil, SysUtils, 12 Common, 13 UNewGameForm, UMainForm, UMapForm, UGameResultForm 13 14 { you can add units after this }; 14 15 … … 31 32 Application.CreateForm(TMapForm, MapForm); 32 33 Application.CreateForm(TNewGameForm, NewGameForm); 33 Application.CreateForm(TDebugForm, DebugForm);34 34 Application.CreateForm(TGameResultForm, GameResultForm); 35 35 {$IFDEF DEBUG}
Note:
See TracChangeset
for help on using the changeset viewer.