/packages/ptc/src/c_api/capi_timer.inc
https://github.com/slibre/freepascal · Pascal · 148 lines · 107 code · 10 blank · 31 comment · 1 complexity · ae297c59515851f5023cdcc13bd39c09 MD5 · raw file
- {
- Free Pascal port of the OpenPTC C++ library.
- Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
- Original C++ version by Glenn Fiedler (ptc@gaffer.org)
- This library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version
- with the following modification:
- As a special exception, the copyright holders of this library give you
- permission to link this library with independent modules to produce an
- executable, regardless of the license terms of these independent modules,and
- to copy and distribute the resulting executable under terms of your choice,
- provided that you also meet, for each linked independent module, the terms
- and conditions of the license of that module. An independent module is a
- module which is not derived from or based on this library. If you modify
- this library, you may extend this exception to your version of the library,
- but you are not obligated to do so. If you do not wish to do so, delete this
- exception statement from your 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
- Lesser General Public License for more details.
- You should have received a copy of the GNU Lesser 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
- }
- function ptc_timer_create: TPTC_TIMER;
- begin
- try
- ptc_timer_create := TPTC_TIMER(TPTCTimer.Create);
- except
- on error: TPTCError do
- begin
- ptc_exception_handle(error);
- ptc_timer_create := nil;
- end;
- end;
- end;
- procedure ptc_timer_destroy(obj: TPTC_TIMER);
- begin
- if obj = nil then
- exit;
- try
- TPTCTimer(obj).Destroy;
- except
- on error: TPTCError do
- ptc_exception_handle(error);
- end;
- end;
- procedure ptc_timer_set(obj: TPTC_TIMER; time: Double);
- begin
- try
- TPTCTimer(obj).settime(time);
- except
- on error: TPTCError do
- ptc_exception_handle(error);
- end;
- end;
- procedure ptc_timer_start(obj: TPTC_TIMER);
- begin
- try
- TPTCTimer(obj).start;
- except
- on error: TPTCError do
- ptc_exception_handle(error);
- end;
- end;
- procedure ptc_timer_stop(obj: TPTC_TIMER);
- begin
- try
- TPTCTimer(obj).stop;
- except
- on error: TPTCError do
- ptc_exception_handle(error);
- end;
- end;
- function ptc_timer_time(obj: TPTC_TIMER): Double;
- begin
- try
- ptc_timer_time := TPTCTimer(obj).time;
- except
- on error: TPTCError do
- begin
- ptc_exception_handle(error);
- ptc_timer_time := 0;
- end;
- end;
- end;
- function ptc_timer_delta(obj: TPTC_TIMER): Double;
- begin
- try
- ptc_timer_delta := TPTCTimer(obj).delta;
- except
- on error: TPTCError do
- begin
- ptc_exception_handle(error);
- ptc_timer_delta := 0;
- end;
- end;
- end;
- function ptc_timer_resolution(obj: TPTC_TIMER): Double;
- begin
- try
- ptc_timer_resolution := TPTCTimer(obj).resolution;
- except
- on error: TPTCError do
- begin
- ptc_exception_handle(error);
- ptc_timer_resolution := 0;
- end;
- end;
- end;
- procedure ptc_timer_assign(obj, timer: TPTC_TIMER);
- begin
- try
- TPTCTimer(obj).Assign(TPTCTimer(timer));
- except
- on error: TPTCError do
- ptc_exception_handle(error);
- end;
- end;
- function ptc_timer_equals(obj, timer: TPTC_TIMER): Boolean;
- begin
- try
- ptc_timer_equals := TPTCTimer(obj).equals(TPTCTimer(timer));
- except
- on error: TPTCError do
- begin
- ptc_exception_handle(error);
- ptc_timer_equals := False;
- end;
- end;
- end;