Jump to content

shineworld

Members
 View Profile  See their activity

  • Content Count

    343

  • Joined

  • Last visited

  • Days Won

    4

Posts posted by shineworld

  1. Posted · Edited by shineworld

    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()

     

    • Thanks 1

  2. Posted

    Seems this works but is hard to say OK, at moment, for me:

      

    {
        A                    B                                                      C
        +-------------------++------------------------------------------------------+
        | PyObject header   ||             TPyObject class                          |
        +----------+--------++-----------------+------------+----------+------------+
        |ob_refcnt |ob_type ||hidden Class Ptr |PythonType  |IsSubType |PythonAlloc |
        |integer   |pointer ||pointer          |TPythonType |Boolean   |Boolean     |
        |4 bytes   |4 bytes ||4 bytes          |4 bytes     |1 byte    |1 byte      |
        +----------+--------++-----------------+------------+----------+------------+

        ^                    ^
        |                    |
        ptr returned         ptr returned by Adjust
        by GetSelf

        - a Python object must start at A.
        - a Delphi class class must start at B
        - TPyObject.InstanceSize will return C-B
        - Sizeof(TPyObject) will return C-B
        - The total memory allocated for a TPyObject instance will be C-A,
          even if its InstanceSize is C-B.
        - When turning a Python object pointer into a Delphi instance pointer, PythonToDelphi
          will offset the pointer from A to B.
        - When turning a Delphi instance into a Python object pointer, GetSelf will offset
          Self from B to A.
        - Properties ob_refcnt and ob_type will call GetSelf to access their data.
}
function CncVisionUpdateImageFromBytesArray_Wrapper(pself, args: PPyObject): PPyObject; cdecl;
var
  Image: TImage;
  Width: Integer;
  Height: Integer;
  Channels: Integer;
  Bytes: TByteArray;
  ImagePyObj: PPyObject;
begin
  with GetPythonEngine do
  begin
    if PyArg_ParseTuple(args, 'Oiii:update_image_from_bytes', @ImagePyObj, @Width, @Height, @Channels) <> 0 then
    begin
      Image := TPyDelphiImage(TPyObject(PAnsiChar(ImagePyObj)+Sizeof(PyObject))).DelphiObject;
      Result := PyUnicodeFromString
      (
        Format('%s %d %d %d', [Image.Name, Width, Height, Channels])
      );
    end
    else
      Result := nil;
  end;
end;

     

  3. Posted

    Hi all,
     

    I'm using DelphiVCL + PyScripter to develop a Python windows application.I've created and "pyd" extension module in which perform some critical time operations or add support functions missing in DelphiVCL.

    - In python script I create an Image
    - now I would like to send a bytes array to cnc_vision_ext module (made with Delphi): 

    import delphivcl
import cnc_vision_ext as ext

....
my_Image = delphivcl.Image(Form1)
ext.update_image_from_bytes(my_image, 1024, 768, 3)

    Now in the wrapper CncVisionUpdateImageFromBytesArray_Wrapper I need to extract the TImage instance contained in PPyObject of args.
    I was not able to find the right way....

      

    { generic functions wrappers }

function CncVisionUpdateImageFromBytesArray_Wrapper(pself, args: PPyObject): PPyObject; cdecl;
var
  Image: TImage;
  Width: Integer;
  Height: Integer;
  Channels: Integer;
  Bytes: TByteArray;
  ImagePyObj: PPyObject;
begin
  with GetPythonEngine do
  begin
    if PyArg_ParseTuple(args, 'Oiii:update_image_from_bytes', @ImagePyObj, @Width, @Height, @Channels) <> 0 then
    begin
      // ??? HOW TO GET BACK wrapped TImage from Image() object created with my_image = delphivcl.Image(owner) ???
      Image := TImage((PythonToDelphi(ImagePyObj) as TPyDelphiObject).DelphiObject);
      Result := PyUnicodeFromString
      (
        Format('%s %d %d %d', [Image.Name, Width, Height, Channels])
      );
    end
    else
      Result := nil;
  end;
end;
{ TPyExtensionManager }

procedure TPyExtensionManager.WrapperInitializationEvent(Sender: TObject);
begin
  FWrapper.RegisterDelphiWrapper(TPyCncVisionVideoCapturePxc_Wrapper);
  FWrapper.RegisterFunction
  (
    PAnsiChar('update_image_from_bytes'),
    CncVisionUpdateImageFromBytesArray_Wrapper,
    PAnsiChar('update delphivcl Image object from bytes array with width, height & channels')
  );
  FWrapper.RegisterFunction
  (
    PAnsiChar('get_usb_camera_device_list'),
    CncVisionGetUSBCameraDeviceList_Wrapper,
    PAnsiChar('get list of available usb camera devices')
  );
end;


    Thanks in advance for the suggestions....
    Best Regards
    Silverio

  4. Posted

    TVideoCapture is managed as a record, not a class, with class members so do not requires a TVideoCapture.Create

    It is defined in videoio.inc.

     

    Never tried if this structure permits more than one instance.

    I've checked the demos and copied/pasted the minimal code to try it.

    My actual implementation is yet on Python + delphivcl + opencv.
    It's a very big project and I'm yet in the writting phase.

    When finished I will try to recreate my vision python framework directly in Delphi code + DelphiPythonVCL.

     

  5. Posted · Edited by shineworld

    In the dropbox link, I can't attach files bigger than 4.8Mb here,

    you can find a very simple Delphi Sydney 10.4.1 project where

    the OpenCV get frames from a USB camera (VideoCapture device 0)

    and with the trackbar, you can apply Canny filter thresholds 1 & 2.


    The required DLLs are in Win64\Debug & Release folders BUT

    can also be placed one time for always in Windows OS folders.
     

    Just my first test with Delphi-OpenCV.

    ONLY 64 bit applications are supported by Delphi-OpenCV class.

     

    https://www.dropbox.com/s/iqzlnfwttj20pnr/cnc_vision_2.7z?dl=0

    PS: I don't know if there are other MS dependencies because I've Microsoft Visual Studio installed
    and some DLL could be already available for MSVC packages.

    During run-in IDE these are modules loaded: 

    Module Load: cnc_vision_2. No Debug Info. Base Address: $0000000000400000. Process cnc_vision_2.exe (14340)
Module Load: ntdll.dll. No Debug Info. Base Address: $00007FFD371B0000. Process cnc_vision_2.exe (14340)
Module Load: KERNEL32.dll. No Debug Info. Base Address: $00007FFD36870000. Process cnc_vision_2.exe (14340)
Module Load: KERNELBASE.dll. No Debug Info. Base Address: $00007FFD34BA0000. Process cnc_vision_2.exe (14340)
Module Load: WINSPOOL.DRV. No Debug Info. Base Address: $00007FFD2AF90000. Process cnc_vision_2.exe (14340)
Module Load: SHELL32.dll. No Debug Info. Base Address: $00007FFD36930000. Process cnc_vision_2.exe (14340)
Module Load: WINMM.dll. No Debug Info. Base Address: $00007FFD2B2A0000. Process cnc_vision_2.exe (14340)
Module Load: msvcp_win.dll. No Debug Info. Base Address: $00007FFD34FC0000. Process cnc_vision_2.exe (14340)
Module Load: COMCTL32.dll. No Debug Info. Base Address: $00007FFD26F50000. Process cnc_vision_2.exe (14340)
Module Load: msvcrt.dll. No Debug Info. Base Address: $00007FFD35B40000. Process cnc_vision_2.exe (14340)
Module Load: ucrtbase.dll. No Debug Info. Base Address: $00007FFD348D0000. Process cnc_vision_2.exe (14340)
Module Load: msvcrt.dll. No Debug Info. Base Address: $0000000000D50000. Process cnc_vision_2.exe (14340)
Module Unload: msvcrt.dll. Process cnc_vision_2.exe (14340)
Module Load: msvcrt.dll. No Debug Info. Base Address: $0000000000DF0000. Process cnc_vision_2.exe (14340)
Module Unload: msvcrt.dll. Process cnc_vision_2.exe (14340)
Module Load: USER32.dll. No Debug Info. Base Address: $00007FFD35BE0000. Process cnc_vision_2.exe (14340)
Module Load: GDI32.dll. No Debug Info. Base Address: $00007FFD370E0000. Process cnc_vision_2.exe (14340)
Module Load: win32u.dll. No Debug Info. Base Address: $00007FFD34F20000. Process cnc_vision_2.exe (14340)
Module Load: win32u.dll. No Debug Info. Base Address: $00000000001A0000. Process cnc_vision_2.exe (14340)
Module Unload: win32u.dll. Process cnc_vision_2.exe (14340)
Module Load: OLEAUT32.dll. No Debug Info. Base Address: $00007FFD35390000. Process cnc_vision_2.exe (14340)
Module Load: gdi32full.dll. No Debug Info. Base Address: $00007FFD34A00000. Process cnc_vision_2.exe (14340)
Module Load: VERSION.dll. No Debug Info. Base Address: $00007FFD2DB50000. Process cnc_vision_2.exe (14340)
Module Load: combase.dll. No Debug Info. Base Address: $00007FFD36460000. Process cnc_vision_2.exe (14340)
Module Load: RPCRT4.dll. No Debug Info. Base Address: $00007FFD35540000. Process cnc_vision_2.exe (14340)
Module Load: ADVAPI32.dll. No Debug Info. Base Address: $00007FFD36140000. Process cnc_vision_2.exe (14340)
Module Load: SECHOST.dll. No Debug Info. Base Address: $00007FFD36290000. Process cnc_vision_2.exe (14340)
Module Load: ole32.dll. No Debug Info. Base Address: $00007FFD36330000. Process cnc_vision_2.exe (14340)
Module Load: NETAPI32.dll. No Debug Info. Base Address: $00007FFD21B00000. Process cnc_vision_2.exe (14340)
Module Load: netutils.dll. No Debug Info. Base Address: $00007FFD33E40000. Process cnc_vision_2.exe (14340)
Module Load: IMM32.dll. No Debug Info. Base Address: $00007FFD356A0000. Process cnc_vision_2.exe (14340)
Module Load: MSCTF.dll. No Debug Info. Base Address: $00007FFD35210000. Process cnc_vision_2.exe (14340)
Module Load: UxTheme.dll. No Debug Info. Base Address: $00007FFD32280000. Process cnc_vision_2.exe (14340)
Module Load: AppCore.dll. No Debug Info. Base Address: $00007FFD32800000. Process cnc_vision_2.exe (14340)
Module Load: bcryptPrimitives.dll. No Debug Info. Base Address: $00007FFD34B10000. Process cnc_vision_2.exe (14340)
Module Load: WTSAPI32.dll. No Debug Info. Base Address: $00007FFD2F7C0000. Process cnc_vision_2.exe (14340)
Module Load: WINSTA.dll. No Debug Info. Base Address: $00007FFD33640000. Process cnc_vision_2.exe (14340)
Module Load: opencv_world455.dll. No Debug Info. Base Address: $00007FFCE7660000. Process cnc_vision_2.exe (14340)
Module Load: WS2_32.dll. No Debug Info. Base Address: $00007FFD35D80000. Process cnc_vision_2.exe (14340)
Module Load: COMDLG32.dll. No Debug Info. Base Address: $00007FFD35460000. Process cnc_vision_2.exe (14340)
Module Load: SHCORE.dll. No Debug Info. Base Address: $00007FFD367C0000. Process cnc_vision_2.exe (14340)
Module Load: SHLWAPI.dll. No Debug Info. Base Address: $00007FFD35330000. Process cnc_vision_2.exe (14340)
Module Load: VCRUNTIME140.dll. No Debug Info. Base Address: $00007FFD21D40000. Process cnc_vision_2.exe (14340)
Module Load: CONCRT140.dll. No Debug Info. Base Address: $00007FFD231C0000. Process cnc_vision_2.exe (14340)
Module Load: MSVCP140.dll. No Debug Info. Base Address: $00007FFD14770000. Process cnc_vision_2.exe (14340)
Module Load: VCRUNTIME140_1.dll. No Debug Info. Base Address: $0000000000830000. Process cnc_vision_2.exe (14340)
Module Unload: VCRUNTIME140_1.dll. Process cnc_vision_2.exe (14340)
Module Load: VCRUNTIME140_1.dll. No Debug Info. Base Address: $00007FFD2F5D0000. Process cnc_vision_2.exe (14340)
Module Load: opencv_videoio_msmf455_64.dll. No Debug Info. Base Address: $00007FFD22EB0000. Process cnc_vision_2.exe (14340)
Module Load: MF.dll. No Debug Info. Base Address: $00007FFD20830000. Process cnc_vision_2.exe (14340)
Module Load: MFReadWrite.dll. No Debug Info. Base Address: $00007FFD1F890000. Process cnc_vision_2.exe (14340)
Module Load: dxgi.dll. No Debug Info. Base Address: $00007FFD33210000. Process cnc_vision_2.exe (14340)
Module Load: MFPlat.DLL. No Debug Info. Base Address: $00007FFD060C0000. Process cnc_vision_2.exe (14340)
Module Load: CFGMGR32.dll. No Debug Info. Base Address: $00007FFD351C0000. Process cnc_vision_2.exe (14340)
Module Load: d3d11.dll. No Debug Info. Base Address: $00007FFD300B0000. Process cnc_vision_2.exe (14340)
Module Load: MFCORE.dll. No Debug Info. Base Address: $00007FFCE71D0000. Process cnc_vision_2.exe (14340)
Module Load: CRYPT32.dll. No Debug Info. Base Address: $00007FFD35060000. Process cnc_vision_2.exe (14340)
Module Load: bcrypt.dll. No Debug Info. Base Address: $00007FFD349D0000. Process cnc_vision_2.exe (14340)
Module Load: POWRPROF.dll. No Debug Info. Base Address: $00007FFD33EA0000. Process cnc_vision_2.exe (14340)
Module Load: ksuser.dll. No Debug Info. Base Address: $00007FFD32120000. Process cnc_vision_2.exe (14340)
Module Load: CRYPTBASE.dll. No Debug Info. Base Address: $00007FFD342A0000. Process cnc_vision_2.exe (14340)
Module Load: RTWorkQ.DLL. No Debug Info. Base Address: $00007FFD1D060000. Process cnc_vision_2.exe (14340)
Module Load: UMPDC.dll. No Debug Info. Base Address: $00007FFD33D10000. Process cnc_vision_2.exe (14340)
Module Load: CLBCatQ.DLL. No Debug Info. Base Address: $00007FFD36010000. Process cnc_vision_2.exe (14340)
Module Load: DEVENUM.DLL. No Debug Info. Base Address: $00007FFD252A0000. Process cnc_vision_2.exe (14340)
Module Load: SETUPAPI.dll. No Debug Info. Base Address: $00007FFD356D0000. Process cnc_vision_2.exe (14340)
Module Load: NTMARTA.dll. No Debug Info. Base Address: $00007FFD335A0000. Process cnc_vision_2.exe (14340)
Module Load: DEVOBJ.dll. No Debug Info. Base Address: $00007FFD34670000. Process cnc_vision_2.exe (14340)
Module Load: WINTRUST.dll. No Debug Info. Base Address: $00007FFD34F50000. Process cnc_vision_2.exe (14340)
Module Load: MSASN1.dll. No Debug Info. Base Address: $00007FFD344B0000. Process cnc_vision_2.exe (14340)
Module Load: msdmo.dll. No Debug Info. Base Address: $00007FFD2C5B0000. Process cnc_vision_2.exe (14340)
Module Load: QCap.dll. No Debug Info. Base Address: $00007FFD16770000. Process cnc_vision_2.exe (14340)
Module Load: QUARTZ.dll. No Debug Info. Base Address: $00007FFD145A0000. Process cnc_vision_2.exe (14340)
Module Load: Windows.Storage.dll. No Debug Info. Base Address: $00007FFD32A00000. Process cnc_vision_2.exe (14340)
Module Load: Wldp.dll. No Debug Info. Base Address: $00007FFD34330000. Process cnc_vision_2.exe (14340)
Module Load: Source.dll. No Debug Info. Base Address: $00007FFD166B0000. Process cnc_vision_2.exe (14340)
Module Load: ATL.DLL. No Debug Info. Base Address: $00007FFD24C60000. Process cnc_vision_2.exe (14340)
Module Load: MFSENSORGROUP.dll. No Debug Info. Base Address: $00007FFD15110000. Process cnc_vision_2.exe (14340)
Module Load: ksproxy.ax. No Debug Info. Base Address: $00007FFD14550000. Process cnc_vision_2.exe (14340)
Module Load: d3d9.dll. No Debug Info. Base Address: $00007FFD2CF10000. Process cnc_vision_2.exe (14340)
Module Load: dwmapi.dll. No Debug Info. Base Address: $00007FFD32510000. Process cnc_vision_2.exe (14340)
Module Load: policymanager.dll. No Debug Info. Base Address: $00007FFD2F4A0000. Process cnc_vision_2.exe (14340)
Module Load: msvcp110_win.dll. No Debug Info. Base Address: $00007FFD33A30000. Process cnc_vision_2.exe (14340)
Module Load: vidcap.dll. No Debug Info. Base Address: $00007FFD24C50000. Process cnc_vision_2.exe (14340)
Module Load: kswdmcap.dll. No Debug Info. Base Address: $00007FFD23190000. Process cnc_vision_2.exe (14340)
Module Load: MFC42.dll. No Debug Info. Base Address: $00007FFCF43E0000. Process cnc_vision_2.exe (14340)
Module Load: QEdit.dll. No Debug Info. Base Address: $00007FFD144A0000. Process cnc_vision_2.exe (14340)
Module Load: gdiplus.dll. No Debug Info. Base Address: $00007FFD2B040000. Process cnc_vision_2.exe (14340)
Module Load: MSVFW32.dll. No Debug Info. Base Address: $00007FFD1F210000. Process cnc_vision_2.exe (14340)
Module Load: DDRAW.dll. No Debug Info. Base Address: $00007FFCFC5D0000. Process cnc_vision_2.exe (14340)
Module Load: DCIMAN32.dll. No Debug Info. Base Address: $00007FFD238F0000. Process cnc_vision_2.exe (14340)
Module Load: nvldumdx.dll. No Debug Info. Base Address: $00007FFD2ADB0000. Process cnc_vision_2.exe (14340)
Module Load: imagehlp.dll. No Debug Info. Base Address: $00007FFD35670000. Process cnc_vision_2.exe (14340)
Module Load: CRYPTSP.dll. No Debug Info. Base Address: $00007FFD34280000. Process cnc_vision_2.exe (14340)
Module Load: RSAENH.dll. No Debug Info. Base Address: $00007FFD339A0000. Process cnc_vision_2.exe (14340)
Module Load: NVD3DUMX.dll. No Debug Info. Base Address: $00007FFCC5A50000. Process cnc_vision_2.exe (14340)
Module Load: nvspcap64.dll. No Debug Info. Base Address: $00007FFD09D00000. Process cnc_vision_2.exe (14340)
Module Load: profapi.dll. No Debug Info. Base Address: $00007FFD34810000. Process cnc_vision_2.exe (14340)
Module Load: NvCameraWhitelisting64.dll. No Debug Info. Base Address: $00007FFD14410000. Process cnc_vision_2.exe (14340)
Module Unload: NvCameraWhitelisting64.dll. Process cnc_vision_2.exe (14340)
Module Load: dxcore.dll. No Debug Info. Base Address: $00007FFD2B680000. Process cnc_vision_2.exe (14340)
Module Unload: NVD3DUMX.dll. Process cnc_vision_2.exe (14340)
Module Unload: nvldumdx.dll. Process cnc_vision_2.exe (14340)
Module Load: nvldumdx.dll. No Debug Info. Base Address: $00007FFD2ADB0000. Process cnc_vision_2.exe (14340)
Module Load: NVD3DUMX.dll. No Debug Info. Base Address: $00007FFCC5A50000. Process cnc_vision_2.exe (14340)
Module Load: NvCameraWhitelisting64.dll. No Debug Info. Base Address: $00007FFD14410000. Process cnc_vision_2.exe (14340)
Module Unload: NvCameraWhitelisting64.dll. Process cnc_vision_2.exe (14340)
Module Unload: NVD3DUMX.dll. Process cnc_vision_2.exe (14340)
Module Unload: nvldumdx.dll. Process cnc_vision_2.exe (14340)
Module Load: nvldumdx.dll. No Debug Info. Base Address: $00007FFD2ADB0000. Process cnc_vision_2.exe (14340)
Module Load: NVD3DUMX.dll. No Debug Info. Base Address: $00007FFCC5A50000. Process cnc_vision_2.exe (14340)
Module Load: NvCameraWhitelisting64.dll. No Debug Info. Base Address: $00007FFD14410000. Process cnc_vision_2.exe (14340)
Module Unload: NvCameraWhitelisting64.dll. Process cnc_vision_2.exe (14340)
Module Unload: NVD3DUMX.dll. Process cnc_vision_2.exe (14340)
Module Unload: nvldumdx.dll. Process cnc_vision_2.exe (14340)
Module Load: WINMMBASE.dll. No Debug Info. Base Address: $00007FFD22CE0000. Process cnc_vision_2.exe (14340)
Module Load: MSYUV.dll. No Debug Info. Base Address: $00007FFD238E0000. Process cnc_vision_2.exe (14340)
Module Unload: MSYUV.dll. Process cnc_vision_2.exe (14340)
Module Load: TextInputFramework.dll. No Debug Info. Base Address: $00007FFD2B430000. Process cnc_vision_2.exe (14340)
Module Load: CoreUIComponents.dll. No Debug Info. Base Address: $00007FFD31640000. Process cnc_vision_2.exe (14340)
Module Load: CoreMessaging.dll. No Debug Info. Base Address: $00007FFD319A0000. Process cnc_vision_2.exe (14340)
Module Load: WinTypes.dll. No Debug Info. Base Address: $0000000007A20000. Process cnc_vision_2.exe (14340)
Module Load: WinTypes.dll. No Debug Info. Base Address: $0000000007B80000. Process cnc_vision_2.exe (14340)
Module Unload: WinTypes.dll. Process cnc_vision_2.exe (14340)
Module Unload: WinTypes.dll. Process cnc_vision_2.exe (14340)
Module Load: WinTypes.dll. No Debug Info. Base Address: $00007FFD30ED0000. Process cnc_vision_2.exe (14340)
Module Load: OLEACC.dll. No Debug Info. Base Address: $00007FFD2AF20000. Process cnc_vision_2.exe (14340)

     

  6. Posted

    IMO, you have two solutions:

    a) Use the new, but experimental, Delphi-OpenCV-Class (opencv 4.5.5) for Delphi 10.4 & 11.0 package:
    https://github.com/Laex/Delphi-OpenCV-Class

    Laex is doing a very very good job to import opencv 4.5.5 C++ based DLLs to Delphi.
    I don't know how much of opencv is already ported but I've cloned the project only yesterday and tried a basic Canny function:
    image.thumb.png.509bf80eb1ea69d75387a8e89e5b6c66.png
    Works very very fastly, with native Delphi (in the snapshot I've got frames from a USB camera and applied canny filter).
    During run-in IDE environment there are some delays (also in Release) because uses debug versions of DLLs,
    but when you close the IDE and start the program from Explorer BOOM is a rocket.
    I will move, only in the next future, my Python delphivcl application to be a native Delphi set of classes.
    This ONLY to fully integrate into Forms of native VCL program.

    b) To back processed image to Delphi just pass the opencv NumPy array content which can be o monodimensional array

    for gray images or a tridimensional array for images with RGB.
    Pass also Width and Height info.
    Then you have only to use a Bitmap, and related canvas HDC Handle with the same width and height and use

    DIB windows functions to recreate bitmap image from a byte array.

    This is an extract of yesterday's experiments for upon Image.
    TMat is the Laex generics implementation of OpenCV mat so array of bytes of image:

      

    function MatDraw(DC: HDC; Image: TMat; const Rect: TRect; const Stretch: Boolean = True): Boolean;
type
  pCOLORREF         = ^COLORREF;
  pBITMAPINFOHEADER = ^BITMAPINFOHEADER;
var
  // isrgb: Boolean;
  IsGray: Boolean;
  buf: array [1 .. SizeOf(BITMAPINFOHEADER) + SizeOf(RGBQUAD) * 256] of byte;
  dibhdr: pBITMAPINFOHEADER;
  _dibhdr: TBitmapInfo ABSOLUTE buf;
  _rgb: pCOLORREF;
  i: Integer;
  iResult: Integer;
begin
  if Image.empty then
    Exit(False);

  // isrgb := ('R' = upcase(img^.colorModel[0])) and ('G' = upcase(img^.colorModel[1])) and ('B' = upcase(img^.colorModel[2]));
  // isgray := 'G' = upcase(img^.colorModel[0]);
  IsGray := Image.channels = 1;
  // if (not isgray) and (not isrgb) then
  // Exit(false);
  // if (1 = img^.nChannels) and (not isgray) then
  // Exit(false);

  dibhdr := pBITMAPINFOHEADER(@buf);
  _rgb := pCOLORREF(Integer(dibhdr) + SizeOf(BITMAPINFOHEADER));

  if (IsGray) then
    for i := 0 to 255 do
      _rgb[i] := rgb(i, i, i);

  dibhdr^.biSize := SizeOf(BITMAPINFOHEADER);
  dibhdr^.biWidth := Image.cols;
  // Check origin for display
  // if img^.Origin = 0 then
  dibhdr^.biHeight := -Image.rows;
  // else
  // dibhdr^.biHeight := img^.Height;

  dibhdr^.biPlanes := 1;
  dibhdr^.biBitCount := 8 * Image.channels;
  dibhdr^.biCompression := BI_RGB;
  dibhdr^.biSizeImage := 0; // img^.imageSize;
  dibhdr^.biXPelsPerMeter := 0;
  dibhdr^.biYPelsPerMeter := 0;
  dibhdr^.biClrUsed := 0;
  dibhdr^.biClrImportant := 0;

  if Stretch then
  begin
    SetStretchBltMode(DC, COLORONCOLOR);
    SetMapMode(DC, MM_TEXT);
    // Stretch the image to fit the rectangle
    iResult := StretchDIBits(DC, Rect.Left, Rect.Top, Rect.Width, Rect.Height, 0, 0, Image.cols, Image.rows, Image.Data, _dibhdr, DIB_RGB_COLORS, SRCCOPY);
    Result := (iResult > 0); // and (iResult <> GDI_ERROR);
  end
  else
  begin
    // Draw without scaling
    iResult := SetDIBitsToDevice(DC, Rect.Left, Rect.Top, Image.cols, Image.rows, 0, 0, 0, Image.rows, Image.Data, _dibhdr, DIB_RGB_COLORS);
    Result := (iResult > 0); // and (iResult <> GDI_ERROR);
  end;
end;

    Code went from Laex library sources so try to read them.


     

  8. Posted

    Hi all.

    There is a way to detect if compile phase is in Delphi 10.4.1 or 10.4.2 ?
    At Embarcadero documentation they notice only VER340 and compiler 34.0 for either:

    https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Compiler_Versions

     

    but VCL from 10.4.1 and 10.4.2 is different and in 10.4.1 NumberBox is not available.

     

    This block 10.4.1 users to compile PythonVCL design package or force them, at any pull, to manually remove

    any reference to NumberBox where present in check:  {$IFDEF DELPHI10_4_OR_HIGHER}  ... {$ENDIF DELPHI10_4_OR_HIGHER}.

  9. Posted

    On 2/1/2022 at 7:32 PM, pyscripter said:

    Demo 29 might be of help.

    Initially failed to understand how in Demo29 the use of PIL allowed to place an image in a TImage object.
    But slowly I succeeded: 

            rgb_im = PIL_Image.fromarray(np.uint8(frame)).convert('RGB')
        self.imgFrameI.Picture.Bitmap.SetSize(rgb_im.width, rgb_im.height)
        dib = PIL_ImageWin.Dib(rgb_im)
        dib.expose(self.imgFrameI.Picture.Bitmap.Canvas.Handle)
        self.imgFrameI.Repaint()

        rgb_im = PIL_Image.fromarray(np.uint8(frame_out)).convert('RGB')
        self.imgFrameO.Picture.Bitmap.SetSize(rgb_im.width, rgb_im.height)
        dib = PIL_ImageWin.Dib(rgb_im)
        dib.expose(self.imgFrameO.Picture.Bitmap.Canvas.Handle)
        self.imgFrameO.Repaint()

    Now perfectly works and from 30FPS of PySimpleGUI version, I've reached 89 stable FPS with delphivcl version.
    AMAZING how fast delphi vcl is"

     

    • Thanks 2

  10. Posted

    Thanks for the info.

    I remember your suggestion to report the request in github in the issue department.

    I haven't done it yet because first I would like to try to do something myself, both because I started studying P4D sources and making some modules, and to actually understand how many things are necessary to cover my needs and that they are then useful to everyone. .

    The project I'm converting from PySimpleGUI is a real-time object recognition system that uses OpenCV and other AI technologies with complicated UIs that need to be really fast, hence the choice of switching to DelphiVCL and / or DelphiFMX.

    Thanks again for the support.

  11. Posted

    I'm converting a complex Python PySimpleGUI based program to Python using delphivcl module.

    In my initial test, the gained speed on UI things sees delphivcl as a very winner.

     

    But I need to add some missing features in delphivcl controls as well as the possibility to modify

    an Image (TImage) content sending it as an array of bitmap (NumPy arrays) instead to have to create

    a file.bmp and then load it with Image.Picture.LoadFromFile.

     

    Also, I need to add OnMouseDown/OnMouseUp in buttons.

     

    Gitting delphivcl, or delphifmx, I was not able to find the delphi building project, only the final files.

    Where I can find sources and projects to make delphivcl module and so to add new features?

  13. Posted

    I have not yet found a fast way to load TImage contents starting from a NumPy array...


    this method is enough fast BUT require a file support (at 30FPS SSD will suffer a lot): 

            # gets and shows frame image storing it in a support file
        bmp_image = cv2.imencode('.bmp', frame)[1].tobytes()
        stream = BytesIO(bmp_image)
        with open("f:\output_a.bmp", "wb") as f:
            f.write(stream.getbuffer())
            f.close()
        self.imgFrameI.Picture.LoadFromFile("f:\output_a.bmp")

this method access to TImage canvas but is VERY SLOW:


            self.imgFrameI.Picture.Bitmap.SetSize(640, 480)
        canvas = self.imgFrameI.Picture.Bitmap.Canvas
        rgb_im = PIL_Image.fromarray(frame)
        for x in range(640):
            for y in range(480):
                b, g, r = rgb_im.getpixel((x, y))
                rgb = b * 65536 + g * 256 + r
                canvas.SetPixel(x, y, rgb)

There is some other way to set Picture of a Image() object from a image array ?

  14. Posted

    I was not able to update image content directly from data in memory, but only

    passing from a support file:

      

        def __on_timer_update(self, sender):
        # gets frame
        frame = cvc.video_capture_get_frame()
        bmp_image = cv2.imencode('.bmp', frame)[1].tobytes()

        # shows frame image storing it in a support file
        stream = BytesIO(bmp_image)
        with open("output.bmp", "wb") as f:
            f.write(stream.getbuffer())
            f.close()
        self.imgFrame.Picture.LoadFromFile("output.bmp")

    This works but I would like to avoid working with files because 60 FPS are

    dangerous for SSD devices.


    There is some other way to assign the image, in this case a BMP to be simple,
    directly to an Image() object using python + DelphiVCL library module ? 

  15. Posted · Edited by shineworld

    Hi all.

     

    I'm trying to convert a layout from PySimpleGUI to DelphiVCL.

    All works fine but I was not able to put an image in an Image() component programmatically.

     

    1] I get a frame from OpenCV VideoCamera cap with:

       self.__cap = cv2.VideoCapture(0, cv2.CAP_DSHOW)

       ret, frame = self.__cap.read()
    2] I convert the frame to a png image with:
          png_image = cv2.imencode('.png', frame)[1].tobytes()


    Now with PySimpleGUI I just update it with: 

       view.window['image_1'].update(data=png_image)

    where image_1 =     sg.Image(filename='', key='image_1', size=(640, 480))

     

    With DelphiVCL I've created a image_1 = Image(self) and assigned basic parent and props

    but I don't find a way to update the img (an array of bytes with a PNG image inner).

     

    Thank you very much for suggestions.

  17. Posted

    The hard thing with a new environment, eg: Sydney vs Alexandria, is to move all 3rd parties libraries (often to re-buy), but overall learn workaround on always present IDE issues.

    The time to discover a problem with an IDE and tool-chain and learn the right workarounds to continue to work is a long activity.
    Back from new created file project to old, in case of very critical issues are a very waste of time.

    • Like 1

  19. Posted

    Hi, all

     

    I'm trying to use Python extension from Embarcadero:
    https://github.com/Embarcadero/DelphiVCL4Python

     

    installed in Python 3.9 (32 bits) with
      

    pip install delphivcl

    I was able to assign an OnClick event (in a Button): 

            # creates jogs buttons
        btnXM = Button(self)
        btnXM.Parent = pgOne
        btnXM.Caption = 'X-'
        btnXM.Left = 8
        btnXM.Top = 10
        btnXP = Button(self)
        btnXP.Parent = pgOne
        btnXP.Caption = 'X+'
        btnXP.Left = btnXM.Left + btnXM.Width + 8
        btnXP.Top = 10

        def ClickEventHandler(Sender):
            pass

        btnXP.OnClick = self.jogClickEvent

        def MouseDownHandler(Sender, State, Button, X, Y):
            pass

        btnXP.OnMouseDown = MouseDownHandler

    but when reaches the btnXP.OnMouseDown Python notice this error: 

    *** Remote Interpreter Reinitialized ***
Traceback (most recent call last):
  File "D:\x\develop\qem\rosetta_cnc_1\python-scripts\pyipctcpjsonvcl-demo.py", line 249, in <module>
    main()
  File "D:\x\develop\qem\rosetta_cnc_1\python-scripts\pyipctcpjsonvcl-demo.py", line 241, in main
    f = MainForm(Application)
  File "D:\x\develop\qem\rosetta_cnc_1\python-scripts\pyipctcpjsonvcl-demo.py", line 67, in __init__
    btnXP.OnMouseDown = MouseDownHandler
AttributeError: Error in setting property OnMouseDown
Error: No Registered EventHandler for events of type "TMouseEvent

    Looking at btnXP dir(): 

    print(btnXP.__dir__())

['__bound__', '__dir__', '__owned__', 'Action', 'AfterConstruction', 'Align', 'AlignDisabled', 'AlignWithMargins', 'Anchors', 'Assign', 'BeforeDestruction', 'BeginDrag', 'BeginInvoke', 'BiDiMode', 'BindMethodsToEvents', 'BoundsRect', 'BringToFront', 'Broadcast', 'Brush', 'Cancel', 'CanFocus', 'Caption', 'CheckNonMainThreadUsage', 'ClassInfo', 'ClassName', 'ClassNameIs', 'ClassParent', 'ClassType', 'CleanupInstance', 'Click', 'ClientHeight', 'ClientOrigin', 'ClientRect', 'ClientToParent', 'ClientToScreen', 'ClientWidth', 'CommandLinkHint', 'ComObject', 'ComponentCount', 'ComponentIndex', 'Components', 'ComponentState', 'ComponentStyle', 'Constraints', 'ContainsControl', 'ControlAtPos', 'ControlCount', 'Controls', 'ControlState', 'ControlStyle', 'Create', 'CreateParented', 'CreateParentedControl', 'CurrentPPI', 'Cursor', 'CustomHint', 'Default', 'DefaultHandler', 'DesignInfo', 'Destroy', 'DestroyComponents', 'Destroying', 'DisableAlign', 'DisabledImageIndex', 'DisabledImageName', 'DisabledImages', 'Dispatch', 'DisposeOf', 'Dock', 'DockClientCount', 'DockDrop', 'DockManager', 'DockOrientation', 'DockSite', 'DoubleBuffered', 'DragCursor', 'DragDrop', 'Dragging', 'DragKind', 'DragMode', 'DrawTextBiDiModeFlags', 'DrawTextBiDiModeFlagsReadingOnly', 'DropDownMenu', 'ElevationRequired', 'EnableAlign', 'Enabled', 'EndDrag', 'EndFunctionInvoke', 'EndInvoke', 'Equals', 'ExecuteAction', 'ExplicitHeight', 'ExplicitLeft', 'ExplicitTop', 'ExplicitWidth', 'FieldAddress', 'FindChildControl', 'FindComponent', 'FlipChildren', 'Floating', 'FloatingDockSiteClass', 'Focused', 'Font', 'Free', 'FreeInstance', 'FreeNotification', 'FreeOnRelease', 'GetChildren', 'GetControlsAlignment', 'GetEnumerator', 'GetHashCode', 'GetInterface', 'GetInterfaceEntry', 'GetInterfaceTable', 'GetNamePath', 'GetParentComponent', 'GetStyleName', 'GetSystemMetrics', 'GetTabControlList', 'GetTabOrderList', 'GetTextBuf', 'GetTextLen', 'Handle', 'HandleAllocated', 'HandleNeeded', 'HasParent', 'Height', 'HelpContext', 'HelpKeyword', 'HelpType', 'Hide', 'Hint', 'HostDockSite', 'HotImageIndex', 'HotImageName', 'ImageAlignment', 'ImageIndex', 'ImageMargins', 'ImageName', 'Images', 'InheritsFrom', 'InitiateAction', 'InitInstance', 'InsertComponent', 'InsertControl', 'InstanceSize', 'Invalidate', 'IsCustomStyleActive', 'IsDrawingLocked', 'IsImplementorOf', 'IsLightStyleColor', 'IsRightToLeft', 'Left', 'LockDrawing', 'LRDockWidth', 'ManualDock', 'ManualFloat', 'Margins', 'MethodAddress', 'MethodName', 'ModalResult', 'MouseInClient', 'MouseWheelHandler', 'Name', 'NewInstance', 'Observers', 'OnClick', 'OnContextPopup', 'OnDragDrop', 'OnDragOver', 'OnDropDownClick', 'OnEndDock', 'OnEndDrag', 'OnEnter', 'OnExit', 'OnGesture', 'OnKeyDown', 'OnKeyPress', 'OnKeyUp', 'OnMouseActivate', 'OnMouseDown', 'OnMouseEnter', 'OnMouseLeave', 'OnMouseMove', 'OnMouseUp', 'OnStartDock', 'OnStartDrag', 'Owner', 'Padding', 'PaintTo', 'Parent', 'ParentBiDiMode', 'ParentCustomHint', 'ParentDoubleBuffered', 'ParentFont', 'ParentShowHint', 'ParentToClient', 'ParentWindow', 'Perform', 'PixelsPerInch', 'PopupMenu', 'PreProcessMessage', 'PressedImageIndex', 'PressedImageName', 'QualifiedClassName', 'Realign', 'RedrawDisabled', 'ReferenceInterface', 'Refresh', 'RemoveComponent', 'RemoveControl', 'RemoveFreeNotification', 'Repaint', 'ReplaceDockedControl', 'SafeCallException', 'ScaleBy', 'ScaleFactor', 'ScaleForPPI', 'ScaleRectSize', 'ScaleValue', 'ScreenToClient', 'ScrollBy', 'SelectedImageIndex', 'SelectedImageName', 'SendToBack', 'SetBounds', 'SetDesignVisible', 'SetFocus', 'SetParentComponent', 'SetProps', 'SetSubComponent', 'SetTextBuf', 'Show', 'ShowHint', 'Showing', 'Style', 'StyleElements', 'StyleName', 'StylusHotImageIndex', 'StylusHotImageName', 'TabOrder', 'TabStop', 'Tag', 'TBDockHeight', 'ToList', 'Top', 'ToString', 'ToTuple', 'Touch', 'UndockHeight', 'UndockWidth', 'UnitName', 'UnitScope', 'UnlockDrawing', 'Update', 'UpdateAction', 'UpdateControlState', 'UseDockManager', 'UseRightToLeftAlignment', 'UseRightToLeftReading', 'UseRightToLeftScrollBar', 'VCLComObject', 'Visible', 'VisibleDockClientCount', 'Width', 'WindowProc', 'WordWrap']

    OnMouseDown/Up are exposed....


    I'm not able to understand what I've missed...

    Thank you in advance for suggestions


     

  20. Posted · Edited by shineworld

    12 hours ago, Remy Lebeau said:

     

    Though, are you really sure you want to catch an exception at all? You are going to leave the connection in an unstable state.  You may as well just let the exception propagate up the call stack uncaught, and let the server catch it and close the connection for you.

    I'm not aware of that, I'm an occasional user of Indy classes.

    So on TIdTTCPServerContex.Execute is better do not manage exceptions on WriteLn because are correctly managed in TidTCPServer.Execute caller?

    To be honest I've got some issues during close application when I do TIdTCPServer.Active := False and TIdTCPServer.Free; with connected clients...
    Could be because I catch the exceptions on Execute().... and the caller doesn't manage the right closing states.

     

    I've changed to:
      

    procedure TIPCTCPServerContext.Execute;
type
  TRequestType = ( rqtpCmd, rqtpGet, rqtpSet );
var
  ArgS: string;
  ArgI: Integer;
  Command: string;
  Request: string;
  Response: string;
  JsonValue: TJSONValue;
  RequestType: TRequestType;
begin
  // sets default response
  Response := RES_NULL;

  // extracts request from tcp stack
  Request := Trim(Connection.IOHandler.ReadLn);
  try
    // gets request type
    JSONValue := TJSONObject.ParseJSONValue(Request);
    try
      if not (JSONValue is TJSONObject) then Exit;
      while True do
      begin
        if JSONValue.TryGetValue(REQ_CMD, Command) then
        begin
          RequestType := rqtpCmd;
          Break;
        end;
        if JSONValue.TryGetValue(REQ_GET, Command) then
        begin
          RequestType := rqtpGet;
          Break;
        end;
        if JSONValue.TryGetValue(REQ_SET, Command) then
        begin
          RequestType := rqtpSet;
          Break;
        end;
        Exit;
      end;

      // evaluates request type
      case RequestType of
        rqtpCmd:
        begin
          if Command = 'cnc.homing' then
          begin
            if not JSONValue.TryGetValue<Integer>('["axes.mask"]', ArgI) then Exit;
            Response := DoCmdCNCHoming(ArgI);
          end
          else if Command = 'cnc.mdi.command' then
          begin
            if not JSONValue.TryGetValue('command', ArgS) then Exit;
            Response := DoCmdCNCMDICommand(ArgS);
          end
          else if Command = 'cnc.pause' then
            Response := DoCmdCNCPause
          else if Command = 'cnc.resume.after.pause' then
            Response := DoCmdCNCResumeAfterPause
          else if Command = 'cnc.resume.after.stop' then
          begin
            if JSONValue.TryGetValue<Integer>('line', ArgI) then
              Response := DoCmdCNCResumeAfterStop(ArgI)
            else
              Response := DoCmdCNCResumeAfterStop(0);
          end
          else if Command = 'cnc.start' then
          begin
            if JSONValue.TryGetValue<Integer>('line', ArgI) then
              Response := DoCmdCNCStart(ArgI)
            else
              Response := DoCmdCNCStart(0);
          end
          else if Command = 'cnc.stop' then
            Response := DoCmdCNCStop
          else if Command = 'program.analysis' then
          begin
            if JSONValue.TryGetValue('mode', ArgS) then
              Response := DoCmdProgramAnalysis(ArgS)
            else
              Response := DoCmdProgramAnalysis('');
          end
          else if Command = 'program.analysis.abort' then
            Response := DoCmdProgramAnalysisAbort
          else if Command = 'program.gcode.add.text' then
          begin
            if not JSONValue.TryGetValue('text', ArgS) then Exit;
            Response := DoCmdProgramGCodeAddText(ArgS);
          end
          else if Command = 'program.gcode.clear' then
            Response := DoCmdProgramGCodeClear
          else if Command = 'program.gcode.set.text' then
          begin
            if not JSONValue.TryGetValue('text', ArgS) then Exit;
            Response := DoCmdProgramGCodeSetText(ArgS);
          end
          else if Command = 'program.load' then
          begin
            if not JSONValue.TryGetValue('name', ArgS) then Exit;
            Response := DoCmdProgramLoad(ArgS);
          end
          else if Command = 'program.new' then
            Response := DoCmdProgramNew
          else if Command = 'program.save' then
          begin
            if JSONValue.TryGetValue('name', ArgS) then
              Response := DoCmdProgramSave(ArgS)
            else
              Response := DoCmdProgramSave('')
          end
          else
            Exit;
        end;
        rqtpGet:
        begin
          if Command = 'axes.info' then
            Response := DoGetAxesInfo
          else if Command = 'cnc.info' then
            Response := DoGetCNCInfo
          else if Command = 'compile.info' then
            Response := DoGetCompileInfo
          else if Command = 'system.info' then
            Response := DoGetSystemInfo
          else
            Exit;
        end;
        rqtpSet:
        begin
          //##
        end;
      end;
    finally
      JSONValue.Free;
    end;
  finally
    Connection.IOHandler.WriteLn(Response);
  end;
end;

    Should be more right now...

  21. Posted

    Yes Remy, I've made

      

    procedure TIPCTCPServerContext.Execute;
type
  TRequestType = ( rqtpCmd, rqtpGet, rqtpSet );
var
  ArgS: string;
  ArgI: Integer;
  Command: string;
  Request: string;
  Response: string;
  JsonValue: TJSONValue;
  RequestType: TRequestType;
begin
  try
    // sets default response
    Response := RES_NULL;

    // extracts request from tcp stack
    Request := Trim(Connection.IOHandler.ReadLn);

    // gets request type
    JSONValue := TJSONObject.ParseJSONValue(Request);
    try
      if not (JSONValue is TJSONObject) then AbortFast;
      while True do
      begin
        if JSONValue.TryGetValue(REQ_CMD, Command) then
        begin
          RequestType := rqtpCmd;
          Break;
        end;
        if JSONValue.TryGetValue(REQ_GET, Command) then
        begin
          RequestType := rqtpGet;
          Break;
        end;
        if JSONValue.TryGetValue(REQ_SET, Command) then
        begin
          RequestType := rqtpSet;
          Break;
        end;
        AbortFast;
      end;

      // evaluates request type
      case RequestType of
        rqtpCmd:
        begin
          if Command = 'cnc.homing' then
          begin
            if not JSONValue.TryGetValue<Integer>('["axes.mask"]', ArgI) then AbortFast;
            Response := DoCmdCNCHoming(ArgI);
          end
          else if Command = 'cnc.mdi.command' then
          begin
            if not JSONValue.TryGetValue('command', ArgS) then AbortFast;
            Response := DoCmdCNCMDICommand(ArgS);
          end
          else if Command = 'cnc.pause' then
            Response := DoCmdCNCPause
          else if Command = 'cnc.resume.after.pause' then
            Response := DoCmdCNCResumeAfterPause
          else if Command = 'cnc.resume.after.stop' then
          begin
            if JSONValue.TryGetValue<Integer>('line', ArgI) then
              Response := DoCmdCNCResumeAfterStop(ArgI)
            else
              Response := DoCmdCNCResumeAfterStop(0);
          end
          else if Command = 'cnc.start' then
          begin
            if JSONValue.TryGetValue<Integer>('line', ArgI) then
              Response := DoCmdCNCStart(ArgI)
            else
              Response := DoCmdCNCStart(0);
          end
          else if Command = 'cnc.stop' then
            Response := DoCmdCNCStop
          else if Command = 'program.analysis' then
          begin
            if JSONValue.TryGetValue('mode', ArgS) then
              Response := DoCmdProgramAnalysis(ArgS)
            else
              Response := DoCmdProgramAnalysis('');
          end
          else if Command = 'program.analysis.abort' then
            Response := DoCmdProgramAnalysisAbort
          else if Command = 'program.gcode.add.text' then
          begin
            if not JSONValue.TryGetValue('text', ArgS) then AbortFast;
            Response := DoCmdProgramGCodeAddText(ArgS);
          end
          else if Command = 'program.gcode.clear' then
            Response := DoCmdProgramGCodeClear
          else if Command = 'program.gcode.set.text' then
          begin
            if not JSONValue.TryGetValue('text', ArgS) then AbortFast;
            Response := DoCmdProgramGCodeSetText(ArgS);
          end
          else if Command = 'program.load' then
          begin
            if not JSONValue.TryGetValue('name', ArgS) then AbortFast;
            Response := DoCmdProgramLoad(ArgS);
          end
          else if Command = 'program.new' then
            Response := DoCmdProgramNew
          else if Command = 'program.save' then
          begin
            if JSONValue.TryGetValue('name', ArgS) then
              Response := DoCmdProgramSave(ArgS)
            else
              Response := DoCmdProgramSave('')
          end
          else
            AbortFast;
        end;
        rqtpGet:
        begin
          if Command = 'system.info' then
            Response := DoGetSystemInfo
          else if Command = 'axes.info' then
            Response := DoGetAxesInfo
          else
            AbortFast;
        end;
        rqtpSet:
        begin
          //##
        end;
      end;
    finally
      JSONValue.Free;
    end;

    // sends response as json contents
    Connection.IOHandler.WriteLn(Response);
  except
    try Connection.IOHandler.WriteLn(Response) except end;
  end;
end;

     

  25. Posted

    Hi all,

     

    I'm trying to use TTask to perform some parallel code with Sydney 10.4.1 looking at the sample code in Help System,

    so it should be supported by 10.4.1:
     

    image.thumb.png.6d895bfc42e15cb0812d5b51612b7c47.png


    but I've got always the error:
    [dcc32 Error] osIPCTCPServerContext.pas(423): E2250 There is no overloaded version of 'Create' that can be called with these arguments

    image.thumb.png.392f661c39173805d9cf059cca882cb5.png


    Have you any idea about it?

    Thank you in advance for replies.

     

×