Changeset 38


Ignore:
Timestamp:
Apr 18, 2019, 3:34:38 PM (5 years ago)
Author:
chronos
Message:
Location:
trunk
Files:
2 added
32 edited

Legend:

Unmodified
Added
Removed

  • trunk/Components/Common/Common.lpk

    r34 r38  
    1111      <PathDelim Value="\"/>
    1212      <SearchPaths>
    13         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     13        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    1414      </SearchPaths>
     15      <Parsing>
     16        <SyntaxOptions>
     17          <SyntaxMode Value="Delphi"/>
     18          <CStyleOperator Value="False"/>
     19          <AllowLabel Value="False"/>
     20          <CPPInline Value="False"/>
     21        </SyntaxOptions>
     22      </Parsing>
     23      <CodeGeneration>
     24        <Optimizations>
     25          <OptimizationLevel Value="0"/>
     26        </Optimizations>
     27      </CodeGeneration>
     28      <Linking>
     29        <Debugging>
     30          <GenerateDebugInfo Value="False"/>
     31        </Debugging>
     32      </Linking>
     33      <Other>
     34        <CompilerMessages>
     35          <IgnoredMessages idx5024="True"/>
     36        </CompilerMessages>
     37      </Other>
    1538    </CompilerOptions>
    1639    <Description Value="Various libraries"/>
    1740    <License Value="GNU/GPL"/>
    1841    <Version Minor="7"/>
    19     <Files Count="20">
     42    <Files Count="22">
    2043      <Item1>
    2144        <Filename Value="StopWatch.pas"/>
    … …  
    3760      <Item5>
    3861        <Filename Value="UPrefixMultiplier.pas"/>
     62        <HasRegisterProc Value="True"/>
    3963        <UnitName Value="UPrefixMultiplier"/>
    4064      </Item5>
    … …  
    106130        <UnitName Value="UScaleDPI"/>
    107131      </Item20>
     132      <Item21>
     133        <Filename Value="UTheme.pas"/>
     134        <HasRegisterProc Value="True"/>
     135        <UnitName Value="UTheme"/>
     136      </Item21>
     137      <Item22>
     138        <Filename Value="UStringTable.pas"/>
     139        <UnitName Value="UStringTable"/>
     140      </Item22>
    108141    </Files>
    109142    <i18n>
    … …  
    112145      <EnableI18NForLFM Value="True"/>
    113146    </i18n>
    114     <RequiredPkgs Count="3">
     147    <RequiredPkgs Count="2">
    115148      <Item1>
    116149        <PackageName Value="LCL"/>
    117150      </Item1>
    118151      <Item2>
    119         <PackageName Value="TemplateGenerics"/>
    120       </Item2>
    121       <Item3>
    122152        <PackageName Value="FCL"/>
    123153        <MinVersion Major="1" Valid="True"/>
    124       </Item3>
     154      </Item2>
    125155    </RequiredPkgs>
    126156    <UsageOptions>

  • trunk/Components/Common/Common.pas

    r34 r38  
    55unit Common;
    66
     7{$warn 5023 off : no warning about unused units}
    78interface
    89
    … …  
    1112  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
    1213  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
    13   UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf;
     14  UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable,
     15  LazarusPackageIntf;
    1416
    1517implementation
    … …  
    1820begin
    1921  RegisterUnit('UDebugLog', @UDebugLog.Register);
     22  RegisterUnit('UPrefixMultiplier', @UPrefixMultiplier.Register);
    2023  RegisterUnit('ULastOpenedList', @ULastOpenedList.Register);
    2124  RegisterUnit('UJobProgressView', @UJobProgressView.Register);
    … …  
    2528  RegisterUnit('UFindFile', @UFindFile.Register);
    2629  RegisterUnit('UScaleDPI', @UScaleDPI.Register);
     30  RegisterUnit('UTheme', @UTheme.Register);
    2731end;
    2832

  • trunk/Components/Common/Languages/UFindFile.cs.po

    r34 r38  
    1515msgid "Directory not found"
    1616msgstr "Adresář nenalezen"
     17

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

    r34 r38  
    2525
    2626#: ujobprogressview.soperations
    27 msgid "Operations"
     27#, fuzzy
     28#| msgid "Operations"
     29msgid "Operations:"
    2830msgstr "Operace"
    2931

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

    r34 r38  
    1515
    1616#: ujobprogressview.soperations
    17 msgid "Operations"
     17msgid "Operations:"
    1818msgstr ""
    1919

  • trunk/Components/Common/Languages/UScaleDPI.cs.po

    r34 r38  
    1515msgid "Wrong DPI [%d,%d]"
    1616msgstr "Chybné DPI [%d,%d]"
     17

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

    r31 r38  
    33
    44#: uthreading.scurrentthreadnotfound
     5#, fuzzy,badformat
    56msgid "Current thread ID %d not found in virtual thread list."
    67msgstr "Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8Content-Type: text/plain; charset=UTF-8"

  • trunk/Components/Common/UApplicationInfo.pas

    r34 r38  
    66
    77uses
    8   SysUtils, Registry, Classes, Forms, URegistry;
     8  SysUtils, Classes, Forms, URegistry, Controls;
    99
    1010type
    … …  
    1414  TApplicationInfo = class(TComponent)
    1515  private
     16    FDescription: TCaption;
    1617    FIdentification: Byte;
    1718    FLicense: string;
    … …  
    3334    constructor Create(AOwner: TComponent); override;
    3435    property Version: string read GetVersion;
     36    function GetRegistryContext: TRegistryContext;
    3537  published
    3638    property Identification: Byte read FIdentification write FIdentification;
    … …  
    4547    property EmailContact: string read FEmailContact write FEmailContact;
    4648    property AppName: string read FAppName write FAppName;
     49    property Description: string read FDescription write FDescription;
    4750    property ReleaseDate: TDateTime read FReleaseDate write FReleaseDate;
    4851    property RegistryKey: string read FRegistryKey write FRegistryKey;
    … …  
    5457
    5558implementation
    56                        
     59
    5760procedure Register;
    5861begin
    … …  
    7982end;
    8083
     84function TApplicationInfo.GetRegistryContext: TRegistryContext;
     85begin
     86  Result := TRegistryContext.Create(RegistryRoot, RegistryKey);
     87end;
     88
    8189end.

  • trunk/Components/Common/UCommon.pas

    r34 r38  
    2727    unfNameServicePrincipal = 10,  // Generalized service principal name
    2828    unfDNSDomainName = 11);
     29
     30  TFilterMethod = function (FileName: string): Boolean of object;
     31  TFileNameMethod = procedure (FileName: string) of object;
    2932
    3033var
    … …  
    6366procedure OpenWebPage(URL: string);
    6467procedure OpenFileInShell(FileName: string);
    65 procedure ExecuteProgram(CommandLine: string);
     68procedure ExecuteProgram(Executable: string; Parameters: array of string);
    6669procedure FreeThenNil(var Obj);
    6770function RemoveQuotes(Text: string): string;
    … …  
    7174function MergeArray(A, B: array of string): TArrayOfString;
    7275function LoadFileToStr(const FileName: TFileName): AnsiString;
     76procedure SaveStringToFile(S, FileName: string);
     77procedure SearchFiles(AList: TStrings; Dir: string;
     78  FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
     79function GetStringPart(var Text: string; Separator: string): string;
     80function StripTags(const S: string): string;
     81function PosFromIndex(SubStr: string; Text: string;
     82  StartIndex: Integer): Integer;
     83function PosFromIndexReverse(SubStr: string; Text: string;
     84  StartIndex: Integer): Integer;
     85procedure CopyStringArray(Dest: TStringArray; Source: array of string);
    7386
    7487
    … …  
    98111  I: Integer;
    99112begin
     113  Result := '';
    100114  for I := 1 to Length(Source) do begin
    101115    Result := Result + LowerCase(IntToHex(Ord(Source[I]), 2));
    … …  
    112126  Path := IncludeTrailingPathDelimiter(APath);
    113127
    114   Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec);
     128  Find := FindFirst(Path + AFileSpec, faAnyFile xor faDirectory, SearchRec);
    115129  while Find = 0 do begin
    116     DeleteFile(Path + UTF8Encode(SearchRec.Name));
     130    DeleteFile(Path + SearchRec.Name);
    117131
    118132    Find := SysUtils.FindNext(SearchRec);
    … …  
    429443end;
    430444
    431 procedure ExecuteProgram(CommandLine: string);
     445procedure ExecuteProgram(Executable: string; Parameters: array of string);
    432446var
    433447  Process: TProcess;
     448  I: Integer;
    434449begin
    435450  try
    436451    Process := TProcess.Create(nil);
    437     Process.CommandLine := CommandLine;
     452    Process.Executable := Executable;
     453    for I := 0 to Length(Parameters) - 1 do
     454      Process.Parameters.Add(Parameters[I]);
    438455    Process.Options := [poNoConsole];
    439456    Process.Execute;
    … …  
    456473procedure OpenFileInShell(FileName: string);
    457474begin
    458   ExecuteProgram('cmd.exe /c start "' + FileName + '"');
     475  ExecuteProgram('cmd.exe', ['/c', 'start', FileName]);
    459476end;
    460477
    … …  
    511528end;
    512529
     530function DefaultSearchFilter(const FileName: string): Boolean;
     531begin
     532  Result := True;
     533end;
     534
     535procedure SaveStringToFile(S, FileName: string);
     536var
     537  F: TextFile;
     538begin
     539  AssignFile(F, FileName);
     540  try
     541    ReWrite(F);
     542    Write(F, S);
     543  finally
     544    CloseFile(F);
     545  end;
     546end;
     547
     548procedure SearchFiles(AList: TStrings; Dir: string;
     549  FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
     550var
     551  SR: TSearchRec;
     552begin
     553  Dir := IncludeTrailingPathDelimiter(Dir);
     554  if FindFirst(Dir + '*', faAnyFile, SR) = 0 then
     555    try
     556      repeat
     557        if (SR.Name = '.') or (SR.Name = '..') or (Assigned(FilterMethod) and (not FilterMethod(SR.Name) or
     558          not FilterMethod(Copy(Dir, 3, Length(Dir)) + SR.Name))) then Continue;
     559        if Assigned(FileNameMethod) then
     560          FileNameMethod(Dir + SR.Name);
     561        AList.Add(Dir + SR.Name);
     562        if (SR.Attr and faDirectory) <> 0 then
     563          SearchFiles(AList, Dir + SR.Name, FilterMethod);
     564      until FindNext(SR) <> 0;
     565    finally
     566      FindClose(SR);
     567    end;
     568end;
     569
     570function GetStringPart(var Text: string; Separator: string): string;
     571var
     572  P: Integer;
     573begin
     574  P := Pos(Separator, Text);
     575  if P > 0 then begin
     576    Result := Copy(Text, 1, P - 1);
     577    Delete(Text, 1, P - 1 + Length(Separator));
     578  end else begin
     579    Result := Text;
     580    Text := '';
     581  end;
     582  Result := Trim(Result);
     583  Text := Trim(Text);
     584end;
     585
     586function StripTags(const S: string): string;
     587var
     588  Len: Integer;
     589
     590  function ReadUntil(const ReadFrom: Integer; const C: Char): Integer;
     591  var
     592    J: Integer;
     593  begin
     594    for J := ReadFrom to Len do
     595      if (S[j] = C) then
     596      begin
     597        Result := J;
     598        Exit;
     599      end;
     600    Result := Len + 1;
     601  end;
     602
     603var
     604  I, APos: Integer;
     605begin
     606  Len := Length(S);
     607  I := 0;
     608  Result := '';
     609  while (I <= Len) do begin
     610    Inc(I);
     611    APos := ReadUntil(I, '<');
     612    Result := Result + Copy(S, I, APos - i);
     613    I := ReadUntil(APos + 1, '>');
     614  end;
     615end;
     616
     617function PosFromIndex(SubStr: string; Text: string;
     618  StartIndex: Integer): Integer;
     619var
     620  I, MaxLen: SizeInt;
     621  Ptr: PAnsiChar;
     622begin
     623  Result := 0;
     624  if (StartIndex < 1) or (StartIndex > Length(Text) - Length(SubStr)) then Exit;
     625  if Length(SubStr) > 0 then begin
     626    MaxLen := Length(Text) - Length(SubStr) + 1;
     627    I := StartIndex;
     628    Ptr := @Text[StartIndex];
     629    while (I <= MaxLen) do begin
     630      if (SubStr[1] = Ptr^) and (CompareByte(Substr[1], Ptr^, Length(SubStr)) = 0) then begin
     631        Result := I;
     632        Exit;
     633      end;
     634      Inc(I);
     635      Inc(Ptr);
     636    end;
     637  end;
     638end;
     639
     640function PosFromIndexReverse(SubStr: string; Text: string;
     641  StartIndex: Integer): Integer;
     642var
     643  I: SizeInt;
     644  Ptr: PAnsiChar;
     645begin
     646  Result := 0;
     647  if (StartIndex < 1) or (StartIndex > Length(Text)) then Exit;
     648  if Length(SubStr) > 0 then begin
     649    I := StartIndex;
     650    Ptr := @Text[StartIndex];
     651    while (I > 0) do begin
     652      if (SubStr[1] = Ptr^) and (CompareByte(Substr[1], Ptr^, Length(SubStr)) = 0) then begin
     653        Result := I;
     654        Exit;
     655      end;
     656      Dec(I);
     657      Dec(Ptr);
     658    end;
     659  end;
     660end;
     661
     662procedure CopyStringArray(Dest: TStringArray; Source: array of string);
     663var
     664  I: Integer;
     665begin
     666  SetLength(Dest, Length(Source));
     667  for I := 0 to Length(Dest) - 1 do
     668    Dest[I] := Source[I];
     669end;
    513670
    514671

  • trunk/Components/Common/UDebugLog.pas

    r34 r38  
    66
    77uses
    8   Classes, SysUtils, FileUtil, SpecializedList, SyncObjs;
     8  Classes, SysUtils, FileUtil, fgl, SyncObjs;
    99
    1010type
    … …  
    2929    procedure SetMaxCount(const AValue: Integer);
    3030  public
    31     Items: TListObject;
     31    Items: TFPGObjectList<TDebugLogItem>;
    3232    Lock: TCriticalSection;
    3333    procedure Add(Text: string; Group: string = '');
    … …  
    104104    if ExtractFileDir(FileName) <> '' then
    105105      ForceDirectories(ExtractFileDir(FileName));
    106     if FileExists(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
    107       else LogFile := TFileStream.Create(UTF8Decode(FileName), fmCreate);
     106    if FileExists(FileName) then LogFile := TFileStream.Create(FileName, fmOpenWrite)
     107      else LogFile := TFileStream.Create(FileName, fmCreate);
    108108    LogFile.Seek(0, soFromEnd);
    109109    Text := FormatDateTime('hh:nn:ss.zzz', Now) + ': ' + Text + LineEnding;
    … …  
    117117begin
    118118  inherited;
    119   Items := TListObject.Create;
     119  Items := TFPGObjectList<TDebugLogItem>.Create;
    120120  Lock := TCriticalSection.Create;
    121121  MaxCount := 100;

  • trunk/Components/Common/UFindFile.pas

    r34 r38  
    2424
    2525uses
    26   SysUtils, Classes, Graphics, Controls, Forms, Dialogs, FileCtrl;
     26  SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
    2727
    2828type
    … …  
    117117  Attr := 0;
    118118  if ffaReadOnly in FileAttr then Attr := Attr + faReadOnly;
    119   if ffaHidden in FileAttr then Attr := Attr + faHidden;
    120   if ffaSysFile in FileAttr then Attr := Attr + faSysFile;
    121   if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;
     119  if ffaHidden in FileAttr then Attr := Attr + 2; //faHidden; use constant to avoid platform warning
     120  if ffaSysFile in FileAttr then Attr := Attr + 4; //faSysFile; use constant to avoid platform warning
     121  // Deprecated: if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;
    122122  if ffaDirectory in FileAttr then Attr := Attr + faDirectory;
    123123  if ffaArchive in FileAttr then Attr := Attr + faArchive;
    124124  if ffaAnyFile in FileAttr then Attr := Attr + faAnyFile;
    125125
    126   if SysUtils.FindFirst(UTF8Decode(inPath + FileMask), Attr, Rec) = 0 then
     126  if SysUtils.FindFirst(inPath + FileMask, Attr, Rec) = 0 then
    127127  try
    128128    repeat
    129       s.Add(inPath + UTF8Encode(Rec.Name));
     129      s.Add(inPath + Rec.Name);
    130130    until SysUtils.FindNext(Rec) <> 0;
    131131  finally
    … …  
    135135  If not InSubFolders then Exit;
    136136
    137   if SysUtils.FindFirst(UTF8Decode(inPath + FilterAll), faDirectory, Rec) = 0 then
     137  if SysUtils.FindFirst(inPath + FilterAll, faDirectory, Rec) = 0 then
    138138  try
    139139    repeat
    140140      if ((Rec.Attr and faDirectory) > 0) and (Rec.Name <> '.')
    141141      and (Rec.Name <> '..') then
    142         FileSearch(IncludeTrailingBackslash(inPath + UTF8Encode(Rec.Name)));
     142        FileSearch(IncludeTrailingBackslash(inPath + Rec.Name));
    143143    until SysUtils.FindNext(Rec) <> 0;
    144144  finally

  • trunk/Components/Common/UJobProgressView.lfm

    r34 r38  
    11object FormJobProgressView: TFormJobProgressView
    22  Left = 467
    3   Height = 246
     3  Height = 345
    44  Top = 252
    5   Width = 328
     5  Width = 539
    66  BorderIcons = [biSystemMenu]
    7   ClientHeight = 246
    8   ClientWidth = 328
    9   Font.Height = -11
    10   Font.Name = 'MS Sans Serif'
     7  ClientHeight = 345
     8  ClientWidth = 539
     9  DesignTimePPI = 120
    1110  OnClose = FormClose
    1211  OnCloseQuery = FormCloseQuery
    1312  OnCreate = FormCreate
    1413  OnDestroy = FormDestroy
     14  OnHide = FormHide
     15  OnShow = FormShow
    1516  Position = poScreenCenter
    16   LCLVersion = '1.6.0.4'
     17  LCLVersion = '1.8.2.0'
    1718  object PanelOperationsTitle: TPanel
    1819    Left = 0
    19     Height = 24
     20    Height = 32
    2021    Top = 0
    21     Width = 328
    22     Align = alTop
    23     BevelOuter = bvNone
    24     ClientHeight = 24
    25     ClientWidth = 328
     22    Width = 539
     23    Align = alTop
     24    BevelOuter = bvNone
     25    ClientHeight = 32
     26    ClientWidth = 539
    2627    FullRepaint = False
    2728    TabOrder = 0
    2829    object LabelOperation: TLabel
    2930      Left = 8
    30       Height = 13
     31      Height = 20
    3132      Top = 8
    32       Width = 66
     33      Width = 76
    3334      Caption = 'Operations:'
    34       Font.Height = -11
    35       Font.Name = 'MS Sans Serif'
    36       Font.Style = [fsBold]
    3735      ParentColor = False
    3836      ParentFont = False
    … …  
    4139  object PanelLog: TPanel
    4240    Left = 0
    43     Height = 122
    44     Top = 124
    45     Width = 328
     41    Height = 133
     42    Top = 212
     43    Width = 539
    4644    Align = alClient
    4745    BevelOuter = bvSpace
    48     ClientHeight = 122
    49     ClientWidth = 328
     46    ClientHeight = 133
     47    ClientWidth = 539
    5048    TabOrder = 1
    5149    object MemoLog: TMemo
    5250      Left = 8
    53       Height = 106
     51      Height = 117
    5452      Top = 8
    55       Width = 312
     53      Width = 523
    5654      Anchors = [akTop, akLeft, akRight, akBottom]
    5755      ReadOnly = True
    … …  
    6260  object PanelProgress: TPanel
    6361    Left = 0
    64     Height = 38
    65     Top = 50
    66     Width = 328
    67     Align = alTop
    68     BevelOuter = bvNone
    69     ClientHeight = 38
    70     ClientWidth = 328
     62    Height = 54
     63    Top = 106
     64    Width = 539
     65    Align = alTop
     66    BevelOuter = bvNone
     67    ClientHeight = 54
     68    ClientWidth = 539
    7169    TabOrder = 2
    7270    object ProgressBarPart: TProgressBar
    73       Left = 8
    74       Height = 17
    75       Top = 16
    76       Width = 312
     71      Left = 10
     72      Height = 24
     73      Top = 24
     74      Width = 523
    7775      Anchors = [akTop, akLeft, akRight]
    7876      TabOrder = 0
    … …  
    8078    object LabelEstimatedTimePart: TLabel
    8179      Left = 8
    82       Height = 13
     80      Height = 20
    8381      Top = -2
    84       Width = 71
     82      Width = 103
    8583      Caption = 'Estimated time:'
    8684      ParentColor = False
    … …  
    8987  object PanelOperations: TPanel
    9088    Left = 0
    91     Height = 26
    92     Top = 24
    93     Width = 328
    94     Align = alTop
    95     BevelOuter = bvNone
    96     ClientHeight = 26
    97     ClientWidth = 328
     89    Height = 42
     90    Top = 64
     91    Width = 539
     92    Align = alTop
     93    BevelOuter = bvNone
     94    ClientHeight = 42
     95    ClientWidth = 539
    9896    FullRepaint = False
    9997    TabOrder = 3
    10098    object ListViewJobs: TListView
    10199      Left = 8
    102       Height = 16
     100      Height = 32
    103101      Top = 5
    104       Width = 312
     102      Width = 523
    105103      Anchors = [akTop, akLeft, akRight, akBottom]
    106104      AutoWidthLastColumn = True
    … …  
    109107      Columns = <     
    110108        item
    111           Width = 312
     109          Width = 523
    112110        end>
    113111      OwnerData = True
    … …  
    122120  object PanelProgressTotal: TPanel
    123121    Left = 0
    124     Height = 36
    125     Top = 88
    126     Width = 328
    127     Align = alTop
    128     BevelOuter = bvNone
    129     ClientHeight = 36
    130     ClientWidth = 328
     122    Height = 52
     123    Top = 160
     124    Width = 539
     125    Align = alTop
     126    BevelOuter = bvNone
     127    ClientHeight = 52
     128    ClientWidth = 539
    131129    TabOrder = 4
    132130    object LabelEstimatedTimeTotal: TLabel
    133131      Left = 8
    134       Height = 13
     132      Height = 20
    135133      Top = 0
    136       Width = 97
     134      Width = 141
    137135      Caption = 'Total estimated time:'
    138136      ParentColor = False
    … …  
    140138    object ProgressBarTotal: TProgressBar
    141139      Left = 8
    142       Height = 16
    143       Top = 16
    144       Width = 312
     140      Height = 24
     141      Top = 24
     142      Width = 523
    145143      Anchors = [akTop, akLeft, akRight]
    146144      TabOrder = 0
     145    end
     146  end
     147  object PanelText: TPanel
     148    Left = 0
     149    Height = 32
     150    Top = 32
     151    Width = 539
     152    Align = alTop
     153    BevelOuter = bvNone
     154    ClientHeight = 32
     155    ClientWidth = 539
     156    TabOrder = 5
     157    object LabelText: TLabel
     158      Left = 8
     159      Height = 24
     160      Top = 8
     161      Width = 525
     162      Anchors = [akTop, akLeft, akRight]
     163      AutoSize = False
     164      ParentColor = False
    147165    end
    148166  end

  • trunk/Components/Common/UJobProgressView.pas

    r34 r38  
    77uses
    88  SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs,
    9   Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading,
     9  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading, Math,
    1010  DateUtils;
    1111
    … …  
    1313  EstimatedTimeShowTreshold = 4;
    1414  EstimatedTimeShowTresholdTotal = 1;
    15   MemoLogHeight = 200;
    1615  UpdateInterval = 100; // ms
    1716
    … …  
    2423    FLock: TCriticalSection;
    2524    FOnChange: TNotifyEvent;
     25    FText: string;
    2626    FValue: Integer;
    2727    FMax: Integer;
    2828    procedure SetMax(const AValue: Integer);
     29    procedure SetText(AValue: string);
    2930    procedure SetValue(const AValue: Integer);
    3031  public
    … …  
    3536    property Value: Integer read FValue write SetValue;
    3637    property Max: Integer read FMax write SetMax;
     38    property Text: string read FText write SetText;
    3739    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    3840  end;
    … …  
    6971  end;
    7072
     73  TJobs = class(TObjectList)
     74  end;
     75
    7176  TJobThread = class(TListedThread)
    7277    procedure Execute; override;
    … …  
    8085  TFormJobProgressView = class(TForm)
    8186    ImageList1: TImageList;
     87    LabelText: TLabel;
    8288    Label2: TLabel;
    8389    LabelOperation: TLabel;
    … …  
    8692    ListViewJobs: TListView;
    8793    MemoLog: TMemo;
     94    PanelText: TPanel;
    8895    PanelProgressTotal: TPanel;
    8996    PanelOperationsTitle: TPanel;
    … …  
    94101    ProgressBarTotal: TProgressBar;
    95102    TimerUpdate: TTimer;
     103    procedure FormHide(Sender: TObject);
     104    procedure FormShow(Sender: TObject);
     105    procedure ReloadJobList;
    96106    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    97107    procedure FormDestroy(Sender: TObject);
    … …  
    100110    procedure FormCreate(Sender: TObject);
    101111    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     112    procedure UpdateHeight;
    102113  public
    103114    JobProgressView: TJobProgressView;
    … …  
    118129    TotalStartTime: TDateTime;
    119130    Log: TStringList;
     131    FForm: TFormJobProgressView;
    120132    procedure SetTerminate(const AValue: Boolean);
    121133    procedure UpdateProgress;
    122     procedure ReloadJobList;
    123     procedure StartJobs;
    124     procedure UpdateHeight;
    125134    procedure JobProgressChange(Sender: TObject);
    126135  public
    127     Form: TFormJobProgressView;
    128     Jobs: TObjectList; // TListObject<TJob>
     136    Jobs: TJobs;
    129137    CurrentJob: TJob;
    130138    CurrentJobIndex: Integer;
    … …  
    132140    destructor Destroy; override;
    133141    procedure Clear;
    134     procedure AddJob(Title: string; Method: TJobProgressViewMethod;
    135       NoThreaded: Boolean = False; WaitFor: Boolean = False);
    136     procedure Start(AAutoClose: Boolean = True);
     142    function AddJob(Title: string; Method: TJobProgressViewMethod;
     143      NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     144    procedure Start;
    137145    procedure Stop;
    138146    procedure TermSleep(Delay: Integer);
     147    property Form: TFormJobProgressView read FForm;
    139148    property Terminate: Boolean read FTerminate write SetTerminate;
    140149  published
    … …  
    166175  STotalEstimatedTime = 'Total estimated time: %s';
    167176  SFinished = 'Finished';
    168   SOperations = 'Operations';
     177  SOperations = 'Operations:';
    169178
    170179procedure Register;
    … …  
    172181  RegisterComponents('Common', [TJobProgressView]);
    173182end;
     183
     184{ TJobThread }
    174185
    175186procedure TJobThread.Execute;
    … …  
    190201end;
    191202
    192 procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
    193   NoThreaded: Boolean = False; WaitFor: Boolean = False);
     203{ TFormJobProgressView }
     204
     205procedure TFormJobProgressView.UpdateHeight;
    194206var
    195   NewJob: TJob;
    196 begin
    197   NewJob := TJob.Create;
    198   NewJob.ProgressView := Self;
    199   NewJob.Title := Title;
    200   NewJob.Method := Method;
    201   NewJob.NoThreaded := NoThreaded;
    202   NewJob.WaitFor := WaitFor;
    203   NewJob.Progress.Max := 100;
    204   NewJob.Progress.Reset;
    205   NewJob.Progress.OnChange := JobProgressChange;
    206   Jobs.Add(NewJob);
     207  H: Integer;
     208  PanelOperationsVisible: Boolean;
     209  PanelOperationsHeight: Integer;
     210  PanelProgressVisible: Boolean;
     211  PanelProgressTotalVisible: Boolean;
     212  PanelLogVisible: Boolean;
     213  MemoLogHeight: Integer = 200;
     214  I: Integer;
     215  ItemRect: TRect;
     216  MaxH: Integer;
     217begin
     218    H := PanelOperationsTitle.Height;
     219    PanelOperationsVisible := JobProgressView.Jobs.Count > 0;
     220    if PanelOperationsVisible <> PanelOperations.Visible then
     221      PanelOperations.Visible := PanelOperationsVisible;
     222    if ListViewJobs.Items.Count > 0 then begin
     223      Maxh := 0;
     224      for I := 0 to ListViewJobs.Items.Count - 1 do
     225      begin
     226        ItemRect := ListViewJobs.Items[i].DisplayRect(drBounds);
     227        Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top));
     228      end;
     229      PanelOperationsHeight := Scale96ToScreen(12) + Maxh;
     230    end else PanelOperationsHeight := Scale96ToScreen(8);
     231    if PanelOperationsHeight <> PanelOperations.Height then
     232      PanelOperations.Height := PanelOperationsHeight;
     233    if PanelOperationsVisible then
     234      H := H + PanelOperations.Height;
     235
     236    PanelProgressVisible := (JobProgressView.Jobs.Count > 0) and not JobProgressView.Finished;
     237    if PanelProgressVisible <> PanelProgress.Visible then
     238      PanelProgress.Visible := PanelProgressVisible;
     239    if PanelProgressVisible then
     240      H := H + PanelProgress.Height;
     241    PanelProgressTotalVisible := (JobProgressView.Jobs.Count > 1) and not JobProgressView.Finished;
     242    if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
     243      PanelProgressTotal.Visible := PanelProgressTotalVisible;
     244    if PanelProgressTotalVisible then
     245      H := H + PanelProgressTotal.Height;
     246    Constraints.MinHeight := H;
     247    PanelLogVisible := MemoLog.Lines.Count > 0;
     248    if PanelLogVisible <> PanelLog.Visible then
     249      PanelLog.Visible := PanelLogVisible;
     250    if PanelLogVisible then
     251      H := H + Scale96ToScreen(MemoLogHeight);
     252    if PanelText.Visible then
     253      H := H + PanelText.Height;
     254    if Height <> H then begin
     255      Height := H;
     256      Top := (Screen.Height - H) div 2;
     257    end;
     258end;
     259
     260procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
     261var
     262  ProgressBarPartVisible: Boolean;
     263  ProgressBarTotalVisible: Boolean;
     264begin
     265  JobProgressView.UpdateProgress;
     266  if Visible and (not ProgressBarPart.Visible) and
     267  Assigned(JobProgressView.CurrentJob) and
     268  (JobProgressView.CurrentJob.Progress.Value > 0) then begin
     269    ProgressBarPartVisible := True;
     270    if ProgressBarPartVisible <> ProgressBarPart.Visible then
     271      ProgressBarPart.Visible := ProgressBarPartVisible;
     272    ProgressBarTotalVisible := True;
     273    if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
     274      ProgressBarTotal.Visible := ProgressBarTotalVisible;
     275  end;
     276  if not Visible then begin
     277    TimerUpdate.Interval := UpdateInterval;
     278    if not JobProgressView.OwnerDraw then Show;
     279  end;
     280  if Assigned(JobProgressView.CurrentJob) then begin
     281    LabelText.Caption := JobProgressView.CurrentJob.Progress.Text;
     282    if LabelText.Caption <> '' then begin
     283      PanelText.Visible := True;
     284      UpdateHeight;
     285    end;
     286  end;
     287end;
     288
     289procedure TFormJobProgressView.FormDestroy(Sender:TObject);
     290begin
     291end;
     292
     293procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
     294begin
     295  if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
     296  with TJob(JobProgressView.Jobs[Item.Index]) do begin
     297    Item.Caption := Title;
     298    if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
     299      else if Finished then Item.ImageIndex := 0
     300      else Item.ImageIndex := 2;
     301    Item.Data := JobProgressView.Jobs[Item.Index];
     302  end;
     303end;
     304
     305procedure TFormJobProgressView.FormClose(Sender: TObject;
     306  var CloseAction: TCloseAction);
     307begin
     308end;
     309
     310procedure TFormJobProgressView.FormCreate(Sender: TObject);
     311begin
     312  Caption := SPleaseWait;
     313  try
     314    //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
     315    //  DirectorySeparator + 'horse.avi';
     316    //Animate1.Active := True;
     317  except
     318
     319  end;
     320end;
     321
     322procedure TFormJobProgressView.ReloadJobList;
     323begin
     324  // Workaround for not showing first line
     325  //Form.ListViewJobs.Items.Count := Jobs.Count + 1;
     326  //Form.ListViewJobs.Refresh;
     327
     328  if ListViewJobs.Items.Count <> JobProgressView.Jobs.Count then
     329    ListViewJobs.Items.Count := JobProgressView.Jobs.Count;
     330  ListViewJobs.Refresh;
     331  Application.ProcessMessages;
     332  UpdateHeight;
     333end;
     334
     335procedure TFormJobProgressView.FormShow(Sender: TObject);
     336begin
     337  ReloadJobList;
     338end;
     339
     340procedure TFormJobProgressView.FormHide(Sender: TObject);
     341begin
     342  JobProgressView.Jobs.Clear;
     343  ReloadJobList;
     344end;
     345
     346procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     347begin
     348  CanClose := JobProgressView.Finished;
     349  JobProgressView.Terminate := True;
     350  Caption := SPleaseWait + STerminate;
     351end;
     352
     353
     354{ TJobProgressView }
     355
     356function TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
     357  NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     358begin
     359  Result := TJob.Create;
     360  Result.ProgressView := Self;
     361  Result.Title := Title;
     362  Result.Method := Method;
     363  Result.NoThreaded := NoThreaded;
     364  Result.WaitFor := WaitFor;
     365  Result.Progress.Max := 100;
     366  Result.Progress.Reset;
     367  Result.Progress.OnChange := JobProgressChange;
     368  Jobs.Add(Result);
    207369  //ReloadJobList;
    208370end;
    209371
    210 procedure TJobProgressView.Start(AAutoClose: Boolean = True);
    211 begin
    212   AutoClose := AAutoClose;
    213   StartJobs;
    214 end;
    215 
    216 procedure TJobProgressView.StartJobs;
     372procedure TJobProgressView.Start;
    217373var
    218374  I: Integer;
    … …  
    229385    Form.MemoLog.Clear;
    230386
     387    Form.PanelText.Visible := False;
    231388    Form.LabelEstimatedTimePart.Visible := False;
    232389    Form.LabelEstimatedTimeTotal.Visible := False;
    … …  
    258415      Form.ProgressBarPart.Visible := False;
    259416      //Show;
    260       ReloadJobList;
     417      Form.ReloadJobList;
    261418      Application.ProcessMessages;
    262419      if NoThreaded then begin
    … …  
    296453    //if Visible then Hide;
    297454    Form.MemoLog.Lines.Assign(Log);
    298     if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin
     455    if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin
    299456      Form.Hide;
    300457    end;
    301     Clear;
     458    if not Form.Visible then Clear;
    302459    Form.Caption := SFinished;
    303460    //LabelEstimatedTimePart.Visible := False;
    304461    Finished := True;
    305462    CurrentJobIndex := -1;
    306     ReloadJobList;
    307   end;
    308 end;
    309 
    310 procedure TJobProgressView.UpdateHeight;
    311 var
    312   H: Integer;
    313   PanelOperationsVisible: Boolean;
    314   PanelOperationsHeight: Integer;
    315   PanelProgressVisible: Boolean;
    316   PanelProgressTotalVisible: Boolean;
    317   PanelLogVisible: Boolean;
    318 begin
    319   with Form do begin
    320   H := PanelOperationsTitle.Height;
    321   PanelOperationsVisible := Jobs.Count > 0;
    322   if PanelOperationsVisible <> PanelOperations.Visible then
    323     PanelOperations.Visible := PanelOperationsVisible;
    324   PanelOperationsHeight := 8 + 18 * Jobs.Count;
    325   if PanelOperationsHeight <> PanelOperations.Height then
    326     PanelOperations.Height := PanelOperationsHeight;
    327   if PanelOperationsVisible then
    328     H := H + PanelOperations.Height;
    329 
    330   PanelProgressVisible := (Jobs.Count > 0) and not Finished;
    331   if PanelProgressVisible <> PanelProgress.Visible then
    332     PanelProgress.Visible := PanelProgressVisible;
    333   if PanelProgressVisible then
    334     H := H + PanelProgress.Height;
    335   PanelProgressTotalVisible := (Jobs.Count > 1) and not Finished;
    336   if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
    337     PanelProgressTotal.Visible := PanelProgressTotalVisible;
    338   if PanelProgressTotalVisible then
    339     H := H + PanelProgressTotal.Height;
    340   Constraints.MinHeight := H;
    341   PanelLogVisible := MemoLog.Lines.Count > 0;
    342   if PanelLogVisible <> PanelLog.Visible then
    343     PanelLog.Visible := PanelLogVisible;
    344   if PanelLogVisible then
    345     H := H + MemoLogHeight;
    346   if Height <> H then Height := H;
     463    Form.ReloadJobList;
    347464  end;
    348465end;
    … …  
    352469  if Assigned(FOnOwnerDraw) then
    353470    FOnOwnerDraw(Self);
    354 end;
    355 
    356 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
    357 var
    358   ProgressBarPartVisible: Boolean;
    359   ProgressBarTotalVisible: Boolean;
    360 begin
    361   JobProgressView.UpdateProgress;
    362   if Visible and (not ProgressBarPart.Visible) and
    363   Assigned(JobProgressView.CurrentJob) and
    364   (JobProgressView.CurrentJob.Progress.Value > 0) then begin
    365     ProgressBarPartVisible := True;
    366     if ProgressBarPartVisible <> ProgressBarPart.Visible then
    367       ProgressBarPart.Visible := ProgressBarPartVisible;
    368     ProgressBarTotalVisible := True;
    369     if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
    370       ProgressBarTotal.Visible := ProgressBarTotalVisible;
    371   end;
    372   if not Visible then begin
    373     TimerUpdate.Interval := UpdateInterval;
    374     if not JobProgressView.OwnerDraw then Show;
    375   end;
    376 end;
    377 
    378 procedure TFormJobProgressView.FormDestroy(Sender:TObject);
    379 begin
    380 end;
    381 
    382 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
    383 begin
    384   if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
    385   with TJob(JobProgressView.Jobs[Item.Index]) do begin
    386     Item.Caption := Title;
    387     if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
    388       else if Finished then Item.ImageIndex := 0
    389       else Item.ImageIndex := 2;
    390     Item.Data := JobProgressView.Jobs[Item.Index];
    391   end;
    392 end;
    393 
    394 procedure TFormJobProgressView.FormClose(Sender: TObject;
    395   var CloseAction: TCloseAction);
    396 begin
    397   ListViewJobs.Clear;
    398 end;
    399 
    400 procedure TFormJobProgressView.FormCreate(Sender: TObject);
    401 begin
    402   Caption := SPleaseWait;
    403   try
    404     //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
    405     //  DirectorySeparator + 'horse.avi';
    406     //Animate1.Active := True;
    407   except
    408 
    409   end;
    410471end;
    411472
    … …  
    426487    Sleep(Quantum);
    427488  end;
    428 end;
    429 
    430 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    431 begin
    432   CanClose := JobProgressView.Finished;
    433   JobProgressView.Terminate := True;
    434   Caption := SPleaseWait + STerminate;
    435489end;
    436490
    … …  
    490544end;
    491545
    492 procedure TJobProgressView.ReloadJobList;
    493 begin
    494   UpdateHeight;
    495   // Workaround for not showing first line
    496   Form.ListViewJobs.Items.Count := Jobs.Count + 1;
    497   Form.ListViewJobs.Refresh;
    498 
    499   if Form.ListViewJobs.Items.Count <> Jobs.Count then
    500     Form.ListViewJobs.Items.Count := Jobs.Count;
    501   Form.ListViewJobs.Refresh;
    502   //Application.ProcessMessages;
    503 end;
    504 
    505546constructor TJobProgressView.Create(TheOwner: TComponent);
    506547begin
    507548  inherited;
    508549  if not (csDesigning in ComponentState) then begin
    509     Form := TFormJobProgressView.Create(Self);
    510     Form.JobProgressView := Self;
    511   end;
    512   Jobs := TObjectList.Create;
     550    FForm := TFormJobProgressView.Create(Self);
     551    FForm.JobProgressView := Self;
     552  end;
     553  Jobs := TJobs.Create;
    513554  Log := TStringList.Create;
    514555  //PanelOperationsTitle.Height := 80;
    515   ShowDelay := 0; //1000; // ms
     556  AutoClose := True;
     557  ShowDelay := 0;
    516558end;
    517559
    … …  
    519561begin
    520562  Jobs.Clear;
     563  Log.Clear;
    521564  //ReloadJobList;
    522565end;
    … …  
    528571  inherited;
    529572end;
     573
     574{ TProgress }
    530575
    531576procedure TProgress.SetMax(const AValue: Integer);
    … …  
    536581    if FMax < 1 then FMax := 1;
    537582    if FValue >= FMax then FValue := FMax;
     583  finally
     584    FLock.Release;
     585  end;
     586end;
     587
     588procedure TProgress.SetText(AValue: string);
     589begin
     590  try
     591    FLock.Acquire;
     592    if FText = AValue then Exit;
     593    FText := AValue;
    538594  finally
    539595    FLock.Release;
    … …  
    563619end;
    564620
    565 { TProgress }
    566 
    567621procedure TProgress.Increment;
    568622begin

  • trunk/Components/Common/ULastOpenedList.pas

    r34 r38  
    66
    77uses
    8   Classes, SysUtils, Registry, URegistry, Menus, XMLConf;
     8  Classes, SysUtils, Registry, URegistry, Menus, XMLConf, DOM;
    99
    1010type
    … …  
    3030    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
    3131    procedure AddItem(FileName: string);
     32    function GetFirstFileName: string;
    3233  published
    3334    property MaxCount: Integer read FMaxCount write SetMaxCount;
    … …  
    139140    OpenKey(Context.Key, True);
    140141    for I := 0 to Items.Count - 1 do
    141       WriteString('File' + IntToStr(I), UTF8Decode(Items[I]));
     142      WriteString('File' + IntToStr(I), Items[I]);
    142143  finally
    143144    Free;
    … …  
    153154begin
    154155  with XMLConfig do begin
    155     Count := GetValue(Path + '/Count', 0);
     156    Count := GetValue(DOMString(Path + '/Count'), 0);
    156157    if Count > MaxCount then Count := MaxCount;
    157158    Items.Clear;
    158159    for I := 0 to Count - 1 do begin
    159       Value := GetValue(Path + '/File' + IntToStr(I), '');
     160      Value := string(GetValue(DOMString(Path + '/File' + IntToStr(I)), ''));
    160161      if Trim(Value) <> '' then Items.Add(Value);
    161162    end;
    … …  
    170171begin
    171172  with XMLConfig do begin
    172     SetValue(Path + '/Count', Items.Count);
     173    SetValue(DOMString(Path + '/Count'), Items.Count);
    173174    for I := 0 to Items.Count - 1 do
    174       SetValue(Path + '/File' + IntToStr(I), Items[I]);
     175      SetValue(DOMString(Path + '/File' + IntToStr(I)), DOMString(Items[I]));
    175176    Flush;
    176177  end;
    … …  
    185186end;
    186187
     188function TLastOpenedList.GetFirstFileName: string;
     189begin
     190  if Items.Count > 0 then Result := Items[0]
     191    else Result := '';
     192end;
     193
    187194end.
    188195

  • trunk/Components/Common/UListViewSort.pas

    r34 r38  
    99uses
    1010  {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,
    11   Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls,
     11  Controls, DateUtils, Dialogs, fgl, Forms, Grids, StdCtrls, ExtCtrls,
    1212  LclIntf, LMessages, LclType, LResources;
    1313
    … …  
    5252    {$ENDIF}
    5353  public
    54     List: TListObject;
    55     Source: TListObject;
     54    List: TFPGObjectList<TObject>;
     55    Source: TFPGObjectList<TObject>;
    5656    constructor Create(AOwner: TComponent); override;
    5757    destructor Destroy; override;
    … …  
    8181    FOnChange: TNotifyEvent;
    8282    FStringGrid1: TStringGrid;
    83     procedure DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    84     procedure DoOnResize(Sender: TObject);
     83    procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     84    procedure GridDoOnResize(Sender: TObject);
    8585  public
    8686    constructor Create(AOwner: TComponent); override;
    … …  
    9898  end;
    9999
     100  { TListViewEx }
     101
     102  TListViewEx = class(TWinControl)
     103  private
     104    FFilter: TListViewFilter;
     105    FListView: TListView;
     106    FListViewSort: TListViewSort;
     107    procedure ResizeHanlder;
     108  public
     109    constructor Create(TheOwner: TComponent); override;
     110    destructor Destroy; override;
     111  published
     112    property ListView: TListView read FListView write FListView;
     113    property ListViewSort: TListViewSort read FListViewSort write FListViewSort;
     114    property Filter: TListViewFilter read FFilter write FFilter;
     115    property Visible;
     116  end;
     117
    100118procedure Register;
    101119
    … …  
    105123procedure Register;
    106124begin
    107   RegisterComponents('Common', [TListViewSort, TListViewFilter]);
     125  RegisterComponents('Common', [TListViewSort, TListViewFilter, TListViewEx]);
     126end;
     127
     128{ TListViewEx }
     129
     130procedure TListViewEx.ResizeHanlder;
     131begin
     132end;
     133
     134constructor TListViewEx.Create(TheOwner: TComponent);
     135begin
     136  inherited Create(TheOwner);
     137  Filter := TListViewFilter.Create(Self);
     138  Filter.Parent := Self;
     139  Filter.Align := alBottom;
     140  ListView := TListView.Create(Self);
     141  ListView.Parent := Self;
     142  ListView.Align := alClient;
     143  ListViewSort := TListViewSort.Create(Self);
     144  ListViewSort.ListView := ListView;
     145end;
     146
     147destructor TListViewEx.Destroy;
     148begin
     149  inherited Destroy;
    108150end;
    109151
    110152{ TListViewFilter }
    111153
    112 procedure TListViewFilter.DoOnKeyUp(Sender: TObject; var Key: Word;
     154procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word;
    113155  Shift: TShiftState);
    114156begin
    … …  
    117159end;
    118160
    119 procedure TListViewFilter.DoOnResize(Sender: TObject);
     161procedure TListViewFilter.GridDoOnResize(Sender: TObject);
    120162begin
    121163  FStringGrid1.DefaultRowHeight := FStringGrid1.Height;
    … …  
    135177  FStringGrid1.Options := [goFixedHorzLine, goFixedVertLine, goVertLine,
    136178    goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll];
    137   FStringGrid1.OnKeyUp := DoOnKeyUp;
    138   FStringGrid1.OnResize := DoOnResize;
     179  FStringGrid1.OnKeyUp := GridDoOnKeyUp;
     180  FStringGrid1.OnResize := GridDoOnResize;
    139181end;
    140182
    … …  
    142184var
    143185  I: Integer;
     186  R: TRect;
    144187begin
    145188  with FStringGrid1 do begin
    146     //Columns.Clear;
    147189    while Columns.Count > ListView.Columns.Count do Columns.Delete(Columns.Count - 1);
    148190    while Columns.Count < ListView.Columns.Count do Columns.Add;
    149191    for I := 0 to ListView.Columns.Count - 1 do begin
    150192      Columns[I].Width := ListView.Columns[I].Width;
     193      if Selection.Left = I then begin
     194        R := CellRect(I, 0);
     195        Editor.Left := R.Left + 2;
     196        Editor.Width := R.Width - 4;
     197      end;
    151198    end;
    152199  end;
    … …  
    197244  if AMsg.Msg = WM_NOTIFY then
    198245  begin
    199     Code := PHDNotify(vMsgNotify.NMHdr)^.Hdr.Code;
     246    Code := NMHDR(PHDNotify(vMsgNotify.NMHdr)^.Hdr).Code;
    200247    case Code of
    201248      HDN_ENDTRACKA, HDN_ENDTRACKW:
    … …  
    272319end;
    273320
     321var
     322  ListViewSortCompare: TCompareEvent;
     323
     324function ListViewCompare(const Item1, Item2: TObject): Integer;
     325begin
     326  Result := ListViewSortCompare(Item1, Item2);
     327end;
     328
    274329procedure TListViewSort.Sort(Compare: TCompareEvent);
    275330begin
     331  // TODO: Because TFLGObjectList compare handler is not class method,
     332  // it is necessary to use simple function compare handler with local variable
     333  ListViewSortCompare := Compare;
    276334  if (List.Count > 0) then
    277     List.Sort(Compare);
     335    List.Sort(ListViewCompare);
    278336end;
    279337
    … …  
    338396begin
    339397  inherited;
    340   List := TListObject.Create;
    341   List.OwnsObjects := False;
     398  List := TFPGObjectList<TObject>.Create;
     399  List.FreeObjects := False;
    342400end;
    343401
    … …  
    353411  TP1: TPoint;
    354412  XBias, YBias: Integer;
    355   OldColor: TColor;
     413  PenColor: TColor;
     414  BrushColor: TColor;
    356415  BiasTop, BiasLeft: Integer;
    357416  Rect1: TRect;
    … …  
    365424  Item.Left := 0;
    366425  GetCheckBias(XBias, YBias, BiasTop, BiasLeft, ListView);
    367   OldColor := ListView.Canvas.Pen.Color;
     426  PenColor := ListView.Canvas.Pen.Color;
     427  BrushColor := ListView.Canvas.Brush.Color;
    368428  //TP1 := Item.GetPosition;
    369429  lRect := Item.DisplayRect(drBounds); // Windows 7 workaround
    … …  
    377437  ItemLeft := Item.Left;
    378438  ItemLeft := 23; // Windows 7 workaround
    379  
     439
    380440  Rect1.Left := ItemLeft - CheckWidth - BiasLeft + 1 + XBias;
    381441  //ShowMessage(IntToStr(Tp1.Y) + ', ' + IntToStr(BiasTop) + ', ' + IntToStr(XBias));
    … …  
    408468  end;
    409469  //ListView.Canvas.Brush.Color := ListView.Color;
    410   ListView.Canvas.Brush.Color := clWindow;
    411   ListView.Canvas.Pen.Color := OldColor;
     470  ListView.Canvas.Brush.Color := BrushColor;
     471  ListView.Canvas.Pen.Color := PenColor;
    412472end;
    413473
    … …  
    476536    FHeaderHandle := ListView_GetHeader(FListView.Handle);
    477537    for I := 0 to FListView.Columns.Count - 1 do begin
     538      {$push}{$warn 5057 off}
    478539      FillChar(Item, SizeOf(THDItem), 0);
     540      {$pop}
    479541      Item.Mask := HDI_FORMAT;
    480542      Header_GetItem(FHeaderHandle, I, Item);

  • trunk/Components/Common/UPersistentForm.pas

    r34 r38  
    88
    99uses
    10   Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls;
     10  Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls,
     11  ExtCtrls;
    1112
    1213type
    … …  
    5657  I: Integer;
    5758  WinControl: TWinControl;
    58   Count: Integer;
    5959begin
    6060  if Control is TListView then begin
    … …  
    7272  end;
    7373
     74  if (Control is TPanel) then begin
     75    with Form, TRegistryEx.Create do
     76    try
     77      RootKey := RegistryContext.RootKey;
     78      OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
     79      if (TPanel(Control).Align = alRight) or (TPanel(Control).Align = alLeft) then begin
     80        if ValueExists('Width') then
     81          TPanel(Control).Width := ReadInteger('Width');
     82      end;
     83      if (TPanel(Control).Align = alTop) or (TPanel(Control).Align = alBottom) then begin
     84        if ValueExists('Height') then
     85          TPanel(Control).Height := ReadInteger('Height');
     86      end;
     87    finally
     88      Free;
     89    end;
     90  end;
     91
    7492  if Control is TWinControl then begin
    7593    WinControl := TWinControl(Control);
    … …  
    96114      for I := 0 to TListView(Control).Columns.Count - 1 do begin
    97115        WriteInteger('ColWidth' + IntToStr(I), TListView(Control).Columns[I].Width);
     116      end;
     117    finally
     118      Free;
     119    end;
     120  end;
     121
     122  if (Control is TPanel) then begin
     123    with Form, TRegistryEx.Create do
     124    try
     125      RootKey := RegistryContext.RootKey;
     126      OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
     127      if (TPanel(Control).Align = alRight) or (TPanel(Control).Align = alLeft) then begin
     128        WriteInteger('Width', TPanel(Control).Width);
     129      end;
     130      if (TPanel(Control).Align = alTop) or (TPanel(Control).Align = alBottom) then begin
     131        WriteInteger('Height', TPanel(Control).Height);
    98132      end;
    99133    finally
    … …  
    217251
    218252procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False);
    219 var
    220   LoadDefaults: Boolean;
    221253begin
    222254  Self.Form := Form;
    … …  
    230262
    231263  if not EqualRect(FormNormalSize, FormRestoredSize) or
    232     (LoadDefaults and DefaultMaximized) then begin
     264    DefaultMaximized then begin
    233265    // Restore to maximized state
    234266    Form.WindowState := wsNormal;

  • trunk/Components/Common/UPool.pas

    r31 r38  
    66
    77uses
    8   Classes, SysUtils, syncobjs, SpecializedList, UThreading;
     8  Classes, SysUtils, syncobjs, fgl, UThreading;
    99
    1010type
    … …  
    2222    function NewItemObject: TObject; virtual;
    2323  public
    24     Items: TListObject;
    25     FreeItems: TListObject;
     24    Items: TFPGObjectList<TObject>;
     25    FreeItems: TFPGObjectList<TObject>;
    2626    function Acquire: TObject; virtual;
    2727    procedure Release(Item: TObject); virtual;
    … …  
    185185begin
    186186  inherited;
    187   Items := TListObject.Create;
    188   FreeItems := TListObject.Create;
    189   FreeItems.OwnsObjects := False;
     187  Items := TFPGObjectList<TObject>.Create;
     188  FreeItems := TFPGObjectList<TObject>.Create;
     189  FreeItems.FreeObjects := False;
    190190  FReleaseEvent := TEvent.Create(nil, False, False, '');
    191191end;

  • trunk/Components/Common/UPrefixMultiplier.pas

    r31 r38  
    2121  { TPrefixMultiplier }
    2222
    23   TPrefixMultiplier = class
     23  TPrefixMultiplier = class(TComponent)
    2424  private
    25     function TruncateDigits(Value:Double;Digits:Integer=3):Double;
     25    function TruncateDigits(Value: Double; Digits: Integer = 3): Double;
    2626  public
    2727    function Add(Value: Double; PrefixMultipliers: TPrefixMultiplierDef;
    … …  
    7272  );
    7373
     74procedure Register;
     75
     76
    7477implementation
     78
     79procedure Register;
     80begin
     81  RegisterComponents('Common', [TPrefixMultiplier]);
     82end;
    7583
    7684{ TPrefixMultiplier }
    … …  
    92100end;
    93101
    94 function TPrefixMultiplier.Add(Value:Double;PrefixMultipliers:TPrefixMultiplierDef
    95   ;UnitText:string;Digits:Integer):string;
     102function TPrefixMultiplier.Add(Value: Double; PrefixMultipliers: TPrefixMultiplierDef
     103  ; UnitText:string; Digits: Integer): string;
    96104var
    97105  I: Integer;

  • trunk/Components/Common/URegistry.pas

    r34 r38  
    99
    1010type
    11   TRegistryRoot = (rrKeyClassesRoot = HKEY($80000000),
    12     rrKeyCurrentUser = HKEY($80000001),
    13     rrKeyLocalMachine = HKEY($80000002),
    14     rrKeyUsers = HKEY($80000003),
    15     rrKeyPerformanceData = HKEY($80000004),
    16     rrKeyCurrentConfig = HKEY($80000005),
    17     rrKeyDynData = HKEY($80000006));
     11  TRegistryRoot = (rrKeyClassesRoot, rrKeyCurrentUser, rrKeyLocalMachine,
     12    rrKeyUsers, rrKeyPerformanceData, rrKeyCurrentConfig, rrKeyDynData);
    1813
    1914  { TRegistryContext }
    … …  
    2318    Key: string;
    2419    class operator Equal(A, B: TRegistryContext): Boolean;
     20    function Create(RootKey: TRegistryRoot; Key: string): TRegistryContext; overload;
     21    function Create(RootKey: HKEY; Key: string): TRegistryContext; overload;
    2522  end;
    2623
    … …  
    3229    procedure SetCurrentContext(AValue: TRegistryContext);
    3330  public
     31    function ReadChar(const Name: string): Char;
     32    procedure WriteChar(const Name: string; Value: Char);
    3433    function ReadBoolWithDefault(const Name: string;
    3534      DefaultValue: Boolean): Boolean;
    3635    function ReadIntegerWithDefault(const Name: string; DefaultValue: Integer): Integer;
    3736    function ReadStringWithDefault(const Name: string; DefaultValue: string): string;
     37    function ReadCharWithDefault(const Name: string; DefaultValue: Char): Char;
    3838    function ReadFloatWithDefault(const Name: string;
    3939      DefaultValue: Double): Double;
    … …  
    4343  end;
    4444
    45 function RegContext(RootKey: HKEY; Key: string): TRegistryContext;
    46 
     45const
     46  RegistryRootHKEY: array[TRegistryRoot] of HKEY = (HKEY_CLASSES_ROOT,
     47    HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_PERFORMANCE_DATA,
     48    HKEY_CURRENT_CONFIG, HKEY_DYN_DATA);
    4749
    4850implementation
    4951
    50 function RegContext(RootKey: HKEY; Key: string): TRegistryContext;
    51 begin
    52   Result.RootKey := RootKey;
    53   Result.Key := Key;
    54 end;
    5552
    5653{ TRegistryContext }
    … …  
    5956begin
    6057  Result := (A.Key = B.Key) and (A.RootKey = B.RootKey);
     58end;
     59
     60function TRegistryContext.Create(RootKey: TRegistryRoot; Key: string): TRegistryContext;
     61begin
     62  Result.RootKey := RegistryRootHKEY[RootKey];
     63  Result.Key := Key;
     64end;
     65
     66function TRegistryContext.Create(RootKey: HKEY; Key: string): TRegistryContext;
     67begin
     68  Result.RootKey := RootKey;
     69  Result.Key := Key;
    6170end;
    6271
    … …  
    7988    else begin
    8089      WriteString(Name, DefaultValue);
     90      Result := DefaultValue;
     91    end;
     92end;
     93
     94function TRegistryEx.ReadCharWithDefault(const Name: string; DefaultValue: Char
     95  ): Char;
     96begin
     97  if ValueExists(Name) then Result := ReadChar(Name)
     98    else begin
     99      WriteChar(Name, DefaultValue);
    81100      Result := DefaultValue;
    82101    end;
    … …  
    131150end;
    132151
     152function TRegistryEx.ReadChar(const Name: string): Char;
     153var
     154  S: string;
     155begin
     156  S := ReadString(Name);
     157  if Length(S) > 0 then Result := S[1]
     158    else Result := #0;
     159end;
     160
     161procedure TRegistryEx.WriteChar(const Name: string; Value: Char);
     162begin
     163  WriteString(Name, Value);
     164end;
     165
    133166function TRegistryEx.ReadBoolWithDefault(const Name: string;
    134167  DefaultValue: Boolean): Boolean;

  • trunk/Components/Common/UResetableThread.pas

    r34 r38  
    156156  FThread.Name := 'ResetableThread';
    157157  FThread.Parent := Self;
    158   FThread.Resume;
     158  FThread.Start;
    159159end;
    160160

  • trunk/Components/Common/UScaleDPI.pas

    r34 r38  
    215215  I: Integer;
    216216begin
     217  ImgList.BeginUpdate;
    217218  NewWidth := ScaleX(ImgList.Width, FromDPI.X);
    218219  NewHeight := ScaleY(ImgList.Height, FromDPI.Y);
    … …  
    248249    Temp[i].Free;
    249250  end;
     251  ImgList.EndUpdate;
    250252end;
    251253
    … …  
    284286  WinControl: TWinControl;
    285287  ToolBarControl: TToolBar;
    286   OldAnchors: TAnchors;
    287   OldAutoSize: Boolean;
    288 begin
     288  //OldAnchors: TAnchors;
     289  //OldAutoSize: Boolean;
     290begin
     291  //if not (Control is TCustomPage) then
     292  // Resize childs first
     293  if Control is TWinControl then begin
     294    WinControl := TWinControl(Control);
     295    if WinControl.ControlCount > 0 then begin
     296      for I := 0 to WinControl.ControlCount - 1 do begin
     297        if WinControl.Controls[I] is TControl then begin
     298          ScaleControl(WinControl.Controls[I], FromDPI);
     299        end;
     300      end;
     301    end;
     302  end;
     303
    289304  //if Control is TMemo then Exit;
    290305  //if Control is TForm then
    … …  
    316331        MinWidth := ScaleX(MinWidth, FromDPI.X);
    317332        MinHeight := ScaleY(MinHeight, FromDPI.Y);
    318         Width := ScaleX(Width, FromDPI.X);
     333        // Workaround to bad band width auto sizing
     334        //Width := ScaleX(Width, FromDPI.X);
     335        Width := ScaleX(Control.Width + 28, FromDPI.X);
    319336        //Control.Invalidate;
    320337      end;
     338    // Workaround for bad autosizing of coolbar
     339    if AutoSize then begin
     340      AutoSize := False;
     341      Height := ScaleY(Height, FromDPI.Y);
     342      AutoSize := True;
     343    end;
    321344    EndUpdate;
    322345  end;
    … …  
    330353  end;
    331354
    332   //if not (Control is TCustomPage) then
    333   if Control is TWinControl then begin
    334     WinControl := TWinControl(Control);
    335     if WinControl.ControlCount > 0 then begin
    336       for I := 0 to WinControl.ControlCount - 1 do begin
    337         if WinControl.Controls[I] is TControl then begin
    338           ScaleControl(WinControl.Controls[I], FromDPI);
    339         end;
    340       end;
    341     end;
    342   end;
    343355  //if Control is TForm then
    344356  //  Control.EnableAutoSizing;

  • trunk/Components/Common/UThreading.pas

    r31 r38  
    3030    Name: string;
    3131    procedure Execute; virtual; abstract;
    32     procedure Resume; virtual; abstract;
    33     procedure Suspend; virtual; abstract;
    3432    procedure Start; virtual; abstract;
    3533    procedure Terminate; virtual; abstract;
    … …  
    8179    procedure Sleep(Delay: Integer); override;
    8280    procedure Execute; override;
    83     procedure Resume; override;
    84     procedure Suspend; override;
    8581    procedure Start; override;
    8682    procedure Terminate; override;
    … …  
    134130    Thread.FreeOnTerminate := False;
    135131    Thread.Method := Method;
    136     Thread.Resume;
     132    Thread.Start;
    137133    while (Thread.State = ttsRunning) or (Thread.State = ttsReady) do begin
    138134      if MainThreadID = ThreadID then Application.ProcessMessages;
    … …  
    155151    Thread.Method := Method;
    156152    Thread.OnFinished := CallBack;
    157     Thread.Resume;
     153    Thread.Start;
    158154    //if Thread.State = ttsExceptionOccured then
    159155    //  raise Exception.Create(Thread.ExceptionMessage);
    … …  
    313309procedure TListedThread.Execute;
    314310begin
    315 end;
    316 
    317 procedure TListedThread.Resume;
    318 begin
    319   FThread.Resume;
    320 end;
    321 
    322 procedure TListedThread.Suspend;
    323 begin
    324   FThread.Suspend;
    325311end;
    326312

  • trunk/Components/Common/UURI.pas

    r34 r38  
    8989function LeftCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean;
    9090var
    91   I, J: Integer;
     91  I: Integer;
    9292  Matched: Boolean;
    9393begin
    … …  
    113113function RightCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean;
    114114var
    115   I, J: Integer;
     115  I: Integer;
    116116  Matched: Boolean;
    117117begin
    … …  
    202202
    203203procedure TURI.SetAsString(Value: string);
    204 var
    205   HostAddr: string;
    206   HostPort: string;
    207204begin
    208205  LeftCutString(Value, Scheme, ':');

  • trunk/Components/Common/UXMLUtils.pas

    r34 r38  
    77uses
    88  {$IFDEF WINDOWS}Windows,{$ENDIF}
    9   Classes, SysUtils, DateUtils, XMLRead, XMLWrite, DOM;
     9  Classes, SysUtils, DateUtils, DOM, xmlread;
    1010
    1111function XMLTimeToDateTime(XMLDateTime: string): TDateTime;
    12 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;
     12function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string;
    1313procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer);
    1414procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64);
    … …  
    2121function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string;
    2222function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime;
     23procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string);
    2324
    2425
    2526implementation
     27
     28procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string);
     29var
     30  Parser: TDOMParser;
     31  Src: TXMLInputSource;
     32  InFile: TFileStream;
     33begin
     34  try
     35    InFile := TFileStream.Create(FileName, fmOpenRead);
     36    Src := TXMLInputSource.Create(InFile);
     37    Parser := TDOMParser.Create;
     38    Parser.Options.PreserveWhitespace := True;
     39    Parser.Parse(Src, Doc);
     40  finally
     41    Src.Free;
     42    Parser.Free;
     43    InFile.Free;
     44  end;
     45end;
    2646
    2747function GetTimeZoneBias: Integer;
    … …  
    3050  TimeZoneInfo: TTimeZoneInformation;
    3151begin
     52  {$push}{$warn 5057 off}
    3253  case GetTimeZoneInformation(TimeZoneInfo) of
    33   TIME_ZONE_ID_STANDARD: Result := TimeZoneInfo.Bias + TimeZoneInfo.StandardBias;
    34   TIME_ZONE_ID_DAYLIGHT: Result := TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias;
     54    TIME_ZONE_ID_STANDARD: Result := TimeZoneInfo.Bias + TimeZoneInfo.StandardBias;
     55    TIME_ZONE_ID_DAYLIGHT: Result := TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias;
    3556  else
    3657    Result := 0;
    3758  end;
     59  {$pop}
    3860end;
    3961{$ELSE}
    … …  
    4567function LeftCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean;
    4668var
    47   I, J: Integer;
     69  I: Integer;
    4870  Matched: Boolean;
    4971begin
    … …  
    99121      if Pos('Z', XMLDateTime) > 0 then
    100122        LeftCutString(XMLDateTime, Part, 'Z');
    101       SecondFraction := StrToFloat('0' + DecimalSeparator + Part);
     123      SecondFraction := StrToFloat('0' + DefaultFormatSettings.DecimalSeparator + Part);
    102124      Millisecond := Trunc(SecondFraction * 1000);
    103125    end else begin
    … …  
    118140end;
    119141
    120 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;
     142function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string;
    121143const
    122144  Neg: array[Boolean] of string =  ('+', '-');
    … …  
    139161  NewNode: TDOMNode;
    140162begin
    141   NewNode := Node.OwnerDocument.CreateElement(Name);
    142   NewNode.TextContent := IntToStr(Value);
     163  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     164  NewNode.TextContent := DOMString(IntToStr(Value));
    143165  Node.AppendChild(NewNode);
    144166end;
    … …  
    148170  NewNode: TDOMNode;
    149171begin
    150   NewNode := Node.OwnerDocument.CreateElement(Name);
    151   NewNode.TextContent := IntToStr(Value);
     172  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     173  NewNode.TextContent := DOMString(IntToStr(Value));
    152174  Node.AppendChild(NewNode);
    153175end;
    … …  
    157179  NewNode: TDOMNode;
    158180begin
    159   NewNode := Node.OwnerDocument.CreateElement(Name);
    160   NewNode.TextContent := BoolToStr(Value);
     181  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     182  NewNode.TextContent := DOMString(BoolToStr(Value));
    161183  Node.AppendChild(NewNode);
    162184end;
    … …  
    166188  NewNode: TDOMNode;
    167189begin
    168   NewNode := Node.OwnerDocument.CreateElement(Name);
    169   NewNode.TextContent := Value;
     190  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     191  NewNode.TextContent := DOMString(Value);
    170192  Node.AppendChild(NewNode);
    171193end;
    … …  
    175197  NewNode: TDOMNode;
    176198begin
    177   NewNode := Node.OwnerDocument.CreateElement(Name);
    178   NewNode.TextContent := DateTimeToXMLTime(Value);
     199  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     200  NewNode.TextContent := DOMString(DateTimeToXMLTime(Value));
    179201  Node.AppendChild(NewNode);
    180202end;
    … …  
    185207begin
    186208  Result := DefaultValue;
    187   NewNode := Node.FindNode(Name);
    188   if Assigned(NewNode) then
    189     Result := StrToInt(NewNode.TextContent);
     209  NewNode := Node.FindNode(DOMString(Name));
     210  if Assigned(NewNode) then
     211    Result := StrToInt(string(NewNode.TextContent));
    190212end;
    191213
    … …  
    195217begin
    196218  Result := DefaultValue;
    197   NewNode := Node.FindNode(Name);
    198   if Assigned(NewNode) then
    199     Result := StrToInt64(NewNode.TextContent);
     219  NewNode := Node.FindNode(DOMString(Name));
     220  if Assigned(NewNode) then
     221    Result := StrToInt64(string(NewNode.TextContent));
    200222end;
    201223
    … …  
    205227begin
    206228  Result := DefaultValue;
    207   NewNode := Node.FindNode(Name);
    208   if Assigned(NewNode) then
    209     Result := StrToBool(NewNode.TextContent);
     229  NewNode := Node.FindNode(DOMString(Name));
     230  if Assigned(NewNode) then
     231    Result := StrToBool(string(NewNode.TextContent));
    210232end;
    211233
    … …  
    215237begin
    216238  Result := DefaultValue;
    217   NewNode := Node.FindNode(Name);
    218   if Assigned(NewNode) then
    219     Result := NewNode.TextContent;
     239  NewNode := Node.FindNode(DOMString(Name));
     240  if Assigned(NewNode) then
     241    Result := string(NewNode.TextContent);
    220242end;
    221243
    … …  
    226248begin
    227249  Result := DefaultValue;
    228   NewNode := Node.FindNode(Name);
    229   if Assigned(NewNode) then
    230     Result := XMLTimeToDateTime(NewNode.TextContent);
     250  NewNode := Node.FindNode(DOMString(Name));
     251  if Assigned(NewNode) then
     252    Result := XMLTimeToDateTime(string(NewNode.TextContent));
    231253end;
    232254

  • trunk/Components/CoolAudio/CoolAudio.lpk

    r32 r38  
    1 <?xml version="1.0"?>
     1<?xml version="1.0" encoding="UTF-8"?>
    22<CONFIG>
    33  <Package Version="4">
    44    <Name Value="CoolAudio"/>
     5    <Type Value="RunAndDesignTime"/>
    56    <Author Value="Chronos"/>
    67    <CompilerOptions>
    … …  
    89      <SearchPaths>
    910        <OtherUnitFiles Value="fmodintf;Systems;Systems/DSP;Systems/FMOD;Systems/MAD;Systems/WinAPI;Systems/mplayer"/>
    10         <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     11        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    1112      </SearchPaths>
     13      <Parsing>
     14        <SyntaxOptions>
     15          <SyntaxMode Value="Delphi"/>
     16          <CStyleOperator Value="False"/>
     17          <AllowLabel Value="False"/>
     18          <CPPInline Value="False"/>
     19        </SyntaxOptions>
     20      </Parsing>
     21      <CodeGeneration>
     22        <Optimizations>
     23          <OptimizationLevel Value="0"/>
     24        </Optimizations>
     25      </CodeGeneration>
    1226      <Linking>
    1327        <Debugging>
     28          <GenerateDebugInfo Value="False"/>
    1429          <DebugInfoType Value="dsStabs"/>
    1530        </Debugging>
    1631      </Linking>
    17       <Other>
    18         <CompilerPath Value="$(CompPath)"/>
    19       </Other>
    2032    </CompilerOptions>
    2133    <Description Value="Features:
    … …  
    6779      </Item10>
    6880    </Files>
    69     <Type Value="RunAndDesignTime"/>
    7081    <RequiredPkgs Count="2">
    7182      <Item1>
    … …  
    8293      <Version Value="2"/>
    8394    </PublishOptions>
     95    <CustomOptions Items="ExternHelp" Version="2">
     96      <_ExternHelp Items="Count"/>
     97    </CustomOptions>
    8498  </Package>
    8599</CONFIG>

  • trunk/Components/CoolTranslator/CoolTranslator.lpk

    r29 r38  
    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="CoolTranslator"/>
     6    <Type Value="RunAndDesignTime"/>
    67    <AddToProjectUsesSection Value="True"/>
    78    <Author Value="Chronos (robie@centrum.cz)"/>
    89    <CompilerOptions>
    9       <Version Value="10"/>
     10      <Version Value="11"/>
    1011      <PathDelim Value="\"/>
    1112      <SearchPaths>
    12         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     13        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    1314      </SearchPaths>
     15      <Parsing>
     16        <SyntaxOptions>
     17          <SyntaxMode Value="Delphi"/>
     18          <CStyleOperator Value="False"/>
     19          <AllowLabel Value="False"/>
     20          <CPPInline Value="False"/>
     21        </SyntaxOptions>
     22      </Parsing>
     23      <CodeGeneration>
     24        <Optimizations>
     25          <OptimizationLevel Value="0"/>
     26        </Optimizations>
     27      </CodeGeneration>
     28      <Linking>
     29        <Debugging>
     30          <GenerateDebugInfo Value="False"/>
     31        </Debugging>
     32      </Linking>
    1433      <Other>
    15         <CompilerPath Value="$(CompPath)"/>
     34        <CompilerMessages>
     35          <IgnoredMessages idx5024="True"/>
     36        </CompilerMessages>
    1637      </Other>
    1738    </CompilerOptions>
    … …  
    3859      <OutDir Value="Languages"/>
    3960    </i18n>
    40     <Type Value="RunAndDesignTime"/>
    4161    <RequiredPkgs Count="2">
    4262      <Item1>

  • trunk/Components/CoolTranslator/UCoolTranslator.pas

    r34 r38  
    127127  I, J: Integer;
    128128  Po: TPoFile;
     129  Item: TPOFileItem;
    129130begin
    130131  TranslateComponentRecursive(Application);
    … …  
    136137    with TPoFile(FPoFiles[I]) do
    137138      for J := 0 to Items.Count - 1 do
    138       with TPoFileItem(Items[J]) do
    139         Po.Add(IdentifierLow, Original, Translation, Comments, Context,
     139      with TPoFileItem(Items[J]) do begin
     140        Item := nil;
     141        Po.FillItem(Item, IdentifierLow, Original, Translation, Comments, Context,
    140142          Flags, PreviousID);
     143      end;
    141144    Translations.TranslateResourceStrings(Po);
    142145  finally
    … …  
    295298  Result := FPOFilesFolder;
    296299  if Copy(Result, 1, 1) <> DirectorySeparator then
    297     Result := ExtractFileDir(UTF8Encode(Application.ExeName)) +
     300    Result := ExtractFileDir(Application.ExeName) +
    298301      DirectorySeparator + Result;
    299302end;

  • trunk/Components/TemplateGenerics/TemplateGenerics.lpk

    r30 r38  
    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="TemplateGenerics"/>
     6    <Type Value="RunAndDesignTime"/>
    67    <AddToProjectUsesSection Value="True"/>
    78    <Author Value="Chronos (robie@centrum.cz)"/>
    … …  
    1213        <IncludeFiles Value="Generic"/>
    1314        <OtherUnitFiles Value="Specialized;Generic;Additional"/>
    14         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     15        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    1516      </SearchPaths>
    1617      <CodeGeneration>
    1718        <Optimizations>
     19          <OptimizationLevel Value="0"/>
    1820          <VariablesInRegisters Value="True"/>
    19           <OptimizationLevel Value="3"/>
    2021        </Optimizations>
    2122      </CodeGeneration>
    22       <Other>
    23         <CompilerMessages>
    24           <UseMsgFile Value="True"/>
    25         </CompilerMessages>
    26         <CompilerPath Value="$(CompPath)"/>
    27       </Other>
     23      <Linking>
     24        <Debugging>
     25          <GenerateDebugInfo Value="False"/>
     26        </Debugging>
     27      </Linking>
    2828    </CompilerOptions>
    2929    <Description Value="Generic classes implemented as templates."/>
    … …  
    139139      </Item27>
    140140    </Files>
    141     <Type Value="RunAndDesignTime"/>
    142141    <RequiredPkgs Count="2">
    143142      <Item1>

  • trunk/Forms/UMainForm.lfm

    r37 r38  
    11object MainForm: TMainForm
    2   Left = 886
    3   Height = 412
    4   Top = 378
    5   Width = 514
     2  Left = 486
     3  Height = 515
     4  Top = 258
     5  Width = 642
    66  Caption = 'Tunneler'
    7   ClientHeight = 378
    8   ClientWidth = 514
     7  ClientHeight = 490
     8  ClientWidth = 642
     9  DesignTimePPI = 120
    910  Menu = MainMenu1
    1011  OnClose = FormClose
    … …  
    1516  OnKeyUp = FormKeyUp
    1617  OnShow = FormShow
    17   LCLVersion = '1.8.0.4'
     18  LCLVersion = '2.0.0.4'
    1819  object StatusBar1: TStatusBar
    1920    Left = 0
    20     Height = 30
    21     Top = 348
    22     Width = 514
    23     Panels = <
     21    Height = 28
     22    Top = 462
     23    Width = 642
     24    Panels = <   
    2425      item
    25         Width = 50
    26       end
     26        Width = 62
     27      end   
    2728      item
    28         Width = 50
    29       end
     29        Width = 62
     30      end   
    3031      item
    31         Width = 50
    32       end
     32        Width = 62
     33      end   
    3334      item
    34         Width = 50
    35       end
     35        Width = 62
     36      end   
    3637      item
    37         Width = 50
    38       end
     38        Width = 62
     39      end   
    3940      item
    40         Width = 50
    41       end
     41        Width = 62
     42      end   
    4243      item
    43         Width = 50
     44        Width = 62
    4445      end>
     46    ParentFont = False
    4547    SimplePanel = False
    4648  end
    4749  object Image1: TImage
    4850    Left = 0
    49     Height = 348
     51    Height = 462
    5052    Top = 0
    51     Width = 514
     53    Width = 642
    5254    Align = alClient
    5355    OnMouseLeave = Image1MouseLeave
    … …  
    5759    Interval = 50
    5860    OnTimer = TimerDrawTimer
    59     left = 99
    60     top = 50
     61    left = 124
     62    top = 63
    6163  end
    6264  object MainMenu1: TMainMenu
    63     left = 184
    64     top = 16
     65    left = 230
     66    top = 20
    6567    object MenuItem1: TMenuItem
    6668      Caption = 'Game'
    … …  
    9193    Interval = 20
    9294    OnTimer = TimerEngineTickTimer
    93     left = 96
    94     top = 104
     95    left = 120
     96    top = 130
    9597  end
    9698  object ActionList1: TActionList
    97     left = 288
    98     top = 32
     99    left = 360
     100    top = 40
    99101    object AFullScreen: TAction
    100102      Caption = 'Fullscreen mode'
    … …  
    127129  object CoolTranslator1: TCoolTranslator
    128130    POFilesFolder = 'Languages'
    129     left = 288
    130     top = 104
     131    left = 360
     132    top = 130
    131133  end
    132134  object ApplicationInfo1: TApplicationInfo
    … …  
    141143    EmailContact = 'robie@centrum.cz'
    142144    AppName = 'Tunneler'
    143     ReleaseDate = 43064
     145    ReleaseDate = 43573
    144146    RegistryKey = '\Software\Chronosoft\Tunneler'
    145147    RegistryRoot = rrKeyCurrentUser
    146148    License = 'CC0'
    147     left = 99
    148     top = 176
     149    left = 124
     150    top = 220
    149151  end
    150152  object XMLConfig1: TXMLConfig
    … …  
    152154    RootName = 'CONFIG'
    153155    ReadOnly = False
    154     left = 99
    155     top = 240
     156    left = 124
     157    top = 300
    156158  end
    157159end

  • trunk/Forms/UMainForm.pas

    r36 r38  
    66
    77uses
    8   Registry, XMLConf, Classes, SysUtils, FileUtil, Forms, Controls, Graphics,
     8  XMLConf, Classes, SysUtils, FileUtil, Forms, Controls, Graphics,
    99  Dialogs, ExtCtrls, ComCtrls, Menus, ActnList, UCore, UPlatform, Math,
    1010  DateUtils, GraphType, UPersistentForm, UApplicationInfo, UCoolTranslator,
    … …  
    7878
    7979uses
    80   UMapForm, UNewGameForm, UDebugForm;
     80  UMapForm, UNewGameForm;
    8181
    8282resourcestring
    … …  
    123123begin
    124124  if Assigned(Engine) then Engine.SaveConfig(XMLConfig1, '');
     125  ForceDirectories(ExtractFileDir(XMLConfig1.Filename));
    125126  XMLConfig1.Flush;
    126127end;
    … …  
    136137
    137138  PersistentForm := TPersistentForm.Create(nil);
    138   PersistentForm.RegistryContext := RegContext(HKEY(ApplicationInfo1.RegistryRoot),
     139  PersistentForm.RegistryContext := TRegistryContext.Create(ApplicationInfo1.RegistryRoot,
    139140    ApplicationInfo1.RegistryKey);
    140141

  • trunk/Forms/UNewGameForm.pas

    r34 r38  
    6868  NewGameForm: TNewGameForm;
    6969
     70
    7071implementation
    71 
    72 uses
    73   UMainForm;
    7472
    7573{$R *.lfm}

  • trunk/tunneler.lpi

    r36 r38  
    22<CONFIG>
    33  <ProjectOptions>
    4     <Version Value="10"/>
     4    <Version Value="11"/>
    55    <General>
    66      <SessionStorage Value="InProjectDir"/>
    … …  
    2525            <IncludeFiles Value="$(ProjOutDir)"/>
    2626            <OtherUnitFiles Value="Common;Forms"/>
    27             <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     27            <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    2828          </SearchPaths>
    2929          <Parsing>
    … …  
    6060        </CompilerOptions>
    6161      </Item2>
     62      <SharedMatrixOptions Count="2">
     63        <Item1 ID="486260008827" Targets="Common,CoolTranslator,TemplateGenerics,CoolAudio" Modes="Debug" Value="-g -gl -gh -CirotR -O1"/>
     64        <Item2 ID="478750724916" Targets="Common,CoolTranslator,TemplateGenerics,CoolAudio" Modes="Release" Value="-CX -XX -O3"/>
     65      </SharedMatrixOptions>
    6266    </BuildModes>
    6367    <PublishOptions>
    6468      <Version Value="2"/>
    65       <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
    66       <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
    6769    </PublishOptions>
    6870    <RunParams>
    69       <local>
    70         <FormatVersion Value="1"/>
    71       </local>
     71      <FormatVersion Value="2"/>
     72      <Modes Count="1">
     73        <Mode0 Name="default"/>
     74      </Modes>
    7275    </RunParams>
    73     <RequiredPackages Count="6">
     76    <RequiredPackages Count="5">
    7477      <Item1>
    75         <PackageName Value="FCL"/>
     78        <PackageName Value="CoolAudio"/>
     79        <DefaultFilename Value="Components/CoolAudio/CoolAudio.lpk" Prefer="True"/>
    7680      </Item1>
    7781      <Item2>
    78         <PackageName Value="CoolAudio"/>
    79         <DefaultFilename Value="Components/CoolAudio/CoolAudio.lpk" Prefer="True"/>
     82        <PackageName Value="Common"/>
     83        <DefaultFilename Value="Components/Common/Common.lpk" Prefer="True"/>
    8084      </Item2>
    8185      <Item3>
    82         <PackageName Value="Common"/>
    83         <DefaultFilename Value="Components/Common/Common.lpk" Prefer="True"/>
     86        <PackageName Value="CoolTranslator"/>
     87        <DefaultFilename Value="Components/CoolTranslator/CoolTranslator.lpk" Prefer="True"/>
    8488      </Item3>
    8589      <Item4>
    86         <PackageName Value="CoolTranslator"/>
    87         <DefaultFilename Value="Components/CoolTranslator/CoolTranslator.lpk" Prefer="True"/>
     90        <PackageName Value="TemplateGenerics"/>
     91        <DefaultFilename Value="Components/TemplateGenerics/TemplateGenerics.lpk" Prefer="True"/>
    8892      </Item4>
    8993      <Item5>
    90         <PackageName Value="TemplateGenerics"/>
    91         <DefaultFilename Value="Components/TemplateGenerics/TemplateGenerics.lpk" Prefer="True"/>
     94        <PackageName Value="LCL"/>
    9295      </Item5>
    93       <Item6>
    94         <PackageName Value="LCL"/>
    95       </Item6>
    9696    </RequiredPackages>
    9797    <Units Count="9">
    … …  
    155155      <IncludeFiles Value="$(ProjOutDir)"/>
    156156      <OtherUnitFiles Value="Common;Forms"/>
    157       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     157      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    158158    </SearchPaths>
    159159    <Parsing>
Note: See TracChangeset for help on using the changeset viewer.