Attribute VB_Name = "ModZoomScroll"
' ModZoomScroll.bas

Option Explicit

Public Sub FixSBars_and_picDRAW(frm As Form)

'Dim v As Long, w As Long
   aScroll = False
   
   frm.picDRAW.Cls   ' ?
   
   With frm
      If FullW * Zoom > MaxVPWidth Then
         .picDRAW.Width = MaxVPWidth
         
         xlonew = 0
         If .scrHorz.Max <> 0 Then
            xlonew = xlo / .scrHorz.Max
         End If
         .scrHorz.Left = .picDRAW.Left
         .scrHorz.Width = .picDRAW.Width + 1
         .scrHorz.Min = 0
         .scrHorz.Max = FullW - (MaxVPWidth / Zoom)
         
'.scrHorz.Value = .scrHorz.Min   ' ?
         
         If xlonew <> 0 Then
            .scrHorz.Value = xlonew * (.scrHorz.Max)
         End If
      Else
         .picDRAW.Width = FullW * Zoom
         .scrHorz.Visible = False
         .scrHorz.Value = 0
      End If
         
      If FullH * Zoom > MaxVPHeight Then
         .picDRAW.Height = MaxVPHeight
         
         ylonew = 0
         If .ScrVert.Min <> 0 Then
            ylonew = ylo / .ScrVert.Min
         End If
         .ScrVert.TOp = .picDRAW.TOp
         .ScrVert.Height = .picDRAW.Height + 1
         .ScrVert.Min = FullH - (CLng(MaxVPHeight / Zoom))
         .ScrVert.Max = 0

'.ScrVert.Value = .ScrVert.Min   ' ?
         
         If ylonew <> 0 Then
            .ScrVert.Value = ylonew * (.ScrVert.Min)
         End If

      Else
         .picDRAW.Height = FullH * Zoom
         .ScrVert.Visible = False
         .ScrVert.Value = 0
      End If
      
      .cmdTLBR(0).Enabled = False
      .cmdTLBR(1).Enabled = False
      
      If FullH * Zoom > MaxVPHeight Then
         .ScrVert.Left = .picDRAW.Left + .picDRAW.Width + 3
         .ScrVert.Visible = True
         .cmdTLBR(0).Enabled = True
         .cmdTLBR(1).Enabled = True
      End If
      
      If FullW * Zoom > MaxVPWidth Then
         .scrHorz.TOp = .picDRAW.TOp + .picDRAW.Height + 3
         .scrHorz.Visible = True
         .cmdTLBR(0).Enabled = True
         .cmdTLBR(1).Enabled = True
      End If
      
      xlo = .scrHorz.Value
      ylo = .ScrVert.Value

' TEST
'v = .ScrVert.Min
'w = .ScrVert.Max

' This is to adjust picDRAW coords to match scrollbar positions
' for Default Size that makes scrollbars invisible when using
' APIs PolyBezier & ExFloodFill
If .scrHorz.Visible = False And .ScrVert.Visible = False Then
   xlo = 0
   Form1.ScrVert.Min = ylo
End If
      DISPLAY frm, .picDRAW   ' Transfer viewport section of picDATA() to picDRAW screen.
      
      frm.Cls
      frm.Line (0, 0)-(.Width \ STX, .picMNU(0).TOp), BackCul, BF
      
      frm.Line (0, 0)-(.Width \ STX, .picMNU(0).TOp), 0, B
      If BackCul = &HCDFAFF Then  ' ie White make border black
         frm.Line (.picDRAW.Left - 1, .picDRAW.TOp - 1)- _
            (.picDRAW.Left + .picDRAW.Width, .picDRAW.TOp + .picDRAW.Height), 0, B
      Else
         frm.Line (.picDRAW.Left - 1, .picDRAW.TOp - 1)- _
         (.picDRAW.Left + .picDRAW.Width, .picDRAW.TOp + .picDRAW.Height), BackCul, B
      End If
      .Refresh
      
      If FullW >= 20 Then
         .scrHorz.LargeChange = FullW \ 10
      Else
         .scrHorz.LargeChange = 1
      End If
      If FullH >= 20 Then
         .ScrVert.LargeChange = FullH \ 10
      Else
         .ScrVert.LargeChange = 1
      End If
   
   End With
   aScroll = True
End Sub


Public Sub MoveDATAtoPIC(DATABYTES() As Byte, PIC As PictureBox, _
           Optional BIG As Long = 0)
' EG' Move picDATA() into picPAPER
'     whence PIC.Width=FullW & PIC.Height=FullH

Dim GetMode As Long
Dim StretchMode As Long
   On Error GoTo errorHandler
   
   GetMode = GetStretchBltMode(PIC.hDC)
   StretchMode = COLORONCOLOR
   SetStretchBltMode PIC.hDC, StretchMode 'COLORONCOLOR 'HALFTONE
   With BHI
      .biSize = 40
      .biPlanes = 1
      .biWidth = PIC.Width
      .biHeight = PIC.Height
      .biBitCount = 32
   End With
   
   Call StretchDIBits(PIC.hDC, _
   0, 0, _
   PIC.Width, PIC.Height, _
   0, 0, _
   PIC.Width, PIC.Height, DATABYTES(0, 0, 0), _
   BHI, 0, vbSrcCopy)
   SetStretchBltMode PIC.hDC, GetMode
   PIC.Refresh
   Exit Sub
   
errorHandler:
MsgBox Err.Number & "-" & Err.Description & ". Probably too large a picture." & vbCrLf & "Try Resizing it."
BIG = 1 ' Error
End Sub


Public Sub DISPLAY(frm As Form, PIC As PictureBox)
' Transfer viewport section of picDATA() to picDRAW screen.

' Public BHI As BITMAPINFOHEADER
' Public xlo,ylo  ' Offsets of picDRAW viewport rectangle within picDATA()
Dim GetMode As Long
Dim StretchMode As Long
   If aCrossHairs Then
      If aZoomMode Then
         Call CrossHairs(PIC, frm.scrHorz, frm.ScrVert, frm.LineCX(0), frm.LineCY(0), frm.LineCX(1), frm.LineCY(1))
      End If
   End If
   
   GetMode = GetStretchBltMode(PIC.hDC)

   If aZoomMode Then
      StretchMode = HALFTONE
   Else
      StretchMode = COLORONCOLOR
   End If

   SetStretchBltMode PIC.hDC, StretchMode 'COLORONCOLOR 'HALFTONE
   ' COLORONCOLOR for setting pixels
   ' HALFTONE for smoothing
   
   With BHI
      .biSize = 40
      .biPlanes = 1
      .biWidth = FullW
      .biHeight = FullH
      .biBitCount = 32
   End With
   
   Call StretchDIBits(PIC.hDC, _
   0, 0, _
   PIC.Width, PIC.Height, _
   xlo, ylo, _
   PIC.Width / Zoom, PIC.Height / Zoom, _
   picDATA(0, 0, 0), _
   BHI, 0, vbSrcCopy)
   
   SetStretchBltMode PIC.hDC, GetMode
   
   PIC.Refresh
   
   frm.LineLR(0).Visible = True
   frm.LineLR(1).Visible = False

   'PIC.Picture = PIC.Image   ' Jerky ?
End Sub

Public Sub TRANSANYDATA(PIC As PictureBox, DATARRAY() As Byte)
' PIC dimensions already set
' Transfer PIC pixels to DATARRAY()
' EG Transfer Form1.picPaper to picDATA()
Dim BDATA As BITMAPINFOHEADER
Dim mHDC As Long, mBMPold As Long
On Error GoTo TRANSANYDATAERROR
   If aZoomMode Then Exit Sub
   If GlobTrans = 0 Then Exit Sub
   
   With BDATA
      .biSize = 40
      .biPlanes = 1
      .biWidth = FullW
      .biHeight = FullH
      .biBitCount = 32
   End With
   ReDim DATARRAY(0 To 3, 0 To FullW - 1, 0 To FullH - 1)
   
   ' Transfer pixel colors in PIC to DATARRAY() both same size
    mHDC = CreateCompatibleDC(0)
    mBMPold = SelectObject(mHDC, PIC.Image)
    GetDIBits mHDC, PIC.Image, 0, FullH, DATARRAY(0, 0, 0), BDATA, 0
    SelectObject mHDC, mBMPold
    DeleteDC mHDC
    DeleteObject mBMPold

    On Error GoTo 0
    Exit Sub
'========
TRANSANYDATAERROR:
MsgBox "TRANSANYDATA ERROR using On Error", vbCritical, "TRANSANYDATA"

End Sub

Public Sub TRANSDATA(PIC As PictureBox)
' TRANSDATA Form1.picDRAW to prevDATA()
Dim BDATA As BITMAPINFOHEADER
Dim mHDC As Long, mBMPold As Long
On Error GoTo TRANSDATAERROR
   If aZoomMode Then Exit Sub
   If GlobTrans = 0 Then Exit Sub
   
   With BDATA
      .biSize = 40
      .biPlanes = 1
      .biWidth = PIC.Width
      .biHeight = PIC.Height
      .biBitCount = 32
   End With
   ReDim prevDATA(0 To 3, 0 To PIC.Width - 1, 0 To PIC.Height - 1)
   ' Transfer pixel colors in picDRAW to prevDATA()
    mHDC = CreateCompatibleDC(0)
    mBMPold = SelectObject(mHDC, PIC.Image)
    GetDIBits mHDC, PIC.Image, 0, PIC.Height, prevDATA(0, 0, 0), BDATA, 0
    SelectObject mHDC, mBMPold
    DeleteDC mHDC
    DeleteObject mBMPold

'picDATAORG() = picDATA()
    
    On Error GoTo 0
    Exit Sub
'========
TRANSDATAERROR:
MsgBox "TRANSDATA ERROR using On Error", vbCritical, "TRANSDATA"
End Sub

Public Sub MouseMoveCalcs(x As Single, y As Single, HS As HScrollBar, VS As VScrollBar)
' Form1 refs
' X,Y cursor on picDRAW
' HS,VS  scrHorz, scrVert
'Public Zoom As Single
'Public xlo As Long, ylo As Long ' picDATA() origin
'Public XTL As Long, YTL As Long ' Top left coords in picDATA()
'Public xp1 As Long, yp1 As Long ' MouseDown x,y

Dim dx As Long, DY As Long
Dim xhi As Long, yhi As Long
   If HS.Visible Then
      dx = x - xp1 + 1
      xlo = XTL - dx / Zoom
      If xlo < 0 Then
         xlo = 0
      End If
      xhi = xlo + MaxVPWidth / Zoom
      
      If xhi > FullW Then
         xlo = FullW - MaxVPWidth / Zoom
      End If
      
      If xlo > HS.Max Then
         xlo = HS.Max
      End If
      HS.Value = xlo   ' -> HS_Change on Form1
   End If

   If VS.Visible Then
      DY = y - yp1 + 1
      yhi = YTL + DY / Zoom
      If yhi > FullH Then
         yhi = FullH
      End If
      ylo = yhi - MaxVPHeight / Zoom
      
      If ylo < 0 Then
         ylo = 0
      End If
      
      If ylo > VS.Min Then
         ylo = VS.Min
      End If
      VS.Value = ylo   ' -> VS_Change on Form1
   End If
End Sub

Public Sub CrossHairs(PIC As PictureBox, HS As HScrollBar, VS As VScrollBar, LX0 As Line, LY0 As Line, LX1 As Line, LY1 As Line)
' From DISPLAY
' Form1 refs
' PIC    picDRAW
' HS,VS  scrHorz, scrVert
' LX,LY  LineCX(0/1), LineCY(0/1)
   If HS.Visible Then
      LX0.Visible = True
      LX1.Visible = True
      If (HS.Max - HS.Min) <> 0 Then
         xlonew = xlo / (HS.Max - HS.Min)
      Else
         xlonew = 0
      End If
         With LX0
            .x1 = MaxVPWidth * xlonew
            If xlo = HS.Max Then .x1 = .x1 - 1
            .x2 = .x1
            .y1 = 0
            .y2 = PIC.Height
         End With
         With LX1
            .x1 = MaxVPWidth * xlonew
            If xlo = HS.Max Then .x1 = .x1 - 1
            .x2 = .x1
            .y1 = 0
            .y2 = PIC.Height
         End With
   Else
      LX0.Visible = False
      LX1.Visible = False
   End If
   
   If VS.Visible Then
      LY0.Visible = True
      LY1.Visible = True
      If (VS.Min - VS.Max) <> 0 Then
         ylonew = ylo / (VS.Min - VS.Max)
      Else
         ylonew = 0
      End If
         With LY0
            .x1 = 0
            .x2 = PIC.Width
            .y1 = MaxVPHeight - MaxVPHeight * ylonew
            If ylo = 0 Then .y1 = .y1 - 1
            .y2 = .y1
         End With
         With LY1
            .x1 = 0
            .x2 = PIC.Width
            .y1 = MaxVPHeight - MaxVPHeight * ylonew
            If ylo = 0 Then .y1 = .y1 - 1
            .y2 = .y1
         End With
   Else
      LY0.Visible = False
      LY1.Visible = False
   End If
End Sub

Public Sub DrawHairs(PIC As PictureBox, x As Single, y As Single, LX0 As Line, LY0 As Line, LX1 As Line, LY1 As Line)
' From picDRAW_MouseMove, DRAW Mode, aCrossHairs True
   With LX0
      .x1 = x
      .x2 = x
      .y1 = 0
      .y2 = PIC.Height
      .Visible = True
   End With
   With LX1
      .x1 = x
      .x2 = x
      .y1 = 0
      .y2 = PIC.Height
      .Visible = True
   End With
   
   With LY0
      .x1 = 0
      .x2 = PIC.Width
      .y1 = y
      .y2 = y
      .Visible = True
   End With
   With LY1
      .x1 = 0
      .x2 = PIC.Width
      .y1 = y
      .y2 = y
      .Visible = True
   End With
End Sub

Public Sub DrawDiagHairs(PIC As PictureBox, x As Single, y As Single, LX0 As Line, LY0 As Line, LX1 As Line, LY1 As Line)
' From picDRAW_MouseMove, DRAW Mode, aDiagHairs True
   With LX0
      .x1 = x - y
      .y1 = 0
      .x2 = x - y + PIC.Height
      .y2 = PIC.Height
      .Visible = True
   End With
   With LX1
      .x1 = x - y
      .y1 = 0
      .x2 = x - y + PIC.Height
      .y2 = PIC.Height
      .Visible = True
   End With
   With LY0
      .x1 = x + y
      .y1 = 0
      .x2 = x + y - PIC.Height
      .y2 = PIC.Height
      .Visible = True
   End With
   With LY1
      .x1 = x + y
      .y1 = 0
      .x2 = x + y - PIC.Height
      .y2 = PIC.Height
      .Visible = True
   End With
End Sub


Public Sub FillDataArrays(InPic As PictureBox)
' InPic = Form1.picDRAW
Dim ix As Long, iy As Long, yo As Long
Dim BDATA As BITMAPINFOHEADER
Dim NScans As Long
Dim mHDC As Long, mBMPold As Long, mOldbmp As Long
   With BDATA
      .biSize = 40
      .biPlanes = 1
      .biWidth = InPic.Width
      .biHeight = InPic.Height
      .biBitCount = 32
   End With
   ReDim picDATAREG(0 To 3, 0 To InPic.Width - 1, 0 To InPic.Height - 1)
   
   ' Transfer pixel colors in InPic to picDATAREG()
    
'   ' Original OK in WinXP not WinME
'   If GetDIBits(Form1.hDC, InPic.Image, 0, _
'      InPic.Height, picDATAREG(0, 0, 0), BHIDATAREG, 0) = 0 Then
'      MsgBox "DIB ERROR", vbCritical, "in Sub FillDataArrays"
'      Exit Sub
'   End If

'  This works in Win ME !
   ' Transfer pixel colors in InPic to picDATAREG()
    mHDC = CreateCompatibleDC(0)
    mBMPold = CreateDIBSection(mHDC, BDATA, 0, 0&, 0&, 0&)
    mOldbmp = SelectObject(mHDC, mBMPold)
    BitBlt mHDC, 0, 0, InPic.Width, InPic.Height, InPic.hDC, 0, 0, vbSrcCopy
    NScans = GetDIBits(mHDC, mBMPold, 0, InPic.Height, picDATAREG(0, 0, 0), BDATA, 0)
    SelectObject mHDC, mBMPold
    DeleteDC mHDC
    DeleteObject mOldbmp
    DeleteObject mBMPold

' Try simpler now  ' didn't work in ME ???
'Dim mHDC As Long, mBMPold As Long
'   mHDC = CreateCompatibleDC(0)
'   mBMPold = SelectObject(mHDC, InPic.Image)
'   GetDIBits mHDC, InPic.Image, 0, InPic.Height, picDATAREG(0, 0, 0), BDATA, 0
'   SelectObject mHDC, mBMPold
'   DeleteDC mHDC


' prevDATA() (image of picDRAW) setup in TRANSDATA which is called from lots inc main Scroll bars
   ' (Transparency 0.0 to 0.9) Larger transparency values gives fainter strokes
   If GlobTrans = 1 Then
   If Transparency <> 0 Then
      For iy = 0 To InPic.Height - 1
      For ix = 0 To InPic.Width - 1
         If picDATAREG(0, ix, iy) <> prevDATA(0, ix, iy) Or _
            picDATAREG(1, ix, iy) <> prevDATA(1, ix, iy) Or _
            picDATAREG(2, ix, iy) <> prevDATA(2, ix, iy) Then
            
            picDATAREG(0, ix, iy) = _
               Transparency * (1& * prevDATA(0, ix, iy) - picDATAREG(0, ix, iy)) + picDATAREG(0, ix, iy)
            picDATAREG(1, ix, iy) = _
               Transparency * (1& * prevDATA(1, ix, iy) - picDATAREG(1, ix, iy)) + picDATAREG(1, ix, iy)
            picDATAREG(2, ix, iy) = _
               Transparency * (1& * prevDATA(2, ix, iy) - picDATAREG(2, ix, iy)) + picDATAREG(2, ix, iy)
         End If
      Next ix
      Next iy
      
   
   End If
   End If
   ' Transfer section of picDRAW (ie InPic) ie picDATAREG() to picDATA()
   yo = ylo
   For iy = 0 To InPic.Height - 1
      CopyMemory picDATA(0, xlo, yo), picDATAREG(0, 0, iy), 4 * InPic.Width
      yo = yo + 1
   Next iy

   If GlobTrans = 1 Then
      'Transparency: always needed in case transparency changed between drawings
      ReDim ModPublics.prevDATA(0 To 3, 0 To InPic.Width - 1, 0 To InPic.Height - 1)
      
      prevDATA() = picDATAREG()
   
      If Transparency <> 0 Then
         Call StretchDIBits(InPic.hDC, _
         0, 0, _
         InPic.Width, InPic.Height, _
         0, 0, _
         InPic.Width, InPic.Height, _
         prevDATA(0, 0, 0), _
         BDATA, 0, vbSrcCopy)     'BHIDATAREG <<<<<<<<<<
         InPic.Picture = InPic.Image
      End If
   End If

End Sub


