Справа налево 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.
Другие вопросы по тегам