Casova zavislost akci – Delphi – Fórum – Programujte.com

Ahoj vsem,

potrebuji radu. Delam testovaci aplikaci - polozim otazku a cekam na odpoved (stisknuti tlacitka) - pote zobrazim vysledek na 5 sekund a na ProgressBaru bude ubihat tento cas - tlacitka po tuto dobu budou neaktivni, pote opet polozim jinou otazku - a zde jsem se zasekl, nejde mi to provazat s casem. Jak to mam udelat, abych po peti sekundach znovu vyvolal akci?

Diky za radu, Milan

Použi na to Timer. Pastujem jednoduchý príkladik na otázky typu ANO / NIE.

Potrebuješ TTimer a ActionList s dvoma akciami ANO / NIE odkazujúce na ten istý EXECUTE ActionOdpovedExecute.

Timeru nastav OnTimer event: TimerTimer. Ten sa stará o to, že sleduje "časomieru", ktorá po štvrť sekunde sa refrešuje, keď progressbar pozícia dosiahne maximum, tak sa skočí na novú otázku.

unit UTFormJednodnoduchyTester;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, ActnList, ComCtrls, StdCtrls, Buttons;



resourcestring

  // ---------------------------------------------------------------------------

  sPretecenaOtazka      = 'Interná chyba: Otázky pretiekli!';



type

  // ---------------------------------------------------------------------------

  TFormJednodnoduchyTester = class(TForm)

    BitBtnAno: TBitBtn;

    BitBtnNie: TBitBtn;

    LabelOtazka: TLabel;

    LabelOdpoved: TLabel;

    ProgressBarCakajuciInterval: TProgressBar;

    ActionList: TActionList;

    ActionAno: TAction;

    ActionNie: TAction;

    Timer: TTimer;



    procedure TimerTimer(Sender: TObject);

    procedure ActionOdpovedExecute(Sender: TObject);

  private

    FOtazka: Integer;           // Aktualna otazka

    FSpravnych: Integer;        // Kolko spravnych odpovedi je zaznamenanych



    function DajVProgrese: Boolean;

    procedure NastavVProgrese(const Hodnota: Boolean);

    procedure NastavOtazku(const Hodnota: Integer);

  protected

    procedure ZacniTestovat;

    procedure CakazSOdpovedou;

    procedure ZacniOdpoved;

    procedure UkonciOdpoved;

    procedure DalsiaOtazka;

    procedure KoniecTestu;



    property VProgrese: Boolean read DajVProgrese write NastavVProgrese;

  public

    constructor Create(AOwner: TComponent); override;



    property Otazka: Integer read FOtazka write NastavOtazku;

  end; // TFormJednodnoduchyTester



var

  FormJednodnoduchyTester: TFormJednodnoduchyTester;



implementation



type

  // ---------------------------------------------------------------------------

  TOtazka = record

    Znenie: String;

    Odpoved: Boolean;

  end; // TOtazka



const

  // ---------------------------------------------------------------------------

  CAKAJ_MS      = 3000; // Cakaj milisekund

  OTAZKY        : Array[0..3] of TOtazka =

   ((Znenie: 'Volas sa Margita Figuli?';        Odpoved: False),

    (Znenie: 'Pochadzas zo Zeme';               Odpoved: True),

    (Znenie: 'Milujes pivo?';                   Odpoved: True),

    (Znenie: 'Neznasas Fica';                   Odpoved: True)

   ); // OTAZKY



{$R *.dfm}



// *****************************************************************************

// Zabezpeci refresovanie progressbaru

procedure TFormJednodnoduchyTester.TimerTimer(Sender: TObject);

begin

  CakazSOdpovedou;

end;



// *****************************************************************************

procedure TFormJednodnoduchyTester.ActionOdpovedExecute(Sender: TObject);

var

  Tlacidlo: Boolean;

begin

  // Zistime, ci sa spravne odpovedalo a podla toho aj priradime farbu odpovede

  Tlacidlo := (Sender = ActionAno);                    // Na ktore tlacidlo sa kliklo?

  if Tlacidlo <> OTAZKY[FOtazka].Odpoved then

    LabelOdpoved.Font.Color := clRed

  else

  begin

    LabelOdpoved.Font.Color := clBlack;

    Inc(FSpravnych);    // Zapamatame si, ze bola spravna odpoved

  end; // ELSE



  // Spustime proces cakania so zobrazenim odpovede

  ActionAno.Enabled := False;

  ActionNie.Enabled := False;

  if OTAZKY[FOtazka].Odpoved then

    LabelOdpoved.Caption := 'ÁNO'

  else

    LabelOdpoved.Caption := 'NIE';

  ZacniOdpoved;

end;



// *****************************************************************************

function TFormJednodnoduchyTester.DajVProgrese: Boolean;

begin

  Result := Timer.Enabled;

end;



// *****************************************************************************

procedure TFormJednodnoduchyTester.NastavVProgrese(const Hodnota: Boolean);

begin

  Timer.Enabled := Hodnota;

end;



// *****************************************************************************

procedure TFormJednodnoduchyTester.NastavOtazku(const Hodnota: Integer);

begin

  if (Hodnota < Low(OTAZKY)) or (Hodnota> High(OTAZKY)) then

    raise Exception.CreateRes(@sPretecenaOtazka);

  FOtazka := Hodnota;

  LabelOtazka.Caption := OTAZKY[FOtazka].Znenie;

  LabelOdpoved.Caption := '';

  ActionAno.Enabled := True;

  ActionNie.Enabled := True;

end;



// *****************************************************************************

procedure TFormJednodnoduchyTester.ZacniTestovat;

begin

  Otazka := 0;          // Skoc na prvu otazku

  FSpravnych := 0;      // Zatial ziadna spravna odpoved

end;



// *****************************************************************************

procedure TFormJednodnoduchyTester.CakazSOdpovedou;

begin

  if (not VProgrese) then

    ZacniOdpoved

  else

  begin

    ProgressBarCakajuciInterval.Position := ProgressBarCakajuciInterval.Position + 1;

    if ProgressBarCakajuciInterval.Position = ProgressBarCakajuciInterval.Max then

      UkonciOdpoved;

  end; // IF

end;



// *****************************************************************************

procedure TFormJednodnoduchyTester.ZacniOdpoved;

const

  REFRESH       = 250;  // Refresh v milisekundach - cim menej tym plynulejsie ale zatazuje viac system

begin

  try // EXCEPT

    ProgressBarCakajuciInterval.Position := 0;

    ProgressBarCakajuciInterval.Max := CAKAJ_MS div REFRESH;

    Timer.Interval := REFRESH;

    VProgrese := True;

  except

    VProgrese := False;

  end; // EXCEPT

end;



// *****************************************************************************

procedure TFormJednodnoduchyTester.UkonciOdpoved;

begin

  VProgrese := False;

  ProgressBarCakajuciInterval.Position := 0;

  DalsiaOtazka;

end;



// *****************************************************************************

procedure TFormJednodnoduchyTester.DalsiaOtazka;

begin

  if FOtazka = High(OTAZKY) then

    KoniecTestu

  else

    Otazka := Otazka + 1;

end;



// *****************************************************************************

procedure TFormJednodnoduchyTester.KoniecTestu;

begin

  ShowMessage('Koniec testu!'#13#10 +

              'Správnych odpovedí: ' + IntToStr(FSpravnych) + #13#10 +

              'Všetkých otázok: ' + IntToStr(Length(OTAZKY)));

  Close;

end;



// *****************************************************************************

constructor TFormJednodnoduchyTester.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  Timer.Enabled := False;

  ZacniTestovat;

end;



end.