screenshot

n000b

Sanokaas miten voi laittaa vb-ohjelman ottamaan ruudunkaappauksen aktiivisesta ikkunasta tai koko näytöstä, ja tallentaa sen bmp-tiedostoon

1

241

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Orwell

      Tarvitset PictureBoxin ja OptionButtonit... ja lisäksi tietenkin kaikki nuo API komennot yms...
      Tuon PictureBoxin AutoRedraw arvo pitää olla True. Muutenkin voit joutua säätämään jotain, mutta idean pitäisi toimia...

      Private Sub ScreenShot()

      Dim lhWnd As Long
      Dim lhDC As Long
      Dim lLeft As Long
      Dim lTop As Long
      Dim lWidth As Long
      Dim lHeight As Long
      Dim wplc As WINDOWPLACEMENT
      Dim sName As String

      sName = vbNullString

      lLeft = 0
      lTop = 0

      'Koko näyttö
      If Option1(0).Value Then
      lhWnd = GetDesktopWindow()
      lWidth = Screen.Width
      lHeight = Screen.Height
      sName = "Test_scr"
      'Aktiivi ikkuna
      ElseIf Option1(1).Value Then
      lhWnd = GetActiveWindow()
      Call GetWindowPlacement(lhWnd, wplc)
      'Lasketaan formin koko (koko pixeleinä -> muutetaan Twipeiksi)
      lWidth = (wplc.rcNormalPosition.Right - wplc.rcNormalPosition.Left) * Screen.TwipsPerPixelX
      lHeight = (wplc.rcNormalPosition.Bottom - wplc.rcNormalPosition.Top) * Screen.TwipsPerPixelY
      sName = "Test_win"
      End If

      Picture1.Width = lWidth
      Picture1.Height = lHeight

      lhDC = GetWindowDC(lhWnd)

      'Kopioi PictureBoxiin
      Call BitBlt(Picture1.hdc, 0, 0, _
      lWidth, lHeight, lhDC, _
      lLeft, lTop, vbSrcCopy)

      'Tallennetaan kuva
      Call SavePicture(Picture1.Image, "c:\temp\" & sName & ".bmp")

      Call ReleaseDC(lhWnd, lhDC)
      End Sub

    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Suomi on täysin sekaisin

      Jo ties monettako päivää hirveä itku ja poru jostain helvetin nilviäisistä. https://www.is.fi/taloussanomat/art-2000010
      Maailman menoa
      450
      4859
    2. Ensimmäisestä kohtaamisesta saakka

      minulla on ollut hämmentynyt olo. Miten voit tuntua siltä, että olisin tuntenut sinut aina? Sinun kanssasi on yhtä aikaa
      Ikävä
      15
      1732
    3. Aivan täysin tahallinen teko

      Ei mitään puolusteluja, eikä selittelyitä. Kuljettajalle kerrottiin asiasta siinä paikanpäällä, mutta silti hän ajoi ves
      Suomussalmi
      94
      1478
    4. Suomussalmi saatu vihdoin maailmankartalle!

      Nyt kun Suomussalmi on vihdoin viimein saatu ennennäkemättömällä tavalla maailman tietoisuuteen niin voitaisiin järjestä
      Suomussalmi
      53
      1359
    5. Olet saanut minut sekoamaan

      Tunteiden ristiaallokossa vellominen on ollut melkoinen kokemus. Ei kukaan ole saanut minua niin raiteiltaan kuin sinä.
      Ikävä
      23
      1337
    6. Mainehaitta metsäkonefirmalle

      Hukkajoen tapahtumista liikkuu paljon huhuja. Eikö kannattaisi julkaista raakkuja tuhonneen metsäkoneyrityksen nimi, kos
      Suomussalmi
      53
      1228
    7. Oho! Maajussi-Kallelta pakit saanut morsioehdokas Miss Suomi -kisoissa! Tunnistaisitko hänet nyt?

      Hmm, tunnistaisitko?!? Onnea missihulinoihin! Lue lisää ja katso kuvat: https://www.suomi24.fi/viihde/oho-maajussi-
      Suomalaiset julkkikset
      0
      1075
    8. Myönnän sinulle nyt

      Että olen erittäin mustasukkainen sinusta jo nyt. Ikävä on tämä tunne, kun tietämättömyyden solista nousee myrkkyä miele
      Ikävä
      54
      1010
    9. Pysytäänkö nainen

      edelleen yhtä viileän tyynenä kun nähdään. Uskotko että tahtoessani saisin murettua tyyneytesi hyvin helposti.
      Ikävä
      57
      895
    10. Olen käyttäytynyt ristiriitaisesti

      eikä minusta varmaankaan ota mitään selvää. Se johtuu siitä, kun järki sanoo ei, ei, ei ja sydän sanoo kyllä, kyllä, kyl
      Ikävä
      61
      879
    Aihe