Changeset 34 for trunk


Ignore:
Timestamp:
Nov 25, 2017, 12:27:33 AM (7 years ago)
Author:
chronos
Message:
  • Modified: Improved New game window.
  • Modified: Used newer version of Common and CoolTranslator packages.
Location:
trunk
Files:
9 added
1 deleted
34 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        33backup
        44tunneler.exe
         5tunneler.dbg
         6tunneler.lps
        57heaptrclog.trc
        6 tunneler.lps
         8Components/Common/Languages/*.mo
         9Components/CoolTranslator/Demo/lib

  • trunk/Components/Common/Common.lpk

    r31 r34  
    1 <?xml version="1.0"?>
     1<?xml version="1.0" encoding="UTF-8"?>
    22<CONFIG>
    33  <Package Version="4">
    44    <PathDelim Value="\"/>
    55    <Name Value="Common"/>
     6    <Type Value="RunAndDesignTime"/>
    67    <AddToProjectUsesSection Value="True"/>
    78    <Author Value="Chronos (robie@centrum.cz)"/>
    … …  
    1213        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
    1314      </SearchPaths>
    14       <Other>
    15         <CompilerMessages>
    16           <UseMsgFile Value="True"/>
    17         </CompilerMessages>
    18         <CompilerPath Value="$(CompPath)"/>
    19       </Other>
    2015    </CompilerOptions>
    2116    <Description Value="Various libraries"/>
    2217    <License Value="GNU/GPL"/>
    2318    <Version Minor="7"/>
    24     <Files Count="15">
     19    <Files Count="20">
    2520      <Item1>
    2621        <Filename Value="StopWatch.pas"/>
    … …  
    8782        <UnitName Value="UApplicationInfo"/>
    8883      </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>
    89108    </Files>
    90109    <i18n>
    91110      <EnableI18N Value="True"/>
    92111      <OutDir Value="Languages"/>
     112      <EnableI18NForLFM Value="True"/>
    93113    </i18n>
    94     <Type Value="RunAndDesignTime"/>
    95     <RequiredPkgs Count="2">
     114    <RequiredPkgs Count="3">
    96115      <Item1>
    97         <PackageName Value="TemplateGenerics"/>
     116        <PackageName Value="LCL"/>
    98117      </Item1>
    99118      <Item2>
     119        <PackageName Value="TemplateGenerics"/>
     120      </Item2>
     121      <Item3>
    100122        <PackageName Value="FCL"/>
    101123        <MinVersion Major="1" Valid="True"/>
    102       </Item2>
     124      </Item3>
    103125    </RequiredPkgs>
    104126    <UsageOptions>

  • trunk/Components/Common/Common.pas

    r31 r34  
    1010  StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading,
    1111  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
    12   UJobProgressView, UXMLUtils, UApplicationInfo, LazarusPackageIntf;
     12  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
     13  UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf;
    1314
    1415implementation
    … …  
    2021  RegisterUnit('UJobProgressView', @UJobProgressView.Register);
    2122  RegisterUnit('UApplicationInfo', @UApplicationInfo.Register);
     23  RegisterUnit('UListViewSort', @UListViewSort.Register);
     24  RegisterUnit('UPersistentForm', @UPersistentForm.Register);
     25  RegisterUnit('UFindFile', @UFindFile.Register);
     26  RegisterUnit('UScaleDPI', @UScaleDPI.Register);
    2227end;
    2328

  • trunk/Components/Common/Languages/UJobProgressView.po

    r31 r34  
    1414msgstr ""
    1515
     16#: ujobprogressview.soperations
     17msgid "Operations"
     18msgstr ""
     19
    1620#: ujobprogressview.spleasewait
    1721msgid "Please wait..."

  • trunk/Components/Common/UApplicationInfo.pas

    r31 r34  
    1515  private
    1616    FIdentification: Byte;
     17    FLicense: string;
    1718    FVersionMajor: Byte;
    1819    FVersionMinor: Byte;
    … …  
    4748    property RegistryKey: string read FRegistryKey write FRegistryKey;
    4849    property RegistryRoot: TRegistryRoot read FRegistryRoot write FRegistryRoot;
     50    property License: string read FLicense write FLicense;
    4951  end;
    5052
    … …  
    5557procedure Register;
    5658begin
    57   RegisterComponents('Samples', [TApplicationInfo]);
     59  RegisterComponents('Common', [TApplicationInfo]);
    5860end;
    5961

  • trunk/Components/Common/UCommon.pas

    r31 r34  
    66
    77uses
    8   {$IFDEF Windows}Windows,{$ENDIF}
     8  {$ifdef Windows}Windows,{$endif}
     9  {$ifdef Linux}baseunix,{$endif}
    910  Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf,
    1011  FileUtil; //, ShFolder, ShellAPI;
    … …  
    4849function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    4950function SplitString(var Text: string; Count: Word): string;
     51function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer;
    5052function GetBit(Variable: QWord; Index: Byte): Boolean;
     53procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); overload;
    5154procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean); overload;
    5255procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean); overload;
    … …  
    6265procedure ExecuteProgram(CommandLine: string);
    6366procedure FreeThenNil(var Obj);
     67function RemoveQuotes(Text: string): string;
     68function ComputerName: string;
     69function OccurenceOfChar(What: Char; Where: string): Integer;
     70function GetDirCount(Dir: string): Integer;
     71function MergeArray(A, B: array of string): TArrayOfString;
     72function LoadFileToStr(const FileName: TFileName): AnsiString;
    6473
    6574
    … …  
    105114  Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec);
    106115  while Find = 0 do begin
    107     DeleteFileUTF8(Path + UTF8Encode(SearchRec.Name));
     116    DeleteFile(Path + UTF8Encode(SearchRec.Name));
    108117
    109118    Find := SysUtils.FindNext(SearchRec);
    … …  
    284293  L: LongWord;
    285294begin
    286 
    287295  L := MAX_USERNAME_LENGTH + 2;
    288296  SetLength(Result, L);
    … …  
    299307  end;
    300308end;
    301 
     309{$endif}
     310
     311function ComputerName: string;
     312{$ifdef mswindows}
     313const
     314 INFO_BUFFER_SIZE = 32767;
     315var
     316  Buffer : array[0..INFO_BUFFER_SIZE] of WideChar;
     317  Ret : DWORD;
     318begin
     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;
     326end;
     327{$endif}
     328{$ifdef unix}
     329var
     330  Name: UtsName;
     331begin
     332  fpuname(Name);
     333  Result := Name.Nodename;
     334end;
     335{$endif}
     336
     337{$ifdef windows}
    302338function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    303339const
    … …  
    336372end;
    337373
     374function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer;
     375var
     376  I: Integer;
     377begin
     378  Result := 0;
     379  for I := 0 to MaxIndex - 1 do
     380    if ((Variable shr I) and 1) = 1 then Inc(Result);
     381end;
     382
    338383function GetBit(Variable:QWord;Index:Byte):Boolean;
    339384begin
    … …  
    341386end;
    342387
     388procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean);
     389begin
     390  Variable := (Variable and ((1 shl Index) xor High(QWord))) or (Int64(State) shl Index);
     391end;
     392
    343393procedure SetBit(var Variable:QWord;Index:Byte;State:Boolean); overload;
    344394begin
    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);
    346396end;
    347397
    348398procedure SetBit(var Variable:Cardinal;Index:Byte;State:Boolean); overload;
    349399begin
    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);
    351401end;
    352402
    353403procedure SetBit(var Variable:Word;Index:Byte;State:Boolean); overload;
    354404begin
    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);
    356406end;
    357407
    … …  
    400450
    401451procedure OpenWebPage(URL: string);
    402 var
    403   Process: TProcess;
    404   Browser, Params: string;
    405452begin
    406453  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;
     454end;
     455
     456procedure OpenFileInShell(FileName: string);
     457begin
     458  ExecuteProgram('cmd.exe /c start "' + FileName + '"');
     459end;
     460
     461function RemoveQuotes(Text: string): string;
     462begin
     463  Result := Text;
     464  if (Pos('"', Text) = 1) and (Text[Length(Text)] = '"') then
     465    Result := Copy(Text, 2, Length(Text) - 2);
     466end;
     467
     468function OccurenceOfChar(What: Char; Where: string): Integer;
     469var
     470  I: Integer;
     471begin
     472  Result := 0;
     473  for I := 1 to Length(Where) do
     474    if Where[I] = What then Inc(Result);
     475end;
     476
     477function GetDirCount(Dir: string): Integer;
     478begin
     479  Result := OccurenceOfChar(DirectorySeparator, Dir);
     480  if Copy(Dir, Length(Dir), 1) = DirectorySeparator then
     481    Dec(Result);
     482end;
     483
     484function MergeArray(A, B: array of string): TArrayOfString;
     485var
     486  I: Integer;
     487begin
     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];
     493end;
     494
     495function LoadFileToStr(const FileName: TFileName): AnsiString;
     496var
     497  FileStream: TFileStream;
     498  Read: Integer;
     499begin
     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;
    416508  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;
     511end;
     512
     513
    425514
    426515initialization

  • trunk/Components/Common/UDebugLog.pas

    r31 r34  
    3131    Items: TListObject;
    3232    Lock: TCriticalSection;
    33     procedure Add(Group: string; Text: string);
     33    procedure Add(Text: string; Group: string = '');
    3434    procedure WriteToFile(Text: string);
    3535    constructor Create(AOwner: TComponent); override;
    … …  
    5252procedure Register;
    5353begin
    54   RegisterComponents('Samples', [TDebugLog]);
     54  RegisterComponents('Common', [TDebugLog]);
    5555end;
    5656
    … …  
    6969end;
    7070
    71 procedure TDebugLog.Add(Group: string; Text: string);
     71procedure TDebugLog.Add(Text: string; Group: string = '');
    7272var
    7373  NewItem: TDebugLogItem;
    … …  
    103103  try
    104104    if ExtractFileDir(FileName) <> '' then
    105       ForceDirectoriesUTF8(ExtractFileDir(FileName));
    106     if FileExistsUTF8(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
     105      ForceDirectories(ExtractFileDir(FileName));
     106    if FileExists(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
    107107      else LogFile := TFileStream.Create(UTF8Decode(FileName), fmCreate);
    108108    LogFile.Seek(0, soFromEnd);

  • trunk/Components/Common/UFindFile.pas

    r31 r34  
    5555  end;
    5656
     57const
     58{$IFDEF WINDOWS}
     59  FilterAll = '*.*';
     60{$ENDIF}
     61{$IFDEF LINUX}
     62  FilterAll = '*';
     63{$ENDIF}
     64
    5765procedure Register;
    5866
    … …  
    6472procedure Register;
    6573begin
    66   RegisterComponents('Samples', [TFindFile]);
     74  RegisterComponents('Common', [TFindFile]);
    6775end;
    6876
    … …  
    7179  inherited Create(AOwner);
    7280  Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir));
    73   FileMask := '*.*';
     81  FileMask := FilterAll;
    7482  FileAttr := [ffaAnyFile];
    7583  s := TStringList.Create;
    … …  
    127135  If not InSubFolders then Exit;
    128136
    129   if SysUtils.FindFirst(UTF8Decode(inPath + '*.*'), faDirectory, Rec) = 0 then
     137  if SysUtils.FindFirst(UTF8Decode(inPath + FilterAll), faDirectory, Rec) = 0 then
    130138  try
    131139    repeat

  • trunk/Components/Common/UJobProgressView.lfm

    r31 r34  
    1414  OnDestroy = FormDestroy
    1515  Position = poScreenCenter
    16   LCLVersion = '1.1'
     16  LCLVersion = '1.6.0.4'
    1717  object PanelOperationsTitle: TPanel
    1818    Left = 0
    … …  
    2828    object LabelOperation: TLabel
    2929      Left = 8
    30       Height = 14
     30      Height = 13
    3131      Top = 8
    32       Width = 67
     32      Width = 66
    3333      Caption = 'Operations:'
    3434      Font.Height = -11
    … …  
    8080    object LabelEstimatedTimePart: TLabel
    8181      Left = 8
    82       Height = 14
     82      Height = 13
    8383      Top = -2
    84       Width = 72
     84      Width = 71
    8585      Caption = 'Estimated time:'
    8686      ParentColor = False
    … …  
    132132    object LabelEstimatedTimeTotal: TLabel
    133133      Left = 8
    134       Height = 14
     134      Height = 13
    135135      Top = 0
    136       Width = 98
     136      Width = 97
    137137      Caption = 'Total estimated time:'
    138138      ParentColor = False

  • trunk/Components/Common/UJobProgressView.lrt

    r31 r34  
    1 TJOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations:
    2 TJOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time:
    3 TJOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time:
     1TFORMJOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations:
     2TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time:
     3TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time:

  • trunk/Components/Common/UJobProgressView.pas

    r31 r34  
    111111    Finished: Boolean;
    112112    FOnJobFinish: TJobProgressViewMethod;
     113    FOnOwnerDraw: TNotifyEvent;
     114    FOwnerDraw: Boolean;
    113115    FShowDelay: Integer;
    114116    FTerminate: Boolean;
    … …  
    116118    TotalStartTime: TDateTime;
    117119    Log: TStringList;
    118     Form: TFormJobProgressView;
    119120    procedure SetTerminate(const AValue: Boolean);
    120121    procedure UpdateProgress;
    … …  
    122123    procedure StartJobs;
    123124    procedure UpdateHeight;
     125    procedure JobProgressChange(Sender: TObject);
    124126  public
     127    Form: TFormJobProgressView;
    125128    Jobs: TObjectList; // TListObject<TJob>
    126129    CurrentJob: TJob;
    … …  
    136139    property Terminate: Boolean read FTerminate write SetTerminate;
    137140  published
     141    property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw;
    138142    property ShowDelay: Integer read FShowDelay write FShowDelay;
    139143    property AutoClose: Boolean read FAutoClose write FAutoClose;
    140144    property OnJobFinish: TJobProgressViewMethod read FOnJobFinish
    141145      write FOnJobFinish;
     146    property OnOwnerDraw: TNotifyEvent read FOnOwnerDraw
     147      write FOnOwnerDraw;
    142148  end;
    143149
    … …  
    160166  STotalEstimatedTime = 'Total estimated time: %s';
    161167  SFinished = 'Finished';
     168  SOperations = 'Operations';
    162169
    163170procedure Register;
    164171begin
    165   RegisterComponents('Samples', [TJobProgressView]);
     172  RegisterComponents('Common', [TJobProgressView]);
    166173end;
    167174
    … …  
    196203  NewJob.Progress.Max := 100;
    197204  NewJob.Progress.Reset;
     205  NewJob.Progress.OnChange := JobProgressChange;
    198206  Jobs.Add(NewJob);
    199207  //ReloadJobList;
    … …  
    212220  Terminate := False;
    213221
    214   Form.BringToFront;
     222  if not OwnerDraw then Form.BringToFront;
    215223
    216224  Finished := False;
    … …  
    244252      CurrentJobIndex := I;
    245253      CurrentJob := TJob(Jobs[I]);
     254      JobProgressChange(Self);
    246255      StartTime := Now;
    247256      Form.LabelEstimatedTimePart.Caption := Format(SEstimatedTime, ['']);
    … …  
    339348end;
    340349
     350procedure TJobProgressView.JobProgressChange(Sender: TObject);
     351begin
     352  if Assigned(FOnOwnerDraw) then
     353    FOnOwnerDraw(Self);
     354end;
     355
    341356procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
    342357var
    … …  
    357372  if not Visible then begin
    358373    TimerUpdate.Interval := UpdateInterval;
    359     Show;
     374    if not JobProgressView.OwnerDraw then Show;
    360375  end;
    361376end;
    … …  
    509524destructor TJobProgressView.Destroy;
    510525begin
    511   Log.Free;
    512   Jobs.Free;
    513   inherited Destroy;
     526  FreeAndNil(Log);
     527  FreeAndNil(Jobs);
     528  inherited;
    514529end;
    515530
    … …  
    519534    FLock.Acquire;
    520535    FMax := AValue;
     536    if FMax < 1 then FMax := 1;
    521537    if FValue >= FMax then FValue := FMax;
    522538  finally
    … …  
    610626begin
    611627  Progress.Free;
    612   inherited Destroy;
     628  inherited;
    613629end;
    614630

  • trunk/Components/Common/ULastOpenedList.pas

    r31 r34  
    66
    77uses
    8   Classes, SysUtils, Registry, URegistry, Menus;
     8  Classes, SysUtils, Registry, URegistry, Menus, XMLConf;
    99
    1010type
    … …  
    1818    procedure SetMaxCount(AValue: Integer);
    1919    procedure LimitMaxCount;
     20    procedure ItemsChange(Sender: TObject);
     21    procedure DoChange;
    2022  public
    2123    Items: TStringList;
    … …  
    2527    procedure LoadFromRegistry(Context: TRegistryContext);
    2628    procedure SaveToRegistry(Context: TRegistryContext);
     29    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string);
     30    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
    2731    procedure AddItem(FileName: string);
    2832  published
    … …  
    3842procedure Register;
    3943begin
    40   RegisterComponents('Samples', [TLastOpenedList]);
     44  RegisterComponents('Common', [TLastOpenedList]);
    4145end;
    4246
    … …  
    5862end;
    5963
     64procedure TLastOpenedList.ItemsChange(Sender: TObject);
     65begin
     66  DoChange;
     67end;
     68
     69procedure TLastOpenedList.DoChange;
     70begin
     71  if Assigned(FOnChange) then
     72    FOnChange(Self);
     73end;
     74
    6075constructor TLastOpenedList.Create(AOwner: TComponent);
    6176begin
    6277  inherited;
    6378  Items := TStringList.Create;
     79  Items.OnChange := ItemsChange;
    6480  MaxCount := 10;
    6581end;
    … …  
    129145end;
    130146
     147procedure TLastOpenedList.LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string
     148  );
     149var
     150  I: Integer;
     151  Value: string;
     152  Count: Integer;
     153begin
     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;
     165end;
     166
     167procedure TLastOpenedList.SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
     168var
     169  I: Integer;
     170begin
     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;
     177end;
     178
    131179procedure TLastOpenedList.AddItem(FileName:string);
    132180begin
    … …  
    134182  Items.Insert(0, FileName);
    135183  LimitMaxCount;
    136   if Assigned(FOnChange) then
    137     FOnChange(Self);
     184  DoChange;
    138185end;
    139186

  • trunk/Components/Common/URegistry.pas

    r31 r34  
    1717    rrKeyDynData = HKEY($80000006));
    1818
     19  { TRegistryContext }
     20
    1921  TRegistryContext = record
    2022    RootKey: HKEY;
    2123    Key: string;
     24    class operator Equal(A, B: TRegistryContext): Boolean;
    2225  end;
    2326
    … …  
    2629  TRegistryEx = class(TRegistry)
    2730  private
     31    function GetCurrentContext: TRegistryContext;
     32    procedure SetCurrentContext(AValue: TRegistryContext);
    2833  public
    2934    function ReadBoolWithDefault(const Name: string;
    … …  
    3540    function DeleteKeyRecursive(const Key: string): Boolean;
    3641    function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
     42    property CurrentContext: TRegistryContext read GetCurrentContext write SetCurrentContext;
    3743  end;
    3844
    … …  
    4652  Result.RootKey := RootKey;
    4753  Result.Key := Key;
     54end;
     55
     56{ TRegistryContext }
     57
     58class operator TRegistryContext.Equal(A, B: TRegistryContext): Boolean;
     59begin
     60  Result := (A.Key = B.Key) and (A.RootKey = B.RootKey);
    4861end;
    4962
    … …  
    106119end;
    107120
     121function TRegistryEx.GetCurrentContext: TRegistryContext;
     122begin
     123  Result.Key := CurrentPath;
     124  Result.RootKey := RootKey;
     125end;
     126
     127procedure TRegistryEx.SetCurrentContext(AValue: TRegistryContext);
     128begin
     129  RootKey := AValue.RootKey;
     130  OpenKey(AValue.Key, True);
     131end;
     132
    108133function TRegistryEx.ReadBoolWithDefault(const Name: string;
    109134  DefaultValue: Boolean): Boolean;

  • trunk/Components/Common/UResetableThread.pas

    r31 r34  
    104104
    105105procedure TResetableThread.WaitForStart;
    106 var
    107   WaitResult: TWaitResult;
     106//var
     107//  WaitResult: TWaitResult;
    108108begin
    109109  //try
    … …  
    127127
    128128procedure TResetableThread.WaitForStop;
    129 var
    130   WaitState: TWaitResult;
     129//var
     130//  WaitState: TWaitResult;
    131131begin
    132132  try

  • trunk/Components/Common/UURI.pas

    r31 r34  
    326326    Drive := Drive + DriveSeparator;
    327327  end else Drive := '';
    328   Directory.AsString := AValue;
     328  if (Drive <> '') and (AValue = '') then
     329    Directory.AsString := Directory.DirSeparator
     330    else Directory.AsString := AValue;
    329331end;
    330332

  • trunk/Components/Common/UXMLUtils.pas

    r31 r34  
    77uses
    88  {$IFDEF WINDOWS}Windows,{$ENDIF}
    9   Classes, SysUtils, DateUtils;
     9  Classes, SysUtils, DateUtils, XMLRead, XMLWrite, DOM;
    1010
    1111function XMLTimeToDateTime(XMLDateTime: string): TDateTime;
    1212function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;
     13procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer);
     14procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64);
     15procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean);
     16procedure WriteString(Node: TDOMNode; Name: string; Value: string);
     17procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime);
     18function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
     19function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64;
     20function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean;
     21function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string;
     22function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime;
    1323
    1424
    … …  
    6676  Minute: Integer;
    6777  Second: Integer;
     78  SecondFraction: Double;
    6879  Millisecond: Integer;
    6980begin
    … …  
    8899      if Pos('Z', XMLDateTime) > 0 then
    89100        LeftCutString(XMLDateTime, Part, 'Z');
    90       Millisecond := StrToInt(Part);
     101      SecondFraction := StrToFloat('0' + DecimalSeparator + Part);
     102      Millisecond := Trunc(SecondFraction * 1000);
    91103    end else begin
    92104      if Pos('+', XMLDateTime) > 0 then
    … …  
    123135end;
    124136
     137procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer);
     138var
     139  NewNode: TDOMNode;
     140begin
     141  NewNode := Node.OwnerDocument.CreateElement(Name);
     142  NewNode.TextContent := IntToStr(Value);
     143  Node.AppendChild(NewNode);
     144end;
     145
     146procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64);
     147var
     148  NewNode: TDOMNode;
     149begin
     150  NewNode := Node.OwnerDocument.CreateElement(Name);
     151  NewNode.TextContent := IntToStr(Value);
     152  Node.AppendChild(NewNode);
     153end;
     154
     155procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean);
     156var
     157  NewNode: TDOMNode;
     158begin
     159  NewNode := Node.OwnerDocument.CreateElement(Name);
     160  NewNode.TextContent := BoolToStr(Value);
     161  Node.AppendChild(NewNode);
     162end;
     163
     164procedure WriteString(Node: TDOMNode; Name: string; Value: string);
     165var
     166  NewNode: TDOMNode;
     167begin
     168  NewNode := Node.OwnerDocument.CreateElement(Name);
     169  NewNode.TextContent := Value;
     170  Node.AppendChild(NewNode);
     171end;
     172
     173procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime);
     174var
     175  NewNode: TDOMNode;
     176begin
     177  NewNode := Node.OwnerDocument.CreateElement(Name);
     178  NewNode.TextContent := DateTimeToXMLTime(Value);
     179  Node.AppendChild(NewNode);
     180end;
     181
     182function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
     183var
     184  NewNode: TDOMNode;
     185begin
     186  Result := DefaultValue;
     187  NewNode := Node.FindNode(Name);
     188  if Assigned(NewNode) then
     189    Result := StrToInt(NewNode.TextContent);
     190end;
     191
     192function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64;
     193var
     194  NewNode: TDOMNode;
     195begin
     196  Result := DefaultValue;
     197  NewNode := Node.FindNode(Name);
     198  if Assigned(NewNode) then
     199    Result := StrToInt64(NewNode.TextContent);
     200end;
     201
     202function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean;
     203var
     204  NewNode: TDOMNode;
     205begin
     206  Result := DefaultValue;
     207  NewNode := Node.FindNode(Name);
     208  if Assigned(NewNode) then
     209    Result := StrToBool(NewNode.TextContent);
     210end;
     211
     212function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string;
     213var
     214  NewNode: TDOMNode;
     215begin
     216  Result := DefaultValue;
     217  NewNode := Node.FindNode(Name);
     218  if Assigned(NewNode) then
     219    Result := NewNode.TextContent;
     220end;
     221
     222function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime
     223  ): TDateTime;
     224var
     225  NewNode: TDOMNode;
     226begin
     227  Result := DefaultValue;
     228  NewNode := Node.FindNode(Name);
     229  if Assigned(NewNode) then
     230    Result := XMLTimeToDateTime(NewNode.TextContent);
     231end;
     232
    125233end.
    126234

  • trunk/Components/CoolTranslator/Demo/Languages/TranslatorDemo.cs.po

    r30 r34  
    1010"Content-Transfer-Encoding: 8bit\n"
    1111
    12 #: TFORM1.FORM1.CAPTION
     12#: tform1.form1.caption
    1313msgctxt "TFORM1.FORM1.CAPTION"
    1414msgid "Translator Demo"
    1515msgstr "Ukázka Translatoru"
    1616
    17 #: TMAINFORM.BUTTON1.CAPTION
     17#: tmainform.button1.caption
    1818msgid "Show MainForm.Name"
    1919msgstr "Ukázat MainForm.Name"
    2020
    21 #: TMAINFORM.CAPTION
     21#: tmainform.caption
    2222msgctxt "TMAINFORM.CAPTION"
    2323msgid "Translator Demo"
    2424msgstr "Ukázka Translatoru"
    2525
    26 #: TMAINFORM.LABEL1.CAPTION
     26#: tmainform.label1.caption
    2727msgid "MainForm"
    2828msgstr "HlavníFormulář"
    2929
    30 #: TMAINFORM.LABEL2.CAPTION
     30#: tmainform.label2.caption
    3131msgid "Form name as label caption:"
    3232msgstr "Jméno formuláře jako titulek textu:"
    3333
    34 #: TMAINFORM.LABEL3.CAPTION
     34#: tmainform.label3.caption
    3535msgid "Language list:"
    3636msgstr ""
    3737
    38 #: TMAINFORM.LABEL4.CAPTION
     38#: tmainform.label4.caption
    3939msgid "Excludes:"
    4040msgstr ""

  • trunk/Components/CoolTranslator/Demo/Languages/TranslatorDemo.de.po

    r30 r34  
    22msgstr "Content-Type: text/plain; charset=UTF-8"
    33
    4 #: TFORM1.FORM1.CAPTION
     4#: tform1.form1.caption
    55msgctxt "TFORM1.FORM1.CAPTION"
    66msgid "Translator Demo"
    77msgstr ""
    88
    9 #: TMAINFORM.BUTTON1.CAPTION
     9#: tmainform.button1.caption
    1010msgid "Show MainForm.Name"
    1111msgstr ""
    1212
    13 #: TMAINFORM.CAPTION
     13#: tmainform.caption
    1414msgctxt "TMAINFORM.CAPTION"
    1515msgid "Translator Demo"
    1616msgstr ""
    1717
    18 #: TMAINFORM.LABEL1.CAPTION
     18#: tmainform.label1.caption
    1919msgid "MainForm"
    2020msgstr ""
    2121
    22 #: TMAINFORM.LABEL2.CAPTION
     22#: tmainform.label2.caption
    2323msgid "Form name as label caption:"
    2424msgstr ""
    2525
    26 #: TMAINFORM.LABEL3.CAPTION
     26#: tmainform.label3.caption
    2727msgid "Language list:"
    2828msgstr ""
    2929
    30 #: TMAINFORM.LABEL4.CAPTION
     30#: tmainform.label4.caption
    3131msgid "Excludes:"
    3232msgstr ""

  • trunk/Components/CoolTranslator/Demo/Languages/TranslatorDemo.po

    r30 r34  
    22msgstr "Content-Type: text/plain; charset=UTF-8"
    33
    4 #: TFORM1.FORM1.CAPTION
     4#: tform1.form1.caption
    55msgctxt "TFORM1.FORM1.CAPTION"
    66msgid "Translator Demo"
    77msgstr ""
    88
    9 #: TMAINFORM.BUTTON1.CAPTION
     9#: tmainform.button1.caption
    1010msgid "Show MainForm.Name"
    1111msgstr ""
    1212
    13 #: TMAINFORM.CAPTION
     13#: tmainform.caption
    1414msgctxt "TMAINFORM.CAPTION"
    1515msgid "Translator Demo"
    1616msgstr ""
    1717
    18 #: TMAINFORM.LABEL1.CAPTION
     18#: tmainform.label1.caption
    1919msgid "MainForm"
    2020msgstr ""
    2121
    22 #: TMAINFORM.LABEL2.CAPTION
     22#: tmainform.label2.caption
    2323msgid "Form name as label caption:"
    2424msgstr ""
    2525
    26 #: TMAINFORM.LABEL3.CAPTION
     26#: tmainform.label3.caption
    2727msgid "Language list:"
    2828msgstr ""
    2929
    30 #: TMAINFORM.LABEL4.CAPTION
     30#: tmainform.label4.caption
    3131msgid "Excludes:"
    3232msgstr ""

  • trunk/Components/CoolTranslator/Demo/TranslatorDemo.lpi

    r30 r34  
    5151        <IsPartOfProject Value="True"/>
    5252        <ComponentName Value="MainForm"/>
     53        <HasResources Value="True"/>
    5354        <ResourceBaseClass Value="Form"/>
    5455        <UnitName Value="UMainForm"/>
     56        <IsVisibleTab Value="True"/>
    5557        <EditorIndex Value="0"/>
    5658        <WindowIndex Value="0"/>
    … …  
    7981        <Filename Value="..\UCoolTranslator.pas"/>
    8082        <UnitName Value="UCoolTranslator"/>
    81         <IsVisibleTab Value="True"/>
    8283        <EditorIndex Value="1"/>
    8384        <WindowIndex Value="0"/>
    8485        <TopLine Value="274"/>
    85         <CursorPos X="1" Y="286"/>
     86        <CursorPos X="33" Y="288"/>
    8687        <UsageCount Value="11"/>
    8788        <Loaded Value="True"/>
    … …  
    265266  </ProjectOptions>
    266267  <CompilerOptions>
    267     <Version Value="10"/>
     268    <Version Value="11"/>
    268269    <PathDelim Value="\"/>
    269270    <Target>
    … …  
    275276    </SearchPaths>
    276277    <Linking>
    277       <Debugging>
    278         <GenerateDebugInfo Value="True"/>
    279         <DebugInfoType Value="dsAuto"/>
    280       </Debugging>
    281278      <Options>
    282279        <Win32>
    … …  
    305302    </Exceptions>
    306303  </Debugging>
     304  <EditorMacros Count="0"/>
    307305</CONFIG>

  • trunk/Components/CoolTranslator/Demo/UMainForm.lfm

    r30 r34  
    88  ClientWidth = 466
    99  OnCreate = FormCreate
    10   LCLVersion = '0.9.31'
     10  LCLVersion = '1.1'
    1111  object ListBox1: TListBox
    1212    Left = 171
    … …  
    2929  object Label1: TLabel
    3030    Left = 10
    31     Height = 14
     31    Height = 13
    3232    Top = 24
    33     Width = 47
     33    Width = 46
    3434    Caption = 'MainForm'
    3535    ParentColor = False
    … …  
    3737  object Label2: TLabel
    3838    Left = 10
    39     Height = 14
     39    Height = 13
    4040    Top = 6
    41     Width = 135
     41    Width = 134
    4242    Caption = 'Form name as label caption:'
    4343    ParentColor = False
    … …  
    4545  object Label3: TLabel
    4646    Left = 171
    47     Height = 14
     47    Height = 13
    4848    Top = 8
    49     Width = 68
     49    Width = 67
    5050    Caption = 'Language list:'
    5151    ParentColor = False
    … …  
    6161  object Label4: TLabel
    6262    Left = 321
    63     Height = 14
     63    Height = 13
    6464    Top = 10
    65     Width = 47
     65    Width = 46
    6666    Caption = 'Excludes:'
    6767    ParentColor = False
    … …  
    6969  object CoolTranslator1: TCoolTranslator
    7070    POFilesFolder = 'Languages'
    71     left = 64
    72     top = 40
     71    left = 72
     72    top = 72
    7373  end
    7474end

  • trunk/Components/CoolTranslator/UCoolTranslator.pas

    r30 r34  
    66
    77uses
    8   Classes, SysUtils, Forms, StdCtrls, ExtCtrls, StrUtils, Controls, Contnrs,
     8  Classes, SysUtils, Forms, ExtCtrls, Controls, Contnrs, LazFileUtils, LazUTF8,
    99  Translations, TypInfo, Dialogs, FileUtil, LCLProc, ULanguages, LCLType;
    1010
    … …  
    4646    procedure TranslateProperty(Component: TPersistent; PropInfo: PPropInfo);
    4747    function IsExcluded(Component: TPersistent; PropertyName: string): Boolean;
     48    function GetLangFileDir: string;
    4849  public
    4950    ComponentExcludes: TComponentExcludesList;
    … …  
    150151  I: Integer;
    151152  LocaleShort: string;
     153  SearchMask: string;
    152154begin
    153155  FPOFiles.Clear;
    … …  
    157159    //ShowMessage(ExtractFileDir(Application.ExeName) +
    158160    //  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);
    161165    for I := 0 to FileList.Count - 1 do begin
    162166      FileName := FileList[I];
    163167      //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));
    165171    end;
    166172  finally
    … …  
    174180  FPoFilesFolder := AValue;
    175181  ReloadFiles;
     182  CheckLanguageFiles;
    176183end;
    177184
    … …  
    223230var
    224231  PropType: PTypeInfo;
    225   Parent: TObject;
    226232  Obj: TObject;
    227233  I: Integer;
    … …  
    285291end;
    286292
     293function TCoolTranslator.GetLangFileDir: string;
     294begin
     295  Result := FPOFilesFolder;
     296  if Copy(Result, 1, 1) <> DirectorySeparator then
     297    Result := ExtractFileDir(UTF8Encode(Application.ExeName)) +
     298      DirectorySeparator + Result;
     299end;
     300
    287301procedure TCoolTranslator.LanguageListToStrings(Strings: TStrings);
    288302var
    … …  
    317331  I: Integer;
    318332begin
     333  Result := '';
    319334  if Text <> '' then begin
    320335    for I := 0 to FPoFiles.Count - 1 do begin
    … …  
    343358var
    344359  I: Integer;
    345 begin
     360  LangDir: string;
     361begin
     362  LangDir := GetLangFileDir;
    346363  TLanguage(Languages[0]).Available := True; // Automatic
    347364
    348365  for I := 1 to Languages.Count - 1 do
    349366  with TLanguage(Languages[I]) do begin
    350     Available := FileExistsUTF8(POFilesFolder + DirectorySeparator + ExtractFileNameOnly(Application.ExeName) +
     367    Available := FileExists(LangDir + DirectorySeparator + ExtractFileNameOnly(Application.ExeName) +
    351368      '.' + Code + ExtensionSeparator + 'po') or (Code = 'en');
    352369  end;
    … …  
    383400begin
    384401  // Win32 user may decide to override locale with LANG variable.
    385   Lang := GetEnvironmentVariableUTF8('LANG');
     402  Lang := GetEnvironmentVariable('LANG');
    386403
    387404  // Use user selected language
    … …  
    391408  if Lang = '' then begin
    392409    for i := 1 to Paramcount - 1 do
    393       if (ParamStrUTF8(i) = '--LANG') or (ParamStrUTF8(i) = '-l') or
    394         (ParamStrUTF8(i) = '--lang') then
    395         Lang := ParamStrUTF8(i + 1);
     410      if (ParamStr(i) = '--LANG') or (ParamStr(i) = '-l') or
     411        (ParamStr(i) = '--lang') then
     412        Lang := ParamStr(i + 1);
    396413  end;
    397414  if Lang = '' then
    398     LCLGetLanguageIDs(Lang, T);
     415    LazGetLanguageIDs(Lang, T);
    399416
    400417  if Assigned(Language) and (Language.Code = '') and Assigned(FOnAutomaticLanguage) then begin
    … …  
    402419  end;
    403420
    404   if Lang = 'en' then Lang := ''; // English files are without en code
    405 
    406421  Result := Lang;
    407422end;
    … …  
    415430var
    416431  T: string;
    417   I: Integer;
    418432  Lang: string;
    419433begin
    … …  
    425439    Exit;
    426440
    427   Result := ChangeFileExt(ParamStrUTF8(0), LCExt);
     441  Result := ChangeFileExt(ParamStr(0), LCExt);
    428442  if FileExistsUTF8(Result) then
    429443    Exit;

  • trunk/Components/TemplateGenerics/Generic/GenericMatrix.inc

    r29 r34  
    4949    function Implode(RowSeparator, ColSeparator: string; Converter: TGMatrixToStringConverter): string;
    5050    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;
    5353    procedure Insert(Index: TGMatrixIndex; Item: TGMatrixItem);
    5454    procedure InsertList(Index: TGMatrixIndex; List: TGMatrix);

  • trunk/Forms/UMainForm.lfm

    r31 r34  
    11object MainForm: TMainForm
    2   Left = 470
     2  Left = 886
    33  Height = 412
    4   Top = 150
     4  Top = 378
    55  Width = 514
    66  Caption = 'Tunneler'
    7   ClientHeight = 387
     7  ClientHeight = 383
    88  ClientWidth = 514
    99  Menu = MainMenu1
    … …  
    1515  OnKeyUp = FormKeyUp
    1616  OnShow = FormShow
    17   LCLVersion = '1.1'
     17  LCLVersion = '1.5'
    1818  object StatusBar1: TStatusBar
    1919    Left = 0
    20     Height = 21
    21     Top = 366
     20    Height = 29
     21    Top = 354
    2222    Width = 514
    2323    Panels = <   
    … …  
    4747  object Image1: TImage
    4848    Left = 0
    49     Height = 366
     49    Height = 354
    5050    Top = 0
    5151    Width = 514

  • trunk/Forms/UMainForm.pas

    r33 r34  
    88  Registry, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
    99  ComCtrls, Menus, ActnList, UCore, UPlatform, Math, DateUtils, GraphType,
    10   UPersistentForm, UApplicationInfo, UCoolTranslator, LCLType;
     10  UPersistentForm, UApplicationInfo, UCoolTranslator, LCLType, URegistry;
    1111
    1212type
    … …  
    5353    procedure TimerDrawTimer(Sender: TObject);
    5454    procedure TimerEngineTickTimer(Sender: TObject);
    55     procedure EraseBackground(DC: HDC); override;
    5655  private
    5756    OriginalBounds: TRect;
    … …  
    6463    PersistentForm: TPersistentForm;
    6564    Engine: TEngine;
    66   end;
     65    procedure EraseBackground(DC: HDC); override;
     66  end;
    6767
    6868var
    … …  
    8989    StartTime := NowPrecise;
    9090    //Engine.Draw;
    91     DrawDuration := NowPrecise - StartTime;
    9291    try
    9392      Engine.Lock.Acquire;
    … …  
    9594      //  IntToStr(TPlayer(Engine.Players[0]).Position.Y) + ' ' +
    9695      //  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));
    9897      StatusBar1.Panels[3].Text := Format(SRound, [IntToStr(Engine.CurrentRound),
    9998        IntToStr(Engine.MaxRound)]);
    … …  
    118117procedure TMainForm.FormCreate(Sender: TObject);
    119118begin
    120   PersistentForm := TPersistentForm.Create;
    121   PersistentForm.RegistryKey := ApplicationInfo1.RegistryKey;
    122   PersistentForm.RegistryRootKey := HKEY(ApplicationInfo1.RegistryRoot);
     119  PersistentForm := TPersistentForm.Create(nil);
     120  PersistentForm.RegistryContext := RegContext(HKEY(ApplicationInfo1.RegistryRoot),
     121    ApplicationInfo1.RegistryKey);
    123122
    124123  Application.OnDeactivate := FormDeactivate;
    … …  
    130129  Engine.Active := True;
    131130  Image1Resize(Self);
     131
     132  Image1.ControlStyle := Image1.ControlStyle + [csOpaque];
    132133end;
    133134
    … …  
    172173procedure TMainForm.ANewGameExecute(Sender: TObject);
    173174begin
    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;
    175180end;
    176181
    … …  
    212217  PersistentForm.Load(Self);
    213218  CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode('cs');
    214   DebugForm.Show;
    215219end;
    216220

  • trunk/Forms/UNewGameForm.lfm

    r23 r34  
    11object NewGameForm: TNewGameForm
    2   Left = 312
    3   Height = 387
    4   Top = 137
    5   Width = 560
     2  Left = 579
     3  Height = 434
     4  Top = 226
     5  Width = 677
    66  Caption = 'New game'
    7   ClientHeight = 387
    8   ClientWidth = 560
     7  ClientHeight = 434
     8  ClientWidth = 677
     9  OnCreate = FormCreate
     10  OnDestroy = FormDestroy
    911  OnShow = FormShow
    10   LCLVersion = '0.9.31'
     12  LCLVersion = '1.8.0.4'
    1113  object ButtonStart: TButton
    12     Left = 476
     14    Left = 592
    1315    Height = 25
    14     Top = 358
     16    Top = 400
    1517    Width = 75
    1618    Anchors = [akRight, akBottom]
    1719    Caption = 'Start'
    1820    ModalResult = 1
    19     OnClick = ButtonStartClick
    2021    TabOrder = 0
    2122  end
    2223  object ButtonCancel: TButton
    23     Left = 388
     24    Left = 504
    2425    Height = 25
    25     Top = 358
     26    Top = 400
    2627    Width = 75
    2728    Anchors = [akRight, akBottom]
    … …  
    3233  object Label1: TLabel
    3334    Left = 8
    34     Height = 18
    35     Top = 8
    36     Width = 53
     35    Height = 26
     36    Top = 0
     37    Width = 66
    3738    Caption = 'Players:'
    3839    ParentColor = False
    … …  
    4041  object ListView1: TListView
    4142    Left = 8
    42     Height = 320
     43    Height = 368
    4344    Top = 24
    4445    Width = 368
     46    Anchors = [akTop, akLeft, akBottom]
    4547    Checkboxes = True
    4648    Columns = <   
    … …  
    5456      item
    5557        Caption = 'Controls'
    56         Width = 147
     58        Width = 151
    5759      end>
     60    OwnerData = True
    5861    ReadOnly = True
    5962    RowSelect = True
    … …  
    6164    ViewStyle = vsReport
    6265    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
    63198  end
    64199end

  • trunk/Forms/UNewGameForm.lrt

    r21 r34  
    66TNEWGAMEFORM.LISTVIEW1.COLUMNS[1].CAPTION=Color
    77TNEWGAMEFORM.LISTVIEW1.COLUMNS[2].CAPTION=Controls
     8TNEWGAMEFORM.LABEL2.CAPTION=Color:
     9TNEWGAMEFORM.GROUPBOX1.CAPTION=Control keys
     10TNEWGAMEFORM.LABEL3.CAPTION=Up:
     11TNEWGAMEFORM.LABEL4.CAPTION=Down:
     12TNEWGAMEFORM.LABEL5.CAPTION=Left:
     13TNEWGAMEFORM.LABEL6.CAPTION=Right:
     14TNEWGAMEFORM.LABEL7.CAPTION=Shoot:
     15TNEWGAMEFORM.LABEL8.CAPTION=Name:

  • trunk/Forms/UNewGameForm.pas

    r24 r34  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ComCtrls;
     9  ComCtrls, UCore;
    1010
    1111type
    … …  
    1616    ButtonStart: TButton;
    1717    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;
    1826    Label1: TLabel;
     27    Label2: TLabel;
     28    Label3: TLabel;
     29    Label4: TLabel;
     30    Label5: TLabel;
     31    Label6: TLabel;
     32    Label7: TLabel;
     33    Label8: TLabel;
    1934    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);
    2153    procedure FormShow(Sender: TObject);
    2254    procedure ListView1Change(Sender: TObject; Item: TListItem;
    2355      Change: TItemChange);
     56    procedure ListView1Data(Sender: TObject; Item: TListItem);
     57    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
     58      Selected: Boolean);
    2459  private
    25     { private declarations }
     60    Players: TPlayers;
     61    procedure ReloadList;
    2662  public
    27     { public declarations }
     63    procedure LoadData(Engine: TEngine);
     64    procedure SaveData(Engine: TEngine);
    2865  end;
    2966
    … …  
    3471
    3572uses
    36   UCore, UMainForm;
     73  UMainForm;
    3774
    3875{$R *.lfm}
    … …  
    4784end;
    4885
    49 procedure TNewGameForm.ButtonStartClick(Sender: TObject);
    50 begin
    51 
     86procedure TNewGameForm.ListView1Data(Sender: TObject; Item: TListItem);
     87begin
     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;
     96end;
     97
     98procedure TNewGameForm.ListView1SelectItem(Sender: TObject; Item: TListItem;
     99  Selected: Boolean);
     100begin
     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;
     111end;
     112
     113procedure TNewGameForm.ReloadList;
     114begin
     115  ListView1.Items.Count := Players.Count;
     116  ListView1.Refresh;
     117end;
     118
     119procedure TNewGameForm.LoadData(Engine: TEngine);
     120begin
     121  Players.Assign(Engine.PlayerPool);
     122end;
     123
     124procedure TNewGameForm.SaveData(Engine: TEngine);
     125begin
     126  Engine.PlayerPool.Assign(Players);
     127end;
     128
     129procedure TNewGameForm.ColorButton1ColorChanged(Sender: TObject);
     130begin
     131  if Assigned(ListView1.Selected) then
     132  with TPlayer(ListView1.Selected.Data) do begin
     133    Color := ColorButton1.ButtonColor;
     134    ReloadList;
     135  end;
     136end;
     137
     138procedure TNewGameForm.EditDownChange(Sender: TObject);
     139var
     140  Value: Integer;
     141begin
     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;
     147end;
     148
     149procedure TNewGameForm.EditDownKeyDown(Sender: TObject; var Key: Word;
     150  Shift: TShiftState);
     151begin
     152  EditDown.Text := IntToStr(Key);
     153end;
     154
     155procedure TNewGameForm.EditLeftChange(Sender: TObject);
     156var
     157  Value: Integer;
     158begin
     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;
     164end;
     165
     166procedure TNewGameForm.EditLeftKeyDown(Sender: TObject; var Key: Word;
     167  Shift: TShiftState);
     168begin
     169  EditLeft.Text := IntToStr(Key);
     170end;
     171
     172procedure TNewGameForm.EditNameChange(Sender: TObject);
     173begin
     174  if Assigned(ListView1.Selected) then
     175  with TPlayer(ListView1.Selected.Data) do begin
     176    Name := EditName.Text;
     177    ReloadList;
     178  end;
     179end;
     180
     181procedure TNewGameForm.EditRightChange(Sender: TObject);
     182var
     183  Value: Integer;
     184begin
     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;
     190end;
     191
     192procedure TNewGameForm.EditRightKeyDown(Sender: TObject; var Key: Word;
     193  Shift: TShiftState);
     194begin
     195  EditRight.Text := IntToStr(Key);
     196end;
     197
     198procedure TNewGameForm.EditShootChange(Sender: TObject);
     199var
     200  Value: Integer;
     201begin
     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;
     207end;
     208
     209procedure TNewGameForm.EditShootKeyDown(Sender: TObject; var Key: Word;
     210  Shift: TShiftState);
     211begin
     212  EditShoot.Text := IntToStr(Key);
     213end;
     214
     215procedure TNewGameForm.EditUpChange(Sender: TObject);
     216var
     217  Value: Integer;
     218begin
     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;
     224end;
     225
     226procedure TNewGameForm.EditUpKeyDown(Sender: TObject; var Key: Word;
     227  Shift: TShiftState);
     228begin
     229  EditUp.Text := IntToStr(Key);
     230end;
     231
     232procedure TNewGameForm.FormCreate(Sender: TObject);
     233begin
     234  Players := TPlayers.Create
     235end;
     236
     237procedure TNewGameForm.FormDestroy(Sender: TObject);
     238begin
     239  FreeAndNil(Players);
    52240end;
    53241
    54242procedure 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;
     243begin
     244  ReloadList;
    74245end;
    75246

  • trunk/Languages/tunneler.cs.po

    r30 r34  
    9393msgstr "Nová hra"
    9494
     95#: tnewgameform.groupbox1.caption
     96msgid "Control keys"
     97msgstr ""
     98
    9599#: tnewgameform.label1.caption
    96100msgid "Players:"
    97101msgstr "Hráči:"
     102
     103#: tnewgameform.label2.caption
     104msgid "Color:"
     105msgstr ""
     106
     107#: tnewgameform.label3.caption
     108msgid "Up:"
     109msgstr ""
     110
     111#: tnewgameform.label4.caption
     112msgid "Down:"
     113msgstr ""
     114
     115#: tnewgameform.label5.caption
     116msgid "Left:"
     117msgstr ""
     118
     119#: tnewgameform.label6.caption
     120msgid "Right:"
     121msgstr ""
     122
     123#: tnewgameform.label7.caption
     124msgid "Shoot:"
     125msgstr ""
     126
     127#: tnewgameform.label8.caption
     128msgid "Name:"
     129msgstr ""
    98130
    99131#: tnewgameform.listview1.columns[0].caption

  • trunk/Languages/tunneler.po

    r30 r34  
    8585msgstr ""
    8686
     87#: tnewgameform.groupbox1.caption
     88msgid "Control keys"
     89msgstr ""
     90
    8791#: tnewgameform.label1.caption
    8892msgid "Players:"
     93msgstr ""
     94
     95#: tnewgameform.label2.caption
     96msgid "Color:"
     97msgstr ""
     98
     99#: tnewgameform.label3.caption
     100msgid "Up:"
     101msgstr ""
     102
     103#: tnewgameform.label4.caption
     104msgid "Down:"
     105msgstr ""
     106
     107#: tnewgameform.label5.caption
     108msgid "Left:"
     109msgstr ""
     110
     111#: tnewgameform.label6.caption
     112msgid "Right:"
     113msgstr ""
     114
     115#: tnewgameform.label7.caption
     116msgid "Shoot:"
     117msgstr ""
     118
     119#: tnewgameform.label8.caption
     120msgid "Name:"
    89121msgstr ""
    90122

  • trunk/UCore.pas

    r32 r34  
    66
    77uses
    8   Dialogs, Classes, SysUtils, Contnrs, Graphics, SpecializedMatrix, SpecializedList,
     8  Dialogs, Classes, SysUtils, Graphics, SpecializedMatrix, SpecializedList,
    99  IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType, Math, URectangle,
    1010  Syncobjs, UThreading, Forms, DateUtils, UAudioSystem, UAudioSystemMPlayer;
    … …  
    9999    function DigProc(Item1, Item2: Byte): Byte;
    100100  public
     101    Color: TColor;
    101102    Id: Integer;
    102103    Enabled: Boolean;
    … …  
    131132    constructor Create;
    132133    destructor Destroy; override;
     134    procedure Assign(Source: TPlayer);
    133135    property Exploded: Boolean read FExploded write SetExploded;
     136  end;
     137
     138  { TPlayers }
     139
     140  TPlayers = class(TListObject)
     141    procedure Assign(Players: TPlayers);
    134142  end;
    135143
    … …  
    207215    Keyboard: TKeyboard;
    208216    World: TWorld;
    209     PlayerPool: TListObject; // TListObject<TPlayer>
    210     Players: TListObject; // TListObject<TPlayer>
     217    PlayerPool: TPlayers; // TListObject<TPlayer>
     218    Players: TPlayers; // TListObject<TPlayer>
    211219    DigMasks: TListObject; // TListObject<TMatrixByte>
    212220    Lock: TCriticalSection;
    … …  
    215223    AudioShot: TMediaPlayer;
    216224    AudioExplode: TMediaPlayer;
     225    DrawDuration: TDatetime;
    217226    procedure CheckGameEnd;
    218227    constructor Create;
    … …  
    242251implementation
    243252
     253uses
     254  UPlatform;
     255
    244256resourcestring
    245257  SPlayer = 'Player';
     258
    246259
    247260
    … …  
    252265  TFastBitmapPixelComponents(Result).R := TFastBitmapPixelComponents(Value).B;
    253266  TFastBitmapPixelComponents(Result).B := TFastBitmapPixelComponents(Value).R;
     267end;
     268
     269{ TPlayers }
     270
     271procedure TPlayers.Assign(Players: TPlayers);
     272var
     273  I: Integer;
     274begin
     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]));
    254279end;
    255280
    … …  
    708733var
    709734  Delta: TPoint;
    710   Matter: TMatterIndex;
    711735  NewBullet: TBullet;
    712   I: Integer;
    713   Pos: TPoint;
    714   ColisionState: TColisionState;
    715736begin
    716737  if Exploded then Exit;
    … …  
    815836  P: Integer;
    816837  Pos: TPoint;
    817   D: Real;
    818838begin
    819839  // Check energy
    … …  
    11811201end;
    11821202
     1203procedure TPlayer.Assign(Source: TPlayer);
     1204begin
     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;
     1213end;
     1214
    11831215{ TEngine }
    11841216
    … …  
    12301262procedure TEngine.DoDrawToBitmap;
    12311263var
    1232   I: Integer;
    12331264  X, Y: Integer;
    12341265  PixelX, PixelY: Integer;
    … …  
    13281359  NewMask: TMatrixByte;
    13291360  I: Integer;
    1330   X, Y: Integer;
    13311361begin
    13321362  DigMasks.Clear;
    … …  
    15421572  FBitmapLock := TCriticalSection.Create;
    15431573  IntfImage := TLazIntfImage.Create(1, 1);
    1544   PlayerPool := TListObject.Create;
    1545   Players := TListObject.Create;
     1574  PlayerPool := TPlayers.Create;
     1575  Players := TPlayers.Create;
    15461576  Players.OwnsObjects := False;
    15471577  Keyboard := TKeyboard.Create;
    15481578  World := TWorld.Create;
    15491579  World.Engine := Self;
    1550   DefaultAudioSystem := TAudioSystemMPlayer.Create(nil);
     1580  //DefaultAudioSystem := TAudioSystemMPlayer.Create(nil);
    15511581  AudioShot := TMediaPlayer.Create(nil);
    15521582  AudioShot.FileName := 'Audio/GE_KF7_Soviet.wav';
    … …  
    15971627var
    15981628  I: Integer;
    1599 begin
    1600   if FRedrawPending then
    1601   begin
     1629  DrawStart: TDateTime;
     1630begin
     1631  if FRedrawPending then begin
     1632    DrawStart := NowPrecise;
    16021633    FRedrawPending := False;
    16031634    try
    … …  
    16111642    end;
    16121643    if not Thread.Terminated then Thread.Synchronize(DoDrawToBitmap);
     1644    DrawDuration := NowPrecise - DrawStart;
    16131645  end;
    16141646end;
    … …  
    16171649var
    16181650  I: Integer;
    1619   I2: Integer;
    16201651begin
    16211652  Active := False;

  • trunk/tunneler.lpi

    r32 r34  
    1 <?xml version="1.0"?>
     1<?xml version="1.0" encoding="UTF-8"?>
    22<CONFIG>
    33  <ProjectOptions>
    4     <Version Value="9"/>
     4    <Version Value="10"/>
    55    <General>
    66      <SessionStorage Value="InProjectDir"/>
    … …  
    1414      <OutDir Value="Languages"/>
    1515    </i18n>
    16     <VersionInfo>
    17       <StringTable ProductVersion=""/>
    18     </VersionInfo>
    1916    <BuildModes Count="2">
    2017      <Item1 Name="Debug" Default="True"/>
    … …  
    6562          <Other>
    6663            <CompilerMessages>
    67               <UseMsgFile Value="True"/>
     64              <IgnoredMessages idx5024="True"/>
    6865            </CompilerMessages>
    69             <CompilerPath Value="$(CompPath)"/>
    7066          </Other>
    7167        </CompilerOptions>
    … …  
    8076      <local>
    8177        <FormatVersion Value="1"/>
    82         <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
    8378      </local>
    8479    </RunParams>
    … …  
    10499      </Item5>
    105100    </RequiredPackages>
    106     <Units Count="10">
     101    <Units Count="9">
    107102      <Unit0>
    108103        <Filename Value="tunneler.lpr"/>
    109104        <IsPartOfProject Value="True"/>
    110         <UnitName Value="tunneler"/>
    111105      </Unit0>
    112106      <Unit1>
    113107        <Filename Value="UCore.pas"/>
    114108        <IsPartOfProject Value="True"/>
    115         <UnitName Value="UCore"/>
    116109      </Unit1>
    117110      <Unit2>
    118111        <Filename Value="UPlatform.pas"/>
    119112        <IsPartOfProject Value="True"/>
    120         <UnitName Value="UPlatform"/>
    121113      </Unit2>
    122114      <Unit3>
    123115        <Filename Value="Common/URectangle.pas"/>
    124116        <IsPartOfProject Value="True"/>
    125         <UnitName Value="URectangle"/>
    126117      </Unit3>
    127118      <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"/>
    131124      </Unit4>
    132125      <Unit5>
    133         <Filename Value="Forms/UNewGameForm.pas"/>
    134         <IsPartOfProject Value="True"/>
    135         <ComponentName Value="NewGameForm"/>
     126        <Filename Value="Forms/UMainForm.pas"/>
     127        <IsPartOfProject Value="True"/>
     128        <ComponentName Value="MainForm"/>
    136129        <HasResources Value="True"/>
    137130        <ResourceBaseClass Value="Form"/>
    138         <UnitName Value="UNewGameForm"/>
    139131      </Unit5>
    140132      <Unit6>
    141         <Filename Value="Forms/UMainForm.pas"/>
    142         <IsPartOfProject Value="True"/>
    143         <ComponentName Value="MainForm"/>
     133        <Filename Value="Forms/UMapForm.pas"/>
     134        <IsPartOfProject Value="True"/>
     135        <ComponentName Value="MapForm"/>
    144136        <HasResources Value="True"/>
    145137        <ResourceBaseClass Value="Form"/>
    146         <UnitName Value="UMainForm"/>
    147138      </Unit6>
    148139      <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"/>
    155144      </Unit7>
    156145      <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"/>
    162150      </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>
    170151    </Units>
    171152  </ProjectOptions>
    … …  
    184165        <SyntaxMode Value="Delphi"/>
    185166        <CStyleOperator Value="False"/>
     167        <IncludeAssertionCode Value="True"/>
    186168        <AllowLabel Value="False"/>
    187169        <CPPInline Value="False"/>
    … …  
    200182      <Debugging>
    201183        <UseHeaptrc Value="True"/>
     184        <UseExternalDbgSyms Value="True"/>
    202185      </Debugging>
    203186      <Options>
    … …  
    209192    <Other>
    210193      <CompilerMessages>
    211         <UseMsgFile Value="True"/>
     194        <IgnoredMessages idx5024="True"/>
    212195      </CompilerMessages>
    213196      <CustomOptions Value="-dDEBUG"/>
    214       <CompilerPath Value="$(CompPath)"/>
    215197    </Other>
    216198  </CompilerOptions>

  • trunk/tunneler.lpr

    r32 r34  
    99  {$ENDIF}{$ENDIF}
    1010  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
    1314  { you can add units after this };
    1415
    … …  
    3132  Application.CreateForm(TMapForm, MapForm);
    3233  Application.CreateForm(TNewGameForm, NewGameForm);
    33   Application.CreateForm(TDebugForm, DebugForm);
    3434  Application.CreateForm(TGameResultForm, GameResultForm);
    3535  {$IFDEF DEBUG}
Note: See TracChangeset for help on using the changeset viewer.