Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 | 2 |

 

  Вопрос: BitBlt + RasterOp Constants. Качество наложения. Добавлено: 10.06.10 00:37  

Автор вопроса:  AWP | Web-сайт: xawp.narod.ru | ICQ: 345685652 
Одна картинка накладывается на другую с использование (констант/фильтров/хз чего) vbSrcInvert, vbSrcAnd или vbMergePaint, но качество, как будто 8и битное...

Можно ли как-нибудь изменить качество наложений?

для наглядности прилагаю картинку: http://www.vbcode.h1.ru/images/123.jpg

Ответить

  Ответы Всего ответов: 18  

Номер ответа: 1
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #1 		Добавлено: 10.06.10 02:40
Ты, кажется, вообще не то, что нужно используешь.
Try this, Luke
  1. Option Explicit
  2. 'Private Type BLENDFUNCTION
  3. '  BlendOp As Byte
  4. '  BlendFlags As Byte
  5. '  SourceConstantAlpha As Byte
  6. '  AlphaFormat As Byte
  7. 'End Type
  8. Private Const AC_SRC_OVER As Long = &H0
  9. Private Const AC_SRC_ALPHA As Long = &H1
  10. Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdcDest As Long, ByVal xDest As Long, ByVal yDest As Long, ByVal WidthDest As Long, ByVal HeightDest As Long, ByVal hdcSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long, ByVal Blendfunc As Long) As Long
  11.  
  12. Private Sub Command1_Click()
  13.     Dim tBF As Long
  14.     tBF = BLENDFUNCTION(, , 128)
  15.     Call AlphaBlend(Picture2.hDC, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture1.hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, tBF)
  16.     Picture2.Refresh
  17. End Sub
  18.  
  19. Private Function BLENDFUNCTION(Optional ByRef BlendOp As Byte = AC_SRC_OVER, _
  20.                                         Optional ByRef BlendFlags As Byte = 0, _
  21.                                         Optional ByRef SourceConstantAlpha As Byte, _
  22.                                         Optional ByRef AlphaFormat As Byte = 0) As Long
  23.     BLENDFUNCTION = CLng(AlphaFormat) * &H1000000 Or CLng(SourceConstantAlpha) * &H10000 Or CLng(BlendFlags) * &H100 Or BlendOp
  24. End Function
  25.  
  26. Private Sub Form_Load()
  27.     Picture1.ScaleMode = vbPixels
  28.     Picture2.ScaleMode = vbPixels
  29.     Picture2.AutoRedraw = True
  30. End Sub
Накладывает пикчер1 на пикчер2 с прозрачностью 128/255

Ответить

Номер ответа: 2
Автор ответа:
 AWP



ICQ: 345685652 

Вопросов: 96
Ответов: 1212
  Web-сайт: xawp.narod.ru
 Профиль | | #2 		Добавлено: 10.06.10 11:43
мне не прозрачность нужна. но есть тут есть разные BLEND-функции, то мне подойдет. они есть?

Ответить

Номер ответа: 3
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #3 		Добавлено: 10.06.10 12:45
AWP, наложить одну картинку на другую с прозрачностью - это и есть бленд - смешивание, не?
Тебе что нужно конкретно?

Ответить

Номер ответа: 4
Автор ответа:
 AWP



ICQ: 345685652 

Вопросов: 96
Ответов: 1212
  Web-сайт: xawp.narod.ru
 Профиль | | #4 		Добавлено: 10.06.10 13:04
Мне нужны логические операции с картинкой, пита vbSrcInvert, vbSrcAnd, vbMergePaint, я же в нулевом после написал.
Но функцией bitblt они работают с искажениями.

а blend это не только прозрачность, это все функции смешивания/наложения. Но AlphaBlend дает только один из них(точнее два, еще есть добавление, аналог vbSrcAnd).

Ответить

Номер ответа: 5
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #5 		Добавлено: 10.06.10 20:33
Если бы bitblt работала с искажениями, это бы давно поправили. Тут чистая математика: "Combines the colors of the source and destination rectangles by using the Boolean XOR operator."
Я получил по сути то же http://imagebin.org/index.php?mode=image&id=100787
верхний рисунок p3 и нижний p4 одинаковые

Ответить

Номер ответа: 6
Автор ответа:
 AWP



ICQ: 345685652 

Вопросов: 96
Ответов: 1212
  Web-сайт: xawp.narod.ru
 Профиль | | #6 		Добавлено: 10.06.10 20:54
использовал почти тотже код
  1. Private Type nrgb
  2.   R As Byte
  3.   G As Byte
  4.   B As Byte
  5. End Type
  6. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
  7. Private Sub Command1_Click()
  8. Dim X As Long, Y As Long, I1 As Long, I2 As Long
  9. Dim c1 As nrgb, c2 As nrgb
  10.   For Y = 0 To pc1.Width
  11.     For X = 0 To pc1.Height
  12.       I1 = pc1.Point(X, Y)
  13.       I2 = pc2.Point(X, Y)
  14.       CopyMemory c1, I1, 3
  15.       CopyMemory c2, I2, 3
  16.       pc1.PSet (X, Y), RGB(c1.R And c2.R, c1.G And c2.G, c1.B And c2.B)
  17.     Next
  18.   Next
  19. End Sub

Все верно, но сама картинка тебе не кажется странной?

Ответить

Номер ответа: 7
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #7 		Добавлено: 10.06.10 21:53
AWP, ну если подумать над тем как работает XOR - 0+0=0 0+1=1 1+1=0, то картинка не выглядит такой уж странной.
у тебя кстати не xor, а and - 0*X=0 1*1=1. И еще я предполагаю, что можно было обойтись
...
pc1.PSet (X, Y), pc1.Point(X, Y) And pc2.Point(X, Y)
...

Ответить

Номер ответа: 8
Автор ответа:
 AWP



ICQ: 345685652 

Вопросов: 96
Ответов: 1212
  Web-сайт: xawp.narod.ru
 Профиль | | #8 		Добавлено: 11.06.10 00:13
да, я там просто эксперементировал.

Ответить

Номер ответа: 9
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #9 		Добавлено: 11.06.10 02:15
интересно как попошоп делает. Получается, что черный и белый полностью прозрачны

Ответить

Номер ответа: 10
Автор ответа:
 AWP



ICQ: 345685652 

Вопросов: 96
Ответов: 1212
  Web-сайт: xawp.narod.ru
 Профиль | | #10 		Добавлено: 11.06.10 02:35
фотошоп делает просто, выводит разницу цветов abs(r1-r2).

Ответить

Номер ответа: 11
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #11 		Добавлено: 12.06.10 02:09
тогда только черный был бы прозрачным

Ответить

Номер ответа: 12
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #12 		Добавлено: 12.06.10 02:25
прозрачный черный и белый. на фотошоп не похоже)
http://imagebin.org/index.php?mode=image&id=100959
  1. Option Explicit
  2. Private Sub Command1_Click()
  3.     Dim i As Long, j As Long, v1 As Long, v2 As Long
  4.     Dim r1 As Integer, g1 As Integer, b1 As Integer, r2 As Integer, g2 As Integer, b2 As Integer
  5.     Dim rr As Integer, gg As Integer, bb As Integer
  6.     For i = 0 To p3.ScaleWidth - 1
  7.         For j = 0 To p3.ScaleHeight - 1
  8.             v1 = p1.Point(i, j)
  9.             v2 = p2.Point(i, j)
  10.             PRS v1, r1, g1, b1
  11.             PRS v2, r2, g2, b2
  12.             rr = Abs(r1 - IIf(r2 > 128, 255 - r2, r2))
  13.             gg = Abs(g1 - IIf(g2 > 128, 255 - g2, g2))
  14.             bb = Abs(b1 - IIf(b2 > 128, 255 - b2, b2))
  15.             p3.PSet (i, j), RGB(rr, gg, bb)
  16.         Next
  17.     Next
  18. End Sub
  19.  
  20. Public Function PRS(ByVal toon As Long, ByRef punane As Integer, ByRef rohene As Integer, ByRef sinine As Integer) As Boolean
  21.     If toon >= 0 And 16777215 >= toon Then
  22.         punane = toon Mod 256
  23.         rohene = (toon And -16711936) / 256
  24.         sinine = (toon And 16711680) / 65536
  25.         PRS = True
  26.     Else
  27.         punane = -1
  28.         rohene = -1
  29.         sinine = -1
  30.         PRS = False
  31.     End If
  32. End Function
вообще я не понимаю. Почему белый прозрачный, а чуть сероватый становится голубым

Ответить

Номер ответа: 13
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #13 		Добавлено: 12.06.10 02:31
м, вот статья про смешение цветов в Photoshop http://balbesof.net/article/a-68.html

Ответить

Номер ответа: 14
Автор ответа:
 AWP



ICQ: 345685652 

Вопросов: 96
Ответов: 1212
  Web-сайт: xawp.narod.ru
 Профиль | | #14 		Добавлено: 12.06.10 12:39
ну да...
Difference- Отображает тональную разницу между содержимым двух слоев, удаляя светлые пиксели из какого-либо из слоев. В результате получается темная и иногда перевернутая картинка.

но все равно не понятно как оно белый убирает.

Ответить

Номер ответа: 15
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #15 		Добавлено: 12.06.10 14:10
Вот самое приближенное к нужному http://imagebin.org/index.php?mode=image&id=100996
  1. Option Explicit
  2. Private Type nrgb
  3.   R As Byte
  4.   G As Byte
  5.   B As Byte
  6. End Type
  7. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
  8. 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
  9. Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  10.  
  11. Private Sub Command1_Click()
  12.     Dim i As Long, j As Long, v1 As Long, v2 As Long
  13.     Dim c1 As nrgb, c2 As nrgb, c3 As nrgb
  14.     For i = 0 To p3.ScaleWidth - 1
  15.         For j = 0 To p3.ScaleHeight - 1
  16.             CopyMemory c1, GetPixel(p1.hdc, i, j), 3
  17.             CopyMemory c2, GetPixel(p2.hdc, i, j), 3
  18.             c3.R = Abs(c1.R - IIf(c2.R = 255, 0, c2.R))
  19.             c3.G = Abs(c1.G - IIf(c2.G = 255, 0, c2.G))
  20.             c3.B = Abs(c1.B - IIf(c2.B = 255, 0, c2.B))
  21.             SetPixel p3.hdc, i, j, RGB(c3.R, c3.G, c3.B)
  22.         Next j
  23.     Next i
  24.     p3.Refresh
  25. End Sub

Ответить

Страница: 1 | 2 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам