summaryrefslogtreecommitdiff
path: root/libgtk_kylix
diff options
context:
space:
mode:
Diffstat (limited to 'libgtk_kylix')
-rw-r--r--libgtk_kylix/GTKClasses.pas174
-rw-r--r--libgtk_kylix/GTKConsts.pas259
-rw-r--r--libgtk_kylix/GTKControls.pas1050
-rw-r--r--libgtk_kylix/GTKDialogs.pas248
-rw-r--r--libgtk_kylix/GTKExtCtrls.pas707
-rw-r--r--libgtk_kylix/GTKForms.pas874
-rw-r--r--libgtk_kylix/GTKMenus.pas530
-rw-r--r--libgtk_kylix/GTKPixbuf.pas214
-rw-r--r--libgtk_kylix/GTKStdCtrls.pas1008
-rw-r--r--libgtk_kylix/GTKText.pas167
-rw-r--r--libgtk_kylix/GTKUtils.pas212
-rw-r--r--libgtk_kylix/GTKView.pas1376
12 files changed, 6819 insertions, 0 deletions
diff --git a/libgtk_kylix/GTKClasses.pas b/libgtk_kylix/GTKClasses.pas
new file mode 100644
index 0000000..af61b66
--- /dev/null
+++ b/libgtk_kylix/GTKClasses.pas
@@ -0,0 +1,174 @@
+(*
+ GTK-Kylix Library: GTKClasses - Non-visual objects
+ Version 0.6.4 (last updated 2003-04-03)
+ Copyright (C) 2003 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 GTKClasses;
+{ $WEAKPACKAGEUNIT}
+
+interface
+
+uses gtk2, gdk2, glib2, Classes, SysUtils;
+
+
+type
+ TGDKColor = record
+ pixel: Cardinal;
+ red, green, blue: Word;
+ end;
+
+(****************************************** TGLIST ******************************************************************************)
+ TGList = class(TComponent)
+ private
+ FNotify: TNotifyEvent;
+ public
+ FList: PGList;
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Append(Data: Pointer); overload;
+ procedure Append(Data: string); overload;
+ procedure Delete(Index: integer);
+ function Count: integer;
+ published
+ property Notify: TNotifyEvent read FNotify write FNotify;
+ end;
+
+(****************************************** TGTKTIMER ***************************************************************************)
+ TGTKTimer = class(TComponent)
+ private
+ FOnTimer: TNotifyEvent;
+ FHandlerID: guint;
+ FEnabled: boolean;
+ FInterval: Cardinal;
+ procedure SetEnabled(Value: boolean);
+ procedure SetInterval(Value: Cardinal);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Start;
+ procedure Stop;
+ published
+ property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
+ property Enabled: boolean read FEnabled write SetEnabled default False;
+ property Interval: Cardinal read FInterval write SetInterval;
+ end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+implementation
+
+uses GTKUtils;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGList.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FList := nil;
+ FNotify := nil;
+end;
+
+destructor TGList.Destroy;
+begin
+ g_list_free(FList);
+ inherited Destroy;
+end;
+
+procedure TGList.Append(Data: Pointer);
+begin
+ FList := g_list_append(FList, Data);
+ if Assigned(FNotify) then FNotify(Self);
+end;
+
+procedure TGList.Append(Data: string);
+begin
+ Append(Pointer(StringToPgchar(Data)));
+end;
+
+procedure TGList.Delete(Index: integer);
+var El: PGSList;
+begin
+ El := g_list_nth_data(FList, Index);
+ if El <> nil then FList := g_list_remove(FList, El);
+end;
+
+function TGList.Count: integer;
+begin
+ Result := 0;
+ if FList <> nil then Result := g_list_length(FList);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKTimer.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOnTimer := nil;
+ FEnabled := False;
+ FInterval := 0;
+ FHandlerID := 0;
+end;
+
+destructor TGTKTimer.Destroy;
+begin
+ SetEnableD(False);
+ inherited Destroy;
+end;
+
+procedure TGTKTimer.SetEnabled(Value: boolean);
+begin
+ if Value <> FEnabled then begin
+ FEnabled := Value;
+ if Value then Start
+ else Stop;
+ end;
+end;
+
+procedure TGTKTimer.SetInterval(Value: Cardinal);
+begin
+ if FInterval <> Value then begin
+ FInterval := Value;
+ Stop;
+ Start;
+ end;
+end;
+
+function TGTKTimer_Timeout(data: gpointer): gboolean; cdecl;
+begin
+ if Assigned(TGTKTimer(data).FOnTimer) then TGTKTimer(data).FOnTimer(TGTKTimer(data));
+ Result := True;
+end;
+
+procedure TGTKTimer.Start;
+begin
+ if FHandlerID > 0 then Stop;
+ if FEnabled then FHandlerID := gtk_timeout_add(FInterval, TGTKTimer_Timeout, Self);
+end;
+
+procedure TGTKTimer.Stop;
+begin
+ if FHandlerID > 0 then gtk_timeout_remove(FHandlerID);
+ FHandlerID := 0;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+
+end.
diff --git a/libgtk_kylix/GTKConsts.pas b/libgtk_kylix/GTKConsts.pas
new file mode 100644
index 0000000..b839b23
--- /dev/null
+++ b/libgtk_kylix/GTKConsts.pas
@@ -0,0 +1,259 @@
+(*
+ GTK-Kylix Library: GTKConsts - Various constants, mainly key codes
+ Version 0.5.20 (last updated 2003-01-25)
+ Copyright (C) 2003 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 GTKConsts;
+{ $WEAKPACKAGEUNIT}
+
+interface
+
+uses glib2, gdk2, gtk2;
+
+const // copied from gdkkeysyms
+ GDK_BackSpace = $FF08;
+ GDK_Tab = $FF09;
+ GDK_Linefeed = $FF0A;
+ GDK_Clear_Key = $FF0B;
+ GDK_Return = $FF0D;
+ GDK_Pause = $FF13;
+ GDK_Scroll_Lock = $FF14;
+ GDK_Sys_Req = $FF15;
+ GDK_Escape = $FF1B;
+ GDK_Delete_Key = $FFFF;
+ GDK_Home = $FF50;
+ GDK_Left = $FF51;
+ GDK_Up = $FF52;
+ GDK_Right = $FF53;
+ GDK_Down = $FF54;
+ GDK_Prior = $FF55;
+ GDK_Page_Up = $FF55;
+ GDK_Next = $FF56;
+ GDK_Page_Down = $FF56;
+ GDK_End = $FF57;
+ GDK_Insert = $FF63;
+ GDK_Num_Lock = $FF7F;
+ GDK_KP_Space = $FF80;
+ GDK_KP_Tab = $FF89;
+ GDK_KP_Enter = $FF8D;
+ GDK_KP_F1 = $FF91;
+ GDK_KP_F2 = $FF92;
+ GDK_KP_F3 = $FF93;
+ GDK_KP_F4 = $FF94;
+ GDK_KP_Home = $FF95;
+ GDK_KP_Left = $FF96;
+ GDK_KP_Up = $FF97;
+ GDK_KP_Right = $FF98;
+ GDK_KP_Down = $FF99;
+ GDK_KP_Prior = $FF9A;
+ GDK_KP_Page_Up = $FF9A;
+ GDK_KP_Next = $FF9B;
+ GDK_KP_Page_Down = $FF9B;
+ GDK_KP_End = $FF9C;
+ GDK_KP_PLUS = 65451;
+ GDK_KP_MINUS = 65453;
+ GDK_KP_ASTERISK = 65450;
+ GDK_KP_SLASH = 65455;
+ GDK_KP_0 = $FFB0;
+ GDK_KP_1 = $FFB1;
+ GDK_KP_2 = $FFB2;
+ GDK_KP_3 = $FFB3;
+ GDK_KP_4 = $FFB4;
+ GDK_KP_5 = $FFB5;
+ GDK_KP_6 = $FFB6;
+ GDK_KP_7 = $FFB7;
+ GDK_KP_8 = $FFB8;
+ GDK_KP_9 = $FFB9;
+ GDK_F1 = $FFBE;
+ GDK_F2 = $FFBF;
+ GDK_F3 = $FFC0;
+ GDK_F4 = $FFC1;
+ GDK_F5 = $FFC2;
+ GDK_F6 = $FFC3;
+ GDK_F7 = $FFC4;
+ GDK_F8 = $FFC5;
+ GDK_F9 = $FFC6;
+ GDK_F10 = $FFC7;
+ GDK_F11 = $FFC8;
+ GDK_L1 = $FFC8;
+ GDK_F12 = $FFC9;
+ GDK_L2 = $FFC9;
+ GDK_F13 = $FFCA;
+ GDK_L3 = $FFCA;
+ GDK_F14 = $FFCB;
+ GDK_L4 = $FFCB;
+ GDK_F15 = $FFCC;
+ GDK_L5 = $FFCC;
+ GDK_F16 = $FFCD;
+ GDK_L6 = $FFCD;
+ GDK_F17 = $FFCE;
+ GDK_L7 = $FFCE;
+ GDK_F18 = $FFCF;
+ GDK_L8 = $FFCF;
+ GDK_F19 = $FFD0;
+ GDK_L9 = $FFD0;
+ GDK_F20 = $FFD1;
+ GDK_L10 = $FFD1;
+ GDK_F21 = $FFD2;
+ GDK_R1 = $FFD2;
+ GDK_F22 = $FFD3;
+ GDK_R2 = $FFD3;
+ GDK_F23 = $FFD4;
+ GDK_R3 = $FFD4;
+ GDK_F24 = $FFD5;
+ GDK_R4 = $FFD5;
+ GDK_F25 = $FFD6;
+ GDK_R5 = $FFD6;
+ GDK_F26 = $FFD7;
+ GDK_R6 = $FFD7;
+ GDK_F27 = $FFD8;
+ GDK_R7 = $FFD8;
+ GDK_F28 = $FFD9;
+ GDK_R8 = $FFD9;
+ GDK_F29 = $FFDA;
+ GDK_R9 = $FFDA;
+ GDK_F30 = $FFDB;
+ GDK_R10 = $FFDB;
+ GDK_F31 = $FFDC;
+ GDK_R11 = $FFDC;
+ GDK_F32 = $FFDD;
+ GDK_R12 = $FFDD;
+ GDK_F33 = $FFDE;
+ GDK_R13 = $FFDE;
+ GDK_F34 = $FFDF;
+ GDK_R14 = $FFDF;
+ GDK_F35 = $FFE0;
+ GDK_R15 = $FFE0;
+ GDK_space = $020;
+ GDK_exclam = $021;
+ GDK_quotedbl = $022;
+ GDK_numbersign = $023;
+ GDK_dollar = $024;
+ GDK_percent = $025;
+ GDK_ampersand = $026;
+ GDK_apostrophe = $027;
+ GDK_quoteright = $027;
+ GDK_parenleft = $028;
+ GDK_parenright = $029;
+ GDK_asterisk = $02a;
+ GDK_plus_key = $02b;
+ GDK_comma = $02c;
+ GDK_minus = $02d;
+ GDK_period = $02e;
+ GDK_slash = $02f;
+ GDK_0 = $030;
+ GDK_1 = $031;
+ GDK_2 = $032;
+ GDK_3 = $033;
+ GDK_4 = $034;
+ GDK_5 = $035;
+ GDK_6 = $036;
+ GDK_7 = $037;
+ GDK_8 = $038;
+ GDK_9 = $039;
+ GDK_colon = $03a;
+ GDK_semicolon = $03b;
+ GDK_less = $03c;
+ GDK_equal = $03d;
+ GDK_greater = $03e;
+ GDK_question = $03f;
+ GDK_at = $040;
+ GDK_Capital_A = $041;
+ GDK_Capital_B = $042;
+ GDK_Capital_C = $043;
+ GDK_Capital_D = $044;
+ GDK_Capital_E = $045;
+ GDK_Capital_F = $046;
+ GDK_Capital_G = $047;
+ GDK_Capital_H = $048;
+ GDK_Capital_I = $049;
+ GDK_Capital_J = $04a;
+ GDK_Capital_K = $04b;
+ GDK_Capital_L = $04c;
+ GDK_Capital_M = $04d;
+ GDK_Capital_N = $04e;
+ GDK_Capital_O = $04f;
+ GDK_Capital_P = $050;
+ GDK_Capital_Q = $051;
+ GDK_Capital_R = $052;
+ GDK_Capital_S = $053;
+ GDK_Capital_T = $054;
+ GDK_Capital_U = $055;
+ GDK_Capital_V = $056;
+ GDK_Capital_W = $057;
+ GDK_Capital_X = $058;
+ GDK_Capital_Y = $059;
+ GDK_Capital_Z = $05a;
+ GDK_bracketleft = $05b;
+ GDK_backslash = $05c;
+ GDK_bracketright = $05d;
+ GDK_quoteleft = $060;
+ GDK_a = $061;
+ GDK_b = $062;
+ GDK_c = $063;
+ GDK_d = $064;
+ GDK_e = $065;
+ GDK_f = $066;
+ GDK_g = $067;
+ GDK_h = $068;
+ GDK_i = $069;
+ GDK_j = $06a;
+ GDK_k = $06b;
+ GDK_l = $06c;
+ GDK_m = $06d;
+ GDK_n = $06e;
+ GDK_o = $06f;
+ GDK_p = $070;
+ GDK_q = $071;
+ GDK_r = $072;
+ GDK_s = $073;
+ GDK_t = $074;
+ GDK_u = $075;
+ GDK_v = $076;
+ GDK_w = $077;
+ GDK_x = $078;
+ GDK_y = $079;
+ GDK_z = $07a;
+ GDK_aacute = $0e1;
+ GDK_leftarrow = $8fb;
+ GDK_uparrow = $8fc;
+ GDK_rightarrow = $8fd;
+ GDK_downarrow = $8fe;
+ GDK_WIN_POPUP = $FF67;
+
+ NumMessageButtons = 12;
+ MessageButtonID : array[1..NumMessageButtons] of Pgchar =
+ (GTK_STOCK_YES, GTK_STOCK_NO, GTK_STOCK_OK, GTK_STOCK_CANCEL, GTK_STOCK_APPLY, GTK_STOCK_CLOSE, GTK_STOCK_HELP,
+ GTK_STOCK_PRINT, GTK_STOCK_QUIT, GTK_STOCK_STOP, GTK_STOCK_GO_BACK, GTK_STOCK_GO_FORWARD);
+
+resourcestring
+ SCDefaultMenuItemCaption = 'MenuItem';
+ SCDefaultButtonCaption = 'Button';
+ SCDefaultLabelCaption = 'Label';
+ SCDefaultToggleButtonCaption = 'ToggleButton';
+ SCDefaultCheckButtonCaption = 'CheckButton';
+ SCDefaultRadioButtonCaption = 'RadioButton';
+ SCDefaultFrameCaption = 'Frame';
+
+
+implementation
+
+
+end.
diff --git a/libgtk_kylix/GTKControls.pas b/libgtk_kylix/GTKControls.pas
new file mode 100644
index 0000000..8004857
--- /dev/null
+++ b/libgtk_kylix/GTKControls.pas
@@ -0,0 +1,1050 @@
+(*
+ GTK-Kylix Library: GTKControls - Basic objects
+ Version 0.6.22 (last updated 2007-12-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 GTKControls;
+{ $WEAKPACKAGEUNIT}
+
+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);
+ 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: gulong;
+ FOnKeyDown: TGDKKeyEvent;
+ FOnKeyUp: TGDKKeyEvent;
+ FOnEnter: TGDKFocusEvent;
+ FOnExit: TGDKFocusEvent;
+ FOnMouseDown: TGDKMouseEvent;
+ FOnMouseUp: TGDKMouseEvent;
+ FOnDblClick: TGDKMouseEvent;
+ FOnExpose: TGDKExposeEvent;
+ 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);
+ 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 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;
+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(widget).FOnMouseDown) and (event^._type = GDK_BUTTON_PRESS)
+ then TGTKControl(widget).FOnMouseDown(TGTKControl(widget), TGDKMouseButton(event^.button - 1), Shift, Trunc(event^.x), Trunc(event^.y), Accept);
+ if Assigned(TGTKControl(widget).FOnDblClick) and (event^._type = GDK_2BUTTON_PRESS)
+ then TGTKControl(widget).FOnDblClick(TGTKControl(widget), 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(widget).FPopupMenu) then begin
+// if Assigned(TGTKMenuItem(TGTKControl(widget).FPopupMenu).OnPopup) then TGTKMenuItem(TGTKControl(widget).FPopupMenu).OnPopup(TGTKMenuItem(TGTKControl(widget).FPopupMenu));
+ if Assigned(TGTKMenuItem(TGTKControl(widget).FPopupMenu).OnPopup) then TGTKMenuItem(TGTKControl(widget).FPopupMenu).OnPopup(TGTKControl(widget));
+ gtk_menu_popup(PGtkMenu(TGTKMenuItem(TGTKControl(widget).FPopupMenu).FMenu), nil, nil, nil, nil, event^.button, event^.time);
+ Result := True;
+ 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_swapped(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_swapped(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_swapped(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(widget).FOnMouseUp)
+ then TGTKControl(widget).FOnMouseUp(TGTKControl(widget), 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_swapped(PGtkObject(FWidget), 'button-release-event', G_CALLBACK(@TGTKControl_button_release_event), Self)
+ else g_signal_handler_disconnect(PGtkObject(FWidget), FButtonReleaseSignalHandler);
+ 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.
diff --git a/libgtk_kylix/GTKDialogs.pas b/libgtk_kylix/GTKDialogs.pas
new file mode 100644
index 0000000..eb24ccc
--- /dev/null
+++ b/libgtk_kylix/GTKDialogs.pas
@@ -0,0 +1,248 @@
+(*
+ GTK-Kylix Library: GTKDialogs - Special purpose dialogs
+ Version 0.7.0 (last updated 2006-02-05)
+ Copyright (C) 2006 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 GTKDialogs;
+{ $WEAKPACKAGEUNIT}
+
+interface
+
+uses gtk2, gdk2, glib2, Classes, GTKControls, GTKConsts, GTKUtils, GTKClasses, GTKForms;
+
+
+type
+
+(****************************************** TGTKFILESELECTIONDIALOG *************************************************************)
+ TGTKFileSelectionDialog = class(TGTKDialog)
+ private
+ function GetFileName: string;
+ function GetShowFileOpButtons: boolean;
+ function GetMultiSelect: boolean;
+ procedure SetFileName(Value: string);
+ procedure SetShowFileOpButtons(Value: boolean);
+ procedure SetMultiSelect(Value: boolean);
+ protected
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateWithTitle(AOwner: TComponent; const Title: string);
+ destructor Destroy; override;
+ published
+ property FileName: string read GetFileName write SetFileName;
+ property ShowFileOpButtons: boolean read GetShowFileOpButtons write SetShowFileOpButtons;
+ property MultiSelect: boolean read GetMultiSelect write SetMultiSelect;
+ end;
+
+(****************************************** TGTKCOLORSELECTIONDIALOG ************************************************************)
+ TGTKColorSelectionDialog = class(TGTKDialog)
+ private
+ function GetShowOpacity: boolean;
+ procedure SetShowOpacity(Value: boolean);
+ function GetShowPalette: boolean;
+ procedure SetShowPalette(Value: boolean);
+ function GetColor: TGDKColor;
+ procedure SetColor(Value: TGDKColor);
+ protected
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateWithTitle(AOwner: TComponent; const Title: string);
+ destructor Destroy; override;
+ property Color: TGDKColor read GetColor write SetColor;
+ published
+ property ShowOpacity: boolean read GetShowOpacity write SetShowOpacity;
+ property ShowPalette: boolean read GetShowPalette write SetShowPalette;
+ end;
+
+(****************************************** TGTKFONTSELECTIONDIALOG *************************************************************)
+ TGTKFontSelectionDialog = class(TGTKDialog)
+ private
+ function GetFontName: string;
+ procedure SetFontName(Value: string);
+ function GetPreviewText: string;
+ procedure SetPreviewText(Value: string);
+ protected
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateWithTitle(AOwner: TComponent; const Title: string);
+ destructor Destroy; override;
+ published
+ property FontName: string read GetFontName write SetFontName;
+ property PreviewText: string read GetPreviewText write SetPreviewText;
+ end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+implementation
+
+uses SysUtils, DateUtils;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKFileSelectionDialog.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_file_selection_new(nil);
+ Show;
+end;
+
+constructor TGTKFileSelectionDialog.CreateWithTitle(AOwner: TComponent; const Title: string);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_file_selection_new(StringToPgchar(Title));
+ Show;
+end;
+
+destructor TGTKFileSelectionDialog.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKFileSelectionDialog.GetFileName: string;
+begin
+ Result := string(gtk_file_selection_get_filename(PGtkFileSelection(FWidget)));
+end;
+
+procedure TGTKFileSelectionDialog.SetFileName(Value: string);
+begin
+ gtk_file_selection_set_filename(PGtkFileSelection(FWidget), PChar(Value));
+end;
+
+function TGTKFileSelectionDialog.GetShowFileOpButtons: boolean;
+var b: Boolean;
+begin
+ g_object_get(FWidget, 'show-fileops', @b, nil);
+ Result := b;
+end;
+
+procedure TGTKFileSelectionDialog.SetShowFileOpButtons(Value: boolean);
+begin
+ if Value then gtk_file_selection_show_fileop_buttons(PGtkFileSelection(FWidget))
+ else gtk_file_selection_hide_fileop_buttons(PGtkFileSelection(FWidget));
+end;
+
+function TGTKFileSelectionDialog.GetMultiSelect: boolean;
+begin
+ Result := gtk_file_selection_get_select_multiple(PGtkFileSelection(FWidget));
+end;
+
+procedure TGTKFileSelectionDialog.SetMultiSelect(Value: boolean);
+begin
+ gtk_file_selection_set_select_multiple(PGtkFileSelection(FWidget), Value);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKColorSelectionDialog.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_color_selection_dialog_new(nil);
+ Show;
+end;
+
+constructor TGTKColorSelectionDialog.CreateWithTitle(AOwner: TComponent; const Title: string);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_color_selection_dialog_new(StringToPgchar(Title));
+ Show;
+end;
+
+destructor TGTKColorSelectionDialog.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKColorSelectionDialog.GetShowOpacity: boolean;
+begin
+ Result := gtk_color_selection_get_has_opacity_control(PGtkColorSelection(PGtkColorSelectionDialog(FWidget)^.colorsel));
+end;
+
+procedure TGTKColorSelectionDialog.SetShowOpacity(Value: boolean);
+begin
+ gtk_color_selection_set_has_opacity_control(PGtkColorSelection(PGtkColorSelectionDialog(FWidget)^.colorsel), Value);
+end;
+
+function TGTKColorSelectionDialog.GetShowPalette: boolean;
+begin
+ Result := gtk_color_selection_get_has_palette(PGtkColorSelection(PGtkColorSelectionDialog(FWidget)^.colorsel));
+end;
+
+procedure TGTKColorSelectionDialog.SetShowPalette(Value: boolean);
+begin
+ gtk_color_selection_set_has_palette(PGtkColorSelection(PGtkColorSelectionDialog(FWidget)^.colorsel), Value);
+end;
+
+function TGTKColorSelectionDialog.GetColor: TGDKColor;
+var Col: gdk2.TGDkColor;
+begin
+ gtk_color_selection_get_current_color(PGtkColorSelection(PGtkColorSelectionDialog(FWidget)^.colorsel), @Col);
+ Result := PGdkColorToGDKColor(@Col);
+end;
+
+procedure TGTKColorSelectionDialog.SetColor(Value: TGDKColor);
+var Col: PGDkColor;
+begin
+ Col := GDKColorToPGdkColor(Value);
+ gtk_color_selection_set_current_color(PGtkColorSelection(PGtkColorSelectionDialog(FWidget)^.colorsel), Col);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKFontSelectionDialog.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_font_selection_dialog_new(nil);
+ Show;
+end;
+
+constructor TGTKFontSelectionDialog.CreateWithTitle(AOwner: TComponent; const Title: string);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_font_selection_dialog_new(StringToPgchar(Title));
+ Show;
+end;
+
+destructor TGTKFontSelectionDialog.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKFontSelectionDialog.GetFontName: string;
+begin
+ Result := PgcharToString(gtk_font_selection_dialog_get_font_name(PGtkFontSelectionDialog(FWidget)));
+end;
+
+procedure TGTKFontSelectionDialog.SetFontName(Value: string);
+begin
+ gtk_font_selection_dialog_set_font_name(PGtkFontSelectionDialog(FWidget), StringToPgchar(Value));
+end;
+
+function TGTKFontSelectionDialog.GetPreviewText: string;
+begin
+ Result := PgcharToString(gtk_font_selection_dialog_get_preview_text(PGtkFontSelectionDialog(FWidget)));
+end;
+
+procedure TGTKFontSelectionDialog.SetPreviewText(Value: string);
+begin
+ gtk_font_selection_dialog_set_preview_text(PGtkFontSelectionDialog(FWidget), StringToPgchar(Value));
+end;
+
+(********************************************************************************************************************************)
+end.
diff --git a/libgtk_kylix/GTKExtCtrls.pas b/libgtk_kylix/GTKExtCtrls.pas
new file mode 100644
index 0000000..8426d02
--- /dev/null
+++ b/libgtk_kylix/GTKExtCtrls.pas
@@ -0,0 +1,707 @@
+(*
+ GTK-Kylix Library: GTKExtCtrls - Extended visual controls
+ Version 0.6.22 (last updated 2004-11-20)
+ Copyright (C) 2004 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 GTKExtCtrls;
+{ $WEAKPACKAGEUNIT}
+
+interface
+
+uses gtk2, gdk2, glib2, Classes, GTKControls, GTKConsts, GTKStdCtrls, GTKUtils, GTKMenus;
+ // Quick jump: QForms QControls QStdCtrls QExtCtrls
+
+
+type
+
+(****************************************** TGTKSEPARATOR ***********************************************************************)
+ TGTKSeparator = class(TGTKControl)
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ end;
+
+(****************************************** TGTKHSEPARATOR **********************************************************************)
+ TGTKHSeparator = class(TGTKSeparator)
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+(****************************************** TGTKVSEPARATOR **********************************************************************)
+ TGTKVSeparator = class(TGTKSeparator)
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+(****************************************** TGTKHANDLEBOX ***********************************************************************)
+ TGTKHandleBox = class(TGTKBin)
+ private
+ function GetShadowType: TGTKShadowType;
+ function GetHandlePosition: TGTKPosition;
+ function GetSnapEdge: TGTKPosition;
+ procedure SetShadowType(Value: TGTKShadowType);
+ procedure SetHandlePosition(Value: TGTKPosition);
+ procedure SetSnapEdge(Value: TGTKPosition);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property ShadowType: TGTKShadowType read GetShadowType write SetShadowType;
+ property HandlePosition: TGTKPosition read GetHandlePosition write SetHandlePosition;
+ property SnapEdge: TGTKPosition read GetSnapEdge write SetSnapEdge;
+ end;
+
+(****************************************** TGTKPROGRESSBAR *********************************************************************)
+ TGTKProgressBarOrientation = (poLeftToRight, poRightToLeft, poBottomToTop, poTopToBottom);
+ TGTKProgressBar = class(TGTKControl)
+ private
+ FMax: Int64;
+ function GetText: string;
+ function GetFraction: Double;
+ function GetPulseStep: Double;
+ function GetOrientation: TGTKProgressBarOrientation;
+ function GetValue: Int64;
+ procedure SetText(Value: string);
+ procedure SetFraction(Value: Double);
+ procedure SetPulseStep(Value: Double);
+ procedure SetOrientation(Value: TGTKProgressBarOrientation);
+ procedure SetValue(Value: Int64);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Pulse;
+ published
+ property Text: string read GetText write SetText;
+ property Fraction: Double read GetFraction write SetFraction;
+ property PulseStep: Double read GetPulseStep write SetPulseStep;
+ property Orientation: TGTKProgressBarOrientation read GetOrientation write SetOrientation;
+ property Max: Int64 read FMax write FMax;
+ property Value: Int64 read GetValue write SetValue;
+ end;
+
+(****************************************** TGTKPANED ***************************************************************************)
+ TGTKPaned = class(TGTKContainer)
+ private
+ FChild1, FChild2: TGTKControl;
+ FOnResize: TNotifyEvent;
+ function GetPosition: integer;
+ procedure SetPosition(Value: integer);
+ procedure SetChild1(Value: TGTKControl);
+ procedure SetChild2(Value: TGTKControl);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property Child1: TGTKControl read FChild1 write SetChild1;
+ property Child2: TGTKControl read FChild2 write SetChild2;
+ property Position: integer read GetPosition write SetPosition;
+ property OnResize: TNotifyEvent read FOnResize write FOnResize;
+ end;
+
+(****************************************** TGTKHPANED **************************************************************************)
+ TGTKHPaned = class(TGTKPaned)
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+(****************************************** TGTKVPANED **************************************************************************)
+ TGTKVPaned = class(TGTKPaned)
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+(****************************************** TGTKNOTEBOOK ************************************************************************)
+ TGTKNotebook = class(TGTKContainer)
+ private
+ FOnSwitchPage: TNotifyEvent;
+ function GetPageIndex: integer;
+ function GetTabPosition: TGTKPosition;
+ function GetShowTabs: boolean;
+ function GetShowBorder: boolean;
+ function GetScrollable: boolean;
+ procedure SetPageIndex(Value: integer);
+ procedure SetTabPosition(Value: TGTKPosition);
+ procedure SetShowTabs(Value: boolean);
+ procedure SetShowBorder(Value: boolean);
+ procedure SetScrollable(Value: boolean);
+ public
+ constructor Create(AOwner: TComponent); virtual;
+ destructor Destroy; virtual;
+ function AppendPage(Child: TGTKControl; Caption: string): integer;
+ procedure RemovePage(PageNo: integer);
+ function GetCaption(PageNo: integer): string;
+ procedure SetCaption(PageNo: integer; Caption: string);
+ procedure NextPage;
+ procedure PrevPage;
+ function GetExpandTab(PageNo: integer): boolean;
+ procedure SetExpandTab(PageNo: integer; Value: boolean);
+ function GetFillTab(PageNo: integer): boolean;
+ procedure SetFillTab(PageNo: integer; Value: boolean);
+ function GetTabLabel(PageNo: integer): TGTKLabel;
+ published
+ property PageIndex: integer read GetPageIndex write SetPageIndex;
+ property TabPosition: TGTKPosition read GetTabPosition write SetTabPosition;
+ property ShowTabs: boolean read GetShowTabs write SetShowTabs;
+ property ShowBorder: boolean read GetShowBorder write SetShowBorder;
+ property Scrollable: boolean read GetScrollable write SetScrollable;
+ property OnSwitchPage: TNotifyEvent read FOnSwitchPage write FOnSwitchPage;
+ end;
+
+(****************************************** TGTKOPTIONMENU **********************************************************************)
+ TGTKOptionMenu = class(TGTKButton)
+ private
+ FItems: TGTKMenuItem;
+ FOnChanged: TNotifyEvent;
+ procedure ItemsChanged(Sender: TObject);
+ function GetItemIndex: integer;
+ procedure SetItemIndex(Value: integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property Items: TGTKMenuItem read FItems;
+ property ItemIndex: integer read GetItemIndex write SetItemIndex;
+ property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
+ end;
+
+(****************************************** TGTKSCROLLEDWINDOW ******************************************************************)
+ TGTKScrollBarPolicy = (sbAlways, sbAutomatic, sbNever);
+ TGTKScrolledWindow = class(TGTKBin)
+ private
+ function GetHorizScrollBarPolicy: TGTKScrollBarPolicy;
+ function GetVertScrollBarPolicy: TGTKScrollBarPolicy;
+ procedure SetHorizScrollBarPolicy(Value: TGTKScrollBarPolicy);
+ procedure SetVertScrollBarPolicy(Value: TGTKScrollBarPolicy);
+ function GetShadowType: TGTKShadowType;
+ procedure SetShadowType(Value: TGTKShadowType);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure AddWithViewPort(Control: TGTKControl);
+ published
+ property HorizScrollBarPolicy: TGTKScrollBarPolicy read GetHorizScrollBarPolicy write SetHorizScrollBarPolicy;
+ property VertScrollBarPolicy: TGTKScrollBarPolicy read GetVertScrollBarPolicy write SetVertScrollBarPolicy;
+ property ShadowType: TGTKShadowType read GetShadowType write SetShadowType;
+ end;
+
+(****************************************** TGTKBUTTONBOX ***********************************************************************)
+ TGTKButtonBoxLayout = (blDefault, blSpread, blEdge, blStart, blEnd);
+ TGTKButtonBox = class(TGTKBox)
+ private
+ function GetLayout: TGTKButtonBoxLayout;
+ procedure SetLayout(Value: TGTKButtonBoxLayout);
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property Layout: TGTKButtonBoxLayout read GetLayout write SetLayout;
+ end;
+
+(****************************************** TGTKHBUTTONBOX **********************************************************************)
+ TGTKHButtonBox = class(TGTKButtonBox)
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+(****************************************** TGTKVBUTTONBOX **********************************************************************)
+ TGTKVButtonBox = class(TGTKButtonBox)
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+implementation
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKSeparator.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+end;
+
+destructor TGTKSeparator.Destroy;
+begin
+ inherited Destroy;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKHSeparator.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_hseparator_new;
+ Show;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKVSeparator.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_vseparator_new;
+ Show;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKHandleBox.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_handle_box_new;
+ Show;
+end;
+
+destructor TGTKHandleBox.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKHandleBox.GetShadowType: TGTKShadowType;
+begin
+ Result := TGTKShadowType(gtk_handle_box_get_shadow_type(PGtkHandleBox(FWidget)));
+end;
+
+procedure TGTKHandleBox.SetShadowType(Value: TGTKShadowType);
+begin
+ gtk_handle_box_set_shadow_type(PGtkHandleBox(FWidget), gtk2.TGtkShadowType(Value));
+end;
+
+function TGTKHandleBox.GetHandlePosition: TGTKPosition;
+begin
+ Result := TGTKPosition(gtk_handle_box_get_handle_position(PGtkHandleBox(FWidget)));
+end;
+
+procedure TGTKHandleBox.SetHandlePosition(Value: TGTKPosition);
+begin
+ gtk_handle_box_set_handle_position(PGtkHandleBox(FWidget), Integer(Value));
+end;
+
+function TGTKHandleBox.GetSnapEdge: TGTKPosition;
+begin
+ Result := TGTKPosition(gtk_handle_box_get_snap_edge(PGtkHandleBox(FWidget)));
+end;
+
+procedure TGTKHandleBox.SetSnapEdge(Value: TGTKPosition);
+begin
+ gtk_handle_box_set_snap_edge(PGtkHandleBox(FWidget), Integer(Value));
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKProgressBar.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FMax := 100;
+ FWidget := gtk_progress_bar_new;
+ Show;
+end;
+
+destructor TGTKProgressBar.Destroy;
+begin
+ inherited Destroy;
+end;
+
+procedure TGTKProgressBar.Pulse;
+begin
+ gtk_progress_bar_pulse(PGtkProgressBar(FWidget));
+end;
+
+function TGTKProgressBar.GetText: string;
+begin
+ Result := PgcharToString(gtk_progress_bar_get_text(PGtkProgressBar(FWidget)));
+end;
+
+procedure TGTKProgressBar.SetText(Value: string);
+begin
+ gtk_progress_bar_set_text(PGtkProgressbar(FWidget), StringToPgchar(Value));
+end;
+
+function TGTKProgressBar.GetFraction: Double;
+begin
+ Result := gtk_progress_bar_get_fraction(PGtkProgressbar(FWidget));
+end;
+
+procedure TGTKProgressBar.SetFraction(Value: Double);
+begin
+ gtk_progress_bar_set_fraction(PGtkProgressbar(FWidget), Value);
+end;
+
+function TGTKProgressBar.GetPulseStep: Double;
+begin
+ Result := gtk_progress_bar_get_pulse_step(PGtkProgressbar(FWidget));
+end;
+
+procedure TGTKProgressBar.SetPulseStep(Value: Double);
+begin
+ gtk_progress_bar_set_pulse_step(PGtkProgressbar(FWidget), Value);
+end;
+
+function TGTKProgressBar.GetOrientation: TGTKProgressBarOrientation;
+begin
+ Result := TGTKProgressBarOrientation(gtk_progress_bar_get_orientation(PGtkProgressBar(FWidget)));
+end;
+
+procedure TGTKProgressBar.SetOrientation(Value: TGTKProgressBarOrientation);
+begin
+ gtk_progress_bar_set_orientation(PGtkProgressbar(FWidget), gtk2.TGtkProgressBarOrientation(Value));
+end;
+
+function TGTKProgressBar.GetValue: Int64;
+begin
+ Result := Round(Fraction * Max);
+end;
+
+procedure TGTKProgressBar.SetValue(Value: Int64);
+begin
+ if FMax = 0 then Fraction := 0
+ else Fraction := Value / FMax;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+
+procedure TGTKPaned_resize(widget : PGtkWidget; allocation : PGtkAllocation; user_data : gpointer); cdecl;
+begin
+ if Assigned(TGTKPaned(user_data).FOnResize) then TGTKPaned(user_data).FOnResize(TGTKPaned(user_data));
+end;
+
+constructor TGTKPaned.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FChild1 := nil;
+ FChild2 := nil;
+end;
+
+destructor TGTKPaned.Destroy;
+begin
+ inherited Destroy;
+end;
+
+procedure TGTKPaned.SetChild1(Value: TGTKControl);
+begin
+ gtk_paned_pack1(PGtkPaned(FWidget), Value.FWidget, True, False);
+ g_signal_connect(PGtkObject(Value.FWidget), 'size-allocate', G_CALLBACK(@TGTKPaned_resize), Self);
+end;
+
+procedure TGTKPaned.SetChild2(Value: TGTKControl);
+begin
+ gtk_paned_pack2(PGtkPaned(FWidget), Value.FWidget, True, False);
+end;
+
+function TGTKPaned.GetPosition: integer;
+begin
+ Result := gtk_paned_get_position(PGtkPaned(FWidget));
+end;
+
+procedure TGTKPaned.SetPosition(Value: integer);
+begin
+ gtk_paned_set_position(PGtkPaned(FWidget), Value);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKHPaned.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_hpaned_new;
+ Show;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKVPaned.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_vpaned_new;
+ Show;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+
+procedure TGTKNotebook_switch_page(notebook: PGtkNotebook; page: PGtkNotebookPage; page_num: guint; user_data: gpointer); cdecl;
+begin
+ if Assigned(user_data) and Assigned(TGTKNotebook(user_data).FOnSwitchPage) then TGTKNotebook(user_data).FOnSwitchPage(user_data);
+end;
+
+constructor TGTKNotebook.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_notebook_new;
+ FOnSwitchPage := nil;
+ g_signal_connect_after(PGtkObject(FWidget), 'switch-page', G_CALLBACK(@TGTKNotebook_switch_page), Self);
+ Show;
+end;
+
+destructor TGTKNotebook.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKNotebook.AppendPage(Child: TGTKControl; Caption: string): integer;
+begin
+ Result := gtk_notebook_append_page(PGtkNotebook(FWidget), Child.FWidget, nil);
+ gtk_notebook_set_tab_label_text(PGtkNotebook(FWidget), Child.FWidget, StringToPgchar(Caption));
+end;
+
+function TGTKNotebook.GetCaption(PageNo: integer): string;
+begin
+ Result := PgcharToString(gtk_notebook_get_tab_label_text(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo)));
+end;
+
+procedure TGTKNotebook.SetCaption(PageNo: integer; Caption: string);
+begin
+ gtk_notebook_set_tab_label_text(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo), StringToPgchar(Caption));
+end;
+
+procedure TGTKNotebook.RemovePage(PageNo: integer);
+begin
+ gtk_notebook_remove_page(PGtkNotebook(FWidget), PageNo);
+end;
+
+function TGTKNotebook.GetPageIndex: integer;
+begin
+ Result := gtk_notebook_get_current_page(PGtkNotebook(FWidget));
+end;
+
+procedure TGTKNotebook.SetPageIndex(Value: integer);
+begin
+ gtk_notebook_set_page(PGtkNotebook(FWidget), Value);
+end;
+
+procedure TGTKNotebook.NextPage;
+begin
+ gtk_notebook_next_page(PGtkNotebook(FWidget));
+end;
+
+procedure TGTKNotebook.PrevPage;
+begin
+ gtk_notebook_prev_page(PGtkNotebook(FWidget));
+end;
+
+function TGTKNotebook.GetTabPosition: TGTKPosition;
+begin
+ Result := TGTKPosition(gtk_notebook_get_tab_pos(PGtkNotebook(FWidget)));
+end;
+
+procedure TGTKNotebook.SetTabPosition(Value: TGTKPosition);
+begin
+ gtk_notebook_set_tab_pos(PGtkNotebook(FWidget), Integer(Value));
+end;
+
+function TGTKNotebook.GetShowTabs: boolean;
+begin
+ Result := gtk_notebook_get_show_tabs(PGtkNotebook(FWidget));
+end;
+
+procedure TGTKNotebook.SetShowTabs(Value: boolean);
+begin
+ gtk_notebook_set_show_tabs(PGtkNotebook(FWidget), Value);
+end;
+
+function TGTKNotebook.GetShowBorder: boolean;
+begin
+ Result := gtk_notebook_get_show_border(PGtkNotebook(FWidget));
+end;
+
+procedure TGTKNotebook.SetShowBorder(Value: boolean);
+begin
+ gtk_notebook_set_show_border(PGtkNotebook(FWidget), Value);
+end;
+
+function TGTKNotebook.GetScrollable: boolean;
+begin
+ Result := gtk_notebook_get_scrollable(PGtkNotebook(FWidget));
+end;
+
+procedure TGTKNotebook.SetScrollable(Value: boolean);
+begin
+ gtk_notebook_set_scrollable(PGtkNotebook(FWidget), Value);
+end;
+
+function TGTKNotebook.GetExpandTab(PageNo: integer): boolean;
+var expand, fill: Pgboolean;
+ packtype: PGtkPackType;
+begin
+ gtk_notebook_query_tab_label_packing(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo), expand, fill, packtype);
+ Result := expand <> nil;
+end;
+
+procedure TGTKNotebook.SetExpandTab(PageNo: integer; Value: boolean);
+begin
+ gtk_notebook_set_tab_label_packing(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo), Value, GetFillTab(PageNo), GTK_PACK_START);
+end;
+
+function TGTKNotebook.GetFillTab(PageNo: integer): boolean;
+var expand, fill: Pgboolean;
+ packtype: PGtkPackType;
+begin
+ gtk_notebook_query_tab_label_packing(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo), expand, fill, packtype);
+ Result := fill <> nil;
+end;
+
+procedure TGTKNotebook.SetFillTab(PageNo: integer; Value: boolean);
+begin
+ gtk_notebook_set_tab_label_packing(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo), GetExpandTab(PageNo), Value, GTK_PACK_START);
+end;
+
+function TGTKNotebook.GetTabLabel(PageNo: integer): TGTKLabel;
+begin
+ Result := TGTKLabel.CreateFromWidget(Self, gtk_notebook_get_tab_label(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo)));
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+procedure TGTKOptionMenu_changed(optionmenu: PGtkOptionMenu; user_data: pgpointer); cdecl;
+begin
+ if Assigned(TGTKOptionMenu(user_data).FOnChanged) then TGTKOptionMenu(user_data).FOnChanged(TGTKOptionMenu(user_data));
+end;
+
+constructor TGTKOptionMenu.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOnChanged := nil;
+ FWidget := gtk_option_menu_new;
+ g_signal_connect(PGtkObject(FWidget), 'changed', G_CALLBACK(@TGTKOptionMenu_changed), Self);
+ Show;
+ FItems := TGTKMenuItem.Create(Self);
+ FItems.FParentMenu := Self;
+ FItems.Notify := ItemsChanged;
+end;
+
+destructor TGTKOptionMenu.Destroy;
+begin
+ FItems.Notify := nil;
+ FItems.Free;
+ inherited Destroy;
+end;
+
+procedure TGTKOptionMenu.ItemsChanged(Sender: TObject);
+begin
+ if Assigned(FItems.FMenu) and (gtk_option_menu_get_menu(PGtkOptionMenu(FWidget)) <> FItems.FMenu)
+ then gtk_option_menu_set_menu(PGtkOptionMenu(FWidget), FItems.FMenu);
+end;
+
+function TGTKOptionMenu.GetItemIndex: integer;
+begin
+ Result := gtk_option_menu_get_history(PGtkOptionMenu(FWidget));
+end;
+
+procedure TGTKOptionMenu.SetItemIndex(Value: integer);
+begin
+ gtk_option_menu_set_history(PGtkOptionMenu(FWidget), Value);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKScrolledWindow.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_scrolled_window_new(nil, nil);
+ Show;
+end;
+
+destructor TGTKScrolledWindow.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKScrolledWindow.GetHorizScrollBarPolicy: TGTKScrollBarPolicy;
+var hscrollbar, vscrollbar: tGtkPolicyType;
+begin
+ gtk_scrolled_window_get_policy(PGtkScrolledWindow(FWidget), @hscrollbar, @vscrollbar);
+ Result := TGTKScrollBarPolicy(hscrollbar);
+end;
+
+procedure TGTKScrolledWindow.SetHorizScrollBarPolicy(Value: TGTKScrollBarPolicy);
+begin
+ gtk_scrolled_window_set_policy(PGtkScrolledWindow(FWidget), TGtkPolicyType(Value), TGtkPolicyType(VertScrollBarPolicy));
+end;
+
+function TGTKScrolledWindow.GetVertScrollBarPolicy: TGTKScrollBarPolicy;
+var hscrollbar, vscrollbar: tGtkPolicyType;
+begin
+ gtk_scrolled_window_get_policy(PGtkScrolledWindow(FWidget), @hscrollbar, @vscrollbar);
+ Result := TGTKScrollBarPolicy(vscrollbar);
+end;
+
+procedure TGTKScrolledWindow.SetVertScrollBarPolicy(Value: TGTKScrollBarPolicy);
+begin
+ gtk_scrolled_window_set_policy(PGtkScrolledWindow(FWidget), TGtkPolicyType(HorizScrollBarPolicy), TGtkPolicyType(Value));
+end;
+
+function TGTKScrolledWindow.GetShadowType: TGTKShadowType;
+begin
+ Result := TGTKShadowType(gtk_scrolled_window_get_shadow_type(PGtkScrolledWindow(FWidget)));
+end;
+
+procedure TGTKScrolledWindow.SetShadowType(Value: TGTKShadowType);
+begin
+ gtk_scrolled_window_set_shadow_type(PGtkScrolledWindow(FWidget), gtk2.TGtkShadowType(Value));
+end;
+
+procedure TGTKScrolledWindow.AddWithViewPort(Control: TGTKControl);
+begin
+ gtk_scrolled_window_add_with_viewport(PGtkScrolledWindow(FWidget), Control.FWidget);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKButtonBox.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+end;
+
+function TGTKButtonBox.GetLayout: TGTKButtonBoxLayout;
+begin
+ Result := TGTKButtonBoxLayout(gtk_button_box_get_layout(PGtkButtonBox(FWidget)));
+end;
+
+procedure TGTKButtonBox.SetLayout(Value: TGTKButtonBoxLayout);
+begin
+ gtk_button_box_set_layout(PGtkButtonBox(FWidget), Integer(Value));
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKHButtonBox.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_hbutton_box_new;
+ Show;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKVButtonBox.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_vbutton_box_new;
+ Show;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+
+
+
+end.
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.
diff --git a/libgtk_kylix/GTKMenus.pas b/libgtk_kylix/GTKMenus.pas
new file mode 100644
index 0000000..2b6e190
--- /dev/null
+++ b/libgtk_kylix/GTKMenus.pas
@@ -0,0 +1,530 @@
+(*
+ GTK-Kylix Library: GTKMenus - Menu handling and related routines
+ Version 0.6.13 (last updated 2003-07-10)
+ Copyright (C) 2003 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 GTKMenus;
+{ $WEAKPACKAGEUNIT}
+
+interface
+
+uses gtk2, gdk2, glib2, Classes, GTKControls, GTKConsts, GTKUtils, GTKPixbuf;
+ // Quick jump: QForms QControls QMenus
+
+
+type
+(****************************************** TGDKSHORTCUTS ***********************************************************************)
+ TGDKShortCut = record
+ Key: word;
+ Locked: boolean;
+ ModAlt: boolean;
+ ModShift: boolean;
+ ModCtrl: boolean;
+ end;
+ TGDKShortCuts = class(TComponent)
+ private
+ FList: TList;
+ FOwner: TGTKControl;
+ function GetCount: Integer;
+ function GetItem(Index: Integer): TGDKShortCut;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Add(Item: TGDKShortCut);
+ procedure AddName(Item: string);
+ procedure Clear;
+ procedure Delete(Index: Integer);
+ procedure Insert(Index: Integer; Item: TGDKShortCut);
+ function IndexOf(Item: TGDKShortCut): Integer;
+ property Count: Integer read GetCount;
+ property Items[Index: Integer]: TGDKShortCut read GetItem; default;
+ end;
+
+(****************************************** TGTKMENUITEM ************************************************************************)
+ TGTKMenuItemType = (itLabel, itSeparator, itTearOff, itCheck, itImageText, itRadio);
+ TGTKMenuItemGroup = PGSList;
+ TGTKMenuItem = class(TGTKBin)
+ private
+ FItems: TList;
+ FTearOffTitle: string;
+ FOnClick: TNotifyEvent;
+ FUKey: guint;
+ FItemType: TGTKMenuItemType;
+ FNotify: TNotifyEvent;
+ FImageWidget: PGtkWidget;
+ FData: Pointer;
+ FOnPopup: TNotifyEvent;
+ function GetCount: Integer;
+ function GetItem(Index: Integer): TGTKMenuItem;
+ function GetCaption: string;
+ function GetRightJustified: boolean;
+ function GetTornOff: boolean;
+ function GetChecked: boolean;
+ function GetGroup: TGTKMenuItemGroup;
+ procedure SetCaption(Value: string);
+ procedure SetTearOffTitle(Value: string);
+ procedure SetRightJustified(Value: boolean);
+ procedure SetItemType(Value: TGTKMenuItemType);
+ procedure SetTornOff(Value: boolean);
+ procedure SetChecked(Value: boolean);
+ procedure SetStockIcon(Value: string);
+ procedure SetIcon(Value: TGDKPixbuf);
+ procedure SetGroup(Value: TGTKMenuItemGroup);
+ protected
+ public
+ FMenu: PGtkWidget;
+ FParentMenu: TGTKControl;
+ ShortCuts: TGDKShortCuts;
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateTyped(AOwner: TComponent; const ItemType: TGTKMenuItemType; AGroup: TGTKMenuItemGroup = nil);
+ destructor Destroy; override;
+ procedure Recreate(AGroup: TGTKMenuItemGroup = nil);
+ procedure Add(Item: TGTKMenuItem);
+ procedure Clear;
+ procedure Delete(Index: Integer);
+ procedure Insert(Index: Integer; Item: TGTKMenuItem);
+ procedure TearOff;
+ procedure UnTearOff;
+ procedure PopUp;
+ procedure PopDown;
+ procedure SetCaptionPlain(Value: string);
+ property Count: Integer read GetCount;
+ property Items[Index: Integer]: TGTKMenuItem read GetItem; default;
+ property Caption: string read GetCaption write SetCaption;
+ property TearOffTitle: string read FTearOffTitle write SetTearOffTitle;
+ property RightJustified: boolean read GetRightJustified write SetRightJustified default False;
+ property OnClick: TNotifyEvent read FOnClick write FOnClick;
+ property ItemType: TGTKMenuItemType read FItemType write SetItemType default itLabel;
+ property TornOff: boolean read GetTornOff write SetTornOff;
+ property Checked: boolean read GetChecked write SetChecked;
+ property Notify: TNotifyEvent read FNotify write FNotify;
+ property StockIcon: string write SetStockIcon;
+ property Icon: TGDKPixbuf write SetIcon;
+ property Data: Pointer read FData write FData;
+ property OnPopup: TNotifyEvent read FOnPopup write FOnPopup;
+ property Group: TGTKMenuItemGroup read GetGroup write SetGroup;
+ end;
+
+
+(****************************************** TGTKMENUBAR *************************************************************************)
+ TGTKMenuBar = class(TGTKContainer)
+ private
+ FItems: TGTKMenuItem;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property Items: TGTKMenuItem read FItems;
+ end;
+
+
+function MakeGDKShortCut(Key: word; Locked, ModAlt, ModShift, ModCtrl : boolean): TGDKShortCut;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+implementation
+
+uses GTKForms, GTKExtCtrls;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKMenuBar.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_menu_bar_new;
+ Show;
+ FItems := TGTKMenuItem.Create(Self);
+ FItems.FParentMenu := Self;
+end;
+
+destructor TGTKMenuBar.Destroy;
+begin
+ if Assigned(FItems) then FItems.Free;
+ inherited Destroy;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+procedure TGTKMenuItem_activate(menuitem : PGtkMenuItem; user_data: pgpointer); cdecl;
+begin
+ if Assigned(TGTKMenuItem(user_data).FOnClick) then TGTKMenuItem(user_data).FOnClick(TGTKMenuItem(user_data));
+end;
+
+constructor TGTKMenuItem.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FItemType := itLabel;
+ FImageWidget := nil;
+ FItems := nil;
+ FMenu := nil;
+ FOnClick := nil;
+ FWidget := nil;
+ FParentMenu := nil;
+ FNotify := nil;
+ FData := nil;
+ FOnPopup := nil;
+ ShortCuts := TGDKShortCuts.Create(Self);
+ FTearOffTitle := '';
+ FUKey := 0;
+ Recreate;
+end;
+
+constructor TGTKMenuItem.CreateTyped(AOwner: TComponent; const ItemType: TGTKMenuItemType; AGroup: TGTKMenuItemGroup = nil);
+begin
+ inherited Create(AOwner);
+ FItemType := ItemType;
+ FImageWidget := nil;
+ FItems := nil;
+ FMenu := nil;
+ FOnClick := nil;
+ FWidget := nil;
+ FParentMenu := nil;
+ FNotify := nil;
+ FData := nil;
+ ShortCuts := TGDKShortCuts.Create(Self);
+ FTearOffTitle := '';
+ FUKey := 0;
+ Recreate(AGroup);
+end;
+
+destructor TGTKMenuItem.Destroy;
+begin
+ if not (csDestroying in ComponentState) then begin
+ ShortCuts.Free;
+ if FItems <> nil then begin
+ Clear;
+ FItems.Free;
+ FItems := nil;
+ end;
+ end;
+ inherited Destroy;
+end;
+
+procedure TGTKMenuItem.Recreate(AGroup: TGTKMenuItemGroup = nil);
+begin
+ if Assigned(FWidget) then begin
+ gtk_widget_unparent(FWidget);
+ gtk_widget_hide(FWidget);
+ gtk_widget_destroy(FWidget);
+ end;
+ case FItemType of
+ itLabel: FWidget := gtk_menu_item_new_with_mnemonic(Pgchar(SCDefaultMenuItemCaption));
+ itSeparator: FWidget := gtk_menu_item_new;
+ itTearOff: FWidget := gtk_tearoff_menu_item_new;
+ itCheck: FWidget := gtk_check_menu_item_new_with_mnemonic(Pgchar(SCDefaultMenuItemCaption));
+ itImageText: begin
+ FWidget := gtk_image_menu_item_new_with_mnemonic(Pgchar(SCDefaultMenuItemCaption));
+ FImageWidget := gtk_image_new;
+ gtk_widget_show(FImageWidget);
+ gtk_image_menu_item_set_image(PGtkImageMenuItem(FWidget), FImageWidget);
+ end;
+ itRadio: FWidget := gtk_radio_menu_item_new_with_mnemonic(AGroup, Pgchar(SCDefaultMenuItemCaption));
+ end;
+ g_signal_connect(PGtkObject(FWidget), 'activate', G_CALLBACK(@TGTKMenuItem_activate), Self);
+ Show;
+end;
+
+procedure TGTKMenuItem.Add(Item: TGTKMenuItem);
+begin
+ Insert(GetCount, Item);
+end;
+
+procedure TGTKMenuItem.Clear;
+var i: Integer;
+begin
+ if Count > 0 then
+ for i := Count - 1 downto 0 do Delete(i);
+end;
+
+function TGTKMenuItem.GetCount: Integer;
+begin
+ if FItems = nil then Result := 0
+ else Result := FItems.Count;
+end;
+
+function TGTKMenuItem.GetItem(Index: Integer): TGTKMenuItem;
+begin
+ Result := nil;
+ if FItems = nil then Exit;
+ Result := FItems[Index];
+end;
+
+procedure TGTKMenuItem.Delete(Index: Integer);
+begin
+ if (Index < 0) or (FItems = nil) or (Index >= GetCount) then Exit;
+ if FParentMenu is TGTKMenuBar
+ then gtk_container_remove(PGtkContainer(Parent.FWidget), TGTKMenuItem(FItems[Index]).FWidget)
+ else gtk_container_remove(PGtkContainer(FMenu), TGTKMenuItem(FItems[Index]).FWidget);
+// Items[Index].Free;
+ FItems.Delete(Index);
+ if FItems.Count = 0 then begin
+ if (FParentMenu is TGTKMenuItem) or (FParentMenu is TGTKMenuBar)
+ then begin
+ if (FParentMenu is TGTKMenuItem) or (FParentMenu is TGTKMenuBar)
+ then gtk_menu_item_remove_submenu(PGtkMenuItem(FWidget));
+ gtk_widget_destroy(FMenu);
+ FMenu := nil;
+ end;
+ FItems.Free;
+ FItems := nil;
+ end;
+ if Assigned(Notify) then Notify(Self);
+end;
+
+procedure TGTKMenuItem.Insert(Index: Integer; Item: TGTKMenuItem);
+begin
+ if (Item = Self) or (FItemType in [itSeparator, itTearOff]) then Exit;
+ if FItems = nil then begin
+ FItems := TList.Create;
+ if FMenu = nil then FMenu := gtk_menu_new;
+ if (FParentMenu is TGTKMenuItem) or (FParentMenu is TGTKMenuBar)
+ then gtk_menu_item_set_submenu(PGtkMenuItem(FWidget), FMenu);
+ SetTearOffTitle(FTearOffTitle);
+ end;
+ Item.FParentMenu := Self;
+ FItems.Insert(Index, Item);
+ if FParentMenu is TGTKMenuBar
+ then gtk_menu_shell_insert(PGtkMenuShell(FParentMenu.FWidget), Item.FWidget, Index)
+ else gtk_menu_shell_insert(PGtkMenuShell(FMenu), Item.FWidget, Index);
+ if Assigned(Notify) then Notify(Self);
+end;
+
+function TGTKMenuItem.GetCaption: string;
+begin
+ Result := '';
+ if FItemType in [itSeparator, itTearOff] then Exit;
+ if Assigned(ChildControl) then Result := PgcharToString(gtk_label_get_text(PGtkLabel(ChildControl)));
+end;
+
+procedure TGTKMenuItem.SetCaption(Value: string);
+begin
+ if FItemType in [itSeparator, itTearOff] then Exit;
+ gtk_label_set_markup_with_mnemonic(PGtkLabel(ChildControl), StringToPgchar(Value));
+ if FTearOffTitle = '' then SetTearOffTitle(Value);
+end;
+
+procedure TGTKMenuItem.SetCaptionPlain(Value: string);
+begin
+ if FItemType in [itSeparator, itTearOff] then Exit;
+ gtk_label_set_markup(PGtkLabel(ChildControl), StringToPgchar(Value));
+ if FTearOffTitle = '' then SetTearOffTitle(Value);
+end;
+
+procedure TGTKMenuItem.SetTearOffTitle(Value: string);
+begin
+ FTearOffTitle := Value;
+ if FItemType = itTearOff then begin
+ if Assigned(FParentMenu) and (FParentMenu is TGTKMenuItem) and Assigned((FParentMenu as TGTKMenuItem).FMenu)
+ then gtk_menu_set_title(PGtkMenu((FParentMenu as TGTKMenuItem).FMenu), StringToPgchar(FTearOffTitle))
+ end else if Assigned(FMenu) then gtk_menu_set_title(PGtkMenu(FMenu), StringToPgchar(FTearOffTitle));
+ end;
+
+function TGTKMenuItem.GetRightJustified: boolean;
+begin
+ Result := False;
+ if FItemType in [itSeparator, itTearOff] then Exit;
+ Result := gtk_menu_item_get_right_justified(PGtkMenuItem(FWidget));
+end;
+
+procedure TGTKMenuItem.SetRightJustified(Value: boolean);
+begin
+ if FItemType in [itSeparator, itTearOff] then Exit;
+ gtk_menu_item_set_right_justified(PGtkMenuItem(FWidget), Value);
+end;
+
+ procedure TGTKMenuItem.SetItemType(Value: TGTKMenuItemType);
+ begin
+ if Value <> FItemType then begin
+ FItemType := Value;
+ Recreate;
+ end;
+ end;
+
+ function TGTKMenuItem.GetTornOff: boolean;
+ begin
+ if FItemType = itTearOff then Result := Boolean(torn_off(PGTKTearOffMenuItem(FWidget)^)) else
+ if Assigned(FMenu) and (Count > 0) then Result := Boolean(torn_off(PGTKMenu(FMenu)^))
+ else Result := False;
+ end;
+
+ procedure TGTKMenuItem.SetTornOff(Value: boolean);
+ begin
+ if FItemType = itTearOff then begin
+ if Assigned(FParentMenu) and (FParentMenu is TGTKMenuItem) and Assigned((FParentMenu as TGTKMenuItem).FMenu)
+ then gtk_menu_set_tearoff_state(PGtkMenu((FParentMenu as TGTKMenuItem).FMenu), Value);
+ end else if Assigned(FMenu) then gtk_menu_set_tearoff_state(PGtkMenu(FMenu), Value);
+ end;
+
+ procedure TGTKMenuItem.TearOff;
+ begin
+ SetTornOff(True);
+ end;
+
+ procedure TGTKMenuItem.UnTearOff;
+begin
+ SetTornOff(False);
+ end;
+
+ function TGTKMenuItem.GetChecked: boolean;
+ begin
+ Result := False;
+ if (FItemType = itCheck) or (FItemType = itRadio) then
+ Result := Boolean(active(PGtkCheckMenuItem(FWidget)^));
+ end;
+
+ procedure TGTKMenuItem.SetChecked(Value: boolean);
+ begin
+ if (FItemType = itCheck) or (FItemType = itRadio) then
+ gtk_check_menu_item_set_active(PGtkCheckMenuItem(FWidget), Value);
+ end;
+
+ procedure TGTKMenuItem.PopUp;
+ begin
+ if FItems.Count > 0 then gtk_menu_popup(PGtkMenu(FMenu), nil, nil, nil, nil, 3, 0);
+end;
+
+ procedure TGTKMenuItem.PopDown;
+ begin
+ if FItems.Count > 0 then gtk_menu_popdown(PGtkMenu(FMenu));
+end;
+
+procedure TGTKMenuItem.SetStockIcon(Value: string);
+begin
+ gtk_image_set_from_stock(PGtkImage(FImageWidget), PChar(Value), GTK_ICON_SIZE_MENU);
+end;
+
+procedure TGTKMenuItem.SetIcon(Value: TGDKPixbuf);
+begin
+ gtk_image_set_from_pixbuf(PGtkImage(FImageWidget), Value.FPixbuf);
+end;
+
+function TGTKMenuItem.GetGroup: TGTKMenuItemGroup;
+begin
+ Result := gtk_radio_menu_item_get_group(PGtkRadioMenuItem(FWidget));
+end;
+
+procedure TGTKMenuItem.SetGroup(Value: TGTKMenuItemGroup);
+begin
+ gtk_radio_menu_item_set_group(PGtkRadioMenuItem(FWidget), Value);
+end;
+
+(********************************************************************************************************************************)
+ (********************************************************************************************************************************)
+constructor TGDKShortCuts.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FList := TList.Create;
+ FOwner := TGTKControl(AOwner);
+end;
+
+destructor TGDKShortCuts.Destroy;
+begin
+ if not (csDestroying in ComponentState) then Clear;
+ inherited Destroy;
+end;
+
+function TGDKShortCuts.GetCount: Integer;
+begin
+ Result := FList.Count;
+end;
+
+procedure TGDKShortCuts.Add(Item: TGDKShortCut);
+begin
+ Insert(GetCount, Item);
+end;
+
+procedure TGDKShortCuts.AddName(Item: string);
+var Key, Modifiers: guint;
+begin
+ gtk_accelerator_parse(StringToPgchar(Item), @Key, @Modifiers);
+ if Key <> 0 then Add(MakeGDKShortCut(Key, False, Modifiers and GDK_MOD1_MASK = GDK_MOD1_MASK, Modifiers and GDK_SHIFT_MASK = GDK_SHIFT_MASK, Modifiers and GDK_CONTROL_MASK = GDK_CONTROL_MASK));
+end;
+
+procedure TGDKShortCuts.Clear;
+var i: Integer;
+begin
+ for i := Count - 1 downto 0 do Delete(i);
+end;
+
+function GetAccelMods(SC: TGDKShortCut): guint;
+begin
+ Result := 0;
+ if SC.ModShift then Inc(Result, GDK_SHIFT_MASK);
+ if SC.ModCtrl then Inc(Result, GDK_CONTROL_MASK);
+ if SC.ModAlt then Inc(Result, GDK_MOD1_MASK);
+end;
+
+function GetAccelFlags(SC: TGDKShortCut): TGtkAccelFlags;
+begin
+ Result := GTK_ACCEL_VISIBLE;
+ if SC.Locked then Result := GTK_ACCEL_LOCKED;
+end;
+
+procedure TGDKShortCuts.Delete(Index: Integer);
+begin
+ if (Index < 0) or (FList = nil) or (Index >= GetCount) then Exit;
+ if (GetParentForm(FOwner) <> nil) and (not (csDestroying in ComponentState))
+ then gtk_widget_remove_accelerator(FOwner.FWidget, GetParentForm(FOwner).FAccelGroup, TGDKShortCut(FList[Index]^).Key, GetAccelMods(TGDKShortCut(FList[Index]^)));
+ FList.Delete(Index);
+end;
+
+procedure TGDKShortCuts.Insert(Index: Integer; Item: TGDKShortCut);
+begin
+ FList.Insert(Index, @Item);
+ if GetParentForm(FOwner) <> nil
+ then gtk_widget_add_accelerator(FOwner.FWidget, 'activate', GetParentForm(FOwner).FAccelGroup, Item.Key, GetAccelMods(Item), GetAccelFlags(Item));
+end;
+
+function TGDKShortCuts.GetItem(Index: Integer): TGDKShortCut;
+begin
+ Result := TGDKShortCut(FList[Index]^);
+end;
+
+function TGDKShortCuts.IndexOf(Item: TGDKShortCut): Integer;
+var i : integer;
+begin
+ Result := -1;
+ if FList.Count > 0 then
+ for i := 0 to FList.Count - 1 do
+ if (TGDKShortCut(FList[i]^).Key = Item.Key) and (TGDKShortCut(FList[i]^).Locked = Item.Locked) and
+ (TGDKShortCut(FList[i]^).ModAlt = Item.ModAlt) and (TGDKShortCut(FList[i]^).ModShift = Item.ModShift) and
+ (TGDKShortCut(FList[i]^).ModCtrl = Item.ModCtrl) then
+ begin
+ Result := i;
+ Break;
+ end;
+end;
+
+function MakeGDKShortCut(Key: word; Locked, ModAlt, ModShift, ModCtrl : boolean): TGDKShortCut;
+begin
+ Result.Key := Key;
+ Result.Locked := Locked;
+ Result.ModAlt := ModAlt;
+ Result.ModShift := ModShift;
+ Result.ModCtrl := ModCtrl;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+
+
+end.
diff --git a/libgtk_kylix/GTKPixbuf.pas b/libgtk_kylix/GTKPixbuf.pas
new file mode 100644
index 0000000..d895071
--- /dev/null
+++ b/libgtk_kylix/GTKPixbuf.pas
@@ -0,0 +1,214 @@
+(*
+ GTK-Kylix Library: GTKPixbuf - Image handling routines
+ Version 0.6.2 (last updated 2003-03-30)
+ Copyright (C) 2003 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 GTKPixbuf;
+{ $WEAKPACKAGEUNIT}
+
+interface
+
+uses glib2, gdk2, gdk2pixbuf, gtk2, Classes, GTKControls, GTKStdCtrls;
+
+
+type
+ TGTKIconSize = (isInvalid, isMenu, isSmallToolbar, isLargeToolbar, isButton, isDND, isDialog);
+
+(****************************************** TGDKPIXBUF **************************************************************************)
+ TGDKPixbuf = class (TComponent)
+ private
+ function GetWidth: integer;
+ function GetHeight: integer;
+ function GetBPP: integer;
+ protected
+ public
+ FPixbuf: PGdkPixbuf;
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateNew(AOwner: TComponent; const Width, Height, BPP: integer; const HasAlpha: boolean);
+ destructor Destroy; override;
+ function LoadFromFile(const FileName: string): boolean;
+ function LoadFromXPM(const Data: PPChar): boolean;
+ function LoadFromInline(Data: Pointer): boolean;
+ procedure Fill(const Pixel: Cardinal);
+ procedure ScaleSimple(const DestWidth, DestHeight: integer);
+ function Copy: PGdkPixbuf;
+ procedure CopyArea(Source: TGDKPixbuf; SourceX, SourceY, SourceWidth, SourceHeight, DestX, DestY: integer);
+ procedure SetFromStock(Stock_ID: string; IconSize: TGTKIconSize);
+ published
+ property Width: integer read GetWidth;
+ property Height: integer read GetHeight;
+ property BPP: integer read GetBPP;
+ end;
+
+(****************************************** TGTKIMAGE ***************************************************************************)
+ TGTKImage = class(TGTKMisc)
+ private
+ protected
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure LoadFromFile(const FileName: string);
+ procedure SetFromPixbuf(Pixbuf: TGDKPixbuf);
+ function GetPixbuf: PGdkPixbuf;
+ procedure CopyFromPixbuf(Pixbuf: TGDKPixbuf);
+ procedure SetFromStock(Stock_ID: string; IconSize: TGTKIconSize);
+ end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+implementation
+
+uses SysUtils, DateUtils;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGDKPixbuf.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FPixbuf := nil;
+end;
+
+constructor TGDKPixbuf.CreateNew(AOwner: TComponent; const Width, Height, BPP: integer; const HasAlpha: boolean);
+begin
+ inherited Create(AOwner);
+ FPixbuf := gdk_pixbuf_new(GDK_COLORSPACE_RGB, HasAlpha, BPP, Width, Height);
+end;
+
+destructor TGDKPixbuf.Destroy;
+begin
+ if FPixbuf <> nil then gdk_pixbuf_unref(FPixbuf);
+ inherited Destroy;
+end;
+
+function TGDKPixbuf.GetWidth: integer;
+begin
+ Result := gdk_pixbuf_get_width(FPixbuf);
+end;
+
+function TGDKPixbuf.GetHeight: integer;
+begin
+ Result := gdk_pixbuf_get_height(FPixbuf);
+end;
+
+function TGDKPixbuf.GetBPP: integer;
+begin
+ Result := gdk_pixbuf_get_bits_per_sample(FPixbuf);
+end;
+
+function TGDKPixbuf.LoadFromFile(const FileName: string): boolean;
+var P: Pointer;
+ Error: PGError;
+begin
+ Error := nil;
+ P := gdk_pixbuf_new_from_file(PChar(FileName), @Error);
+ Result := P <> nil;
+ if P <> nil then FPixbuf := P;
+end;
+
+function TGDKPixbuf.LoadFromXPM(const Data: PPChar): boolean;
+var P: Pointer;
+begin
+ P := gdk_pixbuf_new_from_xpm_data(Data);
+ Result := P <> nil;
+ if P <> nil then FPixbuf := P;
+end;
+
+function TGDKPixbuf.LoadFromInline(Data: Pointer): boolean;
+var P: Pointer;
+ Error: PGError;
+begin
+ Error := nil;
+ P := gdk_pixbuf_new_from_inline(-1, Pguint8(Data)^, True, @Error);
+ Result := P <> nil;
+ if Error <> nil then begin
+ WriteLn('TGDKPixbuf.LoadFromInline error: ', Error^.message);
+ g_error_free(Error);
+ end;
+ if P <> nil then FPixbuf := P;
+end;
+
+procedure TGDKPixbuf.Fill(const Pixel: Cardinal);
+begin
+ gdk_pixbuf_fill(FPixbuf, Pixel);
+end;
+
+procedure TGDKPixbuf.ScaleSimple(const DestWidth, DestHeight: integer);
+begin
+ FPixbuf := gdk_pixbuf_scale_simple(FPixbuf, DestWidth, DestHeight, GDK_INTERP_BILINEAR);
+end;
+
+function TGDKPixbuf.Copy: PGdkPixbuf;
+begin
+ Result := gdk_pixbuf_copy(FPixbuf);
+end;
+
+procedure TGDKPixbuf.CopyArea(Source: TGDKPixbuf; SourceX, SourceY, SourceWidth, SourceHeight, DestX, DestY: integer);
+begin
+ gdk_pixbuf_copy_area(Source.FPixbuf, SourceX, SourceY, SourceWidth, SourceHeight, FPixbuf, DestX, DestY);
+end;
+
+procedure TGDKPixbuf.SetFromStock(Stock_ID: string; IconSize: TGTKIconSize);
+begin
+ FPixbuf := gtk_widget_render_icon(gtk_label_new(nil), PChar(Stock_ID), Ord(IconSize), nil);
+end;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKImage.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_image_new;
+ Show;
+end;
+
+destructor TGTKImage.Destroy;
+begin
+ inherited Destroy;
+end;
+
+procedure TGTKImage.LoadFromFile(const FileName: string);
+begin
+ gtk_image_set_from_file(PGtkImage(FWidget), PChar(FileName));
+end;
+
+function TGTKImage.GetPixbuf: PGdkPixbuf;
+begin
+ Result := gtk_image_get_pixbuf(PGtkImage(FWidget));
+end;
+
+procedure TGTKImage.SetFromPixbuf(Pixbuf: TGDKPixbuf);
+begin
+ gtk_image_set_from_pixbuf(PGtkImage(FWidget), Pixbuf.FPixbuf);
+end;
+
+procedure TGTKImage.CopyFromPixbuf(Pixbuf: TGDKPixbuf);
+begin
+ gtk_image_set_from_pixbuf(PGtkImage(FWidget), Pixbuf.Copy);
+end;
+
+procedure TGTKImage.SetFromStock(Stock_ID: string; IconSize: TGTKIconSize);
+begin
+ gtk_image_set_from_stock(PGtkImage(FWidget), PChar(Stock_ID), Ord(IconSize));
+end;
+
+(********************************************************************************************************************************)
+end.
diff --git a/libgtk_kylix/GTKStdCtrls.pas b/libgtk_kylix/GTKStdCtrls.pas
new file mode 100644
index 0000000..1d4157a
--- /dev/null
+++ b/libgtk_kylix/GTKStdCtrls.pas
@@ -0,0 +1,1008 @@
+(*
+ GTK-Kylix Library: GTKStdCtrls - Standard visual controls (such as buttons, labels, entry)
+ Version 0.6.23 (last updated 2007-12-08)
+ 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 GTKStdCtrls;
+{ $WEAKPACKAGEUNIT}
+
+interface
+
+uses gtk2, gdk2, glib2, Classes, GTKControls, GTKConsts, GTKClasses;
+ // Quick jump: QForms QControls QStdCtrls
+
+
+type
+
+(****************************************** TGTKBUTTON **************************************************************************)
+ TGTKBorderStyle = (bsNormal, bsHalf, bsNone);
+ TGTKButton = class(TGTKBin)
+ private
+ FOnClick: TNotifyEvent;
+ function GetCaption: string;
+ function GetUseStock: boolean;
+ function GetUseUnderline: boolean;
+ function GetBorderStyle: TGTKBorderStyle;
+ procedure SetCaption(Value: string);
+ procedure SetUseStock(Value: boolean);
+ procedure SetUseUnderline(Value: boolean);
+ procedure SetBorderStyle(Value: TGTKBorderStyle);
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateFromStock(AOwner: TComponent; const StockID: PChar);
+ destructor Destroy; override;
+ published
+ property Caption: string read GetCaption write SetCaption;
+ property OnClick: TNotifyEvent read FOnClick write FOnClick;
+ property UseStock: boolean read GetUseStock write SetUseStock;
+ property UseUnderline: boolean read GetUseUnderline write SetUseUnderline;
+ property BorderStyle: TGTKBorderStyle read GetBorderStyle write SetBorderStyle;
+ end;
+
+(****************************************** TGTKMISC ****************************************************************************)
+ TGTKMisc = class(TGTKControl)
+ private
+ function GetXAlign: Single;
+ function GetYAlign: Single;
+ function GetXPadding: integer;
+ function GetYPadding: integer;
+ procedure SetXAlign(Value: Single);
+ procedure SetYAlign(Value: Single);
+ procedure SetXPadding(Value: integer);
+ procedure SetYPadding(Value: integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetAlignment(XAlign, YAlign : Single);
+ procedure SetPadding(XPadding, YPadding : integer);
+ published
+ property XAlign: Single read GetXAlign write SetXAlign;
+ property YAlign: Single read GetYAlign write SetYAlign;
+ property XPadding: integer read GetXPadding write SetXPadding;
+ property YPadding: integer read GetYPadding write SetYPadding;
+ end;
+
+(****************************************** TGTKLABEL **************************************************************************)
+ TGTKAlignment = (taLeftJustify, taRightJustify, taCenter, taFill);
+ TGTKLabel = class(TGTKMisc)
+ private
+ FLinked: boolean;
+ function GetCaption: string;
+ function GetAlignment: TGTKAlignment;
+ function GetUseMarkup: boolean;
+ function GetLineWrap: boolean;
+ function GetUseUnderline: boolean;
+ function GetSelectable: boolean;
+ procedure SetCaption(Value: string);
+ procedure SetAlignment(Value: TGTKAlignment);
+ procedure SetUseMarkup(Value: boolean);
+ procedure SetLineWrap(Value: boolean);
+ procedure SetUseUnderline(Value: boolean);
+ procedure SetFocusControl(Value: TGTKControl);
+ procedure SetSelectable(Value: boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateFromWidget(AOwner: TComponent; Widget: PGtkWidget);
+ destructor Destroy; override;
+ procedure SetMarkup(const Text: string);
+ published
+ property Caption: string read GetCaption write SetCaption;
+ property Alignment: TGTKAlignment read GetAlignment write SetAlignment;
+ property UseMarkup: boolean read GetUseMarkup write SetUseMarkup;
+ property LineWrap: boolean read GetLineWrap write SetLineWrap;
+ property UseUnderline: boolean read GetUseUnderline write SetUseUnderline;
+ property FocusControl: TGTKControl write SetFocusControl;
+ property Selectable: boolean read GetSelectable write SetSelectable;
+ end;
+
+(****************************************** TGTKTOGGLEBUTTON ********************************************************************)
+ TGTKToggleButton = class(TGTKButton)
+ private
+ FOnToggled: TNotifyEvent;
+ function GetCaption: string;
+ function GetChecked: boolean;
+ function GetDrawIndicator: boolean;
+ function GetInconsistent: boolean;
+ procedure SetCaption(Value: string);
+ procedure SetChecked(Value: boolean);
+ procedure SetDrawIndicator(Value: boolean);
+ procedure SetInconsistent(Value: boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property Caption: string read GetCaption write SetCaption;
+ property Checked: boolean read GetChecked write SetChecked;
+ property DrawIndicator: boolean read GetDrawIndicator write SetDrawIndicator;
+ property OnToggled: TNotifyEvent read FOnToggled write FOnToggled;
+ property Inconsistent: boolean read GetInconsistent write SetInconsistent;
+ property UseUnderline;
+ end;
+
+(****************************************** TGTKCHECKBUTTON *********************************************************************)
+ TGTKCheckButton = class(TGTKToggleButton)
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateWithLabel(AOwner: TComponent; const ALabel: string);
+ destructor Destroy; override;
+ published
+ property Caption;
+ property Checked;
+ property DrawIndicator;
+ property OnToggled;
+ property UseUnderline;
+ end;
+
+(****************************************** TGTKRADIOBUTTON *********************************************************************)
+ TGTKRadioButton = class(TGTKToggleButton)
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateWithLabel(AOwner: TComponent; const ALabel: string);
+ destructor Destroy; override;
+ procedure SetRadioGroup(RadioButton: TGTKRadioButton);
+ published
+ property Caption;
+ property Checked;
+ property DrawIndicator;
+ property OnToggled;
+ end;
+
+(****************************************** TGTKFRAME ***************************************************************************)
+ TGTKFrame = class(TGTKBin)
+ private
+ function GetCaption: string;
+ function GetShadowType: TGTKShadowType;
+ procedure SetCaption(Value: string);
+ procedure SetShadowType(Value: TGTKShadowType);
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateWithoutLabel(AOwner: TComponent);
+ destructor Destroy; override;
+ published
+ property Caption: string read GetCaption write SetCaption;
+ property ShadowType: TGTKShadowType read GetShadowType write SetShadowType;
+ end;
+
+(****************************************** TGTKEDITABLE ************************************************************************)
+ TGTKEditable = class(TGTKControl)
+ private
+ FOnChanged: TNotifyEvent;
+ function GetEditable: boolean;
+ function GetPosition: integer;
+ procedure SetEditable(Value: boolean);
+ procedure SetPosition(Value: integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure CutClipboard;
+ procedure CopyClipboard;
+ procedure PasteClipboard;
+ procedure DeleteSelection;
+ procedure SelectRegion(StartPosition, EndPosition: integer);
+ procedure InsertText(AText: string; Position: integer);
+ procedure DeleteText(StartPosition, EndPosition: integer);
+ function GetChars(StartPosition, EndPosition: integer): string;
+ published
+ property Editable: boolean read GetEditable write SetEditable;
+ property CursorPosition: integer read GetPosition write SetPosition;
+ property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
+ end;
+
+(****************************************** TGTKENTRY ************************************************************************)
+ TGTKEntry = class(TGTKEditable)
+ private
+ FLinked: boolean;
+ function GetText: string;
+ function GetMaxLength: integer;
+ function GetVisibility: boolean;
+ procedure SetText(Value: string);
+ procedure SetMaxLength(Value: integer);
+ procedure SetVisibility(Value: boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateFromWidget(AOwner: TComponent; Widget: PGtkWidget);
+ destructor Destroy; override;
+ procedure SelectAll;
+ published
+ property Text: string read GetText write SetText;
+ property MaxLength: integer read GetMaxLength write SetMaxLength;
+ property Visibility: boolean read GetVisibility write SetVisibility;
+ end;
+
+(****************************************** TGTKCOMBO **************************************************************************)
+ TGTKCombo = class(TGTKHBox)
+ private
+ procedure ItemsChanged(Sender: TObject);
+ function GetAllowEmpty: boolean;
+ function GetMatchValue: boolean;
+ function GetCaseSensitive: boolean;
+ procedure SetAllowEmpty(Value: boolean);
+ procedure SetMatchValue(Value: boolean);
+ procedure SetCaseSensitive(Value: boolean);
+ public
+ Items: TGList;
+ Entry: TGTKEntry;
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure UpdateItems;
+ procedure SetPolicy(MatchValue, AllowEmpty: boolean);
+ procedure DisableActivate;
+ published
+ property AllowEmpty: boolean read GetAllowEmpty write SetAllowEmpty;
+ property MatchValue: boolean read GetMatchValue write SetMatchValue;
+ property CaseSensitive: boolean read GetCaseSensitive write SetCaseSensitive;
+ end;
+
+(****************************************** TGTKSPINEDIT ************************************************************************)
+ TGTKSpinEdit = class(TGTKEntry)
+ private
+ FAdjustment: PGtkAdjustment;
+ function GetDigits: integer;
+ procedure SetDigits(AValue: integer);
+ function GetMin: Double;
+ procedure SetMin(AValue: Double);
+ function GetMax: Double;
+ procedure SetMax(AValue: Double);
+ function GetIncrementStep: Double;
+ procedure SetIncrementStep(AValue: Double);
+ function GetIncrementPage: Double;
+ procedure SetIncrementPage(AValue: Double);
+ function GetValue: Double;
+ procedure SetValue(AValue: Double);
+ function GetAsInteger: integer;
+ procedure SetAsInteger(AValue: integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property Digits: integer read GetDigits write SetDigits;
+ property Min: Double read GetMin write SetMin;
+ property Max: Double read GetMax write SetMax;
+ property IncrementStep: Double read GetIncrementStep write SetIncrementStep;
+ property IncrementPage: Double read GetIncrementPage write SetIncrementPage;
+ property Value: Double read GetValue write SetValue;
+ property AsInteger: integer read GetAsInteger write SetAsInteger;
+ property AsFloat: Double read GetValue write SetValue;
+ end;
+
+procedure TGTKButton_OnClick(button: PGtkButton; user_data: Pgpointer); cdecl;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+implementation
+
+uses GTKUtils;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+procedure TGTKButton_OnClick(button: PGtkButton; user_data: Pgpointer); cdecl;
+begin
+ if Assigned(TGTKButton(user_data).FOnClick) then TGTKButton(user_data).FOnClick(TGTKButton(user_data));
+end;
+
+constructor TGTKButton.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOnClick := nil;
+ if ClassName = 'TGTKButton' then begin
+ FWidget := gtk_button_new_with_mnemonic(StringToPgchar(SCDefaultButtonCaption));
+ g_signal_connect(PGtkObject(FWidget), 'clicked', G_CALLBACK(@TGTKButton_OnClick), Self);
+ Show;
+ end;
+end;
+
+constructor TGTKButton.CreateFromStock(AOwner: TComponent; const StockID: PChar);
+begin
+ inherited Create(AOwner);
+ FOnClick := nil;
+ if ClassName = 'TGTKButton' then begin
+ FWidget := gtk_button_new_from_stock(StockID);
+ g_signal_connect(PGtkObject(FWidget), 'clicked', G_CALLBACK(@TGTKButton_OnClick), Self);
+ Show;
+ end;
+end;
+
+destructor TGTKButton.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKButton.GetCaption: string;
+begin
+ Result := PgcharToString(gtk_label_get_text(PGtkLabel(ChildControl)));
+end;
+
+procedure TGTKButton.SetCaption(Value: string);
+begin
+ gtk_label_set_text_with_mnemonic(PGtkLabel(ChildControl), StringToPgchar(Value));
+end;
+
+function TGTKButton.GetUseStock: boolean;
+begin
+ Result := gtk_button_get_use_stock(PGtkButton(FWidget));
+end;
+
+procedure TGTKButton.SetUseStock(Value: boolean);
+begin
+ gtk_button_set_use_stock(PGtkButton(FWidget), Value);
+end;
+
+function TGTKButton.GetUseUnderline: boolean;
+begin
+ Result := gtk_button_get_use_underline(PGtkButton(FWidget));
+end;
+
+procedure TGTKButton.SetUseUnderline(Value: boolean);
+begin
+ gtk_button_set_use_underline(PGtkButton(FWidget), Value);
+end;
+
+function TGTKButton.GetBorderStyle: TGTKBorderStyle;
+begin
+ Result := TGTKBorderStyle(gtk_button_get_relief(PGtkButton(FWidget)));
+end;
+
+procedure TGTKButton.SetBorderStyle(Value: TGTKBorderStyle);
+begin
+ gtk_button_set_relief(PGtkButton(FWidget), integer(Value));
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKMisc.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+end;
+
+destructor TGTKMisc.Destroy;
+begin
+ inherited Destroy;
+end;
+
+procedure TGTKMisc.SetAlignment(XAlign, YAlign : Single);
+begin
+// Writeln('gtk_misc_set_alignment, FWidget = ', integer(FWidget), ', XAlign = ', XAlign, ', YAlign = ', YAlign);
+ gtk_misc_set_alignment(PGtkMisc(FWidget), XAlign, YAlign);
+end;
+
+function TGTKMisc.GetXAlign: Single;
+{var xalign, yalign: pgfloat; }
+begin
+{ gtk_misc_get_alignment(PGtkMisc(FWidget), xalign, yalign);
+ if Assigned(xalign) then Result := Single(xalign^)
+ else Result := 0; }
+ if Assigned(FWidget) then Result := PGtkMisc(FWidget)^.xalign
+ else Result := 0;
+end;
+
+procedure TGTKMisc.SetXAlign(Value: Single);
+begin
+ SetAlignment(Value, YAlign);
+end;
+
+function TGTKMisc.GetYAlign: Single;
+{var xalign, yalign: Extended;
+ x: Extended; }
+begin
+{ gtk_misc_get_alignment(PGtkMisc(FWidget), @xalign, @yalign);
+ writeln('yalign = ', integer(yalign));
+ if Assigned(yalign) then Result := yalign
+ else Result := 0; }
+ if Assigned(FWidget) then Result := PGtkMisc(FWidget)^.yalign
+ else Result := 0;
+end;
+
+procedure TGTKMisc.SetYAlign(Value: Single);
+begin
+ SetAlignment(XAlign, Value);
+end;
+
+procedure TGTKMisc.SetPadding(XPadding, YPadding : integer);
+begin
+ gtk_misc_set_padding(PGtkMisc(FWidget), XPadding, YPadding);
+end;
+
+function TGTKMisc.GetXPadding: integer;
+var xpad, ypad: pgint;
+begin
+ gtk_misc_get_padding(PGtkMisc(FWidget), xpad, ypad);
+ if Assigned(xpad) then Result := Integer(xpad)
+ else Result := 0;
+end;
+
+procedure TGTKMisc.SetXPadding(Value: integer);
+begin
+ SetPadding(Value, YPadding);
+end;
+
+function TGTKMisc.GetYPadding: integer;
+var xpad, ypad: pgint;
+begin
+ gtk_misc_get_padding(PGtkMisc(FWidget), xpad, ypad);
+ if Assigned(ypad) then Result := Integer(ypad)
+ else Result := 0;
+end;
+
+procedure TGTKMisc.SetYPadding(Value: integer);
+begin
+ SetPadding(XPadding, Value);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKLabel.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_label_new(nil);
+ FLinked := False;
+ Show;
+end;
+
+constructor TGTKLabel.CreateFromWidget(AOwner: TComponent; Widget: PGtkWidget);
+begin
+ inherited Create(AOwner);
+ FWidget := Widget;
+ FLinked := True;
+ Show;
+end;
+
+destructor TGTKLabel.Destroy;
+begin
+ if not FLinked then inherited Destroy;
+end;
+
+function TGTKLabel.GetCaption: string;
+begin
+ Result := PgcharToString(gtk_label_get_text(PGtkLabel(FWidget)));
+end;
+
+procedure TGTKLabel.SetCaption(Value: string);
+begin
+ gtk_label_set_text(PGtkLabel(FWidget), StringToPgchar(Value));
+end;
+
+function TGTKLabel.GetAlignment: TGTKAlignment;
+begin
+ Result := TGTKAlignment(gtk_label_get_justify(PGtkLabel(FWidget)));
+end;
+
+procedure TGTKLabel.SetAlignment(Value: TGTKAlignment);
+begin
+ gtk_label_set_justify(PGtkLabel(FWidget), TGtkJustification(Value));
+end;
+
+procedure TGTKLabel.SetMarkup(const Text: string);
+begin
+ gtk_label_set_markup(PGtkLabel(FWidget), PChar(Text));
+end;
+
+function TGTKLabel.GetUseMarkup: boolean;
+begin
+ Result := gtk_label_get_use_markup(PGtkLabel(FWidget));
+end;
+
+procedure TGTKLabel.SetUseMarkup(Value: boolean);
+begin
+ gtk_label_set_use_markup(PGtkLabel(FWidget), Value);
+end;
+
+function TGTKLabel.GetLineWrap: boolean;
+begin
+ Result := gtk_label_get_line_wrap(PGtkLabel(FWidget));
+end;
+
+procedure TGTKLabel.SetLineWrap(Value: boolean);
+begin
+ gtk_label_set_line_wrap(PGtkLabel(FWidget), Value);
+end;
+
+function TGTKLabel.GetUseUnderline: boolean;
+begin
+ Result := gtk_label_get_use_underline(PGtkLabel(FWidget));
+end;
+
+procedure TGTKLabel.SetUseUnderline(Value: boolean);
+begin
+ gtk_label_set_use_underline(PGtkLabel(FWidget), Value);
+end;
+
+procedure TGTKLabel.SetFocusControl(Value: TGTKControl);
+begin
+ gtk_label_set_mnemonic_widget(PGtkLabel(FWidget), Value.FWidget);
+end;
+
+function TGTKLabel.GetSelectable: boolean;
+begin
+ Result := gtk_label_get_selectable(PGtkLabel(FWidget));
+end;
+
+procedure TGTKLabel.SetSelectable(Value: boolean);
+begin
+ gtk_label_set_selectable(PGtkLabel(FWidget), Value);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+procedure TGTKToggleButton_OnToggled(ToggleButton: PGtkToggleButton; user_data: Pgpointer); cdecl;
+begin
+ if Assigned(TGTKToggleButton(user_data).FOnToggled) then TGTKToggleButton(user_data).FOnToggled(TGTKToggleButton(user_data));
+end;
+
+constructor TGTKToggleButton.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOnToggled := nil;
+ if ClassName = 'TGTKToggleButton' then begin
+ FWidget := gtk_toggle_button_new_with_label(StringToPgchar(SCDefaultToggleButtonCaption));
+ g_signal_connect(PGtkObject(FWidget), 'toggled', G_CALLBACK(@TGTKToggleButton_OnToggled), Self);
+ Show;
+ end;
+end;
+
+destructor TGTKToggleButton.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKToggleButton.GetCaption: string;
+begin
+ Result := PgcharToString(gtk_label_get_text(PGtkLabel(ChildControl)));
+end;
+
+procedure TGTKToggleButton.SetCaption(Value: string);
+begin
+ gtk_label_set_text(PGtkLabel(ChildControl), StringToPgchar(Value));
+end;
+
+function TGTKToggleButton.GetChecked: boolean;
+begin
+ Result := gtk_toggle_button_get_active(PGtkToggleButton(FWidget));
+end;
+
+procedure TGTKToggleButton.SetChecked(Value: boolean);
+begin
+ gtk_toggle_button_set_active(PGtkToggleButton(FWidget), Value);
+end;
+
+function TGTKToggleButton.GetDrawIndicator: boolean;
+begin
+ Result := gtk_toggle_button_get_mode(PGtkToggleButton(FWidget));
+end;
+
+procedure TGTKToggleButton.SetDrawIndicator(Value: boolean);
+begin
+ gtk_toggle_button_set_mode(PGtkToggleButton(FWidget), Value);
+end;
+
+function TGTKToggleButton.GetInconsistent: boolean;
+begin
+ Result := gtk_toggle_button_get_inconsistent(PGtkToggleButton(FWidget));
+end;
+
+procedure TGTKToggleButton.SetInconsistent(Value: boolean);
+begin
+ gtk_toggle_button_set_inconsistent(PGtkToggleButton(FWidget), Value);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKCheckButton.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ if ClassName = 'TGTKCheckButton' then begin
+ FWidget := gtk_check_button_new_with_mnemonic(StringToPgchar(SCDefaultCheckButtonCaption));
+ g_signal_connect(PGtkObject(FWidget), 'toggled', G_CALLBACK(@TGTKToggleButton_OnToggled), Self);
+ Show;
+ end;
+end;
+
+constructor TGTKCheckButton.CreateWithLabel(AOwner: TComponent; const ALabel: string);
+begin
+ inherited Create(AOwner);
+ if ClassName = 'TGTKCheckButton' then begin
+ FWidget := gtk_check_button_new_with_mnemonic(StringToPgchar(ALabel));
+ g_signal_connect(PGtkObject(FWidget), 'toggled', G_CALLBACK(@TGTKToggleButton_OnToggled), Self);
+ Show;
+ end;
+end;
+
+destructor TGTKCheckButton.Destroy;
+begin
+ inherited Destroy;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKRadioButton.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ if ClassName = 'TGTKRadioButton' then begin
+ FWidget := gtk_radio_button_new_with_label(nil, StringToPgchar(SCDefaultRadioButtonCaption));
+ g_signal_connect(PGtkObject(FWidget), 'toggled', G_CALLBACK(@TGTKToggleButton_OnToggled), Self);
+ Show;
+ end;
+end;
+
+constructor TGTKRadioButton.CreateWithLabel(AOwner: TComponent; const ALabel: string);
+begin
+ inherited Create(AOwner);
+ if ClassName = 'TGTKRadioButton' then begin
+ FWidget := gtk_radio_button_new_with_mnemonic(nil, StringToPgchar(ALabel));
+ g_signal_connect(PGtkObject(FWidget), 'toggled', G_CALLBACK(@TGTKToggleButton_OnToggled), Self);
+ Show;
+ end;
+end;
+
+destructor TGTKRadioButton.Destroy;
+begin
+ inherited Destroy;
+end;
+
+procedure TGTKRadioButton.SetRadioGroup(RadioButton: TGTKRadioButton);
+begin
+ if Assigned(RadioButton) then gtk_radio_button_set_group(PGtkRadioButton(FWidget), gtk_radio_button_get_group(PGtkRadioButton(RadioButton.FWidget)))
+ else gtk_radio_button_set_group(PGtkRadioButton(FWidget), nil);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKFrame.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_frame_new(StringToPgchar(SCDefaultFrameCaption));
+ Show;
+end;
+
+constructor TGTKFrame.CreateWithoutLabel(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_frame_new(nil);
+ Show;
+end;
+
+destructor TGTKFrame.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKFrame.GetCaption: string;
+begin
+ Result := PgcharToString(gtk_frame_get_label(PGtkFrame(FWidget)));
+end;
+
+procedure TGTKFrame.SetCaption(Value: string);
+begin
+ gtk_label_set_text(PGtkLabel(gtk_frame_get_label_widget(PGtkFrame(FWidget))), StringToPgchar(Value));
+end;
+
+function TGTKFrame.GetShadowType: TGTKShadowType;
+begin
+ Result := TGTKShadowType(gtk_frame_get_shadow_type(PGtkFrame(FWidget)));
+end;
+
+procedure TGTKFrame.SetShadowType(Value: TGTKShadowType);
+begin
+ gtk_frame_set_shadow_type(PGtkFrame(FWidget), gtk2.TGtkShadowType(Value));
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+procedure TGTKEditable_Changed(editable: PGtkEditable; user_data: gpointer); cdecl;
+begin
+ if Assigned(TGTKEditable(user_data).FOnChanged) then TGTKEditable(user_data).FOnChanged(TGTKEditable(user_data));
+end;
+
+constructor TGTKEditable.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOnChanged := nil;
+end;
+
+destructor TGTKEditable.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKEditable.GetEditable: boolean;
+begin
+ Result := gtk_editable_get_editable(PGtkEditable(FWidget));
+end;
+
+procedure TGTKEditable.SetEditable(Value: boolean);
+begin
+ gtk_entry_set_editable(PGtkEntry(FWidget), Value);
+end;
+
+procedure TGTKEditable.CutClipboard;
+begin
+ gtk_editable_cut_clipboard(PGtkEditable(FWidget));
+end;
+
+procedure TGTKEditable.CopyClipboard;
+begin
+ gtk_editable_copy_clipboard(PGtkEditable(FWidget));
+end;
+
+procedure TGTKEditable.PasteClipboard;
+begin
+ gtk_editable_paste_clipboard(PGtkEditable(FWidget));
+end;
+
+procedure TGTKEditable.DeleteSelection;
+begin
+ gtk_editable_delete_selection(PGtkEditable(FWidget));
+end;
+
+procedure TGTKEditable.InsertText(AText: string; Position: integer);
+begin
+ gtk_editable_insert_text(PGtkEditable(FWidget), StringToPgchar(AText), Length(AText), @Position);
+end;
+
+procedure TGTKEditable.DeleteText(StartPosition, EndPosition: integer);
+begin
+ gtk_editable_delete_text(PGtkEditable(FWidget), StartPosition, EndPosition);
+end;
+
+function TGTKEditable.GetChars(StartPosition, EndPosition: integer): string;
+begin
+ Result := PgcharToString(gtk_editable_get_chars(PGtkEditable(FWidget), StartPosition, EndPosition));
+end;
+
+procedure TGTKEditable.SelectRegion(StartPosition, EndPosition: integer);
+begin
+ gtk_editable_select_region(PGtkEditable(FWidget), StartPosition, EndPosition);
+end;
+
+function TGTKEditable.GetPosition: integer;
+begin
+ Result := gtk_editable_get_position(PGtkEditable(FWidget));
+end;
+
+procedure TGTKEditable.SetPosition(Value: integer);
+begin
+ gtk_editable_set_position(PGtkEditable(FWidget), Value);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKEntry.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FLinked := False;
+ FWidget := gtk_entry_new;
+ Show;
+ g_signal_connect(PGtkObject(FWidget), 'changed', G_CALLBACK(@TGTKEditable_Changed), Self);
+end;
+
+constructor TGTKEntry.CreateFromWidget(AOwner: TComponent; Widget: PGtkWidget);
+begin
+ inherited Create(AOwner);
+ FLinked := True;
+ FWidget := Widget;
+end;
+
+destructor TGTKEntry.Destroy;
+begin
+ if not FLinked then inherited Destroy;
+end;
+
+function TGTKEntry.GetText: string;
+begin
+ Result := PgcharToString(gtk_entry_get_text(PGtkEntry(FWidget)));
+end;
+
+procedure TGTKEntry.SetText(Value: string);
+begin
+ gtk_entry_set_text(PGtkEntry(FWidget), StringToPgchar(Value));
+end;
+
+function TGTKEntry.GetMaxLength: integer;
+begin
+ Result := gtk_entry_get_max_length(PGtkEntry(FWidget));
+end;
+
+procedure TGTKEntry.SetMaxLength(Value: integer);
+begin
+ gtk_entry_set_max_length(PGtkEntry(FWidget), Value);
+end;
+
+function TGTKEntry.GetVisibility: boolean;
+begin
+ Result := gtk_entry_get_visibility(PGtkEntry(FWidget));
+end;
+
+procedure TGTKEntry.SetVisibility(Value: boolean);
+begin
+// g_object_set(FWidget, 'visibility', gboolean(Value), nil);
+ gtk_entry_set_visibility(PGtkEntry(FWidget), Value);
+end;
+
+procedure TGTKEntry.SelectAll;
+begin
+ SelectRegion(0, Length(Text));
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKCombo.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FWidget := gtk_combo_new;
+ Items := TGList.Create(Self);
+ Items.Notify := ItemsChanged;
+ Entry := TGTKEntry.CreateFromWidget(Self, PGtkCombo(FWidget)^.entry);
+ Show;
+end;
+
+destructor TGTKCombo.Destroy;
+begin
+ Items.Free;
+ inherited Destroy;
+end;
+
+procedure TGTKCombo.UpdateItems;
+begin
+ gtk_combo_set_popdown_strings(PGtkCombo(FWidget), Items.FList);
+end;
+
+function TGTKCombo.GetAllowEmpty: boolean;
+begin
+ Result := Boolean(ok_if_empty(PGtkCombo(FWidget)^));
+end;
+
+procedure TGTKCombo.SetAllowEmpty(Value: boolean);
+begin
+ SetPolicy(GetMatchValue, Value);
+end;
+
+function TGTKCombo.GetMatchValue: boolean;
+begin
+ Result := Boolean(value_in_list(PGtkCombo(FWidget)^));
+end;
+
+procedure TGTKCombo.SetMatchValue(Value: boolean);
+begin
+ SetPolicy(Value, GetAllowEmpty);
+end;
+
+procedure TGTKCombo.SetPolicy(MatchValue, AllowEmpty: boolean);
+begin
+ gtk_combo_set_value_in_list(PGtkCombo(FWidget), MatchValue, AllowEmpty);
+end;
+
+function TGTKCombo.GetCaseSensitive: boolean;
+begin
+ Result := Boolean(gtk2.case_sensitive(PGtkCombo(FWidget)^));
+end;
+
+procedure TGTKCombo.SetCaseSensitive(Value: boolean);
+begin
+ gtk_combo_set_case_sensitive(PGtkCombo(FWidget), Value);
+end;
+
+procedure TGTKCombo.DisableActivate;
+begin
+ gtk_combo_disable_activate(PGtkCombo(FWidget));
+end;
+
+procedure TGTKCombo.ItemsChanged(Sender: TObject);
+begin
+ UpdateItems;
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKSpinEdit.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FAdjustment := PGtkAdjustment(gtk_adjustment_new(0, 0, 0, 1, 10, 10));
+ FWidget := gtk_spin_button_new(FAdjustment, 1, 0);
+ Show;
+end;
+
+destructor TGTKSpinEdit.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKSpinEdit.GetDigits: integer;
+begin
+ Result := gtk_spin_button_get_digits(PGtkSpinButton(FWidget));
+end;
+
+procedure TGTKSpinEdit.SetDigits(AValue: integer);
+begin
+ gtk_spin_button_set_digits(PGtkSpinButton(FWidget), AValue);
+end;
+
+function TGTKSpinEdit.GetMin: Double;
+var amin, amax: Double;
+begin
+ gtk_spin_button_get_range(PGtkSpinButton(FWidget), @amin, @amax);
+ Result := amin;
+end;
+
+procedure TGTKSpinEdit.SetMin(AValue: Double);
+begin
+ gtk_spin_button_set_range(PGtkSpinButton(FWidget), AValue, Max);
+end;
+
+function TGTKSpinEdit.GetMax: Double;
+var amin, amax: Double;
+begin
+ gtk_spin_button_get_range(PGtkSpinButton(FWidget), @amin, @amax);
+ Result := amax;
+end;
+
+procedure TGTKSpinEdit.SetMax(AValue: Double);
+begin
+ gtk_spin_button_set_range(PGtkSpinButton(FWidget), Min, AValue);
+end;
+
+function TGTKSpinEdit.GetIncrementStep: Double;
+var astep, apage: Double;
+begin
+ gtk_spin_button_get_increments(PGtkSpinButton(FWidget), @astep, @apage);
+ Result := astep;
+end;
+
+procedure TGTKSpinEdit.SetIncrementStep(AValue: Double);
+begin
+ gtk_spin_button_set_increments(PGtkSpinButton(FWidget), AValue, IncrementPage);
+end;
+
+function TGTKSpinEdit.GetIncrementPage: Double;
+var astep, apage: Double;
+begin
+ gtk_spin_button_get_increments(PGtkSpinButton(FWidget), @astep, @apage);
+ Result := apage;
+end;
+
+procedure TGTKSpinEdit.SetIncrementPage(AValue: Double);
+begin
+ gtk_spin_button_set_increments(PGtkSpinButton(FWidget), IncrementStep, AValue);
+end;
+
+function TGTKSpinEdit.GetValue: Double;
+begin
+ Result := gtk_spin_button_get_value(PGtkSpinButton(FWidget));
+end;
+
+procedure TGTKSpinEdit.SetValue(AValue: Double);
+begin
+ gtk_spin_button_set_value(PGtkSpinButton(FWidget), AValue);
+end;
+
+function TGTKSpinEdit.GetAsInteger: integer;
+begin
+ Result := gtk_spin_button_get_value_as_int(PGtkSpinButton(FWidget));
+end;
+
+procedure TGTKSpinEdit.SetAsInteger(AValue: integer);
+begin
+ gtk_spin_button_set_value(PGtkSpinButton(FWidget), AValue);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+
+
+end.
diff --git a/libgtk_kylix/GTKText.pas b/libgtk_kylix/GTKText.pas
new file mode 100644
index 0000000..fe1a0c4
--- /dev/null
+++ b/libgtk_kylix/GTKText.pas
@@ -0,0 +1,167 @@
+(*
+ GTK-Kylix Library: GTKText - Multiline Text Editor (GtkTextView)
+ Version 0.5.16 (last updated 2003-01-21)
+ Copyright (C) 2003 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 GTKText;
+{ $WEAKPACKAGEUNIT}
+
+interface
+
+uses gtk2, gdk2, glib2, Classes, GTKControls, GTKConsts, GTKUtils, GTKClasses, GTKForms;
+
+
+type
+ TGTKTextBuffer = class;
+
+(****************************************** TGTKTEXTVIEW ************************************************************************)
+ TGTKTextViewWrapMode = (wmWrapNone, wmWrapChar, wmWrapWord);
+ TGTKTextView = class(TGTKContainer)
+ private
+ FTextBuffer: TGTKTextBuffer;
+ function GetWrapMode: TGTKTextViewWrapMode;
+ procedure SetWrapMode(Value: TGTKTextViewWrapMode);
+ function GetReadOnly: boolean;
+ procedure SetReadOnly(Value: boolean);
+ function GetCursorVisible: boolean;
+ procedure SetCursorVisible(Value: boolean);
+ protected
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property WrapMode: TGTKTextViewWrapMode read GetWrapMode write SetWrapMode;
+ property ReadOnly: boolean read GetReadOnly write SetReadOnly;
+ property CursorVisible: boolean read GetCursorVisible write SetCursorVisible;
+ property TextBuffer: TGTKTextBuffer read FTextBuffer write FTextBuffer;
+ property Lines: TGTKTextBuffer read FTextBuffer write FTextBuffer;
+ end;
+
+(****************************************** TGTKTEXTBUFFER **********************************************************************)
+ TGTKTextBuffer = class
+ private
+ FOwner: TGTKTextView;
+ FBuffer: PGtkTextBuffer;
+ function GetLineCount: integer;
+ function GetCharCount: integer;
+ protected
+ public
+ constructor Create(AOwner: TGTKTextView);
+ destructor Destroy; override;
+ procedure SetText(const Text: string);
+ procedure InsertText(const Text: string);
+ published
+ property Count: integer read GetLineCount;
+ property LineCount: integer read GetLineCount;
+ property CharCount: integer read GetCharCount;
+ end;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+implementation
+
+uses SysUtils, DateUtils;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKTextView.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FTextBuffer := TGTKTextBuffer.Create(Self);
+ FWidget := gtk_text_view_new_with_buffer(FTextBuffer.FBuffer);
+ Show;
+ g_object_unref(FTextBuffer.FBuffer);
+end;
+
+destructor TGTKTextView.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKTextView.GetWrapMode: TGTKTextViewWrapMode;
+begin
+ Result := TGTKTextViewWrapMode(gtk_text_view_get_wrap_mode(PGtkTextView(FWidget)));
+end;
+
+procedure TGTKTextView.SetWrapMode(Value: TGTKTextViewWrapMode);
+begin
+ gtk_text_view_set_wrap_mode(PGtkTextView(FWidget), integer(Value));
+end;
+
+function TGTKTextView.GetReadOnly: boolean;
+begin
+ Result := not gtk_text_view_get_editable(PGtkTextView(FWidget));
+end;
+
+procedure TGTKTextView.SetReadOnly(Value: boolean);
+begin
+ gtk_text_view_set_editable(PGtkTextView(FWidget), not Value);
+end;
+
+function TGTKTextView.GetCursorVisible: boolean;
+begin
+ Result := gtk_text_view_get_cursor_visible(PGtkTextView(FWidget));
+end;
+
+procedure TGTKTextView.SetCursorVisible(Value: boolean);
+begin
+ gtk_text_view_set_cursor_visible(PGtkTextView(FWidget), Value);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKTextBuffer.Create(AOwner: TGTKTextView);
+begin
+ inherited Create;
+ FOwner := AOwner;
+ FBuffer := gtk_text_buffer_new(nil);
+end;
+
+destructor TGTKTextBuffer.Destroy;
+begin
+ inherited Destroy;
+end;
+
+procedure TGTKTextBuffer.SetText(const Text: string);
+begin
+ gtk_text_buffer_set_text(FBuffer, PChar(Text), -1);
+end;
+
+procedure TGTKTextBuffer.InsertText(const Text: string);
+var Iter: TGtkTextIter;
+begin
+ gtk_text_buffer_get_end_iter(FBuffer, @Iter);
+ gtk_text_buffer_insert(FBuffer, @Iter, PChar(Text), -1);
+end;
+
+function TGTKTextBuffer.GetLineCount: integer;
+begin
+ Result := gtk_text_buffer_get_line_count(FBuffer);
+end;
+
+function TGTKTextBuffer.GetCharCount: integer;
+begin
+ Result := gtk_text_buffer_get_char_count(FBuffer);
+end;
+
+(********************************************************************************************************************************)
+end.
diff --git a/libgtk_kylix/GTKUtils.pas b/libgtk_kylix/GTKUtils.pas
new file mode 100644
index 0000000..924ece1
--- /dev/null
+++ b/libgtk_kylix/GTKUtils.pas
@@ -0,0 +1,212 @@
+(*
+ GTK-Kylix Library: GTKUtils - Various utilities
+ Version 0.6.17 (last updated 2003-10-07)
+ Copyright (C) 2003 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 GTKUtils;
+{ $WEAKPACKAGEUNIT}
+
+interface
+
+uses gtk2, gdk2, glib2, SysUtils, GTKControls, GTKClasses;
+
+(********************************************************************************************************************************)
+function PgcharToString(const S: Pgchar): string;
+function StringToPgchar(const S: string): Pgchar;
+function AllocateColor(Widget: PGtkWidget; R, G, B: Word): PGdkColor; overload;
+function AllocateColor(R, G, B: Word): TGDKColor; overload;
+function KeyValToUnicode(const Key: word): guint32;
+function UnicodeToKeyVal(const UnicodeVal: guint32): word;
+function GetDefaultForegroundColor(State: integer): PGdkColor; overload;
+function GetDefaultForegroundColor(Widget: TGTKControl; State: integer): PGdkColor; overload;
+function GetDefaultBackgroundColor(State: integer): PGdkColor; overload;
+function GetDefaultBackgroundColor(Widget: TGTKControl; State: integer): PGdkColor; overload;
+function GetDefaultBaseColor(State: integer): PGdkColor; overload;
+function GetDefaultBaseColor(Widget: TGTKControl; State: integer): PGdkColor; overload;
+function GetDefaultTextColor(State: integer): PGdkColor; overload;
+function GetDefaultTextColor(Widget: TGTKControl; State: integer): PGdkColor; overload;
+function GDKColorToPGdkColor(Color: TGDKColor): PGdkColor;
+function PGdkColorToGDKColor(Color: PGdkColor): TGDKColor;
+function GDKColorToString(Color: TGDKColor): string;
+function StringToGDKColor(Str: string; var Color: TGDKColor): boolean;
+(********************************************************************************************************************************)
+
+implementation
+
+(********************************************************************************************************************************)
+function PgcharToString(const S: Pgchar): string;
+begin
+ Result := string(S);
+end;
+
+(********************************************************************************************************************************)
+function StringToPgchar(const S: string): Pgchar;
+begin
+ Result := PChar(S);
+end;
+
+(********************************************************************************************************************************)
+function AllocateColor(Widget: PGtkWidget; R, G, B: Word): PGdkColor;
+begin
+ New(Result);
+ with Result^ do begin
+ Pixel := 0;
+ Red := R;
+ Green := G;
+ Blue := B;
+ end;
+ if Assigned(Widget) then gdk_colormap_alloc_color(gtk_widget_get_colormap(Widget), Result, True, False);
+end;
+
+function AllocateColor(R, G, B: Word): TGDKColor;
+begin
+ Result.red := R;
+ Result.green := G;
+ Result.blue := B;
+end;
+
+(********************************************************************************************************************************)
+function KeyValToUnicode(const Key: word): guint32;
+begin
+ Result := gdk_keyval_to_unicode(Key);
+end;
+
+(********************************************************************************************************************************)
+function UnicodeToKeyVal(const UnicodeVal: guint32): word;
+begin
+ Result := gdk_unicode_to_keyval(UnicodeVal);
+end;
+
+(********************************************************************************************************************************)
+function GetDefaultForegroundColor(State: integer): PGdkColor;
+var Widget: PGtkWidget;
+ Style: PGtkStyle;
+begin
+ Widget := gtk_window_new(GTK_WINDOW_TOPLEVEL);
+ Style := gtk_rc_get_style(Widget);
+ Result := @Style^.fg[State];
+ gtk_widget_destroy(Widget);
+end;
+
+function GetDefaultForegroundColor(Widget: TGTKControl; State: integer): PGdkColor;
+var Style: PGtkStyle;
+begin
+ Style := gtk_rc_get_style(Widget.FWidget);
+ Result := @Style^.fg[State];
+end;
+
+(********************************************************************************************************************************)
+function GetDefaultBackgroundColor(State: integer): PGdkColor;
+var Widget: PGtkWidget;
+ Style: PGtkStyle;
+begin
+ Widget := gtk_window_new(GTK_WINDOW_TOPLEVEL);
+ Style := gtk_rc_get_style(Widget);
+ Result := @Style^.bg[State];
+ gtk_widget_destroy(Widget);
+end;
+
+function GetDefaultBackgroundColor(Widget: TGTKControl; State: integer): PGdkColor;
+var Style: PGtkStyle;
+begin
+ Style := gtk_rc_get_style(Widget.FWidget);
+ Result := @Style^.bg[State];
+end;
+
+(********************************************************************************************************************************)
+function GetDefaultBaseColor(State: integer): PGdkColor;
+var Widget: PGtkWidget;
+ Style: PGtkStyle;
+begin
+ Widget := gtk_window_new(GTK_WINDOW_TOPLEVEL);
+ Style := gtk_rc_get_style(Widget);
+ Result := @Style^.base[State];
+ gtk_widget_destroy(Widget);
+end;
+
+function GetDefaultBaseColor(Widget: TGTKControl; State: integer): PGdkColor;
+var Style: PGtkStyle;
+begin
+ Style := gtk_rc_get_style(Widget.FWidget);
+ Result := @Style^.base[State];
+end;
+
+(********************************************************************************************************************************)
+function GetDefaultTextColor(State: integer): PGdkColor;
+var Widget: PGtkWidget;
+ Style: PGtkStyle;
+begin
+ Widget := gtk_window_new(GTK_WINDOW_TOPLEVEL);
+ Style := gtk_rc_get_style(Widget);
+ Result := @Style^.text[State];
+ gtk_widget_destroy(Widget);
+end;
+
+function GetDefaultTextColor(Widget: TGTKControl; State: integer): PGdkColor;
+var Style: PGtkStyle;
+begin
+ Style := gtk_rc_get_style(Widget.FWidget);
+ Result := @Style^.text[State];
+end;
+
+(********************************************************************************************************************************)
+function GDKColorToPGdkColor(Color: TGDKColor): PGdkColor;
+begin
+ New(Result);
+ Result^.pixel := Color.pixel;
+ Result^.red := Color.red;
+ Result^.green := Color.green;
+ Result^.blue := Color.blue;
+end;
+
+(********************************************************************************************************************************)
+function PGdkColorToGDKColor(Color: PGdkColor): TGDKColor;
+begin
+ Result.pixel := Color.pixel;
+ Result.red := Color.red;
+ Result.green := Color.green;
+ Result.blue := Color.blue;
+end;
+
+(********************************************************************************************************************************)
+function GDKColorToString(Color: TGDKColor): string;
+begin
+ Result := Format('#%.2x%.2x%.2xFF', [Color.red div 256, Color.green div 256, Color.blue div 256]);
+end;
+
+(********************************************************************************************************************************)
+function StringToGDKColor(Str: string; var Color: TGDKColor): boolean;
+var AColor: PGdkColor;
+begin
+ Result := False;
+ Str := ANSIUpperCase(Trim(Str));
+ if (Length(Str) < 7) or (Str[1] <> '#') then Exit;
+ try
+ New(AColor);
+ if Length(Str) = 9 then Delete(Str, 8, 2);
+ Result := boolean(gdk_color_parse(PChar(Str), AColor));
+ Color := PGdkColorToGDKColor(AColor);
+ Dispose(AColor);
+ except end;
+end;
+
+(********************************************************************************************************************************)
+
+end.
diff --git a/libgtk_kylix/GTKView.pas b/libgtk_kylix/GTKView.pas
new file mode 100644
index 0000000..a8b80fc
--- /dev/null
+++ b/libgtk_kylix/GTKView.pas
@@ -0,0 +1,1376 @@
+(*
+ GTK-Kylix Library: GTKView - GtkTreeView and its modifications
+ Version 0.6.21 (last updated 2006-05-06)
+ Copyright (C) 2006 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 GTKView;
+{ $WEAKPACKAGEUNIT}
+{$O+} // Optimization needs to be enabled for this unit due to bug in compiler (fixed columns doesn't work)
+
+interface
+
+uses gtk2, gdk2, gdk2pixbuf, glib2, Classes, GTKControls, GTKConsts, GTKUtils, GTKClasses, GTKForms, GTKPixbuf;
+ // Quick jump: QForms QControls QStdCtrls QComCtrls
+
+
+type
+ TGTKListItem = class;
+ TGTKTreeViewColumn = class;
+
+(****************************************** TGTKTREEVIEWCOLUMN ******************************************************************)
+ TGTKTreeViewColumnSizingMode = (smGrowOnly, smAutoSize, smFixed);
+ TGTKTreeViewSortOrder = (soAscending, soDescending, soNone);
+ TGTKTreeViewColumnType = (ctText, ctToggle, ctImageText);
+ TGTKTreeViewColumnEditedEvent = procedure(Sender: TObject; Column: TGTKTreeViewColumn; Item: TGTKListItem; var NewText: string; var AllowChange: boolean; var DataColumn: integer) of object;
+ TGTKTreeViewColumnToggledEvent = procedure(Sender: TObject; Column: TGTKTreeViewColumn; Item: TGTKListItem) of object;
+ TGTKTreeViewColumn = class(TComponent)
+ private
+ FOwner: TComponent;
+ FColumnType: TGTKTreeViewColumnType;
+ FOnEdited: TGTKTreeViewColumnEditedEvent;
+ FOnToggled: TGTKTreeViewColumnToggledEvent;
+ FOnClicked: TNotifyEvent;
+ FIndex: integer;
+ function GetCaption: string;
+ function GetVisible: boolean;
+ function GetResizable: boolean;
+ function GetSizingMode: TGTKTreeViewColumnSizingMode;
+ function GetWidth: integer;
+ function GetFixedWidth: integer;
+ function GetMinWidth: integer;
+ function GetMaxWidth: integer;
+ function GetClickable: boolean;
+ function GetAlignment: Double;
+ function GetReorderable: boolean;
+ function GetSortID: integer;
+ function GetShowSortIndicator: boolean;
+ function GetSortOrder: TGTKTreeViewSortOrder;
+ procedure SetCaption(Value: string);
+ procedure SetVisible(Value: boolean);
+ procedure SetResizable(Value: boolean);
+ procedure SetSizingMode(Value: TGTKTreeViewColumnSizingMode);
+ procedure SetFixedWidth(Value: integer);
+ procedure SetMinWidth(Value: integer);
+ procedure SetMaxWidth(Value: integer);
+ procedure SetClickable(Value: boolean);
+ procedure SetAlignment(Value: Double);
+ procedure SetReorderable(Value: boolean);
+ procedure SetSortID(Value: integer);
+ procedure SetShowSortIndicator(Value: boolean);
+ procedure SetSortOrder(Value: TGTKTreeViewSortOrder);
+ procedure SetColumnType(Value: TGTKTreeViewColumnType);
+ public
+ FColumn: PGtkTreeViewColumn;
+ FRenderer, FPixbufRenderer: PGtkCellRenderer;
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateTyped(AOwner: TComponent; ColType: TGTKTreeViewColumnType);
+ destructor Destroy; override;
+ procedure AddAttribute(Attribute: string; Value: integer);
+ procedure SetProperty(AProperty: string; Value: integer); overload;
+ procedure SetProperty(AProperty: string; Value: string); overload;
+ procedure SetProperty(AProperty: string; Value: Double); overload;
+ procedure SetProperty(AProperty: string; Value: pointer); overload;
+ procedure AddImageAttribute(Attribute: string; Value: integer);
+ procedure SetImageProperty(AProperty: string; Value: integer); overload;
+ procedure SetImageProperty(AProperty: string; Value: string); overload;
+ procedure SetImageProperty(AProperty: string; Value: Double); overload;
+ procedure SetImageProperty(AProperty: string; Value: pointer); overload;
+ procedure ClearAttributes;
+ property Parent: TComponent read FOwner;
+ published
+ property Caption: string read GetCaption write SetCaption;
+ property Visible: boolean read GetVisible write SetVisible;
+ property Resizable: boolean read GetResizable write SetResizable;
+ property SizingMode: TGTKTreeViewColumnSizingMode read GetSizingMode write SetSizingMode;
+ property Width: integer read GetWidth;
+ property FixedWidth: integer read GetFixedWidth write SetFixedWidth;
+ property MinWidth: integer read GetMinWidth write SetMinWidth;
+ property MaxWidth: integer read GetMaxWidth write SetMaxWidth;
+ property Clickable: boolean read GetClickable write SetClickable;
+ property Alignment: Double read GetAlignment write SetAlignment;
+ property Reorderable: boolean read GetReorderable write SetReorderable;
+ property SortID: integer read GetSortID write SetSortID;
+ property ShowSortIndicator: boolean read GetShowSortIndicator write SetShowSortIndicator;
+ property SortOrder: TGTKTreeViewSortOrder read GetSortOrder write SetSortOrder;
+ property ColumnType: TGTKTreeViewColumnType read FColumnType write SetColumnType;
+ property Index: integer read FIndex;
+ property OnEdited: TGTKTreeViewColumnEditedEvent read FOnEdited write FOnEdited;
+ property OnToggled: TGTKTreeViewColumnToggledEvent read FOnToggled write FOnToggled;
+ property OnClicked: TNotifyEvent read FOnClicked write FOnClicked;
+ end;
+
+(****************************************** TGTKTREEVIEWCOLUMNS *****************************************************************)
+ TGTKTreeViewColumns = class(TComponent)
+ private
+ FOwner: TComponent;
+ FList: TList;
+ function GetCount: Integer;
+ function GetItem(Index: Integer): TGTKTreeViewColumn;
+ procedure SetItem(Index: Integer; Value: TGTKTreeViewColumn);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function Add: TGTKTreeViewColumn;
+ function AddTyped(ColType: TGTKTreeViewColumnType): TGTKTreeViewColumn;
+ procedure Insert(Index: Integer; Item: TGTKTreeViewColumn);
+ procedure Delete(Index: Integer);
+ procedure Clear;
+ procedure AutosizeColumns;
+ property Items[Index: Integer]: TGTKTreeViewColumn read GetItem write SetItem; default;
+ property Parent: TComponent read FOwner;
+ published
+ property Count: Integer read GetCount;
+ end;
+
+(****************************************** TGTKLISTITEM ************************************************************************)
+ TGTKListItem = class(TComponent)
+ private
+ FOwner: TComponent;
+ FIndex: longint;
+ FData: pointer;
+ function GetSelected: boolean;
+ procedure SetSelected(Value: boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function AsString(Index: longint): string;
+ function AsInteger(Index: longint): integer;
+ function AsPointer(Index: longint): pointer;
+ function AsBoolean(Index: longint): boolean;
+ procedure SetValue(Index: longint; Value: string); overload;
+ procedure SetValue(Index: longint; Value: integer); overload;
+ procedure SetValue(Index: longint; Value: pointer); overload;
+ procedure SetValue(Index: longint; Value: boolean); overload;
+ procedure SetCursor(const FocusColumnNo: integer; const StartEditing, UseAlignment: boolean; const AlignX, AlignY: Double);
+ procedure StartEditing(ColumnNo: integer);
+ procedure RedrawRow;
+ property Data: pointer read FData write FData;
+ property Parent: TComponent read FOwner;
+ function IsVisible: boolean;
+ published
+ property Selected: boolean read GetSelected write SetSelected;
+ property Index: integer read FIndex;
+ end;
+
+(****************************************** TGTKLISTITEMS ***********************************************************************)
+ TGTKListColumnType = (lcText, lcNumber, lcPointer, lcPixbuf, lcBoolean);
+ TGTKListItems = class(TComponent)
+ private
+ FStore: PGtkListStore;
+ FOwner: TComponent;
+ FList: TList;
+ function GetCount: longint;
+ function GetItem(Index: longint): TGTKListItem;
+ procedure SetItem(Index: longint; Value: TGTKListItem);
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateTyped(AOwner: TComponent; ColumnTypes: array of TGTKListColumnType);
+ destructor Destroy; override;
+ procedure SetColumnTypes(Types: array of TGTKListColumnType);
+ function Add: TGTKListItem;
+ procedure Insert(Index: longint; Item: TGTKListItem);
+ procedure Append(Item: TGTKListItem);
+ procedure Delete(Index: longint);
+ procedure Clear;
+ property Items[Index: longint]: TGTKListItem read GetItem write SetItem; default;
+ property Parent: TComponent read FOwner;
+ published
+ property Count: longint read GetCount;
+ end;
+
+(****************************************** TGTKVIEW ****************************************************************************)
+ TGTKSelectionMode = (smNone, smSingle, smBrowse, smMultiple);
+ TGTKCellDataFunc = procedure (Sender: TObject; tree_view: PGtkTreeView; tree_column : PGtkTreeViewColumn; cell : PGtkCellRenderer; tree_model : PGtkTreeModel; iter : PGtkTreeIter) of object;
+ TGTKSortCoversionFunc = function (Sender: TObject; const Index: integer): integer of object;
+ TGTKView = class(TGTKContainer)
+ private
+ FColumns: TGTKTreeViewColumns;
+ FOnSelectionChanged: TNotifyEvent;
+ FTreeModelSort: PGtkTreeModelSort;
+ FCellDataFunc: TGTKCellDataFunc;
+ FTreeModel: PGtkTreeModel;
+ FToSortedConvFunc, FFromSortedConvFunc: TGTKSortCoversionFunc;
+ function GetSelectionMode: TGTKSelectionMode;
+ function GetShowHeaders: boolean;
+ function GetRulesHint: boolean;
+ function GetReorderable: boolean;
+ function GetEnableSearch: boolean;
+ function GetSearchColumn: integer;
+ function GetSortColumnID: integer;
+ function GetSortOrder: TGTKTreeViewSortOrder;
+ procedure SetSelectionMode(Value: TGTKSelectionMode);
+ procedure SetShowHeaders(Value: boolean);
+ procedure SetRulesHint(Value: boolean);
+ procedure SetReorderable(Value: boolean);
+ procedure SetEnableSearch(Value: boolean);
+ procedure SetSearchColumn(Value: integer);
+ procedure SetSortColumnID(Value: integer);
+ procedure SetSortOrder(Value: TGTKTreeViewSortOrder);
+ protected
+ public
+ FSelection: PGtkTreeSelection;
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SelectAll;
+ procedure DeselectAll;
+ procedure SetSortInfo(ColumnID: integer; Order: TGTKTreeViewSortOrder);
+ function ConvertToSorted(Index: integer): integer;
+ function ConvertFromSorted(Index: integer): integer;
+ procedure ConvertPathToChild(var Path: PGtkTreePath);
+ procedure ConvertChildToPath(var Path: PGtkTreePath);
+ published
+ property Columns: TGTKTreeViewColumns read FColumns write FColumns;
+ property SelectionMode: TGTKSelectionMode read GetSelectionMode write SetSelectionMode;
+ property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged;
+ property ShowHeaders: boolean read GetShowHeaders write SetShowHeaders;
+ property RulesHint: boolean read GetRulesHint write SetRulesHint;
+ property Reorderable: boolean read GetReorderable write SetReorderable;
+ property EnableSearch: boolean read GetEnableSearch write SetEnableSearch;
+ property SearchColumn: integer read GetSearchColumn write SetSearchColumn;
+ property SortColumnID: integer read GetSortColumnID write SetSortColumnID;
+ property SortOrder: TGTKTreeViewSortOrder read GetSortOrder write SetSortOrder;
+ property CellDataFunc: TGTKCellDataFunc read FCellDataFunc write FCellDataFunc;
+ property FromSortedCoversionFunc: TGTKSortCoversionFunc read FFromSortedConvFunc write FFromSortedConvFunc;
+ property ToSortedCoversionFunc: TGTKSortCoversionFunc read FToSortedConvFunc write FToSortedConvFunc;
+ end;
+
+(****************************************** TGTKLISTVIEW ************************************************************************)
+ TGTKLVItemActivateEvent = procedure (Sender: TObject; Item: TGTKListItem) of object;
+ TGTKTreeViewCompareFunc = function (Sender: TObject; var model: PGtkTreeModel; var a, b: PGtkTreeIter): integer of object;
+ TGTKListView = class(TGTKView)
+ private
+ FOnItemActivate: TGTKLVItemActivateEvent;
+ FSortable: boolean;
+ FCompareFunc: TGTKTreeViewCompareFunc;
+ FOnColumnsChanged: TNotifyEvent;
+ protected
+ FListItems: TGTKListItems;
+ procedure Recreate;
+ function GetSelected: TGTKListItem;
+ procedure SetSelected(Value: TGTKListItem);
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateTyped(AOwner: TComponent; Sortable: boolean; ColumnTypes: array of TGTKListColumnType);
+ destructor Destroy; override;
+ procedure StartEditing(ColumnNo: integer);
+ function GetItemAtPos(X, Y: integer): TGTKListItem;
+ published
+ property Items: TGTKListItems read FListItems write FListItems;
+ property Selected: TGTKListItem read GetSelected write SetSelected;
+ property OnItemActivate: TGTKLVItemActivateEvent read FOnItemActivate write FOnItemActivate;
+ property CompareFunc: TGTKTreeViewCompareFunc read FCompareFunc write FCompareFunc;
+ property OnColumnsChanged: TNotifyEvent read FOnColumnsChanged write FOnColumnsChanged;
+ end;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+implementation
+
+uses SysUtils, DateUtils;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKView.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FColumns := TGTKTreeViewColumns.Create(Self);
+ FOnSelectionChanged := nil;
+ FToSortedConvFunc := nil;
+ FFromSortedConvFunc := nil;
+end;
+
+destructor TGTKView.Destroy;
+begin
+ FColumns.Free;
+ inherited Destroy;
+end;
+
+function TGTKView.GetSelectionMode: TGTKSelectionMode;
+begin
+ Result := TGTKSelectionMode(gtk_tree_selection_get_mode(FSelection));
+end;
+
+procedure TGTKView.SetSelectionMode(Value: TGTKSelectionMode);
+begin
+ gtk_tree_selection_set_mode(FSelection, Integer(Value));
+end;
+
+procedure TGTKView.SelectAll;
+begin
+ gtk_tree_selection_select_all(FSelection);
+end;
+
+procedure TGTKView.DeselectAll;
+begin
+ gtk_tree_selection_unselect_all(FSelection);
+end;
+
+function TGTKView.GetShowHeaders: boolean;
+begin
+ Result := gtk_tree_view_get_headers_visible(PGtkTreeView(FWidget));
+end;
+
+procedure TGTKView.SetShowHeaders(Value: boolean);
+begin
+ gtk_tree_view_set_headers_visible(PGtkTreeView(FWidget), Value);
+end;
+
+function TGTKView.GetRulesHint: boolean;
+begin
+ Result := gtk_tree_view_get_rules_hint(PGtkTreeView(FWidget));
+end;
+
+procedure TGTKView.SetRulesHint(Value: boolean);
+begin
+ gtk_tree_view_set_rules_hint(PGtkTreeView(FWidget), Value);
+end;
+
+function TGTKView.GetReorderable: boolean;
+begin
+ Result := gtk_tree_view_get_reorderable(PGtkTreeView(FWidget));
+end;
+
+procedure TGTKView.SetReorderable(Value: boolean);
+begin
+ gtk_tree_view_set_reorderable(PGtkTreeView(FWidget), Value);
+end;
+
+function TGTKView.GetEnableSearch: boolean;
+begin
+ Result := gtk_tree_view_get_enable_search(PGtkTreeView(FWidget));
+end;
+
+procedure TGTKView.SetEnableSearch(Value: boolean);
+begin
+ gtk_tree_view_set_enable_search(PGtkTreeView(FWidget), Value);
+end;
+
+function TGTKView.GetSearchColumn: integer;
+begin
+ Result := gtk_tree_view_get_search_column(PGtkTreeView(FWidget));
+end;
+
+procedure TGTKView.SetSearchColumn(Value: integer);
+begin
+ gtk_tree_view_set_search_column(PGtkTreeView(FWidget), Value);
+end;
+
+function TGTKView.GetSortColumnID: integer;
+var sort_column_id: gint;
+ order: TGtkSortType;
+begin
+ Result := -1;
+ if (FTreeModelSort <> nil) and gtk_tree_sortable_get_sort_column_id(PGtkTreeSortable(FTreeModelSort), @sort_column_id, @order)
+ then Result := sort_column_id;
+end;
+
+procedure TGTKView.SetSortColumnID(Value: integer);
+begin
+ if FTreeModelSort <> nil then
+ gtk_tree_sortable_set_sort_column_id(PGtkTreeSortable(FTreeModelSort), Value, TGtkSortType(GetSortOrder));
+end;
+
+procedure TGTKView.ConvertChildToPath(var Path: PGtkTreePath);
+var NewPath: PGtkTreePath;
+begin
+ if Assigned(FTreeModelSort) then
+ if not Assigned(FToSortedConvFunc) then begin
+ NewPath := gtk_tree_model_sort_convert_child_path_to_path(FTreeModelSort, Path);
+ Path := NewPath;
+ end else begin
+ NewPath := gtk_tree_path_new_from_string(PChar(IntToStr(FToSortedConvFunc(Self, StrToIntDef(gtk_tree_path_to_string(Path), 0)))));
+ Path := NewPath;
+ end;
+end;
+
+procedure TGTKView.ConvertPathToChild(var Path: PGtkTreePath);
+var NewPath: PGtkTreePath;
+begin
+ if Assigned(FTreeModelSort) then
+ if not Assigned(FFromSortedConvFunc) then begin
+ NewPath := gtk_tree_model_sort_convert_path_to_child_path(FTreeModelSort, Path);
+ Path := NewPath;
+ end else begin
+ NewPath := gtk_tree_path_new_from_string(PChar(IntToStr(FFromSortedConvFunc(Self, StrToIntDef(gtk_tree_path_to_string(Path), 0)))));
+ Path := NewPath;
+ end;
+end;
+
+function TGTKView.GetSortOrder: TGTKTreeViewSortOrder;
+var sort_column_id: gint;
+ order: TGtkSortType;
+begin
+ Result := soNone;
+ if (FTreeModelSort <> nil) and gtk_tree_sortable_get_sort_column_id(PGtkTreeSortable(FTreeModelSort), @sort_column_id, @order)
+ then Result := TGTKTreeViewSortOrder(order);
+end;
+
+procedure TGTKView.SetSortOrder(Value: TGTKTreeViewSortOrder);
+begin
+ if FTreeModelSort <> nil then
+ gtk_tree_sortable_set_sort_column_id(PGtkTreeSortable(FTreeModelSort), GetSortColumnID, TGtkSortType(Value));
+end;
+
+procedure TGTKView.SetSortInfo(ColumnID: integer; Order: TGTKTreeViewSortOrder);
+begin
+ if FTreeModelSort <> nil then
+ gtk_tree_sortable_set_sort_column_id(PGtkTreeSortable(FTreeModelSort), ColumnID, TGtkSortType(Order));
+end;
+
+function TGTKView.ConvertToSorted(Index: integer): integer;
+var Path: PGtkTreePath;
+ Iter: TGtkTreeIter;
+begin
+ Result := Index;
+ if Application.GTKVersion_2_0_5_Up then begin
+ Path := gtk_tree_path_new_from_string(StringToPgchar(IntToStr(Index)));
+ if not Assigned(Path) then Exit;
+ if Assigned(FTreeModelSort) then Path := gtk_tree_model_sort_convert_child_path_to_path(FTreeModelSort, Path);
+ if not Assigned(Path) then Exit;
+ Result := gtk_tree_path_get_indices(Path)^;
+ gtk_tree_path_free(Path);
+ end else
+ if Assigned(FToSortedConvFunc) then Result := FToSortedConvFunc(Self, Index) else begin
+ gtk_tree_model_get_iter_from_string(FTreeModel, @Iter, PChar(IntToStr(Index)));
+// gtk_tree_model_sort_convert_child_iter_to_iter(FTreeModelSort, @NewIter, @Iter);
+ Path := gtk_tree_model_get_path(FTreeModel, @Iter);
+ if not Assigned(Path) then Exit;
+ if Assigned(FTreeModelSort) then Path := gtk_tree_model_sort_convert_child_path_to_path(FTreeModelSort, Path);
+ if not Assigned(Path) then Exit;
+ Result := StrToIntDef(String(gtk_tree_path_to_string(Path)), Index);
+ gtk_tree_path_free(Path);
+ end;
+end;
+
+function TGTKView.ConvertFromSorted(Index: integer): integer;
+var Path: PGtkTreePath;
+ Iter: TGtkTreeIter;
+begin
+ Result := Index;
+ if Application.GTKVersion_2_0_5_Up then begin
+ Path := gtk_tree_path_new_from_string(StringToPgchar(IntToStr(Index)));
+ if not Assigned(Path) then Exit;
+ if Assigned(FTreeModelSort) then Path := gtk_tree_model_sort_convert_path_to_child_path(FTreeModelSort, Path);
+ if not Assigned(Path) then Exit;
+ Result := gtk_tree_path_get_indices(Path)^;
+ gtk_tree_path_free(Path);
+ end else
+ if Assigned(FFromSortedConvFunc) then Result := FFromSortedConvFunc(Self, Index) else begin
+ gtk_tree_model_get_iter_from_string(FTreeModel, @Iter, PChar(IntToStr(Index)));
+// gtk_tree_model_sort_convert_child_iter_to_iter(FTreeModelSort, @NewIter, @Iter);
+ Path := gtk_tree_model_get_path(FTreeModel, @Iter);
+ if not Assigned(Path) then Exit;
+ if Assigned(FTreeModelSort) then Path := gtk_tree_model_sort_convert_path_to_child_path(FTreeModelSort, Path);
+ if not Assigned(Path) then Exit;
+ Result := StrToIntDef(String(gtk_tree_path_to_string(Path)), Index);
+ gtk_tree_path_free(Path);
+ end;
+end;
+
+procedure CellDataFunc(tree_column : PGtkTreeViewColumn; cell : PGtkCellRenderer; tree_model : PGtkTreeModel; iter : PGtkTreeIter; data : gpointer); cdecl;
+begin
+ if Assigned(TGTKView(data).FCellDataFunc) then TGTKView(data).FCellDataFunc(TGTKView(data), PGtkTreeView(TGTKView(data).FWidget), tree_column, cell, tree_model, iter);
+end;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKListView.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FListItems := TGTKListItems.Create(Self);
+ FSortable := False;
+ FCompareFunc := nil;
+ Recreate;
+end;
+
+destructor TGTKListView.Destroy;
+begin
+ FListItems.Free;
+ inherited Destroy;
+end;
+
+procedure TGTKListView_changed(treeselection: PGtkTreeSelection; user_data: gpointer); cdecl;
+begin
+ if Assigned(TGTKListView(user_data).FOnSelectionChanged) then TGTKListView(user_data).FOnSelectionChanged(TGTKListView(user_data));
+end;
+
+procedure TGTKListView_row_activated(treeview: PGtkTreeView; arg1: PGtkTreePath; arg2: PGtkTreeViewColumn; user_data: gpointer); cdecl;
+var Item: TGTKListItem;
+ AIndex: integer;
+begin
+ Item := nil;
+ if Assigned(arg1) then begin
+ TGTKListView(user_data).ConvertPathToChild(arg1);
+ if Application.GTKVersion_2_0_5_Up then AIndex := gtk_tree_path_get_indices(arg1)^
+ else AIndex := StrToIntDef(String(gtk_tree_path_to_string(arg1)), 0);
+ Item := TGTKListView(user_data).Items[AIndex];
+ Item.FIndex := AIndex;
+ end;
+ if Assigned(TGTKListView(user_data).FOnItemActivate) then TGTKListView(user_data).FOnItemActivate(TGTKListView(user_data), Item);
+end;
+
+procedure TGTKListView_columns_changed(treeselection: PGtkTreeSelection; user_data: gpointer); cdecl;
+begin
+ if Assigned(TGTKListView(user_data).FOnColumnsChanged) then TGTKListView(user_data).FOnColumnsChanged(TGTKListView(user_data));
+end;
+
+procedure TGTKListView.Recreate;
+begin
+ if Assigned(FWidget) then gtk_widget_destroy(PGtkWidget(FWidget));
+ FTreeModelSort := nil;
+ if not FSortable then FWidget := gtk_tree_view_new_with_model(PGtkTreeModel(FListItems.FStore))
+ else begin
+ FTreeModelSort := gtk_tree_model_sort_new_with_model(FListItems.FStore);
+ FWidget := gtk_tree_view_new_with_model(FTreeModelSort);
+ end;
+ FSelection := gtk_tree_view_get_selection(PGtkTreeView(FWidget));
+ g_signal_connect(FSelection, 'changed', G_CALLBACK(@TGTKListView_changed), Self);
+ g_signal_connect(FWidget, 'row-activated', G_CALLBACK(@TGTKListView_row_activated), Self);
+ g_signal_connect(FWidget, 'columns-changed', G_CALLBACK(@TGTKListView_columns_changed), Self);
+ FTreeModel := gtk_tree_view_get_model(PGtkTreeView(FWidget));
+ Show;
+end;
+
+constructor TGTKListView.CreateTyped(AOwner: TComponent; Sortable: boolean; ColumnTypes: array of TGTKListColumnType);
+begin
+ inherited Create(AOwner);
+ FListItems := TGTKListItems.CreateTyped(Self, ColumnTypes);
+ FSortable := Sortable;
+ FCompareFunc := nil;
+ Recreate;
+end;
+
+function TGTKListView.GetSelected: TGTKListItem;
+var Iter{, NewIter}: TGtkTreeIter;
+ Path: PGtkTreePath;
+ AIndex: integer;
+ i: integer;
+begin
+ Result := nil;
+ Path := nil;
+ if not Application.GTKVersion_2_0_5_Up then begin
+ for i := 0 to Items.Count - 1 do begin
+ Path := gtk_tree_path_new_from_string(PChar(IntToStr(i)));
+ if gtk_tree_selection_path_is_selected(gtk_tree_view_get_selection(PGtkTreeView(FWidget)), Path) then Break else
+// WriteLn('Index ', i, ', Selected: ', gtk_tree_selection_path_is_selected(gtk_tree_view_get_selection(PGtkTreeView(FWidget)), Path));
+ gtk_tree_path_free(Path);
+ Path := nil;
+ end;
+// WriteLn('Selected: ', String(gtk_tree_path_to_string(Path)));
+ ConvertPathToChild(Path);
+(* gtk_tree_model_get_iter_from_string(gtk_tree_view_get_model(PGtkTreeView(FWidget)){FTreeModelSort}, @Iter, gtk_tree_path_to_string(Path));
+ gtk_tree_model_sort_convert_child_iter_to_iter(FTreeModelSort, @NewIter, @Iter);
+ Path := gtk_tree_model_get_path({FTreeModelSort}gtk_tree_view_get_model(PGtkTreeView(FWidget)), @NewIter);
+ *)
+// gtk_tree_model_sort_clear_cache(FTreeModelSort);
+// Path := gtk_tree_model_sort_convert_path_to_child_path(FTreeModelSort, Path);
+ end else begin
+ if not gtk_tree_selection_get_selected(gtk_tree_view_get_selection(PGtkTreeView(FWidget)), nil, @Iter) then Exit;
+ Path := gtk_tree_model_get_path(gtk_tree_view_get_model(PGtkTreeView(FWidget)), @iter);
+ if not Assigned(Path) then Exit;
+ ConvertPathToChild(Path);
+ end;
+// WriteLn('Selected Converted: ', String(gtk_tree_path_to_string(Path)));
+ if Assigned(Path) then begin
+ if Application.GTKVersion_2_0_5_Up then AIndex := gtk_tree_path_get_indices(Path)^
+ else AIndex := StrToIntDef(String(gtk_tree_path_to_string(Path)), 0);
+ Result := Items[AIndex];
+ Result.FIndex := AIndex;
+ gtk_tree_path_free(Path);
+ end;
+end;
+
+procedure TGTKListView.SetSelected(Value: TGTKListItem);
+var Path: PGtkTreePath;
+begin
+ Path := gtk_tree_path_new_from_string(StringToPgchar(IntToStr(Value.FIndex)));
+ ConvertChildToPath(Path);
+ gtk_tree_selection_select_path(FSelection, Path);
+ gtk_tree_path_free(Path);
+end;
+
+function GtkTreeIterCompareFunc(model: PGtkTreeModel; a: PGtkTreeIter; b: PGtkTreeIter; user_data: gpointer): gint; cdecl;
+var Value: TGValue;
+ s: string;
+begin
+ if not Assigned(TGTKListView(user_data).FCompareFunc) then begin
+ Value.g_type := 0;
+ gtk_tree_model_get_value(model, a, TGTKView(user_data).GetSortColumnID, @Value);
+ s := string(PChar(Value.data[0].v_pointer));
+ Value.g_type := 0;
+ gtk_tree_model_get_value(model, b, TGTKView(user_data).GetSortColumnID, @Value);
+ Result := AnsiCompareStr(s, PChar(Value.data[0].v_pointer));
+ end else Result := TGTKListView(user_data).FCompareFunc(TGTKView(user_data), model, a, b);
+end;
+
+procedure TGTKListView.StartEditing(ColumnNo: integer);
+var Iter: TGtkTreeIter;
+ Path: PGtkTreePath;
+begin
+ if not gtk_tree_selection_get_selected(FSelection, nil, @Iter) then Exit;
+ Path := gtk_tree_model_get_path(FTreeModel, @iter);
+ if not Assigned(Path) then Exit;
+ gtk_tree_view_set_cursor(PGtkTreeView(FWidget), Path, FColumns[ColumnNo].FColumn, True);
+end;
+
+function TGTKListView.GetItemAtPos(X, Y: integer): TGTKListItem;
+var Path: PGtkTreePath;
+ Column: PGtkTreeViewColumn;
+ AIndex: integer;
+begin
+ Result := nil;
+ if gtk_tree_view_get_path_at_pos(PGtkTreeView(FWidget), X, Y, Path, Column, nil, nil) then begin
+ if not Assigned(Path) then Exit;
+ ConvertPathToChild(Path);
+ if Application.GTKVersion_2_0_5_Up then AIndex := gtk_tree_path_get_indices(Path)^
+ else AIndex := StrToIntDef(String(gtk_tree_path_to_string(Path)), 0);
+ Result := Items[AIndex];
+ Result.FIndex := AIndex;
+ gtk_tree_path_free(Path);
+ end;
+end;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKListItems.Create(AOwner: TComponent);
+const Types : GType = G_TYPE_STRING;
+begin
+ inherited Create(AOwner);
+ FOwner := AOwner;
+ FStore := gtk_list_store_newv(1, @Types);
+ FList := TList.Create;
+end;
+
+destructor TGTKListItems.Destroy;
+begin
+ if not (csDestroying in ComponentState) then begin
+ Clear;
+ FList.Free;
+ gtk_object_destroy(PGtkObject(FStore));
+ end;
+ inherited Destroy;
+end;
+
+constructor TGTKListItems.CreateTyped(AOwner: TComponent; ColumnTypes: array of TGTKListColumnType);
+var i: integer;
+ Cols : array[0..255] of GType;
+begin
+ inherited Create(AOwner);
+ FOwner := AOwner;
+ FList := TList.Create;
+ for i := Low(ColumnTypes) to High(ColumnTypes) do
+ case ColumnTypes[i] of
+ lcText : Cols[i] := G_TYPE_STRING;
+ lcNumber : Cols[i] := G_TYPE_LONG;
+ lcPointer : Cols[i] := G_TYPE_POINTER;
+ lcPixbuf : Cols[i] := GDK_TYPE_PIXBUF;
+ lcBoolean : Cols[i] := G_TYPE_BOOLEAN;
+ end;
+ FStore := gtk_list_store_newv(Length(ColumnTypes), @Cols);
+end;
+
+procedure TGTKListItems.SetColumnTypes(Types: array of TGTKListColumnType);
+var i: integer;
+ Cols : array[0..255] of GType;
+begin
+ for i := Low(Types) to High(Types) do
+ case Types[i] of
+ lcText : Cols[i] := G_TYPE_STRING;
+ lcNumber : Cols[i] := G_TYPE_LONG;
+ lcPointer : Cols[i] := G_TYPE_POINTER;
+ lcPixbuf : Cols[i] := GDK_TYPE_PIXBUF;
+ lcBoolean : Cols[i] := G_TYPE_BOOLEAN;
+ end;
+ g_object_unref(PGObject(FStore));
+ FStore := gtk_list_store_newv(Length(Types), @Cols);
+ (FOwner as TGTKListView).Recreate;
+end;
+
+function TGTKListItems.GetItem(Index: longint): TGTKListItem;
+begin
+ Result := TGTKListItem(FList[Index]);
+ Result.FIndex := Index;
+end;
+
+procedure TGTKListItems.SetItem(Index: longint; Value: TGTKListItem);
+begin
+ FList[Index] := Value;
+end;
+
+function TGTKListItems.Add: TGTKListItem;
+begin
+ Result := TGTKListItem.Create(Self);
+ Result.FIndex := GetCount;
+// Insert(GetCount, Result);
+ Append(Result);
+end;
+
+function TGTKListItems.GetCount: longint;
+begin
+ Result := FList.Count;
+end;
+
+procedure TGTKListItems.Clear;
+var i: longint;
+begin
+ for i := Count - 1 downto 0 do Delete(i); // !!!! DON'T use here gtk_list_store_clear(FStore), because it causes memory leaks !!!!
+end;
+
+procedure TGTKListItems.Delete(Index: longint);
+var x: pointer;
+ Iter: TGtkTreeIter;
+begin
+ x := FList[Index];
+ if gtk_tree_model_get_iter_from_string(PGtkTreeModel(FStore), @Iter, StringToPgchar(IntToStr(Index))) then begin
+// (FOwner as TGTKView).CovertSortableIter(Iter);
+ gtk_list_store_remove(FStore, @Iter);
+ end;
+ FList.Delete(Index);
+ TObject(x).Free;
+end;
+
+procedure TGTKListItems.Insert(Index: longint; Item: TGTKListItem);
+var Iter: TGtkTreeIter;
+begin
+ FList.Insert(Index, Item);
+ gtk_list_store_insert(FStore, @Iter, Index);
+end;
+
+procedure TGTKListItems.Append(Item: TGTKListItem);
+var Iter: TGtkTreeIter;
+begin
+ FList.Add(Item);
+ gtk_list_store_append(FStore, @Iter);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKTreeViewColumns.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOwner := AOwner;
+ FList := TList.Create;
+end;
+
+destructor TGTKTreeViewColumns.Destroy;
+begin
+ if not (csDestroying in ComponentState) then begin
+ Clear;
+ FList.Free;
+ end;
+ inherited Destroy;
+end;
+
+function TGTKTreeViewColumns.GetItem(Index: Integer): TGTKTreeViewColumn;
+begin
+ Result := TGTKTreeViewColumn(FList[Index]);
+ Result.FIndex := Index;
+end;
+
+procedure TGTKTreeViewColumns.SetItem(Index: Integer; Value: TGTKTreeViewColumn);
+begin
+ FList[Index] := Value;
+end;
+
+function TGTKTreeViewColumns.Add: TGTKTreeViewColumn;
+begin
+ Result := TGTKTreeViewColumn.Create(Self);
+ Result.FIndex := GetCount;
+ Insert(GetCount, Result);
+end;
+
+function TGTKTreeViewColumns.AddTyped(ColType: TGTKTreeViewColumnType): TGTKTreeViewColumn;
+begin
+ Result := TGTKTreeViewColumn.CreateTyped(Self, ColType);
+ Result.FIndex := GetCount;
+ Insert(GetCount, Result);
+end;
+
+function TGTKTreeViewColumns.GetCount: Integer;
+begin
+ Result := FList.Count;
+end;
+
+procedure TGTKTreeViewColumns.Clear;
+var i: Integer;
+begin
+ for i := Count - 1 downto 0 do Delete(i);
+end;
+
+procedure TGTKTreeViewColumns.Delete(Index: Integer);
+var x : pointer;
+begin
+ if not (csDestroying in ComponentState) then
+ gtk_tree_view_remove_column(PGtkTreeView((FOwner as TGTKControl).FWidget), TGTKTreeViewColumn(FList[Index]).FColumn);
+ x := FList[Index];
+ FList.Delete(Index);
+ TObject(x).Free;
+end;
+
+procedure TGTKTreeViewColumns.Insert(Index: Integer; Item: TGTKTreeViewColumn);
+begin
+ FList.Insert(Index, Item);
+ Item.FIndex := Index;
+ gtk_tree_view_insert_column(PGtkTreeView((FOwner as TGTKControl).FWidget), Item.FColumn, Index);
+ if Assigned((FOwner as TGTKView).FTreeModelSort) then
+ gtk_tree_sortable_set_sort_func(PGtkTreeSortable((FOwner as TGTKView).FTreeModelSort), Index, TGtkTreeIterCompareFunc(@GtkTreeIterCompareFunc), FOwner, nil);
+ gtk_tree_view_column_set_cell_data_func(Item.FColumn, Item.FRenderer, @CellDataFunc, (FOwner as TGTKView), nil);
+ if Item.ColumnType = ctImageText then gtk_tree_view_column_set_cell_data_func(Item.FColumn, Item.FPixbufRenderer, @CellDataFunc, (FOwner as TGTKView), nil);
+end;
+
+procedure TGTKTreeViewColumns.AutosizeColumns;
+begin
+ gtk_tree_view_columns_autosize(PGtkTreeView((FOwner as TGTKControl).FWidget));
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKTreeViewColumn.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOwner := AOwner;
+ FColumn := gtk_tree_view_column_new;
+ FRenderer := nil;
+ FPixbufRenderer := nil;
+ FOnEdited := nil;
+ FOnToggled := nil;
+ FOnClicked := nil;
+ SetColumnType(ctText);
+end;
+
+constructor TGTKTreeViewColumn.CreateTyped(AOwner: TComponent; ColType: TGTKTreeViewColumnType);
+begin
+ inherited Create(AOwner);
+ FOwner := AOwner;
+ FColumn := gtk_tree_view_column_new;
+ FRenderer := nil;
+ FPixbufRenderer := nil;
+ FOnEdited := nil;
+ FOnToggled := nil;
+ FOnClicked := nil;
+ SetColumnType(ColType);
+end;
+
+destructor TGTKTreeViewColumn.Destroy;
+begin
+ if not (csDestroying in ComponentState) then begin
+ gtk_object_destroy(PGtkObject(FRenderer));
+ if GTK_IS_OBJECT(FColumn) then gtk_object_destroy(PGtkObject(FColumn));
+ end;
+ inherited Destroy;
+end;
+
+function TGTKTreeViewColumn.GetCaption: string;
+begin
+ Result := PgcharToString(gtk_tree_view_column_get_title(FColumn));
+end;
+
+procedure TGTKTreeViewColumn.SetCaption(Value: string);
+begin
+ gtk_tree_view_column_set_title(FColumn, StringToPgchar(Value));
+end;
+
+function TGTKTreeViewColumn.GetVisible: boolean;
+begin
+ Result := gtk_tree_view_column_get_visible(FColumn);
+end;
+
+procedure TGTKTreeViewColumn.SetVisible(Value: boolean);
+begin
+ gtk_tree_view_column_set_visible(FColumn, Value);
+end;
+
+function TGTKTreeViewColumn.GetResizable: boolean;
+begin
+ Result := gtk_tree_view_column_get_resizable(FColumn);
+end;
+
+procedure TGTKTreeViewColumn.SetResizable(Value: boolean);
+begin
+ gtk_tree_view_column_set_resizable(FColumn, Value);
+end;
+
+function TGTKTreeViewColumn.GetSizingMode: TGTKTreeViewColumnSizingMode;
+begin
+ Result := TGTKTreeViewColumnSizingMode(gtk_tree_view_column_get_sizing(FColumn));
+end;
+
+procedure TGTKTreeViewColumn.SetSizingMode(Value: TGTKTreeViewColumnSizingMode);
+begin
+ gtk_tree_view_column_set_sizing(FColumn, TGtkTreeViewColumnSizing(Value));
+end;
+
+function TGTKTreeViewColumn.GetWidth: integer;
+begin
+ Result := gtk_tree_view_column_get_width(FColumn);
+end;
+
+function TGTKTreeViewColumn.GetFixedWidth: integer;
+begin
+ Result := gtk_tree_view_column_get_fixed_width(FColumn);
+end;
+
+procedure TGTKTreeViewColumn.SetFixedWidth(Value: integer);
+begin
+ gtk_tree_view_column_set_fixed_width(FColumn, Value);
+end;
+
+function TGTKTreeViewColumn.GetMinWidth: integer;
+begin
+ Result := gtk_tree_view_column_get_min_width(FColumn);
+end;
+
+procedure TGTKTreeViewColumn.SetMinWidth(Value: integer);
+begin
+ gtk_tree_view_column_set_min_width(FColumn, Value);
+end;
+
+function TGTKTreeViewColumn.GetMaxWidth: integer;
+begin
+ Result := gtk_tree_view_column_get_max_width(FColumn);
+end;
+
+procedure TGTKTreeViewColumn.SetMaxWidth(Value: integer);
+begin
+ gtk_tree_view_column_set_max_width(FColumn, Value);
+end;
+
+function TGTKTreeViewColumn.GetClickable: boolean;
+begin
+ Result := gtk_tree_view_column_get_clickable(FColumn);
+end;
+
+procedure TGTKTreeViewColumn.SetClickable(Value: boolean);
+begin
+ gtk_tree_view_column_set_clickable(FColumn, Value);
+end;
+
+function TGTKTreeViewColumn.GetAlignment: Double;
+begin
+ Result := gtk_tree_view_column_get_alignment(FColumn);
+end;
+
+procedure TGTKTreeViewColumn.SetAlignment(Value: Double);
+begin
+ gtk_tree_view_column_set_alignment(FColumn, Value);
+end;
+
+function TGTKTreeViewColumn.GetReorderable: boolean;
+begin
+ Result := gtk_tree_view_column_get_reorderable(FColumn);
+end;
+
+procedure TGTKTreeViewColumn.SetReorderable(Value: boolean);
+begin
+ gtk_tree_view_column_set_reorderable(FColumn, Value);
+end;
+
+function TGTKTreeViewColumn.GetSortID: integer;
+begin
+ Result := gtk_tree_view_column_get_sort_column_id(FColumn);
+end;
+
+procedure TGTKTreeViewColumn.SetSortID(Value: integer);
+begin
+ gtk_tree_view_column_set_sort_column_id(FColumn, Value);
+end;
+
+function TGTKTreeViewColumn.GetShowSortIndicator: boolean;
+begin
+ Result := gtk_tree_view_column_get_sort_indicator(FColumn);
+end;
+
+procedure TGTKTreeViewColumn.SetShowSortIndicator(Value: boolean);
+begin
+ gtk_tree_view_column_set_sort_indicator(FColumn, Value);
+end;
+
+function TGTKTreeViewColumn.GetSortOrder: TGTKTreeViewSortOrder;
+begin
+ Result := TGTKTreeViewSortOrder(gtk_tree_view_column_get_sort_order(FColumn));
+end;
+
+procedure TGTKTreeViewColumn.SetSortOrder(Value: TGTKTreeViewSortOrder);
+begin
+ gtk_tree_view_column_set_sort_order(FColumn, TGtkSortType(Value));
+end;
+
+procedure TGTKTreeViewColumn_edited(cell: PGtkCellRendererText; const path_string, new_text: pgchar; data: gpointer); cdecl;
+var NewText: string;
+ AllowChange: boolean;
+ DataColumn, AIndex: integer;
+ Path: PGtkTreePath;
+begin
+ if Assigned(TGTKTreeViewColumn(data).FOnEdited) then begin
+ NewText := PgcharToString(new_text);
+ AllowChange := True;
+ DataColumn := TGTKTreeViewColumn(data).FIndex;
+ Path := gtk_tree_path_new_from_string(path_string);
+ if not Assigned(Path) then Exit;
+ if Application.GTKVersion_2_0_5_Up then AIndex := gtk_tree_path_get_indices(Path)^
+ else AIndex := StrToIntDef(String(gtk_tree_path_to_string(Path)), 0);
+ TGTKTreeViewColumn(data).FOnEdited(TGTKTreeViewColumn(data), TGTKTreeViewColumn(data), ((TGTKTreeViewColumn(data).FOwner as TGTKTreeViewColumns).FOwner as TGTKListView).Items[AIndex], NewText, AllowChange, DataColumn);
+ if AllowChange and (((TGTKTreeViewColumn(data).FOwner as TGTKTreeViewColumns).FOwner as TGTKListView).Items.Count < AIndex) then
+ ((TGTKTreeViewColumn(data).FOwner as TGTKTreeViewColumns).FOwner as TGTKListView).Items[AIndex].SetValue(DataColumn, NewText);
+ gtk_tree_path_free(Path);
+ end;
+end;
+
+procedure TGTKTreeViewColumn_toggled(cell: PGtkCellRendererToggle; const path_string: pgchar; data: gpointer); cdecl;
+var Path: PGtkTreePath;
+ AIndex: integer;
+begin
+ if Assigned(data) and Assigned(TGTKTreeViewColumn(data).FOnToggled) then begin
+ Path := gtk_tree_path_new_from_string(path_string);
+ if not Assigned(Path) then Exit;
+ if Application.GTKVersion_2_0_5_Up then AIndex := gtk_tree_path_get_indices(Path)^
+ else AIndex := StrToIntDef(String(gtk_tree_path_to_string(Path)), 0);
+ TGTKTreeViewColumn(data).FOnToggled(TGTKTreeViewColumn(data), TGTKTreeViewColumn(data), ((TGTKTreeViewColumn(data).FOwner as TGTKTreeViewColumns).FOwner as TGTKListView).Items[AIndex]);
+ end;
+end;
+
+procedure TGTKTreeViewColumn_clicked(treeviewcolumn: PGtkTreeViewColumn; user_data: gpointer); cdecl;
+begin
+ if Assigned(user_data) and Assigned(TGTKTreeViewColumn(user_data).FOnClicked) then
+ TGTKTreeViewColumn(user_data).FOnClicked(TGTKTreeViewColumn(user_data));
+end;
+
+procedure TGTKTreeViewColumn.SetColumnType(Value: TGTKTreeViewColumnType);
+begin
+ FColumnType := Value;
+ if Assigned(FRenderer) then begin
+ gtk_tree_view_column_clear(FColumn);
+ gtk_object_destroy(PGtkObject(FRenderer));
+ end;
+ case Value of
+ ctText : FRenderer := gtk_cell_renderer_text_new;
+ ctToggle : FRenderer := gtk_cell_renderer_toggle_new;
+ ctImageText : begin
+ FRenderer := gtk_cell_renderer_text_new;
+ FPixbufRenderer := gtk_cell_renderer_pixbuf_new;
+ end;
+ end;
+ if Value = ctImageText then gtk_tree_view_column_pack_start(FColumn, FPixbufRenderer, False);
+ gtk_tree_view_column_pack_start(FColumn, FRenderer, True);
+ if (Value = ctImageText) or (Value = ctText) then g_signal_connect(FRenderer, 'edited', G_CALLBACK(@TGTKTreeViewColumn_edited), Self);
+ if Value = ctToggle then g_signal_connect(FRenderer, 'toggled', G_CALLBACK(@TGTKTreeViewColumn_toggled), Self);
+ g_signal_connect_after(FColumn, 'clicked', G_CALLBACK(@TGTKTreeViewColumn_clicked), Self);
+end;
+
+procedure TGTKTreeViewColumn.AddAttribute(Attribute: string; Value: integer);
+begin
+ gtk_tree_view_column_add_attribute(FColumn, FRenderer, StringToPgchar(Attribute), Value);
+end;
+
+procedure TGTKTreeViewColumn.AddImageAttribute(Attribute: string; Value: integer);
+begin
+ gtk_tree_view_column_add_attribute(FColumn, FPixbufRenderer, StringToPgchar(Attribute), Value);
+end;
+
+procedure TGTKTreeViewColumn.ClearAttributes;
+begin
+ gtk_tree_view_column_clear_attributes(FColumn, FRenderer);
+end;
+
+procedure TGTKTreeViewColumn.SetProperty(AProperty: string; Value: integer);
+var AValue: TGValue;
+begin
+ AValue.g_type := G_TYPE_LONG;
+ AValue.data[0].v_long := Value;
+ g_object_set_property(PGObject(FRenderer), StringToPgchar(AProperty), @AValue);
+end;
+
+procedure TGTKTreeViewColumn.SetProperty(AProperty: string; Value: string);
+var AValue: TGValue;
+begin
+ AValue.g_type := G_TYPE_STRING;
+ AValue.data[0].v_pointer := StringToPgchar(Value);
+ g_object_set_property(PGObject(FRenderer), StringToPgchar(AProperty), @AValue);
+end;
+
+procedure TGTKTreeViewColumn.SetProperty(AProperty: string; Value: Double);
+var AValue: TGValue;
+begin
+ AValue.g_type := G_TYPE_DOUBLE;
+ AValue.data[0].v_double := Value;
+ g_object_set_property(PGObject(FRenderer), StringToPgchar(AProperty), @AValue);
+end;
+
+procedure TGTKTreeViewColumn.SetProperty(AProperty: string; Value: pointer);
+var AValue: TGValue;
+begin
+ AValue.g_type := G_TYPE_POINTER;
+ AValue.data[0].v_pointer := Value;
+ g_object_set_property(PGObject(FRenderer), StringToPgchar(AProperty), @AValue);
+end;
+
+procedure TGTKTreeViewColumn.SetImageProperty(AProperty: string; Value: integer);
+var AValue: TGValue;
+begin
+ AValue.g_type := G_TYPE_LONG;
+ AValue.data[0].v_long := Value;
+ g_object_set_property(PGObject(FPixbufRenderer), StringToPgchar(AProperty), @AValue);
+end;
+
+procedure TGTKTreeViewColumn.SetImageProperty(AProperty: string; Value: string);
+var AValue: TGValue;
+begin
+ AValue.g_type := G_TYPE_STRING;
+ AValue.data[0].v_pointer := StringToPgchar(Value);
+ g_object_set_property(PGObject(FPixbufRenderer), StringToPgchar(AProperty), @AValue);
+end;
+
+procedure TGTKTreeViewColumn.SetImageProperty(AProperty: string; Value: Double);
+var AValue: TGValue;
+begin
+ AValue.g_type := G_TYPE_DOUBLE;
+ AValue.data[0].v_double := Value;
+ g_object_set_property(PGObject(FPixbufRenderer), StringToPgchar(AProperty), @AValue);
+end;
+
+procedure TGTKTreeViewColumn.SetImageProperty(AProperty: string; Value: pointer);
+var AValue: TGValue;
+begin
+ AValue.g_type := G_TYPE_POINTER;
+ AValue.data[0].v_pointer := Value;
+ g_object_set_property(PGObject(FPixbufRenderer), StringToPgchar(AProperty), @AValue);
+end;
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+constructor TGTKListItem.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOwner := AOwner;
+ FData := nil;
+end;
+
+destructor TGTKListItem.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TGTKListItem.AsString(Index: longint): string;
+var Iter: TGtkTreeIter;
+ AValue: TGValue;
+begin
+ Result := '';
+ if gtk_tree_model_get_iter_from_string(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, StringToPgchar(IntToStr(FIndex))) then
+ begin
+ AValue.g_type := 0;
+ gtk_tree_model_get_value(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, Index, @AValue);
+ Result := PgcharToString(AValue.data[0].v_pointer);
+ end;
+end;
+
+function TGTKListItem.AsInteger(Index: longint): integer;
+var Iter: TGtkTreeIter;
+ AValue: TGValue;
+begin
+ Result := 0;
+ if gtk_tree_model_get_iter_from_string(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, StringToPgchar(IntToStr(FIndex))) then
+ begin
+ AValue.g_type := 0;
+ gtk_tree_model_get_value(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, Index, @AValue);
+ Result := AValue.data[0].v_long;
+ end;
+end;
+
+function TGTKListItem.AsPointer(Index: longint): pointer;
+var Iter: TGtkTreeIter;
+ AValue: TGValue;
+begin
+ Result := nil;
+ if gtk_tree_model_get_iter_from_string(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, StringToPgchar(IntToStr(FIndex))) then
+ begin
+ AValue.g_type := 0;
+ gtk_tree_model_get_value(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, Index, @AValue);
+ Result := AValue.data[0].v_pointer;
+ end;
+end;
+
+function TGTKListItem.AsBoolean(Index: longint): boolean;
+var Iter: TGtkTreeIter;
+ AValue: TGValue;
+begin
+ Result := False;
+ if gtk_tree_model_get_iter_from_string(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, StringToPgchar(IntToStr(FIndex))) then
+ begin
+ AValue.g_type := 0;
+ gtk_tree_model_get_value(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, Index, @AValue);
+ Result := boolean(AValue.data[0].v_int);
+ end;
+end;
+
+procedure TGTKListItem.SetValue(Index: longint; Value: string);
+var Iter: TGtkTreeIter;
+begin
+ if gtk_tree_model_get_iter_from_string(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, StringToPgchar(IntToStr(FIndex)))
+ then gtk_list_store_set(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, Index, StringToPgchar(Value), -1);
+end;
+
+procedure TGTKListItem.SetValue(Index: longint; Value: integer);
+var Iter: TGtkTreeIter;
+begin
+ if gtk_tree_model_get_iter_from_string(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, StringToPgchar(IntToStr(FIndex)))
+ then gtk_list_store_set(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, Index, Value, -1);
+end;
+
+procedure TGTKListItem.SetValue(Index: longint; Value: pointer);
+var Iter: TGtkTreeIter;
+begin
+ if gtk_tree_model_get_iter_from_string(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, StringToPgchar(IntToStr(FIndex)))
+ then gtk_list_store_set(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, Index, Value, -1);
+end;
+
+procedure TGTKListItem.SetValue(Index: longint; Value: boolean);
+var Iter: TGtkTreeIter;
+begin
+ if gtk_tree_model_get_iter_from_string(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, StringToPgchar(IntToStr(FIndex)))
+ then gtk_list_store_set(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, Index, Value, -1);
+end;
+
+function TGTKListItem.GetSelected: boolean;
+var Iter: TGtkTreeIter;
+begin
+ Result := False;
+ if gtk_tree_model_get_iter_from_string(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, StringToPgchar(IntToStr(FIndex))) then begin
+// ((FOwner as TGTKListItems).FOwner as TGTKView).ConvertSortableIter(Iter);
+ Result := gtk_tree_selection_iter_is_selected(((FOwner as TGTKListItems).FOwner as TGTKView).FSelection, @Iter);
+ end;
+end;
+
+procedure TGTKListItem.SetSelected(Value: boolean);
+var Iter, NewIter: TGtkTreeIter;
+ Path: PGtkTreePath;
+begin
+ try
+ if not Application.GTKVersion_2_0_5_Up then begin
+ Path := gtk_tree_path_new_from_string(StringToPgchar(IntToStr(FIndex)));
+ ((FOwner as TGTKListItems).FOwner as TGTKView).ConvertChildToPath(Path);
+ gtk_tree_selection_select_path(((FOwner as TGTKListItems).FOwner as TGTKView).FSelection, Path);
+ gtk_tree_path_free(Path);
+ end else
+ if gtk_tree_model_get_iter_from_string(PGtkTreeModel((FOwner as TGTKListItems).FStore), @Iter, StringToPgchar(IntToStr(FIndex))) then begin
+ if Assigned(((FOwner as TGTKListItems).FOwner as TGTKView).FTreeModelSort) then begin
+ gtk_tree_model_sort_convert_child_iter_to_iter(((FOwner as TGTKListItems).FOwner as TGTKView).FTreeModelSort, @NewIter, @Iter);
+ Iter := NewIter;
+ end;
+ if Value then gtk_tree_selection_select_iter(((FOwner as TGTKListItems).FOwner as TGTKView).FSelection, @Iter)
+ else gtk_tree_selection_unselect_iter(((FOwner as TGTKListItems).FOwner as TGTKView).FSelection, @Iter);
+ end;
+ except end;
+end;
+
+procedure TGTKListItem.SetCursor(const FocusColumnNo: integer; const StartEditing, UseAlignment: boolean; const AlignX, AlignY: Double);
+var Path: PGtkTreePath;
+ Column: PGtkTreeViewColumn;
+// Renderer: PGtkCellRenderer;
+ i : integer;
+begin
+ Path := gtk_tree_path_new_from_string(StringToPgchar(IntToStr(FIndex)));
+ if not Assigned(Path) then Exit;
+ ((FOwner as TGTKListItems).FOwner as TGTKView).ConvertChildToPath(Path);
+ if not Assigned(Path) then Exit;
+
+ Column := ((FOwner as TGTKListItems).FOwner as TGTKView).Columns[FocusColumnNo].FColumn;
+// Renderer := ((FOwner as TGTKListItems).FOwner as TGTKView).Columns[FocusColumnNo].FRenderer;
+
+// if not Application.GTKVersion_2_0_5_Up then
+ for i := 1 to 2 do gtk_main_iteration_do(False); // This ugly piece of code HAVE TO BE HERE due some focus-related problems in GtkTreeView
+ gtk_tree_view_set_cursor(PGtkTreeView(((FOwner as TGTKListItems).FOwner as TGTKView).FWidget), Path, Column, StartEditing);
+// gtk_tree_view_set_cursor(PGtkTreeView(((FOwner as TGTKListItems).FOwner as TGTKView).FWidget), Path, Column, StartEditing);
+// gtk_tree_view_set_cursor_on_cell(PGtkTreeView(((FOwner as TGTKListItems).FOwner as TGTKView).FWidget), Path, Column, Renderer, StartEditing);
+ gtk_tree_view_scroll_to_cell(PGtkTreeView(((FOwner as TGTKListItems).FOwner as TGTKView).FWidget), Path, nil, UseAlignment, AlignX, AlignY);
+
+ gtk_tree_path_free(Path);
+end;
+
+procedure TGTKListItem.StartEditing(ColumnNo: integer);
+var CellEditable: PGtkCellEditable;
+ Path: PGtkTreePath;
+ Column: PGtkTreeViewColumn;
+ BackgroundRect, CellRect: TGdkRectangle;
+begin
+ Path := gtk_tree_path_new_from_string(StringToPgchar(IntToStr(FIndex)));
+ if not Assigned(Path) then Exit;
+ ((FOwner as TGTKListItems).FOwner as TGTKView).ConvertChildToPath(Path);
+ if not Assigned(Path) then Exit;
+ Column := ((FOwner as TGTKListItems).FOwner as TGTKView).Columns[ColumnNo].FColumn;
+ gtk_tree_view_get_background_area(PGtkTreeView(((FOwner as TGTKListItems).FOwner as TGTKView).FWidget), Path, Column, @BackgroundRect);
+ gtk_tree_view_get_cell_area(PGtkTreeView(((FOwner as TGTKListItems).FOwner as TGTKView).FWidget), Path, Column, @CellRect);
+
+ gtk_tree_view_column_focus_cell(Column, ((FOwner as TGTKListItems).FOwner as TGTKView).Columns[ColumnNo].FRenderer);
+ CellEditable := gtk_cell_renderer_start_editing(((FOwner as TGTKListItems).FOwner as TGTKView).Columns[ColumnNo].FRenderer,
+ nil, ((FOwner as TGTKListItems).FOwner as TGTKView).FWidget, PChar(StringToPgchar(IntToStr(FIndex))),
+ @BackgroundRect, @CellRect, {GTK_CELL_RENDERER_SELECTED or GTK_CELL_RENDERER_SORTED} 0);
+ gtk_widget_show(CellEditable);
+// gtk_cell_editable_start_editing(CellEditable, nil);
+
+
+ gtk_tree_path_free(Path);
+end;
+
+procedure TGTKListItem.RedrawRow;
+var Rect, BackgroundRect: TGdkRectangle;
+ Path: PGtkTreePath;
+ Column: PGtkTreeViewColumn;
+begin
+ Path := gtk_tree_path_new_from_string(StringToPgchar(IntToStr(FIndex)));
+ if not Assigned(Path) then Exit;
+ ((FOwner as TGTKListItems).FOwner as TGTKView).ConvertChildToPath(Path);
+ if not Assigned(Path) then Exit;
+ Column := ((FOwner as TGTKListItems).FOwner as TGTKView).Columns[0].FColumn;
+ gtk_tree_view_get_background_area(PGtkTreeView(((FOwner as TGTKListItems).FOwner as TGTKView).FWidget), Path, Column, @BackgroundRect);
+
+ Rect.x := 0;
+ Rect.width := ((FOwner as TGTKListItems).FOwner as TGTKView).FWidget^.allocation.width;
+ Rect.y := BackgroundRect.y;
+ Rect.height := BackgroundRect.height;
+ gdk_window_invalidate_rect(gtk_tree_view_get_bin_window(PGtkTreeView(((FOwner as TGTKListItems).FOwner as TGTKView).FWidget)), @Rect, True);
+
+ gtk_tree_path_free(Path);
+end;
+
+function TGTKListItem.IsVisible: boolean;
+var CellRect, VisibleRect: TGdkRectangle;
+ Path: PGtkTreePath;
+begin
+ Result := False;
+ gtk_tree_view_get_visible_rect(PGtkTreeView(((FOwner as TGTKListItems).FOwner as TGTKView).FWidget), @VisibleRect);
+ if not Assigned(Path) then Exit;
+ Path := gtk_tree_path_new_from_string(StringToPgchar(IntToStr(FIndex)));
+ ((FOwner as TGTKListItems).FOwner as TGTKView).ConvertChildToPath(Path);
+ if not Assigned(Path) then Exit;
+ gtk_tree_view_get_background_area(PGtkTreeView(((FOwner as TGTKListItems).FOwner as TGTKView).FWidget), Path, nil, @CellRect);
+ gtk_tree_path_free(Path);
+ Result := (CellRect.y > VisibleRect.y) and (CellRect.y + CellRect.height < VisibleRect.y + VisibleRect.height);
+end;
+
+
+(********************************************************************************************************************************)
+(********************************************************************************************************************************)
+
+
+end.
generated by cgit v1.2.3 (git 2.46.0) at 2026-01-12 15:14:58 +0000