Эта задача была решена и опубликована Dan LeClair in April 1997 в Фокс Эдвайсер
http://advisor.com/Articles.nsf/aid/LECLD02
Затем на базе этого кода Scott King
sking@iglobal.net написал свой вариант кода
Код легко переноситься в класс грида, но имеет недостаток, замороженные колонки дисэблены. Этого
можно избежать, но при нажатии клавиш в замороженных колонках их дубль до окончания ввода
появляется в гриде и исчезает после выхода с этих колонок
DEFINECLASS grdlock AS grid FontBold = .T. FontSize = 8 DeleteMark = .F. RowHeight = 17
ScrollBars = 0 *-- Number of columns to freeze (lock) on the grid FreezeCols = 0 Name =
"grdlock" *-- Set to .T. when exiting the grid GridExit = .F. *-- Setup the panel
properties PROCEDURE PanelSetup Local Idx,TotWid THISFORM.LockScreen=.T. If
THIS.FreezeCols 0 For Idx=1 to (THIS.FreezeCols)
THIS.Partition=THIS.Partition+THIS.Columns(Idx).Width+1 THIS.Columns(Idx).Enabled=.F. If
THIS.Columns(Idx).BackColor=RGB(255,255,255) THIS.Columns(Idx).BackColor=THISFORM.BackColor
Endif Endfor TotWid=10 For Idx=1 to THIS.ColumnCount
TotWid=TotWid+THIS.Columns(Idx).Width+1 Endfor If TotWid < THIS.Width-SYSMETRIC(5)
THIS.FreezeCols=0 THIS.Partition=0 Else THIS.PanelLink=.F. THIS.Panel=0
THIS.RecordMark=.T. THIS.Partition=THIS.Partition+10 THIS.ScrollBars=0 THIS.Panel=1
THIS.RecordMark=.F. THIS.PanelLink=.T. Endif Endif For Idx=1 to (THIS.FreezeCols)
=THIS.DoScroll(5) Endfor THISFORM.LockScreen=.F. ENDPROC PROCEDURE Scrolled LPARAMETERS
nDirection Local Idx If (nDirection=4 OR nDirection=6) AND ;
THIS.LeftColumn<=THIS.FreezeCols+1 AND ; THIS.Panel=1 For Idx=THIS.LeftColumn to
(THIS.FreezeCols) =THIS.DoScroll(5) Endfor THIS.Refresh() Endif ENDPROC PROCEDURE
AfterRowColChange LPARAMETERS nColIndex Local Idx THISFORM.LockScreen=.T. If THIS.Panel=0
If THIS.LeftColumn#1 For Idx=THIS.LeftColumn to 1 Step -1 =THIS.DoScroll(4) Endfor Endif
THIS.Panel=1 Keyboard '{TAB}' Else For Idx=THIS.LeftColumn to (THIS.FreezeCols)
=THIS.DoScroll(5) Endfor If THIS.Columns(THIS.ActiveColumn).Enabled=.F. Keyboard '{TAB}'
Endif THIS.Refresh() Endif THIS.ExitRowCol() THISFORM.LockScreen=.F. ENDPROC
PROCEDURE Init THIS.PanelSetup() THIS.SetAll("Resizable", .F., "Column")
THIS.SetAll("Movable", .F., "Column") THIS.GridExit=.F. DoDefault() ENDPROC PROCEDURE
BeforeRowColChange LPARAMETERS nColIndex If not THIS.GridExit THISFORM.LockScreen=.T.
Else THIS.GridExit=.F. Endif ENDPROC PROCEDURE Valid THIS.GridExit=.T. ENDPROC
*-- Allows for updating after the row or column changes. PROCEDURE ExitRowCol ENDPROC
ENDDEFINE
Nadya
14.06.01 00:52:49
define class grdlock
as grid
fontbold = .t.
fontsize = 8
deletemark = .f.
rowheight = 17
scrollbars = 0
*-- Number of columns to freeze (lock) on the grid
FreezeCols = 0
name = "grdlock"
*-- Set to .T. when exiting the grid
GridExit = .f.
*-- Setup the panel properties
procedure PanelSetup
local Idx,TotWid
thisform.lockscreen=.t.
if this.FreezeCols>0
for Idx=1 to (this.FreezeCols)
this.partition=this.partition+this.columns(Idx).width+1
this.columns(Idx).enabled=.f.
if this.columns(Idx).backcolor=rgb(255,255,255)
this.columns(Idx).backcolor=thisform.backcolor
endif
endfor
TotWid=10
for Idx=1 to
this.columncount
TotWid=TotWid+this.columns(Idx).width+1
endfor
if TotWid < this.width-sysmetric(5)
this.FreezeCols=0
this.partition=0
else
this.panellink=.f.
this.panel=0
this.recordmark=.t.
this.partition=this.partition+10
this.scrollbars=0
this.panel=1
this.recordmark=.f.
this.panellink=.t.
endif
endif
for Idx=1 to (this.FreezeCols)
=this.doscroll(5)
endfor
thisform.lockscreen=.f.
endproc
procedure scrolled
lparameters nDirection
local Idx
if (nDirection=4 or nDirection=6) and ;
this.leftcolumn<=this.FreezeCols+1 and ;
this.panel=1
for Idx=this.leftcolumn to (this.FreezeCols)
=this.doscroll(5)
endfor
this.refresh()
endif
endproc
procedure afterrowcolchange
lparameters nColIndex
local Idx
thisform.lockscreen=.t.
if this.panel=0
if this.leftcolumn#1
for Idx=this.leftcolumn to 1 step -1
=this.doscroll(4)
endfor
endif
this.panel=1
keyboard '{TAB}'
else
for Idx=this.leftcolumn to (this.FreezeCols)
=this.doscroll(5)
endfor
if this.columns(this.activecolumn).enabled=.f.
keyboard '{TAB}'
endif
this.refresh()
endif
this.ExitRowCol()
thisform.lockscreen=.f.
endproc
procedure init
this.PanelSetup()
this.setall("Resizable", .f., "Column")
this.setall("Movable", .f., "Column")
this.GridExit=.f.
dodefault()
endproc
procedure beforerowcolchange
lparameters nColIndex
if not this.GridExit
thisform.lockscreen=.t.
else
this.GridExit=.f.
endif
endproc
procedure valid
this.GridExit=.t.
endproc
*-- Allows for updating after the row or column changes.
procedure ExitRowCol
endproc
enddefine
Nadya
14.06.01 00:54:13
Ok, another test:
define class grdlock
as grid
fontbold = .t.
fontsize = 8
deletemark = .f.
rowheight = 17
scrollbars = 0
*-- Number of columns to freeze (lock) on the grid
FreezeCols = 0
name = "grdlock"
*-- Set to .T. when exiting the grid
GridExit = .f.
*-- Setup the panel properties
procedure PanelSetup
local Idx,TotWid
thisform.lockscreen=.t.
if this.FreezeCols>0
for Idx=1 to (this.FreezeCols)
this.partition=this.partition+this.columns(Idx).width+1
this.columns(Idx).enabled=.f.
if this.columns(Idx).backcolor=rgb(255,255,255)
this.columns(Idx).backcolor=thisform.backcolor
endif
endfor
TotWid=10
for Idx=1 to
this.columncount
TotWid=TotWid+this.columns(Idx).width+1
endfor
if TotWid < this.width-sysmetric(5)
this.FreezeCols=0
this.partition=0
else
this.panellink=.f.
this.panel=0
this.recordmark=.t.
this.partition=this.partition+10
this.scrollbars=0
this.panel=1
this.recordmark=.f.
this.panellink=.t.
endif
endif
for Idx=1 to (this.FreezeCols)
=this.doscroll(5)
endfor
thisform.lockscreen=.f.
endproc
procedure scrolled
lparameters nDirection
local Idx
if (nDirection=4 or nDirection=6) and ;
this.leftcolumn<=this.FreezeCols+1 and ;
this.panel=1
for Idx=this.leftcolumn to (this.FreezeCols)
=this.doscroll(5)
endfor
this.refresh()
endif
endproc
procedure afterrowcolchange
lparameters nColIndex
local Idx
thisform.lockscreen=.t.
if this.panel=0
if this.leftcolumn#1
for Idx=this.leftcolumn to 1 step -1
=this.doscroll(4)
endfor
endif
this.panel=1
keyboard '{TAB}'
else
for Idx=this.leftcolumn to (this.FreezeCols)
=this.doscroll(5)
endfor
if this.columns(this.activecolumn).enabled=.f.
keyboard '{TAB}'
endif
this.refresh()
endif
this.ExitRowCol()
thisform.lockscreen=.f.
endproc
procedure init
this.PanelSetup()
this.setall("Resizable", .f., "Column")
this.setall("Movable", .f., "Column")
this.GridExit=.f.
dodefault()
endproc
procedure beforerowcolchange
lparameters nColIndex
if not this.GridExit
thisform.lockscreen=.t.
else
this.GridExit=.f.
endif
endproc
procedure valid
this.GridExit=.t.
endproc
*-- Allows for updating after the row or column changes.
procedure ExitRowCol
endproc
enddefine
Конференция
