Не получается поиск в комбо - CB_FINDSTRINGEXACT

[giaber]

Пытаюсь сделать поиск в комбобоксе – никак не выходит:

Код: Выделить всё

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const CB_FINDSTRING = &H14C 'поиск чувствителен к регистру
Private Const CB_FINDSTRINGEXACT = &H158 'поиск не чувствителен к регистру

Dim strPath As String
Dim YesNo   As Byte
‘-----------------------------
Private Sub Form_Load()
     
    Combo1.AddItem "one"
    Combo1.AddItem "two"
    Combo1.AddItem "three"
   
    'Здесь вставьте какую-нибудь свою директорию
    Combo1.AddItem "C:\Users\GiaBer\Desktop\AAA"
   
    Combo1.AddItem "four"
    Combo1.AddItem "five"
    Combo1.AddItem "six"

End Sub

Private Sub Command1_Click()

‘выбираем директорию
    With CommonDialog1
        .CancelError = True
        .DialogTitle = "Select Folders"
        .Filter = "All files (*.*)|*.*"
        .FileName = "Select Folder"
        .InitDir = "c:\"
        .Flags = cdlOFNHideReadOnly
        On Error GoTo NoFileOpened
        .ShowSave
        strPath = Left(.FileName, Len(.FileName) - Len(.FileTitle))
NoFileOpened:
    End With
    '
    Text1 = strPath ' лучше один раз увидеть чем 100 раз услышать
   
    YesNo = SendMessage(Combo1.hwnd, CB_FINDSTRINGEXACT, -1, strPath)
    Text2 = YesNo’смотрим нашлось в комбо или нет


    If YesNo = -1 Then 'если в комбо такого нет - добавляем
        Combo1.AddItem strPath, 0
        Combo1.ListIndex = 0
    Else
        Combo1.ListIndex = YesNo
    End If

End Sub


Несмотря на то что в комбо есть строка совпадающая с полученным из CommonDialog-а strPath-ом SendMessage возвращает 0 (YesNo =0)
Что я не так делаю, подскажите пожалуйста

ЗЫ
Не получается и с CB_FINDSTRINGEXACT и с CB_FINDSTRING
Причём, еслия цепляю на другой баттон:

Код: Выделить всё

strPath = Text3.Text
YesNo = SendMessage(Combo1.hwnd, CB_FINDSTRINGEXACT, -1, strPath)

ввожу в Text3 строки, которые есть в комбо - всё исправно работает, и если ввожу строку "C:\Users\GiaBer\Desktop\AAA" - тоже нормально находит её в комбо, то есть именно при получении строки из диалого не находит

[pronto]

В конец строки из диалога может быть подставлен символ с кодом 0 (ноль). Он используется диалогом для разделения нескольких имён файлов, если их было выбрано несколько. В любом случае нужно проверить его наличие и, если что, обрезать строку.
Настораживает тип переменной YesNo — Byte. Этот тип не является знаковым, т.е. попытка присвоить значение со знаком минус приведёт к ошибке. Используй Long.

[giaber]

Ой деби-и-и-и-л! Ожидаю от SendMessage -1 и в тоже время присваиваю тип Byte! Просто слов нет! Ща попробую изменить всё, как ты сказал

[giaber]

Ничего не помогло - проблемы остались те же.
Решил сменить CommonDialog на SHBrowseForFolder API function with a callback. Скопировал такое:
'=====================================================================================

Код: Выделить всё

' Browse for a Folder using SHBrowseForFolder API function with a callback
' function BrowseCallbackProc.
'
' This Extends the functionality that was given in the
' MSDN Knowledge Base article Q179497 "HOWTO: Select a Directory
' Without the Common Dialog Control".
'
' After reading the MSDN knowledge base article Q179378 "HOWTO: Browse for
' Folders from the Current Directory", I was able to figure out how to add
' a callback function that sets the starting directory and displays the
' currently selected path in the "Browse For Folder" dialog.
'
' I used VB 6.0 (SP3) to compile this code.  Should work in VB 5.0.
' However, because it uses the AddressOf operator this code will not
' work with versions below 5.0.
'
' This code works in Window 95a so I assume it will work with later versions.
'
' Stephen Fonnesbeck
' steev@xmission.com
' http://www.xmission.com/~steev
' Feb 20, 2000
'
'=====================================================================================
' Usage:
'
'    Dim folder As String
'    folder = BrowseForFolder(Me, "Select A Directory", "C:\startdir\anywhere")
'    If Len(folder) = 0 Then Exit Sub  'User Selected Cancel
'
'=====================================================================================

Option Explicit

Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
'=================
'this 2 lines added by myself (George)
Private Const BIF_EDITBOX = &H10&
Private Const BIF_NEWDIALOGSTYLE = &H40&
'=================
Private Const MAX_PATH = 260

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
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

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 m_CurrentDirectory As String   'The current directory
'

Public Function BrowseForFolder(owner As Form, Title As String, StartDir As String) As String
    'Opens a Treeview control that displays the directories in a computer

    Dim lpIDList    As Long
    Dim szTitle     As String
    Dim sBuffer     As String
    Dim tBrowseInfo As BrowseInfo
    m_CurrentDirectory = StartDir & vbNullChar

    szTitle = Title
    With tBrowseInfo
        .hWndOwner = owner.hWnd
        .lpszTitle = lstrcat(szTitle, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_EDITBOX + BIF_NEWDIALOGSTYLE 'BIF_STATUSTEXT not work with BIF_EDITBOX + BIF_NEWDIALOGSTYLE
        '  .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT - original variant
        .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)  'get address of function.
    End With

    lpIDList = SHBrowseForFolder(tBrowseInfo)
    If (lpIDList) Then
        sBuffer = Space(MAX_PATH)
        SHGetPathFromIDList lpIDList, sBuffer
'!!! в этой строке возникает проблема:
        sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
        BrowseForFolder = sBuffer
    Else
        BrowseForFolder = ""
    End If
 
End Function

Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
 
    Dim lpIDList As Long
    Dim ret      As Long
    Dim sBuffer  As String
 
    On Error Resume Next  'Sugested by MS to prevent an error from
    'propagating back into the calling process.
     
    Select Case uMsg
 
        Case BFFM_INITIALIZED
            Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
     
        Case BFFM_SELCHANGED
            sBuffer = Space(MAX_PATH)
     
            ret = SHGetPathFromIDList(lp, sBuffer)
            If ret = 1 Then
                Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
            End If
     
    End Select
 
    BrowseCallbackProc = 0
 
End Function

' This function allows you to assign a function pointer to a vaiable.
Private Function GetAddressofFunction(add As Long) As Long
    GetAddressofFunction = add
End Function

' Usage:

Код: Выделить всё

Option Explicit

Private getdir As String
'
Private Sub Form_Load()
    Text1.Text = "N:\Visual Basic\! My VB progs\PicCut\ÐÀÁÎ×ÈÅ ÂÀÐÈÀÍÒÛ\PicSword\PicSword Source" 'CurDir
End Sub

Private Sub Command1_Click()   
    getdir = BrowseForFolder(Me, "Select A Directory", Text1.Text)
    If Len(getdir) = 0 Then Exit Sub  'user selected cancel
    Text2.Text = getdir   
End Sub

Изменил:

Код: Выделить всё

.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT - original variant
на
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_EDITBOX + BIF_NEWDIALOGSTYLE

Проблема:
Когда делаю как отдельный проект - всё нормально работает. При переносе в мой проект выдаёт "Expected array" в строке:

Код: Выделить всё

sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)

и выделяет Left

В чём может быть проблема? 4 часа уже сижу- не могу разобраться.

[pronto]

В sBuffer точно есть нулевой символ?
Я бы этот участок записал так:

Код: Выделить всё

NullCharPos% = InStr(1, sBuffer, vbNullChar)
If NullCharPos% Then sBuffer = Left$(sBuffer, NullCharPos% - 1)

Вот малость усовершенствованный диалог выбора папки

[giaber]

pronto, спасибо большое! Очень круто наворочено и спервого взгляда вроде ясно, как получить варианты используя "BIF_..." . Но не смог добиться нужного мне результата:
вставил BIF_USENEWUI
WhatBr:=BIF_RETURNONLYFSDIRS Or BIF_STATUSTEXT Or BIF_USENEWUI,

при ChangeSize:= True обрезается нижний край и ни одной кнопки не видно, при ChangeSize:= False всё нормально, но не центруется по экрану - нижний край уходит вниз за пределы экрана, я пытался поиграть со значениями в Sub ResizeDialog и в Sub CenterDialog, логика там вроде очевидная, но не добился никакого результата, видимо моя ламерская мозга не догоняет чего-то как всегда.

[giaber]

pronto, с твоим вариантом та же проблема! ругается на Left$:

Код: Выделить всё

If iNull Then sPath = Left$(sPath, iNull - 1)

Это в Public Function fBrowseForFolder(...), в самом конце, когда убирается Null в конце строки

сообщение выдаёт такое:
Compile error:
Type-declaration character does not match declared data type

Причём опять - отдельным проектом - всё ОК, а перенесённое копи-пастом в мой проект - проблема.

UPD
Ща подумал - а чё я мечусь - может сделать наоборот - не модуль от pronto переносить в мой проект, а к новому проекту в котором это всё работает прицепить мои 3 формы, модули и код?

[pronto]

Из этого следует вывод, что проблема с твоим проектом. Сообщение об ошибке: Идентификатор типа не соответствует объявленному типу. Идентификатор типа — это специальный знак после имени объявляемой переменной, что позволяет сократить запись Dim i as Long до Dim i&. Скорее всего, где-то объявлена ещё одна переменная с таким же именем. Кандидаты: Left, sPath, iNull.
UPD. Поиск лучше всего делать с помощью Object Browser (F2). Ну, и не забывать про гуглы

[pronto]

Со стилем BIF_USENEWUI функция EnumThreadWndProc, которая вмешивается в размеры и положение элементов вообще не нужна.

[giaber]

Скорее всего, где-то объявлена ещё одна переменная с таким же именем

- разве Option Explicit не выявляет коллизии такого рода?

Гугл не дал никаких ответов.

Поскольку поиск дублированных переменных ничего не дал, решил строки с Left$ через Mid$ -диалог стал появляться на экране, но всё равно зависало и выходило то же сообщение. Заменил и Right$ на Mid и всё наконец заработало.
Начну пробовать CB_FINDSTRINGEXACT

UPD
Кстати, насчёт того, что ругается на Left$ и Right$ - в любом другом месте проекта Left$ принимается без проблем, и только Left$ внутри модуля диалога выбора директории не принимается. Это как нибудь сужает круг поиска проблемы?

.

[giaber]

После замены Left$ и Right$ на Mid$ - теперь на строку YesNoLong = SendMessage(frmSliced.cmbSaveFolderPath.hWnd, CB_FINDSTRING, -1, strSavePath) ругается: Ambiguous name detected:SendMessage

[Хакер]

После замены Left$ и Right$ на Mid$ - теперь на строку YesNoLong = SendMessage(frmSliced.cmbSaveFolderPath.hWnd, CB_FINDSTRING, -1, strSavePath) ругается: Ambiguous name detected:SendMessage

Ну и? Что мешает устранить name ambiguity? Непонимание того, что это такое?

Более того, где размещён код YesNoLong = SendMessage(frmSliced.cmbSaveFolderPath.hWnd, CB_FINDSTRING, -1, strSavePath)? Не дай бог в форме.

[giaber]

Здравствуйте, Хакер!
Извините за поздний ответ - вчера нездоровилось, пост-инсультник я теперь ...

Непонимание того, что это такое?

Поскольку ранее мне такое выскакивало, если я по невнимательности второй раз объявлял переменную, которая уже была объявлена - я это так буквально и понимал, типа: «Детектировано подобное имя». Убирал одно из двух объявлений и проблема решалась. Это неправильное понимание? Хотя, скажу честно, дословный перевод (к стыду моему) только сейчас посмотрел - после прочтения вашего замечания. ambiguity оказалось "неоднозначность". Ну, то есть в принципе, по сути ситуации я близко смысл уловил вроде.

Что мешает устранить name ambiguity?

Поиском по всему проекту ищу Left, sPath, iNull – дупликатов не находится. Только оператор Left со строками несколько раз используется. Что-то надо сделать, чего я не знаю?

Не дай бог в форме

Хакер, я с вашим замечаний каждый раз офигеваю – в хорошем смысле, вдруг осознаёшь, что то, что казалось правильным, естесственным, обыденным – имеет совсем другой уровень причин-следствий, со всей чёткостью встаёт факт, что я «тварь дрожащая, безмозглая» и всё такое … Сотни скачанных примеров и прочитанных кусков кода не давали мне возможности думать по другому – в 95% случаев АПИ-функции объявляются в Модуле и используются из формы. Никак не мог предположить что это неправильная методика. Прошу вас – объясните порочность этого подхода и собственно, а как мне реализовать поиск в комбо, если мне это нужно в процессе исполнения кода формы?

[alibek]

Поиском по всему проекту ищу Left, sPath, iNull – дупликатов не находится

Shift+F2

[alibek]

разве Option Explicit не выявляет коллизии такого рода?

Option Explicit не позволит использовать необъявленную переменную.

[giaber]

alibek

Shift+F2

выдало такое:

Код: Выделить всё

Const Left = 1
Member of PicButtonControl.PosHor
Left

То есть как я понимаю своим скудным умишкой - в э том контроле объявлено Left как константа и отсюда конфликт? Убирание контрола из проекта исправило ситуацию, да, но не понимаю, почему когда Left$ исполняется не раз в теле программы - конфликта нет, ведь Left и в форме и в модуле используется как встроенный оператор VB? И ещё в этом проекте в другом модуле у меня есть

Код: Выделить всё

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

почему это не конфликтует?

ЗЫ
Я понимаю возможное (и справедливое) возмущение (особенно некоторых весьма уважаемых мною персон:) ) - но реально, я очень плохо знаю и понимаю VB, я ни в коем разе не программист, я не изучаю VB - это просто моё развлечение - отсюда мои абсолютно фрагментарные знания. Простите дурака!

[giaber]

Ну, в общем, убрал я этот контрол из проекта – конфликта теперь нет. SHBrowseForFolder API выложеный pronto работает как часы. Но поиск в комбо при помощи CB_FINDSTRINGEXACT всё равно не выходит. Получилось так:

Код: Выделить всё

    stringTMP  получаю из BrowseForFolder(бла-бла-бла)
    If Len(stringTMP) = 0 Then Exit Sub  'user selected cancel
        frmSliced.Text1 = stringTMP
    YesNoLong = SendMessage(frmSliced.cmbSaveFolderPath.hWnd, CB_FINDSTRINGEXACT, -1, frmSliced.Text1.Text)

То есть сперва путь, полученый от SHBrowseForFolder API, запихиваю в текстбох, и взятый из текстбокса стринг нормально ищется. Ну, догадываюсь, что наверное какие-то «лишние» знаки есть в строке и они при попадании в текстбокс «убираются». Не знаю что это – отсечение vbNullChar и так делается в том коде, которым поделился pronto. Что ещё может быть?

PS
Хакер, будьте так добры черкните в двух словах насчёт неправильности вызова из формы SendMessage - CB_FINDSTRINGEXACT, интересно очень, помогите расширить кругозор!