svn/view/base2.pas

unit base2;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}
(***************************************)
(* Copyright (C) 2009, SHIRAISHI Kazuo *)
(***************************************)

interface

uses
  Classes, SysUtils;

 type
    EControlException=class(Exception)
        constructor create;
    end  ;

    ERetry=class(EControlException);
    EContinue=class(EControlException);
    //EExitHandler=class(EControlException);

    EStop=class(EControlException);
    EExitFunction=class(EControlException);
    EExitSub=class(EControlException);
    EExitPicture=class(EControlException);
    EExitDo=class(EControlException);
    EExitFor=class(EControlException);

type
    PAnsiString=^AnsiString;

    function NumericVariable(var x:double; a:double):PDouble;  overload;
    function StringVariable(var s:Ansistring; const t:ansistring):PAnsiString;

type
   StringArray=Array[0..1023] of AnsiString;
   PStringArray=^StringArray;

type
   IntArray=array [0..255] of integer;
   PIntArray=^IntArray;
type
  PExtended=^extended;
  ExtendedArray=array[0..65535] of extended;
  PExtendedArray=^ExtendedArray;


type
   TNval=class(Tobject)
      value:double;
      constructor create(x:double);
   end;

   TSVal=class(TObject)
      value:Ansistring;
      constructor create(const s:ansistring);
   end;

   TValList=class(TList)
      function itself:TValList;
      procedure addval(x:double);overload;
      procedure addval(s:ansistring);overload;
      destructor destroy;override;
   end;


implementation

constructor EControlException.create;
begin
   inherited create('')
end;


function NumericVariable(var x:double; a:double):PDouble; inline;  overload;
begin
   x:=a;
   result:=@x
end;

function StringVariable(var s:Ansistring; const t:ansistring):PAnsiString;inline;
begin
   s:=t;
   result:=@s
end;


{********}
{TValList}
{********}

constructor TNval.create(x:double);
begin
   inherited create;
   value:=x
end;

constructor TSVal.create(const s:ansistring);
begin
   inherited create;
   value:=s;
end;

function TValList.itself:TValList;
begin
   result:=self
end;


procedure TValList.addval(x:double);overload;
begin
    add(TNVal.create(x))
end;

procedure TValList.addval(s:ansistring);overload;
begin
   add(TSVal.create(s))
end;

destructor TValList.destroy;
var
  i:integer;
begin
  for i:=0 to count-1 do
     Tobject(items[i]).free ;
  inherited destroy;
end;


end.

