Красивейший Alpha Selection Box - кто дошлифует?

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
giaber
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 107
Зарегистрирован: 14.01.2009 (Ср) 13:51

Красивейший Alpha Selection Box - кто дошлифует?

Сообщение giaber » 12.06.2017 (Пн) 17:10

Тут мне днём bon818 подкинул контрол - скроллинг-контейнер, автором контрола оказался Leandro I. Ascierto, я зашёл к нему на сайт - очень понравилось! В гугле набираем "Leandro I. Ascierto" - первым же пунктом выходит его сайт. Вбиваем в поиске (в верхнем правом углу) "DrawAlphaSelection", жмём на лупу - выходит страничка с примером ОЧЕНЬ красивого Selection Box-а. Но эти Selection Box-ы приведены статические - то есть при Form Paint просто рисуются несколько штук разных цветов. Я никак не смог прицепить это к MouseMove, чтоб растягивающийся Selection Box рисовался так сказать динамически, вслед за курсором. Может кто-нибудь доработает код? Уж очень красивая штучка! Я написал самому автору просьбу и в комментах и на страничке Contact, но после 2016 года автор не пополнял свой сайт - так что может и не ответит. На всякий случай привожу код здесь:
Хотел прицепить картинку, но не понял как это сделать...


Код: Выделить всё
Option Explicit
 
'=========Gdi32 Api========
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function GdiAlphaBlend Lib "gdi32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long
Private Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
'=========user32 Api========
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
 
'=========Oleaut32 Api========
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long
 
'=========Kernel32 Api========
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
 
Private Type UcsRgbQuad
    R                       As Byte
    G                       As Byte
    B                       As Byte
    a                       As Byte
End Type
 
Private Type BLENDFUNCTION
    BlendOp                 As Byte
    BlendFlags              As Byte
    SourceConstantAlpha     As Byte
    AlphaFormat             As Byte
End Type
 
Private Sub DrawAlphaSelection(hdc As Long, ByVal X As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long, ByVal Color As OLE_COLOR)
 
    Dim BF                  As BLENDFUNCTION
    Dim hDCMemory           As Long
    Dim hBmp                As Long
    Dim hOldBmp             As Long
    Dim DC                  As Long
    Dim lColor              As Long
    Dim hPen                As Long
    Dim hBrush              As Long
    Dim lBF                 As Long
 
    BF.SourceConstantAlpha = 128
 
    DC = GetDC(0)
    hDCMemory = CreateCompatibleDC(0)
    hBmp = CreateCompatibleBitmap(DC, Width, Height)
    hOldBmp = SelectObject(hDCMemory, hBmp)
 
    hPen = CreatePen(0, 1, Color)
    hBrush = CreateSolidBrush(pvAlphaBlend(Color, vbWhite, 120))
    DeleteObject SelectObject(hDCMemory, hBrush)
    DeleteObject SelectObject(hDCMemory, hPen)
    Rectangle hDCMemory, 0, 0, Width, Height
 
    CopyMemory VarPtr(lBF), VarPtr(BF), 4
    GdiAlphaBlend hdc, X, y, Width, Height, hDCMemory, 0, 0, Width, Height, lBF
 
    SelectObject hDCMemory, hOldBmp
    DeleteObject hBmp
    ReleaseDC 0&, DC
    DeleteDC hDCMemory
    DeleteObject hPen
    DeleteObject hBrush
 
End Sub
 
Private Function pvAlphaBlend(ByVal clrFirst As Long, ByVal clrSecond As Long, ByVal lAlpha As Long) As Long
 
    Dim clrFore             As UcsRgbQuad
    Dim clrBack             As UcsRgbQuad
 
    OleTranslateColor clrFirst, 0, VarPtr(clrFore)
    OleTranslateColor clrSecond, 0, VarPtr(clrBack)
    With clrFore
        .R = (.R * lAlpha + clrBack.R * (255 - lAlpha)) / 255
        .G = (.G * lAlpha + clrBack.G * (255 - lAlpha)) / 255
        .B = (.B * lAlpha + clrBack.B * (255 - lAlpha)) / 255
    End With
    CopyMemory VarPtr(pvAlphaBlend), VarPtr(clrFore), 4
 
End Function
 
Private Sub Form_Paint()
    Cls
    DrawAlphaSelection Me.hdc, 10, 50, 100, 200, vbRed
    DrawAlphaSelection Me.hdc, 50, 30, 200, 100, vbBlue
    DrawAlphaSelection Me.hdc, 200, 80, 100, 100, vbGreen
    DrawAlphaSelection Me.hdc, 80, 200, 200, 30, vbYellow
    DrawAlphaSelection Me.hdc, 130, 70, 50, 200, vbMagenta
End Sub

pronto
Постоялец
Постоялец
 
Сообщения: 597
Зарегистрирован: 04.12.2005 (Вс) 6:20
Откуда: Владивосток

Re: Красивейший Alpha Selection Box - кто дошлифует?

Сообщение pronto » 12.06.2017 (Пн) 17:47

Допилить-то, да, можно... только... giaber, не пытайся сделать сразу всё — прикрутить это, то, вот это тоже и так далее. Сосредоточься на функционале. Не пытайся объять необъятное. Пусть всё будет топорненько, но полностью функционально. А красивости можно будет потом добавлять. Постепенно.
Да, ко мне можно обращаться на «ты»
O, sancta simplicitas!

giaber
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 107
Зарегистрирован: 14.01.2009 (Ср) 13:51

Re: Красивейший Alpha Selection Box - кто дошлифует?

Сообщение giaber » 12.06.2017 (Пн) 18:16

Георгий меня зовут, эти ники ... Нда-а-а, pronto... Это моё проклятие по жизни - вот это всё, о чём ты говоришь. Но, в оправдание своё - в своём PicSword-е я закончил блок деления картинки на куски верт-ми и гориз-ми линиями и теперь как раз хочу начать блок выделения частей картинки прямоугольными блоками которые могут и пресекаться (типа - фишка), и поэтому, прежде чем начать, хочу определиться каким именно способом будет происходить выделение. Впрочем, ты всё равно прав - обычный Selection, не альфа, я же умею делать - так и надо продолжать с обычным, а когда узнется, как альфа-вариант делается - изменить. Но раз уж поднял тему - не убивать же её!

TheWatcher
Новичок
Новичок
Аватара пользователя
 
Сообщения: 29
Зарегистрирован: 27.08.2012 (Пн) 0:53
Откуда: Республика Беларусь

Re: Красивейший Alpha Selection Box - кто дошлифует?

Сообщение TheWatcher » 14.06.2017 (Ср) 11:10

Леандро, слава Богу, жив и здоров, как и его VB-форумы.

Прямая ссылка на форум VB6 здесь.

Форум испаноязычный (латиноамериканский), но сам Леандро (ник LeandroA) и несколько активных членов пишут также и по-английски, так что вопросы можно задавать прямо на основном форуме. Главное -- уметь это делать по-английски. Для тех, кто это может, подсказка: в отличие от русского, Гугл-Транслейт прекрасно переводит с испанского на английский и обратно, поэтому любой топик и форумы в целом можно также прочесть на английском, воспользовавшись этим сервисом.

Основной блог Леандро и форумы содержат массу красивейших программ и полезных утилит, а также модулей различной степени сложности, а сам автор и его коллеги весьма общительны и благожелательны к новичкам. Вообще говоря, латиноамериканская ветка VB6 сейчас, пожалуй, одна из самых активных в глобальном масштабе.
TheWatcher
=========
3.6GHz Core i5-3470, 16GB RAM / GTX 1060, 6GB VRAM
x86 Win XP Pro Sp3 / x64 Win 7 Ult Sp1 / x64 Ubuntu 16.04

pronto
Постоялец
Постоялец
 
Сообщения: 597
Зарегистрирован: 04.12.2005 (Вс) 6:20
Откуда: Владивосток

Re: Красивейший Alpha Selection Box - кто дошлифует?

Сообщение pronto » 14.06.2017 (Ср) 11:35

Набросал пример, как менять размеры фигур мышью.
Вложения
Тяни-бросай.rar
(2.99 Кб) Скачиваний: 176
O, sancta simplicitas!

pronto
Постоялец
Постоялец
 
Сообщения: 597
Зарегистрирован: 04.12.2005 (Вс) 6:20
Откуда: Владивосток

Re: Красивейший Alpha Selection Box - кто дошлифует?

Сообщение pronto » 15.06.2017 (Чт) 6:50

Добавил привязку координат фигуры к координатам сетки.
Вложения
Тяни-бросай_v2.rar
(3.32 Кб) Скачиваний: 185
O, sancta simplicitas!

giaber
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 107
Зарегистрирован: 14.01.2009 (Ср) 13:51

Re: Красивейший Alpha Selection Box - кто дошлифует?

Сообщение giaber » 16.06.2017 (Пт) 8:28

pronto! Большое спасибо за примеры! К сожалению, у меня несколько "горячих" деньков выдалось - ещё не было времени разбираться, и собенно тема снаппинга к гриду - ОЧЕНЬ интересна для меня, я там параллельно резалке картин ещё одну прогу для себя ваяю - там без снаппинга никак. Ещё раз БОЛЬШОЕ спасибо!

Но вообще тема доработки именно Альфа Селекшена - очень хотелось бы! Уверен, там для нормального прогера на пол-часа работы. Автор Леандро пока молчит.

TheWatcher - и вам большое спасибо за информацию!


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: AhrefsBot, Google-бот, Mail.ru [бот], Old_Maple, Yandex-бот и гости: 13

    TopList  
cron