|
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"ListViewのHeaderにソート矢印を描画"
MES6#33189FermionさんのRESを参考にListViewソート時の矢印描画をヘッダーに
描画するサンプルです。
実際のソートは行ってません。
CommCtrlをuseしてください。
---------------------------------------------------------------------
type
TForm1 = class(TForm)
ListView1: TListView;
procedure FormCreate(Sender: TObject);
procedure ListView1ColumnClick(Sender: TObject; Column:
TListColumn);
private
{ Private 宣言 }
ACanvas: TCanvas;
HHeader: HWND;
SortCol: Integer; //ソート対象のColumn
IsUpperSort: Boolean;
TmpDis: TDrawItemStruct;
FOldWndProc: TWndMethod;
procedure NewWndProc( var Msg: TMessage );
procedure DrawItem( const dis: TDrawItemStruct );
procedure DrawSortHeader(ARect: TRect; Selected: Boolean);
procedure DrawSortArrow(ARect: TRect);
procedure SetOwnerDrawColumn(Idx: Integer; OwnerDraw: Boolean);
public
{ Public 宣言 }
end;
function NewHeaderWndProc( TheWindow: HWND; Msg: Integer;
wParam: WPARAM; lParam: LPARAM ): Longint;
stdcall;
var
Form1: TForm1;
FOldHDWndProc: TFNWndProc;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
SortCol := -1;
//ListViewのHeaderをGet
HHeader := ListView_GetHeader(ListView1.Handle);
//ListView Message処理を交換
FOldWndProc := ListView1.WindowProc;
ListView1.WindowProc := NewWndProc;
//HeaderのMessageを処理
FOldHDWndProc := TFNWndProc( SetWindowLong( HHeader,
GWL_WNDPROC,
Longint(@NewHeaderWndProc)));
end;
procedure TForm1.ListView1ColumnClick(Sender: TObject;
Column: TListColumn);
begin
if SortCol <> Column.Index then
IsUpperSort := True
else
IsUpperSort := not IsUpperSort;
//以前のソートColumnをDefaultで描画
SetOwnerDrawColumn(SortCol, False);
//SortColの描画はNewHeaderWndProcで処理
SortCol := Column.Index;
end;
{オーナードローの描画処理}
procedure TForm1.DrawItem(const dis: TDrawItemStruct);
var
SavedDC: Integer;
begin
if HHeader = 0 then Exit;
TmpDis := dis;
ACanvas := TCanvas.Create;
try
SavedDC := SaveDC(dis.hDC);
try
ACanvas.Handle := dis.hDC;
ACanvas.Font := ListView1.Font;
ACanvas.Brush.Color := clBtnFace;
ACanvas.FillRect(dis.rcItem);
DrawSortHeader(dis.rcItem, dis.itemState = ODS_SELECTED);
finally
ACanvas.Handle := 0;
RestoreDC(dis.hDC, SavedDC);
end;
finally
ACanvas.Free;
end;
end;
//ListViewのメッセージ処理OwnerDraw時のみ発生する
procedure TForm1.NewWndProc(var Msg: TMessage);
var
dis: TDrawItemStruct;
i: Integer;
begin
if Msg.Msg = WM_DRAWITEM then
begin
dis := TWMDrawItem(Msg).DrawItemStruct^;
DrawItem(dis);
end;
FOldWndProc(Msg);
end;
//HeaderのMessage処理 Columnの幅変更時の描画処理
function NewHeaderWndProc(TheWindow: HWND; Msg: Integer;
wParam: WPARAM; lParam: LPARAM): Longint;
begin
Result := CallWindowProc( FOldHDWndProc, TheWindow,
Msg, wParam, lParam );
case Msg of
WM_CAPTURECHANGED: Form1.SetOwnerDrawColumn(Form1.SortCol, True );
end;
end;
//Sortヘッダーを描画する
procedure TForm1.DrawSortHeader(ARect: TRect; Selected: Boolean);
var
Rct, ArrowRct: TRect;
uformat: Cardinal;
theColumn: TListColumn;
begin
Rct := ARect;
inflateRect(Rct, -6,-1);
Rct.Top := Rct.Top + 1;
//ソート矢印の大きさと場所を設定
ArrowRct := Rect(Rct.Right - 8, Rct.Top + 2,
Rct.Right, Rct.Bottom -4);
Rct.Right := ArrowRct.Left;
//Columnがクリックされたときの処理
if Selected then
begin
OffsetRect(Rct, 1,1);
OffsetRect(ArrowRct, 1,1);
end;
theColumn := ListView1.Columns[SortCol];
uformat := DT_SINGLELINE or DT_NOPREFIX or DT_NOCLIP or
DT_VCENTER or DT_END_ELLIPSIS;
case theColumn.Alignment of
taRightJustify: uformat := uformat or DT_RIGHT;
taCenter: uformat := uformat or DT_CENTER;
else uformat := uformat or DT_LEFT;
end;
DrawText(ACanvas.Handle, PChar(theColumn.Caption), -1, Rct,
uformat);
//ソート矢印を描画する
DrawSortArrow(ArrowRct);
end;
//ソート用矢印を描画
procedure TForm1.DrawSortArrow(ARect: TRect);
var
c: Integer;
begin
c := (ARect.Right - ARect.Left) div 2 + ARect.Left;
with ACanvas do
begin
Pen.Style := psSolid;
if IsUpperSort then
begin
Pen.Color := clBtnHighlight;
MoveTo(c, ARect.Top);
LineTo(ARect.Right, ARect.Bottom);
LineTo(ARect.Left, ARect.Bottom);
Pen.Color := clBtnShadow;
LineTo(c, ARect.Top);
end else
begin
Pen.Color := clBtnHighlight;
MoveTo(ARect.Right, ARect.Top);
LineTo(c, ARect.Bottom);
Pen.Color := clBtnShadow;
LineTo(ARect.Left, ARect.Top);
LineTo(ARect.Right, ARect.Top);
end;
end;
end;
{HeaderのOwnerDrawのOn/Off処理
OwnerDraw=TrueでListViewのMessageにWM_DRAWITEMが発生する}
procedure TForm1.SetOwnerDrawColumn(Idx: Integer; OwnerDraw: Boolean);
var
hdi: THDItem;
begin
if HHeader = INVALID_HANDLE_VALUE then Exit;
hdi.Mask := HDI_FORMAT;
Header_GetItem(HHeader, Idx, hdi);
if OwnerDraw then
begin
hdi.fmt := hdi.fmt or HDF_OWNERDRAW;
hdi.fmt := hdi.fmt and not HDF_STRING;
end else
begin
hdi.fmt := hdi.fmt and not HDF_OWNERDRAW;
hdi.fmt := hdi.fmt or HDF_STRING;
end;
Header_SetItem(HHeader, Idx, hdi);
end;
end.
---------------------------------------------------------------------
2001/02/17(Sat) 09:18pm BYI11634 MOMO_P
- FDELPHI MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 01/02/18 -
Original document by MOMO_P 氏 ID:(BYI11634)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。
Copyright 1996-2002 Delphi Users' Forum
|