Initial commitv0.6.36release-0.6.36-dev

1 files changed, 874 insertions, 0 deletions

diff --git a/libgtk_kylix/GTKForms.pas b/libgtk_kylix/GTKForms.pas
new file mode 100644
index 0000000..ad755b7
--- /dev/null
+++ b/libgtk_kylix/GTKForms.pas
@@ -0,0 +1,874 @@
+(*
+    GTK-Kylix Library: GTKForms - Basic windows (TGTKForm, TGTKDialog), TGTKApplication, TGDKScreen  
+    Version 0.6.26  (last updated 2007-08-19)
+    Copyright (C) 2007 Tomas Bzatek <tbzatek@users.sourceforge.net>
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Library General Public License for more details.
+
+    You should have received a copy of the GNU Library General Public
+    License along with this library; if not, write to the 
+    Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
+    Boston, MA  02111-1307  USA.
+
+*)
+
+unit GTKForms;
+{ $WEAKPACKAGEUNIT}
+
+interface
+
+uses gtk2, gdk2, glib2, Classes, SysUtils, GTKControls, GTKConsts;
+
+
+type    //  Some basic types
+  PCharArray = array[0..0] of PChar;
+
+  TCustomGTKForm = class;
+
+(****************************************** TGDKSCREEN **************************************************************************)
+  TGDKScreen = class(TComponent)
+  private
+    FForms: TList;
+    FActiveForm: TCustomGTKForm;
+    procedure AddForm(AForm: TCustomGTKForm);
+    function GetForm(Index: Integer): TCustomGTKForm;
+    function GetFormCount: Integer;
+    procedure RemoveForm(AForm: TCustomGTKForm);
+    function GetHeight: Integer;
+    function GetWidth: Integer;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    property ActiveForm: TCustomGTKForm read FActiveForm;
+    property FormCount: Integer read GetFormCount;
+    property Forms[Index: Integer]: TCustomGTKForm read GetForm;
+    property Height: Integer read GetHeight;
+    property Width: Integer read GetWidth;
+  end;
+
+(****************************************** TGTKFORM ****************************************************************************)
+  TCloseAction = (caNone, caHide, caFree, caMinimize);
+  TCloseEvent = procedure(Sender: TObject; var Action: TCloseAction) of object;
+  TCloseQueryEvent = procedure(Sender: TObject; var CanClose: Boolean) of object;
+  TWindowPosition = (wpNone, wpCenter, wpMouse, wpCenterAlways, wpCenterOnParent);
+  TGDKWindowState = (wsNormal, wsState1, wsMinimized, wsState2, wsMaximized);
+  TGDKWindowTypeHint = (whNormal, whDialog, whToolbar, whSplashScreen, whUtility, whDock, whDesktop);
+
+  TCustomGTKForm = class(TGTKBin)
+    procedure FormCreate(Sender: TObject); dynamic;
+  private
+    FOnClose: TCloseEvent;
+    FOnCloseQuery: TCloseQueryEvent;
+    FOnResize: TNotifyEvent;
+    FOnShow: TNotifyEvent;
+    FCaption: string;
+    FOnDestroy: TNotifyEvent;
+    function GetWindowPosition: TWindowPosition;
+    function GetResizeable: boolean;
+    function GetWindowTypeHint: TGDKWindowTypeHint;
+    function GetWindowState: TGDKWindowState;
+    function GetLeft: integer;
+    function GetTop: integer;
+    function GetWidth: integer;
+    function GetHeight: integer;
+    procedure SetVisible(Value: Boolean);
+    procedure SetCaption(Value: string);
+    procedure SetWindowPosition(Value: TWindowPosition);
+    procedure SetResizeable(Value: Boolean);
+    procedure SetWindowTypeHint(Value: TGDKWindowTypeHint);
+    procedure SetLeft(Value: integer);
+    procedure SetTop(Value: integer);
+    procedure SetWidth(Value: integer);
+    procedure SetHeight(Value: integer);
+    procedure SetDefault(Value: TGTKControl);
+  protected
+    procedure DoClose(var Action: TCloseAction); dynamic;
+    property Visible write SetVisible default False;
+    property OnClose: TCloseEvent read FOnClose write FOnClose;
+    property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
+    property OnResize: TNotifyEvent read FOnResize write FOnResize;
+    property OnShow: TNotifyEvent read FOnShow write FOnShow;
+    property Caption: string read FCaption write SetCaption;
+    property WindowPosition: TWindowPosition read GetWindowPosition write SetWindowPosition;
+    property Resizeable: boolean read GetResizeable write SetResizeable;
+    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
+    property WindowTypeHint: TGDKWindowTypeHint read GetWindowTypeHint write SetWindowTypeHint;
+    property WindowState: TGDKWindowState read GetWindowState;
+    property Left: integer read GetLeft write SetLeft;
+    property Top: integer read GetTop write SetTop;
+    property Width: integer read GetWidth write SetWidth;
+    property Height: integer read GetHeight write SetHeight;
+    property Default: TGTKControl write SetDefault;
+  public
+    FAccelGroup: PGtkAccelGroup;
+    Tooltips: TGTKTooltips;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Release;
+    function Close: boolean;
+    procedure ShowModal; virtual;
+    function CloseQuery: Boolean; virtual;
+    procedure SetDefaultSize(DefaultWidth, DefaultHeight: integer);
+    procedure SetTransientFor(Parent: TCustomGTKForm);
+    procedure Maximize;
+    procedure Unmaximize;
+    procedure Minimize;
+    procedure Unminimize;
+    procedure Stick;
+    procedure Unstick;
+    procedure WindowMove(ALeft, ATop: integer);
+    procedure Resize(AWidth, AHeight: integer);
+  end;
+
+  TGTKForm = class(TCustomGTKForm)
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure Show; virtual;
+    procedure Hide;
+  end;
+
+(****************************************** TGTKDIALOG **************************************************************************)
+  TMessageButton = (mbYes, mbNo, mbOK, mbCancel, mbApply, mbClose, mbHelp, mbPrint, mbQuit, mbStop, mbBack, mbForward, mbNone);
+  TMessageButtons = set of TMessageButton;
+  TGTKDialogResponseEvent = procedure(Sender: TObject; const ResponseID: integer) of object;
+
+  TGTKDialog = class(TCustomGTKForm)
+  private
+    FButtons: TMessageButtons;
+    FOnResponse: TGTKDialogResponseEvent;
+    function GetShowSeparator: boolean;
+    procedure SetButtons(Value: TMessageButtons);
+    procedure SetShowSeparator(Value: boolean);
+    procedure SetModalResult(Value: TMessageButton);
+    procedure SetDefaultButton(Value: TMessageButton);
+    procedure SetParentForm(Value: TGTKForm);
+  public
+    ClientArea: TGTKVBox;
+    ActionArea: TGTKHBox;
+    constructor Create(AOwner: TComponent); override;
+    function Run: TMessageButton;
+    procedure AddButton(ButtonCaption: string; ButtonID: integer);
+    procedure SetResponseSensitive(ButtonID: integer; Sensitive: boolean);
+  published
+    property Buttons: TMessageButtons read FButtons write SetButtons default [];
+    property ShowSeparator: boolean read GetShowSeparator write SetShowSeparator;
+    property ModalResult: TMessageButton write SetModalResult;
+    property DefaultButton: TMessageButton write SetDefaultButton;
+    property Caption;
+    property OnResponse: TGTKDialogResponseEvent read FOnResponse write FOnResponse;
+    property ParentForm: TGTKForm write SetParentForm;
+  end;
+
+(****************************************** TGTKAPPLICATION *********************************************************************)
+  TMessageStyle = (mbError, mbInfo, mbQuestion, mbWarning);
+
+  TExceptionEvent = procedure (Sender: TObject; E: Exception) of object;
+
+  TGTKApplication = class(TComponent)
+  private
+    FTerminated: Boolean;
+    FOnException: TExceptionEvent;
+    FMainForm: TCustomGTKForm;
+    FMainFormSet, FGTK205Up, FGTK220Up, FGTK240Up, FGTK260Up, FGTK280Up: Boolean;
+    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;
+    procedure ProcessMessages;
+    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 GTKVersion_2_0_5_Up: boolean read FGTK205Up;
+    property GTKVersion_2_2_0_Up: boolean read FGTK220Up;
+    property GTKVersion_2_4_0_Up: boolean read FGTK240Up;
+    property GTKVersion_2_6_0_Up: boolean read FGTK260Up;
+    property GTKVersion_2_8_0_Up: boolean read FGTK280Up;
+  end;
+
+
+{ Global objects }
+
+var Application: TGTKApplication;
+    Screen: TGDKScreen;
+    Argc: Integer;
+    Argv: PPChar;
+
+function GetParentForm(Control: TGTKControl): TCustomGTKForm;
+   
+    
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+implementation
+
+uses GTKUtils;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGDKScreen.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FForms := TList.Create;
+  FActiveForm := nil;
+end;
+
+destructor TGDKScreen.Destroy;
+begin
+  FForms.Free;
+  inherited Destroy;
+end;
+
+procedure TGDKScreen.AddForm(AForm: TCustomGTKForm);
+begin
+  FForms.Add(AForm);
+end;
+
+function TGDKScreen.GetForm(Index: Integer): TCustomGTKForm;
+begin
+  Result := FForms[Index];
+end;
+
+function TGDKScreen.GetFormCount: Integer;
+begin
+  Result := FForms.Count;
+end;
+
+procedure TGDKScreen.RemoveForm(AForm: TCustomGTKForm);
+begin
+  FForms.Remove(AForm);
+end;
+
+function TGDKScreen.GetHeight: Integer;
+begin
+  Result := gdk_screen_height;
+end;
+
+function TGDKScreen.GetWidth: Integer;
+begin
+  Result := gdk_screen_width;
+end;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+function TCustomGTKForm_delete_event(widget: PGtkWidget; event: PGdkEvent; user_data: gpointer): gboolean; cdecl;
+begin
+  Result := not TCustomGTKForm(user_data).Close;
+end;
+
+procedure TCustomGTKForm_show(anobject : PGtkObject; user_data: pgpointer); cdecl;
+begin
+  if Assigned(TCustomGTKForm(user_data).FOnShow) then TCustomGTKForm(user_data).FOnShow(TCustomGTKForm(user_data));
+end;
+
+procedure TCustomGTKForm_size_allocate(widget : PGtkWidget; allocation : PGtkAllocation; user_data : gpointer); cdecl;
+begin
+  if Assigned(TCustomGTKForm(user_data).FOnResize) then TCustomGTKForm(user_data).FOnResize(TCustomGTKForm(user_data));
+end;
+
+constructor TCustomGTKForm.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  Tooltips := TGTKTooltips.Create(Self);
+  FOnClose := nil;
+  FOnCloseQuery := nil;
+  FOnDestroy := nil;
+  FCaption := '';
+  FAccelGroup := gtk_accel_group_new;
+  Screen.AddForm(Self);
+end;
+
+destructor TCustomGTKForm.Destroy;
+begin
+  try
+    Screen.RemoveForm(Self);
+    if Assigned(FOnDestroy) then FOnDestroy(Self);
+  except
+  end;
+  Tooltips.Free;
+  if not Application.Terminated then gtk_widget_destroy(FWidget);
+  inherited Destroy;
+end;
+
+procedure TCustomGTKForm.SetVisible(Value: Boolean);
+begin
+  inherited Visible := Value;
+end;
+
+function TCustomGTKForm.Close: boolean;
+var CloseAction: TCloseAction;
+begin
+  CloseAction := caFree;
+  if CloseQuery then begin
+    DoClose(CloseAction);
+    if CloseAction <> caNone then
+      if Application.MainForm = Self
+        then Application.Terminate
+        else if CloseAction = caHide then
+          Hide
+{        else if CloseAction = caMinimize then
+          WindowState := wsMinimized }
+        else
+          Release;
+    end else CloseAction := caNone;
+  Result := CloseAction = caFree;
+end;
+
+function TCustomGTKForm.CloseQuery: Boolean;
+begin
+  Result := True;
+  if Assigned(FOnCloseQuery) then FOnCloseQuery(Self, Result);
+end;
+
+procedure TCustomGTKForm.DoClose(var Action: TCloseAction);
+begin
+  if Assigned(FOnClose) then FOnClose(Self, Action);
+end;
+
+procedure TCustomGTKForm.Release;
+begin
+//  SetParent(nil);
+//  if Assigned(FWidget) and GTK_IS_WIDGET(FWidget) then gtk_widget_destroy(PGtkWidget(FWidget));
+end;
+
+procedure TCustomGTKForm.FormCreate(Sender: TObject);
+begin
+  //  Dummy procedure, override it in ordinary instance if needed
+end;
+
+procedure TCustomGTKForm.SetCaption(Value: string);
+begin
+  FCaption := Value;
+  gtk_window_set_title(PGtkWindow(FWidget), PChar(Value));
+end;
+
+function TCustomGTKForm.GetWindowPosition: TWindowPosition;
+begin
+  Result := TWindowPosition(position(PGtkWindow(FWidget)^));
+end;
+
+procedure TCustomGTKForm.SetWindowPosition(Value: TWindowPosition);
+begin
+  gtk_window_set_position(PGtkWindow(FWidget), TGtkWindowPosition(Value));
+end;
+
+function TCustomGTKForm.GetResizeable: boolean;
+begin
+  Result := gtk_window_get_resizable(PGtkWindow(FWidget));
+end;
+
+procedure TCustomGTKForm.SetResizeable(Value: Boolean);
+begin
+  gtk_window_set_resizable(PGtkWindow(FWidget), Value);
+end;
+
+procedure TCustomGTKForm.SetDefaultSize(DefaultWidth, DefaultHeight: integer);
+begin
+  gtk_window_set_default_size(PGtkWindow(FWidget), DefaultWidth, DefaultHeight);
+end;
+
+procedure TCustomGTKForm.SetTransientFor(Parent: TCustomGTKForm);
+begin
+  if Assigned(Parent) and Assigned(Parent.FWidget) then
+    gtk_window_set_transient_for(PGtkWindow(FWidget), PGtkWindow(Parent.FWidget));
+end;
+
+procedure TCustomGTKForm.ShowModal;
+begin
+  gtk_window_set_modal(PGtkWindow(FWidget), True);
+  if Assigned(Parent) and (Parent is TCustomGTKForm) then gtk_window_set_transient_for(PGtkWindow(FWidget), PGtkWindow(Parent.FWidget));
+  SetVisible(True);
+end;
+
+function TCustomGTKForm.GetWindowTypeHint: TGDKWindowTypeHint;
+begin
+  Result := TGDKWindowTypeHint(gtk_window_get_type_hint(PGtkWindow(FWidget)));
+end;
+
+procedure TCustomGTKForm.SetWindowTypeHint(Value: TGDKWindowTypeHint);
+begin
+  gtk_window_set_type_hint(PGtkWindow(FWidget), gdk2.TGdkWindowTypeHint(Value));
+end;
+
+function TCustomGTKForm.GetWindowState: TGDKWindowState;
+begin
+  Result := TGDKWindowState(gdk_window_get_state(PGdkWindow(FWidget^.window)));
+end;
+
+procedure TCustomGTKForm.Maximize;
+begin
+  gtk_window_maximize(PGtkWindow(FWidget));
+end;
+
+procedure TCustomGTKForm.Unmaximize;
+begin
+  gtk_window_unmaximize(PGtkWindow(FWidget));
+end;
+
+procedure TCustomGTKForm.Minimize;
+begin
+  gtk_window_iconify(PGtkWindow(FWidget));
+end;
+
+procedure TCustomGTKForm.Unminimize;
+begin
+  gtk_window_deiconify(PGtkWindow(FWidget));
+end;
+
+procedure TCustomGTKForm.Stick;
+begin
+  gtk_window_stick(PGtkWindow(FWidget));
+end;
+
+procedure TCustomGTKForm.Unstick;
+begin
+  gtk_window_unstick(PGtkWindow(FWidget));
+end;
+
+procedure TCustomGTKForm.WindowMove(ALeft, ATop: integer);
+begin
+  gtk_window_move(PGtkWindow(FWidget), ALeft, ATop);
+end;
+
+function TCustomGTKForm.GetLeft: integer;
+var PosLeft, PosTop: integer;
+begin
+  gtk_window_get_position(PGtkWindow(FWidget), @PosLeft, @PosTop);
+  Result := PosLeft;
+end;
+
+function TCustomGTKForm.GetTop: integer;
+var PosLeft, PosTop: integer;
+begin
+  gtk_window_get_position(PGtkWindow(FWidget), @PosLeft, @PosTop);
+  Result := PosTop;
+end;
+
+function TCustomGTKForm.GetWidth: integer;
+var AWidth, AHeight: integer;
+begin
+  gtk_window_get_size(PGtkWindow(FWidget), @AWidth, @AHeight);
+  Result := AWidth;
+end;
+
+function TCustomGTKForm.GetHeight: integer;
+var AWidth, AHeight: integer;
+begin
+  gtk_window_get_size(PGtkWindow(FWidget), @AWidth, @AHeight);
+  Result := AHeight;
+end;
+
+procedure TCustomGTKForm.SetLeft(Value: integer);
+begin
+  gtk_window_move(PGtkWindow(FWidget), Value, GetTop);
+end;
+
+procedure TCustomGTKForm.SetTop(Value: integer);
+begin
+  gtk_window_move(PGtkWindow(FWidget), GetLeft, Value);
+end;
+
+procedure TCustomGTKForm.SetWidth(Value: integer);
+begin
+  gtk_window_resize(PGtkWindow(FWidget), Value, GetHeight);
+end;
+
+procedure TCustomGTKForm.SetHeight(Value: integer);
+begin
+  gtk_window_resize(PGtkWindow(FWidget), GetWidth, Value);
+end;
+
+procedure TCustomGTKForm.Resize(AWidth, AHeight: integer);
+begin
+  gtk_window_resize(PGtkWindow(FWidget), AWidth, AHeight);
+end;
+
+procedure TCustomGTKForm.SetDefault(Value: TGTKControl);
+begin
+  gtk_window_set_default(PGtkWindow(FWidget), Value.FWidget);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKApplication.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FMainForm := nil;
+  FMainFormSet := False;
+  if not Assigned(Classes.ApplicationHandleException) then
+    Classes.ApplicationHandleException := HandleException;
+  if not Assigned(Classes.ApplicationShowException) then
+    Classes.ApplicationShowException := ShowException;
+  CreateHandle;
+  HookSynchronizeWakeup;
+end;
+
+procedure my_g_thread_init(vtable:Pointer);cdecl;external 'libgthread-2.0.so' name 'g_thread_init';
+
+procedure TGTKApplication.CreateHandle;
+var
+  I: Integer;
+  Temp: string;
+  Ver : Pchar;
+begin
+  Argc := ParamCount + 1;
+  Argv := AllocMem((Argc + 1) * SizeOf(PChar));
+  for I := 0 to Argc - 1 do
+  begin
+    Temp := ParamStr(I);
+    {$R-}
+    PCharArray(Argv^)[I] := AllocMem(Length(Temp)+1);
+    StrCopy(PCharArray(Argv^)[I], PChar(Temp));
+    {$R+}
+  end;
+  {$R-}
+  PCharArray(Argv^)[Argc] := nil;
+  {$R+}
+
+  //  Check for correct version of GTK+ library
+  Ver := gtk_check_version(2, 8, 0);
+  FGTK280Up := Ver = nil;
+  if not FGTK280Up then Ver := gtk_check_version(2, 6, 0);
+  FGTK260Up := Ver = nil;
+  if not FGTK260Up then Ver := gtk_check_version(2, 4, 0);
+  FGTK240Up := Ver = nil;
+  if not FGTK240Up then Ver := gtk_check_version(2, 2, 0);
+  FGTK220Up := Ver = nil;
+  if not FGTK220Up then Ver := gtk_check_version(2, 0, 5);
+  FGTK205Up := Ver = nil;
+  if not FGTK220Up then WriteLn('Warning: Your version of GTK+ is old and some workarounds has been activated. It is recommended to update GTK libraries at least to 2.2.0');
+  if Ver <> nil then Ver := gtk_check_version(2, 0, 0);
+  if Ver <> nil then WriteLn('Warning: There might be some problems with GTK+ library or version conflict.');
+
+  //  Init threads
+  my_g_thread_init(nil);
+  gdk_threads_init;
+
+  //  Initialize the widget set
+  gtk_init(@argc, @argv);
+{  if not gtk_init_check(@argc, @argv) then begin
+    WriteLn('Unable to initialize GTK+ interface. Make sure you have correctly installed all of GTK libraries and have set a valid X server in the DISPLAY variable.');
+    Halt(1);
+  end;   }
+end;
+
+destructor TGTKApplication.Destroy;
+type
+  TExceptionEvent = procedure (E: Exception) of object;
+var
+  P: TNotifyEvent;
+  E: TExceptionEvent;
+begin
+  UnhookSynchronizeWakeup;
+  P := HandleException;
+  if @P = @Classes.ApplicationHandleException then
+    Classes.ApplicationHandleException := nil;
+  E := ShowException;
+  if @E = @Classes.ApplicationShowException then
+    Classes.ApplicationShowException := nil; 
+  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
+  if ExceptObject is Exception then
+  begin
+    if not (ExceptObject is EAbort) then
+      if Assigned(FOnException) then
+        FOnException(Sender, Exception(ExceptObject))
+      else
+        ShowException(Exception(ExceptObject));
+  end else
+    SysUtils.ShowException(ExceptObject, ExceptAddr);
+end;
+
+procedure TGTKApplication.CreateForm(InstanceClass: TComponentClass; var Reference);
+var
+  Instance: TComponent;
+begin
+  Instance := TComponent(InstanceClass.NewInstance);
+  TComponent(Reference) := Instance;
+  try
+    Instance.Create(Self);
+  except
+    TComponent(Reference) := nil;
+    raise;
+  end;
+  if not FMainFormSet and (Instance is TCustomGTKForm) then
+  begin
+    // FMainForm will be set to the first form created by TForm.Create but
+    // it will be reset by CreateForm if one was created early, such as through
+    // 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));}
+    FMainFormSet := True;
+  end; 
+end;
+
+procedure TGTKApplication.ControlDestroyed(Control: TGTKControl);
+begin
+  if FMainForm = Control then FMainForm := nil;
+  if Screen.FActiveForm = Control then Screen.FActiveForm := nil;
+end;
+
+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 TGTKApplication.Run;
+begin
+  repeat
+    try
+//      gdk_threads_enter;
+      gtk_main;
+//      gdk_threads_leave;
+    except
+      on E : Exception do
+        if E is EControlC then begin
+          WriteLn('*** Exception: ', E.Message);
+          Halt(1);
+          Exit;
+        end else HandleException(E);
+    end;
+  until Terminated;
+end;
+
+function TGTKApplication_MessageBox_key_press_event(widget: PGtkWidget; event: PGdkEventKey; user_data : gpointer): gboolean; cdecl;
+begin
+  Result := False;
+  if event^.keyval = GDK_ESCAPE then begin
+    gtk_dialog_response(PGtkDialog(widget), integer(user_data));
+//    Beep;
+    Result := True;
+  end;
+end;
+
+function TGTKApplication.MessageBox(const Text: string; Buttons: TMessageButtons; Style: TMessageStyle;
+                                    Default, Escape: TMessageButton): TMessageButton;
+const TMessageStyleID : array[0..3] of TGtkMessageType = (GTK_MESSAGE_ERROR, GTK_MESSAGE_INFO, GTK_MESSAGE_QUESTION, GTK_MESSAGE_WARNING);
+var Dialog: PGtkWidget;
+    DialogParent: PGtkWindow;
+    i: integer;
+begin
+  if Application.Terminated then
+  begin
+    Result := Escape;
+    Exit;
+  end;
+  if Screen.FormCount > 0
+    then DialogParent := PGtkWindow(Screen.Forms[0].FWidget)
+    else DialogParent := nil;
+  Dialog := gtk_message_dialog_new(DialogParent, GTK_DIALOG_MODAL or GTK_DIALOG_DESTROY_WITH_PARENT, TMessageStyleID[Integer(Style)],
+                                   GTK_BUTTONS_NONE, StringToPgchar(Text));
+  for i := 1 to NumMessageButtons do
+    if TMessageButton(i - 1) in Buttons
+      then gtk_dialog_add_button(PGtkDialog(Dialog), MessageButtonID[i], i);
+  if Escape <> mbNone then g_signal_connect(PGtkObject(Dialog), 'key-press-event', G_CALLBACK(@TGTKApplication_MessageBox_key_press_event),
+                                            Pointer(Ord(Escape) + 1{MessageButtonID[Ord(Escape)]}));
+  if Default <> mbNone then gtk_dialog_set_default_response(PGtkDialog(Dialog), Ord(Default));
+  Result := TMessageButton(gtk_dialog_run(PGtkDialog(Dialog)) - 1);
+  gtk_widget_destroy(Dialog);
+end;
+
+procedure TGTKApplication.ShowException(E: Exception);
+var Msg: string;
+begin
+  Msg := E.Message;
+  if (Msg <> '') and (AnsiLastChar(Msg) = '.') then Delete(Msg, Length(Msg), 1); 
+  MessageBox(Format('An unhandled exception has occured: '#10'    %s'#10#10'It is strongly recommended to save your data and quit the application.', [Msg]), [mbOk], mbError);
+end;
+
+procedure TGTKApplication.Terminate;
+begin
+  if (not Application.Terminated) and CallTerminateProcs then begin
+    FTerminated := True;
+    Quit;
+  end;
+end;
+
+procedure TGTKApplication.Quit;
+begin
+  gtk_main_quit();
+{  //  The user lost interest
+  gtk_exit(0); }
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKForm.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FWidget := gtk_window_new(GTK_WINDOW_TOPLEVEL);
+  gtk_window_add_accel_group(PGtkWindow(FWidget), FAccelGroup);
+  g_signal_connect(PGtkObject(FWidget), 'delete-event', G_CALLBACK(@TCustomGTKForm_delete_event), Self);
+  g_signal_connect(PGtkObject(FWidget), 'size-allocate', G_CALLBACK(@TCustomGTKForm_size_allocate), Self);
+  g_signal_connect(PGtkObject(FWidget), 'show', G_CALLBACK(@TCustomGTKForm_show), Self);
+  Visible := False;
+  SetResizeable(True);
+  FormCreate(Self);
+  if Visible then Show;
+end;
+
+procedure TGTKForm.Hide;
+begin
+  SetVisible(False);
+end;
+
+procedure TGTKForm.Show;
+begin
+  SetVisible(True);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+procedure TGTKDialog_response_event(dialog: PGtkDialog; arg1: gint; user_data: gpointer); cdecl;
+begin
+  if Assigned(TGTKDialog(user_data).FOnResponse) then TGTKDialog(user_data).FOnResponse(TGTKDialog(user_data), arg1);
+end;
+
+constructor TGTKDialog.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FWidget := gtk_dialog_new;
+  if Assigned(AOwner) and (AOwner is TCustomGTKForm) then SetTransientFor(AOwner as TCustomGTKForm);
+  FOnResponse := nil;
+  gtk_window_add_accel_group(PGtkWindow(FWidget), FAccelGroup);
+  g_signal_connect(PGtkObject(FWidget), 'delete-event', G_CALLBACK(@TCustomGTKForm_delete_event), Self);
+  g_signal_connect(PGtkObject(FWidget), 'show', G_CALLBACK(@TCustomGTKForm_show), Self);
+  g_signal_connect(PGtkObject(FWidget), 'response', G_CALLBACK(@TGTKDialog_response_event), Self);
+  ClientArea := TGTKVBox.CreateLinked(Self, PGtkDialog(FWidget)^.vbox);
+  ActionArea := TGTKHBox.CreateLinked(Self, PGtkDialog(FWidget)^.action_area);
+  FButtons := [];
+  Visible := False;
+  SetResizeable(True);
+  FormCreate(Self);
+  if Visible then Show;
+end;
+
+function TGTKDialog.Run: TMessageButton;
+begin
+  gtk_widget_show{_all}(FWidget);
+  Result := TMessageButton(gtk_dialog_run(PGtkDialog(FWidget))); 
+end;
+
+procedure TGTKDialog.SetButtons(Value: TMessageButtons);
+var i: integer;
+begin
+  for i := 1 to NumMessageButtons do
+    if TMessageButton(i - 1) in Value
+      then gtk_dialog_add_button(PGtkDialog(FWidget), MessageButtonID[i], i - 1);
+end;
+
+function TGTKDialog.GetShowSeparator: boolean;
+begin
+  Result := gtk_dialog_get_has_separator(PGtkDialog(FWidget));
+end;
+
+procedure TGTKDialog.SetShowSeparator(Value: boolean);
+begin
+  gtk_dialog_set_has_separator(PGtkDialog(FWidget), Value);
+end;
+
+procedure TGTKDialog.SetModalResult(Value: TMessageButton);
+begin
+  gtk_dialog_response(PGtkDialog(FWidget), Integer(Value));
+end;
+
+procedure TGTKDialog.SetDefaultButton(Value: TMessageButton);
+begin
+  gtk_dialog_set_default_response(PGtkDialog(FWidget), Integer(Value));
+end;
+
+procedure TGTKDialog.AddButton(ButtonCaption: string; ButtonID: integer);
+begin
+  gtk_dialog_add_button(PGtkDialog(FWidget), StringToPgchar(ButtonCaption), ButtonID);
+end;
+
+procedure TGTKDialog.SetResponseSensitive(ButtonID: integer; Sensitive: boolean);
+begin
+  gtk_dialog_set_response_sensitive(PGtkDialog(FWidget), ButtonID, Sensitive);
+end;
+
+procedure TGTKDialog.SetParentForm(Value: TGTKForm);
+begin
+  if Value <> nil then gtk_window_set_transient_for(PGtkWindow(FWidget), PGtkWindow(Value.FWidget));
+end;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+function GetParentForm(Control: TGTKControl): TCustomGTKForm;
+begin
+  while Control.Parent <> nil do Control := Control.Parent;
+  if Control is TCustomGTKForm then
+    Result := TCustomGTKForm(Control) else
+    Result := nil;
+end;
+
+initialization
+  Screen := TGDKScreen.Create(nil);
+  Application := TGTKApplication.Create(Screen);
+finalization
+  Application.Free;
+  Screen.Free;
+end.