frmpagesetup.frm

一个机械产品（产品、部件、零件）的工时、工资及进度软件

End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    On Error GoTo ErrorHandler
    
    With mGrid.PageSetup
        .Orientation = IIf(optPortrait.Value, cellPortrait, cellLandscape)
        If cboPaperSize.ListIndex = cboPaperSize.ListCount - 1 Then
            .PaperWidth = Val(txtPaperWidth.Text)
            .PaperHeight = Val(txtPaperHeight.Text)
        Else
            .PaperWidth = mGrid.PageSetup.PaperSizes.Item(cboPaperSize.ListIndex + 1).Width
            .PaperHeight = mGrid.PageSetup.PaperSizes.Item(cboPaperSize.ListIndex + 1).Height
        End If
        .Zoom = Val(GetText(txtZoom))
        .PrintTitleRows = Val(GetText(txtPrintTitleRows))
        .PrintTitleColumns = Val(GetText(txtPrintTitleColumns))
        .PrintBottomTitleRows = Val(GetText(txtPrintBottomTitleRows))
        .PrintFixedRow = IIf(chkPrintFixedRow.Value = vbChecked, True, False)
        .PrintFixedColumn = IIf(chkPrintFixedColumn.Value = vbChecked, True, False)
        .PrintGridlines = IIf(chkPrintGridlines.Value = vbChecked, True, False)
        .BlackAndWhite = IIf(chkBlackAndWhite.Value = vbChecked, True, False)
        .CenterHorizontally = IIf(chkCenterHorizontally.Value = vbChecked, True, False)
        .CenterVertically = IIf(chkCenterVertically.Value = vbChecked, True, False)
        .LeftMargin = Val(GetText(txtLeftMargin))
        .RightMargin = Val(GetText(txtRightMargin))
        .TopMargin = Val(GetText(txtTopMargin))
        .BottomMargin = Val(GetText(txtBottomMargin))
        .HeaderMargin = Val(GetText(txtHeaderMargin))
        .FooterMargin = Val(GetText(txtFooterMargin))
        .Header = txtHeader.Text
        .HeaderAlignment = cboHeaderAlign.ListIndex
        .HeaderFont.Bold = txtHeader.FontBold
        .HeaderFont.Italic = txtHeader.FontItalic
        .HeaderFont.Underline = txtHeader.FontUnderline
        .HeaderFont.Strikethrough = txtHeader.FontStrikethru
        .HeaderFont.Size = txtHeader.FontSize
        .HeaderFont.Name = txtHeader.FontName
        .Footer = txtFooter.Text
        .FooterAlignment = cboFooterAlign.ListIndex
        .FooterFont.Bold = txtFooter.FontBold
        .FooterFont.Italic = txtFooter.FontItalic
        .FooterFont.Underline = txtFooter.FontUnderline
        .FooterFont.Strikethrough = txtFooter.FontStrikethru
        .FooterFont.Size = txtFooter.FontSize
        .FooterFont.Name = txtFooter.FontName
    End With
    
    Unload Me
    
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description, vbCritical, "错误"
End Sub

Private Sub cmdSetFont_Click(Index As Integer)
    CommonDialog1.Flags = cdlCFBoth
    
    If Index = 0 Then
        With CommonDialog1
            .FontBold = txtHeader.FontBold
            .FontItalic = txtHeader.FontItalic
            .FontUnderline = txtHeader.FontUnderline
            .FontStrikethru = txtHeader.FontStrikethru
            .FontSize = txtHeader.FontSize
            .FontName = txtHeader.FontName
        End With
    Else
        With CommonDialog1
            .FontBold = txtFooter.FontBold
            .FontItalic = txtFooter.FontItalic
            .FontUnderline = txtFooter.FontUnderline
            .FontStrikethru = txtFooter.FontStrikethru
            .FontSize = txtFooter.FontSize
            .FontName = txtFooter.FontName
        End With
    End If
    
    CommonDialog1.ShowFont
    
    If Trim(CommonDialog1.FontName) = "" Then
        Exit Sub
    End If
    
    If Index = 0 Then
        With txtHeader
            .FontBold = CommonDialog1.FontBold
            .FontItalic = CommonDialog1.FontItalic
            .FontUnderline = CommonDialog1.FontUnderline
            .FontStrikethru = CommonDialog1.FontStrikethru
            .FontSize = CommonDialog1.FontSize
            .FontName = CommonDialog1.FontName
        End With
    Else
        With txtFooter
            .FontBold = CommonDialog1.FontBold
            .FontItalic = CommonDialog1.FontItalic
            .FontUnderline = CommonDialog1.FontUnderline
            .FontStrikethru = CommonDialog1.FontStrikethru
            .FontSize = CommonDialog1.FontSize
            .FontName = CommonDialog1.FontName
        End With
    End If
End Sub

Private Sub Form_Load()
    Dim strText As String
    Dim i As Single
    
    '在大字体环境下，需要重新调整控件的大小和位置
    fraPaper.ScaleMode = 3 'Pixel
    
    Line1.Y1 = Line2.Y1 + 1
    Line1.Y2 = Line2.Y2 + 1
    
    Line3.Y1 = Line4.Y1 + 1
    Line3.Y2 = Line4.Y2 + 1
    
    Line5.Y1 = Line6.Y1 + 1
    Line5.Y2 = Line6.Y2 + 1
    
    Line10.Y1 = Line9.Y1 + 1
    Line10.Y2 = Line9.Y2 + 1
    
    cboPaperSize.Clear
    
    strText = ""
    For i = 3 To 1 Step -0.1
        strText = strText & vbCrLf & Format(i, "0.0")
    Next
    strText = Mid(strText, 3) '去掉第一个vbCrlf
    
    txtHeaderMargin.Text = strText
    txtFooterMargin.Text = strText
    txtTopMargin.Text = strText
    txtBottomMargin.Text = strText
    txtLeftMargin.Text = strText
    txtRightMargin.Text = strText
    
    strText = ""
    For i = 20 To 0 Step -1
        strText = strText & vbCrLf & i
    Next
    strText = Mid(strText, 3) '去掉第一个vbCrlf
    
    txtPrintTitleRows.Text = strText
    txtPrintTitleColumns.Text = strText
    txtPrintBottomTitleRows = strText

    strText = ""
    For i = 400 To 10 Step -1
        strText = strText & vbCrLf & i
    Next
    strText = Mid(strText, 3) '去掉第一个vbCrlf
    
    txtZoom.Text = strText
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmPageSetup = Nothing
End Sub

Private Sub TabStrip1_Click()
    Select Case TabStrip1.SelectedItem.Index
        Case 1
            fraPaper.Visible = True
            fraMargin.Visible = False
            fraHeaderFooter.Visible = False
        Case 2
            fraPaper.Visible = False
            fraMargin.Visible = True
            fraHeaderFooter.Visible = False
        Case 3
            fraPaper.Visible = False
            fraMargin.Visible = False
            fraHeaderFooter.Visible = True
    End Select
End Sub

Private Sub txtBottomMargin_GotFocus()
    lineBottom.BorderColor = vbBlack
End Sub

Private Sub txtBottomMargin_LostFocus()
    lineBottom.BorderColor = RGB(192, 192, 192)
End Sub

Private Sub txtFooterMargin_GotFocus()
    lineFooter.BorderColor = vbBlack
End Sub

Private Sub txtFooterMargin_LostFocus()
    lineFooter.BorderColor = RGB(192, 192, 192)
End Sub

Private Sub txtHeaderMargin_GotFocus()
    lineHeader.BorderColor = vbBlack
End Sub

Private Sub txtHeaderMargin_LostFocus()
    lineHeader.BorderColor = RGB(192, 192, 192)
End Sub

Private Sub txtLeftMargin_GotFocus()
    lineLeft.BorderColor = vbBlack
End Sub

Private Sub txtLeftMargin_LostFocus()
    lineLeft.BorderColor = RGB(192, 192, 192)
End Sub

Private Sub txtPaperHeight_GotFocus()
    txtPaperHeight.SelStart = 0
    txtPaperHeight.SelLength = Len(txtPaperHeight.Text)
End Sub

Private Sub txtPaperHeight_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case Asc("0") To Asc("9"), vbKeyBack
            '
        Case Asc(".")
            If InStr(1, txtPaperHeight.Text, ".") > 0 Then
                KeyAscii = 0
            End If
        Case Else
            KeyAscii = 0
    End Select
End Sub

Private Sub txtPaperWidth_GotFocus()
    txtPaperWidth.SelStart = 0
    txtPaperWidth.SelLength = Len(txtPaperWidth.Text)
End Sub

Private Sub txtPaperWidth_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case Asc("0") To Asc("9"), vbKeyBack
            '
        Case Asc(".")
            If InStr(1, txtPaperWidth.Text, ".") > 0 Then
                KeyAscii = 0
            End If
        Case Else
            KeyAscii = 0
    End Select
End Sub

Private Sub txtRightMargin_GotFocus()
    lineRight.BorderColor = vbBlack
End Sub

Private Sub txtRightMargin_LostFocus()
    lineRight.BorderColor = RGB(192, 192, 192)
End Sub

Private Sub txtTopMargin_GotFocus()
    lineTop.BorderColor = vbBlack
End Sub

Private Sub txtTopMargin_LostFocus()
    lineTop.BorderColor = RGB(192, 192, 192)
End Sub

Private Function GetText(ctlText As TextBox) As String
    Dim ArrText
    ArrText = Split(ctlText.Text, vbCrLf)
    GetText = ArrText(GetScrollPos(ctlText.hWnd, SB_VERT))
End Function

Private Sub SetText(ctlText As TextBox, Value As Single, ControlType As Long)
    Dim n As Long
    
    Select Case ControlType
    Case 0
        n = Val("&H" & Hex(400 - Value) & "0004")
        Call SendMessage(ctlText.hWnd, WM_VSCROLL, n, 0)
    Case 1
        If Value > 20 Then
            ctlText.Text = Value & vbCrLf & ctlText.Text
            Call SendMessage(ctlText.hWnd, WM_VSCROLL, 6&, 0)
        Else
            n = Val("&H" & Hex(20 - Value) & "0004")
            Call SendMessage(ctlText.hWnd, WM_VSCROLL, n, 0)
        End If
    Case 2
        If Value < 1 Then
            ctlText.Text = ctlText.Text & vbCrLf & Format(Value, "0.0")
            Call SendMessage(ctlText.hWnd, WM_VSCROLL, 7&, 0)
        ElseIf Value > 3 Then
            ctlText.Text = Format(Value, "0.0") & vbCrLf & ctlText.Text
            Call SendMessage(ctlText.hWnd, WM_VSCROLL, 6&, 0)
        Else
            n = Val("&H" & Hex(20 - (Value - 1) * 10) & "0004")
            Call SendMessage(ctlText.hWnd, WM_VSCROLL, n, 0)
        End If
    End Select
End Sub

Public Sub SetGrid(Grid As FlexCell.Grid)
    Dim i As Integer
    Dim intListIndex As Integer
    
    Set mGrid = Grid
    
    '纸张方向
    If mGrid.PageSetup.Orientation = 1 Then
        optPortrait.Value = True
    Else
        optLandscape.Value = True
    End If
    
    '纸张大小
    mGrid.PageSetup.PaperSizes.Refresh
    For i = 1 To mGrid.PageSetup.PaperSizes.Count
        cboPaperSize.AddItem mGrid.PageSetup.PaperSizes.Item(i).PaperName
    Next
    intListIndex = cboPaperSize.ListCount - 1
    For i = 1 To mGrid.PageSetup.PaperSizes.Count
        If mGrid.PageSetup.PaperSizes.Item(i).Width = mGrid.PageSetup.PaperWidth And mGrid.PageSetup.PaperSizes.Item(i).Height = mGrid.PageSetup.PaperHeight Then
            intListIndex = i - 1
            Exit For
        End If
    Next
    cboPaperSize.ListIndex = intListIndex
    If intListIndex = cboPaperSize.ListCount - 1 Then
        txtPaperWidth.Text = mGrid.PageSetup.PaperWidth
        txtPaperHeight.Text = mGrid.PageSetup.PaperHeight
    End If
    
    '缩放比例
    Call SetText(txtZoom, mGrid.PageSetup.Zoom, 0)
    
    '标题行和标题列
    Call SetText(txtPrintTitleRows, mGrid.PageSetup.PrintTitleRows, 1)
    Call SetText(txtPrintTitleColumns, mGrid.PageSetup.PrintTitleColumns, 1)
    Call SetText(txtPrintBottomTitleRows, mGrid.PageSetup.PrintBottomTitleRows, 1)
    
    '打印内容
    chkPrintFixedRow.Value = IIf(mGrid.PageSetup.PrintFixedRow, vbChecked, vbUnchecked)
    chkPrintFixedColumn.Value = IIf(mGrid.PageSetup.PrintFixedColumn, vbChecked, vbUnchecked)
    chkPrintGridlines.Value = IIf(mGrid.PageSetup.PrintGridlines, vbChecked, vbUnchecked)
    chkBlackAndWhite.Value = IIf(mGrid.PageSetup.BlackAndWhite, vbChecked, vbUnchecked)
    
    '页边距
    Call SetText(txtTopMargin, mGrid.PageSetup.TopMargin, 2)
    Call SetText(txtBottomMargin, mGrid.PageSetup.BottomMargin, 2)
    Call SetText(txtLeftMargin, mGrid.PageSetup.LeftMargin, 2)
    Call SetText(txtRightMargin, mGrid.PageSetup.RightMargin, 2)
    Call SetText(txtHeaderMargin, mGrid.PageSetup.HeaderMargin, 2)
    Call SetText(txtFooterMargin, mGrid.PageSetup.FooterMargin, 2)
    
    '页面居中
    chkCenterHorizontally.Value = IIf(mGrid.PageSetup.CenterHorizontally, vbChecked, vbUnchecked)
    chkCenterVertically = IIf(mGrid.PageSetup.CenterVertically, vbChecked, vbUnchecked)
    
    '页眉
    With txtHeader
        .Text = mGrid.PageSetup.Header
        .FontSize = mGrid.PageSetup.HeaderFont.Size
        .FontName = mGrid.PageSetup.HeaderFont.Name
        .FontBold = mGrid.PageSetup.HeaderFont.Bold
        .FontItalic = mGrid.PageSetup.HeaderFont.Italic
        .FontUnderline = mGrid.PageSetup.HeaderFont.Underline
        .FontStrikethru = mGrid.PageSetup.HeaderFont.Strikethrough
    End With
    
    '页脚
    With txtFooter
        .Text = mGrid.PageSetup.Footer
        .FontSize = mGrid.PageSetup.FooterFont.Size
        .FontName = mGrid.PageSetup.FooterFont.Name
        .FontBold = mGrid.PageSetup.FooterFont.Bold
        .FontItalic = mGrid.PageSetup.FooterFont.Italic
        .FontUnderline = mGrid.PageSetup.FooterFont.Underline
        .FontStrikethru = mGrid.PageSetup.FooterFont.Strikethrough
    End With

    '页眉/页脚的对齐方式
   ' cboHeaderAlign.ListIndex = mGrid.PageSetup.HeaderAlignment
   ' cboFooterAlign.ListIndex = mGrid.PageSetup.FooterAlignment
End Sub