请熟悉VB的高手帮忙翻译成Delphi代码 (再加300分! 要快些啊) (150分)

这段代码主要的功能是给一个Treeview增加背景图片，地址在
http://www.vbthunder.com/source/treeview/tvbkgnd.htm
本人Delphi马马虎虎，VB可一点也不熟。请帮忙把它变成可以运行的Delphi代码。多谢！

有这样的Delphi控件，可以添加背景图片的。

看过一些。其中以 Virtual Treeview最好。不过用了它以后要改无数的已有的代码，
所以想直接对Treeview操作。

改好了, 可是效果並不理想

TExTreeView = class(TTreeView)
private
FInterDrawing: boolean;
FBitMap: TBitMap;
procedure PaintWithBackground;
procedure WMPaint(var Message: TWMPaint);
message WM_PAINT;
procedure SetBitMap(const Value: TBitmap);
protected
procedure WndProc(var Message: TMessage);
override;
public
property Background: TBitmap read FBitMap write SetBitMap;
end;

{ TExTreeView }
procedure TExTreeView.PaintWithBackground;
var
ps: PAINTSTRUCT;
DC: HDC;
drawDC1, drawDC2: HDC;
drawBMP1, drawBMP2, oldBMP1, oldBMP2: HBitmap;
iWidth, iHeight, ibmpWidth, ibmpHeight, I, J, K, W: integer;
begin
FInterDrawing := True;
try
begin
Paint(Handle, Ps);
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 Kdo
for J := 0 to Wdo
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 TExTreeView.SetBitMap(const Value: TBitmap);
begin
if FBitMap <> Value then
begin
FBitMap := Value;
if HandleAllocated then
Invalidate;
end;
end;

procedure TExTreeView.WMPaint(var Message: TWMPaint);
begin
if (FBitMap = nil) or FInterDrawing then
inherited
else
PaintWithBackground;
end;

procedure TExTreeView.WndProc(var Message: TMessage);
begin
case Message.Msg of
WM_ERASEBKGND:
begin
Message.Result := 1;
Exit;
end;
WM_HSCROLL, WM_VSCROLL, WM_MOUSEWHEEL:
//Force a repaint to keep the bitmap tiles lined up
InvalidateRect(Handle, nil, False);
end;
inherited;
end;

不错，我稍改了一下，吧处理的消息增加了mousedown和up会更好些，
我也给分。

正点！多谢。

改一下，效果就好了，就是慢了不少。
WM_HSCROLL, WM_VSCROLL,WM_LBUTTONDOWN..WM_MOUSEWHEEL:

lorderic欠你300分，请来取分:
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1114653