Matrixshow, bitte testen und vorschläge machen

[vsilverlord]

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.

[chaosben]

Zum einen haben wir es hier gern, wenn man den Sourcecode bekommt und andererseits sollten da die Fehlermeldungen noch weg. Und es könnte etwas flüssiger laufen.

[MarcoWarm]

also das soll keineswegs ein Erschießen sein:
1. Der Informatiklehrer wird wohl nicht erschrecken, so leid es mir tut. Ein Bluescreen wäre da effektiver.
2. Der Ziel des Informatikunterrichtes ist es den Sinn für Algorithmen zu vermitteln, nicht eine Programmiersprache zu lernen oder Systembefehle möglichst effektiv zu nutzen (sowas kommt später)

Wenn du ne gute Note haben willst, dann liefer besser das Programm, daß der Lehrer will. Es sollte zeigen, daß du komplizierte Algorithmen in einem Programm darstellen kannst. Wenn du darüber hinaus deinen Lehrer beeindrucken willst dann versuchs doch mit einer OpenGL oder DirectX gerenderten Ampelkreuzung ;-)

Das Programm ist so schon nicht schlecht, aber, wie gesagt, verfehlt das Ziel der Aufgabenstellung denke ich.

Gruß
Marco

[vsilverlord]

ja das stimmt schon was du sagst, aber mir ist wirklich nichts besseres eingefallen, habt ihr vllt ideen? im Übrigen sind eigene Funktionen und Schleifen drin, mehr verlangt er nicht.
Ich hab auch Programme mit Open-Gl, aber er will auch den Code und das geht desshalb nicht, weil da ja Packages installiert werden müssen. Ich hab auch größere Programme mit vielen Variablen und Zeigern, aber der Leherer hatte keine Lust das durchzussehen. Er hat gesagt ich soll was kürzeres programmieren.

[MarcoWarm]

wie ist denn die Aufgabenstellung genau?

Wenn es nur um Schleifen geht, dann kannst du das allerdings auch abliefern. ich dachte es wäre was nützliches verlangt worden ;-)

[Mikescher]

Also Fehlermeldungen kamen bei mir keine
Aber ich hätte noch ein paar Tipps für dich:

• Mach das Label (oder was immer das in der Mitte auch ist) Transparent so dass man da wo keine Schrift ist die Zahlen sieht

• Mach den Ton abspielen nicht
  
  Delphi-Quellcode:

  playsound(baba.wav,0,SND_SYNC)

  sondern so:
  
  Delphi-Quellcode:

    PlaySound('baba.wav', 0,SND_ASYNC);

  oder wenn dus mit Resourcen machst so:
  
  Delphi-Quellcode:

  PlaySound('BaBaSound', 0, SND_RESOURCE or SND_ASYNC);

  So stopt/stottert er nicht dauernd :-D

• Und 3. beende das Prog irgenwie anders des is bei mir net gegange (musste überall mit der Maus rumfahren (Als ob Windows sich nicht Refreshen würde)) :-D

:arrow: :arrow: Aber sonst cooooles Proggi :thumb: (wenn auch der Sinn fehlt :gruebel: )

[vsilverlord]

@mikescher: danke für das feedback. Wie kann ich das SND_SYNC bei mir einfügen?
Der Sprachbefehl ist bei mir so:

Delphi-Quellcode:

oleVoice.Speak('Hi', 0);

[Mikescher]

Ou... Gute Frage
was ist denn das

Delphi-Quellcode:

oleVoice.Speak('Hi', 0);

für ein Befehl (Kenn ich gar net :oops: ) ??

Und die Unit MPlayer hast du die selbst geschrieben ???

[Mikescher]

Ach ja noch en' Tipp SourceCodes macht man meistens in den Anhang :-D
:arrow: Ist übersichtlicher

[vsilverlord]

Das m-player hab ich aus versehen drin vergessen, habs jetzt gelöscht.
das Olevoice.speak hab ich aus einem tutorial [cl]