⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 Directx游戏制作开发包DGCBETA6
💻 PAS
字号:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Screen1: TDGCScreen;
    Stars: TDGCStarField;
    procedure Screen1Initialize(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure Screen1Flip(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ViewText : Boolean;

implementation

{$R *.DFM}

procedure TForm1.Screen1Initialize(Sender: TObject);
var
   Pal : Array[0..4] of TPaletteEntry;
   Loop : Integer;
begin
   For Loop := 0 to 4 do
   begin
     Pal[Loop].peRed   := 95 + (Loop * 40);
     Pal[Loop].peGreen := 95 + (Loop * 40);
     Pal[Loop].peBlue  := 95 + (Loop * 40);
   end;
   Screen1.Palette.SetEntries(0,240,5,@Pal);
   Stars.Generate;
   With Screen1.Back.Canvas do
   begin
        Font.Color := clRed;
        Release;
   end;
   ViewText := True;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
     If Key = #27 then Close;
     If Key = '-' then Stars.NumberOfStars := Stars.NumberOfStars - 100;
     if Key = '+' then Stars.NumberOfStars := Stars.NumberOfStars + 100;
     If Stars.NumberofStars > 10000 then Stars.NumberOfStars := 10000;
     If Stars.NumberOfStars < 100 then Stars.NumberOfStars := 100;
     If key = '1' then
     begin
        Stars.Colored  := False;
        Stars.Flashing := False;
     end;
     If Key = '2' then Stars.Colored := True;
     If Key = '3' then
     begin
        Stars.Colored := False;
        Stars.Flashing := True;
     end;
     If Key = #32 then ViewText := Not ViewText;
     If Key = '<' then Stars.Velocity := Stars.Velocity -1;
     If Key = '>' then Stars.Velocity := Stars.Velocity +1;
     If Stars.Velocity > 20 then Stars.Velocity := 20;
     If Stars.Velocity < 0 then Stars.Velocity := 0;
end;

procedure TForm1.Screen1Flip(Sender: TObject);
begin
     Stars.Update;
     If ViewText then With Screen1.Back.Canvas do
     begin
        TextOut(10, 10,'+/- Stars :'+IntToStr(Stars.NumberOfStars));
        TextOut(10, 23,'</> Velocity :'+IntToStr(Stars.Velocity));
        TextOut(10, 36,'1 Normal');
        TextOut(10, 49,'2 Colored');
        TextOut(10, 62,'3 Flashing');
        TextOut(10, 75,'space toggle text');
//        TextOut(10, 88,'PIT:' + Format('%d',[Screen1.Back.WidthBytes]));
        release;
     end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -