Keskustelu: Koodit: VB6: kuvan katselu ohjelma [fastshow]

' Kevyt ja nopea kuvan katselu ohjelma...
'
' Http://kotisivu.mtv3.fi/netman69/fastshow.zip



Dim pienennos As Integer                    'muuttuja näyttämään koko
Dim oikealeveys As Integer                  'nimi sanookin jo
Dim oikeakorkeus As Integer                 'kuten myös
Dim nappi As Integer                        'tekee muuttujan nappi




Private Sub Form_Load()                     'kun käynnistetään
Dim polku As String                         'muuttuja tiedostopolulle
polku = Command$                            'haetaan käsky (esim "c:\kuvat\kuva.jpg")
If Command$ = "" Then                       'jos käskyä ei ole
polku = App.Path + "\Default.jpg"           'kirjoitetaan poluksi default.jpg ohjelman hakemistosta
Image1.Picture = LoadPicture(polku)         'ladataan kuva
Else                                        'muutoin
Dim loyty As Boolean                        'muuttuja loyty joko true tai false
If InStr(polku, Chr(34)) = 0 Then           'etsii missä "-merkki on ja jos niin
loyty = False                               'loyty on true
Else                                        'muutoin
loyty = True                                'false
End If                                      'lopettaa jos-lauseen
If loyty = False Then                       'jos loyty on false niin
Image1.Picture = LoadPicture(polku)         'lataa kuvan määritetystä polusta
Else                                        'muutoin
Dim muutos As String                        'muuttuja muutos polun muokkaamista varten
Dim pituus As Integer                       'muuttuja pituus polun muokkausta varten
pituus = Len(polku)                         'tarkistaa polun pituuden
polku = Left(polku, pituus - 1)             'poistaa yhden merkin
pituus = Len(polku)                         'laskee uuden pituuden
polku = Right(polku, pituus - 1)            'poistaa yhden merkin
Image1.Picture = LoadPicture(polku)         'lataa kuvan määritetystä polusta
End If                                      'lopettaa jos-lauseen loyty-muuttujasta
End If                                      'lopettaa jos-lauseen "-merkin etsimisestä
Image1.Stretch = True                       'muuttaa kuvan/kuvaruudukon oikean kokoiseksi
pienennos = 100                             'pienennos-arvoksi 100
oikealeveys = Image1.Width                  'tallentaa alkuperäisen leveyden
oikeakorkeus = Image1.Height                'sama korkeudelle
Do                                          'aloittaa silmukan
If Image1.Width > Screen.Width * 0.7 Then   'jos kuva leveämpi kuin 70% ruudusta
Image1.Width = Image1.Width * 0.5           'muuttaa leveyden puolet pienemmäksi
Image1.Height = Image1.Height * 0.5         'muuttaa korkeuden puolet pienemmäks
pienennos = pienennos * 0.5                 'puolittaa koko-merkinnän
End If                                      'lopeta jos-lauseen kuvan leveydestä
If Image1.Height > Screen.Height * 0.7 Then 'jos kuva leveämpi kuin 70% ruudusta
Image1.Width = Image1.Width * 0.5           'muuttaa leveyden puolet pienemmäksi
Image1.Height = Image1.Height * 0.5         'muuttaa korkeuden puolet pienemmäks
pienennos = pienennos * 0.5                 'puolittaa koko-merkinnän
End If                                      'lopeta jos-lauseen kuvan leveydestä
If Image1.Height < Screen.Height * 0.7 Then 'jos kuvan korkeus alle 70% ruudusta
If Image1.Width < Screen.Width * 0.7 Then   'jos kuvan leveys alle  70% ruudusta
GoTo jatkuu:                                'siirry jatkuu: kohtaan
End If                                      'lopettaa jos-lauseen leveydestä
End If                                      'lopettaa jos-lauseen korkeudesta
Loop                                        'menee silmukan alkuun
jatkuu:                                     'rivi jolle voi siirtyä goto lausekkeella
Image1.Stretch = True                       'kuva mukautuu image1:n kokoon
koko.Visible = True                         'koko teksi muutetaan näkymään
koko.Caption = "Koko: " & pienennos & "%"   'sen tekstiksi muutetaan "koko: " ja koko-muunnos prosentti
koko.AutoSize = True                        'laitetaan se ottamaan oikea koko
koko.BackStyle = 0                          'tehdään sen taustasta läpinäkyvä
Image1.Top = 0                              'kuvaruudun sijainti ikkunassa aivan ylös
Image1.Left = 0                             'ja vasemmalle
koko.Top = 0                                'koko-teksti ylös
koko.Left = 0                               'koko-teksi vasemmalle
Form1.Width = Image1.Width                  'ikkuna kuvan levyiseksi
Form1.Height = Image1.Height                'ja sama korkeudelle
End Sub                                     'ohjelma avattu :)


Sub pienenna()                              'pienenna sub:i
koko.AutoSize = True                        'laitetaan se ottamaan oikea koko
If koko.Width < Image1.Width Then           'jos koko-teksi mahtuu ikkunaan niin
Image1.Width = Image1.Width * 0.9           'muuttaa leveyden 10% pienemmäksi
Image1.Height = Image1.Height * 0.9         'muuttaa korkeuden 10% pienemmäks
pienennos = pienennos * 0.9                 '10% pienemmäks koko-merkintä
Image1.Stretch = True                       'kuva mukautuu image1:n kokoon
koko.Visible = True                         'koko teksi muutetaan näkymään
koko.Caption = "Koko: " & pienennos & "%"   'sen tekstiksi muutetaan "koko: " ja koko-muunnos prosentti
koko.AutoSize = True                        'laitetaan se ottamaan oikea koko
koko.BackStyle = 0                          'tehdään sen taustasta läpinäkyvä
Image1.Top = 0                              'kuvaruudun sijainti ikkunassa aivan ylös
Image1.Left = 0                             'ja vasemmalle
koko.Top = 0                                'koko-teksti ylös
koko.Left = 0                               'koko-teksi vasemmalle
Form1.Width = Image1.Width                  'ikkuna kuvan levyiseksi
Form1.Height = Image1.Height                'ja sama korkeudelle
End If                                      'lopettaa jos-lauseen jossa tarkistetaan koko
End Sub                                     'lopettaa pienenna sub:in

Sub oikeakoko()                             'oikeakoko sub:i
Image1.Width = oikealeveys                  'muuttaa leveyden oikeaksi
Image1.Height = oikeakorkeus                'muuttaa korkeuden oikeaksi
pienennos = 100                             'koko-merkintä arvoksi 100
Image1.Stretch = True                       'kuva mukautuu image1:n kokoon
koko.Visible = True                         'koko teksi muutetaan näkymään
koko.Caption = "Koko: " & pienennos & "%"   'sen tekstiksi muutetaan "koko: " ja koko-muunnos prosentti
koko.AutoSize = True                        'laitetaan se ottamaan oikea koko
koko.BackStyle = 0                          'tehdään sen taustasta läpinäkyvä
Image1.Top = 0                              'kuvaruudun sijainti ikkunassa aivan ylös
Image1.Left = 0                             'ja vasemmalle
koko.Top = 0                                'koko-teksti ylös
koko.Left = 0                               'koko-teksi vasemmalle
Form1.Width = Image1.Width                  'ikkuna kuvan levyiseksi
Form1.Height = Image1.Height                'ja sama korkeudelle
End Sub                                     'lopettaa oikeakoko sub:in



Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'jos painetaan image1:stä hiirellä
nappi = Button                              'kopioi button-muuttujan sisällön nappi muuttujaan
If nappi = 2 Then                           'jos painettu hiiren nappi on oikea niin
pienenna                                    'suorita pienenna
End If                                      'lopeta jos-lause
If nappi = 1 Then                           'jos painettu hiiren nappi on vasen niin
suurenna                                    'suorittaa suurenna
End If                                      'lopeta jos-lause
If nappi = 4 Then                           'jos painettu hiiren nappi on keski niin
oikeakoko                                   'suorittaa oikeakoko
End If                                      'lopeta jos-lause
End Sub

Sub suurenna()                              'suurenna sub:i
If pienennos < 500 Then                    'jos suurennos on 500% tai enemän niin
Image1.Width = Image1.Width * 1.1           'muuttaa leveyden 10% suuremmaksi
Image1.Height = Image1.Height * 1.1         'muuttaa korkeuden 10% suuremmaks
pienennos = pienennos * 1.1                  '10% suuremmaks koko-merkintä
Image1.Stretch = True                       'kuva mukautuu image1:n kokoon
koko.Visible = True                         'koko teksi muutetaan näkymään
koko.Caption = "Koko: " & pienennos & "%"   'sen tekstiksi muutetaan "koko: " ja koko-muunnos prosentti
koko.AutoSize = True                        'laitetaan se ottamaan oikea koko
koko.BackStyle = 0                          'tehdään sen taustasta läpinäkyvä
Image1.Top = 0                              'kuvaruudun sijainti ikkunassa aivan ylös
Image1.Left = 0                             'ja vasemmalle
koko.Top = 0                                'koko-teksti ylös
koko.Left = 0                               'koko-teksi vasemmalle
Form1.Width = Image1.Width                  'ikkuna kuvan levyiseksi
Form1.Height = Image1.Height                'ja sama korkeudelle
End If                                      'lopettaa jos-lauseen jossa tarkistetaan koko
End Sub