Somerick | Дата: Понедельник, 25.07.2016, 06:58 | Сообщение # 1 |
Рядовой
Группа: Пользователи
Сообщений: 14
Статус: Offline
| Простейший пример как можно показать осветлением и переливающейся рамкой место заданного окна. Задаётся наведением курсора на него или, когда поиск остановлен, задаётся вручную введением в верхнее поле хендла и нажатием кнопки "i" или на клавиатуре Enter. Вместо рисования прямо на экранном DC и обновления региона ставится полупрозрачное окошко по размеру целевого окна. Да, не совсем правильный метод, но и так работает. Брать контекст окон не имеет смысла, так как в тех случаях когда они закрыты другими то рамка не отображается.
HWNDInfo.bas
Код #Include Once"windows.bi" #Include Once"win\tlhelp32.bi" Dim Shared As HWND hw,tHwnd,tInfo,btnSearch,btnInfo,btnGetParent,LayerWnd,x,res Dim Shared As Long col,iFlag Dim Shared As MODULEENTRY32 MODULENTRY Declare Sub StartStopSearch
Sub WndInfo Dim As ZString*3000 s=Any Dim As ZString*510 sTxt=Any Dim As ZString*130 sClass=Any,sParClass=Any,sLocale=Any Dim As ZString Ptr pM=Any,psVE=Any,psF=Any Dim As Long lnTxt=Any,idt=Any,idp=Any Dim As HWND par=Any Dim As RECT rr=Any Dim As WINDOWPLACEMENT wp=Any Dim As Point cp=Any Dim As HPEN pen=Any,OldPen=Any Dim As LOGFONT LF=Any
If iFlag Then'выдача info iFlag-=1 If iFlag<1 Then StartStopSearch:Exit Sub Else'ищем окно под курсором GetCursorPos @cp res=WindowFromPoint(cp) SetDlgItemInt hw,1003,res,1 EndIf
If x<>res Then'сменилось окно, обновляем параметры x=res GetWindowRect res,@rr'получаем координаты wp.Length=SizeOf(WINDOWPLACEMENT) GetWindowPlacement res,@wp MoveWindow LayerWnd,rr.left,rr.top,rr.right-rr.left,rr.bottom-rr.top,1'ставим по координатам par=GetParent(res)'получаем hwnd родительск. окна GetClassName res,sClass,128:sParClass[0]=0:GetClassName par,sParClass,128'получаем классы lnTxt=SendMessage(res,WM_GETTEXT,501,Cast(lparam,@sTxt))'получаем текст pM=@"" If lnTxt>499 Then lnTxt=SendMessage(res,WM_GETTEXTLENGTH,0,0) pM=@"(View 500)" EndIf
idt=GetWindowThreadProcessId(res,@idp)'получаем инфо о процессе Var pSnap=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,idp) MODULENTRY.dwSize=SizeOf(MODULENTRY) MODULENTRY.szExePath[0]=0 Module32First pSnap,@MODULENTRY CloseHandle pSnap
Select Case IIf(IsWindowVisible(res),0,1)+IIf(IsWindowEnabled(res),0,10)+IIf(IsIconic(res),100,0) Case 0:psVE=@"" Case 1:psVE=@!"wnd not visible\r\n" Case 10:psVE=@!"wnd not enabled\r\n" Case 11:psVE=@!"wnd not enabled, not visible\r\n" Case 100:psVE=@!"wnd is iconic\r\n" Case 101:psVE=@!"wnd is iconic, not visible\r\n" Case 110:psVE=@!"wnd is iconic, not enabled\r\n" Case 111:psVE=@!"wnd is iconic, not enabled, not visible\r\n" End Select
Var hFont=SendMessage(res,WM_GETFONT,0,0)'получаем шрифт If hFont Then psF=@"" Else psF=@"(Default system font)":hFont=GetStockObject(SYSTEM_FONT) LF.lfFaceName[0]=0:LF.lfHeight=0 GetObject hFont,sizeof(LOGFONT),@LF
Var hkl=LoWord(GetKeyboardLayout(idt))'получаем локаль GetLocaleInfo hkl,LOCALE_SENGLANGUAGE,@sLocale,128
'вывод всех параметров в текст wsprintf s,!"Thread: %d Process: %d\r\n"_ !"BaseAddr: %d BaseSize: %d\r\n"_ !"Path: %s\r\n"_ !"HWND: %d Parent: %d\r\n%s"_ !"Class: %s Parent: %s\r\n"_ !"Control ID: %d\r\n"_ !"Position x,y,w,h: %d,%d,%d,%d"_ !" Rect l,t,r,b: %d,%d,%d,%d\r\n"_ !"Style: %d ExStyle: %d\r\n"_ !"LayoutLocale: %d(%s) Font: %s,%d%s\r\n"_ !"Text %dB%s: %s",_ idt,idp,_ MODULENTRY.modBaseAddr,MODULENTRY.modBaseSize,_ @MODULENTRY.szExePath,_ res,par,psVE,_ sClass,sParClass,_ GetDlgCtrlID(res),_ wp.rcNormalPosition.left,wp.rcNormalPosition.top,wp.rcNormalPosition.right-wp.rcNormalPosition.left,wp.rcNormalPosition.bottom-wp.rcNormalPosition.top,_ rr.left,rr.top,rr.right,rr.bottom,_ GetWindowLong(res,GWL_STYLE),GetWindowLong(res,GWL_EXSTYLE),_ hkl,sLocale,LF.lfFaceName,Abs(LF.lfHeight),psF,_ lnTxt,pM,sTxt SetWindowText tInfo,s EndIf
'цветная рамка окна Dim As HDC dc=GetDC(LayerWnd) If dc Then col+=758630'смена цвета If col>17783049 Then col=cp.x pen=CreatePen(0,5,col) SelectObject dc,pen GetClientRect LayerWnd,@rr Rectangle dc,rr.left,rr.top,rr.right,rr.bottom DeleteObject pen ReleaseDC LayerWnd,dc EndIf
If GetAsyncKeyState(VK_ESCAPE)Then StartStopSearch End Sub
Sub StartStopSearch If LayerWnd Then KillTimer hw,123 DestroyWindow LayerWnd LayerWnd=0 iFlag=0 SetWindowText btnSearch,"Start" Else SetTimer hW,123,160,@WndInfo LayerWnd=CreateWindowEx(&h000802AC,"#32770","",&hD0800000,0,0,1,1,0,0,0,0) SetLayeredWindowAttributes LayerWnd,0,115,LWA_ALPHA SetWindowText btnSearch,"Stop (Press Esc)" EndIf End Sub
Sub GetInfo(p As Long) Dim As ZString*100 s=Any res=GetDlgItemInt(hw,1003,0,1) If IsWindow(res)Then If p Then res=GetParent(res):If IsWindow(res)=0 Then GoTo SetTxt x=res+1:iFlag=10 If LayerWnd=0 Then StartStopSearch Else SetTxt: wsprintf s,"No exist wnd %d",res SetWindowText tInfo,s EndIf End Sub
Sub main Cdecl Alias"main"'Точка входа. При запуске программы вызывается эта процедура. В CompileExeGUISubmain.bat уже задана. Dim As MSG msg=Any hw=CreateWindowEx(256,"#32770","HWND Info",348782592,500,234,470,326,0,0,0,0)'диалоговый класс не требует регистрации btnSearch=CreateWindowEx(0,"Button","",1342189312,6,0,135,32,hw,1001,0,0) tInfo=CreateWindowEx(512,"Edit","",1345392836,6,32,450,245,hw,1002,0,0) tHwnd=CreateWindowEx(512,"Edit","3016828",1342251008,144,0,88,24,hw,1003,0,0) btnInfo=CreateWindowEx(0,"Button","i",1342189312,232,0,24,24,hw,1004,0,0) btnGetParent=CreateWindowEx(0,"Button","GetParent",1342189312,256,0,84,24,hw,1004,0,0) StartStopSearch
While GetMessage(@msg,0,0,0) Select Case msg.message Case WM_SYSCOMMAND If msg.wParam=SC_CLOSE Then Exit While Case WM_COMMAND If msg.hwnd=hw Then Exit While Case WM_LBUTTONUP Select Case msg.hwnd Case btnSearch:StartStopSearch Case btnInfo:GetInfo 0 Case btnGetParent:GetInfo 1 End Select Case WM_KEYDOWN If msg.hwnd=tHwnd And msg.wParam=13 Then GetInfo 0 End Select TranslateMessage @msg DispatchMessage @msg Wend
DestroyWindow LayerWnd DestroyWindow hw ExitProcess 0 End Sub
CompileExeGUISubmain.bat
Код @echo off :: Расположение папки компилятора. Задать и сохранить bat. Перетащить bas на этот bat. SET FBPATH=C:\FreeBASIC-1.05.0-win32
%~d1 cd %~p1 SET File=%~n1 SET LIBS=-lkernel32 -luser32 -lgdi32 -lmsimg32 -lshell32 -lComdlg32 -lole32 -ladvapi32.dll -luuid -loleaut32 -limm32 -lwinmm -lcomctl32.dll -lfb -lgcc -lmingw32 -lmingwex -lmoldname -lsupc++ -lgcc_eh -lmsvcrt
If Not Exist %File%.rc GoTo norc echo compiling resource.. SET RES="%File%.res.obj" %FBPATH%\bin\win32\gorc /ni /nw /o /fo %RES% "%File%.rc" :norc echo compiling.. %FBPATH%\fbc.exe -w 3 %1 -r -lib If ErrorLevel 1 echo # Compile error! # && GoTo exit echo assembling.. %FBPATH%\bin\win32\as.exe --32 --strip-local-absolute %File%.asm -o %File%.o If ErrorLevel 1 echo # Asm error! # && GoTo exit echo linking.. %FBPATH%\bin\win32\ld.exe -e _main -subsystem windows "%FBPATH%\lib\win32\fbextra.x" -s --stack 102400,102400 -L %FBPATH%\lib\win32 -L "./" "%File%.o" %RES% -o "%File%.exe" -( %LIBS% -) If ErrorLevel 1 echo # Link error! # && GoTo exit echo # No errors ! # :exit pause
Сообщение отредактировал Somerick - Воскресенье, 07.08.2016, 00:35 |
|
| |