unit1.pas

Directx游戏制作开发包DGCBETA6

{
 EasyScrolly - A Delphi Games Creator Demo Program - Jeff Kurtz
 --------------------------------------------------------------------------
 This little program demonstrates the use of the Copy method added to DGC.
 It will allow you to copy a region from one surface to another. Along with
 Copy is ClipCopy which has the same functionality but will clip the region
 to avoid bounds errors.

 If you know that you don't need to use clipping, use the plain Copy method,
 it should me faster since it doesn't need to do clipping calculations. But,
 if your copies are going to move off the edges of your main display surface,
 you should use ClipCopy.
}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DGCILib, DGC, DGCStar;

type
  TForm1 = class(TForm)
    DGCImageLib1: TDGCImageLib;
    DGCScreen1: TDGCScreen;
    DGCStarField1: TDGCStarField;
    procedure FormCreate(Sender: TObject);
    procedure DGCScreen1Flip(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure DGCScreen1Initialize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  //This array will hold the x position of a character in a bitmap. Since we
  //will know the height & width, that info is not needed. Using this type of
  //array/table, you can plug in characters as you need, and re-assign the ones
  //that you won't be using to SPACE or special drawn characters...
  //The array is loaded at creation so that we don't have to use a loop to load
  //in the values. This array is global so all functions can use it.
  //NOTE: Anything with 0 will be spaced

  CharXPos : Array[0..255] of Word = (
  //000-015 -- Nothing Printable (Normally), custom chars???
    0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,
  //016-031 -- Nothing Printable (Normally), custom chars???
    0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,
  //032-047 --
  //SPC  !    "    #    $    %    &    '    (    )    *    +    ,    -    .    /
    0000,0352,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,
  //048-063
  //0    1    2    3    4    5    6    7    8    9    :    ;    <    =    >    ?
    0032,0064,0096,0128,0160,0192,0224,0256,0288,0320,0000,0000,0000,0000,0000,0000,
  //064-079
  //@    A    B    C    D    E    F    G    H    I    J    K    L    M    N    O
    0000,0384,0416,0448,0480,0512,0544,0576,0608,0640,0672,0704,0736,0768,0800,0832,
  //080-095
  //P    Q    R    S    T    U    V    W    X    Y    Z    [    \    ]    ^    _
    0864,0896,0928,0960,0992,1024,1056,1088,1120,1152,1184,0000,0000,0000,0000,0000,
  //096-111 -- repeats of CAPITAL letters
  //`    a    b    c    d    e    f    g    h    i    j    k    l    m    n    o
    0000,0384,0416,0448,0480,0512,0544,0576,0608,0640,0672,0704,0736,0768,0800,0832,
  //112-127
  //p    q    r    s    t    u    v    w    x    y    z    {    |    }    ~
    0864,0896,0928,0960,0992,1024,1056,1088,1120,1152,1184,0000,0000,0000,0000,0000,
  //128-143
    0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,
  //144-159
    0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,
  //160-175
    0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,
  //176-191
    0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,
  //192-207
    0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,
  //208-223
    0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,
  //224-239
    0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,
  //240-255
    0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000);

  //Yep, you guessed it. The text for the scrolly... Make sure the Array size is
  //at least the same size as your message... But that was a given though.
  Text1 : Array[0..670] of Char =
     '#This is an example of the BltFast function. This will ' +
     'allow you to copy a region from one surface to another.  Along with '  +
     'BltFast is the BltClip method which allows for clipping on a copy '    +
     '   %This little demo was coded in about 30 '+
     'minutes to show you how easy DGC is to use.      #DGC !1997 '+
     'John Pullen  Paul Bearne %and  Jeff$Kurtz     %   The text speed changing '+
     'is on purpose       The bars at the top and bottom are examples of the ' +
     'new color cycling function added to dgc beta5        Did you '+
     'notice that you can now have horizontal and $vertical starfields        ';

  Length1  : Integer;                   //Number of characters in the message
  XPos     : Integer;                   //The scroll position
  CPos     : Integer;                   //Current character in the array
  TextSfc  : TDGCSurface;               //A special surface to build the message on
  XInc     : Integer;                   //Scroll Speed control
  YSin     : Array[0..359] of Integer;  //Hold Sin values for the Y movement
  YPos     : Integer;                   //Holds Y position in array
  LogoX    : Integer;
implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Length1 := Length(Text1);             //Get length of message
  CPos := -1;                           //Set first character position
  XPos := 31;                           //Set scrolling offset
  XInc := 4;                            //Set default speed
end;

procedure TForm1.DGCScreen1Flip(Sender: TObject);
var
  Loop : Integer;
begin
  DGCStarfield1.Update;                 //Draw the stars
  DGCScreen1.Back.Draw(0,000,DGCScreen1.Images[2],False);
  DGCScreen1.back.Draw(0,003,DGCScreen1.Images[3],False);
  DGCScreen1.Back.Draw(0,195,DGCScreen1.Images[3],False);
  DGCScreen1.Back.Draw(0,198,DGCScreen1.Images[2],False);
  //Since the font we are using is 32 pixels wide, we want to paste a new
  //blit at the right end of the surface where we are building the message
  Dec(XPos,XInc);            //Decrease counter
  If XPos < 0 then           //If it's less than 0, it's time for a new char
    begin
      //Increase the character counter
      Inc (CPos,1);
      //If it's past the last character, reset it to the first
      If CPos > Length1 then CPos := 0;
      //First, take what we have on the message surface and move it left 32 pixels
      TextSfc.BltFast(0,0,TextSfc,Rect(32,0,352,40),False);
      //Now, paste the new character on the right edge
      TextSfc.BltFast(320,0,DGCScreen1.Images[0],
              Rect(CharXPos[Integer(Text1[CPos])],0,
                   CharXPos[Integer(Text1[CPos])]+32,40),False);
      //Reset the scroll counter
      XPos:=31;
      //These handle special characters. I have them set up for different speeds
      If Text1[CPos] = '#' then begin
         XInc := 4;
         DGCStarField1.StarMode := Horizontal;
         DGCStarField1.Towards  := True;
         DGCStarField1.Velocity := 1;
      end;
      If Text1[CPos] = '$' then begin
         XInc := 1;
         DGCStarField1.StarMode := Vertical;
         DGCStarField1.Towards  := False;
         DGCStarField1.Velocity := 1;
      end;
      if Text1[CPos] = '%' then begin
         XInc := 8;
         DGCStarField1.StarMode := Horizontal;
         DGCStarField1.Towards  := False;
         DGCStarField1.Velocity := 1;
      end;
    end;

  Inc(YPos,4); //Increase Y position in YSin array
  If YPos > 359 then Dec(YPos,360);
  Inc(LogoX,8);
  If LogoX >359 then Dec(LogoX,360);

  //Take the message surface and draw it to our display... The first param is the
  //X position to draw the surface at. Since our character size is 32, we draw
  //the message surface 32 times, each frame, moving it to the left one pixel.
  //NOTE: XInc controls the number of pixels to move in one step. To make things
  //      a lot easier, only use values that can divide in 32 evenly to avoid
  //      jitters. To see what I mean, change one of the XInc speeds to an odd
  //      amount (or even but not divisable into 32) and watch the jumping.

  DGCScreen1.back.Draw(42+YSin[LogoX],6,DGCScreen1.Images[1],True);
  DGCScreen1.back.draw(XPos-32,117 + YSin[YPos],TextSfc,True);
  //One more note... We are using Transparent set to true so that the background
  //will show through... When you create a surface yourself, you must set the
  //transparent color or this call will cause an exception.
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  If Key = #27 then Close; //Escape key = quit
end;

procedure TForm1.DGCScreen1Initialize(Sender: TObject);
var
   WorkPal : Array[0..4] of TPaletteEntry;    //Hold palette colors
   Loop : Integer;
begin
  //This will create the surface that we will use to build the text. It doesn't
  //need to be huge, just one character (32 pixels) wider than the screen and the
  //same height as the character (40 pixels)
  DGCScreen1.CreateSurface(TextSfc,352,40);
  //We MUST set the transparent color or else all transparent copies from this
  //surface will fail
  TextSfc.TransparentColor := 0;
  //Create the starfields
  DGCStarfield1.Generate;
  //A simple loop to assign sequential colors to the stars.
  For Loop := 0 to 4 do
  begin
    WorkPal[Loop].peRed   := 95 + (Loop * 40);
    WorkPal[Loop].peGreen := 95 + (Loop * 40);
    WorkPal[Loop].peBlue  := 95 + (Loop * 40);
  end;
  //Now, set the colors
  DGCScreen1.Palette.SetEntries(0,240,5,@WorkPal);
  //Load the Y Sin array with values
  For Loop := 0 to 359 do
      YSin[Loop] := Round(Sin(Loop *(Pi/180))*35); //The *70 is the size of the wave
  YPos := 0;  //Set starting Y point in array

  DGCScreen1.CyclePalette(245,252,1,4);
end;

end.