form1.frm

很好的教程原代码！

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7950
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10365
   LinkTopic       =   "Form1"
   ScaleHeight     =   7950
   ScaleWidth      =   10365
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Picture2 
      Height          =   6375
      Left            =   5400
      ScaleHeight     =   6315
      ScaleWidth      =   4875
      TabIndex        =   3
      Top             =   0
      Width           =   4935
   End
   Begin VB.PictureBox Picture1 
      Height          =   6375
      Left            =   120
      Picture         =   "Form1.frx":0000
      ScaleHeight     =   6315
      ScaleWidth      =   4995
      TabIndex        =   2
      Top             =   0
      Width           =   5055
   End
   Begin VB.CommandButton Command2 
      Caption         =   "仅旋转图形"
      Height          =   495
      Left            =   5280
      TabIndex        =   1
      Top             =   6840
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "旋转区域"
      Height          =   495
      Left            =   3360
      TabIndex        =   0
      Top             =   6840
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function PlgBlt Lib "gdi32" (ByVal hdcDest As Long, _
    lpPoint As POINTAPI, _
    ByVal hdcSrc As Long, _
    ByVal nXSrc As Long, _
    ByVal nYSrc As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hbmMask As Long, _
    ByVal xMask As Long, _
    ByVal yMask As Long) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type
Const pi = 3.14159265358979
Dim dThetaDeg As Double
'以下只适用於NT/XP
Private Sub Command1_Click()
Picture2.Refresh
Dim pt(1 To 3) As POINTAPI, p4 As POINTAPI
Dim dx As Long, dy As Long
Dim i As Long, offsetX As Long, offsetY As Long
Dim sida As Double
Dim MaxX As Long, MaxY As Long, MinX As Long, MinY As Long

sida = dThetaDeg * pi / 180
dx = Me.ScaleX(Picture1.Picture.Width, vbHimetric, vbPixels)
dy = Me.ScaleX(Picture1.Picture.Height, vbHimetric, vbPixels)
pt(1).x = dy * Sin(sida)
pt(1).y = dy - dy * Cos(sida)
pt(2).x = pt(1).x + dx * Cos(sida)
pt(2).y = pt(1).y + dx * Sin(sida)
pt(3).x = 0: pt(3).y = dy

'p4不用在pt()之阵列，它是由pt(1)-pt(3)所推出
p4.x = pt(3).x + dx * Cos(sida)
p4.y = pt(3).y + dx * Sin(sida)

'以下的工作只是为了让旋转後的图在Picture2的中间显示
MaxX = IIf(pt(1).x > pt(2).x, pt(1).x, pt(2).x)
MaxX = IIf(MaxX > pt(3).x, MaxX, pt(3).x)
MaxX = IIf(MaxX > p4.x, MaxX, p4.x)
MinX = IIf(pt(1).x < pt(2).x, pt(1).x, pt(2).x)
MinX = IIf(MinX < pt(3).x, MinX, pt(3).x)
MinX = IIf(MinX < p4.x, MinX, p4.x)

MaxY = IIf(pt(1).y > pt(2).y, pt(1).y, pt(2).y)
MaxY = IIf(MaxY > pt(3).y, MaxY, pt(3).y)
MaxY = IIf(MaxY > p4.y, MaxY, p4.y)
MinY = IIf(pt(1).y < pt(2).y, pt(1).y, pt(2).y)
MinY = IIf(MinY < pt(3).y, MinY, pt(3).y)
MinY = IIf(MinY < p4.y, MinY, p4.y)
offsetX = (Picture2.ScaleWidth - MaxX + MinX) \ 2 - MinX
offsetY = (Picture2.ScaleHeight - (MaxY - MinY)) \ 2 - MinY
pt(1).x = pt(1).x + offsetX: pt(1).y = pt(1).y + offsetY
pt(2).x = pt(2).x + offsetX: pt(2).y = pt(2).y + offsetY
pt(3).x = pt(3).x + offsetX: pt(3).y = pt(3).y + offsetY

i = PlgBlt(Picture2.hDC, pt(1), Picture1.hDC, 0, 0, dx, dy, 0, 0, 0)
End Sub

'这个方适合98/NT/XP都可行
Private Sub Command2_Click()
Picture2.Refresh
Dim nX As Integer, nY As Integer
    Dim nX1 As Integer, nY1 As Integer
    Dim dX2 As Double, dY2 As Double
    Dim dX3 As Double, dY3 As Double

    Dim dThetaRad As Double

    dThetaRad = -dThetaDeg * pi / 180
    For nX = 0 To Picture2.ScaleWidth
    nX1 = nX - Picture2.ScaleWidth \ 2
    For nY = 0 To Picture2.ScaleHeight
        nY1 = nY - Picture2.ScaleHeight \ 2
        dX2 = nX1 * Cos(-dThetaRad) + nY1 * Sin(-dThetaRad)
        dY2 = nY1 * Cos(-dThetaRad) - nX1 * Sin(-dThetaRad)
        dX3 = dX2 + Picture1.ScaleWidth \ 2
        dY3 = dY2 + Picture1.ScaleHeight \ 2
        If dX3 > 0 And dX3 < Picture1.ScaleWidth - 1 _
        And dY3 > 0 And dY3 < Picture1.ScaleHeight - 1 Then
        Picture2.PSet (nX, nY), Picture1.Point(dX3, dY3)
        End If
    Next nY
    Next nX
End Sub

Private Sub Form_Load()
Picture1.ScaleMode = 3
Picture2.ScaleMode = 3
'设定旋转角度
dThetaDeg = 30
Picture1.Picture = LoadPicture(App.Path + "\mypic.bmp")

End Sub