AeroShot (PB-Edition)

Share your advanced PureBasic knowledge/code with the community.
User avatar
chi
Addict
Addict
Posts: 1028
Joined: Sat May 05, 2007 5:31 pm
Location: Linz, Austria

AeroShot (PB-Edition)

Post by chi »

Capture any window with transparency and shadow... (Windows only)
Image

Code: Select all

EnableExplicit

UsePNGImageEncoder()

Global title$ = "AeroShot (PB-Edition by chi)"

Define user32 = OpenLibrary(#PB_Any, "user32.dll")
If user32
  If CallFunction(user32, "IsProcessDPIAware") = #PROCESS_DPI_UNAWARE
    CallFunction(user32, "SetProcessDPIAware")
  EndIf
  CloseLibrary(user32)
EndIf

Procedure EnumTaskbarWindows()
  Protected hWnd, id, icon
  hWnd = FindWindow_(0, 0)
  Repeat
    hWnd = GetWindow_(hWnd, #GW_HWNDNEXT)
    If hWnd And IsWindowVisible_(hWnd)
      Protected txt${#MAX_PATH}
      GetWindowText_(hWnd, @txt$, #MAX_PATH)
      If txt$ <> "" And txt$ <> "Start" And txt$ <> "Program Manager" And txt$ <> title$
        icon = GetClassLong_(hWnd, #GCL_HICONSM)
        If icon = 0
          icon = SendMessage_(hWnd, #WM_GETICON, #ICON_SMALL, 0)
          If icon = 0
            icon = LoadIcon_(#Null, #IDI_APPLICATION)
          EndIf
        EndIf
        AddGadgetItem(0, id, txt$, icon)
        SetGadgetItemData(0, id, hWnd)
        id + 1
      EndIf
    EndIf
  Until hWnd = 0
  SetGadgetState(0, 0)
  ProcedureReturn #False
EndProcedure

Procedure CreateScreenshot(hWnd, margin=30, toFile=0)
  If IsWindow_(hWnd)=0 Or IsWindowVisible_(hWnd)=0 : ProcedureReturn 0 : EndIf
  
  If IsIconic_(hWnd)
    Protected ai.ANIMATIONINFO\cbSize = SizeOf(ANIMATIONINFO)
    SystemParametersInfo_(#SPI_GETANIMATION, SizeOf(ANIMATIONINFO), @ai, 0)
    ShowWindow_(hWnd, #SW_RESTORE)
    If ai\iMinAnimate
      Delay(300)
    EndIf
  Else
    SetForegroundWindow_(hWnd)
  EndIf
  Delay(50)
  
  Protected wRect.RECT
  GetWindowRect_(hWnd, @wRect)
  InflateRect_(@wRect, margin, margin)
  
  Protected mi.MONITORINFOEX\cbSize = SizeOf(MONITORINFOEX)
  GetMonitorInfo_(MonitorFromWindow_(hWnd, #MONITOR_DEFAULTTONEAREST), @mi)
  If IsZoomed_(hWnd)
    Enumeration
      #ABS_MANUAL = 0
      #ABS_AUTOHIDE = 1
      #ABS_ALWAYSONTOP = 2
      #ABS_AUTOHIDEANDONTOP = 3
    EndEnumeration
    Protected abd.APPBARDATA, hideAppBar
    Select SHAppBarMessage_(#ABM_GETSTATE, @abd)
      Case #ABS_MANUAL, #ABS_ALWAYSONTOP
        If wRect\left < mi\rcWork\left : wRect\left = mi\rcWork\left : EndIf
        If wRect\top < mi\rcWork\top : wRect\top = mi\rcWork\top : EndIf
        If wRect\right > mi\rcWork\right : wRect\right = mi\rcWork\right : EndIf
        If wRect\bottom > mi\rcWork\bottom : wRect\bottom = mi\rcWork\bottom : EndIf
      Case #ABS_AUTOHIDE, #ABS_AUTOHIDEANDONTOP
        If wRect\left < mi\rcMonitor\left : wRect\left = mi\rcMonitor\left : EndIf
        If wRect\top < mi\rcMonitor\top : wRect\top = mi\rcMonitor\top : EndIf
        If wRect\right > mi\rcMonitor\right : wRect\right = mi\rcMonitor\right : EndIf
        If wRect\bottom > mi\rcMonitor\bottom : wRect\bottom = mi\rcMonitor\bottom : EndIf
        hideAppBar = 1
    EndSelect
  Else
    If wRect\left < mi\rcMonitor\left : wRect\left = mi\rcMonitor\left : EndIf
    If wRect\top < mi\rcMonitor\top : wRect\top = mi\rcMonitor\top : EndIf
    If wRect\right > mi\rcMonitor\right : wRect\right = mi\rcMonitor\right : EndIf
    If wRect\bottom > mi\rcMonitor\bottom : wRect\bottom = mi\rcMonitor\bottom : EndIf
    hideAppBar = 1
  EndIf
  
  If hideAppBar
    Protected StartBt, TrayWnd = FindWindow_("Shell_TrayWnd", #Null)
    If TrayWnd
      Protected tRect.RECT
      GetWindowRect_(TrayWnd, @tRect)
      If IntersectRect_(@tRect, @tRect, @wRect)
        ShowWindow_(TrayWnd, #SW_HIDE)
        StartBt = FindWindow_("Button", "Start")
        If StartBt
          ShowWindow_(StartBt, #SW_HIDE)
        EndIf
      EndIf
    EndIf
  EndIf
  
  OpenWindow(1, wRect\left, wRect\top, wRect\right-wRect\left, wRect\bottom-wRect\top, "", #PB_Window_BorderLess, WindowID(0))
  SetForegroundWindow_(hWnd)
  SetWindowPos_(WindowID(1), hWnd, 0, 0, 0, 0, #SWP_NOSIZE|#SWP_NOMOVE|#SWP_NOACTIVATE)
  
  Protected x, mx = wRect\right-wRect\left - 1
  Protected y, my = wRect\bottom-wRect\top - 1
  
  Protected Dim PixelArray0(mx, my)
  Protected Dim PixelArray1(mx, my)
  
  Protected hdc, xdc
  hdc = CreateDC_("DISPLAY", #Null, #Null, 0)
  
  CreateImage(0, wRect\right-wRect\left, wRect\bottom-wRect\top, 24)
  CreateImage(1, wRect\right-wRect\left, wRect\bottom-wRect\top, 24)
  CreateImage(2, wRect\right-wRect\left, wRect\bottom-wRect\top, 32, #PB_Image_Transparent)
  
  SetClassLongPtr_(WindowID(1), #GCL_HBRBACKGROUND, GetStockObject_(#WHITE_BRUSH))
  RedrawWindow_(WindowID(1), 0, 0, #RDW_ERASE|#RDW_INVALIDATE|#RDW_ERASENOW)
  
  EnableWindow_(hWnd, 0)
  LockWindowUpdate_(hWnd)
  
  xdc = StartDrawing(ImageOutput(0))
  BitBlt_(xdc, 0, 0, wRect\right-wRect\left, wRect\bottom-wRect\top, hdc, wRect\left, wRect\top, #SRCCOPY)
  For y = 0 To my
    For x = 0 To mx
      PixelArray0(x, y) = Point(x, y)
    Next
  Next
  :StopDrawing()
  
  SetClassLongPtr_(WindowID(1), #GCL_HBRBACKGROUND, GetStockObject_(#BLACK_BRUSH))
  RedrawWindow_(WindowID(1), 0, 0, #RDW_ERASE|#RDW_INVALIDATE|#RDW_ERASENOW)
  
  xdc = StartDrawing(ImageOutput(1))
  BitBlt_(xdc, 0, 0, wRect\right-wRect\left, wRect\bottom-wRect\top, hdc, wRect\left, wRect\top, #SRCCOPY)
  For y = 0 To my
    For x = 0 To mx
      PixelArray1(x, y) = Point(x, y)
    Next
  Next
  :StopDrawing()
  
  LockWindowUpdate_(0)
  EnableWindow_(hWnd, 1)
  
  DeleteDC_(hdc)
  CloseWindow(1)
  
  Protected pixelA, pixelB, alpha, r, g, b
  StartDrawing(ImageOutput(2))
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    For y=0 To my
      For x=0 To mx
        pixelA = PixelArray0(x, y)
        pixelB = PixelArray1(x, y)
        alpha = (Red(pixelB) - Red(pixelA) + 255 + Green(pixelB) - Green(pixelA) + 255 + Blue(pixelB) - Blue(pixelA) + 255) / 3
        If alpha > 0
          r = 255 * Red(pixelB) / alpha
          g = 255 * Green(pixelB) / alpha
          b = 255 * Blue(pixelB) / alpha
          If toFile
            Plot(x, y, RGBA(r, g, b, alpha))
          Else
            Plot(x, y, RGBA((r * alpha + 127) * 0.003921, (g * alpha + 127) * 0.003921, (b * alpha + 127) * 0.003921, alpha))
          EndIf
        EndIf
      Next
    Next
  StopDrawing()
  
  If TrayWnd
    ShowWindow_(TrayWnd, #SW_SHOW)
  EndIf
  If StartBt
    ShowWindow_(StartBt, #SW_SHOW)
  EndIf
  
  FreeArray(PixelArray0())
  FreeArray(PixelArray1())
  
  If toFile
    SaveImage(2, GetGadgetText(5), #PB_ImagePlugin_PNG)
  Else
    SetClipboardImage(2)
  EndIf
  
  FreeImage(0)
  FreeImage(1)
  FreeImage(2)
  
  MessageBeep_(#MB_ICONINFORMATION)
  
  ProcedureReturn 1
EndProcedure

Define path$ = GetUserDirectory(#PB_Directory_Desktop) + "Screenshot.png"

OpenWindow(0, 747, 490, 420, 96, title$, #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
ComboBoxGadget(0, 10, 10, 400, 23, #PB_ComboBox_Image)
ButtonGadget(1, 10, 64, 90, 25, "Capture")
ButtonGadget(2, 320, 64, 90, 25, "Refresh List")
SpinGadget(3, 264, 67, 50, 20, 0, 9999, #PB_Spin_Numeric)
TextGadget(4, 222, 67, 40, 20, "Margin", #PB_Text_Right|#SS_CENTERIMAGE)
StringGadget(5, 10, 39, 376, 19, path$)
ButtonGadget(6, 391, 39, 19, 19, "...")
OptionGadget(7, 110, 67, 70, 20, "Clipboard")
OptionGadget(8, 180, 67, 45, 20, "File")
EnumTaskbarWindows()
SetGadgetState(3, 30)
SetGadgetState(7, 1)
HideWindow(0, #False)

Repeat
  Define event = WaitWindowEvent()
  Select event
    Case #PB_Event_Gadget
      Select EventGadget()
          
        Case 1
          Define tmpstat = GetGadgetState(0)
          If tmpstat > -1
            Define tmphWnd = GetGadgetItemData(0, tmpstat)
            If tmphWnd
              If CreateScreenshot(tmphWnd, GetGadgetState(3), GetGadgetState(8))=0
                MessageBeep_(#MB_ICONERROR)
                PostEvent(#PB_Event_Gadget, 0, 2)
              EndIf
            EndIf
          EndIf
          
        Case 2
          ClearGadgetItems(0)
          EnumTaskbarWindows()
          
        Case 6
          path$ = Trim(SaveFileRequester("Save screenshot as...", path$, "PNG (*.png)|*.png", 0))
          If path$ <> ""
            If LCase(Right(path$, 4)) <> ".png"
              path$ + ".png"
            EndIf
            SetGadgetText(5, path$)
          EndIf
          
      EndSelect
  EndSelect
Until event = #PB_Event_CloseWindow

Last edited by chi on Sat Apr 28, 2018 8:46 pm, edited 6 times in total.
Et cetera is my worst enemy
User avatar
spikey
Enthusiast
Enthusiast
Posts: 581
Joined: Wed Sep 22, 2010 1:17 pm
Location: United Kingdom

Re: AeroShot (PB-Edition)

Post by spikey »

Nice!

I'm just in the process of writing a help file and its giving the dialog captures a very nice looking finish!
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: AeroShot (PB-Edition)

Post by Kwai chang caine »

Ouaaaah !!!! Splendid !!!! 8)
And really usefull for me, see even incredible !!!!
Again yesterday i need to capture a skin window, and i'm forced to hide all shortcut of the dektop for have my window alone.
I have testing your jewel on W10, without aero, and only my window appears, even if there is something behind :shock:
I win time thanks to you, from now on :D
Thanks a lot CHI for this nice sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
chi
Addict
Addict
Posts: 1028
Joined: Sat May 05, 2007 5:31 pm
Location: Linz, Austria

Re: AeroShot (PB-Edition)

Post by chi »

Well, glad it works :P

update: fixed a small discrepancy between the clipboard and the saved image...
Et cetera is my worst enemy
uweb
User
User
Posts: 98
Joined: Wed Mar 15, 2006 9:40 am
Location: Germany

Re: AeroShot (PB-Edition)

Post by uweb »

Sorry, but I did test it with three opened windows under Windows 10 x64.
PureBasic - it does not takes the tools panel area and the error log area.
With https://sourceforge.net/projects/console/ it takes wrong coordinates.
With https://www.jam-software.de/ultrasearch/ it is the same, unless it is the first capture.
Thank you even so!
Please pardon my English, my native tongue is German.
User avatar
chi
Addict
Addict
Posts: 1028
Joined: Sat May 05, 2007 5:31 pm
Location: Linz, Austria

Re: AeroShot (PB-Edition)

Post by chi »

uweb wrote:Sorry, but I did test it with three opened windows under Windows 10 x64.
My guess: It's a DPI scaling issue?!
Temp.Fix: You have to switch you display scale to 100% for the program to work.

I'm looking into this issue...
Et cetera is my worst enemy
User avatar
chi
Addict
Addict
Posts: 1028
Joined: Sat May 05, 2007 5:31 pm
Location: Linz, Austria

Re: AeroShot (PB-Edition)

Post by chi »

update: fixed DPI scaling issue
Et cetera is my worst enemy
uweb
User
User
Posts: 98
Joined: Wed Mar 15, 2006 9:40 am
Location: Germany

Re: AeroShot (PB-Edition)

Post by uweb »

Hi chi,
sorry for my late answer.
I was offline at the weekend.
Thank you for your additive work.
Now it works perfect with the PureBasic-Window.
Without DPI scaling :
I get no Titlebar and additional right and below a small black border and a big part of the screen with Console and Ultrasearch.
With DPI scaling :
With Console I get the whole window with a small black additional border around.
In Ultrasearch I get the same error - but now not only by the first capture.
[10:52:37] [ERROR] Line: 112
[10:52:37] [ERROR] CreateImage(): Image 'Width' is too small, should be > 0.
Probably Ultrasearch use abuse.
Please pardon my English, my native tongue is German.
User avatar
chi
Addict
Addict
Posts: 1028
Joined: Sat May 05, 2007 5:31 pm
Location: Linz, Austria

Re: AeroShot (PB-Edition)

Post by chi »

Hi uweb,

does it work for you if you set the display scale to 100%? I have no problems on Win10 x64 (VirtualBox) with Console2 and UltraSearch on 100%, 125% and 150%. So I really don't know how to reproduce your bug... What PB version are you using?
Et cetera is my worst enemy
uweb
User
User
Posts: 98
Joined: Wed Mar 15, 2006 9:40 am
Location: Germany

Re: AeroShot (PB-Edition)

Post by uweb »

Hi chi,
I use PB 5.62 on a Razer Blade FHD - normally with 125%.
May somthing is bad with my system. Thank you for the hint. I will check it in the next days.
Please pardon my English, my native tongue is German.
User avatar
chi
Addict
Addict
Posts: 1028
Joined: Sat May 05, 2007 5:31 pm
Location: Linz, Austria

Re: AeroShot (PB-Edition)

Post by chi »

uweb wrote:Hi chi,
I use PB 5.62 on a Razer Blade FHD - normally with 125%.
May somthing is bad with my system. Thank you for the hint. I will check it in the next days.
Your specs are A-OK, so it should be working fine... Any luck with 100%?
Et cetera is my worst enemy
User avatar
Azias
New User
New User
Posts: 7
Joined: Wed Oct 04, 2017 5:59 pm

Re: AeroShot (PB-Edition)

Post by Azias »

Nice !
I wish I had this tool when I was taking screenshots for some old projects :)

I would just like to suggest something.
Since it's working with windows you could put the icons in the list like this:

Image

You would just have to change 2 lines:

Code: Select all

;~L24
AddGadgetItem(0, id, txt$, GetClassLong_(hWnd, #GCL_HICON))

;~L199
ComboBoxGadget(0, 10, 10, 400, 23, #PB_ComboBox_Image)
The only problem with this simplistic approach is that some programs open iconless windows and it doesn't look that good

Image
Image
User avatar
chi
Addict
Addict
Posts: 1028
Joined: Sat May 05, 2007 5:31 pm
Location: Linz, Austria

Re: AeroShot (PB-Edition)

Post by chi »

@Azias: The code for the UI was intentionally kept small, but you're right, it's a nice addition... Thank you!
I also fixed the missing icon problem ;)

update: ComboBox icons
Et cetera is my worst enemy
User avatar
chi
Addict
Addict
Posts: 1028
Joined: Sat May 05, 2007 5:31 pm
Location: Linz, Austria

Re: AeroShot (PB-Edition)

Post by chi »

update: fixed premultiply alpha calculation. pixels of the clipboard and the saved image are now identical ;)
Et cetera is my worst enemy
BarryG
Addict
Addict
Posts: 3294
Joined: Thu Apr 18, 2019 8:17 am

Re: AeroShot (PB-Edition)

Post by BarryG »

Nice code, but it forces the target window to the foreground. Is there a way to do it without that and keep the Aero theme? Having big windows stealing the focus is not good.
Post Reply