From 654daa0724988aa24e7562290ae3dc00c856e830 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Beno=C3=AEt=20Minisini?= Date: Mon, 8 Aug 2022 16:20:45 +0200 Subject: [PATCH] Simplify and fix the PaintBrush implementation. [GB.WEB.GUI] * NEW: Color: Replace 'WebControl._GetColor()' by 'Color.ToHTML()'. * NEW: Paint: Handle the 'PaintBrush' class directly in the Paint class. The paint driver job is just translating it into javascript. * NEW: Paint: Remove the javascript generation routine from the Gradient class and move it to the paint driver. * NEW: Paint: Add the 'Paint.Color' method that creates a color brush. * NEW: Paint: Move the 'PaintBrush' type constants to the 'PaintDriver' class. --- comp/src/gb.web.gui/.src/Color.class | 16 ++++- comp/src/gb.web.gui/.src/Paint/Gradient.class | 15 +--- comp/src/gb.web.gui/.src/Paint/Paint.class | 47 +++++++++---- .../gb.web.gui/.src/Paint/PaintBrush.class | 30 ++------ .../gb.web.gui/.src/Paint/PaintDriver.class | 19 +---- .../Paint/PaintDriver_WebDrawingArea.class | 69 +++++++------------ comp/src/gb.web.gui/.src/Table/WebTable.class | 4 +- .../.src/Test/FTestDrawingArea.class | 8 +-- comp/src/gb.web.gui/.src/Tree/WebTree.class | 4 +- comp/src/gb.web.gui/.src/WebControl.class | 24 +------ 10 files changed, 93 insertions(+), 143 deletions(-) diff --git a/comp/src/gb.web.gui/.src/Color.class b/comp/src/gb.web.gui/.src/Color.class index 7de0ecf7d..4fb03b067 100644 --- a/comp/src/gb.web.gui/.src/Color.class +++ b/comp/src/gb.web.gui/.src/Color.class @@ -73,6 +73,20 @@ End '' Static Public Sub ToHTML({Color} As Integer) As String - Return WebForm._GetColor({Color}) + Dim A As Integer + Dim R As Integer + Dim G As Integer + Dim B As Integer + + A = 255 - Lsr({Color}, 24) + R = Lsr({Color}, 16) And 255 + G = Lsr({Color}, 8) And 255 + B = {Color} And 255 + + If A < 255 Then + Return "rgba(" & CStr(R) & "," & CStr(G) & "," & CStr(B) & "," & CStr(Round(A / 255, -2)) & ")" + Else + Return "#" & Hex$(R, 2) & Hex$(G, 2) & Hex$(B, 2) + Endif End diff --git a/comp/src/gb.web.gui/.src/Paint/Gradient.class b/comp/src/gb.web.gui/.src/Paint/Gradient.class index b62f250ce..ed7912e8e 100644 --- a/comp/src/gb.web.gui/.src/Paint/Gradient.class +++ b/comp/src/gb.web.gui/.src/Paint/Gradient.class @@ -26,11 +26,11 @@ Public Sub _new(Optional Type As Integer = 0, Optional (Coordinates) As Integer[ End '' Add a single gradient point , Pos is a positional number between 0.0 and 1.0 , Color is either a gb Color value or a CSS color value. -Public Sub AddColorStop(Pos As Float, {Color} As Variant) +Public Sub AddColorStop(Pos As Float, vColor As Variant) - If TypeOf({Color}) = gb.Integer Then {Color} = WebControl._GetColor({Color}) + If TypeOf(vColor) = gb.Integer Then vColor = Color.ToHTML(vColor) If Not $aColorStops Then $aColorStops = New Variant[] - $aColorStops.Add([Pos, {Color}]) + $aColorStops.Add([Pos, vColor]) End @@ -43,12 +43,3 @@ Public Sub AddColorStops(Positions As Float[], Colors As Variant[]) End -Public Sub _call() As String - - If Not $aCoordinates Then Error.Raise("No Coordinates") - If Not $aCoordinates.Count Then Error.Raise("No Coordinates") - If Not $aColorStops Then Error.Raise("No ColorStops") - Dim sText As String = "gw.paint.makeGradient(" & JS($iType) & "," & JS($aCoordinates) & "," & JS($aColorStops) & ")" - Return sText - -End diff --git a/comp/src/gb.web.gui/.src/Paint/Paint.class b/comp/src/gb.web.gui/.src/Paint/Paint.class index c3d141f01..e02c44376 100644 --- a/comp/src/gb.web.gui/.src/Paint/Paint.class +++ b/comp/src/gb.web.gui/.src/Paint/Paint.class @@ -6,6 +6,7 @@ Static Private $aStack As New PaintDriver[] Static Property Read Device As WebControl Static Property Write LineWidth As Float +Static Property Brush As PaintBrush Static Private $hCurrent As New PaintDriver @@ -123,28 +124,44 @@ Static Public Sub Clip(Optional Preserve As Boolean) End -Static Public Sub SetBrush(Brush As PaintBrush) - - $hCurrent.SetBrush(Brush) - -End - -Static Public Sub _GetBrush() As PaintBrush - - Return $hCurrent._GetBrush() - -End - - Static Public Sub LinearGradient(X1 As Float, Y1 As Float, X2 As Float, Y2 As Float, Colours As Variant[], Positions As Float[]) As PaintBrush - Return $hCurrent.LinearGradient(X1, Y1, X2, Y2, Colours, Positions) + Dim hGrad As New Gradient(Gradient.Linear, [X1, Y1, X2, Y2]) + Dim hBrush As New PaintBrush + + hGrad.AddColorStops(Positions, Colours) + hBrush._Gradient = hGrad + Return hBrush End Static Public Sub RadialGradient(X1 As Float, Y1 As Float, R1 As Float, X2 As Float, Y2 As Float, R2 As Float, Colours As Variant[], Positions As Float[]) As PaintBrush - Return $hCurrent.RadialGradient(X1, Y1, R1, X2, Y2, R2, Colours, Positions) + Dim hGrad As New Gradient(Gradient.Radial, [X1, Y1, R1, X2, Y2, R2]) + Dim hBrush As New PaintBrush + + hGrad.AddColorStops(Positions, Colours) + hBrush._Gradient = hGrad + Return hBrush End +Static Public Sub Color((Color) As Variant) As PaintBrush + + Dim hBrush As New PaintBrush + hBrush._Color = {Color} + Return hBrush + +End + +Static Private Function Brush_Read() As PaintBrush + + Return $hCurrent.Brush + +End + +Static Private Sub Brush_Write(Value As PaintBrush) + + $hCurrent.Brush = Value + +End diff --git a/comp/src/gb.web.gui/.src/Paint/PaintBrush.class b/comp/src/gb.web.gui/.src/Paint/PaintBrush.class index f9e96f3ee..0e68f3f0f 100644 --- a/comp/src/gb.web.gui/.src/Paint/PaintBrush.class +++ b/comp/src/gb.web.gui/.src/Paint/PaintBrush.class @@ -5,29 +5,11 @@ Export Property _Color As Variant Use $vColor Property _Image As String Use $sImage Property _Gradient As Gradient Use $hGradient -Property Read _Type As Integer Use $iType = -1 - -Public Enum TypeInvalid = -1, TypeColor, TypeImage, TypeGradient +Property Read _Type As Integer Use $iType Public Sub _new() -End - -Public Sub _InitBrush(Optional (Type) As Integer, Optional Value As Variant) - - If Not Type Then Return - - Select Type - Case TypeColor - $vColor = Value - If TypeOf($vColor) = gb.Integer Then $vColor = WebForm._GetColor($vColor) - Case TypeGradient - $hGradient = Value - Case TypeImage - $sImage = Value - End Select - - $iType = Type + _Color_Write(0) End @@ -40,9 +22,9 @@ Private Sub _Color_Write(Value As Variant) Else If TypeOf(Value) = gb.String Then $vColor = Value Else - Error.Raise("Incorrect type") + Error.Raise("Incorrect color") Endif - $iType = TypeColor + $iType = PaintDriver.BRUSH_COLOR End @@ -51,7 +33,7 @@ Private Sub _Gradient_Write(Value As Gradient) $sImage = "" $vColor = Null $hGradient = Value - $iType = TypeGradient + $iType = PaintDriver.BRUSH_GRADIENT End @@ -60,6 +42,6 @@ Private Sub _Image_Write(Value As String) $sImage = Value $hGradient = Null $vColor = Null - $iType = TypeImage + $iType = PaintDriver.BRUSH_IMAGE End diff --git a/comp/src/gb.web.gui/.src/Paint/PaintDriver.class b/comp/src/gb.web.gui/.src/Paint/PaintDriver.class index 9207dbd2f..77a5a3943 100644 --- a/comp/src/gb.web.gui/.src/Paint/PaintDriver.class +++ b/comp/src/gb.web.gui/.src/Paint/PaintDriver.class @@ -1,6 +1,9 @@ ' Gambas class file Public Device As WebControl +Public Brush As PaintBrush + +Public Enum BRUSH_COLOR, BRUSH_IMAGE, BRUSH_GRADIENT Public Sub Begin() @@ -65,19 +68,3 @@ End Public Sub Clip((Preserve) As Boolean) End - -Public Sub SetBrush((Brush) As PaintBrush) - -End - -Public Sub _GetBrush() As PaintBrush - -End - -Public Sub LinearGradient((X1) As Float, (Y1) As Float, (X2) As Float, (Y2) As Float, (Colours) As Variant[], (Positions) As Float[]) As PaintBrush - -End - -Public Sub RadialGradient((X1) As Float, (Y1) As Float, (R1) As Float, (X2) As Float, (Y2) As Float, (R2) As Float, (Colours) As Variant[], (Positions) As Float[]) As PaintBrush - -End diff --git a/comp/src/gb.web.gui/.src/Paint/PaintDriver_WebDrawingArea.class b/comp/src/gb.web.gui/.src/Paint/PaintDriver_WebDrawingArea.class index d7f6b6477..4c85560f2 100644 --- a/comp/src/gb.web.gui/.src/Paint/PaintDriver_WebDrawingArea.class +++ b/comp/src/gb.web.gui/.src/Paint/PaintDriver_WebDrawingArea.class @@ -2,8 +2,6 @@ Inherits PaintDriver -Private $hBrush As PaintBrush - Public Sub Begin() WebForm._AddJavascript("const $_c = $_(" & JS(Me.Device.Name) & ").getContext('2d')") @@ -35,25 +33,40 @@ End Private Sub HandleStyle(hStyle As Variant, sProperty As String) As Boolean - If Not hStyle Then hStyle = $hBrush + Dim hBrush As PaintBrush + Dim hGradient As Gradient + + If Not hStyle Then hStyle = Me.Brush If TypeOf(hStyle) = gb.Integer Then - WebForm._AddJavascript("$_c." & sProperty & " = " & JS(WebControl._GetColor(hStyle))) - - Else If Object.Type(hStyle) = "PaintBrush" Then - Select hStyle._Type - Case PaintBrush.TypeGradient - WebForm._AddJavascript("$_c." & sProperty & " = " & Paint._GetBrush()._Gradient()) - Case PaintBrush.TypeColor - WebForm._AddJavascript("$_c." & sProperty & " = " & Paint._GetBrush()._Color) - End Select + WebForm._AddJavascript("$_c." & sProperty & " = " & JS(Color.ToHTML(hStyle))) Else If TypeOf(hStyle) = gb.String + WebForm._AddJavascript("$_c." & sProperty & " = " & JS(hStyle)) + Else If TypeOf(hStyle) = gb.Object And If hStyle Is PaintBrush Then + + hBrush = hStyle + + Select hBrush._Type + + Case Me.BRUSH_GRADIENT + + hGradient = hBrush._Gradient + WebForm._AddJavascript("$_c." & sProperty & " = gw.paint.makeGradient(" & JS(hGradient.Type) & "," & JS(hGradient.Coordinates) & "," & JS(hGradient.ColorStops) & ")") + + Case Me.BRUSH_COLOR + + WebForm._AddJavascript("$_c." & sProperty & " = " & hBrush._Color) + + End Select + Else + Error.Raise("Incorrect style/brush type") + Endif End @@ -152,35 +165,3 @@ Public Sub Clip(Preserve As Boolean) If Not Preserve Then WebForm._AddJavascript("$_c.beginPath()") End - -Public Sub SetBrush(Brush As PaintBrush) - - $hBrush = Brush - -End - -Public Sub _GetBrush() As PaintBrush - - Return $hBrush - -End - -Public Sub LinearGradient(X1 As Float, Y1 As Float, X2 As Float, Y2 As Float, Colours As Variant[], Positions As Float[]) As PaintBrush - - Dim hGrad As Gradient = New Gradient(Gradient.Linear, [X1, Y1, X2, Y2]) - hGrad.AddColorStops(Positions, Colours) - $hBrush = New PaintBrush - $hBrush._Gradient = hGrad - Return $hBrush - -End - -Public Sub RadialGradient(X1 As Float, Y1 As Float, R1 As Float, X2 As Float, Y2 As Float, R2 As Float, Colours As Variant[], Positions As Float[]) As PaintBrush - - Dim hGrad As Gradient = New Gradient(Gradient.Radial, [X1, Y1, R1, X2, Y2, R2]) - hGrad.AddColorStops(Positions, Colours) - $hBrush = New PaintBrush - $hBrush._Gradient = hGrad - Return $hBrush - -End diff --git a/comp/src/gb.web.gui/.src/Table/WebTable.class b/comp/src/gb.web.gui/.src/Table/WebTable.class index 834d51e5d..c4ca9435f 100644 --- a/comp/src/gb.web.gui/.src/Table/WebTable.class +++ b/comp/src/gb.web.gui/.src/Table/WebTable.class @@ -124,8 +124,8 @@ Private Sub PrintRow(iRow As Integer) sStyle &= "min-width:" & hCol.Width & ";" Endif Endif - If hData.Background <> Color.Default Then sStyle &= "background-color:" & WebControl._GetColor(hData.Background) & ";" - If hData.Foreground <> Color.Default Then sStyle &= "color:" & WebControl._GetColor(hData.Foreground) & ";" + If hData.Background <> Color.Default Then sStyle &= "background-color:" & Color.ToHTML(hData.Background) & ";" + If hData.Foreground <> Color.Default Then sStyle &= "color:" & Color.ToHTML(hData.Foreground) & ";" If sStyle Then Print " style=\""; sStyle; "\""; Print ">"; diff --git a/comp/src/gb.web.gui/.src/Test/FTestDrawingArea.class b/comp/src/gb.web.gui/.src/Test/FTestDrawingArea.class index 3776b3d37..0097cbedf 100644 --- a/comp/src/gb.web.gui/.src/Test/FTestDrawingArea.class +++ b/comp/src/gb.web.gui/.src/Test/FTestDrawingArea.class @@ -22,17 +22,15 @@ Public Sub WebDrawingArea1_Draw() Paint.Stroke(Color.Green) Paint.Rectangle(80, 200, 120, 70) - - Paint.SetBrush(Paint.LinearGradient(80, 200, 80, 270, [Color.Red, Color.Green, Color.Violet], [0, 0.5, 1])) - + Paint.Brush = Paint.LinearGradient(80, 200, 80, 270, [Color.Red, Color.Green, Color.Violet], [0, 0.5, 1]) Paint.Fill() Paint.Rectangle(220, 200, 120, 70) - Paint._GetBrush()._Gradient.Coordinates = [220, 200, 340, 200] + Paint.Brush = Paint.LinearGradient(220, 200, 340, 200, [Color.Red, Color.Green, Color.Violet], [0, 0.5, 1]) Paint.Fill() Paint.Arc(100, 320, 40) - Paint.SetBrush(Paint.RadialGradient(100, 320, 2, 100, 320, 40, ["red", "yellow", "lightblue"], [0, 0.6, 1])) + Paint.Brush = Paint.RadialGradient(100, 320, 2, 100, 320, 40, ["red", "yellow", "lightblue"], [0, 0.6, 1]) Paint.Fill() End diff --git a/comp/src/gb.web.gui/.src/Tree/WebTree.class b/comp/src/gb.web.gui/.src/Tree/WebTree.class index 55cb0e811..2769e71e3 100644 --- a/comp/src/gb.web.gui/.src/Tree/WebTree.class +++ b/comp/src/gb.web.gui/.src/Tree/WebTree.class @@ -1364,8 +1364,8 @@ Private Sub PrintItem(hItem As _WebTreeItem, iLevel As Integer, bVisible As Bool Endif If bData Then - If hData.Background <> Color.Default Then sStyle &= "background-color:" & WebControl._GetColor(hData.Background) & ";" - If hData.Foreground <> Color.Default Then sStyle &= "color:" & WebControl._GetColor(hData.Foreground) & ";" + If hData.Background <> Color.Default Then sStyle &= "background-color:" & Color.ToHTML(hData.Background) & ";" + If hData.Foreground <> Color.Default Then sStyle &= "color:" & Color.ToHTML(hData.Foreground) & ";" Endif If sStyle Then Print " style=\""; sStyle; "\""; diff --git a/comp/src/gb.web.gui/.src/WebControl.class b/comp/src/gb.web.gui/.src/WebControl.class index fac8a5892..1bd6e7eee 100644 --- a/comp/src/gb.web.gui/.src/WebControl.class +++ b/comp/src/gb.web.gui/.src/WebControl.class @@ -413,8 +413,8 @@ Public Sub _RenderStyleSheet() Endif - If $iBackground <> Color.Default Then _AddStyleSheet("background-color:" & _GetColor($iBackground) & ";") - If $iForeground <> Color.Default Then _AddStyleSheet("color:" & _GetColor($iForeground) & ";") + If $iBackground <> Color.Default Then _AddStyleSheet("background-color:" & Color.ToHTML($iBackground) & ";") + If $iForeground <> Color.Default Then _AddStyleSheet("color:" & Color.ToHTML($iForeground) & ";") If $hStyle And If Not $hStyle.IsVoid() Then $aStyleSheet.Insert($hStyle._GetStyleSheet()) @@ -863,26 +863,6 @@ Private Sub Foreground_Write(Value As Integer) End -Static Public Sub _GetColor(iCol As Integer) As String - - Dim A As Integer - Dim R As Integer - Dim G As Integer - Dim B As Integer - - A = 255 - Lsr(iCol, 24) - R = Lsr(iCol, 16) And 255 - G = Lsr(iCol, 8) And 255 - B = iCol And 255 - - If A < 255 Then - Return "rgba(" & CStr(R) & "," & CStr(G) & "," & CStr(B) & "," & CStr(Round(A / 255, -2)) & ")" - Else - Return "#" & Hex$(R, 2) & Hex$(G, 2) & Hex$(B, 2) - Endif - -End - '' Raise the control. Public Sub Raise()