| Вопрос: Из VC++ в VB | Добавлено: 31.03.05 21:48 |
Автор вопроса:  SyavX
|
|
Попробывал перевести пример c VC++ на VB (правда с примитивными знаниями C):
>http://rsdn.ru/article/files/Functions/mctranspblt/mctranspblt_source.zip Мне даже показалось что у меня получилось, но... Почему-то CreateBitmap постоянно возвращает 0 ? (Соответственно пример не работает) Может там параметры не совсем те? Кому не влом - гляньте Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long Private Declare Function StretchBlt Lib "gdi32" (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 dwRop As Long) As Long Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Function McTransparentBlt(hdcDest As Long, nXOriginDest As Integer, nYOriginDest As Integer, _ nWidthDest As Integer, nHeightDest As Integer, hdcSrc As Long, _ nXOriginSrc As Integer, nYOriginSrc As Integer, nWidthSrc As Integer, _ nHeightSrc As Integer, crTransparent As Long) As Boolean Dim tmp As Long Dim bExitCode As Boolean bExitCode = True If ((hdcDest = 0) Or (hdcSrc = 0)) Then McTransparentBlt = False End If Dim hdcMask As Long hdcMask = 0 Dim hdcTmpSrc As Long hdcTmpSrc = 0 Dim hbmTransMask As Long hbmTransMask = 0 Dim oldhbmTransMask As Long oldhbmTransMask = 0 Dim hbmTmpSrc As Long hbmTmpSrc = 0 Dim oldhbmTmpSrc As Long oldhbmTmpSrc = 0 Dim OldBkColor As Long OldBkColor = SetBkColor(hdcDest, RGB(255, 255, 255)) Dim OldTextColor As Long OldTextColor = SetTextColor(hdcDest, RGB(0, 0, 0)) '# Step 0 hdcMask = CreateCompatibleDC(hdcDest) If (hdcMask = 0) Then bExitCode = False GoTo ClearUp End If hdcTmpSrc = CreateCompatibleDC(hdcSrc) If (hdcTmpSrc = 0) Then bExitCode = False GoTo ClearUp End If hbmTmpSrc = CreateCompatibleBitmap(hdcDest, nWidthSrc, nHeightSrc) If (hbmTmpSrc = 0) Then bExitCode = False GoTo ClearUp End If oldhbmTmpSrc = SelectObject(hdcTmpSrc, hbmTmpSrc) tmp = BitBlt(hdcTmpSrc, 0, 0, nWidthSrc, nHeightSrc, hdcSrc, nXOriginSrc, nYOriginSrc, vbSrcCopy) If (tmp = 0) Then bExitCode = False GoTo ClearUp End If '############################# hbmTransMask = CreateBitmap(nWidthSrc, nHeightSrc, 1, 1, 0) If (hbmTransMask = 0) Then bExitCode = False GoTo ClearUp End If '############################# oldhbmTransMask = SelectObject(hdcMask, hbmTransMask) '# Step 1 Call SetBkColor(hdcTmpSrc, crTransparent) tmp = BitBlt(hdcMask, 0, 0, nWidthSrc, nHeightSrc, hdcTmpSrc, 0, 0, vbSrcCopy) If (tmp = 0) Then bExitCode = False GoTo ClearUp End If '# Step 3 If (crTransparent <> RGB(0, 0, 0)) Then Call SetBkColor(hdcTmpSrc, RGB(0, 0, 0)) Call SetTextColor(hdcTmpSrc, RGB(255, 255, 255)) tmp = BitBlt(hdcTmpSrc, 0, 0, nWidthSrc, nHeightSrc, hdcMask, 0, 0, vbSrcAnd) If (tmp = 0) Then bExitCode = False GoTo ClearUp End If End If '# Step 4 If ((nWidthDest = nWidthSrc) And (nHeightDest = nHeightSrc)) Then tmp = BitBlt(hdcDest, nXOriginDest, nYOriginDest, nWidthSrc, nHeightSrc, hdcMask, 0, 0, vbSrcAnd) If (tmp = 0) Then bExitCode = False GoTo ClearUp End If tmp = BitBlt(hdcDest, nXOriginDest, nYOriginDest, nWidthSrc, nHeightSrc, hdcTmpSrc, 0, 0, vbSrcPaint) If (tmp = 0) Then bExitCode = False GoTo ClearUp End If Else tmp = StretchBlt(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest, hdcMask, 0, 0, nWidthSrc, nHeightSrc, vbSrcAnd) If (tmp = 0) Then bExitCode = False GoTo ClearUp End If tmp = StretchBlt(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest, hdcTmpSrc, 0, 0, nWidthSrc, nHeightSrc, vbSrcPaint) If (tmp = 0) Then bExitCode = False GoTo ClearUp End If End If ClearUp: If (hdcMask) Then If (oldhbmTransMask) Then Call SelectObject(hdcMask, oldhbmTransMask) End If Call DeleteDC(hdcMask) End If If (hbmTmpSrc) Then If (oldhbmTmpSrc) Then Call SelectObject(hdcTmpSrc, oldhbmTmpSrc) End If Call DeleteObject(hbmTmpSrc) End If If (hdcTmpSrc) Then Call DeleteDC(hdcTmpSrc) End If If (hbmTransMask) Then Call DeleteObject(hbmTransMask) End If Call SetBkColor(hdcDest, OldBkColor) Call SetTextColor(hdcDest, OldTextColor) McTransparentBlt = bExitCode End Function |
| Ответы | Всего ответов: 2 |
|
Номер ответа: 1 Автор ответа:  sne Разработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445 |
Web-сайт: Профиль | Цитата | #1 | Добавлено: 31.03.05 21:54 |
Не зна, у меня он возвратил не ноль  ) Но вообще по идее вызов должен быть такой:
hbmTransMask = CreateBitmap(nWidthSrc, nHeightSrc, 1, 1, ByVal 0)
|
||
|
Номер ответа: 2 Автор ответа: SyavX Вопросов: 25 Ответов: 149 |
Профиль | Цитата | #2 | Добавлено: 31.03.05 22:36 |
|
Тю блин, работает
с примитивными знаниями VB
|
||
Страница: 1 |