• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 484
  • Last Modified:

Loading Transparent Gif and Use WINAPI to Blit it out

I would like to use bitblt to blit a gif bitmap...
How can it be done? How can it be opened loaded into device and being
Could provide some src code?
  • 8
  • 5
1 Solution
Richie_SimonettiIT OperationsCommented:
Why do you need to use bitblt?
Could you explain a bit more?
You could load an image in a stdpicture object with a simple LoadPicture function (if you don't want to use an ima/picture box control).
Richie_SimonettiIT OperationsCommented:
Also PaintPicture method of form/picture box/printer objects.
luckieAuthor Commented:
Because LoadPicture was too slow and the screen was flickering.
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

luckieAuthor Commented:
here is a bit of code:
Dim objPics(2) As Image

Dim blnStartCapture As Boolean
Dim blnAmCapturing As Boolean
Dim intHandleDisplay As Integer
Dim intStartX As Integer
Dim intStartY As Integer
Dim intMouseX As Integer
Dim intMouseY As Integer
Dim intOldMouseX As Integer
Dim intOldMouseY As Integer

Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As DEVMODE) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Public i, j, k

Private Sub ActiveXPlugin1_GotFocus()

End Sub

 Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Debug.Print x, y, Point(x, y)
End Sub

Private Sub Form_Load()
 '  ImageList1.MaskColor = &H595959
 '  Set Picture2.Picture = ImageList1.Overlay(2, 1)
   Dim i As Single, j As Single
   Dim devDevMode As DEVMODE

   Set objpic(0) = New Image
   Set objpic(1) = New Image  ' doesn't work
   WindowState = 2
  ' Open "C:\images\2tran.gif" For Input As #1
    Set objPics(0).Picture = LoadPicture("C:\images\2tran.gif")
    Set objPics(1).Picture = LoadPicture("C:\images\3tran.gif")
'   intHandleDisplay = CreateDC("DISPLAY", 0&, 0&, devDevMode)
'   AutoRedraw = True

'   For i = 0 To ScaleWidth Step 15
'        For j = 0 To ScaleHeight Step 15
'            PSet (i, j), QBColor(Int(Rnd(1) * 16))
'        Next j
'    Next i
   'Image1.BackColor = QBColor(&H5855577)
   i = 0
   j = 0
   k = 0
   Timer1.Interval = 10
   Timer1.Enabled = True
   Timer2.Interval = 10
   Timer2.Enabled = True
   Timer3.Interval = 10
   Timer3.Enabled = True
   'Set Picture1.Picture = ImageList1.Overlay(2, 1)
   'Picture1.ZOrder 0
  ' Picture2.ZOrder 1
End Sub

Private Sub Speed_Click()
End Sub

Private Sub Timer1_Timer()
   i = i + 10
   If (i >= 0 And i < 1000) Then
      PaintPicture objPics(0), 100, 100, 100, 100, 10, 10, 100, 100, vbSrcPaint
'     Image1.Left = Image1.Left - 1
   ElseIf (i > 1000 And i < 2000) Then
'        If (i = 1000) Then
'            Image1.Picture = LoadPicture("C:\images\2tran.gif")
'        ElseIf (i = 1100) Then
'            Image1.Picture = LoadPicture("C:\images\3tran.gif")
'        ElseIf (i = 1200) Then
'            Image1.Picture = LoadPicture("C:\images\4tran.gif")
'        ElseIf (i = 1300) Then
'            Image1.Picture = LoadPicture("C:\images\5tran.gif")
'        End If
'     Image1.Top = Image1.Top - 1
'     Image1.Left = Image1.Left - 1
'  ElseIf (i > 2000 And i < 3000) Then
'     Image1.Picture = LoadPicture("C:\images\6tran.gif")
'     Image1.Top = Image1.Top - 1
'  ElseIf (i > 3000) Then
'     Image1.Picture = LoadPicture("C:\images\7tran.gif")
   End If
End Sub

Private Sub Timer2_Timer()
 j = j + 1
'If (j >= 1 And j < 1000) Then
'     Picture2.Left = Picture2.Left - 1
'   ElseIf (j > 1000 And j < 1500) Then
'     Picture2.Top = Picture2.Top - 1
'     Picture2.Left = Picture2.Left - 1
'   ElseIf (j > 1500) Then
'     Picture2.Top = Picture2.Top - 1
'   End If
End Sub

Private Sub Timer3_Timer()
 k = k + 1
End Sub
luckieAuthor Commented:
When I continously loading the picture, the image will flicker, do u have the solution for this?
luckieAuthor Commented:
I tried to use block transfer, but when I loaded the file (transparent gif) into the DC, it became white in the background....any suggestions? Picture objects don't have stretch, but I don't know how to do it with an image object
sob... (hence connecting the DC with the 'IMAGE' Object)

luckieAuthor Commented:
with picture boxes, the image was heaps bigger than the picture box... oh no
luckieAuthor Commented:
and with picture boxes, it doesn't deal with the transparency of gif's...! any advice
luckieAuthor Commented:
I beg your pardon, it did support transparency! sorry about it.
Richie_SimonettiIT OperationsCommented:
you could try using an array of stdpictures and before start the animation, populate that array with all pictures that you need to use.
Although picture boxes don't support stretch directly, you can stretch using the PaintPicture method.

Also, the image property contains the "working" image of the picturebox and will become the "background" image by assigning it to the picture property.
Richie_SimonettiIT OperationsCommented:
By the way, re-reading your comment, there is no DC for an Image control.

try to follow this steps and let me know:
sub test
dim arrPics() as stdpicture
dim arrFiles() as string
dim lcount as long,i as long


for i= 0 to lcount
    redim preserve arrpics(i)
next i
end sub

Private Function RetEnumFiles(lCount As Long, sPath As String, ftype As VbFileAttribute, Optional sType As String = "*.*") As String()
Dim ff As String, arrfiles() As String
Dim filecount As Long

ff = Dir$(sPath & sType, ftype)
Do While ff <> ""
    If ff <> "." And ff <> ".." Then
      If GetAttr(sPath & ff) = ftype Then
        ReDim Preserve arrfiles(filecount)
        arrfiles(filecount) = sPath & "\" & ff
        filecount = filecount + 1
      End If
    End If
    ff = Dir$()
lCount = filecount - 1
RetEnumFiles = arrfiles
End Function

'And call your timer, something like...
static i as long

luckieAuthor Commented:
Great Thanks
Richie_SimonettiIT OperationsCommented:
Glad to help and thanks for "A" grade.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 8
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now