お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
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