|
|
Trapez verzerren
|
Mit diesem Script haben Sie die Möglichkeit, beliebige Bilder in alle Richtungen getrennt zu verzerren.
Laden Sie sich die Zip-Datei mit VB 6 Source Code hinunter und probieren Sie es mal aus.
Projekt - Download |
 Quell-Code Form1
|
'Erstellen Sie folgende Steuerelemente:
'Form Form1, Line PolySide, PictureBox PicDummy,
'PictureBox Picture1, PictureBox Picture2,
Option Explicit
Private vScaleX1&, vScaleY1&, vScaleX2&, vScaleY2&
Private vScaleX3&, vScaleY3&, vScaleX4&, vScaleY4&
Dim X_Point As Long
Dim Y_Point As Long
'-- Form1, Picture1, Picture2, PicDammy,
'-- PolyPoint(0) -> PictureBox 13x13px, PolySide(0) -> Line
Private Sub Form_Load()
Dim i%
Me.ScaleMode = 3
With Picture1
.Width = 480
.Height = 400
.AutoRedraw = True
.ScaleMode = 3
End With
With Picture2
.Width = 150
.Height = 150
.AutoRedraw = True
.ScaleMode = 3
End With
With PicDummy
.Width = 150
.Height = 150
.AutoRedraw = True
.ScaleMode = 3
End With
PolySide(0).BorderColor = vbRed
For i = 1 To 3
Load PolySide(i)
Load PolyPoint(i)
PolySide(i).Visible = True
PolyPoint(i).Visible = True
Next
vScaleX1 = 200
vScaleY1 = 200
vScaleX2 = 300
vScaleY2 = 200
vScaleX3 = 300
vScaleY3 = 300
vScaleX4 = 200
vScaleY4 = 300
Call vRefresh
PolyPoint_MouseDown 0, 1, 0, 1, 1
PolyPoint_MouseMove 0, 1, 0, 1, 1
PolyPoint_MouseUp 0, 1, 0, 1, 1
End Sub
Private Sub PolyPoint_MouseDown(Index As Integer, Button As Integer, _
Shift As Integer, X As Single, Y As _
Single)
X_Point = X
Y_Point = Y
End Sub
Private Sub PolyPoint_MouseMove(Index As Integer, Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Dim iW&, iH&
On Error Resume Next
If Button = 1 Then
PolyPoint(Index).Left = PolyPoint(Index).Left + _
(X - X_Point) / Screen.TwipsPerPixelX
PolyPoint(Index).Top = PolyPoint(Index).Top + _
(Y - Y_Point) / Screen.TwipsPerPixelY
'-- Koordinaten für die Punkte (PicRefresh)
If Index = 0 Then
vScaleX1 = CLng(PolyPoint(0).Left + PolyPoint(0).Width)
vScaleY1 = CLng(PolyPoint(0).Top + PolyPoint(0).Height)
ElseIf Index = 1 Then
vScaleX2 = CLng(PolyPoint(1).Left)
vScaleY2 = CLng(PolyPoint(1).Top + PolyPoint(0).Height)
ElseIf Index = 2 Then
vScaleX3 = CLng(PolyPoint(2).Left)
vScaleY3 = CLng(PolyPoint(2).Top)
ElseIf Index = 3 Then
vScaleX4 = CLng(PolyPoint(3).Left + PolyPoint(0).Width)
vScaleY4 = CLng(PolyPoint(3).Top)
End If
'-- Koordinaten innerhalb von DIBDummy bestimmen.
If vScaleX1 < vScaleX4 Then
vSelX1 = 0
vSelX4 = vScaleX4 - vScaleX1
Else
vSelX1 = vScaleX1 - vScaleX4
vSelX4 = 0
End If
If vScaleX1 < vScaleX4 Then
vSelX2 = vScaleX2 - vScaleX1
vSelX3 = vScaleX3 - vScaleX1
Else
vSelX2 = vScaleX2 - vScaleX4
vSelX3 = vScaleX3 - vScaleX4
End If
If vSelX2 > vSelX3 Then
iW = vSelX2
Else
iW = vSelX3
End If
If vScaleY1 < vScaleY2 Then
vSelY1 = 0
vSelY2 = vScaleY2 - vScaleY1
Else
vSelY1 = vScaleY1 - vScaleY2
vSelY2 = 0
End If
If vScaleY1 < vScaleY2 Then
vSelY4 = vScaleY4 - vScaleY1
vSelY3 = vScaleY3 - vScaleY1
Else
vSelY4 = vScaleY4 - vScaleY2
vSelY3 = vScaleY3 - vScaleY2
End If
If vSelY4 > vSelY3 Then
iH = vSelY4
Else
iH = vSelY3
End If
PicDummy.Cls
PicDummy.Width = iW
PicDummy.Height = iH
'Läuft mit einer DIB wesendlich schneller !!!
' Call Trapez(Picture2, PicDummy)
Call vRefresh
End If
End Sub
Private Sub PolyPoint_MouseUp(Index As Integer, Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Dim iW&, iH&
Picture1.MousePointer = 11
PicDummy.Cls
Call Trapez(Picture2, PicDummy)
Call vRefresh
If vScaleX1 < vScaleX4 Then
iW = vScaleX1
Else
iW = vScaleX4
End If
If vScaleY1 < vScaleY2 Then
iH = vScaleY1
Else
iH = vScaleY2
End If
Picture1.Cls
BitBlt Picture1.hDC, iW, iH, PicDummy.Width, PicDummy.Height, _
PicDummy.hDC, 0, 0, vbSrcCopy
Picture1.MousePointer = 0
End Sub
Private Sub vRefresh()
PolySide(0).X1 = vScaleX1
PolySide(0).Y1 = vScaleY1
PolySide(0).X2 = vScaleX2
PolySide(0).Y2 = vScaleY2
PolyPoint(0).Left = vScaleX1 - PolyPoint(0).Width
PolyPoint(0).Top = vScaleY1 - PolyPoint(0).Height
PolySide(1).X1 = vScaleX2
PolySide(1).Y1 = vScaleY2
PolySide(1).X2 = vScaleX3
PolySide(1).Y2 = vScaleY3
PolyPoint(1).Left = vScaleX2
PolyPoint(1).Top = vScaleY2 - PolyPoint(0).Height
PolySide(2).X1 = vScaleX3
PolySide(2).Y1 = vScaleY3
PolySide(2).X2 = vScaleX4
PolySide(2).Y2 = vScaleY4
PolyPoint(2).Left = vScaleX3
PolyPoint(2).Top = vScaleY3
PolySide(3).X1 = vScaleX4
PolySide(3).Y1 = vScaleY4
PolySide(3).X2 = vScaleX1
PolySide(3).Y2 = vScaleY1
PolyPoint(3).Left = vScaleX4 - PolyPoint(0).Width
PolyPoint(3).Top = vScaleY4
End Sub
|
 Quell-Code ModTrapez
|
Option Explicit
Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, ByVal Y As Long) As Long
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 vSelX1&, vSelY1&, vSelX2&, vSelY2&, vSelX3&, vSelY3&, vSelX4&, vSelY4&
Public Sub Trapez(oDIBSrc As PictureBox, oDIBDst As PictureBox)
Dim ii%, iJ%, ix1!, iy1!, ix2!, iy2!, gX&, gY&, xRand&, yRand&, yKorr&
On Error Resume Next
For iJ = 0 To oDIBDst.Height
If vSelX1 < vSelX4 Then '\
'-- Die linke Schräge berechnen.
ix1 = Int(iJ * (vSelX4 / oDIBDst.Height))
Else '/
ix1 = Int((oDIBDst.Height - iJ) * (vSelX1 / oDIBDst.Height))
End If
If vSelX2 > vSelX3 Then
'-- Die rechte Schräge berechnen.
ix2 = (oDIBDst.Height - iJ) * ((vSelX2 - vSelX3) / oDIBDst.Height)
'-- Den rechten Rand zwischen Schräge und Picture2.Width
'bestimmen sowie die linke Schräge abziehen.
xRand = (vSelX3 - oDIBSrc.Width) - ix1
Else
ix2 = iJ * ((vSelX3 - vSelX2) / oDIBDst.Height)
xRand = (vSelX2 - oDIBSrc.Width) - ix1
End If
For ii = 0 To oDIBDst.Width
If vSelY1 < vSelY2 Then
iy1 = Int(ii * (vSelY2 / oDIBDst.Width))
Else
iy1 = Int((oDIBDst.Width - ii) * (vSelY1 / oDIBDst.Width))
End If
If vSelY3 > vSelY4 Then
iy2 = ii * ((vSelY3 - vSelY4) / oDIBDst.Width)
yRand = (vSelY4 - oDIBSrc.Height) - iy1
Else
iy2 = (oDIBDst.Width - ii) * ((vSelY4 - vSelY3) / oDIBDst.Width)
yRand = (vSelY3 - oDIBSrc.Height) - iy1
End If
'-- Ergebnis für linke Schräge proportional zur Schleife (iI%)
'-- ins Verhältnis setzen.
gX = Int(ii * (oDIBSrc.Width / (oDIBSrc.Width + ix2 + xRand)))
gY = Int(iJ * (oDIBSrc.Height / (oDIBSrc.Height + iy2 + yRand)))
'-- Innerhalb von Picture2 auslesen.
If gX > 0 And gX < oDIBSrc.ScaleWidth - 1 And gY > 0 And _
gY < oDIBSrc.ScaleHeight - 3 Then
'-- ************ Fehlerkorrektur ****************************
If vSelX1 < vSelX4 Then
If (iJ + iy1) = yKorr Or (iJ + iy1) + 1 = yKorr Then
If gY + 1 < oDIBSrc.Height Then
SetPixel oDIBDst.hDC, ii + ix1, iJ + iy1 + 1, _
GetPixel(oDIBSrc.hDC, gX, gY + 1)
End If
End If
Else
If gY + 1 < oDIBSrc.Height Then
SetPixel oDIBDst.hDC, ii + ix1, iJ + iy1 + 1, _
GetPixel(oDIBSrc.hDC, gX, gY + 1)
End If
If gY + 2 < oDIBSrc.Height Then
SetPixel oDIBDst.hDC, ii + ix1, iJ + iy1 + 2, _
GetPixel(oDIBSrc.hDC, gX, gY + 2)
End If
If gY + 3 < oDIBSrc.Height Then
SetPixel oDIBDst.hDC, ii + ix1, iJ + iy1 + 3, _
GetPixel(oDIBSrc.hDC, gX, gY + 3)
End If
End If
'-- ******************************************************
SetPixel oDIBDst.hDC, ii + ix1, iJ + iy1, _
GetPixel(oDIBSrc.hDC, gX, gY)
yKorr = iJ + iy1
End If
Next ii
Next iJ
End Sub
|
|
|