diff options
Diffstat (limited to 'libgtk_kylix/GTKForms.pas')
| -rw-r--r-- | libgtk_kylix/GTKForms.pas | 115 |
1 files changed, 20 insertions, 95 deletions
diff --git a/libgtk_kylix/GTKForms.pas b/libgtk_kylix/GTKForms.pas index 7c01b58..ad6e335 100644 --- a/libgtk_kylix/GTKForms.pas +++ b/libgtk_kylix/GTKForms.pas @@ -23,13 +23,9 @@ unit GTKForms; interface -uses lazglib2, lazgobject2, lazgdk3, lazgtk3, Classes, SysUtils, GTKControls, GTKConsts; - -type // Some basic types - PCharArray = array[0..0] of PChar; - - __pthread_t = {$ifdef cpu64}QWord{$else}DWord{$endif}; +uses lazglib2, lazgobject2, lazgdk3, lazgtk3, Classes, SysUtils, UnixType, GTKControls, GTKConsts; +type TCustomGTKForm = class; (****************************************** TGDKSCREEN **************************************************************************) @@ -174,18 +170,14 @@ type // Some basic types FOnException: TExceptionEvent; FMainForm: TCustomGTKForm; FMainFormSet: Boolean; - FThreadID: __pthread_t; + FThreadID: pthread_t; procedure Quit; - protected - procedure CreateHandle; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure ControlDestroyed(Control: TGTKControl); procedure CreateForm(InstanceClass: TComponentClass; var Reference); // procedure HandleException(Sender: TObject); - procedure HandleMessage; - procedure HookSynchronizeWakeup; procedure Initialize; function MessageBox(const Text: string; Buttons: TMessageButtons = [mbOK]; Style: TMessageStyle = mbInfo; Default: TMessageButton = mbNone; Escape: TMessageButton = mbNone): TMessageButton; overload; @@ -195,23 +187,22 @@ type // Some basic types procedure Run; // procedure ShowException(E: Exception); procedure Terminate; - procedure UnhookSynchronizeWakeup; property MainForm: TCustomGTKForm read FMainForm; property Terminated: Boolean read FTerminated; property OnException: TExceptionEvent read FOnException write FOnException; published - property ThreadID: __pthread_t read FThreadID; + property ThreadID: pthread_t read FThreadID; end; { Global objects } -var Application: TGTKApplication; - Screen: TGDKScreen; +var Application: TGTKApplication = nil; + Screen: TGDKScreen = nil; function GetParentForm(Control: TGTKControl): TCustomGTKForm; - - +procedure InitGTK(); + (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) @@ -348,7 +339,7 @@ end; procedure TCustomGTKForm.FormCreate(Sender: TObject); begin - // Dummy procedure, override it in ordinary instance if needed + inherited; end; procedure TCustomGTKForm.SetCaption(Value: string); @@ -522,29 +513,9 @@ begin Classes.ApplicationHandleException := @HandleException; if not Assigned(Classes.ApplicationShowException) then Classes.ApplicationShowException := @ShowException;} - CreateHandle; - HookSynchronizeWakeup; FThreadID := 0; end; -procedure TGTKApplication.CreateHandle; -var argc: gint; - argv: PPgchar; - i: Integer; -begin - argc := ParamCount; - argv := g_malloc0(argc * sizeof(Pointer)); - for i := 0 to argc - 1 do - argv[i] := g_strdup(PChar(ParamStr(i))); - - // Initialize the widget set - gtk_init(@argc, @argv); - - for i := 0 to argc - 1 do - g_free(argv[i]); - g_free(argv); -end; - destructor TGTKApplication.Destroy; type TExceptionEvent = procedure (E: Exception) of object; @@ -552,7 +523,7 @@ var P: TNotifyEvent; E: TExceptionEvent; begin -{ UnhookSynchronizeWakeup; +{ P := @HandleException; if @P = @Classes.ApplicationHandleException then Classes.ApplicationHandleException := nil; @@ -563,22 +534,6 @@ begin inherited Destroy; end; -procedure TGTKApplication.HookSynchronizeWakeup; -begin -{ if not Assigned(Classes.WakeMainThread) then - Classes.WakeMainThread := WakeMainThread; } -end; - -procedure TGTKApplication.UnhookSynchronizeWakeup; -var - P: TNotifyEvent; -begin -{ P := WakeMainThread; - if @P = @Classes.WakeMainThread then - Classes.WakeMainThread := nil; -} -end; - { procedure TGTKApplication.HandleException(Sender: TObject); begin @@ -613,7 +568,6 @@ begin // a splash screen. This allows applications that don't use CreateForm to // still have a main form but preserve the semantics the first CreateForm // being the main form. -{ TCustomGTKForm(Instance).HandleNeeded; } FMainForm := TCustomGTKForm(Instance); { if TForm(Instance).ActiveControl = nil then TForm(Instance).SetFocusedControl(TForm(Instance));} @@ -631,46 +585,14 @@ procedure TGTKApplication.Initialize; begin end; -// function GetCurrentThreadID: Integer; external 'libpthread.so.0' name 'pthread_self'; - procedure TGTKApplication.ProcessMessages; begin while WordBool(gtk_events_pending) do gtk_main_iteration; - // QApplication_processEvents(Handle); -{ if GetCurrentThreadID = Integer(MainThreadID) then - CheckSynchronize; } end; -procedure TGTKApplication.HandleMessage; -begin -// QApplication_processOneEvent(Handle); -{ if GetCurrentThreadID = Integer(MainThreadID) then - CheckSynchronize; } -end; - -procedure _exit(status: longint); cdecl; external 'libc.so.6' name '_exit'; -function __pthread_self: __pthread_t; cdecl; external 'libpthread.so.0' name 'pthread_self'; - procedure TGTKApplication.Run; begin - gtk_main(); - -{ repeat - try -// gdk_threads_enter; - FThreadID := __pthread_self(); - gtk_main(); -// gdk_threads_leave; - except - on E : Exception do - if E is EControlC then begin - WriteLn('*** Exception: ', E.Message); - _exit(1); - Exit; - end else HandleException(E); - end; - until Terminated; - } + gtk_main(); end; function TGTKApplication_MessageBox_key_press_event(widget: PGtkWidget; event: PGdkEventKey; user_data : gpointer): gboolean; cdecl; @@ -736,8 +658,6 @@ end; procedure TGTKApplication.Quit; begin gtk_main_quit(); -{ // The user lost interest - gtk_exit(0); } end; (********************************************************************************************************************************) @@ -838,13 +758,18 @@ begin Result := nil; end; +procedure InitGTK(); +begin + Screen := TGDKScreen.Create(nil); + Application := TGTKApplication.Create(Screen); +end; + initialization // Mask FPU exceptions that are redefined by Gtk+ // https://wiki.freepascal.org/SetExceptionMask + g_type_init(); SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]); - Screen := TGDKScreen.Create(nil); - Application := TGTKApplication.Create(Screen); finalization - Application.Free; - Screen.Free; + if Assigned(Application) then Application.Free; + if Assigned(Screen) then Screen.Free; end. |
