cs_amita
Messages postés151Date d'inscriptionsamedi 17 juillet 2004StatutMembreDernière intervention11 mai 2012
-
22 déc. 2009 à 14:26
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 2021
-
22 déc. 2009 à 14:46
mes ami(e)s svp aidez moi
voici mon code :
je n'arrive pas a récupérer le nom de l'image séléctionner
je ne veux pas récupérer le chemin
mon problème ce situe dans :
Private Function doc_ondblclick() As Boolean
Option Explicit
Private Declare Function GetTempPath _
Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName _
Lib "kernel32" Alias "GetTempFileNameA" _
(ByVal lpszPath As String, _
ByVal lpPrefixString As String, _
ByVal wUnique As Long, _
ByVal lpTempFileName As String) As Long
Private Type BrowseInfo
hwndOwner As Long
pidlRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Dim mDoc As HTMLDocument
Dim imgHeightWidth As Long
Dim imgHeightWidthCont As Long
Dim diff2Images As Long
Dim WithEvents doc As HTMLDocument
Const RIGHT_BUTTON = 2
Public Event DblClick(path1 As String)
Public Event Click(Path As String)
Public Event mouseover(Path As String)
Private FormLoaded As Boolean
Dim alt As String
Dim TempFileName As String
Private Function OpenDirectoryTV(ohwnd As Long, Optional odtvTitle As String) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = odtvTitle
With tBrowseInfo
.hwndOwner = ohwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
OpenDirectoryTV = sBuffer
End If
End Function
Private Sub Command2_Click()
WebBrowser1.Width = WebBrowser1.Width - 60
End Sub
Private Sub Command1_Click()
Dim strPath As String
strPath = OpenDirectoryTV(UserControl.hWnd, "Select image folder")
If Len(Trim(strPath)) = 0 Then Exit Sub
txtAddress.Text = strPath
setPath
End Sub
Private Sub doc_ondataavailable()
MsgBox "downloaded"
End Sub
Private Function doc_onclick() As Boolean
Dim eventObj As IHTMLEventObj
Dim srcName As String
Set eventObj = doc.parentWindow.event
alt = ""
srcName = eventObj.srcElement.tagName
If srcName "IMG" Or srcName "SPAN" Or srcName = "INPUT" Or srcName = "DIV" Then
alt = eventObj.srcElement.getAttribute("ID")
RaiseEvent Click(alt)
End If
End Function
Private Sub doc_onmousedown()
Dim eventObj As IHTMLEventObj
Dim srcName As String
Set eventObj = doc.parentWindow.event
alt = ""
srcName = eventObj.srcElement.tagName
End Sub
Private Sub doc_onmouseover()
Dim eventObj As IHTMLEventObj
Dim srcName As String
Set eventObj = doc.parentWindow.event
alt = ""
srcName = eventObj.srcElement.tagName
If srcName "IMG" Or srcName "SPAN" Or srcName = "INPUT" Or srcName = "DIV" Then
alt = eventObj.srcElement.getAttribute("ID")
RaiseEvent mouseover(alt)
End If
' FrmInternet.Text3 = alt
' File1.list (i)
'Dim i
'Dim id As String
'For i = 0 To File1.ListCount - 1
' FrmInternet.Text3 = File1.list(i)
' Next i
End Sub
Private Sub txtAddress_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
setPath
End If
End Sub
txtAddress.Text = App.Path
Set mDoc = New HTMLDocument
WebBrowser1.Navigate2 "about:blank"
'setPath
End Sub
Public Sub SetLocation(mFolder As String)
txtAddress.Text = mFolder
setPath
End Sub
Private Sub setPath()
Dim ImageFolderPath As String
Dim mDocContents As String
ImageFolderPath = txtAddress.Text
CreateFile (ImageFolderPath)
'Picture1.Enabled = False
If PathExists(ImageFolderPath) Then
WebBrowser1.Navigate2 "file:///" & TempFileName
End If
End Sub
Private Function CreateFile(ImageFolderPath As String) As String
Dim retValue As String
Dim TempFile As String
Dim i As Integer
Dim ID As String
If Not PathExists(ImageFolderPath) Then
MsgBox "Path does not exists", vbCritical, "Path Error"
Exit Function
End If
Open TempFileName For Output As #1
Print #1, retValue
Close #1
End Function
Private Sub UserControl_Resize()
On Error Resume Next
' txtAddress.Move 0, 0, ScaleWidth - Command1.Width - 60, txtAddress.Height
' Command1.Move txtAddress.Left + txtAddress.Width + 30, 0
' WebBrowser1.Move 0, 0, UserControl.Width, UserControl.Height - WebBrowser1.Top
WebBrowser1.Move 0, 0, UserControl.Width, UserControl.Height
End Sub
Public Property Get ImageHeightWidth() As Variant
ImageHeightWidth = imgHeightWidth
End Property
Public Property Let ImageHeightWidth(ByVal vNewValue As Variant)
If vNewValue < 50 Then vNewValue = 50
imgHeightWidth = vNewValue
End Property
Private Sub UserControl_Terminate()
On Error Resume Next
Kill TempFileName
End Sub
Private Sub WebBrowser1_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)
On Error Resume Next
'Clear the selection
If FormLoaded Then
WebBrowser1.ExecWB OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DONTPROMPTUSER
End If
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
FormLoaded = True
Set doc = WebBrowser1.Document
UserControl.MousePointer = vbNormal
UserControl.Enabled = True
End Sub
Private Function PathExists(mPath As String) As Boolean
On Error GoTo errh
File1.Path = mPath
PathExists = True
Exit Function
errh:
PathExists = False
End Function
Public Function GetSystemTempPath() As String
Dim result As Long
Dim buff As String
buff = Space$(MAX_PATH)
result = GetTempPath(MAX_PATH, buff)
GetSystemTempPath = Left$(buff, result)
End Function
Private Function doc_ondblclick() As Boolean
Dim eventObj As IHTMLEventObj
Dim srcName As String
Set eventObj = doc.parentWindow.event
alt = ""
srcName = eventObj.srcElement.tagName
If srcName "IMG" Or srcName "SPAN" Or srcName = "INPUT" Or srcName = "DIV" Then
alt = eventObj.srcElement.getAttribute("ID")
