Author: Tomas Rutkauskas
How to create a flat TComboBox
Answer:
1
2 {$IFDEF BCB}
3 {$OBJEXPORTALL ON}
4 {$ENDIF}
5 unit DebsFlatComboBox;
6
7 interface
8
9 uses
10 Windows, Messages, SysUtils, Classes, Controls, StdCtrls;
11
12 type
13 TDebsCustomFlatComboBox = class(TCustomComboBox)
14 private
15 FFlatButton: boolean;
16 FOnChooseItem: TNotifyEvent;
17 FOnCloseUp: TNotifyEvent;
18 procedure SetFlatButton(const Value: boolean);
19 protected
20 procedure ChooseItem; virtual;
21 {$IFNDEF VER140}
22 procedure CloseUp; virtual;
23 {$ENDIF}
24 procedure CNCommand(var message: TWMCommand); message CN_COMMAND;
25 procedure DrawButton(const DC: HDC); virtual;
26 procedure WMPaint(var message: TWMPaint); message WM_PAINT;
27 property FlatButton: boolean read FFlatButton write SetFlatButton default False;
28 property OnChooseItem: TNotifyEvent read FOnChooseItem write FOnChooseItem;
29 property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
30 end;
31
32 TDebsFlatComboBox = class(TDebsCustomFlatComboBox)
33 published
34 property Style; {Must be published before Items}
35 property Anchors;
36 {$IFDEF VER140}
37 property AutoComplete;
38 property AutoDropDown;
39 {$ENDIF}
40 property BiDiMode;
41 property CharCase;
42 property Color;
43 property Constraints;
44 property Ctl3D;
45 property DragCursor;
46 property DragKind;
47 property DragMode;
48 property DropDownCount;
49 property Enabled;
50 property FlatButton;
51 property Font;
52 property ImeMode;
53 property ImeName;
54 property ItemHeight;
55 property ItemIndex default -1;
56 property MaxLength;
57 property ParentBiDiMode;
58 property ParentColor;
59 property ParentCtl3D;
60 property ParentFont;
61 property ParentShowHint;
62 property PopupMenu;
63 property ShowHint;
64 property Sorted;
65 property TabOrder;
66 property TabStop;
67 property Text;
68 property Visible;
69 property OnChange;
70 property OnChooseItem;
71 property OnClick;
72 property OnCloseUp;
73 property OnContextPopup;
74 property OnDblClick;
75 property OnDragDrop;
76 property OnDragOver;
77 property OnDrawItem;
78 property OnDropDown;
79 property OnEndDock;
80 property OnEndDrag;
81 property OnEnter;
82 property OnExit;
83 property OnKeyDown;
84 property OnKeyPress;
85 property OnKeyUp;
86 property OnMeasureItem;
87 property OnStartDock;
88 property OnStartDrag;
89 property Items; {Must be published after OnMeasureItem}
90 end;
91
92 procedure register;
93
94 implementation
95
96 uses
97 Graphics;
98
99 procedure register;
100 begin
101 RegisterComponents('Debs', [TDebsFlatComboBox]);
102 end;
103
104 {TDebsCustomFlatComboBox}
105
106 procedure TDebsCustomFlatComboBox.ChooseItem;
107 begin
108 if Assigned(FOnChooseItem) then
109 FOnChooseItem(Self);
110 end;
111
112 {$IFNDEF VER140}
113
114 procedure TDebsCustomFlatComboBox.CloseUp;
115 begin
116 if Assigned(FOnCloseUp) then
117 FOnCloseUp(Self);
118 end;
119 {$ENDIF}
120
121 procedure TDebsCustomFlatComboBox.CNCommand(var message: TWMCommand);
122 begin
123 case message.NotifyCode of
124 CBN_SELCHANGE:
125 begin
126 Text := Items[ItemIndex];
127 Click;
128 Change;
129 ChooseItem;
130 end;
131 CBN_CLOSEUP:
132 begin
133 CloseUp;
134 Invalidate;
135 end;
136 else
137 inherited;
138 end;
139 end;
140
141 procedure TDebsCustomFlatComboBox.DrawButton(const DC: HDC);
142 var
143 BtnState: integer;
144 BtnRect: TRect;
145 begin
146 BtnRect := ClientRect;
147 BtnRect.Left := BtnRect.Right - GetSystemMetrics(SM_CXVSCROLL) - 2;
148 BtnState := DFCS_SCROLLDOWN;
149 if DroppedDown then
150 InflateRect(BtnRect, -1, -1) {Draw line inside button for recessed look}
151 else if FFlatButton then
152 BtnState := BtnState or DFCS_FLAT
153 else
154 BtnRect.Top := BtnRect.Top + 1; {Allow room for 3d highlight}
155 if not Enabled then
156 BtnState := BtnState or DFCS_INACTIVE;
157 if DroppedDown then
158 BtnState := BtnState or DFCS_PUSHED;
159 DrawFrameControl(DC, BtnRect, DFC_SCROLL, BtnState);
160 end;
161
162 procedure TDebsCustomFlatComboBox.SetFlatButton(const Value: boolean);
163 begin
164 FFlatButton := Value;
165 Invalidate;
166 end;
167
168 procedure TDebsCustomFlatComboBox.WMPaint(var message: TWMPaint);
169 var
170 DC: HDC;
171 DrawRect: TRect;
172 PS: TPaintStruct;
173 begin
174 if not Ctl3d then
175 begin
176 DC := message.DC;
177 if (DC = 0) then
178 DC := BeginPaint(Handle, PS);
179 try
180 DrawRect := ClientRect;
181 Brush.Color := clWindowFrame;
182 FrameRect(DC, DrawRect, Brush.Handle);
183 InflateRect(DrawRect, -1, -1);
184 Brush.Color := Color;
185 FillRect(DC, DrawRect, Brush.Handle);
186 {Draw the borders and the button}
187 if Style <> csSimple then
188 begin
189 DrawButton(DC);
190 DrawRect.Right := DrawRect.Right - GetSystemMetrics(SM_CXVSCROLL) - 2;
191 end;
192 {Clip the region to stop Windows painting over our work}
193 InflateRect(DrawRect, -1, -1);
194 IntersectClipRect(DC, DrawRect.Left, DrawRect.Top, DrawRect.Right,
195 DrawRect.Bottom);
196 {Now get Windows to fill in the combo text}
197 PaintWindow(DC);
198 finally
199 if message.DC = 0 then
200 EndPaint(Handle, PS);
201 end;
202 end
203 else
204 inherited;
205 end;
206
207 end.
|
