Select a rectangle on the screen

Everything else that doesn't fall into one of the other PB categories.
AZJIO
Addict
Addict
Posts: 1318
Joined: Sun May 14, 2017 1:48 am

Select a rectangle on the screen

Post by AZJIO »

Used this as source code.

Download

Code: Select all

EnableExplicit

Enumeration
	#Win_Tool
	#Win_Sel
	#Win_View
EndEnumeration


Enumeration
	#btnRect
	#btnSave
	#img
EndEnumeration

#Img2 = 0

Global x1, y1, x2, y2
Global hRectangle_GUI
Global HDC

Define hBmp
Define hPreview
Define WWEvent
Define hCursor
Define Mouse_PosX_old, Mouse_PosY_old, hMask
Define Path$

Define Mouse_PosX, Mouse_PosY, tmp, x_Pos, Width, Height, y_Pos, isStarCapture = 0

Declare GUICreateInvRect(hWnd, X, Y, W, H)
Declare HBitmapFromScreen(X, Y, W, H)


ExamineDesktops()

DataSection
	cross:
	IncludeBinary "cross.ico"
	crossend:
	save:
	IncludeBinary "save.ico"
	saveend:
EndDataSection
CatchImage(0, ?cross)
CatchImage(1, ?save)

;- GUI
OpenWindow(#Win_Tool, 0, 0, 240, 40, "Select", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
ButtonImageGadget(#btnRect, 5, 5, 30, 30, ImageID(0))
ButtonImageGadget(#btnSave, 40, 5, 30, 30, ImageID(1))

hRectangle_GUI = OpenWindow(#Win_Sel, 0, 0, DesktopWidth(0), DesktopHeight(0), "", #WS_POPUP | #PB_Window_BorderLess | #PB_Window_Invisible)
If hRectangle_GUI
	SetWindowColor(#Win_Sel, 0)
	SetWindowLong_(hRectangle_GUI, #GWL_EXSTYLE, #WS_EX_LAYERED | #WS_EX_TOPMOST)
	SetLayeredWindowAttributes_(hRectangle_GUI, #Blue, 110, #LWA_COLORKEY | #LWA_ALPHA)
	GUICreateInvRect(hRectangle_GUI, 0, 0, 1, 1)
	hCursor = LoadCursor_(0, #OCR_CROSS)
	SetClassLongPtr_(hRectangle_GUI, #GCL_HCURSOR, hCursor) ; WindowID(#Win_Sel)
	StickyWindow(#Win_Sel, #True)
EndIf



;- Event
Repeat
	WWEvent = WaitWindowEvent()
	Select EventWindow()
		Case #Win_Tool
			Select WWEvent
				Case #PB_Event_Gadget
					Select EventGadget()

						Case #btnSave
							If hPreview
								Path$ = SaveFileRequester("", GetCurrentDirectory(), "Изображение (*.bmp)|*.bmp", 0)
								If Asc(Path$)
									If Right(Path$, 4) <> ".bmp"
										Path$ + ".bmp"
									EndIf
									If CreateImage(#Img2, x2 - x1, y2 - y1, 24)
										StartDrawing(ImageOutput(#Img2))
										DrawImage(hBmp , 0 , 0)
										StopDrawing()
										If IsImage(#Img2)
											SaveImage(#Img2 , Path$)
										EndIf
										FreeImage(#Img2)
									EndIf
								EndIf
							EndIf

						Case #btnRect
							If hPreview
								CloseWindow(#Win_View)
								hPreview = 0
							EndIf
							HideWindow(#Win_Tool, #True)
							HideWindow(#Win_Sel, #False)
							isStarCapture = 1
							hMask = CreateRectRgn_(0, 0, DesktopWidth(0), DesktopHeight(0))
							SetWindowRgn_(hRectangle_GUI, hMask, 1)
							DeleteObject_(hMask)
					EndSelect

				Case #PB_Event_CloseWindow
					CloseWindow(#Win_Tool)
					ReleaseDC_(0, HDC)

					DestroyCursor_(hCursor)
					CloseWindow(#Win_Sel)

					If hPreview
						CloseWindow(#Win_View)
						DeleteObject_(hBmp)
					EndIf

					End
			EndSelect
		Case #Win_View
			If WWEvent = #PB_Event_CloseWindow
				CloseWindow(#Win_View)
				hPreview = 0
				DeleteObject_(hBmp)
			EndIf
		Case #Win_Sel
			If GetAsyncKeyState_(#VK_LBUTTON)
				If isStarCapture

					; Get first mouse position
					x1 = WindowMouseX(#Win_Sel)
					y1 = WindowMouseY(#Win_Sel)

					; Draw rectangle while mouse button pressed
					While GetAsyncKeyState_(#VK_LBUTTON)

						Delay(10)
						Mouse_PosX = WindowMouseX(#Win_Sel)
						Mouse_PosY = WindowMouseY(#Win_Sel)
						If Mouse_PosX = Mouse_PosX_old And Mouse_PosY = Mouse_PosY_old
							Continue
						EndIf

						; Set in correct order if required
						If Mouse_PosX < x1
							x_Pos = Mouse_PosX
							Width = x1 - Mouse_PosX
						Else
							x_Pos = x1
							Width = Mouse_PosX - x1
						EndIf

						If Mouse_PosY < y1
							y_Pos = Mouse_PosY
							Height = y1 - Mouse_PosY
						Else
							y_Pos = y1
							Height = Mouse_PosY - y1
						EndIf

						GUICreateInvRect(hRectangle_GUI, x_Pos, y_Pos, Width, Height)
						Mouse_PosX_old = Mouse_PosX
						Mouse_PosY_old = Mouse_PosY


					Wend

					; Get second mouse position
					x2 = Mouse_PosX
					y2 = Mouse_PosY

					; Set in correct order if required
					If x2 < x1
						tmp = x1
						x1 = x2
						x2 = tmp
					EndIf
					If y2 < y1
						tmp = y1
						y1 = y2
						y2 = tmp
					EndIf


					hBmp = HBitmapFromScreen( x1, y1, x2 - x1, y2 - y1)
					HideWindow(#Win_Tool, #False)
					hPreview = OpenWindow(#Win_View, 330, 0, x2 - x1, y2 - y1, "Selected Rectangle", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
					ImageGadget(#img, 0 , 0, x2 - x1, y2 - y1, hBmp)
					HideWindow(#Win_Sel, #True)
					isStarCapture = 0
				EndIf
			EndIf

	EndSelect
ForEver


Procedure HBitmapFromScreen(X, Y, W, H)
	Protected hBmp, PDC
	If Not HDC
		HDC = GetDC_(0)
	EndIf
	hBmp = CreateCompatibleBitmap_(HDC, W, H)
	PDC = CreateCompatibleDC_(HDC)
	SelectObject_(PDC, hBmp)
	BitBlt_(PDC, 0, 0, W, H, HDC, X, Y, #SRCCOPY)
	DeleteDC_(PDC)
	ProcedureReturn hBmp
EndProcedure


Procedure GUICreateInvRect(hWnd, X, Y, W, H)
	Protected hMask_Top, hMask_Left, hMask_Right, hMask_Bottom

	hMask_Top = CreateRectRgn_(0, 0, DesktopWidth(0), Y)
	hMask_Left = CreateRectRgn_(0, 0, X, DesktopHeight(0))
	hMask_Right = CreateRectRgn_(X + W, 0, DesktopWidth(0), DesktopHeight(0))
	hMask_Bottom = CreateRectRgn_(0, Y + H, DesktopWidth(0), DesktopHeight(0))

	CombineRgn_(hMask_Top, hMask_Top, hMask_Left, 2)
	CombineRgn_(hMask_Top, hMask_Top, hMask_Right, 2)
	CombineRgn_(hMask_Top, hMask_Top, hMask_Bottom, 2)

	DeleteObject_(hMask_Left)
	DeleteObject_(hMask_Right)
	DeleteObject_(hMask_Bottom)

	SetWindowRgn_(hWnd, hMask_Top, 1)
	DeleteObject_(hMask_Top)
EndProcedure
Last edited by AZJIO on Sat Sep 03, 2022 3:41 pm, edited 3 times in total.
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: Select a rectangle on the screen

Post by BarryG »

Thanks for sharing! Very nice way to make a snipping tool.
Axolotl
Enthusiast
Enthusiast
Posts: 435
Joined: Wed Dec 31, 2008 3:36 pm

Re: Select a rectangle on the screen

Post by Axolotl »

Hey AZJIO,
looks very nice.
Thanks for sharing.

BTW: I recently used this flag in combination with bitblt_().

Code: Select all

#CAPTUREBLT                  = $40000000                             ; BitBlt Parameter  
; 
; MSDN wrote: 
; 
; CAPTUREBLT .. Includes any windows that are layered on top of your window in the resulting image. 
;               By default, the image only contains your window. Note that this generally cannot be 
;               used for printing device contexts. 
; 
Mostly running PureBasic <latest stable version and current alpha/beta> (x64) on Windows 11 Home
User avatar
jacdelad
Addict
Addict
Posts: 1431
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: Select a rectangle on the screen

Post by jacdelad »

I feel like it should me mentioned that this code only works on Windows.
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
Axolotl
Enthusiast
Enthusiast
Posts: 435
Joined: Wed Dec 31, 2008 3:36 pm

Re: Select a rectangle on the screen

Post by Axolotl »

I played a little with this and found a small drawback: :oops:
If you add stickywindow() to #win_1, it will also work with the other always-on-top windows.
It worked anyway, but the selection is behind these windows...
Mostly running PureBasic <latest stable version and current alpha/beta> (x64) on Windows 11 Home
AZJIO
Addict
Addict
Posts: 1318
Joined: Sun May 14, 2017 1:48 am

Re: Select a rectangle on the screen

Post by AZJIO »

Add a save image to file button

Code: Select all


ButtonImageGadget(#btnSave, 40, 5, 30, 30, ImageID(1))
; ....

Case #btnSave
	If hPreview
		Path$ = SaveFileRequester("", GetCurrentDirectory(), "Image (*.bmp)|*.bmp", 0)
		If Asc(Path$)
			If Right(Path$, 4) <> ".bmp"
				Path$ + ".bmp"
			EndIf
			If CreateImage(#Img2, iX2 - iX1, iY2 - iY1, 24)
				StartDrawing(ImageOutput(#Img2))
				DrawImage(hBmp , 0 , 0)
				StopDrawing()
				If IsImage(#Img2)
					SaveImage(#Img2 , Path$)
				EndIf
				FreeImage(#Img2)
			EndIf
		EndIf
	EndIf
Axolotl
Enthusiast
Enthusiast
Posts: 435
Joined: Wed Dec 31, 2008 3:36 pm

Re: Select a rectangle on the screen

Post by Axolotl »

Hey AZJIO,

instead of your procedure

Code: Select all

Procedure HBitmapFromScreen(iX, iY, iW, iH)
you can use this one. (Advantage: you will have a PB compatible Image for clipboard and savefile directly)

Code: Select all

Procedure.i CaptureScreenImage(Image, X, Y, W, H)    ; Image .. #Image or #PB_Any 
  Protected hImage, dc, hDC, hdcScreen 

  hImage = CreateImage(Image, W, H, 24) 
  If hImage 
    If Image = #PB_Any 
      Image = hImage 
      hImage = ImageID(Image) 
    EndIf 
    dc = CreateDC_("DISPLAY", 0, 0, 0)  ; Note: so you don't need to use the hDC returned from StartDrawing() 
    hDC = CreateCompatibleDC_(dc)       ; for the API  
    hdcScreen = GetDC_(0)               ; <> 0 ?? 

    SelectObject_(hDC, hImage)          ; 
    BitBlt_(hDC, 0, 0, W, H, hdcScreen, X, Y, #SRCCOPY | #CAPTUREBLT)  

    ReleaseDC_(0, hdcScreen)            ; MSDN: ... must be called ... ; The number of DCs is limited only by available memory. 
    DeleteDC_(hDC)  ; clean up 
    DeleteDC_(dc)   ; 
;   CapturedImageX = X : CapturedImageY = Y : CapturedImageW = W : CapturedImageH = H 
; Else 
;   CapturedImageX = 0 : CapturedImageY = 0 : CapturedImageW = 0 : CapturedImageH = 0 
  EndIf 
  ProcedureReturn hImage 
EndProcedure 


An intriguing question that is on my mind: Do we have to release the DC we get with GetDC_(0) again with ReleaseDC_(0, hdc)?
It seams to work both ways, but maybe only because of the huge memory these days?
Mostly running PureBasic <latest stable version and current alpha/beta> (x64) on Windows 11 Home
AZJIO
Addict
Addict
Posts: 1318
Joined: Sun May 14, 2017 1:48 am

Re: Select a rectangle on the screen

Post by AZJIO »

Axolotl
I don't know if GetDC is a link or creates a buffer to hold screen bitmap content (more than 2MB).

I also want to use this here (Windows 10 OCR and Face detection). In the program, I could make taking a screenshot as an additional option.
Axolotl wrote: Sat Sep 03, 2022 1:23 pm instead of your procedure
To be precise, the function is not mine, it is googled on the forum.
Axolotl wrote: Sat Sep 03, 2022 1:23 pm

Code: Select all

hdcScreen = GetDC_(0)               ; <> 0 ?? 
0 - entire screen
<> 0 = hWnd
All this is in the description of the function.

Update: Download
AZJIO
Addict
Addict
Posts: 1318
Joined: Sun May 14, 2017 1:48 am

Re: Select a rectangle on the screen

Post by AZJIO »

Now select with a yellow rectangle.

Code: Select all

EnableExplicit

Enumeration
	#Win_Tool
	#Win_Sel
	#Win_View
EndEnumeration


Enumeration
	#btnRect
	#btnSave
	#img
EndEnumeration

#Img2 = 0

Global x1, y1, x2, y2
Global hRectangle_GUI
Global HDC

Define hBmp
Define hPreview
Define WWEvent
Define hCursor
Define Mouse_PosX_old, Mouse_PosY_old, hMask
Define Path$, IsRect

Define Mouse_PosX, Mouse_PosY, tmp, x_Pos, Width, Height, y_Pos, isStarCapture = 0

Declare GUICreateInvRect(hWnd, X, Y, W, H)
Declare HBitmapFromScreen(X, Y, W, H)


ExamineDesktops()

DataSection
	cross:
	IncludeBinary "cross.ico"
	crossend:
	save:
	IncludeBinary "save.ico"
	saveend:
EndDataSection
CatchImage(0, ?cross)
CatchImage(1, ?save)

;- GUI
OpenWindow(#Win_Tool, 0, 0, 240, 40, "Select", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
ButtonImageGadget(#btnRect, 5, 5, 30, 30, ImageID(0))
ButtonImageGadget(#btnSave, 40, 5, 30, 30, ImageID(1))

hRectangle_GUI = OpenWindow(#Win_Sel, 0, 0, DesktopWidth(0), DesktopHeight(0), "", #WS_POPUP | #PB_Window_BorderLess | #PB_Window_Invisible)
If hRectangle_GUI
	SetWindowColor(#Win_Sel, RGB(255, 255, 0))
	SetWindowLong_(hRectangle_GUI, #GWL_EXSTYLE, #WS_EX_LAYERED | #WS_EX_TOPMOST)
; 	SetLayeredWindowAttributes_(hRectangle_GUI, #Blue, 50, #LWA_COLORKEY | #LWA_ALPHA)
	GUICreateInvRect(hRectangle_GUI, 0, 0, 1, 1)
	hCursor = LoadCursor_(0, #OCR_CROSS)
	SetClassLongPtr_(hRectangle_GUI, #GCL_HCURSOR, hCursor) ; WindowID(#Win_Sel)
	StickyWindow(#Win_Sel, #True)
EndIf



;- Event
Repeat
	WWEvent = WaitWindowEvent()
	Select EventWindow()
		Case #Win_Tool
			Select WWEvent
				Case #PB_Event_Gadget
					Select EventGadget()

						Case #btnSave
							If hPreview
								Path$ = SaveFileRequester("", GetCurrentDirectory(), "Изображение (*.bmp)|*.bmp", 0)
								If Asc(Path$)
									If Right(Path$, 4) <> ".bmp"
										Path$ + ".bmp"
									EndIf
									If CreateImage(#Img2, x2 - x1, y2 - y1, 24)
										StartDrawing(ImageOutput(#Img2))
										DrawImage(hBmp , 0 , 0)
										StopDrawing()
										If IsImage(#Img2)
											SaveImage(#Img2 , Path$)
										EndIf
										FreeImage(#Img2)
									EndIf
								EndIf
							EndIf

						Case #btnRect
							If hPreview
								CloseWindow(#Win_View)
								hPreview = 0
							EndIf
							SetLayeredWindowAttributes_(hRectangle_GUI, #Blue, 1, #LWA_COLORKEY | #LWA_ALPHA)
							HideWindow(#Win_Tool, #True)
							HideWindow(#Win_Sel, #False)
							isStarCapture = 1
							hMask = CreateRectRgn_(0, 0, DesktopWidth(0), DesktopHeight(0))
							SetWindowRgn_(hRectangle_GUI, hMask, 1)
							DeleteObject_(hMask)
					EndSelect

				Case #PB_Event_CloseWindow
					CloseWindow(#Win_Tool)
					ReleaseDC_(0, HDC)

					DestroyCursor_(hCursor)
					CloseWindow(#Win_Sel)

					If hPreview
						CloseWindow(#Win_View)
						DeleteObject_(hBmp)
					EndIf

					End
			EndSelect
		Case #Win_View
			If WWEvent = #PB_Event_CloseWindow
				CloseWindow(#Win_View)
				hPreview = 0
				DeleteObject_(hBmp)
			EndIf
		Case #Win_Sel
			If GetAsyncKeyState_(#VK_LBUTTON)
				If isStarCapture
					
					; Get first mouse position
					x1 = WindowMouseX(#Win_Sel)
					y1 = WindowMouseY(#Win_Sel)
					
					IsRect = 1
					; Draw rectangle while mouse button pressed
					While GetAsyncKeyState_(#VK_LBUTTON)

; 						Delay(10)
						WWEvent = WaitWindowEvent(10) ; prevents the window from freezing when the mouse is held down for a long time
						Mouse_PosX = WindowMouseX(#Win_Sel)
						Mouse_PosY = WindowMouseY(#Win_Sel)
						If Mouse_PosX = Mouse_PosX_old And Mouse_PosY = Mouse_PosY_old
							Continue
						EndIf

						; Set in correct order if required
						If Mouse_PosX < x1
							x_Pos = Mouse_PosX
							Width = x1 - Mouse_PosX
						Else
							x_Pos = x1
							Width = Mouse_PosX - x1
						EndIf

						If Mouse_PosY < y1
							y_Pos = Mouse_PosY
							Height = y1 - Mouse_PosY
						Else
							y_Pos = y1
							Height = Mouse_PosY - y1
						EndIf

						If IsRect
							SetLayeredWindowAttributes_(hRectangle_GUI, #Blue, 50, #LWA_COLORKEY | #LWA_ALPHA)
							IsRect = 0
						EndIf
						GUICreateInvRect(hRectangle_GUI, x_Pos, y_Pos, Width, Height)
						Mouse_PosX_old = Mouse_PosX
						Mouse_PosY_old = Mouse_PosY


					Wend

					; Get second mouse position
					x2 = Mouse_PosX
					y2 = Mouse_PosY

					; Set in correct order if required
					If x2 < x1
						tmp = x1
						x1 = x2
						x2 = tmp
					EndIf
					If y2 < y1
						tmp = y1
						y1 = y2
						y2 = tmp
					EndIf
					HideWindow(#Win_Sel, #True)


					hBmp = HBitmapFromScreen( x1, y1, x2 - x1, y2 - y1)
					HideWindow(#Win_Tool, #False)
					hPreview = OpenWindow(#Win_View, 330, 0, x2 - x1, y2 - y1, "Selected Rectangle", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
					ImageGadget(#img, 0 , 0, x2 - x1, y2 - y1, hBmp)
					isStarCapture = 0
				EndIf
			EndIf

	EndSelect
ForEver


Procedure HBitmapFromScreen(X, Y, W, H)
	Protected hBmp, PDC
	If Not HDC
		HDC = GetDC_(0)
	EndIf
	hBmp = CreateCompatibleBitmap_(HDC, W, H)
	PDC = CreateCompatibleDC_(HDC)
	SelectObject_(PDC, hBmp)
	BitBlt_(PDC, 0, 0, W, H, HDC, X, Y, #SRCCOPY)
	DeleteDC_(PDC)
	ProcedureReturn hBmp
EndProcedure


Procedure GUICreateInvRect(hWnd, X, Y, W, H)
	Protected hMask, hMask_Left, hMask_Right, hMask_Bottom

	hMask = CreateRectRgn_(X, Y, W + X, H + Y)

	SetWindowRgn_(hWnd, hMask, 1)
	DeleteObject_(hMask)
EndProcedure
AZJIO
Addict
Addict
Posts: 1318
Joined: Sun May 14, 2017 1:48 am

Re: Select a rectangle on the screen

Post by AZJIO »

Now you can drag the selected window with the mouse.
Enter - Done
Esc - cancel
arrows to move the window
Ctrl + arrows - resize window

download

Code: Select all

EnableExplicit

Enumeration
	#Win_Tool
	#Win_Sel
	#Win_View
	#Win_SelDone
EndEnumeration


Enumeration
	#btnRect
	#btnSave
	#img
; 	#btnMenu
EndEnumeration

Enumeration Menu
	#mCancel
	#mDone
	#mLeft
	#mRight
	#mUp
	#mDown
	#mCtrlLeft
	#mCtrlRight
	#mCtrlUp
	#mCtrlDown
EndEnumeration

#Img2 = 0
#Menu = 0

Global hWinSelect
Global x1, y1, x2, y2
Global hRectangle_GUI
Global HDC
Global hBmp

Define hPreview
Define WWEvent
Define hCursor
Define Mouse_PosX_old, Mouse_PosY_old, hMask
Define Path$, IsRect

Define Mouse_PosX, Mouse_PosY, tmp, x_Pos, Width, Height, y_Pos, isStarCapture = 0

Declare GUICreateInvRect(hWnd, X, Y, W, H)
Declare HBitmapFromScreen(X, Y, W, H)
Declare MyWindowCallback(WindowId, Message, wParam, lParam)
; Declare getCoorSize()


ExamineDesktops()

DataSection
	cross:
	IncludeBinary "cross.ico"
	crossend:
	save:
	IncludeBinary "save.ico"
	saveend:
EndDataSection
CatchImage(0, ?cross)
CatchImage(1, ?save)

;- GUI
OpenWindow(#Win_Tool, 0, 0, 240, 40, "Select", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
ButtonImageGadget(#btnRect, 5, 5, 30, 30, ImageID(0))
GadgetToolTip(#btnRect, "After selecting, press Enter or Esc")
ButtonImageGadget(#btnSave, 40, 5, 30, 30, ImageID(1))
GadgetToolTip(#btnSave, "Save image from preview")


hWinSelect = OpenWindow(#Win_SelDone, 0, 0, 100, 10, "", #PB_Window_BorderLess | #PB_Window_Invisible) ; | #WS_THICKFRAME
SetWindowColor(#Win_SelDone, $00FFFF)
SetWindowLong_(hWinSelect, #GWL_EXSTYLE, #WS_EX_LAYERED | #WS_EX_TOPMOST)
SetLayeredWindowAttributes_(hWinSelect, $00FFFF, 90, #LWA_ALPHA) ; #LWA_COLORKEY, #LWA_ALPHA
; ButtonGadget(#btnMenu, 3, 3, 17, 17, "v")

If CreatePopupMenu(#Menu)
	MenuItem(#mCancel, "Cancel")
	MenuItem(#mLeft, "Left")
	MenuItem(#mRight, "Right")
	MenuItem(#mUp, "Up")
	MenuItem(#mDown, "Down")
	MenuItem(#mCtrlLeft, "CtrlLeft")
	MenuItem(#mCtrlRight, "CtrlRight")
	MenuItem(#mCtrlUp, "CtrlUp")
	MenuItem(#mCtrlDown, "CtrlDown")
	MenuItem(#mDone, "Done")
EndIf

;- AddKey
AddKeyboardShortcut(#Win_SelDone, #PB_Shortcut_Escape, #mCancel)
AddKeyboardShortcut(#Win_SelDone, #PB_Shortcut_Return, #mDone)
AddKeyboardShortcut(#Win_SelDone, #PB_Shortcut_Left, #mLeft)
AddKeyboardShortcut(#Win_SelDone, #PB_Shortcut_Right, #mRight)
AddKeyboardShortcut(#Win_SelDone, #PB_Shortcut_Up, #mUp)
AddKeyboardShortcut(#Win_SelDone, #PB_Shortcut_Down, #mDown)
AddKeyboardShortcut(#Win_SelDone, #PB_Shortcut_Control | #PB_Shortcut_Left, #mCtrlLeft)
AddKeyboardShortcut(#Win_SelDone, #PB_Shortcut_Control | #PB_Shortcut_Right, #mCtrlRight)
AddKeyboardShortcut(#Win_SelDone, #PB_Shortcut_Control | #PB_Shortcut_Up, #mCtrlUp)
AddKeyboardShortcut(#Win_SelDone, #PB_Shortcut_Control | #PB_Shortcut_Down, #mCtrlDown)


hRectangle_GUI = OpenWindow(#Win_Sel, 0, 0, DesktopWidth(0), DesktopHeight(0), "", #WS_POPUP | #PB_Window_BorderLess | #PB_Window_Invisible)
If hRectangle_GUI
	SetWindowColor(#Win_Sel, RGB(255, 255, 0))
	SetWindowLong_(hRectangle_GUI, #GWL_EXSTYLE, #WS_EX_LAYERED | #WS_EX_TOPMOST)
	GUICreateInvRect(hRectangle_GUI, 0, 0, 1, 1)
	hCursor = LoadCursor_(0, #OCR_CROSS)
	SetClassLongPtr_(hRectangle_GUI, #GCL_HCURSOR, hCursor) ; WindowID(#Win_Sel)
	StickyWindow(#Win_Sel, #True)
EndIf



SetWindowCallback(@MyWindowCallback(), #Win_SelDone)


;- Event
Repeat
	WWEvent = WaitWindowEvent()
	Select EventWindow()
		Case #Win_Tool
			Select WWEvent
				Case #PB_Event_Gadget
					Select EventGadget()

						Case #btnSave
							If hPreview
								Path$ = SaveFileRequester("", GetCurrentDirectory(), "Image (*.bmp)|*.bmp", 0)
								If Asc(Path$)
									If Right(Path$, 4) <> ".bmp"
										Path$ + ".bmp"
									EndIf
									If CreateImage(#Img2, x2 - x1, y2 - y1, 24)
										StartDrawing(ImageOutput(#Img2))
										DrawImage(hBmp , 0 , 0)
										StopDrawing()
										If IsImage(#Img2)
											SaveImage(#Img2 , Path$)
										EndIf
										FreeImage(#Img2)
									EndIf
								EndIf
							EndIf

						Case #btnRect
							If hPreview
								CloseWindow(#Win_View)
								hPreview = 0
							EndIf
							SetLayeredWindowAttributes_(hRectangle_GUI, 0, 1, #LWA_ALPHA)
							HideWindow(#Win_Tool, #True)
							HideWindow(#Win_Sel, #False)
							isStarCapture = 1
							hMask = CreateRectRgn_(0, 0, DesktopWidth(0), DesktopHeight(0))
							SetWindowRgn_(hRectangle_GUI, hMask, 1)
							DeleteObject_(hMask)
					EndSelect

				Case #PB_Event_CloseWindow
					CloseWindow(#Win_Tool)
					ReleaseDC_(0, HDC)

					DestroyCursor_(hCursor)
					CloseWindow(#Win_Sel)
					
					CloseWindow(#Win_SelDone)

					If hPreview
						CloseWindow(#Win_View)
						DeleteObject_(hBmp)
					EndIf

					End
			EndSelect
		Case #Win_SelDone
			Select WWEvent
; 				Case #PB_Event_RightClick ; WM_NCHITTEST prevents clicking
; 					DisplayPopupMenu(#Menu, hWinSelect)
; 				Case #PB_Event_Gadget
; 					Select EventGadget()
; 						Case #btnMenu
; 							DisplayPopupMenu(#Menu, hWinSelect)
; 					EndSelect
;- Menu
				Case #PB_Event_Menu
					Select EventMenu()
						Case #mCancel
							HideWindow(#Win_Tool, #False) ; shows tool window
							HideWindow(#Win_SelDone, #True) ; hides the selection window
							
							isStarCapture = 0
							
						Case #mDone
							HideWindow(#Win_SelDone, #True) ; hides the selection window
		
							x1 = WindowX(#Win_SelDone)
							y1 = WindowY(#Win_SelDone) 
							x2 = WindowWidth(#Win_SelDone)
							y2 = WindowHeight(#Win_SelDone)
							HBitmapFromScreen( x1, y1, x2, y2) ; get images of the selected part of the screen
							HideWindow(#Win_Tool, #False) ; shows tool window
							 ; show selection result
							hPreview = OpenWindow(#Win_View, 330, 0, x2, y2, "Preview", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
							ImageGadget(#img, 0 , 0, x2, y2, hBmp)
							isStarCapture = 0
							
							
						Case #mLeft
							ResizeWindow(#Win_SelDone, WindowX(#Win_SelDone)-1, #PB_Ignore, #PB_Ignore, #PB_Ignore)
						Case #mRight
							ResizeWindow(#Win_SelDone, WindowX(#Win_SelDone)+1, #PB_Ignore, #PB_Ignore, #PB_Ignore)
						Case #mUp
							ResizeWindow(#Win_SelDone, #PB_Ignore, WindowY(#Win_SelDone) -1, #PB_Ignore, #PB_Ignore)
						Case #mDown
							ResizeWindow(#Win_SelDone, #PB_Ignore, WindowY(#Win_SelDone) +1, #PB_Ignore, #PB_Ignore)
							
						Case #mCtrlLeft
							ResizeWindow(#Win_SelDone, #PB_Ignore, #PB_Ignore, WindowWidth(#Win_SelDone)-1, #PB_Ignore)
						Case #mCtrlRight
							ResizeWindow(#Win_SelDone, #PB_Ignore, #PB_Ignore, WindowWidth(#Win_SelDone)+1, #PB_Ignore)
						Case #mCtrlUp
							ResizeWindow(#Win_SelDone, #PB_Ignore, #PB_Ignore, #PB_Ignore, WindowHeight(#Win_SelDone)-1)
						Case #mCtrlDown
							ResizeWindow(#Win_SelDone, #PB_Ignore, #PB_Ignore, #PB_Ignore, WindowHeight(#Win_SelDone)+1)
					EndSelect
			EndSelect
			

		Case #Win_View
			If WWEvent = #PB_Event_CloseWindow
				CloseWindow(#Win_View)
				hPreview = 0
				DeleteObject_(hBmp)
			EndIf
;- Select
		Case #Win_Sel
			If GetAsyncKeyState_(#VK_LBUTTON)
				If isStarCapture

					; Get first mouse position
					x1 = WindowMouseX(#Win_Sel)
					y1 = WindowMouseY(#Win_Sel)

					IsRect = 1
					; Draw rectangle while mouse button pressed
					While GetAsyncKeyState_(#VK_LBUTTON)

; 						Delay(10)
						WWEvent = WaitWindowEvent(10) ; prevents the window from freezing when the mouse is held down for a long time
						Mouse_PosX = WindowMouseX(#Win_Sel)
						Mouse_PosY = WindowMouseY(#Win_Sel)
						If Mouse_PosX = Mouse_PosX_old And Mouse_PosY = Mouse_PosY_old
							Continue
						EndIf

						; Set in correct order if required
						If Mouse_PosX < x1
							x_Pos = Mouse_PosX
							Width = x1 - Mouse_PosX
						Else
							x_Pos = x1
							Width = Mouse_PosX - x1
						EndIf

						If Mouse_PosY < y1
							y_Pos = Mouse_PosY
							Height = y1 - Mouse_PosY
						Else
							y_Pos = y1
							Height = Mouse_PosY - y1
						EndIf

						If IsRect
							SetLayeredWindowAttributes_(hRectangle_GUI, 0, 90, #LWA_ALPHA)
							IsRect = 0
						EndIf
						GUICreateInvRect(hRectangle_GUI, x_Pos, y_Pos, Width, Height)
						Mouse_PosX_old = Mouse_PosX
						Mouse_PosY_old = Mouse_PosY


					Wend

					; Get second mouse position
					x2 = Mouse_PosX
					y2 = Mouse_PosY

					; Set in correct order if required
					If x2 < x1
						tmp = x1
						x1 = x2
						x2 = tmp
					EndIf
					If y2 < y1
						tmp = y1
						y1 = y2
						y2 = tmp
					EndIf
					ResizeWindow(#Win_SelDone, x1, y1, x2 - x1, y2 - y1)
					HideWindow(#Win_SelDone, #False) ; показывает основное окно
							
					HideWindow(#Win_Sel, #True)
					SetActiveWindow(#Win_SelDone)
				EndIf
			EndIf

	EndSelect
ForEver


Procedure MyWindowCallback(WindowId, Message, wParam, lParam)
	Protected Result = #PB_ProcessPureBasicEvents, iProc

	Select Message
		Case #WM_NCHITTEST
			iProc = DefWindowProc_(WindowId, Message, wParam, lParam)
			If iProc = #HTCLIENT
				ProcedureReturn #HTCAPTION
			EndIf
	EndSelect
	ProcedureReturn Result
EndProcedure


Procedure HBitmapFromScreen(X, Y, W, H)
	Protected PDC
	If hBmp
		DeleteObject_(hBmp)
	EndIf
	If Not HDC
		HDC = GetDC_(0)
	EndIf
	hBmp = CreateCompatibleBitmap_(HDC, W, H)
	PDC = CreateCompatibleDC_(HDC)
	SelectObject_(PDC, hBmp)
	BitBlt_(PDC, 0, 0, W, H, HDC, X, Y, #SRCCOPY)
	DeleteDC_(PDC)
EndProcedure


Procedure GUICreateInvRect(hWnd, X, Y, W, H)
	Protected hMask, hMask_Left, hMask_Right, hMask_Bottom

	hMask = CreateRectRgn_(X, Y, W + X, H + Y)

	SetWindowRgn_(hWnd, hMask, 1)
	DeleteObject_(hMask)
EndProcedure
Last edited by AZJIO on Wed Oct 05, 2022 4:35 pm, edited 3 times in total.
User avatar
Mijikai
Addict
Addict
Posts: 1360
Joined: Sun Sep 11, 2016 2:17 pm

Re: Select a rectangle on the screen

Post by Mijikai »

The code leaks a GDI object (the bitmap remains selected).
AZJIO
Addict
Addict
Posts: 1318
Joined: Sun May 14, 2017 1:48 am

Re: Select a rectangle on the screen

Post by AZJIO »

Mijikai wrote: Wed Oct 05, 2022 3:35 pm The code leaks a GDI object (the bitmap remains selected).
you have to press Enter
The change is made so that you can move the rectangle to fine-tune its position.


I've tried adding the #WS_THICKFRAME style and coloring the window title, but it doesn't work. It would help to be able to resize the window.

Code: Select all

; hRgn = CreateRectRgn_(x1+3, y1+1, x2 - x1-1, y2 - y1 - 1)
; hDC = GetDCEx_(hWinSelect, hRgn, #DCX_WINDOW)
hDC = GetDCEx_(hWinSelect, 0, #DCX_PARENTCLIP)
Debug hRgn
Debug hDC
; hDC = GetWindowDC_(hWinSelect)
hBrush = CreateSolidBrush_($0000FF)
With Rect
	\left = 0
	\right = x2 - x1
	\top = 0
	\bottom = y2 - y1
EndWith
FillRect_(hDC, Rect, hBrush)
DeleteObject_(hBrush)
This always paints only the client side of the window.
Last edited by AZJIO on Wed Oct 05, 2022 4:18 pm, edited 1 time in total.
User avatar
Mijikai
Addict
Addict
Posts: 1360
Joined: Sun Sep 11, 2016 2:17 pm

Re: Select a rectangle on the screen

Post by Mijikai »

HBitmapFromScreen() leaks a GDI object!
AZJIO
Addict
Addict
Posts: 1318
Joined: Sun May 14, 2017 1:48 am

Re: Select a rectangle on the screen

Post by AZJIO »

Delete after use?

Code: Select all

Procedure HBitmapFromScreen(X, Y, W, H)
	Protected hBmp, PDC
	If hBmp
		DeleteObject_(hBmp)
	EndIf
Added to the beginning of the function call. It is also deleted before exiting.
I need to make it global
User avatar
Mijikai
Addict
Addict
Posts: 1360
Joined: Sun Sep 11, 2016 2:17 pm

Re: Select a rectangle on the screen

Post by Mijikai »

Retrive the bitmap out of the dc with SelectObject_(pdc,hOldBitmap)
Post Reply