VB_部分学习用的材料.docVIP

VB_部分学习用的材料 VB源代码,图片转换为32×32的24位图标2009-07-28 23:01Dim Picture1 As PictureBox Private Sub Form_Load() Set Picture1 = Controls.Add(VB.PictureBox, Picture1) With Picture1 .AutoSize = True .AutoRedraw = True .BorderStyle = 0 End With Form_Click End Sub Private Sub Form_Click() AutoRedraw = True ScaleMode = 3 On Error Resume Next Set ComDlg = CreateObject(MSComDlg.CommonDialog) ComDlg.CancelError = True On Error GoTo cancel If IsEmpty(ComDlg) Then file0 = InputBox(请输入要转换的图片文件名) Picture1.Picture = LoadPicture(file0) PaintPicture Picture1.Picture, 0, 0, 32, 32, 0, 0, Picture1.Width, Picture1.Height 在窗体上显示图片 icofile = InputBox(请输入要保存的图标文件名) Else ComDlg.Flags = H1000 ComDlg.Filter = VB6.0可能支持的图片|*.bmp;*.dib;*.jpg;*.jpeg;*.jpe;*.jfif;*.gif;*.ico;*.cur;*.wmf;*.emf|所有文件|*.* ComDlg.ShowOpen file0 = ComDlg.FileName Picture1.Picture = LoadPicture(file0) PaintPicture Picture1.Picture, 0, 0, 32, 32, 0, 0, Picture1.Width, Picture1.Height 在窗体上显示图片 MsgBox 单击确定后选择图标的保存位置, 64, 提示 ComDlg.Flags = 2 ComDlg.FileName = ComDlg.Filter = 图标(*.ico)|*.ico ComDlg.ShowSave icofile = ComDlg.FileName End If Dim ico(3261) As Byte icoHead = Array(0, 0, 1, 0, 1, 0, 32, 32, 0, 0, 1, 0, 24, 0, 168, 12, 0, 0, 22, 0, 0, _ 0, 40, 0, 0, 0, 32, 0, 0, 0, 64, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, 128, 12) For i = 0 To 43 ico(i) = icoHead(i) Next i i = 62 j = 3134 For y = 31 To 0 Step -1 For x = 0 To 31 Step 8 For b = 0 To 7 p = Point(x + b, y) ico(j) = ico(j) - 2 ^ (7 - b) * (p = RGB(192, 192, 192)) 把原图片中颜色为RGB(192,192,192)的像素转换为透明 If p = RGB(192, 192, 192) Then p = 0 ico(i) = p \ 65536 计算像素的蓝色值 ico(i + 1) = p \ 256 Mod 256 计算像素的绿色值 ico(i + 2) = p Mod 256 计算像素的红色值 i = i + 3 Next b j = j + 1 Next x Next y Open icofile For Binary As #1 Put #1, , ico Close #1 MsgBox 图片 file0 vbCrLf 已成功转换为32×32的 _ 24位图标 vbCrLf icofile, 64, 转换成功