Mega Code Archive
Delphi 5 TToolbar does not resize correctly when XP common controls 6.0 are enabled
<![CDATA[
Title: Delphi 5 TToolbar does not resize correctly when XP common controls 6.0 are enabled.
Question: I currently check a Delphi 5.x developed application running under XP with common controls 6.0 enabled (see Paul Swonger, http://www.delphi3000.com/articles/article_2359.asp). Beside the corrections to comctrls.com mentioned by Matteo Riso, http://www.delphi3000.com/articles/article_2843.asp, I realized an other flaw in the same unit, preventing TToolbar to resize correctly.
Answer:
Remark:
This article only applies to Delphi Professional 5.0 (Build 6.18) Update Pack 1!
The problem in my application was, that the button size and bar size did not change to the desired values. Even worse the outcome was depending on the Order of the following assignments to Toolbar1. By repetitive changing from large to small icons the buttons even growth in size.
{my code snippet}
if AppRegSet.LargeIcons then begin
BuildLargeButtonsFromSmall(AppRegSet.StretchIcons,ImageList1,ImageList2);
ToolBar1.Images:=ImageList2;
ToolBar1.ButtonWidth:=32;
ToolBar1.ButtonHeight:=32;
end else begin
ToolBar1.Images:=ImageList1;
ToolBar1.ButtonHeight:=24;
ToolBar1.ButtonWidth:=24;
end;
Careful inspection revealed the problem in the method CreateButtons of TToolbar. The new size settings are applied to the toolbar before removing the individual buttons. Debugging further revealed that the applied size was automatically overridden by the system to bigger values. Not only changed the alteration of the ButtonHeight its height but also its wisth and some how the minimal allowed value (see TB_SETBUTTONWIDTH message).
The win32 platform SDK says (http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/commctls/toolbar/messages/tb_setbitmapsize.asp) that TB_SetButtonsize, TB_SetBitmapSize must be set before adding buttons. I interpreted this statement as must be applied to an empty toolbar and changed the corresponding vcl code in this sense (changed lines have an //XP Theme fix " comment line prepended). When testing my application the resizing now works perfect in either ways, common controls 6 enabled or not.
{changed comctrls.pas code}
procedure TToolBar.CreateButtons(NewWidth, NewHeight: Integer);
function ToolButtonVisible: Boolean;
var
I: Integer;
Control: TControl;
begin
for I := 0 to FButtons.Count - 1 do
begin
Control := TControl(FButtons[I]);
if (Control is TToolButton) and ((csDesigning in ComponentState) or
Control.Visible) and not (TToolButton(Control).Style in
[tbsSeparator, tbsDivider]) then
begin
Result := True;
Exit;
end;
end;
Result := False;
end;
var
ImageWidth, ImageHeight: Integer;
I: Integer;
begin
BeginUpdate;
try
HandleNeeded;
//XP theme fix: folowing line added
for I := 0 to InternalButtonCount - 1 do Perform(TB_DELETEBUTTON, 0, 0);
Perform(TB_BUTTONSTRUCTSIZE, SizeOf(TTBButton), 0);
Perform(TB_SETINDENT, FIndent, 0);
if FImages nil then
begin
ImageWidth := FImages.Width;
ImageHeight := FImages.Height;
end
else if FDisabledImages nil then
begin
ImageWidth := FDisabledImages.Width;
ImageHeight := FDisabledImages.Height;
end
else if FHotImages nil then
begin
ImageWidth := FHotImages.Width;
ImageHeight := FHotImages.Height;
end
else
begin
ImageWidth := 0;
ImageHeight := 0;
end;
Perform(TB_SETBITMAPSIZE, 0, MakeLParam(ImageWidth, ImageHeight));
{ Adjust the working height if there is a visible TToolButton whose caption
height is automatically added by the common control. }
if ShowCaptions and ToolButtonVisible then Dec(NewHeight, FHeightMargin);
{ Prevent toolbar from setting default button size }
if NewWidth if NewHeight Perform(TB_SETBUTTONSIZE, 0, MakeLParam(NewWidth, NewHeight));
FButtonWidth := NewWidth;
FButtonHeight := NewHeight;
finally
EndUpdate;
end;
{ Retrieve current button sizes }
//XP theme fix: following line commented
// for I := 0 to InternalButtonCount - 1 do Perform(TB_DELETEBUTTON, 0, 0);
UpdateButtons;
UpdateImages;
GetButtonSize(FButtonWidth, FButtonHeight);
end;
]]>