多选组合框 java_带复选框可以多选的组合框控件 TCheckCombobox，非常完美

没有合适的局域网管理软件吗？你的网管工具够灵活够高效吗？看看这个network management software【http://www.hainsoft.com/】。

带复选框可以多选的组合框控件 TCheckCombobox

For Delphi 7

作者 覃茂藩

可以多选的组合框，相对于CheckListbox和ListView在界面上中能够节省很多空间。该控件继承自TCustomComboBox，标准控件，不会有兼容性问题。实现原理简单，没有创建任何TForm、TCheckBox、TCheckListBox，代码极少，非常简洁。相比现在网上能够找到的类似控件，优点非常明显。

下载地址： http://lczx.sdedu.net/download/TCheckCombobox.rar

安装方法：把文件CheckCombobox.dcu复制到Delphi安装目录下的LIB，然后点击菜单Component > Install Component，Unit File Name那里点击Browser，打开CheckCombobox.dcu，OK，Compile。然后控件就会在控件工具箱Samples那一页出现了。

本控件使用免费。

QQ: 179845876 (需要加验证，否则不通过)

邮箱: Qinmaofan@21cn.com

发表于 @2007年07月24日　12:42:00

其另一个参考源码网址：http://www.delphipraxis.net/127628-tcheckcombobox-komponente-ueberarbeiten.html

Delphi-Quellcode:

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425unit ATCheckedComboBox;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TATCBQuoteStyle = (qsNone,qsSingle,qsDouble);

TATCheckedComboBox =class(TCustomComboBox)

private

{ Private declarations }

FListInstance   :Pointer;

FDefListProc   :Pointer;

FListHandle    : HWnd;

FQuoteStyle      : TATCBQuoteStyle;

FColorNotFocus: TColor;

FCheckedCount :integer;

FTextAsHint    :boolean;

FOnCheckClick : TNotifyEvent;

FVersion       :String;

procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;

procedure CMEnter(var Message: TCMEnter); message CM_ENTER;

procedure CMExit(var Message: TCMExit); message CM_EXIT;

procedure ListWndProc(var Message: TMessage);

procedure SetColorNotFocus(value:TColor);

procedure SetVersion(value:String);

protected

{ Protected declarations }

m_strText          :string;

m_bTextUpdated   :boolean;

procedure WndProc(var Message: TMessage);override;

procedure RecalcText;

function GetText:string;

function GetCheckedCount:integer;

public

{ Public declarations }

constructor Create(AOwner: TComponent);override;

destructor    Destroy; override;

procedure    SetCheck(nIndex:integer;checked:boolean);

function       AddChecked(value:string;checked:boolean):integer;

function       IsChecked(nIndex:integer):boolean;

procedure    CheckAll(checked:boolean);

property       Text:string read GetText;

property      CheckedCount :integer read GetCheckedCount;

published

{ Published declarations }

property Anchors;

property BiDiMode;

property Color;

property ColorNotFocus : TColor   read FColorNotFocuswrite SetColorNotFocus;

property Constraints;

property Ctl3D;

property DragCursor;

property DragKind;

property DragMode;

property DropDownCount;

property Enabled;

property Font;

property ImeMode;

property ImeName;

property ItemHeight;

property Items;

property MaxLength;

property ParentBiDiMode;

property ParentColor;

property ParentCtl3D;

property ParentFont;

property ParentShowHint;

property PopupMenu;

property QuoteStyle   : TATCBQuoteStyle read FQuoteStylewrite FQuoteStyle default qsNone;

property ShowHint;

property ShowTextAsHint :Boolean read FTextAsHintwrite FTextAsHint defaulttrue;

property Sorted;

property TabOrder;

property TabStop;

property Visible;

property Version :string read FVersionwrite SetVersion;// ver 1.1

property OnChange;

property OnCheckClick: TNotifyEvent read FOnCheckClickwrite FOnCheckClick;

property OnClick;

property OnDblClick;

property OnDragDrop;

property OnDragOver;

property OnDropDown;

property OnEndDock;

property OnEndDrag;

property OnEnter;

property OnExit;

property OnKeyDown;

property OnKeyPress;

property OnKeyUp;

property OnStartDock;

property OnStartDrag;

end;

procedure Register;

implementation

{ TATCheckedComboBox }

procedure Register;

begin

RegisterComponents('Samples', [TATCheckedComboBox]);

end;

var

FCheckWidth, FCheckHeight:Integer;

procedure GetCheckSize;

begin

with TBitmap.Createdo

try

Handle := LoadBitmap(0,PChar(32759));

FCheckWidth := Widthdiv 4;

FCheckHeight := Heightdiv 3;

finally

Free;

end;

end;

procedure TATCheckedComboBox.SetVersion(value:String);

begin

// read only

end;

procedure TATCheckedComboBox.SetCheck(nIndex:integer;checked:boolean);

begin

if (nIndex>-1)and (nIndex

begin

Items.Objects[nIndex] := TObject(checked);

m_bTextUpdated :=FALSE;

Invalidate;

if Assigned(FOnCheckClick)then

OnCheckClick(self)

end;

end;

function TATCheckedComboBox.AddChecked(value:string;checked:boolean):integer;

begin

result := Items.AddObject(value, TObject(checked));

if result>=0 then

begin

m_bTextUpdated :=FALSE;

Invalidate;

end;

end;

function TATCheckedComboBox.IsChecked(nIndex:integer):boolean;

begin

result :=false;

if (nIndex>-1)and (nIndex

result := Items.Objects[nIndex] = TObject(TRUE)

end;

procedure TATCheckedComboBox.CheckAll(checked:boolean);

var i:integer;

begin

for i:=0 to Items.count-1 do

Items.Objects[i] := TObject(checked);

end;

function GetFormatedText(kind:TATCBQuoteStyle;str:string):string;

var s :string;

begin

result := str;

if length(str)>0 then

begin

s := str;

case kindof

qsSingle   : result :=

''''+

StringReplace(S,',',''',''',[rfReplaceAll])+

'''';

qsDouble    : result :=

'"'+

StringReplace(S,',','","',[rfReplaceAll])+

'"';

end;

end;

end;

function TATCheckedComboBox.GetText:string;

begin

RecalcText;

if FQuoteStyle = qsNonethen

result := m_strText

else

result := GetFormatedText(FQuoteStyle,m_strText);

end;

function TATCheckedComboBox.GetCheckedCount:integer;

begin

RecalcText;

result := FCheckedCount;

end;

procedure TATCheckedComboBox.RecalcText;

var

nCount,i    :integer;

strItem,

strText,

strSeparator :string;

begin

if (not m_bTextUpdated)then

begin

FCheckedCount   :=0;

nCount       := items.count;

strSeparator    :='; ';

strText          :='';

for i :=0 to nCount -1 do

if IsChecked(i)then

begin

inc(FCheckedCount);

strItem := items[i];

if (strText<>'')then

strText := strText + strSeparator;

strText := strText + strItem;

end;

// Set the text

m_strText          := strText;

if FTextAsHintthen

Hint := m_strText;

m_bTextUpdated    :=TRUE;

end;

end;

procedure TATCheckedComboBox.SetColorNotFocus(value:TColor);

begin

if FColorNotFocus <> Valuethen

FColorNotFocus := Value;

Invalidate

end;

procedure TATCheckedComboBox.CMEnter(var Message: TCMEnter);

begin

Self.Color      := clWhite;

if Assigned(OnEnter)then OnEnter(Self);

end;

procedure TATCheckedComboBox.CMExit(var Message: TCMExit);

begin

Self.Color       := FColorNotFocus;

if Assigned(OnExit)then OnExit(Self);

end;

procedure TATCheckedComboBox.CNDrawItem(var Message: TWMDrawItem);

var

State                  : TOwnerDrawState;

rcBitmap,rcText   : Trect;

nCheck               :integer;// 0 - No check, 1 - Empty check, 2 - Checked

nState                :integer;

strText             :string;

ItId                  :Integer;

dc                     : HDC;

begin

with Message.DrawItemStruct^do

begin

State       := TOwnerDrawState(LongRec(itemState).Lo);

dc             := hDC;

rcBitmap   := rcItem;

rcText    := rcItem;

ItId         := itemID;

end;

// Check if we are drawing the static portion of the combobox

if (itID <0)then

begin

RecalcText();

strText := m_strText;

nCheck :=0;

end

else

begin

strtext             := Items[ItId];

rcBitmap.Left    :=2;

rcBitmap.Top       := rcText.Top + (rcText.Bottom - rcText.Top - FCheckWidth)div 2;

rcBitmap.Right    := rcBitmap.Left + FCheckWidth;

rcBitmap.Bottom := rcBitmap.Top + FCheckHeight;

rcText.left := rcBitmap.right;

nCheck :=1;

if IsChecked(ItId)then

inc(nCheck);

end;

if (nCheck >0)then

begin

SetBkColor(dc, GetSysColor(COLOR_WINDOW));

SetTextColor(dc, GetSysColor(COLOR_WINDOWTEXT));

nState := DFCS_BUTTONCHECK;

if (nCheck >1)then

nState := nStateor DFCS_CHECKED;

DrawFrameControl(dc, rcBitmap, DFC_BUTTON, nState);

end;

if (odSelectedin State)then

begin

SetBkColor(dc,$0091622F);

SetTextColor(dc, GetSysColor(COLOR_HIGHLIGHTTEXT));

end

else

begin

if (nCheck=0)then

begin

SetTextColor(dc, ColorToRGB(Font.Color));

SetBkColor(dc, ColorToRGB(FColorNotFocus));

end

else

begin

SetTextColor(dc, ColorToRGB(Font.Color));

SetBkColor(dc,     ColorToRGB(Brush.Color));

end;

end;

if itID >=0 then

strText :=' ' + strtext;

ExtTextOut(dc,0,0, ETO_OPAQUE, @rcText,Nil,0,Nil);

DrawText(dc,pchar(strText), Length(strText), rcText, DT_SINGLELINEor DT_VCENTERor DT_END_ELLIPSIS);

if odFocusedin Statethen DrawFocusRect(dc, rcText);

end;

//DefWindowProc

procedure TATCheckedComboBox.ListWndProc(var Message: TMessage);

var

nItemHeight, nTopIndex, nIndex:Integer;

rcItem,rcClient: TRect;

pt              : TPoint;

begin

case Message.Msgof

LB_GETCURSEL :// this is for to not draw the selected in the text area

begin

Message.result := -1;

exit;

end;

WM_CHAR:// pressing space toggles the checked

begin

if (TWMKey(Message).CharCode = VK_SPACE)then

begin

// Get the current selection

nIndex := CallWindowProcA(FDefListProc, FListHandle, LB_GETCURSEL,Message.wParam, Message.lParam);

SendMessage(FListHandle, LB_GETITEMRECT, nIndex,LongInt(@rcItem));

InvalidateRect(FListHandle, @rcItem,FALSE);

SetCheck(nIndex,not IsChecked(nIndex));

SendMessage(WM_COMMAND, handle, CBN_SELCHANGE,handle);

Message.result :=0;

exit;

end

end;

WM_LBUTTONDOWN:

begin

Windows.GetClientRect(FListHandle, rcClient);

pt.x := TWMMouse(Message).XPos;//LOWORD(Message.lParam);

pt.y := TWMMouse(Message).YPos;//HIWORD(Message.lParam);

if (PtInRect(rcClient, pt))then

begin

nItemHeight := SendMessage(FListHandle, LB_GETITEMHEIGHT,0,0);

nTopIndex := SendMessage(FListHandle, LB_GETTOPINDEX,0,0);

// Compute which index to check/uncheck

nIndex := trunc(nTopIndex + pt.y / nItemHeight);

SendMessage(FListHandle, LB_GETITEMRECT, nIndex,LongInt(@rcItem));

if (PtInRect(rcItem, pt))then

begin

InvalidateRect(FListHandle, @rcItem,FALSE);

SetCheck(nIndex,not IsChecked(nIndex));

SendMessage(WM_COMMAND, handle, CBN_SELCHANGE,handle);

end

end

end;

WM_LBUTTONUP:

begin

Message.result :=0;

exit;

end;

end;

ComboWndProc(Message, FListHandle, FDefListProc);

end;

constructor TATCheckedComboBox.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

ShowHint            :=true;

Fversion            :='1.2';

FTextAsHint       :=true;

ParentShowHint :=False;

FListHandle       :=0;

FQuoteStyle       := qsNone;

FColorNotFocus   := clInfoBk;

Style                := csOwnerDrawVariable;

m_bTextUpdated :=FALSE;

FListInstance    := MakeObjectInstance(ListWndProc);

end;

destructor TATCheckedComboBox.Destroy;

begin

FreeObjectInstance(FListInstance);

inherited Destroy;

end;

procedure TATCheckedComboBox.WndProc(var Message: TMessage);

var lWnd : HWND;

begin

if message.Msg = WM_CTLCOLORLISTBOXthen

begin

// If the listbox hasn't been subclassed yet, do so...

if (FListHandle =0)then

begin

lwnd := message.LParam;

if (lWnd <>0)and (lWnd <> FDropHandle)then

begin

// Save the listbox handle

FListHandle := lWnd;

FDefListProc :=Pointer(GetWindowLong(FListHandle, GWL_WNDPROC));

SetWindowLong(FListHandle, GWL_WNDPROC,Longint(FListInstance));

end;

end;

end;

inherited;

end;

initialization

GetCheckSize;

end.

问题修正后的源码：

Re: TCheckComboBox: Komponente überarbeiten???

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76procedure TATCheckedComboBox.CNDrawItem(var Message: TWMDrawItem);

var

State: TOwnerDrawState;

rcBitmap, rcText: Trect;

nCheck:integer;// 0 - No check, 1 - Empty check, 2 - Checked

nState:integer;

strText:string;

ItId:Integer;

dc: HDC;

begin

with Message.DrawItemStruct^do

begin

State := TOwnerDrawState(LongRec(itemState).Lo);

dc := hDC;

rcBitmap := rcItem;

rcText := rcItem;

ItId := itemID;

end;

// Check if we are drawing the static portion of the combobox

if (itID <0)then

begin

RecalcText();

strText := m_strText;

nCheck :=0;

end

else

begin

strtext := Items[ItId];

rcBitmap.Left :=2;

rcBitmap.Top := rcText.Top + (rcText.Bottom - rcText.Top - FCheckWidth)div 2;

rcBitmap.Right := rcBitmap.Left + FCheckWidth;

rcBitmap.Bottom := rcBitmap.Top + FCheckHeight;

rcText.left := rcBitmap.right;

nCheck :=1;

if IsChecked(ItId)then

inc(nCheck);

end;

if (nCheck >0)then

begin

SetBkColor(dc, GetSysColor(COLOR_WINDOW));

SetTextColor(dc, GetSysColor(COLOR_WINDOWTEXT));

nState := DFCS_BUTTONCHECK;

if (nCheck >1)then

nState := nStateor DFCS_CHECKED;

DrawFrameControl(dc, rcBitmap, DFC_BUTTON, nState);

end;

if (odSelectedin State)then

begin

SetBkColor(dc,$0091622F);

SetTextColor(dc, GetSysColor(COLOR_HIGHLIGHTTEXT));

end

else

begin

if (nCheck =0)then

begin

SetTextColor(dc, ColorToRGB(Font.Color));

SetBkColor(dc, ColorToRGB(FColorNotFocus));

end

else

begin

SetTextColor(dc, ColorToRGB(Font.Color));

if ncheck =1 then

SetBkColor(dc, ColorToRGB(Brush.Color))

else

SetBkColor(dc, clRed);// <

end;

end;

if itID >=0 then

strText :=' ' + strtext;

ExtTextOut(dc,0,0, ETO_OPAQUE, @rcText,nil,0,nil);

DrawText(dc,pchar(strText), Length(strText), rcText, DT_SINGLELINEor DT_VCENTERor DT_END_ELLIPSIS);

if odFocusedin Statethen DrawFocusRect(dc, rcText);

end;