Page 1 sur 2

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

Publié : lun. 01/sept./2014 10:19
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+

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

Publié : lun. 01/sept./2014 11:05
par SPH
Pratique 8)

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

Publié : lun. 01/sept./2014 12:43
par raven
bien pratique en effet,merci du partage Papipp.

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

Publié : lun. 01/sept./2014 17:35
par Ar-S
Merci Papipp :wink:

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

Publié : mar. 02/sept./2014 21:45
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

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

Publié : mer. 03/sept./2014 20:51
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 ?






@++

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

Publié : mer. 03/sept./2014 21:18
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+

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

Publié : mer. 03/sept./2014 21:55
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.

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

Publié : mer. 03/sept./2014 22:21
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+

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

Publié : ven. 05/sept./2014 7:40
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+

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

Publié : mar. 09/sept./2014 8:59
par Kwai chang caine
Marche bien sous 5.23 W7
Merci Papipp 8)

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

Publié : mer. 10/sept./2014 9:02
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

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

Publié : jeu. 11/sept./2014 20:38
par venom
Impeccable, merci






@++

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

Publié : ven. 12/sept./2014 8:05
par kernadec
bonjour PAPIPP
très utile et pratique!!
Merci pour le partage :D

Cordialement

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

Publié : ven. 12/sept./2014 9:19
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+