Changeset 19


Ignore:
Timestamp:
Dec 7, 2017, 12:21:08 PM (7 years ago)
Author:
chronos
Message:
  • Fixed: Build under Lazarus 1.8.0.
  • Modified: Updated Common package.
Location:
trunk
Files:
4 added
21 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormBrowse.pas

    r15 r19  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
    9   ExtCtrls, Menus, ActnList, UFindFile, UVCS, Contnrs;
     9  ExtCtrls, Menus, ActnList, UFindFile, UVCS, Contnrs, LazFileUtils;
    1010
    1111type
  • trunk/Forms/UFormProjectGroup.pas

    r13 r19  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
    9   Menus, ActnList, UProject;
     9  Menus, ActnList, UProject, LazFileUtils;
    1010
    1111type
  • trunk/Forms/UFormTest.pas

    r13 r19  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
    9   StdCtrls;
     9  StdCtrls, LazFileUtils;
    1010
    1111type
  • trunk/Packages/Common/Common.lpk

    r6 r19  
    44    <PathDelim Value="\"/>
    55    <Name Value="Common"/>
     6    <Type Value="RunAndDesignTime"/>
    67    <AddToProjectUsesSection Value="True"/>
    78    <Author Value="Chronos (robie@centrum.cz)"/>
     
    109110      <EnableI18N Value="True"/>
    110111      <OutDir Value="Languages"/>
     112      <EnableI18NForLFM Value="True"/>
    111113    </i18n>
    112     <Type Value="RunAndDesignTime"/>
    113     <RequiredPkgs Count="2">
     114    <RequiredPkgs Count="3">
    114115      <Item1>
    115         <PackageName Value="TemplateGenerics"/>
     116        <PackageName Value="LCL"/>
    116117      </Item1>
    117118      <Item2>
     119        <PackageName Value="TemplateGenerics"/>
     120      </Item2>
     121      <Item3>
    118122        <PackageName Value="FCL"/>
    119123        <MinVersion Major="1" Valid="True"/>
    120       </Item2>
     124      </Item3>
    121125    </RequiredPkgs>
    122126    <UsageOptions>
  • trunk/Packages/Common/Languages/UJobProgressView.po

    r6 r19  
    1414msgstr ""
    1515
     16#: ujobprogressview.soperations
     17msgid "Operations"
     18msgstr ""
     19
    1620#: ujobprogressview.spleasewait
    1721msgid "Please wait..."
  • trunk/Packages/Common/UCommon.pas

    r6 r19  
    66
    77uses
    8   {$IFDEF Windows}Windows,{$ENDIF}
     8  {$ifdef Windows}Windows,{$endif}
     9  {$ifdef Linux}baseunix,{$endif}
    910  Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf,
    1011  FileUtil; //, ShFolder, ShellAPI;
     
    6465procedure ExecuteProgram(CommandLine: string);
    6566procedure FreeThenNil(var Obj);
     67function RemoveQuotes(Text: string): string;
     68function ComputerName: string;
     69function OccurenceOfChar(What: Char; Where: string): Integer;
     70function GetDirCount(Dir: string): Integer;
     71function MergeArray(A, B: array of string): TArrayOfString;
     72function LoadFileToStr(const FileName: TFileName): AnsiString;
    6673
    6774
     
    107114  Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec);
    108115  while Find = 0 do begin
    109     DeleteFileUTF8(Path + UTF8Encode(SearchRec.Name));
     116    DeleteFile(Path + UTF8Encode(SearchRec.Name));
    110117
    111118    Find := SysUtils.FindNext(SearchRec);
     
    286293  L: LongWord;
    287294begin
    288 
    289295  L := MAX_USERNAME_LENGTH + 2;
    290296  SetLength(Result, L);
     
    301307  end;
    302308end;
    303 
     309{$endif}
     310
     311function ComputerName: string;
     312{$ifdef mswindows}
     313const
     314 INFO_BUFFER_SIZE = 32767;
     315var
     316  Buffer : array[0..INFO_BUFFER_SIZE] of WideChar;
     317  Ret : DWORD;
     318begin
     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;
     326end;
     327{$endif}
     328{$ifdef unix}
     329var
     330  Name: UtsName;
     331begin
     332  fpuname(Name);
     333  Result := Name.Nodename;
     334end;
     335{$endif}
     336
     337{$ifdef windows}
    304338function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    305339const
     
    416450
    417451procedure OpenWebPage(URL: string);
    418 var
    419   Process: TProcess;
    420   Browser, Params: string;
    421452begin
    422453  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;
     454end;
     455
     456procedure OpenFileInShell(FileName: string);
     457begin
     458  ExecuteProgram('cmd.exe /c start "' + FileName + '"');
     459end;
     460
     461function RemoveQuotes(Text: string): string;
     462begin
     463  Result := Text;
     464  if (Pos('"', Text) = 1) and (Text[Length(Text)] = '"') then
     465    Result := Copy(Text, 2, Length(Text) - 2);
     466end;
     467
     468function OccurenceOfChar(What: Char; Where: string): Integer;
     469var
     470  I: Integer;
     471begin
     472  Result := 0;
     473  for I := 1 to Length(Where) do
     474    if Where[I] = What then Inc(Result);
     475end;
     476
     477function GetDirCount(Dir: string): Integer;
     478begin
     479  Result := OccurenceOfChar(DirectorySeparator, Dir);
     480  if Copy(Dir, Length(Dir), 1) = DirectorySeparator then
     481    Dec(Result);
     482end;
     483
     484function MergeArray(A, B: array of string): TArrayOfString;
     485var
     486  I: Integer;
     487begin
     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];
     493end;
     494
     495function LoadFileToStr(const FileName: TFileName): AnsiString;
     496var
     497  FileStream: TFileStream;
     498  Read: Integer;
     499begin
     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;
    432508  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;
     511end;
     512
     513
    441514
    442515initialization
  • trunk/Packages/Common/UDebugLog.pas

    r6 r19  
    103103  try
    104104    if ExtractFileDir(FileName) <> '' then
    105       ForceDirectoriesUTF8(ExtractFileDir(FileName));
    106     if FileExistsUTF8(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
     105      ForceDirectories(ExtractFileDir(FileName));
     106    if FileExists(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
    107107      else LogFile := TFileStream.Create(UTF8Decode(FileName), fmCreate);
    108108    LogFile.Seek(0, soFromEnd);
  • trunk/Packages/Common/UFindFile.pas

    r6 r19  
    5555  end;
    5656
     57const
     58{$IFDEF WINDOWS}
     59  FilterAll = '*.*';
     60{$ENDIF}
     61{$IFDEF LINUX}
     62  FilterAll = '*';
     63{$ENDIF}
     64
    5765procedure Register;
    5866
     
    7179  inherited Create(AOwner);
    7280  Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir));
    73   FileMask := '*.*';
     81  FileMask := FilterAll;
    7482  FileAttr := [ffaAnyFile];
    7583  s := TStringList.Create;
     
    127135  If not InSubFolders then Exit;
    128136
    129   if SysUtils.FindFirst(UTF8Decode(inPath + '*.*'), faDirectory, Rec) = 0 then
     137  if SysUtils.FindFirst(UTF8Decode(inPath + FilterAll), faDirectory, Rec) = 0 then
    130138  try
    131139    repeat
  • trunk/Packages/Common/UJobProgressView.lfm

    r6 r19  
    1414  OnDestroy = FormDestroy
    1515  Position = poScreenCenter
    16   LCLVersion = '1.1'
     16  LCLVersion = '1.6.0.4'
    1717  object PanelOperationsTitle: TPanel
    1818    Left = 0
  • trunk/Packages/Common/UJobProgressView.lrt

    r6 r19  
    1 TJOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations:
    2 TJOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time:
    3 TJOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time:
     1TFORMJOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations:
     2TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time:
     3TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time:
  • trunk/Packages/Common/UJobProgressView.pas

    r6 r19  
    166166  STotalEstimatedTime = 'Total estimated time: %s';
    167167  SFinished = 'Finished';
     168  SOperations = 'Operations';
    168169
    169170procedure Register;
  • trunk/Packages/Common/UListViewSort.pas

    r6 r19  
    99uses
    1010  {$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;
    1213
    1314type
     
    1819  TCompareEvent = function (Item1, Item2: TObject): Integer of object;
    1920  TListFilterEvent = procedure (ListViewSort: TListViewSort) of object;
     21
     22  { TListViewSort }
    2023
    2124  TListViewSort = class(TComponent)
     
    2831    FColumn: Integer;
    2932    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);
    3038    procedure SetListView(const Value: TListView);
    3139    procedure ColumnClick(Sender: TObject; Column: TListColumn);
     
    4048    procedure SetColumn(const Value: Integer);
    4149    procedure SetOrder(const Value: TSortOrder);
     50    {$IFDEF WINDOWS}
     51    procedure NewListViewWindowProc(var AMsg: TMessage);
     52    {$ENDIF}
    4253  public
    4354    List: TListObject;
     
    5869    property OnCustomDraw: TLVCustomDrawItemEvent read FOnCustomDraw
    5970      write FOnCustomDraw;
     71    property OnColumnWidthChanged: TNotifyEvent read FOnColumnWidthChanged
     72      write FOnColumnWidthChanged;
    6073    property Column: Integer read FColumn write SetColumn;
    6174    property Order: TSortOrder read FOrder write SetOrder;
     
    6982    FStringGrid1: TStringGrid;
    7083    procedure DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     84    procedure DoOnResize(Sender: TObject);
    7185  public
    7286    constructor Create(AOwner: TComponent); override;
    7387    procedure UpdateFromListView(ListView: TListView);
    7488    function TextEntered: Boolean;
     89    function TextEnteredCount: Integer;
     90    function TextEnteredColumn(Index: Integer): Boolean;
    7591    function GetColValue(Index: Integer): string;
    7692    property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1;
     
    7995    property Align;
    8096    property Anchors;
     97    property BorderSpacing;
    8198  end;
    8299
     
    98115  if Assigned(FOnChange) then
    99116    FOnChange(Self);
     117end;
     118
     119procedure TListViewFilter.DoOnResize(Sender: TObject);
     120begin
     121  FStringGrid1.DefaultRowHeight := FStringGrid1.Height;
    100122end;
    101123
     
    114136    goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll];
    115137  FStringGrid1.OnKeyUp := DoOnKeyUp;
     138  FStringGrid1.OnResize := DoOnResize;
    116139end;
    117140
     
    119142var
    120143  I: Integer;
    121   NewColumn: TGridColumn;
    122144begin
    123145  with FStringGrid1 do begin
    124     Columns.Clear;
     146    //Columns.Clear;
    125147    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;
    127149    for I := 0 to ListView.Columns.Count - 1 do begin
    128150      Columns[I].Width := ListView.Columns[I].Width;
     
    132154
    133155function TListViewFilter.TextEntered: Boolean;
     156begin
     157  Result := TextEnteredCount > 0;
     158end;
     159
     160function TListViewFilter.TextEnteredCount: Integer;
    134161var
    135162  I: Integer;
    136163begin
    137   Result := False;
     164  Result := 0;
    138165  for I := 0 to FStringGrid1.ColCount - 1 do begin
    139166    if FStringGrid1.Cells[I, 0] <> '' then begin
    140       Result := True;
    141       Break;
     167      Inc(Result);
    142168    end;
    143169  end;
     170end;
     171
     172function TListViewFilter.TextEnteredColumn(Index: Integer): Boolean;
     173begin
     174  Result := FStringGrid1.Cells[Index, 0] <> '';
    144175end;
    145176
     
    153184{ TListViewSort }
    154185
     186{$IFDEF WINDOWS}
     187procedure TListViewSort.NewListViewWindowProc(var AMsg: TMessage);
     188var
     189  vColWidth: Integer;
     190  vMsgNotify: TLMNotify absolute AMsg;
     191  Code: Integer;
     192begin
     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;
     219end;
     220{$ENDIF}
     221
     222procedure TListViewSort.DoColumnBeginResize(const AColIndex: Integer);
     223begin
     224end;
     225
     226procedure TListViewSort.DoColumnResizing(const AColIndex, AWidth: Integer);
     227begin
     228end;
     229
     230procedure TListViewSort.DoColumnResized(const AColIndex: Integer);
     231begin
     232  if Assigned(FOnColumnWidthChanged) then
     233    FOnColumnWidthChanged(Self);
     234end;
    155235
    156236procedure TListViewSort.ColumnClick(Sender: TObject; Column: TListColumn);
     
    179259procedure TListViewSort.SetListView(const Value: TListView);
    180260begin
     261  if FListView = Value then Exit;
     262  if Assigned(FListView) then
     263    ListView.WindowProc := FOldListViewWindowProc;
    181264  FListView := Value;
    182265  FListView.OnColumnClick := ColumnClick;
    183266  FListView.OnCustomDrawItem := ListViewCustomDrawItem;
    184267  FListView.OnClick := ListViewClick;
     268  FOldListViewWindowProc := FListView.WindowProc;
     269  {$IFDEF WINDOWS}
     270  FListView.WindowProc := NewListViewWindowProc;
     271  {$ENDIF}
    185272end;
    186273
     
    199286  if ListView.Items.Count <> List.Count then
    200287    ListView.Items.Count := List.Count;
    201   if Assigned(FOnCompareItem) then Sort(FOnCompareItem);
     288  if Assigned(FOnCompareItem) and (Order <> soNone) then Sort(FOnCompareItem);
    202289  //ListView.Items[-1]; // Workaround for not show first row if selected
    203290  ListView.Refresh;
  • trunk/Packages/Common/UPersistentForm.pas

    r6 r19  
    88
    99uses
    10   Classes, SysUtils, Forms, URegistry, LCLIntf, Registry;
     10  Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls;
    1111
    1212type
     
    1919    FMinVisiblePart: Integer;
    2020    FRegistryContext: TRegistryContext;
     21    procedure LoadControl(Control: TControl);
     22    procedure SaveControl(Control: TControl);
    2123  public
    2224    FormNormalSize: TRect;
     
    4951
    5052{ TPersistentForm }
     53
     54procedure TPersistentForm.LoadControl(Control: TControl);
     55var
     56  I: Integer;
     57  WinControl: TWinControl;
     58  Count: Integer;
     59begin
     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;
     84end;
     85
     86procedure TPersistentForm.SaveControl(Control: TControl);
     87var
     88  I: Integer;
     89  WinControl: TWinControl;
     90begin
     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;
     114end;
    51115
    52116procedure TPersistentForm.LoadFromRegistry(RegistryContext: TRegistryContext);
     
    181245      Form.BoundsRect := FormNormalSize;
    182246  end;
     247  LoadControl(Form);
    183248end;
    184249
     
    191256  FormWindowState := Form.WindowState;
    192257  SaveToRegistry(RegistryContext);
     258  SaveControl(Form);
    193259end;
    194260
  • trunk/Packages/Common/UScaleDPI.pas

    r6 r19  
    1717  TControlDimension = class
    1818    BoundsRect: TRect;
    19     AuxSize: TPoint;
    2019    FontHeight: Integer;
    2120    Controls: TObjectList; // TList<TControlDimension>
     21    // Class specifics
     22    ButtonSize: TPoint; // TToolBar
     23    CoolBandWidth: Integer;
     24    ConstraintsMin: TPoint; // TForm
     25    ConstraintsMax: TPoint; // TForm
    2226    constructor Create;
    2327    destructor Destroy; override;
     
    7478destructor TControlDimension.Destroy;
    7579begin
    76   Controls.Free;
     80  FreeAndNil(Controls);
    7781  inherited Destroy;
    7882end;
     
    113117  Dimensions.Controls.Clear;
    114118  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;
    117126  if Control is TWinControl then
    118127  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
    120131      NewControl := TControlDimension.Create;
    121132      Dimensions.Controls.Add(NewControl);
     
    133144  Control.Font.Height := Dimensions.FontHeight;
    134145  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;
    137154  end;
    138155  if Control is TWinControl then
    139156  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
    141160      RestoreDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I]));
    142161    end;
     
    152171  Control.Font.Height := ScaleY(Dimensions.FontHeight, DesignDPI.Y);
    153172  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);
    156190  end;
    157191  if Control is TWinControl then
    158192  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
    160196      ScaleDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I]));
    161197    end;
     
    183219
    184220  SetLength(Temp, ImgList.Count);
    185   TempBmp := TBitmap.Create;
    186221  for I := 0 to ImgList.Count - 1 do
    187222  begin
     223    TempBmp := TBitmap.Create;
     224    TempBmp.PixelFormat := pf32bit;
    188225    ImgList.GetBitmap(I, TempBmp);
    189     //TempBmp.PixelFormat := pfDevice;
    190226    Temp[I] := TBitmap.Create;
    191227    Temp[I].SetSize(NewWidth, NewHeight);
     228    Temp[I].PixelFormat := pf32bit;
    192229    Temp[I].TransparentColor := TempBmp.TransparentColor;
    193230    //Temp[I].TransparentMode := TempBmp.TransparentMode;
     
    199236    if (Temp[I].Width = 0) or (Temp[I].Height = 0) then Continue;
    200237    Temp[I].Canvas.StretchDraw(Rect(0, 0, Temp[I].Width, Temp[I].Height), TempBmp);
    201   end;
    202   TempBmp.Free;
     238    TempBmp.Free;
     239  end;
    203240
    204241  ImgList.Clear;
     
    272309  end;
    273310
    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;
    275323
    276324  if Control is TToolBar then begin
  • trunk/Packages/Common/UXMLUtils.pas

    r18 r19  
    1212function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;
    1313procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer);
     14procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64);
    1415procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean);
    1516procedure WriteString(Node: TDOMNode; Name: string; Value: string);
    1617procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime);
    1718function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
     19function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64;
    1820function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean;
    1921function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string;
     
    142144end;
    143145
     146procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64);
     147var
     148  NewNode: TDOMNode;
     149begin
     150  NewNode := Node.OwnerDocument.CreateElement(Name);
     151  NewNode.TextContent := IntToStr(Value);
     152  Node.AppendChild(NewNode);
     153end;
     154
    144155procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean);
    145156var
     
    177188  if Assigned(NewNode) then
    178189    Result := StrToInt(NewNode.TextContent);
     190end;
     191
     192function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64;
     193var
     194  NewNode: TDOMNode;
     195begin
     196  Result := DefaultValue;
     197  NewNode := Node.FindNode(Name);
     198  if Assigned(NewNode) then
     199    Result := StrToInt64(NewNode.TextContent);
    179200end;
    180201
  • trunk/UCore.lfm

    r18 r19  
    33  OnDestroy = DataModuleDestroy
    44  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
    910  object ActionList1: TActionList
    1011    Images = ImageList1
    11     left = 288
    12     top = 176
     12    left = 360
     13    top = 220
    1314    object AQuit: TAction
    1415      Caption = 'Quit'
     
    9697    Height = 32
    9798    Width = 32
    98     left = 288
    99     top = 240
     99    left = 360
     100    top = 300
    100101  end
    101102  object OpenDialog1: TOpenDialog
    102103    Filter = 'Project groups (.vcgrp))|*.vcgrp|All files (.*)|*.*'
    103     left = 288
    104     top = 96
     104    left = 360
     105    top = 120
    105106  end
    106107  object XMLConfig1: TXMLConfig
     
    108109    RootName = 'CONFIG'
    109110    ReadOnly = False
    110     left = 96
    111     top = 96
     111    left = 120
     112    top = 120
    112113  end
    113114  object LastOpenedListProject: TLastOpenedList
    114115    MaxCount = 10
    115116    OnChange = LastOpenedListProjectChange
    116     left = 96
    117     top = 168
     117    left = 120
     118    top = 210
    118119  end
    119120  object LastOpenedListRepoURL: TLastOpenedList
    120121    MaxCount = 10
    121     left = 96
    122     top = 240
     122    left = 120
     123    top = 300
    123124  end
    124125  object LastOpenedListNewDir: TLastOpenedList
    125126    MaxCount = 10
    126     left = 465
    127     top = 302
     127    left = 581
     128    top = 378
    128129  end
    129130  object LastOpenedListProjectGroup: TLastOpenedList
    130131    MaxCount = 10
    131132    OnChange = LastOpenedListProjectGroupChange
    132     left = 464
    133     top = 224
     133    left = 580
     134    top = 280
    134135  end
    135136  object SaveDialog1: TSaveDialog
    136137    DefaultExt = '.vcgrp'
    137138    Filter = 'Project groups (.vcgrp))|*.vcgrp|All files (.*)|*.*'
    138     left = 288
    139     top = 24
     139    left = 360
     140    top = 30
    140141  end
    141142end
  • trunk/UCore.pas

    r18 r19  
    66
    77uses
    8   Classes, SysUtils, XMLConf, FileUtil, ActnList, Controls, UVCS, UProject,
     8  Classes, SysUtils, XMLConf, LazFileUtils, ActnList, Controls, UVCS, UProject,
    99  ULastOpenedList, Forms, Dialogs, Menus, Contnrs, UBackend;
    1010
  • trunk/Units/UProject.pas

    r13 r19  
    77uses
    88  Classes, SysUtils, UVCS, UBackend, Contnrs, DOM, XMLRead, XMLWrite, UXMLUtils,
    9   FileUtil;
     9  LazFileUtils;
    1010
    1111type
  • trunk/Units/UVCS.pas

    r16 r19  
    66
    77uses
    8   Classes, SysUtils, FileUtil, Contnrs;
     8  Classes, SysUtils, LazFileUtils, Contnrs;
    99
    1010type
  • trunk/VCSCommander.lpi

    r18 r19  
    1414      <EnableI18N LFM="False"/>
    1515    </i18n>
    16     <VersionInfo>
    17       <StringTable ProductVersion=""/>
    18     </VersionInfo>
    1916    <BuildModes Count="2">
    2017      <Item1 Name="Debug" Default="True"/>
     
    5552            </Options>
    5653          </Linking>
     54          <Other>
     55            <CompilerMessages>
     56              <IgnoredMessages idx5024="True"/>
     57            </CompilerMessages>
     58          </Other>
    5759        </CompilerOptions>
    5860      </Item2>
     
    234236    </Linking>
    235237    <Other>
     238      <CompilerMessages>
     239        <IgnoredMessages idx5024="True"/>
     240      </CompilerMessages>
    236241      <CustomOptions Value="-dDEBUG"/>
    237242    </Other>
Note: See TracChangeset for help on using the changeset viewer.