home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tp6goodi / error / objtest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-01-06  |  2.4 KB  |  94 lines
  1. uses crt,FRTE;
  2.   { This program shows how FRTE can be used with a object methods,
  3.     both static and virtual.  In the class Note, their are two methods
  4.     SetColor (static) and SetXY (virtual) which use FRTE to force a
  5.     runtime error when a bad value (range) is passed to the method.
  6.     When the error is trigger, FRTE gives control to the IDE and it
  7.     brings the user back to the editor at the location where the
  8.     method was evoked.
  9.   }
  10.  
  11. type
  12.   note = object
  13.     X,Y:word;
  14.     Value:^string;
  15.     Forecolor,BackColor:byte;
  16.  
  17.     constructor init;
  18.     destructor done;
  19.     procedure SetString(S:string);
  20.     procedure SetXY(SX,SY:word); virtual;
  21.     procedure SetColor(Fore,Back:byte);
  22.     procedure Show;
  23.     procedure Hide;
  24.     end;
  25.   var
  26.     Anote : note;
  27.  
  28.     constructor note.init;
  29.       begin
  30.       Value := nil;
  31.       end;
  32.     destructor note.done;
  33.       begin
  34.       if Value<>nil then freemem(Value,length(Value^)+1);
  35.       end;
  36.     procedure note.SetString(S:string);
  37.       begin
  38.       if Value<>nil then note.done;
  39.       getmem(Value,length(S)+1);
  40.       Value^:=S;
  41.       end;
  42.     procedure Note.SetXY(Sx,SY:word);
  43.       begin
  44.       { Here is were FRTE is used to force a run time error }
  45.       if (SX>80)or(SY>25)or((SX*SY)=0) then
  46.         FrtError(Find_far_Caller(1),201);
  47.       X := SX;
  48.       Y := SY;
  49.       end;
  50.     procedure Note.SetColor(Fore,Back:byte);
  51.       begin
  52.       { Here is were FRTE is used to force a run time error }
  53.       if Back>7 then FrtError(Find_far_Caller(1),201);
  54.       ForeColor := Fore;
  55.       BackColor := Back;
  56.       end;
  57.     procedure Note.Show;
  58.       var
  59.         temp:word;
  60.       begin
  61.       gotoxy(X,Y);
  62.       temp := Textattr;
  63.       TextAttr := Forecolor + (BackCOlor shl 4);
  64.       write(Value^);
  65.       end;
  66.     procedure Note.Hide;
  67.       begin
  68.       end;
  69.     { =========== MAIN ==============}
  70.     begin
  71.  
  72.     { This code initializes the Object Error System and would normally
  73.       be in the main code of a unit that contains the objects }
  74.     ShowFRTEMessage := true;
  75.     FRTE_Message := 'Note Error at #A ErrorCode #H #C';
  76.     {------}
  77.  
  78.     with anote do
  79.       begin
  80.       init;
  81.       { This line will cause error if the one is changed to an 81 }
  82.       SetXY(1,2);
  83.       { This line will cause an error if the second paramter is >7 }
  84.       SetColor(7,12);
  85.  
  86.       SetString('This is a test.');
  87.  
  88.       show;
  89.       end;
  90.     end.
  91.  
  92.  
  93.  
  94.