Pascal: Speichern, wie lange ein Key gedrückt wurde

[pape]

Ist es in Pascal möglich zu speichern, wie lange ein Key gedrückt wurde?
repeat until not keypressed usw. hat alles net geklappt...

pape

 

[W-Stefan]

Also ich weiss jetzt nicht genau, bei was du das benutzt, aber ich habs jetzt mal für ein Memo geschrieben. Du könntest es auch in ein Editfeld, auf die Form selber oder wo anderst hin legen, vorrausgesetzt die Komponente besitzt die beiden Ereignisse "OnKeyDown" und "OnKeyUp".

Also, zuerst brauchst du zwei Variablen, eine vom Typ Longint und eine vom Typ Boolean. Die deklarierst du am besten unter "Private".

Dann der Code:

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if gedrueckt = False then   // "gedrueckt" ist meine Boolean-Variable
  begin
    start := GetTickCount;   // Die Windows-Laufzeit wird in meine Longint-Variable "start" eingelesen
    gedrueckt := True;     // "gedrueckt" wird auf "true" gesetzt, sonst würde start immer wieder neu eingelesen werden
  end;
end;

procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  gedrueckt := False;   // gedrueckt wird zurueckgesetzt
  ShowMessage(IntToStr(GetTickCount - start));  // Die gedrückte Zeit wird in Millisekunden angezeigt
end;

Hoffe es funktioniert so wie du es möchtest.

W-Stefan

 

[pape]

öhm...

Ist es in Pascal möglich

...nicht delphi!

ich brauche das für folgendes:

ich habe ein programm geschrieben, sodass man (in diesem) auf der Tastatur "Klavier-spielen" kann.. nun möchte ich, dass man speichern kann was man grade spielt...

dazu muss ich aber auch speichern wie lange ein Ton gedrückt wird...

...naja dabei gibt es übrigens auch noch nen problem...:
wenn man eine taste gedrück hält, dann wird das KeyDown event immerwieder ausgeführt... kann man das abstellen?, sodass es dann möglich ist einen Ton lange zu halten.. ich habe das probiert:
wenn eine taste gedrückt wird, dann wird eine procedure aufgerufen, in der der taste entsprechend eine fqz berechnet wird, die dann einen ton ergibt.. der ton wird dann mithilfe der errechneten fqz und sound(fqz); erzeugt!
jetzt soll der ton solange anhalten, bis die taste losgelssan wird..:

        sound(round(f));//f ist die berechnete fqz
        repeat until not keypressed;
        nosound;

aber das geht net...

grz
pape

 

[pape]

...komisch.. hätte gedacht auf so ner risen-seite ne antwort zu bekommen...

naja
pape

 

[zoku2020]

Mal schaun ^^
Wenn du einen Ton auslöst mit "sound" dann wird er so lange gespielt, bis "nosound" kommt oder ein anderer Ton wiedergegeben wird... Wenn der Sound in der Schleife ist, wird immer wieder ein neuer Ton ausgegeben

Zu deiner Frage weiß ich leider keine direkte Antwort, aber vielleicht hilft dir das hier weiter:

unit thetimer;
interface
Uses
  {crt,} DOS;

Var
  OldInt8 : Procedure;
  Milliseconds, gesamt: LongInt;
  i : integer;

  {Procedure NewInt8;}
  Procedure SetNewInt8;
  Procedure SetOldInt8;
  procedure timed(interval:integer);

implementation
  Procedure NewInt8; Interrupt;
    Begin
      Inline ($FA);{CLI}
      Inc (Milliseconds);
      Inc (gesamt);
      IF ((Milliseconds mod 55{1000 / 18.2}) = 0) THEN
        Begin
          Inline ($9C / $FB);{PUSHF, STI}
          OldInt8;
        End
      ELSE
        Begin
          Inline ($FB);{STI}
          Port[$20] := $20; {Interrupt-end signal}
        End;
    End;


  Procedure SetNewInt8;
    Begin
      GetIntVec ($08, @OldInt8);
      SetIntVec ($08, @NewInt8);
      ASM {Set Timer to 1000 Hz}
        cli
        mov dx, $43
        mov al, $36
        out dx, al
        sub dx, 3
        mov al, 169
        out dx, al
        mov al, 4
        out dx, al
        sti
      End;
    End;


  Procedure SetOldInt8;
    Begin
      ASM {Reset Timer to 18.2 Hz}
        cli
        mov dx, $43
        mov al, $36
        out dx, al
        sub dx, 3
        xor ax, ax
        out dx, al
        out dx, al
        sti
      End;
      SetIntVec ($08, @OldInt8);
    End;

procedure timed(interval:integer);
begin
    Milliseconds := 0;
    repeat
    until (Milliseconds = interval);
end;

Begin
  {for i := 1 to 50 do begin
  clrscr;
  write(i);                          {testprogramm}
  {timed(1000);
  end;}
End.

Diese Unit abe ich aus einem Programm mit einem Millisekunden-timer erstellt.
Der Befehl "timed(x);" unterbricht das Programm für x Millisekunden.

Vielleicht hilft dir das.

greetz zoku