- Timestamp:
- Dec 7, 2017, 12:21:08 PM (7 years ago)
- Location:
- trunk
- Files:
-
- 4 added
- 21 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormBrowse.pas
r15 r19 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, 9 ExtCtrls, Menus, ActnList, UFindFile, UVCS, Contnrs ;9 ExtCtrls, Menus, ActnList, UFindFile, UVCS, Contnrs, LazFileUtils; 10 10 11 11 type -
trunk/Forms/UFormProjectGroup.pas
r13 r19 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, 9 Menus, ActnList, UProject ;9 Menus, ActnList, UProject, LazFileUtils; 10 10 11 11 type -
trunk/Forms/UFormTest.pas
r13 r19 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, 9 StdCtrls ;9 StdCtrls, LazFileUtils; 10 10 11 11 type -
trunk/Packages/Common/Common.lpk
r6 r19 4 4 <PathDelim Value="\"/> 5 5 <Name Value="Common"/> 6 <Type Value="RunAndDesignTime"/> 6 7 <AddToProjectUsesSection Value="True"/> 7 8 <Author Value="Chronos (robie@centrum.cz)"/> … … 109 110 <EnableI18N Value="True"/> 110 111 <OutDir Value="Languages"/> 112 <EnableI18NForLFM Value="True"/> 111 113 </i18n> 112 <Type Value="RunAndDesignTime"/> 113 <RequiredPkgs Count="2"> 114 <RequiredPkgs Count="3"> 114 115 <Item1> 115 <PackageName Value=" TemplateGenerics"/>116 <PackageName Value="LCL"/> 116 117 </Item1> 117 118 <Item2> 119 <PackageName Value="TemplateGenerics"/> 120 </Item2> 121 <Item3> 118 122 <PackageName Value="FCL"/> 119 123 <MinVersion Major="1" Valid="True"/> 120 </Item 2>124 </Item3> 121 125 </RequiredPkgs> 122 126 <UsageOptions> -
trunk/Packages/Common/Languages/UJobProgressView.po
r6 r19 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
r6 r19 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; … … 64 65 procedure ExecuteProgram(CommandLine: string); 65 66 procedure FreeThenNil(var Obj); 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; 72 function LoadFileToStr(const FileName: TFileName): AnsiString; 66 73 67 74 … … 107 114 Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec); 108 115 while Find = 0 do begin 109 DeleteFile UTF8(Path + UTF8Encode(SearchRec.Name));116 DeleteFile(Path + UTF8Encode(SearchRec.Name)); 110 117 111 118 Find := SysUtils.FindNext(SearchRec); … … 286 293 L: LongWord; 287 294 begin 288 289 295 L := MAX_USERNAME_LENGTH + 2; 290 296 SetLength(Result, L); … … 301 307 end; 302 308 end; 303 309 {$endif} 310 311 function ComputerName: string; 312 {$ifdef mswindows} 313 const 314 INFO_BUFFER_SIZE = 32767; 315 var 316 Buffer : array[0..INFO_BUFFER_SIZE] of WideChar; 317 Ret : DWORD; 318 begin 319 Ret := INFO_BUFFER_SIZE; 320 If (GetComputerNameW(@Buffer[0],Ret)) then begin 321 Result := UTF8Encode(WideString(Buffer)); 322 end 323 else begin 324 Result := 'ERROR_NO_COMPUTERNAME_RETURNED'; 325 end; 326 end; 327 {$endif} 328 {$ifdef unix} 329 var 330 Name: UtsName; 331 begin 332 fpuname(Name); 333 Result := Name.Nodename; 334 end; 335 {$endif} 336 337 {$ifdef windows} 304 338 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 305 339 const … … 416 450 417 451 procedure OpenWebPage(URL: string); 418 var419 Process: TProcess;420 Browser, Params: string;421 452 begin 422 453 OpenURL(URL); 423 {try 424 Process := TProcess.Create(nil); 425 Browser := ''; 426 //FindDefaultBrowser(Browser, Params); 427 //Process.Executable := Browser; 428 //Process.Parameters.Add(Format(Params, [ApplicationInfo.HomePage]); 429 Process.CommandLine := 'cmd.exe /c start ' + URL; 430 Process.Options := [poNoConsole]; 431 Process.Execute; 454 end; 455 456 procedure OpenFileInShell(FileName: string); 457 begin 458 ExecuteProgram('cmd.exe /c start "' + FileName + '"'); 459 end; 460 461 function RemoveQuotes(Text: string): string; 462 begin 463 Result := Text; 464 if (Pos('"', Text) = 1) and (Text[Length(Text)] = '"') then 465 Result := Copy(Text, 2, Length(Text) - 2); 466 end; 467 468 function OccurenceOfChar(What: Char; Where: string): Integer; 469 var 470 I: Integer; 471 begin 472 Result := 0; 473 for I := 1 to Length(Where) do 474 if Where[I] = What then Inc(Result); 475 end; 476 477 function GetDirCount(Dir: string): Integer; 478 begin 479 Result := OccurenceOfChar(DirectorySeparator, Dir); 480 if Copy(Dir, Length(Dir), 1) = DirectorySeparator then 481 Dec(Result); 482 end; 483 484 function MergeArray(A, B: array of string): TArrayOfString; 485 var 486 I: Integer; 487 begin 488 SetLength(Result, Length(A) + Length(B)); 489 for I := 0 to Length(A) - 1 do 490 Result[I] := A[I]; 491 for I := 0 to Length(B) - 1 do 492 Result[Length(A) + I] := B[I]; 493 end; 494 495 function LoadFileToStr(const FileName: TFileName): AnsiString; 496 var 497 FileStream: TFileStream; 498 Read: Integer; 499 begin 500 Result := ''; 501 FileStream := TFileStream.Create(FileName, fmOpenRead); 502 try 503 if FileStream.Size > 0 then begin 504 SetLength(Result, FileStream.Size); 505 Read := FileStream.Read(Pointer(Result)^, FileStream.Size); 506 SetLength(Result, Read); 507 end; 432 508 finally 433 Process.Free; 434 end;} 435 end; 436 437 procedure OpenFileInShell(FileName: string); 438 begin 439 ExecuteProgram('cmd.exe /c start "' + FileName + '"'); 440 end; 509 FileStream.Free; 510 end; 511 end; 512 513 441 514 442 515 initialization -
trunk/Packages/Common/UDebugLog.pas
r6 r19 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/UFindFile.pas
r6 r19 55 55 end; 56 56 57 const 58 {$IFDEF WINDOWS} 59 FilterAll = '*.*'; 60 {$ENDIF} 61 {$IFDEF LINUX} 62 FilterAll = '*'; 63 {$ENDIF} 64 57 65 procedure Register; 58 66 … … 71 79 inherited Create(AOwner); 72 80 Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir)); 73 FileMask := '*.*';81 FileMask := FilterAll; 74 82 FileAttr := [ffaAnyFile]; 75 83 s := TStringList.Create; … … 127 135 If not InSubFolders then Exit; 128 136 129 if SysUtils.FindFirst(UTF8Decode(inPath + '*.*'), faDirectory, Rec) = 0 then137 if SysUtils.FindFirst(UTF8Decode(inPath + FilterAll), faDirectory, Rec) = 0 then 130 138 try 131 139 repeat -
trunk/Packages/Common/UJobProgressView.lfm
r6 r19 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
r6 r19 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
r6 r19 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
r6 r19 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; 90 function TextEnteredColumn(Index: Integer): Boolean; 75 91 function GetColValue(Index: Integer): string; 76 92 property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1; … … 79 95 property Align; 80 96 property Anchors; 97 property BorderSpacing; 81 98 end; 82 99 … … 98 115 if Assigned(FOnChange) then 99 116 FOnChange(Self); 117 end; 118 119 procedure TListViewFilter.DoOnResize(Sender: TObject); 120 begin 121 FStringGrid1.DefaultRowHeight := FStringGrid1.Height; 100 122 end; 101 123 … … 114 136 goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll]; 115 137 FStringGrid1.OnKeyUp := DoOnKeyUp; 138 FStringGrid1.OnResize := DoOnResize; 116 139 end; 117 140 … … 119 142 var 120 143 I: Integer; 121 NewColumn: TGridColumn;122 144 begin 123 145 with FStringGrid1 do begin 124 Columns.Clear;146 //Columns.Clear; 125 147 while Columns.Count > ListView.Columns.Count do Columns.Delete(Columns.Count - 1); 126 while Columns.Count < ListView.Columns.Count do NewColumn :=Columns.Add;148 while Columns.Count < ListView.Columns.Count do Columns.Add; 127 149 for I := 0 to ListView.Columns.Count - 1 do begin 128 150 Columns[I].Width := ListView.Columns[I].Width; … … 132 154 133 155 function TListViewFilter.TextEntered: Boolean; 156 begin 157 Result := TextEnteredCount > 0; 158 end; 159 160 function TListViewFilter.TextEnteredCount: Integer; 134 161 var 135 162 I: Integer; 136 163 begin 137 Result := False;164 Result := 0; 138 165 for I := 0 to FStringGrid1.ColCount - 1 do begin 139 166 if FStringGrid1.Cells[I, 0] <> '' then begin 140 Result := True; 141 Break; 167 Inc(Result); 142 168 end; 143 169 end; 170 end; 171 172 function TListViewFilter.TextEnteredColumn(Index: Integer): Boolean; 173 begin 174 Result := FStringGrid1.Cells[Index, 0] <> ''; 144 175 end; 145 176 … … 153 184 { TListViewSort } 154 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; 155 235 156 236 procedure TListViewSort.ColumnClick(Sender: TObject; Column: TListColumn); … … 179 259 procedure TListViewSort.SetListView(const Value: TListView); 180 260 begin 261 if FListView = Value then Exit; 262 if Assigned(FListView) then 263 ListView.WindowProc := FOldListViewWindowProc; 181 264 FListView := Value; 182 265 FListView.OnColumnClick := ColumnClick; 183 266 FListView.OnCustomDrawItem := ListViewCustomDrawItem; 184 267 FListView.OnClick := ListViewClick; 268 FOldListViewWindowProc := FListView.WindowProc; 269 {$IFDEF WINDOWS} 270 FListView.WindowProc := NewListViewWindowProc; 271 {$ENDIF} 185 272 end; 186 273 … … 199 286 if ListView.Items.Count <> List.Count then 200 287 ListView.Items.Count := List.Count; 201 if Assigned(FOnCompareItem) then Sort(FOnCompareItem);288 if Assigned(FOnCompareItem) and (Order <> soNone) then Sort(FOnCompareItem); 202 289 //ListView.Items[-1]; // Workaround for not show first row if selected 203 290 ListView.Refresh; -
trunk/Packages/Common/UPersistentForm.pas
r6 r19 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
r6 r19 17 17 TControlDimension = class 18 18 BoundsRect: TRect; 19 AuxSize: TPoint;20 19 FontHeight: Integer; 21 20 Controls: TObjectList; // TList<TControlDimension> 21 // Class specifics 22 ButtonSize: TPoint; // TToolBar 23 CoolBandWidth: Integer; 24 ConstraintsMin: TPoint; // TForm 25 ConstraintsMax: TPoint; // TForm 22 26 constructor Create; 23 27 destructor Destroy; override; … … 74 78 destructor TControlDimension.Destroy; 75 79 begin 76 Controls.Free;80 FreeAndNil(Controls); 77 81 inherited Destroy; 78 82 end; … … 113 117 Dimensions.Controls.Clear; 114 118 if Control is TToolBar then 115 Dimensions.AuxSize := Point(TToolBar(Control).ButtonWidth, TToolBar(Control).ButtonHeight); 116 119 Dimensions.ButtonSize := Point(TToolBar(Control).ButtonWidth, TToolBar(Control).ButtonHeight); 120 if Control is TForm then begin 121 Dimensions.ConstraintsMin := Point(TForm(Control).Constraints.MinWidth, 122 TForm(Control).Constraints.MinHeight); 123 Dimensions.ConstraintsMax := Point(TForm(Control).Constraints.MaxWidth, 124 TForm(Control).Constraints.MaxHeight); 125 end; 117 126 if Control is TWinControl then 118 127 for I := 0 to TWinControl(Control).ControlCount - 1 do begin 119 if TWinControl(Control).Controls[I] is TControl then begin 128 if TWinControl(Control).Controls[I] is TControl then 129 // Do not scale docked forms twice 130 if not (TWinControl(Control).Controls[I] is TForm) then begin 120 131 NewControl := TControlDimension.Create; 121 132 Dimensions.Controls.Add(NewControl); … … 133 144 Control.Font.Height := Dimensions.FontHeight; 134 145 if Control is TToolBar then begin 135 TToolBar(Control).ButtonWidth := Dimensions.AuxSize.X; 136 TToolBar(Control).ButtonHeight := Dimensions.AuxSize.Y; 146 TToolBar(Control).ButtonWidth := Dimensions.ButtonSize.X; 147 TToolBar(Control).ButtonHeight := Dimensions.ButtonSize.Y; 148 end; 149 if Control is TForm then begin 150 TForm(Control).Constraints.MinWidth := Dimensions.ConstraintsMin.X; 151 TForm(Control).Constraints.MinHeight := Dimensions.ConstraintsMin.Y; 152 TForm(Control).Constraints.MaxWidth := Dimensions.ConstraintsMax.X; 153 TForm(Control).Constraints.MaxHeight := Dimensions.ConstraintsMax.Y; 137 154 end; 138 155 if Control is TWinControl then 139 156 for I := 0 to TWinControl(Control).ControlCount - 1 do begin 140 if TWinControl(Control).Controls[I] is TControl then begin 157 if TWinControl(Control).Controls[I] is TControl then 158 // Do not scale docked forms twice 159 if not (TWinControl(Control).Controls[I] is TForm) then begin 141 160 RestoreDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I])); 142 161 end; … … 152 171 Control.Font.Height := ScaleY(Dimensions.FontHeight, DesignDPI.Y); 153 172 if Control is TToolBar then begin 154 TToolBar(Control).ButtonWidth := ScaleX(Dimensions.AuxSize.X, DesignDPI.X); 155 TToolBar(Control).ButtonHeight := ScaleY(Dimensions.AuxSize.Y, DesignDPI.Y); 173 TToolBar(Control).ButtonWidth := ScaleX(Dimensions.ButtonSize.X, DesignDPI.X); 174 TToolBar(Control).ButtonHeight := ScaleY(Dimensions.ButtonSize.Y, DesignDPI.Y); 175 end; 176 if Control is TCoolBar then begin 177 with TCoolBar(Control) do 178 for I := 0 to Bands.Count - 1 do 179 with TCoolBand(Bands[I]) do begin 180 MinWidth := ScaleX(Dimensions.ButtonSize.X, DesignDPI.X); 181 MinHeight := ScaleY(Dimensions.ButtonSize.Y, DesignDPI.Y); 182 //Width := ScaleX(Dimensions.BoundsRect.Left - 183 end; 184 end; 185 if Control is TForm then begin 186 TForm(Control).Constraints.MinWidth := ScaleX(Dimensions.ConstraintsMin.X, DesignDPI.X); 187 TForm(Control).Constraints.MaxWidth := ScaleX(Dimensions.ConstraintsMax.X, DesignDPI.X); 188 TForm(Control).Constraints.MinHeight := ScaleY(Dimensions.ConstraintsMin.Y, DesignDPI.Y); 189 TForm(Control).Constraints.MaxHeight := ScaleY(Dimensions.ConstraintsMax.Y, DesignDPI.Y); 156 190 end; 157 191 if Control is TWinControl then 158 192 for I := 0 to TWinControl(Control).ControlCount - 1 do begin 159 if TWinControl(Control).Controls[I] is TControl then begin 193 if TWinControl(Control).Controls[I] is TControl then 194 // Do not scale docked forms twice 195 if not (TWinControl(Control).Controls[I] is TForm) then begin 160 196 ScaleDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I])); 161 197 end; … … 183 219 184 220 SetLength(Temp, ImgList.Count); 185 TempBmp := TBitmap.Create;186 221 for I := 0 to ImgList.Count - 1 do 187 222 begin 223 TempBmp := TBitmap.Create; 224 TempBmp.PixelFormat := pf32bit; 188 225 ImgList.GetBitmap(I, TempBmp); 189 //TempBmp.PixelFormat := pfDevice;190 226 Temp[I] := TBitmap.Create; 191 227 Temp[I].SetSize(NewWidth, NewHeight); 228 Temp[I].PixelFormat := pf32bit; 192 229 Temp[I].TransparentColor := TempBmp.TransparentColor; 193 230 //Temp[I].TransparentMode := TempBmp.TransparentMode; … … 199 236 if (Temp[I].Width = 0) or (Temp[I].Height = 0) then Continue; 200 237 Temp[I].Canvas.StretchDraw(Rect(0, 0, Temp[I].Width, Temp[I].Height), TempBmp); 201 end;202 TempBmp.Free;238 TempBmp.Free; 239 end; 203 240 204 241 ImgList.Clear; … … 272 309 end; 273 310 274 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; 275 323 276 324 if Control is TToolBar then begin -
trunk/Packages/Common/UXMLUtils.pas
r18 r19 12 12 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString; 13 13 procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer); 14 procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64); 14 15 procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean); 15 16 procedure WriteString(Node: TDOMNode; Name: string; Value: string); 16 17 procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime); 17 18 function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer; 19 function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64; 18 20 function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean; 19 21 function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string; … … 142 144 end; 143 145 146 procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64); 147 var 148 NewNode: TDOMNode; 149 begin 150 NewNode := Node.OwnerDocument.CreateElement(Name); 151 NewNode.TextContent := IntToStr(Value); 152 Node.AppendChild(NewNode); 153 end; 154 144 155 procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean); 145 156 var … … 177 188 if Assigned(NewNode) then 178 189 Result := StrToInt(NewNode.TextContent); 190 end; 191 192 function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64; 193 var 194 NewNode: TDOMNode; 195 begin 196 Result := DefaultValue; 197 NewNode := Node.FindNode(Name); 198 if Assigned(NewNode) then 199 Result := StrToInt64(NewNode.TextContent); 179 200 end; 180 201 -
trunk/UCore.lfm
r18 r19 3 3 OnDestroy = DataModuleDestroy 4 4 OldCreateOrder = False 5 Height = 435 6 HorizontalOffset = 695 7 VerticalOffset = 306 8 Width = 693 5 Height = 544 6 HorizontalOffset = 869 7 VerticalOffset = 383 8 Width = 866 9 PPI = 120 9 10 object ActionList1: TActionList 10 11 Images = ImageList1 11 left = 28812 top = 17612 left = 360 13 top = 220 13 14 object AQuit: TAction 14 15 Caption = 'Quit' … … 96 97 Height = 32 97 98 Width = 32 98 left = 28899 top = 24099 left = 360 100 top = 300 100 101 end 101 102 object OpenDialog1: TOpenDialog 102 103 Filter = 'Project groups (.vcgrp))|*.vcgrp|All files (.*)|*.*' 103 left = 288104 top = 96104 left = 360 105 top = 120 105 106 end 106 107 object XMLConfig1: TXMLConfig … … 108 109 RootName = 'CONFIG' 109 110 ReadOnly = False 110 left = 96111 top = 96111 left = 120 112 top = 120 112 113 end 113 114 object LastOpenedListProject: TLastOpenedList 114 115 MaxCount = 10 115 116 OnChange = LastOpenedListProjectChange 116 left = 96117 top = 168117 left = 120 118 top = 210 118 119 end 119 120 object LastOpenedListRepoURL: TLastOpenedList 120 121 MaxCount = 10 121 left = 96122 top = 240122 left = 120 123 top = 300 123 124 end 124 125 object LastOpenedListNewDir: TLastOpenedList 125 126 MaxCount = 10 126 left = 465127 top = 3 02127 left = 581 128 top = 378 128 129 end 129 130 object LastOpenedListProjectGroup: TLastOpenedList 130 131 MaxCount = 10 131 132 OnChange = LastOpenedListProjectGroupChange 132 left = 464133 top = 2 24133 left = 580 134 top = 280 134 135 end 135 136 object SaveDialog1: TSaveDialog 136 137 DefaultExt = '.vcgrp' 137 138 Filter = 'Project groups (.vcgrp))|*.vcgrp|All files (.*)|*.*' 138 left = 288139 top = 24139 left = 360 140 top = 30 140 141 end 141 142 end -
trunk/UCore.pas
r18 r19 6 6 7 7 uses 8 Classes, SysUtils, XMLConf, FileUtil, ActnList, Controls, UVCS, UProject,8 Classes, SysUtils, XMLConf, LazFileUtils, ActnList, Controls, UVCS, UProject, 9 9 ULastOpenedList, Forms, Dialogs, Menus, Contnrs, UBackend; 10 10 -
trunk/Units/UProject.pas
r13 r19 7 7 uses 8 8 Classes, SysUtils, UVCS, UBackend, Contnrs, DOM, XMLRead, XMLWrite, UXMLUtils, 9 FileUtil;9 LazFileUtils; 10 10 11 11 type -
trunk/Units/UVCS.pas
r16 r19 6 6 7 7 uses 8 Classes, SysUtils, FileUtil, Contnrs;8 Classes, SysUtils, LazFileUtils, Contnrs; 9 9 10 10 type -
trunk/VCSCommander.lpi
r18 r19 14 14 <EnableI18N LFM="False"/> 15 15 </i18n> 16 <VersionInfo>17 <StringTable ProductVersion=""/>18 </VersionInfo>19 16 <BuildModes Count="2"> 20 17 <Item1 Name="Debug" Default="True"/> … … 55 52 </Options> 56 53 </Linking> 54 <Other> 55 <CompilerMessages> 56 <IgnoredMessages idx5024="True"/> 57 </CompilerMessages> 58 </Other> 57 59 </CompilerOptions> 58 60 </Item2> … … 234 236 </Linking> 235 237 <Other> 238 <CompilerMessages> 239 <IgnoredMessages idx5024="True"/> 240 </CompilerMessages> 236 241 <CustomOptions Value="-dDEBUG"/> 237 242 </Other>
Note:
See TracChangeset
for help on using the changeset viewer.