Changeset 74 for trunk/Packages/Common

Timestamp:

Jan 18, 2018, 11:54:13 PM (7 years ago)

Author:

chronos

Message:

• Fixed: Build under Lazarus 1.8.0.

Location:

trunk/Packages/Common

Files:

• Common.lpk (modified) (3 diffs)
• Common.pas (modified) (2 diffs)
• UApplicationInfo.pas (modified) (1 diff)
• UCommon.pas (modified) (6 diffs)
• UDebugLog.pas (modified) (4 diffs)
• UFindFile.pas (modified) (1 diff)
• UJobProgressView.pas (modified) (1 diff)
• ULastOpenedList.pas (modified) (1 diff)
• UListViewSort.pas (modified) (6 diffs)
• URegistry.pas (modified) (2 diffs)

trunk/Packages/Common/Common.lpk

@@ -1 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <Package Version="4">
@@ -22 +22 @@
     <License Value="GNU/GPL"/>
     <Version Minor="7"/>
-    <Files Count="17">
+    <Files Count="19">
       <Item1>
         <Filename Value="StopWatch.pas"/>
@@ -93 +93 @@
       <Item17>
         <Filename Value="UListViewSort.pas"/>
+        <HasRegisterProc Value="True"/>
         <UnitName Value="UListViewSort"/>
       </Item17>
+      <Item18>
+        <Filename Value="UPersistentForm.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="UPersistentForm"/>
+      </Item18>
+      <Item19>
+        <Filename Value="UFindFile.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="UFindFile"/>
+      </Item19>
     </Files>
     <i18n>

trunk/Packages/Common/Common.pas

@@ -11 +11 @@
   UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 
   UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 
-  LazarusPackageIntf;
+  UPersistentForm, UFindFile, LazarusPackageIntf;
 
 implementation
@@ -21 +21 @@
   RegisterUnit('UJobProgressView', @UJobProgressView.Register);
   RegisterUnit('UApplicationInfo', @UApplicationInfo.Register);
+  RegisterUnit('UListViewSort', @UListViewSort.Register);
+  RegisterUnit('UPersistentForm', @UPersistentForm.Register);
+  RegisterUnit('UFindFile', @UFindFile.Register);
 end;
 

trunk/Packages/Common/UApplicationInfo.pas

@@ -55 +55 @@
 procedure Register;
 begin
-  RegisterComponents('Samples', [TApplicationInfo]);
+  RegisterComponents('Common', [TApplicationInfo]);
 end;
 

trunk/Packages/Common/UCommon.pas

@@ -6 +6 @@
 
 uses
-  {$IFDEF Windows}Windows,{$ENDIF}
+  {$ifdef Windows}Windows,{$endif}
+  {$ifdef Linux}baseunix,{$endif}
   Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf,
   FileUtil; //, ShFolder, ShellAPI;
@@ -64 +65 @@
 procedure ExecuteProgram(CommandLine: string);
 procedure FreeThenNil(var Obj);
+function RemoveQuotes(Text: string): string;
+function ComputerName: string;
+function OccurenceOfChar(What: Char; Where: string): Integer;
+function GetDirCount(Dir: string): Integer;
+function MergeArray(A, B: array of string): TArrayOfString;
+function LoadFileToStr(const FileName: TFileName): AnsiString;
 
 
@@ -107 +114 @@
   Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec);
   while Find = 0 do begin
-    DeleteFileUTF8(Path + UTF8Encode(SearchRec.Name));
+    DeleteFile(Path + UTF8Encode(SearchRec.Name));
 
     Find := SysUtils.FindNext(SearchRec);
@@ -286 +293 @@
   L: LongWord;
 begin
-
   L := MAX_USERNAME_LENGTH + 2;
   SetLength(Result, L);
@@ -301 +307 @@
   end;
 end;
-
+{$endif}
+
+function ComputerName: string;
+{$ifdef mswindows}
+const
+ INFO_BUFFER_SIZE = 32767;
+var
+  Buffer : array[0..INFO_BUFFER_SIZE] of WideChar;
+  Ret : DWORD;
+begin
+  Ret := INFO_BUFFER_SIZE;
+  If (GetComputerNameW(@Buffer[0],Ret)) then begin
+    Result := UTF8Encode(WideString(Buffer));
+  end
+  else begin
+    Result := 'ERROR_NO_COMPUTERNAME_RETURNED';
+  end;
+end;
+{$endif}
+{$ifdef unix}
+var
+  Name: UtsName;
+begin
+  fpuname(Name);
+  Result := Name.Nodename;
+end;
+{$endif}
+
+{$ifdef windows}
 function LoggedOnUserNameEx(Format: TUserNameFormat): string;
 const
@@ -416 +450 @@
 
 procedure OpenWebPage(URL: string);
-var
-  Process: TProcess;
-  Browser, Params: string;
 begin
   OpenURL(URL);
-  {try
-    Process := TProcess.Create(nil);
-    Browser := '';
-    //FindDefaultBrowser(Browser, Params);
-    //Process.Executable := Browser;
-    //Process.Parameters.Add(Format(Params, [ApplicationInfo.HomePage]);
-    Process.CommandLine := 'cmd.exe /c start ' + URL;
-    Process.Options := [poNoConsole];
-    Process.Execute;
+end;
+
+procedure OpenFileInShell(FileName: string);
+begin
+  ExecuteProgram('cmd.exe /c start "' + FileName + '"');
+end;
+
+function RemoveQuotes(Text: string): string;
+begin
+  Result := Text;
+  if (Pos('"', Text) = 1) and (Text[Length(Text)] = '"') then
+    Result := Copy(Text, 2, Length(Text) - 2);
+end;
+
+function OccurenceOfChar(What: Char; Where: string): Integer;
+var
+  I: Integer;
+begin
+  Result := 0;
+  for I := 1 to Length(Where) do
+    if Where[I] = What then Inc(Result);
+end;
+
+function GetDirCount(Dir: string): Integer;
+begin
+  Result := OccurenceOfChar(DirectorySeparator, Dir);
+  if Copy(Dir, Length(Dir), 1) = DirectorySeparator then
+    Dec(Result);
+end;
+
+function MergeArray(A, B: array of string): TArrayOfString;
+var
+  I: Integer;
+begin
+  SetLength(Result, Length(A) + Length(B));
+  for I := 0 to Length(A) - 1 do
+    Result[I] := A[I];
+  for I := 0 to Length(B) - 1 do
+    Result[Length(A) + I] := B[I];
+end;
+
+function LoadFileToStr(const FileName: TFileName): AnsiString;
+var
+  FileStream: TFileStream;
+  Read: Integer;
+begin
+  Result := '';
+  FileStream := TFileStream.Create(FileName, fmOpenRead);
+  try
+    if FileStream.Size > 0 then begin
+      SetLength(Result, FileStream.Size);
+      Read := FileStream.Read(Pointer(Result)^, FileStream.Size);
+      SetLength(Result, Read);
+    end;
   finally
-    Process.Free;
-  end;}
-end;
-
-procedure OpenFileInShell(FileName: string);
-begin
-  ExecuteProgram('cmd.exe /c start "' + FileName + '"');
-end;
+    FileStream.Free;
+  end;
+end;
+
+
 
 initialization

trunk/Packages/Common/UDebugLog.pas

@@ -31 +31 @@
     Items: TListObject;
     Lock: TCriticalSection;
-    procedure Add(Group: string; Text: string);
+    procedure Add(Text: string; Group: string = '');
     procedure WriteToFile(Text: string);
     constructor Create(AOwner: TComponent); override;
@@ -52 +52 @@
 procedure Register;
 begin
-  RegisterComponents('Samples', [TDebugLog]);
+  RegisterComponents('Common', [TDebugLog]);
 end;
 
@@ -69 +69 @@
 end;
 
-procedure TDebugLog.Add(Group: string; Text: string);
+procedure TDebugLog.Add(Text: string; Group: string = '');
 var
   NewItem: TDebugLogItem;
@@ -103 +103 @@
   try
     if ExtractFileDir(FileName) <> '' then
-      ForceDirectoriesUTF8(ExtractFileDir(FileName));
-    if FileExistsUTF8(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
+      ForceDirectories(ExtractFileDir(FileName));
+    if FileExists(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
       else LogFile := TFileStream.Create(UTF8Decode(FileName), fmCreate);
     LogFile.Seek(0, soFromEnd);

trunk/Packages/Common/UFindFile.pas

@@ -64 +64 @@
 procedure Register;
 begin
-  RegisterComponents('Samples', [TFindFile]);
+  RegisterComponents('Common', [TFindFile]);
 end;
 

trunk/Packages/Common/UJobProgressView.pas

@@ -169 +169 @@
 procedure Register;
 begin
-  RegisterComponents('Samples', [TJobProgressView]);
+  RegisterComponents('Common', [TJobProgressView]);
 end;
 

trunk/Packages/Common/ULastOpenedList.pas

@@ -40 +40 @@
 procedure Register;
 begin
-  RegisterComponents('Samples', [TLastOpenedList]);
+  RegisterComponents('Common', [TLastOpenedList]);
 end;
 

trunk/Packages/Common/UListViewSort.pas

@@ -9 +9 @@
 uses
   {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,
-  Controls, DateUtils, Dialogs, SpecializedList;
+  Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls;
 
 type
@@ -19 +19 @@
   TListFilterEvent = procedure (ListViewSort: TListViewSort) of object;
 
-  TListViewSort = class
+  TListViewSort = class(TComponent)
   private
     FListView: TListView;
@@ -43 +43 @@
     List: TListObject;
     Source: TListObject;
-    constructor Create;
+    constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     function CompareTime(Time1, Time2: TDateTime): Integer;
@@ -50 +50 @@
     function CompareBoolean(Value1, Value2: Boolean): Integer;
     procedure Refresh;
+  published
     property ListView: TListView read FListView write SetListView;
     property OnCompareItem: TCompareEvent read FOnCompareItem
@@ -61 +62 @@
   end;
 
+  { TListViewFilter }
+
+  TListViewFilter = class(TWinControl)
+  private
+    FOnChange: TNotifyEvent;
+    FStringGrid1: TStringGrid;
+    procedure DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure UpdateFromListView(ListView: TListView);
+    function TextEntered: Boolean;
+    function GetColValue(Index: Integer): string;
+    property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1;
+  published
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property Align;
+    property Anchors;
+  end;
+
+procedure Register;
+
+
 implementation
+
+procedure Register;
+begin
+  RegisterComponents('Common', [TListViewSort, TListViewFilter]);
+end;
+
+{ TListViewFilter }
+
+procedure TListViewFilter.DoOnKeyUp(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+constructor TListViewFilter.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FStringGrid1 := TStringGrid.Create(Self);
+  FStringGrid1.Align := alClient;
+  FStringGrid1.Parent := Self;
+  FStringGrid1.Visible := True;
+  FStringGrid1.ScrollBars := ssNone;
+  FStringGrid1.FixedCols := 0;
+  FStringGrid1.FixedRows := 0;
+  FStringGrid1.RowCount := 1;
+  FStringGrid1.Options := [goFixedHorzLine, goFixedVertLine, goVertLine,
+    goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll];
+  FStringGrid1.OnKeyUp := DoOnKeyUp;
+end;
+
+procedure TListViewFilter.UpdateFromListView(ListView: TListView);
+var
+  I: Integer;
+  NewColumn: TGridColumn;
+begin
+  with FStringGrid1 do begin
+    Columns.Clear;
+    while Columns.Count > ListView.Columns.Count do Columns.Delete(Columns.Count - 1);
+    while Columns.Count < ListView.Columns.Count do NewColumn := Columns.Add;
+    for I := 0 to ListView.Columns.Count - 1 do begin
+      Columns[I].Width := ListView.Columns[I].Width;
+    end;
+  end;
+end;
+
+function TListViewFilter.TextEntered: Boolean;
+var
+  I: Integer;
+begin
+  Result := False;
+  for I := 0 to FStringGrid1.ColCount - 1 do begin
+    if FStringGrid1.Cells[I, 0] <> '' then begin
+      Result := True;
+      Break;
+    end;
+  end;
+end;
+
+function TListViewFilter.GetColValue(Index: Integer): string;
+begin
+  if (Index >= 0) and (Index < StringGrid.Columns.Count) then
+    Result := StringGrid.Cells[Index, 0]
+    else Result := '';
+end;
 
 { TListViewSort }
@@ -160 +248 @@
 end;
 
-constructor TListViewSort.Create;
-begin
+constructor TListViewSort.Create(AOwner: TComponent);
+begin
+  inherited;
   List := TListObject.Create;
   List.OwnsObjects := False;

trunk/Packages/Common/URegistry.pas

@@ -17 +17 @@
     rrKeyDynData = HKEY($80000006));
 
+  { TRegistryContext }
+
   TRegistryContext = record
     RootKey: HKEY;
     Key: string;
+    class operator Equal(A, B: TRegistryContext): Boolean;
   end;
 
@@ -49 +52 @@
   Result.RootKey := RootKey;
   Result.Key := Key;
+end;
+
+{ TRegistryContext }
+
+class operator TRegistryContext.Equal(A, B: TRegistryContext): Boolean;
+begin
+  Result := (A.Key = B.Key) and (A.RootKey = B.RootKey);
 end;