/packages/ptc/src/c_api/capi_timer.inc

  1{
  2    Free Pascal port of the OpenPTC C++ library.
  3    Copyright (C) 2001-2010  Nikolay Nikolov (nickysn@users.sourceforge.net)
  4    Original C++ version by Glenn Fiedler (ptc@gaffer.org)
  5
  6    This library is free software; you can redistribute it and/or
  7    modify it under the terms of the GNU Lesser General Public
  8    License as published by the Free Software Foundation; either
  9    version 2.1 of the License, or (at your option) any later version
 10    with the following modification:
 11
 12    As a special exception, the copyright holders of this library give you
 13    permission to link this library with independent modules to produce an
 14    executable, regardless of the license terms of these independent modules,and
 15    to copy and distribute the resulting executable under terms of your choice,
 16    provided that you also meet, for each linked independent module, the terms
 17    and conditions of the license of that module. An independent module is a
 18    module which is not derived from or based on this library. If you modify
 19    this library, you may extend this exception to your version of the library,
 20    but you are not obligated to do so. If you do not wish to do so, delete this
 21    exception statement from your version.
 22
 23    This library is distributed in the hope that it will be useful,
 24    but WITHOUT ANY WARRANTY; without even the implied warranty of
 25    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 26    Lesser General Public License for more details.
 27
 28    You should have received a copy of the GNU Lesser General Public
 29    License along with this library; if not, write to the Free Software
 30    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 31}
 32
 33function ptc_timer_create: TPTC_TIMER;
 34begin
 35  try
 36    ptc_timer_create := TPTC_TIMER(TPTCTimer.Create);
 37  except
 38    on error: TPTCError do
 39    begin
 40      ptc_exception_handle(error);
 41      ptc_timer_create := nil;
 42    end;
 43  end;
 44end;
 45
 46procedure ptc_timer_destroy(obj: TPTC_TIMER);
 47begin
 48  if obj = nil then
 49    exit;
 50  try
 51    TPTCTimer(obj).Destroy;
 52  except
 53    on error: TPTCError do
 54      ptc_exception_handle(error);
 55  end;
 56end;
 57
 58procedure ptc_timer_set(obj: TPTC_TIMER; time: Double);
 59begin
 60  try
 61    TPTCTimer(obj).settime(time);
 62  except
 63    on error: TPTCError do
 64      ptc_exception_handle(error);
 65  end;
 66end;
 67
 68procedure ptc_timer_start(obj: TPTC_TIMER);
 69begin
 70  try
 71    TPTCTimer(obj).start;
 72  except
 73    on error: TPTCError do
 74      ptc_exception_handle(error);
 75  end;
 76end;
 77
 78procedure ptc_timer_stop(obj: TPTC_TIMER);
 79begin
 80  try
 81    TPTCTimer(obj).stop;
 82  except
 83    on error: TPTCError do
 84      ptc_exception_handle(error);
 85  end;
 86end;
 87
 88function ptc_timer_time(obj: TPTC_TIMER): Double;
 89begin
 90  try
 91    ptc_timer_time := TPTCTimer(obj).time;
 92  except
 93    on error: TPTCError do
 94    begin
 95      ptc_exception_handle(error);
 96      ptc_timer_time := 0;
 97    end;
 98  end;
 99end;
100
101function ptc_timer_delta(obj: TPTC_TIMER): Double;
102begin
103  try
104    ptc_timer_delta := TPTCTimer(obj).delta;
105  except
106    on error: TPTCError do
107    begin
108      ptc_exception_handle(error);
109      ptc_timer_delta := 0;
110    end;
111  end;
112end;
113
114function ptc_timer_resolution(obj: TPTC_TIMER): Double;
115begin
116  try
117    ptc_timer_resolution := TPTCTimer(obj).resolution;
118  except
119    on error: TPTCError do
120    begin
121      ptc_exception_handle(error);
122      ptc_timer_resolution := 0;
123    end;
124  end;
125end;
126
127procedure ptc_timer_assign(obj, timer: TPTC_TIMER);
128begin
129  try
130    TPTCTimer(obj).Assign(TPTCTimer(timer));
131  except
132    on error: TPTCError do
133      ptc_exception_handle(error);
134  end;
135end;
136
137function ptc_timer_equals(obj, timer: TPTC_TIMER): Boolean;
138begin
139  try
140    ptc_timer_equals := TPTCTimer(obj).equals(TPTCTimer(timer));
141  except
142    on error: TPTCError do
143    begin
144      ptc_exception_handle(error);
145      ptc_timer_equals := False;
146    end;
147  end;
148end;