Leaderboard
Popular Content
Showing content with the highest reputation on 05/20/22 in all areas
-
Rounded polygon
vfbb replied to A.M. Hoornweg's topic in Algorithms, Data Structures and Class Design
Here's an example: uses Skia; function MakeCubicSplineInterpolation(const APoints: TArray<TPointF>): ISkPath; var LPathBuilder: ISkPathBuilder; LSegments: Integer; I: Integer; mx: Single; my: Single; LScratches: array of record a, b, c, r, p: TPointF; end; begin LPathBuilder := TSkPathBuilder.Create; if Length(APoints) < 2 then Exit(LPathBuilder.Detach); if Length(APoints) = 2 then begin LPathBuilder.MoveTo(APoints[0]); LPathBuilder.LineTo(APoints[1]); Exit(LPathBuilder.Detach); end; LSegments := Length(APoints) - 1; SetLength(LScratches, LSegments); LScratches[0].a := PointF(0, 0); LScratches[0].b := PointF(2, 2); LScratches[0].c := PointF(1, 1); LScratches[0].r := PointF(APoints[0].X + 2 * APoints[1].X, APoints[0].Y + 2 * APoints[1].Y); for I := 1 to LSegments - 2 do begin LScratches[I].a := PointF(1, 1); LScratches[I].b := PointF(4, 4); LScratches[I].c := PointF(1, 1); LScratches[I].r := PointF(4 * APoints[i].X + 2 * APoints[I + 1].X, 4 * APoints[I].Y + 2 * APoints[I + 1].Y); end; LScratches[LSegments - 1].a := PointF(2, 2); LScratches[LSegments - 1].b := PointF(7, 7); LScratches[LSegments - 1].c := PointF(0, 0); LScratches[LSegments - 1].r := PointF(8 * APoints[LSegments - 1].X + APoints[LSegments].X, 8 * APoints[LSegments - 1].Y + APoints[LSegments].Y); for I := 1 to LSegments - 1 do begin mx := LScratches[I].a.X / LScratches[I - 1].b.X; my := LScratches[I].a.Y / LScratches[I - 1].b.Y; LScratches[I].b := LScratches[I].b - PointF(mx * LScratches[I - 1].c.X, my * LScratches[I - 1].c.Y); LScratches[I].r := LScratches[I].r - PointF(mx * LScratches[I - 1].r.X, my * LScratches[I - 1].r.Y); end; LScratches[LSegments - 1].p := PointF(LScratches[LSegments - 1].r.X / LScratches[LSegments - 1].b.X, LScratches[LSegments - 1].r.Y / LScratches[LSegments - 1].b.Y); for I := Length(APoints) - 3 downto 0 do begin LScratches[I].p := PointF((LScratches[I].r.X - LScratches[I].c.X * LScratches[I + 1].p.X) / LScratches[I].b.X, (LScratches[I].r.Y - LScratches[I].c.Y * LScratches[I + 1].p.Y) / LScratches[I].b.Y); end; LPathBuilder.MoveTo(APoints[0]); for I := 0 to LSegments - 2 do begin LPathBuilder.CubicTo(LScratches[I].p, PointF(2 * APoints[I + 1].X - LScratches[I + 1].p.X, 2 * APoints[I + 1].Y - LScratches[I + 1].p.Y), APoints[I + 1]); end; LPathBuilder.CubicTo(LScratches[LSegments - 1].p, PointF(0.5 * (APoints[LSegments].X + LScratches[LSegments - 1].p.X), 0.5 * (APoints[LSegments].Y + LScratches[LSegments - 1].p.Y)), APoints[LSegments]); Result := LPathBuilder.Detach; end; procedure TForm1.SkPaintBox1Draw(ASender: TObject; const ACanvas: ISkCanvas; const ADest: TRectF; const AOpacity: Single); var LPaint: ISkPaint; LMyPoints: TArray<TPointF>; begin LMyPoints := [PointF(62, 511), PointF(162, 605), PointF(262, 610), PointF(362, 402), PointF(462, 959), PointF(562, 58), PointF(662, 272), PointF(762, 99), PointF(862, 759), PointF(962, 945)]; LPaint := TSkPaint.Create(TSkPaintStyle.Stroke); LPaint.Color := TAlphaColors.Red; LPaint.AntiAlias := True; LPaint.StrokeWidth := 3; LPaint.StrokeCap := TSkStrokeCap.Round; ACanvas.DrawPath(MakeCubicSplineInterpolation(LMyPoints), LPaint); LPaint.StrokeWidth := 10; LPaint.Color := TAlphaColors.Black; ACanvas.DrawPoints(TSkDrawPointsMode.Points, LMyPoints, LPaint); end; Result: Note: You don't need to use Skia, it was just a facilitator for the example. -
The main reason it hasn't been merged yet is because I just haven't had any time to review it - I don't question that it "works" in general (I've seen enough people say it does), but I still need to see how consistent it fits with the rest of the library, if all of the necessary package/IDE support is in place, how it handles the multiple platforms Indy runs on, etc. The occasional issues being reported in the PR with regards to compiler/runtime errors, etc. As well as this is kind of a big feature to maybe warrant pushing Indy into a new versioning scheme that is long overdue. So, a lot of behind-the-scenes stuff that has made me hesitant to just merge it blindly.
-
I don't remember that. I probably was busy at the time and then forgot about it. Did you file (a) bug report(s)?
-
Can you please elaborate on that?
-
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.
-
This Delphi 11.1 version is indeed a very good version. But I am still starting it in 'High DPI unaware' mode. There are for me still too many issues with High DPI. Else....I like it a lot!!!
-
Delphi 11.1 - a month later
Darian Miller replied to Mike Torrettinni's topic in Delphi IDE and APIs
I agree with most of your observations and 11.1 is a lot better in may ways - but for me, ctrl-click is failing most of the time and some of the automatic code completion gets in the way more. I've increased the delay and rely on it less. It seems almost what 10.4 should have been. -
Delphi 11.1 - a month later
Martin Sedgewick replied to Mike Torrettinni's topic in Delphi IDE and APIs
Agreed that they have done a good job. The cumulative effect of the last few releases being more focused on bug fixes, IDE improvements is now paying off. F2084 Internal Error - I forgot about that one as I have not seen that in a while now! Thankfully 🙂 I also like the more regular patching, and hope they continue to drop bundles of fixes more often. Keeps people happy when they see progress on the things that are blocking them. Would be great to see a roadmap too. No idea what is happening next! -
Manually 🙂
- 10 replies
-
The IF is certainly a yes, but I couldn't tell you the WHEN for sure. But you can try out the pending code for yourself at https://github.com/IndySockets/Indy/pull/299 and see if it works for you.
-
I totally agree. And I have been meaning to reach out to the community for a long time looking for volunteers to join the dev team on a more regular basis, I just haven't gotten around to it. Well, it is still being actively maintained, as in it receives updates for fixes, and adding minor features that are easy to add to the existing code. But major updates have been delayed for a long time. Namely, releasing Indy 11 (maintenance release to drop pre-Unicode compilers, restructure the runtime packages, etc) and starting on Indy 12 (major new features, logic rewrites, etc) has been on the back-burner for many years now. Actually, Indy 11 is almost ready, but without an IDE I haven't been able to test the new structure and finalize it.