APopov
Зарегистрирован: 19.06.2006
Сообщения: 347
Откуда: Самара
|
 Добавлено: Ср 15 Окт 2014 17:18 Заголовок сообщения: |
 |
|
вот основные куски кода, которые должны вам помочь
| Код: | sub LoadLayerStylePics (Layer, WorkDir, loadedPicsCount)
dim style, painter, i, j, pic, picData, ext, fn
for i=0 to Layer.Styles.count-1
set style = Layer.Styles(i)
for j=0 to style.Painters.Count-1
set painter = style.Painters(j)
set pic = GetSinglePic(painter)
if not(pic is nothing) then
fn = GetFileNameForPic(WorkDir, Layer, style, painter, "")
if sysUtils.fileExists( fn + ".bmp") then
pic.Picture = sysUtils.ReadBinaryFile( fn + ".bmp")
loadedPicsCount = loadedPicsCount + 1
else
'пока в 4.4 нельзя загрузить ч/з апи из файла что-то кроме bmp
end if
painter.Comment = "" 'чтоб стиль увидел, что он изменился.
end if
next
style.Update
next
Layer.update
end sub
'----sysUtils
Sub WriteBinaryToFile(binaryData, aFN)
Const adSaveCreateOverWrite = 2
With CreateObject("ADODB.Stream")
.Type = 1 'adTypeBinary
.Open
.Write binaryData
.SaveToFile aFN, adSaveCreateOverWrite
.Close
End With
End Sub
Function ReadBinaryFile(filename)
Dim bArr
With CreateObject("ADODB.Stream")
.Type = 1 'adTypeBinary
.Open
.LoadFromFile filename
bArr = .Read
.Close
ReadBinaryFile = bArr
End With
End Function
|
_________________
ОАО "Самара-Информспутник",
инженер-программист Попов Артем |
|
FAQ
Поиск
Пользователи
Группы
Регистрация
Профиль
Войти и проверить личные сообщения
Вход
