Add the mouse drag function to tstringgrid-reply to the "dxx" question

Problem Source: http://www.cnblogs.com/del/archive/2008/12/11/1091310.html#1398793

In this example (there is still a problem in this example, the distance between dragging and moving is different ):

Code File:

Unit unit1; interfaceuses windows, messages, extensions, variants, classes, graphics, controls, forms, dialogs, grids; Type tform1 = Class (tform) stringgrid1: tstringgrid; Procedure formcreate (Sender: tobject); Procedure destroy (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; {initialize test data} 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 destroy (Sender: tobject; button: tmousebutton; shift: tshiftstate; x, Y: integer); begin if not (ssctrl in shift) Then exit; {if you press Ctrl to drag} 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.
 
   
 

Form file:

 
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