graph64.pas

一款RPG游戏的引擎可以自己制作一款RPG游戏的引擎可以自己制作

{$I param.inc}
{
 ############################################################################
 ## Graph64 unit for Delphi 2/3/4/5 and WDosX 0.95/96, DirectX, GDI        ##
 ##                                                                        ##
 ## Version 0.31010 beta                                                   ##
 ##                                                                        ##
 ## Copyright (c)1999/2000 Pavol Stugel                                    ##
 ## Homepage: www.graph64.miesto.sk                                        ##
 ## This unit is free. e-mail: [e-mail]                            ##
 ############################################################################


  -----------------------------
  Last updated: 05.October 2000
  -----------------------------

  Warning: !this is not english! :-)
  NOTE: For examples see http://www.graph64.miesto.sk

  What you need?: Delphi 3/4/5 (5 or better recomended, only about 100$ for standart version),
                  For DOS:  WDOSX 0.96 alpha 2, units from WDOSX : VBE,FBUFFERS,CRT
                            http://www.geocities.com/siliconvalley/park/4493
                            http://www.wuschel.demon.co.uk
                  For Windows: DirectX 6 units from Erik Unger
                            http://www.bigfoot.com/~ungerik/
                  For GDI:  nothing only Delphi :-)

  Note: This unit is under construction !!!

  -------------
  Future plans: see Graph64 homepage
  -------------

  --------
  History:
  --------

   10.10.2000 - ~ fixed LoadFromBMPFile
                ~ fixed DrawGrayscale,DrawColorize ;)
                + added DrawLight, for lighting effects ...
   
   24.09.2000 - ~ fixed WinColor function
                ~ fixed SwapRGB for 32bpp
                ~ fixed DrawLens (with transparent=true) for 32bpp
                - Triangle "bug" removed (always was only LensTriangle...)
                + added PixelPtr property
                + added DrawColorize effect  (see example for more info)
                + changed ConvertToGrayscale into DrawGrayscale (with speed increase to realtime)
                ! Don't use LoadFromBMPFile nor LoadFromTGAFile in TScreen64!!!

   31.08.2000 - + New Direct64 unit for DirectX 7. Note: You must have DirectX 7 installed!
                + added 32bit(bpp) rendering; without these: MotionBlur,Antialiasing,LoadFromRSBFile,TextureMap,
                  ;-)
                ~ Corrected SwapRGB,Refresh,ClearSurface for GDI,
                ~ corrected LensHLine
                ~ corrected UnpackRGB
                + added ConvertToGrayScale
                + added overload TScreen.Create
                + added Triangle

   16.06.2000 - ~ Corrected bug in TScreen with WDosX, any optimizations.
                  SaveToTGAFile now works with TScreen64
                - Ops, in previous release stupid error was in SetSize procedure (changed width with height),
                  now all is OK
   12.06.2000 - ~ TBitmap64.AssignData updated,
                v 0.3 alpha
                  Note: This is Alpha release of graph64 --> many functions like:
                  LoadFromBMP/TGA/RSBFile, SaveToTGAFile,MotionBlur,SetSize,SetWidth,SetHeight,ConverXXtoYY
                  are not stable after using AssignData...
   06.06.2000 - + added support for internal transparent compression.
   31.05.2000 - ~ Bug: Don't use LoadFromTGAFile/LoadFromBMPFile with TScreen64 !!!
                  (it doesn't work with all cards)
                + added Rectangle.
                ~ Corrected bug in LensBar,
                + added manual (not perfect but IS) see www.graph64.miesto.sk/manual.htm
   28.05.2000 - ? Antialiasing now works OK (but it's extremly slow)
   23.05.2000 - + added support for TBitmap64/TScreen64 resizing: Width,Height, SetSize(x,y)
                  TScreen64 resizing work only in GDI applications not in DirectX nor WDosX
                  !!!DON'T USE MOTION BLUR OR ANTIALIASING FUNCTIONS IN GDI APPLICATIONS NOW!!!
   17.05.2000 - + Port to Free Pascal Compiler started, but compiler crash on 508 line of code.
                  Changed: Integer>>Longint (for FPC compability, because in FPC Integer is -32768 .. 32767)
   06.05.2000 - + added: LensHLine, LensBar
   05.05.2000 - + screen.create( YourCanvas: TImage) changed to screen.create( YourScreen: TPaintBox;Auto: Boolean)
                  more info see in source code for this constructor
                * corrected bug in GDI with exclusive graphics cards like: 3DLabs Permedia1/2, S3 Trio3D...
   14.04.2000 - + added new Constructor AssignData
                + added Animation support(Beta)!!! To create animations use my editor!!!
                  TAnim64.Create, Destroy,DrawFrame,NextFrame,FirstFrame,GotoFrame
   04.04.2000 - * Vesa 1.2+ ,DirectX 6+ and GDI works fine on all graphics cards, now!!!(report me if not)
   27.03.2000 - + added UnpackRGB(), fixed problem in TBitmap64.Destroy()
                * LoadFromBMPfile now works perfectly :-) without RLE compression
   19.03.2000 - + added func. Antialiasing, SwapRGB
   20.02.2000 - + added support for uncompressed BMP files,
                + added conversion procedure g64ConvertBitmap ()
   09.02.2000 - ~ Removed all OVERLOAD declarations for Delphi 3 compatibility!
                + added Ellipse, Circle
                  What else? Only cosmetic decorations.
   20.01.2000 - * Many correction for GDI support, clear up code (hints), now it's faster
                  replaced all Longint to Longint :-)
                + added LensLine, LensPixels[ x,y]
   12.01.2000 - * Ehm, GDI idea.
                  M$ Windows DIB is reverse!
                  Changed TBitmap to TBitmap64, TScreen to TScreen64 ...
                  for GDI application use something like this:

                  MyScreen:= TScreen64. Create( Image1);  (where Image1 is standart TImage)
                  MyScreen. BackBuffer.Canvas.Draw(0,0, YourWindowsBitmap); (backbuffer is standart TBitmap)
                  MyScreen. Line(0,0, MyScreen. Width, MyScreen. Height, 0);
                  MyScreen. Refresh;                      (screen is TScreen64 type)

   04.01.2000 - * New homepage http://www.graph64.miesto.sk
   26.12.1999 - * Any correction (perfomace, clear...)
                + added new overload DrawBlend
   12.12.1999 - Now DrawBlend works well for bitmaps
   11.12.1999 - + added Perspective correct texture mapping. Original cpp code: REDOX, e-mail: [e-mail]
                  TBitmap. TexTriangle ()
   03.12.1999 - * DirectX bug corrected : diferent size of BackSurface (on Savage4 always 1024)
                * DirectX slow bug fixed (DDSCAPS_SYSTEMMEMORY, this is in 99% fastest than VIDEOMEMORY)
   22.11.1999 - * Any bugs fixed in 15bpp resolutions
                + antialiasing for fonts,
   21.11.1999 - + added TBitmap. MotionBlur - realtime effects -> low quality
                + added TBitmap. FlipVertical (for all bpp)
   19.11.1999 - * Nothing in Graph64 but Input64 added for keyboard support
   12.11.1999 - Now Pixels[ x,y] works OK (write/read)
   06.11.1999 - Added support for fonts with unit FONTS,
                * font convertor /from Windows fonts to Bitmap
   27.10.1999 - Added TBitmap. DrawBlend
                Added TBitmap. SaveToTGAFile
                ~ problems with DrawLens,DrawBlend in DirectX, WDosX: 21 fps and DirectX: 2 fps!!
                / removed DrawAlpha
   11.10.1999 - Added support for Rainbow Six Bitmaps, TBitmap. LoadFromRSBFile
   20.09.1999 - Added TBitmap. DrawLens (15/16bit)- it's like blending but only
                50% from SourceRGB + 50% from DestRGB = DestationColor ... and FASTER!
   09.09.1999 - * correct bug in TBitmap. Draw, Alpha don't work now,
   08.09.1999 - In directX you have two pages (FrontSurface,BackSurface)!
                + added support for 15bpp, updated: LoadFromTgaFile,RGB,Line,Bar...
                + added TBitmap.FlipHorizontal (only 15bpp and 16bpp)

   07.09.1999 - * First release which works under Win9x with DirectX 6
                + added unit Direct64 for DirectX control
                + added Lock , Unlock for TScreen
                 For details see TScreen. Lock

                + add '$define win9x'(in param.inc) if you can DirectX application!
                ~ problems with Directx, 16bpp is 15bpp...
   06.09.1999 - DirectX idea ;-)
   25.08.1999 - Noname OS (TM)(r) destroy me one partition on my HDD, two weeks of my work was lost

   01.08.1999 - added CleanSurface (),Line ()...
   11.07.1999 - added DrawAlpha; support for Transparent mode in Draw, DrawAlpha proc.
   23.06.1999 - added LoadFromTGAFile for 15,16,24,32 bit uncopressed TGA files for 16bpp bitmaps,
                added Draw procedure (ala canvas. draw in Windows(TM)(R)(C)(..))
   10.06.1999 - First version, now without any ASM Code ;)
                all functions is very slow without any optimization
                only 16bpp
}

unit graph64;

interface

uses
     {$IFDEF win9x}
      Direct64,  {unit for control DirectX functions}
     {$ENDIF}
     {$IFDEF apGDI}
      Windows,Graphics,ExtCtrls,Dialogs, 
     {$ENDIF}
     {$IFDEF wdosx}
      vbe,       {cool Tippach unit for vesa support}
      fbuffers,  {memory for offscreen drawing ,TDDSurface...}
      crt,
     {$ENDIF}

     {$IFNDEF apFPC}
      SysUtils;  {standart Delphi unit for all platforms}
     {$ELSE}
      dos;

     {$ENDIF}

type PWord= ^Word;
     PByte= ^Byte;
     PLongint= ^Longint;

Type TRGB= record
       b,g,r: byte;
     end;

     TRGB24= record        {here is specification for all color depth resolution}
       R,G,B: byte;
     end;
     TRGB32= record
       b,g,r,A: byte;
     end;
     TRGB16= Word;
     TRGB8=  Byte;
     PRGB=   ^TRGB;
     PRGB24= ^Trgb24;
     PRGB32= ^Trgb32;

const pf1bit= 1;     {pixel format}
      pf4bit= 4;
      pf8bit= 8;
      pf15bit= 15;
      pf16bit= 16;
      pf24bit= 24;
      pf32bit= 32;
      pfCustom= $ff;

      tmDisabled= -1;
      tmAuto=     -2;

type T2DPixel = record
      x,y: single;
     end;

type

  T3DPixel = record
    x,y,z: single;
  end;

  g64Error = word;

  TCLine=array[0..0]of word;


  PPalette64=^TPalette64;
  TPalette64=array[0..255]of TRGB;
   // end; {!?!?!? Delphi "bug" enable this line for total compiler death ?!?!?!}


type
     TCompressBitmap= Class
       FLines,FData: Pointer;
       LineSize: ^TCLine;
       Height,Width: Longint;


       constructor Create( filename: string);
       destructor Destroy;override;
       function GetScanLine( row: Longint): pointer;

       property ScanLine[ Row: Longint]: pointer read GetScanLine;
     end;


type
    TPixelFormat = word;

    TBitmap64= Class{( TObject)}    {Main class for all drawing functions...}


      bmType,            {bmType , not supported yet}
      bmWidth,
      bmHeight,
      bmBpp,                     {how many bytes we need for one pixel (16bpp= 2, 24bpp= 3 ...)}
      bmWidthBytes: Longint;
      bmPlanes: word;
      bmBitsPixel: TPixelFormat; {color depth : pf8bit,pf16bit,pf24bit... }
      bmBits: pointer;           {pointer for bits}

      RStart,GStart,BStart,
      RSize,GSize,BSize: byte;   {}
      RBitMask,GBitMask,BBitMask: cardinal; {for DirectX compability, and for VBE !!!}

      linePitch: Longint;
      TransparentColor: Longint;
      Transparent: boolean;
      WasAssigned: boolean;
      Palette :PPalette64;

    private
      function    GetPixelFormat: TPixelFormat;virtual;
      procedure   SetPixelFormat( value: TPixelFormat);virtual;
      function    GetScanLine( row: Longint): pointer;virtual;
      procedure   SetWidth( value: Longint);virtual;
      procedure   SetHeight( value: Longint);virtual;
      function    GetPixelPtr( x,y: Longint): Pointer;virtual; {get pointer to pixel on x,y coordinates}
      procedure   PutLensPixel( x,y,color: Longint);virtual;
//      procedure   GrayscaleMem( source, target: Pointer;size: Longint;pf: TPixelFormat);virtual;
      procedure   BuildColors;virtual;


    public
      constructor Create( xres:Longint; yres:Longint; pixf: TPixelFormat);
      constructor AssignData( xres,yres: Longint; pixf: TPixelFormat;data: pointer;LineSize: longint);
      Destructor  Destroy;{$IFNDEF apFPC} override;{$ENDIF}
      procedure   SetSize( ValueX, ValueY: integer);virtual; {set new size for bitmap, Picture data (pixmap) will be destroyed}

      //standart functions
      procedure   PutPixel( x,y,color: Longint);virtual; {draw one pixel on x,y coordinates}
      function    GetPixel( x,y: Longint): Longint;virtual; {get color from x,y coordinates}
      procedure   HLine( x,y,x1,color: Longint);virtual; {draw horizontal line from x,y to x1,y }
      procedure   VLine( x,y,y1,color: Longint);virtual;{draw vertical line from x,y to x,y1   }
      procedure   Line( x,y, x1,y1, color: Longint);virtual;  {draw normal line from x,y to x1,y1 with color}
      procedure   Ellipse ( x, y, xsize, ysize, color: Longint);virtual;
      procedure   Circle( x,y, size, color: Longint);virtual;
     procedure   LensLine( x,y, x1,y1, color: Longint);virtual;
     procedure   LensHLine(x,y,x1,color: Longint);virtual; {draw horizontal line with lens}
      procedure   Bar( x,y,x1,y1,color: Longint);virtual;{draw filled rectangle from x,y, to x1,y1 with color}
      procedure   Rectangle( x,y, x1,y1,color: Longint);virtual;
     procedure   LensBar( x,y,x1,y1,color: Longint);virtual; {draw Lens rectangle from x,y to x1,y1 with color}
     procedure   Draw( x,y: Longint; b:TBitmap64);virtual;
     procedure   DrawResize( x,y, NewWidth, NewHeight: Longint; b: TBitmap64);virtual;

      //files manipulation
      procedure   LoadFromTGAFile( s: string);virtual;
      procedure   LoadFromBMPFile( s: string);virtual;
      procedure   LoadFromRSBFile( s: string);virtual;
      procedure   SaveToTGAFile( s: string);virtual;
      procedure   Triangle( x1,y1, x2,y2, x3,y3,color:Longint);

      //any effects

      function    UnpackRGB ( what: Longint): TRGB;virtual;
      function    RGB( r,g,b: byte): Longint;virtual;
      {$ifdef apGDI}
      function    WinColor( color: TColor): Integer;virtual;
      {$endif}
      procedure   DrawBlend( x,y: Longint; b:TBitmap64; sfactor,dfactor: single);virtual;
      procedure   DrawBlendRGB( x,y: Longint; b:TBitmap64; rfactor,gfactor,bfactor: single);virtual;
      procedure   DrawColorize( x,y: Integer; b:TBitmap64; RFactor,GFactor,BFactor: Integer;Light:Byte);virtual;
      procedure   DrawLens( x,y: Longint; b:TBitmap64);virtual; {}
      procedure   FlipHorizontal;virtual;    {for TGA format}
      procedure   FlipVertical;virtual;
      procedure   MotionBlur;virtual;
      procedure   Antialiasing;virtual;
      procedure   Antialiasing2;virtual;
      procedure   SwapRGB;virtual;  //swap windows BGR format to normal RGB format
      procedure   Scan_line( xl,xr,ul,ur,vl,vr,zl,zr: single; y: Longint;texture: TBitmap64);virtual;
      procedure   TextureMap( p1,p2,p3: T3DPixel;t1,t2,t3: T2DPixel;textura: TBitmap64);virtual;
      procedure   DrawGrayscale(x,y: Integer; b:TBitmap64);virtual;
      procedure   DrawLight( x,y: Longint; bitmap:TBitmap64; r,g,b: byte);virtual;

      //experimental only
      function  CompressToFile( filename: string):boolean;
      procedure DrawCompressed( x,y: integer; b: TCompressBitmap);

      property Height: Longint read bmHeight write SetHeight;
      property Width: Longint read bmWidth write SetWidth;
      property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat;
      property ScanLine[ Row: Longint]: pointer read GetScanLine; {ala Delphi, see delphi help in TBitmap...}
      property Pixels[ X,Y: Longint]: Longint read GetPixel write PutPixel;
      property PixelPtr[ x,y: Longint]: Pointer read GetPixelPtr;
      property LensPixels[ X,Y: Longint]: Longint read GetPixel write PutLensPixel;

     end;

    {screen drawing function}
    TScreen64= class( TBitmap64)

    {$IFDEF wdosx}
        Surface: TDDSurface;
        MyScreen: TVbeInterface;   {manipulation with vesa functions}
    {$ENDIF}

    {$IFDEF apGDI}
        BackBuffer: TBitmap;  {This is back buffer bitmap (from standart graphics unit)
                               In win GDI I use system bitmap...}
        gCanvas:    TCanvas;
    {$ENDIF}
        RefreshRate: Longint;

     {$IFDEF apGDI}
      constructor Create( YourScreen: TPaintBox;MaxSize,AutoHandle: boolean;pixf:TPixelFormat);overload;
      constructor Create( YourCanvas: TCanvas; xres,yres: Longint;pixf:TPixelFormat);overload;
      constructor Create( xres,yres: Longint;pixf:TPixelFormat);overload;
      procedure   OnPaint( Sender: TObject);
      procedure   SetSize( ValueX, ValueY: Longint);override;
      procedure   SetWidth( value: Longint);override;
      procedure   SetHeight( value: Longint);override;
      
      property    Height: Longint read bmHeight write SetHeight;
      property    Width: Longint read bmWidth write SetWidth;
      {$ELSE}
      constructor Create( xres,yres: Longint; pixf: TPixelFormat;_refresh: Longint);
     {$ENDIF}
      procedure   Refresh;
      procedure   ClearSurface( color: Longint);
      procedure   Lock;  {for DirectX comp.}
      procedure   UnLock;{    - II -   }
      destructor  Destroy;{$IFNDEF apFPC}override;{$ENDIF}
     end;

    procedure g64ConvertBitmap( source, destation, size: cardinal; fromBits, toBits: byte);


//here is Animation support
type PAnimImage= ^TAnimImage;
     TAnimImage= record
       Data: Pointer;
       Width,Height: Longint;
       Transparent: boolean;
       TransparentColor: word;
       next: PAnimImage;
     end;


type PSprite= ^TSprite;  //This is for Delphi 2/3 compatibility instead of dynamic arrays
     TSprite= record
       ImageIndex: Longint;
       DImageIndex: PAnimImage; //pointer to Image
       PosX,PosY: Longint;
       Blend: boolean;
       SFactor,DFactor: single;
       next: PSprite;   //pointer to next sprite
     end;

type PAnimFrame= ^TAnimFrame;
     TAnimFrame= record
       FSprite: PSprite;  //first sprite
       Sprites: Longint;
       next: PAnimFrame;
     end;

Type TAnim64= class{(TObject)}
       AFrame,             //active image
       FFrame: PAnimFrame; //first frame
       FImage: PAnimImage; //first image
       CurFrame,           //current frame
       Frames,
       Images: Longint;
       pixelformat: {$IFNDEF apFPC}Graph64.TPixelFormat;{$ELSE}TPixelFormat;{$ENDIF}
       constructor Create( filename: string; pixelFormat1: {$IFNDEF apFPC}Graph64.TPixelFormat{$ELSE}TPixelFormat{$ENDIF});
       destructor Destroy;{$IFNDEF apFPC}override;{$ENDIF}
       procedure DrawFrame( where: TBitmap64;x,y: Longint);
       procedure FirstFrame;
       procedure LastFrame;
       procedure NextFrame;
       procedure GotoFrame( whichframe: Longint);

     end;

{$IFDEF debug}
var
  DebugFile: text;
{$ENDIF}

implementation

Procedure SwapL( var a,b: Longint);
var c: Longint;
begin
  c:=a;
  a:= b;
  b:= c;
end;

Procedure SwapW( var a,b: word);
var c: word;
begin
  c:=a;
  a:= b;
  b:= c;
end;

constructor TCompressBitmap. Create( filename: string);
var f: file;
begin
  AssignFile( f, filename);
  reset (f,1);
  BlockRead( f, Width, 4);
  BlockRead( f, Height, 4);
  GetMem( FLines, Height*2);
  BlockRead( f, FLines^, Height*2);
  GetMem( FData, FileSize( f) -FilePos(f));
  BlockRead(f, FData^, FileSize( f) -FilePos(f));
  LineSize:= FLines;
{$IFDEF debug}
  writeln( debugfile, Byte(FData^));
{$ENDIF}
  CloseFile( f);
end;

destructor TCompressBitmap. Destroy;