PureBasic Forums - English

Code: Select all

#DWMWA_EXTENDED_FRAME_BOUNDS = 9
#LB_ITEMFROMPOINT = $1A9
#CAPTUREBLT  = $40000000

UseJPEG2000ImageEncoder()
UseJPEGImageEncoder()
UsePNGImageEncoder()

Global Dim h(100),n,t

Procedure tbWindows(hwnd,lParam)
  title.s = Space(#MAX_PATH)    
  If GetWindowLongPtr_(hwnd,#GWL_EXSTYLE) ! #WS_EX_TOOLWINDOW And GetWindowLongPtr_(hwnd,#GWL_STYLE) & #WS_VISIBLE
    GetWindowText_(hwnd,title,#MAX_PATH)
    If title <> ""
      h(n) = hwnd
      n +1
      AddGadgetItem(0,-1,title)
    EndIf
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure WindowProc(hWnd,uMsg,wParam,lParam)
  Result = #PB_ProcessPureBasicEvents
  Select uMsg 
    Case #WM_NCACTIVATE
        Result = 1
  EndSelect
  ProcedureReturn Result
EndProcedure

LoadFont(0,"Consolas",8)
SetGadgetFont(#PB_Default,FontID(0))
initshadow = 8 
initdelay = 100

OpenWindow(0, 0, 0, 400,155, "Snapshot", #PB_Window_SystemMenu| #PB_Window_ScreenCentered)
StickyWindow(0,1)
ListViewGadget(0,10,10,380,100)
ButtonGadget(1,10,120,60,24,"Re/Start")
ButtonGadget(2,75,120,60,24,"Save As")
TextGadget(3,140,120,40,24,"Delay:",#SS_CENTER|#SS_CENTERIMAGE)
SpinGadget(4,180,120,55,22,0,5000,#PB_Spin_Numeric)
SetGadgetState(4,initdelay)
TextGadget(5,240,120,45,24,"Shadow:",#SS_CENTER|#SS_CENTERIMAGE)
CheckBoxGadget(6,285,120,16,24,"" )
SetGadgetState(6,1)
TextGadget(7,305,120,35,24,"Width:",#SS_CENTER|#SS_CENTERIMAGE)
StringGadget(8,345,122,18,18,"8",#PB_String_Numeric|#ES_CENTER)
OpenWindow(1,0,0,0,0,"",#PB_Window_BorderLess)
SetWindowColor(1,$FEFEFE)
SetWindowLongPtr_(WindowID(1), #GWL_EXSTYLE, #WS_EX_LAYERED)
SetLayeredWindowAttributes_(WindowID(1), 0, 250, #LWA_ALPHA)
SetActiveWindow(0)
SetWindowCallback(@WindowProc())

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      SendMessage_(#HWND_BROADCAST, #WM_SYSCOMMAND, #SC_HOTKEY,GetWindow_(WindowID(0),#GW_HWNDPREV))
      Quit = 1
      
    Case #WM_MOUSEMOVE
      GetCursorPos_(p.POINT)
      ScreenToClient_ (GadgetID(0), @p)
      index = SendMessage_(GadgetID(0),#LB_ITEMFROMPOINT,0,p\y<<16+p\x)
      SetGadgetState(0,index)            
     
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          Select EventType()
            Case #PB_EventType_LeftClick        
              hwnd = h(GetGadgetState(0))
              If IsIconic_(hwnd) = 1
                ShowWindow_(hwnd,#SW_SHOWNORMAL)
                iconflag = 1
              EndIf         
              ahwnd = GetWindow_(hwnd,#GW_HWNDNEXT)
              If OSVersion() >= #PB_OS_Windows_Vista
                lib = OpenLibrary(#PB_Any, "UxTheme.dll")
                If lib
                  *IsThemeActive = GetFunction(lib, "IsThemeActive")
                  If *IsThemeActive
                    Themed = CallFunctionFast(*IsThemeActive)
                  EndIf   
                  CloseLibrary(lib)
                EndIf
                If Themed = 1
                  Lib = OpenLibrary(#PB_Any, "dwmapi.dll")
                  If Lib
                    *DwmIsCompositionEnabled = GetFunction(Lib, "DwmIsCompositionEnabled")
                    If *DwmIsCompositionEnabled
                      CallFunctionFast(*DwmIsCompositionEnabled, @flag)
                    EndIf
                    If flag = 1
                      *DwmGetWindowAttribute = GetFunction(Lib, "DwmGetWindowAttribute")
                      If *DwmGetWindowAttribute                 
                        CallFunctionFast(*DwmGetWindowAttribute, hWnd,  #DWMWA_EXTENDED_FRAME_BOUNDS, wr.RECT, SizeOf(wr))        
                      EndIf
                      shadow = initshadow
                    Else
                      shadow = 0
                      GetWindowRect_(hWnd, wr.RECT)
                    EndIf                    
                  EndIf                  
                  CloseLibrary(Lib)                  
                Else
                  shadow = 0
                  GetWindowRect_(hWnd, wr.RECT)
                EndIf
              Else
                shadow = 0
                GetWindowRect_(hWnd, wr.RECT)
              EndIf
              If Themed = 1
                hBitmap = CreateImage(0,wr\right-wr\left+2*shadow,wr\bottom-wr\top+2*shadow,32,#PB_Image_Transparent )
              Else
                hBitmap = CreateImage(0,wr\right-wr\left+2*shadow,wr\bottom-wr\top+2*shadow)
              EndIf
              MoveWindow_(WindowID(1),wr\left-shadow,wr\top-shadow,wr\right-wr\left+2*shadow,wr\bottom-wr\top+2*shadow,1)
              SetWindowPos_(WindowID(1),#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE)
              SetWindowPos_(hwnd,#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE)
              SendMessage_(#HWND_BROADCAST, #WM_SYSCOMMAND, #SC_HOTKEY, hWnd)
              Delay(GetGadgetState(4))
              hdc = StartDrawing(ImageOutput(0))
              SelectObject_(hdc, hBitmap)
                BitBlt_(hdc,0,0,wr\right-wr\left+2*shadow,wr\bottom-wr\top+2*shadow, GetDC_(0),wr\left-shadow,wr\top-shadow,#SRCCOPY |#CAPTUREBLT)
              StopDrawing()
              ClearClipboard()
              SetClipboardImage(0)
              MoveWindow_(WindowID(1),0,0,1,1,1)
              SetWindowPos_(hwnd,ahwnd,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE|#SWP_NOACTIVATE )
              If iconflag = 1
                ShowWindow_(hwnd,#SW_MINIMIZE	)
                iconflag = 0
              EndIf
          EndSelect
          
        Case 1
          ClearGadgetItems(0)
          n = 0          
          FreeArray(h())
          Dim h(100)
          EnumChildWindows_(FindWindow_("MSTaskSwWClass",0),@tbWindows(),0)
        
        Case 2
          GetClipboardImage(0,32)
          sFile$ = SaveFileRequester("Please choose file to save",""," All supported formats|*.bmp;*.jpg; *.jpeg; *.jp2; *.png | PNG image (*.png)| *.png| BMP image (*.bmp)| *.bmp| JPEG image (*.jpg;*.jpeg)",0)
          If sFile$
            Select LCase(GetExtensionPart(sFile$))
              Case "bmp"
                SaveImage(0,sFile$,#PB_ImagePlugin_BMP)
                 
              Case "png"
                SaveImage(0,sFile$,#PB_ImagePlugin_PNG)
                
              Case "jpg"
                SaveImage(0,sFile$,#PB_ImagePlugin_JPEG)
              
              Case "jpeg","jp2"
                SaveImage(0,sFile$,#PB_ImagePlugin_JPEG2000)                
            EndSelect
          EndIf
          
        Case 6
          If GetGadgetState(6) = 1
            initshadow = Val(GetGadgetText(8))
          Else
            initshadow = 0
          EndIf
          
        Case 8
          initshadow = Val(GetGadgetText(8))
          
      EndSelect
  EndSelect
Until Quit = 1

Code: Select all

  hwnd = h(GetGadgetState(0))