من يك برنامه نوشتم كه از فرمت خاصي تبعيت ميكند مثل xxx
حالا من ميخوام مثل برنامه هاي دگه (media player, jet audio,photoshop)هر جا فرمت برنامه من بود ايكن ان تغيير كنه و با برنامه من با بياد
Printable View
من يك برنامه نوشتم كه از فرمت خاصي تبعيت ميكند مثل xxx
حالا من ميخوام مثل برنامه هاي دگه (media player, jet audio,photoshop)هر جا فرمت برنامه من بود ايكن ان تغيير كنه و با برنامه من با بياد
این کار رو بلد نیستم ولی فکر کنم از رجیستری این کار رو می کنن
File Association
با گوگل دوست باشید.
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
کد:Option Explicit
Private Const REG_SZ As Long = 1
Private Const REG_DWORD As Long = 4
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const ERROR_NONE = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_INVALID_PARAMETER = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259
Private Const KEY_ALL_ACCESS = &H3F
Private Const REG_OPTION_NON_VOLATILE = 0
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Sub CreateAssociation()
Dim sPath As String
CreateNewKey ".xxx", HKEY_CLASSES_ROOT
SetKeyValue ".xxx", "", "MyApp.Document", REG_SZ
CreateNewKey "MyApp.Document\shell\open\command", HKEY_CLASSES_ROOT
SetKeyValue "MyApp.Document", "", "MyApp Document", REG_SZ
sPath = "c:\LongPathname\Myapp.exe %1"
SetKeyValue "MyApp.Document\shell\open\command", "", sPath, REG_SZ
MsgBox "The file association has been made!"
End Sub
Private Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim nValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue & Chr$(0)
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
nValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, nValue, 4)
End Select
End Function
Private Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
Dim hKey As Long
Dim r As Long
r = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hKey, r)
Call RegCloseKey(hKey)
End Sub
Private Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
Dim r As Long
Dim hKey As Long
r = RegOpenKeyEx(HKEY_CLASSES_ROOT, sKeyName, 0, KEY_ALL_ACCESS, hKey)
r = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
Call RegCloseKey(hKey)
End Sub
Private Sub Command1_Click()
CreateAssociation
End Sub
File Association :
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
من كار كردم ولي منظوز منو شما درست نفهميديد
برنامه فوتوشاپ يك فرمت داره به نامه psd ور هرجاي كامپيوتر اين فرمت باشه ايكون فوتوشاپ مياد و با اون باز ميشه منظورم اينه
آقا من هم یک اینجور سوال برایم پیش آمده از دوستان میخواهم که راهنمایی کنند .
بیایید افتخار ایران باشیم .
هرگز بدان چیزی که علم نداری سخن مگو ( مولا علی (ع))
دوست عزیز اون برنامه ای که در پست شماره 5 گذاشتم رو دانلود کن.سپس در قسمت Extension to associate فرمت موردنظرت (XXX) را بنویس و در قسمت Executable to launch associated extension فایل اجرایی که می خوای اون فرمت با آن باز شود را انتخاب کن.
ممنون عالي بود تازه تونستم باهاش كار كنم
تا اينجا كار درست من يك برنامه دارم كه عكس نمايش ميده
و ميخوام حالا كه فرمت من صبت شده با دوبار كليك روي عكس عكس با برنامه من باز بشه
(در اين حالت هيچ اتفاقي نمييفته)
كسي نبود جواب بده
كسي ميتونه كامان ديالوگ مولتي سلكت كنه
نقل قول:کد:Private Sub Command1_Click()
On Error GoTo cError
Dim i As Integer
Dim myFiles() As String
Dim myPath As String
With CommonDialog1
.MaxFileSize = 32000
.CancelError = True
.Filter = "All Files *.*/*.*"
.Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNHideReadOnly
.ShowOpen
myFiles = Split(.FileName, vbNullChar)
Select Case UBound(myFiles)
Case 0
List1.AddItem myFiles(0)
Case Is > 0
For i = 1 To UBound(myFiles)
myPath = myFiles(0) & IIf(Right(myFiles(0), 1) <> "\", "\", "") & myFiles(i)
List1.AddItem myPath
Next i
End Select
End With
Exit Sub
cError:
Beep
MsgBox Err.Description
End Sub
خيلي ممنون
جواب اون سوالو كسي بلد نيست
می تونی اون برنامه ای که عکس نشون میده رو آپلود کنی ، تا ببینم میشه کاری کرد یا نهنقل قول:
اين مثال خيلي ساده است و در حد ياد گرفتن خودم هست
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
این برنامه رو هم آپلودش کننقل قول:
همينه كه اپلود كردم يك مثال ميخوام شايد بعدن بدردم خورد
در ضمن مولتي سلكت رو ميتونيد يك جوري بنويسيد كه تو دو ليست نشون بده يكي نام و ديگري ادرس(من نتونستم)
و يك سوال ديكه تو ليست يكسري ادرس دارم ميخوام روي هر كدوم كه رفتم توي يك تكست فرمت اون فايل رو نشون بدهdat,mp3,bmp,......)
نقل قول:کد:Private Sub Command1_Click()
Dim Fso, FileName
Set Fso = CreateObject("Scripting.FileSystemObject")
On Error GoTo cError
List1.Clear
List2.Clear
Dim I As Integer
Dim myFiles() As String
Dim myPath As String
With CommonDialog1
.MaxFileSize = 32000
.CancelError = True
.Filter = "All Files *.*/*.*"
.Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNHideReadOnly
.ShowOpen
myFiles = Split(.FileName, vbNullChar)
Select Case UBound(myFiles)
Case 0
FileName = Fso.GetBaseName(myFiles(0))
List1.AddItem myFiles(0)
List2.AddItem FileName
Case Is > 0
For I = 1 To UBound(myFiles)
myPath = myFiles(0) & IIf(Right(myFiles(0), 1) <> "\", "\", "") & myFiles(I)
FileName = Fso.GetBaseName(myPath)
List1.AddItem myPath
List2.AddItem FileName
Next I
End Select
End With
Exit Sub
cError:
Beep
MsgBox Err.Description
End Sub
نقل قول:کد:Private Sub List1_Click()
Dim Fso, Extension
Set Fso = CreateObject("Scripting.FileSystemObject")
If List1.Selected(List1.ListIndex) Then
Extension = Fso.GetExtensionName(List1.Text)
Text1.Text = Extension
End If
End Sub
اين كد را كه گزاشتيد من نتونستم باهاش كار كنم يعني ارور ميده (type mismatche)نقل قول:
در ضمن مولتي سلكت رو ميتونيد يك جوري بنويسيد كه تو دو ليست نشون بده يكي نام و ديگري ادرس(من نتونستم)
کدی که نوشتم درسته ؛ کدوم خط رو ارور میگیرهنقل قول:
خط list2.additem filename رو type mismatche ميگيره
MultiSelect CommonDialog :
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
مرسي كاركرد عالي بود