可用分押宝游戏火热进行中...	专题改版：Java Web 专题

窗体旋转90度

楼主aalei（阿磊）2004-12-02 12:49:03 在 VB / 基础类提问

就想MS里的画图板一样，可以把图片旋转90度。
现在我要旋转窗体，里面的控件也相应旋转。。
急啊
解决后另送100分问题点数：100、回复次数：21Top

1 楼swpcsoft（小雪(http://www.qian360.com)）回复于 2004-12-02 12:55:20 得分 5

啊——————
难……………………

Top

2 楼xayzmb（行者）回复于 2004-12-02 13:04:17 得分 5

把显示器横过来
缺点是windows也会跟着转Top

3 楼WallesCai（女人之美,在于蠢得无怨无悔,男人之美,在于撒谎撒得白日见鬼）回复于 2004-12-02 13:06:38 得分 5

什么叫“里面的控件也相应旋转”？Top

4 楼cindytsai（笨笨的蔡鸟）回复于 2004-12-02 13:09:48 得分 5

挺有意思的Top

5 楼aalei（阿磊）回复于 2004-12-02 13:14:09 得分 0

to WallesCai

就是窗体旋转90度。那么里面的TEXTBOX也应该旋转90度Top

6 楼True1024（）回复于 2004-12-02 13:42:02 得分 5

好像有个控件有这个功能，感觉实际中没多大用，就没太注意。
帮你找找看。Top

7 楼aalei（阿磊）回复于 2004-12-02 13:43:09 得分 0

谢谢Top

8 楼songyaowu（不以分多而蹭之;不因分少而不答; www.vb99.com）回复于 2004-12-02 13:46:31 得分 5

有创意！！但愿下一代 Windows 操作系统带这个功能。Top

9 楼aalei（阿磊）回复于 2004-12-03 08:54:08 得分 0

顶Top

10 楼chewinggum（口香糖·个人二五计划第一年）回复于 2004-12-03 08:58:25 得分 5

转过来干什么用啊，呵呵，很好奇Top

11 楼lndlwwh830（笑天星）回复于 2004-12-03 08:59:46 得分 5

这是一个让图片转90度的代码！看看对你有没有用
Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
Public Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long

End Type
Public Function TurnBmp(hSrcBmp As Long, hDestBmp As Long) As Boolean
Dim X As Long, Y As Long

Dim BytesPixel As Long

Dim tSBmpInfo As BITMAP, tDBmpInfo As BITMAP
Dim sBits() As Byte, dBits() As Byte

'获得位图信息
Call GetObject(hSrcBmp, Len(tSBmpInfo), tSBmpInfo)
Call GetObject(hDestBmp, Len(tDBmpInfo), tDBmpInfo)
'申请空间
ReDim sBits(1 To tSBmpInfo.bmWidthBytes, 1 To tSBmpInfo.bmHeight)
ReDim dBits(1 To tDBmpInfo.bmWidthBytes, 1 To tDBmpInfo.bmHeight)

'获得源图与目标图二进制位
Call GetBitmapBits(hSrcBmp, tSBmpInfo.bmWidthBytes * tSBmpInfo.bmHeight, sBits(1, 1))
Call GetBitmapBits(hDestBmp, tDBmpInfo.bmWidthBytes * tDBmpInfo.bmHeight, dBits(1, 1))

'计算颜色值占用多少字节
BytesPixel = tSBmpInfo.bmBitsPixel / 8

'旋转
For Y = 1 To tSBmpInfo.bmHeight
For X = 1 To tSBmpInfo.bmWidth
Call CopyMemory(dBits((tSBmpInfo.bmHeight - Y) * BytesPixel + 1, X), sBits((X - 1) * BytesPixel + 1, Y), BytesPixel)
Next X
Next Y

'将旋转的结果复制到目标位图
Call SetBitmapBits(hDestBmp, tDBmpInfo.bmWidthBytes * tDBmpInfo.bmHeight, dBits(1, 1))

End Function
Private Sub Command1_Click()
Call TurnBmp(Picture1.Image.Handle, Picture2.Image.Handle)
End Sub

//一窗体，2个picture1 ,1个command1Top

12 楼aalei（阿磊）回复于 2004-12-07 09:00:22 得分 0

顶Top

13 楼zgvslch（烟花离落）回复于 2004-12-07 10:58:31 得分 5

关注Top

14 楼aohan（aohan）回复于 2004-12-07 11:02:06 得分 5

'将程序设置为自动启动

Option Explicit
Const REG_SZ As Long = 1
Const HKEY_LOCAL_MACHINE = &H80000002

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Sub Form_Load()
Text1.Text = App.Path & "\设置程序自动开机启动.exe"
End Sub
Private Sub Command1_Click()
Dim hKey As Long
Dim myexe As String
Dim myint As Integer
myint = Len(Text1.Text) - InStrRev(Text1.Text, "\")
myexe = Right(Text1.Text, myint)
If Text1.Text <> "" Then
RegCreateKey HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", hKey
RegSetValueEx hKey, myexe, 0, REG_SZ, ByVal Text1.Text, 13
RegCloseKey hKey
End If
End Sub
Private Sub Command2_Click()
CmD1.DialogTitle = "选择文件"
CmD1.Filter = "exe|*.exe"
CmD1.ShowOpen
If Len(CmD1.FileName) Then
Text1.Text = CmD1.FileName
End If
End Sub
Private Sub Command3_Click()
End
End Sub
Top

15 楼WallesCai（女人之美,在于蠢得无怨无悔,男人之美,在于撒谎撒得白日见鬼）回复于 2004-12-07 11:02:14 得分 5

旋转90度不是不可以，但是我想一般人的屏幕都是宽的吧，要是转了90度，那不是就会比例不同了吗？
有的地方会跑到显示器外面去。除非他的显示器的分辨率设置是方的才不会变形吧。Top

16 楼aohan（aohan）回复于 2004-12-07 11:04:06 得分 5

17 楼aohan（aohan）回复于 2004-12-07 11:04:34 得分 5

Option Explicit
#If Win32 Then
Type LOGFONT_TYPE
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lffacename As String * 32
End Type
Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT_TYPE) As Long
#Else
Type LOGFONT_TYPE
lfHeight As Integer
lfWidth As Integer
lfEscapement As Integer
lfOrientation As Integer
lfWeight As Integer
lfItalic As String * 1
lfUnderline As String * 1
lfStrikeOut As String * 1
lfCharSet As String * 1
lfOutPrecision As String * 1
lfClipPrecision As String * 1
lfQuality As String * 1
lfPitchAndFamily As String * 1
lffacename As String * 32
End Type
Declare Function CreateFontIndirect Lib "GDI" (lpLogFont As Any) As Integer
#End If
#If Win32 Then
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
#Else
Declare Function SelectObject Lib "GDI" (ByVal hdc As Integer, ByVal hObject As Integer) As Integer
Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
#End If

Public Sub DegreesToXY(CenterX As Long, CenterY As Long, degree As Double, radiusX As Long, radiusY As Long, X As Long, Y As Long)
Dim convert As Double

convert = 3.141593 / 180
X = CenterX - (Sin(-degree * convert) * radiusX)
Y = CenterY - (Sin((90 + (degree)) * convert) * radiusY)

End Sub

Public Sub RotateText(Degrees As Integer, obj As Object, fontname As String, Fontsize As Single, X As Integer, Y As Integer, Caption As String)
Dim RotateFont As LOGFONT_TYPE
Dim CurFont As Long, rFont As Long, foo As Long

RotateFont.lfEscapement = Degrees * 10
RotateFont.lffacename = fontname & Chr$(0)
If obj.FontBold Then
RotateFont.lfWeight = 800
Else
RotateFont.lfWeight = 400
End If
RotateFont.lfHeight = (Fontsize * -20) / Screen.TwipsPerPixelY
rFont = CreateFontIndirect(RotateFont)
CurFont = SelectObject(obj.hdc, rFont)

obj.CurrentX = X
obj.CurrentY = Y
obj.Print Caption

'Restore
foo = SelectObject(obj.hdc, CurFont)
foo = DeleteObject(rFont)

End Sub
Public Sub TextCircle(obj As Object, txt As String, X As Long, Y As Long, radius As Long, startdegree As Double)
Dim foo As Integer, TxtX As Long, TxtY As Long, checkit As Integer
Dim twipsperdegree As Long, wrktxt As String, wrklet As String, degreexy As Double, degree As Double
twipsperdegree = (radius * 3.14159 * 2) / 360
If startdegree < 0 Then
Select Case startdegree
Case -1
startdegree = Int(360 - (((obj.TextWidth(txt)) / twipsperdegree) / 2))
Case -2
radius = (obj.TextWidth(txt) / 2) / 3.14159
twipsperdegree = (radius * 3.14159 * 2) / 360
End Select
End If

For foo = 1 To Len(txt)
wrklet = Mid$(txt, foo, 1)
degreexy = (obj.TextWidth(wrktxt)) / twipsperdegree + startdegree
DegreesToXY X, Y, degreexy, radius, radius, TxtX, TxtY
degree = (obj.TextWidth(wrktxt) + 0.5 * obj.TextWidth(wrklet)) / twipsperdegree + startdegree
RotateText 360 - degree, obj, obj.fontname, obj.Fontsize, (TxtX), (TxtY), wrklet
wrktxt = wrktxt & wrklet
Next foo
End Sub
Top

18 楼aohan（aohan）回复于 2004-12-07 11:05:13 得分 5

第一个发错了，二是模块代码，下面是窗体代码

Option Explicit

Private Sub Command1_Click()
Dim foo As Integer
Picture1.Cls
For foo = 0 To 360 Step 45
Picture1.Refresh
'Picture1.Cls
RotateText foo, Picture1, "Arial", 24, 2400, 2400, " Visual Basic"
DoEvents
Next foo

End Sub

Private Sub Command2_Click()
Dim foo As Integer
Picture1.Cls
Picture1.fontname = "arial"
Picture1.Fontsize = 8

For foo = 0 To 3
RotateText 270, Picture1, "Arial", 8, Picture1.ScaleWidth, foo * Picture1.TextWidth("Visual Basic "), " Visual Basic"
Next foo
End Sub

Private Sub Command3_Click(index As Integer)
Picture1.Cls
Select Case index
Case 0 'center on top: degree = -1
Picture1.fontname = "arial"
Picture1.Fontsize = 40
Picture1.FontBold = True
TextCircle Picture1, "Visual Basic", Picture1.ScaleWidth / 2, Picture1.ScaleHeight, Picture1.ScaleHeight * 0.8, -1
Case 1 'adjust circle size to fit text length: degree = -2
Picture1.fontname = "arial"
Picture1.Fontsize = 12
Picture1.FontBold = True
TextCircle Picture1, "VBPJ Visual Basic Programmer's Journal VBPJ Visual Basic Programmer's Journal ", Picture1.ScaleWidth / 2, Picture1.ScaleHeight / 2, Picture1.ScaleHeight * 0.3, -2
Case 2 'start at point: degree = 0 to 360
Picture1.fontname = "arial"
Picture1.Fontsize = 12
Picture1.FontBold = True
TextCircle Picture1, "VBPJ Visual Basic Programmer's Journal VBPJ Visual Basic Programmer's Journal VBPJ Visual Basic Programmer's Journal VBPJ Visual Basic Programmer's ", Picture1.ScaleWidth / 2, Picture1.ScaleHeight / 2, Picture1.ScaleHeight * 0.5, 90

End Select

End Sub
Top

19 楼aalei（阿磊）回复于 2004-12-29 10:06:04 得分 0

窗体旋转90度。里面的控件也相应旋转90度
我顶Top

20 楼shiyunlong（君子爱财-取之用刀）回复于 2004-12-29 10:18:56 得分 30

mark+顶Top

21 楼aalei（阿磊）回复于 2004-12-31 10:40:19 得分 0

我顶Top