更改组合框下拉列表的突出显示颜色
Change the highlight color on combobox dropdown
我们需要在滚动浏览组合框中的项目时替换蓝色突出显示。
我们该怎么做？
我尝试了一个示例代码来处理组合下拉框的边框，下面是我的示例应用程序代码。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters,
cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxDropDownEdit, CXSComboBox, Vcl.StdCtrls;
type
TMycxComboBox = class (PDMCXSComboBox)
protected
procedure Loaded; override;
end;
PDMCXSComboBox = class (TMycxComboBox);
type
TForm1 = class(TForm)
cmbSelectionList: PDMCXSComboBox;
cxComboBox1: TcxComboBox;
procedure cmbSelectionListPropertiesInitPopup(Sender: TObject);
procedure cmbSelectionListPropertiesPopup(Sender: TObject);
procedure cmbSelectionListPropertiesDrawItem(AControl: TcxCustomComboBox; ACanvas: TcxCanvas; AIndex: Integer; const ARect: TRect; AState: TOwnerDrawState);
private
{ Private declarations }
public
{ Public declarations }
procedure DoCustomDrawBorder(AViewInfo: TcxContainerViewInfo; ACanvas: TcxCanvas; const R: TRect; var AHandled: Boolean;
out ABorderWidth: Integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TMycxComboBox.Loaded;
begin
inherited;
ContentParams.Offsets.Left := 20;
end;
procedure TForm1.cmbSelectionListPropertiesDrawItem(AControl: TcxCustomComboBox; ACanvas: TcxCanvas; AIndex: Integer; const ARect: TRect; AState: TOwnerDrawState);
Var
AFlags : LongInt;
R : TRect;
begin
if (Integer(AIndex) >= 0) and (odSelected in AState) then
begin
//ACanvas.Brush.Color := clRed;
//ACanvas.Font.Color := clHighlightText;
ACanvas.Brush.Color := clWhite;// [=10=]E5DFD7; //clRed
ACanvas.Font.Color := [=10=]6c4e1f;
end;
ACanvas.FillRect(ARect);
if (AIndex >= 0) and (AIndex < AControl.Properties.Items.Count) then
begin
R := ARect;
AFlags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
if not UseRightToLeftAlignment then
Inc(R.Left,2)
else
Dec(R.Right,2);
with AControl.Properties do
DrawText(ACanvas.Handle,PChar(Items[AIndex]),Length(Items[AIndex]), R, AFlags);
end;
end;
procedure TForm1.cmbSelectionListPropertiesInitPopup(Sender: TObject);
begin
TcxComboBoxPopupWindow(PDMCXSComboBox(Sender).PopupWindow).ViewInfo.OnCustomDrawBorder := DoCustomDrawBorder;
end;
procedure TForm1.cmbSelectionListPropertiesPopup(Sender: TObject);
begin
TcxComboBoxListBox(PDMCXSComboBox(Sender).ILookupData.ActiveControl).Color := clWhite;
end;
procedure TForm1.DoCustomDrawBorder(AViewInfo: TcxContainerViewInfo;
ACanvas: TcxCanvas; const R: TRect; var AHandled: Boolean;
out ABorderWidth: Integer);
begin
AHandled := True;
ABorderWidth := 1;
ACanvas.FrameRect(R, [=10=]E5DFD7);
end;
end.
PDMCXSComboBox 是我从 tcxcombobox 派生的自定义组件。
同样对于这个组合框，当我通过项目选择时，顶部和右边框是不可见的：
组件代码如下：
unit CXSComboBox;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, cxControls, cxContainer, cxEdit, cxTextEdit,
cxMaskEdit, cxDropDownEdit, cxGraphics, Winapi.Messages, Winapi.Windows, OvcCmbx;// OvcTccbx;
const
ParamsLabel = 'Params: ';
SQLLabel = 'SQL: ';
type
TpMyKeyValue = ^TrMykeyValue;
TrMyKeyValue= record
key: string;
value: string;
end;
TKeyValueShowOption = (soShowValueOnly, soShowKeyOnly, soShowAll);
type
PDMCXSComboBox = class(TcxComboBox)
private
{ Private declarations }
FItemHeight: Integer;
FOnOwnDrawItem: TcxEditDrawItemEvent;
FOnPdmDrawItem: TcxEditDrawItemEvent;
StringListKey: TStringList;
StringListKey_SACOMBO: TStringList;
StringListOKey: TStringList;
FOldWndProc: pointer;
FHintWin : THintWindow;
FHintList : TStrings;
FAutoWidthDropDown:Boolean;
FShowItemsHint:Boolean;
FListHandle: HWND;
FUseDefaultValue: Boolean;
FDefaultValue: String;
FKeyValuePairs: Boolean;
FKeyValueShowOption: TKeyValueShowOption;
procedure CMFontChanged(var Message: TWMFontChange); message CM_FONTCHANGED;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure AdjustHeight;
procedure SetSelKey(const Value: string);
function GetListIndex: Integer;
procedure SetListIndex(Value: Integer);
procedure SetKeyValuePairs(const Value: Boolean);
function GetText_PDMADVCOMBO: string;
procedure SetKeyValueShowOption(const Value: TKeyValueShowOption);
protected
{ Protected declarations }
FMRUList : TOvcMRUList;
FList : TStringList;
FListIndex : Integer; {ItemIndex sans MRU Items}
function GetItemHt: Integer; //override;
procedure Loaded; override;
//procedure Loaded_PDMCOMBO;
procedure OwnDrawItem(Control: TcxCustomComboBox; Canvas:TCxCanvas; Index: Integer; const Rect: TRect; State: TOwnerDrawState);
property OnOwnDrawItem: TcxEditDrawItemEvent read FOnOwnDrawItem write FOnOwnDrawItem;
procedure PdmDrawItem(AControl: TcxCustomComboBox; ACanvas: TcxCanvas; AIndex: Integer; const ARect: TRect; AState: TOwnerDrawState);
property OnPdmDrawItem: TCxEditDrawItemEvent read FOnPdmDrawItem write FOnPdmDrawItem;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Value: string read GetSelKey write SetSelKey;
property DefaultValue: string read FDefaultValue write FDefaultValue;
property UseDefaultValue: boolean read FUseDefaultValue write FUseDefaultValue;
property HintList: TStrings read FHintList write SetHintList;
property ListHandle: HWND read FListHandle write FListHandle;
property AutoWidthDropDown:Boolean read FAutoWidthDropDown write FAutoWidthDropDown;
property ShowItemsHint:Boolean read FShowItemsHint write FShowItemsHint;
property Align;
property KeyValuePairs: Boolean read FKeyValuePairs write SetKeyValuePairs default True;
property KeyValueShowOption: TKeyValueShowOption read FKeyValueShowOption write SetKeyValueShowOption default soShowValueOnly;
property TextPDMADVCOMBO: string read GetText_PDMADVCOMBO;
end;
function CompareValueinMyKeyValue(item1, item2:TpMyKeyValue): Integer;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('PDMCXComponents', [PDMCXSComboBox]);
end;
function CompareValueinMyKeyValue(item1,item2:TpMyKeyValue):integer;
begin
Result := CompareText(item1.value,item2.value);
end;
procedure PDMCXSComboBox.Loaded;
begin
inherited;
if not (csDesigning in ComponentState) then
begin
// chain OnDraw events
OnOwnDrawItem := Properties.OnDrawItem;
Properties.OnDrawItem := OwnDrawItem;
// chain OnDraw events
FOnPdmDrawItem := properties.OnDrawItem;
properties.OnDrawItem := PdmDrawItem;
end;
end;
{procedure PDMCXSComboBox.Loaded_PDMCOMBO;
begin
inherited;
if not (csDesigning in ComponentState) then
begin
// chain OnDraw events
FOnPdmDrawItem := properties.OnDrawItem;
properties.OnDrawItem := PdmDrawItem;
end;
end; }
procedure PDMCXSComboBox.OwnDrawItem(Control: TcxCustomComboBox; Canvas:TCxCanvas; Index: Integer;
const Rect: TRect; State: TOwnerDrawState);
var
LCanvas: TcxCanvas;
S: string;
lRect : TRect;
begin
lRect := Rect;
if not (csDestroying in ComponentState) then
begin
LCanvas := (Control as PDMCXSComboBox).Canvas;
LCanvas.FillRect(lRect);
S := PDMCXSComboBox(Control).Properties.Items[Index];
InflateRect(lRect, -2, -1);
DrawText(LCanvas.Handle, S, Length(S), lRect,
DT_LEFT or DT_NOCLIP or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX);
// call chained event handler
if Assigned(OnOwnDrawItem) then
OnOwnDrawItem(Control,LCanvas, Index, lRect, State);
end;
end;
procedure PDMCXSComboBox.PdmDrawItem(AControl: TcxCustomComboBox;
ACanvas: TcxCanvas; AIndex: Integer; const ARect: TRect;
AState: TOwnerDrawState);
var
S: string;
lRect : Trect;
begin
if not (csDestroying in ComponentState) then
begin
lRect := Arect;
ACanvas.FillRect(lRect);
S := PDMCXSComboBox(AControl).properties.Items[AIndex];
InflateRect(lRect, -2, -1);
DrawText(ACanvas.Handle, S, Length(S), lRect, DT_LEFT or DT_NOCLIP or DT_VCENTER or DT_SINGLELINE);
// maybe developer need another drawing
if Assigned(OnPdmDrawItem) then
OnPdmDrawItem(AControl,Acanvas, AIndex, lRect, AState);
end;
end;
constructor PDMCXSComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
StringListKey := TStringList.Create;
StringListKey_SACOMBO := TStringList.Create;
StringListOKey := TStringList.Create;
FHintList := TStringList.Create;
FHintWin := THintWindow.Create(Self);
autosize := false;
Height := 30;
properties.DropDownwidth := 0;
//Properties.ButtonGlyph.LoadFromFile('.\DROPDOWNICON.png');
style.Font.Size := 10;
style.Font.Name := 'Noto sans';
style.Font.Color := [=11=]757575;
style.BorderStyle := ebssingle;
style.ButtonStyle := btsSimple;
style.BorderColor := [=11=]e5dfd7;
style.LookAndFeel.NativeStyle:= false;
end;
destructor PDMCXSComboBox.Destroy;
begin
StringListKey.Free;
StringListOKey.Free;
FHintList.Free;
if Assigned(FHintWin) then
FHintWin.ReleaseHandle;
if FListHandle <> 0 then
SetWindowLong(FListHandle, GWL_WNDPROC, longint(FOldWndProc));
inherited Destroy;
end;
procedure PDMCXSComboBox.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or CBS_OWNERDRAWVARIABLE;
end;
procedure PDMCXSComboBox.AdjustHeight;
var
I: Integer;
DC: HDC;
SaveFont: HFont;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
try
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
finally
ReleaseDC(0, DC);
end;
if NewStyleControls then
begin
if Ctl3D then I := 4 else I := 2;
I := GetSystemMetrics(SM_CYBORDER) * I;
end else
begin
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
end;
FItemHeight := Metrics.tmHeight + I;
end;
procedure PDMCXSComboBox.CMFontChanged(var Message: TWMFontChange);
begin
AdjustHeight;
RecreateWnd;
end;
procedure PDMCXSComboBox.CNMeasureItem(var Message: TWMMeasureItem);
begin
Message.MeasureItemStruct.itemHeight := FItemHeight;// Properties.ItemHeight;
end;
end.
我已经解决了这个问题，它正在按预期工作。
我唯一做的就是我处理了两次 OnDrawItem，所以我必须在组件设计时禁用它。
unit CXSComboBox;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, cxControls, cxContainer, cxEdit, cxTextEdit,
cxMaskEdit, cxDropDownEdit, cxGraphics, Winapi.Messages, Winapi.Windows, OvcCmbx;// OvcTccbx;
const
ParamsLabel = 'Params: ';
SQLLabel = 'SQL: ';
type
TpMyKeyValue = ^TrMykeyValue;
TrMyKeyValue= record
key: string;
value: string;
end;
TKeyValueShowOption = (soShowValueOnly, soShowKeyOnly, soShowAll);
type
PDMCXSComboBox = class(TcxComboBox)
private
{ Private declarations }
FItemHeight: Integer;
StringListKey: TStringList;
StringListKey_SACOMBO: TStringList;
StringListOKey: TStringList;
FOldWndProc: pointer;
FHintWin : THintWindow;
FHintList : TStrings;
FAutoWidthDropDown:Boolean;
FShowItemsHint:Boolean;
FListHandle: HWND;
FUseDefaultValue: Boolean;
FDefaultValue: String;
FKeyValuePairs: Boolean;
FKeyValueShowOption: TKeyValueShowOption;
procedure CMFontChanged(var Message: TWMFontChange); message CM_FONTCHANGED;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure AdjustHeight;
procedure SetSelKey(const Value: string);
function GetListIndex: Integer;
procedure SetListIndex(Value: Integer);
procedure SetKeyValuePairs(const Value: Boolean);
function GetText_PDMADVCOMBO: string;
procedure SetKeyValueShowOption(const Value: TKeyValueShowOption);
protected
{ Protected declarations }
FMRUList : TOvcMRUList;
FList : TStringList;
FListIndex : Integer; {ItemIndex sans MRU Items}
function GetItemHt: Integer; //override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Value: string read GetSelKey write SetSelKey;
property DefaultValue: string read FDefaultValue write FDefaultValue;
property UseDefaultValue: boolean read FUseDefaultValue write FUseDefaultValue;
property HintList: TStrings read FHintList write SetHintList;
property ListHandle: HWND read FListHandle write FListHandle;
property AutoWidthDropDown:Boolean read FAutoWidthDropDown write FAutoWidthDropDown;
property ShowItemsHint:Boolean read FShowItemsHint write FShowItemsHint;
property Align;
property KeyValuePairs: Boolean read FKeyValuePairs write SetKeyValuePairs default True;
property KeyValueShowOption: TKeyValueShowOption read FKeyValueShowOption write SetKeyValueShowOption default soShowValueOnly;
property TextPDMADVCOMBO: string read GetText_PDMADVCOMBO;
end;
function CompareValueinMyKeyValue(item1, item2:TpMyKeyValue): Integer;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('PDMCXComponents', [PDMCXSComboBox]);
end;
function CompareValueinMyKeyValue(item1,item2:TpMyKeyValue):integer;
begin
Result := CompareText(item1.value,item2.value);
end;
constructor PDMCXSComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
StringListKey := TStringList.Create;
StringListKey_SACOMBO := TStringList.Create;
StringListOKey := TStringList.Create;
FHintList := TStringList.Create;
FHintWin := THintWindow.Create(Self);
autosize := false;
Height := 30;
properties.DropDownwidth := 0;
//Properties.ButtonGlyph.LoadFromFile('.\DROPDOWNICON.png');
style.Font.Size := 10;
style.Font.Name := 'Noto sans';
style.Font.Color := [=10=]757575;
style.BorderStyle := ebssingle;
style.ButtonStyle := btsSimple;
style.BorderColor := [=10=]e5dfd7;
style.LookAndFeel.NativeStyle:= false;
end;
destructor PDMCXSComboBox.Destroy;
begin
StringListKey.Free;
StringListOKey.Free;
FHintList.Free;
if Assigned(FHintWin) then
FHintWin.ReleaseHandle;
if FListHandle <> 0 then
SetWindowLong(FListHandle, GWL_WNDPROC, longint(FOldWndProc));
inherited Destroy;
end;
procedure PDMCXSComboBox.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or CBS_OWNERDRAWVARIABLE;
end;
procedure PDMCXSComboBox.AdjustHeight;
var
I: Integer;
DC: HDC;
SaveFont: HFont;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
try
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
finally
ReleaseDC(0, DC);
end;
if NewStyleControls then
begin
if Ctl3D then I := 4 else I := 2;
I := GetSystemMetrics(SM_CYBORDER) * I;
end else
begin
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
end;
FItemHeight := Metrics.tmHeight + I;
end;
procedure PDMCXSComboBox.CMFontChanged(var Message: TWMFontChange);
begin
AdjustHeight;
RecreateWnd;
end;
procedure PDMCXSComboBox.CNMeasureItem(var Message: TWMMeasureItem);
begin
Message.MeasureItemStruct.itemHeight := FItemHeight;// Properties.ItemHeight;
end;
end.
我们需要在滚动浏览组合框中的项目时替换蓝色突出显示。
我们该怎么做？
我尝试了一个示例代码来处理组合下拉框的边框，下面是我的示例应用程序代码。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters,
cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxDropDownEdit, CXSComboBox, Vcl.StdCtrls;
type
TMycxComboBox = class (PDMCXSComboBox)
protected
procedure Loaded; override;
end;
PDMCXSComboBox = class (TMycxComboBox);
type
TForm1 = class(TForm)
cmbSelectionList: PDMCXSComboBox;
cxComboBox1: TcxComboBox;
procedure cmbSelectionListPropertiesInitPopup(Sender: TObject);
procedure cmbSelectionListPropertiesPopup(Sender: TObject);
procedure cmbSelectionListPropertiesDrawItem(AControl: TcxCustomComboBox; ACanvas: TcxCanvas; AIndex: Integer; const ARect: TRect; AState: TOwnerDrawState);
private
{ Private declarations }
public
{ Public declarations }
procedure DoCustomDrawBorder(AViewInfo: TcxContainerViewInfo; ACanvas: TcxCanvas; const R: TRect; var AHandled: Boolean;
out ABorderWidth: Integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TMycxComboBox.Loaded;
begin
inherited;
ContentParams.Offsets.Left := 20;
end;
procedure TForm1.cmbSelectionListPropertiesDrawItem(AControl: TcxCustomComboBox; ACanvas: TcxCanvas; AIndex: Integer; const ARect: TRect; AState: TOwnerDrawState);
Var
AFlags : LongInt;
R : TRect;
begin
if (Integer(AIndex) >= 0) and (odSelected in AState) then
begin
//ACanvas.Brush.Color := clRed;
//ACanvas.Font.Color := clHighlightText;
ACanvas.Brush.Color := clWhite;// [=10=]E5DFD7; //clRed
ACanvas.Font.Color := [=10=]6c4e1f;
end;
ACanvas.FillRect(ARect);
if (AIndex >= 0) and (AIndex < AControl.Properties.Items.Count) then
begin
R := ARect;
AFlags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
if not UseRightToLeftAlignment then
Inc(R.Left,2)
else
Dec(R.Right,2);
with AControl.Properties do
DrawText(ACanvas.Handle,PChar(Items[AIndex]),Length(Items[AIndex]), R, AFlags);
end;
end;
procedure TForm1.cmbSelectionListPropertiesInitPopup(Sender: TObject);
begin
TcxComboBoxPopupWindow(PDMCXSComboBox(Sender).PopupWindow).ViewInfo.OnCustomDrawBorder := DoCustomDrawBorder;
end;
procedure TForm1.cmbSelectionListPropertiesPopup(Sender: TObject);
begin
TcxComboBoxListBox(PDMCXSComboBox(Sender).ILookupData.ActiveControl).Color := clWhite;
end;
procedure TForm1.DoCustomDrawBorder(AViewInfo: TcxContainerViewInfo;
ACanvas: TcxCanvas; const R: TRect; var AHandled: Boolean;
out ABorderWidth: Integer);
begin
AHandled := True;
ABorderWidth := 1;
ACanvas.FrameRect(R, [=10=]E5DFD7);
end;
end.
PDMCXSComboBox 是我从 tcxcombobox 派生的自定义组件。
同样对于这个组合框，当我通过项目选择时，顶部和右边框是不可见的：
组件代码如下：
unit CXSComboBox;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, cxControls, cxContainer, cxEdit, cxTextEdit,
cxMaskEdit, cxDropDownEdit, cxGraphics, Winapi.Messages, Winapi.Windows, OvcCmbx;// OvcTccbx;
const
ParamsLabel = 'Params: ';
SQLLabel = 'SQL: ';
type
TpMyKeyValue = ^TrMykeyValue;
TrMyKeyValue= record
key: string;
value: string;
end;
TKeyValueShowOption = (soShowValueOnly, soShowKeyOnly, soShowAll);
type
PDMCXSComboBox = class(TcxComboBox)
private
{ Private declarations }
FItemHeight: Integer;
FOnOwnDrawItem: TcxEditDrawItemEvent;
FOnPdmDrawItem: TcxEditDrawItemEvent;
StringListKey: TStringList;
StringListKey_SACOMBO: TStringList;
StringListOKey: TStringList;
FOldWndProc: pointer;
FHintWin : THintWindow;
FHintList : TStrings;
FAutoWidthDropDown:Boolean;
FShowItemsHint:Boolean;
FListHandle: HWND;
FUseDefaultValue: Boolean;
FDefaultValue: String;
FKeyValuePairs: Boolean;
FKeyValueShowOption: TKeyValueShowOption;
procedure CMFontChanged(var Message: TWMFontChange); message CM_FONTCHANGED;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure AdjustHeight;
procedure SetSelKey(const Value: string);
function GetListIndex: Integer;
procedure SetListIndex(Value: Integer);
procedure SetKeyValuePairs(const Value: Boolean);
function GetText_PDMADVCOMBO: string;
procedure SetKeyValueShowOption(const Value: TKeyValueShowOption);
protected
{ Protected declarations }
FMRUList : TOvcMRUList;
FList : TStringList;
FListIndex : Integer; {ItemIndex sans MRU Items}
function GetItemHt: Integer; //override;
procedure Loaded; override;
//procedure Loaded_PDMCOMBO;
procedure OwnDrawItem(Control: TcxCustomComboBox; Canvas:TCxCanvas; Index: Integer; const Rect: TRect; State: TOwnerDrawState);
property OnOwnDrawItem: TcxEditDrawItemEvent read FOnOwnDrawItem write FOnOwnDrawItem;
procedure PdmDrawItem(AControl: TcxCustomComboBox; ACanvas: TcxCanvas; AIndex: Integer; const ARect: TRect; AState: TOwnerDrawState);
property OnPdmDrawItem: TCxEditDrawItemEvent read FOnPdmDrawItem write FOnPdmDrawItem;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Value: string read GetSelKey write SetSelKey;
property DefaultValue: string read FDefaultValue write FDefaultValue;
property UseDefaultValue: boolean read FUseDefaultValue write FUseDefaultValue;
property HintList: TStrings read FHintList write SetHintList;
property ListHandle: HWND read FListHandle write FListHandle;
property AutoWidthDropDown:Boolean read FAutoWidthDropDown write FAutoWidthDropDown;
property ShowItemsHint:Boolean read FShowItemsHint write FShowItemsHint;
property Align;
property KeyValuePairs: Boolean read FKeyValuePairs write SetKeyValuePairs default True;
property KeyValueShowOption: TKeyValueShowOption read FKeyValueShowOption write SetKeyValueShowOption default soShowValueOnly;
property TextPDMADVCOMBO: string read GetText_PDMADVCOMBO;
end;
function CompareValueinMyKeyValue(item1, item2:TpMyKeyValue): Integer;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('PDMCXComponents', [PDMCXSComboBox]);
end;
function CompareValueinMyKeyValue(item1,item2:TpMyKeyValue):integer;
begin
Result := CompareText(item1.value,item2.value);
end;
procedure PDMCXSComboBox.Loaded;
begin
inherited;
if not (csDesigning in ComponentState) then
begin
// chain OnDraw events
OnOwnDrawItem := Properties.OnDrawItem;
Properties.OnDrawItem := OwnDrawItem;
// chain OnDraw events
FOnPdmDrawItem := properties.OnDrawItem;
properties.OnDrawItem := PdmDrawItem;
end;
end;
{procedure PDMCXSComboBox.Loaded_PDMCOMBO;
begin
inherited;
if not (csDesigning in ComponentState) then
begin
// chain OnDraw events
FOnPdmDrawItem := properties.OnDrawItem;
properties.OnDrawItem := PdmDrawItem;
end;
end; }
procedure PDMCXSComboBox.OwnDrawItem(Control: TcxCustomComboBox; Canvas:TCxCanvas; Index: Integer;
const Rect: TRect; State: TOwnerDrawState);
var
LCanvas: TcxCanvas;
S: string;
lRect : TRect;
begin
lRect := Rect;
if not (csDestroying in ComponentState) then
begin
LCanvas := (Control as PDMCXSComboBox).Canvas;
LCanvas.FillRect(lRect);
S := PDMCXSComboBox(Control).Properties.Items[Index];
InflateRect(lRect, -2, -1);
DrawText(LCanvas.Handle, S, Length(S), lRect,
DT_LEFT or DT_NOCLIP or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX);
// call chained event handler
if Assigned(OnOwnDrawItem) then
OnOwnDrawItem(Control,LCanvas, Index, lRect, State);
end;
end;
procedure PDMCXSComboBox.PdmDrawItem(AControl: TcxCustomComboBox;
ACanvas: TcxCanvas; AIndex: Integer; const ARect: TRect;
AState: TOwnerDrawState);
var
S: string;
lRect : Trect;
begin
if not (csDestroying in ComponentState) then
begin
lRect := Arect;
ACanvas.FillRect(lRect);
S := PDMCXSComboBox(AControl).properties.Items[AIndex];
InflateRect(lRect, -2, -1);
DrawText(ACanvas.Handle, S, Length(S), lRect, DT_LEFT or DT_NOCLIP or DT_VCENTER or DT_SINGLELINE);
// maybe developer need another drawing
if Assigned(OnPdmDrawItem) then
OnPdmDrawItem(AControl,Acanvas, AIndex, lRect, AState);
end;
end;
constructor PDMCXSComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
StringListKey := TStringList.Create;
StringListKey_SACOMBO := TStringList.Create;
StringListOKey := TStringList.Create;
FHintList := TStringList.Create;
FHintWin := THintWindow.Create(Self);
autosize := false;
Height := 30;
properties.DropDownwidth := 0;
//Properties.ButtonGlyph.LoadFromFile('.\DROPDOWNICON.png');
style.Font.Size := 10;
style.Font.Name := 'Noto sans';
style.Font.Color := [=11=]757575;
style.BorderStyle := ebssingle;
style.ButtonStyle := btsSimple;
style.BorderColor := [=11=]e5dfd7;
style.LookAndFeel.NativeStyle:= false;
end;
destructor PDMCXSComboBox.Destroy;
begin
StringListKey.Free;
StringListOKey.Free;
FHintList.Free;
if Assigned(FHintWin) then
FHintWin.ReleaseHandle;
if FListHandle <> 0 then
SetWindowLong(FListHandle, GWL_WNDPROC, longint(FOldWndProc));
inherited Destroy;
end;
procedure PDMCXSComboBox.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or CBS_OWNERDRAWVARIABLE;
end;
procedure PDMCXSComboBox.AdjustHeight;
var
I: Integer;
DC: HDC;
SaveFont: HFont;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
try
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
finally
ReleaseDC(0, DC);
end;
if NewStyleControls then
begin
if Ctl3D then I := 4 else I := 2;
I := GetSystemMetrics(SM_CYBORDER) * I;
end else
begin
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
end;
FItemHeight := Metrics.tmHeight + I;
end;
procedure PDMCXSComboBox.CMFontChanged(var Message: TWMFontChange);
begin
AdjustHeight;
RecreateWnd;
end;
procedure PDMCXSComboBox.CNMeasureItem(var Message: TWMMeasureItem);
begin
Message.MeasureItemStruct.itemHeight := FItemHeight;// Properties.ItemHeight;
end;
end.
我已经解决了这个问题，它正在按预期工作。 我唯一做的就是我处理了两次 OnDrawItem，所以我必须在组件设计时禁用它。
unit CXSComboBox;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, cxControls, cxContainer, cxEdit, cxTextEdit,
cxMaskEdit, cxDropDownEdit, cxGraphics, Winapi.Messages, Winapi.Windows, OvcCmbx;// OvcTccbx;
const
ParamsLabel = 'Params: ';
SQLLabel = 'SQL: ';
type
TpMyKeyValue = ^TrMykeyValue;
TrMyKeyValue= record
key: string;
value: string;
end;
TKeyValueShowOption = (soShowValueOnly, soShowKeyOnly, soShowAll);
type
PDMCXSComboBox = class(TcxComboBox)
private
{ Private declarations }
FItemHeight: Integer;
StringListKey: TStringList;
StringListKey_SACOMBO: TStringList;
StringListOKey: TStringList;
FOldWndProc: pointer;
FHintWin : THintWindow;
FHintList : TStrings;
FAutoWidthDropDown:Boolean;
FShowItemsHint:Boolean;
FListHandle: HWND;
FUseDefaultValue: Boolean;
FDefaultValue: String;
FKeyValuePairs: Boolean;
FKeyValueShowOption: TKeyValueShowOption;
procedure CMFontChanged(var Message: TWMFontChange); message CM_FONTCHANGED;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure AdjustHeight;
procedure SetSelKey(const Value: string);
function GetListIndex: Integer;
procedure SetListIndex(Value: Integer);
procedure SetKeyValuePairs(const Value: Boolean);
function GetText_PDMADVCOMBO: string;
procedure SetKeyValueShowOption(const Value: TKeyValueShowOption);
protected
{ Protected declarations }
FMRUList : TOvcMRUList;
FList : TStringList;
FListIndex : Integer; {ItemIndex sans MRU Items}
function GetItemHt: Integer; //override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Value: string read GetSelKey write SetSelKey;
property DefaultValue: string read FDefaultValue write FDefaultValue;
property UseDefaultValue: boolean read FUseDefaultValue write FUseDefaultValue;
property HintList: TStrings read FHintList write SetHintList;
property ListHandle: HWND read FListHandle write FListHandle;
property AutoWidthDropDown:Boolean read FAutoWidthDropDown write FAutoWidthDropDown;
property ShowItemsHint:Boolean read FShowItemsHint write FShowItemsHint;
property Align;
property KeyValuePairs: Boolean read FKeyValuePairs write SetKeyValuePairs default True;
property KeyValueShowOption: TKeyValueShowOption read FKeyValueShowOption write SetKeyValueShowOption default soShowValueOnly;
property TextPDMADVCOMBO: string read GetText_PDMADVCOMBO;
end;
function CompareValueinMyKeyValue(item1, item2:TpMyKeyValue): Integer;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('PDMCXComponents', [PDMCXSComboBox]);
end;
function CompareValueinMyKeyValue(item1,item2:TpMyKeyValue):integer;
begin
Result := CompareText(item1.value,item2.value);
end;
constructor PDMCXSComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
StringListKey := TStringList.Create;
StringListKey_SACOMBO := TStringList.Create;
StringListOKey := TStringList.Create;
FHintList := TStringList.Create;
FHintWin := THintWindow.Create(Self);
autosize := false;
Height := 30;
properties.DropDownwidth := 0;
//Properties.ButtonGlyph.LoadFromFile('.\DROPDOWNICON.png');
style.Font.Size := 10;
style.Font.Name := 'Noto sans';
style.Font.Color := [=10=]757575;
style.BorderStyle := ebssingle;
style.ButtonStyle := btsSimple;
style.BorderColor := [=10=]e5dfd7;
style.LookAndFeel.NativeStyle:= false;
end;
destructor PDMCXSComboBox.Destroy;
begin
StringListKey.Free;
StringListOKey.Free;
FHintList.Free;
if Assigned(FHintWin) then
FHintWin.ReleaseHandle;
if FListHandle <> 0 then
SetWindowLong(FListHandle, GWL_WNDPROC, longint(FOldWndProc));
inherited Destroy;
end;
procedure PDMCXSComboBox.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or CBS_OWNERDRAWVARIABLE;
end;
procedure PDMCXSComboBox.AdjustHeight;
var
I: Integer;
DC: HDC;
SaveFont: HFont;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
try
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
finally
ReleaseDC(0, DC);
end;
if NewStyleControls then
begin
if Ctl3D then I := 4 else I := 2;
I := GetSystemMetrics(SM_CYBORDER) * I;
end else
begin
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
end;
FItemHeight := Metrics.tmHeight + I;
end;
procedure PDMCXSComboBox.CMFontChanged(var Message: TWMFontChange);
begin
AdjustHeight;
RecreateWnd;
end;
procedure PDMCXSComboBox.CNMeasureItem(var Message: TWMMeasureItem);
begin
Message.MeasureItemStruct.itemHeight := FItemHeight;// Properties.ItemHeight;
end;
end.