Как имитировать стиль выбора категорий в стиле Word 2010

Ответ 1

Вы можете использовать компонент TButtonGroup.

Использование VCL Styles на сегодняшний день является самым простым решением, но, как вы сказали, использование стилей в XE2 довольно неудобно, по-моему, эта функция действительно стала жизнеспособной в XE3.

В соответствии с вашим запросом использовать методы рисования по умолчанию, я отправляю свое решение,

исходный код проекта здесь.

Для этого проекта требуется изображение, изображение будет заархивировано вместе с проектом.

Скомпилирован и протестирован в XE4.

type

  TButtonGroup = class(Vcl.ButtonGroup.TButtonGroup)
   protected
     procedure Paint; override;
  end;

  TForm1 = class(TForm)
    ButtonGroup1: TButtonGroup;
    Panel1: TPanel;
    procedure ButtonGroup1DrawButton(Sender: TObject; Index: Integer;
      Canvas: TCanvas; Rect: TRect; State: TButtonDrawState);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MBitmap : TBitmap;

implementation

{$R *.dfm}

procedure TButtonGroup.Paint;
var
  R : TRect;
begin
   inherited;
   R := GetClientRect;
   R.Top := Self.Items.Count * Self.ButtonHeight;
   {Remove the clBtnFace background default Painting}
   Self.Canvas.FillRect(R);
end;

procedure TForm1.ButtonGroup1DrawButton(Sender: TObject; Index: Integer;
  Canvas: TCanvas; Rect: TRect; State: TButtonDrawState);
var
  TextLeft, TextTop: Integer;
  RectHeight: Integer;
  ImgTop: Integer;
  Text : String;
  TextOffset: Integer;
  ButtonItem: TGrpButtonItem;
  InsertIndication: TRect;
  DrawSkipLine : TRect;
  TextRect: TRect;
  OrgRect: TRect;

begin

    //OrgRect := Rect;  //icon
    Canvas.Font := TButtonGroup(Sender).Font;

      if bdsSelected in State then begin
         Canvas.CopyRect(Rect,MBitmap.Canvas,
                         System.Classes.Rect(0, 0, MBitmap.Width, MBitmap.Height));
         Canvas.Brush.Color := RGB(255,228,138);
      end
      else if bdsHot in State then
      begin
        Canvas.Brush.Color := RGB(194,221,244);
        Canvas.Font.Color := clBlack;

      end
       else
        Canvas.Brush.color := clWhite;

      if not (bdsSelected in State)
      then
        Canvas.FillRect(Rect);


      InflateRect(Rect, -2, -1);


    { Compute the text location }
    TextLeft := Rect.Left + 4;
    RectHeight := Rect.Bottom - Rect.Top;
     TextTop := Rect.Top + (RectHeight - Canvas.TextHeight('Wg')) div 2; { Do not localize }
    if TextTop < Rect.Top then
      TextTop := Rect.Top;
    if bdsDown in State then
    begin
      Inc(TextTop);
      Inc(TextLeft);
    end;

    ButtonItem := TButtonGroup(Sender).Items.Items[Index];

    TextOffset := 0;

    { Draw the icon  - if you need to display icons}

//    if (FImages <> nil) and (ButtonItem.ImageIndex > -1) and
//        (ButtonItem.ImageIndex < FImages.Count) then
//    begin
//      ImgTop := Rect.Top + (RectHeight - FImages.Height) div 2;
//      if ImgTop < Rect.Top then
//        ImgTop := Rect.Top;
//      if bdsDown in State then
//        Inc(ImgTop);
//      FImages.Draw(Canvas, TextLeft - 1, ImgTop, ButtonItem.ImageIndex);
//      TextOffset := FImages.Width + 1;
//    end;


    { Show insert indications }

    if [bdsInsertLeft, bdsInsertTop, bdsInsertRight, bdsInsertBottom] * State <> [] then
    begin
      Canvas.Brush.Color := clSkyBlue;
      InsertIndication := Rect;
      if bdsInsertLeft in State then
      begin
        Dec(InsertIndication.Left, 2);
        InsertIndication.Right := InsertIndication.Left + 2;
      end
      else if bdsInsertTop in State then
      begin
        Dec(InsertIndication.Top);
        InsertIndication.Bottom := InsertIndication.Top + 2;
      end
      else if bdsInsertRight in State then
      begin
        Inc(InsertIndication.Right, 2);
        InsertIndication.Left := InsertIndication.Right - 2;
      end
      else if bdsInsertBottom in State then
      begin
        Inc(InsertIndication.Bottom);
        InsertIndication.Top := InsertIndication.Bottom - 2;
      end;
      Canvas.FillRect(InsertIndication);
      //Canvas.Brush.Color := FillColor;
    end;

    if gboShowCaptions in TButtonGroup(Sender).ButtonOptions then
    begin
      { Avoid clipping the image }
      Inc(TextLeft, TextOffset);
      TextRect.Left := TextLeft;
      TextRect.Right := Rect.Right - 1;
      TextRect.Top := TextTop;
      TextRect.Bottom := Rect.Bottom -1;
      Text := ButtonItem.Caption;
      Canvas.TextRect(TextRect, Text, [tfEndEllipsis]);
    end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MBitmap := TBitmap.Create;
  try
  MBitmap.LoadFromFile('bg.bmp');
  except
    on E : Exception do
      ShowMessage(E.ClassName+' error raised, with message : '+E.Message);
  end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MBitmap.Free;
end;

DFM:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 398
  ClientWidth = 287
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  StyleElements = []
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    AlignWithMargins = True
    Left = 5
    Top = 5
    Width = 137
    Height = 388
    Margins.Left = 5
    Margins.Top = 5
    Margins.Right = 5
    Margins.Bottom = 5
    Align = alLeft
    BevelKind = bkFlat
    BevelOuter = bvNone
    Color = clWhite
    ParentBackground = False
    TabOrder = 0
    StyleElements = [seFont]
    object ButtonGroup1: TButtonGroup
      AlignWithMargins = True
      Left = 4
      Top = 4
      Width = 125
      Height = 378
      Margins.Left = 4
      Margins.Top = 4
      Margins.Right = 4
      Margins.Bottom = 2
      Align = alClient
      BevelInner = bvNone
      BevelOuter = bvNone
      BorderStyle = bsNone
      ButtonOptions = [gboFullSize, gboGroupStyle, gboShowCaptions]
      DoubleBuffered = True
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Segoe UI'
      Font.Style = []
      Items = <
        item
          Caption = 'General'
        end
        item
          Caption = 'Display'
        end
        item
          Caption = 'Proofing'
        end
        item
          Caption = 'Save'
        end
        item
          Caption = 'Language'
        end
        item
          Caption = 'Advanced'
        end>
      ParentDoubleBuffered = False
      TabOrder = 0
      OnDrawButton = ButtonGroup1DrawButton
    end
  end
end

В контейнере есть контейнер, в котором размещается TButtonGroup, он не нужен, просто добавляется для визуального улучшения.

Если вы хотите изменить цвет выделения во время выполнения, я предлагаю использовать efg Hue/Saturation для изменения оттенка изображение, таким образом, цветная панель останется, но цвет изменится.

Чтобы получить поддержку VCL Styles, просто отсоедините событие ButtonGroup1DrawButton от компонента TButtonGroup, таким образом, событие DrawButton по умолчанию может ударить, в котором добавлена ​​поддержка для этого.

Ответ 2

Вы можете использовать TListBox со стилем, установленным в lbOwnerDrawFixed (если размер интервала не важен) или lbOwnerDrawVariable, если он есть.

Затем вы можете обрабатывать OnDrawItem и OnMeasureItem соответственно.

Использование clWindow не будет проблемой, однако AFAIK оранжевый цвет не является частью темы Windows, но вы можете получить что-то, что будет соответствовать теме, начиная с clHighlight, а затем применяя изменение оттенка, затем сдвиг яркости для затенения.

Если ваш оттенок будет постоянным, он автоматически адаптируется к цветам тем.

Пример кода (без HueShift для апельсина): отпустите TListBox, установите lbOwnerDrawFixed, отрегулируйте ItemHeight до 28, установите шрифт в "Segoe UI" и используйте следующий OnDrawItem

var
   canvas : TCanvas;
   txt : String;
begin
   canvas:=ListBox1.Canvas;
   canvas.Brush.Style:=bsSolid;
   canvas.Brush.Color:=clWindow;
   canvas.FillRect(Rect);
   InflateRect(Rect, -2, -2);
   if odSelected in State then begin
      canvas.Pen.Color:=RGB(194, 118, 43);
      canvas.Brush.Color:=RGB(255, 228, 138);
      canvas.RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, 6, 6);
      canvas.Pen.Color:=RGB(246, 200, 103);
      canvas.RoundRect(Rect.Left+1, Rect.Top+1, Rect.Right-1, Rect.Bottom-1, 6, 6);
   end;
   canvas.Font.Color:=clWindowText;
   canvas.Brush.Style:=bsClear;
   txt:=ListBox1.Items[Index];
   Rect.Left:=Rect.Left+10;
   canvas.TextRect(Rect, txt, [tfLeft, tfSingleLine, tfVerticalCenter]);
end;

Если у вас будет несколько таких компонентов, конечно, предпочтительнее просто подкласс TListBox, и если вы хотите сглаживание для RoundRect, то можно использовать GR32 или GDI +.

Обратите внимание, что для обратной совместимости с XP шрифт "Segoe UI" должен быть установлен динамически, поскольку он недоступен в XP (в XP "Arial" является хорошим резервом, "Tahoma" выглядит ближе, но не гарантируется есть)

Ответ 3

Мы используем TMS Control Advanced Poly Pager для этого вида. Я очень рекомендую. Это очень мощный и гибкий набор элементов управления. В частности, мы используем TAdvPolyList для наших диалоговых окон в стиле Office с некоторой настраиваемой настройкой цветовой схемы. (Обратите внимание, что это отличается от их TAdvOfficePager, который выглядит не так хорошо. Не производите смешение двух!)

Он позволяет:

• Выберите селектор категорий слева.
• Является элементом управления страницей, поэтому легко управлять своими элементами на страницах справа (так же, как и с обычным управлением страницей).
• Показывает визуальную связь между вкладкой и страницей, то, что предоставленный вами скриншот Word не делает (у Word есть барьер между ними, этот контроль не делает. Это лучший, более интуитивный и хорошо связанный пользовательский интерфейс deisgn.)
• Конечно, вы можете использовать цветовые константы, такие как clWindow, если хотите, хотя что-нибудь будет
• Имеет большое количество элементов, которые можно перемещать на левой панели, включая изображения, текст с изображениями, ссылки и т.д. В скриншоте Word есть тонкие серые разделительные линии, разделяющие некоторые элементы; Я уверен, что вы тоже можете сделать это с помощью этого элемента управления, тогда как было бы более сложно надежно справиться с некоторыми другими ответами, которые дали плакаты, такими как пользовательская покраска TListBox.
• Отлично выглядит!

Изображения на их сайте на самом деле не показывают, как имитировать внешний вид Office, но из этих двух скриншотов (high-res на их сайте) вы сможете увидеть то, что вы можете достичь:

и

Наши меню выглядят похожими на второй скриншот, но с простыми текстовыми элементами (ничего сложного, как флажки и изображения и т.д.), я думаю, что они поставили их там, чтобы продемонстрировать, что вы можете) и использует цветовую схему, более похожую на вашу, плюс мы добавили синие заголовки на каждую страницу.

Мы купили его пару лет назад и никогда не сожалели об этом. Очень рекомендуется.

Ответ 4

Я бы подумал, что вы можете использовать две вещи: управление страницей для части справа. Для части слева я думаю, что у вас есть несколько вариантов, главным из которых, вероятно, является GridLayout, использующая 1 колонку и кнопки скорости.

Не слишком сложно, но немного грязно. Возможно, вы можете сделать с фреймом, чтобы содержать часть кнопок.

Единственный трудный бит - это разделительные столбцы, но, возможно, вы могли бы сделать это путем подклассификации и наличия определенных свойств.

Привет,

А