VFP 愛用者社區 :: 觀看文章 - [轉貼] 在grid中選擇一個區域範圍

VFP 愛用者社區
本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.

常見問題

搜尋

會員列表

會員群組

會員註冊

個人資料

登入檢查您的私人訊息

登入

[轉貼] 在grid中選擇一個區域範圍

VFP 愛用者社區首頁 -> VFP 討論區

發表人

內容

garfield
Site Admin

註冊時間: 2003-01-30
文章: 2157

第 1 樓

發表於: 星期六三月 26, 2005 7:18 am 文章主題: [轉貼] 在grid中選擇一個區域範圍

資料來源: http://fox.wikis.com/wc.dll?Wiki~SelectRangeOfRecordsInGrid~VFP
用鍵盤或滑鼠都可以,真厲害..

代碼:

PUBLIC oGridForm
oGridForm = CREATEOBJECT("frmgrid")
oGridForm.SHOW

**************************************************
*-- Class: frmgrid (test.vcx)
*-- ParentClass: form
*-- BaseClass: form
*-- Time Stamp: 03/30/04 12:03:09 PM
*
DEFINE CLASS frmgrid AS FORM

HEIGHT = 329
WIDTH = 512
DOCREATE = .T.
AUTOCENTER = .T.
CAPTION = "Grid Select"
KEYPREVIEW = .T.
nend = 0
nstart = 0
nmousey = 0
nmousex = 0
ncursorposy = 0
ncursorposx = 0
mclip = ""
nstartposx = 0
nstartposy = 0
NAME = "frmgridselect"

ADD OBJECT label1 AS LABEL WITH ;
   WORDWRAP = .T., ;
   CAPTION = "Click and Drag within the grid, or hold down shift while pressing the cursor arrows, or shift+click on the grid", ;
   HEIGHT = 33, ;
   LEFT = 72, ;
   TOP = 3, ;
   WIDTH = 388, ;
   NAME = "Label1"

ADD OBJECT mygrid AS mygrid WITH ;
   WIDTH = 471, ;
   HEIGHT = 255, ;
   TOP = 39, ;
   LEFT = 21, ;
   DELETEMARK = .F., ;
   SCROLLBARS = 2

ADD OBJECT cnt1 AS cnt1 WITH ;
   OLEDRAGMODE = 1, ;
   OLEDROPMODE = 1, ;
   TOP = 58, ;
   LEFT = 31, ;
   WIDTH = 443, ;
   HEIGHT = 236, ;
   BACKSTYLE = 0, ;
   BORDERWIDTH = 0, ;
   NAME = "cnt1"

PROCEDURE buf2dword
   LPARAMETERS lcBuffer
   RETURN ASC(SUBSTR(lcBuffer,1,1)) + ;
      BITLSHIFT(ASC(SUBSTR(lcBuffer,2,1)), 8)+;
      BITLSHIFT(ASC(SUBSTR(lcBuffer,3,1)), 16)+;
      BITLSHIFT(ASC(SUBSTR(lcBuffer,4,1)), 24)
ENDPROC

PROCEDURE drawbox
   *** DrawBox()
   LOCAL nX, nY, cCursorPos, nRelRow
   *** lock screen to help in "flashiness"

   THISFORM.LOCKSCREEN = .T.
   *** get mouse position for form
   m.nX = MCOL()*5
   m.nY = MROW()*15
   *** get mouse position for Windows
   m.cCursorPos = SPACE(8)
   =GetCursorPos(@cCursorPos)
   WITH THISFORM.cnt1.shpSelected
      IF .VISIBLE = .F.
         *** if shape isn't visible, make it visible and set position of it
         .LEFT=m.nX - THISFORM.cnt1.LEFT
         .TOP=m.nY - THISFORM.cnt1.TOP
         .VISIBLE = .T.
         *** set form properties to hold top and left of shape
         THISFORM.nmousex = .LEFT
         THISFORM.nmousey = .TOP
         *** set form properties to hold top and left of mouse position relative to windows
         THISFORM.nstartposx = SUBSTR(cCursorPos,1,4)
         THISFORM.nstartposx = ASC(SUBSTR(THISFORM.nstartposx , 1,1)) + ;
            ASC(SUBSTR(THISFORM.nstartposx , 2,1)) * 256 +;
            ASC(SUBSTR(THISFORM.nstartposx , 3,1)) * 65536 +;
            ASC(SUBSTR(THISFORM.nstartposx , 4,1)) * 16777216
         THISFORM.nstartposy = SUBSTR(cCursorPos,5,4)
         THISFORM.nstartposy = ASC(SUBSTR(THISFORM.nstartposy , 1,1)) + ;
            ASC(SUBSTR(THISFORM.nstartposy , 2,1)) * 256 +;
            ASC(SUBSTR(THISFORM.nstartposy , 3,1)) * 65536 +;
            ASC(SUBSTR(THISFORM.nstartposy , 4,1)) * 16777216
      ELSE
         *** set form properties to hold top and left of mouse position relative to windows
         THISFORM.ncursorposx = SUBSTR(cCursorPos,1,4)
         THISFORM.ncursorposx = ASC(SUBSTR(THISFORM.ncursorposx , 1,1)) + ;
            ASC(SUBSTR(THISFORM.ncursorposx , 2,1)) * 256 +;
            ASC(SUBSTR(THISFORM.ncursorposx , 3,1)) * 65536 +;
            ASC(SUBSTR(THISFORM.ncursorposx , 4,1)) * 16777216
         THISFORM.ncursorposy = SUBSTR(cCursorPos,5,4)
         THISFORM.ncursorposy = ASC(SUBSTR(THISFORM.ncursorposy , 1,1)) + ;
            ASC(SUBSTR(THISFORM.ncursorposy , 2,1)) * 256 +;
            ASC(SUBSTR(THISFORM.ncursorposy , 3,1)) * 65536 +;
            ASC(SUBSTR(THISFORM.ncursorposy , 4,1)) * 16777216

         DO CASE

               *** if X position is within the container and to the right of shape.left,
               *** then add to the width
            CASE BETWEEN(m.nX, THISFORM.cnt1.LEFT+.LEFT,THISFORM.cnt1.LEFT+THISFORM.cnt1.WIDTH)
               .WIDTH = m.nX-.LEFT - THISFORM.cnt1.LEFT

               *** if X position is to the left of shape.left,
               *** then set the cursor position to shape.left
            CASE m.nX < THISFORM.LEFT+.LEFT
               SetCursorPos(THISFORM.nstartposx,THISFORM.ncursorposy)

               *** otherwise, set the cursor position to shape.right, current Y
            OTHERWISE
               SetCursorPos(m.nX+THISFORM.LEFT,THISFORM.ncursorposy)

         ENDCASE

         DO CASE

               *** if Y position is below the container, then skip and reset top and height of shape
            CASE m.nY > THISFORM.cnt1.TOP+THISFORM.cnt1.HEIGHT
               IF m.nX < THISFORM.cnt1.LEFT+THISFORM.cnt1.WIDTH
                  m.nRelRow = THISFORM.mygrid.RELATIVEROW
                  m.nRecno = RECNO()
                  IF NOT EOF()
                     SKIP
                  ENDIF
                  IF EOF()
                     GO BOTTOM
                  ENDIF
                  IF NOT m.nRecno == RECNO()
                     .TOP = .TOP - THISFORM.mygrid.ROWHEIGHT
                     .HEIGHT = .HEIGHT + THISFORM.mygrid.ROWHEIGHT
                     THISFORM.nstartposy = THISFORM.nstartposy - THISFORM.mygrid.ROWHEIGHT
                     THISFORM.mygrid.REFRESH()
                     DO WHILE THISFORM.mygrid.RELATIVEROW # m.nRelRow OR THISFORM.mygrid.RELATIVEROW = 0
                        THISFORM.mygrid.DOSCROLL(0)
                     ENDDO
                  ENDIF
               ENDIF

               *** if Y position is above the container, then skip-1 and reset top and height of shape
            CASE m.nY > 0 AND m.nY < THISFORM.cnt1.TOP AND THISFORM.nstart # THISFORM.mygrid.ACTIVEROW AND .TOP < 0
               m.nRelRow = THISFORM.mygrid.RELATIVEROW
               m.nRecno = RECNO()
               IF NOT BOF()
                  SKIP -1
               ENDIF
               IF BOF()
                  GO TOP
               ENDIF
               IF NOT m.nRecno == RECNO()
                  .TOP = .TOP + THISFORM.mygrid.ROWHEIGHT
                  .HEIGHT = MAX(.HEIGHT - THISFORM.mygrid.ROWHEIGHT,0)
                  THISFORM.nstartposy = THISFORM.nstartposy + THISFORM.mygrid.ROWHEIGHT
                  THISFORM.mygrid.REFRESH()
                  DO WHILE THISFORM.mygrid.RELATIVEROW # m.nRelRow OR THISFORM.mygrid.RELATIVEROW = 0
                     THISFORM.mygrid.DOSCROLL(1)
                  ENDDO
               ENDIF

               *** if Y position is lower than the shape's top, then set the height and activate the cell
            CASE BETWEEN(m.nY, THISFORM.cnt1.TOP+.TOP,THISFORM.cnt1.TOP+THISFORM.cnt1.HEIGHT)
               .HEIGHT = m.nY-.TOP - THISFORM.cnt1.TOP
               THISFORM.MakeCellActive()

               *** otherwise, set the cursor position to the current x, shape.top
            OTHERWISE
               SetCursorPos(THISFORM.ncursorposx,THISFORM.nstartposy)

         ENDCASE

      ENDIF
   ENDWITH

   *** set ending recno to current recno for display purposes
   THISFORM.nend = RECNO()
   THISFORM.mygrid.REFRESH()
   THISFORM.LOCKSCREEN = .F.
ENDPROC

PROCEDURE num2rect
   *** Num2Rect()
   LPARAMETERS lnLeft, lnTop, lnRight, lnBottom
   RETURN THIS.num2buf(lnLeft) + THIS.num2buf(lnTop)+;
      THIS.num2buf(lnRight) + THIS.num2buf(lnBottom)
ENDPROC

PROCEDURE MakeCellActive
   *** MakeCellActive()
   *** activates cell in grid while dragging based on where mouse cursor is
   LOCAL lnWhere, lnRelRow, lnRelCol, lnX, lcColumn
   STORE 0 TO lnWhere, lnRelRow, lnRelCol

   THISFORM.mygrid.GridHitTest(MCOL()*5, MROW()*15, @lnWhere, @lnRelRow, @lnRelCol)
   THISFORM.mygrid.ACTIVATECELL(lnRelRow,lnRelCol)
ENDPROC

PROCEDURE num2buf
   *** num2buf()
   LPARAMETERS lnValue
   #DEFINE m0 256
   #DEFINE m1 65536
   #DEFINE m2 16777216
   LOCAL b0, b1, b2, b3
   b3 = INT(lnValue/m2)
   b2 = INT((lnValue - b3 * m2)/m1)
   b1 = INT((lnValue - b3*m2 - b2*m1)/m0)
   b0 = MOD(lnValue, m0)
   RETURN CHR(b0)+CHR(b1)+CHR(b2)+CHR(b3)
ENDPROC

PROCEDURE cliptoform
   *** ClipToForm()
   *** lock the mouse cursor within the container widths and the form heights
   *** I had problems when I went past the form on either side, and when I went past the container on the bottom right.
   *** Since I clip Windows this way, the mouse cannot go past the boundaries
   LOCAL HWND, lcBuffer, nTopX, nTopY, nBottX, nBottY

   HWND = Getfocus()
   lcBuffer = CHR(60) +;
      REPLI(CHR(0), 60-1)
   =GetWindowInfo(HWND, @lcBuffer)
   wrleft = THISFORM.buf2dword(SUBS(lcBuffer, 5,4))
   wrtop = THISFORM.buf2dword(SUBS(lcBuffer, 9,4))
   wrright = THISFORM.buf2dword(SUBS(lcBuffer, 13,4))
   wrbottom = THISFORM.buf2dword(SUBS(lcBuffer, 17,4))
   lcBuffer = THISFORM.num2rect(wrleft+THISFORM.cnt1.LEFT, wrtop+24, wrleft+THISFORM.cnt1.LEFT+THISFORM.cnt1.WIDTH, wrbottom-5)
   =ClipCursor(lcBuffer)
ENDPROC

PROCEDURE INIT
   LOCAL lpRect
   DECLARE LONG SetCursorPos IN user32 LONG, LONG
   DECLARE SHORT GetCursorPos IN user32 STRING @ lpPoint
   DECLARE INTEGER ClipCursor IN user32 STRING lpRect
   DECLARE INTEGER GetClipCursor IN user32 STRING @ lpRect
   DECLARE INTEGER GetFocus IN user32
   DECLARE INTEGER GetWindowInfo IN user32 INTEGER HWND, STRING @pwi

   * save initial clipping area to revert back to it after drag
   lpRect = REPLI (CHR(0), 16)
   = GetClipCursor (@lpRect)
   THIS.mclip = lpRect

   THIS.mygrid.SetGrid()

   RETURN DODEFAULT()
ENDPROC

PROCEDURE KEYPRESS
   LPARAMETERS nKeyCode, nShiftAltCtrl

   IF INLIST(m.nKeyCode,50,56) AND LOWER(THISFORM.ACTIVECONTROL.NAME)='mygrid'
      IF THISFORM.nstart = 0 OR NOT BETWEEN(RECNO(),THISFORM.nstart,THISFORM.nend)
         THISFORM.nstart = RECNO()
         THISFORM.nend = RECNO()
      ENDIF

      DO CASE

         CASE m.nKeyCode = 50 && down arrow
            IF NOT EOF()
               SKIP
            ENDIF
            IF EOF()
               GO BOTTOM
            ENDIF
            THISFORM.nend = RECNO()

         CASE m.nKeyCode = 56 && up arrow
            IF NOT BOF()
               SKIP -1
            ENDIF
            IF BOF()
               GO TOP
            ENDIF
            IF THISFORM.nstart > RECNO()
               THISFORM.nstart = RECNO()
            ELSE
               THISFORM.nend = RECNO()
            ENDIF

      ENDCASE

      THISFORM.mygrid.REFRESH()
   ENDIF
   RETURN DODEFAULT(nKeyCode,nShiftAltCtrl)
ENDPROC

ENDDEFINE

DEFINE CLASS mygrid AS GRID
COLUMNCOUNT = 0

PROCEDURE SetGrid
   THISFORM.LOCKSCREEN = .T.
   lcFileName = GETFILE("DBF","Select Table:")
   USE (lcFileName)
   lcAlias = ALIAS()
   THIS.RECORDSOURCE = ""
   THIS.RECORDSOURCE = lcAlias
   SELECT (lcAlias )
   FOR i = 1 TO FCOUNT()
      IF THIS.COLUMNCOUNT < i
         THIS.ADDOBJECT("column" + ALLTRIM(STR(i)),"MyColumn")
      ENDIF
      THIS.COLUMNS(i).VISIBLE = .T.
      THIS.COLUMNS(i).CONTROLSOURCE = FIELD(i)
      THIS.COLUMNS(i).DYNAMICBACKCOLOR="IIF(between(RECNO(),thisform.nStart,thisform.nEnd), RGB(185,217,255), RGB(255,255,255))"
      THIS.COLUMNS(i).Header1.CAPTION = FIELD(i)
   ENDFOR
   FOR i = FCOUNT() + 1 TO THIS.COLUMNCOUNT
      THIS.REMOVEOBJECT("Column"+ALLTRIM(STR(i)))
   ENDFOR
   THISFORM.CAPTION = lcAlias
   THIS.SETALL("DynamicBackColor", "IIF(between(RECNO(),thisform.nStart,thisform.nEnd), RGB(185,217,255), RGB(255,255,255))", "Column")
   THISFORM.LOCKSCREEN = .F.
ENDPROC

ENDDEFINE

DEFINE CLASS myColumn AS COLUMN

ADD OBJECT Header1 AS myHeader WITH VISIBLE = .T.

ENDDEFINE

DEFINE CLASS myHeader AS HEADER
ENDDEFINE

DEFINE CLASS cnt1 AS CONTAINER
PROCEDURE MOUSEDOWN
   LPARAMETERS nButton, nShift, nXCoord, nYCoord

   LOCAL lSetEnd

   *** if shift was held down, then set start row / end row form properties
   IF m.nShift = 1
      m.lSetEnd = .T.
      IF THISFORM.nstart = 0 OR NOT BETWEEN(RECNO(),THISFORM.nstart,THISFORM.nend)
         THISFORM.nstart = RECNO()
         THISFORM.nend = RECNO()
      ENDIF
   ENDIF
   *** activate cell under mouse
   THISFORM.MakeCellActive()

   IF m.lSetEnd
      IF RECNO() > THISFORM.nstart
         THISFORM.nend = RECNO()
      ELSE
         THISFORM.nstart = RECNO()
      ENDIF
      THISFORM.mygrid.REFRESH()
   ENDIF

   RETURN DODEFAULT(nButton, nShift, nXCoord, nYCoord)
ENDPROC

PROCEDURE OLECOMPLETEDRAG
   LPARAMETERS nEffect
   THISFORM.cnt1.shpSelected.VISIBLE=.F.
   =ClipCursor (THISFORM.mclip)
   RETURN DODEFAULT(nEffect)
ENDPROC

PROCEDURE OLEGIVEFEEDBACK
   LPARAMETERS nEffect, eMouseCursor
   THISFORM.drawbox()
   NODEFAULT
ENDPROC

PROCEDURE OLESTARTDRAG
   LPARAMETERS oDataObject, nEffect

   *** clip mouse to form boundaries
   THISFORM.cliptoform()

   *** activate cell at mouse position
   THISFORM.MakeCellActive()

   *** set height of grid/container if grid shows a "half" row at bottom
   DO WHILE MOD((THISFORM.mygrid.HEIGHT-THISFORM.mygrid.HEADERHEIGHT-2),THISFORM.mygrid.ROWHEIGHT) # 0
      THISFORM.mygrid.HEIGHT = THISFORM.mygrid.HEIGHT - 1
      THISFORM.cnt1.HEIGHT = THISFORM.cnt1.HEIGHT - 1
   ENDDO

   *** set form properties that set dynamicbackcolor based on record number
   THISFORM.nstart=RECNO()
   THISFORM.nend=RECNO()

   RETURN DODEFAULT(oDataObject, nEffect)
ENDPROC

ADD OBJECT shpSelected AS SHAPE WITH ;
   OLEDROPMODE = 1, ;
   TOP = 45, ;
   LEFT = 87, ;
   HEIGHT = 17, ;
   WIDTH = 100, ;
   BACKSTYLE = 0, ;
   BORDERSTYLE = 2, ;
   VISIBLE = .F., ;
   BORDERCOLOR = RGB(255,0,0), ;
   NAME = "shpSelected"

ENDDEFINE

*
*-- EndDefine: frmgrid
**************************************************

_________________
利用>>搜尋<<的功能會比問的還要快得到答案.

回頂端

liangszpt

註冊時間: 2004-11-18
文章: 262
來自: 广东省深圳市

第 2 樓

發表於: 星期六七月 15, 2006 2:43 am 文章主題:

这个选取后，能不能计算选择区域某栏位的总和？有没有CTRL来选择的方式，就是只选择某些记录 ...后来在这里找到答案 http://vfp.sunyear.com.tw/viewtopic.php?t=1068&highlight=grid+%B7%C6%B9%AB

回頂端

DennisTsai

註冊時間: 2005-07-26
文章: 176

第 3 樓

發表於: 星期六七月 15, 2006 9:38 am 文章主題:

應該用得到!謝謝分享!

回頂端

garfield
Site Admin

註冊時間: 2003-01-30
文章: 2157

第 4 樓

發表於: 星期六七月 15, 2006 11:07 am 文章主題:

引言回覆:

有没有CTRL来选择的方式，就是只选择某些记录

用 list box 元件可以逹到這樣的功能,
只是無法左右捲動.
_________________
利用>>搜尋<<的功能會比問的還要快得到答案.

回頂端

從之前的文章開始顯示:

	VFP 愛用者社區首頁 -> VFP 討論區	所有的時間均為台北時間 (GMT + 8 小時)
第1頁(共1頁)

您無法在這個版面發表文章
您無法在這個版面回覆文章
您無法在這個版面編輯文章
您無法在這個版面刪除文章
您無法在這個版面進行投票
您無法在這個版面附加檔案
您無法在這個版面下載檔案