ListView

 ListView基本用法大全

//增長項或列(字段)
ListView1.Clear;
ListView1.Columns.Clear;
ListView1.Columns.Add;
ListView1.Columns.Add;
ListView1.Columns.Add;
ListView1.Columns.Items[0].Caption:='id';
ListView1.Columns.Items[1].Caption:='type';
ListView1.Columns.Items[2].Caption:='title';
ListView1.Columns.Items[2].Width:=300;
Listview1.ViewStyle:=vsreport;
Listview1.GridLines:=true;               //注:此處代碼也能夠直接在可視化編輯器中完成,
也可寫成如下這樣
begin
with listview1 do
begin
Columns.Add;
Columns.Add;
Columns.Add;
ViewStyle:=vsreport;
GridLines:=true;
columns.items[0].caption:='進程名';
columns.items[1].caption:='進程ID';
columns.items[2].caption:='進程文件路徑';
Columns.Items[0].Width:=100;
Columns.Items[1].Width:=100;
Columns.Items[2].Width:=150;
end
end;
//增長記錄
with listview1.items.add do 
begin 
caption:='1212'; 
subitems.add('hh1'); 
subitems.add('hh2'); 
end;
//刪除 
listview1.items.delete(0);
//從數據庫表裏讀取數據寫入Listview
var
Titem:Tlistitem;       //此處必定要預約義臨時記錄存儲變量.
begin
ListView1.Items.Clear;
with adoquery1 do
begin
close;
sql.Clear;
sql.Add('select spmc,jg,sl from kcxs');
Open;
ListView1.Items.Clear;
while not eof do
begin
Titem:=ListView1.Items.add;
Titem.Caption:=FieldByName('spmc').Value;
Titem.SubItems.Add(FieldByName('sl').Value);
Titem.SubItems.Add(FieldByName('jg').Value);
next;
end;
//刪除 
ListView1.DeleteSelected;
//如何取得ListView中選中行的某一列的值
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage(ListView1.Selected.SubItems.Strings[1]); //返回選中行第三列中的值
end;
showMessage(listView1.Selected.Caption);   //返回選中行第一列的值.
第1列的值： -->>> ListView1.Selected.Caption   
第i列的值(i>1):-->>> ListView1.Selected.SubItems.Strings[i]
ListView1.Items.Item[1].SubItems.GetText); //取得listview某行某列的值
Edit2.Text := listview1.Items[i].SubItems.strings[0];   //讀第i行第2列
返回選中行全部子列值.是以回車符分開的，你還要從中剝離出來你要的子列的值。
showMessage(ListView1.Selected.SubItems.GetText);  
ListView 簡單排序的實現
ListView 排序

怎樣實現單擊一下按升序,再單擊一下按降序。
function CustomSortProc(Item1, Item2: TListItem; ColumnIndex: integer): integer; stdcall;
begin
if ColumnIndex = 0 then
Result := CompareText(Item1.Caption,Item2.Caption)
else
Result := CompareText(Item1.SubItems[ColumnIndex-1],Item2.SubItems[ColumnIndex-1])
end;
procedure TFrmSrvrMain.ListView1ColumnClick(Sender: TObject;
Column: TListColumn);
begin
ListView1.CustomSort(@CustomSortProc,Column.Index);
end;

===============================================================
//增長 
i := ListView1.Items.Count; 
with ListView1 do 
begin 
ListItem:=Items.Add; 
ListItem.Caption:= IntToStr(i); 
ListItem.SubItems.Add('第 '+IntToStr(i)+' 行'); 
ListItem.SubItems.Add('第三列內容'); 
end;
//按標題刪除 
for i:=ListView1.Items.Count-1 downto 0 Do 
if ListView1.Items[i].Caption = Edit1.Text then 
begin 
ListView1.Items.Item[i].Delete(); //刪除當前選中行 
end;
//選中一行 
if ListView1.Selected <> nil then 
Edit1.Text := ListView1.Selected.Caption;

// listview1.Items[Listview1.Items.Count -1].Selected := True; 
// listview1.Items[Listview1.Items.Count -1].MakeVisible(True); 
procedure TForm1.Button2Click(Sender: TObject); // 選擇第一條 
begin 
listview1.SetFocus; 
listview1.Items[0].Selected := True; 
end;
procedure TForm1.Button1Click(Sender: TObject); // 選擇最後一條 
begin 
listview1.SetFocus; 
listview1.Items[Listview1.Items.Count -1].Selected := True; 
end;
//這是個通用的過程 
procedure ListViewItemMoveUpDown(lv : TListView; Item : TListItem; MoveUp, SetFocus : Boolean); 
var 
DestItem : TListItem; 
begin 
if (Item = nil) or 
((Item.Index - 1 < 0) and MoveUp) or 
((Item.Index + 1 >= lv.Items.Count) and (not MoveUp)) 
then Exit; 
lv.Items.BeginUpdate; 
try 
if MoveUp then 
DestItem := lv.Items.Insert(Item.Index - 1) 
else 
DestItem := lv.Items.Insert(Item.Index + 2); 
DestItem.Assign(Item); 
lv.Selected := DestItem; 
Item.Free; 
finally 
lv.Items.EndUpdate; 
end; 
if SetFocus then lv.SetFocus; 
DestItem.MakeVisible(False); 
end;
//此爲調用過程，能夠任意指定要移動的Item，下面是當前(Selected)Item 
ListViewItemMoveUpDown(ListView1, ListView1.Selected, True, True);//上移 
ListViewItemMoveUpDown(ListView1, ListView1.Selected, False, True);//下移

TListView組件使用方法
引用CommCtrl單元
procedure TForm1.Button1Click(Sender: TObject); 
begin 
ListView_DeleteColumn(MyListView.Handle, i);//i是要刪除的列的序號，從0開始
end;
用LISTVIEW顯示錶中的信息： 
procedure viewchange(listv:tlistview;table:tcustomadodataset;var i:integer); 
begin 
tlistview(listv).Items.BeginUpdate; {listv:listview名} 
try 
tlistview(listv).Items.Clear; 
with table do {table or query名} 
begin 
active:=true; 
first; 
while not eof do 
begin 
listitem:=tlistview(listv).Items.add; 
listitem.Caption:=trim(table.fields[i].asstring); 
// listitem.ImageIndex:=8; 
next; 
end; 
end; 
finally 
tlistview(listv).Items.EndUpdate; 
end; 
end;
 
ListView使用中的一些要點。如下以一個兩列的ListView爲例。 
→增長一行： 
with ListView1 do 
begin 
ListItem:=Items.Add; 
ListItem.Caption:='第一列內容'; 
ListItem.SubItems.Add('第二列內容'); 
end; 
→清空ListView1： 
ListView1.Items.Clear; 
→獲得當前被選中行的行的行號以及刪除當前行： 
For i:=0 to ListView1.Items.Count-1 Do 
If ListView1.Items[i].Selected then //i=ListView1.Selected.index 
begin 
ListView1.Items.Delete(i); //刪除當前選中行 
end; 
固然，ListView有OnSelectItem事件,能夠判斷選擇了哪行,用個全局變量把它賦值出來。 
→讀某行某列的操做： 
Edit1.Text := listview1.Items[i].Caption; //讀第i行第1列 
Edit2.Text := listview1.Items[i].SubItems.strings[0]; //讀第i行第2列 
Edit3.Text := listview1.Items[i].SubItems.strings[1]; //讀第i行第3列 
以次類推，能夠用循環讀出整列。 
→將焦點上移一行： 
For i:=0 to ListView1.Items.Count-1 Do 
If (ListView1.Items[i].Selected) and (i>0) then 
begin 
ListView1.SetFocus; 
ListView1.Items.Item[i-1].Selected := True; 
end; 
不過在Delphi6中，ListView多了一個ItemIndex屬性，因此只要 
ListView1.SetFocus; 
ListView1.ItemIndex:=3; 
就能設定焦點了。

Delphi的listview能實現交替顏色麼？ 
procedure TForm1.ListView1CustomDrawItem( 
Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; 
var DefaultDraw: Boolean); 
var 
i: integer; 
begin 
i:= (Sender as TListView).Items.IndexOf(Item); 
if odd(i) then sender.Canvas.Brush.Color:= $02E0F0D7 
else sender.Canvas.Brush.Color:= $02F0EED7; 
Sender.Canvas.FillRect(Item.DisplayRect(drIcon)); 
end;
 

要想隨時更改ListView 中某一行的字體顏色，要在ListView的 OnCustomDrawItem 的事件中書寫相關的代碼。例如 我想更改選中的某行字體的顏色，則須要在事件中寫入下的代碼：
if item.Index = strtoint(edit1.Text) then //該條件是用於判斷是否符合更改字體顏色的行的條件。
   Sender.Canvas.Font.Color := clred;

View Code

//增長記錄
with listview1.items.add do 
begin 
caption:='1212'; 
subitems.add('hh1'); 
subitems.add('hh2'); 
end;


listview1.items.delete(0);

//從數據庫表裏讀取數據寫入Listview

var
Titem:Tlistitem;       //此處必定要預約義臨時記錄存儲變量.
begin
ListView1.Items.Clear;
with adoquery1 do
begin
close;
sql.Clear;
sql.Add('select spmc,jg,sl from kcxs');
Open;
ListView1.Items.Clear;
while not eof do
begin
Titem:=ListView1.Items.add;
Titem.Caption:=FieldByName('spmc').Value;
Titem.SubItems.Add(FieldByName('sl').Value);
Titem.SubItems.Add(FieldByName('jg').Value);
next;
end;


//刪除 
ListView1.DeleteSelected;

View Code

 

ListView列寬自適應

  使用TListView列表顯示內容，若是列內容過長，就會顯示成‘XXX…’形式，此時若是雙擊列標題，列寬將變爲自適應。用代碼設置以下：

一、設置ListView.Column[0].Width := -1;//列寬根據列內容自適應，此時保證列內容均可見。

二、設置ListView.Column[0].Width := -2;//列寬根據列標題自適應，此時保證列標題可見。

 

改變Listview標題欄顏色

var
  F_FARPROC: FARPROC;
  F_Color: TColor;
procedure SetListHeadColor(hListView: HWND; Color: TColor);
  function NewHeadProc(hwnd: HWND; uMsg: UINT;
    wParam: WPARAM; lParam: LPARAM): Longint; stdcall;
  var
    Rect: TRect;
    Canvas: TCanvas;
    Bmp: TBitmap;
  begin
    Result := Windows.CallWindowProc(F_FARPROC, hwnd, uMsg, wParam, lParam);
    if uMsg = WM_PAINT then
    begin
      Windows.GetClientRect(hwnd, Rect);
      Rect.Top := Rect.Top - 2;
      Rect.Left := Rect.Left - 2;
      Rect.Right := Rect.Right + 2;
      Canvas := TCanvas.Create;
      try
        Canvas.Handle := GetDC(hwnd);
        Bmp := TBitmap.Create;
        try
          Bmp.Width := Rect.Right;
          Bmp.Height := Rect.Bottom;
          Bmp.Canvas.CopyRect(Rect, Canvas, Rect);
          Bmp.Transparent := true;
          Bmp.TransparentColor := clBtnFace;
          Canvas.Brush.Color := F_Color;
          Canvas.Rectangle(Rect);
          Canvas.Draw(0, 0, Bmp);
        finally
          Bmp.Free;
        end;
      finally
        ReleaseDC(hwnd, Canvas.Handle);
        Canvas.Free;
      end;
    end;
  end;
var
  FHeaderHandle: HWND;
begin
  FHeaderHandle := FindWindowEx(hListView, 0, 'SysHeader32', nil);
  F_FARPROC := FARPROC(SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(@NewHeadProc)));
  InvalidateRect(FHeaderHandle, nil, FALSE);
  F_Color := Color;
end;

View Code

繪製TListView背景

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListView1: TListView;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure DrawParentBackground(Control: TControl; DC: HDC; R: PRect = nil;
  bDrawErasebkgnd: Boolean = False);
var
  SaveIndex: Integer;
  MemDC: HDC;
  MemBmp: HBITMAP;
begin
  if R <> nil then
  begin
    MemDC := CreateCompatibleDC(DC);
    MemBmp := CreateCompatibleBitmap(DC, Control.Width, Control.Height);
    SelectObject(MemDC, MemBmp);
    try
      with Control.BoundsRect.TopLeft do
        SetWindowOrgEx(MemDC, X, Y, nil);
      if bDrawErasebkgnd then
        Control.Parent.Perform(WM_ERASEBKGND, Integer(MemDC), Integer(MemDC));
      Control.Parent.Perform(WM_PAINT, Integer(MemDC), Integer(MemDC));
      with Control.BoundsRect.TopLeft do
        BitBlt(DC, R^.Left, R^.Top, R^.Right - R^.Left, R^.Bottom - R^.Top,
          MemDC, X + R^.Left, Y + R^.Top, SRCCOPY);
    finally
      DeleteObject(MemBmp);
      DeleteDC(MemDC);
    end;
    Exit;
  end;
  SaveIndex := SaveDC(DC);
  try
    with Control.BoundsRect.TopLeft do
      SetWindowOrgEx(DC, X, Y, nil);
    if bDrawErasebkgnd then
      Control.Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));
    Control.Parent.Perform(WM_PAINT, Integer(DC), Integer(DC));
  finally
    RestoreDC(DC, SaveIndex);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
DC: HDC;
begin
DrawParentBackground(listview1,DC);
end;

end.

View Code

如何在同一個listview中拖動item以調整原來的順序

procedure TForm1.FormCreate(Sender: TObject);
const
  Names: array[0..5, 0..1] of string = (
    ('Rubble', 'Barney'),
    ('Michael', 'Johnson'),
    ('Bunny', 'Bugs'),
    ('Silver', 'HiHo'),
    ('Simpson', 'Bart'),
    ('Squirrel', 'Rocky')
    );

var
  I: Integer;
  NewColumn: TListColumn;
  ListItem: TListItem;
begin
  with ListView do
  begin
    Align := alClient;
    RowSelect := True;
    ViewStyle := vsReport;
    DragMode := dmAutomatic;

    NewColumn := Columns.Add;
    NewColumn.Caption := 'Last';
    NewColumn := Columns.Add;
    NewColumn.Caption := 'First';

    for I := Low(Names) to High(Names) do
    begin
      ListItem := Items.Add;
      ListItem.Caption := Names[I][0];
      ListItem.SubItems.Add(Names[I][1]);
    end;
  end;
end;

procedure TForm1.ListViewDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  TargetItem, SourceItem: TListItem;
begin
  TargetItem := ListView.GetItemAt(X, Y);
  if (Source = Sender) and (TargetItem <> nil) then
  begin
    Accept := True;

    SourceItem := ListView.Selected;
    if SourceItem = TargetItem then
      Accept := False;
  end
  else
    Accept := False;
end;


procedure TForm1.ListViewDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  TargetItem, SourceItem, TempItem: TListItem;
begin
  TargetItem := ListView.GetItemAt(X, Y);
  if TargetItem <> nil then
  begin
    TempItem := TListItem.Create(ListView.Items);

    SourceItem := ListView.Selected;
    TempItem.Assign(SourceItem);
    SourceItem.Assign(TargetItem);
    TargetItem.Assign(TempItem);
    TargetItem.Selected := True;

    FreeAndNil(TempItem);
  end;
end;

View Code

爲了釋放TreeView中每一個節點的Data佔用的內存

爲了釋放TreeView中每一個節點的Data佔用的內存，需遍歷整個TreeView，因而上網搜索一番，參考各位高手的代碼，編寫以下：
tv: TTreeView;
procedure OverTreeView(node: TTreenode);
......
procedure Form1.FormDestroy(Sender: TObject);
var
  node: TTreenode;
begin
  if tv <> nil then  
  begin
    node := tv.Items.GetFirstNode;
    if (node <> nil) then
    begin
      if (node.Data <> nil) then Dispose(node.Data);
      OverTreeView(node);
    end;
  end;
end;
 
......
 
procedure Form1.OverTreeView(node: TTreenode);
//釋放data佔用的內存
begin
  while node <> nil do
  begin
    if node.HasChildren then
    begin
      node := node.getFirstChild;
      if node.Data <> nil then Dispose(node.Data);
      Overtreeview(node);
      node := node.Parent;
    end;
    if node.getNextSibling <> nil then
    begin
      node := node.getNextSibling;
      if node.Data <> nil then Dispose(node.Data);
    end else exit;
  end;
end;

View Code

將listview顯示的縮圖加入到listview2

下面的function能夠將listview的縮圖加到listview2可是全都顯示listview1第一張的圖片，可是檔名是確定的，只是顯示的圖片都是第一張。

function MoveLvItem(lvOrig,lvdest:TlistView;checked:boolean=false):string;

var i,j:integer;

    itemlist:TObjectlist;

    listitem,newlistitem:TListItem;

begin

  ItemList:=TObjectList.Create(false);

  if not checked then

  begin

    for i:=lvOrig.Selected.Index to lvOrig.Items.Count -1 do

    begin

    if lvorig.Items[i].Selected then ItemList.Add(lvorig.Items[i]);

    end;

  end

  else

  begin

      for i:=0 to lvorig.Items.Count -1 do

      begin

      if lvorig.Items[i].Checked then itemlist.Add(lvorig.Items[i]);

      end;

  end;

    for i:=0 to itemlist.Count -1 do

    begin

      listitem:=itemList[i] as TlistItem;

      newlistitem:= lvdest.Items.Add;

      newlistitem.Caption:=listitem.Caption;

    for j:= 0 to listitem.SubItems.Count -1 do

    begin

      newlistitem.SubItems.Add(listitem.SubItems[j]);

    end;

    end;

    result:=(itemList[0] as TListItem).Caption;

    (ItemList[0] as TlistItem).Delete;

    for i:= 1 to ItemList.Count -1 do

    begin

       result:=Result +','+(Itemlist[-1] as TListItem).Caption;

      (ItemList[1] as TListItem).Delete;

    end;

      ItemList.Free;

    end;

View Code

listview-to-listview2

function MoveLvItem(lvOrig,lvdest:TlistView;checked:boolean=false):string;
var i,j:integer;
    itemlist:TObjectlist;
    listitem,newlistitem:TListItem;
begin
  ItemList:=TObjectList.Create(false);
  if not checked then
  begin
    for i:=lvOrig.Selected.Index to lvOrig.Items.Count -1 do
    begin
    if lvorig.Items[i].Selected then ItemList.Add(lvorig.Items[i]);
    end;
  end
  else
  begin
      for i:=0 to lvorig.Items.Count -1 do
      begin
      if lvorig.Items[i].Checked then itemlist.Add(lvorig.Items[i]);
      end;
  end;
    for i:=0 to itemlist.Count -1 do
    begin
      listitem:=itemList[i] as TlistItem;
      newlistitem:= lvdest.Items.Add;
      newlistitem.Caption:=listitem.Caption;
    for j:= 0 to listitem.SubItems.Count -1 do
    begin
      newlistitem.SubItems.Add(listitem.SubItems[j]);
    end;
    end;
    result:=(itemList[0] as TListItem).Caption;
    (ItemList[0] as TlistItem).Delete;
    for i:= 1 to ItemList.Count -1 do
    begin
       result:=Result +','+(Itemlist[-1] as TListItem).Caption;
      (ItemList[1] as TListItem).Delete;
    end;
      ItemList.Free;
    end;

View Code

 

自繪LISTVIEW的滾動條

因項目須要準備對LISTVIEW的滾動條進行自繪。因而在網上搜了一下，問題沒解決，卻搜出一篇使人不愉快的帖子 。確實，那時候實力是不夠的，但如今應該是沒問題了，爲這個目的纔不斷磨練本身的。

LISTVIEW控件的滾動條是系統自帶的，它不建立窗口。對LISTVIEW窗口自己進行子類化後，要處理一些跟滾動條有關的消息。

首先是要騙過WM_NCPAINT消息。這個十分容易。WM_NCPAINT消息的wParam是一個區域的句柄。當它不爲1時，從它裏面CLIP 掉滾動條的區域，再傳給原窗口過程便可。當它爲1時，建立一個包含控件全客戶區域的Region，再從中CLIP掉滾動條的區域，傳給原窗口過程。

而後是WM_HSCROLL和WM_VSCROLL消息。在調用原窗口過程以前須要去掉窗口的WS_HSCROLL和WS_VSCROLL樣式，否 則窗口過程就會在消息中繪製滾動條。調用後須要恢復。同時爲避免窗口在WM_STYLECHANGING和WM_STYLECHANGED消息中重繪，也 須要截獲這兩個消息。

WM_NCCALCSIZE消息也是必須截獲的。若是是在處理WM_HSCROLL和WM_VSCROLL消息的過程當中響應WM_NCCALCSIZE，則必須去掉WS_HSCROLL和WS_VSCROLL樣式。

而後是WM_ERASEBACKGROUND,WM_MOUSEWHELL消息。在這消息後須要重繪滾動條。

最重要的莫過於WM_NCHITTEST消息了。由於是自繪，因此滾動條的按下和拖動都必須在這裏處理。

在本身寫的滾動條Track函數中，最頭疼的莫過於ThumbTrack了。當你計算好滾動到的絕對位置後，用SendMessage(hWnd, WM_XSCROLL, MAKEWPARAM(SB_THUMBTRACK, Pos), 0)發給窗口時，它竟然沒有反應。這是由於窗口過程不會從消息中取得TrackPos，而是會調用GetScrollInfo的API取得 TrackPos（由於前者只有16位）。可是使用SetScrollInfo是沒辦法設置TrackPos的。雖然你能夠用SIF_POS標誌讓它同時 設置Pos和TrackPos，但當Pos等於TrackPos時，窗口過程不會作任何響應。從windows源代碼中咱們能夠了解到，TrackPos 並不會爲每一個窗口保存一份，實際上，在任一時刻最多隻有一個滾動條在作ThumbTrack的操做，所以系統只須要用一個全局變量來保存就能夠了。

解決這個問題的辦法是HookAPI。在GetScrollInfo中返回咱們本身的TrackPos。要注意的是要Hook的不是本模塊的 API，而是ComCtl32.dll中的GetScrollInfo。所以簡單的如往@GetScrollInfo地址寫幾句跳轉的方法是行不通的。必 須遍歷ComCtl32.dll的pe頭。這種技術在不少文章中都有描述。

很少說了，如下是Delphi代碼，要點在前面已有描述，源碼中沒有作特殊說明。

使用說明：

資源中是一張橫條的192*16的位圖，從左到右依次是：左箭頭、右箭頭、上箭頭、下箭頭、左箭頭按下、右箭頭按下、上箭頭按下、下箭頭按下、橫Thumb條、縱Thumb條、橫背景條、縱背景條。

初始化時，調用GetSkinSB.InitSkinSB(ListView1.Handle);便可。窗口銷燬前調用GetSkinSB.UninitSkinSB(ListView1.Handle)。

雖然也可針對EDIT(TMemo)和其它使用系統滾動條的控件使用此模塊，但效果各有差別，須要分別作特殊處理。

unit SkinSB;
 
interface
 
uses
  SysUtils, Classes, Windows, Messages, Graphics;
 
const
  SKINSB_PROP = '{8BC6661E-5880-4353-878D-C3B3784CFC5F}';
 
type
 
  TBarPosCode = ( bpcNone,
                  bpcHArrowL, bpcHArrowR, bpcHPageL, bpcHPageR, bpcHThumb,
                  bpcVArrowU, bpcVArrowD, bpcVPageU, bpcVPageD, bpcVThumb,
                  bpcCross );
 
  TWindowProc = function (hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
 
  PSkinSBInfo = ^TSkinSBInfo;
  TSkinSBInfo = packed record
    OldWndProc: TWindowProc;
    Prevent: Boolean; // prevent style change message
    Scrolling: Boolean;
    Style: Cardinal; // real style
    ThumbTrack: Boolean;
    ThumbPos: Integer;
    Tracking: Boolean; // tracking: click arrow or track thumb
  end;
 
  TSkinSB = class
  protected
    FBitmap: TBitmap;
    constructor CreateInstance;
  public
    constructor Create;
    destructor Destroy; override;
    procedure InitSkinSB(H: HWND);
    procedure UnInitSkinSB(H: HWND);
    procedure DrawElem(H: HWND; Code: TBarPosCode; R: TRect; Down: Boolean);
  end;
 
function GetSkinSB: TSkinSB;
 
function SkinSBWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
function GetSkinSBInfo(hWnd: HWND): PSkinSBInfo;
 
implementation
 
uses
  CommCtrl;
 
{$R *.res}
 
var
  l_SkinSB: TSkinSB;
  l_SkinSB_Prop: TATOM;
 
type
  PImageImportDescriptor = ^TImageImportDescriptor;
  TImageImportDescriptor = packed record
    OriginalFirstThunk: DWORD;  // or Characteristics: DWORD
    TimeDateStamp: DWORD;
    ForwarderChain: DWORD;
    Name: DWORD;
    FirstThunk: DWORD;
  end;
  PImageChunkData = ^TImageChunkData;
  TImageChunkData = packed record
    case Integer of
      0: ( ForwarderString: DWORD );
      1: ( Func: DWORD );
      2: ( Ordinal: DWORD );
      3: ( AddressOfData: DWORD );
  end;
  PImageImportByName = ^TImageImportByName;
  TImageImportByName = packed record
    Hint: Word;
    Name: array[0..0] of Byte;
  end;
 
type
  PHookRec = ^THookRec;
  THookRec = packed record
    OldFunc: Pointer;
    NewFunc: Pointer;
  end;
 
var
  _HookGetScrollInfo: THookRec;
 
procedure HookApiInMod(ImageBase: Cardinal; ApiName: PChar; PHook: PHookRec);
var
  pidh: PImageDosHeader;
  pinh: PImageNtHeaders;
  pSymbolTable: PIMAGEDATADIRECTORY;
  piid: PIMAGEIMPORTDESCRIPTOR;
  pitd_org, pitd_1st: PImageChunkData;
  piibn: PImageImportByName;
  pAPIFunction: Pointer;
  written, oldAccess: DWORD;
begin
  if ImageBase = 0 then Exit;
  pidh := PImageDosHeader(ImageBase);
  pinh := PImageNtHeaders(DWORD(ImageBase) + Cardinal(pidh^._lfanew));
  pSymbolTable := @pinh^.OptionalHeader.DataDirectory[1];
  piid := PImageImportDescriptor(DWORD(ImageBase) + pSymbolTable^.VirtualAddress);
  repeat
    pitd_org := PImageChunkData(DWORD(ImageBase) + piid^.OriginalFirstThunk);
    pitd_1st := PImageChunkData(DWORD(ImageBase) + piid^.FirstThunk);
    repeat
      piibn := PImageImportByName(DWORD(ImageBase) + LPDWORD(pitd_org)^);
      pAPIFunction := Pointer(pitd_1st^.Func);
      if StrComp(ApiName, @piibn^.Name) = 0 then
      begin
        PHook^.OldFunc := pAPIFunction;
        VirtualProtect(@(pitd_1st^.Func), SizeOf(DWORD), PAGE_WRITECOPY, oldAccess);
        WriteProcessMemory(GetCurrentProcess(), @(pitd_1st^.Func), @PHook^.NewFunc, SizeOf(DWORD), written);
        VirtualProtect(@(pitd_1st^.Func), SizeOf(DWORD), oldAccess, oldAccess);
      end;
      Inc(pitd_org);
      Inc(pitd_1st);
    until pitd_1st^.Func = 0;
    Inc(piid);
  until piid^.FirstThunk + piid^.OriginalFirstThunk + piid^.ForwarderChain + piid^.Name = 0;
end;
 
function GetSkinSBInfo(hWnd: HWND): PSkinSBInfo;
begin
  Result := PSkinSBInfo( GetProp(hWnd, MAKEINTATOM(l_SkinSB_Prop)) );
end;
 
function GetSkinSB: TSkinSB;
begin
  if l_SkinSB = nil then l_SkinSB := TSkinSB.CreateInstance;
  Result := l_SkinSB;
end;
 
function CalcScrollBarRect(H: HWND; nBarCode: Cardinal): TRect;
var
  Style, ExStyle: Cardinal;
begin
  SetRect(Result, 0, 0, 0, 0);
  Style := GetWindowLong(H, GWL_STYLE);
  ExStyle := GetWindowLong(H, GWL_EXSTYLE);
  if (nBarCode = SB_HORZ) and ((Style and WS_HSCROLL) = 0) then Exit;
  if (nBarCode = SB_VERT) and ((Style and WS_VSCROLL) = 0) then Exit;
  GetWindowRect(H, Result);
  OffsetRect(Result, -Result.Left, -Result.Top);
  if ((ExStyle and WS_EX_DLGMODALFRAME) <> 0)
    or ((ExStyle and WS_EX_CLIENTEDGE) <> 0) then
  begin
    InflateRect(Result, -GetSystemMetrics(SM_CXEDGE), -GetSystemMetrics(SM_CYEDGE));
  end;
  // special: returns the cross
  if nBarCode = SB_BOTH then
  begin
    if ((Style and WS_HSCROLL) = 0) or ((Style and WS_VSCROLL) = 0) then
    begin
      SetRect(Result, 0, 0, 0, 0);
      Exit;
    end;
    Result.Top := Result.Bottom - GetSystemMetrics(SM_CYVSCROLL);
    if (ExStyle and WS_EX_LEFTSCROLLBAR) <> 0 then Result.Right := Result.Left + GetSystemMetrics(SM_CXHSCROLL)
    else Result.Left := Result.Right - GetSystemMetrics(SM_CXHSCROLL);
    Exit;
  end;
  if nBarCode = SB_HORZ then
  begin
  //    if (ExStyle and WS_EX_TOPSCROLLBAR) <> 0 then Result.Bottom := Result.Top + GetSystemMetrics(SM_CYVSCROLL)
    Result.Top := Result.Bottom - GetSystemMetrics(SM_CYVSCROLL);
    if ((Style and WS_VSCROLL) <> 0) then Dec(Result.Right, GetSystemMetrics(SM_CYVSCROLL));
  end;
  if nBarCode = SB_VERT then
  begin
    if (ExStyle and WS_EX_LEFTSCROLLBAR) <> 0 then Result.Right := Result.Left + GetSystemMetrics(SM_CXHSCROLL)
    else Result.Left := Result.Right - GetSystemMetrics(SM_CXHSCROLL);
    if ((Style and WS_HSCROLL) <> 0) then Dec(Result.Bottom, GetSystemMetrics(SM_CXHSCROLL));
  end;
end;
 
type
  TBarElem = (beArrow1, beBG, beThumb, beArrow2);
  TBarElemRects = array[TBarElem] of TRect;
 
function CalcBarElemRects(hWnd: HWND; nBarCode: Integer): TBarElemRects;
var
  R: TRect;
  SI: TScrollInfo;
  ThumbSize: Integer;
  X, L, H, BlockH, BlockV: Integer;
begin
  R := CalcScrollBarRect(hWnd, nBarCode);
  SI.cbSize := SizeOf(SI);
  SI.fMask := SIF_ALL;
  GetScrollInfo(hWnd, nBarCode, SI);
  Result[beArrow1] := R;
  Result[beArrow2] := R;
  Result[beBG] := R;
  Result[beThumb] := R;
  if nBarCode = SB_VERT then
  begin
    BlockV := GetSystemMetrics(SM_CYVSCROLL);
    L := Result[beArrow1].Top + BlockV;
    H := Result[beArrow2].Bottom - BlockV;
    Result[beArrow1].Bottom := L;
    Result[beArrow2].Top := H;
//    Inc(L);
//    Dec(H);
    Result[beBG].Top := L;
    Result[beBG].Bottom := H;
  end
  else
  begin
    BlockH := GetSystemMetrics(SM_CXHSCROLL);
    L := Result[beArrow1].Left + BlockH;
    H := Result[beArrow2].Right - BlockH;
    Result[beArrow1].Right := L;
    Result[beArrow2].Left := H;
//    Inc(L);
//    Dec(H);
    Result[beBG].Left := L;
    Result[beBG].Right := H;
  end;
  if SI.nMax - SI.nMin - Integer(SI.nPage) + 1 <= 0 then
  begin
    // max thumb, no thumb
    if nBarCode = SB_VERT then
    begin
      Result[beThumb].Top := L;
      Result[beThumb].Bottom := H;
    end
    else
    begin
      Result[beThumb].Left := L;
      Result[beThumb].Right := H;
    end;
    Exit;
  end;
  ThumbSize := MulDiv(H - L, SI.nPage, SI.nMax - SI.nMin + 1);
  X := L + MulDiv(SI.nTrackPos, H - ThumbSize - L, SI.nMax - Integer(SI.nPage) - SI.nMin + 1);
  if nBarCode = SB_VERT then
  begin
    Result[beThumb].Top := X;
    Result[beThumb].Bottom := X + ThumbSize;
  end
  else
  begin
    Result[beThumb].Left := X;
    Result[beThumb].Right := X + ThumbSize;
  end;
end;
 
function GetPtBarPos(H: HWND; Pt: TPoint): TBarPosCode;
var
  R: TRect;
  BR: TBarElemRects;
begin
  Result := bpcNone;
  R := CalcScrollBarRect(H, SB_HORZ);
  InflateRect(R, GetSystemMetrics(SM_CXEDGE), GetSystemMetrics(SM_CYEDGE));
  if PtInRect(R, Pt) then
  begin
    BR := CalcBarElemRects(H, SB_HORZ);
    if PtInRect(BR[beArrow1], Pt) then Result := bpcHArrowL
    else if PtInRect(BR[beThumb], Pt) then Result := bpcHThumb
    else if PtInRect(BR[beArrow2], Pt) then Result := bpcHArrowR
    else if Pt.X < BR[beThumb].Left then Result := bpcHPageL
    else Result := bpcHPageR;
    Exit;
  end;
  R := CalcScrollBarRect(H, SB_VERT);
  InflateRect(R, GetSystemMetrics(SM_CXEDGE), GetSystemMetrics(SM_CYEDGE));
  if PtInRect(R, Pt) then
  begin
    BR := CalcBarElemRects(H, SB_VERT);
    if PtInRect(BR[beArrow1], Pt) then Result := bpcVArrowU
    else if PtInRect(BR[beThumb], Pt) then Result := bpcVThumb
    else if PtInRect(BR[beArrow2], Pt) then Result := bpcVArrowD
    else if Pt.Y < BR[beThumb].Top then Result := bpcVPageU
    else Result := bpcVPageD;
    Exit;
  end;
end;
 
type
  TGetScrollInfoFunc = function (H: HWND; Code: Integer; var SI: TScrollInfo): Boolean; stdcall;
 
function _SkinSB_GetScrollInfo(H: HWND; Code: Integer; var SI: TScrollInfo): Boolean; stdcall;
var
  P: PSkinSBInfo;
begin
  Result := TGetScrollInfoFunc(_HookGetScrollInfo.OldFunc)(H, Code, SI);
  P := GetSkinSBInfo(H);
  if (P <> nil) and P^.ThumbTrack and ((SI.fMask and SIF_TRACKPOS) <> 0) then
  begin
    SI.nTrackPos := P^.ThumbPos;
  end;
end;
 
{ TSkinSB }
 
constructor TSkinSB.Create;
begin
  raise Exception.Create('use GetSkinSB.');
end;
 
constructor TSkinSB.CreateInstance;
begin
  inherited;
  _HookGetScrollInfo.OldFunc := nil;
  _HookGetScrollInfo.NewFunc := @_SkinSB_GetScrollInfo;
  HookApiInMod( GetModuleHandle('comctl32.dll'), 'GetScrollInfo', @_HookGetScrollInfo );
  FBitmap := TBitmap.Create;
  FBitmap.LoadFromResourceName(hInstance, 'scrollbar');
end;
 
destructor TSkinSB.Destroy;
begin
  FreeAndNil(FBitmap);
  inherited;
end;
 
procedure TSkinSB.DrawElem(H: HWND; Code: TBarPosCode; R: TRect;
  Down: Boolean);
var
  Canvas: TCanvas;
begin
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := GetWindowDC(H);
    try
      case Code of
        bpcHArrowL:
        begin
          if Down then BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16, FBitmap.Canvas.Handle, 64, 0, SRCCOPY)
          else BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);
          Exit;
        end;
        bpcHArrowR:
        begin
          if Down then BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16, FBitmap.Canvas.Handle, 80, 0, SRCCOPY)
          else BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16, FBitmap.Canvas.Handle, 16, 0, SRCCOPY);
          Exit;
        end;
        bpcHThumb:
        begin
          BitBlt(Canvas.Handle, R.Left, R.Top, 2, 16, FBitmap.Canvas.Handle, 128, 0, SRCCOPY);
          BitBlt(Canvas.Handle, R.Right - 2, R.Top, 2, 16, FBitmap.Canvas.Handle, 142, 0, SRCCOPY);
          StretchBlt(Canvas.Handle, R.Left + 2, R.Top, R.Right - R.Left - 4, 16, FBitmap.Canvas.Handle,
            130, 0, 12, 16, SRCCOPY);
          Exit;
        end;
        bpcHPageL, bpcHPageR:
        begin
          if R.Right - R.Left < 4 then
          begin
            StretchBlt(Canvas.Handle, R.Left, R.Top, R.Right - R.Left, 16, FBitmap.Canvas.Handle,
              160, 0, 16, 16, SRCCOPY);
          end
          else
          begin
            BitBlt(Canvas.Handle, R.Left, R.Top, 2, 16, FBitmap.Canvas.Handle, 160, 0, SRCCOPY);
            BitBlt(Canvas.Handle, R.Right - 2, R.Top, 2, 16, FBitmap.Canvas.Handle, 174, 0, SRCCOPY);
            StretchBlt(Canvas.Handle, R.Left + 2, R.Top, R.Right - R.Left - 4, 16, FBitmap.Canvas.Handle,
              162, 0, 12, 16, SRCCOPY);
          end;
          Exit;
        end;
        bpcVArrowU:
        begin
          if Down then BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16, FBitmap.Canvas.Handle, 96, 0, SRCCOPY)
          else BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16, FBitmap.Canvas.Handle, 32, 0, SRCCOPY);
          Exit;
        end;
        bpcVArrowD:
        begin
          if Down then BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16, FBitmap.Canvas.Handle, 112, 0, SRCCOPY)
          else BitBlt(Canvas.Handle, R.Left, R.Top, 16, 16, FBitmap.Canvas.Handle, 48, 0, SRCCOPY);
          Exit;
        end;
        bpcVThumb:
        begin
          BitBlt(Canvas.Handle, R.Left, R.Top, 16, 2, FBitmap.Canvas.Handle, 144, 0, SRCCOPY);
          BitBlt(Canvas.Handle, R.Left, R.Bottom - 2, 16, 2, FBitmap.Canvas.Handle, 144, 14, SRCCOPY);
          StretchBlt(Canvas.Handle, R.Left, R.Top + 2, 16, R.Bottom - R.Top - 4, FBitmap.Canvas.Handle,
            144, 2, 16, 12, SRCCOPY);
          Exit;
        end;
        bpcVPageU, bpcVPageD:
        begin
          if R.Bottom - R.Top < 4 then
          begin
            StretchBlt(Canvas.Handle, R.Left, R.Top, 16, R.Bottom - R.Top, FBitmap.Canvas.Handle,
              176, 0, 16, 16, SRCCOPY);
          end
          else
          begin
            BitBlt(Canvas.Handle, R.Left, R.Top, 16, 2, FBitmap.Canvas.Handle, 176, 0, SRCCOPY);
            BitBlt(Canvas.Handle, R.Left, R.Bottom - 2, 16, 2, FBitmap.Canvas.Handle, 176, 14, SRCCOPY);
            StretchBlt(Canvas.Handle, R.Left, R.Top + 2, 16, R.Bottom - R.Top - 4, FBitmap.Canvas.Handle,
              176, 2, 16, 12, SRCCOPY);
          end;
          Exit;
        end;
      end;
      Canvas.Pen.Color := clBlack;
      Canvas.Brush.Color := clWhite;
      Canvas.Rectangle(R);
    finally
      ReleaseDC(H, Canvas.Handle);
    end;
  finally
    Canvas.Handle := 0;
    FreeAndNil(Canvas);
  end;
end;
 
procedure TSkinSB.InitSkinSB(H: HWND);
var
  PInfo: PSkinSBInfo;
begin
  PInfo := GetSkinSBInfo(H);
  if PInfo <> nil then Exit; // already inited
  New(PInfo);
  PInfo^.OldWndProc := TWindowProc(GetWindowLong(H, GWL_WNDPROC));
  PInfo^.Style := GetWindowLong(H, GWL_STYLE);
  PInfo^.Prevent := False;
  PInfo^.Scrolling := False;
  PInfo^.ThumbTrack := False;
  SetWindowLong(H, GWL_WNDPROC, Cardinal(@SkinSBWndProc));
  SetProp(H, MAKEINTATOM(l_SkinSB_Prop), Cardinal(PInfo));
end;
 
procedure TSkinSB.UnInitSkinSB(H: HWND);
var
  PInfo: PSkinSBInfo;
begin
  PInfo := GetSkinSBInfo(H);
  if PInfo = nil then Exit; // not inited
  RemoveProp(H, MAKEINTATOM(l_SkinSB_Prop));
  SetWindowLong(H, GWL_WNDPROC, Cardinal(@PInfo^.OldWndProc));
  Dispose(PInfo);
end;
 
const
  WM_REPEAT_CLICK = WM_USER + $6478;
 
procedure OnRepeatClickTimer(hWnd: HWND; uMsg: UINT; idEvent: UINT; dwTime: DWORD); stdcall;
begin
  KillTimer(0, idEvent);
  PostThreadMessage(MainThreadID, WM_REPEAT_CLICK, 0, 0);
end;
 
procedure RedrawScrollBars(hWnd: HWND);
var
  RHBar, RVBar, RCross: TRect;
  BR: TBarElemRects;
begin
  RHBar := CalcScrollBarRect(hWnd, SB_HORZ);
  if not IsRectEmpty(RHBar) then
  begin
    BR := CalcBarElemRects(hWnd, SB_HORZ);
    GetSkinSB.DrawElem(hWnd, bpcHPageL, Rect(BR[beBG].Left, BR[beBG].Top, BR[beThumb].Left, BR[beBG].Bottom), False);
    GetSkinSB.DrawElem(hWnd, bpcHPageR, Rect(BR[beThumb].Right, BR[beBG].Top, BR[beBG].Right, BR[beBG].Bottom), False);
    GetSkinSB.DrawElem(hWnd, bpcHThumb, BR[beThumb], False);
    GetSkinSB.DrawElem(hWnd, bpcHArrowL, BR[beArrow1], False);
    GetSkinSB.DrawElem(hWnd, bpcHArrowR, BR[beArrow2], False);
  end;
  RVBar := CalcScrollBarRect(hWnd, SB_VERT);
  if not IsRectEmpty(RVBar) then
  begin
    BR := CalcBarElemRects(hWnd, SB_VERT);
    GetSkinSB.DrawElem(hWnd, bpcVPageU, Rect(BR[beBG].Left, BR[beBG].Top, BR[beBG].Right, BR[beThumb].Top), False);
    GetSkinSB.DrawElem(hWnd, bpcVPageD, Rect(BR[beBG].Left, BR[beThumb].Bottom, BR[beBG].Right, BR[beBG].Bottom), False);
    GetSkinSB.DrawElem(hWnd, bpcVThumb, BR[beThumb], False);
    GetSkinSB.DrawElem(hWnd, bpcVArrowU, BR[beArrow1], False);
    GetSkinSB.DrawElem(hWnd, bpcVArrowD, BR[beArrow2], False);
  end;
  RCross := CalcScrollBarRect(hWnd, SB_BOTH);
  if not IsRectEmpty(RCross) then
  begin
    GetSkinSB.DrawElem(hWnd, bpcCross, RCross, False);
  end;
end;
 
procedure TrackBar(hWnd: HWND; nBarCode: Integer; PosCode: TBarPosCode; BarElem: TBarElem; MsgCode: Integer);
var
  BR: TBarElemRects;
  Msg: tagMSG;
  Pt: TPoint;
  R: TRect;
  ScrollMsg: Cardinal;
  RepeatClick: Boolean;
  idEvent: UINT;
  SI: TScrollInfo;
 
  procedure RefreshRect;
  begin
    BR := CalcBarElemRects(hWnd, nBarCode);
    R := BR[BarElem];
  end;
 
begin
  RepeatClick := False;
  BR := CalcBarElemRects(hWnd, nBarCode);
  R := BR[BarElem];
  GetScrollInfo(hWnd, nBarCode, SI);
  if nBarCode = SB_HORZ then ScrollMsg := WM_HSCROLL
  else ScrollMsg := WM_VSCROLL;
  if BarElem = beBG then
  begin
    if PosCode = bpcHPageL then R.Right := BR[beThumb].Left
    else if PosCode = bpcHPageR then R.Left := BR[beThumb].Right
    else if PosCode = bpcVPageU then R.Bottom := BR[beThumb].Top
    else if PosCode = bpcVPageD then R.Top := BR[beThumb].Bottom;
  end;
  GetSkinSB.DrawElem(hWnd, PosCode, R, True);
  GetSkinSBInfo(hWnd)^.Tracking := True;
  idEvent := 0;
  try
    SetCapture(hWnd);
    idEvent := SetTimer(0, 0, 1000, @OnRepeatClickTimer);
    while GetCapture = hWnd do
    begin
      if not GetMessage(Msg, 0, 0, 0) then Break;
      if (Msg.hwnd = 0) and (Msg.message = WM_REPEAT_CLICK) then
      begin
        GetCursorPos(Pt);
        ScreenToClient(hWnd, Pt);
        if PtInRect(R, Pt) then
        begin
          RepeatClick := True;
          SendMessage(hWnd, ScrollMsg, MsgCode, 0);
          SendMessage(hWnd, ScrollMsg, SB_ENDSCROLL, 0);
          RefreshRect;
          GetSkinSB.DrawElem(hWnd, PosCode, R, True);
//          if MsgCode = SB_LINEDOWN then SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) + 1, False);
          if MsgCode = SB_PAGEDOWN then SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) + Integer(SI.nPage), False);
//          if MsgCode = SB_LINEUP then SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) - 1, False);
          if MsgCode = SB_PAGEUP then SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) - Integer(SI.nPage), False);
          RedrawScrollBars(hWnd);
          SetTimer(0, 0, 80, @OnRepeatClickTimer);
        end;
      end
      else if Msg.hwnd = hWnd then
      begin
        case Msg.message of
          WM_LBUTTONUP:
          begin
            if RepeatClick then Break;
            GetCursorPos(Pt);
            ScreenToClient(hWnd, Pt);
            if PtInRect(R, Pt) then
            begin
              SendMessage(hWnd, ScrollMsg, MsgCode, 0);
              SendMessage(hWnd, ScrollMsg, SB_ENDSCROLL, 0);
              RefreshRect;
//              if MsgCode = SB_LINEDOWN then SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) + 1, False);
              if MsgCode = SB_PAGEDOWN then SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) + Integer(SI.nPage), False);
//              if MsgCode = SB_LINEUP then SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) - 1, False);
              if MsgCode = SB_PAGEUP then SetScrollPos(hWnd, nBarCode, GetScrollPos(hWnd, nBarCode) - Integer(SI.nPage), False);
            end;
            Break;
          end;
        end;
      end;
      DispatchMessage(Msg);
    end;
  finally
    if idEvent <> 0 then KillTimer(0, idEvent);
    if IsWindow(hWnd) then
    begin
      if GetCapture = hWnd then ReleaseCapture;
      GetSkinSB.DrawElem(hWnd, PosCode, R, False);
      GetSkinSBInfo(hWnd)^.Tracking := False;
    end;
  end;
end;
 
procedure TrackThumb(hWnd: HWND; nBarCode: Integer; PosCode: TBarPosCode; BarElem: TBarElem);
var
  BR: TBarElemRects;
  Msg: tagMSG;
  Pt: TPoint;
  DragX: Integer;
  R: TRect;
  ScrollMsg: Cardinal;
  SI, SI2: TScrollInfo;
  Pos: Integer;
  H, L, ThumbSize, X: Integer;
  Pushed: Boolean;
 
  function ValidDragArea(ARect: TRect; APt: TPoint): Boolean;
  begin
    if nBarCode = SB_HORZ then Result := Abs((ARect.Bottom + ARect.Top) div 2 - APt.Y) < 150
    else Result := Abs((ARect.Left + ARect.Right) div 2 - APt.X) < 150;
  end;
 
  function CalcPos(ARect: TRect; APt: TPoint; ADragX: Integer): Integer;
  var
    NewX: Integer;
  begin
    if nBarCode = SB_HORZ then NewX := APt.X - ADragX
    else NewX := APt.Y - ADragX;
    Result := SI.nMin + MulDiv(NewX - L, SI.nMax - Integer(SI.nPage) - SI.nMin + 1, H - L - ThumbSize);
    if Result < SI.nMin then Result := SI.nMin;
    if Result > SI.nMax - Integer(SI.nPage) + 1 then
      Result := SI.nMax - Integer(SI.nPage) + 1;
  end;
 
  procedure UpdateDragBar(ADown: Boolean; APos: Integer = -10000);
  var
    W: Integer;
  begin
    BR := CalcBarElemRects(hWnd, nBarCode);
    R := BR[BarElem];
    if nBarCode = SB_HORZ then
    begin
      if APos <> -10000 then
      begin
        W := R.Right - R.Left;
        if APos < BR[beArrow1].Right then APos := BR[beArrow1].Right;
        if APos + W > BR[beArrow2].Left then APos := BR[beArrow2].Left - W;
        R.Left := APos;
        R.Right := APos + W;
      end;
      GetSkinSB.DrawElem(hWnd, bpcHPageL, Rect(BR[beBG].Left, BR[beBG].Top, R.Left, BR[beBG].Bottom), False);
      GetSkinSB.DrawElem(hWnd, bpcHPageR, Rect(R.Right, BR[beBG].Top, BR[beBG].Right, BR[beBG].Bottom), False);
    end
    else
    begin
      if APos <> -10000 then
      begin
        W := R.Bottom - R.Top;
        if APos < BR[beArrow1].Bottom then APos := BR[beArrow1].Bottom;
        if APos + W >= BR[beArrow2].Top then APos := BR[beArrow2].Top - W - 1;
        R.Top := APos;
        R.Bottom := APos + W;
      end;
      GetSkinSB.DrawElem(hWnd, bpcVPageU, Rect(BR[beBG].Left, BR[beBG].Top, BR[beBG].Right, R.Top), False);
      GetSkinSB.DrawElem(hWnd, bpcVPageD, Rect(BR[beBG].Left, R.Bottom, BR[beBG].Right, BR[beBG].Bottom), False);
    end;
    GetSkinSB.DrawElem(hWnd, PosCode, R, ADown);
    OutputDebugString(PChar(Format('R=(%d,%d,%d,%d)', [R.Left, R.Top, R.Right, R.Bottom])));
  end;
 
begin
  BR := CalcBarElemRects(hWnd, nBarCode);
  R := BR[BarElem];
  if nBarCode = SB_HORZ then ScrollMsg := WM_HSCROLL
  else ScrollMsg := WM_VSCROLL;
  SI.cbSize := SizeOf(SI);
  SI.fMask := SIF_ALL;
  GetScrollInfo(hWnd, nBarCode, SI);
  GetCursorPos(Pt);
  ScreenToClient(hWnd, Pt);
  if nBarCode = SB_HORZ then
  begin
    DragX := Pt.X - BR[beThumb].Left;
    ThumbSize := BR[beThumb].Right - BR[beThumb].Left;
    L := BR[beArrow1].Right;
    H := BR[beArrow2].Left;
  end
  else
  begin
    DragX := Pt.Y - BR[beThumb].Top;
    ThumbSize := BR[beThumb].Bottom - BR[beThumb].Top;
    L := BR[beArrow1].Bottom;
    H := BR[beArrow2].Top;
  end;
{  if nBarCode = SB_HORZ then SendMessage(hWnd, WM_SYSCOMMAND, SC_HSCROLL, MAKELPARAM(Pt.X, Pt.Y))
  else SendMessage(hWnd, WM_SYSCOMMAND, SC_VSCROLL, MAKELPARAM(Pt.X, Pt.Y)); }
  GetSkinSBInfo(hWnd)^.Tracking := True;
  UpdateDragBar(True);
  try
    SetCapture(hWnd);
    while GetCapture = hWnd do
    begin
      if not GetMessage(Msg, 0, 0, 0) then Break;
      if Msg.hwnd = hWnd then
      begin
        case Msg.message of
          WM_MOUSEMOVE:
          begin
            Pushed := ValidDragArea(R, Pt);
            GetCursorPos(Pt);
            ScreenToClient(hWnd, Pt);
            if ValidDragArea(R, Pt) then
            begin
              Pos := CalcPos(R, Pt, DragX);
              if nBarCode = SB_HORZ then X := Pt.X - DragX
              else X := Pt.Y - DragX;
            end
            else
            begin
              Pos := SI.nPos;
              X := DragX;
            end;
            GetSkinSBInfo(hWnd)^.ThumbPos := Pos;
            GetSkinSBInfo(hWnd)^.ThumbTrack := True;
            SendMessage(hWnd, ScrollMsg, MAKEWPARAM(SB_THUMBTRACK, Pos), 0);
            GetSkinSBInfo(hWnd)^.ThumbTrack := False;
            UpdateDragBar(Pushed, X);
          end;
          WM_LBUTTONUP:
          begin
            GetCursorPos(Pt);
            ScreenToClient(hWnd, Pt);
            if ValidDragArea(R, Pt) then
            begin
              Pos := CalcPos(R, Pt, DragX);
              SI2.cbSize := SizeOf(SI2);
              SI2.fMask := SIF_ALL;
              GetScrollInfo(hWnd, nBarCode, SI2);
              SI2.nPos := Pos;
              SI2.nTrackPos := Pos;
              SetScrollInfo(hWnd, nBarCode, SI2, False);
              SI2.nTrackPos := 0;
              SI2.nPos := 0;
              GetScrollInfo(hWnd, nBarCode, SI2);
              SendMessage(hWnd, ScrollMsg, MAKEWPARAM(SB_THUMBPOSITION, Pos), 0);
              SendMessage(hWnd, ScrollMsg, SB_ENDSCROLL, 0);
            end;
            Break;
          end;
        end;
      end;
      DispatchMessage(Msg);
    end;
  finally
    if IsWindow(hWnd) then
    begin
      if GetCapture = hWnd then ReleaseCapture;
      GetSkinSBInfo(hWnd)^.Tracking := False;
    end;
    UpdateDragBar(False);
  end;
end;
 
function SkinSBWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
  PInfo: PSkinSBInfo;
  Style, ExStyle: Cardinal;
  R, RHBar, RVBar, RCross: TRect;
  Pt: TPoint;
  Rgn, Rgn2: HRGN;
  PR: PRect;
  BR: TBarElemRects;
  XBar, YBar: Integer;
begin
  PInfo := GetSkinSBInfo(hWnd);
  if PInfo = nil then Result := DefWindowProc(hWnd, uMsg, wParam, lParam) //// error!!!
  else
  begin
    case uMsg of
      WM_NCHITTEST:
      begin
        GetCursorPos(Pt);
        ScreenToClient(hWnd, Pt);
        case GetPtBarPos(hWnd, Pt) of
          bpcHArrowL:
          begin
            if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
            begin
              if GetCapture <> hWnd then
                TrackBar(hWnd, SB_HORZ, bpcHArrowL, beArrow1, SB_LINELEFT);
            end;
            Result := HTNOWHERE;
            Exit;
          end;
          bpcHArrowR:
          begin
            if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
            begin
              if GetCapture <> hWnd then
                TrackBar(hWnd, SB_HORZ, bpcHArrowR, beArrow2, SB_LINERIGHT);
            end;
            Result := HTNOWHERE;
            Exit;
          end;
          bpcHPageL:
          begin
            if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
            begin
              if GetCapture <> hWnd then
              begin
                TrackBar(hWnd, SB_HORZ, bpcHPageL, beBG, SB_PAGELEFT);
                RedrawScrollBars(hWnd);
              end;
            end;
            Result := HTNOWHERE;
            Exit;
          end;
          bpcHPageR:
          begin
            if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
            begin
              if GetCapture <> hWnd then
              begin
                TrackBar(hWnd, SB_HORZ, bpcHPageR, beBG, SB_PAGERIGHT);
                RedrawScrollBars(hWnd);
              end;
            end;
            Result := HTNOWHERE;
            Exit;
          end;
          bpcHThumb:
          begin
            if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
            begin
              if GetCapture <> hWnd then
                TrackThumb(hWnd, SB_HORZ, bpcHThumb, beThumb);
            end;
            Result := HTNOWHERE;
            Exit;
          end;
 
          bpcVArrowU:
          begin
            if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
            begin
              if GetCapture <> hWnd then
                TrackBar(hWnd, SB_VERT, bpcVArrowU, beArrow1, SB_LINELEFT);
            end;
            Result := HTNOWHERE;
            Exit;
          end;
          bpcVArrowD:
          begin
            if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
            begin
              if GetCapture <> hWnd then
                TrackBar(hWnd, SB_VERT, bpcVArrowD, beArrow2, SB_LINERIGHT);
            end;
            Result := HTNOWHERE;
            Exit;
          end;
          bpcVPageU:
          begin
            if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
            begin
              if GetCapture <> hWnd then
              begin
                TrackBar(hWnd, SB_VERT, bpcVPageU, beBG, SB_PAGELEFT);
                RedrawScrollBars(hWnd);
              end;
            end;
            Result := HTNOWHERE;
            Exit;
          end;
          bpcVPageD:
          begin
            if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
            begin
              if GetCapture <> hWnd then
              begin
                TrackBar(hWnd, SB_VERT, bpcVPageD, beBG, SB_PAGERIGHT);
                RedrawScrollBars(hWnd);
              end;
            end;
            Result := HTNOWHERE;
            Exit;
          end;
          bpcVThumb:
          begin
            if (GetKeyState(VK_LBUTTON) and $8000) <> 0 then
            begin
              if GetCapture <> hWnd then
                TrackThumb(hWnd, SB_VERT, bpcVThumb, beThumb);
            end;
            Result := HTNOWHERE;
            Exit;
          end;
        end;
      end;
      WM_HSCROLL:
      begin
        PInfo^.Scrolling := True;
        Style := GetWindowLong(hWnd, GWL_STYLE);
        PInfo^.Style := Style;
        PInfo^.Prevent := True;
        try
          SetWindowLong(hWnd, GWL_STYLE, Style and (not (WS_VSCROLL or WS_HSCROLL)));
        finally
          PInfo^.Prevent := False;
        end;
        Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg, wParam, lParam);
        RedrawScrollBars(hWnd);
        PInfo^.Prevent := True;
        try
          SetWindowLong(hWnd, GWL_STYLE, Style);
        finally
          PInfo^.Prevent := False;
        end;
        PInfo^.Scrolling := False;
        Exit;
      end;
 
      WM_VSCROLL:
      begin
        PInfo^.Scrolling := True;
        Style := GetWindowLong(hWnd, GWL_STYLE);
        PInfo^.Style := Style;
        PInfo^.Prevent := True;
        try
          SetWindowLong(hWnd, GWL_STYLE, Style and (not (WS_VSCROLL or WS_HSCROLL)));
        finally
          PInfo^.Prevent := False;
        end;
        Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg, wParam, lParam);
        PInfo^.Prevent := True;
        try
          SetWindowLong(hWnd, GWL_STYLE, Style);
        finally
          PInfo^.Prevent := False;
        end;
        PInfo^.Scrolling := False;
        Exit;
      end;
      WM_STYLECHANGED:
      begin
        if wParam = GWL_STYLE then
        begin
          if PInfo^.Prevent then
          begin
            Result := 0;
            Exit;
          end
          else
          begin
            PInfo^.Style := GetWindowLong(hWnd, GWL_STYLE);
          end;
        end;
      end;
      WM_NCCALCSIZE:
      begin
        Style := GetWindowLong(hWnd, GWL_STYLE);
        ExStyle := GetWindowLong(hWnd, GWL_EXSTYLE);
        XBar := GetSystemMetrics(SM_CXVSCROLL);
        YBar := GetSystemMetrics(SM_CYHSCROLL);
        if PInfo^.Scrolling then
        begin
          PInfo^.Prevent := True;
          try
            SetWindowLong(hWnd, GWL_STYLE, Style and (not (WS_HSCROLL or WS_VSCROLL)));  // real style
          finally
            PInfo^.Prevent := False;
          end;
        end;
        Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg, wParam, lParam);
        if PInfo^.Scrolling then
        begin
          PR := PRect(lParam);
          if (PInfo^.Style and WS_VSCROLL) <> 0 then
          begin
            if (ExStyle and WS_EX_LEFTSCROLLBAR) <> 0 then Inc(PR^.Left, XBar)
            else Dec(PR^.Right, XBar);
          end;
          if (PInfo^.Style and WS_HSCROLL) <> 0 then
          begin
            Dec(PR^.Bottom, YBar);
          end;
        end;
        if PInfo^.Scrolling then
        begin
          PInfo^.Prevent := True;
          try
            SetWindowLong(hWnd, GWL_STYLE, Style);  // old style
          finally
            PInfo^.Prevent := False;
          end;
        end;
        Exit;
      end;
      WM_NCPAINT:
      begin
        GetWindowRect(hWnd, R);
        Pt := R.TopLeft;
        if wParam = 1 then
        begin
          Rgn := CreateRectRgn(Pt.X, Pt.Y, Pt.X + R.Right, Pt.Y + R.Bottom);
        end else Rgn := wParam;
        RHBar := CalcScrollBarRect(hWnd, SB_HORZ);
        OffsetRect(RHBar, Pt.X, PT.Y);
        if not IsRectEmpty(RHBar) then
        begin
          BR := CalcBarElemRects(hWnd, SB_HORZ);
          GetSkinSB.DrawElem(hWnd, bpcHPageL, Rect(BR[beBG].Left, BR[beBG].Top, BR[beThumb].Left, BR[beBG].Bottom), False);
          GetSkinSB.DrawElem(hWnd, bpcHPageR, Rect(BR[beThumb].Right, BR[beBG].Top, BR[beBG].Right, BR[beBG].Bottom), False);
          GetSkinSB.DrawElem(hWnd, bpcHThumb, BR[beThumb], False);
          GetSkinSB.DrawElem(hWnd, bpcHArrowL, BR[beArrow1], False);
          GetSkinSB.DrawElem(hWnd, bpcHArrowR, BR[beArrow2], False);
        end;
        Rgn2 := CreateRectRgn(RHBar.Left, RHBar.Top, RHBar.Right, RHBar.Bottom);
        CombineRgn(Rgn, Rgn, Rgn2, RGN_DIFF);
        DeleteObject(Rgn2);
        RVBar := CalcScrollBarRect(hWnd, SB_VERT);
        if not IsRectEmpty(RVBar) then
        begin
          BR := CalcBarElemRects(hWnd, SB_VERT);
          GetSkinSB.DrawElem(hWnd, bpcVPageU, Rect(BR[beBG].Left, BR[beBG].Top, BR[beBG].Right, BR[beThumb].Top), False);
          GetSkinSB.DrawElem(hWnd, bpcVPageD, Rect(BR[beBG].Left, BR[beThumb].Bottom, BR[beBG].Right, BR[beBG].Bottom), False);
          GetSkinSB.DrawElem(hWnd, bpcVThumb, BR[beThumb], False);
          GetSkinSB.DrawElem(hWnd, bpcVArrowU, BR[beArrow1], False);
          GetSkinSB.DrawElem(hWnd, bpcVArrowD, BR[beArrow2], False);
        end;
        OffsetRect(RVBar, Pt.X, PT.Y);
        Rgn2 := CreateRectRgn(RVBar.Left, RVBar.Top, RVBar.Right, RVBar.Bottom);
        CombineRgn(Rgn, Rgn, Rgn2, RGN_DIFF);
        DeleteObject(Rgn2);
        RCross := CalcScrollBarRect(hWnd, SB_BOTH);
        if not IsRectEmpty(RCross) then
        begin
          GetSkinSB.DrawElem(hWnd, bpcCross, RCross, False);
        end;
        OffsetRect(RCross, Pt.X, PT.Y);
        Rgn2 := CreateRectRgn(RCross.Left, RCross.Top, RCross.Right, RCross.Bottom);
        CombineRgn(Rgn, Rgn, Rgn2, RGN_DIFF);
        DeleteObject(Rgn2);
        Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg, Rgn, lParam);
        if wParam = 1 then DeleteObject(Rgn);
        Exit;
      end;
      WM_ERASEBKGND:
      begin
        Style := GetWindowLong(hWnd, GWL_STYLE);
        PInfo^.Prevent := True;
        try
          SetWindowLong(hWnd, GWL_STYLE, Style and (not (WS_VSCROLL or WS_HSCROLL)));
        finally
          PInfo^.Prevent := False;
        end;
 
        Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg, wParam, lParam);
        PInfo^.Prevent := True;
        try
          SetWindowLong(hWnd, GWL_STYLE, Style);  // old style
        finally
          PInfo^.Prevent := False;
        end;
        Exit;
      end;
      WM_MOUSEWHEEL, WM_MOUSEMOVE:
      begin
        Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg, wParam, lParam);
        if PInfo^.Tracking then Exit;
        if (uMsg = WM_MOUSEMOVE) and ((wParam and MK_LBUTTON) = 0) then Exit;
        RedrawScrollBars(hWnd);
        Exit;
      end;
    end;
    Result := CallWindowProc(@PInfo^.OldWndProc, hWnd, uMsg, wParam, lParam);
  end;
end;
 
initialization
 
  l_SkinSB := nil;
  l_SkinSB_Prop := GlobalAddAtom(SKINSB_PROP);
 
finalization
 
  if Assigned(l_SkinSB) then FreeAndNil(l_SkinSB);
 
end.

View Code

補充：使用此方法後，在調用SetScrollInfo後也必須調用RedrawScrollBars重繪滾動條。Hook本模塊的SetScrollInfo API是個好方法。在這裏就不給出代碼了。

 

透明listview

給你段透明的代碼,本身去改吧  
Delphi(Pascal) code
procedure DrawParentBackground(Control: TControl; DC: HDC; R: PRect = nil; bDrawErasebkgnd: Boolean = False);
var
  SaveIndex: Integer;
  MemDC: HDC;
  MemBmp: HBITMAP;
begin
  if R <> nil then
  begin
    MemDC := CreateCompatibleDC(DC);
    MemBmp := CreateCompatibleBitmap(DC, Control.Width, Control.Height);
    SelectObject(MemDC, MemBmp);
    try
      with Control.BoundsRect.TopLeft do
        SetWindowOrgEx(MemDC, X, Y, nil);
      if bDrawErasebkgnd then
        Control.Parent.Perform(WM_ERASEBKGND, Integer(MemDC), Integer(MemDC));
      Control.Parent.Perform(WM_PAINT, Integer(MemDC), Integer(MemDC));
      with Control.BoundsRect.TopLeft do
        BitBlt(DC, R^.Left, R^.Top, R^.Right - R^.Left, R^.Bottom - R^.Top, MemDC, X + R^.Left, Y + R^.Top, SRCCOPY);
    finally
      DeleteObject(MemBmp);
      DeleteDC(MemDC);
    end;
    Exit;
  end;
  SaveIndex := SaveDC(DC);
  try
    with Control.BoundsRect.TopLeft do
      SetWindowOrgEx(DC, X, Y, nil);
    if bDrawErasebkgnd then
      Control.Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));
    Control.Parent.Perform(WM_PAINT, Integer(DC), Integer(DC));
  finally
    RestoreDC(DC, SaveIndex);
  end;
end;
------解決方案--------------------
用winapi嘛。

函數功能：設置窗口透明顏色
格式：BOOL SetLayeredWindowAttributes(
            HWND hwnd,         //窗口手柄
            COLORREF crKey,    //指定顏色值
            BYTE bAlpha,        //混合函數值
            DWORD dwFlags     //動做
            );


------解決方案--------------------
{API聲明}
type
 TSetLayeredWindowAttributes
   = function(wnd: HWND; crKey: DWORD;
     bAlpha: BYTE; dwFlag: DWORD): Boolean; stdcall;

const
 WS_EX_LAYERED = ＄80000;
 LWA_ALPHA = 2;

var
 hLibUser32: THandle;
 MySetLayeredWindowAttributes:
     TSetLayeredWindowAttributes;

implementation

{＄R ＊.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
 p: Pointer;
begin
 hLibUser32 := LoadLibraryA(‘user32.dll');
 MySetLayeredWindowAttributes := nil;
 if hLibUser32 <> 0 then begin
  p:=GetProcAddress(hLibUser32,  
   ‘SetLayeredWindowAttributes');
   if p = nil then begin
     FreeLibrary(hLibUser32);
     hLibUser32 := 0;
   end else begin
     MySetLayeredWindowAttributes :=  
    TSetLayeredWindowAttributes(p);
   end;
 end;
 if hLibUser32 <> 0 then begin
   SetWindowLong(Handle, GWL_EXSTYLE,
     GetWindowLong(Handle, GWL_EXSTYLE)
      or WS_EX_LAYERED);
   ScrollBar1.Position := ScrollBar1.Max;
   ScrollBar1Change(Self);
 end else begin
   ShowMessage(‘該操做系統不支持！');
Application.Terminate;
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if hLibUser32 <> 0 then begin
FreeLibrary(hLibUser32);
hLibUser32 := 0;
end;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
var
alpha: Integer;
begin
if hLibUser32 <> 0 then begin
alpha := ScrollBar1.Position;
alpha := alpha ＊ 255 div  
 (ScrollBar1.Max － ScrollBar1.Min);
if alpha < 8 then alpha := 8;
if alpha > 255 then alpha := 255;
MySetLayeredWindowAttributes
(Handle, 0, Byte(alpha), LWA_ALPHA);
end;
end;

----程序在Delphi5.0、Wndows2000操做系統下調試成功。
Delphi(Pascal) code
  Test = class(TListView)
  public
     function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; override;
  public
     IsTrantp: Boolean;
     constructor Create(AOwner: TComponent); override;
  end;

constructor Test.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  IsTrantp := True;
end;

function Test.IsCustomDrawn(Target: TCustomDrawTarget;
  Stage: TCustomDrawStage): Boolean;
var
  R1: TRect;
begin
  R1 := Self.ClientRect;
  DrawParentBackground(Self, Canvas.Handle, @R1, IsTrantp);
end;

// 測試
procedure TForm1.Button2Click(Sender: TObject);
var
  T1: Test;
begin
  T1 := Test.Create(self);
  T1.Parent := Self;
end;

------解決方案--------------------
持續關注三行代碼。

------解決方案--------------------
等待樓主發出代碼。

------解決方案--------------------
關注NEW人三行代碼！

------解決方案--------------------
三行彷佛不可能。除了下面必須的三行設置屬性的代碼：
SetWindowLong(Form.Handle, GWL_STYLE, GetWindowLong(Form.Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
SetWindowLong(Listview.Handle, GWL_STYLE, GetWindowLong(Listview.Handle, GWL_STYLE) and not WS_CLIPSIBLING);
SetWindowLong(Listview.Handle, GWL_EX_STYLE, GetWindowLong(Listview.Handle, GWL_STYLE) or WS_EX_TRANSPARENT);
還須要截取listview的WM_ERASEBKGND消息

View Code

 

控制listview的每行的顏色

咱們能夠設定一個字段的值,用以判斷用什麼顏色顯示listview的顏色,例子以下

procedure TMainForm.ListView2CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if item.SubItems.Strings[7] = Edit11.Text then
    begin
    item.listview.Canvas.Brush.Color:=clwhite;
    item.ListView.Canvas.Font.Color:=clblack;
    end
  else
    begin
    item.ListView.Canvas.Brush.Color:=clred;
    item.ListView.Canvas.Font.Color:=clwhite;
    end;
end;

View Code

delphi取得文件圖標並在TListView中顯示

{delphi取得文件圖標並在TListView中顯示
技術要點：
　　1、使用SHGetFileInfo函數獲取指定擴展名的文件圖標。須要引用ShellAPI單元。
　　2、使用TStringList來保存擴展名與其圖標的索引號。當添加一個文件名至TListView後，
咱們已經取得了其圖標，再次添加一樣擴展名的文件時，不需再次獲取其圖標，只要從該TStringList中取得其圖標索引號便可}

uses
  ShellAPI;

var
  IconList:TStringList;

{　實現獲取圖標及將圖標添加到TImageList中的過程 }
procedure ListView_SetItemImageIndex(Item: TListItem);
var
  nIndex:Integer;
  Icon:TIcon;
  fileName:string;
  extName:string;
  sinfo:SHFILEINFO;
begin
  if TListView(Item.ListView).SmallImages<>nil then
  begin
    fileName:=Item.Caption;
    extName:=ExtractFileExt(fileName);
    nIndex:=IconList.IndexOf(extName);
    if nIndex>-1 then
    begin
      nIndex:=Integer(IconList.Objects[nIndex]);
      Item.ImageIndex:=nIndex;
    end else
    begin
      FillChar(sinfo, SizeOf(sinfo),0);
      SHGetFileInfo(PChar(extName),FILE_ATTRIBUTE_NORMAL,sinfo,SizeOf(sInfo),
                    SHGFI_USEFILEATTRIBUTES or SHGFI_ICON or SHGFI_SMALLICON);
      if sinfo.hIcon>0 then
      begin
        Icon:=TIcon.Create;
        Icon.Handle:=sinfo.hIcon;
        nIndex:=TListView(Item.ListView).SmallImages.AddIcon(Icon);
        Icon.Free;
        Item.ImageIndex:=nIndex;
        IconList.AddObject(extName,TObject(nIndex));
      end;
    end;
  end;
end;

{　測試過程 }
procedure TForm1.Button1Click(Sender: TObject);
var
  Item:TListItem;
begin
  Item:=ListView1.Items.Add;
  Item.Caption:=‘c:\test.jpg‘;
  ListView_SetItemImageIndex(Item);
end;

{ 對IconList進行初始化及釋放 }
initialization
  IconList:=TStringList.Create;
finalization
  IconList.Free;
end.  

View Code

listview自繪製

{
歡迎轉載，http://www.freedelphitips.com
}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, ImgList, CommCtrl, StdCtrls, shellapi;

  //定義一個記錄用來存放listview的內容
type
  Plistdata = ^Tlistdata;
  Tlistdata = record
    Caption: string; //caption內容
    second: string; //第二列內容
    three: string; //第三列內容
    picon: TIcon; //圖標
  end;
type
  TForm1 = class(TForm)
    ListView1: TListView;
    ImageList1: TImageList;
    Panel1: TPanel;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
    procedure Label1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ListViewData: TList;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  imglist: TImageList;
  i: integer;
  listdata: Plistdata;
begin
  //設定一個imagelist,來擴充listview的item的高度
  imgList := timagelist.Create(nil);
  imgList.Width := 1;
  imglist.Height := 50; //listview的item的設度設置
  listview1.SmallImages := imgList; //這裏設置listView的SmallImageList ,用imgList將其撐大

  //初使化listview的數據到tlist中
  ListViewData := tlist.Create;
  for i := 0 to 5 do
  begin
    New(listdata);
    listdata^.Caption := '第' + inttostr(i) + '行第一列數據';
    listdata^.second := '第' + inttostr(i) + '行第二列數據';
    listdata^.three := '第' + inttostr(i) + '行第三列數據';
    listdata^.picon := TIcon.Create;
    ImageList1.GetIcon(i, listdata^.picon);
    ListViewData.Add(listdata);
  end;
  //插入空內容到listview
  for i := 0 to 5 do
    ListView1.Items.Add;
end;

procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
var
  listdata: Plistdata;
  i: integer;
  rect, BoundRect: TRect;
begin
  //取每行的數據
  listdata := ListViewData.Items[Item.index];
  //獲得每行的rect
  BoundRect := Item.DisplayRect(drBounds);

 // 設定背景色
  if cdsFocused in State then
  begin
    Sender.Canvas.Brush.Color := $00C5F1FF;
  end
  else
  begin
    Sender.Canvas.Brush.Color := clWhite;
  end;

  ListView1.Canvas.FillRect(BoundRect); //填充顏色

  for i := 0 to ListView1.Columns.Count - 1 do
  begin
    //獲取每一列item的Rect
    ListView_GetSubItemRect(Sender.Handle, Item.Index, i, LVIR_LABEL, @Rect);
    case i of
      0: //畫Caption 及圖標
        begin

          //畫圖標
          ListView1.Canvas.Draw(Rect.Left + 7, Rect.top + (Rect.Bottom - rect.Top - ImageList1.Height) div 2, listdata.Picon);

          InflateRect(rect, -45, 0); //向後移45個像素,避免被後面畫字時覆蓋
         // Sender.Canvas.Font.Color := clBlue;

          DrawText(
            ListView1.Canvas.Handle,
            PCHAR(Trim(listdata.Caption)),
            -1,
            rect,
            DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or 0);
        end;
      1:
        begin

          //畫第二列內容
          DrawText(
            ListView1.Canvas.Handle,
            PCHAR(Trim(listdata.second)),
            -1,
            rect,
            DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or 0);
        end;
      2:
        begin

          //畫第三列內容
          DrawText(
            ListView1.Canvas.Handle,
            PCHAR(Trim(listdata.three)),
            -1,
            rect,
            DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or 0);
        end;
    end;
        //畫個線分開
    ListView1.Canvas.Pen.Color := clblue;
    ListView1.Canvas.MoveTo(BoundRect.Left, BoundRect.Bottom - 1);
    ListView1.Canvas.LineTo(BoundRect.right, BoundRect.Bottom - 1);
  end;

  //防止閃屏
  Sender.DoubleBuffered := true;

end;

procedure TForm1.Label1Click(Sender: TObject);
begin
  ShellExecute(Application.Handle, 'open', PChar('http://www.FreeDelphiTips.com'), nil, nil, SW_ShowNormal);
end;

end.

View Code

delphi listview自繪圖形

自畫TlistView帶進度條的Item 

TListView的Item條通常是由系統自畫的，但電驢就實現了自畫，使之看起來很漂亮，咱們用DELPHI也能夠實現！

首先要引用CommCtrl單元，這是TListView底層控制單元：
uses
 CommCtrl;
 
//畫狀態條
procedure DrawSubItem(LV: TListView; Item: TListItem; SubItem: Integer;
 Prosition: Single; Max, Style: Integer; IsShowProgress: Boolean;
 DrawColor: TColor = $00005B00;
 FrameColor: TColor = $00002F00);
//獲取SubItem的區域
 function GetItemRect(LV_Handle, iItem, iSubItem: Integer): TRect;
 var
    Rect: TRect;
 begin
    ListView_GetSubItemRect(LV_Handle, iItem, iSubItem, LVIR_LABEL, @Rect);
    Result := Rect;
 end;
var
 PaintRect, r: TRect;
 i, iWidth, x, y: integer;
 S: string;
begin
 try
 
    with lv do
    begin
      //LockPaint := True;
      PaintRect := GetItemRect(LV.Handle, Item.Index, SubItem);
     r := PaintRect;
//      if SubItem = DrawSubItem then
      Begin
        //這一段是算出百分比
        if Prosition >= Max then
          Prosition := 100
        else
          if Prosition <= 0 then
            Prosition := 0
          else
            Prosition := Round((Prosition / Max) * 100);
 
        if (Prosition = 0) and (not IsShowProgress) then
        begin 
        //若是是百分比是0，就直接顯示空白
          Canvas.FillRect(r);
 
        end
        else
        begin
        //先直充背景色
          Canvas.FillRect(r);
          Canvas.Brush.Color := Color;
//          Canvas.FillRect(r);
 
        //畫一個外框
          InflateRect(r, -2, -2);
          Canvas.Brush.Color := FrameColor; //$00002F00;
          Canvas.FrameRect(R);
 
          Canvas.Brush.Color := Color;
          InflateRect(r, -1, -1);
//          Canvas.FillRect(r);
 
          InflateRect(r, -1, -1);
        //根據百分比算出要畫的進度條內容寬度
          iWidth := R.Right - Round((R.Right - r.Left) * ((100 - Prosition) /
            100));
          case Style of
            0: //進度條類型，實心填充
              begin
                Canvas.Brush.Color := DrawColor;
                r.Right := iWidth;
                Canvas.FillRect(r);
              end;
            1: //進度條類型，豎線填充
              begin
                i := r.Left;
                while i < iWidth do
                begin
                  Canvas.Pen.Color := Color;
                  Canvas.MoveTo(i, r.Top);
                  Canvas.Pen.Color := DrawColor;
                  canvas.LineTo(i, r.Bottom);
                  Inc(i, 3);
                end;
              end;
          end;
//畫好了進度條後，如今要作的就是顯示進度數字了
          Canvas.Brush.Style := bsClear;
          if Prosition = Round(Prosition) then
            S := Format('%d%%', [Round(Prosition)])
          else
            S := FormatFloat('#0.0', Prosition);
 
          with PaintRect do
          begin
            x := Left + (Right - Left + 1 - Canvas.TextWidth(S)) div 2;
            y := Top + (Bottom - Top + 1 - Canvas.TextHeight(S)) div 2;
          end;
          SetBkMode(Canvas.handle, TRANSPARENT);
          Canvas.TextRect(PaintRect, x, y, S);
 
        end;
//進度條所有畫完，把顏色設置成默認色了
        Canvas.Brush.Color := Color;
 
      end
    end;
 except
 end;
end;
 
 
上面是畫進度條的，如今要給TlistView處理Item重繪的消息，事件是OnCustomDrawItem，須要說明的是，若是想要爲所欲爲的自畫Item，那麼就要所有本身來完成，再也不須要系統來處理：
procedure TForm1.ListView1CustomDrawItem(
 Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
 var DefaultDraw: Boolean);
var
 BoundRect, Rect: TRect;
 i: integer;
 TextFormat: Word;
 LV: TListView;
 
//這個子過程是用來畫CheckBox和ImageList的
 procedure Draw_CheckBox_ImageList(r: TRect; aCanvas: TCanvas; Checked: Boolean);
 var
    R1: TRect;
    i: integer;
 begin
    if Sender.Checkboxes then
    begin
      aCanvas.Pen.Color := clBlack;
      aCanvas.Pen.Width := 2;
      //畫CheckBox外框
      aCanvas.Rectangle(r.Left + 2, r.Top + 2, r.Left + 14, r.Bottom - 2);
      if Checked then
      begin //畫CheckBox的勾
        aCanvas.MoveTo(r.Left + 4, r.Top + 6);
        aCanvas.LineTo(r.Left + 6, r.Top + 11);
        aCanvas.LineTo(r.Left + 11, r.Top + 5);
      end;
      aCanvas.Pen.Width := 1;
    end;
    //開始畫圖標
    i := PDownLoadListItem(Item.Data)^.StatsImageIndex;
    if i > -1 then
    begin
    //獲取圖標的RECT
      if Boolean(ListView_GetSubItemRect(sender.Handle, item.Index, 0, LVIR_ICON, @R1)) then
      begin
        ImageList_Stats.Draw(LV.Canvas, R1.Left, R1.Top, i);
        if item.ImageIndex > -1 then
          LV.SmallImages.Draw(LV.Canvas, R1.Right + 2, R1.Top, item.ImageIndex);
      end;
 
    end;
 end;
begin
 LV := ListView1;
 BoundRect := Item.DisplayRect(drBounds);
 InflateRect(BoundRect, -1, 0);
 
//這個地方你能夠根據本身的要求設置成想要的顏色，實現突出顯示
 LV.Canvas.Font.Color := clBtnText;
 
//查看是不是被選中
 if Item.Selected then
 begin
    if cdsFocused in State then
    begin
      LV.Canvas.Brush.Color := $00ECCCB9; // //clHighlight;
    end
    else
    begin
      LV.Canvas.Brush.Color := $00F8ECE5; //clSilver;
    end;
 end
 else
 begin
    if (Item.Index mod 2) = 0 then
      LV.Canvas.Brush.Color := clWhite
    else
      LV.Canvas.Brush.Color := $00F2F2F2;
 end;
 
 LV.Canvas.FillRect(BoundRect); //初始化背景
 
 for i := 0 to LV.Columns.Count - 1 do
 begin
 //獲取SubItem的Rect
    ListView_GetSubItemRect(LV.Handle, Item.Index, i, LVIR_LABEL, @Rect);
    case LV.Columns[i].Alignment of
      taLeftJustify:
        TextFormat := 0;
      taRightJustify:
        TextFormat := DT_RIGHT;
      taCenter:
        TextFormat := DT_CENTER;
    end;
    case i of
      0: //畫Caption，0就是表示Caption，這不是Subitems[0]
        begin
//先畫選擇框與圖標
          Draw_CheckBox_ImageList(BoundRect, LV.Canvas, Item.Checked);
//再畫Caption的文字
          InflateRect(Rect, -(5 + ImageList_Stats.Width), 0); //向後移3個像素,避免被後面畫線框時覆蓋
          DrawText(
            LV.Canvas.Handle,
            PCHAR(Item.Caption),
            Length(Item.Caption),
            Rect,
            DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or TextFormat);
        end;
      1..MaxInt: //畫Subitems[i]
        begin
          if i - 1 = 2 then //顯示狀態條
          begin
//開始處理進度條了，這個示例是第3欄顯示進度條，能夠本身隨便定義
            DrawSubItem(TListView(Sender),
              item,
              i,
              StrToFloatDef(Item.SubItems[i - 1], 0),
              100,
              0,
              True,
 //這裏用了一個Lable來選顏色，你本身可使用一個變量來代替
             LableProgressColor.Color, //進度條外框顏色
              LableProgressColor.Color //進度條顏色
);
 
          end
          else
//畫SubItem的文字
            if i - 1 <= Item.SubItems.Count - 1 then
              DrawText(
                LV.Canvas.Handle,
                PCHAR(Item.SubItems[i - 1]),
                Length(Item.SubItems[i - 1]),
                Rect,
                DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or TextFormat);
 
 
 
        end;
    end;
 
 end;
 
 
 LV.Canvas.Brush.Color := clWhite;
 
 if Item.Selected then //畫選中條外框
 begin
    if cdsFocused in State then//控件是否處於激活狀態
      LV.Canvas.Brush.Color := $00DAA07A // $00E2B598; //clHighlight;
    else
      LV.Canvas.Brush.Color := $00E2B598; //$00DAA07A // clHighlight;
    LV.Canvas.FrameRect(BoundRect); // 
 end;
 
 DefaultDraw := False; //不讓系統畫了
 
 with Sender.Canvas do
    if Assigned(Font.OnChange) then Font.OnChange(Font);
 
 
 
end;
function ReDrawItem(HwndLV: HWND; ItemIndex: integer): boolean;
begin
  Result := ListView_RedrawItems(HwndLV, ItemIndex, ItemIndex);
end;
//使用：
item:=ListView1.Selected;
item.subitems[1]:='30';//設置爲30%
//而後刷新這個item
ReDrawItem(ListView1.handle,Item.index);

View Code

listview數據保存爲txt

一段簡單的跟1同樣的代碼，listview所見即所得寫如txt文件

procedure TForm1.Button2Click(Sender: TObject);
const
  FormatStr = '%:-20s|';
var
  StrList: TStringList;
  Str: string;
  Line: string;
  i, j: integer;
begin
  StrList := TStringList.Create;
  try
    Str := '';
    Line := '';
    for i := 0 to ListView1.Columns.Count - 1 do
    begin
      Str := Str + Format(FormatStr, [ListView1.Columns[i].Caption]);
      Line := Line + '--------------------+';
    end;
    StrList.Add(Str);
    Strlist.Add(Line);
    for j := 0 to ListView1.Items.Count - 1 do
    begin
      Str := Format(FormatStr, [ListView1.Items[j].Caption]);
      for i := 1 to ListView1.Columns.Count - 1 do
        Str := Str + Format(FormatStr, [ListView1.Items[j].SubItems[i - 1]]);
      StrList.Add(Str);
    end;
    Strlist.SaveToFile('c:\temp.txt');
  finally
    StrList.Free;
  end;
end;

View Code

TListView的ListItem徹底自繪

因工做須要徹底自繪ListItem，模仿成電驢的樣式，查找了N久相關的資料，發現不多有這方面的，最後用ListView_GetSubItemRect關鍵詞在一個小日本的網站上找到一點相關的代碼，修改後解決該問題。

至因而否存在BUG，偶用了幾天還木有發現，若是有什麼問題，請你們回覆一下，謝謝

注意：代碼只支持ViewStyle=vsReport

uses
  CommCtrl;
procedure LVDrawItem(Sender: TListView; Item: TListItem; State: TCustomDrawState;
  var DefaultDraw: Boolean);
var
  BoundRect, Rect: TRect;
  i: integer;
  TextFormat: Word;
  LV: TListView;
  procedure Draw_CheckBox_ImageList(r: TRect; aCanvas: TCanvas; Checked: Boolean);
  var
    R1: TRect;
  begin
    if Sender.Checkboxes then
    begin
      aCanvas.Pen.Color := clBlack;
      aCanvas.Pen.Width := 2;
      //畫CheckBox外框，也能夠修改爲你想要的圖標顯示
      aCanvas.Rectangle(r.Left + 2, r.Top + 2, r.Left + 14, r.Bottom - 2);
      if Checked then
      begin //畫CheckBox的勾
        aCanvas.MoveTo(r.Left + 4, r.Top + 6);
        aCanvas.LineTo(r.Left + 6, r.Top + 11);
        aCanvas.LineTo(r.Left + 11, r.Top + 5);
      end;
      aCanvas.Pen.Width := 1;
    end;
    //開始畫圖標
    if (Item.ImageIndex > -1)and(LV.SmallImages <>nil) then
    begin
    //獲取圖標的RECT
      if Boolean(ListView_GetSubItemRect(sender.Handle, item.Index, 0, LVIR_ICON, @R1)) then
      begin
        LV.SmallImages.Draw(LV.Canvas, R1.Left, R1.Top, Item.ImageIndex);
      end;
    end;
  end;
begin
  LV := Sender;
  BoundRect := Item.DisplayRect(drBounds);
  InflateRect(BoundRect, -1, 0);
  if Item.Selected then
  begin
    if cdsFocused in State then
    begin
      LV.Canvas.Brush.Color := $00ECCCB9; //  //clHighlight;
//      LV.Canvas.Font.Color := clBtnText; //clHighlightText;
    end
    else
    begin
      LV.Canvas.Brush.Color := $00F8ECE5; //clSilver;
//      LV.Canvas.Font.Color := clBtnText;
    end;
  end
  else
  begin
//    LV.Canvas.Brush.Color := clWindow;
//    LV.Canvas.Font.Color := clWindowText;
  end;
 
  LV.Canvas.FillRect(BoundRect); //初始化背景
 
  for i := 0 to LV.Columns.Count - 1 do
  begin
  //獲取SubItem的Rect
    ListView_GetSubItemRect(LV.Handle, Item.Index, i, LVIR_LABEL, @Rect);
    case LV.Columns[i].Alignment of
      taLeftJustify:
        TextFormat := 0;
      taRightJustify:
        TextFormat := DT_RIGHT;
      taCenter:
        TextFormat := DT_CENTER;
    end;
    case i of
      0: //畫Caption
        begin
          Draw_CheckBox_ImageList(BoundRect, LV.Canvas, Item.Checked);
 
          InflateRect(Rect, -3, 0); //向後移3個像素,避免被後面畫線框時覆蓋
          DrawText(
            LV.Canvas.Handle,
            PCHAR(Item.Caption),
            Length(Item.Caption),
            Rect,
            DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or TextFormat);
        end;
      1..MaxInt: //畫Subitems[i]
        begin
          if i - 1 <= Item.SubItems.Count - 1 then
            DrawText(
              LV.Canvas.Handle,
              PCHAR(Item.SubItems[i - 1]),
              Length(Item.SubItems[i - 1]),
              Rect,
              DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or TextFormat);
        end;
    end;
 
  end;
 
 
  LV.Canvas.Brush.Color := clWhite;
 
  if Item.Selected then //畫選中條外框
  begin
    if cdsFocused in State then
      LV.Canvas.Brush.Color := $00DAA07A // $00E2B598; //clHighlight;
    else
      LV.Canvas.Brush.Color := $00E2B598; //$00DAA07A // clHighlight;
    LV.Canvas.FrameRect(BoundRect); // DrawFocusRect(Item.DisplayRect(drBounds)); //
  end;
 
  DefaultDraw := False; //True;//cdsSelected in State;
 
  with Sender.Canvas do
    if Assigned(Font.OnChange) then Font.OnChange(Font);
 
end;
 
//使用技巧
 
procedure TFormDownLoad.LV_ResourceListCustomDrawItem(
  Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
  if (Item.Index mod 2) = 0 then
    Sender.Canvas.Brush.Color := clWhite
  else
    Sender.Canvas.Brush.Color := $00EBEBEB;
 
  LVDrawItem(LV_ResourceList, Item, State, DefaultDraw);
 
end;

View Code

Delphi中使用TListView顯示數據庫的內容

本例教你在TListView組件中顯示數據庫的內容。

首先建立一個新的項目，而後向窗體上添加一個TQuery組件和一個TListView組件。添加組件後的窗體。

設置TQuery組件的DatabaseName屬性設置爲DBDEMOS，SQL屬性設置爲select * from country，Active屬性設置爲True。而後添加程序初始化代碼以下：

procedure TForm1.FormCreate(Sender: TObject);

var

　i:Integer;

　TempColumn:TListColumn;

　TempItem:TListItem;

begin

　ListView1.ViewStyle:=vsReport;

　for i:=0 to Query1.FieldCount-1 do

　begin

　　TempColumn:=self.ListView1.Columns.Add;

　　TempColumn.Caption:=Query1.Fields[i].FieldName;

　end;

　Query1.First;

　while not Query1.Eof do

　begin

　　TempItem:=self.ListView1.Items.Add;

　　TempItem.Caption:=Query1.Fields[0].AsString;

　　for i:=1 to Query1.FieldCount-1 do

　　begin

　　　TempItem.SubItems.Add(Query1.Fields[i].AsString);

　　end;

　　Query1.Next;

　end;

end;

View Code

程序首先經過ListView1.ViewStyle:=vsReport語句設置TListView組件的ViewStyle屬性值爲vsReport。而後經過第1個循環中的TempColumn:=self.ListView1.Columns.Add和TempColumn.Caption:=Query1.Fields[i].FieldName語句在TListView組件的標題行中顯示數據庫中字段的名稱。最後經過一個循環逐行輸出數據庫的全部數據。

程序代碼以下：

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, DB, ADODB, Grids, DBGrids, ComCtrls, DBTables;

type

　TForm1 = class(TForm)

　Query1: TQuery;

　ListView1: TListView;

　procedure FormCreate(Sender: TObject);

private

　{ Private declarations }

public

　{ Public declarations }

end;

var

　Form1: TForm1;

　implementation

　{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

// www.bianceng.cn 

var

　i:Integer;

　TempColumn:TListColumn;

　TempItem:TListItem;

begin

　ListView1.ViewStyle:=vsReport;

　for i:=0 to Query1.FieldCount-1 do

　begin

　　TempColumn:=self.ListView1.Columns.Add;

　　TempColumn.Caption:=Query1.Fields[i].FieldName;

　end;

　Query1.First;

　while not Query1.Eof do

　begin

　　TempItem:=self.ListView1.Items.Add;

　　TempItem.Caption:=Query1.Fields[0].AsString;

　　for i:=1 to Query1.FieldCount-1 do

　　begin

　　　TempItem.SubItems.Add(Query1.Fields[i].AsString);

　　end;

　　Query1.Next;

　end;

end;

end.

 

View Code

保存文件，而後按F9鍵運行程序，程序運行結果

 Delphi實現下載進程的動態顯示

許多知名的下載軟件中都有下載管理器，用一個TListView來顯示下載的進程，你能夠清楚的看到已經下載了多少，還有多少內容仍需下載，這樣的控件，Delphi自身並未提供，但咱們能夠在TListView的基礎之上加入進度條控件（TProgressBar)來實現這一功能，這樣就能既能知足咱們的實際需求，又不用「犧牲」口袋裏白花花的銀子，還能增長咱們對控件嵌套的認識，一箭三雕，何樂而不爲呢？
 
　　到底該怎麼作呢？讓我想一想……好了讓咱們先從TListView的ViewStyle屬性開始吧，這個屬性咱們經常使用，把TListView作爲一個表格來顯示各類數據時，咱們經常把這個屬性設置成vsReport，設置以後，最左邊的列（Column)包含一個小的圖標和數據，從第二列開始就是顯示一個個字段的數據，這是咱們最多見的TListView的樣子，天天一打開Windows的資源管理器，咱們就能看到它。（如圖一）
 
Delphi實現下載進程的動態顯示
圖一

 
　　打開Delphi，新建一個工程，在自動生成的Form上，放置一個TListView控件，在它的Columns屬性中定義兩列，第一列放置數據項（Item)，第二列用來存放Progress.（如圖二）
 
Delphi實現下載進程的動態顯示
圖二

 
　　在Form上加入一個按鈕（Button)，在按鈕的Click事件中加入以下代碼，用於在按下按鈕時，能夠在TListView的第二列顯示TProgress。
 
　　添加Item的代碼以下：
 
procedure TForm1.AddItemButtonClick(Sender: TObject);
const
　pbColumnIndex = 1;
　pbMax = 100;
var
　li : TListItem;
　lv : TListView;
　pb : TProgressBar;
　pbRect : TRect;
begin
　lv := ListViewEx1;
　//創建一個新的ListItem
　li := lv.Items.Add;
　li.Caption := ’Item ’ + IntToStr(lv.Items.Count);
 
　//創建一個ProgressBar，置入TListView的第二列中
　pb := TProgressBar.Create(nil);
　pb.Parent := lv;
　li.Data := pb;
　pbRect := li.DisplayRect(drBounds);
　pbRect.Left := pbRect.Left +
　lv.Columns[-1 + pbColumnIndex].Width;
　pbRect.Right := pbRect.Left +
　lv.Columns[pbColumnIndex].Width;
　pb.BoundsRect := pbRect;
end; //添加ItemButton事件
 
　　上面的代碼能夠實現這樣的功能：按下按鈕以後，一個Progressbar被創建，一個對Progressbar的引用被加進ListItem的Data屬性，最後，Progressbar被放置在由pbColumnIndex屬性指定的列中。
 
　　當想要將一個項（Item）從TListView中刪除，你必須先判斷添加進去的Progressbar的內存佔用是否已經被釋放，若是已經完成，就繼續。
 
　　刪除Item的代碼以下：
 
procedure TForm1.RemoveItemButtonClick(Sender: TObject);
var
　lv : TListView;
　li : TListItem;
　i, idx : integer;
　pb : TProgressBar;
begin
　lv := ListViewEx1;
 
　li := lv.Selected;
 
　if li <> nil then
　begin
　　idx := li.Index;
　　TProgressBar(li.Data).Free;//先釋放TProgressBar
　　lv.Items.Delete(idx);
 
　　//把行向上移動
　　for i := idx to -1 + lv.Items.Count do
　　begin
　　　li := lv.Items.Item[i];
　　　pb := TProgressBar(li.Data);
　　　pb.Top := pb.Top - (pb.BoundsRect.Bottom - pb.BoundsRect.Top);
　　end;
　end;
end; //刪除ItemButton事件
 
　　完成以後，咱們來測試一下，咱們拖一個TTimer控件，而後在它的OnTime事件中填入下面的代碼，模擬一下在一個真實的環境下，這個被咱們美化過的TListView控件會有如何精彩表現，也讓大夥一塊兒體會一把寫程序的小小成就感吧。（如圖三）
 
Delphi實現下載進程的動態顯示
圖三

 
　　代碼以下：
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
　idx : integer;
　pb: TProgressbar;
　lv : TListView;
begin
　lv := ListViewEx1;
 
　if lv.Items.Count = 0 then Exit;
 
　//隨機生成一個數據項
　//根據生成的數據來控制TProgressBar的長度
　idx := Random(lv.Items.Count);
　pb := TProgressBar(lv.Items[idx].Data);
　if pb.Position < pb.Max then
　　pb.StepIt
　else
　　pb.Position := 0;
end;//Timer事件
 
　　就是這樣的簡單，任何有名的軟件都是由這樣的一個個小知識點構成，只要細心體會知名軟件的優點與長處，模仿而後改進說不定你能作出比它們都棒的軟件！
 
　　開發環境： WindowsXP SP2+Delphi7
 

View Code

 Delphi 2010的TListView擴展了一些功能，其中就有項分組功能，在XP和Vista以上系統有效。可是擴展的更多一些功能只對Vista系統有效。下面在XP SP3下實現TListView的分組效果：

1.新建一個應用程序，拖動一個TListView到窗體上；

2.在窗體建立函數，寫入如下代碼：

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  with lv1 do 
  begin 
    AllocBy := 0;                                //設置總共的項數量，省去每次添加開闢內存空間 
    Checkboxes := False;                         //項左邊出現複選框，vsList or vsReport有效 
    Color := clWindow;                           //背景顏色 
    ColumnClick := True;                         //列頭可否點擊 
    with Columns.Add do                          //增長列 
    begin 
      Alignment := taLeftJustify;                //左對齊 
      Caption := '列一'; 
      ImageIndex := -1; 
      Width := 100; 
    end; 
    with Columns.Add do                          //增長列 
    begin 
      Caption := '列二'; 
      ImageIndex := -1; 
      Width := 50; 
    end; 
    Ctl3D := True; 
    DoubleBuffered := False;                     //雙緩衝 
    Enabled := True; 
    FlatScrollBars := False;                     //平滑滾動條 
    FullDrag := False;                           //容許拖動列頭 
    GridLines := False;                          //表格線 
    GroupHeaderImages := nil;                    //分組頭關聯圖像列表 
    with Groups.Add do                           //增長分組 
    begin 
      BottomDescription := '底部的說明文字'; 
      ExtendedImage := -1;                       //關聯 GroupHeaderImages圖像列表，only on Windows Vista 
      Footer := '頁腳文本'; 
      FooterAlign := taLeftJustify;              //頁腳文本對齊 
      GroupID := 0;                              //組ID號 
      Header := '頁首文本'; 
      HeaderAlign := taLeftJustify; 
      State := [                                 //分組狀態，一些狀態只應用於VISTA系統 
                lgsNormal,                       //全部分組展開 
                lgsHidden,                       //分組隱藏 
                lgsCollapsed,                    //分組摺疊 Windows Vista only. 
                lgsNoHeader,                     //頁首不可見 Windows Vista only. 
                lgsCollapsible,                  //分組可摺疊 Windows Vista only. 
                lgsFocused,                      //分組有鍵盤焦點 Windows Vista only. 
                lgsSelected,                     //分組被選擇 Windows Vista only. 
                lgsSubseted,                     //只有分組的一個子集顯示出來 Windows Vista only. 
                lgsSubSetLinkFocused             //分組的子集有鍵盤焦點  Windows Vista only. 
               ]; 
       SubsetTitle := '子集標題'; 
       Subtitle := '子標題'; 
       TitleImage := -1;                         //關聯 GroupHeaderImages圖像列表，only on Windows Vista 
       TopDescription := '頂部的說明文字'; 
    end; 
    with Groups.Add do 
    begin 
      GroupID := 1; 
      Header := '分組標題'; 
    end; 
    GroupView := True;                            //打開或關閉分組視圖 
    HideSelection := True;                        //失去焦點時，項再也不保持被選擇狀態 
    HotTrack := False;                            //指定是否鼠標移過項進行高亮 
    HotTrackStyles := [ 
                   //  htHandPoint,               //手勢 
                   //  htUnderlineCold,           //非熱點下劃線 
                   //  htUnderlineHot             //下劃線熱點 
                      ]; 
    HoverTime := -1;                              //鼠標在項上暫停時間，除非HotTrack爲True 
    with IconOptions do                           //肯定如何排列圖標，vsIcon or vsSmallIcons 有效 
    begin 
      Arrangement := iaTop;                       //項在頂部從左到右對齊，iaLeft在左部從上到下對齊 
      AutoArrange := False;                       //圖標自動從新排列 
      WrapText := True;                           //圖標標題是否折行 
    end; 
    with Items.Add do                             //增長項 
    begin 
      Caption := '行一列一'; 
      ImageIndex := -1;                           //關聯 LargeImages or SmallImages圖像列表 
      StateIndex := -1;                           //關聯StateImages圖像列表 
      GroupID := 0;                               //關聯分組ID號 
      SubItems.Add('行一列二');                   //添加第二列 
    end; 
    with Items.Add do 
    begin 
      Caption := '行二列一'; 
      GroupID := 1; 
      SubItems.Add('行二列二'); 
    end; 
    LargeImages := nil;                            //大圖標圖像列表 
    MultiSelect := False;                          //多選 
    OwnerData := False;                            //指定列表視圖控件是不是虛擬的 
    OwnerDraw := False;                            //自繪項 
    ParentColor := False;                          //繼承父控件顏色 
    ReadOnly := False;                             //只讀 
    RowSelect := False;                            //整行選擇 
    ShowColumnHeaders := True;                     //顯示列頭，vsReport有效 
    ShowWorkAreas := False;                        //顯示工做區，vsIcon or vsSmallIcon有效，不支持 OwnerData 
    SmallImages := nil;                            //小圖標圖像列表 
    SortType := stNone;                            //肯定列表項如何自動排序 
    StateImages := nil;                            //狀態圖像列表 
    ViewStyle := vsReport;                         //視圖風格，vsIcon、vsSmallIcon、vsList、vsReport 
  end; 
end; 

View Code

拖動一個TImageList到窗體上，添加一些圖標到TImageList上，使TListView全部能夠關聯圖像列表的都關聯到此TImageList上，而後分別設置圖像索引的不一樣

 

在ListView中添加一個進度條

看CxGrid資料的時候,看見了一個爲兄弟的文章,我就轉一下了.
 
//須要Use CommCtrl
Function GetSubItemRect( handle, ItemsIndex, SubIndex: Integer ): TRect ;
Begin
ListView_GetSubItemRect( Handle, ItemsIndex, SubIndex, 0, @Result ) ;
End ;
Procedure TFormMain.lvw_listCustomDrawSubItem( Sender: TCustomListView ;
Item: TListItem ;SubItem: Integer ;State: TCustomDrawState ;
Var DefaultDraw: Boolean ) ;
Var
l_Rect: TRect ;
l_intPercent: Integer ;
Begin
If SubItem = 3 Then
Begin
If Item.Data = Nil Then
Exit ;
l_intPercent := PListData( Item.Data ).Percent ;
//獲取ListView子項的Rect
l_Rect := GetSubItemRect( Item.Handle, Item.Index, SubItem ) ;
//畫一條外邊框
InflateRect( l_Rect, -1, -1 ) ;
Sender.Canvas.Brush.Color := clBlack ;
Sender.Canvas.FrameRect( l_Rect ) ;
//先填充底色
InflateRect( l_Rect, -1, -1 ) ;
Sender.Canvas.Brush.Color := lvw_list.Color ;
Sender.Canvas.FillRect( l_Rect ) ;
//再根據進度畫出完成區域
If l_intPercent = 100 Then
Sender.Canvas.Brush.Color := clGreen
Else
Sender.Canvas.Brush.Color := clPurple ;
l_Rect.Right := l_Rect.Left + Floor( ( l_Rect.Right - l_Rect.Left ) * l_intPercent / 100 ) ;
Sender.Canvas.FillRect( l_Rect ) ;
//恢復筆刷
Sender.Canvas.Brush.Color := lvw_list.Color ;
//關鍵的一句，屏蔽系統自繪過程
DefaultDraw := False ;
End ;
End ;
相關定義
Type
TListData = Record
FileName: String ;
Percent: Integer ;
End ;
PListData = ^TListData ;

 

View Code

listview導出到excel

uses  
   ExcelXP, strutils, QDialogs, Variants;

 
 function  get_listviewTOexcel(listview:TListView;strTitle:string;strTerm :string):Boolean;
var
  //------------------------------------
  ExcelApplication1: TExcelApplication;
  ExcelWorksheet1: TExcelWorksheet;
  ExcelWorkbook1: TExcelWorkbook;
  //------------------------------------
  SaveDialog_EXCEL : TSaveDialog;//文件保存控件
  //------------------------------------
  filename :string; //文件名
  next_i   :Boolean;//是否能夠繼續運行
  //------------------------------------
  cyc_i    :Integer;
  cyc_j    :Integer;
  cyc_k    :Integer;
  //------------------------------------
begin
  //保存文件對話框
  SaveDialog_EXCEL := TSaveDialog.Create(nil);
  SaveDialog_EXCEL.Filter:= 'EXCEL電子表格|*.xls';
  SaveDialog_EXCEL.Title := '保存到';
  //檢查Excel是否安裝
  try
    ExcelApplication1 := (TExcelApplication.Create(Application));
    ExcelWorksheet1   := TExcelWorksheet.Create(Application);
    ExcelWorkbook1    := TExcelWorkbook.Create(Application);
    ExcelApplication1.Connect;
    next_i := True;
  except
    Application.Messagebox('沒有安裝 Excel。', '錯誤', MB_OK + MB_ICONINFORMATION);
    Abort;
    next_i := False;
  end;
  //調用Excel----------------------
  if next_i then
    begin
      try
        ExcelApplication1.Workbooks.Add(EmptyParam, 0);
        ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
        ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet);
      except
        Application.Messagebox('調用Excel失敗，Excel不可用。', '錯誤', MB_OK + MB_ICONINFORMATION);
        next_i := False;
      end;
    end;
  //選擇保存到什麼位置-------------
  if next_i then
    begin
      if SaveDialog_EXCEL.Execute =  True then
        begin
          if rightstr(SaveDialog_EXCEL.FileName,4) <> '.xls' then
          SaveDialog_EXCEL.FileName := SaveDialog_EXCEL.FileName + '.xls';
          filename := SaveDialog_EXCEL.FileName;
        end
      else
        begin
          next_i := False;
        end;
    end;
  //寫字段名------------------------
  if next_i then
    begin
    for cyc_i:=0 to listview.Columns.Count-1 do//  DBG_WriteExcel.Columns.Count-1 do
      begin
        ExcelWorksheet1.Cells.Item[5, cyc_i + 1]:= listview.Columns[cyc_i].Caption; //DBG_WriteExcel.Columns.Items[j].Title.Caption;
        ExcelWorksheet1.Cells.item[5, cyc_i + 1].font.size := '10';
      end;
    end;
  //寫數據------------------------
  if next_i then
    begin
      try
        for cyc_j := 6 to listview.Items.Count + 5 do  //行
          begin
            for cyc_i:=0 to listview.Columns.Count-1 do//列
              begin
                //列值也有多是Caption
                if cyc_i= 0 then
                  begin
                    ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].NumberFormatLocal:='@';
                    ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].font.size := '10';
                    //ShowMessage( listview.Columns[cyc_i].Caption +'  '+ listview.Items[cyc_j-4].Caption );
                    ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].Value  := listview.Items[cyc_j-6].Caption;
                  end
                else
                  begin
                    if listview.Columns[cyc_i].MaxWidth<>1 then
                      begin
                        ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].NumberFormatLocal:='@';
                        ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].font.size := '10';
                        //ShowMessage( listview.Columns[cyc_i].Caption +'  '+ listview.Items[cyc_j-4].SubItems[cyc_i-1] );
                        ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].Value  := listview.Items[cyc_j-6].SubItems[cyc_i-1];
                      end
                    else
                      begin
                        ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].NumberFormatLocal:='@';
                        ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].font.size := '10';
                        ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].Value  := '';
                      end
                  end;
              end;
          end;
      except
        next_i:= False;
        Application.Messagebox(pchar('網絡鏈接失敗，數據爲能所有導出'), '提示',MB_OK + MB_ICONINFORMATION);
      end;
    end;
  //保存信息-----------------------
  if next_i then
    begin
      try
        ExcelWorksheet1.Columns.AutoFit;
        //表頭
        with ExcelWorkSheet1 do            //將第一行的標題合併居中
          begin
            Columns.AutoFit;
            Cells.item[1, 1] := strTitle;
            Cells.Item[1, 1].font.size := '14';
            Cells.Item[1, 1].Font.Bold := True;
            Range[Cells.Item[1,1], Cells.Item[1,listview.Columns.Count]].HorizontalAlignment:=xlCenter; //水平居中
            Range[Cells.Item[1,1], Cells.Item[1,listview.Columns.Count]].VerticalAlignment  :=xlCenter;      //垂直居中
            Range[Cells.Item[1,1], Cells.Item[1,listview.Columns.Count]].Select;
            Range[Cells.Item[1,1], Cells.Item[1,listview.Columns.Count]].Merge(Cells.Item[1,listview.Columns.Count]);     //合併單元格
          end;

//with   ExcelWorkSheet1   do            //將第一行的標題合併居中
// begin
//      Columns.AutoFit;
//      Cells.Item[1,1]:='標題';
//      Range[Cells.Item[1,1],Cells.Item[1,8]].HorizontalAlignment:=xlCenter;    //水平居中
//    Range[Cells.Item[1,1],Cells.Item[1,8]].VerticalAlignment:=xlCenter;      //垂直居中
//    Range[Cells.Item[1,1],Cells.Item[1,8]].Select;
//      Range[Cells.Item[1,1],Cells.Item[1,8]].Merge(Cells.Item[1,k]);     //合併單元格
//   Cells.Item[1,8].Font.Size:='20';
//end;

        //生成日期
        ExcelWorksheet1.Cells.item[2, 1] := '生成時間:'+ FormatDateTime('yyyy年MM月dd日  hh:mm:ss',Now);
        ExcelWorksheet1.Cells.Item[2, 1].font.size := '14';
        //查詢條件
        ExcelWorksheet1.Cells.item[3, 1] := strTerm;
        ExcelWorksheet1.Cells.Item[3, 1].font.size := '14';
        //保存信息到文件
        ExcelWorksheet1.SaveAs(filename);
        Application.Messagebox(pchar('數據已成功導出至：' + UpperCase(filename) ), '提示', MB_OK + MB_ICONINFORMATION);
      except
        next_i:= False;
        Application.Messagebox(pchar('數據導出失敗：' + UpperCase(filename) ), '提示', MB_OK + MB_ICONINFORMATION);
      end;
    end;

  //資源釋放
  try
    ExcelApplication1.Disconnect;
    ExcelApplication1.Quit;
    ExcelApplication1.Free;
    ExcelWorksheet1.Free;
    ExcelWorkbook1.Free;
  except

  end;

  Result := next_i;
end;
 
調用：  get_listviewTOexcel(lvCLLB,'','');

View Code

 

 插入、載入

procedure TMainFrm_U.TSavaClick(Sender: TObject);
{保存rxrichedit編輯後的內容}
var
  stringstream1: TStringStream;
begin
  stringstream1 := TStringStream.create('');
  rxRichEdit1.Lines.SaveToStream(stringstream1);//須要對這個流文件進行壓縮
  if rxRichEdit1.Modified then   //當已打開的文件被修改了之後
  begin
  UniQuery1.SQL.Text :='UPDATE Rich SET F_Con = :F_Con WHERE Type_id = :Type_id' ;
  UniQuery1.ParamByName('Type_id').AsString := PMyData(TreeView1.Selected.Data)^.ID;
  UniQuery1.ParamByName('F_Con').LoadFromStream(stringstream1, DB.ftBlob);
  UniQuery1.Execute;
  end;

end;


procedure TMainFrm_U.TreeView1Click(Sender: TObject);
{查詢文本內容}
var
  Titem: Tlistitem;
  query: TUniQuery;
  mStream: TStringStream;
  ms: TMemoryStream;
   T: DWORD;
begin
  if TreeView1.Selected <> nil then
  begin
    if TreeView1.Selected.Data <> nil then
    begin
    T := GetTickCount;
      StatusBar1.Panels[1].Text := TreeView1.Selected.Text;
      query := TUniQuery.create(nil);
      query.Connection := UniConnection1;
      query.SQL.Clear;
      query.SQL.Add('Select Type_id,F_Con from Rich where Type_id=:Type_id');
      query.ParamByName('Type_id').AsString := PMyData(TreeView1.Selected.Data)^.ID;
      // UniQuery1.ParamByName('a6').LoadFromFile(OpenDialog1.FileName,DB.ftBlob);
      query.Open;
      ListView1.Clear;
      if query.RecordCount>0 then
      begin
     // if query. then

      while not query.Eof do
      begin
        Titem := ListView1.Items.Add;
        //ms := TMemoryStream.create;
        //mStream := TStringStream.create('');
         Titem.Caption := Query.FieldByName('Type_id').AsString;
         Label1.Caption:=Treeview1.Selected.Text;
         //Titem.SubItems.Add(query.FieldByName('Type_id').AsString);
         //Titem.Data:='';
        // stringstream1 := TStream.Create;
        // (Query.FieldByName('Type_id') as TBlobField).SaveToStream(stringstream1);
        //TBlobField(query.FieldByName('F_Con')).SaveToStream(mStream);
        // ms.SaveToStream(mStream);
       // RichEdit1.Lines.LoadFromStream(mStream);
        //TBlobField(query.FieldByName('F_Con')).Assign(RichEdit1.Lines);
         rxRichEdit1.Lines.Assign(query.FieldByName('F_Con'));
        //query.Post;
        query.next;
      end;
      StatusBar1.Panels[1].Text := Format('用時: %d ms', [GetTickCount - T]);
       end
       else
       begin
         rxRichEdit1.Clear;
       end;
      UniQuery1.close;
    end;
    { PMyData(TreeView1.Selected.Data)
      ^.idName + PMyData(TreeView1.Selected.Data)^.LName; }
  end;
end;

View Code