Changeset 102 for trunk/Packages


Ignore:
Timestamp:
May 5, 2019, 12:09:56 AM (6 years ago)
Author:
chronos
Message:
Location:
trunk/Packages
Files:
16 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/Common/Common.lpk

    r93 r102  
    6060      <Item5>
    6161        <Filename Value="UPrefixMultiplier.pas"/>
     62        <HasRegisterProc Value="True"/>
    6263        <UnitName Value="UPrefixMultiplier"/>
    6364      </Item5>
    … …  
    144145      <EnableI18NForLFM Value="True"/>
    145146    </i18n>
    146     <RequiredPkgs Count="3">
     147    <RequiredPkgs Count="2">
    147148      <Item1>
    148149        <PackageName Value="LCL"/>
    149150      </Item1>
    150151      <Item2>
    151         <PackageName Value="TemplateGenerics"/>
    152       </Item2>
    153       <Item3>
    154152        <PackageName Value="FCL"/>
    155153        <MinVersion Major="1" Valid="True"/>
    156       </Item3>
     154      </Item2>
    157155    </RequiredPkgs>
    158156    <UsageOptions>

  • trunk/Packages/Common/Common.pas

    r93 r102  
    2020begin
    2121  RegisterUnit('UDebugLog', @UDebugLog.Register);
     22  RegisterUnit('UPrefixMultiplier', @UPrefixMultiplier.Register);
    2223  RegisterUnit('ULastOpenedList', @ULastOpenedList.Register);
    2324  RegisterUnit('UJobProgressView', @UJobProgressView.Register);

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

    r54 r102  
    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/Packages/Common/UCommon.pas

    r93 r102  
    2828    unfDNSDomainName = 11);
    2929
    30   TFilterMethodMethod = function (FileName: string): Boolean of object;
     30  TFilterMethod = function (FileName: string): Boolean of object;
     31  TFileNameMethod = procedure (FileName: string) of object;
     32
    3133var
    3234  ExceptionHandler: TExceptionEvent;
    … …  
    7274function MergeArray(A, B: array of string): TArrayOfString;
    7375function LoadFileToStr(const FileName: TFileName): AnsiString;
     76procedure SaveStringToFile(S, FileName: string);
    7477procedure SearchFiles(AList: TStrings; Dir: string;
    75   FilterMethod: TFilterMethodMethod = nil);
     78  FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
    7679function GetStringPart(var Text: string; Separator: string): string;
     80function StripTags(const S: string): string;
    7781function PosFromIndex(SubStr: string; Text: string;
    7882  StartIndex: Integer): Integer;
    7983function PosFromIndexReverse(SubStr: string; Text: string;
    8084  StartIndex: Integer): Integer;
     85procedure CopyStringArray(Dest: TStringArray; Source: array of string);
    8186
    8287
    … …  
    106111  I: Integer;
    107112begin
     113  Result := '';
    108114  for I := 1 to Length(Source) do begin
    109115    Result := Result + LowerCase(IntToHex(Ord(Source[I]), 2));
    … …  
    527533end;
    528534
     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
    529548procedure SearchFiles(AList: TStrings; Dir: string;
    530   FilterMethod: TFilterMethodMethod = nil);
     549  FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
    531550var
    532551  SR: TSearchRec;
    … …  
    538557        if (SR.Name = '.') or (SR.Name = '..') or (Assigned(FilterMethod) and (not FilterMethod(SR.Name) or
    539558          not FilterMethod(Copy(Dir, 3, Length(Dir)) + SR.Name))) then Continue;
     559        if Assigned(FileNameMethod) then
     560          FileNameMethod(Dir + SR.Name);
    540561        AList.Add(Dir + SR.Name);
    541562        if (SR.Attr and faDirectory) <> 0 then
    … …  
    561582  Result := Trim(Result);
    562583  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;
    563615end;
    564616
    … …  
    608660end;
    609661
     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;
     670
     671
    610672initialization
    611673

  • trunk/Packages/Common/UDebugLog.pas

    r93 r102  
    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 = '');
    … …  
    117117begin
    118118  inherited;
    119   Items := TListObject.Create;
     119  Items := TFPGObjectList<TDebugLogItem>.Create;
    120120  Lock := TCriticalSection.Create;
    121121  MaxCount := 100;

  • trunk/Packages/Common/ULastOpenedList.pas

    r93 r102  
    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;
    … …  
    185186end;
    186187
     188function TLastOpenedList.GetFirstFileName: string;
     189begin
     190  if Items.Count > 0 then Result := Items[0]
     191    else Result := '';
     192end;
     193
    187194end.
    188195

  • trunk/Packages/Common/UListViewSort.pas

    r93 r102  
    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;
    … …  
    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
    … …  
    277319end;
    278320
     321var
     322  ListViewSortCompare: TCompareEvent;
     323
     324function ListViewCompare(const Item1, Item2: TObject): Integer;
     325begin
     326  Result := ListViewSortCompare(Item1, Item2);
     327end;
     328
    279329procedure TListViewSort.Sort(Compare: TCompareEvent);
    280330begin
     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;
    281334  if (List.Count > 0) then
    282     List.Sort(Compare);
     335    List.Sort(ListViewCompare);
    283336end;
    284337
    … …  
    343396begin
    344397  inherited;
    345   List := TListObject.Create;
    346   List.OwnsObjects := False;
     398  List := TFPGObjectList<TObject>.Create;
     399  List.FreeObjects := False;
    347400end;
    348401

  • trunk/Packages/Common/UPool.pas

    r54 r102  
    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/Packages/Common/UPrefixMultiplier.pas

    r54 r102  
    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/Packages/Common/URegistry.pas

    r93 r102  
    2929    procedure SetCurrentContext(AValue: TRegistryContext);
    3030  public
     31    function ReadChar(const Name: string): Char;
     32    procedure WriteChar(const Name: string; Value: Char);
    3133    function ReadBoolWithDefault(const Name: string;
    3234      DefaultValue: Boolean): Boolean;
    3335    function ReadIntegerWithDefault(const Name: string; DefaultValue: Integer): Integer;
    3436    function ReadStringWithDefault(const Name: string; DefaultValue: string): string;
     37    function ReadCharWithDefault(const Name: string; DefaultValue: Char): Char;
    3538    function ReadFloatWithDefault(const Name: string;
    3639      DefaultValue: Double): Double;
    … …  
    8992end;
    9093
     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);
     100      Result := DefaultValue;
     101    end;
     102end;
     103
    91104function TRegistryEx.ReadFloatWithDefault(const Name: string;
    92105  DefaultValue: Double): Double;
    … …  
    137150end;
    138151
     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
    139166function TRegistryEx.ReadBoolWithDefault(const Name: string;
    140167  DefaultValue: Boolean): Boolean;

  • trunk/Packages/Common/UScaleDPI.pas

    r93 r102  
    289289  //OldAutoSize: Boolean;
    290290begin
     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
    291304  //if Control is TMemo then Exit;
    292305  //if Control is TForm then
    … …  
    340353  end;
    341354
    342   //if not (Control is TCustomPage) then
    343   if Control is TWinControl then begin
    344     WinControl := TWinControl(Control);
    345     if WinControl.ControlCount > 0 then begin
    346       for I := 0 to WinControl.ControlCount - 1 do begin
    347         if WinControl.Controls[I] is TControl then begin
    348           ScaleControl(WinControl.Controls[I], FromDPI);
    349         end;
    350       end;
    351     end;
    352   end;
    353355  //if Control is TForm then
    354356  //  Control.EnableAutoSizing;

  • trunk/Packages/Common/UXMLUtils.pas

    r93 r102  
    77uses
    88  {$IFDEF WINDOWS}Windows,{$ENDIF}
    9   Classes, SysUtils, DateUtils, DOM;
     9  Classes, SysUtils, DateUtils, DOM, xmlread;
    1010
    1111function XMLTimeToDateTime(XMLDateTime: string): TDateTime;
    … …  
    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;

  • trunk/Packages/CoolTranslator/CoolTranslator.lpk

    r54 r102  
    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          <CStyleOperator Value="False"/>
     18          <AllowLabel Value="False"/>
     19          <CPPInline Value="False"/>
     20        </SyntaxOptions>
     21      </Parsing>
     22      <CodeGeneration>
     23        <Optimizations>
     24          <OptimizationLevel Value="0"/>
     25        </Optimizations>
     26      </CodeGeneration>
     27      <Linking>
     28        <Debugging>
     29          <GenerateDebugInfo Value="False"/>
     30        </Debugging>
     31      </Linking>
    1432      <Other>
    15         <CompilerPath Value="$(CompPath)"/>
     33        <CompilerMessages>
     34          <IgnoredMessages idx5024="True"/>
     35        </CompilerMessages>
    1636      </Other>
    1737    </CompilerOptions>
    … …  
    3858      <OutDir Value="Languages"/>
    3959    </i18n>
    40     <Type Value="RunAndDesignTime"/>
    4160    <RequiredPkgs Count="2">
    4261      <Item1>

  • trunk/Packages/CoolTranslator/UCoolTranslator.pas

    r85 r102  
    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/Packages/TemplateGenerics/ReadMe.txt

    r54 r102  
    1212
    1313Main subversion repository:
    14 http://svn.zdechov.net/svn/PascalClassLibrary/Generics/TemplateGenerics
     14https://svn.zdechov.net/PascalClassLibrary/Generics/TemplateGenerics

  • trunk/Packages/TemplateGenerics/TemplateGenerics.lpk

    r93 r102  
    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>
     17      <Parsing>
     18        <SyntaxOptions>
     19          <CStyleOperator Value="False"/>
     20          <AllowLabel Value="False"/>
     21          <CPPInline Value="False"/>
     22        </SyntaxOptions>
     23      </Parsing>
    1624      <CodeGeneration>
    1725        <Optimizations>
     26          <OptimizationLevel Value="0"/>
    1827          <VariablesInRegisters Value="True"/>
    19           <OptimizationLevel Value="3"/>
    2028        </Optimizations>
    2129      </CodeGeneration>
     30      <Linking>
     31        <Debugging>
     32          <GenerateDebugInfo Value="False"/>
     33        </Debugging>
     34      </Linking>
    2235      <Other>
    2336        <CompilerMessages>
    24           <UseMsgFile Value="True"/>
     37          <IgnoredMessages idx5024="True"/>
    2538        </CompilerMessages>
    26         <CompilerPath Value="$(CompPath)"/>
    2739      </Other>
    2840    </CompilerOptions>
    … …  
    4860      <Item5>
    4961        <Filename Value="Generic\GenericFileList.inc"/>
     62        <UnitName Value="GenericFileList"/>
    5063      </Item5>
    5164      <Item6>
    … …  
    142155      </Item28>
    143156    </Files>
    144     <Type Value="RunAndDesignTime"/>
    145157    <RequiredPkgs Count="2">
    146158      <Item1>
Note: See TracChangeset for help on using the changeset viewer.