home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / JUIN / SCALCHAR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  2KB  |  76 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 548 of 578                                                               
  3. From : Sean Palmer                         1:104/123.0          27 Jun 93  00:00 
  4. To   : All                                                                       
  5. Subj : Scaling characters/fonts                                               
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Been playing around again...
  8.  
  9. This demo shows the use of these routines to scale characters and
  10. draw them in VGA 320x200x256 mode.
  11.  
  12. You can scale from any size to any other size. (but small ones look like
  13. crap)
  14.  
  15. Could be easily enhanced to handle entire sets of characters...}
  16.  
  17. {by Sean Palmer}
  18. {Public Domain}
  19.  
  20. procedure scaleChar(var src,dst;sw,sh,dw,dh:byte);
  21. var s:array[0..65521]of byte absolute src;
  22. var d:array[0..65521]of byte absolute dst;
  23. var xpos:array[0..255]of word;
  24. var i,j,ypos,sa,dp,db:word;
  25. begin
  26.  dp:=0; db:=0;
  27.  fillchar(dst,(dw*dh+7)shr 3,0);
  28.  for i:=0 to dw-1 do begin
  29.   xpos[i]:=(longint(sw)*i+sw div 2)div dw;
  30.   end;
  31.  for j:=0 to dh-1 do begin
  32.   ypos:=((longint(sh)*j+sh div 2)div dh)*sw;
  33.   for i:=0 to dw-1 do begin
  34.    sa:=ypos+xpos[i];
  35.    if s[sa shr 3]and(1 shl (sa and 7))<>0 then
  36.     d[dp]:=d[dp]or 1 shl db;
  37.    db:=succ(db)and 7;
  38.    if db=0 then inc(dp);
  39.    end;
  40.   end;
  41.  end;
  42.  
  43. const color:byte=$F;
  44.  
  45. procedure drawChar(var c;w:word;h:byte;x,y:integer);assembler;asm
  46.  mov ax,$A000; mov es,ax; cld;
  47.  mov ax,320; mul y; add ax,x; mov bx,ax;
  48.  mov dl,$80;  {force load of first byte}
  49.  mov dh,h; mov ah,color;
  50.  push ds;
  51.  lds si,c;
  52. @L2: mov di,bx; mov cx,w;
  53. @L: rol dl,1; jnc @NOLOD; lodsb; @NOLOD:
  54.  shr al,1; jnc @S; mov es:[di],ah; @S: inc di;
  55.  loop @L;
  56.  add bx,320; dec dh; jnz @L2;
  57.  pop ds;
  58.  end;
  59.  
  60. const c1:array[0..1]of longint=($D988A8A8,$88880278); {ugly shape}
  61.  
  62. var c2:array[0..32767]of byte;
  63.  
  64. var i,p:word;
  65.  
  66. begin
  67.  asm mov ax,$13; int $10; end;
  68.  p:=0;
  69.  for i:=1 to 22 do begin
  70.   scalechar(c1,c2,8,8,i,i);
  71.   drawChar(c2,i,i,p,p div 2);
  72.   inc(p,i+1);
  73.   end;
  74.  readln;
  75.  asm mov ax,3; int $10; end;
  76.  end.