
程序代码:
*** demo.prg
PUBLIC oform1
SET PROCEDURE TO myclass.prg ADDITIVE
oform1=Newobject("frmDemo")
oform1.Show
RETURN
DEFINE CLASS frmDemo AS form
Height = 352
Width = 529
DoCreate = .T.
AutoCenter = .T.
Caption = "Demo"
Name = "frmDemo"
ADD OBJECT Grd1 AS grd WITH ;
DeleteMark = .F.,;
Height = 336,;
Left = 7,;
Top = 9,;
Width = 516,;
Name = "Grd1"
PROCEDURE Load
set safety off
Create Cursor Demo(编码 C(10),名称 C(20),价格 N(12,2),日期 D)
Insert Into Demo(编码,名称,价格,日期) Values ("0001","华硕 F9S F9G233S-SL",7399,Date())
Insert Into Demo(编码,名称,价格,日期) Values ("0002","戴尔 Vostro 1310(R520555)",6100,Date())
Insert Into Demo(编码,名称,价格,日期) Values ("0003","Gateway T-6818c",5999,Date())
Insert Into Demo(编码,名称,价格,日期) Values ("0004","海尔 S20-T2370G10160BgHQCFP",5999,Date())
Insert Into Demo(编码,名称,价格,日期) Values ("0005","ThinkPad R61i 774227C",6400,Date())
Insert Into Demo(编码,名称,价格,日期) Values ("0006","惠普 Compaq Presario V3803TX(KS396PA)",5700,Date())
Go Top
ENDPROC
PROCEDURE Init
This.grd1.Bind()
ENDPROC
ENDDEFINE

程序代码:
*** myclass.prg
DEFINE CLASS grd AS grid
Height = 200
Width = 320
issort = .T.
sortgrc = ""
Name = "grd"
PROCEDURE grhclick
If This.isSort = .F.
Return
Endif
Local Array laEvents[1]
Try
Private lcSourceAlias,lcControlSource,lcField,lcTag,Ftag,lnBuffer,lcSortGrc
Local lcSourceAlias,lcControlSource,lcField,lcTag,Ftag,lnBuffer,lcSortGrc
Aevents(laEvents,0)
lcSourceAlias = laEvents[1,1].Parent.Parent.RecordSource
lcControlSource = laEvents[1,1].Parent.ControlSource
lcSourceAlias = Iif(!Empty(lcSourceAlias),lcSourceAlias,Substr(lcControlSource,1,At(".",lcControlSource)-1))
lcSourceAlias = Iif(!Empty(lcSourceAlias),lcSourceAlias,Alias())
lcField = Substr(lcControlSource,At(".",lcControlSource)+1)
*--
If Empty(lcSourceAlias)
Return
Endif
If Empty(lcField)
Return
Endif
lcTag = "SortTag"
Ftag = This.GetFieldTag(lcSourceAlias,lcField)
Select (lcSourceAlias)
*--
lnBuffer = CursorGetProp("Buffering")
If lnBuffer > 3
CursorSetProp("Buffering" ,3)
Endif
*--
lcSortGrc = This.SortGrc
If !Empty(This.SortGrc)
This.&lcSortGrc..Header1.Picture=""
Endif
This.SortGrc= laEvents[1,1].Parent.Name
Select(lcSourceAlias)
If Empty(Ftag)
If laEvents[1,1].Tag = "Down"
Inde On &lcField Tag &lcTag Descending
laEvents[1,1].Picture = Iif(File("Down.bmp"),"Down.bmp","")
laEvents[1,1].Tag = "Up"
Else
Inde On &lcField Tag &lcTag Ascending
laEvents[1,1].Picture = Iif(File("Up.bmp"),"Up.bmp","")
laEvents[1,1].Tag = "Down"
Endif
Else
If laEvents[1,1].Tag = "Down"
Set Order To (Ftag) Descending
laEvents[1,1].Picture = Iif(File("Down.bmp"),"Down.bmp","")
laEvents[1,1].Tag = "Up"
Else
Set Order To (Ftag) Ascending
laEvents[1,1].Picture = Iif(File("Up.bmp"),"Up.bmp","")
laEvents[1,1].Tag = "Down"
Endif
Endif
If lnBuffer > 3
CursorSetProp("Buffering" ,lnBuffer)
Endif
Go Top
This.Refresh
Catch
Endtry
ENDPROC
PROCEDURE bind
Unbindevents(This)
This.SetAll("MousePointer",1,"Header")
For Each oControl In This.Columns
Bindevent(oControl.Controls(1),"Click",This,"grhClick")
Endfor
ENDPROC
PROCEDURE getfieldtag
Lparameter tcAlias,tcField
Local lnTags,lnI,lcKey,lcTag
lcTag = ""
If Used(tcAlias)
lnTags = Tagcount("",tcAlias)
For lnI = 1 To lnTags
lcKey = Key("",lnI,tcAlias)
If Upper(Alltrim(lcKey)) = Upper(Alltrim(tcField))
lcTag = Upper(Tag("",lnI,tcAlias))
Exit
Endif
Endfor
Endif
Return lcTag
ENDPROC
ENDDEFINE
[此贴子已经被作者于2022-4-12 20:16编辑过]