Changeset 116
- Timestamp:
- Dec 10, 2016, 4:25:33 PM (8 years ago)
- Location:
- trunk/Packages/Common
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/Languages/UJobProgressView.po
r107 r116 14 14 msgstr "" 15 15 16 #: ujobprogressview.soperations 17 msgid "Operations" 18 msgstr "" 19 16 20 #: ujobprogressview.spleasewait 17 21 msgid "Please wait..." -
trunk/Packages/Common/UCommon.pas
r109 r116 6 6 7 7 uses 8 {$IFDEF Windows}Windows,{$ENDIF} 8 {$ifdef Windows}Windows,{$endif} 9 {$ifdef Linux}baseunix,{$endif} 9 10 Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, 10 11 FileUtil; //, ShFolder, ShellAPI; … … 65 66 procedure FreeThenNil(var Obj); 66 67 function RemoveQuotes(Text: string): string; 68 function ComputerName: string; 69 function OccurenceOfChar(What: Char; Where: string): Integer; 70 function GetDirCount(Dir: string): Integer; 71 function MergeArray(A, B: array of string): TArrayOfString; 67 72 68 73 … … 108 113 Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec); 109 114 while Find = 0 do begin 110 DeleteFile UTF8(Path + UTF8Encode(SearchRec.Name));115 DeleteFile(Path + UTF8Encode(SearchRec.Name)); 111 116 112 117 Find := SysUtils.FindNext(SearchRec); … … 287 292 L: LongWord; 288 293 begin 289 290 294 L := MAX_USERNAME_LENGTH + 2; 291 295 SetLength(Result, L); … … 302 306 end; 303 307 end; 304 308 {$endif} 309 310 function ComputerName: string; 311 {$ifdef mswindows} 312 const 313 INFO_BUFFER_SIZE = 32767; 314 var 315 Buffer : array[0..INFO_BUFFER_SIZE] of WideChar; 316 Ret : DWORD; 317 begin 318 Ret := INFO_BUFFER_SIZE; 319 If (GetComputerNameW(@Buffer[0],Ret)) then begin 320 Result := UTF8Encode(WideString(Buffer)); 321 end 322 else begin 323 Result := 'ERROR_NO_COMPUTERNAME_RETURNED'; 324 end; 325 end; 326 {$endif} 327 {$ifdef unix} 328 var 329 Name: UtsName; 330 begin 331 fpuname(Name); 332 Result := Name.Nodename; 333 end; 334 {$endif} 335 336 {$ifdef windows} 305 337 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 306 338 const … … 417 449 418 450 procedure OpenWebPage(URL: string); 419 var420 Process: TProcess;421 Browser, Params: string;422 451 begin 423 452 OpenURL(URL); 424 {try425 Process := TProcess.Create(nil);426 Browser := '';427 //FindDefaultBrowser(Browser, Params);428 //Process.Executable := Browser;429 //Process.Parameters.Add(Format(Params, [ApplicationInfo.HomePage]);430 Process.CommandLine := 'cmd.exe /c start ' + URL;431 Process.Options := [poNoConsole];432 Process.Execute;433 finally434 Process.Free;435 end;}436 453 end; 437 454 … … 448 465 end; 449 466 467 function OccurenceOfChar(What: Char; Where: string): Integer; 468 var 469 I: Integer; 470 begin 471 Result := 0; 472 for I := 1 to Length(Where) do 473 if Where[I] = What then Inc(Result); 474 end; 475 476 function GetDirCount(Dir: string): Integer; 477 begin 478 Result := OccurenceOfChar(DirectorySeparator, Dir); 479 if Copy(Dir, Length(Dir), 1) = DirectorySeparator then 480 Dec(Result); 481 end; 482 483 function MergeArray(A, B: array of string): TArrayOfString; 484 var 485 I: Integer; 486 begin 487 SetLength(Result, Length(A) + Length(B)); 488 for I := 0 to Length(A) - 1 do 489 Result[I] := A[I]; 490 for I := 0 to Length(B) - 1 do 491 Result[Length(A) + I] := B[I]; 492 end; 493 494 450 495 451 496 initialization -
trunk/Packages/Common/UDebugLog.pas
r43 r116 103 103 try 104 104 if ExtractFileDir(FileName) <> '' then 105 ForceDirectories UTF8(ExtractFileDir(FileName));106 if FileExists UTF8(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)105 ForceDirectories(ExtractFileDir(FileName)); 106 if FileExists(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite) 107 107 else LogFile := TFileStream.Create(UTF8Decode(FileName), fmCreate); 108 108 LogFile.Seek(0, soFromEnd); -
trunk/Packages/Common/UJobProgressView.lfm
r43 r116 14 14 OnDestroy = FormDestroy 15 15 Position = poScreenCenter 16 LCLVersion = '1. 1'16 LCLVersion = '1.6.0.4' 17 17 object PanelOperationsTitle: TPanel 18 18 Left = 0 -
trunk/Packages/Common/UJobProgressView.lrt
r43 r116 1 T JOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations:2 T JOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time:3 T JOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time:1 TFORMJOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations: 2 TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time: 3 TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time: -
trunk/Packages/Common/UJobProgressView.pas
r43 r116 166 166 STotalEstimatedTime = 'Total estimated time: %s'; 167 167 SFinished = 'Finished'; 168 SOperations = 'Operations'; 168 169 169 170 procedure Register; -
trunk/Packages/Common/UListViewSort.pas
r109 r116 9 9 uses 10 10 {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils, 11 Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls; 11 Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls, 12 LclIntf, LMessages, LclType, LResources; 12 13 13 14 type … … 18 19 TCompareEvent = function (Item1, Item2: TObject): Integer of object; 19 20 TListFilterEvent = procedure (ListViewSort: TListViewSort) of object; 21 22 { TListViewSort } 20 23 21 24 TListViewSort = class(TComponent) … … 28 31 FColumn: Integer; 29 32 FOrder: TSortOrder; 33 FOldListViewWindowProc: TWndMethod; 34 FOnColumnWidthChanged: TNotifyEvent; 35 procedure DoColumnBeginResize(const AColIndex: Integer); 36 procedure DoColumnResized(const AColIndex: Integer); 37 procedure DoColumnResizing(const AColIndex, AWidth: Integer); 30 38 procedure SetListView(const Value: TListView); 31 39 procedure ColumnClick(Sender: TObject; Column: TListColumn); … … 40 48 procedure SetColumn(const Value: Integer); 41 49 procedure SetOrder(const Value: TSortOrder); 50 {$IFDEF WINDOWS} 51 procedure NewListViewWindowProc(var AMsg: TMessage); 52 {$ENDIF} 42 53 public 43 54 List: TListObject; … … 58 69 property OnCustomDraw: TLVCustomDrawItemEvent read FOnCustomDraw 59 70 write FOnCustomDraw; 71 property OnColumnWidthChanged: TNotifyEvent read FOnColumnWidthChanged 72 write FOnColumnWidthChanged; 60 73 property Column: Integer read FColumn write SetColumn; 61 74 property Order: TSortOrder read FOrder write SetOrder; … … 69 82 FStringGrid1: TStringGrid; 70 83 procedure DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 84 procedure DoOnResize(Sender: TObject); 71 85 public 72 86 constructor Create(AOwner: TComponent); override; 73 87 procedure UpdateFromListView(ListView: TListView); 74 88 function TextEntered: Boolean; 89 function TextEnteredCount: Integer; 75 90 function TextEnteredColumn(Index: Integer): Boolean; 76 91 function GetColValue(Index: Integer): string; … … 80 95 property Align; 81 96 property Anchors; 97 property BorderSpacing; 82 98 end; 83 99 … … 99 115 if Assigned(FOnChange) then 100 116 FOnChange(Self); 117 end; 118 119 procedure TListViewFilter.DoOnResize(Sender: TObject); 120 begin 121 FStringGrid1.DefaultRowHeight := FStringGrid1.Height; 101 122 end; 102 123 … … 115 136 goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll]; 116 137 FStringGrid1.OnKeyUp := DoOnKeyUp; 138 FStringGrid1.OnResize := DoOnResize; 117 139 end; 118 140 … … 120 142 var 121 143 I: Integer; 122 NewColumn: TGridColumn;123 144 begin 124 145 with FStringGrid1 do begin 125 Columns.Clear;146 //Columns.Clear; 126 147 while Columns.Count > ListView.Columns.Count do Columns.Delete(Columns.Count - 1); 127 while Columns.Count < ListView.Columns.Count do NewColumn :=Columns.Add;148 while Columns.Count < ListView.Columns.Count do Columns.Add; 128 149 for I := 0 to ListView.Columns.Count - 1 do begin 129 150 Columns[I].Width := ListView.Columns[I].Width; … … 133 154 134 155 function TListViewFilter.TextEntered: Boolean; 156 begin 157 Result := TextEnteredCount > 0; 158 end; 159 160 function TListViewFilter.TextEnteredCount: Integer; 135 161 var 136 162 I: Integer; 137 163 begin 138 Result := False;164 Result := 0; 139 165 for I := 0 to FStringGrid1.ColCount - 1 do begin 140 166 if FStringGrid1.Cells[I, 0] <> '' then begin 141 Result := True; 142 Break; 167 Inc(Result); 143 168 end; 144 169 end; … … 159 184 { TListViewSort } 160 185 186 {$IFDEF WINDOWS} 187 procedure TListViewSort.NewListViewWindowProc(var AMsg: TMessage); 188 var 189 vColWidth: Integer; 190 vMsgNotify: TLMNotify absolute AMsg; 191 Code: Integer; 192 begin 193 // call the old WindowProc of ListView 194 FOldListViewWindowProc(AMsg); 195 196 // Currently we care only with WM_NOTIFY message 197 if AMsg.Msg = WM_NOTIFY then 198 begin 199 Code := PHDNotify(vMsgNotify.NMHdr)^.Hdr.Code; 200 case Code of 201 HDN_ENDTRACKA, HDN_ENDTRACKW: 202 DoColumnResized(PHDNotify(vMsgNotify.NMHdr)^.Item); 203 204 HDN_BEGINTRACKA, HDN_BEGINTRACKW: 205 DoColumnBeginResize(PHDNotify(vMsgNotify.NMHdr)^.Item); 206 207 HDN_TRACKA, HDN_TRACKW: 208 begin 209 vColWidth := -1; 210 if (PHDNotify(vMsgNotify.NMHdr)^.PItem<>nil) 211 and (PHDNotify(vMsgNotify.NMHdr)^.PItem^.Mask and HDI_WIDTH <> 0) 212 then 213 vColWidth := PHDNotify(vMsgNotify.NMHdr)^.PItem^.cxy; 214 215 DoColumnResizing(PHDNotify(vMsgNotify.NMHdr)^.Item, vColWidth); 216 end; 217 end; 218 end; 219 end; 220 {$ENDIF} 221 222 procedure TListViewSort.DoColumnBeginResize(const AColIndex: Integer); 223 begin 224 end; 225 226 procedure TListViewSort.DoColumnResizing(const AColIndex, AWidth: Integer); 227 begin 228 end; 229 230 procedure TListViewSort.DoColumnResized(const AColIndex: Integer); 231 begin 232 if Assigned(FOnColumnWidthChanged) then 233 FOnColumnWidthChanged(Self); 234 end; 161 235 162 236 procedure TListViewSort.ColumnClick(Sender: TObject; Column: TListColumn); … … 185 259 procedure TListViewSort.SetListView(const Value: TListView); 186 260 begin 261 if FListView = Value then Exit; 262 if Assigned(FListView) then 263 ListView.WindowProc := FOldListViewWindowProc; 187 264 FListView := Value; 188 265 FListView.OnColumnClick := ColumnClick; 189 266 FListView.OnCustomDrawItem := ListViewCustomDrawItem; 190 267 FListView.OnClick := ListViewClick; 268 FOldListViewWindowProc := FListView.WindowProc; 269 {$IFDEF WINDOWS} 270 FListView.WindowProc := NewListViewWindowProc; 271 {$ENDIF} 191 272 end; 192 273 … … 205 286 if ListView.Items.Count <> List.Count then 206 287 ListView.Items.Count := List.Count; 207 if Assigned(FOnCompareItem) then Sort(FOnCompareItem);288 if Assigned(FOnCompareItem) and (Order <> soNone) then Sort(FOnCompareItem); 208 289 //ListView.Items[-1]; // Workaround for not show first row if selected 209 290 ListView.Refresh; -
trunk/Packages/Common/UPersistentForm.pas
r109 r116 8 8 9 9 uses 10 Classes, SysUtils, Forms, URegistry, LCLIntf, Registry ;10 Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls; 11 11 12 12 type … … 19 19 FMinVisiblePart: Integer; 20 20 FRegistryContext: TRegistryContext; 21 procedure LoadControl(Control: TControl); 22 procedure SaveControl(Control: TControl); 21 23 public 22 24 FormNormalSize: TRect; … … 49 51 50 52 { TPersistentForm } 53 54 procedure TPersistentForm.LoadControl(Control: TControl); 55 var 56 I: Integer; 57 WinControl: TWinControl; 58 Count: Integer; 59 begin 60 if Control is TListView then begin 61 with Form, TRegistryEx.Create do 62 try 63 RootKey := RegistryContext.RootKey; 64 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True); 65 for I := 0 to TListView(Control).Columns.Count - 1 do begin 66 if ValueExists('ColWidth' + IntToStr(I)) then 67 TListView(Control).Columns[I].Width := ReadInteger('ColWidth' + IntToStr(I)); 68 end; 69 finally 70 Free; 71 end; 72 end; 73 74 if Control is TWinControl then begin 75 WinControl := TWinControl(Control); 76 if WinControl.ControlCount > 0 then begin 77 for I := 0 to WinControl.ControlCount - 1 do begin 78 if WinControl.Controls[I] is TControl then begin 79 LoadControl(WinControl.Controls[I]); 80 end; 81 end; 82 end; 83 end; 84 end; 85 86 procedure TPersistentForm.SaveControl(Control: TControl); 87 var 88 I: Integer; 89 WinControl: TWinControl; 90 begin 91 if Control is TListView then begin 92 with Form, TRegistryEx.Create do 93 try 94 RootKey := RegistryContext.RootKey; 95 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True); 96 for I := 0 to TListView(Control).Columns.Count - 1 do begin 97 WriteInteger('ColWidth' + IntToStr(I), TListView(Control).Columns[I].Width); 98 end; 99 finally 100 Free; 101 end; 102 end; 103 104 if Control is TWinControl then begin 105 WinControl := TWinControl(Control); 106 if WinControl.ControlCount > 0 then begin 107 for I := 0 to WinControl.ControlCount - 1 do begin 108 if WinControl.Controls[I] is TControl then begin 109 SaveControl(WinControl.Controls[I]); 110 end; 111 end; 112 end; 113 end; 114 end; 51 115 52 116 procedure TPersistentForm.LoadFromRegistry(RegistryContext: TRegistryContext); … … 181 245 Form.BoundsRect := FormNormalSize; 182 246 end; 247 LoadControl(Form); 183 248 end; 184 249 … … 191 256 FormWindowState := Form.WindowState; 192 257 SaveToRegistry(RegistryContext); 258 SaveControl(Form); 193 259 end; 194 260 -
trunk/Packages/Common/UScaleDPI.pas
r107 r116 309 309 end; 310 310 311 if Control is TCoolBar then 312 with TCoolBar(Control) do begin 313 BeginUpdate; 314 for I := 0 to Bands.Count - 1 do 315 with Bands[I] do begin 316 MinWidth := ScaleX(MinWidth, FromDPI.X); 317 MinHeight := ScaleY(MinHeight, FromDPI.Y); 318 Width := ScaleX(Width, FromDPI.X); 319 //Control.Invalidate; 320 end; 321 EndUpdate; 322 end; 323 311 324 if Control is TToolBar then begin 312 325 ToolBarControl := TToolBar(Control);
Note:
See TracChangeset
for help on using the changeset viewer.