Thanks to Mijikai who helped me solve the problem.
Usage: press the button <Select region \ Save AVI> then hold down the left mouse button and select the desired area of the screen. Release the left mouse button and select the path for the AVI file and the codec parameters. After this, recording to the file will begin. The right button stops recording.
Code: Select all
EnableExplicit
Enumeration
#Win_Tool
#Win_Sel
#Win_View
#Win_Border_Top
#Win_Border_Bottom
#Win_Border_Left
#Win_Border_Right
#Win_Border_Text
#Border_Text
EndEnumeration
Enumeration
#btnRect
#btnSave
#img
EndEnumeration
#CAPTUREBLT = $40000000
#Img2 = 0
#streamtypeAUDIO = $73647561
#streamtypeVIDEO = 1935960438
#ICMF_CHOOSE_KEYFRAME = 1
#ICMF_CHOOSE_DATARATE = 2
#AVIERR_OK = 0
#AVIIF_KEYFRAME = $10
#BmpFile = 20
#AviFile = 30
#AVISTREAMINFO_DISABLED = $1
#AVISTREAMINFO_FORMATCHANGES = $10000
#AVISTREAMREAD_CONVENIENT = -1
#AVSTREAMMASTER_AUDIO = 0
#AVSTREAMMASTER_NONE = 1
#AVICOMPRESSF_DATARATE = $2
#AVICOMPRESSF_INTERLEAVE = $1
#AVICOMPRESSF_KEYFRAMES = $4
#AVICOMPRESSF_VALID = $8
Macro MAKE_SCODE(sev, fac, code)
((sev << 31) | (fac << 16) | (code))
EndMacro
#FACILITY_ITF = $0
Macro MAKE_AVIERR(e)
MAKE_SCODE(#SEVERITY_ERROR, #FACILITY_ITF, $4000 + e)
EndMacro
#AVIERR_OK = 0
#AVIERR_UNSUPPORTED = MAKE_AVIERR(101)
#AVIERR_BADFORMAT = MAKE_AVIERR(102)
#AVIERR_MEMORY = MAKE_AVIERR(103)
#AVIERR_INTERNAL = MAKE_AVIERR(104)
#AVIERR_BADFLAGS = MAKE_AVIERR(105)
#AVIERR_BADPARAM = MAKE_AVIERR(106)
#AVIERR_BADSIZE = MAKE_AVIERR(107)
#AVIERR_BADHANDLE = MAKE_AVIERR(108)
#AVIERR_FILEREAD = MAKE_AVIERR(109)
#AVIERR_FILEWRITE = MAKE_AVIERR(110)
#AVIERR_FILEOPEN = MAKE_AVIERR(111)
#AVIERR_COMPRESSOR = MAKE_AVIERR(112)
#AVIERR_NOCOMPRESSOR = MAKE_AVIERR(113)
#AVIERR_READONLY = MAKE_AVIERR(114)
#AVIERR_NODATA = MAKE_AVIERR(115)
#AVIERR_BUFFERTOOSMALL = MAKE_AVIERR(116)
#AVIERR_CANTCOMPRESS = MAKE_AVIERR(117)
#AVIERR_USERABORT = MAKE_AVIERR(198)
#AVIERR_ERROR = MAKE_AVIERR(199)
Structure bitmap24
bmiHeader.BITMAPINFOHEADER
EndStructure
Structure msvc
a.b
b.b
c.b
d.b
EndStructure
Structure AVI_STREAM_INFO
fccType.l
fccHandler.msvc
dwFlags.l
dwCaps.l
wPriority.w
wLanguage.w
dwScale.l
dwRate.l
dwStart.l
dwLength.l
dwInitialFrames.l
dwSuggestedBufferSize.l
dwQuality.l
dwSampleSize.l
rcFrame.RECT
dwEditCount.l
dwFormatChangeCount.l
szName.a[64]
EndStructure
Structure AVI_COMPRESS_OPTIONS
fccType.l
fccHandler.l
dwKeyFrameEvery.l
dwQuality.l
dwBytesPerSecond.l
dwFlags.l
*lpFormat
cbFormat.l
*lpParms
cbParms.l
dwInterleaveEvery.l
EndStructure
Prototype AVIFileInit()
Prototype AVISaveOptions(iHwnd.i,iFlags.i,iNstreams.i,ptrAvi,iOpts.i)
Prototype AVISaveVA(sFileSave.s,iPclsidhandler.i,iLpfncallback,iNstreams.i,iPpavistream.i,iPpcompoptions.i)
Prototype AVIMakeCompressedStream(iPpsCompressed.i,iPsSource.i,LpOptions.i,iPclsidHandler.i)
Prototype.l AVIFileOpen(iPfile.l, sFileOpen.p-Ascii, iUmode.l, iPclsidHandler.l)
Prototype AVIFileGetStream(ipfileStream.i,ptr_avi,iFccType.i,iLParam.i)
Prototype AVIStreamStart(iPavi.i)
Prototype AVIStreamLength(iPavi.i)
Prototype AVIStreamInfo(iPaviStream.i,psi.i,iLsize.i)
Prototype AVIStreamGetFrameOpen(ptrAviStream,BitmapHeader)
Prototype AVIStreamGetFrame(iPGetFrameObj.i,iLpos.i)
Prototype AVIFileCreateStream(ptrAviFile,ptrAviStream,ptrStreamInfo)
Prototype AVIStreamSetFormat(ptrAviStream,iLpos.i,LpFormat,iCbFormat.i)
Prototype AVIStreamWrite(ptrAviStream,iLstart.i,iLsamples.i,ptrLpBuffer,iCbBuffer.i,iDwFlags.i,iDummy1.i,iDummy2.i)
Prototype AVIStreamGetFrameClose(iPGetFrameObj.i)
Prototype AVIStreamRelease(ptrAviStream)
Prototype AVIFileRelease(iPfile.i)
Prototype AVIFileExit()
Define sgPat.s, sgAviFile.s, ResultL.l, *pavfile.IAVIFILE, WindHwnd, pAVICompressed, igIndex.i = 0
Define Opts.AVI_COMPRESS_OPTIONS
Define pFile.IAVIFILE
Define pStream
Define strhdr.AVI_STREAM_INFO
Define AviLib
Define isAVIError = #False
Define BytesWritten
Define AVIFileInit.AVIFileInit
Define AVISaveOptions.AVISaveOptions
Define AVISaveVA.AVISaveVA
Define AVIMakeCompressedStream.AVIMakeCompressedStream
Define AVIFileOpen.AVIFileOpen
Define AVIFileGetStream.AVIFileGetStream
Define AVIStreamStart.AVIStreamStart
Define AVIStreamLength.AVIStreamLength
Define AVIStreamInfo.AVIStreamInfo
Define AVIStreamGetFrameOpen.AVIStreamGetFrameOpen
Define AVIStreamGetFrame.AVIStreamGetFrame
Define AVIFileCreateStream.AVIFileCreateStream
Define AVIStreamSetFormat.AVIStreamSetFormat
Define AVIStreamWrite.AVIStreamWrite
Define AVIStreamGetFrameClose.AVIStreamGetFrameClose
Define AVIStreamRelease.AVIStreamRelease
Define AVIFileRelease.AVIFileRelease
Define AVIFileExit.AVIFileExit
Define *Buffer, PixelFormat, Pitch, y, w, h, blinkTimer, isHideBorders, totalmemoryused
Define ci.CURSORINFO, iconinfo.ICONINFO, cur_x, cur_y
Define bmi.bitmap24
Define FrameRate = 25
Global border_text_size=5, fnt_width = 6
Define x1, y1, x2, y2
Define hRectangle_GUI
Define hDC
Define trgDC
Define bitBlt
Define hPreview
Define WWEvent
Define Mouse_PosX_old, Mouse_PosY_old, hMask
Define starttime
Define Mouse_PosX, Mouse_PosY, tmp, x_Pos, Width, Height, y_Pos, isStarCapture = 0
Define Dim Opts(1)
Opts(0) = @Opts
Declare GUICreateInvRect(hWnd, X, Y, W, H)
Declare HBitmapFromScreen(X, Y, W, H)
Procedure SetWindowTranparency(Window, TransparencyColor, Transparency)
Protected hWnd=WindowID(window)
;transform into opaque layered window
SetWindowLongPtr_(hWnd, #GWL_EXSTYLE, GetWindowLongPtr_(hWnd, #GWL_EXSTYLE) | #WS_EX_LAYERED)
SetLayeredWindowAttributes_(hWnd, TransparencyColor, Transparency, #LWA_COLORKEY | #LWA_ALPHA)
EndProcedure
Procedure WinBorders(pos_x, pos_y, border_w, border_h)
OpenWindow(#Win_Border_Top, pos_x-1, pos_y-1, border_w+2, 1, "", #WS_POPUP | #PB_Window_BorderLess)
SetWindowColor(#Win_Border_Top, #Red)
StickyWindow(#Win_Border_Top, #True)
OpenWindow(#Win_Border_Bottom, pos_x-1, pos_y + border_h+1, border_w+2, 1, "", #WS_POPUP | #PB_Window_BorderLess)
SetWindowColor(#Win_Border_Bottom, #Red)
StickyWindow(#Win_Border_Bottom, #True)
OpenWindow(#Win_Border_Left, pos_x-1, pos_y-1, 1, border_h+2, "", #WS_POPUP | #PB_Window_BorderLess)
SetWindowColor(#Win_Border_Left, #Red)
StickyWindow(#Win_Border_Left, #True)
OpenWindow(#Win_Border_Right, pos_x+border_w+1, pos_y-1, 1, border_h+2, "", #WS_POPUP | #PB_Window_BorderLess)
SetWindowColor(#Win_Border_Right, #Red)
StickyWindow(#Win_Border_Right, #True)
OpenWindow(#Win_Border_Text, pos_x-1, pos_y-1-15, 100, 15, "", #WS_POPUP | #PB_Window_BorderLess)
StickyWindow(#Win_Border_Text, #True)
TextGadget(#Border_Text, 0, 0, border_text_size * fnt_width + 2, 15, "", 0)
SetWindowColor(#Win_Border_Text, RGB(255, 255, 0))
SetWindowTranparency(#Win_Border_Text, RGB(255, 255, 0), 190)
EndProcedure
Procedure CloseBorders()
CloseWindow(#Win_Border_Top)
CloseWindow(#Win_Border_Bottom)
CloseWindow(#Win_Border_Left)
CloseWindow(#Win_Border_Right)
CloseWindow(#Win_Border_Text)
EndProcedure
Procedure HideBorders(isTrue)
SetWindowTranparency(#Win_Border_Top, #Blue, 255*isTrue)
SetWindowTranparency(#Win_Border_Bottom, #Blue, 255*isTrue)
SetWindowTranparency(#Win_Border_Left, #Blue, 255*isTrue)
SetWindowTranparency(#Win_Border_Right, #Blue, 255*isTrue)
EndProcedure
Procedure GUICreateInvRect(hWnd, X, Y, W, H)
Protected hMask_Top, hMask_Left, hMask_Right, hMask_Bottom
hMask_Top = CreateRectRgn_(0, 0, DesktopWidth(0), Y)
hMask_Left = CreateRectRgn_(0, 0, X, DesktopHeight(0))
hMask_Right = CreateRectRgn_(X + W, 0, DesktopWidth(0), DesktopHeight(0))
hMask_Bottom = CreateRectRgn_(0, Y + H, DesktopWidth(0), DesktopHeight(0))
CombineRgn_(hMask_Top, hMask_Top, hMask_Left, 2)
CombineRgn_(hMask_Top, hMask_Top, hMask_Right, 2)
CombineRgn_(hMask_Top, hMask_Top, hMask_Bottom, 2)
DeleteObject_(hMask_Left)
DeleteObject_(hMask_Right)
DeleteObject_(hMask_Bottom)
SetWindowRgn_(hWnd, hMask_Top, 1)
DeleteObject_(hMask_Top)
EndProcedure
ExamineDesktops()
;USAGE
;Use mouse left button to select rectangle and right click button to stop record.
OpenWindow(#Win_Tool, 0, 0, 200, 40, "Select Rectangle", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
ButtonGadget(#btnRect, 5, 5, 190, 30,"Select region \ Save AVI")
hRectangle_GUI = OpenWindow(#Win_Sel, 0, 0, DesktopWidth(0), DesktopHeight(0), "", #WS_POPUP | #PB_Window_BorderLess | #PB_Window_Invisible)
If hRectangle_GUI
SetWindowColor(#Win_Sel, 0)
SetWindowLong_(hRectangle_GUI, #GWL_EXSTYLE, #WS_EX_LAYERED | #WS_EX_TOPMOST)
SetLayeredWindowAttributes_(hRectangle_GUI, #Blue, 110, #LWA_COLORKEY | #LWA_ALPHA)
GUICreateInvRect(hRectangle_GUI, 0, 0, 1, 1)
StickyWindow(#Win_Sel, #True)
EndIf
AviLib = OpenLibrary(#PB_Any, "avifil32.dll")
If Not AviLib
MessageRequester("Attention","Could not Open AVI Lib", #PB_MessageRequester_Ok | #MB_ICONERROR)
End
EndIf
AVIFileInit = GetFunction(AviLib, "AVIFileInit")
AVISaveOptions = GetFunction(AviLib, "AVISaveOptions")
AVISaveVA = GetFunction(AviLib, "AVISaveVA")
AVIMakeCompressedStream = GetFunction(AviLib, "AVIMakeCompressedStream")
AVIFileOpen = GetFunction(AviLib, "AVIFileOpen")
AVIFileGetStream = GetFunction(AviLib, "AVIFileGetStream")
AVIStreamStart = GetFunction(AviLib, "AVIStreamStart")
AVIStreamLength = GetFunction(AviLib, "AVIStreamLength")
AVIStreamInfo = GetFunction(AviLib, "AVIStreamInfo")
AVIStreamGetFrameOpen = GetFunction(AviLib, "AVIStreamGetFrameOpen")
AVIStreamGetFrame = GetFunction(AviLib, "AVIStreamGetFrame")
AVIFileCreateStream = GetFunction(AviLib, "AVIFileCreateStream")
AVIStreamSetFormat = GetFunction(AviLib, "AVIStreamSetFormat")
AVIStreamWrite = GetFunction(AviLib, "AVIStreamWrite")
AVIStreamGetFrameClose = GetFunction(AviLib, "AVIStreamGetFrameClose")
AVIStreamRelease = GetFunction(AviLib, "AVIStreamRelease")
AVIFileRelease = GetFunction(AviLib, "AVIFileRelease")
AVIFileExit = GetFunction(AviLib, "AVIFileExit")
FrameRate = 25
starttime=ElapsedMilliseconds()
Repeat
If ElapsedMilliseconds()-starttime>=1000/FrameRate
starttime = ElapsedMilliseconds()
If isStarCapture=3
If IsImage(0)
If Not GetAsyncKeyState_(#VK_RBUTTON) And Not isAVIError
hDC = StartDrawing(ImageOutput(0))
bitBlt = BitBlt_(hDC, 0, 0, x2 - x1, y2 - y1, trgDC, x1, y1, #SRCCOPY|#CAPTUREBLT)
ci\cbSize = SizeOf(CURSORINFO)
GetCursorInfo_(@ci)
cur_x = ci\ptScreenPos\x
cur_y = ci\ptScreenPos\y
GetIconInfo_(ci\hCursor, iconinfo.ICONINFO)
DrawIconEx_(hDC, cur_x - x1 - iconinfo\xHotspot ,cur_y - y1 - iconinfo\yHotspot, ci\hCursor, 32, 32, 0, 0, #DI_NORMAL|#DI_COMPAT )
*Buffer = DrawingBuffer()
PixelFormat = DrawingBufferPixelFormat()
Pitch = DrawingBufferPitch()
StopDrawing()
;!!!! Cursor GDI object should be deleted
DeleteObject_(iconinfo\hbmMask)
DeleteObject_(iconinfo\hbmColor)
If AVIStreamWrite(pAVICompressed, igIndex, 1, *Buffer, bmi\bmiHeader\bisizeimage, #AVIIF_KEYFRAME, 0, @BytesWritten) = 0
igIndex = igIndex + 1
totalmemoryused + BytesWritten
Else
MessageRequester("Attention","AVI Stream Write call failed", #PB_MessageRequester_Ok | #MB_ICONERROR)
isAVIError = #True
EndIf
If ElapsedMilliseconds()-blinkTimer>500
blinkTimer=ElapsedMilliseconds()
isHideBorders = 1-isHideBorders
HideBorders(isHideBorders)
SetGadgetText(#Border_Text, StrD(totalmemoryused/1024/1024,1)+"MB")
If Len(StrD(totalmemoryused/1024/1024,1)+"MB")>border_text_size
border_text_size + 1
ResizeGadget(#Border_Text, #PB_Ignore, #PB_Ignore, border_text_size * fnt_width + 2, #PB_Ignore)
EndIf
EndIf
Else
CloseBorders()
AVIStreamRelease(pAVICompressed)
AVIStreamRelease(pStream)
AVIFileRelease(*pavfile)
AVIFileExit()
HideWindow(#Win_Tool, #False)
isStarCapture = 0
EndIf
EndIf
EndIf
EndIf
WWEvent = WindowEvent()
Select EventWindow()
Case #Win_Tool
Select WWEvent
Case #PB_Event_Gadget
Select EventGadget()
Case #btnRect
HideWindow(#Win_Tool, #True)
HideWindow(#Win_Sel, #False)
isStarCapture = 1
hMask = CreateRectRgn_(0, 0, DesktopWidth(0), DesktopHeight(0))
SetWindowRgn_(hRectangle_GUI, hMask, 1)
DeleteObject_(hMask)
EndSelect
Case #PB_Event_CloseWindow
CloseWindow(#Win_Tool)
CloseLibrary(AviLib)
ReleaseDC_(0, HDC)
If trgDC
ReleaseDC_(GetDesktopWindow_(),trgDC)
EndIf
CloseWindow(#Win_Sel)
End
EndSelect
Case #Win_Sel
If GetAsyncKeyState_(#VK_LBUTTON)
If isStarCapture=1
x1 = WindowMouseX(#Win_Sel)
y1 = WindowMouseY(#Win_Sel)
isStarCapture=2
EndIf
If isStarCapture=2
; Draw rectangle while mouse button pressed
Mouse_PosX = WindowMouseX(#Win_Sel)
Mouse_PosY = WindowMouseY(#Win_Sel)
; Set in correct order if required
If Mouse_PosX < x1
x_Pos = Mouse_PosX
Width = x1 - Mouse_PosX
Else
x_Pos = x1
Width = Mouse_PosX - x1
EndIf
If Mouse_PosY < y1
y_Pos = Mouse_PosY
Height = y1 - Mouse_PosY
Else
y_Pos = y1
Height = Mouse_PosY - y1
EndIf
GUICreateInvRect(hRectangle_GUI, x_Pos, y_Pos, Width, Height)
Mouse_PosX_old = Mouse_PosX
Mouse_PosY_old = Mouse_PosY
EndIf
Else
If isStarCapture=2
isStarCapture=3
; Get second mouse position
x2 = Mouse_PosX
y2 = Mouse_PosY
; Set in correct order if required
If x2 < x1
tmp = x1
x1 = x2
x2 = tmp
EndIf
If y2 < y1
tmp = y1
y1 = y2
y2 = tmp
EndIf
;alignment
If x2 - x1>0 And y2 - y1>0
w = (x2 - x1) + 4 - ((x2 - x1) % 4)
x2 = x1 + w
If x2>DesktopWidth(0)-1
x2= DesktopWidth(0)-1
x1=x2 - w
EndIf
totalmemoryused = 0
border_text_size = 5
If Not trgDC
trgDC = GetDC_(GetDesktopWindow_())
EndIf
If IsImage(0)
FreeImage(0)
EndIf
If Not CreateImage(0, x2 - x1, y2 - y1, 24)
MessageRequester("Attention","Could not create image(0)", #PB_MessageRequester_Ok | #MB_ICONERROR)
isStarCapture = 0
Else
HideWindow(#Win_Sel, #True)
igIndex = 0
bmi\bmiHeader\biSize = SizeOf(bitmap24)
bmi\bmiHeader\biBitCount = 24
bmi\bmiHeader\biPlanes = 1
bmi\bmiHeader\biWidth = ImageWidth(0)
bmi\bmiHeader\biHeight = ImageHeight(0)
bmi\bmiHeader\biSizeImage = bmi\bmiHeader\biWidth * bmi\bmiHeader\biHeight * 3
AVIFileInit()
sgPat = "AVI Movie File (*.AVI *.avi)|*.AVI;*.avi"
sgAviFile = SaveFileRequester("Enter AVI File Name", "", sgPat, 0)
If sgAviFile<>""
If(GetExtensionPart(sgAviFile) = "") : sgAviFile = sgAviFile + ".avi" : EndIf
If FileSize(sgAviFile)>0
DeleteFile(sgAviFile)
EndIf
ResultL = AVIFileOpen(@*pavfile, sgAviFile, #OF_CREATE, #Null)
If ResultL = #AVIERR_OK
strhdr\fccType = #streamtypeVIDEO
strhdr\fccHandler\a = $6D
strhdr\fccHandler\b = $73
strhdr\fccHandler\c = $76
strhdr\fccHandler\d = $63
strhdr\dwScale = 1
strhdr\dwRate = FrameRate ;##Frames per second(1 to 30)
strhdr\dwSuggestedBufferSize = bmi\bmiHeader\bisizeimage
strhdr\rcFrame\top = 0
strhdr\rcFrame\left = 0
strhdr\rcFrame\right = bmi\bmiHeader\biWidth
strhdr\rcFrame\bottom = bmi\bmiHeader\biHeight
strhdr\dwStart = 0 ; StartFrame
strhdr\dwLength = 1
PokeS(@strhdr\szName[0], "Done by PureBasic", -1, #PB_Ascii)
If AVIFileCreateStream(*pavfile, @pStream, @strhdr) = 0
If AVISaveOptions(WindHwnd, #ICMF_CHOOSE_KEYFRAME | #ICMF_CHOOSE_DATARATE, 1, @pStream, @opts(0)) = 1
If AVIMakeCompressedStream(@pAVICompressed, pStream, opts(0), 0) = #AVIERR_OK
If AVIStreamSetFormat(pAVICompressed, 0, @bmi, SizeOf(bitmap24)) = 0
WinBorders(x1, y1, x2 - x1, y2 - y1)
blinkTimer = ElapsedMilliseconds()
isAVIError = #False
Else
MessageRequester("Attention","AVI Stream Set Format call failed", #PB_MessageRequester_Ok | #MB_ICONERROR)
isAVIError = 5
EndIf
Else
MessageRequester("Attention","AVI Make Compressed Stream call failed", #PB_MessageRequester_Ok | #MB_ICONERROR)
isAVIError = 4
EndIf
Else
MessageRequester("Attention","AVI Save Options call failed", #PB_MessageRequester_Ok | #MB_ICONERROR)
isAVIError = 3
EndIf
Else
MessageRequester("Attention","AVI create File Stream failed", #PB_MessageRequester_Ok | #MB_ICONERROR)
isAVIError = 2
EndIf
Else
MessageRequester("Attention","AVI File Open failed: " + Hex(ResultL, #PB_Long), #PB_MessageRequester_Ok | #MB_ICONERROR)
isAVIError = 1
EndIf
Else
isAVIError = #True
EndIf
EndIf
If isAVIError
;break capture due to AVI error
If isAVIError>1
AVIFileRelease(*pavfile)
EndIf
If isAVIError>2
AVIStreamRelease(pStream)
EndIf
If isAVIError>4
AVIStreamRelease(pAVICompressed)
EndIf
isStarCapture = 0
HideWindow(#Win_Tool, #False)
EndIf
Else
isStarCapture=1
EndIf
EndIf
EndIf
EndSelect
Delay(1)
ForEver
