(* 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.