Figure

PS. Mangler stadig koden til en 5-kant og en 6-kant...
PPS. Jonatan Hertel, det der svar kan du godt score 20 UP på... Hvis du ændre det til et svar...

Hvor svært kan det være?! ;-)

Microsoft er meget venlige og har faktisk opfundet den dybe tallerken for dig - du skal blot finde ud af at bruge den ...

Her er koden til at tegne alle mulige vilkårlige polygoner - udfyldte eller ikke - med kant eller ikke. Og du kan også simulere en cirkel ved at tegne en 100-kantet polygon (så kan man ikke se kanterne mere!)

Lav et nyt projekt. Indsæt en rigelig stor PictureBox på din Form (den skal hedde Picture1) og indsæt en knap (Command1). Sæt også Picture1's property AutoRedraw til True.

Se denne kode godt igennem og indsæt den i projektet:

Option Explicit

' Windows API:

Private Declare Function BeginPath Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hDC As Long) As Long

Private Declare Function StrokeAndFillPath Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function StrokePath Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function FillPath Lib "gdi32" (ByVal hDC As Long) As Long

Private Declare Function MoveToEx Lib "gdi32" (ByVal hDC As Long, _
            ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hDC As Long, _
            ByVal x As Long, ByVal y As Long) As Long

Private Type POINTAPI
        x As Long
        y As Long
End Type

Const Pi = 3.14159265358979

Dim CurrentHDC As Long

Private Sub Command1_Click()
    Picture1.BackColor = &HFF0000 ' Baggrundsfarve = Blå
    Picture1.ForeColor = &H0& ' Tegne- og kantfarve = Sort
    Picture1.Cls ' Rens tegning
    
    ' Tegning 1 ("Tilfældig" polygon)
    Picture1.FillColor = &HFFFFFF ' Fyldfarve = Hvid
    Picture1.FillStyle = 7 ' Skal udfyldes ternet
    Picture1.DrawWidth = 1 ' 1 pixels tyk kant
    StartTegning Picture1
    FlytTil 150, 150
    LinieTil 1650, 1650
    LinieTil 900, 1650
    LinieTil 900, 2400
    LinieTil 150, 1650
    LinieTil 150, 150
    AfslutTegning
    UdfyldTegningMedKant
    
    ' Tegning 2 (Stor syv-kantet polygon)
    Picture1.FillColor = &HFF& ' Fyldfarve = Rød
    Picture1.FillStyle = 2 ' Skal udfyldes med vandrette linier
    Picture1.DrawWidth = 5 ' 5 pixels tyk kant
    TegnRegulaerPolygon Picture1, Picture1.Width / 2, _
                Picture1.Height / 3, 1200, 7
    UdfyldTegningMedKant
    
    ' Tegning 3 (Lille cirkel)
    Picture1.FillColor = &H9900& ' Fyldfarve = Mørkegrøn
    Picture1.FillStyle = 0 ' Skal udfyldes fuldstændig
    Picture1.DrawWidth = 3 ' 3 pixels tyk kant
    TegnRegulaerPolygon Picture1, Picture1.Width / 2, _
                Picture1.Height / 3 * 2, 300, 100
    UdfyldTegningMedKant
End Sub

Private Sub TegnRegulaerPolygon(ByRef Pic As PictureBox, _
            ByRef CentrumX As Single, ByRef CentrumY As Single, _
            ByRef Radius As Single, ByRef Kanter As Integer)
    Dim v As Double
    Dim dv As Double
    Dim x As Single
    Dim y As Single
    StartTegning Picture1
    FlytTil CentrumX + Radius, CentrumY
    dv = 2 / Kanter
    For v = 0 To 2 Step dv
        If v <> 0 Then
            x = Cos(v * Pi) * Radius + CentrumX
            y = Sin(v * Pi) * Radius + CentrumY
            LinieTil x, y
        End If
    Next v
    AfslutTegning
End Sub

Private Sub StartTegning(ByRef Pic As PictureBox)
    CurrentHDC = Pic.hDC
    BeginPath CurrentHDC
End Sub

Private Sub FlytTil(ByRef x As Single, ByRef y As Single)
    Dim dummy As POINTAPI
    MoveToEx CurrentHDC, x \\ Screen.TwipsPerPixelX, y \\ _
                Screen.TwipsPerPixelY, dummy
End Sub

Private Sub LinieTil(ByRef x As Single, ByRef y As Single)
    LineTo CurrentHDC, x \\ Screen.TwipsPerPixelX, y \\ Screen.TwipsPerPixelY
End Sub

Private Sub AfslutTegning()
    EndPath CurrentHDC
End Sub

Private Sub UdfyldTegning()
    FillPath CurrentHDC
End Sub

Private Sub UdfyldTegningMedKant()
    StrokeAndFillPath CurrentHDC
End Sub

Private Sub KantPaaTegning()
    StrokePath CurrentHDC
End Sub

Se især hvor simpelt det er at tegne polygoner med de funktioner der bliver kaldt i Command1_Click.
Start programmet - tryk på knappen - se magien i Windows API ;-)

Det kan iøvrigt nemt udvides til at køre med mere avancerede ting som bezier-polygoner (polygoner bestående af bezier-linier), hvis du ved hvad det er - man skal blot importere funktionerne fra sin API Viewer.

Håber du kan bruge det.

/ Bjarke

--------------------------------------------------
[THIS IS A SIGNATURE VIRUS! PLEASE COPY IT INTO YOUR OWN SIGNATURE(S)]
--------------------------------------------------
Naturvidenskab er interessant: http://www.unf.dk/

Du kan bruge Line metoden i Forms og PictureBox-kontroller til at tegne polygoner med. Du kan også sætte enkelte pixels farver med PSet-metoden og finde en bestemt pixel's farve med Point-metoden. Disse kommandoer er allerede indbygget i Picture bokse of forms.

PSet og Point er ikke så hurtige som API kaldene GetPixel og SetPixel funktionerne i Windows' GDI32-bibliotek. Derfor vil du sandsynligvis have fordel af at kalde disse rutiner istedet for de indbyggede Point og PSet metoder.
API kaldene bør have disse deklarationer i dit program:

<pre>Private Declare Function GetPixel Lib "gdi32" ( _
ByVal hDC As Long, ByVal x As Long, _
ByVal y As Long) As Long

Private Declare Function SetPixel Lib "gdi32" ( _
ByVal hDC As Long, ByVal x As Long, ByVal y As Long, _
ByVal crColor As Long) As Long</pre>

Læg mærke til hDC argumentet i de to deklarationer: Dette er formens (eller pictureboksens) Device-context Handle. Du finder en forms hDC ved hjælp af Form1.hDC eller Picture1.hDC for en Picture-kontrol.

Der findes også API-kald til at tegne linjer og cirkler og fylde arealer, men så må du diske op med flere UP!!!

Nej, spøg til side; jeg har simpelthen ikke ide om, hvilke disse API funktioner er, men jeg ved, at de findes, så prøv at søge på internettet. Her er der et link, som jeg tror du kan bruge:

http://www.vb2themax.com/Item.asp?PageID=CodeBank&Cat=1300&ID=99

Software is here and now but rock and roll is forever.

[Redigeret d. 28/05-03 18:10:10 af Herluf Hermansen]

Det er bare lidt svært at lave noget der ikke allerede er blevet lavet 1 gang før...

Prøv selv at nævne bare 1 eksempel... Det er næsten umuligt!

Et program som kan gå i skole for en, uden læreren opdager noget???





I Am The Cyborg, and i`m here to serve

Hvad er problemet?

Hvad er problemet?

jeg tror han mener et værktøj, ligesom det i Paint som laver firkanter, bare med trekanter, femkanter og sekskanter.

Andreas Andersen
www.friserverplads.dk/asp-nuke/

Præcis... Hvordan???

Mener bare .. hvis du kan lave firkant værktöjet .. hvad er problemet så med tre-kant osv ?

Jeg kan overhovedet ikke se hvordan det kan være så svært at forstå hvad jeg vil have!!!

Når man vil tegne en firkant sætter man bare en shape ind og ændre dens property til square...
Når man vil tegn en circle gør man det samme, borset fra at man ændre dens property til noget andet...
Når man vil tegne en linie sætter man bare en linie ind!!!

MEN MAN KAN IKKE BARE SÆTTE EN 5-KANT IND!!!

Der er godt nok nogle "hardcore" click-and-drag programmörer rundt omkring.
Hvad er pointet i at "programmere" hvis man ikke laver andet end at ændre property og arbejde med componenter der er programmeret af rigtige programmörer?

Hvorfor så ikke bare helt springe til et RAD tool der helt befrier en for code-view .. så kan man lave alt uden at skulle programmere en linie .. bare trække og slippe componenter og ændre property værdier.

Jeg hader når folk siger "når man programmerer en xxx .. hvordan laver man den så?".
Hvad med lige at bryde opgaven lidt ned?
Hvad med at tænke selv?

Nå .. undskyld mine meninger .. jeg er nok bare en forkalket olding der voksede op i en tid hvor folk der kaldte sig programmörer kodede selv.

Det er selvfölgeligt idiotisk at programmerer de samme ting igen og igen, og object-genbrug er stort set altid det optimale .. så jeg skal nok bare vende mig til at nutidens programmörer ikke koder en linie selv hvis de ikke kan paste det ind et eller andet sted fra.

Der ramte du mig og mange andre på et meget ømt punkt... Jeg kan faktisk ikke akumentere imod det... Fremtidens programmøre er copycats og vil også være det fremover...

Se på mig... Jeg kan lave det alle andre har lavet før mig. Jeg kan sætte det sammen på flere foskellige måder og kompinere flere forskellige projekter andre har lavet på en sådan måde at jeg får en rigtig god kode! Det er da også meget godt... Men når man pludselig støder ind i et problem som ingen andre har lavet (fordi ideen er ny) kommer man pludselig ud i problemmer! Man kan ikke søge efter hjælp på internettet på grund af at den nye ide kunne blive stjålet (så store programmer taler vi dog ikke om nu).

Jeg er ikke en dårlig programmør og jeg ligger højere end gennemsnittet af folk på min alder (ved jeg af erfaring...). I virkeligheden klare jeg mig rigtig godt. Men jeg synes der mangler et spring fra at kunne lave programmer andre også har lavet før til at lave noget nyt.

Den opgave jeg stilte var godt nok ikke særlig opfindsom og der er sikkert også mange der har lavet den før. Grunden til at jeg overhovedet spurgte hang nok sammen med at ikke selv gad. Fremtidens programmøre er nemlig dovne. Hvis de kan få andre til at lave deres koder så gør de det!

Men dit svar ramte mig på sådan et ømt punkt at jeg valgte at smide cola-flaske fra mig og lave koden helt fra bunden uden at kigge efter nogen steder...

Dette var hvad jeg fandt ud af efter ½ - 1 time:

Dim Prik As Boolean
Dim Linie As Boolean
Dim Trekant As Boolean
Dim Firkant As Boolean
Dim Ramme As Long
Dim Fylde As Long
Dim curX
Dim curY

Private Sub cdmLinie_Click()
    AllFalse
    Linie = True
End Sub

Private Sub cdmPrik_Click()
    AllFalse
    Prik = True
End Sub

Private Sub cdmRamme_Click()
    comdFarve.ShowColor
    Ramme = comdFarve.Color
End Sub

Private Sub cdmTrekant_Click()
    AllFalse
    Trekant = True
End Sub

Private Sub cmdFirkant_Click()
    AllFalse
    Firkant = True
End Sub

Private Sub cmdFylde_Click()
    comdFarve.ShowColor
    Fylde = comdFarve.Color
End Sub

Private Sub picDraw_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Const Højde As Integer = 50
Const Længde As Integer = 50
Dim Stigning As Integer
Dim i
    If Trekant = True Then
        picDraw.Line (X - Længde, Y)-(X, Y - Højde), Ramme
        picDraw.Line (X, Y - Højde)-(X, Y), Ramme
        picDraw.Line (X, Y)-(X - Længde, Y), Ramme
        
        For i = X - 49 To X - 1
            Stigning = Stigning + Højde / Længde
            picDraw.Line (i, Y - Stigning + 1)-(i, Y), Fylde
        Next i
    ElseIf Firkant = True Then
        picDraw.Line (X - 50, Y - 50)-(X, Y - 50), Ramme
        picDraw.Line (X, Y - 50)-(X, Y), Ramme
        picDraw.Line (X, Y)-(X - 50, Y), Ramme
        picDraw.Line (X - 50, Y)-(X - 50, Y - 50), Ramme
        
        For i = X - 49 To X - 1
            picDraw.Line (i, Y - 49)-(i, Y), Fylde
        Next i
    End If
    curX = X
    curY = Y
End Sub

Private Sub picDraw_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        If Prik = True Then
            picDraw.PSet (X, Y), Fylde
        ElseIf Linie = True Then
            picDraw.Line (curX, curY)-(X, Y), Fylde
        End If
    End If
    curX = X
    curY = Y
End Sub

Public Sub AllFalse()
    Prik = False
    Linie = False
    Trekant = False
    Firkant = False
End Sub

PS. Mangler stadig koden til en 5-kant og en 6-kant...
PPS. Jonatan Hertel, det der svar kan du godt score 20 UP på... Hvis du ændre det til et svar...

[Redigeret d. 28/05-03 23:49:30 af HAP]