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

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

---

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

---

代码文件:

---

unit Unit1;interfaceuses  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  endend