PureBasic

Code : Tout sélectionner

; By Dobro
; Capture avec fenetre transparente redimensionable qui sert de cadre;
; note : le passage de l'image se fait par le clipboard ...
; on peut suprimer ceci en ecrivant directement la sortie image :" BMPHandle"
; dans la Procedure "captureScreen"


UsePNGImageEncoder ()
UseJPEGImageEncoder ()
UseJPEGImageDecoder ()
UsePNGImageDecoder ()

Declare CaptureScreen(left.l, top.l, Width.l, Height.l)
Declare ShowWin()
Declare OpenWindow_Window_sauve()
Declare save_image()


Enumeration
	#WIN
	#bouton
	#Image
	#bmp
	#jpg
	#png
	#info
	#Sprite
	#Imagegadget
EndEnumeration
;{- Enumerations / DataSections
;{ Windows
Enumeration
	#Window_sauve
	#window
	#window_2
EndEnumeration
;}
;{ Gadgets
Enumeration
	#Container_0
	#Option_Jpg
	#Option_BMP
	#Option_Png
EndEnumeration
;}
;}

Global x_win,y_win

ShowWin()



End

;
Procedure CaptureScreen(left.l, top.l, Width.l, Height.l)
  #CAPTUREBLT = $40000000
  x_win= WindowX (#win )
  y_win= WindowY ( #win)
  dm.DEVMODE ;structure for CreateDC()
  srcDC.l
  trgDC.l
  BMPHandle.l
  srcDC = CreateDC_ ( "DISPLAY" , "" , "" , dm)
  trgDC = CreateCompatibleDC_ (srcDC)
  BMPHandle = CreateCompatibleBitmap_ (srcDC, Width, Height)
  SelectObject_ ( trgDC, BMPHandle)
  BitBlt_ ( trgDC, 0, 0, Width, Height, srcDC, left , top, #SRCCOPY|#SRCPAINT|#CAPTUREBLT )
  OpenClipboard_ ( #Null )
  EmptyClipboard_ ()
  SetClipboardData_ (2, BMPHandle)
  CloseClipboard_ ()
  hwnd = OpenWindow ( #window_2 , 0, 0, Width, Height, "View_Capture" ,#PB_Window_SystemMenu|#PB_Window_SizeGadget )
  StickyWindow (  #window_2 , 1) ; mise au premier plan
  If CreateImage ( #Image ,Width,Height)
    If StartDrawing ( ImageOutput ( #Image ))
      DrawImage (BMPHandle,0,0)
    EndIf
    StopDrawing ()
  EndIf
  ImageGadget(#ImageGadget,0,0, ImageWidth(#Image),  ImageHeight( #Image), #Image )
  SetGadgetState(#ImageGadget,ImageID(#image))
  DeleteDC_ ( trgDC)
  ReleaseDC_ ( BMPHandle, srcDC)
  Repeat
    event=WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
  ProcedureReturn
EndProcedure


Procedure save_image()
	If OpenWindow ( #Window_sauve , x_win, y_win, 133, 108, "Save image" , #PB_Window_BorderLess )
		StickyWindow ( #Window_sauve , 1) ; mise au premier plan
		
		ContainerGadget ( #Container_0 , 5, 5, 125, 95, #PB_Container_Raised )
		OptionGadget ( #Option_Jpg , 5, 5, 85, 25, "Jpg" )
		OptionGadget ( #Option_BMP , 5, 25, 85, 25, "Bmp" )
		OptionGadget ( #Option_Png , 5, 45, 85, 25, "Png" )
		CloseGadgetList ()
		
		;{- Event loop
		Repeat
			Select WaitWindowEvent ()
					; ///////////////////
				Case #PB_Event_Gadget
					Select EventGadget ()
						Case #Container_0
						Case #Option_Jpg
							type = #jpg
							iEvent = #PB_Event_CloseWindow
						Case #Option_BMP
							type= #bmp
							iEvent = #PB_Event_CloseWindow
						Case #Option_Png
							type= #png
							iEvent = #PB_Event_CloseWindow
					EndSelect
			EndSelect
		Until iEvent = #PB_Event_CloseWindow
		CloseWindow ( #Window_sauve )
	EndIf
	
	
	;
	;}
	If OpenFile ( #info , "capture.inf" )
		path$= ReadString ( #info )
		CloseFile ( #info )
	EndIf
	
	If path$= ""
		path$= "c:\"
	EndIf
	If GetExtensionPart (FileName.s) <> ""
		FileName.s= Mid (FileName.s,1, Len (FileName.s)-4)
	EndIf
	
	Select type
		Case #jpg
			FileName.s= SaveFileRequester ( "sauve jpg" ,path$, "*.jpg" ,1)+ ".jpg"
			If SaveImage ( #Image , FileName.s, #PB_ImagePlugin_JPEG ,10,32) =0
				MessageRequester ( "erreur" , "pas pu enregistrer l'image" )
				
				ProcedureReturn
			EndIf
			
		Case #bmp
			FileName.s= SaveFileRequester ( "sauve bmp" ,path$, "*.bmp" ,1)+ ".bmp" ; bug !!
			If SaveImage ( #Image , FileName.s, #PB_ImagePlugin_BMP ,10,32)=0 ; bug !!!
				MessageRequester ( "erreur" , "pas pu enregistrer l'image" )
				ProcedureReturn
			EndIf
			
		Case #png
			FileName.s= SaveFileRequester ( "sauve png" ,path$, "*.png" ,1)+ ".png"
			If SaveImage ( #Image , FileName.s, #PB_ImagePlugin_PNG )=0
				MessageRequester ( "erreur" , "pas pu enregistrer l'image" )
				ProcedureReturn
			EndIf
	EndSelect
	
	If OpenFile ( #info , "capture.inf" )<>0
		WriteStringN ( #info , GetPathPart (FileName.s) )
		CloseFile ( #info )
	EndIf
	Delay (200)
	
EndProcedure ;

Procedure ShowWin()
	;-------------------
	If OpenWindow ( #WIN , 0, 0, 300, 300, "Pure_Capture" , #PB_Window_BorderLess |#PB_Window_SizeGadget | #PB_Window_ScreenCentered )
		ButtonGadget ( #bouton ,10,10,150,30, "capture" )
		SetWindowColor ( #WIN , #Blue )
		SetWindowLong_ ( WindowID ( #WIN ), #GWL_EXSTYLE , #WS_EX_LAYERED | #WS_EX_TOPMOST )
		SetLayeredWindowAttributes_ ( WindowID ( #WIN ), #Blue ,0, #LWA_COLORKEY )
	EndIf
	Repeat
		
		
		Select WaitWindowEvent (2)
				
			Case #PB_Event_Gadget
				Select EventGadget ()
					Case #bouton
						Beep_ (440,100)
						
						CaptureScreen( WindowX ( #WIN )+4, WindowY ( #WIN )+24, WindowWidth ( #WIN ), WindowHeight ( #WIN )) ; dans le press papier
						GetClipboardImage ( #Image ,32)
						
						save_image()
						iEvent = #PB_Event_CloseWindow
				EndSelect
		EndSelect
		;
	Until iEvent = #PB_Event_CloseWindow
	
EndProcedure 

Code : Tout sélectionner

; Auteur : Le Soldat Inconnu
; Version de PB : 4.41
; 
; Explication du programme :
; Faire une copie d'écran

UsePNGImageEncoder()
UseJPEGImageEncoder()
; UsePNGImageDecoder()
; UseJPEGImageDecoder()

Global Format, Qualite, Type

Procedure CopieEcran()
  Protected Ecran.rect, Nb, Image, Image2, WinMouse, Fenetre.rect, FenetreHG.POINT
	
	Ecran_Largeur = GetSystemMetrics_(#SM_CXSCREEN)
	Ecran_Hauteur = GetSystemMetrics_(#SM_CYSCREEN)
	DC = GetDC_(0)
	Image2 = CreateImage(#PB_Any, Ecran_Largeur, Ecran_Hauteur)
	Dessin = StartDrawing(ImageOutput(Image2))
		BitBlt_(Dessin, 0, 0, Ecran_Largeur, Ecran_Hauteur, DC, 0, 0, #SRCCOPY | $40000000)
	StopDrawing()
	ReleaseDC_(0, DC)
  
  ; On découpe l'image suivant le Type
  Select Type
		Case 0
      ; Tout l'écran
			Fenetre\left = 0
      Fenetre\right = Ecran_Largeur
      Fenetre\top = 0
      Fenetre\bottom = Ecran_Hauteur
		Case 1
      ; L'écran sans la barre des taches
      SystemParametersInfo_(#SPI_GETWORKAREA, 0, @Fenetre.rect, 0)
		Case 2
      ; La fenêtre sous la souris
      WinMouse = WindowFromPoint_(DesktopMouseX() | DesktopMouseY() << 32)
			Repeat
				WinParent = GetParent_(WinMouse)
				If WinParent
					WinMouse = WinParent	
				EndIf
			Until WinParent = 0
      GetWindowRect_(WinMouse, Fenetre.rect)
		Case 3
      ; Uniquement le contenu de la fenêtre sous la souris
      WinMouse = WindowFromPoint_(DesktopMouseX() | DesktopMouseY() << 32)
			Repeat
				WinParent = GetParent_(WinMouse)
				If WinParent
					WinMouse = WinParent	
				EndIf
			Until WinParent = 0
			GetClientRect_(WinMouse, Fenetre.rect) : ClientToScreen_(WinMouse, FenetreHG.POINT)
      Fenetre\left + FenetreHG\x
      Fenetre\right + FenetreHG\x
      Fenetre\top + FenetreHG\y
      Fenetre\bottom + FenetreHG\y
		Case 4
			; Uniquement l'objet sous la souris
      WinMouse = WindowFromPoint_(DesktopMouseX() | DesktopMouseY() << 32)
			; WinAncestor = GetAncestor_(WinMouse, #GA_PARENT)
			; If WinAncestor
			; WinMouse = WinAncestor
			; EndIf
      GetClientRect_(WinMouse, Fenetre.rect) : ClientToScreen_(WinMouse, FenetreHG.POINT)
      Fenetre\left + FenetreHG\x
      Fenetre\right + FenetreHG\x
      Fenetre\top + FenetreHG\y
      Fenetre\bottom + FenetreHG\y
	EndSelect
  
	If Fenetre\left < 0 : Fenetre\left = 0 : EndIf
	If Fenetre\top < 0 : Fenetre\top = 0 : EndIf
	If Fenetre\right > ImageWidth(Image2) : Fenetre\right = ImageWidth(Image2) : EndIf
	If Fenetre\bottom > ImageHeight(Image2) : Fenetre\bottom = ImageHeight(Image2) : EndIf
	Image = GrabImage(Image2, #PB_Any, Fenetre\left, Fenetre\top, Fenetre\right - Fenetre\left, Fenetre\bottom - Fenetre\top)
	
	FreeImage(Image2)
	If IsImage(Image)
		Visualiser = OpenWindow(#PB_Any, Fenetre\left, Fenetre\top, Fenetre\right - Fenetre\left, Fenetre\bottom - Fenetre\top, "Visualisation", #PB_Window_BorderLess)
		If Visualiser
			StickyWindow(Visualiser, 1)
			
			Image2 = CopyImage(Image, #PB_Any)
			StartDrawing(ImageOutput(Image2))
				DrawingMode(#PB_2DDrawing_AlphaBlend)
				For x = 0 To Fenetre\right - Fenetre\left - 1 Step 8
					For y = 0 To Fenetre\bottom - Fenetre\top - 1 Step 8
						If ((x + y) / 8) & %1 = 1
							Box(x, y, 8, 8, $40FFFFFF)
						Else
							Box(x, y, 8, 8, $40000000)
						EndIf
					Next
				Next
			StopDrawing()
			
			Gadget = ImageGadget(#PB_Any, 1, 1, 0, 0, ImageID(Image2))
			GadgetToolTip(Gadget, "Clic gauche = Sauver  /  Clic droit = Annuler")
			
			Repeat
				Event = WaitWindowEvent()
				
				If Event = #PB_Event_Gadget
					If EventGadget() = Gadget
						Select EventType()
							Case #PB_EventType_LeftClick
								Enregistrer = 1
							Case #PB_EventType_RightClick
								Enregistrer = -1
						EndSelect
					EndIf
				EndIf
				
			Until Enregistrer <> 0
			
			CloseWindow(Visualiser)
			
			FreeImage(Image2)
		EndIf
	
		
		; On enregistre l'image
		If Enregistrer > 0
			Nb = 0
			Repeat 
				Nb + 1
			Until FileSize("Copie d'écran " + RSet(Str(Nb), 4, "0") + ".bmp") = -1 And FileSize("Copie d'écran " + RSet(Str(Nb), 4, "0") + ".png") = -1 And FileSize("Copie d'écran " + RSet(Str(Nb), 4, "0") + ".jpg") = -1
			
			Select Format
				Case 0
					Nom.s = "Copie d'écran " + RSet(Str(Nb), 4, "0") + ".bmp"
					SaveImage(Image, Nom, #PB_ImagePlugin_BMP)
				Case 1
					Nom.s = "Copie d'écran " + RSet(Str(Nb), 4, "0") + ".png"
					SaveImage(Image, Nom, #PB_ImagePlugin_PNG)
				Case 2
					Nom.s = "Copie d'écran " + RSet(Str(Nb), 4, "0") + ".jpg"
					SaveImage(Image, Nom, #PB_ImagePlugin_JPEG, Qualite)
			EndSelect
			SetGadgetText(5, Nom)
			
			MessageBeep_(#MB_OK)
		EndIf
		
		FreeImage(Image)
	EndIf

EndProcedure


Global KeyboardHook
Procedure LowLevelKeyboardProc(nCode.l, wParam.l, lParam.l)
	If nCode=#HC_ACTION
		Select wParam 
			Case #WM_KEYDOWN
			Case #WM_KEYUP
				vkCode = PeekL(lParam)
				If vkCode = 44
					CopieEcran()
				EndIf
		EndSelect
	EndIf
	ProcedureReturn CallNextHookEx_(KeyboardHook, nCode, wParam, lParam)
EndProcedure
Procedure AddKeyboardHook()
	If KeyboardHook = 0
		KeyboardHook = SetWindowsHookEx_(#WH_KEYBOARD_LL, @LowLevelKeyboardProc(), GetModuleHandle_(0), 0)
	EndIf
	ProcedureReturn KeyboardHook
EndProcedure
Procedure RemoveKeyboardHook()
	If KeyboardHook
		UnhookWindowsHookEx_(KeyboardHook)
		KeyboardHook = 0
	EndIf
EndProcedure

; Format
; 0 = BMP
; 1 = PNG
; 2 = JPG



Procedure AffichageQualite()
  If Format = 2
    HideGadget(2, 0)
    HideGadget(3, 0)
  Else
    HideGadget(2, 1)
    HideGadget(3, 1)
  EndIf
EndProcedure





; Création de la fenêtre et de la GadgetList
If OpenWindow(0, 0, 0, 300, 196, "Copie d'écran", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget) = 0
  End
EndIf

StickyWindow(0, 1)

LoadFont(0, "Tahoma", 8)
SetGadgetFont(#PB_Default, FontID(0))
LoadFont(1, "Tahoma", 8, #PB_Font_Bold)

TextGadget(0, 0, 0, 150, 16, " Format de l'image :") : SetGadgetFont(0, FontID(1))
ComboBoxGadget(1, 0, 16, 150, 24)
AddGadgetItem(1, 0, "Bmp")
AddGadgetItem(1, 1, "Png")
AddGadgetItem(1, 2, "Jpg")
TextGadget(2, 150, 0, 150, 16, " Qualité de l'image :") : SetGadgetFont(2, FontID(1))
ComboBoxGadget(3, 150, 16, 150, 24)
For n = 1 To 10
  AddGadgetItem(3, n - 1, Str(n))
Next

OpenPreferences("Copie d'écran.ini")
Format = ReadPreferenceLong("Format", 1)
Qualite = ReadPreferenceLong("Qualité", 10)
Type = ReadPreferenceLong("Type", 0)
ClosePreferences()

SetGadgetState(1, Format)
SetGadgetState(3, Qualite - 1)

AffichageQualite()

TextGadget(7, 0, 50, 300, 16, " Type de copie d'écran :") : SetGadgetFont(7, FontID(1))
OptionGadget(10, 0, 66, 300, 16, "Tout l'écran")
OptionGadget(11, 0, 82, 300, 16, "L'écran sans la barre des taches")
OptionGadget(12, 0, 98, 300, 16, "La fenêtre sous la souris")
OptionGadget(13, 0, 114, 300, 16, "Uniquement le contenu de la fenêtre sous la souris")
OptionGadget(14, 0, 130, 300, 16, "Uniquement l'objet sous la souris")
SetGadgetState(10 + Type, 1)

TextGadget(4, 0, 156, 50, 16, " Image :") : SetGadgetFont(4, FontID(1))
TextGadget(5, 50, 156, 250, 16, "")

ButtonGadget(6, 0, 172, 276, 24, "Ouvrir le dossier contenant les copies d'écran")
ButtonGadget(8, 275, 172, 24, 24, "?")

Icone = CreateImage(#PB_Any, 16, 16, 32)
StartDrawing(ImageOutput(Icone))
	DrawingMode(#PB_2DDrawing_AlphaChannel)
	Box(0, 0, 16, 16, 0)
	DrawingMode(#PB_2DDrawing_AlphaBlend)
	Box(1, 1, 14, 14, RGBA(150, 200, 255, 100))
	Box(0, 0, 2, 2, $FF000000)
	Box(14, 0, 2, 2, $FF000000)
	Box(0, 14, 2, 2, $FF000000)
	Box(14, 14, 2, 2, $FF000000)
	DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Outlined)
	Box(1, 1, 14, 14, $60000000)
StopDrawing()

If AddSysTrayIcon(0, WindowID(0), ImageID(Icone))
  SysTrayIconToolTip(0, "Copie d'écran")
Else
  End
EndIf

AddKeyboardHook()

Repeat
  Event = WaitWindowEvent(200)
  Select Event
    Case #PB_Event_Gadget
      Select EventGadget() ; Gadgets
        Case 1
          Format = GetGadgetState(1)
          AffichageQualite()
        Case 3
          Qualite = GetGadgetState(3) + 1
        Case 6
          RunProgram("Explorer.exe", GetPathPart(ProgramFilename()), "")
        Case 10
          If GetGadgetState(10) = 1
            Type = 0
          EndIf
        Case 11
          If GetGadgetState(11) = 1
            Type = 1
          EndIf
        Case 12
          If GetGadgetState(12) = 1
            Type = 2
          EndIf
        Case 13
          If GetGadgetState(13) = 1
            Type = 3
					EndIf
				Case 14
          If GetGadgetState(14) = 1
            Type = 4
					EndIf
        Case 8
          MessageRequester("Copie d'écran", "Auteur : BOUGUIN Régis (LSI Développements)" + Chr(10) + "Logiciel de programmation : PureBasic v4")
      EndSelect
    Case #PB_Event_SysTray
      Select EventType()
        Case #PB_EventType_LeftClick, #PB_EventType_RightClick
					Masquer = 1 - Masquer
          If Masquer
            HideWindow(0, 1)
          Else
 						; ShowWindow_(WindowID(0), #SW_NORMAL)
						SetWindowState(0, #PB_Window_Normal)
            HideWindow(0, 0)
          EndIf
      EndSelect
  EndSelect
	
  If IsIconic_(WindowID(0)) And Masquer = 0
    HideWindow(0, 1)
		Masquer = 1
  EndIf
  
Until Event = #PB_Event_CloseWindow

If CreatePreferences("Copie d'écran.ini")
  WritePreferenceLong("Format", Format)
  WritePreferenceLong("Qualité", Qualite)
  WritePreferenceLong("Type", Type)
  ClosePreferences()
EndIf

End