求助,怎么在treeview中加入背景图,有控件也行,拜托了 ( 积分: 78 )

  • 主题发起人 主题发起人 songjy
  • 开始时间 开始时间
delphi 的demo内有一个customdraw的例子,你可以参考一下!
 
可是那个例子子运行起来也有问题啊
 
这种问题都被人别人题了n遍了!我虽然不会但刚在网上帮你搜了个例子,我运行了下,还行!自己看看:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls;

type
TForm1 = class(TForm)
TreeView1: TTreeView;
procedure TreeView1CustomDraw(Sender: TCustomTreeView;
const ARect: TRect; var DefaultDraw: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.TreeView1CustomDraw(Sender: TCustomTreeView;
const ARect: TRect; var DefaultDraw: Boolean);
var
x,y,w,h : LongInt;
Bitmap1: TBitmap;
begin
Bitmap1 := TBitmap.Create;
Bitmap1.LoadFromFile('E:/DSCF1799.bmp');
with Bitmap1 do begin
W := Width;
H := Height;
end;
Y := 0;
while Y < Height do begin
X := 0;
while X < Width do begin
treeView1.Canvas.Draw(X,Y,Bitmap1);
Inc(X,W);
end;
Inc(Y,H);
end;
end;
end.
 
这个算是勉强可以,但是一拉就不行了
 
unit uUFTreeView;

interface

uses
// 太多无用的,不想繁啦,都加上吧!
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls, CommCtrl;

type
TUFTreeView = class(TTreeView)
private
FBitMap: TBitMap;
FInterDrawing: boolean;
procedure PaintBei;
procedure SetBitMap(const Value: TBitmap);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
// 消息响应,可根据自己的情况进行增加!
// 增加的越多,系统资源占用越多!
// 增加数据时,最好使用BeginUpdate.......EndUpdate
procedure WndProc(var Message: TMessage); override;
public
property Background: TBitmap read FBitMap write SetBitMap;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('UFGOVSY', [TUFTreeView]);
end;

procedure TUFTreeView.PaintBei;
var
ps: PAINTSTRUCT;
DC, drawDC1, drawDC2: HDC;
drawBMP1, drawBMP2, oldBMP1, oldBMP2: HBitmap;
iWidth, iHeight, ibmpWidth, ibmpHeight, I, J, K, W: integer;
begin
// 避免
FInterDrawing := True;
// 加个try!
try
BeginPaint(Handle, Ps);
// 再加一个try,嘿嘿!
try
DC := Ps.hdc;
iWidth := ClientWidth;
iHeight := ClientHeight;
drawDC1 := CreateCompatibleDC(DC);
drawBMP1 := CreateCompatibleBitmap(DC, iWidth, iHeight);
oldBMP1 := SelectObject(drawDC1, drawBMP1);
SendMessage(Handle, WM_PAINT, drawDC1, 0);
drawDC2 := CreateCompatibleDC(DC);
drawBMP2 := CreateCompatibleBitmap(DC, iWidth, iHeight);
oldBMP2 := SelectObject(drawDC2, drawBMP2);
iBmpWidth := Background.Width;
iBmpHeight := Background.Height;
K := ClientWidth div iBmpWidth;
W := ClientHeight div iBmpHeight;
for I := 0 to K do
for J := 0 to W do
BitBlt(drawDC2, I * iBmpWidth, J * iBmpHeight, iBmpWidth, iBmpHeight, Background.Canvas.Handle, 0, 0, SRCCOPY);
TransparentBlt(drawDC2, 0, 0, iWidth, iHeight, drawDC1, 0, 0, iWidth, iHeight, ColorToRGB(clWindow));
BitBlt(DC, 0, 0, iWidth, iHeight, drawDC2, 0, 0, SRCCOPY);
SelectObject(drawDC1, oldBMP1);
DeleteObject(drawDC1);
DeleteObject(drawBMP1);
SelectObject(drawDC2, oldBMP2);
DeleteObject(drawDC2);
DeleteObject(drawBMP2);
finally
EndPaint(Handle, Ps);
end;
finally
FInterDrawing := False;
end;
end;

procedure TUFTreeView.SetBitMap(const Value: TBitmap);
begin
if FBitMap <> Value then
begin
FBitMap := Value;
if HandleAllocated then Invalidate;
end;
end;

procedure TUFTreeView.WMPaint(var Message: TWMPaint);
begin
// 条件
if (FBitMap = nil) or FInterDrawing then
inherited
else
PaintBei;
end;

procedure TUFTreeView.WndProc(var Message: TMessage);
var
pDS :PDrawItemStruct;
phd :PHDNotify;
begin
case Message.Msg of
WM_ERASEBKGND:
begin
Message.Result := 1;
Exit;
end;
WM_HSCROLL,
WM_VSCROLL,
WM_MOUSEWHEEL,
WM_LBUTTONDOWN,
WM_LBUTTONDBLCLK,
WM_MBUTTONDOWN,
WM_MBUTTONDBLCLK,
WM_KEYUP:
InvalidateRect(Handle, nil, False);
end;
inherited;
end;

end.
 
谢谢大家!!!!!!!!!!1
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
后退
顶部