Jump to content

maXcomX

Members
 View Profile  See their activity

  • Content Count

    34

  • Joined

  • Last visited

Posts posted by maXcomX

  2. Posted

    On 10/10/2023 at 1:16 PM, Renate Schaaf said:

    HEIF is a container format like .mp4, as far as I see Windows manages this file format via WICImage only. MFPack contains headers for this, but all that goes a bit over my head.

    If you want to test HEVC-compression, you can do this via BitmapsToVideoWMF by creating an .mp4-file with just one frame using the procedures below.

    This is anything but fast, because of the initialization/finalization of Mediafoundation taking a long time.

    A quick test compresses a .jpg of 2.5 MB taken with my digital camera to an .mp4 of 430 KB. No quality loss visible at first glance.

      

    
uses VCL.Graphics, uTools, uTransformer, uBitmaps2VideoWMF;

procedure EncodeImageToHEVC(const InputFilename, OutputFileName: string);
var
  wic: TWicImage;
  bm: TBitmap;
  bme: TBitmapEncoderWMF;
begin
  Assert(ExtractFileExt(OutputFileName) = '.mp4');
  wic := TWicImage.Create;
  try
    bm := TBitmap.Create;
    try
      wic.LoadFromFile(InputFilename);
      WicToBmp(wic, bm);
      bme := TBitmapEncoderWMF.Create;
      try
        // Make an .mp4 with one frame.
        // Framerate 1/50 would display it for 50sec
        bme.Initialize(OutputFileName, bm.Width, bm.Height, 100,
          1 / 50, ciH265);
        bme.AddFrame(bm, false);
      finally
        bme.Free;
      end;
    finally
      bm.Free
    end;
  finally
    wic.Free;
  end;
end;

procedure DecodeHEVCToBmp(const mp4File: string; const Bmp: TBitmap);
var
  vi: TVideoInfo;
begin
  vi := uTransformer.GetVideoInfo(mp4File);
  GetFrameBitmap(mp4File, Bmp, vi.VideoHeight, 1);
end;

     

    The video codec HEVC is well documented but difficult to understand . However, this codec needs to be initialized with a HEVC profile and optionally payload that is supported by Media Foundation. Now, the documentation is not very accurate about the supported profiles. Two of them are missing though. Note that Media Foundation only supports 2 payloads (0-1) 2 and 3 are not supported.

    Another misunderstanding is how Media Foundation slices a media source. For a regulair file it has a video related codec an audio related codec, maybe a subtitle stream and the container file that holds those. For example a MP4 container (.mp4 file) can contain various types of codecs. Like for example the HEVC video codec and a mp3 audio codec, a H264 video codec and a Dolby_AC3 audio codec etc. 

    The coming MfPack version will be expanded with a Videocheat and video profiles unit to make life easier.

    New updates are regulair committed and can be found here

    Note that the H.265 encoder implements by documentation properties like CODECAPI_AVLowLatencyMode etc. are DirectShow properties and therefore should not be implemented in Media Foundation.

     

  3. Posted

    When examine the code, it's not clear to me what the parameter ShowTime means.

    Lets say I want to render 3 images during the length of an audiofile in a slideshow, that would be the audiofile length div 3.

    So, each image will be shown for 1/3th during the audiofile length. Is this value the "ShowTime" or does ShowTime means the time 2 images are fading to onenother?

  5. Posted

    On 5/27/2023 at 11:47 PM, Renate Schaaf said:
    6 hours ago, Renate Schaaf said:

    Wonder whether it would be possible collecting them into records, so you could consult code completion about them.

    I use a special app that reads almost all possible result codes and when possible where to find more details. These codes and descriptions are stored in Delphi units.

     

     

     

  6. Posted

    On 5/27/2023 at 11:47 PM, Renate Schaaf said:

    @programmerdelphi2k

    What if hrSampleBuffer is not S_Ok, causing pSinkWriter.WriteSample to fail with an AV or such? You would get an exception the source of which would be harder to trace.

     

    Or am I just too dense to understand :). (It's late)

     

     

     

    In that case assign the buffer to nil (which is silence) and try again. However an av will never happen unless the API is wrong translated or when you use sloppy code. You will always get an HResult when something goes wrong.

    • Thanks 1

  8. Posted · Edited by maXcomX
    Clarifying

    1 hour ago, Renate Schaaf said:

    No thanks 🙂. But I've already translated parts of C++-code to Delphi. They could use stuff like Break_On_Fail(hr) and more, made me a bit jealous.

     

    You wouldn't per chance know why I can't mux any audio into an HEVC-encoded video? The video stream is all there, but it seems to be missing the correct stream header. So only the audio is being played.

    Maybe you forgot to add a stream for sound? Container formats always have separate streams for sound and/or subtitles. That's why most players can play a video in native languages and subtitles.

  9. Posted

    On 5/27/2023 at 10:51 PM, programmerdelphi2k said:

    @Renate Schaaf

     

    is it not possible just this way?  or pSample.XXXXX( XXXXX ) can break next line = exception, for example? 

    
  if (MFCreateSample(pSample) = S_OK) then // S_OK = 0
    begin
      hrSampleBuffer   := pSample.AddBuffer(pSampleBuffer);
      hrSampleTime     := pSample.SetSampleTime(fWriteStart);
      hrSampleDuration := pSample.SetSampleDuration(fSampleDuration);
      hrWriteSample    := pSinkWriter.WriteSample(fstreamIndex, pSample);
      //
      if (hrSampleBuffer or hrSampleTime or hrSampleDuration or hrWriteSample) = S_OK then // or just -> (hrWriteSample = S_OK) then
        begin
          inc(fWriteStart, fSampleDuration);
          fVideoTime := fWriteStart div 10000;
          inc(fFrameCount);
        end
      else
        raise Exception.Create('TBitmapEncoderWMF.WriteOneFrame failed');
    end;

     

    And will this give any user or debugger information about what exactly went wrong? The HResult code does. So, you have to be more specific when raising an exception, I would think.

  10. Posted

    On 5/27/2023 at 8:39 PM, Renate Schaaf said:

    Thanks, sounds like it's just the thing needed. Just need to figure out how.

     

    Error: uToolsWMF uses a unit Z_prof. Entry can be safely deleted. Comes from having too much stuff in the path.

     

    Meanwhile I think I figured out how to improve the encoding quality.

     

    Around line 270 in uBitmaps2VideoWMF.pas make the following changes:

      

    
if succeeded(hr) then
    hr := MFCreateAttributes(attribs, 4);  //<--------- change to 4 here
  // this enables hardware encoding, if the GPU supports it
  if succeeded(hr) then
    hr := attribs.SetUINT32(MF_READWRITE_ENABLE_HARDWARE_TRANSFORMS, UInt32(True));
  // this seems to improve the quality of H264 and H265-encodings:
  {*************** add this *********************************}
  // this enables the encoder to use quality based settings
  if succeeded(hr) then
    hr := attribs.SetUINT32(CODECAPI_AVEncCommonRateControlMode, 3);
  {**************** /add this *******************************}
  if succeeded(hr) then
    hr := attribs.SetUINT32(CODECAPI_AVEncCommonQuality, 100);
  if succeeded(hr) then
    hr := attribs.SetUINT32(CODECAPI_AVEncCommonQualityVsSpeed, 100);

    Besides, I'm getting sick and tired of all those if succeeded...
     

    🙂 Learn C++ I would say.  Delphi users are quite spoiled about resolving method results. But helaas, until now, there is no solution in Delphi to handle HResult in it's exception handlers for media foundation and directx. To be more specific: WinApi.Error.Pas is way outdated until version 10.3

  11. Posted

    5 hours ago, programmerdelphi2k said:

    I think that is not problem too... the big question "would be"?

    • where the "exception" (using the pSample in any function above "addBuffer, SetSampleTime, SetSampleDuration, WriteSample") would generated, exactly?
      • my question is about that in MS links dont show if an "exception" would be generated (exactly), but just say the "result would be <> 0", then, if I has the "pSample" = ok, what happens if "I cannot set the Time, Duration" for example, but I can "write a new sample without this 2 values?" for example. The new sample would be invalid or it will use default values? if not invalid then write it would be ok not?
    • using your "CheckFail()" I think that is the same, because you are executing "CheckFail" after "CheckFail", then, if the 1 fail, what happens to others? you see? the same than my "vars = xxxxxx"....
    • now, if none "exception" is "generated by this functions ("addBuffer, SetSampleTime, SetSampleDuration, WriteSample") then, you choice what is better for you, because your "CheckFail" only raise the exception AFTER "HR=FALSE", or be, you raise the exception, not the "function" itself, you see?

    Checking the results of the media foundation methods is as easy as can be. The results will give you information about what went wrong in most cases.  So, the standard exception handling in Delphi is not suitable and therefore you have to write our own exception handlers, because each hresult code is described in WinApi.WinError.pas or WinApi.MediaFoundationApi.MfError.pas and will exactly return what went wrong. Media Foundation and related API's are not part of the Delphi distributions from Embarcadero, and if they are, they are outdated in most cases. The Microsoft documentation explains the retuned values of the API methods very well.

    • Like 1

  13. Posted

    Sorry a bit late response.

    Delphi has a unit called psapi.pas, but it's incomplete , for some reason this record is not translated (since Delphi XE7, or earlier, the first translation of this header I found was from  Borland).

     

    I did indeed made a mistake.

     

    So I translated it  like this: 

      STRUCT_PSAPI_WORKING_SET_BLOCK = record
  private
    Flags: ULONG_PTR;
    function GetBits(const aIndex: Integer): ULONG_PTR;
    procedure SetBits(const aIndex: Integer;
                      const aValue: ULONG_PTR);

  public
    property Protection: ULONG_PTR  index $0005 read GetBits write SetBits;    // 5 bits at offset 0
    property ShareCount: ULONG_PTR  index $0503 read GetBits write SetBits;    // 3 bits at offset 5
    property Shared: ULONG_PTR      index $0801 read GetBits write SetBits;    // 1 bit at offset 8
    property Reserved: ULONG_PTR    index $0903 read GetBits write SetBits;    // 3 bits at offset 9
    {$IFDEF WIN64}
    property VirtualPage: ULONG_PTR index $1253 read GetBits write SetBits;    // 52 bits at offset 12
    {$ELSE}
    property VirtualPage: ULONG_PTR index $1220 read GetBits write SetBits;    // 20 bits at offset 9
    {$ENDIF}
  end;

  PSAPI_WORKING_SET_BLOCK = record
  public
    case Integer of
      0: ( struct: STRUCT_PSAPI_WORKING_SET_BLOCK );
    end;
  {$EXTERNALSYM PSAPI_WORKING_SET_BLOCK}
  PPSAPI_WORKING_SET_BLOCK = ^PSAPI_WORKING_SET_BLOCK;
  {$EXTERNALSYM PPSAPI_WORKING_SET_BLOCK}


// PSAPI_WORKING_SET_BLOCK /////////////////////////////////////////////////////
function STRUCT_PSAPI_WORKING_SET_BLOCK.GetBits(const aIndex: Integer): ULONG_PTR;
begin
  Result := GetUBits(Flags,
                     aIndex);
end;

procedure STRUCT_PSAPI_WORKING_SET_BLOCK.SetBits(const aIndex: Integer;
                                                 const aValue: ULONG_PTR);
begin
  SetUBits(Flags,
           aIndex,
           aValue);
end;
// /////////////////////////////////////////////////////////////////////////////

// global unit helpers

// Record helpers //////////////////////////////////////////////////////////////

function GetUBits(const Bits: ULONG_PTR;
                  const aIndex: Integer): ULONG_PTR;
begin
  Result := (Bits shr (aIndex shr 8)) and  // offset
             ((1 shl Byte(aIndex)) - 1);   // mask
end;

procedure SetUBits(var Bits: ULONG_PTR;
                   const aIndex: Integer;
                   const aValue: ULONG_PTR);
var
  Offset: Byte;
  Mask: Integer;

begin
  Mask := ((1 shl Byte(aIndex)) - 1);
  Assert(Integer(aValue) <= Mask);

  Offset := aIndex shr 8;
  Bits := (Bits and (not (Mask shl Offset)))
          or DWORD(aValue shl Offset);
end;

     In the middle of discussing this issue with Rudy Veldhuis, he passed away  😞 But he pointed out in his blog which is still online, a similar solution.

    Henri Gourvest (from DSPack) opinion is to skip structs containing C/C++ bitshifting, because it's rarely used and what you commented that bitfield ordering is not standardized.

    So good reasons why Embarcadero still did not include this in psapi.pas?

     

    Thanks in advance, Tony.

     

     

     

     

     

     

  14. Posted · Edited by maXcomX
    Added specific information

    Hello,

     

    I'm trying to translate PSAPI_WORKING_SET_BLOCK (psapi.h) structure to Delphi. 

     

    Now I'm struggling with as far as I become this far:

      

    type

  STRUCT_PSAPI_WORKING_SET_BLOCK = record
  private
    Flags: ULONG_PTR;
    function GetBits(const aIndex: NativeUInt): NativeUInt;
    procedure SetBits(const aIndex: NativeUInt;
                      const aValue: NativeUInt);

  public
    property Protection: NativeUInt  index $0005 read GetBits write SetBits;    //  5 bits at offset 0
    property ShareCount: NativeUInt  index $0503 read GetBits write SetBits;    //  3 bits at offset 5
    property Shared: NativeUInt      index $0801 read GetBits write SetBits;    //  1 bit at offset 8
    property Reserved: NativeUInt    index $0903 read GetBits write SetBits;    //  3 bits at offset 9
    {$IFDEF WIN64}
    property VirtualPage: NativeUInt index $1253 read GetBits write SetBits;    //  52 bits at offset 12
    {$ELSE}
    property VirtualPage: NativeUInt index $1220 read GetBits write SetBits;    //  20 bits at offset 9
    {$ENDIF}
  end;



  PSAPI_WORKING_SET_BLOCK = record
    case Integer of
      0: ( struct: STRUCT_PSAPI_WORKING_SET_BLOCK );
    end;
  PPSAPI_WORKING_SET_BLOCK = ^PSAPI_WORKING_SET_BLOCK;

    The issue is that index is a integerConstant clause, so NativeUint will not work in this situation.

     

     

    How do I tackle this?

     

    Like this? 

    type



  STRUCT_PSAPI_WORKING_SET_BLOCK = record
  private
    Flags: ULONG_PTR;
    function GetBits(const aIndex: Integer): NativeUInt;
    procedure SetBits(const aIndex: Integer; const aValue: NativeUInt);

  public
    property Protection: NativeUInt index 5 read GetBits write SetBits;    //  5 bits at offset 0
    property ShareCount: NativeUInt index 503 read GetBits write SetBits;  //  3 bits at offset 5
    property Shared: NativeUInt index 801 read GetBits write SetBits;      //  1 bit at offset 8
    property Reserved: NativeUInt index 903 read GetBits write SetBits;    //  3 bits at offset 9
    {$IFDEF WIN64}
    property VirtualPage: NativeUInt index 1253 read GetBits write SetBits; //  52 bits at offset 12
    {$ELSE}
    property VirtualPage: NativeUInt index 1220 read GetBits write SetBits; //  20 bits at offset 9
    {$ENDIF}
  end;

  PSAPI_WORKING_SET_BLOCK = record
    case Integer of
      0: ( struct: STRUCT_PSAPI_WORKING_SET_BLOCK );
  end;
  PPSAPI_WORKING_SET_BLOCK = ^PSAPI_WORKING_SET_BLOCK;

    And cast the GetBits and SetBits methods, aIndex parameter from Integer to NativeUInt when accessing the appropriate bits in the Flags field?

  15. Posted · Edited by maXcomX
    Typo

    Thanks, Remy.

     

    IAgileObject works as expected.

     

    On 3/29/2023 at 2:40 AM, Remy Lebeau said:

    However, nothing in the ActivateAudioInterfaceAsync() documentation mentions aggregating the FTM at all.  All it says is that your completionHandler object needs to implement the IAgileObject interface, nothing more.  IAgileObject is an indicator that lets the system know that the object is free-threaded and thus can be called across apartment boundaries without marshaling.

    This text confused me:

    E_ILLEGAL_METHOD_CALL
    On versions of Windows previous to Windows 10, this error may result if the function is called from an incorrect COM apartment, or if the passed IActivateAudioInterfaceCompletionHandler is not implemented on an agile object (aggregating a free-threaded marshaler).

     

    So on first thought, I would need an aggregated interface instead of an IAgileObject interface.

    And because IAgileObject is not defined in any Delphi version, TAggregatedObject bubbled up..

     

    Being confused has nothing to do with Confucius I would say...

     

    For the audience I translated IAgileObject to Delphi (which should be declared in ObjIdl, part of Delphi ActiveX?) 

      // Interface IAgileObject
  // ======================
  // The IAgileObject interface is a marker interface that indicates that an object
  // is free threaded and can be called from any apartment.
  // Unlike what happens when aggregating the Free Threaded Marshaler (FTM),
  // implementing the IAgileObject interface doesn't affect what happens when marshaling a call.
  // Instead, the IAgileObject interface is recognized by the Global Interface Table (GIT).
  // When an object that implements the IAgileObject interface is placed in the GIT and
  // localized to another apartment, the object is called directly in the new apartment, rather than marshaling.
  {$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IAgileObject);'}
  {$EXTERNALSYM IAgileObject}
  IAgileObject = interface(IUnknown)
  ['{94ea2b94-e9cc-49e0-c0ff-ee64ca8f5b90}']
    // public
  end;
  IID_IAgileObject = IAgileObject;
  {$EXTERNALSYM IID_IAgileObject}

    Again: Thank you for your help and explanations on this subject.

     

  16. Posted · Edited by maXcomX
    Typo

    Ok, thank you again for this useful info.

    I stumbled into this while writing a basic audio loopback application, where I experienced a strange behavior of function ActivateAudioInterfaceAsync.

    My first thought was it had something todo with ConitializeEx().  But reading the documentation again, the interface should be implemented on an agile object (aggregating a free-threaded marshaler.

    I think I need to implement the TAggregatedObject, but not sure if that is correct and how to implement this.

    I tried this: 

      TActivateAudioInterfaceCompletionHandler = class(TInterfacedObject, IActivateAudioInterfaceCompletionHandler)
  public
    function ActivateCompleted(activateOperation: IActivateAudioInterfaceAsyncOperation): HRESULT; stdcall;
  end;

  TLoopbackCapture = class(TAggregatedObject, IActivateAudioInterfaceCompletionHandler)

  // etc

  // constructor
constructor TLoopbackCapture.Create(oObj: IUnknown);
var
  hr: HResult;

begin
  inherited Create(IActivateAudioInterfaceCompletionHandler(oObj));
  // etc

// From the mainform creating tLoopBackCapture is called

 var
   OuterObj: TActivateAudioInterfaceCompletionHandler;
   oLoopbackCapture: TLoopbackCapture;


procedure TfrmMain.FormCreate(Sender: TObject);
begin
  OuterObj := TActivateAudioInterfaceCompletionHandler.Create();
  oLoopbackCapture := TLoopbackCapture.Create(IActivateAudioInterfaceCompletionHandler(OuterObj));
end;

    But this approach doesn't work either.

    When calling ActivateAudioInterfaceAsync,  

    function TAggregatedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  Result := IInterface(FController).QueryInterface(IID, Obj);  << FController = nil
end;

    No Interface ($80004002), IID = {'94EA2B94-E9CC-49E0-C0FF-EE64CA8F5B90'}, well actually that's the identifier of the IAgile interface..

    Followed by EAccessError.

     

    So, I think implementing TAggregatedObject is not the way, but implementing IAgile should do it?

     

    It's a real headbanger.. 😞

     

     

  17. Posted · Edited by maXcomX
    Clarifying

    I must have overlooked something. 

    When initializing an UI application, any earlier Conitialize() as default, should be set to ConitializeEx() when necessarily.

    So, if Assigned(InitProc) is true, CoUnitialize() should be called to change the thread model and set to ConitializeEx() to make callbacks working.

    Also the parameter COINIT_MULTITHREADED that only should be used by DOSbox and other windowless apps, should be COINIT_APARTMENTTHREADED for UI apps.

    Am I correct?

     

     

     

  19. Posted · Edited by maXcomX

    Yes I can.

    I'm working on a new example that replaces the mmio methods, because they are or will be deprecated (like mmioOpen) And that make all other mmio related methods quite useless.

    So far I managed to translate a CPP example to it's Delphi equivalent. However Microsoft made a lot of samples based on a DOSBox interface.

     

    To be more specific, the DOSbox sample runs well on MS Visual Studio (returning the adequate result of CoInitializeEx() , but not within Delphi 10.4.

     

    Here Delphi source including the CPP source:

     

     

     

     

     

     

    LoopBackCapture_2.zip

     

    The Delphi sample uses MFPack

  20. Posted

    28 minutes ago, programmerdelphi2k said:

    I dont know almost nothing about COM usage, but if you check if "initproc" before any usage... it was assigned, dont help you? 

    
if Assigned(InitProc) then

    It does what it's expected to do, but it will not explain why the function is resulting the results I mentioned. 

  21. Posted

    1 hour ago, Remy Lebeau said:

    That is S_FALSE.

    That is RPC_E_CHANGED_MODE.

    Per the documentation: https://learn.microsoft.com/en-us/windows/win32/api/combaseapi/nf-combaseapi-coinitializeex

    This means that you are calling CoInitializeEx() on a thread that has already called CoInitialize/Ex() successfully, where S_FALSE means you are trying to set the same concurrency model that has already been assigned to the thread, whereas RPC_E_CHANGED_MODE means you are specifying a concurrency model that is not compatible with the thread's current concurrency model.

     

    For instance, are you calling CoInitializeEx() in the main UI thread?  The RTL's System.Win.ComObj unit initializes COM in the main UI thread during program startup, using the global CoInitFlags variable to decide whether to use CoInitialize() or CoInitializeEx().

    Thank you Remy, but I've been through all those things. That's why I ended here 😉

×