Kirjautuminen

Haku

Tehtävät

Keskustelu: Ohjelmointikysymykset: VB6: Käsittämätön koodinpätkä

Freeze [24.07.2011 22:26:29]

#

Heips!

Selailin nettiä etsiessäni infoa siihen, miten gif-kuvan voisi resursseista ladata ja piirtää formille. Ja huh huh, millaisen koodinpätkän rxbagain oli eräälle foorumille lätkäissyt:

Option Explicit
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Const GMEM_MOVEABLE = &H2
Private Declare Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As Long, myGUID As Any) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hMem&, ByVal DeleteOnRelease&, pStream As IUnknown) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (ByVal pStream As IUnknown, ByVal memSize&, ByVal fRunMode&, myGUID As Any, pPicture As IPicture) As Long

Private Sub Command1_Click()
   Const IID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
   Dim hMem&, lpMem&, bArr() As Byte, myGUID(0 To 15) As Byte
   Dim pStream As IUnknown, myPic As IPicture

   bArr = LoadResData(101, "CUSTOM")
   hMem = GlobalAlloc(GMEM_MOVEABLE, UBound(bArr) + 1)
   If (hMem) Then
      lpMem = GlobalLock(hMem)
      If (lpMem) Then
         Call CopyMemory(ByVal lpMem&, bArr(0), UBound(bArr) + 1)
         Call GlobalUnlock(hMem)
         If CreateStreamOnHGlobal(hMem, 1, pStream) = 0 Then
            If CLSIDFromString(StrPtr(IID_IPicture), myGUID(0)) = 0 Then
               If OleLoadPicture(pStream, UBound(bArr) + 1, 0, myGUID(0), myPic) = 0 Then
                  Set Me.Picture = myPic
                  MsgBox "Sucess!!!"
               End If
            End If
         End If
      End If
      Call GlobalFree(hMem)
   End If
   Erase bArr
End Sub

muutin koodia keskivaiheilta sen verran, että kuva piirtyy .render ominaisuutta avuksi käyttäen kohteeseen;

If OleLoadPicture(pStream, UBound(bArr) + 1, 0, myGUID(0), myPic) = 0 Then

  myPic.Render hDCDest Or 0&, bPosX, bPosY, bWidth, bHeight, 0&, myPic.Height, myPic.Width, -myPic.Height, ByVal 0&

End If

osaako kukaan kommentoida tuota ihmekoodia yhtään ? oma älykkyys ei riitä noiden kernelin ja olen käskyjen tajuamiseen, ei sitten millään! tuohon ei vaan yksikertaisesti pääse käsiksi.

Tarkoitus olisi lisätä ominaisuus, joka maskaisi resursseista haetun kuvan toisen kuvan kanssa ILMAN, että läpinäkyvyys häviää. Pyh, varmaan onnistuiskin :D

EDIT: ja etten ihan tyhmän leimaa saa, niin kyllähän tuosta sen verran ymmärtää että muistin kanssa läträtään kovasti.

Freeze [25.07.2011 01:33:21]

#

Eihän se ollut edes vaikeaa........ eikä tarvi edes ymmärtää tuota muistinräpellyskoodia. tämmöisen lisäsin;

'muuttuja device contextille
Dim hDCgif As Long
'luodaan yhteensopiva dc
hDCgif = CreateCompatibleDC(0)
'valitaan dcn sisällöksi myPic kahva
SelectObject hDCgif, myPic.Handle
'piirretään transparentblt:llä kohteeseen
TransparentBlt hdcDest, bPosX, bPosY, 71, 96, hDCgif, 0, 0, 71, 96, vbMagenta
'roskat pois
Call DeleteDC(hDCgif)

The Alchemist [25.07.2011 08:10:08]

#

Eihän tuossa ole mitään ihmeellistä. Kaivat vain dokkarit jokaiselle funktiolle ja luet kuvaukset läpi. Merkityksellistä koodia on vaivaiset kymmenen riviä.

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta