Einzelnen Beitrag anzeigen

Benutzerbild von vsilverlord
vsilverlord

Registriert seit: 7. Jan 2008
Ort: Baden Württemberg- Hohenlohekreis
174 Beiträge
 
RAD-Studio 2009 Arc
 
#1

Matrixshow, bitte testen und vorschläge machen

  Alt 5. Jun 2008, 13:38
Hallo und guten Tag, dieses Programm dient eigentlich nur dazu, meinen informatiklehrer zu erschrecken. Ich muss morgen ein Projekt abgeben und ich hab keine Lust irgendein billig- Ampel Programm zu machen, davon hab ich schon genug. Deswegen hab ich mir hier was kreatives ausgedacht, es soll so aussehen wie die Matrix und der Computer soll sprechen, lauter Sachen zum beeindrucken eben. (bitte erschißt mich nicht, ich wusste nichts besseres);
wenn ihr noch mehr knalleffekte habt dann könnt ihr mir das gerne sagen.
Achtung:
Das Programm übermalt den Bildschirm, man kann 20 sekunden nichts machen. danach geht wieder alles ganz normal.
screenshot konnte ich leider nicht machen weil sich alles bewegt.

Auf Wunsch Sourcecode:
Delphi-Quellcode:
unit lostunit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,ComObj;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    function point(x,y:integer):tpoint;
    function add(x,y:tpoint):tpoint;
    function randomstring(length:integer):string;
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  setpoint:tpoint;
  thestring: string;
  Mitleid:integer=0;

implementation

{$R *.dfm}

function tform1.randomstring(length:integer):string;
var
i,z:integer;
a:string;
begin
i:=1;
while i <= length do
begin
randomize;
z:=random(50);
a:=chr(z+50);
result:=result+a;
inc(i);
end
end;
function tform1.add(x,y:tpoint):tpoint;
begin
result.X:=x.X+y.x;
result.Y:=x.Y+y.Y
end;
function tform1.point(x,y:integer):tpoint;
begin
result.X:=x;
result.Y:=y;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
  DesktopDC: HDC;
  DesktopCanvas: TControlCanvas;
  i:integer;
  oleVoice: OLEVariant;
begin
  oleVoice := CreateOLEObject('SAPI.SpVoice');
  DesktopDC := GetDC(0);
  if DesktopDC = 0 then
  begin
    //Hier Fehlerbehandlung einfügen
  end
  else
  try
    DesktopCanvas := TControlCanvas.Create;
    try
      DesktopCanvas.Handle := DesktopDC;
      desktopcanvas.Font.Size:=10;
      For i:=0 to 100 do
      begin
      if setpoint.y<=2000 then
      begin
      setpoint:=add(point(0,random(100)+50),setpoint);
      end
      else if setpoint.x <= 2000 then
      begin
      setpoint:=point(setpoint.Y+15+random(20),0)
      end
      else if setpoint.x > 2000 then
      begin
      setpoint:=point(0,0);
      end;
      //Hier Zeichnen, z. B.
      DesktopCanvas.Font.Color:=clgreen;
      desktopcanvas.Brush.Color:=clblack;
      thestring:=randomstring(10);
      DesktopCanvas.TextOut(setpoint.X,setpoint.Y,thestring);
      end;
      desktopcanvas.Font.Size:=55;
      DesktopCanvas.Font.Color:=clred;
      desktopcanvas.TextOut(0,500,'WYRM OWNED YOU // '+inttostr(2000-mitleid)+' SECONDd LEFT');
    finally
      DesktopCanvas.Free;
    end;
  finally
    ReleaseDC(0, DesktopDC);
    inc(mitleid);
    case mitleid of
    100: oleVoice.Speak('Hi', 0);
    200: oleVoice.Speak('Noob', 0);
    300 : oleVoice.Speak('Nerd', 0);
    400 : oleVoice.Speak('I am the Computer', 0);
    500 : oleVoice.Speak('Hihihi', 0);
    600 : oleVoice.Speak('Huuhuhu', 0);
    700 : oleVoice.Speak('mimimi', 0);
    800 : oleVoice.Speak('noob noob noob', 0);
    900 : oleVoice.Speak('enter the matrix', 0);
    1000 : oleVoice.Speak('Delphi is good', 0);
    1100 : oleVoice.Speak('Well', 0);
    1200: oleVoice.Speak('Halftime', 0);
    1300 : oleVoice.Speak('John F. Kennedy', 0);
    1400: oleVoice.Speak('Barrack Obama', 0);
    1500: oleVoice.Speak('Bush sucks', 0);
    1600 : oleVoice.Speak('Terry Goodkind', 0);
    1700 : oleVoice.Speak('Life for Sake', 0);
    1800: oleVoice.Speak('This is War', 0);
    1900 : oleVoice.Speak('Rockn Roll', 0);
    2000 : oleVoice.Speak('So much for today', 0);
    end;
    if mitleid >= 2000 then
      begin
      timer1.Enabled:=false;
      form1.Close
      end;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
  DesktopDC: HDC;
  DesktopCanvas: TControlCanvas;
begin
  DesktopDC := GetDC(0);
  if DesktopDC = 0 then
  begin
    //Hier Fehlerbehandlung einfügen
  end
  else
  try
    DesktopCanvas := TControlCanvas.Create;
    try
      DesktopCanvas.Handle := DesktopDC;
      desktopcanvas.Pen.Color:=clwhite;
      DesktopCanvas.Rectangle(0,0,2000,2000);
      DesktopCanvas.Brush.Color:=clblack;
     DesktopCanvas.FloodFill(2,2,clblack,fsborder);
    finally
      DesktopCanvas.Free;
    end;
  finally
    ReleaseDC(0, DesktopDC);
  end;
setpoint:=point(0,0)
end;

end.
Angehängte Dateien
Dateityp: exe lostproject_154.exe (394,0 KB, 73x aufgerufen)
Volker
~beware
Wizards First Rule:
People are stupid; given proper motivation, almost anyone will believe almost anything. Because people are stupid, they will believe a lie because they want to believe it’s true, or because they are afraid it might be true
  Mit Zitat antworten Zitat