Jag hittade en kod, där man skulle kunna rotera en bild. Hur jag än gör, så får jag OVERFLOW.
<code>
Private Declare Function SetPixel Lib "GDI32" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "GDI32" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
Private 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&)

Picture2.Cls
px% = Picture1.ScaleWidth
py% = Picture1.ScaleHeight
retval% = StretchBlt(Picture2.hDC, px%, 0, -px%, py%, Picture1.hDC, 0, 0, px%, py%, SRCCOPY)


Sub bmp_rotate(pic1 As PictureBox, pic2 As PictureBox, ByVal theta!)
' bmp_rotate(pic1, pic2, theta)
' Rotate the image in a picture box.
' pic1 is the picture box with the bitmap to rotate
' pic2 is the picture box to receive the rotated bitmap
' theta is the angle of rotation
Dim c1x As Integer, c1y As Integer
Dim c2x As Integer, c2y As Integer
Dim a As Single
Dim p1x As Integer, p1y As Integer
Dim p2x As Integer, p2y As Integer
Dim n As Integer, r As Integer

c1x = pic1.ScaleWidth \ 2
c1y = pic1.ScaleHeight \ 2
c2x = pic2.ScaleWidth \ 2
c2y = pic2.ScaleHeight \ 2

If c2x < c2y Then n = c2y Else n = c2x
n = n - 1
pic1hDC% = pic1.hDC
pic2hDC% = pic2.hDC

For p2x = 0 To n
For p2y = 0 To n
If p2x = 0 Then a = Pi / 2 Else a = Atn(p2y / p2x)
r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)
p1x = r * Cos(a + theta!)
p1y = r * Sin(a + theta!)
c0& = GetPixel(pic1hDC%, c1x + p1x, c1y + p1y)
c1& = GetPixel(pic1hDC%, c1x - p1x, c1y - p1y)
c2& = GetPixel(pic1hDC%, c1x + p1y, c1y - p1x)
c3& = GetPixel(pic1hDC%, c1x - p1y, c1y + p1x)
If c0& <> -1 Then xret& = SetPixel(pic2hDC%, c2x + p2x, c2y + p2y, c0&)
If c1& <> -1 Then xret& = SetPixel(pic2hDC%, c2x - p2x, c2y - p2y, c1&)
If c2& <> -1 Then xret& = SetPixel(pic2hDC%, c2x + p2y, c2y - p2x, c2&)
If c3& <> -1 Then xret& = SetPixel(pic2hDC%, c2x - p2y, c2y + p2x, c3&)
Next
t% = DoEvents()
Next
End Sub
</code>
Några förslag?

hmm..testa byt ut alla Integer mot Long

/bj

Bra tips, men ingen skillnad.

Hej
Du har en gammal StretchBlt
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

Const ScrCopy = &HCC0020
Byt ut

/Sven

Miss av mig,sorry.
Men du har så rätt SvenP det var den raden som han hängde upp sig på.
<code>
retval% = StretchBlt(Picture2.hDC, px%, 0, -px%, py%, Picture1.hDC, 0, 0, px%, py%, SRCCOPY)
</code>
Men om jag använder ditt förslag, så får jag felet att typdeclaration charaktar does not match declared datatype.

Och då sitter jag väll där...

Jag har hittat en annan kod som jag skall försöka med:
http://www.ur.co.nz/urcorp/default.asp?pageid=10&data_article=167
Tack i allafall

Hej
Den raden bör se ut så här med den nya StretchBlt

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

Const SRCCOPY = &HCC0020

retval& = StretchBlt(Picture2.hDC, px&, 0&, -px&, py&, Picture1.hDC, 0&, 0&, px&, py&, SRCCOPY)
/Sven
Det finns fungerande StretchBlit exempel i Filarean, lite sökjob löser det mesta.
DS

Se Programarkivet:Stretch BitBlitter API
/Sven

Jag är inte säker på att jag förstår hur du menar med det.

Du skall använda den StretchBlt och retval ,jag visar ovan.
Du får ju börja med att lösa Owerflow innan du kan fortsätta.
Öppna och kolla Programarkivet:Stretch BitBlitter API så ser du hur det funkar.
Nok om detta nu får du börja tänka.
/Sven

Det beror på att du deklarat parametrarna till SetPixel och GetPixel som integer när det ska vara long. Eftersom hDC är 32 bitars blir det ofast större än ettt integer. Försök med:
<code>
Option Explicit

Private Const Pi As Single = 3.14159265358979

Private Declare Function SetPixel Lib "GDI32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "GDI32" (ByVal hDC As Long, ByVal X As Long, ByVal Y 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)

Sub RotateBitmap(pic1 As PictureBox, pic2 As PictureBox, ByVal theta As Single)
' bmp_rotate(pic1, pic2, theta)
' Rotate the image in a picture box.
' pic1 is the picture box with the bitmap to rotate
' pic2 is the picture box to receive the rotated bitmap
' theta is the angle of rotation
Dim c1x As Long, c1y As Long
Dim c2x As Long, c2y As Long
Dim a As Single
Dim p1x As Long, p1y As Long
Dim p2x As Long, p2y As Long
Dim pic1hDC As Long, pic2hDC As Long
Dim n As Long, r As Long
Dim c0 As Long, c1 As Long, c2 As Long, c3 As Long
Dim xret As Long

c1x = pic1.ScaleWidth \ 2
c1y = pic1.ScaleHeight \ 2
c2x = pic2.ScaleWidth \ 2
c2y = pic2.ScaleHeight \ 2

If c2x < c2y Then
n = c2y
Else
n = c2x
End If
n = n - 1
pic1hDC = pic1.hDC
pic2hDC = pic2.hDC

For p2x = 0 To n
For p2y = 0 To n
If p2x = 0 Then
a = Pi / 2
Else
a = Atn(p2y / p2x)
End If
r = Sqr(1 * p2x * p2x + 1 * p2y * p2y)
p1x = r * Cos(a + theta)
p1y = r * Sin(a + theta)
c0 = GetPixel(pic1hDC, c1x + p1x, c1y + p1y)
c1 = GetPixel(pic1hDC, c1x - p1x, c1y - p1y)
c2 = GetPixel(pic1hDC, c1x + p1y, c1y - p1x)
c3 = GetPixel(pic1hDC, c1x - p1y, c1y + p1x)
If c0 <> -1 Then xret = SetPixel(pic2hDC, c2x + p2x, c2y + p2y, c0)
If c1 <> -1 Then xret = SetPixel(pic2hDC, c2x - p2x, c2y - p2y, c1)
If c2 <> -1 Then xret = SetPixel(pic2hDC, c2x + p2y, c2y - p2x, c2)
If c3 <> -1 Then xret = SetPixel(pic2hDC, c2x - p2y, c2y + p2x, c3)
Next
DoEvents
Next
End Sub
</code>

Jag vet inte om jag förstår dig riktigt, men jag försöker att kalla på funktionen så här
<code>
Call RotateBitmap(Picture1, Picture2, 3.14 / 4)
</code>
Allt jag får är som ett smallt kors, ingenting mera.
Har jag missuppfattat???

Du kan prova att ändra Picture2 till autoredraw. Picture2.AutoRedraw = True

Du bör oxå ändra till RotateBitmap:
<code>
c1x = pic1.ScaleX(pic1.ScaleWidth \ 2, pic1.ScaleMode, vbPixels)
c1y = pic1.ScaleX(pic1.ScaleHeight \ 2, pic1.ScaleMode, vbPixels)
c2x = pic2.ScaleX(pic2.ScaleWidth \ 2, pic2.ScaleMode, vbPixels)
c2y = pic2.ScaleX(pic2.ScaleHeight \ 2, pic2.ScaleMode, vbPixels)
</code>
För att göra den oberoende av ScaleMode.

Ledsen, men ingen skillnad.
Jag undrar, kallar jag på den på ett korrekt sätt?

Call RotateBitmap(Picture1, Picture2, 3.14 / 4)

Jag har lagt upp ett exempel i filarean. Du kan ju ladda ned det och se vad som skiljer:
Programarkivet:Rotera en Picturebox

Du skall ha tack för att du försöker, men det fungerar inte som jag ville.
Jag försöker att göra ett litet spel till min sonson.
Spelet går ut på att styra en raket, men vad som inte fungerar är att jag ville ändra riktning.
Picture 1 är en behållare för hur picture2 skall se ut.
Jag styr med pilarna.
<code>
modul:
Public kLeft As Boolean
Public kRight As Boolean
Public kUp As Boolean
Public kDown As Boolean
Public Speed As Single
(+ din modul)
i formuläret:

Private Sub Timer1_Timer()
Dim theta As Double, grad As Long
If kUp = True Then
If Picture2.Top <= 0 Then
Exit Sub
Else
Picture2.Top = Picture2.Top - Speed
End If
Picture1.Cls
Set Picture1.Picture = LoadPictureResource(103, "Custom")
Picture2.Picture = Picture1.Picture
Else
Picture1.Picture = LoadPictureResource(102, "Custom")
Picture2.Picture = Picture1.Picture
End If


If kDown = True Then
If Picture2.Top >= 490 Then
Exit Sub
Else
Picture2.Top = Picture2.Top + Speed
End If
Picture1.Cls
Set Picture1.Picture = LoadPictureResource(104, "Custom")
Picture2.Picture = Picture1.Picture

End If
If kLeft = True Then
If Picture2.Left <= 0 Then
Exit Sub
Else
Picture2.Left = Picture2.Left - Speed
Picture2.Cls
Call RotateBitmap(Picture1, Picture2, 3.14 / 2)
Picture2.AutoSize = True
End If


End If
If kRight = True Then
If Picture2.Left >= 634 Then ' - 100 Then
Exit Sub
Else
Picture2.Left = Picture2.Left + Speed
Picture2.Cls
Call RotateBitmap(Picture1, Picture2, 3.14 / -2)
Picture2.AutoSize = True
End If

End If
End Sub
</code>
Som det nu är, så när jag håller pittangent till vänster, så visas halva pilden fladrande.(värdena stämer inte riktigt). Jag skulle vilja att man genom att trycker t ex vänster pil så ändras raketen bara lite grand, och ju mera man trycker på piltangenten, ju mera skall raketen vridas.
Är detta omöjligt i VB?

Det kommer inte bli något bra resultat med funktionen. Vrid bilden i ett externt ritprogramm och växla bild istället. komer vara enklar, snyggare och snabbare. ;o)