Printscreen on Windows 7

This forum is for general support of Xbase++
Message
Author
User avatar
Auge_Ohr
Posts: 1422
Joined: Wed Feb 24, 2010 3:44 pm

Re: Printscreen on Windows 7

#11 Post by Auge_Ohr »

hi,

if you need "Printscreen" for your Xbase++ Application you can use

Code: Select all

FUNCTION GraSaveScreen(oSourcePS, aPos, aSize )
on every XbPart like your oMainDialog or other oChildDialog "Windows"
use Rogers

Code: Select all

FUNCTION SaveScreen2ClipBoard()
to save Bitmap or copy it to Clipboard.

more Code for Test:

Code: Select all

#include "AppEvent.ch" 
#include "Xbp.ch" 

#define APPKEY_TOGGLED      2   // Missing from AppEvent.ch 
#define VK_PAUSE      0x13   // Pause / Break (unless Ctrl is pressed) 
#define VK_SNAPSHOT      0x2C   // Print Screen 
#define VK_CAPITAL      0x14   // Caps Lock 
#define VK_NUMLOCK      0x90   // Num Lock key 
#define VK_SCROLL      0x91   // Scroll Lock 

Procedure Main() 
LOCAL nKey   := 0 
LOCAL nEvent := xbe_None 
LOCAL mp1, mp2, oXbp 
   ? "This only works in GUI mode!" 
   while nEvent # xbeP_Close 
      nEvent := AppEvent(@mp1, @mp2, @oXbp, 50)   // Refresh every half second 
      if nEvent # xbe_None 
         oXbp:HandleEvent(nEvent, mp1, mp2) 
      endif 
      if AppType() == APPTYPE_VIO .and. nEvent < 256 
         ShowKeysPressed(nEvent) 
         if nEvent == xbeK_ESC 
            exit 
         endif 
      else 
         nKey := iif(nEvent == xbeP_Keyboard, mp1, 0) 
         ShowKeysPressed(nKey) 
         if nKey == xbeK_ESC 
            exit 
         endif 
      endif 
   enddo 
return 

Procedure ShowKeysPressed(nKey) 
DevPos(03, 0) ; DevOut('XBase++ Key Code: '  + PadR(alltrim(str(nKey)), 10)) 
DevPos(04, 0) ; DevOut('OEM Character   : "' + chr(nKey) + '"') 

DevPos(06, 0) ; DevOut('CAPS   LOCK  '+iif(AppKeyState(VK_CAPITAL , .t.)==APPKEY_TOGGLED,'ON ','OFF')) 
DevPos(07, 0) ; DevOut('NUM    LOCK  '+iif(AppKeyState(VK_NUMLOCK , .t.)==APPKEY_TOGGLED,'ON ','OFF')) 
DevPos(08, 0) ; DevOut('SCROLL LOCK  '+iif(AppKeyState(VK_SCROLL  , .t.)==APPKEY_TOGGLED,'ON ','OFF')) 

DevPos(10, 0) ; DevOut('PAUSE/BREAK  '+iif(AppKeyState(VK_PAUSE)==APPKEY_DOWN,'Down','Up  ')) 
//
// Snapshot is (should be) made before Result of AppKeyState(VK_SNAPSHOT)
//
DevPos(11, 0) ; DevOut('PRINT SCREEN '+iif(AppKeyState(VK_SNAPSHOT)==APPKEY_DOWN,'Down','Up  '))
 
DevPos(13, 0) ; DevOut('SHIFT        '+iif(AppKeyState(xbeK_SHIFT)==APPKEY_DOWN, 'Down','Up  ')) 
DevPos(14, 0) ; DevOut('CTRL         '+iif(AppKeyState(xbeK_CTRL)==APPKEY_DOWN, 'Down','Up  ')) 
DevPos(15, 0) ; DevOut('ALT          '+iif(AppKeyState(xbeK_ALT)==APPKEY_DOWN,'Down','Up  ')) 
return 
and if this still does not work you can try Günter Beyes "SubClass.OBJ" ( or Ot4XB )
"SubClass.OBJ" can be found here http://www.xbaseforum.de/viewtopic.php?f=16&t=4037

Code: Select all

#include "common.ch"
#include "appevent.ch"
#include "xbp.ch"
#include "dll.ch"
//
// für das benötigte subclass.obj
//
#pragma library("user32.lib")
  
// Windows-Message
#define WM_HOTKEY       0x0312
#define WM_APP          0x8000

#define VK_F10            0x79
#define MOD_ALT         0x0001
#define MOD_CONTROL     0x0002
#define MOD_SHIFT       0x0004

// ===========================================================

PROCEDURE Main()
   LOCAL nEvent := 0, mp1, mp2, oXbp
   LOCAL oDlg
   local cMP2
   
   oDlg := CreateDialog()
   
   setappwindow( oDlg )

   oDlg:show()

   setappfocus( oDlg )
   
   DO WHILE nEvent <> xbeP_Close
      nEvent := AppEvent( @mp1, @mp2, @oXbp )
      
      if nEvent ==  xbeP_User + WM_HOTKEY
         
         
         /*
         cMP2 := L2Bin( mp2 )

         MsgBox("Hotkey " + var2char(mp1) + " " + ;
                var2char( Bin2W(substr(cMP2,1,4) ) ), ;
                appname() )
         */
         
         // holt den Dialog nicht in den Vordergrund
         MessageBeep( 0x40 )
         Tone(1234)
      else
         oXbp:handleEvent( nEvent, mp1, mp2 )
      endif
   ENDDO

RETURN

// -----------------------------------------------------
// Keine DBEs, kein Konsolfenster
   
PROCEDURE DBESys() ; return
PROCEDURE AppSys() ; return

// ======================================================

FUNCTION CreateDialog()
   LOCAL oDlg, aPos, aSize
   LOCAL nXsize := 400
   LOCAL nYsize := 100
   
   aSize := AppDesktop():currentSize()

   // zentriert
   aPos  := { ( aSize[1]-nXsize )/2, ( aSize[2]-nYsize ) / 2 }

   oDlg := XbpHotkeyDialog():new( AppDesktop(),, aPos, {nXsize,nYsize}, , FALSE )
   
   oDlg:title    := "Hotkey-Beispiel - Alt+F10"
   oDlg:taskList := .T.
   oDlg:create()

 RETURN oDlg


CLASS XbpHotkeyDialog FROM XbpDialog

EXPORTED:

VAR lHotkeySet

INLINE METHOD Init( oParent, oOwner, aPos, aSize, aPP, lVisible )

   ::lHotkeySet := .F.

   ::XbpDialog:Init( oParent, oOwner, aPos, aSize, aPP, lVisible )

RETURN self

INLINE METHOD Create( oParent, oOwner, aPos, aSize, aPP, lVisible )

local rc

   ::XbpDialog:create( oParent, oOwner, aPos, aSize, aPP, lVisible )

   rc := _Subclass( ::getHWND(), {|a,b,c,d|::HotkeyHandler(a,b,c,d)} )

   // Hotkey definieren. Das funktioniert nur innerhalb des EVM/GUI-Threads,
   // nicht aus Anwendungs-Threads.
   rc := SendMessageA( ::getHWND(), WM_APP+1, 0, 0 )
   
RETURN self

INLINE METHOD Configure( oParent, oOwner, aPos, aSize, aPP, lVisible )

local rc

   if ::lHotkeySet
      // Hotkey entfernen. Das funktioniert nur innerhalb des EVM/GUI-Threads,
      // nicht aus Anwendungs-Threads.

      rc := SendMessageA( ::getHWND(), WM_APP+2, 0, 0 )
   endif

   rc := _Unsubclass( ::getHWND() )

   ::XbpDialog:configure( oParent, oOwner, aPos, aSize, aPP, lVisible )

   rc := _Subclass( ::getHWND(), {|a,b,c,d|::HotkeyHandler(a,b,c,d)} )
   
   rc := SendMessageA( ::getHWND(), WM_APP+1, 0, 0 )

RETURN self

INLINE METHOD Close()

::destroy()

return self

INLINE METHOD Destroy()

local rc

   if ::lHotkeySet
      // Hotkey entfernen. Das funktioniert nur innerhalb des EVM/GUI-Threads,
      // nicht aus Anwendungs-Threads.
      rc := SendMessageA( ::getHWND(), WM_APP+2, 0, 0 )
   endif

   rc := _Unsubclass( ::getHWND() )
   
   ::XbpDialog:destroy()

RETURN self

// wird im EVM/GUI-Thread durch Windows aufgerufen.
INLINE METHOD HotkeyHandler( hwnd, msg, wparam, lparam )

local rc

if msg == WM_HOTKEY
   // Hotkey-Event an Xbase++ weiterleiten
   
   PostAppEvent( xbeP_User + WM_HOTKEY,  wParam, lParam, self  )
   return 0
elseif msg == WM_APP+1
   // Hotkey registrieren

   if ! ::lHotkeySet
      rc := RegisterHotKey( hWnd, 1234, MOD_ALT, VK_F10 )

      if rc <> 0
         ::lHotkeySet := .T.
      endif   
   endif
   return 0
elseif msg == WM_APP+2
   // Hotkey deregistrieren

   if ::lHotkeySet
      rc := UnregisterHotKey( hWnd, 1234 )

      if rc <> 0
         ::lHotkeySet := .F.
      endif
   endif
   return 0
endif

// Defaultverarbeitung aller anderen Messages. 
RETURN _CallPrevWindowProc( hwnd, msg, wparam, lparam )

ENDCLASS

dllfunction RegisterHotKey(hWnd, id, nModifiers, nVKeyCode ) using stdcall from user32.dll

dllfunction UnregisterHotKey(hWnd, id) using stdcall from user32.dll

dllfunction SendMessageA(hWnd, msg, wParam, lParam ) using stdcall from user32.dll

dllfunction MessageBeep( nSoundID ) using stdcall from user32.dll
// EOF 
greetings by OHR
Jimmy

Cliff Wiernik
Posts: 605
Joined: Thu Jan 28, 2010 9:11 pm
Location: Steven Point, Wisconsin USA
Contact:

Re: Printscreen on Windows 7

#12 Post by Cliff Wiernik »

Forgot to test over the Thanksgiving Holiday. Left my computer off. Will check tonight.

Cliff Wiernik
Posts: 605
Joined: Thu Jan 28, 2010 9:11 pm
Location: Steven Point, Wisconsin USA
Contact:

Re: Printscreen on Windows 7

#13 Post by Cliff Wiernik »

I have tested my printscreen process on a 64bit Win7 machine. It works just the same as on a WinXP machine. I will post the code tomorrow if I get the chance. The pixels of the border are a bit different for Win7 vs WinXP, which I have not taken into account, but it works just fine. I print to the default printer using the GraScreenSave process from within the Xbase++ help file. Have not had any problem with this in years. I print the current window as I have defined via an object.

Cliff.

Cliff Wiernik
Posts: 605
Joined: Thu Jan 28, 2010 9:11 pm
Location: Steven Point, Wisconsin USA
Contact:

Re: Printscreen on Windows 7

#14 Post by Cliff Wiernik »

Here is the code I use. Hope it helps. Works just find with Win7 version found on computers from Electronic stores. Did not test on Win7 Professional.

Cliff

Code: Select all

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+      FUNCTION LB_PrintScreen(lPrintNow, lPostEsc, oDialog )
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION LB_PrintScreen(lPrintNow,lPostEsc,oDialog )
  LOCAL oXbp, oBitMap                                                           // PC CAW 11-18-05 added oBitMap
  
  DEFAULT lPrintNow TO .F.
  DEFAULT lPostESC  TO .F.

  m->G_oMsgBox:setcaption('Print Screen Selected')                              // PC CAW 11-08-05 added caption when deferred
    
  IF m->G_cDeferPScreen == 'P' .AND. !lPrintNow
    RETURN NIL
  ENDIF
  
  IF m->G_cDeferPScreen == "Y"
    m->G_cDeferPScreen := 'P'
    RETURN NIL
  ENDIF
  
  oXbp := SetAppFocus()
  
  IF lPostEsc
    PostAppEvent(xbeP_Keyboard,xbeK_ESC,,oXbp)
    sleep(20)
  ENDIF
//dc_debugqout('scrn2clipboard')
//  DC_Scrn2ClipBoard(oDialog)
  oBitMap := LB_Scrn2ClipBoard(oDialog)                                         // PC CAW 11-18-05 added saving to bitmap
  sleep(50)

  IF !m->G_lDisableF12                                                          // PC CAW 11-26-07 Added the ability to disable F12 key for Snagit Printing via PrintScreen Button

    LB_PrintClipBoard(.F.,oBitMap)                                              // PC CAW 11-18-05 added passing of bitmap

  ELSE
    LB_Warning({'That key is not currently available','Press PrintScreen Button!'})
//    keybd_event(VK_SNAPSHOT, 1, 0, 0)
//    keybd_event(VK_MENU, 0, 0, 0)
//    keybd_event(VK_SNAPSHOT, 0, 0, 0)
//    keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0)
//    keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0)
  ENDIF

  sleep(50)
  SetAppFocus(oXbp)                                                             // .T. to preview

  m->G_oMsgBox:setcaption('')                                                   // PC CAW 11-08-05 added caption when deferred
  m->G_cDeferPScreen := 'N'
  RETURN NIL                      

Code: Select all

*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
*+      Function LB_Scrn2ClipBoard( oXbp )
*+
*+        Copies the specified object (oXbp) to clipboard or the application
*+        Application desktop if not specified
*+
*+±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
*+
FUNCTION LB_Scrn2ClipBoard( oXbp )

LOCAL oSourcePS, oBitmap, oClipBoard, aPos

//IF oXbp == NIL //.OR. .T.                                                     // PC CAW 12-15-05 changed to force old way always
                                                                                // PC CAW 12-27-05 changed to modified new way
  keybd_event(VK_SNAPSHOT, 1, 0, 0)
  keybd_event(VK_MENU, 0, 0, 0)
  keybd_event(VK_SNAPSHOT, 0, 0, 0)
  keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0)
  keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0)

  sleep(50)

IF !oXbp == NIL  
//ELSE
  oSourcePS := oXbp:lockPS()
  
  IF oXbp:isDerivedFrom('XbpDialog')
    aPos := { -4, -4 }
  ELSE
    aPos := { 0, 0 }
  ENDIF

  oBitmap := GraSaveScreen( oSourcePS, aPos, oXbp:currentSize() )
//  oClipBoard := XbpClipboard():new():create()                         // PC CAW 12-28-05 commented out the save to clipboard
//  oClipBoard:open()
//  oClipBoard:setBuffer(oBitmap)
//  oClipBoard:close()
//  oClipBoard:destroy()
ENDIF

RETURN oBitmap

skiman
Posts: 1195
Joined: Thu Jan 28, 2010 1:22 am
Location: Sijsele, Belgium
Contact:

Re: Printscreen on Windows 7

#15 Post by skiman »

Hi Cliff,

Thanks for the code. I will test it.
Best regards,

Chris.
www.aboservice.be

Cliff Wiernik
Posts: 605
Joined: Thu Jan 28, 2010 9:11 pm
Location: Steven Point, Wisconsin USA
Contact:

Re: Printscreen on Windows 7

#16 Post by Cliff Wiernik »

I don't use the clipboard. Found to be unreliable and problematic.

Cliff Wiernik
Posts: 605
Joined: Thu Jan 28, 2010 9:11 pm
Location: Steven Point, Wisconsin USA
Contact:

Re: Printscreen on Windows 7

#17 Post by Cliff Wiernik »

Chris, did this work for you??

skiman
Posts: 1195
Joined: Thu Jan 28, 2010 1:22 am
Location: Sijsele, Belgium
Contact:

Re: Printscreen on Windows 7

#18 Post by skiman »

Hi Cliff,

No, still a big black bitmap as result.
Best regards,

Chris.
www.aboservice.be

Cliff Wiernik
Posts: 605
Joined: Thu Jan 28, 2010 9:11 pm
Location: Steven Point, Wisconsin USA
Contact:

Re: Printscreen on Windows 7

#19 Post by Cliff Wiernik »

Works just fine for me on my Windows 7 machine (not the home basic version but the next version). I will try in my Windows 7 professional (or it might be ultimate version). I can also package a small test application for you to test to see if my behaves the same as I have no problems.

skiman
Posts: 1195
Joined: Thu Jan 28, 2010 1:22 am
Location: Sijsele, Belgium
Contact:

Re: Printscreen on Windows 7

#20 Post by skiman »

Cliff,

I'm testing on a Windows 7 Professional 64 bit.
Best regards,

Chris.
www.aboservice.be

Post Reply