home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / pascal / psppd100.zip / STRINGS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-09-18  |  13KB  |  643 lines

  1. {
  2.  
  3.                                                       ╔══════════════════╗
  4.                                                       ║ String, Variable ║
  5.                                                       ║   and Keyboard   ║
  6.                                                       ║    Utilities     ║
  7.                                                       ║    Rev. 1.01     ║
  8.                                                       ╚══════════════════╝
  9.  
  10. }
  11.  
  12. {$F-} {$O-} {$A+} {$G-}
  13. {$V-} {$B-} {$X-} {$N+} {$E+}
  14.  
  15. {$I FINAL.PAS}
  16.  
  17. {$IFDEF FINAL}
  18.   {$I-} {$R-}
  19.   {$D-} {$L-} {$S-}
  20. {$ENDIF}
  21.  
  22. Unit Strings;
  23.  
  24. Interface
  25.  
  26. Uses CRT,DOS;
  27.  
  28. Const
  29.   MaxXYSaves        =    5;                  {Max Number of Cursor Saves}
  30.   LeftText          =    0;
  31.   CentreText        =    1;
  32.   RightText         =    2;
  33.  
  34. Type
  35.   TextFormats       = LeftText..RightText;
  36.   XYType            = (CursorX,CursorY);
  37.   XYPosData         = Array[1..MaxXYSaves] of
  38.                         Array [XYType] of Byte;
  39.   KeyBufferFunction = (Clear,Save,Restore);
  40.  
  41.  
  42. Procedure SpacesToZeros (StIn:String;Var StOut:String);
  43. Function  PosFrom       (SubS:String;StIn:String;FarIn:Byte):Byte;
  44. Procedure UpperCase     (StIn:String;Var StOut:String);
  45. Procedure PadVar        (StIn:String;Var StOut:String;Count:Byte);
  46. Procedure PadVarWith    (StIn:String;Var StOut:String;Count:Byte;
  47.                                                       WithMe:Char);
  48. Procedure FormatVar     (StIn:String;Var StOut:String;
  49.                          Size:Byte;Format:TextFormats);
  50. Procedure UnPadVar      (StIn:String;Var StOut:String);
  51. Procedure UnPadVarRight (StIn:String;Var StOut:String);
  52. Procedure UnPadVarLeft  (StIn:String;Var StOut:String);
  53. Procedure RightJustify  (StIn:String;Var StOut:String;Margin:Byte);
  54. Procedure PadFileName   (StIn:String;Var StOut:String);
  55.  
  56. Function  AdjustMeter   (StartMeter1,EndMeter1,ValueMeter1,
  57.                          StartMeter2,EndMeter2:LongInt):LongInt;
  58.  
  59. Function  MemoryCount   (P:Pointer):LongInt;
  60. Procedure GetLowestOfs  (P:Pointer;Var S,O:Word);
  61. Procedure AdjustPtr     (Var P:Pointer;Amount:LongInt);
  62.  
  63. Procedure SaveCursorSize(Var Data:Word);
  64. Procedure RestCursorSize(Data:Word);
  65. Procedure SaveXYPos     (Var Position:XYPosData);
  66. Procedure RestXYPos     (Var Position:XYPosData);
  67. Procedure CursorSize    (UpLim,DownLim:Byte);
  68.  
  69. Procedure PushCursorSize;
  70. Procedure PopCursorSize;
  71. Procedure PushXYPos;
  72. Procedure PopXYPos;
  73. Procedure PushTextColor;
  74. Procedure PopTextColor;
  75.  
  76. Procedure KeyBuffer     (Option:KeyBufferFunction);
  77.  
  78. Procedure SwapBytes     (Var A,B:Byte);
  79. Procedure SwapIntegers  (Var A,B:Integer);
  80. Procedure SwapWords     (Var A,B:Word);
  81. Procedure SwapLongInts  (Var A,B:LongInt);
  82. Procedure SwapReals     (Var A,B:Real);
  83. Procedure SwapSingles   (Var A,B:Single);
  84. Procedure SwapDoubles   (Var A,B:Double);
  85. Procedure SwapExtendeds (Var A,B:Extended);
  86. Procedure SwapStrings   (Var A,B:String);
  87.  
  88. Implementation
  89.  
  90. Var
  91.   PushPopCursorSize:Array[1..MaxXYSaves] of Word;
  92.   PushPopTextColor :Array[1..MaxXYSaves] of Word;
  93.   PushPopCursorPos :XYPosData;
  94.  
  95. Procedure SpacesToZeros(StIn:String;Var StOut:String); Assembler;
  96.  
  97. Asm
  98.   push  ds
  99.   cld
  100.   lds   si,StIn
  101.   les   di,StOut
  102.   lodsb
  103.   stosb
  104.   xor   ah,ah
  105.   xchg  ax,cx
  106.   jcxz  @Section3
  107.  
  108. @Section1:
  109.  
  110.   lodsb
  111.   cmp   al,' '
  112.   jne   @Section2
  113.   mov   al,'0'
  114.  
  115. @Section2:
  116.  
  117.   stosb
  118.   loop  @Section1
  119.  
  120. @Section3:
  121.  
  122.   pop   ds
  123.  
  124. End;
  125.  
  126. Function PosFrom(SubS:String;StIn:String;FarIn:Byte):Byte;
  127.  
  128. Var
  129.   NewPos:Byte;
  130.  
  131. Begin
  132.   Delete(StIn,1,FarIn-1);
  133.   NewPos:=Pos(SubS,StIn);
  134.   If NewPos=0 Then
  135.     PosFrom:=0
  136.   Else
  137.     PosFrom:=NewPos+FarIn-1;
  138. End;
  139.  
  140. Procedure UpperCase(StIn:String;Var StOut:String); Assembler;
  141.  
  142. Asm
  143.   push  ds
  144.   cld
  145.   lds   si,StIn
  146.   les   di,StOut
  147.   lodsb
  148.   stosb
  149.   xor   ah,ah
  150.   xchg  ax,cx
  151.   jcxz  @Section3
  152.  
  153. @Section1:
  154.  
  155.   lodsb
  156.   cmp   al,'a'
  157.   jb    @Section2
  158.   cmp   al,'z'
  159.   ja    @Section2
  160.   sub   al,20h
  161.  
  162. @Section2:
  163.  
  164.   stosb
  165.   loop  @Section1
  166.  
  167. @Section3:
  168.  
  169.   pop   ds
  170.  
  171. End;
  172.  
  173. Procedure PadVar(StIn:String;Var StOut:String;Count:Byte);
  174.  
  175. Var
  176.    J:Byte;
  177.  
  178. Begin
  179.   StOut:=StIn;
  180.   For J:=1 to Count do
  181.     StOut:=StOut+' ';
  182. End;
  183.  
  184. Procedure PadVarWith(StIn:String;Var StOut:String;Count:Byte;WithMe:Char);
  185.  
  186. Var
  187.    J:Byte;
  188.  
  189. Begin
  190.   StOut:=StIn;
  191.   For J:=1 to Count do
  192.     StOut:=StOut+WithMe;
  193. End;
  194.  
  195. Procedure FormatVar(StIn:String;Var StOut:String;
  196.                     Size:Byte;Format:TextFormats);
  197. Begin
  198.   StOut:=StIn;
  199.  
  200.   If Format=LeftText Then
  201.     While Length(StOut)<Size do
  202.       StOut:=StOut+' '
  203.   Else
  204.     If Format=CentreText Then
  205.     Begin
  206.       While Length(StOut)<Size-1 do
  207.         StOut:=' '+StOut+' ';
  208.       Format:=RightText;
  209.     End;
  210.  
  211.   If Format=RightText Then
  212.     While Length(StOut)<Size do
  213.       StOut:=' '+StOut;
  214. End;
  215.  
  216. Procedure UnPadVar(StIn:String;Var StOut:String);
  217. Begin
  218.   StOut:=StIn;
  219.   While (Length(StOut)>0) And (StOut[1]=' ') do
  220.     Delete(StOut,1,1);
  221.   While (Length(StOut)>0) And (StOut[Length(StOut)]=' ') do
  222.     Delete(StOut,Length(StOut),1);
  223. End;
  224.  
  225. Procedure UnPadVarRight(StIn:String;Var StOut:String);
  226. Begin
  227.   StOut:=StIn;
  228.   While (Length(StOut)>0) And (StOut[Length(StOut)]=' ') do
  229.     Delete(StOut,Length(StOut),1);
  230. End;
  231.  
  232. Procedure UnPadVarLeft(StIn:String;Var StOut:String);
  233. Begin
  234.   StOut:=StIn;
  235.   While (Length(StOut)>0) And (StOut[1]=' ') do
  236.     Delete(StOut,1,1);
  237. End;
  238.  
  239. Procedure RightJustify(StIn:String;Var StOut:String;Margin:Byte);
  240.  
  241. Var
  242.   EndLoop  :Boolean;
  243.   Marker,
  244.   SpPos    :Byte;
  245.  
  246. Begin
  247.   EndLoop:=False;
  248.   StOut:=StIn;
  249.   While (Length(StOut)<Margin) And (Not EndLoop) do
  250.   Begin
  251.     Marker:=1;
  252.     Repeat
  253.       SpPos:=PosFrom(' ',StOut,Marker);
  254.       If (SpPos=0) Or (SpPos=Length(StOut)) Then
  255.       Begin
  256.         If Marker=1 Then EndLoop:=True;
  257.         Marker:=255
  258.       End
  259.       Else
  260.       Begin
  261.         Insert(' ',StOut,SpPos);
  262.         Marker:=SpPos+2;
  263.       End;
  264.     Until (Length(StOut)>=Margin) Or (Marker>Length(StOut)) Or EndLoop;
  265.   End;
  266. End;
  267.  
  268. Procedure PadFileName(StIn:String;Var StOut:String);
  269.  
  270. { ╔════════════════════════════════════════════════════════════════════════╗ }
  271. { ║  Pads the file name to 12 characters.                                  ║ }
  272. { ╚════════════════════════════════════════════════════════════════════════╝ }
  273.  
  274. Var
  275.   T1 :DirStr;
  276.   T2 :NameStr;
  277.   T3 :ExtStr;
  278.   Dot:Char;
  279.  
  280. Begin
  281.   If StIn='.' Then
  282.   Begin
  283.     PadVar(StIn,StOut,11);
  284.     Exit;
  285.   End;
  286.  
  287.   If StIn='..' Then
  288.   Begin
  289.     PadVar(StIn,StOut,10);
  290.     Exit;
  291.   End;
  292.  
  293.   FSplit(StIn,T1,T2,T3);
  294.   PadVar(T2,T2,8-Length(T2));
  295.   Delete(T3,1,1);
  296.   PadVar(T3,T3,3-Length(T3));
  297.   If T3='   ' Then Dot:=' ' Else Dot:='.';
  298.   StOut:=T1+T2+Dot+T3;
  299. End;
  300.  
  301. Function AdjustMeter(StartMeter1,EndMeter1,ValueMeter1,
  302.                      StartMeter2,EndMeter2:LongInt):LongInt;
  303. Begin
  304.   AdjustMeter:=(((EndMeter2-StartMeter2)*(ValueMeter1-StartMeter1)) Div
  305.                (EndMeter1-StartMeter1))+StartMeter2;
  306. End;
  307.  
  308. Function MemoryCount(P:Pointer):LongInt;
  309. Begin
  310.   MemoryCount:=LongInt(Seg(P^)) * 16 + Ofs(P^);
  311. End;
  312.  
  313. Procedure GetLowestOfs(P:Pointer;Var S,O:Word);
  314. Begin
  315.   O:=Ofs(P^);
  316.   S:=Seg(P^);
  317.   If O<16 Then Exit;
  318.   Inc(S,O Div 16);
  319.   O:=O Mod 16;
  320. End;
  321.  
  322. Procedure AdjustPtr(Var P:Pointer;Amount:LongInt);
  323.  
  324. Var
  325.   X,
  326.   Segt,
  327.   Ofst  :Word;
  328.  
  329. Begin
  330.   Segt:=Seg(P^);
  331.   Ofst:=Ofs(P^);
  332.   If Amount<0 Then
  333.   Begin
  334.     X:=$FFFF-Ofst;      {Want to Make Ofst as Big as Possible}
  335.     X:=X - (X Mod 16);  {Round It to the Nearest 16}
  336.     Dec(Segt,X Div 16); {Take it from the Segment}
  337.     Inc(Ofst,X);        {Add it to the Offset}
  338.   End
  339.   Else
  340.   Begin
  341.     X:=Ofst - (Ofst Mod 16);    {Want to make Ofst as Small as Possible}
  342.     Inc(Segt,X Div 16);         {Add it to the Segment}
  343.     Dec(Ofst,X);                {Take it from the Offset}
  344.   End;
  345.   P:=Ptr(Segt,Ofst+Amount);
  346. End;
  347.  
  348. Procedure SaveCursorSize(Var Data:Word); Assembler;
  349. Asm
  350.   mov  ah,3
  351.   int  10h
  352.   les  di,Data
  353.   mov  es:[di],cx
  354. End;
  355.  
  356. Procedure RestCursorSize(Data:Word); Assembler;
  357. Asm
  358.   mov  ah,1
  359.   mov  cx,Data
  360.   int  10h
  361. End;
  362.  
  363. Procedure SaveXYPos(Var Position:XYPosData);
  364. {This saves the current cursor position and can store up to the last five}
  365. {cursor positions}
  366. {Number 'MaxXYSaves' is the lastest save}
  367.  
  368. Var
  369.   X:Byte;   {Loop}
  370.  
  371. Begin
  372.   For X:=1 to MaxXYSaves-1 do                    {Shift Cursor Saves up}
  373.   Begin
  374.       Position[X,CursorX]:=Position[X+1,CursorX];
  375.       Position[X,CursorY]:=Position[X+1,CursorY];
  376.   End;   {For X Loop}
  377.   Position[5,CursorX]:=WhereX;      {Insert New Cursor Save Position}
  378.   Position[5,CursorY]:=WhereY;
  379. End;  {SaveXYPos}
  380.  
  381. Procedure RestXYPos(Var Position:XYPosData);
  382. {This will restore up to five previously saved cursor positions}
  383. {Number 'MaxXYSaves' is the position to be restored}
  384.  
  385. Var
  386.   X:Byte;       {Loop}
  387.  
  388. Begin
  389.   GotoXY(Position[MaxXYSaves,CursorX],Position[MaxXYSaves,CursorY]); {Goto Old Position}
  390.   For X:=MaxXYSaves downto 2 do    {Shift up the cursor positions for the next restore}
  391.   Begin
  392.       Position[X,CursorX]:=Position[X-1,CursorX];
  393.       Position[X,CursorY]:=Position[X-1,CursorY];
  394.   End;  {For X Loop}
  395. End;  {RestXYPos}
  396.  
  397. Procedure CursorSize(UpLim,DownLim:Byte); Assembler;
  398. {Set the cursor size.  Send $20,$20 for no cursor}
  399. Asm
  400.   mov  ah,1
  401.   mov  ch,UpLim
  402.   mov  cl,DownLim
  403.   int  10h
  404. End;
  405.  
  406. Procedure PushCursorSize;
  407.  
  408. Var
  409.   X:Word;
  410.  
  411. Begin
  412.   For X:=1 to MaxXYSaves-1 do
  413.     PushPopCursorSize[X]:=PushPopCursorSize[X+1];
  414.  
  415.   Asm
  416.     mov  ah,3
  417.     int  10h
  418.     mov  X,cx
  419.   End;
  420.  
  421.   PushPopCursorSize[MaxXYSaves]:=X;
  422. End;
  423.  
  424. Procedure PopCursorSize;
  425.  
  426. Var
  427.   X:Word;
  428.  
  429. Begin
  430.   X:=PushPopCursorSize[MaxXYSaves];
  431.  
  432.   Asm
  433.     mov  ah,1
  434.     mov  cx,X
  435.     int  10h
  436.   End;
  437.  
  438.   For X:=MaxXYSaves DownTo 2 do
  439.     PushPopCursorSize[X]:=PushPopCursorSize[X-1];
  440. End;
  441.  
  442. Procedure PushXYPos;
  443.  
  444. Var
  445.   X:Byte;
  446.  
  447. Begin
  448.   For X:=1 to MaxXYSaves-1 do
  449.     PushPopCursorPos[X]:=PushPopCursorPos[X+1];
  450.  
  451.   PushPopCursorPos[MaxXYSaves,CursorX]:=WhereX;
  452.   PushPopCursorPos[MaxXYSaves,CursorY]:=WhereY;
  453. End;
  454.  
  455. Procedure PopXYPos;
  456.  
  457. Var
  458.   X:Byte;
  459.  
  460. Begin
  461.   GotoXY(PushPopCursorPos[MaxXYSaves,CursorX],
  462.          PushPopCursorPos[MaxXYSaves,CursorY]);
  463.  
  464.   For X:=MaxXYSaves DownTo 2 do
  465.     PushPopCursorPos[X]:=PushPopCursorPos[X-1];
  466. End;
  467.  
  468. Procedure PushTextColor;
  469.  
  470. Var
  471.   X:Byte;
  472.  
  473. Begin
  474.   For X:=1 to MaxXYSaves-1 do
  475.     PushPopTextColor[X]:=PushPopTextColor[X+1];
  476.  
  477.   PushPopTextColor[MaxXYSaves]:=TextAttr;
  478. End;
  479.  
  480. Procedure PopTextColor;
  481.  
  482. Var
  483.   X:Word;
  484.  
  485. Begin
  486.   TextAttr:=PushPopTextColor[MaxXYSaves];
  487.  
  488.   For X:=MaxXYSaves DownTo 2 do
  489.     PushPopTextColor[X]:=PushPopTextColor[X-1];
  490. End;
  491.  
  492. Procedure KeyBuffer(Option:KeyBufferFunction);
  493.  
  494. Type
  495.   KeyBufType=Record
  496.                Head:Word;
  497.                Tail:Word;
  498.                Data:Array[1..16] Of Word;
  499.              End;
  500.  
  501. Const
  502.   KeyBuf:KeyBufType=(Head:0;Tail:0;Data:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0));
  503.   P     :Pointer   =Ptr(0,$41A);
  504.  
  505. Begin
  506.   Case Option Of
  507.     Clear   :MemW[0:$41A]:=MemW[0:$41C];
  508.     Save    :Move(P^,KeyBuf,SizeOf(KeyBuf));
  509.     Restore :Move(KeyBuf,P^,SizeOf(KeyBuf));
  510.   End;
  511. End;
  512.  
  513. Procedure SwapBytes(Var A,B:Byte); Assembler;
  514. Asm
  515.   push  ds
  516.   les   di,A
  517.   lds   si,B
  518.   mov   al,es:[di]
  519.   mov   bl,al             {A into BX}
  520.   mov   al,ds:[si]        {B into AX}
  521.   mov   es:[di],al
  522.   mov   al,bl
  523.   mov   ds:[si],al
  524.   pop   ds
  525. End;
  526.  
  527. Procedure SwapIntegers(Var A,B:Integer); Assembler;
  528. Asm
  529.   push  ds
  530.   les   di,A
  531.   lds   si,B
  532.   mov   ax,es:[di]
  533.   mov   bx,ax             {A into BX}
  534.   mov   ax,ds:[si]        {B into AX}
  535.   mov   es:[di],ax
  536.   mov   ax,bx
  537.   mov   ds:[si],ax
  538.   pop   ds
  539. End;
  540.  
  541. Procedure SwapWords(Var A,B:Word); Assembler;
  542. Asm
  543.   push  ds
  544.   les   di,A
  545.   lds   si,B
  546.   mov   ax,es:[di]
  547.   mov   bx,ax             {A into BX}
  548.   mov   ax,ds:[si]        {B into AX}
  549.   mov   es:[di],ax
  550.   mov   ax,bx
  551.   mov   ds:[si],ax
  552.   pop   ds
  553. End;
  554.  
  555. Procedure SwapLongInts(Var A,B:LongInt);
  556.  
  557. Var
  558.   C:LongInt;
  559.  
  560. Begin
  561.   C:=A;
  562.   A:=B;
  563.   B:=C;
  564. End;
  565.  
  566. Procedure SwapReals(Var A,B:Real);
  567.  
  568. Var
  569.   C:Real;
  570.  
  571. Begin
  572.   C:=A;
  573.   A:=B;
  574.   B:=C;
  575. End;
  576.  
  577. Procedure SwapSingles(Var A,B:Single);
  578.  
  579. Var
  580.   C:Single;
  581.  
  582. Begin
  583.   C:=A;
  584.   A:=B;
  585.   B:=C;
  586. End;
  587.  
  588. Procedure SwapDoubles(Var A,B:Double);
  589.  
  590. Var
  591.   C:Double;
  592.  
  593. Begin
  594.   C:=A;
  595.   A:=B;
  596.   B:=C;
  597. End;
  598.  
  599. Procedure SwapExtendeds(Var A,B:Extended);
  600.  
  601. Var
  602.   C:Extended;
  603.  
  604. Begin
  605.   C:=A;
  606.   A:=B;
  607.   B:=C;
  608. End;
  609.  
  610. Procedure SwapComps(Var A,B:Comp);
  611.  
  612. Var
  613.   C:Comp;
  614.  
  615. Begin
  616.   C:=A;
  617.   A:=B;
  618.   B:=C;
  619. End;
  620.  
  621. Procedure SwapStrings(Var A,B:String);
  622.  
  623. Var
  624.   C:String;
  625.  
  626. Begin
  627.   C:=A;
  628.   A:=B;
  629.   B:=C;
  630. End;
  631.  
  632. End.
  633.  
  634. {
  635. ╔══════════════════════════════════════════════════════════════╗
  636. ║                   Pure Power Software                        ║
  637. ╟──────────────────────────────────────────────────────────────╢
  638. ║                                                              ║
  639. ║       This  software  is copyright by Michael Gallias.       ║
  640. ║                                                              ║
  641. ╚══════════════════════════════════════════════════════════════╝
  642. }
  643.