Más de 2,500 Juegos/CD1.iso/ZIPDAT/0828/0828.ZIP/MAIN.PAS

Pascal/Delphi Source File | 1998-03-09 | 5.5 KB | 234 lines

{Maggot - Remco de Korte - Soft Machine - 1998

Made with Delphi 1,  so it'll run in Win3.xx.
Look at the code, study it, ask questions about it, change it, but please:
don't steal.
You can also have a look at this code to see how to make a program into a
screensaver. Look at the projectsource and at the Saverout and Show/Hide
procedures in the mainscreen-code. That's all.

Have fun!

Mail me at [e-mail]}

unit Main;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls;

type
  Tmainscreen = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    pic1: TImage;
    pic: TImage;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    procedure saverout(var Msg:TMsg; var Handled:boolean);
    procedure capturedesktop;
  public
    { Public declarations }
  end;

var
  mainscreen: Tmainscreen;

implementation

{$R *.DFM}

const
  maxlength=100;
  maxnumber=256;

type
  mag_rec=record
    headx,heady:integer;
    tailx,taily:integer;
    bodyx,bodyy:array[1..maxlength] of integer;
    leng:integer; {length}
    dir:byte; {direction of movement:  1  2  3
                                       8  x  4
                                       7  6  5}
  end;
  mag_rec_ptr=^mag_rec;

var
  xc,yc:integer;
  xmax,ymax:integer;
  mag:array[1..maxnumber] of mag_rec_ptr;
  i,j,k,x,y:integer;
  crs:Tpoint;
  dc:hdc;
  tmp:tcanvas;
  desk:tbitmap;
  numb:integer;
  pw,ph:integer;

procedure Tmainscreen.saverout(var Msg : TMsg; var Handled : boolean);
var
  done : boolean;
begin
  if Msg.message = WM_MOUSEMOVE then
    done := (Abs(LOWORD(Msg.lParam) - crs.x) > 5) or
            (Abs(HIWORD(Msg.lParam) - crs.y) > 5)
  else
    done := (Msg.message = WM_KEYDOWN) or (Msg.message = WM_ACTIVATE) or
            (Msg.message = WM_ACTIVATEAPP) or (Msg.message = WM_NCACTIVATE);
  if done then
  begin
    releasedc(0,dc);
    Close;
  end;
end;

procedure Tmainscreen.capturedesktop;

begin
  mainscreen.hide;
  dc:=GetWindowDC(getdesktopwindow);
  tmp:=tcanvas.create;
  tmp.handle:=dc;
  canvas.copyrect(rect(100,100,200,200),tmp,rect(300,300,400,400));
  mainscreen.show;
end;

procedure Tmainscreen.FormCreate(Sender: TObject);

var
  i,j:integer;

begin
  randomize;
  xmax:=screen.width;
  ymax:=screen.height;
  width:=xmax;
  height:=ymax;
  left:=0;
  top:=0;
  xc:=xmax div 2;
  yc:=ymax div 2;

  for i:=1 to maxnumber do {initialize data}
  begin
    new(mag[i]);
    with mag[i]^ do
    begin
      headx:=xc;
      heady:=yc;
      leng:=5;
      for j:=1 to leng do
      begin
        bodyx[j]:=xc;
        bodyy[j]:=yc;
      end;
      tailx:=xc;
      taily:=yc;
      dir:=random(8)+1;
    end;
  end;
  dc:=getwindowdc(getdesktopwindow);
  tmp:=tcanvas.create;
  tmp.handle:=dc;
  desk:=tbitmap.create;
  desk.width:=xmax;
  desk.height:=ymax;
  desk.canvas.copyrect(rect(0,0,xmax,ymax),tmp,rect(0,0,xmax,ymax));
  numb:=64;
  pw:=pic.width;
  ph:=pic.height;
end;

procedure Tmainscreen.Timer1Timer(Sender: TObject);

begin
  for i:=1 to numb do
  with mag[i]^ do
  begin
    canvas.pixels[tailx,taily]:=pic.canvas.pixels[tailx mod pw,taily mod ph]; {wipes tail}
    canvas.pixels[tailx,taily+1]:=pic.canvas.pixels[tailx mod pw,(taily+1) mod ph]; {wipes tail}
    canvas.pixels[headx,heady+1]:=clGray;
    canvas.pixels[headx,heady]:=clSilver; {wipes head, makes it part of the body}
    {calculate new place of head}
    x:=headx;
    y:=heady;
    if dir in [1..3] then y:=y-1;
    if dir in [3..5] then x:=x+1;
    if dir in [5..7] then y:=y+1;
    if dir in [7,8,1] then x:=x-1;
  {check if it's valid}
    if x<0 then x:=0;
    if x>xmax then x:=xmax;
    if y<0 then y:=0;
    if y>ymax then y:=ymax;
    if (x<>headx) or (y<>heady) then {if not the maggot won't move}
    begin
      tailx:=bodyx[leng];
      taily:=bodyy[leng];
      for j:=leng downto 2 do
      begin
        bodyx[j]:=bodyx[j-1];
        bodyy[j]:=bodyy[j-1];
      end;
      bodyx[1]:=headx;
      bodyy[1]:=heady;
      headx:=x;
      heady:=y;
      if leng<100 then if random(500)=0 then
      begin
        inc(leng); {it grows}
        bodyx[leng]:=tailx;
        bodyy[leng]:=taily;
      end;
    end;
    canvas.pixels[headx,heady]:=clWhite;
    canvas.pixels[tailx,taily]:=clGray; {draw head and tail}
    {change direction}
    dir:=dir-1+random(3);
    if dir=0 then dir:=8;
    if dir=9 then dir:=1;
  end;
  if random(64)=0 then if numb<maxnumber then
  begin
    inc(numb);
    if numb=128 then {if random(1000)=0 then} pic.canvas.copyrect(rect(0,0,pw,ph),pic1.canvas,rect(0,0,pw,ph));
    label2.caption:=inttostr(numb);
  end;
end;

procedure Tmainscreen.FormClick(Sender: TObject);
begin
  application.terminate;
end;

procedure Tmainscreen.FormShow(Sender: TObject);
begin
  GetCursorPos(crs);
  Application.OnMessage:=SAverout;
  showcursor(false);
end;

procedure Tmainscreen.FormHide(Sender: TObject);
begin
  application.OnMessage:=nil;
  timer1.enabled:=false;
  showcursor(true);
end;

procedure Tmainscreen.FormPaint(Sender: TObject);
begin
  canvas.draw(0,0,desk);
end;

end.