PureBasic

Forums PureBasic
Nous sommes le Mer 28/Oct/2020 21:06

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 17 messages ]  Aller à la page 1, 2  Suivante
Auteur Message
 Sujet du message: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Lun 01/Sep/2014 10:19 
Hors ligne

Inscription: Sam 23/Fév/2008 17:58
Messages: 499
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:
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+

_________________
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.


Dernière édition par PAPIPP le Lun 01/Sep/2014 22:23, édité 2 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Lun 01/Sep/2014 11:05 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4191
Pratique 8)

_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Lun 01/Sep/2014 12:43 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 06/Jan/2005 15:45
Messages: 222
bien pratique en effet,merci du partage Papipp.

_________________
Pb5.24 Lts/5.31 Windows 7 64 nvidia 560 ti E8500 8g ram


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Lun 01/Sep/2014 17:35 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 9027
Merci Papipp :wink:

_________________
~~~~Règles du forum ~~~~
.: Ar-S :. Tour + portable W10 x64 PB 5.6x / 5.7x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Mar 02/Sep/2014 21:45 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 25/Avr/2008 11:14
Messages: 1406
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Mer 03/Sep/2014 20:51 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 29/Juil/2004 16:33
Messages: 2918
Localisation: Klyntar
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.72 1 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Mer 03/Sep/2014 21:18 
Hors ligne

Inscription: Sam 23/Fév/2008 17:58
Messages: 499
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:
    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+

_________________
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.


Dernière édition par PAPIPP le Jeu 04/Sep/2014 7:05, édité 4 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Mer 03/Sep/2014 21:55 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 08/Déc/2013 23:19
Messages: 603
Localisation: Hérault
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.

_________________
Mon site dédié à ma passion pour la programmation :
http://majikeyric.free.fr


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Mer 03/Sep/2014 22:21 
Hors ligne

Inscription: Sam 23/Fév/2008 17:58
Messages: 499
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.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Ven 05/Sep/2014 7:40 
Hors ligne

Inscription: Sam 23/Fév/2008 17:58
Messages: 499
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:
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.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Mar 09/Sep/2014 8:59 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6714
Localisation: Isere
Marche bien sous 5.23 W7
Merci Papipp 8)

_________________
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Mer 10/Sep/2014 9:02 
Hors ligne

Inscription: Sam 23/Fév/2008 17:58
Messages: 499
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:
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.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Jeu 11/Sep/2014 20:38 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 29/Juil/2004 16:33
Messages: 2918
Localisation: Klyntar
Impeccable, merci






@++

_________________
Windows 10 x64, PureBasic 5.72 1 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Ven 12/Sep/2014 8:05 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 25/Avr/2008 11:14
Messages: 1406
bonjour PAPIPP
très utile et pratique!!
Merci pour le partage :D

Cordialement


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Programme de capture d’une zone quelconque de l'écran
MessagePosté: Ven 12/Sep/2014 9:19 
Hors ligne

Inscription: Sam 23/Fév/2008 17:58
Messages: 499
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
viewtopic.php?f=4&t=13019&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.


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 17 messages ]  Aller à la page 1, 2  Suivante

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 6 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye