Attribute VB_Name = "mExGraphics"
Option Explicit
' API declarations
Public Const STRETCH_ANDSCANS = 1
Public Const STRETCH_ORSCANS = 2
Public Const STRETCH_DELETESCANS = 3
Public Const STRETCH_HALFTONE = 4

Public Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Public Declare Function BitBlt Lib "gdi32" _
  (ByVal hDCDest As Long, _
   ByVal XDest As Long, _
   ByVal YDest As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal hDCSrc As Long, _
   ByVal XSrc As Long, _
   ByVal YSrc As Long, _
   ByVal dwRop As Long) As Long

Public Declare Function CreateBitmap Lib "gdi32" _
  (ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal nPlanes As Long, _
   ByVal nBitCount As Long, _
   lpBits As Any) As Long

Public Declare Function CreateCompatibleBitmap Lib "gdi32" _
   (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Public Declare Function CreateCompatibleDC Lib "gdi32" _
   (ByVal hdc As Long) As Long

Public Declare Function DeleteDC Lib "gdi32" _
   (ByVal hdc As Long) As Long

Public Declare Function DeleteObject Lib "gdi32" _
   (ByVal hObject As Long) As Long

Public Declare Function RealizePalette Lib "gdi32" _
   (ByVal hdc As Long) As Long
   
Public Declare Function SelectObject Lib "gdi32" _
   (ByVal hdc As Long, ByVal hObject As Long) As Long

Public Declare Function SelectPalette Lib "gdi32" _
   (ByVal hdc As Long, _
    ByVal hPalette As Long, _
    ByVal bForceBackground As Long) As Long

Public Declare Function SetBkColor Lib "gdi32" _
   (ByVal hdc As Long, ByVal crColor As Long) As Long

Public Declare Function SetStretchBltMode Lib "gdi32" _
   (ByVal hdc As Long, _
    ByVal nStretchMode As Long) As Long

Public Declare Function StretchBlt Lib "gdi32" _
  (ByVal hDCDest As Long, _
   ByVal XDest As Long, _
   ByVal YDest As Long, _
   ByVal nDestWd As Long, _
   ByVal nDestHt As Long, _
   ByVal hDCSrc As Long, _
   ByVal XSrc As Long, _
   ByVal YSrc As Long, _
   ByVal nSrcWd As Long, _
   ByVal nSrcHt As Long, _
   ByVal dwRop As Long) As Long

Type MonstPicDataType
   PicType As Integer         'width/height 1-1x1; 2-2x1; 3-1x2; 4-2x2
   PicNum As Integer          'first picture row in monstpics
End Type

' Stuff for picMap picturebox on frmMain
Public Type MapDataType
   Terrain As Byte
   Flags(5) As Boolean        ' start, wandering, top, left, bottom, right
   Special As Integer
   Sign As Integer
   Area(11) As Boolean        ' Area.L,T,R,B; Town.L,T,R,B; Save.L,T,R,B
   Town As Integer
   Field(13) As Integer       ' One position for each type of field
   Transport As Integer       ' 0-23 - Boats, 100-123 - Horses
   NItems As Integer          ' number of items in a cell
   Item() As Integer          ' likely more in the game, but not at design time
   NMonst As Integer          ' number of monsters in a cell
   Monst() As Integer         ' possibly more, not likely
End Type

'Public ErrMsg As String

Public MapCenter(1) As Byte   ' X, Y
Public MapContext As Integer  ' 0- Lg town, 1- Med Town, 2 - Sm Town, 3 - Outside
Public MapSize As Integer     ' 63- Lg town, 47- Med town, 31- Sm town, 47- Outside
Public MapZoom As Boolean     ' False - Area view, True - Close up
Public MapRange(3) As Byte    ' L,T,R,B
Public MapLimit(1) As Byte    ' L/T limit, R/B limit
Public MapData() As MapDataType
Public FieldPicData(13) As Integer
Public MonstPicData(174) As MonstPicDataType
Public TerrPicData(29) As Integer
Public flgCustomGraphics As Boolean
Public imgMarblePics As StdPicture
Public imgScenPics As StdPicture

Private Sub CalcCustMonstPic(ByVal PicNum As Integer, PicX As Integer, PicY As Integer)
   PicX = Int(PicNum Mod 10) * 28
   PicY = Int(PicNum / 10) * 36
End Sub

Private Sub CalcMonstPic(ByVal PicNum As Integer, PicSet As Integer, PicX As Integer, PicY As Integer)
   Dim PicOne As Integer
   
   PicSet = Int(PicNum / 20)
   PicOne = Int(PicNum Mod 20)
   PicX = Int(PicOne / 10) * 56
   PicY = Int(PicOne Mod 10) * 36
End Sub

Private Sub CalcTerrPic(ByVal PicNum As Integer, PicSet As Integer, PicX As Integer, PicY As Integer)
   Dim PicOne As Integer
   
   PicSet = Int(PicNum / 50)
   PicOne = Int(PicNum Mod 50)
   PicX = Int(PicOne / 10) * 28
   PicY = Int(PicOne Mod 10) * 36
End Sub

Private Function CheckRoad(ByVal Terrain As Integer) As Boolean
   Dim PicNum As Integer
   
   CheckRoad = False
   PicNum = TerrDef(Terrain).Pict
   Select Case PicNum
      Case 61, 62, 63, 64, 65, 66, 401, 402    ' bridges
         CheckRoad = True
      Case 202, 203, 204, 215                  ' road/walkways
         CheckRoad = True
      Case 90, 91, 92, 93, 102, 103, 104, 105, 112, 113, 114, 115 'doors
          CheckRoad = True
       Case 187, 188, 189, 190, 191, 197, 200, 201, 232, 236, 239  ' towns
          CheckRoad = True
       Case 192, 193, 194, 195, 196, 240, 241, 242, 243, 244 ' caverns
          CheckRoad = True
       Case 207, 208, 209, 210, 211, 212 ' specials
          CheckRoad = True
    End Select
End Function


Public Sub InitGraphics()
   Dim IX As Integer
   Dim IY As Integer
   
   Set imgMarblePics = LoadPicture(App.Path & "\Images\marble.bmp")
   Set imgScenPics = LoadPicture(App.Path & "\Images\scenpics.bmp")
   
   Set frmPics.imgCustomPics = Nothing
   Set frmPics.imgButtons = LoadPicture(App.Path & "\Images\buttons.bmp")
   Set frmPics.imgDlgButtonPics = LoadPicture(App.Path & "\Images\dlogbtns.bmp")
   Set frmPics.imgDlogPics = LoadPicture(App.Path & "\Images\dlogpics.bmp")
   Set frmPics.imgFieldpics = LoadPicture(App.Path & "\Images\fields.bmp")
   Set frmPics.imgMonstpics(0) = LoadPicture(App.Path & "\Images\monst1.bmp")
   Set frmPics.imgMonstpics(1) = LoadPicture(App.Path & "\Images\monst2.bmp")
   Set frmPics.imgMonstpics(2) = LoadPicture(App.Path & "\Images\monst3.bmp")
   Set frmPics.imgMonstpics(3) = LoadPicture(App.Path & "\Images\monst4.bmp")
   Set frmPics.imgMonstpics(4) = LoadPicture(App.Path & "\Images\monst5.bmp")
   Set frmPics.imgMonstpics(5) = LoadPicture(App.Path & "\Images\monst6.bmp")
   Set frmPics.imgMonstpics(6) = LoadPicture(App.Path & "\Images\monst7.bmp")
   Set frmPics.imgMonstpics(7) = LoadPicture(App.Path & "\Images\monst8.bmp")
   Set frmPics.imgMonstpics(8) = LoadPicture(App.Path & "\Images\monst9.bmp")
   Set frmPics.imgMonstpics(9) = LoadPicture(App.Path & "\Images\monst10.bmp")
   Set frmPics.imgObjectpics = LoadPicture(App.Path & "\Images\objects.bmp")
   Set frmPics.imgTalkPics = LoadPicture(App.Path & "\Images\talkport.bmp")
   Set frmPics.imgTinyobjpics = LoadPicture(App.Path & "\Images\tinyobj.bmp")
   Set frmPics.imgTerDisp = LoadPicture(App.Path & "\Images\terdisp.bmp")
   Set frmPics.imgTerpics(0) = LoadPicture(App.Path & "\Images\ter1.bmp")
   Set frmPics.imgTerpics(1) = LoadPicture(App.Path & "\Images\ter2.bmp")
   Set frmPics.imgTerpics(2) = LoadPicture(App.Path & "\Images\ter3.bmp")
   Set frmPics.imgTerpics(3) = LoadPicture(App.Path & "\Images\ter4.bmp")
   Set frmPics.imgTerpics(4) = LoadPicture(App.Path & "\Images\ter5.bmp")
   Set frmPics.imgTerpics(5) = LoadPicture(App.Path & "\Images\ter6.bmp")
   Set frmPics.imgTeranimpics = LoadPicture(App.Path & "\Images\teranim.bmp")
   Set frmPics.imgTinyTerr = LoadPicture(App.Path & "\Images\tinyterr.bmp")
   
   FieldPicData(0) = 5
   FieldPicData(1) = 6
   FieldPicData(2) = 7
   FieldPicData(3) = 16
   FieldPicData(4) = 18
   FieldPicData(5) = 15
   FieldPicData(6) = 24
   FieldPicData(7) = 25
   FieldPicData(8) = 26
   FieldPicData(9) = 27
   FieldPicData(10) = 28
   FieldPicData(11) = 29
   FieldPicData(12) = 30
   FieldPicData(13) = 31
      
   IY = 0
   For IX = 0 To 174
      MonstPicData(IX).PicNum = IY
      Select Case IX
      Case 120, 140, 142                     ' 2x2
         MonstPicData(IX).PicType = 4
         IY = IY + 3
      Case 51, 52, 53, 54, 78, 114, 115, 145 ' 1x2
         MonstPicData(IX).PicType = 3
         IY = IY + 1
      Case 75, 103, 107, 112, 123, 143, 144  ' 2x1
         MonstPicData(IX).PicType = 2
         IY = IY + 1
      Case Else                              ' 1x1
         MonstPicData(IX).PicType = 1
      End Select
      IY = IY + 1
   Next IX
   For IX = 0 To 29
      TerrPicData(IX) = -1
   Next IX
   TerrPicData(1) = 29
   TerrPicData(2) = 14
   TerrPicData(3) = 15
   TerrPicData(4) = 16
   TerrPicData(5) = 28
   TerrPicData(6) = 22
   TerrPicData(7) = 20
   TerrPicData(8) = 26
   TerrPicData(9) = 26
   TerrPicData(10) = 26
   TerrPicData(11) = 17
   TerrPicData(14) = 19
   TerrPicData(16) = 12
   TerrPicData(17) = 13
   TerrPicData(18) = 10
   TerrPicData(19) = 11
   TerrPicData(20) = 21
   TerrPicData(21) = 18
   TerrPicData(24) = 29
   TerrPicData(25) = 23
   TerrPicData(26) = 24
End Sub

Public Sub LoadCustomGraphics(ByVal Filename As String)
   Dim IX As Integer
   Dim PicX As Integer
   Dim PicY As Integer
   Dim EOF As Boolean
   Dim XXX As StdPicture
   
   On Error Resume Next
   Set frmPics.imgCustomPics = LoadPicture(Filename)
   flgCustomGraphics = True
   If Err.Number Then
      Set frmPics.imgCustomPics = Nothing
      flgCustomGraphics = False
      Exit Sub
   End If
End Sub

Public Sub PaintBoat(obj As Object, ByVal PicNum As Integer, _
      ByVal objx As Integer, ByVal objy As Integer)
   Dim PicOne As Integer
   Dim PicRect As RECT
   
   PicRect.Left = PicNum * 28
   PicRect.Top = 252
   PicRect.Right = PicRect.Left + 28
   PicRect.Bottom = PicRect.Top + 36
   TransparentBlt obj.hdc, obj.hdc, frmPics.imgFieldpics.hdc, PicRect, objx, objy
End Sub

Public Sub PaintCustomDlogPic(obj As Object, ByVal PicNum As Integer)
   Dim PicOne As Integer
   Dim PicX As Integer
   Dim PicY As Integer
   
   PicOne = PicNum
   PicX = Int(PicOne Mod 10) * 28
   PicY = Int(PicOne / 10) * 36
   nRet = StretchBlt(obj.hdc, 0, 0, 16, 32, _
      frmPics.imgCustomPics.hdc, PicX, PicY, 16, 32, vbSrcCopy)
   PicOne = PicOne + 1
   PicX = Int(PicOne Mod 10) * 28
   PicY = Int(PicOne / 10) * 36
   nRet = StretchBlt(obj.hdc, 16, 0, 16, 32, _
      frmPics.imgCustomPics.hdc, PicX, PicY, 16, 32, vbSrcCopy)
End Sub

Public Sub PaintCustomPic(obj As Object, ByVal PicNum As Integer, _
      ByVal objx As Integer, ByVal objy As Integer, ByVal PicSize As Integer)
   Dim PicX As Integer
   Dim PicY As Integer
   
   PicX = Int(PicNum Mod 10) * 28
   PicY = Int(PicNum / 10) * 36
   Select Case PicSize
   Case 0
      nRet = StretchBlt(obj.hdc, objx, objy, 28, 36, _
         frmPics.imgCustomPics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
   Case 1
      nRet = StretchBlt(obj.hdc, objx, objy, 16, 16, _
         frmPics.imgCustomPics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
   End Select
End Sub

Public Sub PaintCustomTalkPic(obj As Object, ByVal PicNum As Integer)
   Dim PicOne As Integer
   Dim PicX As Integer
   Dim PicY As Integer
   
   PicOne = PicNum
   PicX = Int(PicOne Mod 10) * 28
   PicY = Int(PicOne / 10) * 36
   nRet = StretchBlt(obj.hdc, 0, 0, 18, 36, _
      frmPics.imgCustomPics.hdc, PicX, PicY, 18, 36, vbSrcCopy)
   PicOne = PicOne + 1
   PicX = Int(PicOne Mod 10) * 28
   PicY = Int(PicOne / 10) * 36
   nRet = StretchBlt(obj.hdc, 18, 0, 18, 36, _
      frmPics.imgCustomPics.hdc, PicX, PicY, 18, 36, vbSrcCopy)
End Sub

Public Sub PaintCustomZPic(obj As Object, ByVal PicNum As Integer, _
      ByVal objx As Integer, ByVal objy As Integer)
   Dim PicX As Integer
   Dim PicY As Integer
   
   PicX = Int(PicNum Mod 10) * 28
   PicY = Int(PicNum / 10) * 36
   nRet = StretchBlt(obj.hdc, objx, objy, 6, 6, _
      frmPics.imgCustomPics.hdc, PicX, PicY + 6, 28, 18, vbSrcCopy)
End Sub

Public Sub PaintDialogPic(obj As Object, ByVal PicNum As Integer)
   Dim PicOne As Integer
    
   If PicNum < 253 Then          ' Terrain picture in dialog
      PaintTerrain obj, PicNum, 0, 0
   ElseIf PicNum < 400 Then
      Exit Sub
   ElseIf PicNum < 573 Then      ' Monster picture in dialog
      PicOne = PicNum - 400
      PaintMonsterDlog obj, PicOne
   ElseIf PicNum < 800 Then
      Exit Sub
   Else                          ' Dlog picture in dialog
      PicOne = PicNum - 800
      PaintDlogPic obj, PicOne
   End If
End Sub

Public Sub PaintDlogPic(obj As Object, ByVal PicNum As Integer)
   Dim PicX As Integer
   Dim PicY As Integer

   PicX = Int(PicNum Mod 4) * 36
   PicY = Int(PicNum / 4) * 36
   nRet = StretchBlt(obj.hdc, 0, 0, 36, 36, _
      frmPics.imgDlogPics.hdc, PicX, PicY, 36, 36, vbSrcCopy)
End Sub

Public Sub PaintField(obj As Object, ByVal FldNum As Integer, _
   ByVal objx As Integer, ByVal objy As Integer)
   Dim PicNum As Integer
   Dim PicRect As RECT
   
   PicNum = FieldPicData(FldNum)
   PicRect.Left = Int(PicNum Mod 8) * 28
   PicRect.Top = Int(PicNum / 8) * 36
   PicRect.Right = PicRect.Left + 28
   PicRect.Bottom = PicRect.Top + 36
   TransparentBlt obj.hdc, obj.hdc, frmPics.imgFieldpics.hdc, PicRect, objx, objy
End Sub

Public Sub PaintForm(frm As Object, ByVal Style As Integer)
   Dim objcontrol As Control
   Dim CellX As Integer
   Dim CellY As Integer
   Dim IX As Integer
   Dim IY As Integer
   Dim PicX As Integer
   Dim PicY As Integer
   CellX = frm.ScaleWidth / 64
   CellY = frm.ScaleHeight / 64
   PicX = Int(Style Mod 4) * 64
   PicY = Int(Style / 4) * 64
   For IX = 0 To CellX
      For IY = 0 To CellY
         frm.PaintPicture imgMarblePics, IX * 64, IY * 64, 64, 64, PicX, PicY, 64, 64
      Next IY
   Next IX
   Select Case Style
      Case 2, 6, 8
      For Each objcontrol In frm.Controls
         If TypeOf objcontrol Is Label Then
            objcontrol.ForeColor = &HFFFFFF
         End If
      Next objcontrol
   End Select
End Sub

Public Sub PaintHorse(obj As Object, ByVal PicNum As Integer, _
      ByVal objx As Integer, ByVal objy As Integer)
   Dim PicOne As Integer
   Dim PicRect As RECT
   
   PicRect.Left = 112 + (PicNum * 28)
   PicRect.Top = 252
   PicRect.Right = PicRect.Left + 28
   PicRect.Bottom = PicRect.Top + 36
   TransparentBlt obj.hdc, obj.hdc, frmPics.imgFieldpics.hdc, PicRect, objx, objy
End Sub


Public Sub PaintItem(obj As Object, ByVal PicNum As Integer, _
      ByVal objx As Integer, ByVal objy As Integer)
   Dim PicOne As Integer
   Dim PicX As Integer
   Dim PicY As Integer
   Dim PicRect As RECT

' Use objects.bmp for 1st 0 - 44
' Use tinyobj.bmp for the rest (45-122)
   If PicNum <= 44 Then
      PicX = Int(PicNum Mod 5) * 28
      PicY = Int(PicNum / 5) * 36
      PicRect.Left = PicX
      PicRect.Top = PicY
      PicRect.Right = PicX + 28
      PicRect.Bottom = PicY + 36
      TransparentBlt obj.hdc, obj.hdc, frmPics.imgObjectpics.hdc, PicRect, objx, objy
   ElseIf PicNum <= 122 Then
      PicX = Int(PicNum Mod 10) * 18
      PicY = Int(PicNum / 10) * 18
      PicRect.Left = PicX
      PicRect.Top = PicY
      PicRect.Right = PicX + 18
      PicRect.Bottom = PicY + 18
      TransparentBlt obj.hdc, obj.hdc, frmPics.imgTinyobjpics.hdc, _
         PicRect, objx + 5, objy + 9
   Else
      PicOne = PicNum - 150
      PicX = Int(PicOne Mod 10) * 28
      PicY = Int(PicOne / 10) * 36
      PicRect.Left = PicX
      PicRect.Top = PicY
      PicRect.Right = PicX + 28
      PicRect.Bottom = PicY + 36
      TransparentBlt obj.hdc, obj.hdc, frmPics.imgCustomPics.hdc, PicRect, objx, objy
   End If
End Sub

Public Sub PaintTinyObject(obj As Object, ByVal PicNum As Integer, _
      ByVal objx As Integer, ByVal objy As Integer)
' This is used for the item status screen
   Dim PicOne As Integer
   Dim PicX As Integer
   Dim PicY As Integer
   Dim PicRect As RECT

      PicX = Int(PicNum Mod 10) * 18
      PicY = Int(PicNum / 10) * 18
      PicRect.Left = PicX + 1
      PicRect.Top = PicY + 1
      PicRect.Right = PicX + 13
      PicRect.Bottom = PicY + 13
      TransparentBlt obj.hdc, obj.hdc, frmPics.imgTinyobjpics.hdc, _
         PicRect, objx, objy
End Sub

Public Sub PaintItemDlog(obj As Object, ByVal PicNum As Integer)
   Dim PicOne As Integer
   Dim PicX As Integer
   Dim PicY As Integer

' Use objects.bmp for 1st 0 - 44
' Use tinyobj.bmp for the rest (45-122)
   If PicNum < 0 Then
      obj.Cls
   ElseIf PicNum <= 44 Then
      PicX = Int(PicNum Mod 5) * 28
      PicY = Int(PicNum / 5) * 36
      nRet = StretchBlt(obj.hdc, 0, 0, 28, 36, _
         frmPics.imgObjectpics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
   ElseIf PicNum <= 122 Then
      PicX = Int(PicNum Mod 10) * 18
      PicY = Int(PicNum / 10) * 18
      obj.BackColor = &HFFFFFF
      nRet = StretchBlt(obj.hdc, 5, 9, 18, 18, _
         frmPics.imgTinyobjpics.hdc, PicX, PicY, 18, 18, vbSrcCopy)
   Else
      PicOne = PicNum - 150
      PicX = Int(PicOne Mod 10) * 28
      PicY = Int(PicOne / 10) * 36
      nRet = StretchBlt(obj.hdc, 0, 0, 28, 36, _
         frmPics.imgCustomPics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
   End If
End Sub

Public Sub PaintLine(obj As Object, ByVal LineNum As Integer, _
   ByVal objx As Integer, ByVal objy As Integer)
   Dim bX As Integer
   Dim bY As Integer
   Dim eX As Integer
   Dim eY As Integer
   Dim Color As Long
   
   Select Case LineNum
      Case 0, 4, 8:
         bX = 13
         bY = 17
         eX = 0
         eY = 17
      Case 1, 5, 9:
         bX = 13
         bY = 17
         eX = 13
         eY = 0
      Case 2, 6, 10:
         bX = 13
         bY = 17
         eX = 27
         eY = 17
      Case 3, 7, 11:
         bX = 13
         bY = 17
         eX = 13
         eY = 35
   End Select
   Select Case LineNum
      Case 0, 1, 2, 3:
         Color = vbRed
      Case 4, 5, 6, 7:
         Color = vbWhite
         bX = bX + 1
         bY = bY + 1
         eX = eX + 1
         eY = eY + 1
      Case 8, 9, 10, 11:
         Color = vbYellow
         bX = bX - 1
         bY = bY - 1
         eX = eX - 1
         eY = eY - 1
   End Select
   obj.Line (objx + bX, objy + bY)-(objx + eX, objy + eY), Color
End Sub

Public Sub PaintMap(obj As PictureBox)
   Dim ATX As Integer
   Dim ATY As Integer
   Dim IX As Integer
   Dim IY As Integer
   Dim MapX As Integer
   Dim MapY As Integer
   Dim Top As Integer
   Dim Left As Integer
   Dim Bottom As Integer
   Dim Right As Integer

   Left = MapCenter(0) - 4
   Top = MapCenter(1) - 4
   For IX = 0 To 8
      MapX = IX + Left
      ATX = IX * 28
      For IY = 0 To 8
         MapY = IY + Top
         ATY = IY * 36
         PaintMapCell obj, ATX, ATY, MapX, MapY
      Next IY
   Next IX
End Sub

Public Sub PaintMapZoom(obj As Object)
   Dim IX As Integer
   Dim IY As Integer
   Dim IX1 As Integer
   Dim IY1 As Integer
   Dim PicNum As Integer
   
   If MapContext < 3 Then
      For IX = 0 To MapSize
         For IY = 0 To MapSize
            PaintMapCell obj, IX * 6, IY * 6, IX, IY
         Next IY
      Next IX
   Else
      For IX = 0 To MapSize - 2
         For IY = 0 To MapSize - 2
            IX1 = IX + 1
            IY1 = IY + 1
            PaintMapCell obj, IX * 6, IY * 6, IX1, IY1
         Next IY
      Next IX
   End If
End Sub

Public Sub PaintMapCell(obj As PictureBox, ByVal ATX As Integer, ByVal ATY As Integer, _
      ByVal MapX As Integer, ByVal MapY As Integer)
   Dim NDX As Integer
   Dim FieldNum As Integer
   Dim ItemNum As Integer
   Dim MonstNum As Integer
   Dim PicNum As Integer
   Dim TerNum As Integer
   
   If MapX < 0 Then Exit Sub
   If MapX > MapSize Then Exit Sub
   If MapY < 0 Then Exit Sub
   If MapY > MapSize Then Exit Sub

   TerNum = MapData(MapX, MapY).Terrain
   PicNum = TerrDef(TerNum).Pict
   If MapZoom Then
      PaintTerrain obj, PicNum, ATX, ATY
   Else
      nRet = SetStretchBltMode(obj.hdc, STRETCH_DELETESCANS)
      PaintTerrainZoom obj, PicNum, ATX, ATY
      Exit Sub
   End If
   PicNum = TerrPicData(TerrDef(TerNum).SpProperty)
   Select Case TerrDef(TerNum).SpProperty
      Case 9, 10
         If TerrDef(TerNum).Extra2 < 5 Then
            PicNum = 26
         ElseIf TerrDef(TerNum).Extra2 < 10 Then
            PicNum = 27
         Else
            PicNum = 25
         End If
      Case 25, 26
         PicNum = -1
   End Select
   PaintTerrSp obj, PicNum, ATX + 21, ATY + 29
' Paint Roads
   Select Case TerNum
      Case 79, 80, 81
         If MapX > 0 Then
            If CheckRoad(MapData(MapX - 1, MapY).Terrain) Then
               PaintRoad obj, 0, ATX, ATY
            End If
         End If
         If MapX < MapSize Then
            If CheckRoad(MapData(MapX + 1, MapY).Terrain) Then
               PaintRoad obj, 1, ATX, ATY
            End If
         End If
         If MapY > 0 Then
            If CheckRoad(MapData(MapX, MapY - 1).Terrain) Then
               PaintRoad obj, 2, ATX, ATY
            End If
         End If
         If MapY < MapSize Then
            If CheckRoad(MapData(MapX, MapY + 1).Terrain) Then
               PaintRoad obj, 3, ATX, ATY
            End If
         End If
   End Select
' Start location
   If MapData(MapX, MapY).Flags(0) Then
      PaintTerrSp obj, 6, ATX, ATY + 29
   End If
' Wandering monster
   If MapData(MapX, MapY).Flags(1) Then
         PaintTerrSp obj, 4, ATX + 21, ATY + 14
   End If
' Town entry points
   For NDX = 0 To 3
      If MapData(MapX, MapY).Flags(2 + NDX) Then
         PaintTerrSp obj, NDX, ATX + (NDX * 7), ATY
      End If
   Next NDX
' Special location
   If MapData(MapX, MapY).Special > -1 Then
      PaintTerrSp obj, 5, ATX + 21, ATY + 21
   End If
   If MapContext = 3 Then GoTo MapAreas
' Fields
   With TownData(CurTown)
   For NDX = 0 To 13
      If MapData(MapX, MapY).Field(NDX) >= 0 Then
         FieldNum = .Field(MapData(MapX, MapY).Field(NDX)).Num
         PaintField obj, FieldNum, ATX, ATY
      End If
   Next NDX
' Items
   For NDX = 0 To MapData(MapX, MapY).NItems
      If MapData(MapX, MapY).Item(NDX) < 0 Then
         Exit For
      End If
      ItemNum = .Item(MapData(MapX, MapY).Item(NDX)).Type
      If ItemNum < 0 Then
         Exit For
      End If
      PicNum = ItemDef(ItemNum).Pict
      PaintItem obj, PicNum, ATX, ATY
   Next NDX
' Monsters
   For NDX = 0 To MapData(MapX, MapY).NMonst
      If MapData(MapX, MapY).Monst(0, NDX) > -1 Then
         MonstNum = .Monster(MapData(MapX, MapY).Monst(0, NDX)).Num
         PicNum = MonsterDef(MonstNum).Pict
         PaintMonster obj, PicNum, MapData(MapX, MapY).Monst(1, NDX), ATX, ATY
      End If
   Next NDX
   End With
' Boats/Horses
   If MapData(MapX, MapY).Transport = 0 Then
      PaintBoat obj, 0, ATX, ATY
   End If
   If MapData(MapX, MapY).Transport = 1 Then
      PaintHorse obj, 0, ATX, ATY
   End If
' Area lines
MapAreas:
   For NDX = 0 To 11
      If MapData(MapX, MapY).Area(NDX) Then
         PaintLine obj, NDX, ATX, ATY
      End If
   Next NDX
End Sub

Public Sub PaintMonster(obj As Object, ByVal PicNum As Integer, ByVal PicOffset As Integer, _
   ByVal objx As Integer, ByVal objy As Integer)
   Dim PicX As Integer
   Dim PicY As Integer
   Dim PicOne As Integer
   Dim PicSet As Integer
   Dim PicRect As RECT
      
   If PicNum < 1000 Then
      PicOne = MonstPicData(PicNum).PicNum + PicOffset
      CalcMonstPic PicOne, PicSet, PicX, PicY
      PicRect.Left = PicX
      PicRect.Top = PicY
      PicRect.Right = PicX + 28
      PicRect.Bottom = PicY + 36
      TransparentBlt obj.hdc, obj.hdc, frmPics.imgMonstpics(PicSet).hdc, PicRect, objx, objy
   Else
      If PicNum < 2000 Then
         PicOne = PicNum - 1000
      ElseIf PicNum < 3000 Then
         PicOne = PicNum - 2000
      ElseIf PicNum < 4000 Then
         PicOne = PicNum - 3000
      Else
         PicOne = PicNum - 4000
      End If
      PicOne = PicOne + PicOffset
      CalcCustMonstPic PicOne, PicX, PicY
      PicRect.Left = PicX
      PicRect.Top = PicY
      PicRect.Right = PicX + 28
      PicRect.Bottom = PicY + 36
      TransparentBlt obj.hdc, obj.hdc, frmPics.imgCustomPics.hdc, PicRect, objx, objy
   End If
End Sub

Public Sub PaintMonsterDlog(obj As Object, ByVal PicNum As Integer)
   Dim PicX As Integer
   Dim PicY As Integer
   Dim PicSet As Integer
   Dim PicOne As Integer
   Dim PicTyp As Integer

   obj.Cls
   obj.BackColor = &HFFFFFF
   If PicNum < 1000 Then
      PicOne = MonstPicData(PicNum).PicNum
      PicTyp = MonstPicData(PicNum).PicType
      nRet = SetStretchBltMode(obj.hdc, STRETCH_DELETESCANS)
      Select Case PicTyp
      Case 1               ' 1x1
         CalcMonstPic PicOne, PicSet, PicX, PicY
         nRet = StretchBlt(obj.hdc, 0, 0, 28, 36, _
            frmPics.imgMonstpics(PicSet).hdc, PicX, PicY, 28, 36, vbSrcCopy)
      Case 2               ' 2x1
         nRet = SelectPalette(obj.hdc, frmPics.imgMonstpics(0).Picture.hPal, False)
         nRet = RealizePalette(obj.hdc)
         CalcMonstPic PicOne, PicSet, PicX, PicY
         nRet = StretchBlt(obj.hdc, 0, 9, 14, 18, _
            frmPics.imgMonstpics(PicSet).hdc, PicX, PicY, 28, 36, vbSrcCopy)
         PicOne = PicOne + 1
         CalcMonstPic PicOne, PicSet, PicX, PicY
         nRet = StretchBlt(obj.hdc, 14, 9, 14, 18, _
            frmPics.imgMonstpics(PicSet).hdc, PicX, PicY, 28, 36, vbSrcCopy)
      Case 3               ' 1x2
         nRet = SelectPalette(obj.hdc, frmPics.imgMonstpics(0).Picture.hPal, False)
         nRet = RealizePalette(obj.hdc)
         CalcMonstPic PicOne, PicSet, PicX, PicY
         nRet = StretchBlt(obj.hdc, 7, 0, 14, 18, _
            frmPics.imgMonstpics(PicSet).hdc, PicX, PicY, 28, 36, vbSrcCopy)
         PicOne = PicOne + 1
         CalcMonstPic PicOne, PicSet, PicX, PicY
         nRet = StretchBlt(obj.hdc, 7, 18, 14, 18, _
            frmPics.imgMonstpics(PicSet).hdc, PicX, PicY, 28, 36, vbSrcCopy)
      Case 4               ' 2x2
         nRet = SelectPalette(obj.hdc, frmPics.imgMonstpics(0).Picture.hPal, False)
         nRet = RealizePalette(obj.hdc)
         CalcMonstPic PicOne, PicSet, PicX, PicY
         nRet = StretchBlt(obj.hdc, 0, 0, 14, 18, _
            frmPics.imgMonstpics(PicSet).hdc, PicX, PicY, 28, 36, vbSrcCopy)
         PicOne = PicOne + 1
         CalcMonstPic PicOne, PicSet, PicX, PicY
         nRet = StretchBlt(obj.hdc, 13, 0, 14, 18, _
            frmPics.imgMonstpics(PicSet).hdc, PicX, PicY, 28, 36, vbSrcCopy)
         PicOne = PicOne + 1
         CalcMonstPic PicOne, PicSet, PicX, PicY
         nRet = StretchBlt(obj.hdc, 0, 18, 14, 18, _
            frmPics.imgMonstpics(PicSet).hdc, PicX, PicY, 28, 36, vbSrcCopy)
         PicOne = PicOne + 1
         CalcMonstPic PicOne, PicSet, PicX, PicY
         nRet = StretchBlt(obj.hdc, 13, 18, 14, 18, _
            frmPics.imgMonstpics(PicSet).hdc, PicX, PicY, 28, 36, vbSrcCopy)
      End Select
   Else
      nRet = SetStretchBltMode(obj.hdc, STRETCH_DELETESCANS)
      nRet = SelectPalette(obj.hdc, frmPics.imgCustomPics.Picture.hPal, False)
      nRet = RealizePalette(obj.hdc)
      If PicNum < 2000 Then
         PicOne = PicNum - 1000
         PicTyp = 1
      ElseIf PicNum < 3000 Then
         PicOne = PicNum - 2000
         PicTyp = 2
      ElseIf PicNum < 4000 Then
         PicOne = PicNum - 3000
         PicTyp = 3
      Else
         PicOne = PicNum - 4000
         PicTyp = 4
      End If
      Select Case PicTyp
      Case 1               ' 1x1
         CalcCustMonstPic PicOne, PicX, PicY
         nRet = StretchBlt(obj.hdc, 0, 0, 28, 36, _
            frmPics.imgCustomPics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
      Case 2               ' 2x1
         CalcCustMonstPic PicOne, PicX, PicY
         nRet = StretchBlt(obj.hdc, 0, 9, 14, 18, _
            frmPics.imgCustomPics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
         PicOne = PicOne + 1
         CalcCustMonstPic PicOne, PicX, PicY
         nRet = StretchBlt(obj.hdc, 14, 9, 14, 18, _
            frmPics.imgCustomPics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
      Case 3               ' 1x2
         CalcCustMonstPic PicOne, PicX, PicY
         nRet = StretchBlt(obj.hdc, 7, 0, 14, 18, _
            frmPics.imgCustomPics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
         PicOne = PicOne + 1
         CalcCustMonstPic PicOne, PicX, PicY
         nRet = StretchBlt(obj.hdc, 7, 18, 14, 18, _
            frmPics.imgCustomPics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
      Case 4               ' 2x2
         CalcCustMonstPic PicOne, PicX, PicY
         nRet = StretchBlt(obj.hdc, 0, 0, 14, 18, _
            frmPics.imgCustomPics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
         PicOne = PicOne + 1
         CalcCustMonstPic PicOne, PicX, PicY
         nRet = StretchBlt(obj.hdc, 13, 0, 14, 18, _
            frmPics.imgCustomPics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
         PicOne = PicOne + 1
         CalcCustMonstPic PicOne, PicX, PicY
         nRet = StretchBlt(obj.hdc, 0, 17, 14, 18, _
            frmPics.imgCustomPics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
         PicOne = PicOne + 1
         CalcCustMonstPic PicOne, PicX, PicY
         nRet = StretchBlt(obj.hdc, 13, 17, 14, 18, _
            frmPics.imgCustomPics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
      End Select
   End If
End Sub

Public Sub PaintRoad(obj As Object, ByVal Section As Integer, _
      ByVal objx As Integer, ByVal objy As Integer)
   Dim PicX As Integer
   Dim PicY As Integer

   Select Case Section
      Case 0 ' west
         PicX = 168
         PicY = 304
         obj.PaintPicture frmPics.imgFieldpics, _
            objx, objy + 16, 14, 4, PicX, PicY, 14, 4
      Case 1 ' east
         PicX = 182
         PicY = 304
         obj.PaintPicture frmPics.imgFieldpics, _
            objx + 14, objy + 16, 14, 4, PicX, PicY, 14, 4
      Case 2 ' north
         PicX = 152
         PicY = 288
         obj.PaintPicture frmPics.imgFieldpics, _
            objx + 12, objy, 4, 16, PicX, PicY, 4, 18
      Case 3 ' south
         PicX = 152
         PicY = 306
         obj.PaintPicture frmPics.imgFieldpics, _
            objx + 12, objy + 18, 4, 18, PicX, PicY, 4, 18
   End Select
End Sub

Public Sub PaintScenPic(obj As Object, ByVal PicNum As Integer)
   Dim PicX As Integer
   Dim PicY As Integer
   
   PicX = Int(PicNum Mod 5) * 32
   PicY = Int(PicNum / 5) * 32
   obj.PaintPicture imgScenPics, _
      0, 0, 32, 32, PicX, PicY, 32, 32
End Sub

Public Sub PaintTalkPic(obj As Object, ByVal PicNum As Integer)
   Dim PicOne As Integer
   Dim PicX As Integer
   Dim PicY As Integer
   
   If PicNum > 0 Then
      PicOne = PicNum - 1
   Else
      PicOne = 89
   End If
   PicX = Int(PicOne Mod 10) * 32
   PicY = Int(PicOne / 10) * 32
   obj.PaintPicture frmPics.imgTalkPics, 0, 0, 36, 36, PicX, PicY, 32, 32
'   nRet = StretchBlt(obj.hdc, 0, 0, 36, 36, _
      frmPics.imgTalkPics.hdc, PicX, PicY, 32, 32, vbSrcCopy)
End Sub

Public Sub PaintTerrain(obj As Object, ByVal PicNum As Integer, _
      ByVal objx As Integer, ByVal objy As Integer)
   Dim PicOne As Integer
   Dim PicX As Integer
   Dim PicY As Integer
   
   PicOne = PicNum
' pictures are number 0 - 259; custom pictures are number 1000 and up
   If PicNum < 300 Then          ' standard pics
      PaintTerrPic obj, PicOne, objx, objy, 0
   ElseIf PicNum < 400 Then
      Exit Sub
   ElseIf PicNum < 500 Then
      PicOne = PicOne - 400
      PaintTerrAnim obj, PicOne, objx, objy, 0
   ElseIf PicNum < 1000 Then
      Exit Sub
   ElseIf PicNum < 2000 Then    ' custom pic
      PicOne = PicOne - 1000
      PaintCustomPic obj, PicOne, objx, objy, 0
   ElseIf PicNum < 3000 Then    ' custom animated
      PicOne = PicOne - 2000
      PaintCustomPic obj, PicOne, objx, objy, 0
   Else
      Exit Sub
   End If
End Sub

Public Sub PaintTerrainList(obj As Object, ByVal PicNum As Integer, _
      objx As Integer, ByVal objy As Integer)
   Dim PicOne As Integer
   Dim PicSet As Integer
   Dim PicX As Integer
   Dim PicY As Integer
   
   PicOne = PicNum
   If PicNum < 300 Then          ' standard pics
      PaintTerrPic obj, PicOne, objx, objy, 1
   ElseIf PicNum < 400 Then
      Exit Sub
   ElseIf PicNum < 500 Then
      PicOne = PicOne - 400
      PaintTerrAnim obj, PicOne, objx, objy, 1
   ElseIf PicNum < 1000 Then
      Exit Sub
   ElseIf PicNum < 2000 Then    ' custom pic
      PicOne = PicOne - 1000
      PaintCustomPic obj, PicOne, objx, objy, 1
   ElseIf PicNum < 3000 Then    ' custom animated
      PicOne = PicOne - 2000
      PaintCustomPic obj, PicOne, objx, objy, 1
   Else
      Exit Sub
   End If
End Sub

Public Sub PaintTerrainZoom(obj As Object, ByVal PicNum As Integer, _
      ByVal objx As Integer, ByVal objy As Integer)
   Dim PicOne As Integer
   
   PicOne = PicNum
   If PicNum < 300 Then          ' standard pics
      PaintTinyTerr obj, PicOne, objx, objy
   ElseIf PicNum < 400 Then
      Exit Sub
   ElseIf PicNum < 500 Then
      PicOne = PicOne - 400 + 260
      PaintTinyTerr obj, PicOne, objx, objy
   ElseIf PicNum < 1000 Then
      Exit Sub
   ElseIf PicNum < 2000 Then    ' custom pic
      PicOne = PicOne - 1000
      PaintCustomZPic obj, PicOne, objx, objy
   ElseIf PicNum < 3000 Then    ' custom animated
      PicOne = PicOne - 2000
      PaintCustomZPic obj, PicOne, objx, objy
   Else
      Exit Sub
   End If
End Sub

Public Sub PaintTerrAnim(obj As Object, ByVal PicNum As Integer, _
      ByVal objx As Integer, ByVal objy As Integer, ByVal PicSize As Integer)
   Dim PicX As Integer
   Dim PicY As Integer
   
   PicX = Int(PicNum / 5) * (28 * 4)
   PicY = Int(PicNum Mod 5) * 36
   Select Case PicSize
   Case 0
      nRet = StretchBlt(obj.hdc, objx, objy, 28, 36, _
         frmPics.imgTeranimpics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
   Case 1
      nRet = StretchBlt(obj.hdc, objx, objy, 16, 16, _
         frmPics.imgTeranimpics.hdc, PicX, PicY, 28, 36, vbSrcCopy)
   End Select
End Sub

Public Sub PaintTerrPic(obj As Object, ByVal PicNum As Integer, _
      ByVal objx As Integer, ByVal objy As Integer, ByVal PicSize As Integer)
   Dim PicSet As Integer
   Dim PicX As Integer
   Dim PicY As Integer
      
   PicSet = Int(PicNum / 50)
   PicX = Int(PicNum Mod 10) * 28
   PicY = Int((PicNum - (PicSet * 50)) / 10) * 36
   Select Case PicSize
   Case 0
      nRet = StretchBlt(obj.hdc, objx, objy, 28, 36, _
         frmPics.imgTerpics(PicSet).hdc, PicX, PicY, 28, 36, vbSrcCopy)
   Case 1
      nRet = StretchBlt(obj.hdc, objx, objy, 16, 16, _
         frmPics.imgTerpics(PicSet).hdc, PicX, PicY, 28, 36, vbSrcCopy)
   End Select
End Sub

Public Sub PaintTerrSp(obj As Object, ByVal PicNum As Integer, _
      ByVal objx As Integer, ByVal objy As Integer)
   Dim PicX As Integer
   Dim PicY As Integer
   
   If PicNum < 0 Then Exit Sub
   PicX = Int(PicNum Mod 10) * 7
   PicY = Int(PicNum / 10) * 7
   If PicNum = 6 Then
      nRet = StretchBlt(obj.hdc, objx, objy, 21, 7, _
         frmPics.imgTerDisp.hdc, PicX, PicY, 21, 7, vbSrcCopy)
   Else
      nRet = StretchBlt(obj.hdc, objx, objy, 7, 7, _
         frmPics.imgTerDisp.hdc, PicX, PicY, 7, 7, vbSrcCopy)
   End If
End Sub

Public Sub PaintTinyTerr(obj As Object, ByVal PicNum As Integer, _
      ByVal objx As Integer, ByVal objy As Integer)
   Dim PicX As Integer
   Dim PicY As Integer
         
   PicX = Int(PicNum Mod 10) * 6
   PicY = Int(PicNum / 10) * 6
   nRet = StretchBlt(obj.hdc, objx, objy, 6, 6, _
      frmPics.imgTinyTerr.hdc, PicX, PicY, 6, 6, vbSrcCopy)
End Sub

Private Sub TransparentBlt(OutDstDC As Long, _
   DstDC As Long, SrcDC As Long, SrcRect As RECT, _
   DstX As Integer, DstY As Integer)
   Dim W As Integer, H As Integer
   Dim MonoMaskDC As Long, hMonoMask As Long
   Dim MonoInvDC As Long, hMonoInv As Long
   Dim ResultDstDC As Long, hResultDst As Long
   Dim ResultSrcDC As Long, hResultSrc As Long
   Dim hPrevMask As Long, hPrevInv As Long
   Dim hPrevSrc As Long, hPrevDst As Long
   Dim OldBC As Long
   Dim TransColor As Long
   
   TransColor = vbWhite
   W = SrcRect.Right - SrcRect.Left
   H = SrcRect.Bottom - SrcRect.Top
   
   'create monochrome mask and inverse masks
   MonoMaskDC = CreateCompatibleDC(DstDC)
   MonoInvDC = CreateCompatibleDC(DstDC)
   hMonoMask = CreateBitmap(W, H, 1, 1, ByVal 0&)
   hMonoInv = CreateBitmap(W, H, 1, 1, ByVal 0&)
   hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
   hPrevInv = SelectObject(MonoInvDC, hMonoInv)
   
   'create keeper DCs and bitmaps
   ResultDstDC = CreateCompatibleDC(DstDC)
   ResultSrcDC = CreateCompatibleDC(DstDC)
   hResultDst = CreateCompatibleBitmap(DstDC, W, H)
   hResultSrc = CreateCompatibleBitmap(DstDC, W, H)
   hPrevDst = SelectObject(ResultDstDC, hResultDst)
   hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)

   'copy src to monochrome mask
   OldBC = SetBkColor(SrcDC, TransColor)
   nRet = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top, vbSrcCopy)
   TransColor = SetBkColor(SrcDC, OldBC)
   'create inverse of mask
   nRet = BitBlt(MonoInvDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbNotSrcCopy)
   'get background
   nRet = BitBlt(ResultDstDC, 0, 0, W, H, DstDC, DstX, DstY, vbSrcCopy)
   'AND with Monochrome mask
   nRet = BitBlt(ResultDstDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbSrcAnd)
   'get overlapper
   nRet = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top, vbSrcCopy)
   'AND with inverse monochrome mask
   nRet = BitBlt(ResultSrcDC, 0, 0, W, H, MonoInvDC, 0, 0, vbSrcAnd)
   'XOR these two
   nRet = BitBlt(ResultDstDC, 0, 0, W, H, ResultSrcDC, 0, 0, vbSrcInvert)
   'output results
   nRet = BitBlt(OutDstDC, DstX, DstY, W, H, ResultDstDC, 0, 0, vbSrcCopy)
   'clean up
   hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
   DeleteObject hMonoMask
   hMonoInv = SelectObject(MonoInvDC, hPrevInv)
   DeleteObject hMonoInv
   hResultDst = SelectObject(ResultDstDC, hPrevDst)
   DeleteObject hResultDst

   hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
   DeleteObject hResultSrc

   DeleteDC MonoMaskDC
   DeleteDC MonoInvDC
   DeleteDC ResultDstDC
   DeleteDC ResultSrcDC
End Sub
