VFP Grid 的“代码设置”

*!******************************************************************************
*!* 程序.......: TOOLS_AUTOGRIDSET.PRG
*!* 作者.......: xinjie
*!* 日期.......: 06/13/22
*!* 版权.......: Copyright (c) 2022 xinjie
*!* 编译版本...: Visual FoxPro09.00.0000.7423
*!* 版本.......: 1.0.0.4
*!* 说明.......: 提取已设置 Grid 的所有非只读属性的默认值至选定 Grid 的 Refresh 方法
*!* 语法.......:
*!* 参数.......:
*!* 返回值.....:
*!* 使用方法...: 选定 Grid，然后执行此 PRG
*!******************************************************************************

*!* 2022.06.13
*!* 适当修改代码以适用于框架 Grid 类

*!* 2019.12.18
*!* 完善代码，使 Grid 自动调整列宽

*!*  2016.12.22 bug fix
*!*  如果 Column 中添加其他控件，那么所得到的代码会忽略控件的 Visible 属性设置，直接重复使用会造成所绑定数据源内容不显示。

*!* 2016.12.15 bug fix
*!*  1 明确操作完成
*!*  2 插入 Refresh 方法而不是覆盖
*!*  3 忽略只读属性
*!*  4 注意：某些属性设计时可用，运行时只读，无法在代码中忽略。自行删除。

Private All Like l*
Private i, j, k, n

Local loObject  As Object,    ;
    lcSet   As Character,  ;
    lnNum    As Number,    ;
    laObject

Dimension laObject[1]

If Aselobj(laObject) = 0
  Messagebox([没有选定要操作的对象！], 16, _Screen.Caption)
  Return
Else
  m.loObject = laObject[1]
Endif

If m.loObject.BaseClass <> [Grid]
  Messagebox([本工具仅对 Grid 进行操作！], 0, _Screen.Caption)
  Return
Endif

Dimension laGrid[1]

m.lnNum = Amembers(laGrid, m.loObject, 3, [C])

TEXT to m.lcSet textmerge noshow pretext 1
    With This
      *!* Code by tq_tool_AutoGridSet Ver:1.0.0.4
    
EndText

*!*  获取并组合设置代码
*!*  1 Grid
For m.i = 1 to m.lnNum
  If laGrid[m.i, 2] == [Property] and PemStatus(m.loObject, laGrid[m.i, 1], 1) = .F.
    TEXT to m.lcSet additive textmerge noshow pretext 1
          .<<laGrid[m.i, 1]>>  =  <<Iif(Vartype(GetPem(m.loObject , laGrid[m.i, 1])) = [C], "["+ GetPem(m.loObject , laGrid[m.i, 1]) + "]", GetPem(m.loObject , laGrid[m.i, 1]))>>        &&  <<laGrid[m.i, 4]>>
          
    EndText 
  EndIf 
EndFor 

*!*  2 Column
For m.i = 1 to m.loObject.ColumnCount
  Dimension laColumn[1]
  m.lnNum = AMembers(laColumn, m.loObject.Objects[m.i], 3, [C])

  For m.j = 1 to m.lnNum
    If laColumn[m.j, 2] == [Property] and PemStatus(m.loObject.Objects[m.i], laColumn[m.j, 1], 1) = .F.
      TEXT to m.lcSet additive textmerge noshow pretext 1
              .Column<<Alltrim(Str(m.i))>>.<<laColumn[m.j, 1]>>  =  <<Iif(Vartype(GetPem(m.loObject.Objects[m.i] , laColumn[m.j, 1])) = [C], "[" + GetPem(m.loObject.Objects[m.i] , laColumn[m.j, 1]) + "]", GetPem(m.loObject.Objects[m.i] , laColumn[m.j, 1]))>>        &&  <<laColumn[m.j, 4]>>
          
      EndText 
    EndIf  
  EndFor 

  *!*  3 Header and xxxxxxx
  For m.k = 1 to m.loObject.Objects[m.i].ControlCount
    Dimension laHeader[1]
    m.lnNum2 = AMembers(laHeader, m.loObject.Objects[m.i].Controls[m.k], 3, [C])  

    For m.n = 1 to m.lnNum2
      If laHeader[m.n, 2] == [Property] and PemStatus(m.loObject.Objects[m.i].Controls[m.k], laHeader[m.n, 1], 1) = .F.
        TEXT to m.lcSet additive textmerge noshow pretext 1
                     .Column<<Alltrim(Str(m.i))>>.<<m.loObject.Objects[m.i].Controls[m.k].Name>>.<<laHeader[m.n, 1]>>  =  <<Iif(Vartype(GetPem(m.loObject.Objects[m.i].Controls[m.k] , laHeader[m.n, 1])) = [C], "[" + GetPem(m.loObject.Objects[m.i].Controls[m.k] , laHeader[m.n, 1]) + "]", GetPem(m.loObject.Objects[m.i].Controls[m.k] , laHeader[m.n, 1]))>>        &&  <<laHeader[m.n, 4]>>
                     
        EndText 
      EndIf 
    EndFor 
    
    If m.loObject.Objects[m.i].Controls[m.k].Class # [Textbox] and m.loObject.Objects[m.i].Controls[m.k].Class # [Header]
      TEXT to m.lcSet additive textmerge noshow pretext 1
                 .Column<<Alltrim(Str(m.i))>>.<<m.loObject.Objects[m.i].Controls[m.k].Name>>.Visible  =  .T.
                     
      EndText 
    EndIf 
  EndFor
EndFor 


TEXT to m.lcSet additive textmerge noshow pretext 1
    
      .AutoFit()
      
      For each m.loColumn in .Columns
        m.loColumn.Width = m.loColumn.Width + 10
      EndFor 
      
      Try
        .Mask()
      Catch 
      EndTry 
    EndWith 
EndText

m.lcSet = m.lcSet + Chr(13) + m.loObject.ReadMethod([Refresh])

_cliptext = m.lcSet

Local lcTemp as Character
m.lcTemp = GetEnv("TEMP") + [\] + Sys(2015) + [.prg]

Set Safety Off

StrToFile(m.lcSet, m.lcTemp)
AutoBeauty(m.lcTemp)
loObject.WriteMethod([Refresh], FileToStr(m.lcTemp), .T., 1)

Set Safety On 

MessageBox([所选 Grid 的自定义属性设置已全部提取至控件的 Refresh 方法！])

Procedure AutoBeauty
    Lparameters m.LcPRG

    *自动获取 VFP 美化选项并美化指定PRG文件：
    Local LcResource As Character, ;
          LaBeautify[1]

    If Set([Resource]) == [ON]
        Select Data From Sys(2005) Where Upper(Id) == [BEAUTIFY] Into Array LaBeautify

    Else
        m.LcResource = Addbs(Getenv([APPDATA])) + [Microsoft\Visual FoxPro 9\FoxUser.dbf]
        If File(m.LcResource, 1)
            Select Data From (m.LcResource) Where Upper(Id) == [BEAUTIFY] Into Array LaBeautify
        Endif
    Endif

    If Select([FoxUser]) > 0
        Use In Foxuser
    Endif

    Set Procedure To (_Beautify) Additive

    Try    && BUG:从未使用过美化功能，或者 foxuser.dbf 被重置/存在的美化默认设置被破坏时，会产生错误   by 树袋熊
        Strtofile(Filetostr(beautify(m.LcPRG, Right(m.LaBeautify[1], 36))), m.LcPRG)
    Catch 
        *!*  美化选项是由9组ASC字符组成：
        *!*  第一部分 chr(n) + chr(0) + chr(0) + chr(0) ,n 对应变量大小写设置，其值和显示顺序相同
        *!*  第二部分 chr(n) + chr(0) + chr(0) + chr(0) ,n 对应关键字大小写设置，其值和显示顺序相同
        *!*  第三部分 chr(n) + chr(0) + chr(0) + chr(0) ,n 为当 TAB 设置为空格时，指定的空格数值；当使用 TAB 设置缩进时，n = 系统设置（估计可以自己指定，未测试）
        *!*  第四部分 chr(n) + chr(0) + chr(0) + chr(0) ,n 对应TAB设置,其值和显示顺序相同
        *!*  第五部分 chr(0) + chr(0) + chr(0) + chr(0)  
        *!*  第六部分 chr(n) + chr(0) + chr(0) + chr(0) ,  注释不缩进 n=0   否则 n =1
        *!*  第七部分 chr(n) + chr(0) + chr(0) + chr(0) ,  续行不缩进 n=0   否则 n =1
        *!*  第八部分 chr(n) + chr(0) + chr(0) + chr(0) ,  proc不缩进 n=0   否则 n =1
        *!*  第九部分 chr(n) + chr(0) + chr(0) + chr(0) ,  case不缩进 n=0   否则 n =1
        m.LaBeautify[1] = chr(3) + chr(0) + chr(0) + chr(0) + ;    && 大小写混合
                          chr(3) + chr(0) + chr(0) + chr(0) + ;    && 关键字不改变
                          chr(4) + chr(0) + chr(0) + chr(0) + ;    && 四个空格
                          chr(2) + chr(0) + chr(0) + chr(0) + ;    && 空格
                          chr(0) + chr(0) + chr(0) + chr(0) + ;
                          chr(1) + chr(0) + chr(0) + chr(0) + ;    && 注释缩进
                          chr(1) + chr(0) + chr(0) + chr(0) + ;    && 续行缩进
                          chr(1) + chr(0) + chr(0) + chr(0) + ;    && proc缩进
                          chr(1) + chr(0) + chr(0) + chr(0)        && case缩进
        Strtofile(Filetostr(beautify(m.LcPRG, Right(m.LaBeautify[1], 36))), m.LcPRG)
    EndTry 
EndProc