Vanhaa kuvan pyörittämistä moitittiin hitaaksi, joten tein uuden nopeamman. Tällä kertaa pisteiden uudet paikat lasketaan suoraan trigonometrisillä funktioilla ja ohjelma käyttää WinApin grafiikkakomentoja SetPixel ja GetPixel - pyörittäminen onkin selvästi nopeampaa. Toisaalta ohjelmasta tuli niin sekava, etten edes itse enää ymmärrä sitä kunnolla. Pääasia että toimii :)
Formille tarvitaan samat kontrollit kuin alkuperäisessä vinkissäkin, eli kaksi PictureBoxia (pK ja pL), CommandButton (Command1) ja TextBox (tK). PictureBoxien Scalemode tulee olla 3 - Pixel.
DefDbl A-Z
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 Sub Command1_Click()
keskix = pK.Width / 2
keskiy = pK.Height / 2
lkeskix = pL.Width / 2
lkeskiy = pL.Height / 2
leveys = pL.Width / 2
korkeus = pL.Height / 2
pii = 4 * Atn(1)
kulma = (-CDbl(tK) - 180 - 45) * (pii / 180)
pK.Cls
ux1 = keskix + Sin(kulma) * leveys * 0.75
uy1 = keskiy + Cos(kulma) * korkeus * 0.75
ux2 = keskix + Sin(kulma + pii / 2) * leveys * 0.75
uy2 = keskiy + Cos(kulma + pii / 2) * korkeus * 0.75
ux3 = keskix + Sin(kulma + pii) * leveys * 0.75
uy3 = keskiy + Cos(kulma + pii) * korkeus * 0.75
ux4 = keskix + Sin(kulma - pii / 2) * leveys * 0.75
uy4 = keskiy + Cos(kulma - pii / 2) * korkeus * 0.75
xa1 = (ux2 - ux1) / leveys
ya1 = (uy2 - uy1) / leveys
xa2 = (ux4 - ux1) / korkeus
ya2 = (uy4 - uy1) / korkeus
For i = 0 To leveys * 2 Step 0.7
For j = 0 To korkeus * 2 Step 0.6
vari = GetPixel(pL.hdc, leveys * 2 - i, j)
If vari <> -1 Then
x = SetPixel(pK.hdc, ux1 + xa1 * i + xa2 * j + 20, uy1 + ya1 * i + ya2 * j - 20, vari)
End If
Next
DoEvents
Next
End SubMiten sen saa reunaan?
Tämä ei kyllä mulla heitä errorii mutta ei kyllä teekään mitään...
(VB 6)
??????????????????????????????????
Ware versio?
kulma = (-CDbl(tK) - 180 - 45) * (pii / 180) valittaa tästä.
Type mismatch.
onko toi GetPixel ja SetPixel samat kuin vanhat tutut Point ja Pset? loistava keksintö toi gdi32
Hey hey... niinhän se menee että siihen loppuun tarvitaan joillakin koneilla se pK.Refresh että näyttää kivemmalta
Hey hey... niinhän se menee että siihen loppuun tarvitaan joillakin koneilla se pK.Refresh että näyttää kivemmalta
niin ja sitten picturelaatikot vielä AutoRedrawiksi
ei toimi ei... vb6.. ja wareversio...
mitä puhvelille kuuluu?
Aihe on jo aika vanha, joten et voi enää vastata siihen.