当我在 Delphi XE2中使用ComboBox与自定义样式(Emerald Light Slate)和此属性时,我遇到了问题:
BiDiMode := bdRightToLeft; Style := csDropDownList;
没有自定义样式的ComboBox:
使用自定义样式(Emerald Light Slate):
我如何修复它?
cczfrluj1#
问题似乎位于TComboBoxStyleHook的DrawItem方法(TComboBox的vcl风格钩子)中,您可以通过覆盖此方法来修复此问题。试试这个示例代码(这个解决方案远非完美,但只是一个开始)
DrawItem
type TComboBoxStyleHookFix = class(TComboBoxStyleHook) protected procedure DrawItem(Canvas: TCanvas; Index: Integer; const R: TRect; Selected: Boolean); override; end; { TComboBoxStyleHookFix } procedure TComboBoxStyleHookFix.DrawItem(Canvas: TCanvas; Index: Integer; const R: TRect; Selected: Boolean); var DIS : TDrawItemStruct; Text : string; begin if Control.BiDiMode<>bdRightToLeft then inherited else begin FillChar(DIS, SizeOf(DIS), 0); DIS.CtlType := ODT_COMBOBOX; DIS.CtlID := GetDlgCtrlID(Handle); DIS.itemAction := ODA_DRAWENTIRE; DIS.hDC := Canvas.Handle; DIS.hwndItem := Handle; DIS.rcItem := R; Text:=TComboBox(Control).Items[Index]; DIS.rcItem.Left:=DIS.rcItem.Left+ (DIS.rcItem.Width-Canvas.TextWidth(Text)-5); DIS.itemID := Index; DIS.itemData := SendMessage(ListHandle, LB_GETITEMDATA, 0, 0); if Selected then DIS.itemState := DIS.itemState {or ODS_FOCUS} or ODS_SELECTED; SendMessage(Handle, WM_DRAWITEM, Handle, LPARAM(@DIS)); end; end;
用这种方式
TStyleManager.Engine.RegisterStyleHook(TComboBox, TComboBoxStyleHookFix);
不要忘记在Embarcadero的QC页面报告此错误。
jslywgbw2#
我修复了上面的代码,它的问题被修复了(RTL对齐和焦点颜色),它被测试了,没有问题。感谢@RRUZ:
unit ComboBoxStyleHookFix; interface uses Vcl.Forms, Vcl.StdCtrls, Vcl.Graphics, Winapi.Windows, System.Classes, Winapi.Messages; type TComboBoxStyleHookFix = class(TComboBoxStyleHook) protected procedure DrawItem(Canvas: TCanvas; Index: Integer; const R: TRect; Selected: Boolean); override; end; implementation procedure TComboBoxStyleHookFix.DrawItem(Canvas: TCanvas; Index: Integer; const R: TRect; Selected: Boolean); var DIS: TDrawItemStruct; Text: string; R1: TRect; begin if Control.BiDiMode <> bdRightToLeft then inherited else begin FillChar(DIS, SizeOf(DIS), 0); DIS.CtlType := ODT_COMBOBOX; DIS.CtlID := GetDlgCtrlID(Handle); DIS.itemAction := ODA_DRAWENTIRE; DIS.hDC := Canvas.Handle; DIS.hwndItem := Handle; DIS.rcItem := R; Text := TComboBox(Control).Items[Index]; DIS.rcItem.Left := DIS.rcItem.Right + 11; DIS.itemID := Index; DIS.itemData := SendMessage(ListHandle, LB_GETITEMDATA, 0, 0); Canvas.Font.Name := Application.DefaultFont.Name; Canvas.Font.Size := Application.DefaultFont.Size; if Selected then begin Canvas.Font.Color := clWhite; DIS.itemState := DIS.itemState { or ODS_FOCUS } or ODS_SELECTED; Canvas.Brush.Color := $00D77800; end; Canvas.FillRect(R); R1 := R; DrawText(Canvas.Handle, PChar(Text), -1, R1, DT_SINGLELINE or DT_RTLREADING or DT_RIGHT); // Canvas.TextRect(R, TComboBox(Control).Width - Canvas.TextWidth(Text) - 5, R.Top + 1, TextM(Text)); // Canvas.TextOut(TComboBox(Control).Width - Canvas.TextWidth(Text) - 5, R.Top + 1, Text); SendMessage(Handle, WM_DRAWITEM, Handle, LPARAM(@DIS)); end; end; end.
Project1.dpr:
program Project1; uses Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Types, Vcl.Graphics, System.SysUtils, Winapi.Windows, System.Classes, Vcl.Controls, Winapi.Messages, Vcl.Themes, ComboBoxStyleHookFix in 'ComboBoxStyleHookFix.pas', Unit1 in 'Unit1.pas' {Form1} , Vcl.Styles; {$R *.res} begin Application.Initialize; Application.MainFormOnTaskbar := True; Application.DefaultFont.Name := 'Arial'; Application.DefaultFont.Size := 10; TStyleManager.TrySetStyle('Windows10'); TStyleManager.Engine.RegisterStyleHook(TComboBox, TComboBoxStyleHookFix); Application.CreateForm(TForm1, Form1); Application.Run; end.
2条答案
按热度按时间cczfrluj1#
问题似乎位于TComboBoxStyleHook的
DrawItem
方法(TComboBox的vcl风格钩子)中,您可以通过覆盖此方法来修复此问题。试试这个示例代码(这个解决方案远非完美,但只是一个开始)
用这种方式
不要忘记在Embarcadero的QC页面报告此错误。
jslywgbw2#
我修复了上面的代码,它的问题被修复了(RTL对齐和焦点颜色),它被测试了,没有问题。感谢@RRUZ:
Project1.dpr: