15°C
завтра: 19°C
Погода в Перми
15°C
утром15°C
днем19°C
завтра19°C
Подробно
 66,00
+0.1054
Курс USD ЦБ РФна 17 августа
65,9961
+0.1054
 73,22
−0.2323
Курс EUR ЦБ РФна 17 августа
73,2227
−0.2323
PRM.Форум /Компьютеры Интернет Связь / Программирование /

Кто программирует или программировал на MapBasic, откликнитесь

  • Кто программирует или программировал на MapBasic, откликнитесь

  • Я занимался некоторое время. Что интересует?

  • Имеется код на 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


    Заранее спасибо

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

    MakeFontSymbol(35,0,12,"Webdings",0,0) вот так должно сработать

    Исправлено пользователем Towahawk (16.01.14 11:21)

  • спасибо, сейчас попробую

  • А не подскажете, для присвоения заливки полигону там сначала прописывается 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 (16.01.14 17:04)

  • Ошибку в таком варианте выдает?

  • вообще не компилирует...

Записей на странице:

Перейти в форум

Модератор: