原文：Visual Basic设计图标提取工具
天极IT资讯短信服务 电脑小技巧
|
介绍：细处着手，巧处用功。高手和菜鸟之间的差别就是：高手什么都知道，菜鸟知道一些。电脑小技巧收集最新奇招高招，让你轻松踏上高手之路。(首月免费) | |
在一些可执行模块包括*.EXE（可执行文件），*.DLL（Dynamic Link Library, 即动态连接库），*.CPL（ 控制面板模块）等都含有图标。其中，不少图标做得非常漂亮，如何将其“据为己有”？你一定用过诸如“东日探囊”之类的查看图标的小东东，但是有没有想过自己编写一个类似的小程序，我们知道：包含在可执行模块中的图标资源是以二进制数据（也叫资源，不懂的查书去） 的形式存储，我们需要把二进制数据转换成图标文件的格式，然后再存为图标文件（*.ICO）。
打开VB，新建一窗体，其caption值为“图标提取工具”，添加部件Microsoft Common Dialog Control6.0，并在窗体上放置两个common dialog，分别命名为：dlgsave和dlgopen，用于制作保存和打开的通用对话框。放置一个textbox，命名为textbox，用于显示选择文件后的文件路径及文件名，再放置两个命令按钮，caption值分别为：“打开文件”、“取消”，放置一个picturebox，命名为Iconbox，用于显示提取出来的图标，在picturebox下方放置一个hscrollbar，用于多个图标的选择，界面排列如图（图1） 准备工作做完后，开始代码的编写。
在工程中新建一模块，进行API声明：
Option Explicit
Declare Function ExtractIcon& Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long)
Declare Function DrawIcon& Lib "user32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) |
ExtractIcon用于判断一个可执行文件或DLL中是否有图标存在，并将其提取出来，返回值为Long，如成功，返回指向图标的句柄；如文件中不存在图标，则返回零。如果nIconIndex设为-1，就返回文件中的图标总数；DrawIcon函数则在指定的位置画一个图标。
作者：许晓静出处：yesky责任编辑：
方舟
[ 2003-10-23 08:48 ]
本文详细解说用VB设计图标工具的原理和各个步骤
首先定义命令按钮1（打开文件按钮），代码如下：
Private Sub command1_Click()
dlgopen.ShowOpen '显示打开对话框
textbox.Text = dlgopen.Filename '将选择的文件名称显示在textbox内
End Sub | 在取消命令按钮内输入：
Private Sub command2_Click()
Unload Me '退出程序
End Sub | 在textbox的change事件中定义：
Private Sub textbox_Change()
If textbox.Text = "" Then '空则退出
Exit Sub
End If
Dim Icons As Integer
Icons = ExtractIcon(hInst, textbox, -1)
If Icons > 1 Then '图标数大于1，则scroll有效
Scroll.Enabled = True
Scroll.Max = Icons - 1
Scroll.Value = 0
Else
Scroll.Enabled = False
End If
Scroll_Change
End Sub
在scroll的change事件中输入代码：
Private Sub Scroll_Change()
Dim a As Integer
Iconbox.Cls '清除存在的图标
hIcon = ExtractIcon(0, textbox.Text, Scroll.Value) '根据scrollbar提取相应图标
a = DrawIcon(Iconbox.hDC, 5, 5, hIcon) '在picturebox显示相应图标
End Sub
scroll的scroll事件代码：
Private Sub Scroll_Scroll()
Scroll_Change
End Sub | 最后需要保存选中的图标，我们设计将其存为bmp格式，直接定义iconbox的click事件，当在图形上点击鼠标左键时提示是否保存：
Private Sub Iconbox_Click()
On Error Resume Next
dlgsave.Filename = strSaveIconFile
dlgsave.CancelError = True
dlgsave.Filter = "Bitmap Image (*.bmp)|*.bmp"
dlgsave.ShowSave
strSaveIconFile = dlgsave.Filename
SavePicture Iconbox.Image, strSaveIconFile
End Sub | 至此，一个完整的图标提取工具就诞生了，编译成可执行文件后运行一下看看效果如何？用自己的软件，干自己的事，是不是特有成就感？ 源代码下载 |
编辑
删除
回复
收藏
留言
好友
置顶 
取消精华 