Кто программирует или программировал на MapBasic, откликнитесь
4418
7
Кто программирует или программировал на MapBasic, откликнитесь
nikomuro
Я занимался некоторое время. Что интересует?
Towahawk
Имеется код на MapBasic. Формируется меню с двумя кнопками, одна отвечает за присвоения стиля выбранным объектам символа а другая за присвоения стиля растрового символа. Никак не могу разобраться вот в чем. Стиль присваивается только из файла Символы MapInfo 3.0 (самый последний шрифт) а мне нужно чтобы присваивался стиль из любого шрифта типа Symbol (35,0,12,"Webdings",0,0). Вот и ломаю голову. MapBasic 12, mapinfo 12. Буду признателен за помощь.
Имеется код:

Include "mapbasic.def"
Declare Sub Main
Declare Sub TestPrint
Declare Sub TestPrint2
Declare Sub theEnd
Declare Sub ProgressBarDemo
Declare Sub WorkingLine
dim ProgressStart,ProgressEnd as integer
dim dt,ProgressD as integer
dim tbName as string

Sub Main
Create Menu "Обновить стиль" As
"Обновить" Calling TestPrint,
"Обновить2" Calling TestPrint2,
"Выход" Calling theEnd
Alter Menu Bar Add "Обновить стиль"
end sub

Sub TestPrint
dim ob as object
dim tb as string
dim aa as alias
dim n,i as integer
n=SelectionInfo(SEL_INFO_NROWS)
if n=0 then exit sub end if
tb=SelectionInfo(SEL_INFO_SELNAME)
for i=1 to n
Fetch Rec i From tb
aa=tb & ".obj"
ob=aa
Alter Object ob Info OBJ_INFO_SYMBOL,MakeSymbol(44, 255, 16)
Update tb Set obj=ob Where rowid=i
next
end sub

Sub TestPrint2
dim ob as object
dim tb as string
dim aa as alias
dim n,i as integer
dim sm as symbol
n=SelectionInfo(SEL_INFO_NROWS)
if n=0 then exit sub end if
sm=MakeCustomSymbol("CAR1-32.BMP", 65280, 22,0)
tb=SelectionInfo(SEL_INFO_SELNAME)
for i=1 to n
Fetch Rec i From tb
aa=tb & ".obj"
ob=aa
Alter Object ob Info OBJ_INFO_SYMBOL,sm
Update tb Set obj=ob Where rowid=i
next
end sub

Sub theEnd
End Program
end sub


Заранее спасибо
nikomuro
Чтобы создать символ из буквы или знака шрифта TrueType, используется Функция
MakeFontSymbol( ).

MakeFontSymbol(35,0,12,"Webdings",0,0) вот так должно сработать
Towahawk
А не подскажете, для присвоения заливки полигону там сначала прописывается pen а потом Brush?
как должно поменяться:
Sub OKSkdnS
dim ob as object
dim tb as string
dim aa as alias
dim n,i as integer
n=SelectionInfo(SEL_INFO_NROWS)
if n=0 then exit sub end if
tb=SelectionInfo(SEL_INFO_SELNAME)
for i=1 to n
Fetch Rec i From tb
aa=tb & ".obj"
ob=aa
Alter Object ob Info OBJ_INFO_PEN,MakePen (2, 6, 0) & ", " &
OBJ_INFO_BRUSH, MakeBrush (75, 14680064)
Update tb Set obj=ob Where rowid=i
Update Selection Set Xк = 12
next
nikomuro
Ошибку в таком варианте выдает?