PureBasic Forums - English

Posted: **Sat Sep 29, 2012 5:08 am**

Hi experts....

Hope you can kindly assist me...

I am using the following codes for screen capture obtained from forum here ... it works fine.

However , like all sreen captures we need an option to allow to select the size and part of the screen to be captured.
This can be accomplished by changing the widht and height of the capture.

However , I need to allow the users to resize on the screen with a GUI , so that they can actually pin point the actual part of the screen to be captured.

Is there a ready script for this anywhere or maybe can provide me a hint on the syntax to use...or which purebasic syntax can enable this ?

Many thanks to you all...

Regards
Alan

[quote;capture a piece of screen
Procedure.l CaptureScreen(Left.l, Top.l, Width.l, Height.l)
dm.DEVMODE
BMPHandle.l
srcDC = CreateDC_("DISPLAY", "", "", dm)
trgDC = CreateCompatibleDC_(srcDC)
BMPHandle = CreateCompatibleBitmap_(srcDC, Width, Height)
SelectObject_( trgDC, BMPHandle)
BitBlt_( trgDC, 0, 0, Width, Height, srcDC, Left, Top, #SRCCOPY)
DeleteDC_( trgDC)
ReleaseDC_( BMPHandle, srcDC)
ProcedureReturn BMPHandle
EndProcedure

;ScreenCaptureAddress = CaptureScreen(192, 112, 256, 256)
ScreenCaptureAddress = CaptureScreen(00,0, 1000, 1000)

UseJPEGImageEncoder()

CreateImage(0, 1000, 1000)

;StartDrawing(ImageOutput())
StartDrawing(ImageOutput(0))
DrawImage(ScreenCaptureAddress, 0, 0)
StopDrawing()
SaveImage(0, "c:\Screenshotjpg2.JPG",#PB_ImagePlugin_JPEG)
RunProgram("c:\screenshotjpg2.jpg")
][/quote]

Posted: **Sat Sep 29, 2012 7:56 am**

I did it by using a window with a transparent background -- the window was resizable and a button "capture".
The user resizes the window, clicks 'capture', capture hides itself, the capture captures that window (or use the coordinates from the window and hide the window)....

Posted: **Sat Sep 29, 2012 8:10 am**

jassing wrote:I did it by using a window with a transparent background -- the window was resizable and a button "capture".
The user resizes the window, clicks 'capture', capture hides itself, the capture captures that window (or use the coordinates from the window and hide the window)....

Thanks for your reply.

That seems to be a way to do it.

However, how do you make a window with tranparent backgroud.?

Regards
Alan

Posted: **Sat Sep 29, 2012 9:59 am**

AlanFoo wrote:However, how do you make a window with tranparent backgroud.?

this procedure make a color (you can set it with SetwindowColor()) fully transparent...
Famous color for that is $FF00FF

Code: Select all

Procedure SetWindowCutColor(Window, Color) ; macht alle Pixel der Farbe Transparency durchsichtig
  
  If IsWindow(Window)
    Protected WindowID = WindowID(Window)
    SetWindowLongPtr_(WindowID,#GWL_EXSTYLE,#WS_EX_LAYERED)
    SetLayeredWindowAttributes_(WindowID,Color,0,#LWA_COLORKEY)
  EndIf

EndProcedure

Edit : Also with this procedure you can "skin" your window (if you made it borderless for example)

Posted: **Sat Sep 29, 2012 11:01 am**

this procedure make a color (you can set it with SetwindowColor()) fully transparent...

Just for information, it's strange because your code works, but the window not keep the transparency on XP

Code: Select all

Enumeration
 #String0
 #Bouton0
 #Form0
EndEnumeration

Procedure SetWindowCutColor(Window, Color) ; macht alle Pixel der Farbe Transparency durchsichtig
  
 If IsWindow(Window)
  Protected WindowID = WindowID(Window)
  SetWindowLongPtr_(WindowID,#GWL_EXSTYLE,#WS_EX_LAYERED)
  SetLayeredWindowAttributes_(WindowID,Color,0,#LWA_COLORKEY)
 EndIf

EndProcedure

OpenWindow(#Form0, 450, 69, 287, 236, "New window ( 0 )",  #PB_Window_BorderLess)
StringGadget(#String0, 27, 23, 162, 31, "")
ButtonGadget(#Bouton0, 150, 177, 74, 32, "")
SetWindowCutColor(#Form0, $FF00FF)

Repeat
  
 Evenement = WaitWindowEvent()
     
Until Evenement = #PB_Event_CloseWindow

Posted: **Sat Sep 29, 2012 10:40 pm**

KCC.... you have to set the WindowColor to $ff00ff...

Code: Select all

SetWindowColor(#Form0, $FF00FF)
SetWindowCutColor(#Form0, $FF00FF)

All Pixel with the color $FF00FF are now transparent. So you see only the frame and the Gadgets of the window.
If you put an imagegadget with an image that contains also pixel with this color in it, they are also transparent.

Posted: **Sun Sep 30, 2012 3:57 am**

Bisonte wrote:KCC.... you have to set the WindowColor to $ff00ff...
Code: Select all
SetWindowColor(#Form0, $FF00FF)
SetWindowCutColor(#Form0, $FF00FF)
All Pixel with the color $FF00FF are now transparent. So you see only the frame and the Gadgets of the window.
If you put an imagegadget with an image that contains also pixel with this color in it, they are also transparent.

Dear Bisonte,

I works beautifully. Thanks a million.

Btw... I tried with other colors like black or any color, they became transparent too so long as both

Code: Select all

SetWindowColor(#Form0, $00000)
SetWindowCutColor(#Form0, $000000)

are of the same color. It became completely transparent.

How to get say a slight color tint but transparent too able to see the background so that if I use the borderless windows optoin, the color tint can indicate the areas to be selected.Right now it looked completely invisible.
Thanks

Warmest regards

Alan

Posted: **Sun Sep 30, 2012 5:35 am**

Here's a short example, you can move the window around with the mouse and right-click it for a menu to close it:

Code: Select all

OpenWindow(0,0,0,512,512,"",#PB_Window_ScreenCentered|#PB_Window_BorderLess)
SetWindowColor(0, RGB(100,0,0))
SetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE,GetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE)|#WS_EX_LAYERED)
SetLayeredWindowAttributes_(WindowID(0), RGB(100,0,0), 80, #LWA_ALPHA)
CreatePopupMenu(0)
MenuItem(1, "Quit")
MenuItem(2, "Cancel")
SetClassLongPtr_(WindowID(0), #GCL_HCURSOR, LoadCursor_(0, #IDC_SIZEALL))

Repeat
  EventID = WaitWindowEvent()
  Select EventID
    Case #WM_LBUTTONDOWN
      SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
      
    Case #WM_RBUTTONUP
      DisplayPopupMenu(0, WindowID(0))
      
    Case #PB_Event_Menu
      Select EventMenu()
        Case 1
          End
      EndSelect
      
  EndSelect
Until EventID = #PB_Event_CloseWindow

Posted: **Sun Sep 30, 2012 6:39 am**

netmaestro wrote:Here's a short example, you can move the window around with the mouse and right-click it for a menu to close it:

Code: Select all

OpenWindow(0,0,0,512,512,"",#PB_Window_ScreenCentered|#PB_Window_BorderLess)
SetWindowColor(0, RGB(100,0,0))
SetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE,GetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE)|#WS_EX_LAYERED)
SetLayeredWindowAttributes_(WindowID(0), RGB(100,0,0), 80, #LWA_ALPHA)
CreatePopupMenu(0)
MenuItem(1, "Quit")
MenuItem(2, "Cancel")
SetClassLongPtr_(WindowID(0), #GCL_HCURSOR, LoadCursor_(0, #IDC_SIZEALL))

Repeat
  EventID = WaitWindowEvent()
  Select EventID
    Case #WM_LBUTTONDOWN
      SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
      
    Case #WM_RBUTTONUP
      DisplayPopupMenu(0, WindowID(0))
      
    Case #PB_Event_Menu
      Select EventMenu()
        Case 1
          End
      EndSelect
      
  EndSelect
Until EventID = #PB_Event_CloseWindow

Hi Netmaestro,

Thanks for your response. It works beautifully with a transparent tint.

Notice that there is no resizeable option while it can be moved around nicely and right click quits the program.

I put in resize ... but it creates windows borders but is able to resize as usual.
Good but not perfect.

It would be nice if your routine is able to be resized without the windows border so that users will know exactly the area they wanted to capture screen. If that is possible then it would be perfect.

Thanks again for your assistance.

Warmest regards
Alan

Posted: **Sun Sep 30, 2012 7:12 am**

AlanFoo wrote:Good but not perfect. It would be nice if your routine is able to be resized without the windows border so that users will know exactly the area they wanted to capture screen.

Hi Alan. I don't think that resize would work without the borders. However, you could remove the titlebar if you used the Windows constants #WS_SIZEBOX or #WS_THICKFRAME, instead of PureBasic's #PB_Window_SizeGadget flag, which creates the titlebar by default:

Code: Select all

OpenWindow(0,0,0,512,512,"",#PB_Window_ScreenCentered|#PB_Window_BorderLess|#WS_SIZEBOX)

OpenWindow(0,0,0,512,512,"",#PB_Window_ScreenCentered|#PB_Window_BorderLess|#WS_THICKFRAME)

Not perfect, but better.

Posted: **Sun Sep 30, 2012 7:48 am**

Added 8 Size Boxes (CanvasGadgets) at the corners + sides and StickyWindow(0,#True) to stay on top:

Code: Select all

#BOXSIZE = 6

Procedure WindowCallback(hWnd, msg, wParam, lParam)
    If msg = #WM_SIZE
        ww = lParam & $FFFF
        wh = (lParam >> 16) & $FFFF
        ResizeGadget(0,0,0,#BOXSIZE,#BOXSIZE)
        ResizeGadget(1,ww/2-#BOXSIZE/2,0,#BOXSIZE,#BOXSIZE)
        ResizeGadget(2,ww-#BOXSIZE,0,#BOXSIZE,#BOXSIZE)
        ResizeGadget(3,ww-#BOXSIZE,wh/2-#BOXSIZE/2,#BOXSIZE,#BOXSIZE)
        ResizeGadget(4,ww-#BOXSIZE,wh-#BOXSIZE,#BOXSIZE,#BOXSIZE)
        ResizeGadget(5,ww/2-#BOXSIZE/2,wh-#BOXSIZE,#BOXSIZE,#BOXSIZE)
        ResizeGadget(6,0,wh-#BOXSIZE,#BOXSIZE,#BOXSIZE)
        ResizeGadget(7,0,wh/2-#BOXSIZE/2,#BOXSIZE,#BOXSIZE)
        ProcedureReturn 0
    EndIf
    ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

OpenWindow(0,0,0,512,512,"",#PB_Window_ScreenCentered|#PB_Window_BorderLess)
StickyWindow(0,#True)
SetWindowColor(0, RGB(0,100,255)) ; RGB(120,120,120)
SetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE,GetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE)|#WS_EX_LAYERED)
SetLayeredWindowAttributes_(WindowID(0), RGB(100,0,0), 120, #LWA_ALPHA)
CreatePopupMenu(0)
MenuItem(1, "Quit")
MenuItem(2, "Cancel")
SetClassLongPtr_(WindowID(0), #GCL_HCURSOR, LoadCursor_(0, #IDC_SIZEALL))

wh = WindowHeight(0)
ww = WindowWidth(0)

CanvasGadget(0,0,0,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(0,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
CanvasGadget(1,ww/2-#BOXSIZE/2,0,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(1,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
CanvasGadget(2,ww-#BOXSIZE,0,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(2,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
CanvasGadget(3,ww-#BOXSIZE,wh/2-#BOXSIZE/2,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(3,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
CanvasGadget(4,ww-#BOXSIZE,wh-#BOXSIZE,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(4,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
CanvasGadget(5,ww/2-#BOXSIZE/2,wh-#BOXSIZE,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(5,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
CanvasGadget(6,0,wh-#BOXSIZE,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(6,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
CanvasGadget(7,0,wh/2-#BOXSIZE/2,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(7,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)

SetWindowCallback(@WindowCallback())

Repeat
  EventID = WaitWindowEvent()
  Select EventID
    Case #WM_LBUTTONDOWN
      SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
     
    Case #WM_RBUTTONUP
      DisplayPopupMenu(0, WindowID(0))
     
    Case #PB_Event_Menu
      Select EventMenu()
        Case 1
          End
      EndSelect
    Case #PB_Event_Gadget
        If EventGadget() >= 0 And EventGadget() <= 7 And EventType()=#PB_EventType_LeftButtonDown
            Select EventGadget()
                Case 0: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTTOPLEFT     , 0)
                Case 1: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTTOP         , 0)
                Case 2: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTTOPRIGHT    , 0)
                Case 3: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTRIGHT       , 0)
                Case 4: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTBOTTOMRIGHT , 0)
                Case 5: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTBOTTOM      , 0)
                Case 6: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTBOTTOMLEFT  , 0)
                Case 7: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTLEFT        , 0)
            EndSelect
        EndIf
     
  EndSelect
Until EventID = #PB_Event_CloseWindow

Posted: **Sun Sep 30, 2012 8:39 am**

TI-994A wrote:
AlanFoo wrote:Good but not perfect. It would be nice if your routine is able to be resized without the windows border so that users will know exactly the area they wanted to capture screen.
Hi Alan. I don't think that resize would work without the borders. However, you could remove the titlebar if you used the Windows constants #WS_SIZEBOX or #WS_THICKFRAME, instead of PureBasic's #PB_Window_SizeGadget flag, which creates the titlebar by default:
Code: Select all
OpenWindow(0,0,0,512,512,"",#PB_Window_ScreenCentered|#PB_Window_BorderLess|#WS_SIZEBOX)

OpenWindow(0,0,0,512,512,"",#PB_Window_ScreenCentered|#PB_Window_BorderLess|#WS_THICKFRAME)
Not perfect, but better.

Hi TI-994,

Very many thanks indeed to all who responded

Yes, but using #WS ... , the title bar is gone and do have a small thin border.
It definitely is better and to me .. near to perfect and good enough for my work. :>)

Really appreciative on the help provided by all.
Great forum .

Warmest regards
Alan

Posted: **Sun Sep 30, 2012 4:01 pm**

hello
Good code Danilo, thank you.

No resize on windows with windows seven : PackardBell DOTS E2 32bits
PB 4.61 & PB 5 b2

goodday

Posted: **Sun Sep 30, 2012 4:41 pm**

kernadec wrote:No resize on windows with windows seven : PackardBell DOTS E2 32bits
PB 4.61 & PB 5 b2

Hmm, it does not work on Win7 32bits? Works here on Win7 64bit.

lParam for #WM_NCLBUTTONDOWN should contain the cursor position, maybe that's the reason it didn't work?
Maybe make the #BOXSIZE little bit bigger?

Code: Select all

#BOXSIZE = 8

Procedure WindowCallback(hWnd, msg, wParam, lParam)
    If msg = #WM_SIZE
        ww = lParam & $FFFF
        wh = (lParam >> 16) & $FFFF
        ResizeGadget(0,0,0,#BOXSIZE,#BOXSIZE)
        ResizeGadget(1,ww/2-#BOXSIZE/2,0,#BOXSIZE,#BOXSIZE)
        ResizeGadget(2,ww-#BOXSIZE,0,#BOXSIZE,#BOXSIZE)
        ResizeGadget(3,ww-#BOXSIZE,wh/2-#BOXSIZE/2,#BOXSIZE,#BOXSIZE)
        ResizeGadget(4,ww-#BOXSIZE,wh-#BOXSIZE,#BOXSIZE,#BOXSIZE)
        ResizeGadget(5,ww/2-#BOXSIZE/2,wh-#BOXSIZE,#BOXSIZE,#BOXSIZE)
        ResizeGadget(6,0,wh-#BOXSIZE,#BOXSIZE,#BOXSIZE)
        ResizeGadget(7,0,wh/2-#BOXSIZE/2,#BOXSIZE,#BOXSIZE)
        ;ProcedureReturn 0
    EndIf
    ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

OpenWindow(0,0,0,512,512,"",#PB_Window_ScreenCentered|#PB_Window_BorderLess)
StickyWindow(0,#True)
SetWindowColor(0, RGB(0,100,255)) ; RGB(120,120,120)
SetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE,GetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE)|#WS_EX_LAYERED)
SetLayeredWindowAttributes_(WindowID(0), RGB(100,0,0), 120, #LWA_ALPHA)
CreatePopupMenu(0)
MenuItem(1, "Quit")
MenuItem(2, "Cancel")
SetClassLongPtr_(WindowID(0), #GCL_HCURSOR, LoadCursor_(0, #IDC_SIZEALL))

wh = WindowHeight(0)
ww = WindowWidth(0)

CanvasGadget(0,0,0,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(0,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
CanvasGadget(1,ww/2-#BOXSIZE/2,0,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(1,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
CanvasGadget(2,ww-#BOXSIZE,0,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(2,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
CanvasGadget(3,ww-#BOXSIZE,wh/2-#BOXSIZE/2,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(3,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
CanvasGadget(4,ww-#BOXSIZE,wh-#BOXSIZE,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(4,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
CanvasGadget(5,ww/2-#BOXSIZE/2,wh-#BOXSIZE,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(5,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
CanvasGadget(6,0,wh-#BOXSIZE,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(6,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
CanvasGadget(7,0,wh/2-#BOXSIZE/2,#BOXSIZE,#BOXSIZE)
    SetGadgetAttribute(7,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)

SetWindowCallback(@WindowCallback())

Repeat
  EventID = WaitWindowEvent()
  Select EventID
    Case #WM_LBUTTONDOWN
      GetCursorPos_(@pt.POINT)
      cursor = (pt\x << 16) | pt\y
      SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, cursor)
     
    Case #WM_RBUTTONUP
      DisplayPopupMenu(0, WindowID(0))
     
    Case #PB_Event_Menu
      Select EventMenu()
        Case 1
          End
      EndSelect
    Case #PB_Event_Gadget
        If EventGadget() >= 0 And EventGadget() <= 7 And EventType()=#PB_EventType_LeftButtonDown
            GetCursorPos_(@pt.POINT)
            cursor = (pt\x << 16) | pt\y
            Select EventGadget()
                Case 0: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTTOPLEFT     , cursor)
                Case 1: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTTOP         , cursor)
                Case 2: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTTOPRIGHT    , cursor)
                Case 3: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTRIGHT       , cursor)
                Case 4: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTBOTTOMRIGHT , cursor)
                Case 5: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTBOTTOM      , cursor)
                Case 6: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTBOTTOMLEFT  , cursor)
                Case 7: SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTLEFT        , cursor)
            EndSelect
        EndIf
     
  EndSelect
Until EventID = #PB_Event_CloseWindow

Tested also on WinXP Pro and it works here.

Posted: **Sun Sep 30, 2012 7:00 pm**

test new code with # BOXSIZE up to 20 without success.
move windows in all codes to mouse and padmouse is ok

redimentionnent does not function with the mouse and padmouse

Danilo thank you for your work
bye

PureBasic Forums - English

How to create resize box on desktop?

How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?

Re: How to create resize box on desktop?