Jump to content

Leaderboard


Popular Content

Showing content with the highest reputation on 04/12/22 in all areas

  1. shineworld

    Transferring TBitmap to Python and back

    To fastly send an image in NumPy array to a delphivcl.Image component, without use Pillow and DIB way, you can create a new python extension module with Delphi where you wrap a update_image_from_bytes(image: Image(), data: bytes, width: int, height: int, channels: int) -> bool { generic functions wrappers } function CncVisionUpdateImageFromBytesArray_Wrapper(pself, args: PPyObject): PPyObject; cdecl; var Image: TImage; Width: Integer; Height: Integer; Channels: Integer; Bytes: TByteArray; BytesPyObj: PPyObject; ImagePyObj: PPyObject; function PyBytesAsBytes(Obj: PPyObject): TByteArray; var Size: NativeInt; Buffer: PAnsiChar; begin Result := nil; with GetPythonEngine do begin if not PyBytes_Check(Obj) then Exit; PyBytes_AsStringAndSize(Obj, Buffer, Size); if Size = 0 then Exit; SetLength(Result, Size); CopyMemory(Result, Buffer, Size); end; end; begin with GetPythonEngine do begin try if PyArg_ParseTuple(args, 'OOiii:update_image_from_bytes', @ImagePyObj, @BytesPyObj, @Width, @Height, @Channels) <> 0 then begin if ImagePyObj.ob_type.tp_name <> 'Image' then AbortFast; Image := TPyDelphiImage(TPyObject(PAnsiChar(ImagePyObj) + SizeOf(PyObject))).DelphiObject; if Image = nil then AbortFast; if BytesPyObj.ob_type.tp_name <> 'bytes' then AbortFast; Bytes := PyBytesAsBytes(BytesPyObj); if Bytes = nil then AbortFast; if Length(Bytes) <> (Width * Height * Channels) then AbortFast; if not CncVisionUpdateImageFromBytesArray(Image, Bytes, Width, Height, Channels) then AbortFast; Result := ReturnTrue; end else Result := ReturnFalse; except Result := ReturnFalse; end; end; end; ... . ... procedure TPyExtensionManager.WrapperInitializationEvent(Sender: TObject); begin FWrapper.RegisterFunction ( PAnsiChar('update_image_from_bytes'), CncVisionUpdateImageFromBytesArray_Wrapper, PAnsiChar('update delphivcl Image object from bytes array with width, height & channels') ); end; Then the pascal byte array to Image is: function CncVisionUpdateImageFromBytesArray(Image: TImage; Bytes: osCncVisionTypes.TByteArray; Width, Height, Channels: Integer): Boolean; type TRGBBitmapInfoHeader = record Header: TBitmapInfoHeader; ColorTable: array[0..255] of TRGBQuad; end; PBitmapInfoHeader = ^TBitmapInfoHeader; var I: Integer; Bitmap: TBitmap; IsGray: Boolean; Buffer: TRGBBitmapInfoHeader; BmpInfoHeader: PBitmapInfoHeader; var BmpInfoBuffer: TBitmapInfo absolute Buffer; begin try if Length(Bytes) = 0 then Exit(False); if Length(Bytes) <> (Width * Height * Channels) then Exit(False); if not Channels in [1, 3] then Exit(False); if Image.Picture.Bitmap = nil then Image.Picture.Bitmap := TBitmap.Create; Bitmap := Image.Picture.Bitmap; Bitmap.Width := Width; Bitmap.Height := Height; BmpInfoHeader := PBitmapInfoHeader(@Buffer); BmpInfoHeader^.biSize := SizeOf(TBitmapInfoHeader); BmpInfoHeader^.biWidth := Width; BmpInfoHeader^.biHeight := -Height; BmpInfoHeader^.biPlanes := 1; BmpInfoHeader^.biBitCount := 8 * Channels; BmpInfoHeader^.biCompression := BI_RGB; BmpInfoHeader^.biSizeImage := 0; BmpInfoHeader^.biXPelsPerMeter := 0; BmpInfoHeader^.biYPelsPerMeter := 0; BmpInfoHeader^.biClrUsed := 0; BmpInfoHeader^.biClrImportant := 0; // if Bytes array is for monochrome image (channels = 1) normalizes bitmap color table // https://docs.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-bitmapinfoheader // // The BITMAPINFOHEADER structure may be followed by an array of palette entries or color masks. // The rules depend on the value of biCompression. // // - If biCompression equals BI_RGB and the bitmap uses 8 bpp or less, the bitmap has a color table immediately // following the BITMAPINFOHEADER structure. The color table consists of an array of RGBQUAD values. The size // of the array is given by the biClrUsed member. If biClrUsed is zero, the array contains the maximum number // of colors for the given bitdepth; that is, 2^biBitCount colors. if Channels = 1 then begin for I := 0 to 255 do begin Buffer.ColorTable[I].rgbBlue := I; Buffer.ColorTable[I].rgbGreen := I; Buffer.ColorTable[I].rgbRed := I; end; end; LockWindowUpdate(Bitmap.Canvas.Handle); try Result := SetDIBitsToDevice ( Bitmap.Canvas.Handle, // handle to device context 0, // x-coordinate of upper-left corner of 0, // y-coordinate of upper-left corner of Width, // source rectangle width Height, // source rectangle height 0, // x-coordinate of Lower-left corner of 0, // y-coordinate of Lower-left corner of 0, // first scan line in array Height, // number of scan lines Bytes, // address of array with DIB bits BmpInfoBuffer, // address of structure with bitmap info DIB_RGB_COLORS // RGB or palette indexes ) > 0; finally LockWindowUpdate(0) end; except Result := False; end; end; CncVisionUpdateImageFromBytesArray permits RGB or Monochrome Bytes array. In python the code to update image is simple: import cnc_vision_ext as ext # this is only my delphi extension module for python where extra features for delphivcl are placed # for monochrome frames to CameraImage (delphivcl.Image object) frame = get_frame_image_from_somewhere() frame = cv2.cvtColor(frame, cv2.COLOR_BGR2GRAY) ext.update_image_from_bytes( self.CameraImage, frame_inp.tobytes(), frame_inp.shape[1], frame_inp.shape[0], 3 if len(frame_inp.shape) == 3 else 1) self.CameraImage.Invalidate() # for color frames to CameraImage (delphivcl.Image object) frame = get_frame_image_from_somewhere() ext.update_image_from_bytes( self.CameraImage, frame_inp.tobytes(), frame_inp.shape[1], frame_inp.shape[0], 3 if len(frame_inp.shape) == 3 else 1) self.CameraImage.Invalidate()
  2. Bertie Buitendag

    Error - [PAClient Error] Error: E7176

    I got the error resolved by changing my SDK Java properties to the installed Java version.
  3. Remy Lebeau

    Delete unicode non-breaking space

    That is because the original data is encoded in UTF-8, but once it is loaded into your string, it is no longer encoded in UTF-8, it is encoded in UTF-16 instead. $C2 $A0 are the UTF-8 bytes for the non-breaking character, whereas $00A0 (decimal 160) is the UTF-16 value of that same character.
  4. (This is a re-start of another thread) I have published Delphi sorting routines that ought to be similar in speed to TIMsort, for arrays of simple types, strings and objects. The focus has been on large (10M+) real-world situations, where there is already some order in the data. The documentation explains how to use in case you do not want generics. The software is free: https://sourceforge.net/projects/fast-stable-sorting-in-delphi/ It includes a test suite. Stable sorting of objects with QuickSort is possible by adding to the object a tag that can serve as stability key. In that way I compare sorting speeds of my procedures with Tarray.sort<Tobject>. For (semi-)random data the difference is 5-10 times. When there is already order in the data, the improvement may go up to a factor of 20. I chose some optimization parameters on the basis of the test arrays that I generated. It would be nice to know if attractive results are obtained when applied to real-world data.
×