M_P_1374
سه شنبه 29 بهمن 1387, 10:36 صبح
میخوام یه نرم افزار بنویسم که فایل های تکست رو بخونه میخوام فقط کدش تو فرم باشه و ماژول اینجور چیزا رو نداشته باشه حداکثر کدش هم 30 خط باشه نمیخوام فایل سنگین بشه برای لود کردن عکس رو قبلا داشتم ولی نمیتونستم کدش رو برای تکست هم درست کنم
این کد قبلیه که از سایت v-basic.mihanblog.com
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Sub SHChangeNotify Lib "shell32.dll" (ByVal wEventId As Long, ByVal uFlags As Long, dwItem1 As Any, dwItem2 As Any)
Private Sub Form_Load()
Image1.Stretch = True
Image1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
'
RegisterFile ".BMP"
RegisterFile ".JPG"
RegisterFile ".GIF"
RegisterFile ".WMF"
RegisterFile ".EMF"
'
On Error Resume Next
If Len(Command()) > 0 Then
Image1.Picture = LoadPicture(FixPath(Command()))
End If
End Sub
Private Sub RegisterFile(strPasvand As String)
Dim sKeyName As String ' Holds Key Name in registry.
Dim sKeyValue As String ' Holds Key Value in registry.
Dim ret& ' Holds error status if any from API calls.
Dim lphKey& ' Holds key handle from RegCreateKey.
Dim path As String
path = App.path
If Right(path, 1) <> "\" Then
path = path & "\"
End If
' This creates a Root entry called "PicturePreview".
sKeyName = "PicturePreview" ' Project Name
sKeyValue = "Picture"
' This creates a Root entry called .BMP;.JPG;.GIF;.WMF associated with "PicturePreview".
sKeyName = strPasvand
sKeyValue = "PicturePreview" ' Project Name
' This sets the command line for "PicturePreview".
sKeyName = "PicturePreview" ' Project Name
sKeyValue = path & App.EXEName & ".exe %1"
' This sets the icon for the file extension
sKeyName = "PicturePreview" ' Project Name
sKeyValue = path & "MyIcon.ico"
ret& = RegSetValue&(lphKey&, "DefaultIcon", REG_SZ, sKeyValue, MAX_PATH)
' This notifies the shell that the icon has changed
SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0
End Sub
Public Function FixPath(strPath As String) As String
Dim strTemp As String
strTemp = strPath
strChar = """"
If Len(strTemp) > 0 Then
If Mid(strTemp, 1, 1) = strChar Then strTemp = Right(strTemp, Len(strTemp) - 1)
If Mid(strTemp, Len(strTemp), 1) = strChar Then strTemp = Left(strTemp, Len(strTemp) - 1)
End If
FixPath = strTemp
End Function
میشه یه نفر منو راهنمایی کنه
این کد قبلیه که از سایت v-basic.mihanblog.com
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Sub SHChangeNotify Lib "shell32.dll" (ByVal wEventId As Long, ByVal uFlags As Long, dwItem1 As Any, dwItem2 As Any)
Private Sub Form_Load()
Image1.Stretch = True
Image1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
'
RegisterFile ".BMP"
RegisterFile ".JPG"
RegisterFile ".GIF"
RegisterFile ".WMF"
RegisterFile ".EMF"
'
On Error Resume Next
If Len(Command()) > 0 Then
Image1.Picture = LoadPicture(FixPath(Command()))
End If
End Sub
Private Sub RegisterFile(strPasvand As String)
Dim sKeyName As String ' Holds Key Name in registry.
Dim sKeyValue As String ' Holds Key Value in registry.
Dim ret& ' Holds error status if any from API calls.
Dim lphKey& ' Holds key handle from RegCreateKey.
Dim path As String
path = App.path
If Right(path, 1) <> "\" Then
path = path & "\"
End If
' This creates a Root entry called "PicturePreview".
sKeyName = "PicturePreview" ' Project Name
sKeyValue = "Picture"
' This creates a Root entry called .BMP;.JPG;.GIF;.WMF associated with "PicturePreview".
sKeyName = strPasvand
sKeyValue = "PicturePreview" ' Project Name
' This sets the command line for "PicturePreview".
sKeyName = "PicturePreview" ' Project Name
sKeyValue = path & App.EXEName & ".exe %1"
' This sets the icon for the file extension
sKeyName = "PicturePreview" ' Project Name
sKeyValue = path & "MyIcon.ico"
ret& = RegSetValue&(lphKey&, "DefaultIcon", REG_SZ, sKeyValue, MAX_PATH)
' This notifies the shell that the icon has changed
SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0
End Sub
Public Function FixPath(strPath As String) As String
Dim strTemp As String
strTemp = strPath
strChar = """"
If Len(strTemp) > 0 Then
If Mid(strTemp, 1, 1) = strChar Then strTemp = Right(strTemp, Len(strTemp) - 1)
If Mid(strTemp, Len(strTemp), 1) = strChar Then strTemp = Left(strTemp, Len(strTemp) - 1)
End If
FixPath = strTemp
End Function
میشه یه نفر منو راهنمایی کنه