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

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