From ecde167da74c86bc047aaf84c5e548cf65a5da98 Mon Sep 17 00:00:00 2001 From: Tomas Bzatek Date: Sat, 7 Jun 2008 20:34:49 +0200 Subject: Initial commit --- libgtk_kylix/GTKClasses.pas | 174 ++++++ libgtk_kylix/GTKConsts.pas | 259 ++++++++ libgtk_kylix/GTKControls.pas | 1050 ++++++++++++++++++++++++++++++++ libgtk_kylix/GTKDialogs.pas | 248 ++++++++ libgtk_kylix/GTKExtCtrls.pas | 707 ++++++++++++++++++++++ libgtk_kylix/GTKForms.pas | 874 +++++++++++++++++++++++++++ libgtk_kylix/GTKMenus.pas | 530 ++++++++++++++++ libgtk_kylix/GTKPixbuf.pas | 214 +++++++ libgtk_kylix/GTKStdCtrls.pas | 1008 +++++++++++++++++++++++++++++++ libgtk_kylix/GTKText.pas | 167 +++++ libgtk_kylix/GTKUtils.pas | 212 +++++++ libgtk_kylix/GTKView.pas | 1376 ++++++++++++++++++++++++++++++++++++++++++ 12 files changed, 6819 insertions(+) create mode 100644 libgtk_kylix/GTKClasses.pas create mode 100644 libgtk_kylix/GTKConsts.pas create mode 100644 libgtk_kylix/GTKControls.pas create mode 100644 libgtk_kylix/GTKDialogs.pas create mode 100644 libgtk_kylix/GTKExtCtrls.pas create mode 100644 libgtk_kylix/GTKForms.pas create mode 100644 libgtk_kylix/GTKMenus.pas create mode 100644 libgtk_kylix/GTKPixbuf.pas create mode 100644 libgtk_kylix/GTKStdCtrls.pas create mode 100644 libgtk_kylix/GTKText.pas create mode 100644 libgtk_kylix/GTKUtils.pas create mode 100644 libgtk_kylix/GTKView.pas (limited to 'libgtk_kylix') 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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. -- cgit v1.2.3