VBNet - Форум - Помогите модифицировать функцию. Бьюсь целый день(

Вопрос: Помогите модифицировать функцию. Бьюсь целый день( Добавлено: 17.02.05 13:12

Автор вопроса: dimoon | Web-сайт: dimoon.by.ru

Тупой вопрос. Бьюсь уже целый день и нифига. Помогите, кто может!!!

Есть очень быстрая функция вращения картинки FoxRotate (см.ниже), вызывается она следующим образом

FoxRotate picturebox2.hDc, picturebox2.width, picturebox2.height, picturebox1.hDc, picturebox1.Image.handle, &HFF00FF, 35, True + chkRotSmooth * 2

(на форме должно быть 2 picturebox, с параметрами autosize=true, autoredraw=true и scalemode=pixel)
Содержимое bas-модуля

Option Explicit

Global Const SRCCOPY = &HCC0020
Global Const Pi = 3.14159265359
Declare Function SetPixel Lib "gdi32" (ByVal hDc As Integer, ByVal x As Integer, ByVal y As Integer, ByVal crColor As Long) As Long
Declare Function GetPixel Lib "gdi32" (ByVal hDc As Integer, ByVal x As Integer, ByVal y As Integer) As Long
Declare Function StretchBlt% Lib "gdi32" (ByVal hDc%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal xSrc%, ByVal ySrc%, ByVal nSrcWidth%, ByVal nSrcHeight%, ByVal dwRop&)
Public Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hDCDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hDCsrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal crTransparent As Long) As Long

Public Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type

Public Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type

Public Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type

Public Declare Function GetTickCount Lib "kernel32" () As Long
Public 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
Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function SetDIBits Lib "gdi32" (ByVal hDc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hDc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDc As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public 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
Public Declare Function SelectObject Lib "gdi32" (ByVal hDc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hDc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Global Const PIDEG As Double = 1.74532925199433E-02
Public Function FoxRotate(ByVal DstDC As Long, ByVal DstX As Long, ByVal DstY As Long, ByVal SrcDC As Long, ByVal SrcBmp As Long, ByVal TransColor As Long, ByVal Angle As Double, Optional ByVal Flags As Long) As Long
Dim TmpDC As Long, TmpBmp As Long, OldObject As Long
Dim BitCount As Long, BitCount2 As Long, LineWidth As Long, LineWidth2 As Long
Dim retVal As Long
Dim Width As Long, Height As Long, NewSize As Long
Dim H As Long, b As Long, F As Long, D As Long, i As Long
Dim dx1 As Double, dy1 As Double
Dim TransR As Byte, TransG As Byte, TransB As Byte
Dim TempAlpha As Byte
Dim Info As BITMAPINFO, Info2 As BITMAPINFO
Dim SrcBits() As Byte, TmpBits() As Byte

TransR = TransColor And &HFF
TransG = (TransColor And &HFF00&) / 255
TransB = (TransColor And &HFF0000) / 65536
Info.bmiHeader.biSize = Len(Info.bmiHeader)
Info2.bmiHeader.biSize = Len(Info2.bmiHeader)
retVal = GetDIBits(SrcDC, SrcBmp, 0, 0, ByVal 0, Info, 0)
If retVal = 0 Then Exit Function
TmpDC = CreateCompatibleDC(SrcDC)
Width = Info.bmiHeader.biWidth
Height = Info.bmiHeader.biHeight
NewSize = Math.Sqr(Width ^ 2 + Height ^ 2) + 2

TmpBmp = CreateCompatibleBitmap(SrcDC, NewSize, NewSize)
If TmpBmp Then
OldObject = SelectObject(TmpDC, TmpBmp)
BitBlt TmpDC, 0, 0, NewSize, NewSize, DstDC, DstX - NewSize / 2, DstY - NewSize / 2, vbSrcCopy

Info.bmiHeader.biBitCount = 24
Info.bmiHeader.biCompression = 0
Info2.bmiHeader.biBitCount = 24
Info2.bmiHeader.biCompression = 0
Info2.bmiHeader.biPlanes = 1
Info2.bmiHeader.biHeight = NewSize
Info2.bmiHeader.biWidth = NewSize

LineWidth = Width * 3
If (LineWidth Mod 4) Then LineWidth = LineWidth + 4 - (LineWidth Mod 4)
BitCount = LineWidth * Height

LineWidth2 = NewSize * 3
If (LineWidth2 Mod 4) Then LineWidth2 = LineWidth2 + 4 - (LineWidth2 Mod 4)
BitCount2 = LineWidth2 * NewSize

ReDim SrcBits(BitCount - 1)
ReDim TmpBits(BitCount2 - 1)
GetDIBits SrcDC, SrcBmp, 0, Height, SrcBits(0), Info, 0
GetDIBits TmpDC, TmpBmp, 0, NewSize, TmpBits(0), Info2, 0

Dim CurOffset As Long
Dim NewX As Double, NewY As Double
Dim Xmm As Long, Ymm As Long
Dim I1 As Long
Dim v1 As Boolean
dx1 = Cos(Angle * PIDEG)
dy1 = Sin(Angle * PIDEG)

For H = 0 To NewSize - 1
CurOffset = LineWidth2 * H
For b = 0 To NewSize - 1
F = CurOffset + 3 * b
NewX = Width / 2 + (b - NewSize / 2) * dx1 - (H - NewSize / 2) * dy1
NewY = Height / 2 + (b - NewSize / 2) * dy1 + (H - NewSize / 2) * dx1

Xmm = Int(NewX + 0.5)
Ymm = Int(NewY + 0.5)
If (Xmm >= 0) And (Xmm < Width) And (Ymm >= 0) And (Ymm < Height) Then
v1 = True
I1 = LineWidth * Ymm + 3 * Xmm
If Flags And &H1 Then
v1 = Not (SrcBits(I1 + 2) = TransR And SrcBits(I1 + 1) = TransG And SrcBits(I1) = TransB)
End If
If v1 Then For D = 0 To 2: TmpBits(F + D) = SrcBits(I1 + D): Next D
End If
Next b
Next H

SetDIBitsToDevice DstDC, DstX - NewSize / 2, DstY - NewSize / 2, NewSize, NewSize, 0, 0, 0, NewSize, TmpBits(0), Info2, 0
Erase SrcBits
Erase TmpBits
DeleteObject SelectObject(TmpDC, OldObject)
End If
DeleteDC TmpDC
End Function

Трабла: как сделать, чтоб картинка после поворота оказывалась не в центре picturebox (как сейчас) а у верхнего левого угла? Помогите, plz! Я что то нифига понять не могу

p.s. Функция очень быстрая, имхо, ее даже в FAQ можно!
Ответить

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

Номер ответа: 1 Автор ответа: Comanche Вопросов: 87 Ответов: 459	Профиль \| \| #1	Добавлено: 17.02.05 15:59
	В двух местах - при вызовах BitBlt и SetDIBitsToDevice - замени "stX - NewSize / 2" и "stY - NewSize / 2" на НУЛИ! PS: не сказал бы я, что она такая уж шустрая... Ответить

Номер ответа: 2 Автор ответа: AgentFire ICQ: 192496851 Вопросов: 75 Ответов: 3178	Профиль \| \| #2	Добавлено: 17.02.05 22:05
	Самая быстрая – PlgBlt, но только на 2000, ХР и выше... хотя выше не куда Ответить

Номер ответа: 3 Автор ответа: dimoon Вопросов: 32 Ответов: 19	Web-сайт: dimoon.by.ru Профиль \| \| #3	Добавлено: 17.02.05 23:21
	2Commanche, однако не помогло! Немного отьехала картинка в сторону, но все равно не в плотную к верхнему левому углу А у тебя работает? Ответить

Номер ответа: 4 Автор ответа: Comanche Вопросов: 87 Ответов: 459	Профиль \| \| #4	Добавлено: 18.02.05 13:09
	Уменьшь не до нуля, а ещё меньше - уйди вообще в минус по иксу и игреку Ответить

Страница: 1 |