setprint.frm

来自「这个是我以前做的一个客户管理系统.包内已经含有源码和所用到的控件.代码是用VB写」· FRM 代码 · 共 956 行 · 第 1/3 页

'
'将设置的数据保存在gxwh.ini文件中
'
'************************************************************
    Dim sFile           As String
    
    sFile = mGetWindowsPath() & "\gxwh.ini"
'*****************保存主标题字体信息
    mbSaveValues "Title1", "FontName", gFontNameTitle, sFile
    mbSaveValues "Title1", "FontSize", CStr(gFontSizeTitle), sFile
    mbSaveValues "Title1", "FontBold", CStr(gbFontBoldTitle), sFile
    mbSaveValues "Title1", "FontUnderLine", CStr(gbFontUnderTitle), sFile
    mbSaveValues "Title1", "FontItalic", CStr(gbFontItalicTitle), sFile
'*****************保存子标题字体信息
    mbSaveValues "MuliTitle", "FontName", gFontNameMuliTitle, sFile
    mbSaveValues "MuliTitle", "FontSize", CStr(gFontSizeMuliTitle), sFile
    mbSaveValues "MuliTitle", "FontBold", CStr(gbFontBoldMuliTitle), sFile
    mbSaveValues "MuliTitle", "FontUnderLine", CStr(gbFontUnderMuliTitle), sFile
    mbSaveValues "MuliTitle", "FontItalic", CStr(gbFontItalicMuliTitle), sFile
'*****************保存尾注字体信息
    mbSaveValues "FootTitle", "FontName", gFontNameFootTitle, sFile
    mbSaveValues "FootTitle", "FontSize", CStr(gFontSizeFootTitle), sFile
    mbSaveValues "FootTitle", "FontBold", CStr(gbFontBoldFootTitle), sFile
    mbSaveValues "FootTitle", "FontUnderLine", CStr(gbFontUnderFootTitle), sFile
    mbSaveValues "FootTitle", "FontItalic", CStr(gbFontItalicFootTitle), sFile
'******************保存标题头字体信息
    mbSaveValues "Head", "FontName", gFontNameHead, sFile
    mbSaveValues "head", "FontSize", CStr(gFontSizeHead), sFile
    mbSaveValues "Head", "FontBold", CStr(gbFontBoldHead), sFile
    mbSaveValues "Head", "FontUnderLine", CStr(gbFontUnderHead), sFile
    mbSaveValues "Head", "FontItalic", CStr(gbFontItalicHead), sFile
'******************保存正文字体信息
    mbSaveValues "Content", "FontName", gFontNameCon, sFile
    mbSaveValues "Content", "FontSize", CStr(gFontSizeCon), sFile
    mbSaveValues "Content", "FontBold", CStr(gbFontBoldCon), sFile
    mbSaveValues "Content", "FontUnderLine", CStr(gbFontUnderCon), sFile
    mbSaveValues "Content", "FontItalic", CStr(gbFontItalicCon), sFile
'******************保存间距设置
    mbSaveValues "SetPage", "LeftCon", CStr(gLeftCon), sFile
    mbSaveValues "SetPage", "TopCon", CStr(gTopCon), sFile
    mbSaveValues "SetPage", "TitleSep", CStr(gTitleSep), sFile
'    mbSaveValues "SetPage", "Grids", CStr(gGridCount), sFile

    
    mbSaveToINI = True
    
End Function


Private Function mbSetContentFont() As Boolean
'*************************************
'
'设置正文字体大小
'
'**************************************
    
    On Error GoTo ErrSetContentFont
    
    mbSetContentFont = False
    
    '设置字体
    COMDLG.Flags = cdlCFBoth
    
    '设置原字体
    If gFontNameCon <> "" Then COMDLG.FontName = gFontNameCon
    If gFontSizeCon <> 0 Then COMDLG.FontSize = gFontSizeCon
    
    COMDLG.FontItalic = gbFontItalicCon
    COMDLG.FontBold = gbFontBoldCon
    COMDLG.FontUnderline = gbFontUnderCon
    
    COMDLG.ShowFont
    
    '判断字体信息是否已经变化
    If gFontNameCon <> COMDLG.FontName Then gFontNameCon = COMDLG.FontName: mbSetContentFont = True
    If gFontSizeCon <> COMDLG.FontSize Then gFontSizeCon = COMDLG.FontSize: mbSetContentFont = True
    If gFontSizeCon <> COMDLG.FontSize Then gFontSizeCon = COMDLG.FontSize: mbSetContentFont = True
    If gbFontItalicCon <> COMDLG.FontItalic Then gbFontItalicCon = COMDLG.FontItalic: mbSetContentFont = True
    If gbFontBoldCon <> COMDLG.FontBold Then gbFontBoldCon = COMDLG.FontBold: mbSetContentFont = True
    If gbFontUnderCon <> COMDLG.FontUnderline Then gbFontUnderCon = COMDLG.FontUnderline: mbSetContentFont = True
        
    Exit Function
ErrSetContentFont:
    mbSetContentFont = False
    gShowMsg "设置正文字体出错 frmSetPrint.mbSetContentFont"
    
End Function

Private Function mbSetSubFont() As Boolean
'*************************************
'
'设置副标题字体大小
'
'**************************************
    
    On Error GoTo ErrSetSubFont
    
    mbSetSubFont = False
    
    COMDLG.Flags = cdlCFBoth
    
    '设置原字体
    If gFontNameMuliTitle <> "" Then COMDLG.FontName = gFontNameMuliTitle
    If gFontSizeMuliTitle <> 0 Then COMDLG.FontSize = gFontSizeMuliTitle
    
    COMDLG.FontItalic = gbFontItalicMuliTitle
    COMDLG.FontBold = gbFontBoldMuliTitle
    COMDLG.FontUnderline = gbFontUnderMuliTitle
    
    COMDLG.ShowFont
    
    '改变字体信息
    '字体名称
    If gFontNameMuliTitle <> COMDLG.FontName Then gFontNameMuliTitle = COMDLG.FontName: mbSetSubFont = True
    '字体大小
    If gFontSizeMuliTitle <> COMDLG.FontSize Then gFontSizeMuliTitle = COMDLG.FontSize: mbSetSubFont = True
    '斜体
    If gbFontItalicMuliTitle <> COMDLG.FontItalic Then gbFontItalicMuliTitle = COMDLG.FontItalic: mbSetSubFont = True
    '粗体
    If gbFontBoldMuliTitle <> COMDLG.FontBold Then gbFontBoldMuliTitle = COMDLG.FontBold: mbSetSubFont = True
    '下划线
    If gbFontUnderMuliTitle <> COMDLG.FontUnderline Then gbFontUnderMuliTitle = COMDLG.FontUnderline: mbSetSubFont = True
    
    Exit Function
ErrSetSubFont:
    mbSetSubFont = False
    gShowMsg "设置副标题字体出错 frmSetPrint.mbSetsubFont"


End Function

Private Function mbSetHeadFont() As Boolean
'*************************************
'
'设置正文字体大小
'
'**************************************
    
    On Error GoTo ErrSetHeadFont
    
    mbSetHeadFont = False
    
    COMDLG.Flags = cdlCFBoth
    
    '设置原字体
    If gFontNameHead <> "" Then COMDLG.FontName = gFontNameHead
    If gFontSizeHead <> 0 Then COMDLG.FontSize = gFontSizeHead
    
    COMDLG.FontItalic = gbFontItalicHead
    COMDLG.FontBold = gbFontBoldCon
    COMDLG.FontUnderline = gbFontUnderHead
    
    COMDLG.ShowFont
    
    '改变字体信息
    '字体名称
    If gFontNameHead <> COMDLG.FontName Then gFontNameHead = COMDLG.FontName: mbSetHeadFont = True
    '字体大小
    If gFontSizeHead <> COMDLG.FontSize Then gFontSizeHead = COMDLG.FontSize: mbSetHeadFont = True
    '斜体
    If gbFontItalicHead <> COMDLG.FontItalic Then gbFontItalicHead = COMDLG.FontItalic: mbSetHeadFont = True
    '粗体
    If gbFontBoldHead <> COMDLG.FontBold Then gbFontBoldHead = COMDLG.FontBold: mbSetHeadFont = True
    '下划线
    If gbFontUnderHead <> COMDLG.FontUnderline Then gbFontUnderHead = COMDLG.FontUnderline: mbSetHeadFont = True
    
    Exit Function
ErrSetHeadFont:
    mbSetHeadFont = False
    gShowMsg "设置正文字体出错 frmSetPrint.mbSetHeadFont"
    
End Function

Private Function mbSetFootFont() As Boolean
'*************************************
'
'设置尾注字体大小
'
'**************************************
On Error GoTo ErrSetFootFont
    
    mbSetFootFont = False
    
    COMDLG.Flags = cdlCFBoth
    
    '设置原字体
    If gFontNameFootTitle <> "" Then COMDLG.FontName = gFontNameFootTitle
    If gFontSizeFootTitle <> 0 Then COMDLG.FontSize = gFontSizeFootTitle
    
    COMDLG.FontItalic = gbFontItalicFootTitle
    COMDLG.FontBold = gbFontBoldFootTitle
    COMDLG.FontUnderline = gbFontUnderFootTitle
    
    COMDLG.ShowFont
    
    '改变字体信息
    '字体名称
    If gFontNameFootTitle <> COMDLG.FontName Then gFontNameFootTitle = COMDLG.FontName: mbSetFootFont = True
    '字体大小
    If gFontSizeFootTitle <> COMDLG.FontSize Then gFontSizeFootTitle = COMDLG.FontSize: mbSetFootFont = True
    '斜体
    If gbFontItalicFootTitle <> COMDLG.FontItalic Then gbFontItalicFootTitle = COMDLG.FontItalic: mbSetFootFont = True
    '粗体
    If gbFontBoldFootTitle <> COMDLG.FontBold Then gbFontBoldFootTitle = COMDLG.FontBold: mbSetFootFont = True
    '下划线
    If gbFontUnderFootTitle <> COMDLG.FontUnderline Then gbFontUnderFootTitle = COMDLG.FontUnderline: mbSetFootFont = True
    
    Exit Function
ErrSetFootFont:
    mbSetFootFont = False
    gShowMsg "设置尾注字体出错 frmSetPrint.mbSetfootFont"

End Function

Private Function mbSetTitleFont() As Boolean
'*************************************
'
'设置正文字体大小
'
'**************************************
    
    On Error GoTo ErrSetTitleFont
    
    COMDLG.Flags = cdlCFBoth
    
    '设置原字体
    If gFontNameTitle <> "" Then COMDLG.FontName = gFontNameTitle
    If gFontSizeTitle <> 0 Then COMDLG.FontSize = gFontSizeTitle
    
    COMDLG.FontItalic = gbFontItalicTitle
    COMDLG.FontBold = gbFontBoldTitle
    COMDLG.FontUnderline = gbFontUnderTitle
    
    COMDLG.ShowFont
    
    '改变字体信息
    '字体名称
    If gFontNameTitle <> COMDLG.FontName Then gFontNameTitle = COMDLG.FontName: mbSetTitleFont = True
    '改变字体大小
    If gFontSizeTitle <> COMDLG.FontSize Then gFontSizeTitle = COMDLG.FontSize: mbSetTitleFont = True
    '斜体
    If gbFontItalicTitle <> COMDLG.FontItalic Then gbFontItalicTitle = COMDLG.FontItalic: mbSetTitleFont = True
    '粗体
    If gbFontBoldTitle <> COMDLG.FontBold Then gbFontBoldTitle = COMDLG.FontBold: mbSetTitleFont = True
    '下划线
    If gbFontUnderTitle <> COMDLG.FontUnderline Then gbFontUnderTitle = COMDLG.FontUnderline: mbSetTitleFont = True
    
    Exit Function
ErrSetTitleFont:
    mbSetTitleFont = False
    gShowMsg "设置正文字体出错 frmSetPrint.mbSetTitleFont"
    
End Function


Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub mSetFontInfo()
'*********************************
'显示字体信息
    
    '显示标题字体信息
    txtFontNameTitle = gFontNameTitle & "," & gFontSizeTitle & ","
    If gbFontBoldTitle And gbFontItalicTitle Then
        txtFontNameTitle = txtFontNameTitle & "粗斜体,"
    ElseIf gbFontBoldTitle Then
        txtFontNameTitle = txtFontNameTitle & "粗体,"
    ElseIf gbFontItalicCon Then
        txtFontNameTitle = txtFontNameTitle & "斜体,"
    Else
        txtFontNameTitle = txtFontNameTitle & "规则,"
    End If
            
    If gbFontUnderTitle Then txtFontNameTitle = txtFontNameTitle & "下划线,"
    
    txtFontNameTitle = Mid(txtFontNameTitle, 1, Len(txtFontNameTitle) - 1)
    
    '显示副标题字体信息
    txtSubTitle = gFontNameMuliTitle & "," & gFontSizeMuliTitle & ","
    If gbFontBoldMuliTitle And gbFontItalicMuliTitle Then
        txtSubTitle = txtSubTitle & "粗斜体,"
    ElseIf gbFontBoldMuliTitle Then
        txtSubTitle = txtSubTitle & "粗体,"
    ElseIf gbFontItalicMuliTitle Then
        txtSubTitle = txtSubTitle & "斜体,"
    Else
        txtSubTitle = txtSubTitle & "规则,"
    End If
            
    If gbFontUnderMuliTitle Then txtSubTitle = txtSubTitle & "下划线,"
    
    txtSubTitle = Mid(txtSubTitle, 1, Len(txtSubTitle) - 1)
    
    '显示字段名称标题信息
    
    txtFontNameHead = gFontNameHead & "," & gFontSizeHead & ","
    If gbFontBoldHead And gbFontItalicHead Then
        txtFontNameHead = txtFontNameHead & "粗斜体,"
    ElseIf gbFontBoldHead Then
        txtFontNameHead = txtFontNameHead & "粗体,"
    ElseIf gbFontItalicCon Then
        txtFontNameHead = txtFontNameHead & "斜体,"
    Else
        txtFontNameHead = txtFontNameHead & "规则,"
    End If
            
    If gbFontUnderHead Then txtFontNameHead = txtFontNameHead & "下划线,"
    
    txtFontNameHead = Mid(txtFontNameHead, 1, Len(txtFontNameHead) - 1)
    
    
    '显示正文字体信息
    txtFontNameContent = gFontNameCon & "," & gFontSizeCon & ","
    If gbFontBoldCon And gbFontItalicCon Then
        txtFontNameContent = txtFontNameContent & "粗斜体,"
    ElseIf gbFontBoldCon Then
        txtFontNameContent = txtFontNameContent & "粗体,"