Jump to content

shineworld

Members
  • Content Count

    282
  • Joined

  • Last visited

  • Days Won

    3

Posts posted by shineworld


  1. I don't know if its the right way but with Indy10 I use:
     

    unit osCustomConnection;
    
    interface
    
    uses
      Windows,
    
      IdGlobal,
      IdBuffer,
      IdIOHandler,
      IdTCPClient,
      IdTCPConnection;
    
    type
      TCustomConnection = class
      private
        FDevice: TIdTCPClient;
      private
        function GetConnected: Boolean;
        function GetHost: string;
        function GetPort: Integer;
        function GetInputBuffer: TIdBuffer;
      private
        procedure SetHost(const Value: string);
        procedure SetPort(Value: Integer);
      public
        procedure Connect(const ATimeout: Integer = IdTimeoutDefault);
        procedure Disconnect;
        function ReadFromStack(const ARaiseExceptionIfDisconnected: Boolean = True; ATimeout: Integer = IdTimeoutDefault; const ARaiseExceptionOnTimeout: Boolean = True): Integer;
        procedure WriteBuffer(const ABuffer; AByteCount: Integer; const AWriteNow: Boolean = False);
      public
    	function FlushInputBuffer: Integer;  
      public
        property Connected: Boolean read GetConnected;
        property Host: string read GetHost write SetHost;
        property Port: Integer read GetPort write SetPort;
        property InputBuffer: TIdBuffer read GetInputBuffer;
      public
        constructor Create;
        destructor Destroy; override;
      end;
    
      TIdIOHandlerHelper = class(TIdIOHandler)
      public
        function ReadFromSource(ARaiseExceptionIfDisconnected: Boolean; ATimeout: Integer; ARaiseExceptionOnTimeout: Boolean): Integer;
      end;
    
    implementation
    
    { TCustomConnection }
    
    procedure TCustomConnection.Connect(const ATimeout: Integer);
    begin
      FDevice.ConnectTimeout := ATimeOut;
      FDevice.Connect;
    end;
    
    constructor TCustomConnection.Create;
    begin
      FDevice := nil;
    
      FDevice := TIdTCPClient.Create(nil);
    end;
    
    destructor TCustomConnection.Destroy;
    begin
      FDevice.Free;
    
      inherited;
    end;
    
    procedure TCustomConnection.Disconnect;
    begin
      FDevice.Disconnect;
    end;
    
    function TCustomConnection.GetConnected: Boolean;
    begin
      Result := FDevice.Connected;
    end;
    
    function TCustomConnection.GetHost: string;
    begin
      Result := FDevice.Host;
    end;
    
    function TCustomConnection.GetInputBuffer: TIdBuffer;
    begin
      Result := FDevice.IOHandler.InputBuffer;
    end;
    
    function TCustomConnection.GetPort: Integer;
    begin
      Result := FDevice.Port;
    end;
    
    function TCustomConnection.ReadFromStack(const ARaiseExceptionIfDisconnected: Boolean; ATimeout: Integer; const ARaiseExceptionOnTimeout: Boolean): Integer;
    begin
      Result := TIdIOHandlerHelper(FDevice.IOHandler).ReadFromSource(ARaiseExceptionIfDisconnected, ATimeout, ARaiseExceptionOnTimeout);
    end;
    
    procedure TCustomConnection.SetHost(const Value: string);
    begin
      FDevice.Host := Value;
    end;
    
    procedure TCustomConnection.SetPort(Value: Integer);
    begin
      FDevice.Port := Value;
    end;
    
    procedure TCustomConnection.WriteBuffer(const ABuffer; AByteCount: Integer; const AWriteNow: Boolean);
    begin
      if AByteCount = 0 then Exit;
      FDevice.IOHandler.WriteDirect(TIdBytes(@ABuffer), AByteCount);
    end;
    
    // flushes communications device input buffer
    function TCustomConnection.FlushInputBuffer: Integer;
    begin
      if not Connected then
        Result := 0
      else
      begin
        ReadFromStack(False, 1, False);
        Result := InputBuffer.Size;
        InputBuffer.Clear;
      end;
    end;
    
    { TIdIOHandlerHelper }
    
    function TIdIOHandlerHelper.ReadFromSource(ARaiseExceptionIfDisconnected: Boolean; ATimeout: Integer; ARaiseExceptionOnTimeout: Boolean): Integer;
    begin
      Result := inherited ReadFromSource(ARaiseExceptionIfDisconnected, ATimeout, ARaiseExceptionIfDisconnected);
    end;
    
    end.

    It's a part of a more complex class (reduced to be simple to be read) but works.

     

    I use Indy10 TCP to capture encoded/encrypted/compressed continuous flow of data and so I've moved to public ReadFromSource,

    which call private TIdIOHandler.ReadFromSource function, to manage better the flow in a capture/decode/decrypt/uncompress thread.

    FlusInputBuffer calls a ReadFromStack to capture pending data en delete InputBuffer.Size return how many bytes were flushed.


  2. Actually, I was a little poor in the description because I thought I shouldn't bore you.

    Let's see if I can group the ideas.

     

    1] The IP Camera
    The IP camera is made with an embedded board + a motorized camera sensor + Linux.

    The IP camera, mounted on the Z axis of the CNC, uses a LAN connection to receive commands (eg: manual focus, brightness, resolution, etc)

    and return a stream of encoded and compressed frames.

    To do this, it uses the TCP / UDP protocols.
    The management software was initially made with Python but then I will calmly rewrite it completely in C ++.

    Theoretically, the code is already performing even in Python, as the bottleneck remains the acquisition of the frames from the sensor,

    their encoding, and compression, which is already done using native code libraries.

    In any case, a large part of the Python project was then compiled with Cython, creating python modules .so that a few percentage points of profit made me get.

     

    2] Delphi and its expansion modules for Python.
    Initially, I tried to manage TCP/UPD streams directly in Python via sockets and threads, but unfortunately, Python gives the worst,

    as threading management is always subject to the rules of the GIL and therefore in fact creating more threads in python does not always

    mean being able to optimize the use of cores.

    I will not dwell on this question, which I too was not aware of, there are many discussions on the net.

    I, therefore, thought of using Delphi to create an extension module for Python in which I entered all the communication work between PC and

    Camera using Delphi's TThread (more practically internally I used INDY both for the TCP Client and for the UDP server)

    In python, I no longer needed to create threads for managing TCP/UDP packets with the resolution of many problems that I had had in the first tests.

    Still in the Python expansion module written in Delphi, I was able to manage other features not present in ready-made libraries for Python,

    but which I already had working fine in Delphi, certainly gaining performances.

     

    3] Python program
    The Python program is actually made up of Python + DelphiVCL + Skia + OpenCV and other minor libraries, plus an image processing framework

    that I built from scratch in pure python language.

    To improve performance, the whole package, apart from the main file, was also compiled with Cython, obtaining a series of .pyd modules that make up the final product.

     

    4] CNC
    The CNC is actually made up of an embedded board with a REAL TIME industrial operating system that I wrote years ago and that we have been using for years

    for CNC and PLC and all the CNC part is done directly on the board.

    The CNC board, which controls the motors/inputs/outputs/EtherCAT /etc, communicates with the PC and with the CNC control software via LAN.

    The control software is just a UI interface, has a G-code compiler, and takes care of transferring motion instructions or pre-processed blocks to the CNC board's execution buffer.
    In the CNC control software, there is an API server (TCP/Server) which allows an external program/process, through an API Client, to access all the functions of the CNC,

    including sending programs, MDI programs, JOG, etc.

    So for Python, I have created a package that implements the client core API allowing a Python program to have full control of the CNC.

     

    NOTE
    The program can use Themes.
    Without a theme, the assignment of a Bitmap to TImage objects (a Window control) can generate flickering (due to the WM_ERASExxx message).
    Using Themes the flickering increase a lot.
    So I've created a new DelphiVCL branch with Graphics32:TImgView32 which is a TGraphicControl-based object and solved the flickering phase managing the PAINT event.

    Now I've been really boring :)
    Sorry!

    • Thanks 1

  3. Good,
    after a long time stressing this forum, especially the Python4Delphi channel, with lots of rookie requests,

    I got to a good point with the development of my first Python program.

     

    Until a few months ago I had always ignored Python and its possibilities as Delphi has always been a tool

    with which I create all my works and I have never thought of anything else.

     

    When Python4Delphi and DelphiVCL showed up I wondered if I could do something interesting with both

    and I must admit that although Python was completely new land to me, the fact of sticking with Delphi

    anyway took away any doubt. .. I had to try.

     

    Basically, the program is pure Python (after being compiled with Cython), an embedded version, with the addition

    of DelphiVCL (I've never used FMX so it's better to start from the VCL that I know very well) and some Python modules

    made in Delphi where I put the more delicate parts and in use real threads and not "crippled" threads by the GIL.


    I anticipate, it is nothing transcendental, but as a first Python project, I am satisfied with it.

    Description of video
    In this short video, we can see the execution of an external program written in Python for the holding of print markers

    necessary to calculate the zero machining, the rotation of the piece on the work table, and all the scaling needed to

    compensate for the error of model printing between CAD and plotter printer.

     

    The Python program interacts directly with the CNC that moves the XYZ axes for the final cut through an API Client (cnc_api_client_core in PyPi)

    to the CNC control software API Server, retrieving information and sending direct commands to the CNC System.

     

    Image capture is done using a proprietary IP Camera equipped with LED lighting.
     

    The Python program is executed through an embedded version of the language prepared with all the necessary tools and allows two UI,
    vertical and horizontal, to adapt to all types of monitors.

    NOTE:

    The below CNC Control Software is 100% made with Delphi 🙂


    Many Thanks to forum people for the support!

    • Like 4

  4. Ok, I've added my first extension to DelphiVCL to use Graphics32 TImgView32 instead of standard Delphi TImage which suffers from blinking effects,

    during the repaint phase (not an issue on Delphi but inherited from OS level) when bitmap images do not fully cover the Image area.

    It is only an early implementation... I'm not a guru of P4D unfortunately, but it works.

    {***
     *  TAKE CARE
     *  =========
     *  This units add extra third parties components from Graphics32.
     *
     *  https://github.com/graphics32/graphics32
     *
     *  LICENSE
     *  =======
     *  As of version 1.5.1b Graphics32 is licensed under the terms of the Mozilla Public License (MPL) 1.1.
     *  You may obtain a copy of the License at http://www.mozilla.org/MPL
     *
     *  Starting with version 1.9 Graphics32 is also licensed under the Lesser General Public License (LGPL) 2.1
     *  with linking exception.
     *
     *  You may use the files in this distribution under the terms of either the MPL 1.1 or the LGPL 2.1 with linking
     *  exception. You can find a copy of both licenses in the plain text file License.txt which is located in the root
     *  directory of the Graphics32 distribution package.
     *
     **}
    
    {$I ..\Definition.Inc}
    
    unit WrapExtGraphics32;
    
    interface
    
    uses
      System.Classes,
      System.TypInfo,
      System.SysUtils,
      Winapi.Windows,
      Vcl.Controls,
      Vcl.Graphics,
      Vcl.StdCtrls,
    
      WrapDelphi,
      PythonEngine,
      WrapVclControls,
      WrapDelphiClasses,
    
      GR32_Image,
      GR32_Layers;
    
    type
    {
      TMouseEvent = procedure(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;
      TImgMouseEvent = procedure(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer) of object;
    }
    
      { TImgMouseEvent wrapper }
    
      TImgMouseEventHandler = class(TEventHandler)
      protected
        procedure DoEvent(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer; Layer: TCustomLayer);
      public
        constructor Create(PyDelphiWrapper : TPyDelphiWrapper; Component : TObject; PropertyInfo : PPropInfo; Callable : PPyObject); override;
        class function GetTypeInfo : PTypeInfo; override;
      end;
    
      { TImgView32 wrapper }
    
      TPyDelphiImgView32 = class(TPyDelphiControl)
      private
        FBitmap: Vcl.Graphics.TBitmap;
      private
        function GetDelphiObject: TImgView32;
        procedure SetDelphiObject(const Value: TImgView32);
      public
        class function DelphiObjectClass: TClass; override;
        property DelphiObject: TImgView32 read GetDelphiObject write SetDelphiObject;
      public
        constructor Create(APythonType: TPythonType); override;
        constructor CreateWith(PythonType: TPythonType; args: PPyObject); override;
        destructor Destroy; override;
      end;
    
    implementation
    
    uses
      WrapVclExtCtrls;
    
    type
      TByteDynArray = array of Byte;
    
    { TImgMouseEventHandler }
    
    constructor TImgMouseEventHandler.Create(PyDelphiWrapper : TPyDelphiWrapper; Component : TObject; PropertyInfo : PPropInfo; Callable : PPyObject);
    var
      Method : TMethod;
    begin
      inherited;
    
      Method.Code := @TImgMouseEventHandler.DoEvent;
      Method.Data := Self;
      SetMethodProp(Component, PropertyInfo, Method);
    end;
    
    procedure TImgMouseEventHandler.DoEvent(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer; Layer: TCustomLayer);
    var
      PyObject, PyTuple, PyButton, PyX, PyY, PyLayer, PyResult: PPyObject;
    begin
      Assert(Assigned(PyDelphiWrapper));
      if Assigned(Callable) and PythonOK then
        with GetPythonEngine do begin
          PyObject := PyDelphiWrapper.Wrap(Sender);
          PyButton := PyLong_FromLong(Ord(Button));
          PyX := PyLong_FromLong(X);
          PyY := PyLong_FromLong(Y);
          PyLayer := Py_None; //### TAKE CARE: Layers are not supported yet!!!
          PyTuple := PyTuple_New(6);
          GetPythonEngine.PyTuple_SetItem(PyTuple, 0, PyObject);
          GetPythonEngine.PyTuple_SetItem(PyTuple, 1, PyButton);
          GetPythonEngine.PyTuple_SetItem(PyTuple, 2, ShiftToPython(Shift));
          GetPythonEngine.PyTuple_SetItem(PyTuple, 3, PyX);
          GetPythonEngine.PyTuple_SetItem(PyTuple, 4, PyY);
          GetPythonEngine.PyTuple_SetItem(PyTuple, 5, PyLayer);
          try
            PyResult := PyObject_CallObject(Callable, PyTuple);
            if Assigned(PyResult) then
            begin
              Py_DECREF(PyResult);
            end;
          finally
            Py_DECREF(PyTuple);
          end;
          CheckError;
        end;
    end;
    
    class function TImgMouseEventHandler.GetTypeInfo : PTypeInfo;
    begin
      Result := System.TypeInfo(TImgMouseEvent);
    end;
    
    { TPyDelphiImgView32 }
    
    class function TPyDelphiImgView32.DelphiObjectClass: TClass;
    begin
      Result := TImgView32;
    end;
    
    constructor TPyDelphiImgView32.Create(APythonType: TPythonType);
    begin
      inherited;
    
      FBitmap := Vcl.Graphics.TBitmap.Create;
      FBitmap.Width := 100;
    end;
    
    constructor TPyDelphiImgView32.CreateWith(PythonType: TPythonType; args: PPyObject);
    begin
      inherited;
    end;
    
    destructor TPyDelphiImgView32.Destroy;
    begin
      if FBitmap <> nil then
        FreeAndNil(FBitmap);
    
      inherited;
    end;
    
    function TPyDelphiImgView32.GetDelphiObject: TImgView32;
    begin
      Result := TImgView32(inherited DelphiObject);
    end;
    
    procedure TPyDelphiImgView32.SetDelphiObject(const Value: TImgView32);
    begin
      inherited DelphiObject := Value;
    end;
    
    {***
     *  TAKE CARE
     *  =========
     *  At moment I've prefered to create the extra python function update_imgview32_from_bytes which call internal wrapped
     *  UpdateImg32ViewFromBytesArray_Wrapper instead to add it directly to TPyDelphiImgView32. The second possibility is
     *  create a local version of TImgView32 -> TImageView32Ex in which add the UpdateImage() function and leave to P4D to
     *  create a wrapped interface. The bad thing of this way is that TByteDynArray is a tkDynArray and P4D converts it
     *  to a list which is managed byte for byte to reconstruct a Delphi dynamic array becoming very very slow.
     *
     **}
    
    function UpdateImg32ViewFromBytesArray_Wrapper(pself, args: PPyObject): PPyObject; cdecl;
    {
            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.
    }
    var
      Width: Integer;
      Height: Integer;
      Channels: Integer;
      Image: TImgView32;
      Bytes: TByteDynArray;
      BytesPyObj: PPyObject;
      ImagePyObj: PPyObject;
      ImageBitmap: Vcl.Graphics.TBitmap;
    
      function PyBytesAsBytes(Obj: PPyObject): TByteDynArray;
      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;
    
      function UpdateImg32ViewFromBytesArray(Bytes: TByteDynArray; Width, Height, Channels: Integer): Boolean;
    
        {***
         *  TAKE CARE
         *  =========
         *  Unfortunately Windows SetDIBitsToDevice requires that Bytes image lines are aligned with DWORD (4 bytes), so
         *  when Width is not a multiple of 4 bytes the result is a tilted image. At moment I don't know a fast way to
         *  align the flow of bytes. A possibility is to create ONLY 4 bytes aligned Width images in Python application but
         *  sincerely I dont like this approach. Other possibility is to try generating RGBA bytes with A fiexd to 255, so
         *  A is unmanaged but this mean more bytes to move.
         *
         *  To solve, at moment I've created an UpdateImg32ViewFromBytesArrayEx which recreate the Bitmap from bytes using
         *  scanline, so a row at time. I hope this is not a too slow way to do.
         *
         **}
    
        function UpdateBitmapFromBytesArray(Bitmap: Vcl.Graphics.TBitmap; Bytes: TByteDynArray; Width, Height, Channels: Integer): Boolean;
        type
          TRGBBitmapInfoHeader = record
            Header: TBitmapInfoHeader;
            ColorTable: array[0..255] of TRGBQuad;
          end;
          PBitmapInfoHeader = ^TBitmapInfoHeader;
        var
          I: Integer;
          Buffer: TRGBBitmapInfoHeader;
          BmpInfoHeader: PBitmapInfoHeader;
        var
          BmpInfoBuffer: TBitmapInfo absolute Buffer;
        begin
          Result := False;
          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 Bitmap = nil then
              Exit;
    
            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;
    
            Result := SetDIBitsToDevice
            (
              Bitmap.Canvas.Handle, // hdc        | handle to device context
              0,                    // xDest      | x-coordinate of upper-left corner of
              0,                    // yDest      | y-coordinate of upper-left corner of
              Width,                // w          | source rectangle width
              Height,               // h          | source rectangle height
              0,                    // xSrc       | x-coordinate of Lower-left corner of
              0,                    // ySrc       | y-coordinate of Lower-left corner of
              0,                    // StartScan  | first scan line in array
              Height,               // cLines     | number of scan lines
              Bytes,                // *lpvBits   | address of array with DIB bits
              BmpInfoBuffer,        // *lpbmi     | address of structure with bitmap info
              DIB_RGB_COLORS        // ColorUse   | RGB or palette indexes
            ) > 0;
          except
          end;
        end;
    
        function UpdateBitmapFromBytesArrayEx(Bitmap: Vcl.Graphics.TBitmap; Bytes: TByteDynArray; Width, Height, Channels: Integer): Boolean;
        var
          I: Integer;
          Size: Integer;
          SOffset: Integer;
          DOrigin: Pointer;
        begin
          Result := False;
          try
            if Length(Bytes) = 0 then
              Exit;
            if Length(Bytes) <> (Width * Height * Channels) then
              Exit;
            if not Channels in [1, 3] then
              Exit;
            if Bitmap = nil then
              Exit;
    
            Bitmap.Width := Width;
            Bitmap.Height := Height;
            case Channels of
              1: Bitmap.PixelFormat := pf8bit;
              3: Bitmap.PixelFormat := pf24bit;
            end;
    
            SOffset := 0;
            Size := Width * Channels;
            for I := 0 to Height - 1 do
            begin
              DOrigin := Bitmap.ScanLine[I];
              CopyMemory(DOrigin, @Bytes[SOffset], Size);
              Inc(SOffset, Size);
            end;
    
            Result := True;
          except
          end;
        end;
    
      begin
        Result := UpdateBitmapFromBytesArrayEx(ImageBitmap, Bytes, Width, Height, Channels);
        Image.Bitmap.Assign(ImageBitmap);
      end;
    
    begin
      with GetPythonEngine do
      begin
        try
          if PyArg_ParseTuple(args, 'OOiii:update_imgview32_from_bytes', @ImagePyObj, @BytesPyObj, @Width, @Height, @Channels) <> 0 then
          begin
            if ImagePyObj.ob_type.tp_name <> 'ImgView32' then Abort;
            Image := TPyDelphiImgView32(TPyObject(PAnsiChar(ImagePyObj) + SizeOf(PyObject))).DelphiObject;
            if Image = nil then Abort;
    
            ImageBitmap := TPyDelphiImgView32(TPyObject(PAnsiChar(ImagePyObj) + SizeOf(PyObject))).FBitmap;
            if ImageBitmap = nil then Abort;
    
            if BytesPyObj.ob_type.tp_name <> 'bytes' then Abort;
            Bytes := PyBytesAsBytes(BytesPyObj);
            if Bytes = nil then Abort;
            if Length(Bytes) <> (Width * Height * Channels) then Abort;
    
            if not UpdateImg32ViewFromBytesArray(Bytes, Width, Height, Channels) then Abort;
            Result := ReturnTrue;
          end
          else
            Result := ReturnFalse;
        except
          Result := ReturnFalse;
        end;
      end;
    end;
    
    { register the wrappers, the globals and the constants }
    
    type
      TThirdPartiesCtrlsRegistration = class(TRegisteredUnit)
      public
        function Name : string; override;
        procedure RegisterWrappers(APyDelphiWrapper : TPyDelphiWrapper); override;
        procedure DefineFunctions(APyDelphiWrapper : TPyDelphiWrapper); override;
        procedure DefineVars(APyDelphiWrapper : TPyDelphiWrapper); override;
      end;
    
    { TThirdPartiesCtrlsRegistration }
    
    procedure TThirdPartiesCtrlsRegistration.DefineFunctions(APyDelphiWrapper: TPyDelphiWrapper);
    begin
      inherited;
    
      APyDelphiWrapper.RegisterFunction
      (
        PAnsiChar('update_imgview32_from_bytes'),
        UpdateImg32ViewFromBytesArray_Wrapper,
        PAnsiChar('update graphics32 ImgView32 object from bytes array with width, height & channels')
      );
    end;
    
    procedure TThirdPartiesCtrlsRegistration.DefineVars(APyDelphiWrapper: TPyDelphiWrapper);
    begin
      inherited;
    
      // TScrollBarVisibility enum
      APyDelphiWrapper.DefineVar('svAlways',      svAlways);
      APyDelphiWrapper.DefineVar('svHidden',      svHidden);
      APyDelphiWrapper.DefineVar('svAuto',        svAuto);
    end;
    
    function TThirdPartiesCtrlsRegistration.Name: string;
    begin
      Result := 'ThirdPartiesGraphics32';
    end;
    
    procedure TThirdPartiesCtrlsRegistration.RegisterWrappers(APyDelphiWrapper: TPyDelphiWrapper);
    begin
      inherited;
    
      APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiImgView32);
    
      APyDelphiWrapper.EventHandlers.RegisterHandler(TImgMouseEventHandler);
    end;
    
    initialization
      RegisteredUnits.Add(TThirdPartiesCtrlsRegistration.Create);
      System.Classes.RegisterClasses([TImgView32]);
    
    end.

     

    image.thumb.png.f1a160a89fcd288d1ff266a490c251e3.png

    At now frame refresh is very fast and flicker-free.

     


  5. 11 hours ago, pyscripter said:

    TPythonEngine and TPyDelphiWrapper are singleton.  You should not have two in the same application.   Better to add your control wrapper to delphivcl and recompile.

    Following your info, I've created a custom DelphiVCL with third parties VCL objects, and now WORKS perfectly.
    This was the occasion to add your fix for memory leaks on property sets.
    I will test the behavior in the next few days.

    image.thumb.png.1bbf06221d344719a1b3215a2d7507c4.png

     

    Thank you very much for your help!

    • Like 1

  6. Ah, I missed this thing ... so I got the whole structure of my project wrong 😞

     

    So far what I had done:

    - Python program developed with PyScripter.
    - Using DelphiVCL (pip install delphivcl) as the main UI.
    - Using P4D to create a new extension module in Delphi (cnc_vision_ext.pyd) where I added new features and where I "wanted" to add new graphic components as well, eg: TImgView32.

     

    Having the cnc_vision_ext module is due to the need that some features I currently use are only available in Delphi and are not in Python and I wanted to "port" them to Python.

    This module uses its own TPythonEngine, TPythonModule, and TPyDelphiWrapper.

     

    So far it has worked but everything was not foreseen in the P4D structure could it run into malfunctions?

    So far it seems to me everything has worked correctly but with only one trick to add a function that updates an Image (TImage) created in Python with a bytes array that did not recognize the type passed as Delphi and I went around it.

     

    For example in the function update_image_from_bytes -> CncVisionUpdateImageFromBytesArray_Wrapper I've worked around a Image (TImage) created with delphivcl and passed as argument to recover Delphi wrapped object

    and so permits to assign it an image using a byte array containing the bitmap elaborated with Python....

    I hope I have not completely misunderstood how to use DelphiVCL and P4D to add new extra features ...

    cnc_vision_video_ext.zip


  7. Hi all.

     

    To complete my first Python + DelphiVCL program I need to expose to Python an extra Image Viewer Control.

     

    I don't want to create a custom delphivcl.pyd which is a good thing remains original and installable with pip install delphivcl,

    so I've tried to add the component in a custom package.

     

    Well, seems simple to do but does not work fine...

     

    The control to expose is TImgView32 which inherits from:
    TImgView32->TCustomImgView32->TCustomImage32->TCustomPaintBox32->TCustomControl

     

    so it is close to TLabel and looking at DelphiVCL code I've made same steps:

    library cnc_vision_ext;
    
    uses
      osPyCncVisionExt in 'sources\osPyCncVisionExt.pas';
    
    exports
      PyInit_cnc_vision_ext;
    
    {$E pyd}
    
    begin
    end.

     

    unit osPyCncVisionExt;
    
    interface
    
    uses
      PythonEngine;
    
    function PyInit_cnc_vision_ext: PPyObject; cdecl;
    
    implementation
    
    uses
      System.Classes,
      System.SysUtils,
      System.Variants,
      Winapi.Windows,
      Vcl.ExtCtrls,
    
      VarPyth,
      WrapDelphi,
      WrapVclExtCtrls,
      WrapVclControls,
      WrapDelphiClasses,
    
      GR32_Image;
      
    type
      TPyDelphiImgView32 = class(TPyDelphiControl)
      private
        function GetDelphiObject: TImgView32;
        procedure SetDelphiObject(const Value: TImgView32);
      public
        class function DelphiObjectClass: TClass; override;
        property DelphiObject: TImgView32 read GetDelphiObject write SetDelphiObject;
      end;
    
      TPyExtensionManager = class
      private
        FEngine: TPythonEngine;
        FModule: TPythonModule;
        FWrapper: TPyDelphiWrapper;
      public
        procedure WrapperInitializationEvent(Sender: TObject);
      end;
    
    var
      ExtensionManager: TPyExtensionManager;
    
    { module import functions }
    
    function PyInit_cnc_vision_ext: PPyObject;
    begin
      Result := nil;
      try
        ExtensionManager.FEngine := TPythonEngine.Create(nil);
        ExtensionManager.FEngine.AutoFinalize := False;
        ExtensionManager.FEngine.UseLastKnownVersion := True;
        ExtensionManager.FEngine.LoadDllInExtensionModule();
    
        ExtensionManager.FModule := TPythonModule.Create(nil);
        ExtensionManager.FModule.Engine := ExtensionManager.FEngine;
        ExtensionManager.FModule.ModuleName := 'cnc_vision_ext';
    
        ExtensionManager.FWrapper := TPyDelphiWrapper.Create(nil);
        ExtensionManager.FWrapper.Engine := ExtensionManager.FEngine;
        ExtensionManager.FWrapper.Module := ExtensionManager.FModule;
    
        ExtensionManager.FModule.Initialize;
        ExtensionManager.FWrapper.OnInitialization := ExtensionManager.WrapperInitializationEvent;
        ExtensionManager.FWrapper.Initialize;
    
        Result := ExtensionManager.FModule.Module;
      except
      end;
    end;
    
    { TPyDelphiImgView32 }
    
    class function TPyDelphiImgView32.DelphiObjectClass: TClass;
    begin
      Result := TImgView32;
    end;
    
    function TPyDelphiImgView32.GetDelphiObject: TImgView32;
    begin
      Result := TImgView32(inherited DelphiObject);
    end;
    
    procedure TPyDelphiImgView32.SetDelphiObject(const Value: TImgView32);
    begin
      inherited DelphiObject := Value;
    end;
    
    { TPyExtensionManager }
    
    procedure TPyExtensionManager.WrapperInitializationEvent(Sender: TObject);
    begin
      FWrapper.RegisterDelphiWrapper(TPyDelphiImgView32);
    end;
    
    initialization
      ExtensionManager := TPyExtensionManager.Create;
    
    finalization
      ExtensionManager.Free;
    
    end.

    Well, compilation OK and import on Python OK,

    but when I try to create the object assigning the parent I got that:

     

    from delphivcl import *
    from cnc_vision_ext import *
    
    class TestForm(Form):
    
        def __init__(self, owner):
    
            # print type of self ('__main__.TestForm')
            print(type(self))
    
            # create a vcl label and assign parent: WORKS
            self.label = Label(self)
            self.label.Parent = self
            self.label.Left = 10
            self.label.Top = 10
            self.label.Caption = 'Hello World'
    
    
            # create a ext image and assign parent: ERROR
            self.image = ImgView32(self) # <-- AttributeError: Owner receives only Delphi objects
            self.image.Parent = self
            self.image.Left = 10
            self.image.Top = 30
            self.image.Width = 200
            self.image.Height = 100
    
    def main():
        Application.Initialize()
        Application.Title = 'test'
        MainForm = TestForm(Application)
        MainForm.Show()
        FreeConsole()
        Application.Run()
    
    if __name__ == '__main__':
        main()

    image.thumb.png.37d6be3dad92a96e45a9f2da9741085c.pngù

     

    If I check with a Python console the types seem very close:

    D:\x\develop\qem\cnc_vision_1>python
    Python 3.9.12 (tags/v3.9.12:b28265d, Mar 23 2022, 23:52:46) [MSC v.1929 64 bit (AMD64)] on win32
    Type "help", "copyright", "credits" or "license" for more information.
    
    >>> from delphivcl import *
    >>> from cnc_vision_ext import *
    
    >>> frm = Form(None)
    
    >>> lbl = Label(frm)
    >>> lbl.Parent = frm
    
    >>> type(lbl)
    <class 'Label'>
    >>> lbl.__doc__
    'Wrapper for Delphi TLabel\n'
    >>> lbl.ClassName
    'TLabel'
    
    >>> img = ImgView32(frm) # does not work with frm as like as lbl
    Traceback (most recent call last):
      File "<stdin>", line 1, in <module>
    AttributeError: Owner receives only Delphi objects
    
    >>> img = ImgView32(None) # try with none to check object type
    
    >>> type(img)
    <class 'ImgView32'>
    >>> img.__doc__
    'Wrapper for Delphi TImgView32\n'
    >>> img.ClassName
    'TImgView32'


    Thank you in advance for any suggestion 🙂
     


  8. I've tried many SVG implementations in the past.
    At now I'm with SVGIconImageList + Image32.

     

    SVGIconImageList permits you to choose the SVG to render between: Skia4Delphi, Image32, D2D (directdraw), TSVG.

     

    Skia4Delphi is very interesting.
    I already use the skia4python in Python programs and recently I've installed Skia4Delphi in Sydney to draw canvas with its powerful features.

    Same with Image32 which is full native Delphi and extremely powerful.

    Delphi developers definitely can't complain about having few tools in the box.

     


  9. You have to check libraries path in "Options -> Language -> Delphi -> Library" for 32 (default folder) and 64 bits:
    image.thumb.png.26d8cad38f0514c8738c66da8ddeaa27.png

     

    The best thing is to use ALWAYS git-ted sources codes of libraries instead of pre-compiled from Get-it.
    This leaves you knowledge of where sources are and fastly insert your changes.

     


  10. a) YES without any code in __on_timer(...) I  have no memory leaks.
    b) YES if I add any operations with a checkbox in __on_timer() the memory leaks begin.
    c) I've used a const to DISABLE trace malloc os I can exclude that memory-leaks depends by it.
    d) YES the graphical images posted are without the use of trace malloc but are a bird-eye view of the python windows process memory consumption.

    In the test, I've checked only CheckBox.Enabled, to be simple, but in the full project, I've got some memory leaks also in <vcl>.Caption = etc.
    The memory leaks began when I switched from PySimpleGUI to DelphiVCL UI.

    The project uses a lot of DelphiVCL components so, in running time, the memory leak increases a lot.

    A program, at first start, uses 139MB, but after two hours it reaches 700MB or memory usage and trace malloc suggests that is in DelphiVCL.

    In the below video, I try to show the behavior.
    The system is simple.

    An embedded board with a camera, in this case, an RPI4, captures the camera frames and implements a server service to obtain an IP-CAMERA.
    To simplify the case is written in Python.

    A PC program, with Python + DelphiVCL + OpenCV + Skia connects to IP-Camera, gets frames, and applies code to elaborate it.

    In the test code, I've added trace malloc with a first memory snapshot (take_snaphot) at the start.

    When I press the middle button on the frame view I capture a memory snapshot that I compare with the start snapshot to show the top 10 memory consumers.

    It is normal that no VCL objects reach temporary the top because I capture some frames and I take them for future uses but looking on the counter is low.

    What I see is the usage memory and allocated counter increase continuously in some DelphiVCL operations.
    To be honest, I don't know so wheel Python and inners, I've begun to use it some time ago to try to port some apps to Python language on customer request, I'm a Delphi developer.
    So I can have mistakes on how to use tracemalloc to catch memory leaks.
     

    https://www.youtube.com/watch?v=rhUniVnXgEQ


  11. Hi all.

    What I love of Delphi is memory management and overall the integration of FastMM and related memory leak management.

    All my projects are Memory Leak Free (just thanks to reports of FastMM which permits me to create a better code).

     

    Now I'm migrating some programs to Python using DelphiVCL and I'm falling into odd memory leaks.

     

    In a Python (3.9.12) application that uses DelphiVCL (0.1.40) I've noticed a continuous memory leak in some simple operations

    with VCL objects like Checkbox.

     

    I've attached a very simple Python program that uses a Timer to constantly update the Enabled state of a Checkbox.

    In the sample, I've also added a const to enable a tracemalloc and confirm the continue grow of memory used by <Checkbox>.Enabled = True

    # enable/disable tracemalloc to exclude the memory impact of tracemalloc
    TRACEMALLOC_ENABLED = False

     

    By default, TRACEMALLOC_ENABLED is set to False to remove any impact of tracemalloc framework.

    If enabled, the first mouse down on the form capture the BASE snapshot of memory.

    Any following mouse down, report on console the comparison of current snapshot with the first.

    Initially, tracemalloc internals is in the top ten results, but after some time Checkbox1.Enabled = True gain the top.

     

    If I disable the interesting lines, commenting on them, any memory leak disappears:

        def __on_timer(self, sender):
            """
            self.CheckBox1.Enabled = True
            self.CheckBox1.Enabled = True
            self.CheckBox1.Enabled = True
            self.CheckBox1.Enabled = True
            self.CheckBox1.Enabled = True
            self.CheckBox1.Enabled = True
            self.CheckBox1.Enabled = True
            self.CheckBox1.Enabled = True
            self.CheckBox1.Enabled = True
            self.CheckBox1.Enabled = True
            self.CheckBox1.Enabled = True
            self.CheckBox1.Enabled = True
            self.CheckBox1.Enabled = True
            """

    I've placed many CheckBox1.Enabled to exasperate the case-test but usually, I do this for a lot of controls in update events.

     

    This is the memory usage captured with Process Explorer on running Python process with TRACEMALLOC_ENABLED = False:

    image.thumb.png.4330030421ee48cab25c7c9c0ea5800e.png
     

     

     

    test.zip


  12. It is embarrassing but I was not able to set a multiline text in a Button Caption.

    Usually in Delphi is only necessary to:

    MyButton.Caption = 'first line' + #13#10 + 'second line'

    What to get same behaviour in Python + DelphiVCL ?
     


  13. As like as David Heffernan I use the embedded python version for our customers.

    You can install pip in the embedded version so the end-user can add new packages or update packages from whl or Pypi.


    The embedded way is perfect to have an isolated python in which trust to deploy software for end-user.

    For example, my embedded version contains right OpenCV, NumPy, delphivcl/fmx, and support packages that I will use to create the end-user python program

    avoiding any conflicts with different versions already installed in other customer python installations and without use conda, etc.


  14. Actually, I've used the simplest way to send an image to Python, send it completely (header, image structure, data).
    This required a python cv2.imdecode to get back a NumPy array clean of container (GIF/BMP/JPG/PNG/etc).
    You can use GetDIB in Delphi to extract only pure image data (RGB or RGBA), packet it, and return it to python then
    reorganize data in NumPy without the use of cv2.imdecode.

    TAKE CARE
    =======
    In your time test for ByteIO, you have an overhead of cv2.imdecode....
    Try without it.


  15. Attached to the post there is a very simple Delphi application that should help you.

    The demo creates a PythonEngine and adds a new Module called delphi_vcl_ext in which
    wraps two functions:

    get_loaded_image_as_bytes()    # get delphi loaded image as bytes
    update_image_from_bytes(...)   # update delphivcl Image object from bytes array with width, height & channels

    The program has two panels:
    - Left Panel is a TImage and shows the loaded image to transfer to the Python script.
    - Right Panel is a TImage to show the python script evaluated image.

    By default, the program preloads a test BMP file (640x480 so fits the left image panel).
    Default script:
    - Get Delphi loaded image using get_loaded_image_as_byte().
    - Decode the image to a NumPy array.
    - Apply an automatic canny filter.
    - Send back to Delphi the resulting image to be shown in the right panel.

    The time to transfer images is shown in the right log panel.
    With Load Image, you can try other files but must be supported by the TImage component.
    After all, is only a demo code made for you during rest time.
     

    Take care
    If you call script in a Delphi Thread you can't write python sent image directly in a TImage, or in
    any VCL component but use rightly Thread.Synchronized method to be done in the main thread.

     

    image.thumb.png.7c771dac24ef572e12de5ea182104524.png

     

    delphi_python_001.7z


  16. I've to move IMemento and IPersistable to JSON.
    I've already made that in Python and moving to Delphi should be simple.

    At moment I cannot do that, current project timings.....

    cnc_memento.py

    Delphi, Sydeny in my case, have a full JSON support.

    Here an example of element read to compare with python way....
    Delphi JSON is very close to dict in python and so to related python json:

     

    function TAPITCPEngineClient.GetAxesInfo: TAPIAxesInfo;
    var
      Request: string;
      Response: string;
      JSONValue: TJSONValue;
    begin
      try
        if not GetActive then AbortFast;
        Result.Init;
        Request := '{"get":"axes.info"}';
        Response := SendCommand(Request);
        if Response = '' then Exit;
        JSONValue := TJSONObject.ParseJSONValue(Response);
        try
          if not (JSONValue is TJSONObject) then Exit;
          if not JSONValue.TryGetValue<TAPIAxesArray>('["res"]["joint.position"]', Result.JointPosition.V) then AbortFast;
          if not JSONValue.TryGetValue<TAPIAxesArray>('["res"]["machine.position"]', Result.MachinePosition.V) then AbortFast;
          if not JSONValue.TryGetValue<TAPIAxesArray>('["res"]["program.position"]', Result.ProgramPosition.V) then AbortFast;
          if not JSONValue.TryGetValue<TAPIAxesArray>('["res"]["machine.target.position"]', Result.MachineTargetPosition.V) then AbortFast;
          if not JSONValue.TryGetValue<TAPIAxesArray>('["res"]["program.target.position"]', Result.ProgramTargetPosition.V) then AbortFast;
          if not JSONValue.TryGetValue<TAPIAxesSpeedArray>('["res"]["actual.velocity"]', Result.ActualVelocity.V) then AbortFast;
          if not JSONValue.TryGetValue<Cardinal>('["res"]["working.wcs"]', Result.WorkingWCS) then AbortFast;
          if not JSONValue.TryGetValue<TAPIAxesArray>('["res"]["working.offset"]', Result.WorkingOffset.V) then AbortFast;
          if not JSONValue.TryGetValue<Boolean>('["res"]["homing.done"]', Result.HomingDone) then AbortFast;
          if not JSONValue.TryGetValue<Cardinal>('["res"]["homing.done.mask"]', Result.HomingDoneMask) then AbortFast;
          Result.HasData := True;
        finally
          JSONValue.Free;
        end;
      except
        Result.Init;
      end;
    end;

    JSon is simplest than XML but more readable.
     


  17. 7 hours ago, Andrzej said:

    I try use osMemento;

    I have problems with other because I need library for both: old a new Delphi.

    osMemento is OK, I have already converted binary->xml for files of report definition

    Usually, I use osMemento with BDS2006 (which is IDENTICAL to Delphi7) and Sydney.
    MSXML DOM is also very fast.

    With latest software, however, I'm migrating my settings files to JSON so I can open them
    in Python, where I've another implementation of Memento very close to Delphi version but for JSON.


  18. CreateChild creates a new child empty node overwriting the eventual existent node.
    CreateChildSmart at first check if the child already exists and return it, maintaining contents otherwise it creates a new one.

    PS: I've missed a unit in git:
    osExceptionUtils.pas

    osExceptionsUtils add a new fast Abort (AbortFast) that I use often, but in source, you can replace any AbortFast with a native Abort.


  19. If compile for Windows you can use MSXML directly to load/get/set/DOM and save.

    Here you can find how I use MSXML with Delphi implementing a light version of the Memento pattern:

    https://github.com/shineworld/memento

    Example of use in a system to load/save recently opened files:

    unit osMRUManager;
    
    interface
    
    uses
      osIMemento;
    
    type
      TMRUManager = class
      private
        FBackupPath: string;
        FCount: Integer;
        FItems: array of string;
        FMaxItems: Integer;
      private
        function GetItems(Index: Integer): string;
        procedure SetMaxItems(Value: Integer);
      public
        procedure Clear;
        procedure Delete(Index: Integer);
        function LoadFromFile(const FileName: string): Boolean;
        function LoadFromMemento(Memento: IMemento): Boolean;
        procedure Push(const Item: string);
        function SaveToFile(const FileName: string): Boolean;
        function SaveToMemento(Memento: IMemento): Boolean;
        procedure ValidateItems;
      public
        constructor Create;
      public
        property BackupPath: string read FBackupPath write FBackupPath;
        property Count: Integer read FCount;
        property Items[Index: Integer]: string read GetItems;
        property MaxItems: Integer read FMaxItems write SetMaxItems;
      end;
    
    implementation
    
    uses
      System.SysUtils,
    
      osIPersistable,
    
      osXMLMemento,
      osExceptionUtils;
    
    const
      DEF_MAX_ITEMS = 8;
    
    constructor TMRUManager.Create;
    begin
      // sets default members values
      FBackupPath := '';
      FCount := 0;
      FItems := nil;
      FMaxItems := 0;
    
      // sets initial max items
      MaxItems := DEF_MAX_ITEMS;
    end;
    
    procedure TMRUManager.Delete(Index: Integer);
    var
      I: Integer;
    begin
      if (Index < 0) or (Index >= FMaxItems) then Exit;
      if (Index >= FCount) then Exit;
      for I := Index to FCount - 2 do
        FItems[I] := FItems[I + 1];
      FItems[FCount - 1] := '';
      Dec(FCount);
    end;
    
    procedure TMRUManager.Clear;
    begin
      FCount := 0;
    end;
    
    function TMRUManager.GetItems(Index: Integer): string;
    begin
      if (Index < 0) or (Index >= Count) then
        Result := ''
      else
        Result := FItems[Index];
    end;
    
    function TMRUManager.LoadFromFile(const FileName: string): Boolean;
    var
      Memento: IMemento;
      BackupFileName: string;
    
      function GetBackupFileName: string;
      begin
        try
          if FBackupPath = '' then AbortFast;
          if not DirectoryExists(FBackupPath) then AbortFast;
          Result := FBackupPath + ExtractFileName(FileName);
        except
          Result := '';
        end;
      end;
    
      function InternalLoadFromFile(const FileName: string): Boolean;
      begin
        try
          Memento := CreateReadRoot(FileName);
          if Memento = nil then AbortFast;
          if Memento.GetName <> 'mru_root' then AbortFast;
          if not LoadFromMemento(Memento) then AbortFast;
          Result := True;
        except
          Result := False;
        end;
      end;
    
    begin
      Clear;
      try
        BackupFileName := GetBackupFileName;
        Result := InternalLoadFromFile(FileName);
        if Result then
        begin
          if BackupFileName <> '' then SaveToFile(BackupFileName);
          Exit;
        end;
        Result := InternalLoadFromFile(BackupFileName);
        if not Result then AbortFast;
        SaveToFile(FileName);
        Result := True;
      except
        Clear;
        Result := False;
      end;
    end;
    
    function TMRUManager.LoadFromMemento(Memento: IMemento): Boolean;
    var
      I: Integer;
      W: TXMLString;
      MainNode: IMemento;
      FileNodes: IMementoArray;
    begin
      Clear;
      try
        MainNode := Memento.GetChild('mru');
        if MainNode = nil then AbortFast;
        FileNodes := MainNode.GetChildren('file');
        if FileNodes = nil then AbortFast;
        if Length(FileNodes) > MaxItems then AbortFast;
        FCount := Length(FileNodes);
        for I := 0 to FCount - 1 do
        begin
          if not FileNodes[I].GetString('name', W) then AbortFast;
          FItems[I] := W;
        end;
        Result := True;
      except
        Clear;
        Result := False;
      end;
    end;
    
    procedure TMRUManager.Push(const Item: string);
    var
      I: Integer;
      J: Integer;
    begin
      for I := 0 to FCount - 1 do
      begin
        if FItems[I] = Item then
        begin
          if I = 0 then Exit;
          for J := I downto 1 do
            FItems[J] := FItems[J - 1];
          FItems[0] := Item;
          Exit;
        end;
      end;
      if FCount < FMaxItems then
        Inc(FCount);
      for I := FCount - 1 downto 1 do
        FItems[I] := FItems[I - 1];
      FItems[0] := Item;
    end;
    
    function TMRUManager.SaveToFile(const FileName: string): Boolean;
    var
      Memento: IMemento;
      BackupFileName: string;
    
      function GetBackupFileName: string;
      begin
        try
          if FBackupPath = '' then AbortFast;
          if not DirectoryExists(FBackupPath) then AbortFast;
          Result := FBackupPath + ExtractFileName(FileName);
        except
          Result := '';
        end;
      end;
    
      function InternalSaveToFile(const FileName: string): Boolean;
      begin
        try
          Memento := CreateWriteRoot('mru_root');
          if not SaveToMemento(Memento) then AbortFast;
          if not (Memento as IPersistable).SaveToFile(FileName, nrmd_UTF8, False) then AbortFast;
          Result := True;
        except
          Result := False;
        end;
      end;
    
    begin
      try
        BackupFileName := GetBackupFileName;
        if not InternalSaveToFile(FileName) then AbortFast;
        if BackupFileName <> '' then InternalSaveToFile(BackupFileName);
        Result := True;
      except
        Result := False;
      end;
    end;
    
    function TMRUManager.SaveToMemento(Memento: IMemento): Boolean;
    var
      I: Integer;
      Node: IMemento;
      MainNode: IMemento;
    begin
      try
        MainNode := Memento.CreateChildSmart('mru');
        for I := 0 to Count - 1 do
        begin
          Node := MainNode.CreateChild('file');
          Node.PutString('name', FItems[I]);
        end;
        Result := True;
      except
        Result := False;
      end;
    end;
    
    procedure TMRUManager.SetMaxItems(Value: Integer);
    var
      I: Integer;
    begin
      if FMaxItems = Value then Exit;
      SetLength(FItems, Value);
      for I := FMaxItems to Value - 1 do
        FItems[I] := '';
      FMaxItems := Value;
      if FCount > FMaxItems then
        FCount := FMaxItems;
    end;
    
    procedure TMRUManager.ValidateItems;
    var
      I: Integer;
    begin
      I := FCount - 1;
      while I >= 0 do
      begin
        if not FileExists(FItems[I]) then
          Delete(I);
        Dec(I);
      end;
    end;
    
    end.

     


  20. On 5/6/2022 at 6:47 PM, SwiftExpat said:

    Your UI looks good and I think it is interesting to extend via python.

    You should be Embarcadero's case study 🙂

    Could be interesting, to have time to write something about....
    Natively the Delphi project is around 10 million lines and with the introduction of expandability via Python I don't know where it will end 🙂

    Fortunately, in an I7, Delphi is so fast that it takes just over 3 minutes to compile the whole project.
    In another language, I could go for a quick lunch.

    image.thumb.png.71b0d76cfe2ff5d8ab2276349357ecd2.png

     

     


  21. I work in a company that makes control boards for CNC and related control environments on PC, but I don't physically own a CNC 🙂

    However, we also drive 5-axis CNCs and more.
     

    The PC control part has always been done with Delphi and I couldn't be happier.
    I have abandoned other development environments and find that as fast and productive as Delphi there is no other, at least for this sector.
     

    I work in software/firmware development for embedded boards and proprietary real-time OS but in recent years most of my time is spent with my nose in Delphi pascal 🙂 
    I'm starting to get old to still work with assembler and C...
     

×