Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Saving Icons

Posted on 1999-07-28
1
Medium Priority
?
246 Views
Last Modified: 2010-04-30
I have written an icon editor addin for vb6, I cannot locate any API calls or source code for converting/saving a picturebox image as an icon.

If anyone can help I'll send them the Addin along with the points

Thanks
0
Comment
Question by:sp25
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
1 Comment
 
LVL 14

Accepted Solution

by:
waty earned 200 total points
ID: 1527939
' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 13/10/98
' * Time             : 09:52
' * Module Name      : Module1
' * Module Filename  :
' **********************************************************************
' * Comments         : Create a VB Picture object from an API icon handle
' *  or an Bitmap handle
' *
' **********************************************************************

Option Explicit

Private Type PictDesc
   cbSizeofStruct As Long
   picType        As Long
   hImage         As Long
   xExt           As Long
   yExt           As Long
End Type

Private Type GUID
   Data1          As Long
   Data2          As Integer
   Data3          As Integer
   Data4(0 To 7)  As Byte
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PictDesc, riid As GUID, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long

Public Function IconToPicture(ByVal hIcon As Long) As IPicture
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 13/10/98
   ' * Time             : 09:51
   ' * Module Name      : Module1
   ' * Module Filename  :
   ' * Procedure Name   : IconToPicture
   ' * Parameters       :
   ' *                    ByVal hIcon As Long
   ' **********************************************************************
   ' * Comments         : Create a VB Picture object from an API icon handle
   ' *
   ' * Sample of use
   ' *
   ' * Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" _
   ' *     (ByVal hInst As Long, ByVal lpsz As String, _
   ' *     ByVal iType As Long, _
   ' *     ByVal cx As Long, ByVal cy As Long, _
   ' *     ByVal fOptions As Long) As Long
   ' * ' iType options:
   ' * Private Const IMAGE_BITMAP = 0
   ' * Private Const IMAGE_ICON = 1
   ' * Private Const IMAGE_CURSOR = 2
   ' * ' *  fOptions flags:
   ' * Private Const LR_LOADMAP3DCOLORS = &H1000
   ' * Private Const LR_LOADFROMFILE = &H10
   ' * Private Const LR_LOADTRANSPARENT = &H20
   ' *
   ' *
   ' * Private Sub Command1_Click()
   ' * Dim hIcon As Long
   ' *     ' Load an icon called Test.Ico from the directory:
   ' *
   ' *     ' If the icon contains more than one size of image,
   ' *     ' set cx and cy to the width and height to load
   ' *     ' the appropriate image in:
   ' *     hIcon = LoadImage(App.hInstance, App.Path & "\TEST.ICO", IMAGE_ICON, 0, 0, LR_LOADFROMFILE Or LR_LOADMAP3DCOLORS)
   ' *     ' Set the picture to this icon:
   ' *     Set Picture1.Picture = IconToPicture(hIcon)
   ' * End Sub
   ' *
   ' **********************************************************************

   Dim oNewPic    As Picture
   Dim tPicConv   As PictDesc
   Dim IGuid      As GUID

   If hIcon = 0 Then Exit Function

   With tPicConv
      .cbSizeofStruct = Len(tPicConv)
      .picType = vbPicTypeIcon
      .hImage = hIcon
   End With

   ' *** Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
   With IGuid
      .Data1 = &H7BF80980
      .Data2 = &HBF32
      .Data3 = &H101A
      .Data4(0) = &H8B
      .Data4(1) = &HBB
      .Data4(2) = &H0
      .Data4(3) = &HAA
      .Data4(4) = &H0
      .Data4(5) = &H30
      .Data4(6) = &HC
      .Data4(7) = &HAB
   End With
   OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic

   Set IconToPicture = oNewPic

End Function

Public Function BitmapToPicture(ByVal hBmp As Long) As IPicture
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 13/10/98
   ' * Time             : 09:56
   ' * Module Name      : Module1
   ' * Module Filename  : Icon.bas
   ' * Procedure Name   : BitmapToPicture
   ' * Parameters       :
   ' *                    ByVal hBmp As Long
   ' **********************************************************************
   ' * Comments         : Create a VB Picture object from a GDI bitmap handle
   ' *
   ' * Sample of use
   ' *
   ' * Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" _
   ' *     (ByVal hInst As Long, ByVal lpsz As String, _
   ' *     ByVal iType As Long, _
   ' *     ByVal cx As Long, ByVal cy As Long, _
   ' *     ByVal fOptions As Long) As Long
   ' * ' *  iType options:
   ' * Private Const IMAGE_BITMAP = 0
   ' * Private Const IMAGE_ICON = 1
   ' * Private Const IMAGE_CURSOR = 2
   ' * ' *  fOptions flags:
   ' * Private Const LR_LOADMAP3DCOLORS = &H1000
   ' * Private Const LR_LOADFROMFILE = &H10
   ' * Private Const LR_LOADTRANSPARENT = &H20
   ' *
   ' *
   ' * Private Sub Command1_Click()
   ' * Dim hBmp As Long
   ' *     ' *  Load an icon called Test.Ico from the directory:
   ' *
   ' *     ' *  If the icon contains more than one size of image,
   ' *     ' *  set cx and cy to the width and height to load
   ' *     ' *  the appropriate image in:
   ' *     hBmp = LoadImage(App.hInstance, App.Path & "\TEST.BMP", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_LOADMAP3DCOLORS)
   ' *     ' *  Set the picture to this icon:
   ' *     Set Picture1.Picture = BitmapToPicture(hBmp)
   ' *
   ' * End Sub
  ' **********************************************************************


   Dim oNewPic    As Picture
   Dim tPicConv   As PictDesc
   Dim IGuid      As GUID

   If (hBmp = 0) Then Exit Function

   ' Fill PictDesc structure with necessary parts:
   With tPicConv
      .cbSizeofStruct = Len(tPicConv)
      .picType = vbPicTypeBitmap
      .hImage = hBmp
   End With

   ' Fill in IDispatch Interface ID
   With IGuid
      .Data1 = &H20400
      .Data4(0) = &HC0
      .Data4(7) = &H46
   End With

   ' Create a picture object:
   OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic

   ' Return it:
   Set BitmapToPicture = oNewPic

End Function

0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses

660 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question