form1.frm

这里有很多很实用的VB编程案例,方便大家学习VB.

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "旋转图像"
   ClientHeight    =   3345
   ClientLeft      =   2415
   ClientTop       =   3405
   ClientWidth     =   5895
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3345
   ScaleWidth      =   5895
   Begin VB.PictureBox Picture2 
      Height          =   1815
      Left            =   3000
      ScaleHeight     =   1755
      ScaleWidth      =   2115
      TabIndex        =   4
      Top             =   360
      Width           =   2175
   End
   Begin VB.PictureBox Picture1 
      Height          =   1815
      Left            =   600
      Picture         =   "form1.frx":0000
      ScaleHeight     =   1755
      ScaleWidth      =   2115
      TabIndex        =   3
      Top             =   360
      Width           =   2175
   End
   Begin VB.CommandButton Command3 
      Caption         =   "45度"
      Height          =   495
      Left            =   4080
      TabIndex        =   2
      Top             =   2520
      Width           =   1575
   End
   Begin VB.CommandButton Command2 
      Caption         =   "垂直"
      Height          =   495
      Left            =   2160
      TabIndex        =   1
      Top             =   2520
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "水平"
      Height          =   495
      Left            =   240
      TabIndex        =   0
      Top             =   2520
      Width           =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
               Const SRCCOPY = &HCC0020
               Const Pi = 3.14159265359
               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&)
Sub bmp_rotate(pic1 As PictureBox, pic2 As PictureBox, ByVal theta!)
                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
Sub Form_Load()
    Picture1.ScaleMode = 3
    Picture2.ScaleMode = 3
End Sub


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


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

Sub Command3_Click()
    Picture2.Cls
    Call bmp_rotate(Picture1, Picture2, 3.14 / 4)
End Sub