http://blog.csdn.net/qinmaofan/archive/2007/07/24/1705090.aspx
转载请勿清除广告。
没有合适的局域网管理软件吗?你的网管工具够灵活够高效吗?看看这个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:
unit 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 FColorNotFocus write 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 FQuoteStyle write FQuoteStyle default qsNone; property ShowHint; property ShowTextAsHint : Boolean read FTextAsHint write FTextAsHint default true; property Sorted; property TabOrder; property TabStop; property Visible; property Version :string read FVersion write SetVersion; // ver 1.1 property OnChange; property OnCheckClick: TNotifyEvent read FOnCheckClick write 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.Create do try Handle := LoadBitmap(0, PChar(32759)); FCheckWidth := Width div 4; FCheckHeight := Height div 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<Items.count) then 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<Items.count) then 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 kind of qsSingle : result := ''''+ StringReplace(S, ',', ''',''',[rfReplaceAll])+ ''''; qsDouble : result := '"'+ StringReplace(S, ',', '","',[rfReplaceAll])+ '"'; end; end; end; function TATCheckedComboBox.GetText: string; begin RecalcText; if FQuoteStyle = qsNone then 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 FTextAsHint then Hint := m_strText; m_bTextUpdated := TRUE; end; end; procedure TATCheckedComboBox.SetColorNotFocus(value:TColor); begin if FColorNotFocus <> Value then 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 := nState or DFCS_CHECKED; DrawFrameControl(dc, rcBitmap, DFC_BUTTON, nState); end; if (odSelected in 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_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS); if odFocused in State then DrawFocusRect(dc, rcText); end; //DefWindowProc procedure TATCheckedComboBox.ListWndProc(var Message: TMessage); var nItemHeight, nTopIndex, nIndex: Integer; rcItem,rcClient: TRect; pt : TPoint; begin case Message.Msg of 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_CTLCOLORLISTBOX then 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???
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 := nState or DFCS_CHECKED; DrawFrameControl(dc, rcBitmap, DFC_BUTTON, nState); end; if (odSelected in 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); // <<----- hier 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_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS); if odFocused in State then DrawFocusRect(dc, rcText); end;
非常感谢老外。