Tisknout stránku - Delphi

FreePascal (FPC) a Lazarus => Obecné => Téma založeno: Radekzatec 20-01-2018, 20:12:28

Název: Delphi - Label a jiné
Přispěvatel: Radekzatec 20-01-2018, 20:12:28

Tak jsem tu znova tentokrát programuji Kolotoč (dle televizního pořadu).

Potřebuji pomoci, Při nahrazování znaků v komponentě label mi nejde vše jak bych chtěl.
Do labelu nahraji libovolnou frázi, kterou potřebuji převést na "_" (podtržítko), při uhádnutí se podtržítko přepíše na původní znak.
Mezery, čárky, tečky, pomlčky, otazníky a další obdobné znaky se ve frázi nesmí nahradit podtržítkem.

Příklad:
Únor bílý, pole sílí.
_ _ _ _ _ _ _ _, _ _ _ _ _ _ _ _.

Stávající kód nefunguje jak má, mezery, nesedí a zástupné znaky "_" se při nahrazení posouvají doprava.

Dále se mi nedaří ošetřit, abych po bankrotu nehádal, ale musel znova točit.

No a kdyby někdo poradil jak nejjednodušeji udělat, zadané písmeno v edit odpovídá malému i velkému písmenu a u samohlásek (a,e,i,o,u,y) i dlouhým.

Kód: [Vybrat]

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids;

type
  TForm1 = class(TForm)
    BtnEnd: TButton;
    BtnHrat: TButton;
    LVCastka: TLabel;
    LHFraze: TLabel;
    BtnHledej: TButton;
    Edit1: TEdit;
    LVyhra: TLabel;
    LFraze: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    procedure BtnEndClick(Sender: TObject);
    procedure BtnHratClick(Sender: TObject);
    procedure BtnHledejClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);

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

var
  Form1: TForm1;
    Castka: Integer;
    Fraz: string;
    Pocet: Integer;
    Vyhra: Integer;
    Skryte: string;

implementation

{$R *.dfm}
//=============================
// Vyber fraze (pranostiky)
//=============================

procedure Fraze;
  var
    f: integer;  // f jako Fraze
  begin
    Randomize;
    f := random(11); // Nahodne cislo od 0 do 10
    if f = 0 then Fraz := 'Na svatého Jeronýma stěhuje se k nám už zima.';
    if f = 1 then Fraz := 'Jak na Nový rok, tak po celý rok.';
    if f = 2 then Fraz := 'Na Tři krále mrzne stále.';
    if f = 3 then Fraz := 'Únor bílý, pole sílí.';
    if f = 4 then Fraz := 'Na Hromnice o hodinu více.';
    if f = 5 then Fraz := 'Svatý Matěj ledy láme, nemá-li je, nadělá je.';
    if f = 6 then Fraz := 'Březen, za kamna vlezem. Duben, ještě tam budem.';
    if f = 7 then Fraz := 'Kdo se v máji ožení, přivodí si soužení.';
    if f = 8 then Fraz := 'O Petru-li prší, po třicet dní déšť se vrší.';
    if f = 9 then Fraz := 'Svatá Markyta hodila srp do žita.';
    if f = 10 then  Fraz := 'Do svatého Vavřince nechval pšenice.';
  end;

//=============================
// Tlacitko Hrat
//=============================

procedure TForm1.BtnHratClick(Sender: TObject);
 var
    c: integer;  // c jako castka

  begin
    Randomize;
    c := random(11); // Nahodne cislo od 0 do 10
    if (c = 0) then Castka := 100;
    if (c = 1) then Castka := 100;
    if (c = 2) then Castka := 100;
    if (c = 3) then Castka := 100;
    if (c = 4) then Castka := 200;
    if (c = 5) then Castka := 200;
    if (c = 6) then Castka := 200;
    if (c = 7) then Castka := 500;
    if (c = 8) then Castka := 500;
    if (c = 9) then Castka := 1000;
    if (c = 10) then Castka := -1;
    if Castka > 0 then
      LVCastka.Caption := ((IntToStr(Castka)) + ',- kč')
    else
      LVCastka.Caption := ('BANKROT!!!');
      Pocet := 0;
    if Castka = 0 then Vyhra := 0;
       BtnHrat.Enabled := False;
       Edit1.Clear;
       BtnHledej.Enabled := True;
  end;

//=============================
// Tlacitko Hledej
//=============================

procedure TForm1.BtnHledejClick(Sender: TObject);
  var
    i: integer;
    Pismeno: string;
  begin
    Pocet := 0;
    Pismeno := Edit1.Text;
      for i := 0 to length(Fraz) do
        begin
          if Pismeno = Fraz[i] then
            begin
              Skryte[i] := Fraz[i];
              Pocet := Pocet + 1;
            end;
        end;

      if Fraz = skryte then LVCastka.Caption := 'Výhra';
        LFraze.Caption := skryte;
        BtnHrat.Enabled := true;
        BtnHledej.Enabled := false;
        Vyhra := (Castka * Pocet) + Vyhra;
        Lvyhra.Caption := IntToStr(Vyhra) + ',- kč';
  end;

//=============================
// Vytvoreni formulare
//=============================

procedure TForm1.FormCreate(Sender: TObject);
    i: integer;
begin
  Fraze;
  LHFraze.Caption := Fraz;
  BtnHrat.Enabled := true;
  BtnHledej.Enabled := false;
  Vyhra := 0;
  Skryte := '';
  for i := 0 to Length(Fraz) do
    begin
        if Fraz[i] = '.' then   skryte := skryte + '.'
        else if Fraz[i] = ',' then   skryte := skryte + ','
        else if Fraz[i] = ' ' then   skryte := skryte + ' '
        else
        skryte := skryte + '_ ';
        LFraze.Caption := skryte;
    end;
end;

//=============================
// Tlacitko Konec
//=============================

procedure TForm1.BtnEndClick(Sender: TObject);
  begin
    Close;
  end;

end.

Mám to do školy a nejsem programátor a ani jím býti nechci ale splnit to musím.

Název: Re:Delphi - Label a jiné
Přispěvatel: 98719 20-01-2018, 21:30:54

Znaky se nikam neposouvaji. Tys je "posunul" sam na tomto radku extra mezerou (a pri nahrazovani pismen ty extra mezery ignorujes):

Kód: Delphi [Vybrat]

skryte := skryte + '_ ';

A pak, string je indexovan od 1, ne od 0 (0 based je jen za urcitych podminek). Ohledne porovnani bez hacku a carek, muzes zkusit touto funkci (https://stackoverflow.com/a/1892432) zkonvertovat originalni frazi a pismena porovnavat treba case insensitive funkci SameText.

Název: Re:Delphi - Label a jiné
Přispěvatel: Radekzatec 21-01-2018, 02:34:08

Děkuji za radu,
kromě funkce porovnávaní znaku mam hotovo.
Nově upravený kód přikládám - určitě znáte lepší řešení ale na začátečníka si myslím, že je to dobré.

Současně se zeptám jak udělat aby label (LVCastka) v proceduře (BtnHratClick) rotoval.
Vysvětlení: Měl by se cca po 1 sekundě měnit, třeba 7x pak by se zastavil a ta částka by se teprve akceptovala.
Zkoušel jsem to takto se sleep jenže ten to zaseká a efekt nenastane.

Kód: [Vybrat]

procedure TForm1.BtnHratClick(Sender: TObject);
 var
    i, c: integer;  // c jako castka
  begin
    for i := 0 to 7 do
      begin
        Sleep(1000);
        Randomize;
        c := Random(11); // Nahodne cislo od 0 do 10
        if (c = 0) then Castka := 100;
        if (c = 1) then Castka := 100;
        if (c = 2) then Castka := 100;
        if (c = 3) then Castka := 100;
        if (c = 4) then Castka := 200;
        if (c = 5) then Castka := 200;
        if (c = 6) then Castka := 200;
        if (c = 7) then Castka := 500;
        if (c = 8) then Castka := 500;
        if (c = 9) then Castka := 1000;
        if (c = 10) then Castka := 0;
        if Castka > 0 then
           LVCastka.Caption := ((IntToStr(Castka)) + ',- Kč')
        else
           LVCastka.Caption := ('BANKROT!!!');
           Pocet := 0;
      end;
          if Castka > 0 then
             Hadat
          else
             Hrat;
             Vyhra := (Castka * Pocet) + Vyhra;
            if LVCastka.Caption = 'BANKROT!!!' then
               Ztrata
            else
               Vyhra := (Castka * Pocet) + Vyhra;
  end;

Co se týče Timer tak tuto komponentu neznám a ani netuším jak bych jí implementoval do tohoto kódu.
Kdyby byl někdo tak moc hodný a pomohl mi byl bych rád.

Přikládám celý funkční kód.

Kód: [Vybrat]

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    BtnEnd: TButton;
    BtnHrat: TButton;
    LVCastka: TLabel;
    LHFraze: TLabel;
    BtnHledej: TButton;
    Edit1: TEdit;
    LCelkem: TLabel;
    LFraze: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    LKonec: TLabel;
    procedure BtnEndClick(Sender: TObject);
    procedure BtnHratClick(Sender: TObject);
    procedure BtnHledejClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Hadat;
    procedure Hrat;
    procedure HledanaFraze;
    procedure Ztrata;

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

var
  Form1: TForm1;
    Castka: Integer;
    Fraz: string;
    Pocet: Integer;
    Vyhra: Integer;
    Skryte: string;

implementation

{$R *.dfm}
//=============================
// Vyber fraze (pranostiky)
//=============================

procedure Fraze;
  var
    f: Integer;  // f jako Fraze
  begin
    Randomize;
    f := Random(11); // Nahodne cislo od 0 do 10
    if f = 0 then Fraz := 'na svatého jeronýma stěhuje se k nám už zima.';
    if f = 1 then Fraz := 'jak na nový rok, tak po celý rok.';
    if f = 2 then Fraz := 'na tři krále mrzne stále.';
    if f = 3 then Fraz := 'únor bílý, pole sílí.';
    if f = 4 then Fraz := 'na hromnice o hodinu více.';
    if f = 5 then Fraz := 'svatý matěj ledy láme, nemá-li je, nadělá je.';
    if f = 6 then Fraz := 'březen, za kamna vlezem. duben, ještě tam budem.';
    if f = 7 then Fraz := 'kdo se v máji ožení, přivodí si soužení.';
    if f = 8 then Fraz := 'o petru-li prší, po třicet dní déšť se vrší.';
    if f = 9 then Fraz := 'svatá markyta hodila srp do žita.';
    if f = 10 then  Fraz := 'do svatého vavřince nechval pšenice.';
  end;

//=============================
// Tlacitko Hrat
//=============================

procedure TForm1.BtnHratClick(Sender: TObject);
 var
    c: integer;  // c jako castka
  begin
    Randomize;
    c := Random(11); // Nahodne cislo od 0 do 10
    if (c = 0) then Castka := 100;
    if (c = 1) then Castka := 100;
    if (c = 2) then Castka := 100;
    if (c = 3) then Castka := 100;
    if (c = 4) then Castka := 200;
    if (c = 5) then Castka := 200;
    if (c = 6) then Castka := 200;
    if (c = 7) then Castka := 500;
    if (c = 8) then Castka := 500;
    if (c = 9) then Castka := 1000;
    if (c = 10) then Castka := 0;
    if Castka > 0 then
       LVCastka.Caption := ((IntToStr(Castka)) + ',- Kč')
    else
       LVCastka.Caption := ('BANKROT!!!');
       Pocet := 0;
      if Castka > 0 then
         Hadat
      else
         Hrat;
         Vyhra := (Castka * Pocet) + Vyhra;
        if LVCastka.Caption = 'BANKROT!!!' then
           Ztrata
        else
           Vyhra := (Castka * Pocet) + Vyhra;
  end;

//=============================
// Aktivace a deaktivace tlacitek pri bankrotu
//=============================

procedure TForm1.Hadat; // vylosovana castka
  begin
    BtnHrat.Enabled := False;
    Edit1.Clear;
    BtnHledej.Enabled := True;
  end;

procedure TForm1.Hrat; // vylosovany bankrot
  begin
    BtnHrat.Enabled := True;
    BtnHledej.Enabled := False;
  end;

procedure TForm1.HledanaFraze; // zobrazeni hledane fraze
  begin
    LHFraze.Visible := True;
    LHFraze.Caption := Fraz;
  end;

procedure TForm1.Ztrata; // zobrazeni hledane fraze
  begin
    Vyhra := 0;
    LCelkem.Caption := IntToStr(0) + ',- Kč';
  end;

//=============================
// Tlacitko hledej
//=============================

procedure TForm1.BtnHledejClick(Sender: TObject);
  var
    i: Integer;
    Pismeno: string;
  begin
    Pocet := 0;
    Pismeno := Edit1.Text;
      for i := 1 to length(Fraz) do  // string indexujeme od 1
        begin
          if Pismeno = Fraz[i] then
            begin
              Skryte[i] := Fraz[i];
              Pocet := Pocet + 1;
            end;
        end;

      if Fraz = Skryte then LKonec.Caption := 'Vyhraná částka je ';
        LFraze.Caption := Skryte;
        Vyhra := (Castka * Pocet) + Vyhra;
        LCelkem.Caption := IntToStr(Vyhra) + ',- Kč';
        Hrat;  // vylosovana castka
  end;

//=============================
// Vytvoreni formulare
//=============================

procedure TForm1.FormCreate(Sender: TObject);
  var
    i: Integer;
  begin
    Fraze;
    HledanaFraze; // zakomentujte "//" pro skryti hledane fraze
    Hrat; // nastavení tlacitek na hru (vylosovany bankrot)
    Vyhra := 0;
    Skryte := '';
    for i := 1 to Length(Fraz) do  // string indexujeme od 1
      begin
          if Fraz[i] = '.' then
             Skryte := Skryte + '.'
          else
            if Fraz[i] = ',' then
               Skryte := Skryte + ','
            else
              if Fraz[i] = ' ' then
                 Skryte := Skryte + ' '
              else
                if Fraz[i] = '-' then
                   Skryte := Skryte + '-'
                else
                  Skryte := Skryte + '*';
                  LFraze.Caption := Skryte;
      end;
  end;

//=============================
// Tlacitko Konec
//=============================

procedure TForm1.BtnEndClick(Sender: TObject);
  begin
    Close;
  end;

end.

a zde odkaz ke stažení https://drive.google.com/open?id=11wRPBNuwfvkv55vBcGbhqFpx1zdswzXo (https://drive.google.com/open?id=11wRPBNuwfvkv55vBcGbhqFpx1zdswzXo)

Název: Re:Delphi - Label a jiné
Přispěvatel: Ondřej Pokorný 21-01-2018, 03:10:01

Nezapomeň, že Lazarus používá v typu string UTF-8. T.j. české znaky jsou kódovány jako posloupnost 2 znaků. Nejjednodušší bude, když si všechny string proměnné přehodíš na UnicodeString, ten používá UTF-16 a české znaky se vejdou do 1 znaku:

Fraz: UnicodeString;
Skryte: UnicodeString;
Pismeno: UnicodeString;

Název: Re:Delphi - Label a jiné
Přispěvatel: 98723 21-01-2018, 04:19:03

Citace: Ondřej Pokorný 21-01-2018, 03:10:01

Nezapomeň, že Lazarus používá v typu string UTF-8. T.j. české znaky jsou kódovány jako posloupnost 2 znaků. Nejjednodušší bude, když si všechny string proměnné přehodíš na UnicodeString, ten používá UTF-16 a české znaky se vejdou do 1 znaku:

Fraz: UnicodeString;
Skryte: UnicodeString;
Pismeno: UnicodeString;

Tohle nebude dotaz na Lazarus. Mrkni na nazvy unit.

Název: Re:Delphi - Label a jiné
Přispěvatel: Ondřej Pokorný 21-01-2018, 04:43:42

Citace: Delfin 21-01-2018, 04:19:03

Tohle nebude dotaz na Lazarus. Mrkni na nazvy unit.

Pravda, to jsem přehlédl ::)

Název: Re:Delphi - Label a jiné
Přispěvatel: Radekzatec 21-01-2018, 10:15:07

Jde o RAD studio 10.2

Myslím, že úpravě kódu to je jedno.

Název: Re:Delphi - Label a jiné
Přispěvatel: našinec 21-01-2018, 10:20:12

Popravdě, zrovna jsem to chtěl napsat, že určitě máš Delphi 10.2 Start. S ohledem na ten Tvůj kód a to, co od toho očekáváš, nebylo lepší požít FMX místo Vcl? ;)

Název: Re:Delphi - Label a jiné
Přispěvatel: Radekzatec 21-01-2018, 10:25:59

Netuším o čem mluvíš.

Je mi 40, nikdy jsem neprogramoval a dělám výšku. bohužel programování je součástí studia i když jsem se zařekl, že programovat se učit nikdy nebudu tak teď musím. Ale jen v rámci studia opravdu se tím dále zabývat nebudu. To málo co jsem napsal mi trvalo tři dny než jsem to zprovoznil tak jak to je.

Název: Re:Delphi - Label a jiné
Přispěvatel: pf1957 21-01-2018, 11:04:25

Citace: Radekzatec 21-01-2018, 10:25:59

Je mi 40, nikdy jsem neprogramoval a dělám výšku. bohužel programování je součástí studia i když jsem se zařekl, že programovat se učit nikdy nebudu tak teď musím. Ale jen v rámci studia opravdu se tím dále zabývat nebudu. To málo co jsem napsal mi trvalo tři dny než jsem to zprovoznil tak jak to je.

V udalostmi rizenem programu nesmis delat zadne sleep a podobne zalezitosti, protoze program se nevykonava od postupne od zacatku do konce, ale vykonava se po castech v jednotlivych udalostech. Takze to musis rozdelit:
1. do udalosti OnTimer dat kod, ktery do labelu priradi novou hodnotu a tu si mozna nekde zapamatuje v poli formulare
2. do udalosti tlacitka OnClick dat kod, ktery zastavi timer a neco udela s naposledy zapamatovanou hodnotu

Název: Re:Delphi - Label a jiné
Přispěvatel: Radekzatec 21-01-2018, 14:23:47

RAD STUDIO 10.2

Tak nevím co dělám zle. Řeším tu rotaci přes Timer1

Kód: [Vybrat]

procedure Obnos;
  var
    c: integer;  // c jako castka
  begin
    Randomize;
    c := Random(11); // Nahodne cislo od 0 do 10
    if (c = 0) then Castka := 100;
    if (c = 1) then Castka := 100;
    if (c = 2) then Castka := 100;
    if (c = 3) then Castka := 100;
    if (c = 4) then Castka := 200;
    if (c = 5) then Castka := 200;
    if (c = 6) then Castka := 200;
    if (c = 7) then Castka := 500;
    if (c = 8) then Castka := 500;
    if (c = 9) then Castka := 1000;
    if (c = 10) then Castka := 0;
    end;

procedure TForm1.Timer1Timer(Sender: TObject); // casovac pro rotaci castky
  var   i: integer;
  begin
    for i := 0 to 4 do
      begin
        Obnos;
      end;
  end;

procedure TForm1.BtnHratClick(Sender: TObject);
 var
    i: Integer;
  begin
    Obnos;
    if Castka > 0 then
       LVCastka.Caption := ((IntToStr(Castka)) + ',- Kč')
    else
       LVCastka.Caption := ('BANKROT!!!');
       Pocet := 0;
       Timer1.Enabled := False; //zastaveni casovace
      if Castka > 0 then
         Hadat
      else
         Hrat;
         Vyhra := (Castka * Pocet) + Vyhra;
        if LVCastka.Caption = 'BANKROT!!!' then
           Ztrata
        else
           Vyhra := (Castka * Pocet) + Vyhra;
  end;

Nastavení events:
OnTimer := BtnHratClick

Fakt nevím jak to použít, aby to rotovalo po zmačknutí tlačítka Hrát a skončilo po pěti protočení částky v label.
Když to roztočím, tak se točí stále do kola.
Prosím pomoc s úpravou kódu.

Název: Re:Delphi - Label a jiné
Přispěvatel: Stanislav Hruška 21-01-2018, 15:29:34

Timer som v živote nepoužil, ale chýba mi tam jeho ukončenie/prerušenie. Niečo také

Kód: [Vybrat]


procedure TForm1.Timer1Timer(Sender: TObject); // casovac pro rotaci castky
var
  I: integer;
begin
  for I := 0 to 5 do
  begin
    if I = 5 then
      Timer1.Terminate  // Tu ho ukončiť
    else
      Obnos;
  end;
end;

Název: Re:Delphi - Label a jiné
Přispěvatel: pf1957 21-01-2018, 15:56:24

Citace: Radekzatec 21-01-2018, 14:23:47

Tak nevím co dělám zle. Řeším tu rotaci přes Timer1

:
Proc mas zase v obsluze ticknuti timeru iteraci? Ta je prece tim zaclenenim do obsluhy udalosti invertovana, takze to musis rozdelit:

Kód: Delphi [Vybrat]

...
FPocetVygenerovanychCisel: integer;
FKolikCiselVygenerovat: integer;
...
procedure Xxx.StartCounting(AMaxPocet:integer);
begin
  FKolikCiselVygenerovat := AMaxPocet;
  FPocetVygenerovanychCisel  := 0;
  Timer1.Enabled := True;  //v Design time nastasven na False
end
 
procedure Xxx.GenerujCislo();
var
  cislo: integer;
begin
  cislo = Random(11)*100;
  LabelCislo.Caption := Format('%d Kč',[cislo]);
  FPocetVygenerovanychCisel :=   FPocetVygenerovanychCisel + 1;
  if (FPocetVygenerovanychCisel >= FKolikCiselVygenerovat)
  begin
    Timer1.Enabled := false;
    NecoUdelej();
  end;
end;
 
procedure Xxx.OnTimer();
begin
  GenerujCislo();
end;
 
procedure Xxx.ButtonStart(...);
begin
  StartCounting(6);
end;
 

Název: Re:Delphi - Label a jiné
Přispěvatel: našinec 22-01-2018, 10:19:14

Citace: Radekzatec 21-01-2018, 10:25:59

Netuším o čem mluvíš.

Je mi 40, nikdy jsem neprogramoval a dělám výšku. bohužel programování je součástí studia i když jsem se zařekl, že programovat se učit nikdy nebudu tak teď musím. Ale jen v rámci studia opravdu se tím dále zabývat nebudu. To málo co jsem napsal mi trvalo tři dny než jsem to zprovoznil tak jak to je.

Trochu jsme mluvili oba o něčem jiném, jelikož já si pod rotací představuji rotation angle.

Forum Delphi.cz

FreePascal (FPC) a Lazarus => Obecné => Téma založeno: Radekzatec 20-01-2018, 20:12:28