📄 unit1.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 + -