Renate Schaaf

I'm not all that familiar with FMX. So I'm trying to have a TImage display a TBitmap so I see the "exact" original, and I also want the image to resize to the correct dimensions of the bitmap.

This is what I have come up with, but it seems overly complicated:

procedure DisplayInOriginalSize_AndSizeToFit(const bmp: TBitmap; im: TImage);
var
  ScaleInv: single;
begin
  im.WrapMode := TImageWrapMode.Original;
  ScaleInv := 1 / im.Scene.GetSceneScale;
  // ScaleInv:=1/Screen.Displays[0].Scale;
  im.SetBounds(im.Position.X, im.Position.Y, bmp.Width * ScaleInv,
    bmp.Height * ScaleInv);
  im.Bitmap.Assign(bmp);
  im.Bitmap.BitmapScale := 1;
end;

The commented line works too for me, but it wouldn't in a multiple-monitor-setting.

There must be an easier way to set the exact pixel dimensions of a control.

Thanks, Renate

Your handcrafted routine isn't *that* slow, just turn on compiler-optimization.

As for resampling, I had started to port my parallel bitmap-resampler to fmx, but then I thought, hey, these guys can use DirectDraw, there won't be a demand.

Now, seeing how poor the quality is for (supposedly) bilinear rescaling, I have continued working on it. A first version is usable on Windows only for the time being. I just have to add some demos, and I'll probably upload it later today to

https://github.com/rmesch/Parallel-Bitmap-Resampler

Just in case you might be interested.

It looks like you want to use the component list of a TForm, so you should pass that form as a parameter:

function SetDBSessionNames(const AForm: TForm; const sSessionName: string): boolean;
begin
  //
  for var i := 0 to AForm.ComponentCount - 1 do
  begin
    //
    if AForm.Components[i] is TEDBSession then (AForm.Components[i] as TEDBSession).SessionName := sSessionName;
..

Then you can call it in the code of a form as

SetDBSessionNames(self, sSessionName);

11 minutes ago, Anders Melander said:

I don't think it is, but...

Well, the test clearly shows it, or doesn't it?

13 minutes ago, Anders Melander said:

You should only call CoUninitialize if the call to CoInitialize(Ex) succeeded.

Because I could step on the toes of some other code, I guess. Thanks, I'll keep it in mind. Anyway, for the time being I feel safer with just creating a TWICImage in initialization.

1 hour ago, dwrbudr said:

Is there anything else that shall be protected by a critical section, e.g. some other class variable or something else.

Is has to do with COM, ActiveX, don't ask me to explain, I know next to nothing about these things. But I browsed QC a bit, in which this or similar bugs have been reported multiple times (almost all closed), but I got the idea that a CoInitialize call could be missing.

Look at this simple test:

uses System.Threading, WinApi.ActiveX;

procedure TForm2.Button1Click(Sender: TObject);
var
  task: iTask;
begin
  task := TTask.Run(
    procedure
    var
      WIC: TWICImage;
    begin
      //CoInitializeEx(nil,COINIT_MULTITHREADED);
      WIC := TWICImage.Create;
      try

      finally
        WIC.Free;
      end;
    end);
end;

As it is, this gives an error in VCL.Graphics in the line marked:

constructor TWICImage.Create;
var
  LResult: HResult;
begin
  inherited;
  FInterpolationMode := wipmNone;

  EnterCriticalSection(WicImageLock);
  try
    if FImagingFactory = nil then
    begin
      LResult := CoCreateInstance(CLSID_WICImagingFactory, nil, CLSCTX_INPROC_SERVER or //<---------------------------
        CLSCTX_LOCAL_SERVER, IUnknown, FImagingFactory);
      if Failed(LResult) then
        raise EInvalidGraphicOperation.CreateFmt(SWinRTInstanceError + ' (%X)', ['CLSID_WICImagingFactory', LResult]);
    end
    else
      FImagingFactory._AddRef;
  finally
    LeaveCriticalSection(WicImageLock);
  end;

Uncommenting the line with CoInitializeEx in the test, seems to fix the error in the test procedure.

Renate

On 4/24/2023 at 8:19 PM, dwrbudr said:

What makes you think TWICImage.Create is not thread-safe in recent Delphi versions?

The TWICImage-factory-bug in threads is still present in 11.3 (I just got the new community-edition 🙂)

3 hours ago, angusj said:

Oops, sorry, it appears that alpha is an integer, not a byte.

It could still work, since the weights only run from -$100 to $100. So a 3-dimensional table would work. Let's try.

Edit: No, such a table would just be too big.

Edit2: shr 2 doesn't work, because the result of the multiplication could be negative.

Thanks for the idea!

I just managed to get the routine for the pre-multiplication much faster. I naively assumed that MulDiv is faster than multiplication and subsequent div. So I used this (PremultPrecision is a constant of value 4):

if ps.rgbReserved > 0 then
  begin
    alpha := Weight * ps.rgbReserved;
    inc(Cache.b, MulDiv(ps.rgbBlue, alpha, PreMultPrecision));
    inc(Cache.g, MulDiv(ps.rgbGreen, alpha, PreMultPrecision));
    inc(Cache.r, MulDiv(ps.rgbRed, alpha, PreMultPrecision));
    inc(Cache.a, alpha);
  end;

But this is in fact faster (with compiler-optimization turned on):

if ps.rgbReserved > 0 then
  begin
    alpha := Weight * ps.rgbReserved;
    inc(Cache.b, ps.rgbBlue*alpha div PreMultPrecision);
    inc(Cache.g, ps.rgbGreen*alpha div PreMultPrecision);
    inc(Cache.r, ps.rgbRed*alpha div PreMultPrecision);
    inc(Cache.a, alpha);
  end;

And now I remember that Anders even explained that behavior to me before:

  If the div is by a constant that is a power of 2, the optimizer is smart enough to turn div into a shift.

Guess the optimizer isn't smart enough to do this in MulDiv.

22 hours ago, angusj said:

It's very easy to rename a repository

Wow, it was indeed very easy, and even the previous link still works!

Thanks!

It certainly isn't in 10.4, I tried it. Don't know about 11.x, since I don't have it. I'm claiming to support 10.x and higher.

See here: https://www.delphitools.info/2019/07/18/workaround-for-twicimage-imagefactory-bug-in-delphi-10-x/

Edit: I played around with this some more, and it seems like you just have to create any old TWICImage in the main thread before you send off a thread. Then the thread can safely use TWICImage.Create, because the factory has been initialized already. If the factory is initialized in the thread, it bombs.

On 4/20/2023 at 5:15 AM, Tommi Prami said:

threads are not initialized to consume memory

I've implemented this in the new version, but not via a new unit, too much of a can of worms for me right now.

Changes to https://github.com/rmesch/Repository-R.Schaaf are now as follows:

Hi Tommi,

Your suggestions make a lot of sense. I had already thought it would be better not to initialize the thread pool in initialization, but moving the thread pool stuff into a different unit is a much better idea.

Renate

A new version is available at https://github.com/rmesch/Repository-R.Schaaf.

The parallel resampler can now be used in concurrent threads. You can define more than one thread pool for the resampling and tell the parallel procedure which pool to use. A new demo "ThreadsInThreads" has been added.

Initially I had the problem that this demo would sometimes hang waiting for an event, but that has hopefully been fixed.

I'd much appreciate a feedback if it still occurs.

Thanks,

Renate

Hi Anders,

Just tried the new version of Graphics32, and found that the downscaling with Box looks as cr***y as before we changed the radius to 0.5, which IS the logically correct value, since the box function has a support [-0.5,0.5]. I can't see right now what goes wrong with the upscaling, it must be something different.

Anyway, I don't see any problems with upscaling in my code, just tried it with a factor 20.

You did a lot of work on graphics32, will have a closer look.

Renate

@johnnydp Sorry for the late reply, I took a break from delphi.

I now created a repository on GITHub which contains the latest version of the resampler plus 2 demos.

https://github.com/rmesch/Repository-R.Schaaf

See you, Renate

On 8/13/2022 at 3:56 PM, Tom F said:

Is there a way to show the "old style" (with a tree) when using styles??

You can add the following line e.g. in the OnCreate of the main form:

TStyleManager.SystemHooks := TStyleManager.SystemHooks - [shDialogs];

VCL.Themes needs to be in the uses list. The drawback is, that the style is also removed from all message dialogs. But I find it easier to make your own message boxes than your own file dialogs.

1 hour ago, Fr0sT.Brutal said:

Do you mean these issues exist inside the DLL itself?

No. The functions have just not been used not quite correctly in the example procedure that encodes a file. I should have made that more clear in my post.

29 minutes ago, David Heffernan said:

Did you submit a PR for these changes?

No. I'd like to find out if this really works in all cases, first. Then I'll have to teach myself how to do PRs :).

I spent some time to have Delphi interface correctly with the Lame-encoder-DLL, so I thought it a good idea to share the result, since I also could not find any good Delphi-code for this on the net.

The Lame-source comes with a rudimentary Delphi-header-file, but this has several issues, which I have tried to fix:

• The file references unnecessary stuff, preventing compilation, easy to fix.
• The encoding starts at the beginning of the wave-file, thereby encoding the header. This gives a noise at the beginning and can switch the stereo-channels. Fix: Offset the source into the data-section of the wave-file. Since this offset can vary, I have used the utility functions by Kambiz R. Khojasteh (http://www.delphiarea.com) to retrieve the necessary info using WinApi.MMSystem.
• Lame suggests writing a VBR-Header to the file, even though it's CBR, I have changed the routine accordingly. This way devices can e.g. figure out the duration of the mp3-audio more easily.
• Instead of file-handles I'm using TFileStream, that seems to speed up encoding considerably.

Usage:  EncodeWavToMP3(WaveFile, MP3File, Bitrate)

WaveFile needs to be 16-bit Stereo, but that could be adjusted.

Bitrate is a constant bitrate, for example 128. Support for VBR could be added.

If you use it and find something wrong, I'd like to know 🙂

Here is the unit:

unit MP3ExportLame;

interface

Uses System.SysUtils, WinApi.Windows, System.Classes;

type
  // type definitions

  PHBE_STREAM = ^THBE_STREAM;
  THBE_STREAM = LongWord;
  BE_ERR = LongWord;

const
  // encoding formats

  BE_CONFIG_MP3 = 0;
  BE_CONFIG_LAME = 256;

  // error codes

  BE_ERR_SUCCESSFUL: LongWord = 0;
  BE_ERR_INVALID_FORMAT: LongWord = 1;
  BE_ERR_INVALID_FORMAT_PARAMETERS: LongWord = 2;
  BE_ERR_NO_MORE_HANDLES: LongWord = 3;
  BE_ERR_INVALID_HANDLE: LongWord = 4;

   // format specific variables

  BE_MP3_MODE_STEREO = 0;
  BE_MP3_MODE_DUALCHANNEL = 2;
  BE_MP3_MODE_MONO = 3;

  // other constants

  BE_MAX_HOMEPAGE = 256;

type

  TMP3 = packed record
    dwSampleRate: LongWord;
    byMode: Byte;
    wBitRate: Word;
    bPrivate: LongWord;
    bCRC: LongWord;
    bCopyright: LongWord;
    bOriginal: LongWord;
  end;

  TLHV1 = packed record
    // STRUCTURE INFORMATION
    dwStructVersion: DWORD;
    dwStructSize: DWORD;

    // BASIC ENCODER SETTINGS
    dwSampleRate: DWORD; // ALLOWED SAMPLERATE VALUES DEPENDS ON dwMPEGVersion
    dwReSampleRate: DWORD; // DOWNSAMPLERATE, 0=ENCODER DECIDES
    nMode: Integer;
    // BE_MP3_MODE_STEREO, BE_MP3_MODE_DUALCHANNEL, BE_MP3_MODE_MONO
    dwBitrate: DWORD; // CBR bitrate, VBR min bitrate
    dwMaxBitrate: DWORD; // CBR ignored, VBR Max bitrate
    nQuality: Integer; // Quality setting (NORMAL,HIGH,LOW,VOICE)
    dwMpegVersion: DWORD; // MPEG-1 OR MPEG-2
    dwPsyModel: DWORD; // FUTURE USE, SET TO 0
    dwEmphasis: DWORD; // FUTURE USE, SET TO 0

    // BIT STREAM SETTINGS
    bPrivate: LONGBOOL; // Set Private Bit (TRUE/FALSE)
    bCRC: LONGBOOL; // Insert CRC (TRUE/FALSE)
    bCopyright: LONGBOOL; // Set Copyright Bit (TRUE/FALSE)
    bOriginal: LONGBOOL; // Set Original Bit (TRUE/FALSE_

    // VBR STUFF
    bWriteVBRHeader: LONGBOOL; // WRITE XING VBR HEADER (TRUE/FALSE)
    bEnableVBR: LONGBOOL; // USE VBR ENCODING (TRUE/FALSE)
    nVBRQuality: Integer; // VBR QUALITY 0..9

    btReserved: array [0 .. 255] of Byte; // FUTURE USE, SET TO 0
  end;

  TAAC = packed record
    dwSampleRate: LongWord;
    byMode: Byte;
    wBitRate: Word;
    byEncodingMethod: Byte;
  end;

  TFormat = packed record
    case Byte of
      1:
        (mp3: TMP3);
      2:
        (lhv1: TLHV1);
      3:
        (aac: TAAC);
  end;

  TBE_Config = packed record
    dwConfig: LongWord;
    format: TFormat;
  end;

  PBE_Config = ^TBE_Config;

  TBE_Version = record
    byDLLMajorVersion: Byte;
    byDLLMinorVersion: Byte;

    byMajorVersion: Byte;
    byMinorVersion: Byte;

    byDay: Byte;
    byMonth: Byte;
    wYear: Word;

    zHomePage: Array [0 .. BE_MAX_HOMEPAGE + 1] of Char;
  end;

  PBE_Version = ^TBE_Version;


//Headers for Lame_enc.dll (ver. 3.100)

Function beInitStream(var pbeConfig: TBE_Config; var dwSample: LongWord;
  var dwBufferSize: LongWord; var phbeStream: THBE_STREAM): BE_ERR; cdecl;
  external 'Lame_enc.dll';
Function beEncodeChunk(hbeStream: THBE_STREAM; nSamples: LongWord; var pSample;
  var pOutput; var pdwOutput: LongWord): BE_ERR; cdecl; external 'Lame_enc.dll';
Function beDeinitStream(hbeStream: THBE_STREAM; var pOutput;
  var pdwOutput: LongWord): BE_ERR; cdecl; external 'Lame_enc.dll';
Function beCloseStream(hbeStream: THBE_STREAM): BE_ERR; cdecl;
  external 'Lame_enc.dll';
Procedure beVersion(var pbeVersion: TBE_Version); cdecl;
  external 'Lame_enc.dll';
// Added header for beWriteVBRHeader
Procedure beWriteVBRHeader(MP3FileName: pAnsiChar); cdecl;
  external 'Lame_enc.dll';

Procedure EncodeWavToMP3(WaveFile, MP3File: string; BitRate: Integer);
// BitRate 128 192 256 etc.

implementation

uses WinApi.MMSystem;

{ ---------------------------------------- }

{ The following functions retrieve the necessary info from the input-wave-file. }
{ Source: }
{ WaveUtils - Utility functions and data types }
{ by Kambiz R. Khojasteh }
{ }
{ kambiz@delphiarea.com }
{ http://www.delphiarea.com }

function mmioStreamProc(lpmmIOInfo: PMMIOInfo; uMsg, lParam1, lParam2: DWORD)
  : LRESULT; stdcall;
var
  Stream: TStream;
begin
  if Assigned(lpmmIOInfo) and (lpmmIOInfo^.adwInfo[0] <> 0) then
  begin
    Stream := TStream(lpmmIOInfo^.adwInfo[0]);
    case uMsg of
      MMIOM_OPEN:
        begin
          if TObject(lpmmIOInfo^.adwInfo[0]) is TStream then
          begin
            Stream.Seek(0, SEEK_SET);
            lpmmIOInfo^.lDiskOffset := 0;
            Result := MMSYSERR_NOERROR;
          end
          else
            Result := -1;
        end;
      MMIOM_CLOSE:
        Result := MMSYSERR_NOERROR;
      MMIOM_SEEK:
        try
          if lParam2 = SEEK_CUR then
            Stream.Seek(lpmmIOInfo^.lDiskOffset, SEEK_SET);
          Result := Stream.Seek(lParam1, lParam2);
          lpmmIOInfo^.lDiskOffset := Result;
        except
          Result := -1;
        end;
      MMIOM_READ:
        try
          Stream.Seek(lpmmIOInfo^.lDiskOffset, SEEK_SET);
          Result := Stream.Read(Pointer(lParam1)^, lParam2);
          lpmmIOInfo^.lDiskOffset := Stream.Seek(0, SEEK_CUR);
        except
          Result := -1;
        end;
      MMIOM_WRITE, MMIOM_WRITEFLUSH:
        try
          Stream.Seek(lpmmIOInfo^.lDiskOffset, SEEK_SET);
          Result := Stream.Write(Pointer(lParam1)^, lParam2);
          lpmmIOInfo^.lDiskOffset := Stream.Seek(0, SEEK_CUR);
        except
          Result := -1;
        end
    else
      Result := MMSYSERR_NOERROR;
    end;
  end
  else
    Result := -1;
end;

function OpenStreamWaveAudio(Stream: TStream): HMMIO;
var
  mmIOInfo: TMMIOINFO;
begin
  FillChar(mmIOInfo, SizeOf(mmIOInfo), 0);
  mmIOInfo.pIOProc := @mmioStreamProc;
  mmIOInfo.adwInfo[0] := DWORD(Stream);
  Result := mmioOpen(nil, @mmIOInfo, MMIO_READWRITE);
end;

function GetWaveAudioInfo(mmIO: HMMIO; var pWaveFormat: PWaveFormatEx;
  var DataSize, DataOffset: DWORD): Boolean;

  function GetWaveFormat(const ckRIFF: TMMCKInfo): Boolean;
  var
    ckFormat: TMMCKInfo;
  begin
    Result := False;
    ckFormat.ckid := mmioStringToFOURCC('fmt', 0);
    if (mmioDescend(mmIO, @ckFormat, @ckRIFF, MMIO_FINDCHUNK)
      = MMSYSERR_NOERROR) and (ckFormat.cksize >= SizeOf(TWaveFormat)) then
    begin
      if ckFormat.cksize < SizeOf(TWaveFormatEx) then
      begin
        GetMem(pWaveFormat, SizeOf(TWaveFormatEx));
        FillChar(pWaveFormat^, SizeOf(TWaveFormatEx), 0);
      end
      else
        GetMem(pWaveFormat, ckFormat.cksize);
      Result := (mmioRead(mmIO, pAnsiChar(pWaveFormat), ckFormat.cksize)
        = Integer(ckFormat.cksize));
    end;
  end;

  function GetWaveData(const ckRIFF: TMMCKInfo): Boolean;
  var
    ckData: TMMCKInfo;
  begin
    Result := False;
    ckData.ckid := mmioStringToFOURCC('data', 0);
    if (mmioDescend(mmIO, @ckData, @ckRIFF, MMIO_FINDCHUNK) = MMSYSERR_NOERROR)
    then
    begin
      DataSize := ckData.cksize;
      DataOffset := ckData.dwDataOffset;
      Result := True;
    end;
  end;

var
  ckRIFF: TMMCKInfo;
  OrgPos: Integer;
begin
  Result := False;
  OrgPos := mmioSeek(mmIO, 0, SEEK_CUR);
  try
    mmioSeek(mmIO, 0, SEEK_SET);
    ckRIFF.fccType := mmioStringToFOURCC('WAVE', 0);
    if (mmioDescend(mmIO, @ckRIFF, nil, MMIO_FINDRIFF) = MMSYSERR_NOERROR) then
    begin
      pWaveFormat := nil;
      if GetWaveFormat(ckRIFF) and GetWaveData(ckRIFF) then
        Result := True
      else if Assigned(pWaveFormat) then
        ReallocMem(pWaveFormat, 0);
    end
  finally
    mmioSeek(mmIO, OrgPos, SEEK_SET);
  end;
end;

function GetStreamWaveAudioInfo(Stream: TStream; var pWaveFormat: PWaveFormatEx;
  var DataSize, DataOffset: DWORD): Boolean;
var
  mmIO: HMMIO;
begin
  Result := False;
  if Stream.Size <> 0 then
  begin
    mmIO := OpenStreamWaveAudio(Stream);
    if mmIO <> 0 then
      try
        Result := GetWaveAudioInfo(mmIO, pWaveFormat, DataSize, DataOffset);
      finally
        mmioClose(mmIO, MMIO_FHOPEN);
      end;
  end;
end;

Procedure EncodeWavToMP3(WaveFile, MP3File: string; BitRate: Integer);
var
  beConfig: TBE_Config;
  dwSamples, dwSamplesMP3: LongWord;
  hbeStream: THBE_STREAM;
  error: BE_ERR;
  pBuffer: PSmallInt;
  pMP3Buffer: PByte;

  done: LongWord;
  dwWrite: LongWord;
  ToRead: LongWord;
  ToWrite: LongWord;

  // changed from THandle to TFileStream
  fs, ft: TFileStream;
  TotalSize: DWORD;

  // variables to hold the wave info necessary for encoding
  pWaveFormat: PWaveFormatEx;
  DataOffset, DataSize, InputSampleRate: DWORD;

begin
  beConfig.dwConfig := BE_CONFIG_LAME;
  fs := TFileStream.Create(WaveFile, fmOpenRead or fmShareDenyWrite);
  ft := TFileStream.Create(MP3File, fmCreate or fmShareDenyWrite);
  try
    TotalSize := fs.Size;

    // obtain info from source wave file
    try
      if not GetStreamWaveAudioInfo(fs, pWaveFormat, DataSize, DataOffset) then
        raise Exception.Create
          ('Unable to obtain necessary info from wave file.');
      if (pWaveFormat.nChannels <> 2) or (pWaveFormat.wBitsPerSample <> 16) then
        raise Exception.Create('Wave format must be 16bit Stereo.');
      InputSampleRate := pWaveFormat.nSamplesPerSec;
    finally
      FreeMem(pWaveFormat);
    end;

    // Structure information
    beConfig.format.lhv1.dwStructVersion := 1;
    beConfig.format.lhv1.dwStructSize := SizeOf(beConfig);
    // Basic encoder setting
    beConfig.format.lhv1.dwSampleRate := InputSampleRate;
    beConfig.format.lhv1.dwReSampleRate := InputSampleRate;
    beConfig.format.lhv1.nMode := BE_MP3_MODE_STEREO;
    beConfig.format.lhv1.dwBitrate := BitRate;
    beConfig.format.lhv1.dwMaxBitrate := BitRate;
    beConfig.format.lhv1.nQuality := 4;
    beConfig.format.lhv1.dwMpegVersion := 1;
    // MPEG1
    beConfig.format.lhv1.dwPsyModel := 0;
    beConfig.format.lhv1.dwEmphasis := 0;
    // Bit Stream Settings
    beConfig.format.lhv1.bPrivate := False;
    beConfig.format.lhv1.bCRC := True;
    beConfig.format.lhv1.bCopyright := True;
    beConfig.format.lhv1.bOriginal := True;
    // VBR Stuff
    // Have it write a VBRHeader, as recommended by Lame, even though it's CBR
    beConfig.format.lhv1.bWriteVBRHeader := True;
    beConfig.format.lhv1.bEnableVBR := False;
    beConfig.format.lhv1.nVBRQuality := 0;

    error := beInitStream(beConfig, dwSamples, dwSamplesMP3, hbeStream);
    if error = BE_ERR_SUCCESSFUL then
    begin
      pBuffer := AllocMem(dwSamples * 2);
      pMP3Buffer := AllocMem(dwSamplesMP3);
      try
        // Position the source file stream at the beginning of the PCM-data:
        done := DataOffset;
        fs.Seek(DataOffset, soFromBeginning);
        While (done < TotalSize) do
        begin
          if (done + dwSamples * 2 < TotalSize) then
            ToRead := dwSamples * 2
          else
          begin
            ToRead := TotalSize - done;
            FillChar(pBuffer^, dwSamples * 2, 0);
          end;

          fs.Read(pBuffer^, ToRead);

          error := beEncodeChunk(hbeStream, ToRead div 2, pBuffer^,
            pMP3Buffer^, ToWrite);

          if error <> BE_ERR_SUCCESSFUL then
          begin
            beCloseStream(hbeStream);
            raise Exception.Create('Encoding Error');
          end;

          ft.Write(pMP3Buffer^, ToWrite);

          done := done + ToRead;

        end;

        error := beDeinitStream(hbeStream, pMP3Buffer^, dwWrite);

        if error <> BE_ERR_SUCCESSFUL then
        begin
          beCloseStream(hbeStream);
          raise Exception.Create('Close Error');
        end;

        if dwWrite <> 0 then
        begin
          ft.Write(pMP3Buffer^, dwWrite);
        end;

        error := beCloseStream(hbeStream);
        if error <> BE_ERR_SUCCESSFUL then
        begin
          raise Exception.Create('Close Error');
        end;
      finally
        FreeMem(pBuffer);
        FreeMem(pMP3Buffer);
      end;
    end
    else
    begin
      Raise Exception.Create('InitStream failure');
    end;
  finally
    fs.free;
    ft.free;
  end;
  beWriteVBRHeader(pAnsiChar(AnsiString(MP3File)));
end;

end.

1 hour ago, Remy Lebeau said:

I generally prefer to use a local accessor class instead:

What's the advantage? When do you use a class helper and when do you use a local accessor class, to me they both seem to serve the same purpose.

I might have introduced a bug in GR32_Resamplers, as it is, the left bound of the source rectangle is ignored. The fix is simple:

Line 1778 needs to be

SourceColor := @Src.Bits[ClusterY[0].Pos * Src.Width+SrcRect.Left];  //+SrcRect.Left was missing!

and line 1806:

        SourceColor := @Src.Bits[ClusterY[Y].Pos * Src.Width+SrcRect.Left];//+SrcRect.Left was missing!

Hope, you read this, Anders. If I don't hear from you, I'll create an issue on GitHub.

Edit: I definitely intoduced it by changing the order of the loops, I checked against an old version. Instead of

+SrcRect.Left

one should probably use

+MapXLoPos

Renate

55 minutes ago, Anders Melander said:

Please verify that the comments I've added in the source are correct

Correct and very clear.

I like the introduction of the MappingTablePrecicion.. constants.

5 hours ago, Anders Melander said:

The [10:22] must mean that you have multiplied two [21:11] values at some point but I can't really spot where that happens.

One weight in x-direction times another one in y-direction. Thanks for the explanation, now I understand the notation.

5 hours ago, Anders Melander said:

I don't understand what this refers to

That my posted "correction" can be safely ignored :).

5 hours ago, Anders Melander said:

Ah, now I get it. It was your comments that confused me. For example:

Sometimes I'm making it too complicated, sorry.

2 hours ago, Anders Melander said:

You say that you're "computing the integral for the convolution with the filter using the midpoint-rule" so I would have expected to see the averaging of two filter values in order to find the midpoint but I can't really match that with the above. Can you explain what's going on, please?

No, that would be the trapezoidal rule, and that is just as bad as using the antiderivatives. 

Midpoint rule:

integral from x1 to x2 f(x) dx  is appoximately f(0.5*(x1+x2))*(x2-x1).

The multiplications by oldscale transform this from the scale of the source (pixelwidth 1) to the scale of the destination ("pixelwidth" NewWidth/OldWidth).

If you want to know why using the integral is a good way of thinking about the algorithm, there's a little article in the doc folder. I couldn't explain it any better here.

2 hours ago, Anders Melander said:

Also, am I correct in assuming that you're doing calculation in [21:11] fixed precision and storing the weights in [10:22] instead of the old [24:8] and [16:16]?

I'm not sure what you're asking, could you do some explaining back? For the pre-mult I'm using precision $100, for the others $800. Is that what you are asking?

BTW, the check x2>x1 isn't necessary, Filter(x3) would be zero if not true.

14 hours ago, Anders Melander said:

One thing that almost gave me brain cancer was the abysmal ASM generated by this code (not your fault):

I was hoping for you to untwiddle this 🙂

Meanwhile I found the reason for the box-kernel not being up to par, it's here:

function TBoxKernel.GetWidth: TFloat;
begin
  Result := 1; //must be 0.5!
end;

I also spotted a mistake in my code. It could be that the interval [x0-0.5,x0+0.5] is completely outside of the support of the filter. In this case a false non-zero weight would be generated. So a check of x2>x1 needs to be added:

      ...
      for J := Left to Right do
      begin
        x0 := J - Center; // previous weight: Filter(x0*Oldscale)*Oldscale
        x1 := max(x0 - 0.5, -FilterWidth);
        x2 := min(x0 + 0.5, FilterWidth);
        // intersect symmetric interval of length 1 about x0 with support of scaled filter
        if (x2 > x1) then
        begin
          x3 := 0.5 * (x2 + x1); // new center
          Weight := Round(Prec * Filter(x3 * OldScale) * OldScale * (x2 - x1));
          // intersection with support entered into the weight
          if Weight <> 0 then
          begin
            Inc(Count, Weight);
            K := Length(Result[I]);
            SetLength(Result[I], K + 1);
            Result[I][K].Pos := Constrain(J, SrcLo, SrcHi - 1);
            Result[I][K].Weight := Weight;
          end;
        end;
      end;

Also, at the analogous place for the case scale>1. The code for the 2 cases could be unified, but it's better to understand as it is.