leuke Delphi code

[rockyj]

Zijn er (simpele) grappige dingen te doen met de code???

[Dutchy15]

voor informatica?

[rockyj]

Dutchy15 schreef:
voor informatica?

Nee gewoon voor de lol

[Spacey]

even zoeken in google lijkt me

[Cai]

Keyboard LED bestuurder

Dit is iets wat ik al een half jaar geleden geschreven heb, niet spannend maar toendertijd wel leuk om mee te beginnen.

Alles wat geïmplementeerd moet worden kun je opmaken aan de includes en procedures.

De knoppen die erin staan is om te starten->stoppen->versnellen->vertragen->enz.

Doe ctrl+c ctrl+v en ga een beetje rommelen.


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus, ExtCtrls, ComCtrls;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Bestand1: TMenuItem;
Afsluiten1: TMenuItem;
Keyboard1: TMenuItem;
CrashKeyboard1: TMenuItem;
UndoCrash1: TMenuItem;
Info1: TMenuItem;
About1: TMenuItem;
Label1: TLabel;
Button5: TButton;
Timer1: TTimer;
StatusBar1: TStatusBar;
Button7: TButton;
Button8: TButton;
Button9: TButton;
Button10: TButton;
Button11: TButton;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
Timer2: TTimer;
procedure weergeven;
procedure updatestatusbar;
procedure loop;
procedure SetLED;
procedure Button1Click(Sender: TObject);
procedure Afsluiten1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure checkverander(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure CrashKeyboard1Click(Sender: TObject);
procedure UndoCrash1Click(Sender: TObject);


private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
led:byte;
rechts:boolean;
implementation

{$R *.DFM}

procedure TForm1.weergeven;
begin
with TCheckbox do
begin
case led of
0:begin
CheckBox1.checked:=false;
CheckBox2.checked:=false;
CheckBox3.checked:=false;
end;
1:begin
CheckBox1.checked:=false;
CheckBox2.checked:=false;
CheckBox3.checked:=true;
end;
2:begin
CheckBox1.checked:=true;
CheckBox2.checked:=false;
CheckBox3.checked:=false;
end;
3:begin
CheckBox1.checked:=true;
CheckBox2.checked:=false;
CheckBox3.checked:=true;
end;
4:begin
CheckBox1.checked:=false;
CheckBox2.checked:=true;
CheckBox3.checked:=false;
end;
5:begin
CheckBox1.checked:=false;
CheckBox2.checked:=true;
CheckBox3.checked:=true;
end;
6:begin
CheckBox1.checked:=true;
CheckBox2.checked:=true;
CheckBox3.checked:=false;
end;
7:begin
CheckBox1.checked:=true;
CheckBox2.checked:=true;
CheckBox3.checked:=true;
end;
end;
end;
end;
Procedure Tform1.SetLED; Assembler;
ASM
MOV AL, $ED
OUT $60, AL
MOV CX, $200
@@1:
//LOOP @@1
MOV AL, LED
OUT $60, AL
End;

procedure Tform1.loop;
begin

if rechts then
begin
led:=led shl 1;
if led=8 then led:=1;
end
else
begin
led:=led shr 1;
if led=0 then led:=4;
end;

end;
procedure TForm1.Button1Click(Sender: TObject);
begin
timer1.enabled:=true;
loop;
end;

procedure TForm1.Afsluiten1Click(Sender: TObject);
begin
application.terminate;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
updatestatusbar;
setled;
weergeven;
loop;
end;

procedure TForm1.UpdateStatusBar;
begin
with statusbar1 do
begin
panels[0].text:='Vertraging: '+inttostr(Timer1.Interval);

end;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
Timer1.interval:=Timer1.Interval+10;
end;

procedure TForm1.Button10Click(Sender: TObject);
begin

Timer1.enabled:=false;
led:=1;
statusbar1.panels[0].text:='Gestopt!!!';
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
Timer1.Interval:=Timer1.Interval-10;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
rechts:=false;
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
rechts:=true;
end;


procedure TForm1.checkverander(Sender: TObject);
begin
with TCheckbox do
begin
if ((CheckBox1.checked=false)and(CheckBox2.checked=false)and(CheckBox3.ch ecked=false)) then
led:=0;
if ((CheckBox1.checked=false)and(CheckBox2.checked=false)and(CheckBox3.ch ecked=true)) then
led:=1;
if ((CheckBox1.checked=true)and(CheckBox2.checked=false)and(CheckBox3.che cked=false)) then
led:=2;
if ((CheckBox1.checked=true)and(CheckBox2.checked=false)and(CheckBox3.che cked=true)) then
led:=3;
if ((CheckBox1.checked=false)and(CheckBox2.checked=true)and(CheckBox3.che cked=false)) then
led:=4;
if ((CheckBox1.checked=false)and(CheckBox2.checked=true)and(CheckBox3.che cked=true)) then
led:=5;
if ((CheckBox1.checked=true)and(CheckBox2.checked=true)and(CheckBox3.chec ked=false)) then
led:=6;
if ((CheckBox1.checked=true)and(CheckBox2.checked=true)and(CheckBox3.chec ked=true)) then
led:=7;
end;

setled;
weergeven;

end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
StatusBar1.panels[1].text:='Tijd: '+timetostr(Time);
end;

procedure TForm1.CrashKeyboard1Click(Sender: TObject);assembler;
begin
ASM
MOV AL, $ED
OUT $60, AL
end;
end;

procedure TForm1.UndoCrash1Click(Sender: TObject);assembler;
begin
ASM
MOV AL, $ED
OUT $60, AL
MOV CX, $200
@@1:
//LOOP @@1
MOV AL, LED
OUT $60, AL
end;
end;


end.

[Cai]

Helaas zijn de tabs om een of andere reden weggevallen zodat het onduidelijk(er) is geworden. Mijn excuses hiervoor

[durex]

heb je het maar tussen moeten zetten

[1024]

Eigenlijk heb ik geen grapige code (/me progt alleen serieus...),

maar wist je dat je met het standaard component TMediaPlayer (<- zeer oud) ook MP3's kan afspelen ? Het staat nergens beschreven (help/object inspector) maar toch kan het!

Hier onder een stukje van het begin van me mp3 spelertje:

// mp3player is dus de TMediaPlayer

unit Hoofdform;


interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, ImgList, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Mp3Naam: TPanel;
    ImageList1: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    Label1: TLabel;
    PlayLijst: TListView;
    ToolButton6: TToolButton;
    mp3player: TMediaPlayer;
    procedure ToolButton2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ToolButton2Click(Sender: TObject);
begin
  mp3player.Close;
  mp3player.FileName := 'E:\MultiMedia\mp3\Alanis Morissette\UNDER RUG SWEPT TOUR\Alanis Morissette - Sister Blister (MWB).mp3';
  mp3player.Open;
end;

end.

[Dit bericht is aangepast door 1024 (17-12-2001).]