gambas-source-code/app/examples/Drawing/Painting/.src/FMain.class

549 lines
12 KiB
Text
Raw Normal View History

' Gambas class file
Private Const IMAGE_NAME As String = "clovis.jpg"
Private Const SVG_EXPORT As String = "~/Gambas with red ballon.svg"
Private $sFunctionName As String = "Example1"
Public Sub _new()
Editor1.Text = File.Load($sFunctionName)
End
Public Sub Form_Open()
HSplit1.Layout = [1, 2]
End
Public Sub Example1()
Dim XC As Float = 128
Dim YC As Float = 128
Dim Radius As Float = 100
Dim Angle1 As Float = Rad(-45)
Dim Angle2 As Float = Rad(-180)
Dim X, Y As Float
Paint.LineWidth = 10
Paint.Arc(XC, YC, Radius, Angle1, Angle2 - Angle1)
Paint.Stroke
'Draw helping Lines
Paint.LineWidth = 6.0
Paint.Brush = Paint.Color(Color.RGB(255, 0.2 * 255, 0.2 * 255, 0.6 * 255))
Paint.Arc(XC, YC, 10.0)
Paint.Fill
Paint.Arc(XC, YC, Radius, Angle1, 0)
X = Paint.X
Y = Paint.Y
Paint.Arc(XC, YC, Radius, Angle2, 0)
Paint.LineTo(XC, YC)
Paint.LineTo(X, Y)
Paint.Stroke
End
Public Sub Example2()
Dim XC As Float = 128
Dim YC As Float = 128
Dim Radius As Float = 100
Dim Angle1 As Float = Rad(-45)
Dim Angle2 As Float = Rad(180)
Dim X, Y As Float
Paint.LineWidth = 10
Paint.Arc(XC, YC, Radius, Angle1, Angle2 - Angle1)
Paint.Stroke
'Draw helping Lines
Paint.LineWidth = 6.0
Paint.Brush = Paint.Color(Color.RGB(255, 0.2 * 255, 0.2 * 255, 0.6 * 255))
Paint.Arc(XC, YC, 10.0)
Paint.Fill
Paint.Arc(XC, YC, Radius, Angle1, 0)
X = Paint.X
Y = Paint.Y
Paint.Arc(XC, YC, Radius, Angle2, 0)
Paint.LineTo(XC, YC)
Paint.LineTo(X, Y)
Paint.Stroke
End
Public Sub Example3()
Paint.Arc(128.0, 128.0, 76.8)
Paint.Clip
Paint.Rectangle(0, 0, 256, 256)
Paint.Fill
Paint.Brush = Paint.Color(Color.RGB(0, 255, 0))
Paint.MoveTo(0, 0)
Paint.LineTo(256, 256)
Paint.MoveTo(256, 0)
Paint.LineTo(0, 256)
Paint.LineWidth = 10.0
Paint.Stroke
End
Public Sub Example4()
Dim hImg As Image
Paint.Arc(128.0, 128.0, 76.8)
Paint.Clip
hImg = Image.Load(IMAGE_NAME)
Paint.Scale(256 / hImg.Width, 256 / hImg.Height)
Paint.Brush = Paint.Image(hImg, 0, 0)
Paint.Rectangle(0, 0, 512, 512)
Paint.Fill()
End
Public Sub Example5()
' A custom shape that could be wrapped in a function
Dim X0 As Float = 25.6
Dim Y0 As Float = 25.6
Dim RectWidth As Float = 204.8
Dim RectHeight As Float = 204.8
Dim Radius As Float = 102.4
Dim X1, Y1 As Float
X1 = X0 + RectWidth
Y1 = Y0 + RectHeight
If Not (RectWidth > 0.0) Or Not (RectHeight > 0.0) Then Return
If RectWidth / 2 < Radius Then
If RectHeight / 2 < Radius Then
Paint.MoveTo(X0, (Y0 + Y1) / 2)
Paint.CurveTo(X0, Y0, X0, Y0, (X0 + X1) / 2, Y0)
Paint.CurveTo(X1, Y0, X1, Y0, X1, (Y0 + Y1) / 2)
Paint.CurveTo(X1, Y1, X1, Y1, (X1 + X0) / 2, Y1)
Paint.CurveTo(X0, Y1, X0, Y1, X0, (Y0 + Y1) / 2)
Else
Paint.MoveTo(X0, Y0 + Radius)
Paint.CurveTo(X0, Y0, X0, Y0, (X0 + X1) / 2, Y0)
Paint.CurveTo(X1, Y0, X1, Y0, X1, Y0 + Radius)
Paint.LineTo(X1, Y1 - Radius)
Paint.CurveTo(X1, Y1, X1, Y1, (X1 + X0) / 2, Y1)
Paint.CurveTo(X0, Y1, X0, Y1, X0, Y1 - Radius)
Endif
Else
If (RectHeight / 2 < Radius) Then
Paint.MoveTo(X0, (Y0 + Y1) / 2)
Paint.CurveTo(X0, Y0, X0, Y0, X0 + Radius, Y0)
Paint.LineTo(X1 - Radius, Y0)
Paint.CurveTo(X1, Y0, X1, Y0, X1, (Y0 + Y1) / 2)
Paint.CurveTo(X1, Y1, X1, Y1, X1 - Radius, Y1)
Paint.LineTo(X0 + Radius, Y1)
Paint.CurveTo(X0, Y1, X0, Y1, X0, (Y0 + Y1) / 2)
Else
Paint.MoveTo(X0, Y0 + Radius)
Paint.CurveTo(X0, Y0, X0, Y0, X0 + Radius, Y0)
Paint.LineTo(X1 - Radius, Y0)
Paint.CurveTo(X1, Y0, X1, Y0, X1, Y0 + Radius)
Paint.LineTo(X1, Y1 - Radius)
Paint.CurveTo(X1, Y1, X1, Y1, X1 - Radius, Y1)
Paint.LineTo(X0 + Radius, Y1)
Paint.CurveTo(X0, Y1, X0, Y1, X0, Y1 - Radius)
Endif
Endif
Paint.ClosePath
Paint.Brush = Paint.Color(Color.RGB(128, 128, 255))
Paint.Fill(True)
Paint.Brush = Paint.Color(Color.RGB(128, 0, 0, 128))
Paint.LineWidth = 10.0
Paint.Stroke
End
Public Sub Example6()
Dim X As Float = 25.6
Dim Y As Float = 128.0
Dim X1 As Float = 102.4
Dim Y1 As Float = 230.4
Dim X2 As Float = 153.6
Dim Y2 As Float = 25.6
Dim X3 As Float = 230.4
Dim Y3 As Float = 128.0
Paint.MoveTo(X, Y)
Paint.CurveTo(X1, Y1, X2, Y2, X3, Y3)
Paint.LineWidth = 10
Paint.Stroke
Paint.Brush = Paint.Color(Color.RGB(255, 255 * 0.2, 255 * 0.2, 255 * 0.6))
Paint.LineWidth = 6
Paint.MoveTo(X, Y)
Paint.LineTo(X1, Y1)
Paint.MoveTo(X2, Y2)
Paint.LineTo(X3, Y3)
Paint.Stroke
End
Public Sub Example7()
Dim Dashes As Float[] = [5.0, 'ink
1.0, 'skip
1.0, 'ink
1.0] 'skip
Paint.Dash = Dashes
Paint.DashOffset = -5
Paint.LineWidth = 10.0
Paint.MoveTo(128.0, 25.6)
Paint.LineTo(230.4, 230.4)
Paint.RelLineTo(-102.4, 0)
Paint.CurveTo(51.2, 230.4, 51.2, 128.0, 128.0, 128.0)
Paint.Stroke
End
Public Sub Example8()
Paint.MoveTo(128.0, 25.6)
Paint.LineTo(230.4, 230.4)
Paint.LineTo(Paint.X - 102.4, Paint.Y)
Paint.CurveTo(51.2, 230.4, 51.2, 128.0, 128.0, 128.0)
Paint.ClosePath
Paint.MoveTo(64.0, 25.6)
Paint.RelLineTo(51.2, 51.2)
Paint.RelLineTo(-51.2, 51.2)
Paint.RelLineTo(-51.2, -51.2)
Paint.ClosePath
Paint.LineWidth = 10
Paint.Brush = Paint.Color(Color.Blue)
Paint.Fill(True)
Paint.Brush = Paint.Color(Color.Black)
Paint.Stroke
End
Public Sub Example9()
Paint.LineWidth = 6
Paint.Rectangle(12, 12, 232, 70)
Paint.Arc(64, 64, 40, 0, Pi(2))
Paint.Arc(192, 64, 40, 0, Pi(-2))
Paint.FillRule = Paint.FillRuleEvenOdd
Paint.Brush = Paint.Color(Color.RGB(0, 179, 0))
Paint.Fill(True)
Paint.Brush = Paint.Color(0)
Paint.Stroke
Paint.Translate(0, 128)
Paint.Rectangle(12, 12, 232, 70)
Paint.Arc(64, 64, 40, 0, Pi(-2))
Paint.Arc(192, 64, 40, 0, Pi(2))
Paint.FillRule = Paint.FillRuleWinding
Paint.Brush = Paint.Color(Color.RGB(0, 0, 230))
Paint.Fill(True)
Paint.Brush = Paint.Color(0)
Paint.Stroke
End
Public Sub Example10()
Paint.Brush = Paint.LinearGradient(0, 0, 0, 256, [Color.Black, Color.White], [1.0, 0.0])
Paint.Rectangle(0, 0, 256, 256)
Paint.Fill
Paint.Brush = Paint.RadialGradient(102.4, 102.4, 128.0, 115.2, 102.4, [Color.Black, Color.White], [1.0, 0.1])
Paint.Arc(128, 128, 76.8)
Paint.Fill
End
Public Sub Example11()
Dim X, Y, W, H As Float
Dim hBrush As PaintBrush
Dim hImage As Image
hImage = Image.Load(IMAGE_NAME)
X = 16
Y = 40
W = 200
H = 200
'Paint.DrawImage(hImage, X, Y, W, H)
hBrush = Paint.Image(hImage)
hBrush.Translate(X, Y)
hBrush.Scale(W / hImage.W, H / hImage.H)
Paint.Brush = hBrush
Paint.Rectangle(X, Y, W, H)
Paint.Fill
Paint.Brush = Paint.Color(Color.RGB(255, 127, 127, 153))
Paint.Arc(X, Y, 10)
Paint.Fill
End
Public Sub Example12()
Dim hImg As Image
Dim hBrush As PaintBrush
hImg = Image.Load(IMAGE_NAME)
Paint.Translate(128, 128)
'Paint.Rotate(Pi / 4)
Paint.Scale(1 / Sqr(2), 1 / Sqr(2))
Paint.Translate(-128, -128)
hBrush = Paint.Image(himg, 0, 0)
hBrush.Matrix = hBrush.Matrix.Scale(1 / (himg.w / 256.0 * 5.0), 1 / (hImg.w / 256.0 * 5.0))
Paint.Brush = hBrush
Paint.Rectangle(0, 0, 256, 256)
Paint.Fill
End
Public Sub Example13()
Paint.MoveTo(50, 75)
Paint.LineTo(200, 75)
Paint.MoveTo(50, 125)
Paint.LineTo(200, 125)
Paint.MoveTo(50, 175)
Paint.LineTo(200, 175)
Paint.LineWidth = 30
Paint.LineCap = Paint.LineCapRound
Paint.Stroke
End
Public Sub Example14()
Paint.LineWidth = 30
Paint.LineCap = Paint.LineCapButt
Paint.MoveTo(64, 50)
Paint.LineTo(64, 200)
Paint.Stroke
Paint.LineCap = Paint.LineCapRound
Paint.MoveTo(128, 50)
Paint.LineTo(128, 200)
Paint.Stroke
Paint.LineCap = Paint.LineCapSquare
Paint.MoveTo(192, 50)
Paint.LineTo(192, 200)
Paint.Stroke
'Draw helping lines
Paint.Brush = Paint.Color(Color.RGB(255, 31, 31))
Paint.LineWidth = 6
Paint.MoveTo(64, 50)
Paint.LineTo(64, 200)
Paint.MoveTo(128, 50)
Paint.LineTo(128, 200)
Paint.MoveTo(192, 50)
Paint.LineTo(192, 200)
Paint.Stroke
End
Public Sub Example15()
Paint.LineWidth = 40.96
Paint.MoveTo(76.8, 84.48)
Paint.RelLineTo(51.2, -51.2)
Paint.RelLineTo(51.2, 51.2)
Paint.LineJoin = Paint.LineJoinMiter 'Default
Paint.Stroke
Paint.MoveTo(76.8, 161.28)
Paint.RelLineTo(51.2, -51.2)
Paint.RelLineTo(51.2, 51.2)
Paint.LineJoin = Paint.LineJoinBevel
Paint.Stroke
Paint.MoveTo(76.8, 238.08)
Paint.RelLineTo(51.2, -51.2)
Paint.RelLineTo(51.2, 51.2)
Paint.LineJoin = Paint.LineJoinRound
Paint.Stroke
End
Public Sub Example16()
Paint.Font.Name = "Sans"
Paint.Font.Size = 90
Paint.Font.Bold = True
Paint.MoveTo(10, 135)
Paint.Text("Hello")
Paint.Fill
Paint.MoveTo(70, 165)
Paint.text("void")
Paint.Brush = Paint.Color(Color.RGB(128, 128, 255))
Paint.Fill(True)
Paint.Brush = Paint.Color(0)
Paint.LineWidth = 0 '2.56
Paint.Stroke
'Draw helping lines
Paint.Brush = Paint.Color(Color.RGB(255, 31, 31, 93))
Paint.Arc(10, 135, 5.12)
Paint.ClosePath
Paint.Arc(70, 165, 5.12)
Paint.Fill
End
Public Sub Example17()
Dim sText As String = "<font size=\"+2\" color=\"green\">Gambas</font><br><i>already</i> <u>means</u><br><b>Basic!</b>"
Dim X, Y As Float
Dim hExt As PaintExtents
Paint.Font = Font["Sans,40"]
X = 50
Y = 100
Paint.MoveTo(X, Y)
hExt = Paint.RichTextExtents(sText)
Paint.Brush = Paint.RadialGradient(50, 100, 300, 50, 100, [Color.Yellow, Color.Cyan], [1.0, 0.0])
Paint.RichText(sText)
Paint.Fill
Paint.Brush = Paint.Color(Color.RGB(255, 31, 31, 93))
Paint.LineWidth = 1
Paint.Arc(X, Y, 10)
Paint.Fill
Paint.Brush = Paint.Color(Color.RGB(255, 31, 31, 224))
Paint.Rectangle(hExt.X, hExt.Y, hExt.Width, hExt.Height)
Paint.Fill
End
Public Sub Example18()
Paint.Save
Paint.Rectangle(10, 10, 200, 100)
Paint.Stroke(True)
Paint.Clip
Paint.Font.Size = 18
'Paint.Brush = Paint.Color(Color.Blue)
Paint.Text("TO BE, OR NOT TO BE: THAT IS THE QUESTION:", 10, 10, 30, 30)
Paint.Fill
Paint.Restore
'Paint.Brush = Paint.Color(Color.Blue)
Paint.Text("TO BE, OR NOT TO BE: THAT IS THE QUESTION:", 10, 40, 30, 30)
Paint.Fill
End
Public Sub Example20()
Dim eWidth As Float
Dim Y As Float
Y = 20.5
For eWidth = 0 To 5 Step 0.25
Paint.LineWidth = eWidth
Paint.MoveTo(50, Y)
Paint.RelLineTo(200, 0)
Paint.Stroke
Paint.Text(eWidth, 0, Y - 10, 40, 20, Align.Right)
Paint.Fill
Y += 20
Next
End
Private $hSvgImage As SvgImage
Public Sub Example21()
If Not $hSvgImage Then
$hSvgImage = SvgImage.Load("gambas.svg")
Paint.Begin($hSvgImage)
Paint.Brush = Paint.RadialGradient(200, 140, 40, 215, 115, [Color.RGB(255, 0, 0, 64), Color.White], [1.0, 0.1])
Paint.Arc(200, 140, 40)
Paint.Fill
Paint.End
Endif
$hSvgImage.Paint
End
Public Sub Example22()
Paint.Background = Color.RGB(128, 128, 255)
Paint.Rectangle(32, 32, 192, 192, 32)
Paint.Fill(True)
Paint.Background = Color.RGB(128, 0, 0, 128)
Paint.LineWidth = 10
Paint.Stroke
'Paint.Background = Color.Black
'Paint.Arc(128, 128, 96)
'Paint.Stroke
End
Public Sub optExample_Click()
$sFunctionName = "Example" & Last.tag
Try Editor1.text = File.Load($sFunctionName)
If Error Then Editor1.Text = Error.Text
DrawingArea1.Refresh
End
Public Sub DrawingArea1_Draw()
Paint.Reset
Paint.Scale(sldScale.Value / 100, sldScale.Value / 100)
Paint.Translate(128, 128)
Paint.Rotate(Rad(sldRotate.Value))
Paint.Translate(-128, -128)
Object.Call(Me, $sFunctionName)
End
Public Sub sldRotate_Change()
DrawingArea1.Refresh
End
Public Sub sldScale_Change()
DrawingArea1.Refresh
End