Attribute VB_Name = "ModLoadPicture"
' ModLoadPicture.bas

Option Explicit

Private anERR As Boolean
Private FileSize As Long

Dim ThePic As StdPicture
Dim CommonDialog1 As cOSDialog

'EG If Not LoadThePicture(Form1,  aLoadAgain) Then

' Public FullW As Long, FullH As Long     ' Image width & height
' Fills picDATAORG()

Public Function LoadThePicture(frm As Form, OBT As Integer, Optional aLoadAgain As Boolean = False) As Boolean
' Public BHI As BITMAPINFOHEADER   - see ModAPI.bas
' Public tBitmap As BITMAP
' Could be private: BHI also used in DISPLAY on Form1
' OBT 1 Open, 10 Browse, 11 Thumbnail viewer

' Note: Form1.hdc used. Could Create a DC instead.
Dim Title$, Filt$, InDir$
Dim FIndex As Long
Dim TempSpec$
Dim PW As Long, PH As Long
Dim r As RECT
Dim mHDC As Long, mBMPold As Long
Dim Message$

   anERR = False
   On Error GoTo FileError
   
   TempSpec$ = FileSpec$
   If Not aLoadAgain Then
      If OBT = 1 Then ' Open
         Title$ = "Open a picture file"
         If Not aHasGDI Then
            Filt$ = "Pics bmp,jpg,jpeg,gif|*.bmp;*.jpg;*.jpeg;*.gif|"
            Filt$ = Filt$ & "bmp|*.bmp|"
            Filt$ = Filt$ & "jpg|*.jpg|"
            Filt$ = Filt$ & "jpeg|*.jpeg|"
            Filt$ = Filt$ & "gif|*.gif"
         Else
            Filt$ = "Pics bmp,jpg,jpeg,gif,png,tif,tiff|*.bmp;*.jpg;*.jpeg;*.gif;*.png;*.tif;*.tiff|"
            Filt$ = Filt$ & "bmp|*.bmp|"
            Filt$ = Filt$ & "jpg|*.jpg|"
            Filt$ = Filt$ & "jpeg|*.jpeg|"
            Filt$ = Filt$ & "gif|*.gif|"
            Filt$ = Filt$ & "png|*.png|"
            Filt$ = Filt$ & "tif|*.tif"
            Filt$ = Filt$ & "tiff|*.tiff"
         End If
         FileSpec$ = ""
         InDir$ = CurrPath$ 'Pathspec$
         Set CommonDialog1 = New cOSDialog
         CommonDialog1.ShowOpen FileSpec$, Title$, Filt$, InDir$, "", frm.hwnd, FIndex
      '   FIndex = 1 bmp, 2 jpg, 3 jpeg, 4 gif   NO, only when opened in separate items
      '                                          in drop-down list.
         Set CommonDialog1 = Nothing  ' Returns FileSpec$
      ElseIf OBT = 10 Then ' Browse
      ' OR BROWSER
         frmBrowse.Hide
         frmBrowse.Show vbModal   ' Returns FileSpec$  & ImageSpec$ = FileSpec$
      ElseIf OBT = 11 Then ' Thumbnail
         frmThumb.Hide
         frmThumb.Show vbModal   ' Returns FileSpec$  & ImageSpec$ = FileSpec$
      
      End If
      
      ' Avoid click through
      GetWindowRect Form1.cmdDrawZoom.hwnd, r
      SetCursorPos r.Left + 10, r.TOp + 10
      
      If Len(FileSpec$) = 0 Then
         ' Cancel or Error
         Screen.MousePointer = vbDefault
         FileSpec$ = TempSpec$  ' To preserve any last opened filespec
         'LabFilter = "Filters"
         On Error GoTo 0
         Exit Function     ' False
      End If
      CurrPath$ = GetPath(FileSpec$)
   End If
   
   Screen.MousePointer = vbHourglass
   Message$ = ""
   ModPublics.CheckFile FileSpec$, Message$
   
   If Message$ <> "" Then
      Set ThePic = LoadPicture
      Set ThePic = Nothing
      LoadThePicture = False
      Err.Clear
      On Error GoTo 0
      Screen.MousePointer = vbDefault
      MsgBox Message$, vbCritical, "PaintRR Loading Main image"
      Exit Function
   End If
   
   LoadIt FileSpec$
   
   If FileSpec$ = "" Then
      Set ThePic = LoadPicture
      Set ThePic = Nothing
      LoadThePicture = False
      Err.Clear
      On Error GoTo 0
      Screen.MousePointer = vbDefault
      If FileSize > 15000000 Then
         MsgBox "Picture size =" & Str$(FileSize) & " B - too big !  ", vbInformation, "PaintRR Load picture"
      End If
      Exit Function
   End If
   
   If anERR Then
      ' Overdone ??
      Set ThePic = LoadPicture
      Set ThePic = Nothing
      LoadThePicture = False
      Err.Clear
      Screen.MousePointer = vbDefault
      MsgBox "Invalid file ", vbCritical, "PaintRR Loading Main image"
      Exit Function
   End If
   'If Err.Number = 481 Then GoTo FileError
   If GetObject(ThePic, Len(tBitmap), tBitmap) = 0 Then
      Screen.MousePointer = vbDefault
      Set ThePic = Nothing
      MsgBox "FILE ERROR", vbCritical, "Loading Main image"
      On Error GoTo 0
      Exit Function
   End If
   PW = tBitmap.bmWidth
   PH = tBitmap.bmHeight
   
   If PW < 8 Or PH < 8 Then
      Screen.MousePointer = vbDefault
      Set ThePic = Nothing
      MsgBox "Picture size too small ie < 8x8 ", vbInformation, "Loading Main image"
      On Error GoTo 0
      Exit Function
   End If
   ' Set Public FullW & FullH
   FullW = PW
   FullH = PH
   
   ReDim picDATAORG(0 To 3, 0 To FullW - 1, 0 To FullH - 1)
   
   ' Copy image colors to picDATAORG()
   With BHI
      .biSize = 40
      .biPlanes = 1
      .biWidth = FullW
      .biHeight = FullH
      .biBitCount = 32
   End With
   mHDC = CreateCompatibleDC(0)
   mBMPold = SelectObject(mHDC, ThePic.handle)
   GetDIBits mHDC, ThePic.handle, 0, FullH, picDATAORG(0, 0, 0), BHI, 0
   SelectObject mHDC, mBMPold
   DeleteDC mHDC
   DeleteObject mBMPold
   
   Set ThePic = Nothing
   Screen.MousePointer = vbDefault
   LoadThePicture = True
   On Error GoTo 0
   Exit Function
'=======
FileError:
      
'      If Err.Number = 481 Then
'         anERR = True
'         MsgBox "FILE ERROR Err number = " & Str$(Err.Number), vbCritical, "PaintRR Loading Main image"
'         Resume Next
'      End If
'
      Screen.MousePointer = vbDefault
      Set ThePic = Nothing
      MsgBox "FILE ERROR", vbCritical, "PaintRR Loading Main image"
      LoadThePicture = False
'
'
'      Err.Clear
'      On Error GoTo 0
'      Exit Function

End Function

Private Sub LoadIt(TheFile$)
' This seems to prevent fatal error in EXE
' with Err = 481  Invalid picture
Dim Ext$

On Error GoTo LoadError
   
   Ext$ = LCase$(FindExtension$(TheFile$))
   FileSize = FileLen(TheFile$)
   If FileSize > 15000000 Then
      TheFile$ = ""
      Exit Sub
   End If
   
   Select Case Ext$
   Case "bmp", "gif", "jpg", "jpeg"
      Set ThePic = New StdPicture
      Set ThePic = LoadPicture(TheFile$)
   Case "png", "tif", "tiff"
      If Not aHasGDI Then
         TheFile$ = ""
         Exit Sub
      Else
         Set ThePic = LoadPictureGDIPlus(TheFile$, RightColor)
      End If
   End Select
   
   Exit Sub
'============
LoadError:
   anERR = True
   Resume Next
End Sub

Public Function CheckLoadImage(FSpec$) As Boolean
Dim Ext$
   CheckLoadImage = False   ' Default
   Ext$ = LCase$(FindExtension$(FSpec$))
   If Not aHasGDI Then
      Select Case Ext$
      Case "bmp", "jpg", "gif", "jpeg"
      Case Else
         MsgBox "Not bmp, jpg, jpeg or gif", vbCritical, "Loading"
         Exit Function
      End Select
   Else
      Select Case Ext$
      Case "bmp", "jpg", "gif", "jpeg", "png", "tif", "tiff"
      Case Else
         MsgBox "Not bmp, jpg, jpeg, gif, png, tif or tiff", vbCritical, "Loading"
         Exit Function
      End Select
   End If
   
   CheckLoadImage = True
End Function

Public Sub GetImage(frm As Form) ' Into picSelect
' Use Browser instead of CommonDialog
' From
' Merge (Form1 LABMNU 13)      (ImageSpec$)
' frmSculpture cmdOpen_Click   (ImageSpec$)
' frmUFill cmdGetFillImage_Click      (ImageSpec$)

' Public ImageSpec$
Dim k As Long
Dim Ext$

   On Error GoTo ImageError
   
   If aSculpture Then frmSculpture.Hide
   If aImageFiller Then frmStampBrush.Hide 'frmUFill.Hide
   If aStamp Then frmStampBrush.Hide
   
   frmBrowse.Hide
   frmBrowse.Show vbModal  'Returns ImageSpec$
   
   Ext$ = LCase$(FindExtension$(ImageSpec$))
  
   If aSculpture Then frmSculpture.Show
   If aImageFiller Then frmStampBrush.Show 'frmUFill.Show
   If aStamp Then frmStampBrush.Show
   
   ' Avoid click through
'   GetWindowRect Form1.cmdDrawZoom.hwnd, r
'   SetCursorPos r.Left + 10, r.Top + 10
   
   If Len(ImageSpec$) = 0 And aFromClipboard = False Then
      ' Cancel or Error
      Screen.MousePointer = vbDefault
      'LabFilter = "Filters"
      Exit Sub
   End If
   ' Have an ImageSpec$
   CurrPath$ = GetPath(ImageSpec$)
   
   frm.picSelect.AutoSize = True
   frm.picSelect.BackColor = RightColor
   
   If aMerge Or aSculpture Then
      If aFromClipboard Then
         frm.picSelect.Picture = Clipboard.GetData(vbCFBitmap)
      Else
         Select Case Ext$
         Case "bmp", "gif", "jpg", "jpeg"
             frm.picSelect.Picture = LoadPicture(ImageSpec$)
         Case "ico"
             frm.picSelect.Picture = LoadPicture(ImageSpec$, 1)
         Case "png", "tif", "tiff"
             Set frm.picSelect = LoadPictureGDIPlus(ImageSpec$, RightColor)
         End Select
      End If
   Else  'Stamp,Brush
      frm.picSelect.Picture = LoadPicture(ImageSpec$)
   End If
   
   If frm.picSelect.Width > frm.picDRAW.Width Or _
      frm.picSelect.Height > frm.picDRAW.Height Then
      MsgBox "Image larger than viewport", vbCritical, "Image loading"
      ImageSpec$ = ""
      Clear_picSelect frm
   ElseIf frm.picSelect.Width < 8 Or _
         frm.picSelect.Height < 8 Then
      MsgBox "Picture size too small ie < 8x8 ", vbInformation, "Loading image"
      ImageSpec$ = ""
      Clear_picSelect frm
   ElseIf aMerge Then      ' ie Layer
      ' Move picSelect onto picDraw
      With frm.picSelect
         .Visible = True
         .Refresh
         .Left = 0 'frm.picDRAW.Left
         .TOp = 0 'frm.picDRAW.Top
      End With
      ' Show select rectangle
      For k = 0 To 1
         frm.SHP(k).Left = frm.picSelect.Left
         frm.SHP(k).TOp = frm.picSelect.TOp
         frm.SHP(k).Width = frm.picSelect.Width
         frm.SHP(k).Height = frm.picSelect.Height
      Next k
   End If
   Screen.MousePointer = vbDefault
   Exit Sub
'=======
ImageError:
'   If aHasGDI And Ext$ = "ico" Then
'      frm.picSelect.Picture = LoadPicture(ImageSpec$)
'      Resume Next
'   End If
'
   MsgBox "Error reading this file ", vbCritical, "In ModLoadPicture"
   ImageSpec$ = ""
End Sub

