关于LISTBOX的自绘<以及仿背景透明的实现>

 

今天又研究了一下列表框的自绘问题，对自绘又有了一些进一步的认识
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, jpeg,ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    ListBox1: TListBox;
    Button1: TButton;
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  x,y,w,h : LongInt;
  Bitmap1: TBitmap;
begin
  //listbox1的style属性应设置为 lbOwnerDrawVariable
  Bitmap1 := TBitmap.Create;
  Bitmap1.LoadFromFile('c:\11.bmp');
  W := bitmap1.Width;
  H := bitmap1.Height;
  Y := 0;
  while Y < listbox1.Height do begin
    X := 0;
    while X < listbox1.Width do begin
      listbox1.Canvas.Draw(X,Y,Bitmap1);  //绘背景图
      Inc(X,W);
    end;
    Inc(Y,H);
  end;
  listbox1.ItemHeight :=20;    //列表项高度
  listbox1.Canvas.textout(1,1,'啊');    //自绘文本
  listbox1.Canvas.textout(1,21,'吧');
  listbox1.Canvas.textout(1,41,'才');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  listbox1.Items.Add('啊');  //这里请注意 ，上面的自绘TEXTout仅仅是美观
  listbox1.Items.Add('吧');  //是给人看的，其实程序不认的，程序认的还是
  listbox1.Items.Add('才');  //这里的赋值
  sendmessage(listbox1.Handle ,WM_LBUTTONDOWN,0,10);  //模拟鼠标单击
  sendmessage(listbox1.Handle ,WM_LBUTTONup,0,10);    //否则自绘的文本是白色的

，很是难看
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(listbox1.Items[listbox1.itemindex]);
  listbox1.Refresh ;  //刷新列表框，否则它自己不会自绘
  sendmessage(listbox1.Handle ,WM_LBUTTONDOWN,0,10);  //模拟鼠标单击
  sendmessage(listbox1.Handle ,WM_LBUTTONup,0,10);    //否则自绘的文本是白色的

，很是难看
end;

end.
 
终于实现了所谓的控件背景透明（只是在LISTBOX上试验了，而且貌似还有BUG），理论来自

AIZB老师
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, jpeg,ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    ListBox1: TListBox;
    Button1: TButton;
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    bmp2: tbitmap;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  x,y,w,h : LongInt;
  Bitmap1: TBitmap;
begin
  //listbox1的style属性应设置为 lbOwnerDrawVariable
  W := bmp2.Width;
  H := bmp2.Height;
  Y := 0;
  while Y < listbox1.Height do begin
    X := 0;
    while X < listbox1.Width do begin
      listbox1.Canvas.Draw(X,Y,bmp2);  //绘背景图
      Inc(X,W);
    end;
    Inc(Y,H);
  end;
  listbox1.ItemHeight :=20;    //列表项高度
  listbox1.Canvas.textout(1,1,'啊');    //自绘文本
  listbox1.Canvas.textout(1,21,'吧');
  listbox1.Canvas.textout(1,41,'才');
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp2:= TBitmap.Create;
  bmp.Width :=image1.Picture.Width ;
  bmp.Height :=image1.Picture.Height ;
  //这里主要是把JPG转换成BMP，因为BITBLT函数不支持JPG格式
  bmp.Canvas.Draw(0,0,image1.Picture.Graphic);
  bmp2.Width :=listbox1.Width ;
  bmp2.Height :=listbox1.Height ;
  //这里用 listbox1.Left+2 ,listbox1.Top+2 来确定被LISTBOX遮盖部分的
  // X Y 坐标 2 是列表框的线条宽度，我也不知道怎末来的，反正是一个一个
  //的试验得出来的结果
  //这里IMAGE1是BMP格式，所以可以直接用IMAGE1.CANVAS.HANDLE 否则应该使用
  //bmp.canvas.handle
  bitblt(bmp2.Canvas.Handle,0,0,bmp2.Width ,bmp2.Height ,
         image1.Canvas.Handle,listbox1.Left+2 ,listbox1.Top+2 ,SRCCOPY);
  ////////////////////////////////////////////////////////////////////
  listbox1.Items.Add('啊');  //这里请注意 ，上面的自绘TEXTout仅仅是美观
  listbox1.Items.Add('吧');  //是给人看的，其实程序不认的，程序认的还是
  listbox1.Items.Add('才');  //这里的赋值
  sendmessage(listbox1.Handle ,WM_LBUTTONDOWN,0,10);  //模拟鼠标单击
  sendmessage(listbox1.Handle ,WM_LBUTTONup,0,10);    //否则自绘的文本是白色的

，很是难看
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(listbox1.Items[listbox1.itemindex]);
  listbox1.Refresh ;  //刷新列表框，否则它自己不会自绘
  sendmessage(listbox1.Handle ,WM_LBUTTONDOWN,0,10);  //模拟鼠标单击
  sendmessage(listbox1.Handle ,WM_LBUTTONup,0,10);    //否则自绘的文本是白色的

，很是难看
end;

end.