(*
    GTK-Kylix Library: GTKControls - Basic objects
    Version 0.6.23  (last updated 2008-11-11)
    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 GTKControls;

interface

uses gtk2, gdk2, glib2, Classes;
   //  Quick jump: QForms QControls

const

  { TModalResult values }
  mrNone     = 0;
  mrOk       = mrNone + 1;
  mrCancel   = mrOk + 1;
  mrYes      = mrCancel + 1;
  mrNo       = mrYes + 1;
  mrAbort    = mrNo + 1;
  mrRetry    = mrAbort + 1;
  mrIgnore   = mrRetry + 1;
  mrAll      = mrIgnore + 1;
  mrNoToAll  = mrAll + 1;
  mrYesToAll = mrNoToAll + 1;

type
{$IFNDEF CPU64}   //  32-bit platform
  TComponent64 = class(TComponent);
{$ELSE}           //  64-bit platform
  TComponent64 = class(TComponent)
  private
    FTag: QWORD;
  published
    property Tag: QWORD read FTag write FTag default 0;
  end;
{$ENDIF}



type
  TGTKShadowType = (stNone, stShadowIn, stShadowOut, stEtchedIn, stEtchedOut);
  TGTKPosition = (poLeft, poRight, poTop, poBottom);
  
(****************************************** TGTKCONTROL *************************************************************************)
  TGDKMouseButton = (mbLeft, mbMiddle, mbRight, mbNoButton);
  TGDKKeyEvent = procedure (Sender: TObject; Key: Word; Shift: TShiftState; var Accept: boolean) of object;
  TGDKMouseEvent = procedure (Sender: TObject; Button: TGDKMouseButton; Shift: TShiftState; X, Y: Integer; var Accept: boolean) of object;
  TGDKFocusEvent = procedure (Sender: TObject; var Accept: boolean) of object;
  TGDKExposeEvent = procedure (Sender: TObject; const Rect: PGdkRectangle; var Accept: boolean) of object;
  TGTKControlState = (csNormal, csActive, csPrelight, csSelected, csInsensitive);
  TGTKControl = class(TComponent64)
  private
    FVisible: Boolean;
    FParent: TGTKControl;
    FPopupMenu: TGTKControl;
    FButtonPressSignalHandler, FButtonReleaseSignalHandler, FKeyDownSignalHandler, FKeyUpSignalHandler,
    FFocusInSignalHandler, FFocusOutSignalHandler, FExposeSignalHandler, FMotionNotifyHandler: gulong;
    FOnKeyDown: TGDKKeyEvent;
    FOnKeyUp: TGDKKeyEvent;
    FOnEnter: TGDKFocusEvent;
    FOnExit: TGDKFocusEvent;
    FOnMouseDown: TGDKMouseEvent;
    FOnMouseUp: TGDKMouseEvent;
    FOnDblClick: TGDKMouseEvent;
    FOnExpose: TGDKExposeEvent;
    FOnMouseMove: TGDKMouseEvent;
    function GetWidth: Integer;
    function GetHeight: Integer;
    function GetLeft: Integer;
    function GetTop: Integer;
    function GetEnabled: boolean;
    function GetTooltip: string;
    function GetCanFocus: boolean;
    function GetFocused: boolean;
    function GetDefault: boolean;
    function GetControlState: TGTKControlState;
    procedure SetHeight(const Value: Integer);
    procedure SetVisible(const Value: Boolean);
    procedure SetWidth(const Value: Integer);
    procedure SetEnabled(const Value: boolean);
    procedure SetPopupMenu(Value: TGTKControl);
    procedure SetTooltip(Value: string);
    procedure SetFocused(Value: boolean);
    procedure SetOnKeyDown(Value: TGDKKeyEvent);
    procedure SetOnKeyUp(Value: TGDKKeyEvent);
    procedure SetOnEnter(Value: TGDKFocusEvent);
    procedure SetOnExit(Value: TGDKFocusEvent);
    procedure SetOnMouseDown(Value: TGDKMouseEvent);
    procedure SetOnMouseUp(Value: TGDKMouseEvent);
    procedure SetDefault(Value: boolean);
    procedure SetOnDblClick(Value: TGDKMouseEvent);
    procedure SetCanFocus(Value: boolean);
    procedure SetOnExpose(Value: TGDKExposeEvent);
    procedure SetControlState(Value: TGTKControlState);
    procedure SetOnMouseMove(Value: TGDKMouseEvent);
  protected
    procedure SetParent(const Value: TGTKControl); virtual;
  public
    FWidget: PGtkWidget;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Hide;
    procedure HideAll;
    procedure Show;
    procedure ShowAll;
    procedure SetSizeRequest(const Width, Height: Integer);
    property Parent: TGTKControl read FParent write SetParent;
    property Visible: Boolean read FVisible write SetVisible default True;
    property Enabled: Boolean read GetEnabled write SetEnabled default True;
    property PopupMenu: TGTKControl read FPopupMenu write SetPopupMenu;
    procedure SetFocus;
    procedure SetForegroundColor(Red, Green, Blue: word); overload;
    procedure SetForegroundColor(State: integer; Red, Green, Blue: word); overload;
    procedure SetForegroundColor(State: integer; Color: PGdkColor); overload;
    procedure SetForegroundColor(Color: PGdkColor); overload;
    procedure SetBackgroundColor(Red, Green, Blue: word); overload;
    procedure SetBackgroundColor(State: integer; Red, Green, Blue: word); overload;
    procedure SetBackgroundColor(State: integer; Color: PGdkColor); overload;
    procedure SetBackgroundColor(Color: PGdkColor); overload;
    procedure SetTextColor(Red, Green, Blue: word); overload;
    procedure SetTextColor(State: integer; Red, Green, Blue: word); overload;
    procedure SetBaseColor(Red, Green, Blue: word); overload;
    procedure SetBaseColor(State: integer; Red, Green, Blue: word); overload;
    procedure Invalidate;
    procedure SetAlignment(XAlign, YAlign: Double);
    procedure SetPadding(XPad, YPad: integer);
    function GetData(Key: string): Pointer;
    procedure SetData(Key: string; Value: Pointer);
  published
    property Width: Integer read GetWidth write SetWidth;
    property Height: Integer read GetHeight write SetHeight;
    property Left: Integer read GetLeft;
    property Top: Integer read GetTop;
    property Tooltip: string read GetTooltip write SetTooltip;
    property CanFocus: boolean read GetCanFocus write SetCanFocus;
    property Focused: boolean read GetFocused write SetFocused;
    property Default: boolean read GetDefault write SetDefault;
    property OnKeyDown: TGDKKeyEvent read FOnKeyDown write SetOnKeyDown;
    property OnKeyUp: TGDKKeyEvent read FOnKeyUp write SetOnKeyUp;
    property OnEnter: TGDKFocusEvent read FOnEnter write SetOnEnter;
    property OnExit: TGDKFocusEvent read FOnExit write SetOnExit;
    property OnMouseDown: TGDKMouseEvent read FOnMouseDown write SetOnMouseDown;
    property OnMouseUp: TGDKMouseEvent read FOnMouseUp write SetOnMouseUp;
    property OnMouseMove: TGDKMouseEvent read FOnMouseMove write SetOnMouseMove;
    property OnDblClick: TGDKMouseEvent read FOnDblClick write SetOnDblClick;
    property OnExpose: TGDKExposeEvent read FOnExpose write SetOnExpose;
    property ComponentState;
    property ControlState: TGTKControlState read GetControlState write SetControlState;
  end;

(****************************************** TGTKCONTAINER ***********************************************************************)
  TGTKContainer = class(TGTKControl)
  private
    function GetBorderWidth: integer;
    procedure SetBorderWidth(Value: integer);
    function GetChildrenCount: integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddControl(AControl: TGTKControl);
    procedure RemoveControl(AControl: TGTKControl);
  published
    property BorderWidth: integer read GetBorderWidth write SetBorderWidth;
    property ChildrenCount: integer read GetChildrenCount;
  end;

(****************************************** TGTKBIN *****************************************************************************)
  TGTKBin = class(TGTKContainer)
  private
    function GetChildControl: PGtkWidget;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property ChildControl: PGtkWidget read GetChildControl;
  end;

(****************************************** TGTKBOX *****************************************************************************)
  TGTKBox = class(TGTKContainer)
  private
    FLinked: boolean;
    function GetHomogeneous: boolean;
    function GetSpacing: integer;
    procedure SetHomogeneous(Value: boolean);
    procedure SetSpacing(Value: integer);
  public
    constructor Create(AOwner: TComponent); override;
    constructor CreateLinked(AOwner: TComponent; Widget: PGtkWidget);
    destructor Destroy; override;
    procedure AddControl(Control: TGTKControl);
    procedure AddControlEnd(Control: TGTKControl);
    procedure AddControlEx(Control: TGTKControl; Expand, Fill: boolean; Padding: integer);
    procedure AddControlEndEx(Control: TGTKControl; Expand, Fill: boolean; Padding: integer);
  published
    property Homogeneous: boolean read GetHomogeneous write SetHomogeneous;
    property Spacing: integer read GetSpacing write SetSpacing;
  end;

(****************************************** TGTKHBOX ****************************************************************************)
  TGTKHBox = class(TGTKBox)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

(****************************************** TGTKVBOX ****************************************************************************)
  TGTKVBox = class(TGTKBox)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

(****************************************** TGTKEVENTBOX ************************************************************************)
  TGTKEventBox = class(TGTKBin)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

(****************************************** TGTKTOOLTIPS ************************************************************************)
  TGTKTooltips = class(TComponent)
  private
    function GetEnabled: boolean;
    procedure SetEnabled(Value: boolean);
  public
    FObject: PGtkTooltips;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Enabled: boolean read GetEnabled write SetEnabled;
  end;

(****************************************** TGTKTABLE ***************************************************************************)
  TGTKTableAttachOptions = set of (taoExpand, taoShrink, taoFill);
  TGTKTable = class(TGTKContainer)
  private
    function GetRowCount: integer;
    procedure SetRowCount(Value: integer);
    function GetColCount: integer;
    procedure SetColCount(Value: integer);
    function GetRowSpacing: integer;
    procedure SetRowSpacing(Value: integer);
    function GetColSpacing: integer;
    procedure SetColSpacing(Value: integer);
    function GetHomogeneous: boolean;
    procedure SetHomogeneous(Value: boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetRowColCount(Rows, Cols: integer);
    procedure AddControl(Column, Row, NumCols, NumRows: integer; Control: TGTKControl; XPadding, YPadding: integer);
    procedure AddControlEx(Column, Row, NumCols, NumRows: integer; Control: TGTKControl; XAttachOptions,
                           YAttachOptions: TGTKTableAttachOptions; XPadding, YPadding: integer); 
  published
    property RowCount: integer read GetRowCount write SetRowCount;
    property ColCount: integer read GetColCount write SetColCount;
    property RowSpacing: integer read GetRowSpacing write SetRowSpacing;
    property ColSpacing: integer read GetColSpacing write SetColSpacing;
    property Homogeneous: boolean read GetHomogeneous write SetHomogeneous;
  end;


procedure Beep;
  
(********************************************************************************************************************************)
(********************************************************************************************************************************)
(********************************************************************************************************************************)
(********************************************************************************************************************************)
implementation

uses GTKMenus, GTKForms, GTKUtils;

procedure Beep;
begin
  gdk_beep;
end;


(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGTKControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if AOwner is TGTKControl then FParent := AOwner as TGTKControl;
  FButtonPressSignalHandler := 0;
  FButtonReleaseSignalHandler := 0;
  FKeyDownSignalHandler := 0;
  FKeyUpSignalHandler := 0;
  FFocusInSignalHandler := 0;
  FFocusOutSignalHandler := 0;
  FExposeSignalHandler := 0;
  FVisible := True;
  FWidget := nil;
  FPopupMenu := nil;
  FOnKeyDown := nil;
  FOnKeyUp := nil;
  FOnEnter := nil;
  FOnExit := nil;
  FOnExpose := nil;
  FOnMouseMove := nil;
  FOnMouseDown := nil;
  FOnMouseUp := nil;
end;

destructor TGTKControl.Destroy;
begin
  try
//    SetParent(nil);
//    if Assigned(FWidget) {and GTK_IS_WIDGET(FWidget)} then gtk_widget_destroy(PGtkWidget(FWidget));
  except end;
  inherited Destroy;
end;

procedure TGTKControl.Hide;
begin
  FVisible := False;
  gtk_widget_hide(FWidget);
end;

procedure TGTKControl.HideAll;
begin
  if Parent <> nil then Parent.HideAll;
  FVisible := False;
  gtk_widget_hide_all(FWidget);
end;

procedure TGTKControl.Show;
begin
  FVisible := True;
  gtk_widget_show(FWidget);
end;

procedure TGTKControl.ShowAll;
begin
  if Parent <> nil then Parent.ShowAll;
  FVisible := True;
  gtk_widget_show_all(FWidget);
end;

procedure TGTKControl.SetParent(const Value: TGTKControl);
begin
  if (csDestroying in ComponentState) then Exit;
  if FParent <> Value then begin
    if Value = Self then
      raise EInvalidOperation.Create('Invalid Operation');
    FParent := Value;
    try
    if Assigned(FWidget) and GTK_IS_WIDGET(FWidget) then
      if Assigned(Value)
        then gtk_widget_set_parent(FWidget, Value.FWidget)
        else gtk_widget_unparent(FWidget);
    except end;
  end;
end;

procedure TGTKControl.SetVisible(const Value: Boolean);
begin
  if Value then Show
           else Hide;
end;

function TGTKControl.GetWidth: Integer;
begin
  Result := FWidget^.allocation.width;
end;

function TGTKControl.GetHeight: Integer;
begin
  Result := FWidget^.allocation.height;
end;

procedure TGTKControl.SetWidth(const Value: Integer);
begin
  SetSizeRequest(Value, GetHeight);
end;

procedure TGTKControl.SetHeight(const Value: Integer);
begin
  SetSizeRequest(GetWidth, Value);
end;

procedure TGTKControl.SetSizeRequest(const Width, Height: Integer);
begin
  gtk_widget_set_size_request(FWidget, Width, Height);
end;

function TGTKControl.GetLeft: Integer;
begin
  Result := FWidget^.allocation.x;
end;

function TGTKControl.GetTop: Integer;
begin
  Result := FWidget^.allocation.y;
end;

function TGTKControl.GetEnabled: boolean;
begin
  Result := False;
  if (csDestroying in ComponentState) then Exit;
  Result := GTK_WIDGET_SENSITIVE(FWidget);
end;

procedure TGTKControl.SetEnabled(const Value: boolean);
begin
  gtk_widget_set_sensitive(FWidget, Value);
end;

function TGTKControl_button_press_event(widget: PGtkWidget; event: PGdkEventButton; user_data: gpointer):gboolean; cdecl;
var Shift: TShiftState;
    Accept: boolean;
begin
  Shift := [];
  if event^.state and GDK_SHIFT_MASK = GDK_SHIFT_MASK then Include(Shift, ssShift);
  if event^.state and GDK_CONTROL_MASK = GDK_CONTROL_MASK then Include(Shift, ssCtrl);
  if event^.state and GDK_MOD1_MASK = GDK_MOD1_MASK then Include(Shift, ssAlt);
  Accept := True;
  if Assigned(TGTKControl(user_data).FOnMouseDown) and (event^._type = GDK_BUTTON_PRESS)
    then TGTKControl(user_data).FOnMouseDown(TGTKControl(user_data), TGDKMouseButton(event^.button - 1), Shift, Trunc(event^.x), Trunc(event^.y), Accept);
  if Assigned(TGTKControl(user_data).FOnDblClick) and (event^._type = GDK_2BUTTON_PRESS)
    then TGTKControl(user_data).FOnDblClick(TGTKControl(user_data), TGDKMouseButton(event^.button - 1), Shift, Trunc(event^.x), Trunc(event^.y), Accept);
  Result := not Accept;
  if Accept then 
  if (Event^.button = 3) and Assigned(TGTKControl(user_data).FPopupMenu) then begin
//    if Assigned(TGTKMenuItem(TGTKControl(user_data).FPopupMenu).OnPopup) then TGTKMenuItem(TGTKControl(user_data).FPopupMenu).OnPopup(TGTKMenuItem(TGTKControl(user_data).FPopupMenu));
    if Assigned(TGTKMenuItem(TGTKControl(user_data).FPopupMenu).OnPopup) then TGTKMenuItem(TGTKControl(user_data).FPopupMenu).OnPopup(TGTKControl(user_data));
    gtk_menu_popup(PGtkMenu(TGTKMenuItem(TGTKControl(user_data).FPopupMenu).FMenu), nil, nil, nil, nil, event^.button, event^.time);
    Result := False;   //  Allow list views to process their events - select an item beneath the cursor
  end;
end;

procedure TGTKControl.SetPopupMenu(Value: TGTKControl);
begin
  if FPopupMenu <> Value then begin
    FPopupMenu := Value;
    if not Assigned(Value) then begin
      if not Assigned(FOnMouseDown) then begin
        g_signal_handler_disconnect(PGtkObject(FWidget), FButtonPressSignalHandler);
        FButtonPressSignalHandler := 0;
      end;
    end else
      if FButtonPressSignalHandler = 0
        then FButtonPressSignalHandler := g_signal_connect(PGtkObject(FWidget), 'button-press-event', G_CALLBACK(@TGTKControl_button_press_event), Self)
  end;
end;

function TGTKControl.GetTooltip: string;
var TooltipsData : PGtkTooltipsData;
begin
  Result := '';
  TooltipsData := gtk_tooltips_data_get(FWidget);
  if Assigned(TooltipsData) then Result := PgcharToString(TooltipsData^.tip_text);
end;

procedure TGTKControl.SetTooltip(Value: string);
var FParentForm : TCustomGTKForm;
begin
  FParentForm := GetParentForm(Self);
  if FParentForm <> nil then gtk_tooltips_set_tip(FParentForm.Tooltips.FObject, FWidget, StringToPgchar(Value), nil);
end;

procedure TGTKControl.SetFocus;
begin
  if (csDestroying in ComponentState) then Exit;
  gtk_widget_grab_focus(FWidget);
end;

function TGTKControl.GetCanFocus: boolean;
begin
  Result := False;
  if (csDestroying in ComponentState) then Exit;
  Result := GTK_WIDGET_CAN_FOCUS(FWidget);
end;

procedure TGTKControl.SetCanFocus(Value: boolean);
begin
{  if Value then FWidget^.private_flags := FWidget^.private_flags or GTK_CAN_FOCUS
           else FWidget^.private_flags := FWidget^.private_flags and (not GTK_CAN_FOCUS); }
  g_object_set(G_OBJECT(FWidget), 'can-focus', Ord(Value), nil);
end;

function TGTKControl.GetFocused: boolean;
begin
  Result := False;
  try
    if (csDestroying in ComponentState) or (FWidget = nil) then Exit;
    Result := GTK_WIDGET_HAS_FOCUS(FWidget);
  except end;
end;

procedure TGTKControl.SetFocused(Value: boolean);
begin
  SetFocus;
end;

function TGTKControl_key_event(event: PGdkEventKey; user_data : gpointer; KeyDown : boolean): gboolean; 
var Shift: TShiftState;
    Accept: boolean;
begin
  Accept := True;
  Shift := [];
  if event^.state and GDK_SHIFT_MASK = GDK_SHIFT_MASK then Include(Shift, ssShift);
  if event^.state and GDK_CONTROL_MASK = GDK_CONTROL_MASK then Include(Shift, ssCtrl);
  if event^.state and GDK_MOD1_MASK = GDK_MOD1_MASK then Include(Shift, ssAlt);
  if KeyDown then begin
    if Assigned(TGTKControl(user_data).FOnKeyDown) then TGTKControl(user_data).FOnKeyDown(TGTKControl(user_data), event^.keyval,
                                                                                          Shift, Accept);
  end else  if Assigned(TGTKControl(user_data).FOnKeyUp) then TGTKControl(user_data).FOnKeyUp(TGTKControl(user_data), event^.keyval,
                                                                                          Shift, Accept);
  Result := not Accept;
end;

function TGTKControl_key_press_event(widget: PGtkWidget; event: PGdkEventKey; user_data : gpointer): gboolean; cdecl;
begin
  Result := TGTKControl_key_event(event, user_data, True);
end;

function TGTKControl_key_release_event(widget: PGtkWidget; event: PGdkEventKey; user_data : gpointer): gboolean; cdecl;
begin
  Result := TGTKControl_key_event(event, user_data, False);
end;

procedure TGTKControl.SetOnKeyDown(Value: TGDKKeyEvent);
begin
  if @FOnKeyDown <> @Value then begin
    FOnKeyDown := Value;
    if Assigned(Value)
      then FKeyDownSignalHandler := g_signal_connect(PGtkObject(FWidget), 'key-press-event', G_CALLBACK(@TGTKControl_key_press_event), Self)
      else g_signal_handler_disconnect(PGtkObject(FWidget), FKeyDownSignalHandler);
  end;
end;

procedure TGTKControl.SetOnKeyUp(Value: TGDKKeyEvent);
begin
  if @FOnKeyUp <> @Value then begin
    FOnKeyUp := Value;
    if Assigned(Value)
      then FKeyUpSignalHandler := g_signal_connect(PGtkObject(FWidget), 'key-release-event', G_CALLBACK(@TGTKControl_key_release_event), Self)
      else g_signal_handler_disconnect(PGtkObject(FWidget), FKeyUpSignalHandler);
  end;
end;
 
function TGTKControl_focus_in_event(widget: PGtkWidget; event: PGdkEventFocus; user_data : gpointer): gboolean; cdecl;
var Accept: boolean;
begin
  Accept := True;
  if Assigned(TGTKControl(user_data).FOnEnter) then TGTKControl(user_data).FOnEnter(TGTKControl(user_data), Accept);
  Result := not Accept;
end;

function TGTKControl_focus_out_event(widget: PGtkWidget; event: PGdkEventFocus; user_data : gpointer): gboolean; cdecl;
var Accept: boolean;
begin
  Accept := True;
  if Assigned(TGTKControl(user_data).FOnExit) then TGTKControl(user_data).FOnExit(TGTKControl(user_data), Accept);
  Result := not Accept;
end;

procedure TGTKControl.SetOnEnter(Value: TGDKFocusEvent);
begin
  if @FOnEnter <> @Value then begin
    FOnEnter := Value;
    if Assigned(Value)
      then FFocusInSignalHandler := g_signal_connect(PGtkObject(FWidget), 'focus-in-event', G_CALLBACK(@TGTKControl_focus_in_event), Self)
      else g_signal_handler_disconnect(PGtkObject(FWidget), FFocusInSignalHandler);
  end;
end;

procedure TGTKControl.SetOnExit(Value: TGDKFocusEvent);
begin
  if @FOnExit <> @Value then begin
    FOnExit := Value;
    if Assigned(Value)
      then FFocusOutSignalHandler := g_signal_connect(PGtkObject(FWidget), 'focus-out-event', G_CALLBACK(@TGTKControl_focus_out_event), Self)
      else g_signal_handler_disconnect(PGtkObject(FWidget), FFocusOutSignalHandler);
  end;
end;

procedure TGTKControl.SetForegroundColor(Red, Green, Blue: word);
begin
  gtk_widget_modify_fg(FWidget, 0, AllocateColor(FWidget, Red, Green, Blue));
end;

procedure TGTKControl.SetForegroundColor(State: integer; Red, Green, Blue: word);
begin
  gtk_widget_modify_fg(FWidget, State, AllocateColor(FWidget, Red, Green, Blue));
end;

procedure TGTKControl.SetForegroundColor(State: integer; Color: PGdkColor);
begin
  gtk_widget_modify_fg(FWidget, State, Color);
end;

procedure TGTKControl.SetForegroundColor(Color: PGdkColor);
begin
  gtk_widget_modify_fg(FWidget, 0, Color);
end;

procedure TGTKControl.SetBackgroundColor(Red, Green, Blue: word);
begin
  gtk_widget_modify_bg(FWidget, 0, AllocateColor(FWidget, Red, Green, Blue));
end;

procedure TGTKControl.SetBackgroundColor(State: integer; Red, Green, Blue: word);
begin
  gtk_widget_modify_bg(FWidget, State, AllocateColor(FWidget, Red, Green, Blue));
end;

procedure TGTKControl.SetBackgroundColor(State: integer; Color: PGdkColor);
begin
  gtk_widget_modify_bg(FWidget, State, Color);
end;

procedure TGTKControl.SetBackgroundColor(Color: PGdkColor);
begin
  gtk_widget_modify_bg(FWidget, 0, Color);
end;

procedure TGTKControl.SetTextColor(Red, Green, Blue: word);
begin
  gtk_widget_modify_text(FWidget, 0, AllocateColor(FWidget, Red, Green, Blue));
end;

procedure TGTKControl.SetTextColor(State: integer; Red, Green, Blue: word);
begin
  gtk_widget_modify_text(FWidget, State, AllocateColor(FWidget, Red, Green, Blue));
end;

procedure TGTKControl.SetBaseColor(Red, Green, Blue: word);
begin
  gtk_widget_modify_base(FWidget, 0, AllocateColor(FWidget, Red, Green, Blue));
end;

procedure TGTKControl.SetBaseColor(State: integer; Red, Green, Blue: word);
begin
  gtk_widget_modify_base(FWidget, State, AllocateColor(FWidget, Red, Green, Blue));
end;

procedure TGTKControl.SetOnMouseDown(Value: TGDKMouseEvent);
begin
  if @FOnMouseDown <> @Value then begin
    FOnMouseDown := Value;
    if not Assigned(Value) then begin
      if (not Assigned(FPopupMenu)) and (not Assigned(FOnDblClick)) then begin
        g_signal_handler_disconnect(PGtkObject(FWidget), FButtonPressSignalHandler);
        FButtonPressSignalHandler := 0;
      end;
    end else
      if FButtonPressSignalHandler = 0
        then FButtonPressSignalHandler := g_signal_connect(PGtkObject(FWidget), 'button-press-event', G_CALLBACK(@TGTKControl_button_press_event), Self)
  end;
end;

procedure TGTKControl.SetOnDblClick(Value: TGDKMouseEvent);
begin
  if @FOnMouseDown <> @Value then begin
    FOnDblClick := Value;
    if not Assigned(Value) then begin
      if (not Assigned(FPopupMenu)) and (not Assigned(FOnMouseDown)) then begin
        g_signal_handler_disconnect(PGtkObject(FWidget), FButtonPressSignalHandler);
        FButtonPressSignalHandler := 0;
      end;
    end else
      if FButtonPressSignalHandler = 0
        then FButtonPressSignalHandler := g_signal_connect(PGtkObject(FWidget), 'button-press-event', G_CALLBACK(@TGTKControl_button_press_event), Self)
  end;
end;

function TGTKControl_button_release_event(widget: PGtkWidget; event: PGdkEventButton; user_data: gpointer):gboolean; cdecl;
var Shift: TShiftState;
    Accept: boolean;
begin
  Shift := [];
  if event^.state and GDK_SHIFT_MASK = GDK_SHIFT_MASK then Include(Shift, ssShift);
  if event^.state and GDK_CONTROL_MASK = GDK_CONTROL_MASK then Include(Shift, ssCtrl);
  if event^.state and GDK_MOD1_MASK = GDK_MOD1_MASK then Include(Shift, ssAlt);
  Accept := True;
  if Assigned(TGTKControl(user_data).FOnMouseUp)
    then TGTKControl(user_data).FOnMouseUp(TGTKControl(user_data), TGDKMouseButton(event^.button - 1), Shift, Trunc(event^.x), Trunc(event^.y), Accept);
  Result := not Accept;
end;

procedure TGTKControl.SetOnMouseUp(Value: TGDKMouseEvent);
begin
  if @FOnMouseUp <> @Value then begin
    FOnMouseUp := Value;
    if Assigned(Value) then FButtonReleaseSignalHandler := g_signal_connect(PGtkObject(FWidget), 'button-release-event', G_CALLBACK(@TGTKControl_button_release_event), Self)
                       else g_signal_handler_disconnect(PGtkObject(FWidget), FButtonReleaseSignalHandler);
  end;
end;

function TGTKControl_motion_notify_event(widget: PGtkWidget; event: PGdkEventMotion; user_data: gpointer): gboolean; cdecl;
var Shift: TShiftState;
    Button: TGDKMouseButton;
    Accept: boolean;
begin
  Accept := True;
  Result := False;
  if event^.is_hint <> 0 then Exit;
  Shift := [];
  if event^.state and GDK_SHIFT_MASK = GDK_SHIFT_MASK then Include(Shift, ssShift);
  if event^.state and GDK_CONTROL_MASK = GDK_CONTROL_MASK then Include(Shift, ssCtrl);
  if event^.state and GDK_MOD1_MASK = GDK_MOD1_MASK then Include(Shift, ssAlt);
  if event^.state and GDK_BUTTON1_MASK = GDK_BUTTON1_MASK then Button := mbLeft else
  if event^.state and GDK_BUTTON2_MASK = GDK_BUTTON2_MASK then Button := mbMiddle else
  if event^.state and GDK_BUTTON3_MASK = GDK_BUTTON3_MASK then Button := mbRight else
  Button := mbNoButton;
  if Assigned(TGTKControl(user_data).FOnMouseMove)
    then TGTKControl(user_data).FOnMouseMove(TGTKControl(user_data), Button, Shift, Trunc(event^.x), Trunc(event^.y), Accept);
  Result := not Accept;
end;

procedure TGTKControl.SetOnMouseMove(Value: TGDKMouseEvent);
begin
  if @FOnMouseMove <> @Value then begin
    FOnMouseMove := Value;
    if Assigned(Value) then FMotionNotifyHandler := g_signal_connect(PGtkObject(FWidget), 'motion-notify-event', G_CALLBACK(@TGTKControl_motion_notify_event), Self)
                       else g_signal_handler_disconnect(PGtkObject(FWidget), FMotionNotifyHandler);
  end;
end;

function TGTKControl.GetDefault: boolean;
begin
  Result := False;
  if (csDestroying in ComponentState) then Exit;
  Result := GTK_WIDGET_HAS_DEFAULT(FWidget);
end;

procedure TGTKControl.SetDefault(Value: boolean);
begin
  if (csDestroying in ComponentState) then Exit;
  GTK_WIDGET_SET_FLAGS(FWidget, GTK_CAN_DEFAULT);
//  gtk_widget_grab_default(FWidget);
end;

procedure TGTKControl.Invalidate;
begin
  if (csDestroying in ComponentState) then Exit;
  gtk_widget_queue_draw(FWidget);
end;

procedure TGTKControl.SetAlignment(XAlign, YAlign: Double);
begin
  gtk_misc_set_alignment(PGtkMisc(FWidget), XAlign, YAlign);
end;

procedure TGTKControl.SetPadding(XPad, YPad: integer);
begin
  gtk_misc_set_padding(PGtkMisc(FWidget), XPad, YPad);
end;

function TGTKControl_expose_event(widget: PGtkWidget; event: PGdkEventExpose; user_data: gpointer):gboolean; cdecl;
var Accept: boolean;
begin
  Accept := True;
  if Assigned(TGTKControl(user_data).FOnExpose)
    then TGTKControl(user_data).FOnExpose(TGTKControl(user_data), @event^.area, Accept);
  Result := not Accept;
end;

procedure TGTKControl.SetOnExpose(Value: TGDKExposeEvent);
begin
  if @FOnExpose <> @Value then begin
    FOnExpose := Value;
    if Assigned(Value)
      then FExposeSignalHandler := g_signal_connect(PGtkObject(FWidget), 'expose-event', G_CALLBACK(@TGTKControl_expose_event), Self)
      else g_signal_handler_disconnect(PGtkObject(FWidget), FExposeSignalHandler);
  end;
end;

function TGTKControl.GetControlState: TGTKControlState;
begin
  Result := TGTKControlState(FWidget^.state);
end;

procedure TGTKControl.SetControlState(Value: TGTKControlState);
begin
  gtk_widget_set_state(FWidget, integer(Value));
end;

function TGTKControl.GetData(Key: string): Pointer;
begin
  Result := g_object_get_data(G_OBJECT(FWidget), PChar(Key));
end;

procedure TGTKControl.SetData(Key: string; Value: Pointer);
begin
  g_object_set_data(G_OBJECT(FWidget), PChar(Key), Value);
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGTKContainer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TGTKContainer.Destroy;
begin
  inherited Destroy;
end;

function TGTKContainer.GetBorderWidth: integer;
begin
  Result := gtk_container_get_border_width(PGtkContainer(FWidget));
end;

procedure TGTKContainer.SetBorderWidth(Value: integer);
begin
  gtk_container_set_border_width(PGtkContainer(FWidget), Value);
end;

procedure TGTKContainer.AddControl(AControl: TGTKControl);
begin
  gtk_container_add(PGtkContainer(FWidget), AControl.FWidget);
end;

procedure TGTKContainer.RemoveControl(AControl: TGTKControl);
begin
  gtk_container_remove(PGtkContainer(FWidget), AControl.FWidget);
end;

function TGTKContainer.GetChildrenCount: integer;
begin
  Result := g_list_length(gtk_container_get_children(PGtkContainer(FWidget)));
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGTKBin.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TGTKBin.Destroy;
begin
  inherited Destroy;
end;

function TGTKBin.GetChildControl: PGtkWidget;
begin
  Result := gtk_bin_get_child(PGtkBin(FWidget));
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGTKBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLinked := False;
end;

constructor TGTKBox.CreateLinked(AOwner: TComponent; Widget: PGtkWidget);
begin
  inherited Create(AOwner);
  FLinked := True;
  FWidget := Widget;
  Show;
end;

destructor TGTKBox.Destroy;
begin
  if not FLinked then inherited Destroy;
end;

procedure TGTKBox.AddControl(Control: TGTKControl);
begin
  gtk_box_pack_start_defaults(PGtkBox(FWidget), Control.FWidget);
end;

procedure TGTKBox.AddControlEnd(Control: TGTKControl);
begin
  gtk_box_pack_end_defaults(PGtkBox(FWidget), Control.FWidget);
end;

procedure TGTKBox.AddControlEx(Control: TGTKControl; Expand, Fill: boolean; Padding: integer);
begin
  gtk_box_pack_start(PGtkBox(FWidget), Control.FWidget, Expand, Fill, Padding);
end;

procedure TGTKBox.AddControlEndEx(Control: TGTKControl; Expand, Fill: boolean; Padding: integer);
begin
  gtk_box_pack_end(PGtkBox(FWidget), Control.FWidget, Expand, Fill, Padding);
end;

function TGTKBox.GetHomogeneous: boolean;
begin
  Result := gtk_box_get_homogeneous(PGtkBox(FWidget));
end;

procedure TGTKBox.SetHomogeneous(Value: boolean);
begin
  gtk_box_set_homogeneous(PGtkBox(FWidget), Value);
end;

function TGTKBox.GetSpacing: integer;
begin
  Result := gtk_box_get_spacing(PGtkBox(FWidget));
end;

procedure TGTKBox.SetSpacing(Value: integer);
begin
  gtk_box_set_spacing(PGtkBox(FWidget), Value);
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGTKHBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if ClassName = 'TGTKHBox' then begin
    FWidget := gtk_hbox_new(True, 0);
    Show;
  end;
end;

destructor TGTKHBox.Destroy;
begin
  inherited Destroy;
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGTKVBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if ClassName = 'TGTKVBox' then begin
    FWidget := gtk_vbox_new(False, 0);
    Show;
  end;
end;

destructor TGTKVBox.Destroy;
begin
  inherited Destroy;
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGTKTooltips.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FObject := gtk_tooltips_new;
end;

destructor TGTKTooltips.Destroy;
begin
  inherited Destroy;
end;

function TGTKTooltips.GetEnabled: boolean;
begin
  Result := Boolean(gtk2.enabled(FObject^));
end;

procedure TGTKTooltips.SetEnabled(Value: boolean);
begin
  if Value then gtk_tooltips_enable(FObject)
           else gtk_tooltips_disable(FObject);
end;


(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGTKEventBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWidget := gtk_event_box_new;
  Show;
end;

destructor TGTKEventBox.Destroy;
begin
  inherited Destroy;
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGTKTable.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWidget := gtk_table_new(0, 0, False);
  Show;
end;

destructor TGTKTable.Destroy;
begin
  inherited Destroy;
end;

function TGTKTable.GetRowCount: integer;
begin
  Result := PGtkTable(FWidget)^.nrows;
end;

procedure TGTKTable.SetRowCount(Value: integer);
begin
  SetRowColCount(Value, ColCount);
end;

function TGTKTable.GetColCount: integer;
begin
  Result := PGtkTable(FWidget)^.ncols;
end;

procedure TGTKTable.SetColCount(Value: integer);
begin
  SetRowColCount(RowCount, Value);
end;

procedure TGTKTable.SetRowColCount(Rows, Cols: integer);
begin
  gtk_table_resize(PGtkTable(FWidget), Rows, Cols);
end;

function TGTKTable.GetRowSpacing: integer;
begin
  Result := gtk_table_get_default_row_spacing(PGtkTable(FWidget));
end;

procedure TGTKTable.SetRowSpacing(Value: integer);
begin
  gtk_table_set_row_spacings(PGtkTable(FWidget), Value);
end;

function TGTKTable.GetColSpacing: integer;
begin
  Result := gtk_table_get_default_col_spacing(PGtkTable(FWidget));
end;

procedure TGTKTable.SetColSpacing(Value: integer);
begin
  gtk_table_set_col_spacings(PGtkTable(FWidget), Value);
end;

function TGTKTable.GetHomogeneous: boolean;
begin
  Result := gtk_table_get_homogeneous(PGtkTable(FWidget));
end;

procedure TGTKTable.SetHomogeneous(Value: boolean);
begin
  gtk_table_set_homogeneous(PGtkTable(FWidget), Value);
end;

procedure TGTKTable.AddControl(Column, Row, NumCols, NumRows: integer; Control: TGTKControl; XPadding, YPadding: integer);
begin
  gtk_table_attach(PGtkTable(FWidget), Control.FWidget, Column, Column + NumCols, Row, Row + NumRows,
                   GTK_EXPAND or GTK_SHRINK or GTK_FILL, GTK_EXPAND or GTK_SHRINK or GTK_FILL, XPadding, YPadding);
end;

procedure TGTKTable.AddControlEx(Column, Row, NumCols, NumRows: integer; Control: TGTKControl; XAttachOptions,
                                 YAttachOptions: TGTKTableAttachOptions; XPadding, YPadding: integer);
begin
  gtk_table_attach(PGtkTable(FWidget), Control.FWidget, Column, Column + NumCols, Row, Row + NumRows,
                   (GTK_EXPAND*Ord(taoExpand in XAttachOptions)) or (GTK_SHRINK*Ord(taoShrink in XAttachOptions)) or (GTK_FILL*Ord(taoFill in XAttachOptions)),
                   (GTK_EXPAND*Ord(taoExpand in YAttachOptions)) or (GTK_SHRINK*Ord(taoShrink in YAttachOptions)) or (GTK_FILL*Ord(taoFill in YAttachOptions)),
                   XPadding, YPadding);
end;


(********************************************************************************************************************************)
(********************************************************************************************************************************)



end.