Changeset 181 for trunk/Packages


Ignore:
Timestamp:
Apr 11, 2018, 11:35:38 AM (7 years ago)
Author:
chronos
Message:
  • Modified: Updated files for Common package.
Location:
trunk/Packages/Common
Files:
1 added
19 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/Common/Common.lpk

    r174 r181  
    4040    <License Value="GNU/GPL"/>
    4141    <Version Minor="7"/>
    42     <Files Count="21">
     42    <Files Count="22">
    4343      <Item1>
    4444        <Filename Value="StopWatch.pas"/>
    … …  
    134134        <UnitName Value="UTheme"/>
    135135      </Item21>
     136      <Item22>
     137        <Filename Value="UStringTable.pas"/>
     138        <UnitName Value="UStringTable"/>
     139      </Item22>
    136140    </Files>
    137141    <i18n>

  • trunk/Packages/Common/Common.pas

    r174 r181  
    55unit Common;
    66
     7{$warn 5023 off : no warning about unused units}
    78interface
    89
    910uses
    10   StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading,
    11   UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
    12   UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
    13   UPersistentForm, UFindFile, UScaleDPI, UTheme, LazarusPackageIntf;
     11  StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading,
     12  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
     13  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
     14  UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable,
     15  LazarusPackageIntf;
    1416
    1517implementation

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

    r79 r181  
    2424msgstr "Dokončené"
    2525
    26 #: ujobprogressview.soperations
    27 msgid "Operations"
    28 msgstr "Operace"
    29 
    3026#: ujobprogressview.spleasewait
    3127msgid "Please wait..."

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

    r54 r181  
    1414msgstr ""
    1515
    16 #: ujobprogressview.soperations
    17 msgid "Operations"
    18 msgstr ""
    19 
    2016#: ujobprogressview.spleasewait
    2117msgid "Please wait..."

  • trunk/Packages/Common/UApplicationInfo.pas

    r169 r181  
    66
    77uses
    8   SysUtils, Registry, Classes, Forms, URegistry;
     8  SysUtils, Classes, Forms, URegistry, Controls;
    99
    1010type
    … …  
    1414  TApplicationInfo = class(TComponent)
    1515  private
    16     FDescription: string;
     16    FDescription: TCaption;
    1717    FIdentification: Byte;
    1818    FLicense: string;
    … …  
    5757
    5858implementation
    59                        
     59
    6060procedure Register;
    6161begin

  • trunk/Packages/Common/UCommon.pas

    r169 r181  
    2828    unfDNSDomainName = 11);
    2929
     30  TFilterMethodMethod = function (FileName: string): Boolean of object;
    3031var
    3132  ExceptionHandler: TExceptionEvent;
    … …  
    7172function MergeArray(A, B: array of string): TArrayOfString;
    7273function LoadFileToStr(const FileName: TFileName): AnsiString;
     74procedure SearchFiles(AList: TStrings; Dir: string;
     75  FilterMethod: TFilterMethodMethod);
     76function GetStringPart(var Text: string; Separator: string): string;
    7377
    7478
    … …  
    514518end;
    515519
     520function DefaultSearchFilter(const FileName: string): Boolean;
     521begin
     522  Result := True;
     523end;
     524
     525procedure SearchFiles(AList: TStrings; Dir: string;
     526  FilterMethod: TFilterMethodMethod);
     527var
     528  SR: TSearchRec;
     529begin
     530  Dir := IncludeTrailingPathDelimiter(Dir);
     531  if FindFirst(Dir + '*', faAnyFile, SR) = 0 then
     532    try
     533      repeat
     534        if (SR.Name = '.') or (SR.Name = '..') or not FilterMethod(SR.Name) or
     535          not FilterMethod(Copy(Dir, 3, Length(Dir)) + SR.Name) then Continue;
     536        AList.Add(Dir + SR.Name);
     537        if (SR.Attr and faDirectory) <> 0 then
     538          SearchFiles(AList, Dir + SR.Name, FilterMethod);
     539      until FindNext(SR) <> 0;
     540    finally
     541      FindClose(SR);
     542    end;
     543end;
     544
     545function GetStringPart(var Text: string; Separator: string): string;
     546var
     547  P: Integer;
     548begin
     549  P := Pos(Separator, Text);
     550  if P > 0 then begin
     551    Result := Copy(Text, 1, P - 1);
     552    Delete(Text, 1, P - 1 + Length(Separator));
     553  end else begin
     554    Result := Text;
     555    Text := '';
     556  end;
     557  Result := Trim(Result);
     558  Text := Trim(Text);
     559end;
     560
    516561
    517562

  • trunk/Packages/Common/UDebugLog.pas

    r3 r181  
    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;

  • trunk/Packages/Common/UFindFile.pas

    r106 r181  
    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/Packages/Common/UJobProgressView.lfm

    r55 r181  
    11object FormJobProgressView: TFormJobProgressView
    2   Left = 656
     2  Left = 467
    33  Height = 246
    4   Top = 354
     4  Top = 252
    55  Width = 328
    66  BorderIcons = [biSystemMenu]
    77  ClientHeight = 246
    88  ClientWidth = 328
     9  DesignTimePPI = 120
    910  Font.Height = -11
    1011  Font.Name = 'MS Sans Serif'
    … …  
    1415  OnDestroy = FormDestroy
    1516  Position = poScreenCenter
    16   LCLVersion = '1.6.0.4'
     17  LCLVersion = '1.8.2.0'
    1718  object PanelOperationsTitle: TPanel
    1819    Left = 0

  • trunk/Packages/Common/UJobProgressView.pas

    r54 r181  
    166166  STotalEstimatedTime = 'Total estimated time: %s';
    167167  SFinished = 'Finished';
    168   SOperations = 'Operations';
    169168
    170169procedure Register;

  • trunk/Packages/Common/ULastOpenedList.pas

    r3 r181  
    66
    77uses
    8   Classes, SysUtils, Registry, URegistry, Menus, XMLConf;
     8  Classes, SysUtils, Registry, URegistry, Menus, XMLConf, DOM;
    99
    1010type
    … …  
    139139    OpenKey(Context.Key, True);
    140140    for I := 0 to Items.Count - 1 do
    141       WriteString('File' + IntToStr(I), UTF8Decode(Items[I]));
     141      WriteString('File' + IntToStr(I), Items[I]);
    142142  finally
    143143    Free;
    … …  
    153153begin
    154154  with XMLConfig do begin
    155     Count := GetValue(Path + '/Count', 0);
     155    Count := GetValue(DOMString(Path + '/Count'), 0);
    156156    if Count > MaxCount then Count := MaxCount;
    157157    Items.Clear;
    158158    for I := 0 to Count - 1 do begin
    159       Value := GetValue(Path + '/File' + IntToStr(I), '');
     159      Value := string(GetValue(DOMString(Path + '/File' + IntToStr(I)), ''));
    160160      if Trim(Value) <> '' then Items.Add(Value);
    161161    end;
    … …  
    170170begin
    171171  with XMLConfig do begin
    172     SetValue(Path + '/Count', Items.Count);
     172    SetValue(DOMString(Path + '/Count'), Items.Count);
    173173    for I := 0 to Items.Count - 1 do
    174       SetValue(Path + '/File' + IntToStr(I), Items[I]);
     174      SetValue(DOMString(Path + '/File' + IntToStr(I)), DOMString(Items[I]));
    175175    Flush;
    176176  end;

  • trunk/Packages/Common/UListViewSort.pas

    r177 r181  
    384384  ItemLeft := Item.Left;
    385385  ItemLeft := 23; // Windows 7 workaround
    386  
     386
    387387  Rect1.Left := ItemLeft - CheckWidth - BiasLeft + 1 + XBias;
    388388  //ShowMessage(IntToStr(Tp1.Y) + ', ' + IntToStr(BiasTop) + ', ' + IntToStr(XBias));
    … …  
    483483    FHeaderHandle := ListView_GetHeader(FListView.Handle);
    484484    for I := 0 to FListView.Columns.Count - 1 do begin
     485      {$push}{$warn 5057 off}
    485486      FillChar(Item, SizeOf(THDItem), 0);
     487      {$pop}
    486488      Item.Mask := HDI_FORMAT;
    487489      Header_GetItem(FHeaderHandle, I, Item);

  • trunk/Packages/Common/UPersistentForm.pas

    r123 r181  
    5656  I: Integer;
    5757  WinControl: TWinControl;
    58   Count: Integer;
    5958begin
    6059  if Control is TListView then begin
    … …  
    217216
    218217procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False);
    219 var
    220   LoadDefaults: Boolean;
    221218begin
    222219  Self.Form := Form;
    … …  
    230227
    231228  if not EqualRect(FormNormalSize, FormRestoredSize) or
    232     (LoadDefaults and DefaultMaximized) then begin
     229    DefaultMaximized then begin
    233230    // Restore to maximized state
    234231    Form.WindowState := wsNormal;

  • trunk/Packages/Common/UResetableThread.pas

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

  • trunk/Packages/Common/UScaleDPI.pas

    r169 r181  
    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

  • trunk/Packages/Common/UTheme.pas

    r175 r181  
    132132  I: Integer;
    133133begin
    134   for I := 0 to Component.ComponentCount - 1 do
    135     ApplyTheme(Component.Components[I]);
     134  if Component is TWinControl then begin
     135    for I := 0 to TWinControl(Component).ControlCount - 1 do
     136      ApplyTheme(TWinControl(Component).Controls[I]);
     137  end;
    136138
    137139  if Component is TControl then begin
    … …  
    139141    if (Control is TEdit) or (Control is TSpinEdit) or (Control is TComboBox) and
    140142    (Control is TMemo) or (Control is TListView) or (Control is TCustomDrawGrid) or
    141     (Control is TCheckBox) then begin
     143    (Control is TCheckBox) or (Control is TPageControl) or (Control is TRadioButton) then begin
    142144      Control.Color := FTheme.ColorWindow;
    143145      Control.Font.Color := FTheme.ColorWindowText;
    … …  
    150152      (Control as TCustomDrawGrid).Editor.Color := FTheme.ColorWindow;
    151153      (Control as TCustomDrawGrid).Editor.Font.Color := FTheme.ColorWindowText;
     154    end;
     155
     156    if Control is TPageControl then begin
     157      for I := 0 to TPageControl(Component).PageCount - 1 do
     158        ApplyTheme(TPageControl(Component).Pages[I]);
    152159    end;
    153160  end;

  • trunk/Packages/Common/UThreading.pas

    r3 r181  
    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/Packages/Common/UURI.pas

    r3 r181  
    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/Packages/Common/UXMLUtils.pas

    r54 r181  
    77uses
    88  {$IFDEF WINDOWS}Windows,{$ENDIF}
    9   Classes, SysUtils, DateUtils, XMLRead, XMLWrite, DOM;
     9  Classes, SysUtils, DateUtils, DOM;
    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);
    … …  
    3030  TimeZoneInfo: TTimeZoneInformation;
    3131begin
     32  {$push}{$warn 5057 off}
    3233  case GetTimeZoneInformation(TimeZoneInfo) of
    33   TIME_ZONE_ID_STANDARD: Result := TimeZoneInfo.Bias + TimeZoneInfo.StandardBias;
    34   TIME_ZONE_ID_DAYLIGHT: Result := TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias;
     34    TIME_ZONE_ID_STANDARD: Result := TimeZoneInfo.Bias + TimeZoneInfo.StandardBias;
     35    TIME_ZONE_ID_DAYLIGHT: Result := TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias;
    3536  else
    3637    Result := 0;
    3738  end;
     39  {$pop}
    3840end;
    3941{$ELSE}
    … …  
    4547function LeftCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean;
    4648var
    47   I, J: Integer;
     49  I: Integer;
    4850  Matched: Boolean;
    4951begin
    … …  
    99101      if Pos('Z', XMLDateTime) > 0 then
    100102        LeftCutString(XMLDateTime, Part, 'Z');
    101       SecondFraction := StrToFloat('0' + DecimalSeparator + Part);
     103      SecondFraction := StrToFloat('0' + DefaultFormatSettings.DecimalSeparator + Part);
    102104      Millisecond := Trunc(SecondFraction * 1000);
    103105    end else begin
    … …  
    118120end;
    119121
    120 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;
     122function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string;
    121123const
    122124  Neg: array[Boolean] of string =  ('+', '-');
    … …  
    139141  NewNode: TDOMNode;
    140142begin
    141   NewNode := Node.OwnerDocument.CreateElement(Name);
    142   NewNode.TextContent := IntToStr(Value);
     143  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     144  NewNode.TextContent := DOMString(IntToStr(Value));
    143145  Node.AppendChild(NewNode);
    144146end;
    … …  
    148150  NewNode: TDOMNode;
    149151begin
    150   NewNode := Node.OwnerDocument.CreateElement(Name);
    151   NewNode.TextContent := IntToStr(Value);
     152  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     153  NewNode.TextContent := DOMString(IntToStr(Value));
    152154  Node.AppendChild(NewNode);
    153155end;
    … …  
    157159  NewNode: TDOMNode;
    158160begin
    159   NewNode := Node.OwnerDocument.CreateElement(Name);
    160   NewNode.TextContent := BoolToStr(Value);
     161  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     162  NewNode.TextContent := DOMString(BoolToStr(Value));
    161163  Node.AppendChild(NewNode);
    162164end;
    … …  
    166168  NewNode: TDOMNode;
    167169begin
    168   NewNode := Node.OwnerDocument.CreateElement(Name);
    169   NewNode.TextContent := Value;
     170  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     171  NewNode.TextContent := DOMString(Value);
    170172  Node.AppendChild(NewNode);
    171173end;
    … …  
    175177  NewNode: TDOMNode;
    176178begin
    177   NewNode := Node.OwnerDocument.CreateElement(Name);
    178   NewNode.TextContent := DateTimeToXMLTime(Value);
     179  NewNode := Node.OwnerDocument.CreateElement(DOMString(Name));
     180  NewNode.TextContent := DOMString(DateTimeToXMLTime(Value));
    179181  Node.AppendChild(NewNode);
    180182end;
    … …  
    185187begin
    186188  Result := DefaultValue;
    187   NewNode := Node.FindNode(Name);
    188   if Assigned(NewNode) then
    189     Result := StrToInt(NewNode.TextContent);
     189  NewNode := Node.FindNode(DOMString(Name));
     190  if Assigned(NewNode) then
     191    Result := StrToInt(string(NewNode.TextContent));
    190192end;
    191193
    … …  
    195197begin
    196198  Result := DefaultValue;
    197   NewNode := Node.FindNode(Name);
    198   if Assigned(NewNode) then
    199     Result := StrToInt64(NewNode.TextContent);
     199  NewNode := Node.FindNode(DOMString(Name));
     200  if Assigned(NewNode) then
     201    Result := StrToInt64(string(NewNode.TextContent));
    200202end;
    201203
    … …  
    205207begin
    206208  Result := DefaultValue;
    207   NewNode := Node.FindNode(Name);
    208   if Assigned(NewNode) then
    209     Result := StrToBool(NewNode.TextContent);
     209  NewNode := Node.FindNode(DOMString(Name));
     210  if Assigned(NewNode) then
     211    Result := StrToBool(string(NewNode.TextContent));
    210212end;
    211213
    … …  
    215217begin
    216218  Result := DefaultValue;
    217   NewNode := Node.FindNode(Name);
    218   if Assigned(NewNode) then
    219     Result := NewNode.TextContent;
     219  NewNode := Node.FindNode(DOMString(Name));
     220  if Assigned(NewNode) then
     221    Result := string(NewNode.TextContent);
    220222end;
    221223
    … …  
    226228begin
    227229  Result := DefaultValue;
    228   NewNode := Node.FindNode(Name);
    229   if Assigned(NewNode) then
    230     Result := XMLTimeToDateTime(NewNode.TextContent);
     230  NewNode := Node.FindNode(DOMString(Name));
     231  if Assigned(NewNode) then
     232    Result := XMLTimeToDateTime(string(NewNode.TextContent));
    231233end;
    232234
Note: See TracChangeset for help on using the changeset viewer.