Мобильная версия форумов
Открыть
 −7°C
завтра: −7°C
Погода в Перми
−7°C
днем−7°C
вечером−6°C
завтра−7°C
Подробно
 66,70
+0.1615
Курс USD ЦБ РФна 16 февраля
66,7044
+0.1615
 75,25
+0.2021
Курс EUR ЦБ РФна 16 февраля
75,2492
+0.2021
PRM.Форум /Компьютеры Интернет Связь / Программирование /

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

  • junior

    Сообщений: 5

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

  • member

    Сообщений: 73

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

  • junior

    Сообщений: 5

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


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

  • member

    Сообщений: 73

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

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

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

  • junior

    Сообщений: 5

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

  • junior

    Сообщений: 5

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

  • member

    Сообщений: 73

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

  • junior

    Сообщений: 5

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

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

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

Модератор: