Create Scale Bar

277 views
Skip to first unread message

Kara Jean

unread,
Jul 16, 2009, 5:06:35 PM7/16/09
to MapInfo-L
Hello again,

Has anybody had any success creating a custom scale bar using MapBasic
code? I want to add the scale bar to my layout, that way it will be
the most accurate rather than just using the 1in = XX mi. I've tried
looking at the code that comes with the MapBasic download, even if to
change it a bit to work and have had no success getting it to run.

I have a program that I make layer and create the map in the mapper
window and then have the layout set up- it's the easiest way for me to
put custom text on the layout each time it runs. I would then like to
have the scale bar appear as well.

Any tips or guidence would be most helpful!



Thanks,
Kara

Sitaneph

unread,
Jul 19, 2009, 7:21:34 PM7/19/09
to MapInfo-L
I have created a custom scale bar but it is within the map window not
the layout window. I did this to avoid the need for working out the
scale, and if the map window zoom is changed i don't have to redo the
scale bar

Sub MakeScaleBar
'Makes a scale bar in the SW corner of the map window

'Want to set the paper units
Set Paper Units "cm"
'also want to set the distance units
Set Distance Units "m"

'This is alot simpler changing the projection of the map to eastings
'and northings.
'But i want to retain the original settings after the function has
'finished calculating.

'this sub is called from another location outside this routine
'so need to check if the front window is a map
'Need to check if the front window is a map
If WindowInfo(FrontWindow(),WIN_INFO_TYPE) = WIN_MAPPER Then
'don't need to do anything
Else
Note "The active window is not a map. This tool can only be used on
a map window."
End If

Dim keepcoords as string
keepcoords = MapperInfo(windowid(FrontWindow()),
MAPPER_INFO_COORDSYS_CLAUSE)

'i don't want to waste time redrawing the map after the projection
has changed
Set Map
Window FrontWindow()
Redraw off

'Now Change the co-ord system
set coordsys GDA94

'Need the bounding box co-ords for the input window
dim x1, y1, x2, y2, DeltaX, DeltaY as float
x1 = MapperInfo(FrontWindow(),MAPPER_INFO_MINX)

y1 = MapperInfo(FrontWindow(),MAPPER_INFO_MINY)
x2 = MapperInfo(FrontWindow(),MAPPER_INFO_MAXX)
y2 = MapperInfo(FrontWindow(),MAPPER_INFO_MAXY)

'adjust the boundaries to where the scalebar needs to be.
'width needs to be % of window but rounded to a whole number

'what it is rounded to depends on the width of the window
'i.e is scale bar in m, or km
Dim ScaleUnits as String

If x2 -x1>5000 then
'measure in km
x2 = x1 + round((x2-x1)*0.3,1000)
ScaleUnits = "kilometres"

Else
'measure in m
x2 = x1 + round((x2-x1)*0.3,100)
ScaleUnits = "metres"
End If

'the height is set
DeltaY = 0.3*MapperInfo(FrontWindow(), MAPPER_INFO_SCALE)
y2 = y1 + DeltaY

'The width of the scale bar
DeltaX = x2-x1

'need to buffer the scale bar from the edge of the map window
x1 = x1 + MapperInfo(FrontWindow(), MAPPER_INFO_SCALE)*0.1
y1 = y1 + MapperInfo(FrontWindow(), MAPPER_INFO_SCALE)*0.5
x2 = x2 + MapperInfo(FrontWindow(), MAPPER_INFO_SCALE)*0.1
y2 = y2 + MapperInfo(FrontWindow(), MAPPER_INFO_SCALE)*0.5

If debug then
Print "Scalebar co-ordinates ="+str$(x1)+", "+str$(y1)+"; "+str$
(x2)+","+str$(y2)
Print str$(DeltaX)+", "+str$(DeltaY)
End if

Dim Scalebar as object

'Make the black parts of the scale bar
Create Region into Variable Scalebar
3
4
(x1, y1+DeltaY/2)
(x1, y2)
(x1+DeltaX/4, y2)
(x1+DeltaX/4, y1+DeltaY/2)
4
(x1+DeltaX/4, y1)
(x1+DeltaX/4, y1+DeltaY/2)
(x1+DeltaX/2, y1+DeltaY/2)
(x1+DeltaX/2, y1)
4
(x1+DeltaX/2, y1+DeltaY/2)
(x1+DeltaX/2, y2)
(x2, y2)
(x2, y1+DeltaY/2)

Pen (1,2,0)
Brush (2,0,16777215)
Center (x1+DeltaX/2,y1+DeltaY/2)

Insert into WindowInfo(FrontWindow(),WIN_INFO_TABLE)(obj)
Values (Scalebar)

'Make the white parts of the scale bar
Create Region into Variable Scalebar
3
4
(x1, y1)
(x1, y1+DeltaY/2)
(x1+DeltaX/4, y1+DeltaY/2)
(x1+DeltaX/4, y1)
4
(x1+DeltaX/4, y1+DeltaY/2)
(x1+DeltaX/4, y2)
(x1+DeltaX/2, y2)
(x1+DeltaX/2, y1+DeltaY/2)
4
(x1+DeltaX/2, y1)
(x1+DeltaX/2, y1+DeltaY/2)
(x2, y1+DeltaY/2)
(x2, y1)

Pen (1,2,0)
Brush (2,16777215,0)
Center (x1+DeltaX/2,y1+DeltaY/2)

Insert into WindowInfo(FrontWindow(),WIN_INFO_TABLE)(obj)
Values (Scalebar)

'some variables that define the text location
dim ftext_1, ftext_2, ftext_3, ftext_4, ftext_0, ftext_mid,
ftext_last as float

ftext_1 = y2 + 1.35*DeltaY 'top of # text
ftext_2 = y2 - 0.15*DeltaY 'bottom of # text
ftext_3 = y1 - 1.35*DeltaY 'bottom of unit text
ftext_4 = y1 + 0.15*DeltaY 'top of unit text
ftext_0 = x1 - 0.1*DeltaY 'left side 0 text
ftext_mid = x1+ (Deltax/2)-round((log(DeltaX/2)/log(10)),1)
*0.2*DeltaY
ftext_last = x2 - round((log(DeltaX)/log(10)),1)*0.2*DeltaY

'Make the text part
Create Text into Variable Scalebar
"0"
(ftext_0,ftext_1) (x1+DeltaX/2,ftext_2)
Font ("Arial Narrow",256,10,BLACK,WHITE)

Insert into WindowInfo(FrontWindow(),WIN_INFO_TABLE)(obj)
Values (Scalebar)

'All the calculations up to this point have been in metres but the
text
'of the scale bar may need to be in kilometres
if ScaleUnits = "kilometres" then
Create Text into Variable Scalebar
str$(DeltaX/2000)
(ftext_mid,ftext_1) (x2,ftext_2)
Font ("Arial Narrow",256,10,BLACK,WHITE)
Else
Create Text into Variable Scalebar
str$(DeltaX/2)
(ftext_mid,ftext_1) (x2,ftext_2)
Font ("Arial Narrow",256,10,BLACK,WHITE)
End If

Insert into WindowInfo(FrontWindow(),WIN_INFO_TABLE)(obj)
Values (Scalebar)

if ScaleUnits = "kilometres" then
Create Text into Variable Scalebar
str$(DeltaX/1000)
(ftext_last,ftext_1) (x2,ftext_2)
Font ("Arial Narrow",256,10,BLACK,WHITE)
Else
Create Text into Variable Scalebar
str$(DeltaX)
(ftext_last,ftext_1) (x2,ftext_2)
Font ("Arial Narrow",256,10,BLACK,WHITE)
End If

Insert into WindowInfo(FrontWindow(),WIN_INFO_TABLE)(obj)
Values (Scalebar)

Create Text into Variable Scalebar
ScaleUnits
(x1,ftext_4) (x2,ftext_3)
Font ("Arial Narrow",256,10,BLACK,WHITE)

Insert into WindowInfo(FrontWindow(),WIN_INFO_TABLE)(obj)
Values (Scalebar)

'Return to co-ord system to the original
run command "set " + keepcoords

'want to redraw the map now
Set Map
Window FrontWindow()
Redraw On

End Sub
Reply all
Reply to author
Forward
0 new messages