程序代码：

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;

程序代码：

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)

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

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