home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / JUIN / SHADOBOX.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  3KB  |  94 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 224 of 465
  3. From : Lou Duchez                          1:157/200.0          17 Jun 93  07:52
  4. To   : Robert Cadena
  5. Subj : WINDOW TRICKS
  6. ────────────────────────────────────────────────────────────────────────────────
  7. RC> When I open the window, I want to give it a shadow, in C what you
  8. RC>would do is switch the 2nd bit of each character.
  9.  
  10. Shadowing here.  You'll need "Crt" for this to work:
  11. -------------------------------------------------------------------------------
  12. -}
  13.  
  14. procedure atshadow(x1, y1, x2, y2: byte);
  15.  
  16. { Makes a "shadow" to the right of and below a screen region, by setting the
  17.   foreground there to low intensity and the background to black. }
  18.  
  19. type  videolocation = record
  20.         videodata: char;
  21.         videoattribute: byte;
  22.         end;
  23.  
  24. var xbegin, xend, ybegin, yend, xcnt, ycnt: byte;
  25.     videosegment: word;
  26.     monosystem: boolean;
  27.     vidptr: ^videolocation;
  28.  
  29. begin
  30.  
  31. { Determine location of video memory. }
  32.  
  33.   monosystem := (lastmode in [0,2,7]);
  34.   if monosystem then videosegment := $b000 else videosegment := $b800;
  35.  
  36. { Determine the x coordinates where the shadowing begins and ends on the lower
  37.   edge.  (Basically two spaces to the right of the box.) }
  38.  
  39.   xbegin := x1 + 2; xend := x2 + 2;
  40.  
  41. { Determine the y coordinates where the shadowing begins and ends on the
  42.   right.  (Basically one row below the box.) }
  43.  
  44.   ybegin := y1 + 1; yend := y2 + 1;
  45.   ycnt := ybegin;
  46.   while (ycnt <= yend) and (ycnt <= 25) do begin
  47.  
  48. { This loop goes through each row, putting in the shadows on the right and
  49.   bottom.  First thing to check on each pass: if we're not below the region
  50.   to shadow, shade only to the right.  Otherwise, start at the left. }
  51.  
  52.     if ycnt > y2 then xcnt := xbegin else xcnt := x2 + 1;
  53.     vidptr := ptr(videosegment, 2*(80*(ycnt - 1) + (xcnt - 1)));
  54.     while (xcnt <= xend) and (xcnt <= 80) do begin
  55.  
  56. { This loop does the appropriate shadowing for this row. }
  57.  
  58.       vidptr^.videoattribute := vidptr^.videoattribute and $07; { SHADOW! }
  59.       xcnt := xcnt + 1;
  60.       inc(vidptr);
  61.       end;
  62.     ycnt := ycnt + 1;
  63.     end;
  64.   end;
  65.  
  66. -------------------------------------------------------------------------------
  67. -
  68. RC> In C there is a function that gets a portion of the screen, saves it in 
  69. RC>a buffer and the another funtion that puts that buffer on the screen.  Could
  70. RC>someone make these funtions in PASCAL please.
  71.  
  72. I find it faster to save entire screens.  To save an entire screen:
  73.  
  74. 1) make a pointer variable
  75. 2) allocate 4000 bytes to it via "GetMem"
  76. 3) use the "Move" procedure to copy video memory to/from the buffer
  77.  
  78. Example:
  79. -------------------------------------------------------------------------------
  80. -
  81.  
  82. var buffy, videoimage: pointer;
  83.     monosystem: boolean;
  84.     videosegment: word;
  85.  
  86. { Figure out where video memory is }
  87.  
  88. monosystem := (lastmode in [0,2,7]);
  89. if monosystem then videosegment := $b000 else videosegment := $b800;
  90. videoimage := ptr(videosegment, $0000);
  91.  
  92. getmem(buffy, 4000);
  93. move(videoimage^, buffy^, 4000); { saves screen }
  94. move(buffy^, videoimage^, 4000); { restores screen }