因为需要为用户提供完整的系统字体选择，比如：“下划线、删除线、字体颜色”等等GetFont()得不到的选项，就想到了ChooseFont。提问DeepSeek，它倒是刷刷刷立刻实现了一大堆代码，可惜搞得有些复杂，且运行不起来。主要原因可能是LOGFONT和CHOOSEFONT两个struct（结构体）在VFP中实现的内存问题吧。感觉上，DeepSeek的代码皆是从VB6转译过来的，当中掺杂了无数幻觉错误——怎么破？

DeepSeek提供的代码（略）。

正确的代码完整版见：

https://bbs.bc-cn.net/viewthread.php?tid=514359&page=2#pid2791699

非常感谢诸位英雄对这个帖子的关注与帮助！

[此贴子已经被作者于2025-6-12 18:07编辑过]

函数声明要放在程序后面，创建表单的代码放前面。

另外，sys（2600）函数用法有问题。lnPtr = SYS(2600, 0, LEN(tcBuffer))，这句是有问题的，你没有分配内存

是这样吗？C原型 的VFP代码量太大了

将VFP引用V8，会简单很多就像调用VBA一样方便多了，三四行代码搞定。

实在搞不懂，DeepSeek为什么要虚构出第二个参数为0的SYS(2600, 0, ...)调用方法。于是，继续提问：

--------------------------------

问：vfp如何获取一个字符串变量的绝对内存地址？比如：lcLogFontBuffer = REPLICATE(CHR(0), LEN(lcLogFont))，如何得到lcLogFontBuffer的地址？

DeepSeek答：在 Visual FoxPro (VFP) 中获取字符串变量的绝对内存地址确实需要特别注意，因为 VFP 的内存管理机制与 C/C++ 等低级语言不同。
方法2：使用 WinAPI 的 GlobalAlloc 和 GlobalLock 函数
DECLARE INTEGER GlobalAlloc IN kernel32 INTEGER wFlags, INTEGER dwBytes
DECLARE INTEGER GlobalLock IN kernel32 INTEGER hMem
DECLARE INTEGER GlobalUnlock IN kernel32 INTEGER hMem
DECLARE INTEGER GlobalFree IN kernel32 INTEGER hMem

#DEFINE GMEM_FIXED 0x0000
#DEFINE GMEM_ZEROINIT 0x0040

FUNCTION AllocStringToMemAPI(tcString)
    LOCAL lnSize, hMem, lpMem
    lnSize = LEN(tcString)
    hMem = GlobalAlloc(GMEM_FIXED + GMEM_ZEROINIT, lnSize)
    IF hMem = 0
        RETURN 0
    ENDIF
    lpMem = GlobalLock(hMem)
    = SYS(2600, lpMem, lnSize, tcString)
    = GlobalUnlock(hMem)
    RETURN lpMem
ENDFUNC

FUNCTION FreeMemAPI(lnPointer)
    LOCAL hMem
    IF lnPointer != 0
        hMem = GlobalLock(lnPointer)
        = GlobalUnlock(lnPointer)
        = GlobalFree(hMem)
    ENDIF
ENDFUNC
--------------------------------
这个回答估计靠谱一些吧。

给你改了代码，你看看！

*----------------------------------
* API 函数声明
DECLARE INTEGER ChooseFont IN comdlg32.dll STRING @lpChooseFont
DECLARE INTE GlobalAlloc IN WIN32API integer,integer
DECLARE INTE GlobalFree IN win32api integer

* 常量定义
#DEFINE CF_SCREENFONTS          0x0001
#DEFINE CF_PRINTERFONTS         0x0002
#DEFINE CF_BOTH                 (CF_SCREENFONTS + CF_PRINTERFONTS)
#DEFINE CF_EFFECTS              0x0100
#DEFINE CF_FORCEFONTEXIST       0x10000
#DEFINE CF_INITTOLOGFONTSTRUCT  0x0040
#DEFINE CF_LIMITSIZE            0x2000
#DEFINE CF_NOVECTORFONTS        0x0800
#DEFINE CF_NOSCRIPTSEL          0x800000
#DEFINE CF_SCRIPTSONLY          CF_NOSCRIPTSEL
#DEFINE CF_SELECTSCRIPT         0x400000
#DEFINE CF_APPLY                0x0200
#DEFINE CF_ANSIONLY             0x0400
#DEFINE CF_NOVERTFONTS          0x1000000

* LOGFONT 结构定义
#DEFINE LF_FACESIZE             32

* 字体权重常量
#DEFINE FW_NORMAL               400
#DEFINE FW_BOLD                 700

* 字符集常量
#DEFINE ANSI_CHARSET            1

*----------------------------------
*创建一个表单，添加一个按钮，并在按钮的 Click 事件中使用以下代码：
LOCAL lcResult, laFont[7], lcMessage

* 调用字体对话框
lcResult = ShowFontDialog(_VFP.HWnd, 8, 72, "Arial", 12, .F., .F., RGB(0,0,0))

IF !EMPTY(lcResult)
    * 解析返回结果
    ALINES(laFont, lcResult, 0, CHR(0))
   
    * 显示选择结果
    lcMessage = "字体: " + laFont[1] + CHR(13) + ;
               "字号: " + laFont[2] + CHR(13) + ;
               "粗体: " + IIF(laFont[3] = "1", "是", "否") + CHR(13) + ;
               "斜体: " + IIF(laFont[4] = "1", "是", "否") + CHR(13) + ;
               "下划线: " + IIF(laFont[5] = "1", "是", "否") + CHR(13) + ;
               "删除线: " + IIF(laFont[6] = "1", "是", "否") + CHR(13) + ;
               "颜色值: " + laFont[7]
   
    MESSAGEBOX(lcMessage, 64, "字体选择结果")
ELSE
    MESSAGEBOX("用户取消了字体选择", 64, "提示")
ENDIF

FUNCTION CreateLogFont(tcFaceName, tnHeight, tnWeight, tnItalic, tnUnderline, tnStrikeOut)
    LOCAL lcLogFont
   
    * LOGFONT 结构 (60字节)
    * 注意: VFP 中使用字符串模拟结构，需要按顺序填充所有字段
   
    * lfHeight (Long)
    lcLogFont = INT2WORD(LOWORD(tnHeight)) + INT2WORD(HIWORD(tnHeight))
   
    * lfWidth (Long)
    lcLogFont = lcLogFont + REPLICATE(CHR(0), 4)
   
    * lfEscapement (Long)
    lcLogFont = lcLogFont + REPLICATE(CHR(0), 4)
   
    * lfOrientation (Long)
    lcLogFont = lcLogFont + REPLICATE(CHR(0), 4)
   
    * lfWeight (Long)
    lcLogFont = lcLogFont + INT2WORD(LOWORD(tnWeight)) + INT2WORD(HIWORD(tnWeight))
   
    * lfItalic (Byte)
    lcLogFont = lcLogFont + CHR(tnItalic)
   
    * lfUnderline (Byte)
    lcLogFont = lcLogFont + CHR(tnUnderline)
   
    * lfStrikeOut (Byte)
    lcLogFont = lcLogFont + CHR(tnStrikeOut)
   
    * lfCharSet (Byte)
    lcLogFont = lcLogFont + CHR(ANSI_CHARSET)
   
    * lfOutPrecision (Byte)
    lcLogFont = lcLogFont + CHR(0)
   
    * lfClipPrecision (Byte)
    lcLogFont = lcLogFont + CHR(0)
   
    * lfQuality (Byte)
    lcLogFont = lcLogFont + CHR(0)
   
    * lfPitchAndFamily (Byte)
    lcLogFont = lcLogFont + CHR(0)
   
    * lfFaceName (32 bytes)
    lcLogFont = lcLogFont + PADR(tcFaceName, LF_FACESIZE, CHR(0))
   
    RETURN lcLogFont
ENDFUNC

FUNCTION CreateChooseFont(tnStructSize, tnhWndOwner, tnhDC, tnlpLogFont, ;
                         tniPointSize, tnFlags, tnrgbColors, tnlCustData, ;
                         tnlpfnHook, tclpTemplateName, tnhInstance, tclpszStyle, ;
                         tniFontType, tniSizeMin, tniSizeMax)
    LOCAL lcChooseFont
   
    * CHOOSEFONT 结构 (60字节)
    * 注意: 需要按顺序填充所有字段
   
    * lStructSize (Long)
    lcChooseFont = INT2WORD(LOWORD(tnStructSize)) + INT2WORD(HIWORD(tnStructSize))
   
    * hwndOwner (Long)
    lcChooseFont = lcChooseFont + INT2WORD(LOWORD(tnhWndOwner)) + INT2WORD(HIWORD(tnhWndOwner))
   
    * hDC (Long)
    lcChooseFont = lcChooseFont + INT2WORD(LOWORD(tnhDC)) + INT2WORD(HIWORD(tnhDC))
   
    * lpLogFont (Long)
    lcChooseFont = lcChooseFont + INT2WORD(LOWORD(tnlpLogFont)) + INT2WORD(HIWORD(tnlpLogFont))
   
    * iPointSize (Long)
    lcChooseFont = lcChooseFont + INT2WORD(LOWORD(tniPointSize)) + INT2WORD(HIWORD(tniPointSize))
   
    * Flags (Long)
    lcChooseFont = lcChooseFont + INT2WORD(LOWORD(tnFlags)) + INT2WORD(HIWORD(tnFlags))
   
    * rgbColors (Long)
    lcChooseFont = lcChooseFont + INT2WORD(LOWORD(tnrgbColors)) + INT2WORD(HIWORD(tnrgbColors))
   
    * lCustData (Long)
    lcChooseFont = lcChooseFont + INT2WORD(LOWORD(tnlCustData)) + INT2WORD(HIWORD(tnlCustData))
   
    * lpfnHook (Long)
    lcChooseFont = lcChooseFont + INT2WORD(LOWORD(tnlpfnHook)) + INT2WORD(HIWORD(tnlpfnHook))
   
    * lpTemplateName (String - 4 bytes pointer)
    lcChooseFont = lcChooseFont + REPLICATE(CHR(0), 4)
   
    * hInstance (Long)
    lcChooseFont = lcChooseFont + INT2WORD(LOWORD(tnhInstance)) + INT2WORD(HIWORD(tnhInstance))
   
    * lpszStyle (String - 4 bytes pointer)
    lcChooseFont = lcChooseFont + REPLICATE(CHR(0), 4)
   
    * nFontType (Integer)
    lcChooseFont = lcChooseFont + INT2WORD(tniFontType)
   
    * 对齐填充 (2 bytes)
    lcChooseFont = lcChooseFont + REPLICATE(CHR(0), 2)
   
    * nSizeMin (Long)
    lcChooseFont = lcChooseFont + INT2WORD(LOWORD(tniSizeMin)) + INT2WORD(HIWORD(tniSizeMin))
   
    * nSizeMax (Long)
    lcChooseFont = lcChooseFont + INT2WORD(LOWORD(tniSizeMax)) + INT2WORD(HIWORD(tniSizeMax))
   
    RETURN lcChooseFont
ENDFUNC

* 辅助函数
FUNCTION INT2WORD(tnValue)
    RETURN CHR(MOD(tnValue, 256)) + CHR(INT(tnValue/256))
ENDFUNC

FUNCTION LOWORD(tnValue)
    RETURN MOD(tnValue, 65536)
ENDFUNC

FUNCTION HIWORD(tnValue)
    RETURN INT(tnValue/65536)
ENDFUNC

FUNCTION ShowFontDialog
    LPARAMETERS ;
        tnhWndOwner, ;
        tniSizeMin, ;
        tniSizeMax, ;
        tcInitFontName, ;
        tniInitFontSize, ;
        tlInitBold, ;
        tlInitItalic, ;
        tnInitColor, ;
        tlShowEffects, ;
        tlShowPrinterFonts
        
    LOCAL lcLogFont, lcChooseFont, lnFlags, lnResult
    LOCAL lcLogFontBuffer, lnLogFontPtr, lcReturn
   
    * 设置默认参数
    tnhWndOwner = IIF(EMPTY(tnhWndOwner), _VFP.HWnd, tnhWndOwner)
    tniSizeMin = IIF(EMPTY(tniSizeMin), 0, tniSizeMin)
    tniSizeMax = IIF(EMPTY(tniSizeMax), 0, tniSizeMax)
    tcInitFontName = IIF(EMPTY(tcInitFontName), "Arial", tcInitFontName)
    tniInitFontSize = IIF(EMPTY(tniInitFontSize), 10, tniInitFontSize)
    tlInitBold = IIF(EMPTY(tlInitBold), .F., tlInitBold)
    tlInitItalic = IIF(EMPTY(tlInitItalic), .F., tlInitItalic)
    tnInitColor = IIF(EMPTY(tnInitColor), RGB(0,0,0), tnInitColor)
    tlShowEffects = IIF(EMPTY(tlShowEffects), .T., tlShowEffects)
    tlShowPrinterFonts = IIF(EMPTY(tlShowPrinterFonts), .F., tlShowPrinterFonts)
   
    * 创建 LOGFONT 结构：转换为逻辑单位，无下划线，无删除线
    lcLogFont = CreateLogFont(tcInitFontName, ;
                             -1 * (tniInitFontSize * 20), ;
                             IIF(tlInitBold, FW_BOLD, FW_NORMAL), ;
                             IIF(tlInitItalic, 1, 0), ;
                             0, ;
                             0)
   
    * 为 LOGFONT 分配内存
    lcLogFontBuffer = REPLICATE(CHR(0), LEN(lcLogFont))
    lnLogFontPtr = STRTOVAR(lcLogFont, lcLogFontBuffer)
   
    * 设置标志
    lnFlags = CF_BOTH + CF_EFFECTS + CF_INITTOLOGFONTSTRUCT
   
    IF tlShowEffects = .F.
        lnFlags = BITAND(lnFlags, BITNOT(CF_EFFECTS))
    ENDIF
   
    IF tlShowPrinterFonts = .T.
        lnFlags = BITAND(lnFlags, BITNOT(CF_SCREENFONTS)) + CF_PRINTERFONTS
    ENDIF
   
    IF tniSizeMin > 0 OR tniSizeMax > 0
        lnFlags = lnFlags + CF_LIMITSIZE
    ENDIF
   
    * 创建 CHOOSEFONT 结构
    lcChooseFont = CreateChooseFont(60, ;             && lStructSize
                                   tnhWndOwner, ;     && hwndOwner
                                   0, ;               && hDC
                                   lnLogFontPtr, ;    && lpLogFont
                                   0, ;               && iPointSize
                                   lnFlags, ;         && Flags
                                   tnInitColor, ;     && rgbColors
                                   0, ;               && lCustData
                                   0, ;               && lpfnHook
                                   "", ;             && lpTemplateName
                                   0, ;               && hInstance
                                   "", ;             && lpszStyle
                                   0, ;               && nFontType
                                   tniSizeMin, ;      && nSizeMin
                                   tniSizeMax)        && nSizeMax
   
    * 调用字体对话框
    lnResult = ChooseFont(@lcChooseFont)
   
    IF lnResult <> 0
        * 从 CHOOSEFONT 结构中提取信息
        LOCAL lnPointSize, lnColor, lcFaceName
        
        * 获取点大小 (单位是1/10点)
        lnPointSize = CTOBIN(SUBSTR(lcChooseFont, 17, 2), "2RS") * 65536 + ;
                     CTOBIN(SUBSTR(lcChooseFont, 19, 2), "2RS")
        lnPointSize = lnPointSize / 10
        
        * 获取颜色
        lnColor = CTOBIN(SUBSTR(lcChooseFont, 25, 2), "2RS") * 65536 + ;
                 CTOBIN(SUBSTR(lcChooseFont, 27, 2), "2RS")
        
        * 从 LOGFONT 结构中获取字体名称
        lcFaceName = SUBSTR(lcLogFontBuffer, 29, LF_FACESIZE)
        lcFaceName = LEFT(lcFaceName, AT(CHR(0), lcFaceName) - 1)
        
        * 从 LOGFONT 结构中获取样式信息
        LOCAL lnWeight, llBold, llItalic, llUnderline, llStrikeOut
        
        lnWeight = CTOBIN(SUBSTR(lcLogFontBuffer, 17, 2), "2RS") * 65536 + ;
                  CTOBIN(SUBSTR(lcLogFontBuffer, 19, 2), "2RS")
        llBold = (lnWeight >= FW_BOLD)
        
        llItalic = (ASC(SUBSTR(lcLogFontBuffer, 21, 1)) <> 0)
        llUnderline = (ASC(SUBSTR(lcLogFontBuffer, 22, 1)) <> 0)
        llStrikeOut = (ASC(SUBSTR(lcLogFontBuffer, 23, 1)) <> 0)
        
        * 返回结果
        lcReturn = lcFaceName + CHR(0) + ;
                  TRANSFORM(lnPointSize) + CHR(0) + ;
                  IIF(llBold, "1", "0") + CHR(0) + ;
                  IIF(llItalic, "1", "0") + CHR(0) + ;
                  IIF(llUnderline, "1", "0") + CHR(0) + ;
                  IIF(llStrikeOut, "1", "0") + CHR(0) + ;
                  TRANSFORM(lnColor)
    ELSE
        lcReturn = ""
    ENDIF
   
    * 释放内存
    = VarFree(lnLogFontPtr)
   
    RETURN lcReturn
ENDFUNC

* 辅助函数 [color=#808080]- 将字符串复制到内存并返回指针[/color]
FUNCTION STRTOVAR(tcString, tcBuffer)
    LOCAL lnPtr
*    lnPtr [color=#808080]= SYS(2600, 0, LEN(tcBuffer))[/color]
    lnPtr = globalalloc(0x42,LEN(tcBuffer))    
    = SYS(2600, lnPtr, LEN(tcBuffer), tcString)
    RETURN lnPtr
ENDFUNC

* 辅助函数 [color=#808080]- 释放内存[/color]
FUNCTION VarFree(tnPtr)
    IF tnPtr <> 0
*        [color=#808080]= SYS(2600, tnPtr, 0, REPLICATE(CHR(0), 0))[/color]
        =globalfree(tnPtr)
    ENDIF
ENDFUNC

在win7+vfp9.0环境下运行通过！

收到的鲜花

• wengjl 于 7 天前 08:31 送鲜花  1朵   附言：非常棒！

大侠！非常感谢！至少代码总算可以运行，字体选择对话框出现啦！！


Win11+VFP9经测试可能存在一些问题：

1、lnPtr = globalalloc(0x40, LEN(tcBuffer))这一句，0x42很不稳定，可能还是要按DeepSeek的范例代码，改用0x40（GMEM_MOVEABLE|GMEM_ZEROINIT）。
2、提取的字体结果大多是错的：【字体】提取结果空白；【字号】数值古怪，非常大；粗体、斜体、下划线、删除线都不对；颜色值不对。

再次感谢！

[此贴子已经被作者于2025-6-10 06:59编辑过]

我收集的大侠的代码，试一试可否？

loFont = createobject('')
loFont.ShowFont()
messagebox(loFont.fontsize)

ShowFont对话框跟VFP自带的Getfont()区别不大，与ChooseFont对话框相比，少了很多选项：

确实如此，平时很少用到，没有仔细比较他们的差别，我又查找了收藏的，还有

DO decl
#DEFINE GMEM_FIXED                 0
#DEFINE LF_FACESIZE               32
#DEFINE FW_NORMAL                400
#DEFINE DEFAULT_CHARSET            1
#DEFINE OUT_DEFAULT_PRECIS         0
#DEFINE CLIP_DEFAULT_PRECIS        0
#DEFINE DEFAULT_QUALITY            0
#DEFINE DEFAULT_PITCH              0
#DEFINE CF_SCREENFONTS             1
#DEFINE CF_INITTOLOGFONTSTRUCT    64
#DEFINE CF_EFFECTS               256
#DEFINE CF_FORCEFONTEXIST      65536

LOCAL lcChooseFont, lcLogFont, hLogFont, lcFontFace
lcLogFont = num2dword(16) +;
        num2dword(0)  +;
        num2dword(0)  +;
        num2dword(0)  +;
        num2dword(FW_NORMAL) +;
        Chr(1) +;
        Chr(0) +;
        Chr(0) +;
        Chr(DEFAULT_CHARSET)     +;
        Chr(OUT_DEFAULT_PRECIS)  +;
        Chr(CLIP_DEFAULT_PRECIS) +;
        Chr(DEFAULT_QUALITY)     +;
        Chr(DEFAULT_PITCH)       +;
        PADR("Times New Roman"+Chr(0),32)

    lnLogFontSize = 60
    hLogFont = GlobalAlloc(GMEM_FIXED, lnLogFontSize)

    DECLARE RtlMoveMemory IN kernel32 As String2Heap;
        INTEGER Destination, STRING @ Source,;
        INTEGER nLength
    = String2Heap (hLogFont, @lcLogFont, lnLogFontSize)

    lcChooseFont = num2dword(60) +;
        num2dword(0) +;
        num2dword(0) +;
        num2dword(hLogFont) +;
        num2dword(0) +;
        num2dword(CF_SCREENFONTS + CF_EFFECTS +;
            CF_INITTOLOGFONTSTRUCT + CF_FORCEFONTEXIST) +;
        num2dword(0) +;
        num2dword(0) +;
        num2dword(0) +;
        num2dword(0) +;
        num2dword(0) +;
        num2dword(0) +;
        num2dword(0) +;
        num2dword(0) +;
        num2dword(0)

    IF ChooseFont (@lcChooseFont) <> 0
        DECLARE RtlMoveMemory IN kernel32 As Heap2String;
            STRING @Dest, INTEGER Source, INTEGER nLength
        = Heap2String (@lcLogFont, hLogFont, lnLogFontSize)
    ENDIF
    = GlobalFree (hLogFont)
RETURN

PROCEDURE  decl
    DECLARE INTEGER ChooseFont IN comdlg32 STRING @lpcf
    DECLARE INTEGER GlobalFree IN kernel32 INTEGER hMem
    DECLARE INTEGER GlobalAlloc IN kernel32;
        INTEGER wFlags,;
        INTEGER dwBytes

FUNCTION  num2dword (lnValue)
#DEFINE m0       256
#DEFINE m1     65536
#DEFINE m2  16777216
    LOCAL b0, b1, b2, b3
    b3 = Int(lnValue/m2)
    b2 = Int((lnValue - b3*m2)/m1)
    b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
    b0 = Mod(lnValue, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)

[此贴子已经被作者于2025-6-10 11:19编辑过]