AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Projekte Matrixshow, bitte testen und vorschläge machen
Thema durchsuchen
Ansicht
Themen-Optionen

Matrixshow, bitte testen und vorschläge machen

Ein Thema von vsilverlord · begonnen am 5. Jun 2008 · letzter Beitrag vom 6. Jun 2008
 
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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 17:59 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz