Ordinamento ListView colonne con frecce

Question

Sto usando Delphi 6 e voglio aggiungere la funzionalità di ordinare un ListView, come è fatto in Windows Explorer.

In un primo test, ho (Quick & sporco) copiato alcuni codici sorgente da alcune fonti, e fatto alcuni piccoli aggiustamenti:

Questo è quello che ho finora (solo veloce & sporco per ora):

uses 
    CommCtrls; 

var 
    Descending: Boolean; 
    SortedColumn: Integer; 

const 
    { For Windows >= XP } 
    {$EXTERNALSYM HDF_SORTUP} 
    HDF_SORTUP    = $0400; 
    {$EXTERNALSYM HDF_SORTDOWN} 
    HDF_SORTDOWN   = $0200; 

procedure ShowArrowOfListViewColumn(ListView1: TListView; ColumnIdx: integer; Descending: boolean); 
var 
    Header: HWND; 
    Item: THDItem; 
begin 
    Header := ListView_GetHeader(ListView1.Handle); 
    ZeroMemory(@Item, SizeOf(Item)); 
    Item.Mask := HDI_FORMAT; 
    Header_GetItem(Header, ColumnIdx, Item); 
    Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN);//remove both flags 
    if Descending then 
    Item.fmt := Item.fmt or HDF_SORTDOWN 
    else 
    Item.fmt := Item.fmt or HDF_SORTUP;//include the sort ascending flag 
    Header_SetItem(Header, ColumnIdx, Item); 
end; 

procedure TUD2MainForm.ListView3Compare(Sender: TObject; Item1, 
    Item2: TListItem; Data: Integer; var Compare: Integer); 
begin 
    if SortedColumn = 0 then 
    Compare := CompareText(Item1.Caption, Item2.Caption) 
    else 
    Compare := CompareText(Item1.SubItems[SortedColumn-1], Item2.SubItems[SortedColumn-1]); 
    if Descending then Compare := -Compare; 
end; 

procedure TUD2MainForm.ListView3ColumnClick(Sender: TObject; 
    Column: TListColumn); 
begin 
    TListView(Sender).SortType := stNone; 
    if Column.Index<>SortedColumn then 
    begin 
    SortedColumn := Column.Index; 
    Descending := False; 
    end 
    else 
    Descending := not Descending; 
    ShowArrowOfListViewColumn(TListView(Sender), column.Index, Descending); 
    TListView(Sender).SortType := stText; 
end; 

Le colonne possono essere ordinati a monte e verso il basso, ma non riesco a vedere le frecce.

In base a this question, la mia funzione ShowArrowOfListViewColumn() dovrebbe aver risolto il problema.

È possibile che Delphi 6 non supporti questa funzione o ci sia un problema nel mio codice? D'altra parte, ListView è IIRC a Windows control e quindi mi aspetto che WinAPI restituisca la grafica a freccia e non il (molto vecchio) VCL.

Ho letto in un German website che la grafica della freccia deve essere aggiunta manualmente, ma la soluzione di tale sito Web ha l'obbligo di cambiare CommCtrl.pas di Delphi (a causa di un problema tecnico durante il ridimensionamento della colonna). Ma mi piace davvero modifing la fonte VCL, soprattutto perché io sviluppo OpenSource, e io non voglio che altri sviluppatori cambiano/ricompilare le loro fonti di Delphi.

Nota che non ho aggiunto un manifest XP al mio binario, quindi l'app sembra Win9x.

Answer 1

HDF_SORTDOWN e HDF_SORTUP richiedono comctl32 v6. Questo è indicato nella documentazione per HDITEM:

HDF_SORTDOWN versione 6.00 e successive. Disegna una freccia verso il basso su questo oggetto. Viene in genere utilizzato per indicare che le informazioni nella finestra corrente sono ordinate in questa colonna in ordine decrescente. Questo flag non può essere combinato con HDF_IMAGE o HDF_BITMAP.

HDF_SORTUP Versione 6.00 e successive. Disegna una freccia su questo elemento. Questo viene in genere utilizzato per indicare che le informazioni nella finestra corrente sono ordinate su questa colonna in ordine crescente. Questo flag non può essere combinato con HDF_IMAGE o HDF_BITMAP.

Come spiegato nei commenti, non è stato incluso manifest di comctl32 v6. Questo spiega ciò che osservi.

soluzioni includono:

• Aggiungendo il V6 manifesta comctl32, o
• disegno personalizzato frecce di intestazione.

Answer 2

Non è necessario per cambiare la sorgente VCL a seguire l'esempio tedesco, si può solo patchare il codice runtime.

DISCALMER ho voluto testare il mio codice su Delphi 6, ma la mia installazione di Delphi 6 non partiva questa mattina, quindi è testato solo su Delphi XE!

Ma suppongo che funzionerebbe anche su Delphi 6.

In primo luogo è necessaria una classe di patch un metodo di esecuzione:

unit PatchU; 

interface 

type 
    pPatchEvent = ^TPatchEvent; 

    // "Asm" opcode hack to patch an existing routine 
    TPatchEvent = packed record 
    Jump: Byte; 
    Offset: Integer; 
    end; 

    TPatchMethod = class 
    private 
    PatchedMethod, OriginalMethod: TPatchEvent; 
    PatchPositionMethod: pPatchEvent; 
    public 
    constructor Create(const aSource, aDestination: Pointer); 
    destructor Destroy; override; 
    procedure Restore; 
    procedure Hook; 
    end; 

implementation 

uses 
    Windows, Sysutils; 

{ TPatchMethod } 

constructor TPatchMethod.Create(const aSource, aDestination: Pointer); 
var 
    OldProtect: Cardinal; 
begin 
    PatchPositionMethod := pPatchEvent(aSource); 
    OriginalMethod := PatchPositionMethod^; 
    PatchedMethod.Jump := $E9; 
    PatchedMethod.Offset := PByte(aDestination) - PByte(PatchPositionMethod) - SizeOf(TPatchEvent); 

    if not VirtualProtect(PatchPositionMethod, SizeOf(TPatchEvent), PAGE_EXECUTE_READWRITE, OldProtect) then 
    RaiseLastOSError; 

    Hook; 
end; 

destructor TPatchMethod.Destroy; 
begin 
    Restore; 
    inherited; 
end; 

procedure TPatchMethod.Hook; 
begin 
    PatchPositionMethod^ := PatchedMethod; 
end; 

procedure TPatchMethod.Restore; 
begin 
    PatchPositionMethod^ := OriginalMethod; 
end; 

end. 

allora abbiamo bisogno di usarlo. Pau un controllo ListView in un modulo di un allora questo codice:

unit Unit1; 

interface 

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

type 
    TListView = class(ComCtrls.TListView) 
    protected 
    procedure ColClick(Column: TListColumn); override; 
    end; 

    TForm1 = class(TForm) 
    ListView1: TListView; 
    private 
    { Private declarations } 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

uses 
    CommCtrl; 

var 
    ListView_UpdateColumn_Patch: TPatchMethod; 

type 
    THooked_ListView = class(TListView) 
    procedure HookedUpdateColumn(AnIndex: Integer); 
    end; 

    { TListView } 

procedure TListView.ColClick(Column: TListColumn); 
var 
    Header: HWND; 
    Item: THDItem; 
    NewFlag: DWORD; 
begin 
    Header := ListView_GetHeader(Handle); 
    ZeroMemory(@Item, SizeOf(Item)); 
    Item.Mask := HDI_FORMAT; 
    Header_GetItem(Header, Column.Index, Item); 

    if Item.fmt and HDF_SORTDOWN <> 0 then 
    NewFlag := HDF_SORTUP 
    else 
    NewFlag := HDF_SORTDOWN; 

    Item.fmt := Item.fmt and not(HDF_SORTUP or HDF_SORTDOWN); // remove both flags 
    Item.fmt := Item.fmt or NewFlag; 
    Header_SetItem(Header, Column.Index, Item); 

    inherited; 
end; 

{ THooked_ListView } 

procedure THooked_ListView.HookedUpdateColumn(AnIndex: Integer); 
begin 
    ListView_UpdateColumn_Patch.Restore; 
    try 
    UpdateColumn(AnIndex); 
    finally 
    ListView_UpdateColumn_Patch.Hook; 
    end; 
end; 

initialization 

ListView_UpdateColumn_Patch := TPatchMethod.Create(@TListView.UpdateColumn, @THooked_ListView.HookedUpdateColumn); 

finalization 

ListView_UpdateColumn_Patch.Free; 

end. 

Come si vede poi il mio demo ho heavly ispirato dal codice hai pubblicato. Ho appena rimosso i vars globali. Nel mio esempio, non faccio altro che chiamare la procedura originale, ma dovrai chiamare il codice dell'esempio Geraman.

Quindi, in pratica, volevo solo mostrarti come puoi modificare la VCL senza modificare il codice sorgente originale. Questo dovrebbe farti andare.