what wrong for my code? (i have attach it). when it run and load the "combine.txt" file, it came out an error "subscript out of range"
Printable View
what wrong for my code? (i have attach it). when it run and load the "combine.txt" file, it came out an error "subscript out of range"
I get various other errors... Disk not ready, overflow...?
Me too. When I commented the offending line of code, I get another couple of errors. Try putting a breakpoint.
Check your ****** file combine.txt, where do you save the longitude and latitude values? the long's are the bigger one's, correct? So you have the format: longitude latitude depth. Now look thru your file, you are changing the sequence down in the file somewhere, that way the functions getx and gety will make negative values, which you don't want to have!
And use a :
because you have at least one empty line in the file.vb Code:
Loop Input #filenr, data If Not data="" then '.... End If Loop Until EOF(filenr) End if
without changing the file, I was able to run it with this peace of code:
vb Code:
'in the declaration of the Sub Form_load Dim Changer as Single 'after latitude=CSng(.... If longitutude<latitude Then Changer=longitude longitude=latitude latitude=Changer End if
BTW you still have lots of points in there where Depth is "0", the one'S you have in the file and others as well.
Use something like this to show all your entries:
all entries will show a black dot.vb Code:
'after the line arrDepth(..... Picture1.ForeColor=vbBlack Picture1.PSet(getX(longitude),GetY(latitude))
It looks like the iso-depth lines on your sea-chart! But what depth is valid between those lines?
Opus, thank you very much. You help me so much.Quote:
Originally Posted by opus
The iso-depth lines is the contour depth line, so the depth valid between those line is between the value of the two contour.
for example:the contour line 1 =2, the contour line 2 = 5,
then the depth in between two line is in range 2 to 5.
so, do u have any idea to represent the other depth where is "0" to a depth like 2-5.
Actually I don't have a good idea.
Two ways are thinkable:
-1- Make entries for each possibel point on the map. One of the problem is how to determine whicj points don't have an entry yet (since you have 0 in the file already that value can't trigger it). Theother problem is how to calculate the correct depth value for each of those new points (maybe the closest point from the original file is giving its value).
-2- draw "regions" using the coordinates with the same depth an fill the closed regions with a color, that way the color will show the depth. But that would be changing your approach with showing the depth as a tooltip.
can u provide me sample on how to draw regions using the coordinates with the same depth an fill the closed regions with a color, that way the color will show the depth.Thank you.Quote:
Originally Posted by opus
I did a quick lok into the API guide and made some entries in the code.
All the points having a depth of 2,10,20,30,50 and 100 will create a seperate region that will be filled in a color.
Note: -1- The regions should be closed and not overlapping (which they are in your case). So you have to play around with it, probably make more regions for a depth to show it correctly. Play around with the sequence, when drawing (first the deep part or vice versa)
-2- all the infomrmation on your map is beeing brushed over by those colored regions, I don't think that you are comfortable with that!
Code:Private Type Point
Longitude As Long
Latitude As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Const ALTERNATE = 1 ' ALTERNATE and WINDING are
Const WINDING = 2 ' constants for FillMode.
Dim PicHght As Long 'the height of your picturebox
Dim PicWdth As Long 'the width of your picturebox
Dim MapHght As Double 'the height of your map
Dim MapWdth As Double 'the width of your picturebox
Dim Map0X As Double 'the maximum X or width of your map
Dim Map0Y As Double 'the maximum Y or height of your map
Dim arrDepth(1000, 1000) As Single
Dim Region2() As Point
Dim Region10() As Point
Dim Region20() As Point
Dim Region30() As Point
Dim Region50() As Point
Dim Region100() As Point
Dim Region2Count As Integer
Dim Region10Count As Integer
Dim Region20Count As Integer
Dim Region30Count As Integer
Dim Region50Count As Integer
Dim Region100Count As Integer
Private Sub Form_load()
Dim filenr As Long
Dim filename As String
Dim data As String
Dim i As Integer
Dim j As Integer
Dim Latitude As Single
Dim Longitude As Single
Dim Depth As Single
Dim Changer As Single
With Picture1
.AutoRedraw = True
.ScaleMode = vbPixels
PicHght = .ScaleHeight
PicWdth = .ScaleWidth
End With
'Map0X = 101.46667
'Map0Y = 2.85667
'MapWdth = 99.7 - Map0X
'MapHght = 4.01666 - Map0Y
Map0X = 99.7
Map0Y = 4.01666
MapWdth = 101.46667 - Map0X
MapHght = 2.85667 - Map0Y
filenr = FreeFile
'put your filepath in here!!!!
'filename = "C:\XXX\depth.txt"
filename = "D:\Testing\ENC Project\Setting\SampleExtract.txt"
Open filename For Input As filenr
Do
Input #filenr, data
If Not data = "" Then
Longitude = Val(Left(data, InStr(1, data, " ") - 1))
data = Mid(data, InStr(1, data, " ") + 1)
Latitude = Val(Left(data, InStr(1, data, ";") - 1))
data = Mid(data, InStr(1, data, ";") + 1)
Depth = CSng(data)
If Longitude < Latitude Then
Changer = Longitude
Longitude = Latitude
Latitude = Changer
End If
arrDepth(GetX(Longitude), GetY(Latitude)) = Depth
CreateRegion GetX(Longitude), GetY(Latitude), Depth
Picture1.PSet (GetX(Longitude), GetY(Latitude))
End If
Loop Until EOF(filenr)
Close filenr
'fill regions
FillRegions Region2, UBound(Region2) - 1, vbYellow
FillRegions Region10, UBound(Region10) - 1, vbGreen
FillRegions Region20, UBound(Region20) - 1, vbBlue
FillRegions Region30, UBound(Region30) - 1, vbRed
FillRegions Region50, UBound(Region50) - 1, vbWhite
FillRegions Region100, UBound(Region100) - 1, vbBlack
End Sub
Private Function GetLatitude(y As Single) As Double
GetLatitude = Round((y * MapHght / PicHght) + Map0Y, 5)
End Function
Private Function GetLongitude(x As Single) As Double
GetLongitude = Round((x * MapWdth / PicWdth) + Map0X, 5)
End Function
Private Function GetY(Latitude As Single) As Long
GetY = (Latitude - Map0Y) * PicHght / MapHght
End Function
Private Function GetX(Longitude As Single) As Long
GetX = (Longitude - Map0X) * PicWdth / MapWdth
End Function
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Picture1.ToolTipText = "x=" & CStr(x) & " y=" & CStr(y) & "Lat=" & CStr(GetLatitude(y)) & " Long=" & CStr(GetLongitude(x)) & " Depth: " & CStr(arrDepth(x, y))
End Sub
Private Sub CreateRegion(Longitude As Long, Latitude As Long, Depth As Single)
'will add the coordinates to the region of this depth
'only depth of 2, 10,20,30,50,100 are supported!
Dim i As Integer
Select Case Depth
Case Is = 2
Region2Count = Region2Count + 1
ReDim Preserve Region2(Region2Count)
Region2(Region2Count - 1).Latitude = Latitude
Region2(Region2Count - 1).Longitude = Longitude
Case Is = 10
Region10Count = Region10Count + 1
ReDim Preserve Region10(Region10Count)
Region10(Region10Count - 1).Latitude = Latitude
Region10(Region10Count - 1).Longitude = Longitude
Case Is = 20
Region20Count = Region20Count + 1
ReDim Preserve Region20(Region20Count)
Region20(Region20Count - 1).Latitude = Latitude
Region20(Region20Count - 1).Longitude = Longitude
Case Is = 30
Region30Count = Region30Count + 1
ReDim Preserve Region30(Region30Count)
Region30(Region30Count - 1).Latitude = Latitude
Region30(Region30Count - 1).Longitude = Longitude
Case Is = 50
Region50Count = Region50Count + 1
ReDim Preserve Region50(Region50Count)
Region50(Region50Count - 1).Latitude = Latitude
Region50(Region50Count - 1).Longitude = Longitude
Case Is = 100
Region100Count = Region100Count + 1
ReDim Preserve Region100(Region100Count)
Region100(Region100Count - 1).Latitude = Latitude
Region100(Region100Count - 1).Longitude = Longitude
End Select
End Sub
Private Sub FillRegions(Region() As Point, NumPoints As Long, color As Long)
Dim hBrush As Long
Dim hRgn As Long
Polygon Picture1.hdc, Region(0), NumPoints
' Gets stock black brush.
'hBrush = GetStockObject(color)
hBrush = CreateSolidBrush(color)
' Creates region to fill with color.
hRgn = CreatePolygonRgn(Region(0), NumPoints, ALTERNATE)
' If the creation of the region was successful then color.
If hRgn Then FillRgn Picture1.hdc, hRgn, hBrush
DeleteObject hRgn
End Sub