Attribute VB_Name = "MapWindowDeclarations"
Rem ******* MAP window (Form8) August 2006 *******
Rem MAP window variables

Public Type Map_info
 FileName As String * 60
 Origo_X As Double
 Origo_Y As Double
 Pix_Height As Double
 Pix_Width As Double
 Cols As Long
 Rows As Long
 ColorMode As Byte
End Type
Public MapInfo As Map_info
Public Map() As RGBtriplet

Public Type Map_Win_Info
 WinOriCol As Long
 WinOriRow As Long
 Mapwidth As Long   ' width of the map window, in pixels
 Mapheight As Long  ' height of the map window, in pixels
 MapPan As Double
 startcol As Long
 endcol As Long
 startrow As Long
 endrow As Long
End Type
Public MapWinInfo As Map_Win_Info

Public Sub MapRegion()

Rem This routine computes the extent of the map-image to be displayed in the map window

End Sub

Public Sub Calculate_Map_Region(X As Long, Y As Long)
Rem This routine finds the extent of the image to be displaeyd

'X_left = MapWinInfo.WinOriCol + X * 1 / MapWinInfo.MapPan - (MapWinInfo.Mapwidth / 2) * 1 / MapWinInfo.MapPan
'X_right = MapWinInfo.WinOriCol + X * 1 / MapWinInfo.MapPan + (MapWinInfo.Mapwidth / 2 - 1) * 1 / MapWinInfo.MapPan
'Y_Up = MapWinInfo.WinOriRow + Y * 1 / MapWinInfo.MapPan - (MapWinInfo.Mapheight / 2) * 1 / MapWinInfo.MapPan
'Y_down = MapWinInfo.WinOriRow + Y * 1 / MapWinInfo.MapPan + (MapWinInfo.Mapheight / 2 - 1) * 1 / MapWinInfo.MapPan

X_left = X - (MapWinInfo.Mapwidth / 2) * 1 / MapWinInfo.MapPan
X_right = X + (MapWinInfo.Mapwidth / 2 - 1) * 1 / MapWinInfo.MapPan
Y_Up = Y - (MapWinInfo.Mapheight / 2) * 1 / MapWinInfo.MapPan
Y_down = Y + (MapWinInfo.Mapheight / 2 - 1) * 1 / MapWinInfo.MapPan


If X_left < 1 Then
 X_left = 1
 X_right = 1 + (MapWinInfo.Mapwidth - 1) * 1 / MapWinInfo.MapPan
End If
'If X_left > (MapInfo.Cols) - MapWinInfo.Mapwidth * 1 / MapWinInfo.MapPan Then
' X_left = (MapInfo.Cols - MapWinInfo.Mapwidth)
' X_right = (MapInfo.Cols - MapWinInfo.Mapwidth) + (MapWinInfo.Mapwidth - 1) * 1 / MapWinInfo.MapPan
'End If
If Y_Up < 1 Then
 Y_Up = 1
 Y_down = 1 + (MapWinInfo.Mapheight - 1) * 1 / MapWinInfo.MapPan
End If
If Y_Up > (MapInfo.Rows) - MapWinInfo.Mapheight * 1 / MapWinInfo.MapPan Then
 Y_Up = (MapInfo.Rows) - MapWinInfo.Mapheight * 1 / MapWinInfo.MapPan
 Y_down = Y_Up + (MapWinInfo.Mapheight - 1) * 1 / MapWinInfo.MapPan
End If

MapWinInfo.WinOriCol = X_left
MapWinInfo.WinOriRow = Y_Up
MapWinInfo.startcol = X_left
MapWinInfo.startrow = Y_Up
MapWinInfo.endcol = X_right
MapWinInfo.endrow = Y_down
'MsgBox (X_right - X_left + 1)
'MsgBox (Y_down - Y_Up + 1)

'Call create_Map_bmp(CInt(1), CInt(X_left), CInt(Y_up), CInt(X_right), CInt(Y_down), "f:\Map.BMP", CDbl(1), CDbl(1))
'Form8.Picture1.Picture = LoadPicture("F:\MAP.BMP")


Rem The wanted center is at (XY)
Rem MapInfo.Rows, MapInfo.Cols define the number of picture elements that can be displaeyd
'MapWinInfo.MapPan

'MapWinInfo.WinOriCol
'MapWinInfo.WinOriRow
'MapWinInfo.StartRow
'MapWinInfo.EndRow
'MapWinInfo.StartCol
'MapWinInfo.EndCol

End Sub

Public Sub Map_Position(Dire As Long, ByRef X As Long, ByRef Y As Long, ByRef X_Gnd As Double, ByRef Y_Gnd As Double)

Rem DIR = 0 From (X,Y) image coordinates  compute XY object space coordinates
Rem DIR = 1 From (X,Y) object coordinates compute XY image coordinates
Dim X_im As Double, Y_im As Double

Select Case Dire
Case 0
 X_im = MapWinInfo.WinOriCol + 1 / MapWinInfo.MapPan * CDbl(X)
 Y_im = MapWinInfo.WinOriRow + 1 / MapWinInfo.MapPan * CDbl(Y)
 X_Gnd = MapInfo.Origo_X + X_im * MapInfo.Pix_Width
 Y_Gnd = MapInfo.Origo_Y + (MapInfo.Rows - Y_im) * MapInfo.Pix_Height
 Form8.Label1.Caption = X & " , " & Y & "    " & Format$(X_Gnd, "#.00") & " , " & Format$(Y_Gnd, "#.00")
 
 Case 1 ' Compute image coords!
 X_im = (X_Gnd - MapInfo.Origo_X) / MapInfo.Pix_Width
 X = 1 / MapWinInfo.MapPan * (X_im - MapWinInfo.WinOriCol)
 
 Y_im = -((Y_Gnd - MapInfo.Origo_Y) - (MapInfo.Rows * MapInfo.Pix_Height)) / MapInfo.Pix_Height
 Y = (Y_im - MapWinInfo.WinOriRow) / MapWinInfo.MapPan


End Select

End Sub
Public Sub set_map_window_size()
Rem This routine Sets the width of the Map window and assigns values to Mapwidth and Mapheight variables
MapWinInfo.Mapwidth = (Form8.ScaleWidth - 10)
MapWinInfo.Mapwidth = MapWinInfo.Mapwidth + (MapWinInfo.Mapwidth * 3) Mod 4 + 4
MapWinInfo.Mapheight = Form8.ScaleHeight - 10 + Form8.ScaleHeight Mod 4 + 4
Form8.Picture1.Width = MapWinInfo.Mapwidth
Form8.Picture1.Height = MapWinInfo.Mapheight

End Sub


Public Sub create_Map_bmp(ByVal Index As Integer, ByVal startcol As Integer, ByVal startrow As Integer, ByVal endcol As Integer, ByVal endrow As Integer, FileName As String, ByVal pan_x As Double, ByVal pan_y As Double)

Rem Declarations Needed for BMP-printing

Dim byteapu As Byte
Dim hederi As BITMAPINFOHEADER ' 40 bytes
Dim varitaulu(0 To 255) As RGBQUAD
Dim bmicolor As RGBQUAD
Dim isohederi As BITMAPINFO
Dim filehederi As BITMAPFILEHEADER ' 14 bytes
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, N As Integer, lisa As Integer
Dim W_byte_array As Integer, H_byte_array As Integer
Dim i_step As Integer
Dim j_step As Integer, padding As Integer, lx As Integer
Dim isum As Integer, apusum As Integer, maxh As Integer
Dim paikka As Long

W_byte_array = MapWinInfo.Mapwidth
H_byte_array = MapWinInfo.Mapheight

Close (1)
Open FileName For Binary As 1

lisa = (W_byte_array * 3) Mod 4
If lisa = 0 Then
 padding = 0
 Else
 padding = 4 - lisa
End If

Rem Note the order of BMP-files ! It is not RGB but BGR!
ReDim b_array(0 To (W_byte_array - 1) + (padding), 0 To H_byte_array - 1) As RGBtriplet
ReDim bkuva(0 To (W_byte_array - 1) + (padding), 0 To H_byte_array - 1) As RGBQ
Rem ckuva is used (temporary) to make sure we don't accidentally go outside OK indeces
ReDim ckuva(-100 To (W_byte_array - 1) + 100 + (padding), -100 To H_byte_array - 1 + 100) As RGBQ

filehederi.bfType = &H4D42
filehederi.bfSize = (CLng(W_byte_array + padding) * CLng(H_byte_array) * CLng(3))
filehederi.bfReserved1 = &H0
filehederi.bfReserved2 = &H0
filehederi.bfOffBits = &H36 ' 55 (54 byte offset, read 55th as first data-byte)
hederi.biSize = CLng(40)  ' 4 bytes
hederi.biWidth = CLng(W_byte_array) ' 4
hederi.biHeight = CLng(-H_byte_array) ' 4
hederi.biPlanes = CInt(1) ' 2
hederi.biBitCount = CInt(24) '2
hederi.biCompression = CLng(0) '4
hederi.biSizeImage = CLng(0) '4
hederi.biXPelsPerMeter = CLng(0) '4
hederi.biYPelsPerMeter = CLng(0) '4
hederi.biClrUsed = CLng(0) '4
hederi.biClrImportant = CLng(0) '4

isohederi.bmiHeader = hederi

Put #1, , filehederi
Put #1, , hederi   ' 40 Bytes

Rem For applying contrast enhancement by means of GAmma Correction

If MapWinInfo.MapPan > 0.99 And MapWinInfo.MapPan < 1.1 Then GoTo pan_x_1
If MapWinInfo.MapPan < 1 Then GoTo ZoomOut
If MapWinInfo.MapPan > 1 Then GoTo ZoomIn

pan_x_1: ' 1-1 Case
ReDim RROW(0 To (endcol - startcol)) As RGBtriplet
Close (2)
Open MapInfo.FileName For Binary As 2
k = -1
 For i = startrow To endrow
   k = k + 1
   paikka = CLng(i) * CLng(MapInfo.Cols) * 3 + CLng(startcol) * 3
   Rem Read a row
   Get #2, paikka + 1, RROW()
    For m = 0 To (endcol - startcol) - 1
     bkuva(m, k).r = RROW(m).r
     bkuva(m, k).G = RROW(m).G
     bkuva(m, k).B = RROW(m).B
    Next m
  Next i
Close (2)
GoTo loppu

ZoomOut:
Rem This is the N --> 1 case
ReDim RROW(0 To (endcol - startcol) + 1 / MapWinInfo.MapPan) As RGBtriplet
Open MapInfo.FileName For Binary As 2
k = -1

lx = -CInt(1 / MapWinInfo.MapPan)
For i = 0 To H_byte_array - 1
   lx = lx + CInt(1 / MapWinInfo.MapPan)
   paikka = CLng(startrow + lx) * (MapInfo.Cols) * CLng(3) + CLng(startcol) * 3
   If paikka < 1 Then
    paikka = startcol * 3
   End If
   Get #2, paikka + 1, RROW()
   l = -CInt(1 / MapWinInfo.MapPan)
    For j = 0 To W_byte_array - 1
     l = l + CInt(1 / MapWinInfo.MapPan)
    ' m = startcol + i * CInt(1 / MapWinInfo.MapPan)
    ' N = startrow + j * CInt(1 / MapWinInfo.MapPan)
    'If m < 0 Or N < 0 Or m > MapInfo.Cols Or N > MapInfo.Rows Then
       'MsgBox ("In create BMP: exceeding allowed indeces")
    '   bkuva(j, i).r = 255: bkuva(j, i).g = 255: bkuva(j, i).B = 255:
    'GoTo Ohita
    'End If
    If l > (endcol - startcol) + 1 / MapWinInfo.MapPan Then GoTo Ohita
     bkuva(j, i).r = RROW(l).r
     bkuva(j, i).G = RROW(l).G
     bkuva(j, i).B = RROW(l).B
Ohita:
  Next j
 Next i
Close (2)
GoTo loppu

ZoomIn:
Rem The 1->N Case
ReDim RROW(0 To (endcol - startcol)) As RGBtriplet
Close (2)
Open MapInfo.FileName For Binary As 2
i_step = -1
   
For i = startrow To endrow
   i_step = i_step + 1
   j_step = -1
   paikka = CLng(i) * CLng(MapInfo.Cols) * 3 + CLng(startcol) * 3
   Get #2, paikka + 1, RROW()
Rem Parse it
For j = startcol To endcol
  j_step = j_step + 1
    For k = 0 To CInt(MapWinInfo.MapPan) - 1
     For l = 0 To CInt(MapWinInfo.MapPan) - 1
      ckuva(j_step * CInt(MapWinInfo.MapPan) + l, i_step * CInt(MapWinInfo.MapPan) + k).r = RROW(j_step).r
      ckuva(j_step * CInt(MapWinInfo.MapPan) + l, i_step * CInt(MapWinInfo.MapPan) + k).G = RROW(j_step).G
      ckuva(j_step * CInt(MapWinInfo.MapPan) + l, i_step * CInt(MapWinInfo.MapPan) + k).B = RROW(j_step).B
     Next l
    Next k
  Next j
 Next i
   
For i = 0 To MapWinInfo.Mapwidth - 1
 For j = 0 To MapWinInfo.Mapheight - 1
     bkuva(i, j).r = ckuva(i, j).r
     bkuva(i, j).G = ckuva(i, j).G
     bkuva(i, j).B = ckuva(i, j).B
  Next j
Next i
Close (2)
GoTo loppu



loppu: Put #1, , bkuva
Close (1)

Exit Sub

error_in_creating_bmp_file:
Close (1)
MsgBox ("Error in creating the bmp-file!")
Exit Sub


End Sub