frmpagesetup.frm

VB做的报表设计源程序,非常不错,可以自定义模版

Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ScaleFactor As Single
Private Type PageParameters
    Name As String
    width As Single
    Height As Single
    PgScale As Single
End Type

Private Type MargRect
    Left As Single
    Right As Single
    Top As Single
    Bottom As Single
End Type

Dim Margin As MargRect

Dim PageSize(3) As PageParameters
Dim CurrPageWd As Single
Dim CurrPageHt As Single
Dim UnitScaleMod As Single
Dim CurrUnits As Integer
Dim blnLoading As Boolean

Private Sub LoadPageSizes()

    PageSize(0).Name = "Letter"
    PageSize(0).width = 8.5
    PageSize(0).Height = 11
    PageSize(0).PgScale = 1

    PageSize(1).Name = "Legal"
    PageSize(1).width = 8.5
    PageSize(1).Height = 14
    PageSize(1).PgScale = 0.9

    PageSize(2).Name = "B-Size"
    PageSize(2).width = 11
    PageSize(2).Height = 17
    PageSize(2).PgScale = 0.7

End Sub

Private Sub SetPageDimensions()
Dim i As Integer
    
    For i = 0 To 3
        If cboPageSize = PageSize(i).Name Then
            CurrPageWd = PageSize(i).width * UnitScaleMod
            CurrPageHt = PageSize(i).Height * UnitScaleMod
            If OptPortrait Then
                txtPageWid = CurrPageWd
                txtPageHt = CurrPageHt
            ElseIf OptLandscape Then
                txtPageWid = CurrPageHt
                txtPageHt = CurrPageWd
            End If
            ScaleFactor = PageSize(i).PgScale
            Exit Sub
        End If
    Next i

End Sub

Private Sub UpdatePreview()

    If OptLandscape Then
        shpPage(0).Left = 3.03
        shpPage(0).Top = 0.33
        shpPage(1).Left = 3
        shpPage(1).Top = 0.3
    Else
        shpPage(0).Left = 3.13
        shpPage(0).Top = 0.23
        shpPage(1).Left = 3.1
        shpPage(1).Top = 0.2
    End If

    shpPage(0).width = txtPageWid / UnitScaleMod * 0.1 * ScaleFactor
    shpPage(0).Height = txtPageHt / UnitScaleMod * 0.1 * ScaleFactor
    shpPage(1).width = txtPageWid / UnitScaleMod * 0.1 * ScaleFactor
    shpPage(1).Height = txtPageHt / UnitScaleMod * 0.1 * ScaleFactor
    shpMargBord.Left = shpPage(1).Left + ((Val(txtLM) / UnitScaleMod) / 10) * ScaleFactor
    shpMargBord.Top = shpPage(1).Top + ((Val(txtTM) / UnitScaleMod) / 10) * ScaleFactor
    shpMargBord.width = shpPage(1).width - ((Val(txtLM) / UnitScaleMod) / 10) * ScaleFactor - ((Val(txtRM) / UnitScaleMod) / 10) * ScaleFactor
    shpMargBord.Height = shpPage(1).Height - ((Val(txtTM) / UnitScaleMod) / 10) * ScaleFactor - ((Val(txtBM) / UnitScaleMod) / 10) * ScaleFactor

End Sub

Private Sub cboPageSize_Click()

    SetPageDimensions
    UpdatePreview

End Sub

Private Sub cmdCancel_Click()

    Unload Me

End Sub

Private Sub cmdOK_Click()

    blnPageWidChanged = True
    PageSizeName = cboPageSize
    If OptPortrait Then
        PageWd = CurrPageWd / UnitScaleMod
        PageHt = CurrPageHt / UnitScaleMod
    Else
        PageWd = CurrPageHt / UnitScaleMod
        PageHt = CurrPageWd / UnitScaleMod
    End If
    LeftMarg = Val(txtLM) / UnitScaleMod
    RightMarg = Val(txtRM) / UnitScaleMod
    TopMarg = Val(txtTM) / UnitScaleMod
    BottomMarg = Val(txtBM) / UnitScaleMod
    If OptPortrait Then
        PageOrient = cPortrait
    Else
        PageOrient = cLandscape
    End If
    frmDesign.ShowHorizScale
    frmDesign.ShowVertScale
    ShowGrid
    If PageScaleUnits <> CurrUnits And blnSnapOn Then
        frmGridSpace.Show
    End If
    Unload Me

End Sub

Private Sub Form_Load()

    blnLoading = True
    CurrUnits = PageScaleUnits
    cboPageSize = PageSizeName
    If PageScaleUnits = scEnglish Then
        UnitScaleMod = 1
        optEng.value = True
        lblWidth = "Width (in.)"
        lblHeight = "Height (in.)"
        lblPageMarg.Caption = "Page Margins  (Inches)"
    ElseIf PageScaleUnits = scMetric Then
        UnitScaleMod = 2.54
        optMetric.value = True
        lblWidth = "Width (cm)"
        lblHeight = "Height (cm)"
        lblPageMarg.Caption = "Page Margins  (cm)"
    End If
    
    If PageOrient = cPortrait Then
        OptPortrait = True
    Else
        OptLandscape = True
    End If
    
    cboPageSize.text = PageSizeName
    LoadPageSizes
    Margin.Left = LeftMarg
    Margin.Right = RightMarg
    Margin.Top = TopMarg
    Margin.Bottom = BottomMarg
    
    txtLM.text = Margin.Left * UnitScaleMod
    txtTM.text = Margin.Top * UnitScaleMod
    txtRM.text = Margin.Right * UnitScaleMod
    txtBM.text = Margin.Bottom * UnitScaleMod
    SetPageDimensions
    UpdatePreview
    blnLoading = False

End Sub

Private Sub optEng_Click()

    PageScaleUnits = scEnglish
    UnitScaleMod = 1
    lblWidth = "Width (in.)"
    lblHeight = "Height (in.)"
    lblPageMarg.Caption = "Page Margins  (Inches)"
    txtLM.text = Margin.Left * UnitScaleMod
    txtTM.text = Margin.Top * UnitScaleMod
    txtRM.text = Margin.Right * UnitScaleMod
    txtBM.text = Margin.Bottom * UnitScaleMod
    SetPageDimensions

End Sub

Private Sub OptLandscape_Click()

    SetPageDimensions
    UpdatePreview

End Sub

Private Sub optMetric_Click()

    PageScaleUnits = scMetric
    UnitScaleMod = 2.54
    lblWidth = "Width (cm)"
    lblHeight = "Height (cm)"
    lblPageMarg.Caption = "Page Margins  (cm)"
    txtLM.text = Margin.Left * UnitScaleMod
    txtTM.text = Margin.Top * UnitScaleMod
    txtRM.text = Margin.Right * UnitScaleMod
    txtBM.text = Margin.Bottom * UnitScaleMod
    SetPageDimensions

End Sub

Private Sub OptPortrait_Click()

    SetPageDimensions
    UpdatePreview

End Sub

Private Sub txtBM_GotFocus()

    txtBM.SelStart = 0
    txtBM.SelLength = Len(txtBM)

End Sub

Private Sub txtBM_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
        Margin.Bottom = Val(txtBM)
        UpdatePreview
    End If

End Sub

Private Sub txtLM_GotFocus()

    txtLM.SelStart = 0
    txtLM.SelLength = Len(txtLM)

End Sub

Private Sub txtLM_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
        Margin.Left = Val(txtLM)
        UpdatePreview
    End If

End Sub

Private Sub txtRM_GotFocus()
    
    txtRM.SelStart = 0
    txtRM.SelLength = Len(txtRM)

End Sub

Private Sub txtRM_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
        Margin.Right = Val(txtRM)
        UpdatePreview
    End If

End Sub

Private Sub txtTM_GotFocus()

    txtTM.SelStart = 0
    txtTM.SelLength = Len(txtTM)

End Sub

Private Sub txtTM_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
        Margin.Top = Val(txtTM)
        UpdatePreview
    End If

End Sub