screenshot

n000b

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

1

282

    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. Tänään pyörit ajatuksissa enemmän, kun erehdyin lukemaan palstaa

      En saisi, silti toivon että sinä vielä palaat ja otetaan oikeasti selvää, hioituuko särmät ja sulaudummeko yhteen. Vuod
      Ikävä
      22
      5134
    2. Huomenta ihana

      Kauniskasvoinen ihanuus 😘 saan sut vielä
      Ikävä
      25
      4308
    3. Hei rakas...

      Miten on työpäivä sujunut? Rakastan sinua 💗
      Ikävä
      27
      2461
    4. Edelleen sitä on vaikea uskoa

      Että olisit oikeasti rakastunut muhun
      Ikävä
      34
      2234
    5. Toiveikas vai toivoton

      torstai? Ajatuksia?
      Ikävä
      37
      1998
    6. Vitsi mihin menit. Heti takasin.

      Mä näin sut tuu takasin! Oli kiire, niin en ehtiny sin perään!
      Ikävä
      15
      1908
    7. En ole koskaan kokenut

      Ennen mitään tällaista rakastumista. Tiedän että kaipaan sinua varmaan loppu elämän. Toivottavasti ei tarvitsisi vain ka
      Ikävä
      19
      1587
    8. Mukavaa päivää

      Mun rakkauden kohteelle ❤️ toivottavasti olet onnellinen
      Ikävä
      12
      1521
    9. Voi ei! Jari Sillanpää heitti keikan Helsingissä - Hämmästyttävä hetki lavalla...

      Ex-tangokuningas on parhaillaan konserttikiertueella. Hän esiintyi Savoy teatterissa äitienpäivänä. Sillanpää jakoi kons
      Suomalaiset julkkikset
      21
      1247
    10. Kerranki asiat oikein

      Ilkka ja muut pienpuolueeet...teitte hyvän työn kun valitsitte pätevän henkilön virkaan eikä kepulle passelia!! Jatkakaa
      Haapavesi
      10
      1164
    Aihe