Справа налево ComboBox в Delphi XE2 со стилями
У меня проблемы, когда я использую ComboBox в Delphi XE2 с пользовательскими стилями (Emerald Light Slate) и этим свойством:
BiDiMode := bdRightToLeft;
Style := csDropDownList;
Это ComboBox без пользовательского стиля:
И с Пользовательскими стилями (Изумрудный Светлый Сланец):
Как я могу это исправить?
2 ответа
Решение
Проблема, кажется, находится в DrawItem
метод TComboBoxStyleHook (хук стиля vcl TComboBox), вы можете исправить это, переопределяя этот метод.
Попробуйте этот пример кода (это решение далеко не идеально, но это начало)
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.
Я исправил приведенный выше код, и его проблемы были исправлены (выравнивание RTL и цвет фокуса), он был протестирован и проблем не возникло. Спасибо от user91299:
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.
Проект1.дпр:
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.