setprint.frm

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

    ElseIf gbFontItalicCon Then
        txtFontNameContent = txtFontNameContent & "斜体,"
    Else
        txtFontNameContent = txtFontNameContent & "规则,"
    End If
            
    If gbFontUnderCon Then txtFontNameContent = txtFontNameContent & "下划线,"
    
    txtFontNameContent = Mid(txtFontNameContent, 1, Len(txtFontNameContent) - 1)
            
    '显示尾注字体信息
    txtFootTitle = gFontNameFootTitle & "," & gFontSizeFootTitle & ","
    If gbFontBoldFootTitle And gbFontItalicFootTitle Then
        txtFootTitle = txtFootTitle & "粗斜体,"
    ElseIf gbFontBoldFootTitle Then
        txtFootTitle = txtFootTitle & "粗体,"
    ElseIf gbFontItalicFootTitle Then
        txtFootTitle = txtFootTitle & "斜体,"
    Else
        txtFootTitle = txtFootTitle & "规则,"
    End If
            
    If gbFontUnderFootTitle Then txtFootTitle = txtFootTitle & "下划线,"
    
    txtFootTitle = Mid(txtFootTitle, 1, Len(txtFootTitle) - 1)
    
End Sub

Private Sub mSetOtherInfo()
'************************************
'
'设置其它信息
'
'*************************************
    
    txtMainTitle.Text = gTitle
    txtSubMainTitle.Text = gSubTitle
    txtTitleSep.Text = gTitleSep
    txtConBefore.Text = gLeftCon
    txtConAfter.Text = gTopCon
    
End Sub


Private Function mbSaveOk() As Boolean
'****************************************
'
'保存设置的结果
'
'****************************************
    
    On Error GoTo ErrSaveOK
    
    '主标题
    If gTitle <> txtMainTitle Then
        gTitle = txtMainTitle
        mbChange = True
    End If
    
    '主子标题
    If gSubTitle <> txtSubMainTitle Then
        gSubTitle = Trim(txtSubMainTitle)
        mbChange = True
    End If
    
    '标题同表格之间距离
    If gTitleSep <> Int(txtTitleSep) Then
        gTitleSep = Int(txtTitleSep)
        mbChange = True
    End If
    
    '方格边距
    If gLeftCon <> Int(txtConBefore) Then
        gLeftCon = Int(txtConBefore)
        mbChange = True
    End If
    If gTopCon <> Int(txtConAfter) Then
        gTopCon = Int(txtConAfter)
        mbChange = True
    End If
    
    
    mbSaveOk = mbChange
    Exit Function
ErrSaveOK:
    Screen.MousePointer = vbDefault
    mbSaveOk = False
    gShowMsg "保存设置结果出错 frmSetPrint.mbSaveOK"
    
End Function

Private Sub cmdFontNameContent_Click()
    
    If mbSetContentFont() Then
        
        mbChange = True
        
        txtFontNameContent = gFontNameCon & "," & gFontSizeCon & ","
        If gbFontBoldCon And gbFontItalicCon Then
            txtFontNameContent = txtFontNameContent & "粗斜体,"
        ElseIf gbFontBoldCon Then
            txtFontNameContent = txtFontNameContent & "粗体,"
        ElseIf gbFontItalicCon Then
            txtFontNameContent = txtFontNameContent & "斜体,"
        Else
            txtFontNameContent = txtFontNameContent & "规则,"
        End If
        
        If gbFontUnderCon Then txtFontNameContent = txtFontNameContent & "下划线,"
        
        txtFontNameContent = Mid(txtFontNameContent, 1, Len(txtFontNameContent) - 1)
        
    End If
    
End Sub

Private Sub cmdFontNameHead_Click()
    
     If mbSetHeadFont() Then
     
        mbChange = True
        
        txtFontNameHead = gFontNameHead & "," & gFontSizeHead & ","
        If gbFontBoldHead And gbFontItalicHead Then
            txtFontNameHead = txtFontNameHead & "粗斜体,"
        ElseIf gbFontBoldHead Then
            txtFontNameHead = txtFontNameHead & "粗体,"
        ElseIf gbFontItalicHead Then
            txtFontNameHead = txtFontNameHead & "斜体,"
        Else
            txtFontNameHead = txtFontNameHead & "规则,"
        End If
        
        If gbFontUnderHead Then txtFontNameHead = txtFontNameHead & "下划线,"
        
        txtFontNameHead = Mid(txtFontNameHead, 1, Len(txtFontNameHead) - 1)
        
    End If
    
End Sub

Private Sub cmdFontNameTitle_Click()
    
    If mbSetTitleFont() Then
        
        mbChange = True
        
        txtFontNameTitle = gFontNameTitle & "," & gFontSizeTitle & ","
        If gbFontBoldTitle And gbFontItalicTitle Then
            txtFontNameTitle = txtFontNameTitle & "粗斜体,"
        ElseIf gbFontBoldTitle Then
            txtFontNameTitle = txtFontNameTitle & "粗体,"
        ElseIf gbFontItalicTitle Then
            txtFontNameTitle = txtFontNameTitle & "斜体,"
        Else
            txtFontNameTitle = txtFontNameTitle & "规则,"
        End If
        
        If gbFontUnderTitle Then txtFontNameTitle = txtFontNameTitle & "下划线,"
        
        txtFontNameTitle = Mid(txtFontNameTitle, 1, Len(txtFontNameTitle) - 1)
        
    End If
    
End Sub

Private Sub cmdFootTitle_Click()

    If mbSetFootFont() Then
        
        mbChange = True
        
        txtFootTitle = gFontNameFootTitle & "," & gFontSizeFootTitle & ","
        If gbFontBoldFootTitle And gbFontItalicFootTitle Then
            txtFootTitle = txtFootTitle & "粗斜体,"
        ElseIf gbFontBoldFootTitle Then
            txtFootTitle = txtFootTitle & "粗体,"
        ElseIf gbFontItalicFootTitle Then
            txtFootTitle = txtFootTitle & "斜体,"
        Else
            txtFootTitle = txtFootTitle & "规则,"
        End If
        
        If gbFontUnderFootTitle Then txtFootTitle = txtFootTitle & "下划线,"
        
        txtFootTitle = Mid(txtFootTitle, 1, Len(txtFootTitle) - 1)
        
    End If

End Sub

Private Sub cmdOk_Click()
    If mbSaveOk() Then
        If mbSaveToINI() Then
            Call SendMessageToCtl(frmPreview.VsPreview, WM_KEYDOWN, VK_F5, 0)
            Unload Me
        End If
    Else
        Unload Me
    End If
End Sub

Private Sub cmdSubTitle_Click()

If mbSetSubFont() Then
        
        mbChange = True
        
        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)
        
    End If

End Sub

Private Sub Form_Load()
    
    Center Me
    mbChange = False
    Call mSetFontInfo
    Call mSetOtherInfo
    
End Sub

Private Sub txtConAfter_KeyPress(KeyAscii As Integer)
    KeyAscii = gNumericKey(KeyAscii)
End Sub

Private Sub txtConAfter_Validate(Cancel As Boolean)
    
    If Trim(txtConAfter) = "" Then txtConAfter = 30
    
End Sub

Private Sub txtConBefore_KeyPress(KeyAscii As Integer)
    KeyAscii = gNumericKey(KeyAscii)
End Sub

Private Sub txtConBefore_Validate(Cancel As Boolean)
    
    If Trim(txtConBefore) = "" Then txtConBefore = 80
    
End Sub

Private Sub txtTitleSep_KeyPress(KeyAscii As Integer)
    KeyAscii = gNumericKey(KeyAscii)
End Sub

Private Sub UDConAfter_DownClick()
    
    If Trim(txtConAfter) = "" Then
        txtConAfter = 30
    ElseIf Trim(txtConAfter) >= 10 Then
        txtConAfter = Int(txtConAfter) - 10
    End If
    
End Sub

Private Sub UDConAfter_UpClick()
    
    If Trim(txtConAfter) = "" Then
        txtConAfter = 30
    ElseIf Trim(txtConAfter) <= 200 Then
        txtConAfter = Int(txtConAfter) + 10
    End If
    
End Sub

Private Sub UDConBefore_DownClick()
    
    If Trim(txtConBefore) = "" Then
        txtConBefore = 80
    ElseIf Int(txtConBefore) >= 10 Then
        txtConBefore = Int(txtConBefore) - 10
    End If
    
End Sub

Private Sub UDConBefore_UpClick()
    
    If Trim(txtConBefore) = "" Then
        txtConBefore = 80
    ElseIf Int(txtConBefore) <= 190 Then
        txtConBefore = Int(txtConBefore) + 10
    End If
    
End Sub

Private Sub UDTitleSep_DownClick()

    If Trim(txtTitleSep) = "" Then
        txtTitleSep = 300
    ElseIf Int(txtTitleSep) >= 350 Then
        txtTitleSep.Text = Int(txtTitleSep.Text) - 50
    End If
    
End Sub

Private Sub UDTitleSep_UpClick()
    If Trim(txtTitleSep) = "" Then
        txtTitleSep = 300
    ElseIf Int(txtTitleSep) <= 2950 Then
        txtTitleSep.Text = Int(txtTitleSep.Text) + 50
    End If
End Sub