控制的TComboBox下拉框的宽度

{自动显示下拉框的宽度}
procedure TdeliveOrderForm.comb_productDropDown(Sender: TObject);
var
CBox: TComboBox;
Width: Integer;
I, TextLen: Longint;
lf: LOGFONT;
f: HFONT;
begin
CBox := (Sender as TComboBox);
Width := CBox.Width;
FillChar(lf,SizeOf(lf),0);
StrPCopy(lf.lfFaceName, CBox.Font.Name);
lf.lfHeight := CBox.Font.Height;
lf.lfWeight := FW_NORMAL;
if fsBold in CBox.Font.Style then
lf.lfWeight := lf.lfWeight or FW_BOLD;

f := CreateFontIndirect(lf);
if (f <> 0) then
try
CBox.Canvas.Handle := GetDC(CBox.Handle);
SelectObject(CBox.Canvas.Handle,f);
try
for i := 0 to CBox.Items.Count-1 do begin
TextLen := CBox.Canvas.TextWidth(CBox.Items[i]);
if CBox.Items.Count-1 > CBox.DropDownCount then
begin
if TextLen > Width-25 then
Width := TextLen +25;
end
else if CBox.Items.Count-1 <= CBox.DropDownCount then
begin
if TextLen > Width-5 then
Width := TextLen+8;
end;
end;
finally
ReleaseDC(CBox.Handle, CBox.Canvas.Handle);
end;
finally
DeleteObject(f);
end;
SendMessage(CBox.Handle, CB_SETDROPPEDWIDTH, Width, 0);
end;