VB部分学习用的材料.docxVIP

VB_部分学习用的材料 VB源代码，图片转换为32X32的24位图标2009-07-28 23:01Dim Picturel As PictureBox Private Sub FormLoad() Set Picturel = Controls?Add (〃VB. PictureBox, Picturel) With Picturel .AutoSize = True .AutoRedraw = True .BorderStyle = 0 End With FormClick End Sub Private Sub FormClick() AutoRedraw = True ScaleMode = 3 On Error Resume Next Set ComDlg = CreateObject CzMSComDlg .CommonDialog) ComDlg. CancelError = True On Error GoTo cancel If IsEmpty(ComDlg) Then fileO = InputBox(z，请输入要转换的图片文件名〃) Picture1. Picture = LoadPicture(fileO) PaintPicture Picturel. Picture, 0, 0, 32, 32, 0, 0, Picturel. Width, Picturel. Height 在窗体上显示图片 icofile = InputBox(/，请输入要保存的图标文件名〃) Else ComDlg. Flags = H1000 ComDlg. Filter = 〃VB6?0可能支持的图片 *. bmp;*. dib;*. jpg;*? jpeg;*. jpe;*? jfif ;*. gif ;*. ico;*? cur;*? wmf;*? emf|所有文件|*?*〃 ComDlg. ShowOpen fileO 二 ComDlg?FileName Picturel.Picture 二 LoadPicture(fileO) PaintPicture Picturel.Picture, 0, 0, 32, 32, 0, 0, Picturel. Width, Picturel. 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, 16 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, 12 12) For i = 0 To 43 ico(i)二 icollead(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 〃图片〃 fileO vbCrLf 〃已成功转换为 32X32 的〃 _ 〃24位图标〃 vbCrLf icof订e, 64, 〃转换成功〃 MousePointer二99 这两句把转换成的图标作为窗体的鼠标图标, 以查看效果 Mouseicon 二 LoadPicture(icofile) Exit Sub cancel: MsgBox Err. Description 〃，本次转换被取消，要再次转换，请单击 窗体〃