Как "нарезать" *.bmp?

[dr-kvn]

Здравствуйте!

Подскажите, пожалуйста, такую беду (вопросов несколько по одной теме):
1. Как правильно (оптимально и короче с точки зрения кодинга) "вытаскивать" картинки из "ленточных" bmp-шек? Это мое авторское эксклюзивное название, я не знаю, как они правильно называются в приложении - res.bmp. Затем нужно вставить их в определенные контролы, да чтоб они не вставлялись в виде картинки на своем фоне, как все bmp-шки, а чтоб была графика на фоне контрола. Для этого, я понимаю, нужно перевести bmp в ico. Заходить в графические редакторы, резать все на отдельные bmp-шки, переводить в *.ico - муторно. Я нашел на этом сайте примеров, много наскачивал, натолкнулся на один (в приложении в папке [Original/Ico from Bmp]), как "резать" картинку на составляющие с помощью PictureClip-контрола [папка Original/RedTop] - из дистрибутива VB5). В папке [My] - мои "изыскания".
Понимаю, что это пример "неправильного" программирования, на уровне Copy/Paste, но я недавно знаком с VB, а с API-шками незнаком вообще. Грубо говоря, слепил вместе два примера.
Скажите, такой код, как в высланном приложении, оптимален? В общем-то, он небольшой по размерам... А если нет, то как, подскажите. Только на деревенском языке желательно, я походил по этому сайту - я далеко не все умные слова знаю

2. Почему в основной проге у меня не получается вставить картинки в закладки SSTab, на месте их - белые пустые квадратики? (См. в приложении "11.ipg")

3. Как правильно программно вставлять bmp-шки из "ленты" в ImageList, чтобы затем воткнуть их в кнопки Toolbar'а? В ImageList есть своя функция "очистки" от фона, но как вогнать в него все из файла ресурсов?

Если по отдельности, и с диска, то получается хорошо:

Код: Выделить всё

Dim imgX As ListImage

Set imgX = ImageList1.ListImages.Add(, , LoadPicture(App.Path & "/a.bmp"))
Set imgX = ImageList1.ListImages.Add(, , LoadPicture(App.Path & "/b.bmp"))
Set imgX = ImageList1.ListImages.Add(, , LoadPicture(App.Path & "/c.bmp"))
Toolbar1.Buttons(1).Image = 1
Toolbar1.Buttons(2).Image = 2
Toolbar1.Buttons(3).Image = 3

А если я "ленту" сажу в ресурс, то не знаю как вытащить их оттуда - LoadResPicture не помогает. А я с ресурсом привык уже...

[kibernetics]

dr-kvn
а зачем тебе из ресурса ещё вставлять в ImageList?
Храни картинки сразу в ImageList'e.

[Бяка]

на форму кидаеш свою SSTab1 с твоего примера
кидаеш два пикчур бокса

"ленту" кидаеш в Picture1 задоеш ему автосайз - труе
второй пиктурбокс обзываеш Pic
и кидаеш етот код, и всё работает

Код: Выделить всё

Option Explicit

Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Dim MaskColor As Long, i As Integer

Private Sub Form_Load()
Me.ScaleMode = 3
Pic.Width = 16
Pic.Height = 16
Pic.AutoRedraw = True
MaskColor = RGB(192, 192, 192)
For i = 0 To 9
    Call CustomPic(i)
    SSTab1.TabPicture(i) = Pic.Image
Next i
End Sub

Sub CustomPic(index As Integer)
Dim x, y, tempColor
Pic.Cls
    For x = 0 To 16 - 1
        For y = 0 To 16 - 1
            tempColor = GetPixel(Picture1.hdc, x + 16 * i, y)
            ' Если цвет текущего пиксела не совпадает с цветом маски
            If MaskColor <> tempColor Then
                ' В зависимости от цветом маски переносим картинку
                Call SetPixel(Pic.hdc, x, y, tempColor)
            End If
        Next
    Next
End Sub

[Бяка]

чуть незабыл, там гдето в начале присобачь ету строку:

Код: Выделить всё

Pic.BackColor = SSTab1.BackColor

[alibek]

Да, рисовать по пикселу это наверное очень круто.
Но я все-таки посоветую использовать хоть PaintPicture.

[Бяка]

ну, дык, круче чем PaintPicture, ладно, ненравится вот на TransparentBlt

Код: Выделить всё

Option Explicit

Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean

Dim MaskColor As Long, i As Integer

Private Sub Form_Load()
Me.ScaleMode = 3
Pic.Width = 16
Pic.Height = 16
Pic.BackColor = SSTab1.BackColor
Pic.AutoRedraw = True
Picture1.ScaleMode = vbPixels
Pic.BackColor = SSTab1.BackColor
MaskColor = RGB(192, 192, 192)
For i = 0 To 9
    Call CustomPic(i)
    SSTab1.TabPicture(i) = Pic.Image
Next i
End Sub

Sub CustomPic(index As Integer)
Dim x, y, tempColor
Pic.Cls
TransparentBlt Pic.hdc, 0, 0, 16, 16, Picture1.hdc, 16 * index, 0, 16, 16, MaskColor
End Sub

[Antonariy]

Есть специальный контрол, который нарезает картинки, MS PictureClip называется. Ему нужно только указать сколько строк и столбцов в картинке, и можно обращаться к нужному куску как к элементу двухмерного массива. Специально для ленивых.

[Хакер]

Автор топика ведь о нём знает?

[Бяка]

Есть специальный контрол, который нарезает картинки, MS PictureClip называется. Ему нужно только указать сколько строк и столбцов в картинке, и можно обращаться к нужному куску как к элементу двухмерного массива. Специально для ленивых.

Автору нуна ешо и фон на рисунке убрать PictureClip - это лишний контрол, кста афтар его в примере использует

[Antonariy]

В пример я не заглядывал

[dr-kvn]

Здравствуйте!
Блин, И-нет что-то глючит последнее время, сразу не мог ответить.

kibernetics

а зачем тебе из ресурса ещё вставлять в ImageList?
Храни картинки сразу в ImageList'e.

Я пробовал, но ImageList сжимает всю "ленту" в размер иконки 16х16, или 32х32, или... т.д. А если хранить отдельно каждую картинку - см. мой вопрос - муторно нарезать в фотошопе или где еще.

А с PictureClip я все же не ощибся, значица

Спасибо Вам всем преогромнейшее! С Новым Годом!

[Бяка]

dr-kvn
а ты пробовал тот код шо я привёл? http://bbs.vbstreets.ru/viewtopic.php?p=6683665#6683665

[dr-kvn]

Здравствуйте, уважаемые форумчане!

Уважаемый Бяка! Я пробовал оба твоих кода, и вот что получилось (см. в приложении Scr.jpg,Scr1.jpg,Scr2.jpg), а иногда в примере с TransparentBlt вместо обрезанных картинок высвечиваются какие-то обрезанные символы, причем не относящиеся к тому или иному алфавиту (технические?).

Вот такая беда. Может, у меня не тот релиз VB, или чего другого? На компе установлен WinXP SP2 Professional. Может, он корявый?

С уважением - dr-kvn

[Atoman]

Код: Выделить всё

Picture1.AutoRedraw = True 'Вот так будкт работать

[dr-kvn]

Во-о-он чо!
Спасибо!