人在旅途--How to get the file type icon by the file name extension

[微软技术开发]How to get the file type icon by the file name extension

人在旅途发表于 2006/1/23 9:16:56

SHFileOperation function ShellExecute GetFileInfo The best way is here（Downloaded from:http://www.mvps.org/vbnet/index.html?code/comctl/lvdemo4.htm）: 500)this.width=500'>Visual Basic Common Control API Routines.rar 1.Use the imagelist functions in the comctl32.lib by this way:Public Declare Function ImageList_Draw Lib "comctl32" (ByVal himl As Long, ByVal i As Long, ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal fStyle As Long) As Long２．I can not use the function SHGetFileInfo in VB, it always return 0 and the error code is 0 too.maybe before use it we need to call some initial function first.3.We can load a lib called shell32 into VB, try it. ４．I have solved this problem: The reason that I can not call SHGetFileInfo is that : I used "\\" for the path in VB program. Just as I did in the VC++ program. But VB is default for unicode, so the "\\" is really stands for the "\\" not "\" as it did in VC++. And what it is interesting is that you can use "\\" in VB correctly for some function, for examle, "Open StrNamePath For Input As #FileNo" and "CreateFile". And for other functions, as in "FileListBox" and "SHGetFileInfo" , it does not work. 5. Finished: And my program about it is here://Here to implement'/************************************************************************/'/* Copyright(c) Kawatetsu Systems, Inc */'/* All Rights Reserved */'/* An Unpublished Work */'/* */'/* This is a Proprietary program product material and is the */'/* property of KAWATETSU SYSTEMS, INC. No sale, reproduction */'/* or other use of this program product is authorized except */'/* as granted by the fully executed KAWATETSU SYSTEMS, INC. */'/* product license or by the separate written agreement */'/* and approval of: */'/* */'/* Kawatetsu Systems, INC. */'/* 36-11, Minamisuna 2-chome, Koto-ku, TOKYO, JAPAN */'/************************************************************************' * ClsFileInfo.cls バージョン1.0' * 2002.3' * ファール情報（たとえばアイコン）クラス。' ************************************************************************/ Option Explicit'/*内部変数*/Private FilePath As String '/*ファイルPath*/Private IsVirtual As BooleanPrivate FileName As String Public Sub Init(ByVal FilePathIn As String, ByVal IsVirtualIn As Boolean) If IsVirtualIn Then If InStr(FilePathIn, "\") <> 0 Then Exit Sub FileName = FilePathIn Else Dim Values() As String Dim RetLen As Long RetLen = Str2ArrayStr(FilePathIn, "\", Values) If RetLen <= 0 Then Exit Sub FileName = Values(RetLen - 1) End If FilePath = FilePathIn IsVirtual = IsVirtualInEnd Sub Public Sub GetLargeIcon(ByRef Pic As PictureBox) Dim Handle As Long If IsVirtual Then FilePath = App.Path + "\" + FileName Dim Tmp As SECURITY_ATTRIBUTES Handle = CreateFile(FilePath, GENERIC_WRITE Or GENERIC_READ, _ FILE_SHARE_READ, 0, CREATE_ALWAYS, 0, 0) If Handle = -1 Then Exit Sub CloseHandle Handle End If Dim hImgSmall As Long Dim shinfo As SHFILEINFO hImgSmall = SHGetFileInfo(FilePath, _ 0, shinfo, Len(shinfo), _ SHGFI_ICON + SHGFI_LARGEICON) 'ImageList_Draw hImgSmall, shinfo.iIcon, Pic.hdc, 0, 0, imlTransparent Pic.Picture = LoadPicture() DrawIcon Pic.hdc, 0, 0, shinfo.hIcon Pic.Picture = Pic.Image If IsVirtual Then CloseHandle Handle DeleteFile FilePath End IfEnd Sub //Here to usingPrivate Sub MenuEditAttach_Click() FileDlg.FileName = "" FileDlg.ShowOpen On Error GoTo MenuEditAttach_ClickErr If FileDlg.FileName <> "" Then Dim Tools As New ClsFileInfo Tools.Init FileDlg.FileName, False Tools.GetLargeIcon PicTmp FileIcons.ListImages.Add , FileDlg.FileName, PicTmp lstAttch.ListItems.Add , FileDlg.FileName, FileDlg.FileName, FileDlg.FileName, FileDlg.FileName MyMail.Attachs.Add FileDlg.FileName, FileDlg.FileName End If Exit SubMenuEditAttach_ClickErr: If Err.Number = 35602 Then ErrorDlgLog.Report ERROR_MSG_File_Aready_Attached Else ErrorDlgLog.Report Err.Description End If Exit SubEnd Sub

阅读全文(3765) | 回复(0) | 编辑 | 精华

发表评论：

昵称：
密码：
主页：
标题：

验证码： (不区分大小写,请仔细填写,输错需重写评论内容！)