How to create a flat TComboBox

Problem/Question/Abstract:

How to create a flat TComboBox

Answer:

{$IFDEF BCB}
{$OBJEXPORTALL ON}
{$ENDIF}
unit DebsFlatComboBox;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls;

type
  TDebsCustomFlatComboBox = class(TCustomComboBox)
  private
    FFlatButton: boolean;
    FOnChooseItem: TNotifyEvent;
    FOnCloseUp: TNotifyEvent;
    procedure SetFlatButton(const Value: boolean);
  protected
    procedure ChooseItem; virtual;
{$IFNDEF VER140}
    procedure CloseUp; virtual;
{$ENDIF}
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure DrawButton(const DC: HDC); virtual;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    property FlatButton: boolean read FFlatButton write SetFlatButton default False;
    property OnChooseItem: TNotifyEvent read FOnChooseItem write FOnChooseItem;
    property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
  end;

  TDebsFlatComboBox = class(TDebsCustomFlatComboBox)
  published
    property Style; {Must be published before Items}
    property Anchors;
{$IFDEF VER140}
    property AutoComplete;
    property AutoDropDown;
{$ENDIF}
    property BiDiMode;
    property CharCase;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property FlatButton;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property ItemIndex default -1;
    property MaxLength;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnChooseItem;
    property OnClick;
    property OnCloseUp;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDock;
    property OnStartDrag;
    property Items; {Must be published after OnMeasureItem}
  end;

procedure Register;

implementation

uses
  Graphics;

procedure Register;
begin
  RegisterComponents('Debs', [TDebsFlatComboBox]);
end;

{TDebsCustomFlatComboBox}

procedure TDebsCustomFlatComboBox.ChooseItem;
begin
  if Assigned(FOnChooseItem) then
    FOnChooseItem(Self);
end;

{$IFNDEF VER140}

procedure TDebsCustomFlatComboBox.CloseUp;
begin
  if Assigned(FOnCloseUp) then
    FOnCloseUp(Self);
end;
{$ENDIF}

procedure TDebsCustomFlatComboBox.CNCommand(var Message: TWMCommand);
begin
  case Message.NotifyCode of
    CBN_SELCHANGE:
      begin
        Text := Items[ItemIndex];
        Click;
        Change;
        ChooseItem;
      end;
    CBN_CLOSEUP:
      begin
        CloseUp;
        Invalidate;
      end;
  else
    inherited;
  end;
end;

procedure TDebsCustomFlatComboBox.DrawButton(const DC: HDC);
var
  BtnState: integer;
  BtnRect: TRect;
begin
  BtnRect := ClientRect;
  BtnRect.Left := BtnRect.Right - GetSystemMetrics(SM_CXVSCROLL) - 2;
  BtnState := DFCS_SCROLLDOWN;
  if DroppedDown then
    InflateRect(BtnRect, -1, -1) {Draw line inside button for recessed look}
  else if FFlatButton then
    BtnState := BtnState or DFCS_FLAT
  else
    BtnRect.Top := BtnRect.Top + 1; {Allow room for 3d highlight}
  if not Enabled then
    BtnState := BtnState or DFCS_INACTIVE;
  if DroppedDown then
    BtnState := BtnState or DFCS_PUSHED;
  DrawFrameControl(DC, BtnRect, DFC_SCROLL, BtnState);
end;

procedure TDebsCustomFlatComboBox.SetFlatButton(const Value: boolean);
begin
  FFlatButton := Value;
  Invalidate;
end;

procedure TDebsCustomFlatComboBox.WMPaint(var Message: TWMPaint);
var
  DC: HDC;
  DrawRect: TRect;
  PS: TPaintStruct;
begin
  if not Ctl3d then
  begin
    DC := Message.DC;
    if (DC = 0) then
      DC := BeginPaint(Handle, PS);
    try
      DrawRect := ClientRect;
      Brush.Color := clWindowFrame;
      FrameRect(DC, DrawRect, Brush.Handle);
      InflateRect(DrawRect, -1, -1);
      Brush.Color := Color;
      FillRect(DC, DrawRect, Brush.Handle);
      {Draw the borders and the button}
      if Style <> csSimple then
      begin
        DrawButton(DC);
        DrawRect.Right := DrawRect.Right - GetSystemMetrics(SM_CXVSCROLL) - 2;
      end;
      {Clip the region  to stop Windows painting over our work}
      InflateRect(DrawRect, -1, -1);
      IntersectClipRect(DC, DrawRect.Left, DrawRect.Top, DrawRect.Right, DrawRect.Bottom);
      {Now get Windows to fill in the combo text}
      PaintWindow(DC);
    finally
      if Message.DC = 0 then
        EndPaint(Handle, PS);
    end;
  end
  else
    inherited;
end;

end.