Kirjautuminen

Haku

Tehtävät

Keskustelu: Ohjelmointikysymykset: VB.NET: väripulmia

Sivun loppuun

Fisher [05.04.2004 17:48:00]

#

voisiko lomakkeelle saada liukuvärin vb6:ssa ja jos, niin miten?

setä [05.04.2004 18:20:41]

#

Line-metodilla muuttamalla väriä ja viivan paikkaa halutulla tavalla.

remontti-reiska [05.04.2004 18:32:40]

#

Voit myös tietenkin tehdä jollakin piirto-ohjelmalla liukuvärjäyksen ja lisätä se formin picture ominaisuudeksi.

Antti Laaksonen [05.04.2004 18:43:06]

#

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 Sub

Fisher [06.04.2004 16:16:34]

#

kiitti antti! miten sinulta tuleekin aina parhaimmat kuvavinkit?

miiro [31.05.2004 11:35:13]

#

no mikä se qbasic-koodi sitten on?

Latska [31.05.2004 11:46:27]

#

miiro: Anttihan sanoi, että tämä on käännös siitä koodista.

Antti Laaksonen [31.05.2004 11:47:42]

#

Ja alkuperäinen QBasic-koodi on koodivinkeissä:
https://www.ohjelmointiputka.net/koodivinkit/23487-qb-väriliuku

JoreSoft [01.06.2004 10:12:42]

#

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 Sub

tuomas [01.06.2004 10:13:32]

#

Viitsisitkö korjata tuon jälkimmäisen kooditagin?

sooda [01.06.2004 10:13:56]

#

Ei toimi w98se:ssä. Valittaa ettei löydy GdiGradientFillRectiä gdi32:sta.

JoreSoft [01.06.2004 10:19:47]

#

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 With

tuomas [01.06.2004 13:31:10]

#

Tä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.

miiro [01.06.2004 16:20:03]

#

Antti Laaksonen kirjoitti:

Ja alkuperäinen QBasic-koodi on koodivinkeissä:
https://www.ohjelmointiputka.net/koodivinkit/23487-qb-väriliuku

kiitos.


Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta