frmsetformat.frm

金算盘软件代码

        Utility.ShowMsg Me.hWnd, "请在字体设置中选择", vbInformation, "格式设置"
        Exit Sub
    ElseIf intCount = 2 And Not mclsFset.IsReport Then
        intCount = 3
    End If

    lngTemp = DlgFormat.Color
    DlgFormat.Color = mlngFontColor(intCount)
    DlgFormat.ShowColor
    mlngFontColor(intCount) = DlgFormat.Color
    LblExample.ForeColor = DlgFormat.Color
    CmdFontColor.SetFocus
    mblnChanged = True
End Sub
Private Sub cmdFooter_Click()
Dim intCount As Integer
   Set frmFH = New FrmFHDeFineSelf
   frmFH.g_TxtPage(0) = LblFooter(0).Tag
   frmFH.g_TxtPage(1) = LblFooter(1).Tag
   frmFH.g_TxtPage(2) = LblFooter(2).Tag
   If frmFH.ShowFrmFHDefineSelf(2) = True Then
        LblFooter(0).Visible = True
        LblFooter(2).Visible = True
        LblFooter(1).width = 1905
        LblFooter(1).Left = 2220
        LblFooter(1).Alignment = 0
    
        For intCount = 0 To 2
            LblFooter(intCount).Tag = frmFH.g_TxtPage(intCount)
            LblFooter(intCount).Caption = ReplaceString(LblFooter(intCount).Tag)
        Next intCount
        mblnChanged = True
   End If
   Set frmFH = Nothing
End Sub

Private Sub CmdHeader_Click()
Dim intCount As Integer
    Set frmFH = New FrmFHDeFineSelf
    frmFH.g_TxtPage(0) = LblHeader(0).Tag
    frmFH.g_TxtPage(1) = LblHeader(1).Tag
    frmFH.g_TxtPage(2) = LblHeader(2).Tag
    If frmFH.ShowFrmFHDefineSelf(1) Then
        LblHeader(0).Visible = True
        LblHeader(2).Visible = True
        LblHeader(1).width = 1905
        LblHeader(1).Left = 2220
        LblHeader(1).Alignment = 0
    
        For intCount = 0 To 2
            LblHeader(intCount).Tag = frmFH.g_TxtPage(intCount)
            LblHeader(intCount).Caption = ReplaceString(LblHeader(intCount).Tag)
        Next intCount
        mblnChanged = True
    End If
    Set frmFH = Nothing
End Sub


Private Sub CmdShowColor_Click(Index As Integer)
    DlgFormat.Color = LblColor(Index).BackColor
    DlgFormat.ShowColor
    LblColor(Index).BackColor = DlgFormat.Color
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_Load()
    mblnLoaded = False
    #If conWan = 1 Then '万能版
        LblExample.Caption = "万能软件"
    #Else
        LblExample.Caption = "金算盘软件"
    #End If
    LoadResMap
    InitArray       '初始化数组
    
    If mclsFset.SeriesPrintID <> 0 Then         '说明要套打
        TabSetFormat.TabVisible(0) = False
        TabSetFormat.TabVisible(2) = False
        TabSetFormat.TabVisible(5) = False
        TabSetFormat.TabVisible(6) = False
        InitLoc
        TabSetFormat.Tab = 1
        InitSeriesPrint                        '初始化套打有关对象
    Else
        TabSetFormat.Tab = 0
        InitLoc                                '初始化控件位置
        InitForm                               '初始化窗体有关对象
        InitLimited                            '初始化窗体限制
    End If
    mblnChanged = False
    mblnLoaded = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (139)
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (3002)
    Utility.RemoveFormResPicture (3003)
    
    Set CmdOK.Picture = Nothing
    Set CmdCancel.Picture = Nothing
    Set ImgDerector.Picture = Nothing
    Set frmFH = Nothing
    Set fontDig = Nothing
End Sub



Private Sub LstSetupFont_Click()
Dim intCount As Integer
    intCount = LstSetupFont.ListIndex
    LblExample.FontName = mfntSetup(intCount).Name
    LblExample.FontSize = mfntSetup(intCount).Size
    LblExample.ForeColor = mlngFontColor(intCount)
    If intCount = 2 Then
        LblExample.BackColor = &H8000000F
        FraFormatSet(13).BackColor = &H8000000F
        CmdBackColor.Enabled = False
    Else
        LblExample.BackColor = mlngFontBKColor(intCount)
        FraFormatSet(13).BackColor = mlngFontBKColor(intCount)
        CmdBackColor.Enabled = True
    End If
    LblExample.FontBold = mfntSetup(intCount).Bold
    LblExample.FontItalic = mfntSetup(intCount).Italic
    LblExample.FontStrikethru = mfntSetup(intCount).Strikethrough
    LblExample.FontUnderline = mfntSetup(intCount).UnderLine
End Sub


Private Sub OptFormatset_Click(Index As Integer)
    If Not mblnLoaded Then Exit Sub
    Select Case Index
    Case 0  '缩放比例
        SpiZoomScale.Enable = True
        LblTitle(2).Enabled = True
        ChkFormatSet(1).Value = 1
        ChkFormatSet(1).Enabled = True
    Case 1, 2 '最合适的纸宽,纸高
        SpiZoomScale.Enable = False
        LblTitle(2).Enabled = False
        ChkFormatSet(1).Value = 0
        ChkFormatSet(1).Enabled = False
    Case 3  '自动设置每页行数
        SpiRows.Enable = False
        LblTitle(7).Enabled = False
        LblTitle(8).Enabled = False
        ChkFormatSet(1).Value = 1
        ChkFormatSet(1).Enabled = True
    Case 4  '指定每页行数
        SpiRows.Enable = True
        LblTitle(7).Enabled = True
        LblTitle(8).Enabled = True
        ChkFormatSet(1).Value = 0
        ChkFormatSet(1).Enabled = False
    Case 8  '纵向
        Exchange
        RefreshPaper
    Case 9  '横向
        Exchange
        RefreshPaper
    Case Else
    End Select
    mblnChanged = True
End Sub


Private Sub OptInch_Click()
    If Not mblnLoaded Then Exit Sub
    SpiPaperWidth.Text = MMToInch(CLng(SpiPaperWidth.Text))
    SpiPaperHeight.Text = MMToInch(CLng(SpiPaperHeight.Text))
    SpiPaperWidth.Min = MMToInch(SpiPaperWidth.Min)
    SpiPaperWidth.Max = MMToInch(SpiPaperWidth.Max)
End Sub

Private Sub OptMM_Click()
    If Not mblnLoaded Then Exit Sub
    SpiPaperWidth.Text = InchToMM(CLng(SpiPaperWidth.Text))
    SpiPaperHeight.Text = InchToMM(CLng(SpiPaperHeight.Text))
    SpiPaperWidth.Min = InchToMM(SpiPaperWidth.Min)
    SpiPaperWidth.Max = InchToMM(SpiPaperWidth.Max)
End Sub

Private Sub SpiLineSpace_Change()
    IsValid SpiLineSpace
End Sub

Private Sub SpiLineSpace_GotFocus()
    mstrOld = SpiLineSpace.Text
End Sub

Private Sub SpiPageBorder_Change(Index As Integer)
Dim dblConstY As Double, dblConstX As Double
    If Not mblnLoaded Then Exit Sub
    If IsValid(SpiPageBorder(Index)) = False Then Exit Sub
    If mclsFset.SeriesPrintID > 0 Then
        dblConstY = mclsFset.GPaperHeight
        dblConstX = mclsFset.GPaperWidth
    Else
        dblConstY = Val(SpiPaperHeight.Text)
        dblConstX = Val(SpiPaperWidth.Text)
    End If
    dblConstY = PicExample(2).Height * 10 / dblConstY / Screen.TwipsPerPixelY
    dblConstX = PicExample(2).width * 10 / dblConstX / Screen.TwipsPerPixelX
    Select Case Index
    Case 0  '上边距
        LinHori(0).y1 = Val(SpiPageBorder(0).Text) * dblConstY + 8
        LinHori(0).y2 = LinHori(0).y1
    Case 1  '下边距
        LinHori(1).y1 = PicExample(2).Height / Screen.TwipsPerPixelY - Val(SpiPageBorder(1).Text) * dblConstY - 11
        LinHori(1).y2 = LinHori(1).y1
    Case 2  '左边距
        LinVert(0).x1 = Val(SpiPageBorder(2).Text) * dblConstX + 8
        LinVert(0).x2 = LinVert(0).x1
    Case 3  '右边距
        LinVert(1).x1 = PicExample(2).width / Screen.TwipsPerPixelX - Val(SpiPageBorder(3).Text) * dblConstX - 11
        LinVert(1).x2 = LinVert(1).x1
    Case Else
    End Select
    RefreshBoder
    SpiPaperHeight.Min = 10 * ((IIf(mclsFset.IsReport, 3, 8) * Val(SpiRowHeight.Text) + Val(SpiPageBorder(0).Text) + Val(SpiPageBorder(1).Text))) + mlngHeaderHeight + mlngHeightDiff + 1
    mblnChanged = True
End Sub

Private Sub SpiPageBorder_GotFocus(Index As Integer)
    mstrOld = SpiPageBorder(Index).Text
End Sub


Private Sub SpiPaperHeight_GotFocus()
    mstrOld = SpiPaperHeight.Text
End Sub


Private Sub SpiPaperHeight_LostFocus()
    If Me.ActiveControl Is CmdCancel Then Exit Sub
    IsValid SpiPaperHeight
End Sub

Private Sub SpiPaperWidth_GotFocus()
    mstrOld = SpiPaperWidth.Text
End Sub


Private Sub SpiPaperWidth_LostFocus()
    If Me.ActiveControl Is CmdCancel Then Exit Sub
    IsValid SpiPaperWidth
End Sub

Private Sub SpiRowHeight_GotFocus()
    mstrOld = SpiRowHeight.Text
End Sub

Private Sub SpiRowHeight_LostFocus()
    If Me.ActiveControl Is CmdCancel Then Exit Sub
    IsValid SpiRowHeight
    SpiPaperHeight.Min = 10 * ((IIf(mclsFset.IsReport, 3, 8) * Val(SpiRowHeight.Text) + Val(SpiPageBorder(0).Text) + Val(SpiPageBorder(1).Text))) + mlngHeaderHeight + mlngHeightDiff + 1
    CalcuRow
End Sub

Private Sub SpiRows_Change()
'    IsValid SpiRows
End Sub

Private Sub SpiRows_GotFocus()
    mstrOld = SpiRows.Text
End Sub

Private Sub SpiRows_LostFocus()
    If Me.ActiveControl Is CmdCancel Then Exit Sub
    IsValid SpiRows
    CalcuRow
End Sub

Private Sub SpiZoomScale_GotFocus()
    mstrOld = SpiZoomScale.Text
End Sub

Private Sub SpiZoomScale_LostFocus()
    If Me.ActiveControl Is CmdCancel Then Exit Sub
    IsValid SpiZoomScale
End Sub

Private Sub TxtFooter_Change()
    LblFooter(0).Visible = False
    LblFooter(2).Visible = False
    LblFooter(1).Left = LblFooter(0).Left
    LblFooter(1).width = 5690
    LblFooter(1).Alignment = 2
    LblFooter(0).Caption = ""
    LblFooter(1).Caption = TxtFooter.Text
    LblFooter(2).Caption = ""
    LblFooter(1).Caption = TxtFooter.Text
End Sub

Private Sub TxtHeader_Change()
    LblHeader(0).Visible = False
    LblHeader(2).Visible = False
    LblHeader(1).Left = LblHeader(0).Left
    LblHeader(1).width = 5690
    LblHeader(1).Alignment = 2
    LblHeader(0).Caption = ""
    LblHeader(1).Caption = TxtHeader.Text
    LblHeader(2).Caption = ""
End Sub

Private Sub TabSetFormat_Click(PreviousTab As Integer)
    Select Case PreviousTab
    Case 2, 3, 6         '纸张可能改变
        CalcuRow       '页面修改
    Case Else
    End Select
    If TabSetFormat.Tab = 3 Then
        RefreshBoder
    End If
    SetTabIndex
End Sub



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                           私有过程
'
Private Sub Drawline(XPicBox As PictureBox, iBeginX As Single, iBeginY As Single, iEndX As Single)
     Dim x As Single                 '画picpage中举例的方框
     Dim y As Single
     Dim i As Integer
     Dim endx As Single
     Dim endy As Single
     Dim inc As Single
     XPicBox.DrawWidth = 1
     XPicBox.ForeColor = &H8000000B
     x = iBeginX
     y = iBeginY
     endx = iEndX
    '画横线
    For i = 0 To 14
       y = iBeginY + i * 4
       XPicBox.Line (x, y)-(endx, y)
    Next
    endy = y
    inc = (endx - x) / 5
    x = iBeginX
    y = iBeginY
    '画竖线
    For i = 0 To 5
       XPicBox.Line (x, y)-(x, endy)
       x = x + inc
    Next
End Sub

Private Sub LoadResMap()
    Me.HelpContextID = 10004
    Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    CmdOK.Picture = GetFormResPicture(1001, vbResBitmap)
    CmdCancel.Picture = GetFormResPicture(1002, vbResBitmap)
    CmdHeader.Picture = GetFormResPicture(1017, vbResBitmap)
    CmdFooter.Picture = GetFormResPicture(1017, vbResBitmap)
End Sub
Private Sub AddItemPaper()
Dim intIndex As Integer, intTempSize As Integer
Dim intPrintSize As Integer
Dim intSuccess As Integer
Dim strIndex As String
    
    strIndex = "55,8,9,12,13,39,45"
    If Printer.PaperSize <> 0 Then
        Do While strIndex <> ""
            intIndex = Val(StringOut(strIndex, ","))