• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

BMP2ICON

Các ví dụ nho nhỏ và những thứ linh tinh không thuộc nhóm nào
Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4763
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 517 time

BMP2ICON

Gửi bàigửi bởi truongphu » T.Sáu 16/01/2009 8:37 am

Tên chương trình: BMP2ICON
Ngôn ngữ lập trình: VB6
Tác giả: Chui Tey 2000
Chức năng: Chuyển BMP sang ICO


Rất tốt

Mã: Chọn hết

  1. Option Explicit
  2.  
  3. '=================================================================================
  4. '   BMP2ICON
  5. '
  6. '   It eats its own dogfood: the icon for this program is created using BMP2ICON
  7. '   (c) Chui Tey 2000
  8. '
  9. '   Email: teyc@bigfoot.com
  10. '
  11. '   Requires:
  12. '       Common Dialog Control
  13. '       Windows Common Controls-5.0 (SP2)
  14. '
  15. '=================================================================================
  16.  
  17. Private Sub cmdSelectBMP_Click()
  18.  
  19.     On Error GoTo ErrHandler
  20.     cdlFileOpen.ShowOpen
  21.        
  22.     Dim lsICOFilename As String
  23.     Dim lsBMPFilename As String
  24.     lsBMPFilename = cdlFileOpen.FileName
  25.     lsICOFilename = Left(lsBMPFilename, Len(lsBMPFilename) - 3) & "ico"
  26.    
  27.     '   Responding to Alessandro's request:
  28.     '   1. Show the Bitmap in the image control
  29.     '   2. Let the user decide whether to convert
  30.     '      to icon format
  31.     '
  32.     Image1.Picture = LoadPicture(lsBMPFilename)
  33.     Dim liChoice As VbMsgBoxResult
  34.     liChoice = MsgBox("Convert this image to icon?", vbYesNo)
  35.     If liChoice = vbYes Then
  36.    
  37.         '   Call the actual conversion routine
  38.         '
  39.         Convert lsBMPFilename, lsICOFilename
  40.        
  41.         MsgBox "BMP file converted to " & lsICOFilename, vbInformation
  42.        
  43.     End If
  44.    
  45.     Exit Sub
  46.    
  47. ErrHandler:
  48.  
  49.     Select Case Err.Number
  50.         Case 32755
  51.             'Do nothing
  52.        
  53.         Case Else
  54.             MsgBox "ERROR " & Err.Number & vbNewLine & Err.Description, vbExclamation
  55.            
  56.     End Select
  57.    
  58. End Sub
  59.  
  60. Private Sub Convert(ByVal asBMPFilename As String, ByVal asICOFilename As String)
  61.  
  62.     Dim a As IPictureDisp
  63.     Set a = LoadPicture(asBMPFilename)
  64.    
  65.     ImageList1.ListImages.Add Picture:=a
  66.     Set a = ImageList1.ListImages(1).ExtractIcon
  67.    
  68.     On Error GoTo ErrHandler
  69.     SavePicture a, asICOFilename
  70.    
  71.     ImageList1.ListImages.Remove (1)
  72.        
  73.     Exit Sub
  74.    
  75. ErrHandler:
  76.  
  77.     ImageList1.ListImages.Remove (1)
  78.    
  79.     Select Case Err.Number
  80.         Case 380
  81.             Err.Raise Err.Number, Err.Source, Err.Description & vbNewLine & "The bitmap may be too big to convert to an icon format"
  82.         Case Else
  83.             Err.Raise Err.Number, Err.Source, Err.Description
  84.     End Select
  85.    
  86. End Sub
Tập tin đính kèm
CODE_UPLOAD1209811262000.zip
(4.48 KiB) Đã tải 526 lần


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Quay về “[VB] Mã nguồn linh tinh”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách