Changeset 116 for trunk/Packages/Common

Timestamp:

Dec 10, 2016, 4:25:33 PM (8 years ago)

Author:

chronos

Message:

• Modified: Updated Common package.

Location:

trunk/Packages/Common

Files:

• Languages/UJobProgressView.po (modified) (1 diff)
• UCommon.pas (modified) (7 diffs)
• UDebugLog.pas (modified) (1 diff)
• UJobProgressView.lfm (modified) (1 diff)
• UJobProgressView.lrt (modified) (1 diff)
• UJobProgressView.pas (modified) (1 diff)
• UListViewSort.pas (modified) (14 diffs)
• UPersistentForm.pas (modified) (5 diffs)
• UScaleDPI.pas (modified) (1 diff)

trunk/Packages/Common/Languages/UJobProgressView.po

@@ -14 +14 @@
 msgstr ""
 
+#: ujobprogressview.soperations
+msgid "Operations"
+msgstr ""
+
 #: ujobprogressview.spleasewait
 msgid "Please wait..."

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;
@@ -65 +66 @@
 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;
 
 
@@ -108 +113 @@
   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);
@@ -287 +292 @@
   L: LongWord;
 begin
-
   L := MAX_USERNAME_LENGTH + 2;
   SetLength(Result, L);
@@ -302 +306 @@
   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
@@ -417 +449 @@
 
 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;
-  finally
-    Process.Free;
-  end;}
 end;
 
@@ -448 +465 @@
 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;
+
+
 
 initialization

trunk/Packages/Common/UDebugLog.pas

@@ -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/UJobProgressView.lfm

@@ -14 +14 @@
   OnDestroy = FormDestroy
   Position = poScreenCenter
-  LCLVersion = '1.1'
+  LCLVersion = '1.6.0.4'
   object PanelOperationsTitle: TPanel
     Left = 0

trunk/Packages/Common/UJobProgressView.lrt

@@ -1 @@
-TJOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations:
-TJOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time:
-TJOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time:
+TFORMJOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations:
+TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time:
+TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time:

trunk/Packages/Common/UJobProgressView.pas

@@ -166 +166 @@
   STotalEstimatedTime = 'Total estimated time: %s';
   SFinished = 'Finished';
+  SOperations = 'Operations';
 
 procedure Register;

trunk/Packages/Common/UListViewSort.pas

@@ -9 +9 @@
 uses
   {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,
-  Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls;
+  Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls,
+  LclIntf, LMessages, LclType, LResources;
 
 type
@@ -18 +19 @@
   TCompareEvent = function (Item1, Item2: TObject): Integer of object;
   TListFilterEvent = procedure (ListViewSort: TListViewSort) of object;
+
+  { TListViewSort }
 
   TListViewSort = class(TComponent)
@@ -28 +31 @@
     FColumn: Integer;
     FOrder: TSortOrder;
+    FOldListViewWindowProc: TWndMethod;
+    FOnColumnWidthChanged: TNotifyEvent;
+    procedure DoColumnBeginResize(const AColIndex: Integer);
+    procedure DoColumnResized(const AColIndex: Integer);
+    procedure DoColumnResizing(const AColIndex, AWidth: Integer);
     procedure SetListView(const Value: TListView);
     procedure ColumnClick(Sender: TObject; Column: TListColumn);
@@ -40 +48 @@
     procedure SetColumn(const Value: Integer);
     procedure SetOrder(const Value: TSortOrder);
+    {$IFDEF WINDOWS}
+    procedure NewListViewWindowProc(var AMsg: TMessage);
+    {$ENDIF}
   public
     List: TListObject;
@@ -58 +69 @@
     property OnCustomDraw: TLVCustomDrawItemEvent read FOnCustomDraw
       write FOnCustomDraw;
+    property OnColumnWidthChanged: TNotifyEvent read FOnColumnWidthChanged
+      write FOnColumnWidthChanged;
     property Column: Integer read FColumn write SetColumn;
     property Order: TSortOrder read FOrder write SetOrder;
@@ -69 +82 @@
     FStringGrid1: TStringGrid;
     procedure DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure DoOnResize(Sender: TObject);
   public
     constructor Create(AOwner: TComponent); override;
     procedure UpdateFromListView(ListView: TListView);
     function TextEntered: Boolean;
+    function TextEnteredCount: Integer;
     function TextEnteredColumn(Index: Integer): Boolean;
     function GetColValue(Index: Integer): string;
@@ -80 +95 @@
     property Align;
     property Anchors;
+    property BorderSpacing;
   end;
 
@@ -99 +115 @@
   if Assigned(FOnChange) then
     FOnChange(Self);
+end;
+
+procedure TListViewFilter.DoOnResize(Sender: TObject);
+begin
+  FStringGrid1.DefaultRowHeight := FStringGrid1.Height;
 end;
 
@@ -115 +136 @@
     goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll];
   FStringGrid1.OnKeyUp := DoOnKeyUp;
+  FStringGrid1.OnResize := DoOnResize;
 end;
 
@@ -120 +142 @@
 var
   I: Integer;
-  NewColumn: TGridColumn;
 begin
   with FStringGrid1 do begin
-    Columns.Clear;
+    //Columns.Clear;
     while Columns.Count > ListView.Columns.Count do Columns.Delete(Columns.Count - 1);
-    while Columns.Count < ListView.Columns.Count do NewColumn := Columns.Add;
+    while Columns.Count < ListView.Columns.Count do Columns.Add;
     for I := 0 to ListView.Columns.Count - 1 do begin
       Columns[I].Width := ListView.Columns[I].Width;
@@ -133 +154 @@
 
 function TListViewFilter.TextEntered: Boolean;
+begin
+  Result := TextEnteredCount > 0;
+end;
+
+function TListViewFilter.TextEnteredCount: Integer;
 var
   I: Integer;
 begin
-  Result := False;
+  Result := 0;
   for I := 0 to FStringGrid1.ColCount - 1 do begin
     if FStringGrid1.Cells[I, 0] <> '' then begin
-      Result := True;
-      Break;
+      Inc(Result);
     end;
   end;
@@ -159 +184 @@
 { TListViewSort }
 
+{$IFDEF WINDOWS}
+procedure TListViewSort.NewListViewWindowProc(var AMsg: TMessage);
+var
+  vColWidth: Integer;
+  vMsgNotify: TLMNotify absolute AMsg;
+  Code: Integer;
+begin
+  // call the old WindowProc of ListView
+  FOldListViewWindowProc(AMsg);
+
+  // Currently we care only with WM_NOTIFY message
+  if AMsg.Msg = WM_NOTIFY then
+  begin
+    Code := PHDNotify(vMsgNotify.NMHdr)^.Hdr.Code;
+    case Code of
+      HDN_ENDTRACKA, HDN_ENDTRACKW:
+        DoColumnResized(PHDNotify(vMsgNotify.NMHdr)^.Item);
+
+      HDN_BEGINTRACKA, HDN_BEGINTRACKW:
+        DoColumnBeginResize(PHDNotify(vMsgNotify.NMHdr)^.Item);
+
+      HDN_TRACKA, HDN_TRACKW:
+        begin
+          vColWidth := -1;
+          if (PHDNotify(vMsgNotify.NMHdr)^.PItem<>nil)
+             and (PHDNotify(vMsgNotify.NMHdr)^.PItem^.Mask and HDI_WIDTH <> 0)
+          then
+            vColWidth := PHDNotify(vMsgNotify.NMHdr)^.PItem^.cxy;
+
+          DoColumnResizing(PHDNotify(vMsgNotify.NMHdr)^.Item, vColWidth);
+        end;
+    end;
+  end;
+end;
+{$ENDIF}
+
+procedure TListViewSort.DoColumnBeginResize(const AColIndex: Integer);
+begin
+end;
+
+procedure TListViewSort.DoColumnResizing(const AColIndex, AWidth: Integer);
+begin
+end;
+
+procedure TListViewSort.DoColumnResized(const AColIndex: Integer);
+begin
+  if Assigned(FOnColumnWidthChanged) then
+    FOnColumnWidthChanged(Self);
+end;
 
 procedure TListViewSort.ColumnClick(Sender: TObject; Column: TListColumn);
@@ -185 +259 @@
 procedure TListViewSort.SetListView(const Value: TListView);
 begin
+  if FListView = Value then Exit;
+  if Assigned(FListView) then
+    ListView.WindowProc := FOldListViewWindowProc;
   FListView := Value;
   FListView.OnColumnClick := ColumnClick;
   FListView.OnCustomDrawItem := ListViewCustomDrawItem;
   FListView.OnClick := ListViewClick;
+  FOldListViewWindowProc := FListView.WindowProc;
+  {$IFDEF WINDOWS}
+  FListView.WindowProc := NewListViewWindowProc;
+  {$ENDIF}
 end;
 
@@ -205 +286 @@
   if ListView.Items.Count <> List.Count then
     ListView.Items.Count := List.Count;
-  if Assigned(FOnCompareItem) then Sort(FOnCompareItem);
+  if Assigned(FOnCompareItem) and (Order <> soNone) then Sort(FOnCompareItem);
   //ListView.Items[-1]; // Workaround for not show first row if selected
   ListView.Refresh;

trunk/Packages/Common/UPersistentForm.pas

@@ -8 +8 @@
 
 uses
-  Classes, SysUtils, Forms, URegistry, LCLIntf, Registry;
+  Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls;
 
 type
@@ -19 +19 @@
     FMinVisiblePart: Integer;
     FRegistryContext: TRegistryContext;
+    procedure LoadControl(Control: TControl);
+    procedure SaveControl(Control: TControl);
   public
     FormNormalSize: TRect;
@@ -49 +51 @@
 
 { TPersistentForm }
+
+procedure TPersistentForm.LoadControl(Control: TControl);
+var
+  I: Integer;
+  WinControl: TWinControl;
+  Count: Integer;
+begin
+  if Control is TListView then begin
+    with Form, TRegistryEx.Create do
+    try
+      RootKey := RegistryContext.RootKey;
+      OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
+      for I := 0 to TListView(Control).Columns.Count - 1 do begin
+        if ValueExists('ColWidth' + IntToStr(I)) then
+          TListView(Control).Columns[I].Width := ReadInteger('ColWidth' + IntToStr(I));
+      end;
+    finally
+      Free;
+    end;
+  end;
+
+  if Control is TWinControl then begin
+    WinControl := TWinControl(Control);
+    if WinControl.ControlCount > 0 then begin
+      for I := 0 to WinControl.ControlCount - 1 do begin
+        if WinControl.Controls[I] is TControl then begin
+          LoadControl(WinControl.Controls[I]);
+        end;
+      end;
+    end;
+  end;
+end;
+
+procedure TPersistentForm.SaveControl(Control: TControl);
+var
+  I: Integer;
+  WinControl: TWinControl;
+begin
+  if Control is TListView then begin
+    with Form, TRegistryEx.Create do
+    try
+      RootKey := RegistryContext.RootKey;
+      OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
+      for I := 0 to TListView(Control).Columns.Count - 1 do begin
+        WriteInteger('ColWidth' + IntToStr(I), TListView(Control).Columns[I].Width);
+      end;
+    finally
+      Free;
+    end;
+  end;
+
+  if Control is TWinControl then begin
+      WinControl := TWinControl(Control);
+      if WinControl.ControlCount > 0 then begin
+        for I := 0 to WinControl.ControlCount - 1 do begin
+          if WinControl.Controls[I] is TControl then begin
+            SaveControl(WinControl.Controls[I]);
+          end;
+        end;
+      end;
+    end;
+end;
 
 procedure TPersistentForm.LoadFromRegistry(RegistryContext: TRegistryContext);
@@ -181 +245 @@
       Form.BoundsRect := FormNormalSize;
   end;
+  LoadControl(Form);
 end;
 
@@ -191 +256 @@
   FormWindowState := Form.WindowState;
   SaveToRegistry(RegistryContext);
+  SaveControl(Form);
 end;
 

trunk/Packages/Common/UScaleDPI.pas

@@ -309 +309 @@
   end;
 
+  if Control is TCoolBar then
+  with TCoolBar(Control) do begin
+    BeginUpdate;
+    for I := 0 to Bands.Count - 1 do
+      with Bands[I] do begin
+        MinWidth := ScaleX(MinWidth, FromDPI.X);
+        MinHeight := ScaleY(MinHeight, FromDPI.Y);
+        Width := ScaleX(Width, FromDPI.X);
+        //Control.Invalidate;
+      end;
+    EndUpdate;
+  end;
+
   if Control is TToolBar then begin
     ToolBarControl := TToolBar(Control);