Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 | 2 | 3 | 4 |

 

  Вопрос: Как определить Handle Label-a? Добавлено: 31.12.06 16:58  

Автор вопроса:  Tur | ICQ: 201446364 

Ответить

  Ответы Всего ответов: 48  

Номер ответа: 16
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
 Web-сайт: sharpc.livejournal.com
 Профиль | | #16
Добавлено: 02.01.07 04:33
Если тебе что-то стало лень дописывать - это разве ограничение? Нужен тебе полупрозрачный лабел - ну так и пиши отрисовку сам.

Ответить

Номер ответа: 17
Автор ответа:
 Tur



ICQ: 201446364 

Вопросов: 22
Ответов: 72
 Профиль | | #17 Добавлено: 02.01.07 11:12
Sharp, я не знаю как это сделать. Я это и спросил с самого начала, на что мне было сказано, что это невозможно, т.к. нет такой апи, я усомнился и в ответ получил: "не ной" и "лень". А я спашиваю по-существу: как мне решить свою проблему: сделать полу-прозрачным окно не верхнего уровня? Ведь т.к. у лабела есть крайности прозрачности - значит это должно быть возможно.

Ответить

Номер ответа: 18
Автор ответа:
 -АлександР-



Вопросов: 55
Ответов: 1008
 Web-сайт: sham.clan.su
 Профиль | | #18
Добавлено: 02.01.07 16:52
ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
ret = ret Or WS_EX_LAYERED
SetWindowLong Me.hWnd, GWL_EXSTYLE, ret
Здесь я меняю стиль окна на прозрачный

ret = SetParent(Form2.hwnd, Form1.hwnd)
ret у меня возвращает стиль, а функция setparent - дискриптор.
если будешь использовать АПИ в том же духе, то такие резульаты и будешь получать

Ответить

Номер ответа: 19
Автор ответа:
 -АлександР-



Вопросов: 55
Ответов: 1008
 Web-сайт: sham.clan.su
 Профиль | | #19
Добавлено: 02.01.07 16:58
ret = SetParent(Form2.hwnd, Form1.hwnd)

то увидишь проблему: все дрожит и трепещет.
это значит, что ты присвоил окну стиль хрен какой ,вот он и дрожит

Я тебе советую приобрести хоть какой-нибудь АПИ-справочник, чтобы понимать, что делаешь

Неясно также для чего использовать GetCursorPos, кода есть Form_MouseDown и Form_MouseMove с текущей точкой.
АПИ всегда хоть на малую долю секунды быстрее - чтоб меньше тормозов было

пикчебокс это окно или нет?
Конечно окно, и TextBox - окно, и Button - окно, а лэйбел - не окно(((((

Т.е. я не могу себя убедить что Windows сделан так что это нельзя.
Я все больше убеждаюсь, что это не windows так сделан, а VB6 (

Ответить

Номер ответа: 20
Автор ответа:
 -АлександР-



Вопросов: 55
Ответов: 1008
 Web-сайт: sham.clan.su
 Профиль | | #20
Добавлено: 02.01.07 17:00
Sharp, осторожней!

Нужен тебе полупрозрачный лабел - ну так и пиши отрисовку сам.
за свои слова отвесать придется...
как ты его средствами АПИ?

Ответить

Номер ответа: 21
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
 Web-сайт: sharpc.livejournal.com
 Профиль | | #21
Добавлено: 02.01.07 22:47
Ведь т.к. у лабела есть крайности прозрачности - значит это должно быть возможно.

Это не крайности. Просто в одном случае рисуется только текст, а во втором еще и серый прямоугольник под ним.
Отрисовывать полупрозрачный лабел самому - это значит получить битмап диси формы, покомпонентно сложить составляющие цвета для каждого пиксела, разделить на 2 (ну или с коэффициентами), сунуть их обратно в битмап и отрисовать его там, где нужно.

Ответить

Номер ответа: 22
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
 Профиль | | #22 Добавлено: 02.01.07 23:01
Нормально он сделан, скажи спасибо что хоть запускается.
Зачёт! Реально факт!

Да, хендела у лабела нет... но дык кто здесь ищет легкие пути?
Option Explicit

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const VBM_WINDOWTITLEADDR = &H1091
Private Declare Function SendMessage Lib "USER32.DLL" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, wParam As Any, lParam As Any) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const PROCESS_VM_READ = (&H10)
Private Const PROCESS_VM_WRITE = (&H20)
Private Const PROCESS_VM_OPERATION = (&H8)
Private Const PROCESS_QUERY_INFORMATION = (&H400)
Private Const PROCESS_READ_WRITE_QUERY = PROCESS_VM_READ + PROCESS_VM_WRITE + PROCESS_VM_OPERATION + PROCESS_QUERY_INFORMATION
Private Const MEM_PRIVATE = &H20000
Private Const MEM_COMMIT = &H1000

Private Type MEMORY_BASIC_INFORMATION ' 28 bytes
    BaseAddress As Long
    AllocationBase As Long
    AllocationProtect As Long
    RegionSize As Long
    State As Long
    Protect As Long
    lType As Long
End Type
Private Declare Function VirtualQueryEx& Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, lpBuffer As MEMORY_BASIC_INFORMATION, ByVal dwLength As Long)
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
 
Private abBuffer() As Byte 'Heap Buffer
Private hProcess As Long
Private lBaseAddress As Long

Public Sub GetFormLabels(hwnd As Long)
    Dim sClass As String
    Dim lRet As Long
    Dim pid As Long
    Dim lFormCaptionHeapAddress As Long
    
    Dim lpMem As Long
    Dim lLenMBI As Long
    Dim lBytesRead As Long
    Dim mbi As MEMORY_BASIC_INFORMATION
    
    'Make sure we are working with a VB Form hWnd
    sClass = Space(256)
    lRet = GetClassName(hwnd, sClass, 255)
    sClass = Left(sClass, lRet)
    If Not sClass = "ThunderRT6FormDC" Then
        MsgBox "This function only works on VB RunTime 6 Forms ThunderFormRT6DC"
        Exit Sub
    End If
    
    'Now get the internal heap address of the form caption.  All that we need can be found in this heap (hopefully!)
    'This is done with a little undocumented SendMessage magic
    lFormCaptionHeapAddress = SendMessage(hwnd, VBM_WINDOWTITLEADDR, ByVal 0&, ByVal 0&;)
    
    'Get a handle on the process with required access
    lRet = GetWindowThreadProcessId(hwnd, pid)
    If pid = 0 Then
        MsgBox "Unable to determine pid of this hwnd."
        Exit Sub
    End If
    hProcess = OpenProcess(PROCESS_READ_WRITE_QUERY, False, pid)
    
    'Get the Heap at the caption point
    lLenMBI = Len(mbi)
    lpMem = lFormCaptionHeapAddress
    mbi.AllocationBase = lpMem
    mbi.BaseAddress = lpMem
    lRet = VirtualQueryEx(hProcess, ByVal lpMem, mbi, lLenMBI)
    If lRet <> lLenMBI Then GoTo Finished
    
    'Now go back and get the entire heap
    lBaseAddress = mbi.AllocationBase
    lpMem = lBaseAddress
    mbi.BaseAddress = lBaseAddress
    mbi.RegionSize = 0
    lRet = VirtualQueryEx(hProcess, ByVal lpMem, mbi, lLenMBI)
    If lRet <> lLenMBI Then GoTo Finished
    
    'A couple of sanity checks, just to be safe
    If Not ((mbi.lType = MEM_PRIVATE) And (mbi.State = MEM_COMMIT) And mbi.RegionSize > 0) Then
        MsgBox "Unexpected Heap Type, State, or Size."
        GoTo Finished
    End If
    
     'Allocate a buffer and read it in
    ReDim abBuffer(mbi.AllocationBase To mbi.AllocationBase + mbi.RegionSize - 1)
    ReadProcessMemory hProcess, ByVal mbi.BaseAddress, abBuffer(LBound(abBuffer)), mbi.RegionSize, lBytesRead
    
    'So far, so good.  Things get messy from here.  We have to
    'do some manual parsing of the buffer to get what we are after.  To
    'make things easier, I'll will get every label on every form in the
    'exe.  Otherwise, you will need to first find the form that is
    'reference the caption.  Then find every label between it and the next
    'form.
    
    Dim iCnt As Integer
    Dim al() As Long
    
    'Print all of the label captions
    If EnumVBObjectPtrs("VB.Label", 44, al) > 0 Then
        For iCnt = LBound(al) To UBound(al)
            MsgBox "Hit at: " & Hex(al(iCnt) + 44) & " Object At: " & Hex(al(iCnt)) & " " & GetLabelCaption(al(iCnt)) & " " & GetLabelName(al(iCnt))
        Next iCnt
    End If
    
Finished:
    CloseHandle hProcess
    abBuffer() = ""
End Sub

Private Function GetLabelName(lpObjPtr As Long) As String
    Dim lpMem As Long
    Dim lLenMBI As Long
    Dim lBytesRead As Long
    Dim mbi As MEMORY_BASIC_INFORMATION
    Dim lRet As Long
    Dim ab() As Byte
    Dim lStrPtr As Long
    Dim lInfoPtr As Long

    'Get the local pointer to object info
    CopyMemory lInfoPtr, abBuffer(lpObjPtr + 60), 4
    
    'Get the pointer to label name
    CopyMemory lStrPtr, abBuffer(lInfoPtr + 4), 4

    'Get the EXE at the name point
    lLenMBI = Len(mbi)
    lpMem = lStrPtr
    mbi.AllocationBase = lpMem
    mbi.BaseAddress = lpMem
    lRet = VirtualQueryEx(hProcess, ByVal lpMem, mbi, lLenMBI)
    If lRet <> lLenMBI Then Exit Function
    
    'Read in the EXE Heap
    ReDim ab(0 To mbi.RegionSize - 1)
    ReadProcessMemory hProcess, ByVal mbi.BaseAddress, ab(LBound(ab)), mbi.RegionSize, lBytesRead
    
    GetLabelName = StrConv(MidB(ab, lStrPtr - mbi.BaseAddress + 1, 260), vbUnicode)
    GetLabelName = Left$(GetLabelName, InStr(GetLabelName, vbNullChar) - 1)
End Function

Private Function GetLabelCaption(lpObjPtr As Long) As String
    Dim lStrPtr As Long

    'Get local pointer to caption
    CopyMemory lStrPtr, abBuffer(lpObjPtr + 136), 4
    
    'Get caption
    If lStrPtr <> 0 Then
        GetLabelCaption = StrConv(MidB(abBuffer, lStrPtr - lBaseAddress + 1, 260), vbUnicode)
    End If
    GetLabelCaption = Left$(GetLabelCaption, InStr(GetLabelCaption, vbNullChar) - 1)
End Function

'This function will search the buffer for a given VBObjectIDString, then
'find the start of that control by searching for a refence to it in the 600
'bytes prior.
'It then finds any object of that type by searching the buffer for any
'references to the Heap Location of that control, and adds it to the enumeration
'if the reference hit position is at the correct offset (pos-offset = lBaseAddress)
'setting the EnumObj entry to the start location (local buffer address) and
'returns the counrt
Private Function EnumVBObjectPtrs(VBObjectIDString As String, _
                                  lOffset As Long, _
                                  EnumObj() As Long) As Integer
    Dim abObjectPtr(0 To 3) As Byte 'LittleEndian byte array of the Heap Address of the VBObject
    Dim abBaseAddress(0 To 3) As Byte 'LittleEndian byte array of the Heap Base Memory Address
    Dim abLong(0 To 3) As Byte 'Byte array for ptr manipulation
    Dim lPtr As Long 'Buffer pointer for search hits
    Dim iCnt As Integer
    Dim alRet() As Long
    
    'Find the location of the VBObjectIDString string
    lPtr = InStrB(1, abBuffer, StrConv(VBObjectIDString, vbFromUnicode)) - 1
    If lPtr = -1 Then Exit Function
    lPtr = lBaseAddress + lPtr
    
    'We now need to find the location that points to the start of the object
    'which should be 244 bytes prior (on XP at least) we go back 600 just in
    'case.  This is at offset 36, so we'll need to adjust back to the beginning
    'of the object
    CopyMemory abLong(0), lPtr, 4
    lPtr = InStrB(lPtr - lBaseAddress - 600, abBuffer, abLong) - 1
    If lPtr = -1 Then Exit Function
    lPtr = lPtr + lBaseAddress - 36 'Adjust back to the beginning of the object
    CopyMemory abObjectPtr(0), lPtr, 4
    
    'Turn the lBaseAddress into LittleEndian byte array for searching
    CopyMemory abBaseAddress(0), lBaseAddress, 4
    
    'Loop through the buffer
    lPtr = 1
    Do Until lPtr = 0
        'Find a reference to this object
        lPtr = InStrB(lPtr, abBuffer, abObjectPtr)
        If lPtr > 0 Then
            'make sure that this is really a VB object
            'move back from the offset of the object
            'and make sure that it has the correct base memory value
            If InStrB(lPtr - lOffset - 1, abBuffer, abBaseAddress) = lPtr - lOffset Then
                ReDim Preserve alRet(0 To iCnt)
                alRet(iCnt) = lPtr + lBaseAddress - lOffset - 1
                iCnt = iCnt + 1
            End If
            'Keep searching from the next byte
            lPtr = lPtr + 1
        End If
    Loop
    
    EnumVBObjectPtrs = iCnt
    EnumObj = alRet
End Function

Private Sub Form_Load()
GetFormLabels Me.hwnd
End Sub


С полупрозрачностью - незавидую :) Хотя нет ничего невозможного :) Ну например чё если перерисовать лабел по точкам, учитывая какой должен получится цвет с прозрачностью... Ну только неподумайте что для перерисовки лабела надо отталкиваться от этого примера :) Лабел создайте юзерконтролом, контрол прозранчый оставите, лабел на него пусть вообще невидимый, и самому вычислять цвет прозрачности и рисовать текст :)

Ответить

Номер ответа: 23
Автор ответа:
 -АлександР-



Вопросов: 55
Ответов: 1008
 Web-сайт: sham.clan.su
 Профиль | | #23
Добавлено: 02.01.07 23:18
HUCKER
This function only works on VB RunTime 6 Forms ThunderFormRT6DC
А что это за класс такой?

Sharp
Отрисовывать полупрозрачный лабел самому - это значит получить битмап диси формы, покомпонентно сложить составляющие цвета для каждого пиксела, разделить на 2 (ну или с коэффициентами), сунуть их обратно в битмап и отрисовать его там, где нужно.
А, ну да. РУЛИТ. Наверно единственное правильное решение, правда трудоемкое ИМХО -> медленнее будет работать. Попиксельная работа всегда медленная в вб6, это особенно заметно будет (правда в зависимости от размеров "лэйбла"


2HUCKER
Лабел создайте юзерконтролом, контрол прозранчый оставите, лабел на него пусть вообще невидимый, и самому вычислять цвет прозрачности и рисовать текст :)
контрол нельзя сделать полупрозрачным

Ответить

Номер ответа: 24
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
 Профиль | | #24 Добавлено: 02.01.07 23:24
Я же писал тебе уже - юзай WPF, будешь просто впечатлен возможностями.

Ответить

Номер ответа: 25
Автор ответа:
 -АлександР-



Вопросов: 55
Ответов: 1008
 Web-сайт: sham.clan.su
 Профиль | | #25
Добавлено: 02.01.07 23:29
Я же писал тебе уже - юзай WPF
А что это и с чем его кушать?
Может ссылкой поделишься?

Ответить

Номер ответа: 26
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
 Профиль | | #26 Добавлено: 02.01.07 23:42
Windwos Presentation Foundation
http://msdn2.microsoft.com/en-us/netframework/aa663326.aspx
http://en.wikipedia.org/wiki/Windows_Presentation_Foundation
http://ru.wikipedia.org/wiki/Windows_Presentation_Foundation (очень кратно но на русском)
Это первое реальное обновление технологической среды пользовательского интерфейса со времени выпуска Windows 95. Оно включает новое ядро, которое должно заменить GDI и GDI+, используемые в нынешней Windows-платформе. WPF представляет собой высокоуровневый объектно-ориентированный функциональный слой (framework), позволяющий создавать 2D- и 3D-интерфейсы. Сейчас его можно назвать альтернативным вариантом DHTML и JavaScript, используемым в Web-разработке применительно к Windows Forms. Но в будущем WPF должен объединить Windows и Web-разработку (в том числе AJAX).


Все необходимые инструменты можно найти здесь:
http://vbnet.ru/forum/show.aspx?id=122080

Ответить

Номер ответа: 27
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
 Профиль | | #27 Добавлено: 02.01.07 23:44
ну типо в IDE неработает, компиль exe...

Ответить

Номер ответа: 28
Автор ответа:
 Tur



ICQ: 201446364 

Вопросов: 22
Ответов: 72
 Профиль | | #28 Добавлено: 03.01.07 00:23
Спасибо всем за такое внимание!

HACKER, что этот код делает? У меня выдается такое сообщение:
This function only works on VB RunTime 6 Forms ThunderFormRT6DC
и на этом все кончается.

Sharp, спасибо за идею, но я это делать не буду. Дело в том что этот лабел у меня 0.01% от программы. Это так для удобства и красоты. Я уже сделал с обычным прозрачным лабелом. Получилось сносно, но работает.

Brand, все или почти все что я пишу - это логика, математика, обработка сигналов. вб6 здесь очень удобен. Красоты всякой типа полу-прозрачности нет или почти нет. Я двигаюсь вообще в направлении матлаба. Ты думаешь что WPF был бы мне удобен и необходим?
Вот я взглянул сюда http://blogs.gotdotnet.ru/personal/e-zolotko/PermaLink.aspx?guid=D6BCF992-32AE-495D-88F8-0501D35C3577 и что то во мне увяло.

Новый вопрос(в обход старого, его др решение):
Пользователь схватил мышкой за заголовок форма и двигает его. Как не загружая таймером слишком программу отследить перемещение этого форма, т.е получать его новые координаты? Где или как фиксируется нажатие мышкой на заголовок форма? Не вообще нажатие, а на заголовок,т.е. на синюю полосу вверху, где написано Form1

Ответить

Номер ответа: 29
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
 Профиль | | #29 Добавлено: 03.01.07 00:34
Brand, все или почти все что я пишу - это логика, математика, обработка сигналов. вб6 здесь очень удобен. Красоты всякой типа полу-прозрачности нет или почти нет. Я двигаюсь вообще в направлении матлаба.

О да, тратить кучу времени из-за дизайнерского элемента который весит 0.01% программы - это по-нашему, по-русски.

Если все так как ты говоришь то тебе не нужен WPF

Вот я взглянул сюда http://blogs.gotdotnet.ru/personal/e-zolotko/PermaLink.aspx?guid=D6BCF992-32AE-495D-88F8-0501D35C3577 и что то во мне увяло.

О, Женя Золотько... Правильный чувак.

Ответить

Номер ответа: 30
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
 Web-сайт: sharpc.livejournal.com
 Профиль | | #30
Добавлено: 03.01.07 00:39
Попиксельная работа всегда медленная

Если работать с битмапом, то это будет достаточно быстро.

Ответить

Страница: 1 | 2 | 3 | 4 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам