Changeset 40


Ignore:
Timestamp:
Dec 10, 2016, 11:01:49 PM (7 years ago)
Author:
chronos
Message:
  • Added: Files for required package CoolTranslator.
  • Modified: Updated Common package files.
Location:
trunk
Files:
10 added
12 edited

Legend:

Unmodified
Added
Removed

  • trunk/CoolDisk.lpi

    r37 r40  
    153153      <Item1>
    154154        <PackageName Value="CoolTranslator"/>
     155        <DefaultFilename Value="Packages/CoolTranslator/CoolTranslator.lpk" Prefer="True"/>
    155156      </Item1>
    156157      <Item2>

  • trunk/Packages/Common/Common.lpk

    r4 r40  
    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

    r4 r40  
    1414msgstr ""
    1515
     16#: ujobprogressview.soperations
     17msgid "Operations"
     18msgstr ""
     19
    1620#: ujobprogressview.spleasewait
    1721msgid "Please wait..."

  • trunk/Packages/Common/UCommon.pas

    r12 r40  
    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;
    … …  
    6566procedure FreeThenNil(var Obj);
    6667function 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;
    6772function LoadFileToStr(const FileName: TFileName): AnsiString;
    6873
    … …  
    288293  L: LongWord;
    289294begin
    290 
    291295  L := MAX_USERNAME_LENGTH + 2;
    292296  SetLength(Result, L);
    … …  
    303307  end;
    304308end;
    305 
     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}
    306338function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    307339const
    … …  
    418450
    419451procedure OpenWebPage(URL: string);
    420 var
    421   Process: TProcess;
    422   Browser, Params: string;
    423452begin
    424453  OpenURL(URL);
    425   {try
    426     Process := TProcess.Create(nil);
    427     Browser := '';
    428     //FindDefaultBrowser(Browser, Params);
    429     //Process.Executable := Browser;
    430     //Process.Parameters.Add(Format(Params, [ApplicationInfo.HomePage]);
    431     Process.CommandLine := 'cmd.exe /c start ' + URL;
    432     Process.Options := [poNoConsole];
    433     Process.Execute;
    434   finally
    435     Process.Free;
    436   end;}
    437454end;
    438455
    … …  
    447464  if (Pos('"', Text) = 1) and (Text[Length(Text)] = '"') then
    448465    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];
    449493end;
    450494
    … …  
    467511end;
    468512
     513
     514
    469515initialization
    470516

  • trunk/Packages/Common/UFindFile.pas

    r4 r40  
    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

    r4 r40  
    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

    r4 r40  
    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

    r4 r40  
    166166  STotalEstimatedTime = 'Total estimated time: %s';
    167167  SFinished = 'Finished';
     168  SOperations = 'Operations';
    168169
    169170procedure Register;

  • trunk/Packages/Common/UListViewSort.pas

    r4 r40  
    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;
    7590    function TextEnteredColumn(Index: Integer): Boolean;
    7691    function GetColValue(Index: Integer): string;
    … …  
    8095    property Align;
    8196    property Anchors;
     97    property BorderSpacing;
    8298  end;
    8399
    … …  
    99115  if Assigned(FOnChange) then
    100116    FOnChange(Self);
     117end;
     118
     119procedure TListViewFilter.DoOnResize(Sender: TObject);
     120begin
     121  FStringGrid1.DefaultRowHeight := FStringGrid1.Height;
    101122end;
    102123
    … …  
    115136    goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll];
    116137  FStringGrid1.OnKeyUp := DoOnKeyUp;
     138  FStringGrid1.OnResize := DoOnResize;
    117139end;
    118140
    … …  
    120142var
    121143  I: Integer;
    122   NewColumn: TGridColumn;
    123144begin
    124145  with FStringGrid1 do begin
    125     Columns.Clear;
     146    //Columns.Clear;
    126147    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;
    128149    for I := 0 to ListView.Columns.Count - 1 do begin
    129150      Columns[I].Width := ListView.Columns[I].Width;
    … …  
    133154
    134155function TListViewFilter.TextEntered: Boolean;
     156begin
     157  Result := TextEnteredCount > 0;
     158end;
     159
     160function TListViewFilter.TextEnteredCount: Integer;
    135161var
    136162  I: Integer;
    137163begin
    138   Result := False;
     164  Result := 0;
    139165  for I := 0 to FStringGrid1.ColCount - 1 do begin
    140166    if FStringGrid1.Cells[I, 0] <> '' then begin
    141       Result := True;
    142       Break;
     167      Inc(Result);
    143168    end;
    144169  end;
    … …  
    159184{ TListViewSort }
    160185
     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;
    161235
    162236procedure TListViewSort.ColumnClick(Sender: TObject; Column: TListColumn);
    … …  
    185259procedure TListViewSort.SetListView(const Value: TListView);
    186260begin
     261  if FListView = Value then Exit;
     262  if Assigned(FListView) then
     263    ListView.WindowProc := FOldListViewWindowProc;
    187264  FListView := Value;
    188265  FListView.OnColumnClick := ColumnClick;
    189266  FListView.OnCustomDrawItem := ListViewCustomDrawItem;
    190267  FListView.OnClick := ListViewClick;
     268  FOldListViewWindowProc := FListView.WindowProc;
     269  {$IFDEF WINDOWS}
     270  FListView.WindowProc := NewListViewWindowProc;
     271  {$ENDIF}
    191272end;
    192273
    … …  
    205286  if ListView.Items.Count <> List.Count then
    206287    ListView.Items.Count := List.Count;
    207   if Assigned(FOnCompareItem) then Sort(FOnCompareItem);
     288  if Assigned(FOnCompareItem) and (Order <> soNone) then Sort(FOnCompareItem);
    208289  //ListView.Items[-1]; // Workaround for not show first row if selected
    209290  ListView.Refresh;

  • trunk/Packages/Common/UPersistentForm.pas

    r4 r40  
    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/UPrefixMultiplier.pas

    r31 r40  
    3939    (ShortText: 'n'; FullText: 'nano'; Value: 1e-9),
    4040    (ShortText: 'u'; FullText: 'mikro'; Value: 1e-6),
    41     (ShortText: 'm'; FullText: 'mili'; Value: 1-3),
     41    (ShortText: 'm'; FullText: 'mili'; Value: 1e-3),
    4242    (ShortText: ''; FullText: ''; Value: 1e0),
    4343    (ShortText: 'k'; FullText: 'kilo'; Value: 1e3),

  • trunk/Packages/Common/UScaleDPI.pas

    r4 r40  
    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
Note: See TracChangeset for help on using the changeset viewer.