rtreeview.~pas

tabenter delphi组件包（用ENTER键代替TAB键)

unit RTreeview;

interface 

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

type 
 rlTreeView = 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('Samples', [rlTreeView]); 
end; 

procedure rlTreeView.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 rlTreeView.SetBitMap(const Value: TBitmap); 
begin 
 if FBitMap <> Value then
 begin 
   FBitMap := Value; 
   if HandleAllocated then Invalidate; 
 end; 
end; 

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

procedure rlTreeView.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.