MyCad

freeBASIC source code examples by FbCadcam staff and interns

Moderators: kitty_webb, Ywsp, joanCruz03, yajra1219, Jayem, shela

Post Reply
User avatar
jfiofficial
Posts: 281
Joined: Mon Nov 05, 2018 8:52 am
Location: Bulacan, Philippines
Contact:

MyCad

Post by jfiofficial » Tue Aug 27, 2019 9:26 am

we had a skype session with Sir Owen with regards to creating our own cad using FreeBASIC.

here's the code that the day we create our own Cad

Code: Select all

ScreenRes (600,600)
Window (0,0)-(599,599)
Dim As Integer boxwidth,boxheight,boxspacing,boxpadding
Dim As String boxname(10)
Dim As Integer mx,my,mb,mw,mres
Dim As BOOLEAN mr
Dim As Integer x1,y1,x2,y2
Dim k As String
Dim As Integer c
Dim As integer boxarray(10,3)
Dim As Integer mycadfunction
Dim As Integer mouseclicks
Dim As Integer dax1, day1, dax2, day2
Dim As Double lines(99,3)
Dim As Integer linesc

dax1= 150
dax2= 550
day1= 550
day2=	150
Line (dax1,day1)-(dax2,day2),,b
boxheight = 14
boxspacing = 8
boxpadding = 4
boxname (0) = "Line"
boxname (1) = "Circle"
boxname (2) = "Arcs"
boxname (3) = "Ellipses"
boxname (4) = "Splines"
boxname (5) = "Snap to End"
boxname (6) = "Snap to Mid"
boxname (7) = "Perpendicular"
boxname (8) = "Tangent"
boxname (9) = "Intersection"
boxname (10) = "Nearest Point"

For y As Integer = 0 To 10
	If Len(boxname(y))*8>boxwidth Then
		boxwidth = Len(boxname(y))*8
	EndIf
Next
boxwidth += boxpadding * 2

For y As Integer = 0 To 10
	
	
	boxarray (y,0) = 10'x1
	boxarray (y,1) = 600-y*(boxheight+boxspacing) 'y1
	boxarray (y,2) = 10+boxwidth'x2
	boxarray (y,3) = boxarray(y,1)-boxheight 'y2
	x1 = boxarray (y,0) 
	y1 = boxarray (y,1) 
	x2 = boxarray (y,2)
	y2 = boxarray (y,3)
	Line (x1,y1) - (x2,y2),,b
	Draw String (x1 + (boxwidth/2)-(Len (boxname(y))*4),y1-boxpadding),boxname(y)
	
	
	
	
Next

Do
	
	k = InKey
	'mouse button values 
	'left mouse button = 1
	'right mouse button = 2
	'center mouse button = 4
	'mo mouse button = 0
	'mousewheel = 0 initial mousewheel value
	'mousewheeldown = -1,-2,-3,-4 negative
	'mousewheelup = 1,2,3,4 positive
	mres = GetMouse (mx,my,mw,mb)
	If mb = 0 Then mr = TRUE 
	my = 600 - my
	Select Case k
		Case Chr(27), Chr (255) + "k"
			Exit Do
	End Select
	
	For y As Integer = 0 To 10
		Select Case mx
			Case boxarray(y,0) To boxarray(y,2) 'x1 to x2
				Select Case my
					Case boxarray (y,3) To boxarray(y,1) ' y1 to y2
						If mb = 1 Then mycadfunction = y '0 line, 1 circle, 2 arc, etc.
						exit For
				End Select
		End Select
	Next
	Select Case mx
		Case dax1 To dax2
			Select Case my
				Case day2 To day1
					If mb = 1 Then
						If mr = TRUE Then
							mouseclicks+=1
							'This is where we wanted to do things
							Select Case mycadfunction							
								Case 0 'line
									Select Case mouseclicks
										Case 1
											'Start the line
											linesc+=1
											lines(linesc,0) = mx
											lines(linesc,1) = my
										Case 2
											'End the line
											lines(linesc,2) = mx
											lines(linesc,3) = my
											Line(lines(linesc,0),lines(linesc,1))-(lines(linesc,2),lines(linesc,3))
											mouseclicks = 0
									End Select
								Case 1 'circle
				
								Case 2 'arcs
				
								Case 3 'ellipses
				
								Case 4 'splines
				
								Case 5 'snap to end
				
								Case 6 'snap to mid
				
								Case 7 'Perpendicular
				
								Case 8 'Tangent
				
								Case 9 'Intersection
				
								Case 10 'Nearest Point
							End Select
						EndIf
						mr = FALSE
					EndIf
			End Select
	End Select
	
	
	
	Sleep 1
Loop
Sleep 
Image
Tech Enthusiast

“I consider that our present sufferings are not worth comparing with the glory that will be revealed in us.”
Romans 8:18 (NIV)

owen
Site Admin
Posts: 650
Joined: Thu Apr 13, 2017 12:14 pm

Re: MyCad

Post by owen » Tue Aug 27, 2019 1:45 pm

First we created some simple buttons then we started working on the drawing area functions like drawing lines and circles. Last thing we were doing was working on screen flipping.

The code that creates the buttons is kind of cool because you could set the button spacing and button padding variables to make the buttons spread out.

User avatar
Ichibane
Posts: 50
Joined: Tue Oct 16, 2018 4:37 am

Re: MyCad

Post by Ichibane » Wed Aug 28, 2019 6:48 am

I added drawing circle and also the drawing can be tracked

Image

Code: Select all

ScreenRes 600,600,,2
Window (0,0)-(599,599)
Dim As Integer boxwidth,boxheight,boxspacing,boxpadding
Dim As String boxname(10)
Dim As Integer mx,my,mb,mw,mres
Dim As BOOLEAN mr
Dim As Integer x1,y1,x2,y2
Dim k As String
Dim As Integer c
Dim As integer boxarray(10,3)
Dim As Integer mycadfunction
Dim As Integer mouseclicks
Dim As Integer dax1, day1, dax2, day2
Dim As Double lines(99,3)
Dim As Double circles(99,1)
Dim As Integer linesc,circlesc
Dim As Integer cr 'variables for a circle's center x,y and radius

dax1= 150
dax2= 550
day1= 550
day2=	150
Line (dax1,day1)-(dax2,day2),,b
boxheight = 14
boxspacing = 8
boxpadding = 4
boxname (0) = "Line"
boxname (1) = "Circle"
boxname (2) = "Arcs"
boxname (3) = "Ellipses"
boxname (4) = "Splines"
boxname (5) = "Snap to End"
boxname (6) = "Snap to Mid"
boxname (7) = "Perpendicular"
boxname (8) = "Tangent"
boxname (9) = "Intersection"
boxname (10) = "Nearest Point"

For y As Integer = 0 To 10
	If Len(boxname(y))*8>boxwidth Then
		boxwidth = Len(boxname(y))*8
	EndIf
Next
boxwidth += boxpadding * 2

For y As Integer = 0 To 10
	boxarray (y,0) = 10'x1
	boxarray (y,1) = 600-y*(boxheight+boxspacing) 'y1
	boxarray (y,2) = 10+boxwidth'x2
	boxarray (y,3) = boxarray(y,1)-boxheight 'y2
	x1 = boxarray (y,0) 
	y1 = boxarray (y,1) 
	x2 = boxarray (y,2)
	y2 = boxarray (y,3)
	Line (x1,y1) - (x2,y2),,b
	Draw String (x1 + (boxwidth/2)-(Len (boxname(y))*4),y1-boxpadding),boxname(y)
Next

ScreenCopy 0,1
ScreenSet 1,1

Do
	k = InKey
	'mouse button values 
	'left mouse button = 1
	'right mouse button = 2
	'center mouse button = 4
	'mo mouse button = 0
	'mousewheel = 0 initial mousewheel value
	'mousewheeldown = -1,-2,-3,-4 negative
	'mousewheelup = 1,2,3,4 positive
	mres = GetMouse (mx,my,mw,mb)
	If mb = 0 Then mr = TRUE 
	my = 600 - my
	Select Case k
		Case Chr(27), Chr (255) + "k"
			Exit Do
	End Select
	
	For y As Integer = 0 To 10
		Select Case mx
			Case boxarray(y,0) To boxarray(y,2) 'x1 to x2
				Select Case my
					Case boxarray (y,3) To boxarray(y,1) ' y1 to y2
						If mb = 1 Then mycadfunction = y '0 line, 1 circle, 2 arc, etc.
						exit For
				End Select
		End Select
	Next
	Select Case mx
		Case dax1 To dax2
			Select Case my
				Case day2 To day1
					If mb = 0 Then
						If mouseclicks<>0 Then
							ScreenCopy 0,1
							Select Case mycadfunction
								Case 0 'Line
									Line(lines(linesc,0),lines(linesc,1))-(mx,my)
								Case 1 'Circle
									cr=Sqr((circles(circlesc,0)-mx)^2 + (circles(circlesc,1)-my)^2)
			 						Circle(circles(circlesc,0),circles(circlesc,1)),cr
							End Select
						EndIf
					EndIf
					If mb = 1 Then
						If mr = TRUE Then
							mouseclicks+=1
							'This is where we wanted to do things
							Select Case mycadfunction							
								Case 0 'line
									Select Case mouseclicks
										Case 1
											'Start the line
											linesc+=1
											lines(linesc,0) = mx
											lines(linesc,1) = my
										Case 2
											'End the line
											ScreenSet 0,1
											lines(linesc,2) = mx
											lines(linesc,3) = my
											Line(lines(linesc,0),lines(linesc,1))-(lines(linesc,2),lines(linesc,3))
											ScreenSet 1,1
											ScreenCopy 0,1
											mouseclicks = 0
									End Select
								Case 1 'circle
									Select Case mouseclicks
										Case 1
											'Start the circle
											circlesc+=1
											circles(circlesc,0) = mx
											circles(circlesc,1) = my
										Case 2
											'End the circle
											cr=Sqr((circles(circlesc,0)-mx)^2 + (circles(circlesc,1)-my)^2)
											ScreenSet 0,1
											Circle(circles(circlesc,0),circles(circlesc,1)),cr,14
											ScreenSet 1,1
											ScreenCopy 0,1
											mouseclicks = 0
									End Select
								Case 2 'arcs
				
								Case 3 'ellipses
				
								Case 4 'splines
				
								Case 5 'snap to end
				
								Case 6 'snap to mid
				
								Case 7 'Perpendicular
				
								Case 8 'Tangent
				
								Case 9 'Intersection
				
								Case 10 'Nearest Point
							End Select
						EndIf
						mr = FALSE
					EndIf
			End Select
	End Select
	
	
	
	Sleep 1
Loop
Sleep 

Post Reply