frmpreview.frm

This application provides much functionality for creating data-driven reports, including preview, gr

        Select Case sngZoom
            Case Is > 0
                sngCoeff = sngZoom
            Case 0
                If w / cw > h / ch Then
                    sngCoeff = (cw - 6) / w
                Else
                    sngCoeff = (ch - 6) / h
                End If
            Case -0.01
                sngCoeff = (cw - 6) / w
        End Select
        pw = w * sngCoeff
        ph = h * sngCoeff

        picPage.Width = pw
        picPage.Height = ph
        
        HS.Max = 100
        HS.Value = HS.Max / 2
        HS_Change
        If pw <= picContainer.Width - 3 Then
            HS.Max = 0
            HS.Enabled = False
        Else
            HS.Enabled = True
        End If
        VS.Max = 100
        VS.Value = VS.Max / 2
        VS_Change
        If ph <= picContainer.Height - 3 Then
            VS.Max = 0
            VS.Enabled = False
        Else
            VS.Enabled = True
        End If

        If oldZoom <> sngZoom Or oldCurPage <> intCurPage Or pw <> oldPW Or ph <> oldPH Then
            txtStatus.Text = intCurPage & " / " & intPagesCount
            oldZoom = sngZoom
            oldCurPage = intCurPage
            oldPW = pw: oldPH = ph

            picPage.Cls
            SendPage picPage, intCurPage, sngCoeff, IndentX_mm, IndentY_mm

            If intCurPage > 1 Then
                tbToolBar.Buttons(1).Enabled = True
                tbToolBar.Buttons(2).Enabled = True
            End If
            If intCurPage = 1 Then
                tbToolBar.Buttons(1).Enabled = False
                tbToolBar.Buttons(2).Enabled = False
            End If
            If intCurPage = intPagesCount Then
                tbToolBar.Buttons(4).Enabled = False
                tbToolBar.Buttons(5).Enabled = False
            End If
            If intCurPage < intPagesCount Then
                tbToolBar.Buttons(4).Enabled = True
                tbToolBar.Buttons(5).Enabled = True
            End If
        End If
        Call LockWindowUpdate(0)

        Me.MousePointer = vbDefault
    End If
End Sub

Private Sub cboZoom_KeyDown(KeyCode As Integer, Shift As Integer)
    If Shift <> vbShiftMask And Shift <> vbAltMask Then
        KeyCode = 0
    End If
End Sub

Private Sub cmdClose_Click()
    HideWithAnim
    Unload Me
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim i As Integer, j As Integer, Ctrl As Integer

    i = VS.Value
    j = HS.Value
    Ctrl = Shift
    If KeyCode = vbKeyF4 And Ctrl = vbAltMask Then
        KeyCode = 0
    ElseIf KeyCode = vbKeyUp And VS.Enabled Then
        If Ctrl = vbCtrlMask Then
            i = i - 1
        Else
            i = i - 4
        End If
        If i < 0 Then
            i = 0
        End If
        VS.Value = i
    ElseIf KeyCode = vbKeyDown And VS.Enabled Then
        If Ctrl = vbCtrlMask Then
            i = i + 1
        Else
            i = i + 4
        End If
        If i > VS.Max Then
            i = VS.Max
        End If
        VS.Value = i
    ElseIf KeyCode = vbKeyRight And HS.Enabled Then
        If Ctrl = vbCtrlMask Then
            j = j + 1
        Else
            j = j + 4
        End If
        If j > HS.Max Then
            j = HS.Max
        End If
        HS.Value = j
    ElseIf KeyCode = vbKeyLeft And HS.Enabled Then
        If Ctrl = vbCtrlMask Then
            j = j - 1
        Else
            j = j - 4
        End If
        If j < 0 Then
            j = 0
        End If
        HS.Value = j
    ElseIf KeyCode = vbKeyHome And VS.Enabled Then
        VS.Value = VS.Min
    ElseIf KeyCode = vbKeyEnd And VS.Enabled Then
        VS.Value = VS.Max
    ElseIf KeyCode = vbKeyPageDown Then
        If Ctrl = vbCtrlMask And tbToolBar.Buttons(5).Enabled Then
            tbToolBar_ButtonClick tbToolBar.Buttons(5)
        ElseIf tbToolBar.Buttons(4).Enabled Then
            tbToolBar_ButtonClick tbToolBar.Buttons(4)
        End If
    ElseIf KeyCode = vbKeyPageUp Then
        If Ctrl = vbCtrlMask And tbToolBar.Buttons(1).Enabled Then
            tbToolBar_ButtonClick tbToolBar.Buttons(1)
        ElseIf tbToolBar.Buttons(2).Enabled Then
            tbToolBar_ButtonClick tbToolBar.Buttons(2)
        End If
    ElseIf KeyCode = vbKeyP And Ctrl = vbCtrlMask Then
        tbToolBar_ButtonClick tbToolBar.Buttons(12)
    ElseIf KeyCode = vbKeyI And Ctrl = vbCtrlMask Then
        tbToolBar_ButtonClick tbToolBar.Buttons(14)
    ElseIf KeyCode > vbKeyNumpad0 And KeyCode < vbKeyNumpad7 And Ctrl = vbCtrlMask Then
        cboZoom.ComboItems(KeyCode - 96).Selected = True
        cboZoom_Click
    End If
End Sub

Private Sub Form_Load()
Dim prW_mm As Single, prH_mm As Single
    
    lngHWnd = Me.hWnd
    fIsLoaded = False
    fMoving = False
    intCurPage = 1: oldCurPage = 0
    oldPW = 0: oldPH = 0
    oldZoom = 0
    picPage.MouseIcon = imgCursor(1).Picture

    With cboZoom.ComboItems
        .Add(, , "100%").Tag = 100
        .Add(, , "75%").Tag = 75
        .Add(, , "50%").Tag = 50
        .Add(, , "25%").Tag = 25
        .Add(, , "page width").Tag = -1
        .Add(, , "all page").Tag = 0
        .Item(.Count).Selected = True
    End With

    With PrinterEx
        w = .Width
        h = .Height
        prW_mm = .PrintableWidth
        prH_mm = .PrintableHeight
    End With

    IndentX_mm = (w - prW_mm) / 2
    IndentY_mm = (h - prH_mm) / 2

    Call DisableClose(lngHWnd)
    Hook_Zoom cboZoom.hWnd
End Sub

Private Sub Form_Resize()
Const s As Single = 4.5
Dim w As Single, h As Single, t As Single

    If Not fIsLoaded Then
        intPagesCount = UBound(colPage)
        fIsLoaded = True
    End If

    If Me.WindowState <> vbMinimized Then
        If Me.Width < 5100 Then
            Me.Width = 5100
            Exit Sub
        End If
        If Me.Height < 4000 Then
            Me.Height = 4000
            Exit Sub
        End If

        w = Me.ScaleWidth
        h = Me.ScaleHeight
        t = tbToolBar.Height + 0.5
        VS.Move w - s, t, s, h - 5 - t
        HS.Move 0, h - s, w - 5, s
        picContainer.Move 0, t, w - s, h - s - t
        cboZoom_Click
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHook_Zoom
End Sub

Private Sub picPage_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim p As POINTAPI

    If Button = vbLeftButton Then
        With picPage
            If HS.Enabled = False And VS.Enabled Then
                .MouseIcon = imgCursor(4).Picture
            ElseIf HS.Enabled And VS.Enabled = False Then
                .MouseIcon = imgCursor(5).Picture
            ElseIf HS.Enabled And VS.Enabled Then
                .MouseIcon = imgCursor(3).Picture
            Else
                .MouseIcon = imgCursor(6).Picture
            End If
            Call GetCursorPos(p)
            X_ = p.X - .ScaleX(.Left, vbMillimeters, vbPixels)
            Y_ = p.Y - .ScaleY(.Top, vbMillimeters, vbPixels)
            fMoving = True
        End With
    End If
End Sub

Private Sub picPage_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Single, j As Single, Max_ As Single, Min_ As Single
Dim p As POINTAPI

    On Error Resume Next
    If Button = vbLeftButton Then
        Call GetCursorPos(p)
        If HS.Enabled Then
            Min_ = picContainer.Width / 2
            j = picPage.Width
            Max_ = Min_ - j
            i = picPage.ScaleX(p.X - X_, vbPixels, vbMillimeters)
            If i < Max_ Then
                i = Max_
            ElseIf i > Min_ Then
                i = Min_
            End If
            picPage.Left = i
            HS.Value = (Min_ - i) * HS.Max / j
        End If
        If VS.Enabled Then
            Min_ = picContainer.Height / 2
            j = picPage.Height
            Max_ = Min_ - j
            i = picPage.ScaleY(p.Y - Y_, vbPixels, vbMillimeters)
            If i < Max_ Then
                i = Max_
            ElseIf i > Min_ Then
                i = Min_
            End If
            picPage.Top = i
            VS.Value = (Min_ - i) * VS.Max / j
        End If
    End If
End Sub

Private Sub picPage_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        picPage.MouseIcon = imgCursor(1).Picture
        fMoving = False
    End If
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim p As Integer, tmp As String

    MousePointer = vbHourglass
    Select Case Button.Key
        Case "first"
            intCurPage = 1
            cboZoom_Click
        Case "previous"
            intCurPage = intCurPage - 1
            cboZoom_Click
        Case "next"
            intCurPage = intCurPage + 1
            cboZoom_Click
        Case "last"
            intCurPage = intPagesCount
            cboZoom_Click
        Case "goto"
            p = Val(txtGoto.Text)
            If p > 0 And p <= intPagesCount Then
                intCurPage = p
                cboZoom_Click
                txtGoto.SetFocus
                txtGoto_GotFocus
            Else
                If intPagesCount > 1 Then
                    CInteraction.ShowMsgBox , "Enter number between 1 and " & intPagesCount & ".", , , , , imgExclamationEx, , 1
                End If
            End If
        Case "print"
            frmPrint.Cls 'for Form Load
            Me.Visible = False
            PrinterEx.PrintDoc PrinterEx.Owner_hWnd
            Unload Me
            Exit Sub
        Case "info"
            If cboZoom.SelectedItem.Index = 4 Then
                frmAnimatedLogo.LoadLogo 0, 0, -10, picLogo.Picture
            End If

            With PrinterEx
                Select Case .PageSize
                    Case sizeA3: tmp = "A3"
                    Case sizeA4: tmp = "A4"
                    Case sizeA5: tmp = "A5"
                    Case sizeB4: tmp = "B4"
                    Case sizeB5: tmp = "B5"
                    Case sizeLetter: tmp = "Letter"
                    Case sizeCustom: tmp = "Custom"
                End Select
                CInteraction.ShowMsgBox "Information", _
                        "Orientation:  " & IIf(.Orientation = OPortrait, "Portrait", "Landscape") & vbCrLf & _
                        "Page format:  " & tmp & vbCrLf & _
                        "Size:  " & Round(.Width, 1) & " x " & Round(.Height, 1) & " mm" & vbCrLf & _
                        "Printable area:  " & Round(.PrintableWidth, 1) & " x " & Round(.PrintableHeight, 1) & " mm" & vbCrLf & _
                        "Zoom:  " & 100 * Round(picPage.Width / .Width, 2) & "%", , , , , imgInformationEx, , 1
            End With

            If cboZoom.SelectedItem.Index = 4 Then
                frmAnimatedLogo.UnloadLogo
            End If
        Case "close"
            Unload Me
    End Select
    MousePointer = vbDefault
End Sub

Private Sub txtGoto_GotFocus()
    SelectText txtGoto
End Sub

Private Sub txtGoto_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        tbToolBar_ButtonClick tbToolBar.Buttons(7)
    End If
End Sub

Private Sub VS_Change()
    On Error Resume Next
    If Not fMoving Then
        picPage.Top = -VS.Value * picPage.Height / VS.Max + picContainer.Height / 2
    End If
End Sub

Private Sub HS_Change()
    On Error Resume Next
    If Not fMoving Then
        picPage.Left = -HS.Value * picPage.Width / HS.Max + picContainer.Width / 2
    End If
End Sub

Private Sub HS_Scroll()
    HS_Change
End Sub

Private Sub VS_Scroll()
    VS_Change
End Sub

Private Sub HideWithAnim()
Dim hw As Long, f As RECT, t As RECT

    hw = Me.hWnd
    Call GetWindowRect(hw, f)
    Call OffsetRect(f, (Screen.Width / Screen.TwipsPerPixelX - (f.Right - f.Left)) \ 2, (Screen.Height / Screen.TwipsPerPixelY - (f.Bottom - f.Top)) \ 2)
    With t
        .Left = 3 / 4 * (Screen.Width / Screen.TwipsPerPixelX)
        .Right = .Left + (f.Right - f.Left) \ 3
        .Top = 2 / 3 * (Screen.Height / Screen.TwipsPerPixelY)
        .Bottom = .Top + (f.Bottom - f.Top) \ 3
    End With
    Call DrawAnimatedRects(hw, 3, f, t)
    Call CopyRect(f, t)
    Call SetRectEmpty(t)
    Call DrawAnimatedRects(hw, 3, f, t)
End Sub