-
Content Count
350 -
Joined
-
Last visited
-
Days Won
4
Everything posted by shineworld
-
In my projects, I use dxgettext with PoEdit pro, which creates an internal net DBase of translated terms, so any old translation, made by me or my colleagues can be fastly re-used. It also permits auto-translations using Microsoft Translation tools, Deepl (if you have a pro account), etc. It has also a free version so end-customers can translate the programs to their native language with total autonomy, because gettext translations are in extern .mo files (but can also be embedded in the EXE if you want).
-
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!
-
Thanks for the suggestion I will go and look at it. There is another aspect behind the scenes about the choice to use Python. In the whole office the only one who uses and knows Delphi and object pascal is me, while my colleagues have been using Python for support projects for a long time already, so creating a framework that is based on Python + extra extensions made ad hoc with Delphi allows me to relieve myself from future work on the Vision compartment to devote myself to something else. This is the reason why, when I can, I prefer to create tools that others use and not take a complete, specific project all the way through. My mathematical background, compared to that of some of the team members, is basic, and they in python will surely be able to solve more elegantly and efficiently cases where my limitations will only get in the way.
-
Sincerely, I've used an embedded version of Python with minimal packages installed, and the required files are few. In Embarcadero GitHub repositories you can find a distro ready to be used. No anaconda, conda, or virtual environment. Just point to python dll with P4D and the joke is made. You can also avoid calling a pure py script ad use Embarcadero P4D-Data-Sciences, PythonEnvironments and Lightweight-Python-Wrappers and remain always on the Delphi project. For markers detection, you can always extract the math and logic of FindContours HougCircles. etc from OpenCV sources, as suggested by the name they are open but you have to use something like to NumPy. I don't like re-invent the wheel when it is already done so I've discarded the idea to re-write all math in pure pascal code, although the related math (find counters, HougCircles, etc) is very simple, but very well implemented in OpenCV. What they have done in embarcadero with P4D and related tools is very important and allows them not to reinvent hot water by going direct to the use of tools born for scientific purposes.
-
Surely, I'm 53 years old.
-
Yes, I've used OpenCV features to detect markers but my CNC Vision framework is born and designed to do more other. I'm already working on a system which use TensorFlow for more complex image objects detection where Delphi will do things hard to do natively in python.
-
My First P4D was completed and released π Thanks to the developers of PyScripter and P4D for these amazing tools.
-
This, I believe, is due to the fact that the IDE developers, in order to keep the huge amount of threads, timers, etc. needed by the development environment more responsive, have forced the Windows timeCAPS down from the default values (about 50ms) to the lowest possible values, so as to achieve greater accuracy in the timers. Some time ago I wasted a lot of hours on this myself. I used to run a program from IDE and it was faster than when IDE was not active in memory. As long as it was active, any program would run better, even if not launched from it. From here I realized that the IDE was changing something in the operating system. I tried to make a program that read timeCAPS with IDE active (they are system and not process) and with IDE active it gave me 1ms, without IDE active 50ms π In my applications I force too, obtaining the same times (precision) of timeGetTime and GetTickCount or precision in TThread.Sleep when I run WITH IDE in run o without IDE: uses MMSystem; ; use this option to disable the force of timer precision {$DEFINE USES_TIME_BEGIN_END_PERIOD} var {$IFDEF USES_TIME_BEGIN_END_PERIOD} TimeCaps: TTimeCaps; NeedToChangeTimerPrecsion: Boolean; {$ENDIF} ... other global values procedure PrecisionTimersStart: begin {$IFDEF USES_TIME_BEGIN_END_PERIOD} // starts high precision timer if timeGetDevCaps(@TimeCaps, SizeOf(TTimeCaps)) = TIMERR_NOERROR then NeedToChangeTimerPrecsion := timeBeginPeriod(TimeCaps.wPeriodMin) = TIMERR_NOERROR; {$ENDIF} end; procedure PrecisionTimersEnd: begin {$IFDEF USES_TIME_BEGIN_END_PERIOD} // stops high precision timer if NeedToChangeTimerPrecsion then timeEndPeriod(TimeCaps.wPeriodMin); {$ENDIF} end; Just call PrecisionTimersStart at program START, eg in dpk code, and call PrecisionTimersStop when the program ends.
-
GetLastError() is a typical Win32 API function to get the latest error in an API call from OS.
-
I could easily be proven wrong; I haven't looked into this very deeply, but from what I make of the 32- and 64-bit versions of the applications, it seems to me that the 64-bit version gains a few percent in performance. The projects are complex and use a lot of memory and graphics, including 3D, but running both exe's, the 64-bit one gives me a better time log. Debugging in 64-bit, however, is more difficult because of constant IDE crashes (10.4.1 at the moment).
-
My 10 cents... I have currently abandoned the idea of using FreePascal with x86/x64 Linux environments pending how Delphi's native support for Linux will evolve. Since I have the professional version, which does not support Linux, I am waiting to see in the next versions what will happen on ARM support, and whether to migrate to the fuller version and update my entire dev system (at moment is 10.4.1). For embedded, ARM-based Linux systems, Freepascal + Lazarus is currently a solution that I use occasionally, and although it is very limited compared to Delphi it keeps me in a fairly well-known language/library. LCL is not comparable to VCL but for small things in the hostile world of ARM, it may be okay for the time being.
-
IMO: I've tried to run, after some changes because two languages are not fully compatible, a Delphi program to Lazarus, for Windows (my idea is to move some apps to Linux). The performances of Lazarus compiled code are lower than Delphi compiled. I've tried to move GLScene so 3D UI with bad results when compared, but working. I've never tried then to move it to Linux using FreePascal.
-
So the question is ? Do you want to run the script using only python + delphivcl and send image to its TImage, or run the script inner a Delphi application, which "share" a TImage object exposed as custom python module so the script place image elaboration result on that ?
-
We need to know the structure of all. 1] A Delphi program which call a Python Script? 2] The python script that captures/elaborates image in an infinite loop? 3] The python script that sends back the elaborated image? It is hard to reply to your question without knowing your project structure.
-
OpenCV's video source backends (CAP_MSMF and CAP_DSHOW) are rather limited and chaotic in CAP properties. Often CAP_MSMF raises internal exceptions, although recommended over CAP_DSHOW. For example, there is no way, unless you get your hands on the code, to directly access the webcam driver supported properties list and range/defaults, which the backend retrieves internally anyway. If you use Python solely to capture a video stream better to act directly with the Windows DirectShow or similar new interfaces. There are examples of how to do this in github.
-
I still have a lot of 32-bit applications and often found myself with memory problems because of the 2GB maximum limitation per project. By keeping the application 32-bit you can add another GB to the available ram via FASTMM4 using {$SetPEFlags $20}. Example: program myprogram; uses {$IFDEF CPUX86} {$SetPEFlags $20} {$ENDIF} FastMM4 in 'sources\memory-managers\FastMM4-4.992\FastMM4.pas', FastMM4Messages in 'sources\memory-managers\FastMM4-4.992\FastMM4Messages.pas', ...projects files I'm using wonderful FastMM4 from pleriche: https://github.com/pleriche/FastMM4 Intervention in the code is as simple as checking whether there are actual benefits to the application. In my case SynEdit without {$SetPEFlags $20} and FastMM can load 1.5 million lines but with the patch can reach 4 million lines. That application gain per-processes extra memory when executed on a 64-bit windows OS. https://stackoverflow.com/questions/1849344/how-can-i-enable-my-32-bit-delphi-application-to-use-4gb-of-memory-on-64-bit-win
-
Is there buffered Memory stream implementation available
shineworld replied to Tommi Prami's topic in RTL and Delphi Object Pascal
TMemoryStream https://docwiki.embarcadero.com/Libraries/Sydney/en/System.Classes.TMemoryStream -
I would like to have a Delphi version to work with ARM/Linux overall on Raspberry PI and clones. In industry, a lot of embedded ARM-based SOMs are developed with C++ or Python (QT on under the hood), overall for UI parts, but Delphi power could change the trends. I've tried FreePascal + Lazarus but is very messy...
-
how to flush buffers on Indy components
shineworld replied to al17nichols's topic in Network, Cloud and Web
Sorry I've missed part "socket disconnected"... sorry again -
how to flush buffers on Indy components
shineworld replied to al17nichols's topic in Network, Cloud and Web
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. -
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!
-
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() ΓΉ 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 π
-
Add an extra Delphi Control in a new package
shineworld replied to shineworld's topic in Python4Delphi
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. At now frame refresh is very fast and flicker-free. -
Add an extra Delphi Control in a new package
shineworld replied to shineworld's topic in Python4Delphi
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. Thank you very much for your help! -
Add an extra Delphi Control in a new package
shineworld replied to shineworld's topic in Python4Delphi
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