VFP如何调用ChooseFont（Windows API标准字体选择对话框）？ - 编程论坛

#2

sam_jiang2025-06-09 20:35

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

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

#3

iswith2025-06-09 21:24

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

只有本站会员才能查看附件，请登录

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

只有本站会员才能查看附件，请登录

#4

cssnet2025-06-09 21:51

以下是引用sam_jiang在2025-6-9 20:35:27的发言：

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

实在搞不懂，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
--------------------------------
这个回答估计靠谱一些吧。

#5

sam_jiang2025-06-09 22:36

给你改了代码，你看看！

程序代码：

*----------------------------------
* 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环境下运行通过！

只有本站会员才能查看附件，请登录

#6

cssnet2025-06-09 23:03

以下是引用sam_jiang在2025-6-9 22:36:32的发言：

给你改了代码，你看看！

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

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

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

再次感谢！

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

#7

schtg2025-06-10 07:14

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

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

#8

cssnet2025-06-10 07:30

以下是引用schtg在2025-6-10 07:14:41的发言：

我收集的大侠的代码，试一试可否？
loFont = createobject('')
loFont.ShowFont()
messagebox(loFont.fontsize)

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

只有本站会员才能查看附件，请登录

#9

hsfisher2025-06-10 08:06

#10

schtg2025-06-10 11:17

回复 8楼 cssnet

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

只有本站会员才能查看附件，请登录

程序代码：

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编辑过]

#11

sam_jiang2025-06-10 11:27

回复 6楼 cssnet

检查一下结构体解析，肯定解析错了。选择字体的对话框都出来了，说明没有问题，问题出在分析字体结构

#12

cssnet2025-06-10 11:38

能弹出字体选择对话框，这意味着：
前半部分错误较少，只是默认【字号】搞乱了。
测试了一下，若希望默认12号字，将ShowFontDialog()的第5个参数改为16即可（12+4=16）。具体原因暂不太清楚，不过这个小问题几乎可以忽略，因默认值不重要。

问题主要在后半部分：解析字体选择对话框的返回值，存在不少错误。

首先，之前让DeepSeek的一大堆“骚操作”给迷惑了！看了半天，才想起来：
lnPointSize = CTOBIN(SUBSTR(lcChooseFont, 17, 2), "2RS") * 65536 + ;
CTOBIN(SUBSTR(lcChooseFont, 19, 2), "2RS")
其实，DeepSeek的真实意图，无非就是：
lnPointSize = CTOBIN(SUBSTR(lcChooseFont, 17, 4), "4RS")
结果它给弄得乱七八糟！——NND！

其次，跟踪了一下ChooseFont(@lcChooseFont)的返回值，lcChooseFont的内容基本正常（即，CHOOSEFONT 结构基本没问题）；然而，lcLogFontBuffer完全空白（即，LOGFONT 结构问题大大的），难怪【字体】、【下划线】、【删除线】那些选项，全部解析错误。网上搜了一下LOGFONT 结构的字节长度，好像不是60？这么重要的东西，DeepSeek也敢胡来？！

唉，图样图森破——人生处处是陷阱啊！

#13

sam_jiang2025-06-10 11:46

回复 12楼 cssnet

程序代码：

typedef struct tagLOGFONT {
    LONG lfHeight;          // 字体高度（逻辑单位）
    LONG lfWidth;           // 字符平均宽度（0表示自动适配）
    LONG lfEscapement;      // 文本行旋转角度（单位：0.1度）
    LONG lfOrientation;     // 字符基线旋转角度（单位：0.1度）
    LONG lfWeight;          // 字体粗细（0-1000，如400为正常，700为粗体）
    BYTE lfItalic;          // 斜体标志（非零表示斜体）
    BYTE lfUnderline;       // 下划线标志（非零表示下划线）
    BYTE lfStrikeOut;       // 删除线标志（非零表示删除线）
    BYTE lfCharSet;         // 字符集（如ANSI_CHARSET、GB2312_CHARSET）
    BYTE lfOutPrecision;    // 输出精度（如OUT_DEFAULT_PRECIS）
    BYTE lfClipPrecision;   // 裁剪精度（如CLIP_DEFAULT_PRECIS）
    BYTE lfQuality;         // 输出质量（如DEFAULT_QUALITY、ANTIALIASED_QUALITY）
    BYTE lfPitchAndFamily;  // 字体间距和族（如FF_SWISS | DEFAULT_PITCH）
    TCHAR lfFaceName;   // 字体名称（如"Arial"）
} LOGFONT;

#14

cssnet2025-06-10 12:28

以下是引用schtg在2025-6-10 11:17:15的发言：
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)

schtg英雄，太感谢啦！这一段代码基本等效于#5的sam_jiang英雄的代码。
区别在于，schtg英雄的代码没有bug，检测返回值LOGFONT 结构体的内部，是正确的！
虽说只有前半部分，缺失了后半部分的返回值解析，可，只要那两个结构体本身是正确的，那么，后半部分的问题就比较好办啦！

#15

cssnet2025-06-10 12:47

以下是引用sam_jiang在2025-6-10 11:46:45的发言：
typedef struct tagLOGFONT {
    LONG lfHeight;          // 字体高度（逻辑单位）
    LONG lfWidth;           // 字符平均宽度（0表示自动适配）
    LONG lfEscapement;      // 文本行旋转角度（单位：0.1度）
    LONG lfOrientation;     // 字符基线旋转角度（单位：0.1度）
    LONG lfWeight;          // 字体粗细（0-1000，如400为正常，700为粗体）
    BYTE lfItalic;          // 斜体标志（非零表示斜体）
    BYTE lfUnderline;       // 下划线标志（非零表示下划线）
    BYTE lfStrikeOut;       // 删除线标志（非零表示删除线）
    BYTE lfCharSet;         // 字符集（如ANSI_CHARSET、GB2312_CHARSET）
    BYTE lfOutPrecision;    // 输出精度（如OUT_DEFAULT_PRECIS）
    BYTE lfClipPrecision;   // 裁剪精度（如CLIP_DEFAULT_PRECIS）
    BYTE lfQuality;         // 输出质量（如DEFAULT_QUALITY、ANTIALIASED_QUALITY）
    BYTE lfPitchAndFamily;  // 字体间距和族（如FF_SWISS | DEFAULT_PITCH）
    TCHAR lfFaceName;   // 字体名称（如"Arial"）
} LOGFONT;

非常感谢sam_jiang英雄的帮助！
这是schtg英雄那段代码的运行结果，终于得到了CHOOSEFONT和LOGFONT两个结构体的完整返回值！
我眼瞅着那两个结果，闪闪发光，仿佛看到了美丽的耶利亚女郎！

只有本站会员才能查看附件，请登录

#16

cssnet2025-06-10 14:42

简单地合并了两份代码，念去去，温一壶烧酒，酬谢诸位英雄！

程序代码：

DO decl
#DEFINE GMEM_FIXED                 0
#DEFINE LF_FACESIZE               32
#DEFINE FW_BOLD                  700
#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, lcLogFontBuffer, hLogFont, lcFontFace
lcLogFontBuffer = num2dword(16) +;
        num2dword(0)  +;
        num2dword(0)  +;
        num2dword(0)  +;
        num2dword(FW_NORMAL) +;
        Chr(0) +;
        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, @lcLogFontBuffer, 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 (@lcLogFontBuffer, hLogFont, lnLogFontSize)

    *-----------解析ChooseFont()返回值开始------------*
        LOCAL lnPointSize, lnColor, lcFaceName, lcResult

        * 从 CHOOSEFONT 结构中获取点大小 (单位是1/10点)
        lnPointSize = CTOBIN(SUBSTR(lcChooseFont, 17, 4), "4RS")
        lnPointSize = lnPointSize / 10

        * 从 CHOOSEFONT 结构中获取颜色
        lnColor = CTOBIN(SUBSTR(lcChooseFont, 25, 4), "4RS")

        * 从 LOGFONT 结构中获取字体名称(偏移量28开始，32字节)
        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, 4), "4RS")
        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)

        * 返回结果
        lcResult = 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)

    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
    *-----------解析ChooseFont()返回值结束------------*

    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)

#17

cssnet2025-06-11 00:10

返回值当中的颜色值一项，是个整型数，经测试其数值没有问题。若不放心，可以将返回值直接赋给某个控件的forecolor属性，看一眼，核实一下。假如看不惯整数颜色值，找个函数转换为RGB表示法即可。

相关函数VfpColor2Html()，见：

https://bbs.bc-cn.net/thread-514363-1-1.html

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

#18

sych2025-06-11 10:16

非常流畅，谢谢分享

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

#19

cssnet2025-06-11 12:09

讲真，若非有DeepSeek的啰哩啰嗦代码在前，一般人是很难看懂10#代码的，异常简洁，然而以硬编码字符串模拟结构体，完全无注释，在外人眼中，等同于“天书”！借助DeepSeek的注解，就能轻易读懂了，且能欣赏到大侠代码的精妙之处。

写代码有DeepSeek帮忙，相当于一个人带了一个Team，还不花钱，纯免费！DeepSeek虽无法解决100%的问题，然而，已解决85%甚至更高的问题了！

#20

kangss2025-06-12 11:56

十分感谢！

#21

seasoners2025-06-12 15:15

赞，非常感谢分享

#22

sam_jiang2025-06-14 13:18

电脑里保存了一个老外写的如何调用api函数的大全apiviewer，里面详细列举了各种api函数的说明，介绍，用法，变量，结构等，以及vfp范例，找到与createfont相关的范例，分享给大家，仅做参考！

createfont相关api运用例子：

程序代码：

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

*| typedef struct {
*|   DWORD        lStructSize;     4
*|   HWND         hwndOwner;       4
*|   HDC          hDC;             4
*|   LPLOGFONT    lpLogFont;       4
*|   INT          iPointSize;      4
*|   DWORD        Flags;           4
*|   COLORREF     rgbColors;       4
*|   LPARAM       lCustData;       4
*|   LPCFHOOKPROC lpfnHook;        4
*|   LPCTSTR      lpTemplateName;  4
*|   HINSTANCE    hInstance;       4
*|   LPTSTR       lpszStyle;       4
*|   WORD         nFontType;       2
*|   WORD         ___MISSING_ALIGNMENT__; 2
*|   INT          nSizeMin;        4
*|   INT          nSizeMax;        4
*| } CHOOSEFONT, *LPCHOOSEFONT; total: 60 bytes

*| typedef struct tagLOGFONT {
*|   LONG lfHeight;                   4
*|   LONG lfWidth;                    4
*|   LONG lfEscapement;               4
*|   LONG lfOrientation;              4
*|   LONG lfWeight;                   4
*|   BYTE lfItalic;                   1
*|   BYTE lfUnderline;                1
*|   BYTE lfStrikeOut;                1
*|   BYTE lfCharSet;                  1
*|   BYTE lfOutPrecision;             1
*|   BYTE lfClipPrecision;            1
*|   BYTE lfQuality;                  1
*|   BYTE lfPitchAndFamily;           1
*|   TCHAR lfFaceName[LF_FACESIZE];  32
*| } LOGFONT, *PLOGFONT; total: 60 bytes

    LOCAL lcChooseFont, lcLogFont, hLogFont, lcFontFace

    * initializing LOGFONT structure:
    * Times New Roman, Italic
    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)

    * copying the LOGFONT data into the global memory object
    * because CHOOSEFONT structure uses the pointer
    lnLogFontSize = 60
    hLogFont = GlobalAlloc(GMEM_FIXED, lnLogFontSize)

    * this function is re-declared below
    * with different parameter types
    DECLARE RtlMoveMemory IN kernel32 As String2Heap;
        INTEGER Destination, STRING @ Source,;
        INTEGER nLength
    = String2Heap (hLogFont, @lcLogFont, lnLogFontSize)

    * initializing CHOOSEFONT structure
    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
    * displaying selection
        * re-declaring API function with different parameters
        DECLARE RtlMoveMemory IN kernel32 As Heap2String;
            STRING @Dest, INTEGER Source, INTEGER nLength

        * copying data from the global memory object to VFP string
        = Heap2String (@lcLogFont, hLogFont, lnLogFontSize)

        ? "*** CHOOSEFONT Structure:"
        ? "Point size:", buf2dword(SUBSTR(lcChooseFont, 17,4))
        ? "RGB color: ", buf2dword(SUBSTR(lcChooseFont, 25,4))

        ?
        ? "*** LOGFONT Structure:"
        ? "Font Weight:", buf2dword(SUBSTR(lcLogFont, 17,4))
        ? "Italic:     ", Iif(Asc(SUBSTR(lcLogFont, 21,1))=0, "No","Yes")
        ? "Underline:  ", Iif(Asc(SUBSTR(lcLogFont, 22,1))=0, "No","Yes")
        ? "Strikeout:  ", Iif(Asc(SUBSTR(lcLogFont, 23,1))=0, "No","Yes")

        lcFontFace = SUBSTR(lcLogFont, 29)
        lcFontFace = SUBSTR(lcFontFace, 1, AT(Chr(0),lcFontFace)-1)
        ? "Font Face:  ", lcFontFace
    ENDIF

    * releasing system resources
    = 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)

FUNCTION  buf2dword (lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
    Asc(SUBSTR(lcBuffer, 2,1)) * 256 +;
    Asc(SUBSTR(lcBuffer, 3,1)) * 65536 +;
    Asc(SUBSTR(lcBuffer, 4,1)) * 16777216

运行效果如下：

只有本站会员才能查看附件，请登录

#23

cssnet2025-06-14 14:10

以下是引用sam_jiang在2025-6-14 13:18:14的发言：

电脑里保存了一个老外写的如何调用api函数的大全apiviewer，里面详细列举了各种api函数的说明，介绍，用法，变量，结构等，以及vfp范例，找到与createfont相关的范例，分享给大家，仅做参考！

哈，你这么一说，想起来啦！apiviewer_VFP早在VFP7年代就曾下载过，只是一直都没空（准确地说，是没耐心）仔细看看……我去翻翻旧光盘。

“DO decl”这种句式，以前在红雨的API例子中常见，还挺有印象的。原以为那是他原创，敢情，源头在老外那边啊。

#24

cssnet2025-06-14 14:49

刚搜了一下旧光盘，2006年，好古老，那时候MYF1都还在呢！
可，news2news早都不存在了！
再搜一下原作者Anatoliy Mogylevets……切，敢情早就捐给VFPX了，改名了，难怪一时想不起：
https://
也只有我们这种老家伙，才会对VFP如数家珍，念念不忘。