Changeset 34 for trunk/Components


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
23 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);
Note: See TracChangeset for help on using the changeset viewer.