Kirjautuminen

Haku

Tehtävät

Kilpailu

Putka Open 2025
5. kierros:
28.11. klo 18 – 30.11. klo 23

Koodit: VB.NET: Viivan raahaaminen

Kirjoittaja: tnb

Kirjoitettu: 11.03.2004 – 11.03.2004

Tagit: koodi näytille, vinkki

Demo jossa näytetään miten viivan raahaaminen tapahtuu.

'***********************************************
' Viivan raahaus demo
' TNB 2004, vb.net
'***********************************************

Dim Polku As System.Drawing.Drawing2D.GraphicsPath
Dim ViivanAlku As Point = New Point(10, 40)
Dim ViivanLoppu As Point = New Point(50, 80)
Dim Kynä As Pen = New Pen(Color.Black, 3.0)
Dim g As Graphics
Dim raahaa As Boolean
Dim alkux As Integer
Dim alkuy As Integer
Dim alkux1, alkux0, alkuy1, alkuy0 As Integer

Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
    Dim mp As Point = New Point(e.X, e.Y)
    If Me.Polku.IsOutlineVisible(mp, Me.Kynä) Then
        'hiiri on viivan päällä ja nappi alhaalla
        'lähtö paikka muistiin
        alkux = e.X
        alkuy = e.Y
        raahaa = True ' raahaus lippu päälle
        alkux0 = Me.ViivanAlku.X
        alkuy0 = Me.ViivanAlku.Y
        alkux1 = Me.ViivanLoppu.X
        alkuy1 = Me.ViivanLoppu.Y
    Else
        'hiiri ohi
        g.DrawPath(Me.Kynä, Me.Polku)
    End If
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    'tehdään instanssi ja luodaan eka viiva
    Me.Polku = New System.Drawing.Drawing2D.GraphicsPath
    Me.Polku.AddLine(Me.ViivanAlku, Me.ViivanLoppu)
End Sub

Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
    g = Me.CreateGraphics
    If raahaa Then
        'raahaus tapahtuma
        Me.Polku.Reset() 'vanha data pois
        g.Clear(Color.White) 'pohja valkoiseksi, vanha viiva pois
        Me.ViivanLoppu = New Point(alkux0 + (e.X - alkux), alkuy0 + (e.Y - alkuy))
        Me.ViivanAlku = New Point(alkux1 + (e.X - alkux), alkuy1 + (e.Y - alkuy))
        Me.Polku.AddLine(Me.ViivanAlku, Me.ViivanLoppu) 'uuden viivan lisäys
        g.DrawPath(Me.Kynä, Me.Polku) 'piirto
    End If
End Sub

Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseUp
    raahaa = False ' raahaaminen loppu
End Sub

Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
    g = Me.CreateGraphics
    g.Clear(Color.White) 'pohja valkoiseksi
    g.DrawPath(Me.Kynä, Me.Polku) 'näytä eka viiva
    Me.Text = "Raahaa hiirellä viivaa"
End Sub

Kommentit

T.M. [13.03.2004 01:58:15]

#

Et vaan osaa? :-}
Olisko exee kellään...?

Bill Keltanen [13.03.2004 07:50:03]

#

Heh, jos ei oo VB.NET ni ei ehkä sitte...

Monkkats [13.03.2004 10:08:05]

#

VB.NET on suoraa sanottuna ihan eri ohjelmointikieli. Mä käytän ainaki kunnon VB6:ta ja Visual C++ 6:ta..

WinC [14.03.2004 12:05:39]

#

Toimii erinomaisesti, itseasiassa en ollut koskaan ennen tätä kääntänyt visual basic ohjelmaa, joten sen kunniaksi julkaisen ohjelman exen joka löytyy rar-pakettina osoitteesta. http://ameba.lpt.fi/~seppsami/mobiilifilu/

NanoSoft [14.01.2006 20:34:27]

#

iha pärseestä ku toi ei toimi

Heketti [23.06.2009 23:22:13]

#

Hyvin toimii. Tätähän pystyy soveltamaan vaikka missä.

heikkju2 [14.11.2013 21:06:47]

#

Tässä peni sovellus asiasta, eli piirtää kasan punaisia viivoja.

Public Class Kuormitus

    Dim Polku1 As System.Drawing.Drawing2D.GraphicsPath
    Dim AS1a As Point = New Point(79, 35)
    Dim As1l As Point = New Point(79, 45)
    Dim Polku2 As System.Drawing.Drawing2D.GraphicsPath
    Dim AS2a As Point = New Point(132, 35)
    Dim As2l As Point = New Point(132, 45)
    Dim Polku3 As System.Drawing.Drawing2D.GraphicsPath
    Dim AS3a As Point = New Point(185, 35)
    Dim As3l As Point = New Point(185, 45)
    Dim Polku4 As System.Drawing.Drawing2D.GraphicsPath
    Dim AS4a As Point = New Point(238, 35)
    Dim As4l As Point = New Point(238, 45)

    Dim Kynä As Pen = New Pen(Color.Red, 45.0)
    Dim g As Graphics



    Private Sub Kuormitus_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim p As String
        p = Application.StartupPath & "\"
        FileOpen(1, p & "klo.set", OpenMode.Input)
        Input(1, Label1.Text)
        Input(1, Label2.Text)
        Input(1, Label3.Text)
        Input(1, Label4.Text)
        FileClose()


        Me.Polku1 = New System.Drawing.Drawing2D.GraphicsPath
        Me.Polku1.AddLine(Me.AS1a, Me.As1l)
        Me.Polku2 = New System.Drawing.Drawing2D.GraphicsPath
        Me.Polku2.AddLine(Me.AS2a, Me.As2l)
        Me.Polku3 = New System.Drawing.Drawing2D.GraphicsPath
        Me.Polku3.AddLine(Me.AS3a, Me.As3l)
        Me.Polku4 = New System.Drawing.Drawing2D.GraphicsPath
        Me.Polku4.AddLine(Me.AS4a, Me.As4l)

    End Sub

    Private Sub Kuormitus_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint

        g = Me.CreateGraphics
        g.DrawPath(Me.Kynä, Me.Polku1)
        g.DrawPath(Me.Kynä, Me.Polku2)
        g.DrawPath(Me.Kynä, Me.Polku3)
        g.DrawPath(Me.Kynä, Me.Polku4)

    End Sub
End Class

Siskohan tuohon load tapahtumaan ujutettua värin vaihdon esim.
Jos luetaan tiedostosta jokin arvo joka vastaisi toista väriä,
yritin tuota " Dim Kynä As Pen = New Pen(Color.Red, 45.0)"
lausetta laittaa loadiin mutta eihän se siellä viihdy.

Kirjoita kommentti

Muista lukea kirjoitusohjeet.
Tietoa sivustosta