Saving screenshots of open Windows with graphic files

[Eugene Lutsenko]

Thanks, Roger!

If you press Alt+PrtScr on the keyboard before exiting 1.4 mode, i.e. put an image of the active window in the clipboard, everything works correctly. But if you do not press anything, you get an image of the part of the screen that is behind the active window. I would also like to do not have anything to press and the screen was not at all the image of this dummy button "PrtScr"

[Eugene Lutsenko]

How to make when you open a new window first of all its screenshot was saved as a file, and after that everything else was done? In the screenshot should be only this new window and nothing else

[Eugene Lutsenko]

In principle, something similar happened, but not quite. 1st picture- what happened, and the 2nd is what I would like.

Code: Select all

/* ----- Create ToolBar ----- */

mStr1 = L('Помощь')                                  ;mStr1Len = LEN(mStr1)
mStr2 = L('1.Выбрать язык текущим')                  ;mStr2Len = LEN(mStr2)
mStr3 = L('2.Выбрать язык текущим и сделать перевод');mStr3Len = LEN(mStr3)
mStr4 = L('3.Создать все языковые базы')             ;mStr4Len = LEN(mStr4)

 d    = 7                                                                                                                   
 n    = 1.5                                                                                                                   
 mL   = 20
 mK   = 0.3

*bSaveScreen := {||SaveScreenAsFile(Disk_dir+'/Aid_data/Screenshots/F1_4.jpg'), DC_GetRefresh(GetList)}

 @ 43, 0           DCGROUP oGroup1 CAPTION L(' ') SIZE 137, 3.0
 @  1, 1           DCPUSHBUTTON    CAPTION mStr1 SIZE mStr1Len+(mL-mStr1Len)*mK+n, 1.5 ACTION {||Help14(), DC_GetRefresh(GetList)}                                  PARENT oGroup1
 @  1, DCGUI_COL+d DCPUSHBUTTON    CAPTION mStr2 SIZE mStr2Len+(mL-mStr2Len)*mK+n, 1.5 ACTION {||SelectLang(1, Languages->ISO639_1,'один'), DC_GetRefresh(GetList)} PARENT oGroup1
 @  1, DCGUI_COL+d DCPUSHBUTTON    CAPTION mStr3 SIZE mStr3Len+(mL-mStr3Len)*mK+n, 1.5 ACTION {||SelectLang(0, Languages->ISO639_1,'один'), DC_GetRefresh(GetList)} PARENT oGroup1
 @  1, DCGUI_COL+d DCPUSHBUTTON    CAPTION mStr4 SIZE mStr4Len+(mL-mStr4Len)*mK+n, 1.5 ACTION {||CreateAllLangBases(),                      DC_GetRefresh(GetList)} PARENT oGroup1
*@  1, DCGUI_COL+d DCPUSHBUTTON    CAPTION 'PrtScr' SIZE LEN('PrtScr'), 1.5 ACTION {||SaveScreenAsFile(Disk_dir+'/Aid_data/Screenshots/F1_4.jpg'), DC_GetRefresh(GetList)} PARENT oGroup1

****** Отображение таблицы ***************

DCSETPARENT TO

@ 5, 0 DCBROWSE oBrowse ALIAS 'Languages' SIZE 137,38 ;
       PRESENTATION DC_BrowPres() ;       // Только просмотр БД
       NOSOFTTRACK ;
       HEADLINES 2 ;                      // Кол-во строк в заголовке (перенос строки - ";")
       SCOPE ;
       ITEMMARKED bItems;
       COLOR {||IIF(LEN(ALLTRIM(Languages->SELECT))>0, {nil,aColor[153]}, IIF(Languages->APPEALS>0, {nil,aColor[39]}, {nil,GRA_CLR_WHITE}))}

*DCSETPARENT oBrowse

 DCGETOPTIONS TABSTOP

*** Подарок от Роджера

DCBROWSECOL FIELD Languages->LANGCODE HEADER L("Lang;Code" )        PARENT oBrowse WIDTH 4
DCBROWSECOL FIELD Languages->SELECT   HEADER L("Current;language" ) PARENT oBrowse WIDTH 10 
DCBROWSECOL FIELD Languages->LANGUAGE HEADER L("ISO language name") PARENT oBrowse WIDTH 52
DCBROWSECOL FIELD Languages->APPEALS  HEADER L("Number;appeals"   ) PARENT oBrowse WIDTH 10
DCBROWSECOL FIELD Languages->ISO639_1 HEADER L("ISO;639-1"        ) PARENT oBrowse WIDTH 6

DCGETOPTIONS SAYFONT '10.Helv Bold' TABSTOP AUTORESIZE

bSaveScreen := {||DC_Scrn2ImageFile(oBrowse,Disk_dir+'/Aid_data/Screenshots/F1_4.bmp'), DC_GetRefresh(GetList)}

DCREAD GUI ;
   FIT ;
   OPTIONS GetOptions ;
   MODAL ;
   SetAppWindow;
   TITLE L('1.4. Выбор текущего языка интерфейса системы "Эйдос-Х++"');
   CLEAREVENTS;
   EVAL bSaveScreen

[/size]

Code: Select all

FUNCTION DC_Scrn2ImageFile( oXbp, cFileName, nFormat )

LOCAL oSourcePS, oBitmap, oClipBoard, aPos

oSourcePS := oXbp:lockPS()
IF oXbp:isDerivedFrom('XbpDialog')
  aPos := { -4, -4 }
ELSE
  aPos := { 0, 0 }
ENDIF
oBitmap := GraSaveScreen( oSourcePS, aPos, oXbp:currentSize() )

RETURN oBitMap:saveFile( cFileName, nFormat )

[/size]

[Auge_Ohr]

2nd Picture is MDI where Child is "on" DrawingArea.
i guess your Problem are "free" Windows with AppDeskTop() as Parent

---

when running Video i can't use GraSaveScreen() but "PrintScreen" work.
but i do not want hole Screen so i "cut out" just where my Video Windows is on Desktop

Code: Select all

     IF ::oClipBoard:open()
         aFormats := ::oClipBoard:queryFormats()
         IF ASCAN( aFormats, XBPCLPBRD_BITMAP ) > 0
            oBuffer := ::oClipBoard:getBuffer( XBPCLPBRD_BITMAP )
            // cut out part of bitmap  
            oBMP := CutOutBMP( oBuffer, ::aoChild )



FUNCTION CutOutBMP( oBuffer, aoChild )
LOCAL oOutBMP   := XBPBITMAP() :New() :Create()
LOCAL oMain     := GetApplication()
LOCAL oTargetPS := XBPPRESSPACE() :new() :create()
LOCAL nOutSizeX := SP_BMPxSize()
LOCAL nOutSizeY := SP_BMPySize()
LOCAL aPos      := { 0, 0 }
LOCAL aSize     := { 0, 0 }
LOCAL aSize1    := { 0, 0 }

   // Pos / Size of Windows 
   aPos := aoChild[ CH_LOGO ] :CurrentPos()
   aSize := aoChild[ CH_ANZEIG ] :CurrentSize()             // parent of WMP

   // need to adjust position "inside" frame
   aPos[ 1 ] += 10                                          // oAnzeig
   aPos[ 2 ] += 10

   // reduce bottom Size with statusbar
   aSize1 := aoChild[ CH_STATBAR ] :CurrentSize()
   aPos[ 2 ] += aSize1[ 2 ]

   // adjust Border wide  
   aPos[ 1 ] += SP_CXBORDER()
   aPos[ 2 ] += SP_CYBORDER()

   // adjust Frame wide  
   aPos[ 1 ] += SP_CXDLGFRAME()
   aPos[ 2 ] += SP_CYDLGFRAME()

   // still 1 Pixel missing
   aPos[ 1 ] += 1
   aPos[ 2 ] += 1

   IF OnOSVersion() > 5                                     // Vista-Win7 DWM Aero
      * aPos[1] += SP_CXPADDEDBORDER()                      // Border Padding ? 
      * aPos[2] += SP_CXPADDEDBORDER()
   ENDIF

   * ------------------------------------------------------ *

   oOutBMP:presSpace( oTargetPS )
   oOutBMP:make( nInSizeX, nInSizeY )

   oBuffer:Draw( oTargetPS, ;                               // oTargetPS
                 { 0, 0, nOutSizeX, nOutSizeY }, ;          // aTargetRect
                 { aPos[1], aPos[2], aPos[1] + aSize[1], aPos[2] + aSize[2] }, ; // aSourceRect
                 GRA_BLT_ROP_SRCCOPY, ;                     // nRasterOP GRA_BLT_ROP_*
                 GRA_BLT_BBO_IGNORE )                       // nCompress GRA_BLT_BBO_*

   Sleep( 0 )
   oTargetPS:destroy()
   Sleep( 0 )
   oTargetPS := NIL

RETURN oOutBMP

[Eugene Lutsenko]

Thanks, Jimmy!
I'll try it when I get back from work.
(PS Window I have a license. Purchased by the University)

Tom!
Your function uses a command that is analogous to PrtScr: DC_Scrn2Clipboard(). Is it possible to use a command similar to Alt+PrtScr?

Code: Select all

FUNCTION SaveScreenAsFile(cFileName) // hand over filename you want to use
LOCAL oClipBoard, oPicture, nResolution := 30

DC_Scrn2Clipboard()         // <<<######
oClipBoard := XbpClipBoard():new():create()
oClipBoard:open()
oPicture := oClipBoard:GetBuffer(XBPCLPBRD_BITMAP)
oClipBoard:Close()
oPicture:SaveFile(cFileName,XBPBMP_FORMAT_JPG,nResolution)

RETURN File(cFileName)

[Auge_Ohr]

hi,

even you press "Alt+PrtScr", which is same as DC_Scrn2Clipboard(with_Object), you just get 1 Windows

your picture show a transparency Windows which only possible when you have a Top-Windows (AppDeskTop() as Parent).
as you call it from Main Window you never will get both Windows with "Alt+PrtScr"

[Eugene Lutsenko]

Hi, Jimmy! What are these functions?

SP_BMPXSIZE()
SP_BMPYSIZE()
SP_CXBORDER()
SP_CYBORDER()
SP_CXDLGFRAME()
SP_CYDLGFRAME()
ONOSVERSION()

[Auge_Ohr]

Hi, Jimmy! What are these functions?

i do not like PUBLIC so i use a Function for it

Code: Select all

   nCYCAPTION  := GetSystemMetrics( SM_CYCAPTION )
   nCXBORDER   := GetSystemMetrics( SM_CXBORDER )
   nCYBORDER   := GetSystemMetrics( SM_CYBORDER )
   nCXDLGFRAME := GetSystemMetrics( SM_CXDLGFRAME )
   nCYDLGFRAME := GetSystemMetrics( SM_CYDLGFRAME )
   nCXPADDEDBORDER := GetSystemMetrics( SM_CXPADDEDBORDER )

FUNCTION SP_CYCAPTION( nValue )                             // Caption height
   IF( PCOUNT() > 0, nCYCAPTION := nValue, NIL )
RETURN nCYCAPTION

FUNCTION SP_CXBORDER( nValue )                              // Border wide
   IF( PCOUNT() > 0, nCXBORDER := nValue, NIL )
RETURN nCXBORDER

FUNCTION SP_CYBORDER( nValue )                              // Border height
   IF( PCOUNT() > 0, nCYBORDER := nValue, NIL )
RETURN nCYBORDER

FUNCTION SP_CXDLGFRAME( nValue )                            // Dialog X-Frame
   IF( PCOUNT() > 0, nCXDLGFRAME := nValue, NIL )
RETURN nCXDLGFRAME

FUNCTION SP_CYDLGFRAME( nValue )                            // Dialog Y-Frame
   IF( PCOUNT() > 0, nCYDLGFRAME := nValue, NIL )
RETURN nCYDLGFRAME

FUNCTION SP_CXPADDEDBORDER( nValue )                        // Border Padding
   IF( PCOUNT() > 0, nCXPADDEDBORDER := nValue, NIL )
RETURN nCXPADDEDBORDER

FUNCTION OnOSVersion()
LOCAL cVersion := OS( OS_VERSION )
LOCAL nVersion := 0
LOCAL nPosi
   nPosi := AT( ".", cVersion )
   IF nPosi > 0
      nVersion := VAL( SUBSTR( cVersion, 1, nPosi - 1 ) )
   ENDIF
RETURN nVersion

SP_BMPXSIZE() and SP_BMPYSIZE() are the Size i want to have

[Eugene Lutsenko]

Thank you!

Is it possible to define SP_BMPXSIZE() and SP_BMPYSIZE () from the information in the clipboard?

[Auge_Ohr]

Is it possible to define SP_BMPXSIZE() and SP_BMPYSIZE () from the information in the clipboard?

"Print Screen" always make Bitmap from full Screen, that's why i have to "cut out" Pos/Size what i want.