注册 登录
编程论坛 VFP论坛

表头排序问题

丁春秋yxp 发布于 2022-03-30 09:35, 2643 次点击
本站大神的这个点击表头排序确实强悍,值得学习:https://bbs.bccn.net/viewthread.php?tid=245879&highlight=%B1%ED%CD%B7%C5%C5%D0%F2

但发现一个问题:这方法只对自由表排序有效,对数据库中的表排序不起作用。还向大神们请教如何修正,让其对数据库中的表也起作用。


14 回复
#2
吹水佬2022-03-30 11:26
表排序通常是创建索引文件
#3
丁春秋yxp2022-03-30 22:22
回复 2楼 吹水佬
能请版主指导一下吗,最好是在原程序上修改。
#4
sdta2022-03-30 23:12
回复 3楼 丁春秋yxp
你的原程序在哪
#5
shenlancwz2022-04-10 10:39
我用VFP做的不仅能点击列标题排序,并且还可以筛选
只有本站会员才能查看附件,请 登录
#6
wengjl2022-04-10 11:25
以下是引用shenlancwz在2022-4-10 10:39:23的发言:

我用VFP做的不仅能点击列标题排序,并且还可以筛选



能把你的代码共享吗? 期待.........
#7
ljlhpop2022-04-10 15:08
回复 楼主 丁春秋yxp
研究了半天,,搞不懂附件里面的表数据是在哪里? 没看到自由表
#8
schtg2022-04-10 20:17
回复 7楼 ljlhpop
程序代码:
*** 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编辑过]

#9
shenlancwz2022-04-11 15:34
再补充一张表头筛选的示例
只有本站会员才能查看附件,请 登录
#10
ljlhpop2022-04-12 17:20
回复 8楼 schtg
只有本站会员才能查看附件,请 登录

都是有提示。。
#11
schtg2022-04-12 20:13
回复 10楼 ljlhpop
在demo.prg的PROCEDURE Load下增加一句:set safety off

[此贴子已经被作者于2022-4-12 20:15编辑过]

#12
ljlhpop2022-04-13 21:07
回复 11楼 schtg
只有本站会员才能查看附件,请 登录

弱弱问下,,这个DEMO里面,,,没看到 程序文件,,,,怎么加这句话。。。。
#13
schtg2022-04-14 05:40
回复 12楼 ljlhpop
试一试
只有本站会员才能查看附件,请 登录
#14
cwb63571232025-07-07 15:26
回复 9楼 shenlancwz
大佬。想问一下你这个是怎么做的?Form类?
#15
hsfisher3 天前 08:22
学习学习
1