Attribute VB_Name = "modPrinting"
Option Explicit
 
'   Public Type CharRange
'     firstChar As Long     ' First character of range (0 for start of doc)
'     lastChar As Long     ' Last character of range (-1 for end of doc)
'   End Type

'Public isPreview As Boolean

Public blnDirectPrint As Boolean

Public TextLength As Long

Public Const WM_USER As Long = &H400
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Public Const EM_SETTARGETDEVICE As Long = WM_USER + 72
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113

Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wp As Long, lp As Any) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As Long, ByVal lpInitData As Long) As Long

'Some public variables for printer/screen formatting

Public gLeft As Long
Public gRight As Long
Public gTop As Long
Public gBottom As Long
Public gHeader As String
Public gFooter As String
Public gAlign As Integer '0=left 1=center 2=right
Public gHeadAlign As Integer '0=left 1=center 2=right - Alignment for header
Public gFootAlign As Integer '0=left 1=center 2=right - Alignment for footer
Public gPageNumber As Long 'counts printed pages
Public gOrientation As Integer
Public gPaperSize As Variant
Public gPaperWidth As Variant
Public gPaperHeight As Variant
Public gMargin As Long

Private Prs As String 'The parsed header/footer string
   
'for print preview
'Public gLeftMargin As Integer
'Public gRightMargin As Integer
'Public gTopMargin As Integer
'Public gBottomMargin As Integer
Public gprint As Boolean

Public mFormatRangeP As FormatRange  'preview
'Public rectDrawTo As Rect
Public rectPage As Rect
Public newStartPos As Long
Public dumpaway As Long
Public currTotalPages As Integer

Public mNormalWidth, mNormalHeight
   
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, _
    ByVal y As Long, ByVal mDestWidth As Long, ByVal mDestHeight As Long, _
    ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal mSrcWidth As Long, _
    ByVal mSrcHeight As Long, ByVal dwRop As Long) As Long
    
Public myHeaderRTF As RichTextBox

Public mFormatRange As FormatRange
Public mFormatRangeH As FormatRange  'header
Public mFormatRangeL As FormatRange  'LOGO
Public mFormatRangeEX As FormatRange  'examinfo
Public mFormatRangeEXR As FormatRange  'examinfoR
Public mFormatRangeT As FormatRange  ' TEXT
Public mFormatRangeRF As FormatRange  ' Report footer
Public mFormatRangeF As FormatRange  ' Page footer
Public MyRTF As RichTextBox
Public WYSIWYGMode As Boolean

Public CustomFormat As Integer
Public myReportID As String

Public DestControl As Control
    
Public Sub myPrintReportRTF(RTF As RichTextBox, LeftMarginWidth As Long, TopMarginHeight, RightMarginWidth, BottomMarginHeight)

'*****************************************************************************
'* This code largely from Microsoft KB - Modified by me for header/footers   *
'*****************************************************************************

'On Error Resume Next

    If ChkTrace = 1 Then MsgBox " MyRTF = RTF"
    
    Set MyRTF = RTF
    
    Dim LeftOffSet As Long, TopOffSet As Long
    Dim LeftMargin As Long, TopMargin As Long
    Dim RightMargin As Long, BottomMargin As Long
    
    Dim rcDrawToHeader As Rect
    Dim rcDrawToExamInfo As Rect
    Dim rcDrawToExamInfoR As Rect
    Dim rcDrawToBody As Rect
    Dim rcDrawToFooter As Rect
    
    Dim rcPage As Rect
    Dim TextLength As Long
    Dim NextCharPosition As Long
    Dim r As Long
    Dim IX As Integer
    Dim TopText As Integer
    
    Dim mRect
    Dim mAdjFactor
    Dim mSq, mNewSq, mfactor
   
    Printer.Print "";
    Printer.ScaleMode = vbTwips
    
    ' Start a print job to get a valid Printer.hDC
'    Select Case Mode
'    Case "print"
'       'Printer.Font.Size = frmMainTextControl.
'    End Select

    'Printer.ScaleMode = vbTwips
    
    DoEvents
    
    
    ChkTrace = 0
    
    If ChkTrace = 1 Then MsgBox "myPrintReportRTF"
    
    
    ' Get the offset to the printable area on the page in twips
    LeftOffSet = Printer.ScaleX(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX), vbPixels, vbTwips)
    TopOffSet = Printer.ScaleY(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY), vbPixels, vbTwips)
            
    ' Calculate the Left, Top, Right, and Bottom margins
    LeftMargin = gLeft - LeftOffSet  'LeftMarginWidth
    TopMargin = gTop - TopOffSet 'TopMarginHeight
    RightMargin = (Printer.Width - RightMarginWidth) - LeftOffSet
    BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffSet
    
    ' Set printable area rect
    rcPage.Left = 0
    rcPage.Top = 0
    
'    Select Case mode
'    Case "print"
        rcPage.Right = Printer.ScaleWidth
        rcPage.Bottom = Printer.ScaleHeight
'    Case "preview"
'        rcPage.Right = frmReportPrintPreview.picSource(0).ScaleX(frmReportPrintPreview.picSource(0).ScaleWidth, frmReportPrintPreview.picSource(0).ScaleMode, vbTwips)
'        rcPage.Bottom = frmReportPrintPreview.picSource(0).ScaleY(frmReportPrintPreview.picSource(0).ScaleHeight, frmReportPrintPreview.picSource(0).ScaleMode, vbTwips)
'    End Select
'
    Select Case CustomFormat
    Case 0
        TopText = 4500
    Case 1
        TopText = Val(frmReportDesigner.txtSettings(0).Text)
    End Select
 
    If TopText = 0 Then
        TopText = 4500
    End If
   
    ' Header
    'MsgBox
    
    'rcDrawToHeader.Left = 2650 'gLeft - 0 'Margin * 1440
    Dim LeftPos2 As Integer
    '
   ' frmStorage.picLogo.ScaleMode = 1
        
    'MsgBox frmStorage.picLogo.Picture.Width
    'MsgBox frmStorage.picLogo.ScaleWidth
    
    ' 2000
    'LeftPos2 = (frmStorage.picLogo.Picture.Width / 1.8) + 600    'gLeft - 0 'Margin * 1440
    
    rcDrawToHeader.Left = LeftPos2
    
    rcDrawToHeader.Top = 288 ''Margin * 1440
        
     If frmStorage.picLogo2.Picture = 0 Then
        rcDrawToHeader.Right = RightMargin
    Else
        rcDrawToHeader.Right = RightMargin - 2000   'inControl.Width * Screen.TwipsPerPixelX - (gRight - 360) 'Margin * 1440
    End If
    
    rcDrawToHeader.Bottom = TopText 'BottomMargin   'inControl.Height * Screen.TwipsPerPixelY - (gBottom - 0) 'Margin * 1440

    ' Exam Details
    rcDrawToExamInfo.Left = LeftMargin
    rcDrawToExamInfo.Top = 1800 ''Margin * 1440
    rcDrawToExamInfo.Right = RightMargin - 1500
    rcDrawToExamInfo.Bottom = TopText
            
    rcDrawToExamInfoR.Left = LeftMargin + (RightMargin / 2) - 400
    rcDrawToExamInfoR.Top = 2500 ''Margin * 1440
    rcDrawToExamInfoR.Right = RightMargin - 500 '1500
    rcDrawToExamInfoR.Bottom = TopText
            
    ' Body - Set rect in which to print (relative to printable area)
    rcDrawToBody.Left = LeftMargin
    rcDrawToBody.Top = TopText ' TopMargin
    rcDrawToBody.Right = RightMargin
    rcDrawToBody.Bottom = BottomMargin - 1200

    ' Footer
    rcDrawToFooter.Left = LeftMargin
    rcDrawToFooter.Top = BottomMargin - 1000
    rcDrawToFooter.Right = RightMargin
    rcDrawToFooter.Bottom = BottomMargin + 1000
   
    mFormatRangeH.rectPage = rcPage           ' Entire size of page
    mFormatRangeH.mCharRange.firstChar = 0      ' Start of text
    mFormatRangeH.mCharRange.lastChar = -1      ' End of the text

    mFormatRangeEX.rectPage = rcPage           ' Entire size of page
    mFormatRangeEX.mCharRange.firstChar = 0      ' Start of text
    mFormatRangeEX.mCharRange.lastChar = -1      ' End of the text

    mFormatRangeEXR.rectPage = rcPage           ' Entire size of page
    mFormatRangeEXR.mCharRange.firstChar = 0      ' Start of text
    mFormatRangeEXR.mCharRange.lastChar = -1      ' End of the text

    mFormatRangeL.rectPage = rcPage           ' Entire size of page
    mFormatRangeL.mCharRange.firstChar = 0      ' Start of text
    mFormatRangeL.mCharRange.lastChar = -1      ' End of the text
    
    mFormatRangeRF.rectPage = rcPage           ' Entire size of page
    mFormatRangeRF.mCharRange.firstChar = 0      ' Start of text
    mFormatRangeRF.mCharRange.lastChar = -1      ' End of the text
    
    mFormatRangeF.rectPage = rcPage           ' Entire size of page
    mFormatRangeF.mCharRange.firstChar = 0      ' Start of text
    mFormatRangeF.mCharRange.lastChar = -1      ' End of the text
    'frmStorage.Show
    ' Gtet Number of Pages
    
    'mFormatRangeT.rectRegion = rcDrawToBody
    mFormatRangeT.mCharRange.firstChar = 0           ' Indicate start of text through
    mFormatRangeT.mCharRange.lastChar = -1          ' end of the text
    
    'RTF.Text = Trim(RTF.Text)
     TextLength = Len(RTF.Text)
    ' Loop printing each page until done
    currTotalPages = 0
    frmStorage.ScaleMode = 1
        
    Do
    

        If ChkTrace = 1 Then MsgBox "currTotalPages"
    
        currTotalPages = currTotalPages + 1
        
        mFormatRangeT.hdc = frmStorage.picTemp.hdc  ' Use the same DC for measuring and rendering
        mFormatRangeT.hdcTarget = frmStorage.picTemp.hdc ' Point at printer hDC
        mFormatRangeT.rectRegion = rcDrawToBody
                
        ' PRINT MAIN TEXT
        NextCharPosition = SendMessage(RTF.hwnd, EM_FORMATRANGE, True, mFormatRangeT)
        frmReportPrintPreview.picSource(0).Width = Printer.ScaleWidth
        frmReportPrintPreview.picSource(0).Height = Printer.ScaleHeight
        
        If NextCharPosition >= TextLength Then Exit Do  'If done then exit
            
        mFormatRangeT.mCharRange.firstChar = NextCharPosition
        If NextCharPosition = -1 Then
            Exit Do
        End If
        
    Loop

    ' Set up the print instructions
    If blnDirectPrint = True Then
    
        rcDrawToBody.Right = RightMargin
        mFormatRangeT.rectRegion = rcDrawToBody
    
        mFormatRangeH.hdc = Printer.hdc
        mFormatRangeH.hdcTarget = Printer.hdc
        
        mFormatRangeEX.hdc = Printer.hdc
        mFormatRangeEX.hdcTarget = Printer.hdc
        
        mFormatRangeEXR.hdc = Printer.hdc
        mFormatRangeEXR.hdcTarget = Printer.hdc
        
        mFormatRangeT.hdc = Printer.hdc   ' Use the same DC for measuring and rendering
        mFormatRangeT.hdcTarget = Printer.hdc  ' Point at printer hDC
    
        mFormatRangeL.hdc = Printer.hdc
        mFormatRangeL.hdcTarget = Printer.hdc
        
        mFormatRangeRF.hdc = Printer.hdc
        mFormatRangeRF.hdcTarget = Printer.hdc
        
        mFormatRangeF.hdc = Printer.hdc
        mFormatRangeF.hdcTarget = Printer.hdc
        
    Else
        
        ' preview
        

        If ChkTrace = 1 Then MsgBox "preview"
        rcDrawToBody.Left = LeftMargin
        rcDrawToBody.Right = RightMargin
    
        'rcDrawToBody.Left = frmReportPrintPreview.picSource(0).ScaleX(LeftMargin, frmReportPrintPreview.picSource(0).ScaleMode, vbTwips)
        'rcDrawToBody.Right = frmReportPrintPreview.picSource(0).ScaleY(RightMargin, frmReportPrintPreview.picSource(0).ScaleMode, vbTwips)
        
        rcDrawToBody.Right = RightMargin ' - 1100
        mFormatRangeT.rectRegion = rcDrawToBody
    
        On Error Resume Next
        Unload frmReportPrintPreview
        On Error GoTo 0
        
        frmReportPrintPreview.PagesLoaded = False

        'Printer.ScaleMode = vbTwips
        mNormalWidth = Printer.ScaleWidth
        mNormalHeight = Printer.ScaleHeight
        
        mNormalWidth = 8.5 * 1440        ' Inch * 1440 twip per inch
        mNormalHeight = 11 * 1440        ' Normal paper size
        
        mRect = mNormalWidth * mNormalHeight
        'mSq = mNormalWidth * mNormalHeight
        'mAdjFactor = 60 / 100
        'mNewSq = mSq * (95 / 100) * mAdjFactor      ' Set 95%
 
        frmReportPrintPreview.picSource(0).AutoSize = False
   
        'frmReportPrintPreview.picPreview(0).Width = CInt(mNormalWidth * 55 / 100)
        'frmReportPrintPreview.picPreview(0).Height = CInt(mNormalHeight * 55 / 100)
        frmReportPrintPreview.picSource(0).Width = mNormalWidth
        frmReportPrintPreview.picSource(0).Height = mNormalHeight
        
        'frmReportPrintPreview.picSource(0).Width = frmReportPrintPreview.picSource(0).Width - frmReportPrintPreview.picSource(0).ScaleWidth + mNormalWidth
        'frmReportPrintPreview.picSource(0).Height = frmReportPrintPreview.picSource(0).Height - frmReportPrintPreview.picSource(0).ScaleHeight + mNormalHeight
        
        frmReportPrintPreview.picPreview(0).Width = frmReportPrintPreview.picSource(0).Width
        frmReportPrintPreview.picPreview(0).Height = frmReportPrintPreview.picSource(0).Height
    
        SetPages
                
        frmReportPrintPreview.cboScale.Text = frmReportPrintPreview.cboScale.List(1)      ' i.e. 25%
        frmReportPrintPreview.PagesLoaded = True

        frmReportPrintPreview.lblPageCount = currTotalPages
        If currTotalPages > 1 Then
            frmReportPrintPreview.fraPages.Visible = True
        End If
        
        rcPage.Right = frmReportPrintPreview.picSource(0).ScaleX(frmReportPrintPreview.picSource(0).ScaleWidth, frmReportPrintPreview.picSource(0).ScaleMode, vbTwips)
        rcPage.Bottom = frmReportPrintPreview.picSource(0).ScaleY(frmReportPrintPreview.picSource(0).ScaleHeight, frmReportPrintPreview.picSource(0).ScaleMode, vbTwips)
    
    End If

    mFormatRangeT.rectRegion = rcDrawToBody         ' Indicate the area on page to draw to
    mFormatRangeT.rectPage = rcPage                 ' Indicate entire size of page
    mFormatRangeT.mCharRange.firstChar = 0          ' Indicate start of text through
    mFormatRangeT.mCharRange.lastChar = -1          ' end of the text

    ' Get length of text in RTF
    gPageNumber = 0
    
'    rcDrawTo.Left = LeftMargin
'    rcDrawTo.Top = TopMargin
'    rcDrawTo.Right = RightMargin
'    rcDrawTo.Bottom = BottomMargin
    
    ' Loop printing each page until done
    
    Select Case blnDirectPrint
    Case True
        Set DestControl = Printer
    Case False
    
    End Select
        
    Do
        gPageNumber = gPageNumber + 1
                
        Select Case blnDirectPrint
        Case False

            Set DestControl = frmReportPrintPreview.picSource(gPageNumber)
            ' DestControl.Print " "
            mFormatRangeH.hdc = DestControl.hdc
            mFormatRangeH.hdcTarget = DestControl.hdc
            mFormatRangeL.hdc = DestControl.hdc
            mFormatRangeL.hdcTarget = DestControl.hdc
            mFormatRangeRF.hdc = DestControl.hdc
            mFormatRangeRF.hdcTarget = DestControl.hdc
            mFormatRangeF.hdc = DestControl.hdc
            mFormatRangeF.hdcTarget = DestControl.hdc
            mFormatRangeEX.hdc = DestControl.hdc
            mFormatRangeEX.hdcTarget = DestControl.hdc
            mFormatRangeEXR.hdc = DestControl.hdc
            mFormatRangeEXR.hdcTarget = DestControl.hdc
        
        End Select
        
        ' print Header, Logo and ISO number, record status    SIZE=400x1200
        DestControl.ScaleMode = 1
                
        Select Case blnDirectPrint
        Case False
            DestControl.CurrentX = 400
        Case Else
            DestControl.CurrentX = 2200
        End Select
        
        
        
        Select Case CustomFormat
        Case 0
        
            'Printer.PrintQuality = vbPRPQHigh
        
            If frmStorage.picLogo.Picture <> 0 Then DestControl.PaintPicture frmStorage.picLogo, 600, 300  ', 2000, 1500
            If frmStorage.picLogo2.Picture <> 0 Then DestControl.PaintPicture frmStorage.picLogo2, RightMargin - 1800, 300, 2000, 1500
            DestControl.ScaleMode = 3
            DestControl.CurrentX = 5
            DestControl.CurrentY = 5
            DestControl.FontSize = 6
            DestControl.Font = "Arial Narrow"
            'DestControl.Print frmStorage.lblISONum.Caption
            DestControl.CurrentY = 5
            DestControl.FontSize = 8
            'DestControl.Print frmStorage.lblStatus
            
            mFormatRangeH.rectRegion = rcDrawToHeader
            SendMessage frmStorage.txtHeader.hwnd, EM_FORMATRANGE, True, mFormatRangeH
             
            mFormatRangeEX.rectRegion = rcDrawToExamInfo
            SendMessage frmStorage.txtExamInfo.hwnd, EM_FORMATRANGE, True, mFormatRangeEX
            
            mFormatRangeEXR.rectRegion = rcDrawToExamInfoR
            SendMessage frmStorage.txtExamInfoR.hwnd, EM_FORMATRANGE, True, mFormatRangeEXR
            
            ' Patient Picture and Exam Info
            DestControl.ScaleMode = 1
            If frmStorage.picPhoto.Picture <> 0 Then DestControl.PaintPicture frmStorage.picPhoto, 9800, 1800, 1500, 1300
            DestControl.ScaleMode = 3
            
        Case 1

            'If frmStorage.picBackGround.Picture <> 0 Then DestControl.PaintPicture frmStorage.picBackGround, 1, 1    ', 2000, 1500
            If gPageNumber = currTotalPages Then
                frmReportDesigner.PrintPage1 True, 1
            Else
                frmReportDesigner.PrintPage1 True
            End If
            
        End Select
                            
        ' PRINT MAIN TEXT
'        rcDrawTo.Left = LeftMargin
'        rcDrawTo.Top = TopText ' TopMargin
'        rcDrawTo.Right = RightMargin
'        rcDrawTo.Bottom = BottomMargin - 1200
        mFormatRangeT.hdc = DestControl.hdc  ' Use the same DC for measuring and rendering
        mFormatRangeT.hdcTarget = DestControl.hdc ' Point at printer hDC
        mFormatRangeT.rectRegion = rcDrawToBody
                
'        Select Case mode
'        Case "preview"
'
'                        DestControl.ScaleMode = 1
'            'DestControl.CurrentX = LeftMargin
'            'DestControl.CurrentY = TopText
'            'RTF.SelPrint DestControl.hdc
'            mFormatRangeT.hdc = frmStorage.picTemp.hdc
'            NextCharPosition = SendMessage(RTF.hwnd, EM_FORMATRANGE, True, mFormatRangeT)
'
'            Dim rv As Long
'            Const WM_PAINT = &HF
'            Dim PW, PH
'
'            frmStorage.picTemp.AutoRedraw = True
'            frmStorage.picTemp.FillStyle = vbFSSolid
'            frmStorage.picTemp.FillColor = QBColor(Int(Rnd * 15))
'            PW = Printer.ScaleWidth ' frmStorage.picTemp.ScaleWidth   ' Set ScaleWidth.
'            PH = Printer.ScaleHeight ' frmStorage.picTemp.ScaleHeight   ' Set ScaleHeight.
'            frmStorage.picTemp.Width = Printer.ScaleWidth
'            frmStorage.picTemp.Height = Printer.ScaleHeight
'            rv = SendMessage(RTF.hwnd, WM_PAINT, frmStorage.picTemp.hdc, 0)
'
'             DestControl.PaintPicture frmStorage.picTemp.Image, LeftMargin, TopText
'
'
'        Case "print"
            NextCharPosition = SendMessage(RTF.hwnd, EM_FORMATRANGE, 1, mFormatRangeT)

'        End Select
           
        mFormatRangeRF.rectRegion = rcDrawToFooter
        
        Select Case CustomFormat
        Case 0
         
'
'            ' Report Footer
'            If gPageNumber = currTotalPages Then
'
'                SendMessage frmStorage.txtReportFooter.hwnd, EM_FORMATRANGE, True, mFormatRangeRF
'                ' SIGNATURE
'                DestControl.ScaleMode = 1
'                frmStorage.picSignature.ScaleMode = 3
'
'                Dim x1 As Single
'                Dim y1 As Single
'                Dim x2 As Single
'                Dim y2 As Single
'
'                If frmStorage.picSignature.Picture <> 0 Then
'
'                    x1 = (Printer.ScaleWidth / 2) - ((frmStorage.picSignature.Picture.Width / 2) / 2)
'                    'y1 = BottomMargin - (frmStorage.picSignature.Picture.Height / 2) - 500
'                    y1 = BottomMargin - 2000
'
'                    x1 = x1 + (x1 / 2) ' move sig to the right
'
'                    x2 = x1 + frmStorage.picSignature.Picture.Width / 2
'                    y2 = y1 + frmStorage.picSignature.Picture.Height / 2
'
'                    DestControl.PaintPicture frmStorage.picSignature, x1, y1 + 360
'                    'DestControl.ScaleMode = 1
'                    'DestControl.Line (x1, y1)-(x2, y2), vbRed, B
'                    'DestControl.Line (RightMargin, BottomMargin)-(RightMargin - 50, BottomMargin - 50), vbRed, B
'                Else
'
'                    x1 = (Printer.ScaleWidth / 2) - 1500
'                    y1 = BottomMargin - 1800
'                    x2 = x1 + 1000 / 2
'                    y2 = y1 + 500 / 2
'                End If
'                'frmStorage.Show
'
'                DestControl.CurrentY = y1 + 1000
'                DestControl.FontSize = 8
'
'                Dim UnderLine As String
'                For iX = 1 To Len(frmStorage.txtRadName) + 20
'                    UnderLine = UnderLine & "_"
'                Next iX
'
'                DestControl.CurrentX = x1 - 200
'                DestControl.Print UnderLine
'                DestControl.CurrentX = x1
'                DestControl.Print frmStorage.txtRadName & " " & frmStorage.txtRadTitle
'
'
'                'DestControl.CurrentX = x1
'                'DestControl.Print frmStorage.txtRadTitle
'
'                DestControl.ScaleMode = 3
'
'            Else
'                SendMessage frmStorage.txtContinued.hwnd, EM_FORMATRANGE, True, mFormatRangeRF
'
'            End If
            
        Case 1

            ' Report Footer
            If gPageNumber = currTotalPages Then
    
                'SendMessage frmStorage.txtReportFooter.hwnd, EM_FORMATRANGE, True, mFormatRangeRF
                ' SIGNATURE
                DestControl.ScaleMode = 1
                frmStorage.picSignature.ScaleMode = 3
                   
                Dim x1 As Single
                Dim y1 As Single
                Dim x2 As Single
                Dim y2 As Single
                
                Dim RadName As String
                Dim RadTitle As String
                Dim RadSon As String
                RadName = GetFieldData("{RadName}")
                RadTitle = GetFieldData("{RadTitle}")
                RadSon = GetFieldData("{RadSon}")
                
                Dim SigTopLocation As Integer
                
                'SigTopLocation = BottomMargin
                SigTopLocation = DestControl.ScaleHeight - 3500
                
                Dim HalfPageWidth As Integer

                Dim RadNameWidth As Integer
                                                                   
                                                                   
                If frmReportDesigner.Images(3).Picture <> 0 And RadName <> "" Then
    
                    HalfPageWidth = DestControl.ScaleWidth / 4
                    'x1 = (Printer.ScaleWidth / 2) - ((frmReportDesigner.Images(3).Picture.Width / 2) / 2)
                    x1 = HalfPageWidth * 3 - ((frmReportDesigner.Images(3).Width / 2) + 200)
                    
                    'RadNameWidth = DestControl.TextWidth(RadName & " " & RadTitle)
                    
                    ' ------------------------------
                    '               '  asdfasdfasdf
                    '               '       '
                    
                    'x1 = HalfPageWidth * 3 - RadNameWidth / 2
                
                    y1 = SigTopLocation - (frmStorage.picSignature.Picture.Height / 2) - 500
                    'y1 = BottomMargin - 3800
                    
                    'x1 = x1 + (x1 / 2) ' move sig to the right
                    
                    x2 = x1 + frmReportDesigner.Images(3).Width / 2
                    y2 = y1 + frmReportDesigner.Images(3).Height / 2
                    
                    DestControl.PaintPicture frmReportDesigner.Images(3), x1, y1 + 360
                    'DestControl.ScaleMode = 1
                    'DestControl.Line (x1, y1)-(x2, y2), vbRed, B
                    'DestControl.Line (RightMargin, BottomMargin)-(RightMargin - 50, BottomMargin - 50), vbRed, B
                Else
                
                    x1 = (Printer.ScaleWidth / 2) - 1500
                    y1 = SigTopLocation - 1800
                    x2 = x1 + 1000 / 2
                    y2 = y1 + 500 / 2
                    
                End If
                
                'frmStorage.Show
                
                DestControl.CurrentY = y1 + 1000
                'DestControl.CurrentY = DestControl.ScaleHeight - 3300
                DestControl.FontSize = 8
                
                HalfPageWidth = DestControl.ScaleWidth / 2
                HalfPageWidth = HalfPageWidth / 2
                
                
                Dim UnderLine As String
                For IX = 1 To Len(RadName & " " & RadTitle)
                    UnderLine = UnderLine & "_"
                Next IX
                RadNameWidth = DestControl.TextWidth(UnderLine)
                x1 = HalfPageWidth * 3 - RadNameWidth / 2
                
                DestControl.CurrentX = x1 - 200
                DestControl.Print UnderLine
                
                
                RadNameWidth = DestControl.TextWidth(RadName & " " & RadTitle)
                
                ' ------------------------------
                '               '  asdfasdfasdf
                '               '       '
                
                x1 = HalfPageWidth * 3 - RadNameWidth / 2
                
                
                

                DestControl.CurrentX = x1 - 200
                DestControl.Print RadName & " " & RadTitle
                
                
                RadNameWidth = DestControl.TextWidth(RadSon)
                 x1 = HalfPageWidth * 3 - RadNameWidth / 2
                 
                DestControl.CurrentY = DestControl.CurrentY + 80
                DestControl.CurrentX = x1 - 200
                DestControl.Print RadSon
                
                For IX = 1 To Len(RadName) + 20
                    UnderLine = UnderLine & "_"
                Next IX
                 
                'DestControl.CurrentX = x1
                'DestControl.Print frmStorage.txtRadTitle
                
                DestControl.ScaleMode = 3
                
            Else
            
                SendMessage frmStorage.txtContinued.hwnd, EM_FORMATRANGE, True, mFormatRangeRF
                
            End If
            
        End Select
        
        ' Regular printing of footer
        DestControl.ScaleMode = 1
        DestControl.CurrentX = RightMargin - 4000
        'DestControl.CurrentY = BottomMargin + 200
        DestControl.CurrentY = DestControl.ScaleHeight - 1300
        DestControl.FontSize = 7
        DestControl.Print "page: " & gPageNumber & " of " & currTotalPages & "     printed by: " & pclsUser.EmployeeName & "    print date: " & Now
        'DestControl.CurrentY = 5
        DestControl.FontSize = 5
        DestControl.CurrentX = RightMargin - 800
        'DestControl.Print "www.gomedsys.com"
        DestControl.ScaleMode = 3
                 
        ' Actual Printing
        Select Case blnDirectPrint
        Case True
            
            If NextCharPosition >= TextLength Then Exit Do  'If done then exit
            
            Printer.NewPage
            Printer.Print Space(1) ' Re-initialize hDC
            mFormatRangeT.hdc = Printer.hdc
            mFormatRangeT.hdcTarget = Printer.hdc
                
        Case False
        
            frmReportPrintPreview.picPreview(gPageNumber).Picture = LoadPicture()
            MakeSizes gPageNumber
        
            If NextCharPosition >= TextLength Then Exit Do  'If done then exit
            
        End Select
    
        ' Starting position for next page
        mFormatRangeT.mCharRange.firstChar = NextCharPosition
        If NextCharPosition = -1 Then
            Exit Do
        End If

    Loop
    
    Select Case blnDirectPrint
    Case True
        Printer.EndDoc
    Case False
        Printer.KillDoc
        frmReportPrintPreview.Show
    End Select
    
    ' Allow the RTF to free up memory
    r = SendMessage(RTF.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
    
    RTF.Refresh
    
    Exit Sub
    
PrintFields:
        
End Sub

Private Function GetFieldData(FindStr As String) As String
    Dim IX As Integer
    
    For IX = 1 To frmReportDesigner.grdFLD.Rows - 1
        If frmReportDesigner.grdFLD.TextMatrix(IX, 0) = FindStr Then
            GetFieldData = frmReportDesigner.grdFLD.TextMatrix(IX, 1)
        End If
         
    Next IX

End Function

                
' To display the same as it would print on the selected printer
'Public Function DocWYSIWYG(RTB As Control) As Long
'     Dim LeftOffSet As Long
'     Dim LeftMargin As Long, RightMargin As Long
'     Dim LineWidth As Long
'     Dim PrinterhDC As Long
'     Dim r As Long
'
'
'     Printer.ScaleMode = vbTwips
'
'               ' Get the offset to the printable area on the page in twips
'    LeftOffSet = Printer.ScaleX(GetDeviceCaps(Printer.hdc, 112), vbPixels, vbTwips)
'
'     LeftMargin = gLeft - LeftOffSet 'Margin * 1440
'     RightMargin = (Printer.Width - gRight) - LeftOffSet 'Margin * 1440
'     LineWidth = RightMargin - LeftMargin
'     DocWYSIWYG = LineWidth
'
'End Function


   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   '
   ' WYSIWYG_RTF - Sets an RTF control to display itself the same as it
   '               would print on the default printer
   '
   ' RTF - A RichTextBox control to set for WYSIWYG display.
   '
   ' LeftMarginWidth - Width of desired left margin in twips
   '
   ' RightMarginWidth - Width of desired right margin in twips
   '
   ' Returns - The length of a line on the printer in twips
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Public Function WYSIWYG_RTF(RTF As RichTextBox, LeftMarginWidth As Long, RightMarginWidth As Long) As Long
      
      Dim LeftOffSet As Long, LeftMargin As Long, RightMargin As Long
      Dim LineWidth As Long
      Dim PrinterhDC As Long
      Dim r As Long
      
    On Error GoTo ErrTrap
        
    If WYSIWYGMode = 1 Then

        ' Start a print job to initialize printer object
        Printer.Print Space(1)
        Printer.ScaleMode = vbTwips
        
        ' Get the offset to the printable area on the page in t wips
        LeftOffSet = Printer.ScaleX(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX), vbPixels, vbTwips)
        
        ' Calculate the Left, and Right margins
        LeftMargin = LeftMarginWidth - LeftOffSet
        RightMargin = (Printer.Width - RightMarginWidth) - LeftOffSet
        
        ' Calculate the line width
        LineWidth = RightMargin - LeftMargin
        
        ' Create an hDC on the Printer pointed to by the Printer object
        ' This DC needs to remain for the RTF to keep up the WYSIWYG display
        PrinterhDC = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)
        
        ' Tell the RTF to base it's display off of the printer
        '    at the desired line width
        r = SendMessage(RTF.hwnd, EM_SETTARGETDEVICE, PrinterhDC, ByVal LineWidth)
        
        ' Abort the temporary print job used to get printer info
        Printer.KillDoc
        
        WYSIWYG_RTF = LineWidth
      
      Else
      
        'Turn OFF WYSWYG Display.
        SendMessageLong RTF.hwnd, EM_SETTARGETDEVICE, 0, 0
              
        WYSIWYG_RTF = RTF.Width
        
      End If
      Exit Function
ErrTrap:
      MsgBox Err.Description
      
End Function
'
'Private Sub FooterPrint(LeftMargin As Long, BottomMargin As Long)
' Dim txtWidth As Long
' Dim MaxWidth As Long
'
' Prs = gFooter
' gAlign = 0
' MaxWidth = Printer.Width - LeftMargin * 2
'
'
''footer y location is constant
' Printer.CurrentY = BottomMargin + 360
'
' ParseHF Prs, gPageNumber
'
' txtWidth = Printer.TextWidth(Prs)
'
'   Select Case gAlign
'
'     Case 0 'left align
'        Printer.CurrentX = LeftMargin
'
'     Case 1 'center align
'        Printer.CurrentX = (LeftMargin + (MaxWidth - txtWidth) / 2) - LeftMargin / 2
'
'     Case 2 'right align
'        Printer.CurrentX = (LeftMargin + (MaxWidth - txtWidth)) - LeftMargin / 2
'
'
'  End Select
'
'  Printer.Print Prs 'print the parsed footer
'
'End Sub
'
'
'Private Sub HeaderPrint(LeftMargin As Long, TopMargin As Long)
'    Dim txtWidth As Long
'    Dim MaxWidth As Long
'
'    Prs = gHeader
'    gAlign = 0
'    MaxWidth = Printer.Width - LeftMargin * 2
'
'
'    'location is constant
'    Printer.CurrentY = TopMargin - 360
'
'    ParseHF Prs, gPageNumber
'
'    txtWidth = Printer.TextWidth(Prs)
'
'
'    Select Case gAlign
'
'    Case 0 'left align
'       Printer.CurrentX = LeftMargin
'
'    Case 1 'center align
'       Printer.CurrentX = (LeftMargin + (MaxWidth - txtWidth) / 2) - LeftMargin
'
'    Case 2 'right align
'       Printer.CurrentX = (LeftMargin + (MaxWidth - txtWidth)) - LeftMargin / 2
'
'
'    End Select
'
'
'     Printer.Print Prs 'print the parsed header
'
'  '        rectDrawTo.Left = LeftMargin 'gLeft - 0 'Margin * 1440
''        rectDrawTo.Top = 1   ''Margin * 1440
''        rectDrawTo.Right = RightMargin   'inControl.Width * Screen.TwipsPerPixelX - (gRight - 360) 'Margin * 1440
''        rectDrawTo.Bottom = BottomMargin   'inControl.Height * Screen.TwipsPerPixelY - (gBottom - 0) 'Margin * 1440
''        mFormatRangeH.rectRegion = rectDrawTo
''
''        SendMessage frmMainText.txtHeader.hwnd, EM_FORMATRANGE, True, mFormatRangeH
'
'
'
'End Sub
'
'Private Sub ParseHF(Prs$, gPageNumber)
'
''************************************************************
''This parses out requests for alignment of header/footer as
''well as request for page numbers, date, time filename
''************************************************************
'
'Dim Pars As Integer
'
'Pars = InStr(Prs$, "&p")
' If Pars Then
'  Prs$ = Mid$(Prs$, 1, Pars - 1) & Str$(gPageNumber) & Mid$(Prs$, Pars + 2, Len(Prs$))
' End If
'
'Pars = InStr(Prs$, "&f")
' If Pars Then
'  Prs$ = Mid$(Prs$, 1, Pars - 1) & LastPart(IQFileName) & Mid$(Prs$, Pars + 2, Len(Prs$))
' End If
'
' Pars = InStr(Prs$, "&d")
'  If Pars Then
'   Prs$ = Mid$(Prs$, 1, Pars - 1) & Format(Now, "dddd, mmmm dd, yyyy") & Mid$(Prs$, Pars + 2, Len(Prs$))
'  End If
'
' Pars = InStr(Prs$, "&t")
'  If Pars Then
'   Prs$ = Mid$(Prs$, 1, Pars - 1) & Format(Now, "h:mm AM/PM") & Mid$(Prs$, Pars + 2, Len(Prs$))
'  End If
'
''Parse for alignment
' Pars = InStr(Prs$, "&r") 'right align
'  If Pars Then
'   gAlign = 2
'   Prs$ = Mid$(Prs$, 1, Pars - 1) & Mid$(Prs$, Pars + 2, Len(Prs$))
'  End If
'
' Pars = InStr(Prs$, "&c") 'center align
'  If Pars Then
'   gAlign = 1
'   Prs$ = Mid$(Prs$, 1, Pars - 1) & Mid$(Prs$, Pars + 2, Len(Prs$))
'  End If
'
' Pars = InStr(Prs$, "&l") 'center align
'  If Pars Then
'   gAlign = 0
'   Prs$ = Mid$(Prs$, 1, Pars - 1) & Mid$(Prs$, Pars + 2, Len(Prs$))
'  End If
'
'End Sub

Public Sub SetPages()
    
    Dim i As Integer
    With frmReportPrintPreview
        For i = 1 To currTotalPages
        
            On Error Resume Next
            Unload .picPreview(i)
            Unload .picSource(i)
            
            On Error GoTo 0
            Load .picPreview(i)
            Load .picSource(i)
            
            '.picPreview(i).Move .picPreview(0).Left, .picPreview(0).Top, .picPreview(0).Width, .picPreview(0).Height
            .picPreview(i).Visible = False
            .picPreview(i).AutoRedraw = True
            .picPreview(i).ZOrder 0
            .picPreview(i).ScaleMode = 3
            .picPreview(i).AutoSize = False
            
            
            'mLineWidth = WYSIWYG_RTF(.picPreview(i), gLeft, gRight, True)
    
            .picSource(i).Move .picSource(0).Left + i * 100, .picSource(0).Top, .picSource(0).Width, .picSource(0).Height
            .picSource(i).AutoRedraw = True
            .picSource(i).ZOrder 0
            .picSource(i).ScaleMode = 3
            .picSource(i).AutoSize = False
            .picSource(i).Visible = True
            
        Next i
        .PagesLoaded = True
        If currTotalPages > 0 Then
            .picPreview(1).Visible = True
        End If
    End With
    'Picture1(0).Visible = False
End Sub

Public Sub SetPageSizes()
    'lblPageCount = PageCount
    Dim i As Integer
    With frmReportPrintPreview
    For i = 1 To currTotalPages
        'Unload Picture1(I)
        
        .picPreview(i).Move .picPreview(0).Left, .picPreview(0).Top, .picPreview(0).Width, .picPreview(0).Height
        
        MakeSizes i
        .picPreview(i).Refresh
        
    Next i
    End With
End Sub

Private Function MakeSizes(ByVal Page As Long) As Boolean
    Dim SrcX As Long, SrcY As Long
    Dim DestX As Long, DestY As Long
    Dim SrcWidth As Long, SrcHeight As Long
    Dim DestWidth As Long, DestHeight As Long
    Dim SrcHDC As Long, DestHDC As Long
    Dim mresult
      
    SrcX = 0: SrcY = 0: DestX = 0: DestY = 0
    
    SrcWidth = frmReportPrintPreview.picSource(Page).ScaleWidth
    SrcHeight = frmReportPrintPreview.picSource(Page).ScaleHeight
    SrcHDC = frmReportPrintPreview.picSource(Page).hdc

    DestWidth = frmReportPrintPreview.picPreview(Page).ScaleWidth
    DestHeight = frmReportPrintPreview.picPreview(Page).ScaleHeight
    DestHDC = frmReportPrintPreview.picPreview(Page).hdc
    
    'frmReportPrintPreview.picPreview(Page).Picture = LoadPicture
'
    mresult = StretchBlt(DestHDC, DestX, DestY, DestWidth, DestHeight, SrcHDC, _
      SrcX, SrcY, SrcWidth, SrcHeight, vbSrcCopy)

    If mresult = 0 Then
        MsgBox "Error occurred in sizing images. Cannot continue"
        MakeSizes = False
    Else
        MakeSizes = True
    End If
End Function
'
'