Ignore:
Timestamp:
May 16, 2019, 11:35:07 PM (6 years ago)
Author:
chronos
Message:
Location:
branches/generator/Packages/Common
Files:
1 deleted
16 edited

Legend:

Unmodified
Added
Removed

  • branches/generator/Packages/Common/Common.lpk

    r167 r189  
    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>

  • branches/generator/Packages/Common/Common.pas

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

  • branches/generator/Packages/Common/Languages/UJobProgressView.cs.po

    r167 r189  
    2424msgstr "Dokončené"
    2525
    26 #: ujobprogressview.soperations
    27 #, fuzzy
    28 #| msgid "Operations"
    29 msgid "Operations:"
    30 msgstr "Operace"
    31 
    3226#: ujobprogressview.spleasewait
    3327msgid "Please wait..."

  • branches/generator/Packages/Common/Languages/UJobProgressView.po

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

  • branches/generator/Packages/Common/Languages/UThreading.po

    r114 r189  
    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"

  • branches/generator/Packages/Common/UCommon.pas

    r167 r189  
    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

  • branches/generator/Packages/Common/UDebugLog.pas

    r167 r189  
    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;

  • branches/generator/Packages/Common/UJobProgressView.lfm

    r167 r189  
    1515  OnShow = FormShow
    1616  Position = poScreenCenter
    17   LCLVersion = '1.8.2.0'
     17  LCLVersion = '2.0.2.0'
    1818  object PanelOperationsTitle: TPanel
    1919    Left = 0
    … …  
    241241    Interval = 100
    242242    OnTimer = TimerUpdateTimer
    243     left = 264
     243    left = 320
    244244    top = 8
    245245  end

  • branches/generator/Packages/Common/UJobProgressView.pas

    r167 r189  
    175175  STotalEstimatedTime = 'Total estimated time: %s';
    176176  SFinished = 'Finished';
    177   SOperations = 'Operations:';
    178177
    179178procedure Register;

  • branches/generator/Packages/Common/UListViewSort.pas

    r167 r189  
    99uses
    1010  {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,
    11   Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls,
    12   LclIntf, LMessages, LclType, LResources;
     11  Controls, DateUtils, Dialogs, fgl, Forms, Grids, StdCtrls, ExtCtrls,
     12  LclIntf, LclType, LResources;
    1313
    1414type
    … …  
    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

  • branches/generator/Packages/Common/UMemory.pas

    r167 r189  
    112112procedure TMemory.WriteMemory(Position: Integer; Memory: TMemory);
    113113begin
    114   Move(Memory.FData, PByte(@FData + Position)^, Memory.Size);
     114  Move(Memory.FData, PByte(PByte(@FData) + Position)^, Memory.Size);
    115115end;
    116116
    117117procedure TMemory.ReadMemory(Position: Integer; Memory: TMemory);
    118118begin
    119   Move(PByte(@FData + Position)^, Memory.FData, Memory.Size);
     119  Move(PByte(PByte(@FData) + Position)^, Memory.FData, Memory.Size);
    120120end;
    121121

  • branches/generator/Packages/Common/UPool.pas

    r114 r189  
    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;

  • branches/generator/Packages/Common/UPrefixMultiplier.pas

    r114 r189  
    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;

  • branches/generator/Packages/Common/URegistry.pas

    r167 r189  
    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;

  • branches/generator/Packages/Common/UScaleDPI.pas

    r167 r189  
    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;

  • branches/generator/Packages/Common/UXMLUtils.pas

    r167 r189  
    77uses
    88  {$IFDEF WINDOWS}Windows,{$ENDIF}
    9   Classes, SysUtils, DateUtils, DOM, XMLRead;
     9  Classes, SysUtils, DateUtils, DOM, xmlread;
    1010
    1111function XMLTimeToDateTime(XMLDateTime: string): TDateTime;
Note: See TracChangeset for help on using the changeset viewer.