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

Question

使用Office XP样式显示聚焦/选定列表框项目的最简单,最干净的方法是什么？

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

我想我需要将Listbox Style设置为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;

结果如下: