TListBox自画时，如何支持背景和让背景色渐变

Question

  最近需要做一个带背景的或者背景色可渐变的ListBox
直接设置ListBox.Brush.Bitmap为一个图片是可实现背景色，但是不知道如何控制
截获了他的WM_EraseBkGnd消息绘制渐变，但是只要我稍微动一下，绘制的东西就没了
重载DefaultHandler方法处理过之后，效果很不理想，请求有经验者。

Answer 1

不好处理吧!
VC可以直接WM_EraseBkGnd消息里处理
但是Delphi就不行了呵哦再等高手出现
顶一下

Answer 2

建议你直接开贴向etomahawk提问，他是一个很热心的人，而且图像处理水平和系统消息方面非常厉害。查看他的一些回贴就可以对此人了解一二，他比较低调，可用分8000多了。

Answer 3

{以下测试，也不是很理想，楼主试一下}
type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure HandleCTLColorEdit(var Msg: TWMCTLCOLOREDIT);message WM_CTLCOLOREDIT;
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.HandleCTLColorEdit(var Msg: TWMCTLCOLOREDIT);
begin
  if Msg.ChildWnd = Self.ListBox1.Handle then begin
    SetBkMode(Msg.ChildDC, TRANSPARENT);
    Msg.Result := Self.ListBox1.Brush.Handle;
  end;
end;procedure TForm1.Button1Click(Sender: TObject);
var
  BMP : TBitmap;
begin
  BMP := TBitmap.Create;
  BMP.LoadFromFile('c:\test.bmp');
  Self.ListBox1.Brush.Bitmap:=BMP;
  Self.ListBox1.Repaint;
  Bmp.Free;
end;

Answer 4

哎!不理想啊!
要背景渐变所以,我用了一个空的BMP
然后在Bmp上绘制渐变颜色,绘制之后
然后再执行
ListBox1.Brush.Bitmap:=BMP;
ListBox1.Repaint;
效果不好

Answer 5

{用错了。下面的OK了}type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure HandleCTLColorEdit(var Msg: TWMCtlColorListbox);message WM_CTLCOLORListbox;
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.HandleCTLColorEdit(var Msg: TWMCtlColorListbox);
begin
  if Msg.ChildWnd = Self.ListBox1.Handle then begin
    SetBkMode(Msg.ChildDC, TRANSPARENT);
    Msg.Result := Self.ListBox1.Brush.Handle;
  end;
end;procedure TForm1.Button1Click(Sender: TObject);
var
  BMP : TBitmap;
begin
  BMP := TBitmap.Create;
  BMP.LoadFromFile('c:\test.bmp');
  Self.ListBox1.Brush.Bitmap:=BMP;
  Self.ListBox1.Repaint;
  Bmp.Free;
end;

Answer 6

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls; type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure HandleCTLColorEdit(var Msg: TWMCtlColorListbox);message WM_CTLCOLORListbox;
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.HandleCTLColorEdit(var Msg: TWMCtlColorListbox);
begin
  if Msg.ChildWnd = Self.ListBox1.Handle then begin
    SetBkMode(Msg.ChildDC, TRANSPARENT);
    Msg.Result := Self.ListBox1.Brush.Handle;
  end;
end;procedure TForm1.Button1Click(Sender: TObject);
var
  BMP : TBitmap;
begin
  BMP := TBitmap.Create;
  BMP.LoadFromFile('c:\test.bmp');
  Self.ListBox1.Brush.Bitmap:=BMP;
  Self.ListBox1.Repaint;
  Bmp.Free;
end;
end.
底图没有什么变化呀？

Answer 7

你要么自己继承下listbox重新写一下，要么用子类化搞一下

Answer 8

这个...我想说真的很简单,将主要函数贴出来给你,自己画吧.如果图片看不到请到:
http://hi.baidu.com/sail2000/album/item/d9a460d91e7a383110df9b59.html
或者:
http://hi.baidu.com/sail2000/album/Xiaplayerprocedure DrawGradientHV(ACanvas: TCanvas; Rect: TRect;
  Horicontal: Boolean; Colors: array of TColor);
type
  RGBArray = array[0..2] of Byte;
var
  x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
  Faktor: double;
  A: RGBArray;
  B: array of RGBArray;
  merkw: integer;
  merks: TPenStyle;
  merkp: TColor;
begin
  mx := High(Colors);
  if mx > 0 then
  begin
    if Horicontal then
      mass := Rect.Right - Rect.Left
    else
      mass := Rect.Bottom - Rect.Top;
    SetLength(b, mx + 1);
    for x := 0 to mx do
    begin
      Colors[x] := ColorToRGB(Colors[x]);
      b[x][0] := GetRValue(Colors[x]);
      b[x][1] := GetGValue(Colors[x]);
      b[x][2] := GetBValue(Colors[x]);
    end;
    merkw := ACanvas.Pen.Width;
    merks := ACanvas.Pen.Style;
    merkp := ACanvas.Pen.Color;
    ACanvas.Pen.Width := 1;
    ACanvas.Pen.Style := psSolid;
    faColorsh := Round(mass / mx);
    for y := 0 to mx - 1 do
    begin
      if y = mx - 1 then
        bis := mass - y * faColorsh - 1
      else
        bis := faColorsh;
      for x := 0 to bis do
      begin
        Stelle := x + y * faColorsh;
        faktor := x / bis;
        for z := 0 to 3 do
          a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
        ACanvas.Pen.Color := RGB(a[0], a[1], a[2]);
        if Horicontal then
        begin
          ACanvas.MoveTo(Rect.Left + Stelle, Rect.Top);
          ACanvas.LineTo(Rect.Left + Stelle, Rect.Bottom);
        end
        else
        begin
          ACanvas.MoveTo(Rect.Left, Rect.Top + Stelle);
          ACanvas.LineTo(Rect.Right, Rect.Top + Stelle);
        end;
      end;
    end;
    b := nil;
    ACanvas.Pen.Width := merkw;
    ACanvas.Pen.Style := merks;
    ACanvas.Pen.Color := merkp;
  end
  else
    // Please specify at least two colors
    raise EMathError.Create('Please specify at least two colors.');
end;

Answer 9

///首先设置TListBox的Style为lbOwnerDrawFixed,然后在OnDrawItem事件中写入处理代码
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,Math;type
  TForm1 = class(TForm)
    Image1: TImage;
    PaintBox1: TPaintBox;
    ListBox1: TListBox;
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure FillGradient(DC: HDC; ARect: TRect;
  StartColor, EndColor: TColor);
var
  StartRGB, EndRGB: array[0..2] of Byte;
  RGBKoef: array[0..2] of Double;
  Brush: HBRUSH;
  ColorCount: Integer;
  AreaWidth, AreaHeight, I: Integer;
  ColorRect: TRect;
  RectOffset: Double;
  IntR, IntG, IntB: Integer;
begin
  StartColor := ColorToRGB(StartColor);
  EndColor := ColorToRGB(EndColor);
  StartRGB[0] := GetRValue(StartColor);
  StartRGB[1] := GetGValue(StartColor);
  StartRGB[2] := GetBValue(StartColor);
  EndRGB[0] := GetRValue(EndColor);
  EndRGB[1] := GetGValue(EndColor);
  EndRGB[2] := GetBValue(EndColor);
  IntR := (EndRGB[0] - StartRGB[0]);
  IntG := (EndRGB[1] - StartRGB[1]);
  IntB := (EndRGB[2] - StartRGB[2]);
  ColorCount := Max(Abs(IntR), max(abs(IntG), abs(IntB)));
  RGBKoef[0] := IntR / ColorCount;
  RGBKoef[1] := IntG / ColorCount;
  RGBKoef[2] := IntB / ColorCount;
  AreaWidth := ARect.Right - ARect.Left;
  AreaHeight := ARect.Bottom - ARect.Top;
  RectOffset := AreaHeight / ColorCount;
  for I := 0 to ColorCount - 1 do
  begin
    Brush := CreateSolidBrush(RGB(
      StartRGB[0] + Round((I + 1) * RGBKoef[0]),
      StartRGB[1] + Round((I + 1) * RGBKoef[1]),
      StartRGB[2] + Round((I + 1) * RGBKoef[2])));
    SetRect(ColorRect, 0, Round(RectOffset * I), AreaWidth, Round(RectOffset * (I + 1)));
    OffsetRect(ColorRect, ARect.Left, ARect.Top);
    FillRect(DC, ColorRect, Brush);
    DeleteObject(Brush);
  end;
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
  var
  _Canvas:TCanvas;
begin
  _Canvas:=TListBox(Control).Canvas;
  FillGradient(_Canvas.Handle,Rect,clWhite,clBlue);
  _Canvas.Brush.Style:=bsClear;
  _Canvas.TextOut(Rect.Left,Rect.Top,TListBox(Control).Items[index]);
end;end.

Answer 10

回完以后才想道,你要的是这个ListBox的背景,哈哈

Answer 11

是否可以这样考虑：
每一条记录都用ideation_shang 的方式来画，但是每一条的背景都不一样，是连续的，这样看起来就是一个完整的ListBox的背景了。
如何？

Answer 12

感谢兄弟的提醒,先用,改进了一下,先用不得闲设置ListBox.Brush.Bitmap的方法,然后拷贝背景,再将文字画上去就可以了.///首先设置TListBox的Style为lbOwnerDrawFixed,然后在OnDrawItem事件中写入处理代码
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Math;type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementationuses Types;{$R *.dfm}procedure FillGradient(DC: HDC; ARect: TRect;
  StartColor, EndColor: TColor);
var
  StartRGB, EndRGB: array[0..2] of Byte;
  RGBKoef: array[0..2] of Double;
  Brush: HBRUSH;
  ColorCount: Integer;
  AreaWidth, AreaHeight, I: Integer;
  ColorRect: TRect;
  RectOffset: Double;
  IntR, IntG, IntB: Integer;
begin
  StartColor := ColorToRGB(StartColor);
  EndColor := ColorToRGB(EndColor);
  StartRGB[0] := GetRValue(StartColor);
  StartRGB[1] := GetGValue(StartColor);
  StartRGB[2] := GetBValue(StartColor);
  EndRGB[0] := GetRValue(EndColor);
  EndRGB[1] := GetGValue(EndColor);
  EndRGB[2] := GetBValue(EndColor);
  IntR := (EndRGB[0] - StartRGB[0]);
  IntG := (EndRGB[1] - StartRGB[1]);
  IntB := (EndRGB[2] - StartRGB[2]);
  ColorCount := Max(Abs(IntR), max(abs(IntG), abs(IntB)));
  RGBKoef[0] := IntR / ColorCount;
  RGBKoef[1] := IntG / ColorCount;
  RGBKoef[2] := IntB / ColorCount;
  AreaWidth := ARect.Right - ARect.Left;
  AreaHeight := ARect.Bottom - ARect.Top;
  RectOffset := AreaHeight / ColorCount;
  for I := 0 to ColorCount - 1 do
  begin
    Brush := CreateSolidBrush(RGB(
      StartRGB[0] + Round((I + 1) * RGBKoef[0]),
      StartRGB[1] + Round((I + 1) * RGBKoef[1]),
      StartRGB[2] + Round((I + 1) * RGBKoef[2])));
    SetRect(ColorRect, 0, Round(RectOffset * I), AreaWidth, Round(RectOffset * (I + 1)));
    OffsetRect(ColorRect, ARect.Left, ARect.Top);
    FillRect(DC, ColorRect, Brush);
    DeleteObject(Brush);
  end;
end;procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  _Canvas: TCanvas;
  _Bmp: TBitmap;
  _BrushStyle: TBrushStyle;
begin
  _Canvas := TListBox(Control).Canvas;
  _Canvas.FillRect(Rect);
  _Bmp:=TBitmap.Create;
  _Bmp.Width:=Rect.Right-Rect.Left;
  _Bmp.Height:=Rect.Bottom-Rect.Top;
  _Bmp.Canvas.CopyRect(_Bmp.Canvas.ClipRect,_Canvas,Rect);
  _Bmp.Canvas.Brush.Style := bsClear;
  if odSelected in State then
    _Bmp.Canvas.Font.Color:=clHighlightText
  else
    _Bmp.Canvas.Font.Color:=clBlack;
  _Bmp.Canvas.TextOut(2, 2, TListBox(Control).Items[index]);
  _Canvas.Draw(Rect.Left,Rect.Top,_Bmp);
  _Bmp.Free;
end;procedure TForm1.FormCreate(Sender: TObject);
var
  gBitMap: TBitmap;
begin
  gBitMap:=TBitmap.Create;
  gBitMap.Width:=ListBox1.Width;
  gBitMap.Height:=ListBox1.Height;
  FillGradient(gBitMap.Canvas.Handle,gBitMap.Canvas.ClipRect,clWhite,clBlue);
  ListBox1.Brush.Bitmap:=gBitMap;
end;end.

Answer 13

不曾想到，有那么多人会贴了呢！
这两天一直在做TreeView，这个暂时没管！等我做完TreeView之后，再来思考一下
顺便揭贴

Answer 14

说明一点，要的不是你那个效果，是整个背景，而非某一个项目的背景
其次，在ListBox的每个项目的绘制中，我也要处理一些别的事情，比如自己绘制焦点边框
自己绘制获得焦点的底色，或者底色透明等一系列的处理。
其实整体是已经绘制出现，只是不理想。或许
ideation_shang 的方法可行！不过效率低下