XPost: alt.comp.lang.borland-delphi   
   From: spam@merlyn.demon.co.uk   
      
   JRS:  In article , dated Tue, 11 Jan 2005   
   04:47:13, seen in news:alt.comp.lang.borland-delphi, Raptor   
    posted :   
   >I'm often chagined with the lack of a genuine string case   
   >statement in Pascal/Delphi.   
   > ...   
   >function incase(aStr : string): boolean;   
   >begin   
   >  if aStr     = IncaseString   
   >  then result := True   
   >  else Result := False;   
   >end;   
      
   or   
           function incase(aStr : string): boolean;   
           begin Result := aStr = IncaseString end ;   
      
   > ...   
      
      
   The following program, tested in BP7 & slightly in D3, has as its body a   
   Writeln the content of which consists, as in a case statement,   
   essentially of a list of string-procedure pairs, preceded by a selector,   
   and interspersed with syntax.   
      
      
   type   
   TProc = procedure ;   
   PilePtr = ^Pile ;   
   Pile = record Ptr : PilePtr ; S : string ; Proc : TProc end ;   
      
   function FirstOf(const St : string ; A : PilePtr) : boolean ;   
   begin FirstOf := true ;   
     while A<>nil do begin   
       if St = A^.S then begin A^.Proc ; EXIT end ;   
       A := A^.Ptr end ;   
     FirstOf := false end {FirstOf} ;   
      
   function P(const S : string ; Proc : TProc ; Ptr : PilePtr) : PilePtr ;   
   var NP : PilePtr ;   
   begin   
     NP := New(PilePtr) ;   
     NP^.S := S ; NP^.Proc := Proc ; NP^.Ptr := Ptr ;   
     P := NP ;   
     end {P} ;   
      
   procedure ProcA ; FAR ; begin Writeln('ProcA called') end ;   
   procedure ProcB ; FAR ; begin Writeln('ProcB called') end ;   
   procedure ProcC ; FAR ; begin Writeln('ProcC called') end ;   
      
   BEGIN ;   
   Writeln(   
     FirstOf('BB',   
       P('AA', ProcA,   
       P('BB', ProcB,   
       P('CC', ProcC,   
       NIL))))   
     ) ;   
   END.   
      
      
   Cleaning up the pile is left as an exercise for the reader; it should   
   not be done in FirstOf, because the pile might be needed again.   
      
   Maybe, untested,   
      
   procedure UTLD(P : pointer ; const S : word) ;    { ??? }   
   var T : pointer ;   
   begin   
     while P <> NIL do begin   
       T := P ; P := pointer(P^) ; FreeMem(T, S) end ;   
     end {UTLD} ;   
      
      
   XP c.l.p.b, FU not set.   
      
   --   
    © John Stockton, Surrey, UK.  ?@merlyn.demon.co.uk   Turnpike v4.00   MIME. ©   
      TP/BP/Delphi/&c., FAQqy topics & links;   
        RAH Prins : c.l.p.b mFAQ;   
      Timo Salmi's Turbo Pascal FAQ.   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)