voisiko lomakkeelle saada liukuvärin vb6:ssa ja jos, niin miten?
Line-metodilla muuttamalla väriä ja viivan paikkaa halutulla tavalla.
Voit myös tietenkin tehdä jollakin piirto-ohjelmalla liukuvärjäyksen ja lisätä se formin picture ominaisuudeksi.
Liukuväritausta on aika helposti mahdollinen, tässä on esimerkki (käännös vanhasta QBasic-ohjelmastani):
Private Sub Form_Activate()
Randomize Timer
ScaleMode = 3 'pikseli
Dim a(2) As Integer, l(2) As Integer
Dim f(2) As Single, n(2) As Single
Dim i As Integer
'väri ylhäällä
a(0) = Int(Rnd * 1 + 0.5) * 255
a(1) = Int(Rnd * 1 + 0.5) * 255
a(2) = Int(Rnd * 1 + 0.5) * 255
'väri alhaalla
l(0) = Int(Rnd * 1 + 0.5) * 255
l(1) = Int(Rnd * 1 + 0.5) * 255
l(2) = Int(Rnd * 1 + 0.5) * 255
'muuttumisaskel
f(0) = (l(0) - a(0)) / ScaleHeight
f(1) = (l(1) - a(1)) / ScaleHeight
f(2) = (l(2) - a(2)) / ScaleHeight
'aloitusväri
n(0) = a(0)
n(1) = a(1)
n(2) = a(2)
For i = 1 To ScaleHeight
'lasketaan uusi väri askeleen avulla
n(0) = n(0) + f(0)
n(1) = n(1) + f(1)
n(2) = n(2) + f(2)
'piirretään vaakasuora viiva
Line (0, i)-(ScaleWidth, i), RGB(n(0), n(1), n(2))
Next
End Subkiitti antti! miten sinulta tuleekin aina parhaimmat kuvavinkit?
no mikä se qbasic-koodi sitten on?
miiro: Anttihan sanoi, että tämä on käännös siitä koodista.
Ja alkuperäinen QBasic-koodi on koodivinkeissä:
https://www.ohjelmointiputka.net/koodivinkit/
Tässä toinen tapa tehdä liukuvärit - vaakasuuntaan: (Nopeampi, ja ottaa formin koon huomioon.) (Esimerkki VB6)
Private Type TRIVERTEX
x As Long
y As Long
Red As Integer 'Ushort value
Green As Integer 'Ushort value
Blue As Integer 'ushort value
Alpha As Integer 'ushort
End Type
Private Type GRADIENT_RECT
UpperLeft As Long 'In reality this is a UNSIGNED Long
LowerRight As Long 'In reality this is a UNSIGNED Long
End Type
Const GRADIENT_FILL_RECT_H As Long = &H0 'In this mode, two endpoints describe a rectangle. The rectangle is
'defined to have a constant color (specified by the TRIVERTEX structure) for the left and right edges. GDI interpolates
'the color from the top to bottom edge and fills the interior.
Const GRADIENT_FILL_RECT_V As Long = &H1 'In this mode, two endpoints describe a rectangle. The rectangle
' is defined to have a constant color (specified by the TRIVERTEX structure) for the top and bottom edges. GDI interpolates
' the color from the top to bottom edge and fills the interior.
Const GRADIENT_FILL_TRIANGLE As Long = &H2 'In this mode, an array of TRIVERTEX structures is passed to GDI
'along with a list of array indexes that describe separate triangles. GDI performs linear interpolation between triangle vertices
'and fills the interior. Drawing is done directly in 24- and 32-bpp modes. Dithering is performed in 16-, 8.4-, and 1-bpp mode.
Const GRADIENT_FILL_OP_FLAG As Long = &HFF
Private Declare Function GdiGradientFillRect Lib "gdi32" Alias "GdiGradientFill" (ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Function LongToUShort(Unsigned As Long) As Integer
'A small function to convert from long to unsigned short
LongToUShort = CInt(Unsigned - &H10000)
End Function
Private Sub Form_Load()
'KPD-Team 2001
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'API uses pixels
Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Paint()
Dim vert(1) As TRIVERTEX
Dim gRect As GRADIENT_RECT
'from black
With vert(0)
.x = 0
.y = 0
.Red = 0&
.Green = 0& '&HFF& '0&
.Blue = 0&
.Alpha = 0&
End With
'to red
With vert(1)
.x = Me.ScaleWidth
.y = Me.ScaleHeight
.Red = LongToUShort(&HFF00&)
.Green = 0&
.Blue = 0&
.Alpha = 0&
End With
gRect.UpperLeft = 0
gRect.LowerRight = 1
GdiGradientFillRect Me.hdc, vert(0), 2, gRect, 1, GRADIENT_FILL_RECT_H
End SubViitsisitkö korjata tuon jälkimmäisen kooditagin?
Ei toimi w98se:ssä. Valittaa ettei löydy GdiGradientFillRectiä gdi32:sta.
Edit:
VB.NET : System.Drawing.Drawing2D.LinearGradientBrush
Operating Systems Supported :Requires Windows 2000 or later; Win9x/ME: Not supported
Värin saa esim. vihreäksi:
With vert(1)
.X = Me.ScaleWidth
.Y = Me.ScaleHeight
.Red = 0&
.Green = LongToUShort(&HFF00&)
.Blue = 0&
.Alpha = 0&
End WithTässä vielä tälläistä "Liukuväriä!"
Dim AA Dim BB Dim CC Dim DD Dim R Dim G Dim B Dim AX Dim BY Dim CX Dim DY Private Sub Form_Load() AX = 1 BY = 100 CX = 288 CY = 288 AA = 800 BB = 600 CC = 400 DD = 10 End Sub Private Sub Timer1_Timer() R = R + 0.4 G = G + 0.5 B = B + 0.01 AX = AX + 1 BY = BY + 1 CX = CX - 1 CY = CY - 1 AA = AA - 1 BB = BB + 1 CC = CC - 1 DD = DD - 1 Picture1.Line (AX, BY)-(CX, CY), RGB(R, G, B) Picture1.Line (BY, AX)-(CY, CX), RGB(G, B, R) Picture1.Line (CX, BY)-(AX, CY), RGB(B, R, G) Picture1.Line (AA, BB)-(CC, DD), RGB(G, R, B) Picture1.Line (AA, BB)-(CC, DD), RGB(G, R, B) Picture1.Line (AA, AA)-(DD, Int(Rnd * 0)), RGB(B, R, R) Picture1.Line (AA + 1, AA)-(DD, Int(Rnd * 0)), RGB(B, R, R) If DD = 0 Then DD = DD + 15 End If End Sub
tarvitsee timerin ja pictureboksin jonka koko kannattaa laittaa niin suureksi kuin pystyy.Ja timerin intervaliksi 10.
Antti Laaksonen kirjoitti:
Ja alkuperäinen QBasic-koodi on koodivinkeissä:
https://www.ohjelmointiputka.net/koodivinkit/23487-qb-väriliuku
kiitos.
Aihe on jo aika vanha, joten et voi enää vastata siihen.