-
Jun 12th, 2022, 09:35 PM
#1
Thread Starter
Fanatic Member
[RESOLVED] Line Methof for a gradient in a Triangle
I have used the following code to put a gradient in a triangle
Code:
Private Sub FadeTriangle(ByVal pic As PictureBox, _ ByVal start_r As Single, ByVal start_g As Single, ByVal start_b As Single, _
ByVal end_r As Single, ByVal end_g As Single, ByVal end_b As Single, _
ByVal start_y, ByVal end_y, ByVal Dir As String)
' Fade colors in a vertical area of a PictureBox.
Dim hgt As Single
Dim wid As Single
Dim r As Single
Dim g As Single
Dim b As Single
Dim dr As Single
Dim dg As Single
Dim db As Single
Dim Y As Single
If Dir = "U" Then
wid = pic.ScaleWidth
hgt = end_y - start_y
dr = (end_r - start_r) / hgt
dg = (end_g - start_g) / hgt
db = (end_b - start_b) / hgt
r = start_r
g = start_g
b = start_b
'For Y = start_y To end_y '(end_y / 2)
For Y = (end_y / 2) To end_y
pic.Line (Y, Y)-(wid - Y, Y), RGB(r, g, b)
r = r + dr
g = g + dg
b = b + db
Next Y
ElseIf Dir = "D" Then
wid = pic.ScaleWidth
hgt = end_y - start_y
dr = (end_r - start_r) / hgt
dg = (end_g - start_g) / hgt
db = (end_b - start_b) / hgt
r = start_r
g = start_g
b = start_b
'For y = (end_y / 2) To start_y Step -1
For Y = start_y To (end_y / 2)
pic.Line (Y, Y)-(wid - Y, Y), RGB(r, g, b)
r = r + dr
g = g + dg
b = b + db
Next Y
End If
End Sub
The "U" and "D" are up for up oriented or down oriented triangles.
I amd using a PB with width = height
The problems are
1. I get a triangle for only half the height of the PB,
2. I get two triangle shaped like an hourglass.
What I need is a triangle as follows
I could easily change the gradient colors. I would also need one that is upside down.
Thanks
-
Jun 13th, 2022, 12:15 AM
#2
Re: Line Methof for a gradient in a Triangle
I stripped out a bunch of stuff from an old project and made this demo:
Code:
Option Explicit
Private Const PI As Double = 3.14159265358979
Private Type TRIVERTEX
X As Long
Y As Long
RedLow As Byte
Red As Byte
GreenLow As Byte
Green As Byte
BlueLow As Byte
Blue As Byte
AlphaLow As Byte
Alpha As Byte
End Type
Private Type GRADIENT_TRIANGLE
Vertex1 As Long
Vertex2 As Long
Vertex3 As Long
End Type
Public Enum GRADIENT_FILL_MODES
GRADIENT_FILL_RECT_H = &H0&
GRADIENT_FILL_RECT_V = &H1&
GRADIENT_FILL_TRIANGLE = &H2&
[_GRADIENT_FILL_OP_FLAG] = &HFF&
End Enum
'Preserve identifier case:
#If False Then
Dim GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V, GRADIENT_FILL_TRIANGLE
#End If
Private Declare Function GradientFill Lib "msimg32" ( _
ByVal hDC As Long, _
ByRef Vertex As TRIVERTEX, _
ByVal nVertex As Long, _
ByRef Mesh As Any, _
ByVal nMesh As Long, _
Optional ByVal Mode As GRADIENT_FILL_MODES = GRADIENT_FILL_TRIANGLE) As Long
Private Type GDI_POINT
X As Long
Y As Long
End Type
Private Declare Function Polygon Lib "gdi32" ( _
ByVal hDC As Long, _
ByRef Points As GDI_POINT, _
ByVal nCount As Long) As Long
Private Type EquLatTri
Center As GDI_POINT
Vertices(0 To 2) As GDI_POINT
End Type
Private Function ColorGFTriVertices( _
ByRef EquLatTri As EquLatTri, _
ByRef COLORREFs As Variant) As TRIVERTEX()
Dim Vertices() As TRIVERTEX
Dim I As Long
If VarType(COLORREFs) <> (vbArray Or vbVariant) Then Err.Raise 5 'Invalid procedure call or argument.
If LBound(COLORREFs) <> 0 Or UBound(COLORREFs) <> 2 Then Err.Raise 5
ReDim Vertices(0 To 2)
For I = 0 To 2
If VarType(COLORREFs(I)) <> vbLong Then Err.Raise 5
If COLORREFs(I) And &HFF000000 Then Err.Raise 5
With Vertices(I)
.X = EquLatTri.Vertices(I).X
.Y = EquLatTri.Vertices(I).Y
.Red = COLORREFs(I) And &HFF&
.Green = (COLORREFs(I) And &HFF00&) \ &H100&
.Blue = COLORREFs(I) \ &H10000
End With
Next
ColorGFTriVertices = Vertices
End Function
Private Function MakeEquLatTri( _
ByVal CenterX As Single, _
ByVal CenterY As Single, _
ByVal LengthSide As Single, _
Optional ByVal Units As ScaleModeConstants = vbTwips) As EquLatTri
Dim Altitude As Single
With MakeEquLatTri
.Center.X = Int(ScaleX(CenterX, Units, vbPixels) + 0.5)
.Center.Y = Int(ScaleY(CenterY, Units, vbPixels) + 0.5)
Altitude = ScaleY(Sqr(3) / 2 * LengthSide, Units, vbPixels)
.Vertices(0).X = .Center.X - Int(ScaleX(LengthSide / 2, Units, vbPixels) + 0.5)
.Vertices(0).Y = .Center.Y + Int(Altitude / 3 + 0.5)
.Vertices(1).X = .Center.X
.Vertices(1).Y = .Vertices(0).Y - Int(Altitude + 0.5)
.Vertices(2).X = .Vertices(0).X + Int(ScaleX(LengthSide, Units, vbPixels) + 0.5)
.Vertices(2).Y = .Vertices(0).Y
End With
End Function
Private Sub MoveEquLatTri( _
ByRef EquLatTri As EquLatTri, _
ByVal DeltaX As Single, _
ByVal DeltaY As Single, _
Optional ByVal Units As ScaleModeConstants = vbTwips)
Dim DX As Long
Dim DY As Long
Dim I As Long
With EquLatTri
DX = Int(ScaleX(DeltaX, Units, vbPixels) + 0.5)
DY = Int(ScaleY(DeltaY, Units, vbPixels) + 0.5)
.Center.X = .Center.X + DX
.Center.Y = .Center.Y + DY
For I = 0 To 2
.Vertices(I).X = .Vertices(I).X + DX
.Vertices(I).Y = .Vertices(I).Y + DY
Next
End With
End Sub
Private Sub RotateEquLatTri(ByRef EquLatTri As EquLatTri, ByVal Angle As Double)
Dim I As Long
Dim NewEquLatTri As EquLatTri
With EquLatTri
NewEquLatTri.Center.X = .Center.X
NewEquLatTri.Center.Y = .Center.Y
For I = 0 To 2
NewEquLatTri.Vertices(I).X = ((.Vertices(I).X - .Center.X) * Cos(Angle) _
- (.Vertices(I).Y - .Center.Y) * Sin(Angle)) _
+ .Center.X
NewEquLatTri.Vertices(I).Y = ((.Vertices(I).X - .Center.X) * Sin(Angle) _
+ (.Vertices(I).Y - .Center.Y) * Cos(Angle)) _
+ .Center.Y
Next
End With
LSet EquLatTri = NewEquLatTri
End Sub
Private Sub Form_Load()
Dim EquLatTri As EquLatTri
Dim GFTriVertices() As TRIVERTEX
Dim GFTriMesh As GRADIENT_TRIANGLE 'Indexes into GFTriVertices().
AutoRedraw = True
BackColor = &H104010
ForeColor = vbWhite
FillColor = vbGreen
FillStyle = vbFSSolid
'We'll pick some sizes to fit the Form's client area:
EquLatTri = MakeEquLatTri(ScaleWidth / 4, ScaleHeight / 4, ScaleHeight / 4)
Polygon hDC, EquLatTri.Vertices(0), 3
MoveEquLatTri EquLatTri, ScaleWidth / 2, ScaleHeight / 2
RotateEquLatTri EquLatTri, PI
ForeColor = vbYellow
FillColor = vbBlue
DrawWidth = 2
Polygon hDC, EquLatTri.Vertices(0), 3
ForeColor = vbRed
FillStyle = vbFSTransparent
DrawWidth = 4
EquLatTri = MakeEquLatTri(ScaleWidth / 2, ScaleHeight / 2, ScaleHeight / 2)
RotateEquLatTri EquLatTri, PI / 4
GFTriVertices = ColorGFTriVertices(EquLatTri, Array(vbMagenta, vbYellow, vbMagenta))
GFTriMesh.Vertex1 = 0
GFTriMesh.Vertex2 = 1
GFTriMesh.Vertex3 = 2
GradientFill hDC, GFTriVertices(0), 3, GFTriMesh, 1
Polygon hDC, EquLatTri.Vertices(0), 3
End Sub
Maybe you can find something in there that can help? It rotates to any angle in radians.
-
Jun 13th, 2022, 01:29 PM
#3
Thread Starter
Fanatic Member
Re: Line Methof for a gradient in a Triangle
Thanks for your code. I will review.
At first glance, I see it makes an equilateral triangle (all sides of equal length). My case has an isoceles triangle (two equal sides and one shorter side). The short side is 550 units. Think of a square 550x550. Find the center point of the top part of the square. Connect the bottom 2 corners to the top center point. I don't know yet, if your code will handle this type of triangle.
Likewise, I will need this triangle inverted.
-
Jun 13th, 2022, 01:57 PM
#4
Re: Line Methof for a gradient in a Triangle
Well perhaps something there is still useful. It shows some of the calculations for arbitrary rotation and such.
If you change the characteristics of your triangles you will need to rework those. For a really specific case like yours you can probably eliminate most of that. Get the vertices and drawing them is easy. Get the altitude and a vertical flip-and-move is easy.
-
Jun 13th, 2022, 01:59 PM
#5
Re: Line Methof for a gradient in a Triangle
You might also want more control over drawing gradients, perhaps more of a "fill line" than a gradient?
-
Jun 14th, 2022, 08:31 AM
#6
Re: Line Methof for a gradient in a Triangle
I didn't try your code from post #1 yet, but I suspect you forgot that a triangle is reducing its width by 2 for each line, i.e. you are reducing both the left and right sides, so dividing your step size by height gives you how much the line should shrink with each step, but half of that should be applied to the left and half to the right.
I would try dividing by hgt*2 in some areas to see if it fixes your issue.
p.s. I looked at the code and I was sort of wrong.
The issue was that your code assumes a 1 to 1 ratio between X and Y dimensions, i.e. you're using the value of Y for both your X value and your Y value when drawing the line, which is actually what you stated you didn't want, i.e. you didn't want an equal-lateral triangle.
So, you need to determine the ratio between the change in X compared to the change in Y.
Since you are looping Y by 1, then X becomes the calculated value, so that it reduces to 0 over the range of Y.
I added a variable "rat" to hold the ratio, i.e. how much to reduce X by each iteration of the loop.
You can implement it several ways, but I just choose to add two more variables, sx for starting X and ex for ending X, and initial those before the loop and increase the start by the ration and decrease the end by the ratio for each step.
Code:
Private Sub FadeTriangle(ByVal pic As PictureBox, _
ByVal start_r As Single, ByVal start_g As Single, ByVal start_b As Single, _
ByVal end_r As Single, ByVal end_g As Single, ByVal end_b As Single, _
ByVal start_y, ByVal end_y, ByVal Dir As String)
' Fade colors in a vertical area of a PictureBox.
Dim hgt As Single
Dim wid As Single
Dim r As Single
Dim g As Single
Dim b As Single
Dim dr As Single
Dim dg As Single
Dim db As Single
Dim Y As Single
Dim rat As Single
Dim sx As Single, ex As Single
If Dir = "U" Then
wid = pic.ScaleWidth
hgt = end_y - start_y
rat = (wid / 2) / hgt
dr = (end_r - start_r) / hgt
dg = (end_g - start_g) / hgt
db = (end_b - start_b) / hgt
r = start_r
g = start_g
b = start_b
sx = 0
ex = wid
For Y = start_y To end_y '(end_y / 2)
' For Y = (end_y / 2) To end_y
pic.Line (sx, Y)-(ex, Y), RGB(r, g, b)
sx = sx + rat
ex = ex - rat
r = r + dr
g = g + dg
b = b + db
Next Y
ElseIf Dir = "D" Then
wid = pic.ScaleWidth
hgt = end_y - start_y
dr = (end_r - start_r) / hgt
dg = (end_g - start_g) / hgt
db = (end_b - start_b) / hgt
rat = (wid / 2) / hgt
r = start_r
g = start_g
b = start_b
sx = 0
ex = wid
'For y = (end_y / 2) To start_y Step -1
For Y = start_y To end_y
pic.Line (sx, Y)-(ex, Y), RGB(r, g, b)
sx = sx + rat
ex = ex - rat
r = r + dr
g = g + dg
b = b + db
Next Y
End If
End Sub
Last edited by passel; Jun 14th, 2022 at 09:05 AM.
"Anyone can do any amount of work, provided it isn't the work he is supposed to be doing at that moment" Robert Benchley, 1930
-
Jun 14th, 2022, 04:21 PM
#7
Re: Line Methof for a gradient in a Triangle
I rediddled the code I posted earlier. This might come closer to what you wanted.
Code:
Option Explicit
Private Const WIN32_NULL As Long = 0
Private Declare Function ColorHLSToRGB Lib "shlwapi" ( _
ByVal wHue As Integer, _
ByVal wLuminance As Integer, _
ByVal wSaturation As Integer) As Long
Private Declare Sub ColorRGBToHLS Lib "shlwapi" ( _
ByVal clrRGB As Long, _
ByRef wHue As Integer, _
ByRef wLuminance As Integer, _
ByRef wSaturation As Integer)
Private Declare Function LineTo Lib "gdi32" ( _
ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long) As Long
Private Type GDI_POINT
X As Long
Y As Long
End Type
Private Declare Function MoveToEx Lib "gdi32" ( _
ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByRef Point As Any) As Long
Private Declare Function Polygon Lib "gdi32" ( _
ByVal hDC As Long, _
ByRef Points As GDI_POINT, _
ByVal nCount As Long) As Long
Private Type IsocTri
Altitude As Long
Base As Long
Vertices(0 To 2) As GDI_POINT
End Type
Private Function ARound(ByVal Expression As Single) As Long
'Arithmetically round to a Long integer value.
ARound = Fix(Expression + Sgn(Expression) * 0.5)
End Function
Private Sub Backdrop()
Dim I As Single
DrawStyle = vbDot
For I = 0 To ScaleWidth Step ScaleX(15, vbPixels)
Line (I, 0)-(I, ScaleHeight), &HD0B080
Next
For I = 0 To ScaleHeight Step ScaleX(15, vbPixels)
Line (0, I)-(ScaleWidth, I), &HD0B080
Next
DrawStyle = vbSolid
End Sub
Private Function ColorShift( _
ByVal CurrentColor As Long, _
ByVal DeltaHue As Single, _
ByVal DeltaLuminance As Single, _
ByVal DeltaSaturation As Single) As Long
Dim wHue As Integer
Dim wLuminance As Integer
Dim wSaturation As Integer
ColorRGBToHLS CurrentColor, wHue, wLuminance, wSaturation
wHue = (wHue + ARound(DeltaHue) + 240) Mod 240
wLuminance = wLuminance + ARound(DeltaLuminance)
If wLuminance < 0 Then wLuminance = 0 Else If wLuminance > 240 Then wLuminance = 240
wSaturation = wSaturation + ARound(DeltaSaturation)
If wSaturation < 0 Then wSaturation = 0 Else If wSaturation > 240 Then wSaturation = 240
ColorShift = ColorHLSToRGB(wHue, wLuminance, wSaturation)
End Function
Private Function MakeIsocTri( _
ByVal Base As Single, _
ByVal Altitude As Single, _
Optional ByVal Units As ScaleModeConstants = vbTwips) As IsocTri
With MakeIsocTri
.Altitude = ARound(ScaleY(Altitude, Units, vbPixels))
.Base = ARound(ScaleX(Base, Units, vbPixels))
'.Vertices(0).X = 0
.Vertices(0).Y = .Altitude
.Vertices(1).X = ARound(.Base * 0.5)
'.Vertices(1).Y = 0
.Vertices(2).X = .Vertices(0).X + .Base - 1
.Vertices(2).Y = .Vertices(0).Y
End With
End Function
Private Function MakeLinePointsAtHeight( _
ByRef IsocTri As IsocTri, _
ByVal Height As Single, _
Optional ByVal Units As ScaleModeConstants = vbTwips) As GDI_POINT()
'Height is a positive value growing "down" from the apex.
Dim LinePoints() As GDI_POINT
Dim HalfBaseAtHeight As Long
ReDim LinePoints(0 To 1)
With IsocTri
HalfBaseAtHeight = ARound((.Base * 0.5 / .Altitude) * Sgn(.Altitude) * ScaleY(Height, Units, vbPixels))
LinePoints(0).X = .Vertices(1).X - HalfBaseAtHeight
LinePoints(0).Y = .Vertices(1).Y _
+ Sgn(.Altitude) * ARound(ScaleY(Height, Units, vbPixels))
LinePoints(1).X = LinePoints(0).X + HalfBaseAtHeight * 2
LinePoints(1).Y = LinePoints(0).Y
End With
MakeLinePointsAtHeight = LinePoints
End Function
Private Sub MoveIsocTri( _
ByRef IsocTri As IsocTri, _
ByVal DeltaX As Single, _
ByVal DeltaY As Single, _
Optional ByVal Units As ScaleModeConstants = vbTwips)
Dim I As Long
With IsocTri
For I = 0 To 2
.Vertices(I).X = .Vertices(I).X + ARound(ScaleX(DeltaX, Units, vbPixels))
.Vertices(I).Y = .Vertices(I).Y + ARound(ScaleY(DeltaY, Units, vbPixels))
Next
End With
End Sub
Private Sub Rot180IsocTri(ByRef IsocTri As IsocTri)
Dim NewIsocTri As IsocTri
With IsocTri
NewIsocTri.Altitude = -.Altitude
NewIsocTri.Base = -.Base
NewIsocTri.Vertices(0).X = .Vertices(2).X
NewIsocTri.Vertices(0).Y = .Vertices(1).Y
NewIsocTri.Vertices(1).X = .Vertices(1).X
NewIsocTri.Vertices(1).Y = .Vertices(2).Y
NewIsocTri.Vertices(2).X = .Vertices(0).X
NewIsocTri.Vertices(2).Y = .Vertices(1).Y
End With
IsocTri = NewIsocTri
End Sub
Private Sub DrawLine(ByVal hDC As Long, ByRef LinePoints() As GDI_POINT)
MoveToEx hDC, LinePoints(0).X, LinePoints(0).Y, ByVal WIN32_NULL
LineTo hDC, LinePoints(1).X, LinePoints(1).Y
End Sub
Private Sub Form_Load()
Dim IsocTri As IsocTri
Dim LinePoints() As GDI_POINT
Dim LevelHeight As Long
Dim StartColor As Long
Dim DeltaHue As Single
Dim SaveForeColor As Long
AutoRedraw = True
Backdrop
IsocTri = MakeIsocTri(2100, 1200)
MoveIsocTri IsocTri, (ScaleWidth - 2100) / 2, 300
Rot180IsocTri IsocTri
DrawWidth = 1
'70% height:
LevelHeight = Abs(IsocTri.Altitude * 0.7)
LinePoints = MakeLinePointsAtHeight(IsocTri, LevelHeight, vbPixels)
'Fill "from the line, up" here:
StartColor = vbRed
DeltaHue = 0
Do
ForeColor = ColorShift(StartColor, DeltaHue, 0, 0)
DrawLine hDC, LinePoints
LevelHeight = LevelHeight + Sgn(IsocTri.Altitude)
LinePoints = MakeLinePointsAtHeight(IsocTri, LevelHeight, vbPixels)
DeltaHue = DeltaHue + 0.75
Loop Until LinePoints(0).Y = IsocTri.Vertices(1).Y
SaveForeColor = ForeColor
ForeColor = vbBlack
DrawWidth = 2
Polygon hDC, IsocTri.Vertices(0), 3
Rot180IsocTri IsocTri
MoveIsocTri IsocTri, 0, IsocTri.Altitude, vbPixels
DrawWidth = 1
'70% height:
LevelHeight = Abs(IsocTri.Altitude * 0.7)
LinePoints = MakeLinePointsAtHeight(IsocTri, LevelHeight, vbPixels)
'Fill "from the line, down" here:
StartColor = SaveForeColor
DeltaHue = 0
Do
ForeColor = ColorShift(StartColor, DeltaHue, 0, 0)
DrawLine hDC, LinePoints
LevelHeight = LevelHeight + Sgn(IsocTri.Altitude)
LinePoints = MakeLinePointsAtHeight(IsocTri, LevelHeight, vbPixels)
DeltaHue = DeltaHue - 2
Loop Until LinePoints(0).Y = IsocTri.Vertices(0).Y
ForeColor = vbBlack
DrawWidth = 2
Polygon hDC, IsocTri.Vertices(0), 3
End Sub
Like the other one, just paste this into a blank Form.
-
Jun 14th, 2022, 05:03 PM
#8
Re: Line Methof for a gradient in a Triangle
BTW:
Never underestimate the power of dumb mistakes.
While tinkering on the code above, a slip of the keyboard caused me to convert twips to points in one place. That one goofy error caused me to waste almost two frustrating hours trying to correct an algorithm based on similar triangles and geometric mean... before I finally spotted it.
At least I saw it before resorting to posting it for help. To other eyeballs it might have been obvious but I just didn't see it for a long time. My brain "knew what I wrote" and that blinded me to the screwup.
-
Jun 15th, 2022, 04:25 PM
#9
Thread Starter
Fanatic Member
Re: Line Methof for a gradient in a Triangle
I spent more than 1 day relearning trigonometry to solve my triangle problem. Well I had trig as a senior ih high school. I don't rermember using it much since then. But here I am learning it again. Oh, BTW, that was over 60 yrs ago. I don't think trig as changed.
Anyway, I broke up the PB into three PBs. The one on the left was easy to enter a horizontal color gradient with some numbers placed on it. The one on the right was similar to the one on the left with different numbers.
So the middle PB. I made sure the width was equal to the height. First I placed the same gradient as with the other 2 PBs. AT this point it looked like on long PB. No borders. Now this is where the trig came in. This PB needed 2 gradients. The first gradient matched the other two. On top of this gradient I placed another on. For a casual observer, it appeaded that I placed the 2nd gradient on a transparent background. Of course,, we know better. This is where the triangle had to go. I decided to make this easy (ha, ha), be requiring the bas of the triangle to be the width of the PB. The hight of the triangel to be the height of the PB. when I needed an upward pointing triangle the top woub be at the senter point of the top of the PB. Just reverse it for downward triangle I occationally needed. OK so how do I get the sides of the triangle to place my gradient. Thats where ALL trig came it.
I knew the height and wodth. I veritcally cut the triangle in half. Now by using the Tan(theta) for the angle in question I could walk my way up the bid triangel with small ones to get the horizontal size. The rest was easy, remebering to do the reflection for the other side of the triangle.
Well, anyway, heres the code.
Code:
Private Sub FadeTriangle(ByVal pic As PictureBox, _ ByVal start_r As Single, ByVal start_g As Single, ByVal start_b As Single, _
ByVal end_r As Single, ByVal end_g As Single, ByVal end_b As Single, _
ByVal start_y, ByVal end_y, ByVal Dir As String)
' Fade colors in a vertical area of a PictureBox.
Dim hgt As Single
Dim wid As Single
Dim r As Single
Dim g As Single
Dim b As Single
Dim dr As Single
Dim dg As Single
Dim db As Single
Dim Y As Single
Dim hyp As Double
Dim adj As Double
Dim opp As Double
Dim dblTanUGBL As Double 'U=Up, G=green,B=Bottom,L=Left,
Dim dblTanDRTL As Double 'D=Down,R=Red, T=Top, L=Left,
If Dir = "U" Then
wid = pic.ScaleWidth
hgt = end_y - start_y
dr = (end_r - start_r) / hgt
dg = (end_g - start_g) / hgt
db = (end_b - start_b) / hgt
dblTanUGBL = (1200 / 600) 'Opposite/Adjacent
r = start_r
g = start_g
b = start_b
For Y = start_y To end_y
adj = Y / dblTanUGBL
pic.Line ((wid / 2) - adj, Y)-((wid / 2) + adj, Y), RGB(r, g, b)
r = r + dr
g = g + dg
b = b + db
Next Y
ElseIf Dir = "D" Then
wid = pic.ScaleWidth
hgt = end_y - start_y
dr = (end_r - start_r) / hgt
dg = (end_g - start_g) / hgt
db = (end_b - start_b) / hgt
dblTanDRTL = (600 / 1200) 'Opposite/Adjacent
r = start_r
g = start_g
b = start_b
For Y = end_y To start_y Step -1
adj = 1200 - Y
opp = adj * dblTanDRTL
pic.Line ((wid / 2) - opp, Y)-((wid / 2) + opp, Y), RGB(r, g, b)
r = r + dr
g = g + dg
b = b + db
Next Y
End If
End Sub
Oh, I just noticed some hard coded number. I will now update my code to change to scaleheight and scalewidth.
Thanks you all for you input and encouragement.
dilettante, thanks for you code. I will look at is soon.
-
Jun 15th, 2022, 05:38 PM
#10
Re: [RESOLVED] Line Methof for a gradient in a Triangle
You don't need any trig functions at all to vertically flip the triangle... or rotate it by 180 deg.
Same for calculating the endpoint coords of a series of horizontal lines drawn as "fill." It's a simple case of similar triangles, and a ratio/proportion calculation does it all.
-
Jun 15th, 2022, 06:14 PM
#11
Re: [RESOLVED] Line Methof for a gradient in a Triangle
I did some screwing around with manually filling with 2-color gradients. More specifically ways of fading from start color to end color. Here's a "toy" for evaluating the approach I settled on:
Form1.frm
Code:
Option Explicit
'Two small square PictureBox controls where BackColor values are our start/end colors:
'
' PictureBox(0)
' and PictureBox(1)
Private ColorDlg As ColorDlg
Private Function ARound(ByVal Expression As Single) As Long
'Arithmetically round to a Long integer value.
ARound = Fix(Expression + Sgn(Expression) * 0.5)
End Function
Private Sub Gradiate()
Dim I As Long
Dim Color As Long
Dim R(0 To 1) As Single
Dim G(0 To 1) As Single
Dim B(0 To 1) As Single
Dim Steps As Long
Dim DeltaR As Single
Dim DeltaG As Single
Dim DeltaB As Single
Dim DrawHeight As Long
Dim NewR As Long
Dim NewG As Long
Dim NewB As Long
With ColorDlg
For I = 0 To 1
Color = .OleColorToColor(PictureBox(I).BackColor)
R(I) = Color And &HFF&
G(I) = (Color And &HFF00&) \ &H100&
B(I) = Color \ &H10000
Next
End With
Steps = ScaleWidth
DeltaR = (R(1) - R(0)) / Steps
DeltaG = (G(1) - G(0)) / Steps
DeltaB = (B(1) - B(0)) / Steps
DrawHeight = ScaleHeight - 1
For I = 0 To Steps
NewR = ARound(R(0) + DeltaR * I)
If NewR < 0 Then NewR = 0 Else If NewR > 255 Then NewR = 255
NewG = ARound(G(0) + DeltaG * I)
If NewG < 0 Then NewG = 0 Else If NewG > 255 Then NewG = 255
NewB = ARound(B(0) + DeltaB * I)
If NewB < 0 Then NewB = 0 Else If NewB > 255 Then NewB = 255
Line (I, 0)-(I, DrawHeight), NewR Or NewG * &H100& Or NewB * &H10000
Next
End Sub
Private Sub Form_Load()
Set ColorDlg = New ColorDlg
ScaleMode = vbPixels
AutoRedraw = True
Gradiate
End Sub
Private Sub Form_Resize()
If WindowState <> vbMinimized Then
With PictureBox(0)
.Move 0, (ScaleHeight - .Height) / 2
End With
With PictureBox(1)
.Move ScaleWidth - .Width, (ScaleHeight - .Height) / 2
End With
Gradiate
End If
End Sub
Private Sub PictureBox_Click(Index As Integer)
With ColorDlg
.Color = PictureBox(Index).BackColor
.CustomColor(14) = PictureBox(0).BackColor
.CustomColor(15) = PictureBox(1).BackColor
If .Show(hWnd) Then
PictureBox(Index).BackColor = .Color
Gradiate
End If
End With
End Sub
ColorDlg.cls:
Code:
Option Explicit
Private Const CC_ANYCOLOR = &H100
Private Const CC_RGBINIT = &H1
Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As Long
End Type
Private Declare Function ChooseColorAPI Lib "comdlg32" Alias "ChooseColorW" ( _
ByRef CHOOSECOLOR As CHOOSECOLOR) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private CHOOSECOLOR As CHOOSECOLOR
Private mCustomColors(0 To 15) As Long 'Buffer to retain user's settings.
Private mColor As Long
Public Property Get Color() As OLE_COLOR
Color = mColor
End Property
Public Property Let Color(ByVal RHS As OLE_COLOR)
mColor = OleColorToColor(RHS)
End Property
Public Property Get CustomColor(ByVal Index As Long) As OLE_COLOR
CustomColor = mCustomColors(Index)
End Property
Public Property Let CustomColor(ByVal Index As Long, ByVal RHS As OLE_COLOR)
mCustomColors(Index) = OleColorToColor(RHS)
End Property
Public Function OleColorToColor(ByVal OLE_COLOR As OLE_COLOR) As Long
If OLE_COLOR And &H80000000 Then
OleColorToColor = GetSysColor(OLE_COLOR And &HFFFF&)
Else
OleColorToColor = OLE_COLOR
End If
End Function
Public Function Show(ByVal hWnd As Long) As Boolean
'Returns False on Cancel or error.
With CHOOSECOLOR
.lStructSize = LenB(CHOOSECOLOR)
.hwndOwner = hWnd
.Flags = CC_ANYCOLOR Or CC_RGBINIT Or CC_FULLOPEN
.lpCustColors = VarPtr(mCustomColors(0))
.rgbResult = mColor
End With
Show = ChooseColorAPI(CHOOSECOLOR) <> 0
If Show Then mColor = CHOOSECOLOR.rgbResult
End Function
Private Sub Class_Initialize()
Color = &HC0C0C0
End Sub
-
Jun 15th, 2022, 07:05 PM
#12
Re: [RESOLVED] Line Methof for a gradient in a Triangle
Here's my take regarding a gradient-triangle routine (allowing free rotation):
Code:
Sub GradientTriangle(PB As PictureBox, ColorAt_xy, ColorAt_ab, ByVal x As Double, ByVal y As Double, _
ByVal th As Double, ByVal ta As Double, ByVal tb As Double, _
Optional ByVal aDeg As Double = 0, Optional ByVal BorderColor As Long = -1, _
Optional ByVal gIv0 As Double = 0, Optional ByVal gIv1 As Double = 1)
If th > 1 Then y = Int(y) + 0.5 Else Exit Sub
Dim sR#: sR = (ColorAt_xy And &HFF&)
Dim sG#: sG = (ColorAt_xy And &HFF00&) \ &H100&
Dim sB#: sB = (ColorAt_xy And &HFF0000) \ &H10000
Dim dh#: dh = th * (gIv1 - gIv0) 'calculate the effective gradient-height-difference
Dim dR#: dR = ((ColorAt_ab And &HFF&) - sR) / dh
Dim dG#: dG = ((ColorAt_ab And &HFF00&) \ &H100& - sG) / dh
Dim dB#: dB = ((ColorAt_ab And &HFF0000) \ &H10000 - sB) / dh
Dim ar#: ar = (aDeg - 90) * Atn(1) / 45 'convert aDeg into radians
Dim y0#: y0 = th * gIv0 'the start-offset for our gradient-line-loop
Dim i#, x1#, y1#, x2#, y2#, dy#, gC&
For i = 0.25 To dh Step 0.5
PointRotate ar, y0 + i, (y0 + i) * ta / th, x1, y1 'rotate the line-start-point (result in x1 and y1)
PointRotate ar, y0 + i, -(y0 + i) * tb / th, x2, y2 'rotate the line-end-point (result in x2 and y2)
gC = RGB(sR + i * dR, sG + i * dG, sB + i * dB) 'calculate the current gradient-color
'we draw two lines (with an additional y-Offs of +-dy, to avoid line-gaps on certain angles)
If y0 + i < 10 Then dy = 0 Else dy = 0.25
PB.Line (Int(x + x1), Int(y + y1 - dy))-(Int(x + x2), Int(y + y2 - dy)), gC
PB.Line (Int(x + x1), Int(y + y1 + dy))-(Int(x + x2), Int(y + y2 + dy)), gC
Next
If BorderColor <> -1 Then 'draw an additional framing-border, when the BorderColor<>-1
PointRotate ar, th, ta, x1, y1: PointRotate ar, th, -tb, x2, y2
PB.Line (Int(x), Int(y))-(Int(x + x1), Int(y + y1)), BorderColor
PB.Line -(Int(x + x2), Int(y + y2)), BorderColor
PB.Line -(Int(x), Int(y)), BorderColor
End If
End Sub
Sub PointRotate(ByVal aRad As Double, ByVal x As Double, ByVal y As Double, xRot, yRot) 'just a little helper
Dim sa#: sa = Sin(aRad)
Dim ca#: ca = Cos(aRad)
xRot = y * sa + x * ca
yRot = y * ca - x * sa
End Sub
And here the code for an empty test-form (assuming the above 2 routines in a *.bas-module or the form):
Code:
Option Explicit
Private PB As VB.PictureBox, WithEvents tmrRot As VB.Timer
Private Sub Form_Load()
Set PB = Controls.Add("VB.PictureBox", "Canvas")
PB.ScaleMode = vbPixels: PB.AutoRedraw = True: PB.Visible = True
PB.Move 0, 0, ScaleWidth, ScaleHeight
Set tmrRot = Controls.Add("VB.Timer", "tmrRot")
tmrRot.Interval = 15
End Sub
Private Sub tmrRot_Timer()
PB.Cls
Static aRot&: aRot = (aRot + 1) Mod 360 'let's increment the angle by one degree in each round
Dim cx#: cx = PB.ScaleWidth / 2 'the offsets for the top of the triangle ...
Dim cy#: cy = PB.ScaleHeight / 2 '... are set to the canvas-center here (to have space for a "full-rotation")
Const th = 90, ta = 30, tb = 30 'th = height of the triangle, ta + tb the left- and right-parts of the "base-line"
GradientTriangle PB, vbYellow, vbRed, cx, cy, th, ta, tb, aRot, vbBlack, _
0.2, 0.9 '<- the last 2 opt. Params are the gradient-interval, defaulting to [0..1]
PB.Refresh
Caption = aRot & "°"
End Sub
All of that will produce a fluent animation (similar to a "radar-sweep"):
HTH
Olaf
-
Jun 16th, 2022, 10:17 AM
#13
Thread Starter
Fanatic Member
Re: [RESOLVED] Line Methof for a gradient in a Triangle
1. I may have used the word rotate in a previous post. I did NOT mean that I had to rotate the triangle. I need 1 up triangle and 1 down triangle. I can easily do this with paint.
2. I am always aware that there exists more than one way to code a problem. Whichever is easier to understand is the best way. Once I understood the trig route, that was my best approach.
3. I am now trying to decide if building the gradients each time I run the program is more efficient, than taking a picture of each one, making .jpgs and loading them based on data criteria in the program.
4. Would someone please tell me why I keep losing e-mail notifications when I get a response. I know I have to be logged out of the forum.
Thanks
Last edited by AccessShell; Jun 16th, 2022 at 11:06 AM.
-
Jun 16th, 2022, 11:36 AM
#14
Re: [RESOLVED] Line Methof for a gradient in a Triangle
I think we aren't entirely sure what you need. I know I'm not.
Is it just one image? "One image" that gets rescaled when the Form resizes? Or something even more dynamic that uses varying colors and/or sizes or even animates as some sort of "progress" indicator?
JPEG is almost always the wrong choice unless you have a photograph. GIF or PNG or even ICO make more sense for this sort of non-photo. Bringing in the requirement for some transparency makes that even more true.
The problem (or interpretations of the problem) are more interesting to play with than other things we are working on. That's probably why you are still getting code suggestions.
-
Jun 16th, 2022, 12:17 PM
#15
Thread Starter
Fanatic Member
Re: [RESOLVED] Line Methof for a gradient in a Triangle
I have basically 4 images. One is just a horizontal gradient, 1 a gradient green and 1 a gradient red.
The other 2. One is a gradient green up triangle on the gradient background. The other is gradient red down triangle on the red gradiend backgrount. And, yes the background gradients are different than the triangle gradients.
I tried the .jpg route. I am not satisfied with it.
-
Jun 16th, 2022, 01:43 PM
#16
Re: [RESOLVED] Line Methof for a gradient in a Triangle
Originally Posted by AccessShell
1. I may have used the word rotate in a previous post.
I did NOT mean that I had to rotate the triangle. I need 1 up triangle and 1 down triangle.
I can easily do this with paint.
Well, so far you did not manage that in the routines you've posted
(e.g. your "D"own case did not work in my tests)...
See, the Down-case is just a "special case of a 180° rotation" -
...hence why I posted a generic function, which works for any angle...
...less mistakes possible this way...
...once you got it to work for "0°" then it will likely work also for all other "angle-cases",
(as "reduced they may be").
Originally Posted by AccessShell
2. I am always aware that there exists more than one way to code a problem.
Whichever is easier to understand is the best way.
Always remaining in your "comfort-zone" will not help with "getting better with coding", IMO...
If you don't force yourself to understand "routines, written by others",
then you're missing out in your learning-curve-progress...
Originally Posted by AccessShell
Once I understood the trig route, that was my best approach.
I've moved that "trig-problem" out of the way already at the very start,
writing another generic (universally usable) routine:
Code:
Sub PointRotate(ByVal aRad As Double, ByVal x As Double, ByVal y As Double, xRot, yRot) 'just a little helper
Dim sa#: sa = Sin(aRad)
Dim ca#: ca = Cos(aRad)
xRot = y * sa + x * ca
yRot = y * ca - x * sa
End Sub
And yes, I *had* to visit Wikipedia for this, to refresh my mind...
Originally Posted by AccessShell
3. I am now trying to decide if building the gradients each time I run the program is more efficient, ...
I would always prefer a dynamic routine over a (more or less "static") resource-image,
unless performance is of high import (like in a game-engine, which renders hundreds of sprites).
FYI, here's how the GradientTriangle-routine (posted in #12),
can be "reduced", to support only 4 cases ("Up, Down, Left, Right"):
It will work on an empty Form (when you have the two helper-routines from #12 in a *.bas):
Code:
Private WithEvents PB As VB.PictureBox
Private Sub Form_Load()
Caption = "Click me"
Set PB = Controls.Add("VB.PictureBox", "PB")
PB.ScaleMode = vbPixels: PB.AutoRedraw = True: PB.Visible = True
PB.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub PB_Click()
Static i: i = (i + 1) Mod 4 '"loops" over indexes 0..3 with each Click
PB.Cls
Dim w, h: w = PB.ScaleWidth: h = PB.ScaleHeight 'get w/h dimensions from the PB
Dim w2, h2: w2 = w / 2: h2 = h / 2 'set w2/h2 as "half-width and half-height"
Dim x, y, th, ta, tb, aDeg '<- let's fill these input-vars for the Gradient-call
Select Case Array("U", "D", "L", "R")(i)
Case "U": y = 0: x = w2: ta = w2: tb = w2: th = h: aDeg = 0
Case "D": y = h: x = w2: ta = w2: tb = w2: th = h: aDeg = 180
Case "L": x = 0: y = h2: ta = h2: tb = h2: th = w: aDeg = 90
Case "R": x = w: y = h2: ta = h2: tb = h2: th = w: aDeg = 270
End Select
GradientTriangle PB, vbYellow, vbRed, x, y, th, ta, tb, aDeg
PB.Refresh
Caption = Array("U", "D", "L", "R")(i) 'report the current direction in the Form-Caption
End Sub
HTH
Olaf
-
Jun 16th, 2022, 02:57 PM
#17
Re: [RESOLVED] Line Methof for a gradient in a Triangle
Originally Posted by AccessShell
I have basically 4 images.
One is just a horizontal gradient, 1 a gradient green and 1 a gradient red.
The other 2. One is a gradient green up triangle on the gradient background.
The other is gradient red down triangle on the red gradiend backgrount.
Do you mean something (roughly) similar to this?
GreenGradient-BG with inversed Green-Gradient on the triangle:
RedGradient-BG with inversed Red-Gradient on the triangle:
Posting a few mockup-images (created with a graphics-program) for what you have on your mind, would surely help...
I'm currently not sure, whether you need 4 or - in the end - only 2 (combined) images...
For those interested, here's the (RC6-based) Code, which produced this:
Code:
Option Explicit
Dim CC As cCairoContext
Private Sub Form_Load()
Caption = "Click me"
Set CC = Cairo.CreateSurface(128, 128).CreateContext
End Sub
Private Sub Form_Click()
Static Up As Boolean: Up = Not Up
RenderGradientImg IIf(Up, vbGreen, vbRed), Up
End Sub
Sub RenderGradientImg(Color, Optional ByVal Up As Boolean)
Dim dx2 As Double, dy2 As Double, Grad As cCairoPattern
dx2 = CC.Surface.Width / 2
dy2 = CC.Surface.Height / 2
CC.Save
Set Grad = Cairo.CreateLinearPattern(0, -dy2, 0, dy2)
Grad.AddGaussianStops_TwoColors vbBlack, Color
CC.TranslateDrawings dx2, dy2 'shift to the center
CC.RotateDrawingsDeg IIf(Up, 0, 180) 'rotate, when not up
CC.Paint , Grad 'draw the gradient on the whole 128x128 surface
Set Grad.Matrix = Grad.Matrix.RotateCoordsDeg(180)
CC.MoveTo 0, -(dy2 * 0.75) 'construct a triangle
CC.RelLineTo -(dx2 * 0.75), (dy2 * 0.75) * 2
CC.RelLineTo (dx2 * 0.75) * 2, 0
CC.Fill , Grad 'fill the triangle with the rotated gradient
CC.Restore
Set Picture = CC.Surface.Picture
End Sub
Olaf
-
Jun 16th, 2022, 03:35 PM
#18
Re: [RESOLVED] Line Methof for a gradient in a Triangle
if that's true why not just make and use two GIF or PNG images and flip-flop between them?
Then if you need to so the same with squares, circles, and dairy cows later you can save a ton of grief.
But perhaps I missed the reason why this needs to be dynamic drawing.
-
Jun 16th, 2022, 03:50 PM
#19
Thread Starter
Fanatic Member
Re: [RESOLVED] Line Methof for a gradient in a Triangle
The two images schmidt showed are correct. I do need two more. They are same as schmidt showed without the triangles.
I quickly tried the jpg method. I did not like the results.
I code because I like to code. I do not work. I don't want to work. I am very much retired. I feel the coding keeps the cobwebs away. I try to code things I have never done before. As schmidt said (paraphrased), go out of your comfort zone.
My entire career was writing accounting softwarefor large companies in many different languages. Now I write for me. I wrote some solitaire games, some graphics manipulation. I even wrote an analoge clock, and for fun I attached BigBen chimes to it. Wrote a music player. I'm tired of accounting, I just want to experience other apps and other controls.
-
Jun 16th, 2022, 03:53 PM
#20
Thread Starter
Fanatic Member
Re: [RESOLVED] Line Methof for a gradient in a Triangle
schmidt, what is (RC6-based) Code?
-
Jun 16th, 2022, 06:18 PM
#21
Re: [RESOLVED] Line Methof for a gradient in a Triangle
Originally Posted by AccessShell
schmidt, what is (RC6-based) Code?
RC6.dll is a "free COM-lib" (an ActiveX-library, produced with VB6 for the VB6-community),
which you have to check-in via the References-Dialog (before "RC6-based Code" will work in your IDE).
Though before you can check-in said reference (which is named 'RC6'),
you will have to download and install the "RC6BaseDlls-package" first -
which sits in a Zip - in the download-section on vbRichClient.com.
After downloading, one needs to unpack this Zip into a local Folder - usually at C:\RC6\...
and then run the included "install-in-place"-scripts from within that local Folder.
Afer this installation went through successfully, you will find a new 'RC6'-entry in your References-Dialog.
HTH
Olaf
-
Jun 16th, 2022, 07:14 PM
#22
Re: [RESOLVED] Line Methof for a gradient in a Triangle
Originally Posted by dilettante
if that's true why not just make and use two GIF or PNG images and flip-flop between them?
Then if you need to so the same with squares, circles, and dairy cows later you can save a ton of grief.
But perhaps I missed the reason why this needs to be dynamic drawing.
I can speak from experience about the choice between static images vs dynamic rendering. You almost always want to do as much as you can dynamically. You gain so much and lose almost nothing.
-
Jun 17th, 2022, 08:45 AM
#23
Re: [RESOLVED] Line Methof for a gradient in a Triangle
Originally Posted by Niya
I can speak from experience about the choice between static images vs dynamic rendering. You almost always want to do as much as you can dynamically. You gain so much and lose almost nothing.
I'm not sure I agree with that. I don't think it makes sense to recreate button and toolbar images from dirt on the fly every run or form load.
But that doesn't matter here. He already said he is exploring and learning drawing techniques for himself so anything goes. Once he gets more experience with such things he'll have techniques to use for more dynamic scenarios as they come up.
I don't write games or dolly up my UIs like painted ladies, but I suppose there is a case for things like custom charting. And sometimes you want to write graphics creation tools for specific purposes.
-
Jun 17th, 2022, 12:15 PM
#24
Re: [RESOLVED] Line Methof for a gradient in a Triangle
Originally Posted by dilettante
I'm not sure I agree with that. I don't think it makes sense to recreate button and toolbar images from dirt on the fly every run or form load.
When it comes to special effects like gradients, blending effects or colour shifting like grayscaling, these things are best done on the fly. The problem with using static images for special effects is that you could end up with large blobs of assets that have to be shipped with or in the binaries. This can have a serious effect on loading times if you're not careful. The other problem with this is that you lack freedom. You can only have as many variations as you've created, for example, different colour gradients. Another potential problem and one that applies to gradients in particular is stretching. If you want to use them as backgrounds, you have to make them large and high quality enough so they don't noticeably degrade when stretched across large surfaces. This can really bloat the total size of your image assets. All of these problems go away with dynamic generation.
-
Jun 17th, 2022, 01:02 PM
#25
Re: [RESOLVED] Line Methof for a gradient in a Triangle
I guess I don't write too many programs with a user interface that tries to rival those old Windows Media Player skins from the 1990s.
-
Jun 17th, 2022, 02:18 PM
#26
Re: [RESOLVED] Line Methof for a gradient in a Triangle
Originally Posted by dilettante
I guess I don't write too many programs with a user interface that tries to rival those old Windows Media Player skins from the 1990s.
I made many attempts in my life
I spent a decade plus being obsessed with "pretty" interfaces. This obsession only got worse the first time I ever saw the Aero Glass Windows theme in Windows Vista.
Last edited by Niya; Jun 17th, 2022 at 02:25 PM.
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
|