Here is a small program to capture any screen area you choose yourself
This PRG is unpretentious.
Operation:
1) Start the prg
2) You get a transparent window which can be moved and enlarged on demand.
3) when moving, as the area does not appear (In my option: Property Office XP)
This is the area defined when moving that sets the limits of the rectangle to capture.
4) After adjusting the window press F12 key release a menu you
ask the way, the name and type of file you want to save (BMP, JPG, PNG). (Default PNG)
5) You can repeat as many times as you like this.
6) To exit the PRG:
Click X in the title field.
Please note the transparent window is not always easy to spot.
7) In the title box, if you click - you minimize the window and if you click on zoom, you can capture the entire screen.
Code: Select all
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 = 2)
Filtre$+"Jpeg (*.jpg)|*.jpg|" ; Troisième filtre (index = 3)
Filtre$+"Tous les fichiers (*.*)|*.*" ; Quatriè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
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%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
