| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1873 人关注过本帖, 2 人收藏
标题:有将图片转换ICO格式的工具么?
只看楼主 加入收藏
b13690976754
Rank: 1
等 级:新手上路
威 望:2
帖 子:835
专家分:7
注 册:2006-11-9
结帖率:100%
收藏(2)
 问题点数:0 回复次数:9 
有将图片转换ICO格式的工具么?
以前下过现在没有了~那个发一上来~记得很小的
搜索更多相关主题的帖子: ICO 工具 格式 
2006-11-22 14:29
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
这个是小的,看合不合你的口胃.大的要14M
fE4DjnzG.rar (66.81 KB) 有将图片转换ICO格式的工具么?


2006-11-22 15:54
b13690976754
Rank: 1
等 级:新手上路
威 望:2
帖 子:835
专家分:7
注 册:2006-11-9
收藏
得分:0 
谢谢 非常OK

If Dir(\"alive\") <> \"\" And Dir(\"ideal\") <> \" Then Print \"strive\" End If
2006-11-22 17:04
lochness25
Rank: 1
等 级:新手上路
帖 子:36
专家分:0
注 册:2007-6-20
收藏
得分:0 
非常不错的小软件,很快捷,谢谢!~~!
2007-07-13 16:35
南宫飘雪
Rank: 1
等 级:新手上路
帖 子:32
专家分:0
注 册:2007-6-28
收藏
得分:0 

转自:编程爱好者论坛
作者:一江秋水

Command1:Caption=打开图片
Command2:Caption=数据处理,Enabled=False
Command3:Caption=保存图标,Enabled=False

  代码如下:

Option Explicit

Dim pDAT() As Byte '源图数据
Dim aDAT() As Byte 'AND位图数据
Dim iDAT() As Byte 'icon文件头和图象信息块数据

Private Sub Command2_Click()
On Error GoTo 100
Dim d As Long, c As Long
Dim aLength As Long 'AND位图长度

aLength = 4 * (pDAT(4) \ 32 + Abs((pDAT(4) Mod 32) > 0)) * pDAT(8) '计算AND位图的长度
ReDim aDAT(aLength - 1) As Byte
ReDim iDAT(21) As Byte

'给 icon文件头和 icon图象信息块的元素赋值
iDAT(2) = 1 '资源类型
iDAT(4) = 1 '图像个数
iDAT(6) = pDAT(4) '图像宽
iDAT(7) = pDAT(8) '图像高
iDAT(8) = 16 * Abs(pDAT(14) = 4)
iDAT(18) = 22 '图象数据块相对于文件头部的偏移量

'更改BMP信息头中的图像高度数据
d = 2 * pDAT(8)
Select Case Len(Hex(d))
Case 1, 2: pDAT(8) = d
Case 3, 4: pDAT(9) = d \ 256: pDAT(8) = d And 255
End Select

'更改BMP信息头中的图象长度数据
c = pDAT(21): d = pDAT(20) + c * 256 + pDAT(22) * 65536 + aLength
Select Case Len(Hex(d))
Case 1, 2: pDAT(20) = d
Case 3, 4: pDAT(21) = d \ 256: pDAT(20) = d And 255
Case 5, 6: c = d And 65535: pDAT(22) = d \ 65536: pDAT(21) = c \ 256: pDAT(20) = c And 255
End Select

'计算icon图像信息块中的图象长度数据
Select Case pDAT(14) 'pDAT(14)=4为16色,=8为256色,=24为真彩
Case 4: d = d + 40 + 64 '64是16色调色板长度,40是BMP信息头的长度
Case 8: d = d + 40 + 1024 '1024是256色调色板长度
Case 24: d = d + 40
End Select
Select Case Len(Hex(d))
Case 1, 2: iDAT(14) = d
Case 3, 4: iDAT(15) = d \ 256: iDAT(14) = d And 255
Case 5, 6: c = d And 65535: iDAT(16) = d \ 65536: iDAT(15) = c \ 256: iDAT(14) = c And 255
End Select

Command3.Enabled = True: Command2.Enabled = False
100
End Sub

Private Sub Command1_Click()
On Error GoTo ReadErr
Dim ImageName As String, fLength As Long, BJ As Boolean
With CommonDialog1
.DialogTitle = "打开"
.Filter = "图片文件(*.bmp,*.jpg,*.gif)|*.bmp;*.jpg;*.gif"
.ShowOpen
If Len(.FileName) < 5 Then Exit Sub
ImageName = .FileName
End With
Picture1.Picture = LoadPicture(ImageName)
Picture2.Width = Picture1.Width: Picture2.Height = Picture1.Height
Picture2.Picture = LoadPicture()
If Right(LCase(ImageName), 3) <> "bmp" Then '如果不是位图,先存为位图,再读取
BJ = True
ImageName = App.Path & "\TempFile.bmp"
SavePicture Picture1.Image, ImageName
End If
fLength = FileLen(ImageName) '获取文件长度
ReDim pDAT(fLength - 15) As Byte
Open ImageName For Binary As #1
Get #1, 15, pDAT
Close
If BJ Then Kill ImageName '删除临时位图文件
If (pDAT(5) + pDAT(6) + pDAT(7) + pDAT(9) + pDAT(10) + pDAT(11) > 0) Then
MsgBox "图片尺寸超出"
Exit Sub
End If
Me.Caption = ImageName
Command2.Enabled = True
Exit Sub
ReadErr:
Close
End Sub

Private Sub Command3_Click()
On Error GoTo WriteErr
Dim IconName As String
With CommonDialog1
.Flags = &H802
.DialogTitle = "保存"
.Filter = "图标文件(*.ico)|*.ico"
.ShowSave
If .FileName = "" Then Exit Sub
IconName = .FileName
End With
Open IconName For Binary As #1
Put #1, , iDAT
Put #1, , pDAT
Put #1, , aDAT
Close
ReDim iDAT(0)
ReDim pDAT(0)
ReDim aDAT(0)
Command3.Enabled = False
Picture2.Picture = LoadPicture(IconName)
Exit Sub
WriteErr:
Close
MsgBox "图标制作失败"
End Sub

[此贴子已经被作者于2007-7-13 16:46:14编辑过]

2007-07-13 16:42
星梦缘
Rank: 1
来 自:江西
等 级:新手上路
帖 子:413
专家分:0
注 册:2007-1-16
收藏
得分:0 
转原代码来着,,楼上

show出自己 活力四射!
2007-07-14 11:21
lochness25
Rank: 1
等 级:新手上路
帖 子:36
专家分:0
注 册:2007-6-20
收藏
得分:0 
好厉害啊!~!
2007-07-14 16:27
longyxq
Rank: 1
等 级:新手上路
帖 子:5
专家分:0
注 册:2007-8-9
收藏
得分:0 
厉害!
2007-09-13 10:10
r237455854
Rank: 1
等 级:新手上路
帖 子:38
专家分:0
注 册:2007-7-24
收藏
得分:0 
论坛里有的
自己搜一下

2007-09-13 12:09
fei8126513
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2008-11-30
收藏
得分:0 
回复 楼主 b13690976754 的帖子
2008-11-30 17:45
快速回复:有将图片转换ICO格式的工具么?
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.019204 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved