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