unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
BGRAVirtualScreen, BGRABitmap,BGRABitmapTypes,BGRATransform,BGRAGradientScanner,mmsystem;
type
TWaveScanner = class(TBGRAAffineBitmapTransform)
Time: integer;
function GetOffset({%H-}X, Y: Single): Single;
{ fast integer scanning (used by PutImage) }
procedure ScanMoveTo(X, Y: Integer); override;
{ slow floating point scanning }
function ScanAt(X, Y: Single): TBGRAPixel; override;
constructor Create(ASource: TBGRACustomBitmap; ARepeatX,ARepeatY: boolean);
end;
{ TForm1 }
TForm1 = class(TForm)
BGRAVirtualScreen1: TBGRAVirtualScreen;
Timer1: TTimer;
procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
txt_scanner: TWaveScanner;
procedure DrawNormalScroller;
function drawFontChar(charek: Char; x: Integer): Integer;
end;
var
Form1: TForm1;
bitmap_font,tx_scroll_bitmap,logo,dest_bitmap,copper,gridTop,gridBottom,ball : TBGRABitmap; // images
charek : char;
offset: Char;
charSet: String;
fonts_width, fonts_height,pos_y: Integer;
sx, tx, scroll_speed : Integer;
s_text : string = 'MEGABYTE INC. PROUDLY PRESENTS... LEADER BOARD DON"T HIT THE MOUSE BUTTONS YET, BUT TAKE A COMFORTABLE SEAT AND ENJOY OUR BREATHTAKING INTRO. IT WAS ABOUT TIME THAT SOMEONE STARTED TO USE THE POWERFUL CAPABILITIES OF THIS AWESOME MACHINE. ABOUT LEADER BOARD: YOU CAN PRESS THE SLASH KEY (/) TO RESTART THE GAME. FIRST OF ALL, HERE ARE THE ESSENTIAL GREETINGS TO ALL OUR FRIENDS: ADJ, BOB, THE GENERAL (THANKS FOR SENDING US THE ORIGINAL !), MIKE, CCL (HOW"S THE ARMY, ROB...?), INDY, HEADBANGER, ECA, JWO, THE AMIGAMASTERS, DR. F, RABBIT SYSTEMS, GAME WORLD, SOFTRUNNER, BYTEBREAKER AND ALL THE OWNERS OF A GENUINE N.T.S.C. AMIGA. THE STRANGE BACKGROUND SOUNDS WERE TAKEN FROM PART ONE OF J.M. JARRE"S ALBUM "ZOOLOOK" SPECIAL THANKS TO W.H.T.T. PRODUCTIONS FOR DEVELOPING THE SOUND SAMPLING DEVICES AND MIDI HARDWARE. IF YOU LOOK AT THE DISGUSTING TITLE SCREEN OF EA"S "ONE ON ONE", YOU MIGHT BELIEVE THAT SOFT SCROLLING ON THE AMIGA IS AS BAD AS IT IS ON "MSX"... HOWEVER, WE PROVE THAT IT IS ABSOLUTELY NO PROBLEM ! SORRY ATARI; IMITATING THE AMIGA BALL DEMO IS POSSIBLE, BUT CAN YOU PLAY DIGITIZED MUSIC, SCROLL TWO LINES OF TEXT, MOVE SEVERAL BITPLANES UP"N"DOWN, CYCLE COLORS AND DISPLAY ABOUT 80 COLORS SIMULTANEOUSLY AND ALL THIS NEARLY WITHOUT USING THE 68000...? BETTER LUCK NEXT TIME, OK ? BY THE WAY, THE LITTLE BALL IS NOT A SPRITE, BUT A BLITTER IMAGE (IF YOU DON"T KNOW WHAT THE BLITTER IS, YOU REALLY SHOULDN"T HAVE BOUGHT THIS MACHINE...!!??) A LITTLE UNIMPORTANT NOTE: I THINK I"M GOING TO DEGAUSS MY MONITOR TOMORROW. FINAL NOTE TO ALL AMIGA OWNERS: MEGABYTE INCORPORATED; YOUR CHOICE FOR HIGH LEVEL PROGRAMMING AND SECURITY CODE REMOVAL. ';
// grid
gr : single;
// ball
x,y : single;
cnt : single;
dx,dy : integer;
// copper;
cpy : single;
MyAudio_File: AnsiString;
WavStream : TMemoryStream;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
logo := TBGRABitmap.Create('mbilogo.png');
dest_bitmap := TBGRABitmap.Create(740,32);
bitmap_font := TBGRABitmap.Create('mbifnt.png');
copper := TBGRABitmap.Create('mbicopper.png');
gridTop := TBGRABitmap.Create('grid.png');
gridBottom := gridTop;
ball := TBGRABitmap.Create('ball.png');
fonts_width := 16;
fonts_height := 32;
sx := 680; // start scroll pos x right
charek :=' '; // void always !
offset := ' '; // the first char on s_text = ' ' = space
scroll_speed := 2;
pos_y := 0;
txt_scanner := TWaveScanner.Create(dest_bitmap,false,false);
txt_scanner.Translate(00,290); // scroll text
// grid
gr :=0;
// ball
x :=210;
y :=180;
dx :=1;
dy :=1;
cnt :=0;
// copper
cpy :=0;
// audio stream
MyAudio_File := 'mbi.wav';
WavStream := TMemoryStream.Create;
WavStream.LoadFromFile(MyAudio_File);
PlaySound(WavStream.Memory, 0, SND_LOOP or SND_NODEFAULT or SND_ASYNC or SND_MEMORY);
end;
procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
begin
DrawNormalScroller; // normal text scrolling
// Scroll bitmap font text
// bitmap.StretchPutImage(Rect(0,50,0+740,50+200),copper,dmSet); // Logo
//bitmap.StretchPutImage(Rect(-40,20,-40+780,20+240),logo,dmDrawWithTransparency); // Logo
bitmap.PutImage(0,Round(gr),gridTop,dmSet);
bitmap.PutImage(0,335-Round(gr),gridBottom,dmSet);
bitmap.PutImage(0,180-Round(cpy),copper,dmDrawWithTransparency); // copper
bitmap.PutImage(-55,100,logo,dmDrawWithTransparency); // Logo
bitmap.PutImage(Round(x),round(y-50* abs(sin(cnt))) ,ball,dmSet);
Bitmap.Fill(txt_scanner,dmLinearBlend);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
inc(txt_scanner.Time,1);
// grid
gr := gr -0.5;
if (gr<-23) then gr :=0;
// ball
cnt := cnt + 0.092;
x := x + dx;
y := y + dy;
if( x<210 ) or (x>620) then dx := -dx;
if( y<180 ) or (y>30) then dy := -dy;
// copper
cpy := cpy + 0.5;
if(cpy>36) then cpy :=0;
BGRAVirtualScreen1.RedrawBitmap;
end;
function TForm1.drawFontChar(charek: Char; x: Integer): Integer;
var
p, cx, cy, l, r: Integer;
begin
if (x > width) and (x > 0) then
begin
Result := 0;
Exit;
end;
// 16x16
p := Ord(charek) ;
r := (p - Ord(offset)) div (bitmap_font.Width div fonts_width); // nb char 40*8
cx := (p - Ord(offset) -r * (bitmap_font.Width div fonts_width) ) * fonts_width; // dans ce cas là * 40
cy := 0 + (r * fonts_height); // 0
// 8x8
//p := Ord(charek);
//cx := (p - Ord(offset) ) * fonts_width;
//cy := 0; // 0
for l := 0 to fonts_width-1 do
begin
if (cx >= 0) and (x + l <= width) then
begin
dest_bitmap.PutImagePart(x + l , pos_y , bitmap_font, Rect(cx + l, cy, cx + l + 1, cy + fonts_height), dmSet);
end;
end;
Result := 1;
end;
procedure TForm1.DrawNormalScroller;
var
last_char: Char;
x, i: Integer;
koda: Char;
xLimit: Integer;
begin
dec(sx, scroll_speed);
x := sx;
xLimit := width + fonts_width;
for i := 1 to Length(s_text) do
begin
koda := s_text[i];
x := x + fonts_width;
if (x > -fonts_width) and (x < xLimit) then
begin
if drawFontChar(koda, x) = 0 then
Break;
last_char := koda;
end;
end;
if x < 0 then sx := xLimit;
end;
{ TWaveScanner }
function TWaveScanner.GetOffset(X, Y: Single): Single;
begin
result := 0 * sin((Y + Time) * 30/6 * PI / 180); // no sinus * 0
end;
procedure TWaveScanner.ScanMoveTo(X, Y: Integer);
begin
inherited ScanMoveTo(X + round(GetOffset(X, Y)), Y);
end;
function TWaveScanner.ScanAt(X, Y: Single): TBGRAPixel;
begin
Result:=inherited ScanAt(X + GetOffset(X, Y), Y);
end;
constructor TWaveScanner.Create(ASource: TBGRACustomBitmap;
ARepeatX,ARepeatY: boolean);
begin
inherited Create(ASource, ARepeatX, ARepeatY);
Time := 0;
end;
end.
// internal usage nothing was destroyed after Exit !!!
Recent
