如何使用Office XP主题制作列表框，如选择矩形？

Question

使用Office XP样式显示焦点/选定列表框项目的最简单，最简洁的方法是什么？

请参阅此示例图像以更清晰地显示该想法：

我想我需要将列表框样式设置为lbOwnerDrawFixed或lbOwnerDrawVariable，然后修改OnDrawItem事件？

这是我被困的地方，我不确定在那里写什么代码，到目前为止我试过：

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  with (Control as TListBox).Canvas do
  begin
    if odSelected in State then
    begin
      Brush.Color := $00FCDDC0;
      Pen.Color   := $00FF9933;
      FillRect(Rect);
    end;

    TextOut(Rect.Left, Rect.Top, TListBox(Control).Items[Index]);
  end;
end;

我应该知道这不起作用，我会得到各种各样的时髦事情：

我做错了什么，更重要的是我需要改变什么才能让它发挥作用？

感谢。

Answer 1

您忘了为不同的状态绘制项目。您需要确定该项目当前处于什么状态，并根据该项目进行绘制。

你可以通过这种方式获得你的照片。但是，如果您启用了多选并选择了多个项目，则效果不佳：

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Offset: Integer;
begin
  with (Control as TListBox) do
  begin
    Canvas.Font.Color := Font.Color;
    if (odSelected in State) then
    begin
      Canvas.Pen.Color := $00FF9932;
      Canvas.Brush.Color := $00FDDDC0;
    end
    else
    begin
      Canvas.Pen.Color := Color;
      Canvas.Brush.Color := Color;
    end;
    Canvas.Rectangle(Rect);
    Canvas.Brush.Style := bsClear;
    Offset := (Rect.Bottom - Rect.Top - Canvas.TextHeight(Items[Index])) div 2;
    Canvas.TextOut(Rect.Left + Offset + 2, Rect.Top + Offset, Items[Index]);
  end;
end;

ItemHeight设置为16的结果：

奖金 - 连续选择：

这是实现连续选择的棘手解决方案。原理是像之前一样绘制项目，然后根据上一个和下一个项目的选择状态，用颜色的线条过度绘制项目的边框顶部和底部线条。除此之外，必须在当前项目之外进行渲染，因为项目选择不会自然地调用要重新绘制的邻居项目。因此，水平线被绘制在当前项边界上方一个像素和一个像素之下（这些线的颜色也取决于相对选择状态）。

这里很奇怪的是使用item对象来存储每个项目的选定状态。我做到了，因为当使用拖拉机时删除项目选择，Selected属性在释放鼠标按钮之前不会返回实际状态。幸运的是，OnDrawItem事件当然会触发真实状态，因此作为一种解决方法，我使用了OnDrawItem事件中的这些状态存储。

<强> 重要的：

请注意，我正在使用项目对象来存储实际的选择状态，因此要小心，当您将项目对象用于其他内容时，请存储此实际状态，例如：到一个布尔数组。

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
const
  SelBackColor = $00FDDDC0;
  SelBorderColor = $00FF9932;
var
  Offset: Integer;
  ItemSelected: Boolean;
begin
  with (Control as TListBox) do
  begin
    Items.Objects[Index] := TObject((odSelected in State));    

    if (odSelected in State) then
    begin
      Canvas.Pen.Color := SelBorderColor;
      Canvas.Brush.Color := SelBackColor;
      Canvas.Rectangle(Rect);
    end
    else
    begin
      Canvas.Pen.Color := Color;
      Canvas.Brush.Color := Color;
      Canvas.Rectangle(Rect);   
    end;

    if MultiSelect then
    begin
      if (Index > 0) then
      begin
        ItemSelected := Boolean(ListBox1.Items.Objects[Index - 1]);
        if ItemSelected then
        begin
          if (odSelected in State) then
          begin
            Canvas.Pen.Color := SelBackColor;
            Canvas.MoveTo(Rect.Left + 1, Rect.Top);
            Canvas.LineTo(Rect.Right - 1, Rect.Top);
          end
          else
            Canvas.Pen.Color := SelBorderColor;
        end
        else
          Canvas.Pen.Color := Color;
        Canvas.MoveTo(Rect.Left + 1, Rect.Top - 1);
        Canvas.LineTo(Rect.Right - 1, Rect.Top - 1);
      end;

      if (Index < Items.Count - 1) then
      begin
        ItemSelected := Boolean(ListBox1.Items.Objects[Index + 1]);
        if ItemSelected then
        begin
          if (odSelected in State) then
          begin
            Canvas.Pen.Color := SelBackColor;
            Canvas.MoveTo(Rect.Left + 1, Rect.Bottom - 1);
            Canvas.LineTo(Rect.Right - 1, Rect.Bottom - 1);
          end
          else
            Canvas.Pen.Color := SelBorderColor;
        end
        else
          Canvas.Pen.Color := Color;
        Canvas.MoveTo(Rect.Left + 1, Rect.Bottom);
        Canvas.LineTo(Rect.Right - 1, Rect.Bottom);
      end;
    end;

    Offset := (Rect.Bottom - Rect.Top - Canvas.TextHeight(Items[Index])) div 2;
    Canvas.Brush.Style := bsClear;
    Canvas.Font.Color := Font.Color;
    Canvas.TextOut(Rect.Left + Offset + 2, Rect.Top + Offset, Items[Index]);
  end;
end;

结果：

Answer 2

您需要查看传递给函数的State变量的值。这会告诉您是否选择了该项目，然后您可以适当地设置画笔和笔。