Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1460

Paint PNGs via DrawIconEx()

$
0
0
Use WIA 2.0 and an ImageList to load a PNG file as a StdPicture. Then draw using DrawIconEx(), which seems to hold the alchemy here.

Code:

Option Explicit

Private Const WIN32_NULL As Long = 0

Private Enum DI_FLAGS
    DI_MASK = &H1&
    DI_IMAGE = &H2&
    DI_NORMAL = &H3&
    DI_COMPAT = &H4&
    DI_DEFAULTSIZE = &H8&
    DI_NOMIRROR = &H10&
End Enum

Private Declare Function DrawIconEx Lib "user32" ( _
    ByVal hDC As Long, _
    ByVal xLeft As Long, _
    ByVal yTop As Long, _
    ByVal hIcon As Long, _
    ByVal cxWidth As Long, _
    ByVal cyWidth As Long, _
    ByVal istepIfAniCur As Long, _
    ByVal hbrFlickerFreeDraw As Long, _
    ByVal diFlags As DI_FLAGS) As Long

Private PngAsIcon As StdPicture
Private WidthPx As Long
Private HeightPx As Long
Private Coords As Collection

Private Sub Backdrop()
    Dim I As Single

    For I = 0 To ScaleWidth Step ScaleX(15, vbPixels)
        Line (I, 0)-(I, ScaleHeight), &HC0E0C0
    Next
    For I = 0 To ScaleHeight Step ScaleX(15, vbPixels)
        Line (0, I)-(ScaleWidth, I), &HFFC0C0
    Next
End Sub

Private Sub DrawCenteredAt(ByVal X As Single, ByVal Y As Single)
    DrawIconEx hDC, _
              ScaleX(X, ScaleMode, vbPixels) - WidthPx \ 2, _
              ScaleY(Y, ScaleMode, vbPixels) - HeightPx \ 2, _
              PngAsIcon.Handle, _
              WidthPx, _
              HeightPx, _
              0, _
              WIN32_NULL, _
              DI_NORMAL
End Sub

Private Sub Form_Load()
    With New WIA.ImageFile
        .LoadFile "GlassBall.png"
        WidthPx = .Width
        HeightPx = .Height
        ImageList1.ImageWidth = WidthPx
        ImageList1.ImageHeight = HeightPx
        ImageList1.ListImages.Add , , .FileData.Picture()
    End With
    Set PngAsIcon = ImageList1.ListImages.Item(1).ExtractIcon()
    ImageList1.ListImages.Clear
    Set Coords = New Collection
    BackColor = &HF0F0FF
    DrawWidth = 2
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DrawCenteredAt X, Y
    Coords.Add Array(X, Y)
End Sub

Private Sub Form_Resize()
    Dim Coord As Variant
   
    If WindowState <> vbMinimized Then
        Cls
        Backdrop
        For Each Coord In Coords
            DrawCenteredAt Coord(0), Coord(1)
        Next
    End If
End Sub

Name:  sshot.png
Views: 136
Size:  11.7 KB
Attached Images
 
Attached Files

Viewing all articles
Browse latest Browse all 1460

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>