|
-
Aug 4th, 2000, 12:49 AM
#1
Thread Starter
Addicted Member
ok I'm making a paint type app so I get to know line, circle, and so on but I have a wierd problem
here is the form(I'm going to just past in the form as read by notepad, you copy paste to *.txt vb will create a form when you add the *.txt file (if it formats right in here))if you loud it run with it a start up form and try draw text you'll see what i mean
the main code foor draw text is in the form mdown & mUp and the timer tmrText
start from version
sel all the way to bottom
thanks
VERSION 5.00
Begin VB.Form frmDraw
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "Draw"
ClientHeight = 5775
ClientLeft = 150
ClientTop = 720
ClientWidth = 7695
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 5775
ScaleWidth = 7695
StartUpPosition = 3 'Windows Default
Begin VB.Timer tmrtext
Interval = 1
Left = 7080
Top = 5280
End
Begin VB.Label lblDrawText
BackStyle = 0 'Transparent
Height = 255
Left = 7440
TabIndex = 0
Top = 5520
Visible = 0 'False
Width = 255
End
Begin VB.Menu mnuFIle
Caption = "&File"
End
Begin VB.Menu mnuEdit
Caption = "&Edit"
End
Begin VB.Menu mnuDraw
Caption = "&Draw"
Begin VB.Menu mnuDrawBox
Caption = "Draw &Box"
End
Begin VB.Menu mnuDrawCircle
Caption = "Draw &Circle"
End
Begin VB.Menu mnuDrawLine
Caption = "Draw &Line"
End
Begin VB.Menu mnuDrawText
Caption = "Draw &Text"
End
End
End
Attribute VB_Name = "frmDraw"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Shape As String
Dim XStart, YStart As Single
Dim XPrevious, YPrevious As Single
Dim PrintText As Boolean
Private Declare Function SetCursorPos Lib "user32.dll" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINT_API) As Long
Private Type POINT_API
x As Long
y As Long
End Type
Private Sub Form_Load()
PrintText = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
XStart = x
YStart = y
XPrevious = XStart
YPrevious = YStart
Me.DrawMode = 7
Me.DrawStyle = 1
Select Case Shape$
Case "Line"
Me.MousePointer = 2
Case "Circle"
Me.MousePointer = 2
Case "Box"
Me.MousePointer = 2
Case "Text"
If PrintText Then
Dim DrawString As String
Dim lX, lY
Dim lX2, lY2 As Single
Dim point As POINT_API
GetCursorPos point
lX = point.x
lY = point.y
lX2 = x
lY2 = y
DrawString = InputBox("Enter Text")
If DrawString = "" Then
Shape = ""
Me.MousePointer = 0
Exit Sub
End If
SetCursorPos lX, lY
lblDrawText.Caption = DrawString
lblDrawText.Width = TextWidth(DrawString)
PrintText = False
Me.MousePointer = 3
With lblDrawText
.ForeColor = Me.ForeColor
.Visible = True
.Left = lX / Me.Left
.Top = lY / Me.Top
tmrtext.Enabled = True
End With
Else
tmrtext.Enabled = False
Me.CurrentX = x
Me.CurrentY = y
Me.Print lblDrawText.Caption
lblDrawText.Visible = False
Me.MousePointer = 0
Shape = ""
Exit Sub
End If
End Select
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Select Case Shape$
Case "Line"
Me.MousePointer = 2
Case "Circle"
Me.MousePointer = 2
Case "Box"
Me.MousePointer = 2
Case "Text"
Me.MousePointer = 3
End Select
If Button = 1 Then
Me.DrawMode = 10 'enable dotted line
Select Case Shape$
Case "Line"
Me.Line (XStart, YStart)-(XPrevious, YPrevious)
Me.Line (XStart, YStart)-(x, y)
Me.MousePointer = 2
Case "Circle"
Me.Circle (XStart, YStart), Sqr((XPrevious - XStart) ^ 2 + (YPrevious - YStart) ^ 2)
Me.Circle (XStart, YStart), Sqr((x - XStart) ^ 2 + (y - YStart) ^ 2)
Me.MousePointer = 2
Case "Box"
Me.Line (XStart, YStart)-(XPrevious, YPrevious), , B
Me.Line (XStart, YStart)-(x, y), , B
Me.MousePointer = 2
Case "Text"
'lblDrawText.Left = x
'lblDrawText.Top = y
'Me.MousePointer = 3
End Select
XPrevious = x
YPrevious = y
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Me.DrawMode = 13
Me.DrawStyle = 0
Select Case Shape$
Case "Line"
Me.Line (XStart, YStart)-(x, y)
Me.MousePointer = 0
Shape = ""
Case "Circle"
Me.Circle (XStart, YStart), Sqr((x - XStart) ^ 2 + (y - YStart) ^ 2)
Me.MousePointer = 0
Shape = ""
Case "Box"
Me.Line (XStart, YStart)-(x, y), , B
Me.MousePointer = 0
Shape = ""
Case "Text"
End Select
End If
End Sub
Private Sub mnuDrawBox_Click()
Shape = "Box"
End Sub
Private Sub mnuDrawCircle_Click()
Shape = "Circle"
End Sub
Private Sub mnuDrawLine_Click()
Shape = "Line"
End Sub
Private Sub mnuDrawText_Click()
Shape = "Text"
' Dim DrawString As String
' DrawString = InputBox("Enter Text")
' lblDrawText.Caption = DrawString
' lblDrawText.Width = TextWidth(DrawString)
PrintText = True
End Sub
Private Sub tmrtext_Timer()
Dim lX, lY
Dim point As POINT_API
GetCursorPos point
lX = ScaleX(point.x, vbPixels, Me.ScaleMode)
lY = ScaleY(point.y, vbPixels, Me.ScaleMode)
' Screen.TwipsPerPixelY
lblDrawText.Left = lX 'ScaleX(lX, vbPixels, Me.ScaleMode) - ScaleX(Screen.TwipsPerPixelX, vbPixels, Me.ScaleMode)
lblDrawText.Top = lY 'ScaleY(lY, vbPixels, Me.ScaleMode) - ScaleY(Screen.TwipsPerPixelY, vbPixels, Me.ScaleMode)
End Sub
Magiaus
Visual Basic 6.0 SP5
Visual C++ 6.0 SP5
The only sovereign you can allow to rule you is reason.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|