home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / TPPCX256.ZIP / PCXPLAY.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-21  |  7KB  |  219 lines
  1. { Sample program for TPPCX-VGA256 }
  2. { Copyright 1993, Mark D. Rafn, MDRUtils(tm) }
  3.  
  4. program PCXPLAY;
  5. uses graph, crt, uPcxVGA, uVesa, uVga, uPal256, uBGIVesa;
  6. { tabs = 2 }
  7. {
  8.   *** NOTE ***
  9.   A 256 color image displayed in 16 color video mode will use gray scaling.
  10.   A 16 color image displayed in 256 color video mode will sum colors.
  11.   Registered users will be able to manipulate palettes to produce quality
  12.   results.
  13. }
  14.  
  15. var
  16.   ePcx: PPcxEncoder_Vga; { PCX encoder object }
  17.   VesaAdapter: PVesa;    { VESA object }
  18.   VgaAdapter: PVga;      { VGA object  }
  19.   Adapter: PVga;         { VGA object }
  20.   Picx, Picy, PicW, PicH: integer;
  21.  
  22. const
  23.   BGIRegister = 240; { Vga palette register number }
  24.   NoRegisters = 16;  { number of registers to set  }
  25.   TextX: integer = 10;
  26.   TextY: integer = 10;
  27.  
  28. { *** PCX file names to use *** }
  29.   VGAPCX  = 'COLOR256.PCX';
  30.   VESAPCX = 'THECOVER.PCX';
  31.  
  32. procedure Pause;
  33. begin
  34.   repeat until keypressed;
  35.   MemW[$0000:$041C] := MemW[$0000:$041A]; {clear kbd buffer}
  36. end;
  37.  
  38. procedure WriteOut(S : string);
  39. begin
  40.   Adapter^.SetColor(255,63,63,63);
  41.   SetColor(BGIRegister + White);
  42.   SetTextStyle(DefaultFont, HorizDir, 1);
  43.   SetTextJustify(LeftText,TopText);
  44.   OutTextxy(Textx, Texty, S);
  45.   Inc(TextY, 15);
  46. end; { WriteOut }
  47.  
  48. procedure ShowVesa;
  49. var
  50.    Pcx: PPcxDecoder_VGA; { PCX decoder object }
  51.    Size: longint;
  52.    SaveDac: PDac_256;
  53. begin
  54.   Pcx := nil;
  55.   { create VESA descendant PCX object }
  56.   Pcx := New(PPcxDecoder_VESA, Init(VESAPCX, VesaAdapter));
  57.   { was object created? }
  58.   if not (Pcx = nil) then
  59.   begin
  60.     { decode image to RAM, will automatically decode to disk if no memory }
  61.     Pcx^.Decode(ToRam);
  62.     { decoded OK? }
  63.     if PcxError = PcxError0 then
  64.         begin
  65.       PicW := Pcx^.GetMxX; { width of image }
  66.       PicH := Pcx^.GetMxY; { height of image }
  67.       PicX := (VesaAdapter^.GetMaxX div 2) - (PicW div 2); { center horiz }
  68.       PicY := (VesaAdapter^.GetMaxY div 2) - (PicH div 2); { center vert  }
  69.       { set Vga palette registers to PCX info }
  70.       Pcx^.Set_Palette;
  71.       { show image at x, y, full image - no clipping }
  72.         Pcx^.Show(New(PPosWin, Init(PicX, PicY, 0, 0, PicW, PicH)));
  73.  
  74.       { if you want the BGI colors, it is best to relocate them to a high   }
  75.       { register number. Usually a 256 color image does not use the last    }
  76.       { 8 to 16 registers (240-255). And they generally never remap color   }
  77.       { 255. Worst case you can set register 255 to white for your text     }
  78.       { output. Run COLOR256.PCX with the following SetColorBlock proc and  }
  79.       { see what happens. You can play with the beginning register number   }
  80.       { and quantity. I tried BGIRegister=128 and NoRegisters=8 which worked}
  81.             { fairly well. Note: that you are then limited to 8 known colors,     }
  82.             { black thru lightgray                                                }
  83.  
  84.       {comment out if you want all 256 colors un-modified }
  85.       {
  86.       Adapter^.SetColorBlock(BGIRegister, NoRegisters, @Dac16_bgi);
  87.  
  88.       graph.SetColor(BGIRegister + White);
  89.       }
  90.       Rectangle(Picx -1, Picy-1, Picx + PicW+1, Picy+1 + PicH);
  91.       { destroy VESA PCX object }
  92.       Dispose(Pcx, Done);
  93.  
  94.       WriteOut('256 GrayScale, palette loaded.');
  95.       WriteOut('press any key ...');
  96.       WriteOut('');
  97.       Pause;
  98.  
  99.       { decode and display new image }
  100.  
  101.       Pcx := New(PPcxDecoder_VESA, Init(VGAPCX, VesaAdapter));
  102.       Pcx^.Decode(ToRam);
  103.         Pcx^.Show(New(PPosWin,
  104.               Init(PicX + 50, PicY + 50, 0, 0, Pcx^.GetMxX, Pcx^.GetMxY)));
  105.       Pcx^.Set_Palette;
  106.       Dispose(Pcx, Done);
  107.  
  108.       WriteOut('256 color image, palette loaded.');
  109.       WriteOut('press any key ...');
  110.       WriteOut('');
  111.       Pause;
  112.  
  113.       { Sum the Vga palette registers to gray }
  114.       Adapter^.SumToGray(0, 256);
  115.       WriteOut('256 colors summed to gray.');
  116.       WriteOut('press any key ...');
  117.     end;
  118.   end;
  119. end;
  120.  
  121. {also see ShowVESA for further palette information}
  122. procedure ShowVGA;
  123. var
  124.    Pcx: PPcxDecoder_VGA; { PCX decoder object }
  125. begin
  126.   Pcx := nil;
  127.   { create a VGA PCX object }
  128.   Pcx := New(PPcxDecoder_VGA, Init(VGAPCX, Adapter));
  129.   { was object created? }
  130.   if not (Pcx = nil) then
  131.   begin
  132.     { decode image to RAM, will automatically decode to disk if no memory }
  133.     Pcx^.Decode(ToRam);
  134.     { decoded OK? }
  135.     if PcxError = PcxError0 then
  136.         begin
  137.       PicW := Pcx^.GetMxX;
  138.       PicH := Pcx^.GetMxY;
  139.       Picx := (Adapter^.GetMaxX div 2) - (PicW div 2);
  140.       Picy := (Adapter^.GetMaxY div 2) - (PicH div 2);
  141.       Pcx^.Set_Palette;
  142.         Pcx^.Show(New(PPosWin, Init(Picx, Picy, 0, 0, PicW, PicH)));
  143.       graph.SetColor(BGIRegister + White);
  144.       Rectangle(Picx -1, Picy-1, Picx + PicW+1, Picy+1 + PicH);
  145.       Dispose(Pcx, Done);
  146.     end;
  147.   end;
  148.  
  149. end;
  150.  
  151. begin
  152.   { is system VGA? }
  153.   if not Vga_Detect then Halt;
  154.   { next we need a video adapter object, either VESA or VGA }
  155.   { check first for VESA }
  156.   Adapter := New(PVesa, Init);
  157.   { is VESA present? }
  158.   if Adapter <> nil then
  159.   begin
  160.     { VESA is present }
  161.     VesaAdapter := PVesa(Adapter);
  162.     { initialize graphics, no other graphics initialization is needed }
  163.     { a video object must be passed to the initialization procedure }
  164.     InitBGI_Vesa(VesaAdapter);
  165.     { set VESA mode to requested resolution }
  166.     BGI_SetVesaMode(VesaAdapter, Vesa_max);
  167.     { four modes available, use the following constants
  168.       VESA_Lo      =  640x 400 256 Color
  169.       VESA_Med     =  640x 480 256 Color
  170.       VESA_Hi      =  800x 600 256 Color
  171.       VESA_SuperHi = 1024x 768 256 Color
  172.       VESA_Max     = Maximum mode detected
  173.     }
  174.     ShowVesa;
  175.     Pause;
  176.     Dispose(VesaAdapter, Done);
  177.   end
  178.   else
  179.   begin
  180.     { VESA is not supported, use standard VGA 256 mode (13h) }
  181.     Adapter := New(PVga, Init);
  182.     { initialize graphics, no other graphics initialization is needed }
  183.     { a video object must be passed to the initialization procedure }
  184.     { in standard VGA mode, the requested mode must also be passed }
  185.     InitBGI_Vga(Adapter, Vga_256);
  186.       { use standard BGI mode calls plus additional mode 13h }
  187.       { VGAlo, VGAmed, VGAhi, VGA_256 (13h) }
  188.     ShowVga;
  189.     Pause;
  190.     Dispose(Adapter, Done);
  191.   end;
  192.  
  193. {
  194.   sample code for creating a PCX file, commented out
  195.   ePcx := nil;
  196.   (create VESA descendant PCX encoder object)
  197.   ePcx := New(PPcxEncoder_Vesa, Init('TEST.PCX', Adapter));
  198.   if not (ePcx = nil) then
  199.     (save image in boundaries)
  200.     ePcx^.Save(New(PWin, Init(Picx, Picy, Picx + PicW, Picy + PicH)));
  201.   Dispose(ePcx, Done);
  202. }
  203.  
  204. end.
  205.  
  206. { sample code for intializing VESA graphics without a BGI driver }
  207. { any and all calls to graph unit procedures or functions will   }
  208. { hang the system. Remove all calls to graph unit                }
  209. {    Adapter := New(PVesa, Init);}
  210. {    if Adapter <> nil then VesaAdapter := Adapter;
  211. {    VesaAdapter := PVesa(Adapter);}
  212. {    InitBIOS_Vesa(VesaAdapter);}
  213. {    VesaAdapter^.SetVESAMode(Vesa16_superhi);}
  214. {      All 256 color modes Vesa_lo - Vesa_SuperHi plus }
  215. {      2 additional modes available, planar type}
  216. {      VESA16_Hi = 800x 600 16 Color, BIOS Vesa}
  217. {      VESA16_SuperHi = 1024x 768 16 Color, BIOS Vesa}
  218.  
  219.