GRID增强专集1
出处:网络

grid是VFP中最重要的控件之一, 可惜从FOX6-9对GRID的增强力度太小

只好自己来了. 表格控件对程序编制极重要, 大家都来出一分力吧.

以前的好东东, 也请摘录在此.

先来一下, 我们的 _grid 基类. 适用于FOX9, FOX8可能也可以.

可能有BUG的,我的GRID多数用于REMOTE VIEW, 用于DBF不知有无问题.

一些功能来源于坛子上的FOX朋友, 至谢!

有空还打算更多功能, 如: 打印, FBILO的离开GRID前强制REPLACE等

功能:
* 支持 header双击
* header 双击排序
* 在焦点离开grid 后, 还能取得光标所在COLUMN
* 自动记录列宽列位置行高等,自动恢复
* 支持双行表头

耦合情况:
用到了 双层表头类, 表单缩放类, 一些系统通用函数
*-- Class: _grid (d:\yx\workshop\onair\粤信通用帐务_正本\lib\lib_粤信_基本.vcx)
*-- ParentClass: grid
*-- BaseClass: grid
*-- Time Stamp: 11/23/04 05:49:13 PM
*
DEFINE CLASS _grid AS grid

OLEDropMode = 1
Height = 200
Width = 320
*-- 是否自动记录列位置、宽度并恢复
_l记录列宽并恢复 = "恢复 = (.t.)"
o双行表头 = "?= .F."
_l允许双击header排序 = "判?= (.t.)"
oheader双击_上一个header = "er = (.null.)"
_l恢复列顺序 = "序 = (.t.)"
*-- 当前或离开grid前, 光标所在的列
_o光标所在的列 = "牧?= (.null.)"
*-- (不算disable和not visible的)在最后那列，如按回车，则填入dnArrow以换行 此功能未有
_l在最后一列按回车则换行 = "车则换行 = .T."
Name = "_grid"

*-- 使区别于其他grid,用于save/load列宽,不斌值则按form.caption+数据源
_cgrid标识 = .F.

*-- 指定生成多行表头及格式。值格式如：3-3-上月,6-2-本月。列可调宽但位置不可调了
_c双行表头定义串 = .F.

*-- 指出光标所在的列，当grid无焦点时仍有效
_n当前列 = .F.
_n当前列_相对 = .F.
_n当前行 = .F.
_n当前行_相对 = .F.

PROCEDURE l记录列宽
IF not this._l记录列宽并恢复
RETURN
ENDIF

*- 保存到系统_参数
*- 列宽，列顺序，headerheight, rowHeight
LOCAL cTmp,c列标识,n列宽,n列顺序,i
cTmp=''

FOR i=1 TO this.ColumnCount
o=this.Columns(i)
c列标识=ALLTRIM(o.ControlSource)+ALLTRIM(o.comment) &&o.header1.caption
n列宽=o.width
n列顺序=o.columnOrder
cTmp=cTmp+ c列标识+','+ALLTRIM(STR(n列顺序))+','+ALLTRIM(STR(n列宽))+' ; '
NEXT

cTmp=goApp.fn._chr._csetmacro('','HeaderHeight',STR(this.HeaderHeight) ) + ;
goApp.fn._chr._csetmacro('','RowHeight',STR(this.RowHeight) ) + ;
goApp.fn._chr._csetmacro('','LockColumns',STR(this.LockColumns) ) + ;
goApp.fn._chr._csetmacro('','columnControlSource+comment - columnOrder - columnWidth',cTmp)

goApp.fn._sql._lSetSysPara(this._cgrid标识, cTmp)
ENDPROC

PROCEDURE l恢复列宽
LOCAL i,cTmp,cHCC,nHeaderHeight,nRowHeight,j,nOrder,c列标识,cWidth

cTmp=goApp.fn._sql._uGetsyspara(this._cgrid标识)
IF ISNULL(cTmp)
RETURN
ENDIF

nHeaderHeight=VAL( goApp.fn._chr._cGetMacro(cTmp,'HeaderHeight') )
nRowHeight=VAL( goApp.fn._chr._cGetMacro(cTmp,'RowHeight') )
nLockColumns=VAL( goApp.fn._chr._cGetMacro(cTmp,'LockColumns') )

IF NOT EMPTY(this._c双行表头定义串)
IF nHeaderHeight>0
this.HeaderHeight=nHeaderHeight
ENDIF
ENDIF
IF nRowHeight>0
this.RowHeight=nRowHeight
ENDIF

cHCC=goApp.fn._chr._cGetMacro(cTmp,'columnControlSource+comment - columnOrder - columnWidth')

FOR i=1 TO GETWORDCOUNT(cHCC,';')-1
cTmp=GETWORDNUM(cHCC,i,';')

c列标识=ALLTRIM(GETWORDNUM(cTmp,1,','))
nOrder =VAL(GETWORDNUM(cTmp,2,','))
nWidth =VAL(GETWORDNUM(cTmp,3,','))

FOR j=1 TO this.ColumnCount
IF ALLTRIM(this.Columns(j).ControlSource)+ALLTRIM(this.Columns(j).comment)==c列标识
IF this._l恢复列顺序
this.columns(j).columnOrder=nOrder
ENDIF
this.Columns(j).width=nWidth
ENDIF
NEXT

NEXT

this.LockColumns=nLockColumns
ENDPROC

PROCEDURE v生成grid标识
this._cgrid标识=SYS(1272,this)

*'formname:'+thisform.Name+' formCaption: '+thisform.Caption+;
* ' gridname:'+this.Name+' gridRecordSource: '+ this.RecordSource
ENDPROC

PROCEDURE _header双击
LPARAMETERS tcHeader标题,to列

IF NOT this._l允许双击header排序 OR EMPTY(this.RecordSource)
RETURN
ENDIF

LOCAL cField,nOPos,nArea,cTag,l新到一个header,lIndexErr

nArea=SELECT()
SELECT (this.RecordSource)
nOPos=RECNO()

cField=JUSTEXT(to列.controlsource )
IF EMPTY(cField) OR EMPTY(field(cField)) &&一些计算列，不可index的啦
RETURN
ENDIF

IF TYPE(cField) $ 'GMLOUX' &&还有，一些类型的字段不可index
RETURN
ENDIF

cTag='_ghsrt_'+ALLTRIM(STR(gnFieldPos(cField),4))

*- 三种状态: 1. 无; 2. asce; 3.desc

IF TAGNO(cTag)=0

nOBuffMode=CURSORGETPROP("Buffering")

TRY
CURSORSETPROP("Buffering",3)
INDEX ON &cField TAG &cTag
SET ORDER TO
CATCH
lIndexErr=.t.
FINALLY
CURSORSETPROP("Buffering",nOBuffMode)

ENDTRY

IF lIndexErr
RETURN
ENDIF

ENDIF

IF NOT isnull(this.oheader双击_上一个header) ;
AND this.oheader双击_上一个header<>to列.header1

this.oheader双击_上一个header.picture=''
ENDIF
this.oheader双击_上一个header=to列.header1

DO CASE
CASE EMPTY(to列.header1.picture)
SET ORDER TO tag &cTag
to列.header1.picture='..\..\shared\pic\up4.bmp'

CASE NOT DESCENDING() &&顺序
SET ORDER TO tag &cTag DESCENDING
to列.header1.picture='..\..\shared\pic\down4.bmp'

OTHERWISE &&倒序
SET ORDER TO
to列.header1.picture=''

ENDCASE

this.Refresh

TRY
GO (nOPos)
CATCH
ENDTRY

SELECT (nArea)
ENDPROC

PROCEDURE cheader双击临时过渡
LPARAMETERS tcHeader标题,to列
LOCAL o
o=SYS(1270)
this._header双击(o.header1.caption,o)
ENDPROC

PROCEDURE _o据列序号取列对象引用
LPARAMETERS tn列序号

FOR EACH oCol IN this.Columns
IF oCol.ColumnOrder=tn列序号
RETURN oCol
ENDIF
NEXT

RETURN .null.
ENDPROC

PROCEDURE _o光标所在的列_access
*To do: Modify this routine for the Access method

this.o光标所在的列=this._o据列序号取列对象引用(this._n当前列)

RETURN THIS.o光标所在的列
ENDPROC

PROCEDURE Init
LOCAL o,c列对象

IF EMPTY(this._cgrid标识)
this.v生成grid标识()
ENDIF

*------设置统一事件--------------------
BINDEVENT(this,"DblClick",this,"_双击")
FOR j=1 TO this.ColumnCount
c列对象='this.columns(j).'+this.columns(j).CurrentControl
BINDEVENT(&c列对象,"DblClick",this,"_双击")
BINDEVENT(this.columns(j).header1,"DblClick",this,"cheader双击临时过渡")
NEXT

IF EMPTY(this.RecordSource) OR ISNULL(this.RecordSource)
RETURN
ENDIF

IF this._l记录列宽并恢复
IF not goApp.fn._api._ngetkeystate(0x10)>100 && not shift press
this.l恢复列宽()
ENDIF
ENDIF

IF NOT EMPTY(this._c双行表头定义串)
this.parent.AddObject(this.Name+'_双行表头','doubleheader')
this.o双行表头=EVALUATE(TEXTMERGE("this.parent.<>"))
this.o双行表头._c多栏表头定义串=this._c双行表头定义串
this.o双行表头._c目标grid名='this.parent.'+this.Name
this.o双行表头.v开始()
ENDIF

FOR EACH oCol IN this.Columns
BINDEVENT(oCol,'moved',this,'afterRowColChange',1)
NEXT
ENDPROC

PROCEDURE Destroy
IF TYPE('goApp')="O" AND !ISNULL(goApp) ;
AND ! goApp.fn._api._ngetkeystate(0x10)>100 && not shift press

this.l记录列宽()
ENDIF

RETURN .t.
ENDPROC

PROCEDURE AfterRowColChange
LPARAMETERS nColIndex
IF NOT EMPTY(this._c双行表头定义串)
This.o双行表头.ScrollHeader()
ENDIF

IF this.ActiveColumn<>0
this._n当前列=this.ActiveColumn
endif

IF this.ActiveRow<>0
this._n当前行=this.ActiveRow
endif

IF this.ActiveColumn<>0
this._n当前列_相对=this.ActiveColumn
endif

IF this.ActiveRow<>0
this._n当前行_相对=this.ActiveRow
endif
ENDPROC

PROCEDURE Scrolled
LPARAMETERS nDirection
IF NOT EMPTY(this._c双行表头定义串 )
This.o双行表头.ScrollHeader()
ENDIF
ENDPROC

PROCEDURE _双击
ENDPROC

ENDDEFINE
*
*-- EndDefine: _grid

[返回]

首页 | 设为首页 | 加入收藏 | 关于本站 | 友情链接 | 版权声明