Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 6 additions & 2 deletions Packages/Delphi/Delphi 10.4+/PythonVcl.dpk
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,9 @@ requires
rtl,
vcl,
Python,
VclSmp;
VclSmp,
vclimg,
vclwinx;

contains
Vcl.PythonGUIInputOutput in '..\..\..\Source\vcl\Vcl.PythonGUIInputOutput.pas',
Expand All @@ -49,6 +51,8 @@ contains
WrapVclGraphics in '..\..\..\Source\vcl\WrapVclGraphics.pas',
WrapVclGrids in '..\..\..\Source\vcl\WrapVclGrids.pas',
WrapVclSamplesSpin in '..\..\..\Source\vcl\WrapVclSamplesSpin.pas',
WrapVclStdCtrls in '..\..\..\Source\vcl\WrapVclStdCtrls.pas';
WrapVclStdCtrls in '..\..\..\Source\vcl\WrapVclStdCtrls.pas',
WrapVclWinXCtrls in '..\..\..\Source\vcl\WrapVclWinXCtrls.pas',
WrapVclThemes in '..\..\..\Source\vcl\WrapVclThemes.pas';

end.
123 changes: 120 additions & 3 deletions Source/fmx/WrapFmxForms.pas
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,8 @@ interface

uses
System.Classes, System.SysUtils, FMX.Forms,
PythonEngine, WrapFmxTypes, WrapDelphiClasses, WrapFmxControls;
PythonEngine, WrapFmxTypes, WrapDelphiClasses, WrapFmxControls, WrapDelphi,
System.TypInfo, System.UITypes;

type
TPyDelphiApplication = class(TPyDelphiComponent)
Expand All @@ -20,6 +21,24 @@ TPyDelphiApplication = class(TPyDelphiComponent)
property DelphiObject: TApplication read GetDelphiObject write SetDelphiObject;
end;

TCloseQueryEventHandler = class(TEventHandler)
protected
procedure DoEvent(Sender: TObject; var CanClose : Boolean);
public
constructor Create(PyDelphiWrapper : TPyDelphiWrapper; Component : TObject;
PropertyInfo : PPropInfo; Callable : PPyObject); override;
class function GetTypeInfo : PTypeInfo; override;
end;

TCloseEventHandler = class(TEventHandler)
protected
procedure DoEvent(Sender: TObject; var Action: TCloseAction);
public
constructor Create(PyDelphiWrapper : TPyDelphiWrapper; Component : TObject;
PropertyInfo : PPropInfo; Callable : PPyObject); override;
class function GetTypeInfo : PTypeInfo; override;
end;

TPyDelphiCommonCustomForm = class(TPyDelphiFmxObject)
private
function GetDelphiObject: TCommonCustomForm;
Expand Down Expand Up @@ -93,7 +112,7 @@ EInvalidFormClass = class(Exception);
implementation

uses
WrapDelphi, System.Types;
System.Types;

{ Register the wrappers, the globals and the constants }
type
Expand Down Expand Up @@ -137,6 +156,9 @@ procedure TFormsRegistration.RegisterWrappers(
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiForm);
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiFrame);
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiScreen);

APyDelphiWrapper.EventHandlers.RegisterHandler(TCloseQueryEventHandler);
APyDelphiWrapper.EventHandlers.RegisterHandler(TCloseEventHandler);
end;

{ TPyDelphiApplication }
Expand All @@ -156,6 +178,101 @@ procedure TPyDelphiApplication.SetDelphiObject(const Value: TApplication);
inherited DelphiObject := Value;
end;

{ TCloseQueryEventHandler }

constructor TCloseQueryEventHandler.Create(PyDelphiWrapper: TPyDelphiWrapper;
Component: TObject; PropertyInfo: PPropInfo; Callable: PPyObject);
var
LMethod : TMethod;
begin
inherited;
LMethod.Code := @TCloseQueryEventHandler.DoEvent;
LMethod.Data := Self;
SetMethodProp(Component, PropertyInfo, LMethod);
end;

procedure TCloseQueryEventHandler.DoEvent(Sender: TObject;
var CanClose: Boolean);
var
LPyObject, LPyTuple, LPyResult, LPyCanClose : PPyObject;
LVarParam : TPyDelphiVarParameter;
begin
Assert(Assigned(PyDelphiWrapper));
if Assigned(Callable) and PythonOK then
with GetPythonEngine do begin
LPyObject := PyDelphiWrapper.Wrap(Sender);
LPyCanClose := CreateVarParam(PyDelphiWrapper, CanClose);
LVarParam := PythonToDelphi(LPyCanClose) as TPyDelphiVarParameter;
LPyTuple := PyTuple_New(2);
GetPythonEngine.PyTuple_SetItem(LPyTuple, 0, LPyObject);
GetPythonEngine.PyTuple_SetItem(LPyTuple, 1, LPyCanClose);
try
LPyResult := PyObject_CallObject(Callable, LPyTuple);
if Assigned(LPyResult) then
begin
Py_DECREF(LPyResult);
CanClose := PyObject_IsTrue(LVarParam.Value) = 1;
end;
finally
Py_DECREF(LPyTuple);
end;
CheckError;
end;
end;

class function TCloseQueryEventHandler.GetTypeInfo: PTypeInfo;
begin
Result := System.TypeInfo(TCloseQueryEvent);
end;

{ TCloseEventHandler }

constructor TCloseEventHandler.Create(PyDelphiWrapper: TPyDelphiWrapper;
Component: TObject; PropertyInfo: PPropInfo; Callable: PPyObject);
var
LMethod : TMethod;
begin
inherited;
LMethod.Code := @TCloseEventHandler.DoEvent;
LMethod.Data := Self;
SetMethodProp(Component, PropertyInfo, LMethod);
end;

procedure TCloseEventHandler.DoEvent(Sender: TObject; var Action: TCloseAction);
var
LPyObject, LPyTuple, LPyResult, LPyAction : PPyObject;
LVarParam : TPyDelphiVarParameter;
begin
Assert(Assigned(PyDelphiWrapper));
if Assigned(Callable) and PythonOK then
with GetPythonEngine do begin
LPyObject := PyDelphiWrapper.Wrap(Sender);
LPyAction := CreateVarParam(PyDelphiWrapper, NativeInt(Action));
LVarParam := PythonToDelphi(LPyAction) as TPyDelphiVarParameter;
LPyTuple := PyTuple_New(2);
GetPythonEngine.PyTuple_SetItem(LPyTuple, 0, LPyObject);
GetPythonEngine.PyTuple_SetItem(LPyTuple, 1, LPyAction);
try
LPyResult := PyObject_CallObject(Callable, LPyTuple);
if Assigned(LPyResult) then
begin
Py_DECREF(LPyResult);
if PyLong_Check(LVarParam.Value) and
CheckEnum('TCloseAction', PyLong_AsLong(LVarParam.Value), Ord(Low(TCloseAction)), Ord(High(TCloseAction))) then
Action := TCloseAction(PyLong_AsLong(LVarParam.Value));
end;
finally
Py_DECREF(LPyTuple);
end;
CheckError;
end;
end;

class function TCloseEventHandler.GetTypeInfo: PTypeInfo;
begin
Result := System.TypeInfo(TCloseEvent);
end;

{ TPyDelphiCommonCustomForm }

function TPyDelphiCommonCustomForm.CreateComponent(
Expand Down Expand Up @@ -312,7 +429,7 @@ procedure TPyDelphiScreen.SetDelphiObject(const Value: TScreen);
inherited DelphiObject := Value;
end;

initialization
Initialization
RegisteredUnits.Add(TFormsRegistration.Create);

end.
4 changes: 3 additions & 1 deletion Source/vcl/WrapDelphiVCL.pas
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,8 @@ implementation
WrapVclExtCtrls,
WrapVclButtons,
WrapVclGrids,
WrapVclSamplesSpin;
WrapVclSamplesSpin,
WrapVclWinXCtrls,
WrapVclThemes;

end.
28 changes: 28 additions & 0 deletions Source/vcl/WrapVclComCtrls.pas
Original file line number Diff line number Diff line change
Expand Up @@ -103,6 +103,16 @@ TPyDelphiPageControl = class (TPyDelphiWinControl)
property DelphiObject: TPageControl read GetDelphiObject write SetDelphiObject;
end;

TPyDelphiTrackBar = class (TPyDelphiWinControl)
private
function GetDelphiObject: TTrackBar;
procedure SetDelphiObject(const Value: TTrackBar);
public
class function DelphiObjectClass : TClass; override;
// Properties
property DelphiObject: TTrackBar read GetDelphiObject write SetDelphiObject;
end;

implementation

uses
Expand Down Expand Up @@ -137,6 +147,7 @@ procedure TComCtrlsRegistration.RegisterWrappers(APyDelphiWrapper: TPyDelphiWrap
{$ENDIF FPC}
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiPageControl);
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiTabSheet);
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiTrackBar);

APyDelphiWrapper.EventHandlers.RegisterHandler(TTabChangingEventHandler);
end;
Expand Down Expand Up @@ -613,6 +624,23 @@ class function TTabChangingEventHandler.GetTypeInfo: PTypeInfo;
Result := System.TypeInfo(TTabChangingEvent);
end;

{ TPyDelphiTrackBar }

class function TPyDelphiTrackBar.DelphiObjectClass: TClass;
begin
Result := TTrackBar;
end;

function TPyDelphiTrackBar.GetDelphiObject: TTrackBar;
begin
Result := TTrackBar(inherited DelphiObject);
end;

procedure TPyDelphiTrackBar.SetDelphiObject(const Value: TTrackBar);
begin
inherited DelphiObject := Value;
end;

initialization
RegisteredUnits.Add( TComCtrlsRegistration.Create );
{$IFNDEF FPC}
Expand Down
Loading