• Status: Solved
• Priority: Medium
• Security: Public
• Views: 480

# Rotate picture control

I print a word on a picture control. How do I rotate the
picture control by angle of 270 degree.

So I can see that word vertically ???
0
tanc02
• 11
• 9
• 3
1 Solution

Commented:
try something like this (put two picture controls on form (named picture1 and picture2) you can just make picture1 invisible.

Sub bmp_rotate(pic1 As Control, pic2 As Control, ByVal theta!)
Const Pi = 3.14159265359
Dim c1x As Integer
Dim c1y As Integer
Dim c2x As Integer
Dim c2y As Integer
Dim a As Single
Dim r As Integer
Dim p1x As Integer
Dim p1y As Integer
Dim p2x As Integer
Dim p2y As Integer
Dim n As Integer

c1x = pic1.ScaleWidth / 2
c1y = pic1.ScaleHeight / 2
c2x = pic2.ScaleWidth / 2
c2y = pic2.ScaleHeight / 2

n = pic2.ScaleWidth
If n < pic2.ScaleHeight Then n = pic2.ScaleHeight
n = n / 2 - 1

For p2x = 0 To n
For p2y = 0 To n

If p2x = 0 Then
a = Pi / 2
Else
a = Atn(p2y / p2x)
End If
r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)

p1x = r * Cos(a + theta)
p1y = r * Sin(a + theta)

c0& = pic1.Point(c1x + p1x, c1y + p1y)
c1& = pic1.Point(c1x - p1x, c1y - p1y)
c2& = pic1.Point(c1x + p1y, c1y - p1x)
c3& = pic1.Point(c1x - p1y, c1y + p1x)
If c0& <> -1 Then pic2.PSet (c2x + p2x, c2y + p2y), c0&
If c1& <> -1 Then pic2.PSet (c2x - p2x, c2y - p2y), c1&
If c2& <> -1 Then pic2.PSet (c2x + p2y, c2y - p2x), c2&
If c3& <> -1 Then pic2.PSet (c2x - p2y, c2y + p2x), c3&
Next
t% = DoEvents()
Next
End Sub

Private Sub Command1_Click()
Const Pi = 3.14159265359
Picture1.AutoSize = True
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
Picture1.ScaleMode = 3 - pixel
Picture2.ScaleMode = 3 - pixel
Picture1.Print "           test"
Call bmp_rotate(Picture1, Picture2, (3 * Pi) / 2)

End Sub
0

Author Commented:
bobbit31,

Your code work, but it is rotated by angle of 90 degree
What I want is 270 degree.
0

Commented:

Call bmp_rotate(Picture1, Picture2, Pi / 2)
0

Author Commented:
bobbit31,

It is working now, but if you try to change this :

Picture1.Print "           test"
to
Picture1.Print "test"

and you will see the rotated "test" is so far away from
the top-left corner.

How to make it appear on the top-left corner ?
I will increase the another 100 points if you can do it.
Thanks !

0

Commented:
add this after all the dim's in the bmp_rotate sub

pic2.Height = pic1.Width
pic2.Width = pic1.Height

and use this:
Private Sub Command1_Click()
Const Pi = 3.14159265359
Picture1.AutoSize = True
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
Picture1.ScaleMode = 3
Picture2.ScaleMode = 3

DrawText Picture1, "This is a test" & vbCrLf & "hello"
Call bmp_rotate(Picture1, Picture2, Pi / 2)

End Sub

Public Sub DrawText(pic1 As Control, str As String)

pic1.ScaleMode = 3
pic1.Height = pic1.TextHeight(str) + 5
pic1.Width = pic1.TextWidth(str) + 5

pic1.Print str

End Sub

basically what it does, is it automatically sizes the picture boxes so that your rotated one doesn't have any of that wasted space.
0

Author Commented:
When I hit the command1 button, two pictures control disappeared!
0

IT OperationsCommented:
0

Commented:
don't forget the pic1.scalemode = 3
0

IT OperationsCommented:
Forgive me!
0

Author Commented:
I do have pic1.scalemode = 3, the picture boxes just disappeared.
0

IT OperationsCommented:
The code works, how you got pic disappeared?
0

Author Commented:
I don't know. I will try again !
0

Author Commented:
It is still disappear. Can I have the latest code ?
Thanks !
0

Author Commented:
I know why !
Because

pic1.Height = pic1.TextHeight(str) + 5
pic1.Width = pic1.TextWidth(str) + 5

5 is too small.
0

Commented:
so did you get it working?
0

Author Commented:
still yes and no,
Because I am using Times New Roman, and it is variable font. I don't know how should I change this :

pic1.Height = pic1.TextHeight(str) + 5
pic1.Width = pic1.TextWidth(str) + 5

because 5 is too small. This is the reason my picture boxes
keep missing.
0

Commented:
ok, try setting the scalemode property of picture1 and picture2 to 3... not at run-time, but in the design time properties list.

then still use this:
pic1.Height = pic1.TextHeight(str) + 5
pic1.Width = pic1.TextWidth(str) + 5

0

Author Commented:
This is what I have:

Sub bmp_rotate(pic1 As Control, pic2 As Control, ByVal theta!)
Const Pi = 3.14159265359
Dim c1x As Integer
Dim c1y As Integer
Dim c2x As Integer
Dim c2y As Integer
Dim a As Single
Dim r As Integer
Dim p1x As Integer
Dim p1y As Integer
Dim p2x As Integer
Dim p2y As Integer
Dim n As Integer

pic2.Height = pic1.Width
pic2.Width = pic1.Height
c1x = pic1.ScaleWidth / 2
c1y = pic1.ScaleHeight / 2
c2x = pic2.ScaleWidth / 2
c2y = pic2.ScaleHeight / 2

n = pic2.ScaleWidth
If n < pic2.ScaleHeight Then n = pic2.ScaleHeight
n = n / 2 - 1

For p2x = 0 To n
For p2y = 0 To n

If p2x = 0 Then
a = Pi / 2
Else
a = Atn(p2y / p2x)
End If
r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)

p1x = r * Cos(a + theta)
p1y = r * Sin(a + theta)

c0& = pic1.Point(c1x + p1x, c1y + p1y)
c1& = pic1.Point(c1x - p1x, c1y - p1y)
c2& = pic1.Point(c1x + p1y, c1y - p1x)
c3& = pic1.Point(c1x - p1y, c1y + p1x)
If c0& <> -1 Then pic2.PSet (c2x + p2x, c2y + p2y), c0&
If c1& <> -1 Then pic2.PSet (c2x - p2x, c2y - p2y), c1&
If c2& <> -1 Then pic2.PSet (c2x + p2y, c2y - p2x), c2&
If c3& <> -1 Then pic2.PSet (c2x - p2y, c2y + p2x), c3&
Next
t% = DoEvents()
Next
End Sub

Private Sub Command1_Click()
Const Pi = 3.14159265359
Picture1.AutoSize = True
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
Picture1.ScaleMode = 3
Picture2.ScaleMode = 3
DrawText Picture1, "This is a test" & vbCrLf & "hello"
Call bmp_rotate(Picture1, Picture2, Pi / 2)
End Sub

Public Sub DrawText(pic1 As Control, str As String)
pic1.ScaleMode = 3
pic1.Height = pic1.TextHeight(str) + 5
pic1.Width = pic1.TextWidth(str) + 5
pic1.Print str
End Sub

and I have set scalemode to 3 in properties box.
0

Commented:
for both picture boxes? and it is still not working?
0

Author Commented:
yes, for both picture boxes. Any idea ?
0

Commented:
don't ask me why, but set your form scalemode either to user or pixel in the properties list... should work
0

Author Commented:
It is working now. WOW !
I have to set form's scale mode. Cool !
I will increase another 100 points for you.
0

Commented:
thanks for the points, glad to help!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.