控制的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;