Kirjoittaja: Antti Laaksonen
Kirjoitettu: 30.11.2002 – 30.11.2002
Tagit: grafiikka, koodi näytille, vinkki
Tämä ohjelma luo tekstille 3d-varjostuksen Visual Basicissa. Kaikki kuvan ominaisuudet, kuten koko, tekstin fontti ja koko, värit, 3d-varjostuksen keskipiste ja pituus ovat säädettävissä. Nopeuden pitäisi olla suht' koht' siedettävä, optimointivaraa kuitenkin vielä on. Formilla on oltava kaksi tavallista PictureBoxia, nimillä Picture1 ja Picture2.
Private Sub Form_Activate()
'muuttujamäärittelyt
Dim leveys As Integer, korkeus As Integer
Dim tv As Long, v1 As Long, v2 As Long
Dim tn As String, tk As Integer, teksti As String
Dim kpx As Integer, kpy As Integer
Dim lax As Integer, lay As Integer
Dim i As Integer, j As Integer
'kuvan asetukset
leveys = 300: korkeus = 200 'kuvan koko
tv = RGB(255, 255, 255) 'taustaväri
v1 = RGB(127, 127, 255) 'edustaväri
v2 = RGB(0, 0, 127) '3d-väri
tn = "Arial": tk = 30 'tekstityyppi ja tekstin koko
teksti = "Ohjelmointiputka" 'teksti
kpx = 150: kpy = 150 '3d:n keskipiste
kpp = 0.15 '3d:n pituus 0-1
'kuvien alustaminen
Picture1.Width = leveys: Picture2.Width = leveys
Picture1.Height = korkeus: Picture2.Height = korkeus
Picture1.BackColor = tv: Picture2.BackColor = tv
Picture1.FontName = tn: Picture2.FontName = tn
Picture1.FontSize = tk: Picture2.FontSize = tk
Picture1.ForeColor = v1: Picture2.ForeColor = v1
'teksti apukuvaan
lax = Picture2.TextWidth(teksti) / 2
lay = Picture2.TextHeight(teksti) / 2
Picture2.CurrentX = leveys / 2 - lax
Picture2.CurrentY = korkeus / 2 - lay
Picture2.Print teksti
'3d:n piirtäminen
For i = leveys / 2 - lax To leveys / 2 + lax
For j = korkeus / 2 - lay To korkeus / 2 + lay
If Picture2.Point(i, j) <> tv And Picture2.Point(i, j) <> -1 Then
Picture1.Line (i, j)-(i + (kpx - i) * kpp, j + (kpy - j) * kpp), v2
End If
Next
DoEvents
Next
'päälle teksti toisella värillä
Picture1.CurrentX = leveys / 2 - Picture1.TextWidth(teksti) / 2
Picture1.CurrentY = korkeus / 2 - Picture1.TextHeight(teksti) / 2
Picture1.Print teksti
End Sub
Private Sub Form_Load()
ScaleMode = 3
Picture1.AutoRedraw = True: Picture2.AutoRedraw = True
Picture1.ScaleMode = 3: Picture2.ScaleMode = 3
End SubAika hieno
Iha sika Hieno,Hyvä Antti ;D
Hieno! Entä QB:llä??
-PC-Master-
Vähäks hieno!!