Programme de capture d’une zone quelconque de l'écran

Programmation d'applications complexes
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Programme de capture d’une zone quelconque de l'écran

Message par PAPIPP »

Bonjour à Tous

Voici un petit PRG de capture d’une zone quelconque de l’écran que vous choisirez vous-même
Ce PRG est sans prétention.

Fonctionnement :

1) Lancer le prg

2) Vous obtenez une fenêtre transparente qui peut être déplacée et agrandie à la demande.

3) lors du déplacement, la zone titre n’apparait pas (Chez moi option : propriété du bureau sous XP)
C’est la zone définie lors du déplacement qui fixe les limites du rectangle à capturer.

4) Après ajustement de la fenêtre appuyez sur F12 au relâchement de touche un menu vous
demandera le chemin, le nom et le type de fichier que vous désirez enregistrer(BMP,JPG,PNG).

5) Vous pouvez recommencer autant de fois que vous le désirez cette opération.

6) Pour quitter le PRG :
Cliquez sur X de la zone titre.
Attention la fenêtre transparente n’est pas toujours facile à repérer.

7) Dans la zone titre, si vous cliquez sur – , vous réduisez la fenêtre et si vous cliquez sur agrandir, vous pouvez capturer tout l’écran.

Code : Tout sélectionner

EnableExplicit
Enumeration
  #FEN=0
EndEnumeration
Global nb_p,hwnd,WWIN,WHIN,WWOUT,WHOUT,rcwin.rect,Hwindow
Define eventID
Macro SAVEIMAGE_M
  FichierParDefaut$="C:\"   ; Répertoire et fichier par défaut qui seront affichés
  Filtre$+"PNG (*.png)|*.png|"                   ; Quatrième filtre (index = 3)
  Filtre$+"Bmp (*.bmp)|*.bmp|"                   ; Troisième filtre (index = 2)
  Filtre$+"Jpeg (*.jpg)|*.jpg|"                  ; Quatrième filtre (index = 3)
  Filtre$+"Tous les fichiers (*.*)|*.*"          ; Cinquième filtre (index = 4)
  Filtre=0                                       ; utiliser  par défaut le premier des trois filtres possibles
  TITRE$="Choix du Chemin & donnez un fichier à sauvegarder sans le suffix"
  ltitr=Len(titre$)
  BOUC1:
  TITRE$+Space(10)
  Fichier$=SaveFileRequester(TITRE$,FichierParDefaut$,Filtre$,Filtre)
  If FICHIER$>""
    Index=SelectedFilePattern()
    Select index
      Case 0
        UsePNGImageEncoder()
        SaveImage(img,fichier$+".PNG",#PB_ImagePlugin_PNG)
      Case 1
        SaveImage(img,fichier$+".BMP",#PB_ImagePlugin_BMP)
      Case 2
        UseJPEGImageEncoder()
        SaveImage(img,fichier$+".JPG",#PB_ImagePlugin_JPEG)
      Case 3
        UsePNGImageEncoder()
        UseJPEGImageEncoder()
        UseJPEG2000ImageEncoder()
        SaveImage(img,fichier$,#PB_ImagePlugin_JPEG | #PB_ImagePlugin_PNG | #PB_ImagePlugin_JPEG2000 | #PB_ImagePlugin_BMP)
    EndSelect
  ElseIf Len(titre$)<ltitr+11
    Goto BOUC1
  Else
    MessageRequester("Apès 2 tentatives STOP","STOP STOP STOP")
    End
  EndIf
EndMacro


Macro BITBIT
  img=CreateImage(#PB_Any,WWIN,WHOUT)
  dc=GetDC_(0)
  Fdest=StartDrawing(ImageOutput(img))
    BitBlt_(Fdest,0,0,WWIN,WHOUT,dc,RCWIN\left,RCWIN\top,#SRCCOPY)
  StopDrawing()
  ReleaseDC_(0,dc)
  SAVEIMAGE_M
EndMacro
Procedure.l KeyboardHook(nCode,wParam,*p.KBDLLHOOKSTRUCT)
  Protected img.l,dc.l,Fdest,FichierParDefaut$,Filtre$,Filtre,TITRE$,Fichier$,Index,ltitr
  If wParam=#WM_KEYDOWN Or wParam=#WM_SYSKEYDOWN Or wParam=#WM_KEYUP Or wParam=#WM_SYSKEYUP
    If *p\flags=128 And *p\vkCode=123  ; vkcode de la touche F12 au relachement
      BITBIT
      ProcedureReturn 1
    EndIf
  EndIf
  ProcedureReturn CallNextHookEx_(0,nCode,wParam,*p)
EndProcedure
; Hwindow=OpenWindow(#Fen,0,0,500,400,"Window",#PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
Hwindow=OpenWindow(#Fen,10,10,500,400,"Ajuster la fenêtre & F12",#PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
SetWindowsHookEx_(#WH_KEYBOARD_LL,@KeyboardHook(),GetModuleHandle_(0),0);  SetWindowsHookEx_(#WH_KEYBOARD_LL,@KeyboardHook(),GetModuleHandle_(0),0)
StickyWindow(#Fen,1)
If Hwindow
  SetWindowColor(#Fen,RGB(255,0,0))
  SetWindowLongPtr_(Hwindow,#GWL_EXSTYLE,#WS_EX_LAYERED | #WS_EX_TOPMOST)
  SetLayeredWindowAttributes_(HWindow,RGB(255,0,0),0,#LWA_COLORKEY); RGB(255,0,0) rouge est la couleur à ne pas faire apparaitre donc transparante
  Repeat
    nb_p+1
    Delay(1)
    EventID=WindowEvent()
    If EventID=#PB_Event_CloseWindow
      End
    EndIf
    If nb_p%100=0
      WWIN=WindowWidth(#Fen,#PB_Window_InnerCoordinate)
      WHIN=WindowHeight(#Fen,#PB_Window_InnerCoordinate)
      WWOUT=WindowWidth(#Fen,#PB_Window_FrameCoordinate)
      WHOUT=WindowHeight(#Fen,#PB_Window_FrameCoordinate)
      GetWindowRect_(HWindow,rcwin.rect)
    EndIf
  ForEver
EndIf
A+
Dernière modification par PAPIPP le lun. 01/sept./2014 22:23, modifié 2 fois.
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Avatar de l’utilisateur
SPH
Messages : 4722
Inscription : mer. 09/nov./2005 9:53

Re: Programme de capture d’une zone quelconque de l'écran

Message par SPH »

Pratique 8)
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
raven
Messages : 222
Inscription : jeu. 06/janv./2005 15:45

Re: Programme de capture d’une zone quelconque de l'écran

Message par raven »

bien pratique en effet,merci du partage Papipp.
Pb5.24 Lts/5.31 Windows 7 64 nvidia 560 ti E8500 8g ram
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Programme de capture d’une zone quelconque de l'écran

Message par Ar-S »

Merci Papipp :wink:
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
kernadec
Messages : 1594
Inscription : ven. 25/avr./2008 11:14

Re: Programme de capture d’une zone quelconque de l'écran

Message par kernadec »

bonsoir PAPIPP
Merci, pour le code, il tombe bien!! :mrgreen:
j'en avais fait un dans le genre, mais je me rappel plus ce que j'en ai foutu 8O

Cordialement
Avatar de l’utilisateur
venom
Messages : 3071
Inscription : jeu. 29/juil./2004 16:33
Localisation : Klyntar
Contact :

Re: Programme de capture d’une zone quelconque de l'écran

Message par venom »

Toujours utile ces codes, merci.

Ps: ça ne serait plus propre si la fenêtre ne s'afficherait pas dans la capture finale ?






@++
Windows 10 x64, PureBasic 5.73 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: Programme de capture d’une zone quelconque de l'écran

Message par PAPIPP »

Bonjour à Tous et merci d'avoir essayer ce PRG
@venon
Chez moi je n'ai pas de fenêtre de saisie dans la capture sous XP SP3 .
Mais comme je ne l'efface pas voici le même PRG avec effacement de la fenêtre de saisie au moment de la capture

Code : Tout sélectionner

    EnableExplicit
    UsePNGImageEncoder()
    UseJPEGImageEncoder()
    UseJPEG2000ImageEncoder()
    
    Enumeration
      #FEN=0
    EndEnumeration
    Global nb_p,hwnd,WWIN,WHIN,WWOUT,WHOUT,rcwin.rect,Hwindow
    Define eventID
    Macro SAVEIMAGE_M
      FichierParDefaut$="C:\"   ; Répertoire et fichier par défaut qui seront affichés
      Filtre$+"PNG (*.png)|*.png|"                   ; Premier filtre (index = 0)
      Filtre$+"Bmp (*.bmp)|*.bmp|"                   ; Deuxième filtre (index = 1)
      Filtre$+"Jpeg (*.jpg)|*.jpg|"                  ; Troisième filtre (index = 2)
      Filtre$+"Tous les fichiers (*.*)|*.*"          ; Quatrième filtre (index = 3)
      Filtre=0                                       ; utiliser  par défaut le premier des trois filtres possibles
      TITRE$="Choix du Chemin & donnez un fichier à sauvegarder sans le suffix"
      ltitr=Len(titre$)
      BOUC1:
      TITRE$+Space(10)
      Fichier$=SaveFileRequester(TITRE$,FichierParDefaut$,Filtre$,Filtre)
      If FICHIER$>""
        Index=SelectedFilePattern()
        Select index
          Case 0
            SaveImage(img,fichier$+".PNG",#PB_ImagePlugin_PNG)
          Case 1
            SaveImage(img,fichier$+".BMP",#PB_ImagePlugin_BMP)
          Case 2
            SaveImage(img,fichier$+".JPG",#PB_ImagePlugin_JPEG)
          Case 3
            SaveImage(img,fichier$+".PNG",#PB_ImagePlugin_PNG)
        EndSelect
      ElseIf Len(titre$)<ltitr+11
        Goto BOUC1
      Else
        MessageRequester("Apès 2 tentatives STOP","STOP STOP STOP")
        End
      EndIf
    EndMacro
    
    Macro BITBIT
      img=CreateImage(#PB_Any,WWIN,WHOUT)
      dc=GetDC_(0)
      HideWindow(#Fen,#True)
      ;   Delay(2000)
      Fdest=StartDrawing(ImageOutput(img))
        BitBlt_(Fdest,0,0,WWIN,WHOUT,dc,RCWIN\left,RCWIN\top,#SRCCOPY)
      StopDrawing()
      ReleaseDC_(0,dc)
      HideWindow(#Fen,#False)
      
      SAVEIMAGE_M
    EndMacro
    Procedure.l KeyboardHook(nCode,wParam,*p.KBDLLHOOKSTRUCT)
      Protected img.l,dc.l,Fdest,FichierParDefaut$,Filtre$,Filtre,TITRE$,Fichier$,Index,ltitr
      If wParam=#WM_KEYDOWN Or wParam=#WM_SYSKEYDOWN Or wParam=#WM_KEYUP Or wParam=#WM_SYSKEYUP
        If *p\flags=128 And *p\vkCode=123  ; vkcode de la touche F12 au relachement
          BITBIT
          ProcedureReturn 1
        EndIf
      EndIf
      ProcedureReturn CallNextHookEx_(0,nCode,wParam,*p)
    EndProcedure
    ; Hwindow=OpenWindow(#Fen,0,0,500,400,"Window",#PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
    Hwindow=OpenWindow(#Fen,10,10,500,400,"Ajuster la fenêtre & F12",#PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
    SetWindowsHookEx_(#WH_KEYBOARD_LL,@KeyboardHook(),GetModuleHandle_(0),0);  SetWindowsHookEx_(#WH_KEYBOARD_LL,@KeyboardHook(),GetModuleHandle_(0),0)
    StickyWindow(#Fen,1)
    If Hwindow
      SetWindowColor(#Fen,RGB(255,0,0))
      SetWindowLongPtr_(Hwindow,#GWL_EXSTYLE,#WS_EX_LAYERED | #WS_EX_TOPMOST)
      SetLayeredWindowAttributes_(HWindow,RGB(255,0,0),0,#LWA_COLORKEY); RGB(255,0,0) rouge est la couleur à ne pas faire apparaitre donc transparante
      Repeat
        nb_p+1
        Delay(1)
        EventID=WindowEvent()
        If EventID=#PB_Event_CloseWindow
          End
        EndIf
        If nb_p%50=0
          WWIN=WindowWidth(#Fen,#PB_Window_InnerCoordinate)
          WHIN=WindowHeight(#Fen,#PB_Window_InnerCoordinate)
          WWOUT=WindowWidth(#Fen,#PB_Window_FrameCoordinate)
          WHOUT=WindowHeight(#Fen,#PB_Window_FrameCoordinate)
          GetWindowRect_(HWindow,rcwin.rect)
        EndIf
      ForEver
    EndIf

Voyez-vous une différence ?
A+
Dernière modification par PAPIPP le jeu. 04/sept./2014 7:05, modifié 4 fois.
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Avatar de l’utilisateur
majikeyric
Messages : 602
Inscription : dim. 08/déc./2013 23:19
Contact :

Re: Programme de capture d’une zone quelconque de l'écran

Message par majikeyric »

PAPIPP, tu n'es pas obligé d'appeler UsePNGImageEncoder() avant chaque sauvegarde d'image PNG.
Tu l'appelles une fois au début de ton programme (comme tous les encoders-decoders necéssaires), c'est tout.
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: Programme de capture d’une zone quelconque de l'écran

Message par PAPIPP »

Bonjour majikeyric

C'est exact et c’est corrigé dans le deuxième PRG ci-dessus. Merci
Corrigé aussi l'index 4 tous les fichiers par défaut PNG
A+
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: Programme de capture d’une zone quelconque de l'écran

Message par PAPIPP »

Merci à tous.

Voici la correction demandée par le Forum anglais (option semi-transparente)

Pour obtenir une semi transparence 3 possibilités :
........1) vous lancer le prg en absence d’un paramètre externe il vous sera demandé de donner le niveau de transparence
...............Transparence complète <50
............... Semi-transparence (50 < xxx < 200) limite à 200 MAX
....... 2) Si vous êtes sur l’IDE imposez une valeur de la façon suivante :
.................21) Option du compilateur
.................22) Compiler/exécuter
.................23) Dans Paramètres de l’exécutable tapez une valeur entre 0 et 255
......................Ensuite vous pouvez lancer le prg
........3) Si vous avez compiler le prg
............... Prg.exe xxx (xxx valeur entre 0 et 255)


Code : Tout sélectionner

EnableExplicit
UsePNGImageEncoder()
UseJPEGImageEncoder()
UseJPEG2000ImageEncoder()

Enumeration
  #FEN=0
EndEnumeration
Global nb_p,hwnd,WWIN,WHIN,WWOUT,WHOUT,rcwin.rect,Hwindow
Define eventID,RESinp$,transp,nb_par,i
Macro SAVEIMAGE_M
  FichierParDefaut$="C:\"   ; Répertoire et fichier par défaut qui seront affichés
  Filtre$+"PNG (*.png)|*.png|"                   ; Premier filtre (index = 0)
  Filtre$+"Bmp (*.bmp)|*.bmp|"                   ; Deuxième filtre (index = 1)
  Filtre$+"Jpeg (*.jpg)|*.jpg|"                  ; Troisième filtre (index = 2)
  Filtre$+"Tous les fichiers (*.*)|*.*"          ; Quatrième filtre (index = 3)
  Filtre=0                                       ; utiliser  par défaut le premier des trois filtres possibles
  TITRE$="Choix du Chemin & donnez un fichier à sauvegarder sans le suffix"
  ltitr=Len(titre$)
  BOUC1:
  TITRE$+Space(10)
  Fichier$=SaveFileRequester(TITRE$,FichierParDefaut$,Filtre$,Filtre)
  If FICHIER$>""
    Index=SelectedFilePattern()
    Select index
      Case 0
        SaveImage(img,fichier$+".PNG",#PB_ImagePlugin_PNG)
      Case 1
        SaveImage(img,fichier$+".BMP",#PB_ImagePlugin_BMP)
      Case 2
        SaveImage(img,fichier$+".JPG",#PB_ImagePlugin_JPEG)
      Case 3
        SaveImage(img,fichier$+".PNG",#PB_ImagePlugin_PNG)
    EndSelect
  ElseIf Len(titre$)<ltitr+11
    Goto BOUC1
  Else
    MessageRequester("Apès 2 tentatives STOP","STOP STOP STOP")
    End
  EndIf
EndMacro

Macro BITBIT
  img=CreateImage(#PB_Any,WWIN,WHOUT)
  dc=GetDC_(0)
  HideWindow(#Fen,#True)
  ;   Delay(2000)
  Fdest=StartDrawing(ImageOutput(img))
    BitBlt_(Fdest,0,0,WWIN,WHOUT,dc,RCWIN\left,RCWIN\top,#SRCCOPY)
  StopDrawing()
  ReleaseDC_(0,dc)
  HideWindow(#Fen,#False)
  
  SAVEIMAGE_M
EndMacro
Procedure.l KeyboardHook(nCode,wParam,*p.KBDLLHOOKSTRUCT)
  Protected img.l,dc.l,Fdest,FichierParDefaut$,Filtre$,Filtre,TITRE$,Fichier$,Index,ltitr
  If wParam=#WM_KEYDOWN Or wParam=#WM_SYSKEYDOWN Or wParam=#WM_KEYUP Or wParam=#WM_SYSKEYUP
    If *p\flags=128 And *p\vkCode=123  ; vkcode de la touche F12 au relachement
      BITBIT
      ProcedureReturn 1
    EndIf
  EndIf
  ProcedureReturn CallNextHookEx_(0,nCode,wParam,*p)
EndProcedure
;*********************************** Recherche de paramètre *********************
NB_PAR=CountProgramParameters() ; nombre de paramètre
For i=0 To NB_par-1
  RESinp$=ProgramParameter(i)  ; le dernier paramètre sera pris en compte
Next
If resinp$=""
  RESinp$=InputRequester("Transparent ou semitransparent","Transparent <50  semitansparent 50<xxx<200","0")
EndIf
;***************************************************************************************************************
Hwindow=OpenWindow(#Fen,10,10,500,400,"Ajuster la fenêtre & F12",#PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
If Hwindow
  transp=Val(resinp$)
  If transp <50
    SetWindowColor(#Fen,RGB(255,0,0))
    SetWindowLongPtr_(Hwindow,#GWL_EXSTYLE,#WS_EX_LAYERED | #WS_EX_TOPMOST)
    SetLayeredWindowAttributes_(HWindow,RGB(255,0,0),0,#LWA_COLORKEY); RGB(255,0,0) rouge est la couleur à ne pas faire apparaitre donc transparante
  Else
    If transp>200
      transp=200
    EndIf
    SetWindowLongPtr_(Hwindow,#GWL_EXSTYLE,GetWindowLongPtr_(WindowID(0),#GWL_EXSTYLE) | #WS_EX_LAYERED)
    ; peut-on ne rendre que la partie intérieure transparente  ???
    SetLayeredWindowAttributes_(Hwindow,0,transp,#LWA_ALPHA)
  EndIf
  SetWindowsHookEx_(#WH_KEYBOARD_LL,@KeyboardHook(),GetModuleHandle_(0),0);  SetWindowsHookEx_(#WH_KEYBOARD_LL,@KeyboardHook(),GetModuleHandle_(0),0)
  StickyWindow(#Fen,1)
  Repeat
    nb_p+1
    Delay(1)
    EventID=WindowEvent()
    If EventID=#PB_Event_CloseWindow
      End
    EndIf
    If nb_p%100=0
      WWIN=WindowWidth(#Fen,#PB_Window_InnerCoordinate)
      WHIN=WindowHeight(#Fen,#PB_Window_InnerCoordinate)
      WWOUT=WindowWidth(#Fen,#PB_Window_FrameCoordinate)
      WHOUT=WindowHeight(#Fen,#PB_Window_FrameCoordinate)
      GetWindowRect_(HWindow,rcwin.rect)
    EndIf
  ForEver
EndIf
A+
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Programme de capture d’une zone quelconque de l'écran

Message par Kwai chang caine »

Marche bien sous 5.23 W7
Merci Papipp 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: Programme de capture d’une zone quelconque de l'écran

Message par PAPIPP »

Bonjour à tous

Sur une idée de Danilo voici une capture avec une fenêtre sans barre de titre.
Elle peut être déplacée et redimensionnée avec le bouton gauche de la souris.
Pour la capture après avoir placé et dimensionné la fenêtre taper sur F12.

PS : La transparence peut être modifiée et la couleur du fond aussi dans le PRG.
Pour quitter cliquer sur le bouton droit et cliquer sur Quit.

Code : Tout sélectionner

 EnableExplicit
Enumeration
  #FEN=2
  #POP
  #BOXSIZE=8
EndEnumeration
UsePNGImageEncoder()
UseJPEGImageEncoder()
UseJPEG2000ImageEncoder()
Global nb_p,hwnd,WWIN,WHIN,WWOUT,WHOUT,rcwin.rect,Hwindow
Define eventID,RESinp$,transp,nb_par,i,WID, PT.point, cursor
Macro SAVEIMAGE_M
  FichierParDefaut$="C:\"   ; Répertoire et fichier par défaut qui seront affichés
  Filtre$+"PNG (*.png)|*.png|"                   ; Premier filtre (index = 0)
  Filtre$+"Bmp (*.bmp)|*.bmp|"                   ; Deuxième filtre (index = 1)
  Filtre$+"Jpeg (*.jpg)|*.jpg|"                  ; Troisième filtre (index = 2)
  Filtre$+"Tous les fichiers (*.*)|*.*"          ; Quatrième filtre (index = 3)
  Filtre=0                                       ; utiliser  par défaut le premier des trois filtres possibles
  TITRE$="Choix du Chemin & donnez un fichier à sauvegarder sans le suffix"
  ltitr=Len(titre$)
  BOUC1:
  TITRE$+Space(10)
  Fichier$=SaveFileRequester(TITRE$,FichierParDefaut$,Filtre$,Filtre)
  If FICHIER$>""
    Index=SelectedFilePattern()
    Select index
      Case 0
        SaveImage(img,fichier$+".PNG",#PB_ImagePlugin_PNG)
      Case 1
        SaveImage(img,fichier$+".BMP",#PB_ImagePlugin_BMP)
      Case 2
        SaveImage(img,fichier$+".JPG",#PB_ImagePlugin_JPEG)
      Case 3
        SaveImage(img,fichier$+".PNG",#PB_ImagePlugin_PNG)
    EndSelect
  ElseIf Len(titre$)<ltitr+11
    Goto BOUC1
  Else
    MessageRequester("Apès 2 tentatives STOP","STOP STOP STOP")
    End
  EndIf
EndMacro

Macro BITBIT
  ;       img=CreateImage(#PB_Any,WWIN,WHOUT)
  img=CreateImage(#PB_Any,WWOUT,WHOUT)
  dc=GetDC_(0)
  HideWindow(#Fen,#True)
  ;   Delay(2000)
  Fdest=StartDrawing(ImageOutput(img))
    ;         BitBlt_(Fdest,0,0,WWIN,WHOUT,dc,RCWIN\left,RCWIN\top,#SRCCOPY)
    BitBlt_(Fdest,0,0,WWOUT,WHOUT,dc,RCWIN\left,RCWIN\top,#SRCCOPY)
  StopDrawing()
  ReleaseDC_(0,dc)
  HideWindow(#Fen,#False)
  
  SAVEIMAGE_M
EndMacro
Procedure.l KeyboardHook(nCode,wParam,*p.KBDLLHOOKSTRUCT)
  Protected img.l,dc.l,Fdest,FichierParDefaut$,Filtre$,Filtre,TITRE$,Fichier$,Index,ltitr
  If wParam=#WM_KEYDOWN Or wParam=#WM_SYSKEYDOWN Or wParam=#WM_KEYUP Or wParam=#WM_SYSKEYUP
    If *p\flags=128 And *p\vkCode=123  ; vkcode de la touche F12 au relachement
      BITBIT
      ProcedureReturn 1
    EndIf
  EndIf
  ProcedureReturn CallNextHookEx_(0,nCode,wParam,*p)
EndProcedure

Hwindow=OpenWindow(#FEN,0,0,512,512,"",#PB_Window_BorderLess | #WS_SIZEBOX | #PB_Window_ScreenCentered)
If hwindow
  StickyWindow(#FEN,#True)
  WID=WindowID(#FEN)
  ;************************* En modifiant les valeurs de RGB ci-dessous  vous pouvez modifier la couleur du fond de la fenêtre **************************
  ;   SetWindowColor(#FEN,RGB(200,250,255)) ; RGB(120,120,120) ;RGB(0,100,255) ; Vous pouvez modifier la couleur du fond
  SetWindowLongPtr_(WID,#GWL_EXSTYLE,GetWindowLongPtr_(WID,#GWL_EXSTYLE) | #WS_EX_LAYERED)
  SetLayeredWindowAttributes_(Hwindow,0,100,#LWA_ALPHA) ; ******** Vous pouvez rendre la transparence plus ou moins importante *********
  CreatePopupMenu(#POP)
  MenuItem(1,"Quit")
  MenuItem(2,"Capturer F12")
  SetClassLongPtr_(Hwindow,#GCL_HCURSOR,LoadCursor_(0,#IDC_SIZEALL))
  
  ; ********* on peut supprimer les commentaires des 10 instructions suivantes  **************
  ;   WHOUT=WindowHeight(#FEN,#PB_Window_FrameCoordinate)
  ;   WWOUT=WindowWidth(#FEN,#PB_Window_FrameCoordinate)
  ;   CanvasGadget(0,-#BOXSIZE/2,-#BOXSIZE/2,#BOXSIZE,#BOXSIZE,#PB_Canvas_Border)                   ; Haut Gauche
  ;   CanvasGadget(1,WWOUT/2-#BOXSIZE/2,-#BOXSIZE/2,#BOXSIZE,#BOXSIZE,#PB_Canvas_Border)            ; Haut Milieu
  ;   CanvasGadget(2,WWOUT-#BOXSIZE,-#BOXSIZE/2,#BOXSIZE,#BOXSIZE,#PB_Canvas_Border)                ; Haut Droit
  ;   CanvasGadget(3,WWOUT-#BOXSIZE,WHOUT/2-#BOXSIZE/2,#BOXSIZE,#BOXSIZE,#PB_Canvas_Border)         ; Milieu Droit
  ;   CanvasGadget(4,WWOUT-#BOXSIZE,WHOUT-#BOXSIZE,#BOXSIZE,#BOXSIZE,#PB_Canvas_Border)             ; Bas Droit
  ;   CanvasGadget(5,WWOUT/2-#BOXSIZE/2,WHOUT-#BOXSIZE,#BOXSIZE,#BOXSIZE,#PB_Canvas_Border)         ; Bas milieu
  ;   CanvasGadget(6,-#BOXSIZE/2,WHOUT-#BOXSIZE,#BOXSIZE,#BOXSIZE,#PB_Canvas_Border)                ; Bas gauche
  ;   CanvasGadget(7,-#BOXSIZE/2,WHOUT/2-#BOXSIZE/2,#BOXSIZE,#BOXSIZE,#PB_Canvas_Border)            ; Milieu gauche
  ; ********* on peut supprimer les commentaires des 10 instructions Ci-dessus **************
  
  SetWindowsHookEx_(#WH_KEYBOARD_LL,@KeyboardHook(),GetModuleHandle_(0),0);  SetWindowsHookEx_(#WH_KEYBOARD_LL,@KeyboardHook(),GetModuleHandle_(0),0)
  
  Repeat
;     EventID=WindowEvent()
    EventID=WaitWindowEvent(2)
; *********** Option ci dessous à tester contre l'option   Case #PB_Event_SizeWindow , #PB_Event_MoveWindow un peu plus loin  *********
;     Delay(1)
;     nb_p+1
;     If nb_p%50=0
;       WWIN=WindowWidth(#Fen,#PB_Window_InnerCoordinate)
;       WHIN=WindowHeight(#Fen,#PB_Window_InnerCoordinate)
;       WWOUT=WindowWidth(#Fen,#PB_Window_FrameCoordinate)
;       WHOUT=WindowHeight(#Fen,#PB_Window_FrameCoordinate)
;       GetWindowRect_(HWindow,rcwin.rect)
;     EndIf  
    Select EventID
      Case #WM_LBUTTONDOWN
        GetCursorPos_(@pt.POINT)
        cursor=(pt\x<<16) | pt\y
        SendMessage_(Hwindow,#WM_NCLBUTTONDOWN,#HTCAPTION,cursor)
      Case #WM_RBUTTONUP
        DisplayPopupMenu(#POP,WID)
      Case #PB_Event_Menu
        Select EventMenu()
          Case 1
            End
        EndSelect
              Case #PB_Event_SizeWindow , #PB_Event_MoveWindow
;               WWIN=WindowWidth(#Fen,#PB_Window_InnerCoordinate) ;  Largeur de la fenêtre sans les bordures 
;               WHIN=WindowHeight(#Fen,#PB_Window_InnerCoordinate) ; Hauteur de la fenêtre sans les bordures
              WWOUT=WindowWidth(#Fen,#PB_Window_FrameCoordinate)   : ;Largeur de toute la fenêtre 
              WHOUT=WindowHeight(#Fen,#PB_Window_FrameCoordinate)  ;  Hauteur de toute la fenêtre
              GetWindowRect_(HWindow,rcwin.rect) 
    EndSelect
  Until EventID=#PB_Event_CloseWindow
EndIf
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Avatar de l’utilisateur
venom
Messages : 3071
Inscription : jeu. 29/juil./2004 16:33
Localisation : Klyntar
Contact :

Re: Programme de capture d’une zone quelconque de l'écran

Message par venom »

Impeccable, merci






@++
Windows 10 x64, PureBasic 5.73 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz
Avatar de l’utilisateur
kernadec
Messages : 1594
Inscription : ven. 25/avr./2008 11:14

Re: Programme de capture d’une zone quelconque de l'écran

Message par kernadec »

bonjour PAPIPP
très utile et pratique!!
Merci pour le partage :D

Cordialement
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: Programme de capture d’une zone quelconque de l'écran

Message par PAPIPP »

Bonjour à venon et à Kernadec.

Merci pour ce retour d'expérience.
Je signale à Kernadec la MAJ des 1000 API en Français ( Rbasic) du 18/04/2014 ci-dessous
http://www.purebasic.fr/french/viewtopi ... 9&start=75
ATTENTION : Le fichier *.rar n'est accessible que 1 mois.

A+
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Répondre