gbClientCapture
#1
This app displays a transparent dialog, with a Toolbar and a Statusbar. Images under the open dialog client area are captured and merged into a horizontal image.  This will be used by my next app to scroll the horizontal image - corresponding to my post about breaking vertical sheet music into scrollable horizontal music.

Discussion is here.

Toolbar buttons:

1. Exit - close gbClientCapture

2. Copy - captures the desktop below the transparent dialog client and saves it as a BMP. each capture is merged with previous captures to form a horizontal image (first captured image on the left, last captured image on the right)

3. New - deletes all images, including the merged image

4. View - opens the current merged image in the default image viewer

The Statusbar keeps track of how many images there are in the image folder.

Here's a picture of the app, with some desktop showing through the client area.

[Image: capture.jpg]

Code and images are here:  https://www.garybeene.com/files/gbclientcapture.zip

Code:
'Compilable Example:  (Jose Includes)
#Compile Exe  "gbclientcapture.exe"
#Dim All

#Debug Error On
#Debug Display On

%Unicode=1
#Include "Win32API.inc"

%IDC_Toolbar   = 500
%IDT_Exit      = 501
%IDT_Copy      = 502
%IDT_New       = 503
%IDT_View      = 504
%IDC_StatusBar = 505

#Resource Manifest, 1,      "icons\xptheme_dpiaware.xml"
#Resource VersionInfo
#Resource StringInfo "0409", "04B0"
#Resource Version$ "CompanyName", "New Vision Concepts"
#Resource Version$ "ProductName", "gbClientCapture"
#Resource Version$ "ProductVersion", "1.0"
#Resource Version$ "FileDescription",  "gbClientCapture - Capture Desktop Behind Client"
#Resource Version$ "LegalCopyright",   "Copyright 2025 New Vision Concepts"

#Resource Icon logo, "icons\alogo.ico"
#Resource Icon zexit, "icons\power.ico"
#Resource Icon zcopy, "icons\copy.ico"
#Resource Icon znew, "icons\new.ico"
#Resource Icon zmerge, "icons\view.ico"

$Ver = "1.0"

Global hDlg, hToolbar, hList, hBrush, hFont As Dword
Global ImageCount, ImageWidth, ImageHeight As Long
Global SBW, SBH, TBW, TBH As Long

Function PBMain() As Long
   Dialog New Pixels, 0, "gbClientCapture  v" + $Ver,300,50,200,100, %WS_OverlappedWindow, %WS_Ex_Layered To hDlg
   Dialog Set Icon hDlg, "logo"
   Dialog Set Color hDlg, %Black, %White
   CreateToolbar

   Control Add Statusbar, hDlg, %IDC_StatusBar, "", 0,0,0,0, %CCS_Bottom Or %SBars_SizeGrip
   Control Get Size hDlg, %IDC_StatusBar To SBW, SBH
   Control Set Color hDlg, %IDC_StatusBar, %Black, %Gray

   Font New "Tahoma",10, 1 To hFont
   Control Set Font hDlg, %IDC_Toolbar, hFont
   Control Set Font hDlg, %IDC_StatusBar, hFont

   Dialog Show Modal hDlg Call DlgProc
End Function

CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         hBrush = CreateSolidBrush(RGB(243,243,243))
         SetWindowPos hDlg, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NOMOVE Or %SWP_NOSIZE
         If IsFalse IsFolder("images") Then MkDir "images"
         Settings_INI "get"
         Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "ImageCount = " + Format$(ImageCount)
         SetLayeredWindowAttributes(hDlg, %White, 255, %LWA_ALPHA Or %LWA_Colorkey)
      Case %WM_ContextMenu
         sBeep : Dialog End hDlg
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDT_Exit  : sBeep : Dialog End hDlg
            Case %IDT_Copy  : sBeep : SaveDialogToClipboard : MergeImages
            Case %IDT_New   : sBeep : NewProject
            Case %IDT_View : sBeep : ViewMerge
         End Select

      Case %WM_Notify
         Select Case Cb.NmId
            Case %IDC_Toolbar
               Local pTbCustDraw As NmTbCustomDraw Pointer
               pTbCustDraw  = Cb.LParam
               Select Case @pTbCustDraw.nmcd.dwDrawStage
                  Case %CDDS_PREPAINT  ' paint entire toolbar
                     FillRect(@pTbCustDraw.nmcd.hdc, @pTbCustDraw.nmcd.rc, hBrush)
                     Function = %CDRF_NOTIFYITEMDRAW
               End Select
         End Select

      Case %WM_Destroy
         DeleteObject hBrush
         Settings_INI "save"
   End Select
End Function

Sub CreateToolbar
   ImageList New Icon 32,32,32,20 To hList
   ImageList Add Icon hList, "zexit"   '1
   ImageList Add Icon hList, "zcopy"   '2
   ImageList Add Icon hList, "znew"    '3
   ImageList Add Icon hList, "zmerge"  '4

   Control Add Toolbar, hDlg, %IDC_Toolbar, "", 0,0,0,0 ', %TbStyle_Flat
   Control Handle hDlg, %IDC_Toolbar To hToolbar
   Toolbar Set ImageList hDlg, %IDC_Toolbar, hList, 0

   Toolbar Add Button hDlg, %IDC_Toolbar, 1, %IDT_Exit, %TbStyle_Button, " Exit "
   Toolbar Add Button hDlg, %IDC_Toolbar, 2, %IDT_Copy, %TbStyle_Button, " Copy "
   Toolbar Add Button hDlg, %IDC_Toolbar, 3, %IDT_New, %TbStyle_Button, " New "
   Toolbar Add Button hDlg, %IDC_Toolbar, 4, %IDT_View, %TbStyle_Button, " View "

   Control Get Size hDlg, %IDC_Toolbar To TBW, TBH

End Sub

Sub Settings_INI(Task$)
   Local x,y,w,h, tempz, INIFileName As WStringZ * %Max_Path, WinPla As WindowPlacement

   'set ini filename
   INIFileName = Exe.Path$ + Exe.Name$ + ".ini"    'get INI file name

   Select Case Task$
      Case "get"
         'get dialog width/height from INI file and use to set Dialog size
         GetPrivateProfileString "All", "Width", "1200", w, %Max_Path, INIFileName
         GetPrivateProfileString "All", "Height", "300", h, %Max_Path, INIFileName
         Dialog Set Size hDlg,Val(w), Val(h)   'width/height

         'get dialog top/left from INI file and use to set Dialog location
         Getprivateprofilestring "All", "Left", "0", x, %Max_Path, INIFileName
         Getprivateprofilestring "All", "Top", "0",  y,  %Max_Path, INIFileName
         If IsFile(INIFileName) Then Dialog Set Loc hDlg, Val(x), Val(y)   'left/top but only once INIFileName exists

         'get value for string variables
'         GetPrivateProfileString "All", "FontName", "Arial Black", FontName, %Max_Path, INIFileName

         'get value for numeric variables
         Getprivateprofilestring "All", "ImageWidth", "",     tempz, %Max_Path, INIFileName   : ImageHeight = Val(tempz)
         Getprivateprofilestring "All", "ImageHeight", "",    tempz, %Max_Path, INIFileName   : ImageWidth = Val(tempz)
         Getprivateprofilestring "All", "ImageCount", "0",    tempz, %Max_Path, INIFileName   : ImageCount = Val(tempz)

      Case "save"
         If IsFile(INIFileName) Then Kill INIFileName    'clear the INI file Name to remove residual entries before saving
         WinPla.Length = SizeOf(WinPla)
         GetWindowPlacement hDlg, WinPla
         WritePrivateProfileString "All", "Left",   Str$(WinPla.rcNormalPosition.nLeft), INIFileName
         WritePrivateProfileString "All", "Top",    Str$(WinPla.rcNormalPosition.nTop), INIFileName
         WritePrivateProfileString "All", "Width",  Str$(WinPla.rcNormalPosition.nRight - WinPla.rcNormalPosition.nLeft), INIFileName
         WritePrivateProfileString "All", "Height", Str$(WinPla.rcNormalPosition.nBottom - WinPla.rcNormalPosition.nTop), INIFileName

         'save string variables
'         WritePrivateProfileString "All", "FontName",   FontName, INIFileName

         'save numeric variables
         WritePrivateProfileString "All", "ImageHeight",    Str$(ImageHeight), INIFileName
         WritePrivateProfileString "All", "ImageWidth",     Str$(ImageWidth), INIFileName
         WritePrivateProfileString "All", "ImageCount",     Str$(ImageCount), INIFileName
   End Select
End Sub

Sub sBeep : WinBeep(275,150) : End Sub

Sub NewProject  'remove all \images\*.bmp
   Local temp$
   Clipboard Reset
   ImageCount = 0
   temp$ = Dir$("images\*.bmp")
   If Len(temp$) Then Kill "images\*.bmp"
   Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "ImageCount = " + Format$(ImageCount)
End Sub

Sub SaveDialogToClipboard
   Local x,y As Long, hBMP, hBMPDC, hDC As Dword       '         abcdegfg
   'create memory bitmap the size of the dialog client (less Toolbar and less StatusBar)
   Dialog Get Client hDlg To ImageWidth, ImageHeight
   ImageWidth = ImageWidth - 1
   ImageHeight = ImageHeight - SBH - TBH - 2

   Graphic Bitmap New ImageWidth, ImageHeight To hBMP
   Graphic Attach hBMP,0
   Graphic Get DC To hBMPDC

   'bitblt dialog rectangle from the screen to the me                            mory bitmap
   Dialog Get Loc hDlg To x,y
   x = x + 9
   y = y + TBH + CaptionHeight - 7
   hDC = GetDC(%Null)
   BitBlt hBMPDC, 0,0,ImageWidth,ImageHeight, hDC, x,y, %SRCCopy 'copy desktop image to
   ReleaseDC(%Null,hDC)

   'save to file
   Incr ImageCount
   Graphic Save "images\" + Format$(ImageCount) + ".bmp"

   'send to clipboard
   Clipboard Reset
   Clipboard Set Bitmap hBMP

   'get rid of the bitmap
   Graphic Bitmap End

   'count images
   Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "ImageCount = " + Format$(ImageCount)

End Sub

Function captionHeight As Long
   Local cw,ch,ddw,ddh As Long
   Dialog Get Size hDlg To ddw,ddh
   Dialog Get Client hDlg To cw,ch
   Function = ddh-ch
End Function

Sub MergeImages
   Local i, x1, y1, x2, y2 As Long
   Local hBMP, hBMPDC As Dword, ImageName$

   If IsFile("merge.bmp") Then Kill "merge.bmp"

   Graphic Bitmap New ImageCount*ImageWidth,ImageHeight To hBMP
   Graphic Attach hBMP,0
   Graphic Get DC To hBMPDC

   For i = 1 To ImageCount
      ImageName$ = "images\" + Format$(i) + ".bmp"
      x1 = (i-1) * ImageWidth
      x2 = x1 + ImageWidth
      y1 = 0
      y2 = ImageHeight
      Graphic Render Bitmap ImageName$, (x1,y1)-(x2,y2)
   Next i

   Graphic Save "merge.bmp"
   Graphic Bitmap End
End Sub

Sub ViewMerge
   Local iReturn As Long, hBMP As Dword

   Graphic Bitmap Load "merge.bmp", 0,0 To hBMP
   Graphic Attach hBMP,0

   Clipboard Reset
   Clipboard Set Bitmap hBMP

   Graphic Bitmap End

   iReturn = ShellExecute(hDlg, "Open", "merge.bmp", $Nul, $Nul, %SW_ShowNormal)
End Sub
Reply


Messages In This Thread
gbClientCapture - by Gary Beene - 20.09.2025, 07:38 PM
RE: gbClientCapture - by Gary Beene - 22.09.2025, 02:15 AM

Forum Jump:


Users browsing this thread: 2 Guest(s)