PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Save part of desktop to AVI

https://www.purebasic.fr/english/viewtopic.php?t=86484

Page 1 of 1

Save part of desktop to AVI

Posted: Sun Mar 09, 2025 7:59 pm
by Etayson
Sometimes you need to save a part of the desktop as a AVI video. And this program will help you with this.
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

Re: Save part of desktop to AVI

Posted: Sun Mar 09, 2025 8:39 pm
by Caronte3D
Thanks! It's very interesting! :D
Would be nice to have better codecs.

Re: Save part of desktop to AVI

Posted: Sun Mar 09, 2025 8:50 pm
by Etayson
Caronte3D wrote: Sun Mar 09, 2025 8:39 pm Thanks! It's very interesting! :D
Would be nice to have better codecs.
you can install any codec you want, for example XVID and it will appear in the options.

Re: Save part of desktop to AVI

Posted: Sun Mar 09, 2025 9:01 pm
by Caronte3D
Yes! I know, my idea was more to have native support in the PB code, so there would be no need to ask users to install codecs.
Thanks anyway :wink:

Re: Save part of desktop to AVI

Posted: Mon Mar 10, 2025 12:36 am
by BarryG
Thanks for sharing. :)

Re: Save part of desktop to AVI

Posted: Tue Mar 11, 2025 9:20 pm
by Kwai chang caine
Works great here
Just a little detail, the red square not appear when i select the area, it appear when the recording begin, i don't know if it's normal :oops:
Thanks for sharing 8)

Re: Save part of desktop to AVI

Posted: Tue Mar 11, 2025 11:07 pm
by AZJIO
Instead of a blinking red border, it is better to make crawling ants

Re: Save part of desktop to AVI

Posted: Thu Mar 13, 2025 11:35 am
by Mesa
I've just adapted this code for my own use: fullscreen recording (only).
Use right click to stop.

Code: Select all

;- TOP

EnableExplicit

;- CONSTANTS
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)


;- STRUCTURES
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
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
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, totalmemoryused
Define ci.CURSORINFO, iconinfo.ICONINFO, cur_x, cur_y
Define bmi.bitmap24
Define FrameRate = 25
Define x1, y1, x2, y2
Define hRectangle_GUI
Define hDC
Define trgDC
Define bitBlt
Define starttime
Define isStarCapture = 0
Define Dim Opts(1)
Opts(0) = @Opts

;- 
;- Main
ExamineDesktops()


;USAGE
;It begins to record immediately, and right click button to stop record.

;DPI AWARE
hRectangle_GUI = OpenWindow(#Win_Sel, 0, 0, DesktopUnscaledX(DesktopWidth(0)), DesktopUnscaledY(DesktopHeight(0)), "", #WS_POPUP | #PB_Window_BorderLess | #PB_Window_Invisible)
;   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)
  StickyWindow(#Win_Sel, #True)
EndIf

;- avilib
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()
isStarCapture = 3

x1 = 0
y1 = 0
x2 = DesktopWidth(0)
y2 = DesktopHeight(0)

totalmemoryused = 0


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
              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
  If pAVICompressed:AVIStreamRelease(pAVICompressed):EndIf
  If pStream:AVIStreamRelease(pStream):EndIf
  If *pavfile:AVIFileRelease(*pavfile):EndIf
  AVIFileExit()
  CloseLibrary(AviLib)
  ReleaseDC_(0, HDC)
  If trgDC
    ReleaseDC_(GetDesktopWindow_(), trgDC)
  EndIf
  CloseWindow(#Win_Sel)
  End
EndIf



;- loop
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
          
        Else
          
          If pAVICompressed:AVIStreamRelease(pAVICompressed):EndIf
          If pStream:AVIStreamRelease(pStream):EndIf
          If *pavfile:AVIFileRelease(*pavfile):EndIf
          AVIFileExit()
          CloseLibrary(AviLib)
          ReleaseDC_(0, HDC)
          If trgDC
            ReleaseDC_(GetDesktopWindow_(), trgDC)
          EndIf
          CloseWindow(#Win_Sel)
          End
          isStarCapture = 0
        EndIf
      EndIf
    EndIf
  EndIf
  
ForEver

;- END
M.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited