Visualizza il feed RSS

cyberlaundry

[Delphi 7] TDBGrid "tattile" per muoversi con "touch & gesture"

Valuta questo inserimento
di pubblicato il 13-02-2011 alle 13:16 (3436 Visite)
Questo codice è nato per una necessità lavorativa: dare la possibilità ad un utente che usa un touch screen di scrollare una TDBGrid senza usare né mouse né tastiera, ma "trascinando" il contenuto in modo tattile.
É l'effetto casalingo del "touch and gesture" di Windows7, ampiamente implementato da Delphi2010 in poi, ma può tornare comodo in molte situazioni, specie se si usa, come me, una versione "meno recente" di Delphi.

Sfruttando gli eventi di Drag (StartDrag, DragDrop, DragOver) è possibile "memorizzare" la cella che si inizia a trascinare e convertire il movimento di trascinamento in scroll della griglia sfruttando i messaggi WM_HSCROLL e WM_VSCROLL di Windows. Purtroppo la DBGrid (AFAIK) non è in grado di scrollare in modo "soft", quindi lo spostamento avviene, come con le normali scrollbar, di riga in riga, o di colonna in colonna.

Nell'esempio viene sfruttato anche il messaggio WM_NCCALCSIZE per impedire la visualizzazione delle scrollbar della griglia, definendo un interposer della classe TDBGrid. Definendo questo nuovo oggetto in una unit, sarà quindi sufficiente dichiararlo nelle uses della sezione interface affiché tutte le DBGrid di quella unit siano ridichiarate.

Chiameremo la nostra unit "U_DBGrid_Interposer":

codice:
unit U_DBGrid_Interposer;

interface

uses
  Controls, Grids, DBGrids, Messages, Types, Classes;
Ridefiniamo ora la classe TDBGrid come classe di sé stessa.
Intercettiamo il messaggio WM_NCCALCSIZE di Windows, in modo da inibire la visualizzazione delle scrollbar e definiamo le override dei metodi che ci interessano per "convertire" il drag & drop in spostamento:

codice:
type
  TDBGrid = class(DBGrids.TDBGrid)
  private
    FDragCell: TGridCoord;
    Procedure WMNCCalcSize( Var msg: TMessage); message WM_NCCALCSIZE;
  protected
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override;
    procedure DoStartDrag(var DragObject: TDragObject); override;
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;  Column: TColumn; State: TGridDrawState); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  public
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    constructor Create(AOwner: TComponent); override;
  end;

implementation

uses
  Windows, Graphics;
Nel metodo Create semplicemente mettiamo a -1 la riga iniziale di spostamento

codice:
  
constructor TDBGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDragCell.Y := -1;
end;
Qui nascondiamo le scrollbar. Notare che se si imposta DBGrid.DragMode = dmManual, la griglia si comporta in modo "normale".

codice:
procedure TDBGrid.WMNCCalcSize(var msg: TMessage);
var
  style: Integer;
begin
  if DragMode = dmManual then
    exit;

  style := getWindowLong(handle, GWL_STYLE);
  If (style and WS_VSCROLL) <> 0 Then
    SetWindowLong(handle, GWL_STYLE, style and not WS_VSCROLL);
  If (style and WS_HSCROLL) <> 0 Then
    SetWindowLong(handle, GWL_STYLE, style and not WS_HSCROLL);
  inherited;
end;
Nel metodo DragOver imponiamo lo Scroll della DBGrid facendo la differenza tra le coordinate della cella dove si trova il mouse e la cella dove è iniziato il Drag.

codice:
procedure TDBGrid.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  iVal: integer;
  Amsg: TMessage;
  Agc: TGridCoord;
  P: TPoint;
begin
  inherited DragOver(Source, X, Y, State, Accept);
  Accept := Source = self;
  if not(Accept) then
    exit;

  P := ScreenToClient(Mouse.CursorPos);
  Agc := MouseCoord(P.X, P.Y);

  iVal := Agc.X - FDragCell.X;
  if iVal <> 0 then
  begin
    if iVal < 0 then
      Amsg.WParamLo := SB_LINERIGHT
    else
      Amsg.WParamLo := SB_LINELEFT;
    Amsg.WParamHi := 0;
    iVal := round(abs(iVal));
    while iVal > 0 do
    begin
      PostMessage(Handle, WM_HSCROLL, Amsg.WParam, 0);
      dec(iVal);
    end;
    Invalidate;
  end;

  iVal := Agc.Y - FDragCell.Y;
  if iVal <> 0 then
  begin
    if iVal < 0 then
      Amsg.WParamLo := SB_LINEDOWN
    else
      Amsg.WParamLo := SB_LINEUP;
    Amsg.WParamHi := 0;
    iVal := round(abs(iVal));
    while iVal > 0 do
    begin
      PostMessage(Handle, WM_VSCROLL, Amsg.WParam, 0);
      dec(iVal);
    end;
    Invalidate;
  end;
  FDragCell := Agc;
end;
Nel metodo StartDrag, semplicemente, memorizziamo le coordinate della cella dove inizia il trascinamento.

codice:
procedure TDBGrid.DoStartDrag(var DragObject: TDragObject);
var
  P: TPoint;
begin
  inherited DoStartDrag(DragObject);
  if DragMode = dmAutomatic then
  begin
    P := ScreenToClient(Mouse.CursorPos);
    FDragCell := MouseCoord(P.X, P.Y);
  end;
end;
In corrispondenza del metodo DragDrop resettiamo al valore "nullo" le coordinate iniziali di trascinamento e simuliamo un "mouse down" e successivo "mouse up" per selezionare la cella corretta.

codice:
procedure TDBGrid.DragDrop(Source: TObject; X, Y: Integer);
var
  Agc: TGridCoord;
  P: TPoint;
  Amsg: TMessage;
begin
  inherited DragDrop(Source, X, Y);
  FDragCell.Y := -1;
  Invalidate;

  P := ScreenToClient(Mouse.CursorPos);
  Agc := MouseCoord(P.X, P.Y);
  AMsg.LParamLo := P.X;
  AMsg.LParamHi := P.Y;
  AMsg.WParam := MK_LBUTTON;
  PostMessage(Handle, WM_LBUTTONDOWN, Amsg.WParam, Amsg.LParam);
  PostMessage(Handle, WM_LBUTTONUP, Amsg.WParam, Amsg.LParam);
end;
Nel metodo MouseMove, se avviene tenendo premuto il tasto sinistro del mouse, iniziamo il drag.

codice:
procedure TDBGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  inherited MouseMove(Shift, X, Y);
  if (DragMode = dmManual) and not(Dragging) and (Shift = [ssLeft]) then
  begin
    P := ScreenToClient(Mouse.CursorPos);
    FDragCell := MouseCoord(P.X, P.Y);
    BeginDrag(True);
  end;
end;
Questa è una finezza: coloriamo in clLime la riga che stiamo trascinando ereditando il metodo DrawColumnCell. Impostare DefaultDrawing a False per attivare l'effetto.

codice:
procedure TDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;  Column: TColumn; State: TGridDrawState);
var
  P: TPoint;
  Agc: TGridCoord;
begin
  inherited DrawColumnCell(Rect, DataCol, Column, State);
  if DefaultDrawing then
    exit;
    
  // Calcolo il punto centrale del rettangolo della cella
  P.X := (Rect.Left + Rect.Right) div 2;
  P.Y := (Rect.Bottom + Rect.Top) div 2;
  // Converto in coordinate della griglia
  Agc := MouseCoord(P.X, P.Y);
  // Se è la riga che sto trascinando, coloro in modo diverso
  if Agc.Y = FDragCell.Y then
  begin
    Canvas.Brush.Color := clLime;
    Canvas.FillRect(Rect);
  end;
  DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
Fine unit

codice:
end.
Se qualcuno è in grado di suggerire migliorie, ben vengano! Nella fattispecie, sarebbe bello rendere "soft" lo spostamento.

aggiornamento da 10-11-2011 a 06:59 di cyberlaundry

Categorie
Programmazione

Commenti