'Declare Function Arc Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
'Declare Function Chord Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private 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
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nwidth As Long, ByVal nheight As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nwidth As Long, ByVal nheight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nwidth As Long, ByVal nheight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
'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
'Declare Function GetPaletteEntries Lib "gdi32" (ByVal hPalette As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
'Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject 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 SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
'Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
'Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long'Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
'Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
'Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
'Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
'Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
'Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
'Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
'Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
'Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
'Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Const SRCCOPY = &HCC0020
Const BLACKNESS = &H42&
Const SrcPaint = &HEE0086
Const SRCAND = &H8800C6
Const SRCINVERT = &H660046
Dim a, b, c, d, e, f, g, r, pi, zz, cx, cy, bx, by, zr, sc, drawcolor, Sscr&, stool, ww, tool, gbs, x1, y1, sx, sy, deg, ims, ti, Sh, Sw, scv, Picwidth, Picheight, Bm&, tp&, tmp&
Dim Px, Py, S, Ital, Wt, Ht, Thick, Esc, Ul, Fontuse, Fbc, Dm, FilcolorSub Rotate()
Rot.ScaleMode = 3
Rem this routine draws the square one side at a time
Rem by = center Y of bitmap and bx = center X of the bitmap
Rem e = Work Box center X and f = Work Box center Y
Rem a holds the Degrees and b = right side c = Bottom d = left side
Rem zx and zy are just temparary variables
pi = 4 * Atn(1): pi = (pi / 180): a = deg: b = (deg + 90): c = (deg + 180): d = (deg + 270)
e = (Form1.Rot.ScaleWidth / 2) - 2: f = (Form1.Rot.ScaleHeight / 2) - 2: Form1.Rot.DrawWidth = 1
zx = (by * Sin(a * pi) + e): zy = (by * Cos(a * pi) + f)
Form1.Rot.Line (-bx * Sin((a + 90) * pi) + zx, -bx * Cos((a + 90) * pi) + zy)-(bx * Sin((a + 90) * pi) + zx, bx * Cos((a + 90) * pi) + zy), QBColor(10)
zx = (bx * Sin(b * pi) + e): zy = (bx * Cos(b * pi) + f):
Form1.Rot.Line (-by * Sin((b + 90) * pi) + zx, -by * Cos((b + 90) * pi) + zy)-(by * Sin((b + 90) * pi) + zx, by * Cos((b + 90) * pi) + zy), QBColor(10)
zx = (by * Sin(c * pi) + e): zy = (by * Cos(c * pi) + f)
Form1.Rot.Line (-bx * Sin((c + 90) * pi) + zx, -bx * Cos((c + 90) * pi) + zy)-(bx * Sin((c + 90) * pi) + zx, bx * Cos((c + 90) * pi) + zy), QBColor(10)
zx = (bx * Sin(d * pi) + e): zy = (bx * Cos(d * pi) + f)
Form1.Rot.Line (-by * Sin((d + 90) * pi) + zx, -by * Cos((d + 90) * pi) + zy)-(by * Sin((d + 90) * pi) + zx, by * Cos((d + 90) * pi) + zy), QBColor(10)
Text1.Text = " " + Str$(deg) + " Degrees"
End Sub
Private Sub Form_Load()
Rem set the Rot.PictureBox to an area big enough to hold the Bitmap on a 45 degree angle
Rem now copy the bitmap into it to start rotations
Rem and Position the buttons
Rr.Left = Rot.Width - Rr.Width: deg = 0
bx = (Store.ScaleWidth / 2): by = (Store.ScaleHeight / 2)
a = (Form1.Store.Width * Form1.Store.Width) + (Form1.Store.Height * Form1.Store.Height): b = Sqr(a)
Form1.Rot.Top = 0: Form1.Rot.Left = 0:
Form1.Rot.Width = b: Form1.Rot.Height = b: Form1.Rot.Visible = True: Form1.Ren.Visible = True
a = (b / 2) - 1: tmp = BitBlt(Form1.Rot.hdc, (a - bx), (a - by), Form1.Store.Width, Form1.Store.Height - 6, Form1.Store.hdc, 0, 0, SRCCOPY)
Form1.Ren.Left = (Rot.Width / 2) - (Form1.Ren.Width / 2) + 4: Form1.Ren.Top = 6
Rr.Left = Rot.ScaleWidth - Rr.Width: Ren.Left = (Rot.ScaleWidth / 2 - Ren.Width / 2): Ren.Top = 0
Text1.Text = " " + Str$(deg) + " Degrees"
End Sub'看下文
Private Sub Ren_Click()
r = 0: Ren.Visible = False: Rr.Visible = False: Rl.Visible = False
Rot.AutoRedraw = False
Rem setup the draw in degrees function
pi = 4 * Atn(1): pi = (pi / 180): a = deg: b = (deg + 90): c = (deg + 180): d = (deg + 270)
e = (Rot.ScaleWidth / 2) - 2: f = (Rot.ScaleHeight / 2) - 2: Form1.Rot.DrawWidth = 1
Rem Do a palette copy so the colors will come out right in 256 colors
Clipboard.Clear: Clipboard.SetData Form1.Picture, 9
Form1.Rot.Picture = Clipboard.GetData(9)
Rem setup the variables
Dim cc As Long
Form1.Rot.DrawMode = 13
tby = (by - 2): lft = 0: rt = 0: Form1.Rot.Cls
Rem loop through the bitmap getting one pixel color at a time
Rem and paste them down on the new position on the rot.PictureBox
Rem the for next loop does one scan line at a time
Rem the loop counts down then vertical scan lines to the bottom on the bitmap
Rem useing tby as a checkpoint
Rem Note that everything is calculated from the center
lpf:
For stx = (bx - 2) To (-bx + 2) Step -1
cc = Form1.Store.Point(lft, rt): lft = lft + 1
zx = (tby * Sin(c * pi) + e): zy = (tby * Cos(c * pi) + f)
tmp = SetPixel(Form1.Rot.hdc, (stx * Sin((c + 90) * pi) + zx), (stx * Cos((c + 90) * pi) + zy), cc)
tmp = SetPixel(Form1.Rot.hdc, (stx * Sin((c + 90) * pi) + zx), (stx * Cos((c + 90) * pi) + zy + 1), cc)
Next: lft = 0: rt = rt + 1
tby = tby - 1: If tby > (-by + 2) Then GoTo lpf
Rem replace the buttons for another rotation
Ren.Visible = True
Rl.Visible = True: Rr.Visible = TrueEnd Sub
Private Sub Rl_Click()
Rem draw the square
Form1.Rot.DrawMode = 6
If r = 1 Then Rotate: r = 0
If deg < 360 Then deg = deg + 2: Rotate: r = 1End Sub
Private Sub Rr_Click()
Rem draw the square
Form1.Rot.DrawMode = 6
If r = 1 Then Rotate: r = 0
deg = deg - 2: Rotate: r = 1End Sub
'L，Ren，R分别是三个按钮控件
'Rot、Store分别是两个picturebox控件
'Text1是文本框
'运行后点击L（或R）按钮后，再点击Ren按钮试试看
第二 ：我试了 好象行不通
不知是程序问题 还是我的问题 按下Ren好象死机一样
你调试的是正常的吗 结帖后一定给你送上
如果愿意和我交个朋友的话 我的联系方式：QQ 45377191 我一直在线的 可能是隐身 [email protected]
Const Pi = 3.14Private Sub Command1_Click()
Dim x As Integer, y As Integer
Dim X1 As Integer, Y1 As Integer
Dim X2 As Double, Y2 As Double
Dim X3 As Double, Y3 As Double
Dim JiaoDu As Double
Dim HuDu As Double
JiaoDu = 90 ' 角 度
HuDu = JiaoDu * Pi / 180 ' 弧 度
PicSource.ScaleMode = vbPixels
PicTarget.ScaleMode = vbPixels
For x = 0 To PicTarget.ScaleWidth
X1 = x - PicTarget.ScaleWidth \ 2
For y = 0 To PicTarget.ScaleHeight
Y1 = y - PicTarget.ScaleHeight \ 2
X2 = X1 * Cos(-HuDu) + Y1 * Sin(-HuDu)
Y2 = Y1 * Cos(-HuDu) - X1 * Sin(-HuDu)
X3 = X2 + PicSource.ScaleWidth \ 2
Y3 = Y2 + PicSource.ScaleHeight \ 2If X3 > 0 And X3 < PicSource.ScaleWidth - 1 And Y3 > 0 And Y3 < PicSource.ScaleHeight - 1 Then
PicTarget.PSet (x, y), PicSource.Point(X3, Y3)End If
Next y
Next xEnd Sub