How to create a flat TComboBox (Views: 27)
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. |