给 TStringGrid 添加鼠标拖动功能 - 回复 "dxx" 的问题

问题来源: http://www.cnblogs.com/del/archive/2008/12/11/1091310.html#1398793

---

本例效果图(这个例子还有问题, 拖动和移动的距离单位不一样):

---

代码文件:

---

unit Unit1;



interface



uses

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

  Dialogs, Grids;



type

  TForm1 = class(TForm)

    StringGrid1: TStringGrid;

    procedure FormCreate(Sender: TObject);

    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,

      Y: Integer);

    procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



var

  flag: Boolean;

  x1,y1: Integer;



{初始化测试数据}

procedure TForm1.FormCreate(Sender: TObject);

var

  i,j: Integer;

begin

  StringGrid1.ColCount := 100;

  StringGrid1.RowCount := 100;

  StringGrid1.Align := alClient;

  StringGrid1.Options := StringGrid1.Options - [goRangeSelect];

  for i := 0 to StringGrid1.ColCount - 1 do

    for j := 0 to StringGrid1.RowCount - 1 do

      StringGrid1.Cells[i,j] := IntToStr(i*j);

end;



procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  if not(ssCtrl in Shift) then Exit; {假如是按住 Ctrl 才能拖动}

  flag := True;

  x1 := X;

  y1 := Y;

end;



procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

var

  px,py: Integer;

begin

  if not flag then Exit;

  //if not(ssCtrl in Shift) then Exit;



  px := GetScrollPos(StringGrid1.Handle, SB_HORZ);

  py := GetScrollPos(StringGrid1.Handle, SB_VERT);

  px := px - (X - x1);

  py := py - (Y - y1);



  StringGrid1.Perform(WM_HSCROLL, px shl 16 or SB_THUMBPOSITION, 0);

  StringGrid1.Perform(WM_VSCROLL, py shl 16 or SB_THUMBPOSITION, 0);



  x1 := X;

  y1 := Y;

end;



procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  flag := False;

end;



end.


 
   

窗体文件:

---

object Form1: TForm1

  Left = 0

  Top = 0

  Caption = 'Form1'

  ClientHeight = 187

  ClientWidth = 310

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object StringGrid1: TStringGrid

    Left = 8

    Top = 8

    Width = 281

    Height = 153

    TabOrder = 0

    OnMouseDown = StringGrid1MouseDown

    OnMouseMove = StringGrid1MouseMove

    OnMouseUp = StringGrid1MouseUp

  end

end