freepascal.compiler/packages/extra/ptc/errori.inc

{
    Free Pascal port of the OpenPTC C++ library.
    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
    Original C++ version by Glenn Fiedler ([email protected])

    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.

    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
}

Procedure TPTCError.defaults;

Begin
  Fmessage := '';
End;

Constructor TPTCError.Create;

Begin
  defaults;
End;

Constructor TPTCError.Create(Const _message : String);

Begin
  Fmessage := _message;
  LOG('error', Self);
End;

Constructor TPTCError.Create(Const _message : String; Const error : TPTCError);

Begin
  Fmessage := _message + #13 + #10 + error.Fmessage;
  LOG('composite error', Self);
End;

Constructor TPTCError.Create(Const error : TPTCError);

Begin
  defaults;
  ASSign(error);
End;

Destructor TPTCError.Destroy;

Begin
  Inherited Destroy;
End;

Procedure TPTCError.Assign(Const error : TPTCError);

Begin
  If Self = error Then
    Raise TPTCError.Create('self assignment is not allowed');
  Fmessage := error.Fmessage;
End;

Function TPTCError.Equals(Const error : TPTCError) : Boolean;

Begin
  Equals := (Fmessage = error.Fmessage);
End;

Procedure TPTCError.report;

{$IFDEF WIN32}
Var
  txt : ShortString;
{$ENDIF WIN32}

Begin
  LOG('error report', Self);
  {$IFDEF GO32V2}
  RestoreTextMode;
  Writeln(stderr, Fmessage);
  {$ENDIF GO32V2}

  {$IFDEF WIN32}
  Win32Cursor_resurrect;
  txt := Fmessage + #0;
  MessageBox(0, @txt[1], 'Error', MB_OK Or MB_ICONERROR Or MB_SETFOREGROUND Or MB_TOPMOST);
  {$ENDIF WIN32}

  {$IFDEF UNIX}
  Writeln(stderr, 'error: ', Fmessage);
  {$ENDIF UNIX}

  Halt(1);
End;

Function TPTCError.message : String;

Begin
  message := Fmessage;
End;