žvejkal2009

Toto vlákno bylo označeno za vyřešené.

Melamber777 0

Newbie

12. 4. 2009 #1

unit zvejkal;



interface



uses

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

  Dialogs, StdCtrls, ComCtrls, jpeg, ExtCtrls, Menus;



type

  TForm1 = class(TForm)



    Edit1: TEdit;

    Button1: TButton;

    PageControl1: TPageControl;

    TabSheet1: TTabSheet;

    TabSheet2: TTabSheet;

    TabSheet3: TTabSheet;

    RichEdit1: TRichEdit;

    Image1: TImage;

    MainMenu1: TMainMenu;

    Soubor1: TMenuItem;

    Vlastnosti1: TMenuItem;

    opalikaci1: TMenuItem;

    Konec1: TMenuItem;

    Natislovnk1: TMenuItem;

    OAplikaci1: TMenuItem;

    editor1: TMenuItem;

    vejkal1: TMenuItem;

    ListBox1: TListBox;

    ListBox2: TListBox;

    ListBox3: TListBox;

    ListBox4: TListBox;

    Edit2: TEdit;

    Edit3: TEdit;

    Button2: TButton;

    Button3: TButton;

    Button4: TButton;

    Memo1: TMemo;

    Timer1: TTimer;

    Timer2: TTimer;

    procedure Button1Click(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure Edit1KeyPress(Sender: TObject; var Key: Char);

    procedure Edit1Click(Sender: TObject);

    procedure PageControl1Change(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

    procedure Edit2Click(Sender: TObject);

    procedure Edit3Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure Natislovnk1Click(Sender: TObject);

    procedure OAplikaci1Click(Sender: TObject);

    procedure Konec1Click(Sender: TObject);

    procedure ListBox3Click(Sender: TObject);

    procedure ListBox4Click(Sender: TObject);

    procedure Timer1Timer(Sender: TObject);

    procedure editor1Click(Sender: TObject);

    procedure vejkal1Click(Sender: TObject);

    procedure Timer2Timer(Sender: TObject);

    procedure Edit1Change(Sender: TObject);



  private

    { Private declarations }

  public

    { Public declarations }

  end;

        type

 TKeyType = (ktCapsLock, ktNumLock, ktScrollLock);

var

  Form1: TForm1;

          value:string[60];

          zmena,nalezeno:boolean;



implementation



{$R *.dfm}





procedure TForm1.Button1Click(Sender: TObject);

var i,j:integer;

begin

  with richedit1 do   //pro nastaveni barev na vystup

begin

  //move caret to end

 nalezeno:=false;

  SelStart := GetTextLen;

   //add bold + red

       SelAttributes.Style := [fsBold];//sel atributes je lazaru pro memo nepouzitelny...

  SelAttributes.Color := clred;

 SelAttributes.Size := 10;

  SelText := '(*** '+value+'***):( ';

  seltext:=datetostr(now)+' :datum,čas: '+timetostr(now)+' )***)';



             SelAttributes.Size := 8;

             selattributes.Color:=clblack;



         SelText := #13#10;

          end;

      richedit1.Lines.Add(edit1.Text);



       with richedit1 do

begin

  //move caret to end

  SelStart := GetTextLen;

          SelAttributes.Style := [fsBold];

  SelAttributes.Color := clred;

  SelAttributes.Size := 10;



  SelText := '(*** žvejkal***):(';

   seltext:=datetostr(now)+' :datum,čas: '+timetostr(now)+' )***)';

               SelAttributes.Size := 8;



             selattributes.Color:=clblack;

         SelText := #13#10;

          end;



       for i:=0 to listbox1.Items.Count-1 do begin

    if edit1.Text=listbox1.Items[i] then begin

    richedit1.Lines.Add(listbox2.Items[i]);

       nalezeno:=true; end;

     end;

       if nalezeno=false then begin

           randomize();

           j:=random(5)+1;

           case j of

           1:richedit1.Lines.Add('neznám správnou odpověď');

           2:richedit1.Lines.Add('no teď zrovna nevim...:(');

           3:richedit1.Lines.Add('já tomuhle nerozumím...');

           4:richedit1.Lines.Add('nerozumim této větě,protože ji nemám ve slovníku:(');

           5:richedit1.Lines.Add('tohle neumim,a radši otom zatím nebudem diskutovat...');

           end;





       end;









    if edit1.Text='' then

    richedit1.Lines.Add('zadejte prosim vetu...nebo nejake zaeditovane souslovi...')

    else if edit1.Text='konec' then

    begin

    application.Terminate;

    end;



    timer1.Enabled:=false;timer2.Enabled:=false; //pro vypnuti timeru 1 ,2

     if(edit1.Text='zablikej diodama')or(edit1.Text='zablikej diodama...')then

     begin

  timer2.Enabled:=true;

     end;

    if(edit1.Text='samomluva') or (edit1.Text='mluv sám se sebou') then begin



   timer1.Enabled:=true; end;

    edit1.Text:='';

   memo1.SelStart := memo1.GetTextLen;













end;



procedure TForm1.Button2Click(Sender: TObject);

begin

if (edit2.Text='') or (edit3.Text='') then begin

  showmessage('zadejte do poliček slovni spojeni (prosim editujte)');

  zmena:=false;

  end

  else begin

  listbox3.Items.Add(edit2.Text);

  listbox4.Items.Add(edit3.Text);

  edit2.Text:='';

  edit3.Text:='';

  zmena:=true;

  end;

end;



procedure TForm1.Button3Click(Sender: TObject);

var i:integer;

begin

 for i:=0 to listbox3.Items.Count-1 do begin



  if listbox3.Selected[i]then begin

   listbox3.Items.Delete(i);

   listbox4.Items.Delete(i);

   zmena:=true;

   break;

    end

  else if listbox4.Selected[i] then begin

   listbox4.Items.Delete(i);

   listbox3.Items.Delete(i);

   zmena:=true;

   break;

  end

  else zmena:=false;

  end;//cyklus for







end;



procedure TForm1.Button4Click(Sender: TObject);

begin

 if zmena=true then begin

    listbox3.Items.SaveToFile('slovnik1.zvk');

  listbox4.Items.SaveToFile('slovnik2.zvk');

  end;

end;



procedure TForm1.Edit1Change(Sender: TObject);

begin

timer2.Enabled:=false;

end;



procedure TForm1.Edit1Click(Sender: TObject);

begin

 edit1.Text:=''; timer1.Enabled:=false;timer2.Enabled:=false;

end;



procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

 if key=#13 then  //reakce na oba entery

  button1.Click;



end;



procedure TForm1.Edit2Click(Sender: TObject);

begin

edit2.Text:='';

end;



procedure TForm1.Edit3Click(Sender: TObject);

begin

edit3.Text:='';

end;



procedure TForm1.editor1Click(Sender: TObject);

begin

pagecontrol1.ActivePageIndex:=1;

end;



procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

 if zmena=true then begin

    listbox1.Items.SaveToFile('slovnik1.zvk');

  listbox2.Items.SaveToFile('slovnik2.zvk');

  end;

end;



procedure TForm1.FormCreate(Sender: TObject);

var i:integer;

begin

       repeat

    value := InputBox('program žvejkal', 'prosim zadejte svůj nick:', '');

  until value <> '';



            with richedit1 do

begin

  //move caret to end

  SelStart := GetTextLen;

          SelAttributes.Style := [fsBold];

  SelAttributes.Color := clred;

  SelAttributes.Size := 10;



  SelText := '(*** žvejkal***): (';

   seltext:=datetostr(now)+' :datum,čas: '+timetostr(now)+' )***)';

               SelAttributes.Size := 8;



             selattributes.Color:=clblack;

         SelText := #13#10;

          end;

     randomize();

     i:=random(5)+1;

     case i of

     1:richedit1.Lines.Add('Zdravím Tě příteli,očem pokecáme?');

     2:richedit1.Lines.Add('Ahoj,jak to jde?');

     3:richedit1.Lines.Add('Zdar a sílu,jak se vede?');

     4:richedit1.Lines.Add('hoj:),jdeš pozdě,čekal jsem tu na Tebe celou věčnost...');

     5:richedit1.Lines.Add('Ahoj,nevim ale někdy mě dojímáš:)');

       else richedit1.Lines.Add('chyba programu!prosím ukončete tento program!');

     end;

  if FileExists('slovnik1.zvk') and fileExists('slovnik2.zvk')then begin

  listbox1.Items.LoadFromFile('slovnik1.zvk');

  listbox2.Items.LoadFromFile('slovnik2.zvk');

  showmessage('slovník načten!');

  end

  else showmessage('slovníky nenalezeny!');



end;



procedure TForm1.Konec1Click(Sender: TObject);

begin

 application.Terminate;

end;



procedure TForm1.ListBox3Click(Sender: TObject);

begin

 listbox4.ItemIndex:=listbox3.ItemIndex;

end;



procedure TForm1.ListBox4Click(Sender: TObject);

begin

listbox3.ItemIndex:=listbox4.ItemIndex;

end;



procedure TForm1.Natislovnk1Click(Sender: TObject);

begin

  if pagecontrol1.ActivePageIndex=1 then begin

    if fileexists('slovnik1.zvk')and fileexists('slovnik2.zvk')then begin

 listbox3.Items.LoadFromFile('slovnik1.zvk');

  listbox4.Items.LoadFromFile('slovnik2.zvk');

  showmessage('slovník načten!');

  end

  else showmessage('slovníky nenalezeny!uložte prosím nový slovník...');end

  else if fileexists('slovnik1.zvk')and fileexists('slovnik2.zvk')then begin

 listbox1.Items.LoadFromFile('slovnik1.zvk');

  listbox2.Items.LoadFromFile('slovnik2.zvk');

  showmessage('slovník načten!');

end

    else showmessage('slovníky nenalezeny!uložte prosím nový slovník...');

end;



procedure TForm1.OAplikaci1Click(Sender: TObject);

begin

 pagecontrol1.ActivePageIndex:=2;

end;



procedure TForm1.PageControl1Change(Sender: TObject);

begin

if pagecontrol1.ActivePageIndex=0 then begin

edit1.enabled:=true;

button1.enabled:=true;

      end

      else begin

      edit1.Enabled:=false;

      button1.Enabled:=false;

      end;

end;









procedure TForm1.Timer1Timer(Sender: TObject);

var i:integer;

 

begin

      with richedit1 do

begin

  //move caret to end

  SelStart := GetTextLen;

          SelAttributes.Style := [fsBold];

  SelAttributes.Color := clred;

  SelAttributes.Size := 10;



  SelText := '(*** žvejkal***): (';

   seltext:=datetostr(now)+' :datum,čas: '+timetostr(now)+' )***)';

               SelAttributes.Size := 8;



             selattributes.Color:=clblack;

         SelText := #13#10;

          end;

    randomize();

    i:=abs(random(listbox1.Items.Count));

  richedit1.Lines.Add(listbox1.Items[i]);

  richedit1.Lines.Add(listbox2.Items[i]);



       timer2.Enabled:=true;

end;

{

procedure TForm1.Timer2Timer(Sender: TObject);

var

 o : OSVERSIONINFO;

 NumLockState : boolean;

 ScrollLockState : boolean;

 CapsLockState : boolean;

 keys : TKeyboardState;

begin

 o.dwOSVersionInfoSize := SizeOf(o);

 GetVersionEx(o);

 GetKeyboardState(keys);



 //NumLock handling:



 If NumLockState <> True then    //Turn numlock on

  If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  //=== Win95/98

     begin

          keys[VK_NUMLOCK] := 1;

          SetKeyboardState(keys);

     end

        Else

          If o.dwPlatformId = VER_PLATFORM_WIN32_NT Then //=== WinNT

       begin

        //Simulate Key Press

          keybd_event(VK_NUMLOCK, $45, KEYEVENTF_EXTENDEDKEY Or 0, 0);

        //Simulate Key Release

          keybd_event (VK_NUMLOCK, $45, KEYEVENTF_EXTENDEDKEY

           Or KEYEVENTF_KEYUP, 0);

        End;



 //CapsLock handling:



  If CapsLockState <> True Then    //Turn capslock on

    If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  //=== Win95/98

     begin

       keys[VK_CAPITAL] := 1;

       SetKeyboardState(keys);

     end

       Else

         If o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   //=== WinNT

          begin

            //Simulate Key Press

            keybd_event(VK_CAPITAL, $45, KEYEVENTF_EXTENDEDKEY Or 0, 0);

           //Simulate Key Release

           keybd_event (VK_CAPITAL, $45, KEYEVENTF_EXTENDEDKEY

             Or KEYEVENTF_KEYUP, 0);

          End;



 //ScrollLock handling:



 If ScrollLockState <> True Then  //Turn Scroll lock on

  If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  //=== Win95/98

   begin

     keys[VK_SCROLL] := 1;

     SetKeyboardState(keys);

   end

    Else

      If o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   //=== WinNT

       begin

         //Simulate Key Press

         keybd_event(VK_SCROLL, $45, KEYEVENTF_EXTENDEDKEY Or 0, 0);

         //Simulate Key Release

         keybd_event(VK_SCROLL, $45, KEYEVENTF_EXTENDEDKEY

            Or KEYEVENTF_KEYUP, 0);

        End;



//stimto si doted nevim rady,potreboval nejake to bliani diod....

end;

}

procedure TForm1.vejkal1Click(Sender: TObject);

begin

pagecontrol1.ActivePageIndex:=0;

end;



end.by melamber777

Nahlásit jako SPAM

IP: 213.19.108.–

Melamber777 0

Newbie

12. 4. 2009 #2

www.melamber777.webgarden.cz na této adrese najdete také požadovaný program+foto...pokud chcete se naučit programovat používejte na source kody google nebo pokud začínáte můžete začínat s pascalem...(nebo freepascal)

Nahlásit jako SPAM

IP: 213.19.108.–

Melamber777 0

Newbie

5. 7. 2009 #3

zde je vylepšená verze 2011...

unit zvejkal;



interface



uses

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

  Dialogs, ExtCtrls, StdCtrls, ComCtrls, jpeg, Menus;



type

  TForm1 = class(TForm)

    Image1: TImage;

    Edit1: TEdit;

    Button1: TButton;

    PageControl1: TPageControl;

    TabSheet1: TTabSheet;

    TabSheet2: TTabSheet;

    TabSheet3: TTabSheet;

    ListBox1: TListBox;

    ListBox2: TListBox;

    Edit2: TEdit;

    Edit3: TEdit;

    Button2: TButton;

    Button3: TButton;

    Button4: TButton;

    Memo1: TMemo;

    RichEdit1: TRichEdit;

    Timer1: TTimer;

    Timer2: TTimer;

    Edit4: TEdit;

    Timer3: TTimer;

    procedure Button1Click(Sender: TObject);

    procedure Timer1Timer(Sender: TObject);

    procedure PageControl1Change(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

    procedure Edit1Click(Sender: TObject);

    procedure Edit1KeyPress(Sender: TObject; var Key: Char);

    procedure FormCreate(Sender: TObject);

    procedure ListBox1Click(Sender: TObject);

    procedure ListBox2Click(Sender: TObject);

    procedure Edit1DblClick(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure Edit3DblClick(Sender: TObject);

    procedure Edit2DblClick(Sender: TObject);

    procedure Edit2KeyPress(Sender: TObject; var Key: Char);

    procedure Edit3KeyPress(Sender: TObject; var Key: Char);

    procedure Timer2Timer(Sender: TObject);

    procedure Timer3Timer(Sender: TObject);



  private

    { Private declarations }

  public

    { Public declarations }

  end;



var

  Form1: TForm1;

         nalezeno:boolean;



implementation



{$R *.dfm}



procedure TForm1.Button1Click(Sender: TObject);



var i,j:integer;



begin

     if (fileexists('slovnik1.zvk'))and(fileexists('slovnik2.zvk')) then begin



  with richedit1 do   //pro nastaveni barev na vystup



begin



  //move caret to end



 nalezeno:=false;



  SelStart := GetTextLen;



   //add bold + red



       SelAttributes.Style := [fsBold];//sel atributes je lazaru pro memo nepouzitelny...



  SelAttributes.Color := clblue;



 SelAttributes.Size := 10;



  SelText := '(***Uživatel***):( ';



  seltext:=datetostr(now)+' :datum,čas: '+timetostr(now)+' )***)';







             SelAttributes.Size := 8;



             selattributes.Color:=clblack;







         SelText := #13#10;



          end;



      richedit1.Lines.Add(edit1.Text);







       with richedit1 do



begin



  //move caret to end



  SelStart := GetTextLen;



          SelAttributes.Style := [fsBold];



  SelAttributes.Color := clred;



  SelAttributes.Size := 10;







  SelText := '(*** žvejkal***):(';



   seltext:=datetostr(now)+' :datum,čas: '+timetostr(now)+' )***)';



               SelAttributes.Size := 8;







             selattributes.Color:=clblack;



         SelText := #13#10;



          end;

           for i := 0 to Listbox1.Items.Count - 1 do begin



           j:=pos(edit1.Text,listbox1.Items[i]);











    if j<>0 then begin



    richedit1.Lines.Add(listbox2.Items[i]);



       nalezeno:=true;break; end;

                                 end;//for





       if nalezeno=false then begin



           randomize();



           j:=random(5)+1;



           case j of



           1:richedit1.Lines.Add('neznám správnou odpověď');



           2:richedit1.Lines.Add('no teď zrovna nevim...:(');



           3:richedit1.Lines.Add('já tomuhle nerozumím...');



           4:richedit1.Lines.Add('nerozumim této větě,protože ji nemám ve slovníku:(');



           5:richedit1.Lines.Add('tohle neumim,a radši otom zatím nebudem diskutovat...');



           end;











       end;







    if edit1.Text='' then



    richedit1.Lines.Add('zadejte prosim vetu...nebo nejake zaeditovane souslovi...')



    else if edit1.Text='konec' then



    begin



    application.Terminate;



    end;



    timer1.Enabled:=false; //pro vypnuti timeru 1

              timer2.Enabled:=true;

    if(edit1.Text='samomluva') or (edit1.Text='mluv sám se sebou') then begin



             timer1.Enabled:=true; end;  end//kotrola souborů

             else begin

               showmessage('nelze komunikovat bez slovníků!aplikace se ukončuje!');

application.Terminate;

             end;



    edit1.Text:='';





























end;



procedure TForm1.Button2Click(Sender: TObject);

begin



if (edit2.Text='') or (edit3.Text='') then begin



  showmessage('zadejte do poliček slovni spojeni (prosim editujte)');







  end



  else begin



  listbox1.Items.Add(edit2.Text);



  listbox2.Items.Add(edit3.Text);



  edit2.Text:='';



  edit3.Text:='';







  end;

end;



procedure TForm1.Button3Click(Sender: TObject);

var i:integer;



begin



 for i:=0 to listbox1.Items.Count-1 do begin







  if listbox1.Selected[i]then begin



   listbox1.Items.Delete(i);



   listbox2.Items.Delete(i);

    break;



    end



  else if listbox2.Selected[i] then begin



   listbox2.Items.Delete(i);



   listbox1.Items.Delete(i);



   break;



  end;







  end;//cyklus for



end;



procedure TForm1.Button4Click(Sender: TObject);

begin









    listbox1.Items.SaveToFile('slovnik1.zvk');



  listbox2.Items.SaveToFile('slovnik2.zvk');





end;



procedure TForm1.Edit1Click(Sender: TObject);

begin

 edit1.Text:='sem pište svůj text...';

  timer1.Enabled:=false; timer2.Enabled:=false;

end;



procedure TForm1.Edit1DblClick(Sender: TObject);

begin

edit1.Text:='';  timer2.Enabled:=false;

end;



procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

if key=#13 then

            button1.Click;

end;



procedure TForm1.Edit2DblClick(Sender: TObject);

begin

edit2.Text:='';

end;



procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);

begin

if key=#13 then

button2.Click;

end;



procedure TForm1.Edit3DblClick(Sender: TObject);

begin

edit3.Text:='';

end;







procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);

begin

if key=#13 then

button2.Click;

end;



procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  listbox1.Items.SaveToFile('slovnik1.zvk');



  listbox2.Items.SaveToFile('slovnik2.zvk');

end;



procedure TForm1.FormCreate(Sender: TObject);

var i:integer;

begin

if fileexists('slovnik1.zvk')and fileexists('slovnik2.zvk')then begin



 listbox1.Items.LoadFromFile('slovnik1.zvk');



  listbox2.Items.LoadFromFile('slovnik2.zvk');



  showmessage('slovníky načteny!');



  end



  else begin showmessage('slovníky nenalezeny!uložte prosím nový slovník...');

 end;



   with richedit1 do

 begin

   //move caret to end

    SelStart := GetTextLen;

     SelAttributes.Style := [fsBold];

     SelAttributes.Color := clred;

     SelAttributes.Size := 10;



       SelText := '(*** žvejkal***): (***(';



   seltext:=datetostr(now)+' :datum,čas:) '+timetostr(now)+' )***)';



               SelAttributes.Size := 8;







             selattributes.Color:=clblack;



         SelText := #13#10;

 end;

      randomize();

      i:=random(10)+1;

      case i of

      1:richedit1.Lines.Add('Ahoj,jak se máš?');

      2:richedit1.Lines.Add('Ahoj,jak to jde?');

      3:richedit1.Lines.Add('Ahoj,očem pokecáme?co nového?');

      4:richedit1.Lines.Add('Zdar a sílu,jak je dneska?');

      5:richedit1.Lines.Add('Ahoooj,jak se Ti vede?co nového?');

      6:richedit1.Lines.Add('Čusky busky,stýskalo se mi...pokecáme?');

      7:richedit1.Lines.Add('Ahoj Kamaráde:-),co nového?');

      8:richedit1.Lines.Add('Ahojky Kamošu/ško...,co nového?');

      9:richedit1.Lines.Add('Ahojky,tak jaká?Co nového?');

      10:richedit1.Lines.Add('Ahoj,co nového?');

      else richedit1.Lines.Add('jsem překvapen,nevim co říct');

      end;

       timer3.Enabled:=true;

end;



procedure TForm1.ListBox1Click(Sender: TObject);

begin

listbox2.ItemIndex:=listbox1.ItemIndex;

end;



procedure TForm1.ListBox2Click(Sender: TObject);

begin

  listbox1.ItemIndex:=listbox2.ItemIndex;

end;











procedure TForm1.PageControl1Change(Sender: TObject);

begin

if pagecontrol1.ActivePageIndex=0 then begin



edit1.enabled:=true;



button1.enabled:=true;



      end



      else begin



      edit1.Enabled:=false;



      button1.Enabled:=false;



       if fileexists('slovnik1.zvk')and fileexists('slovnik2.zvk')then begin

         button3.Enabled:=true;

       end else button3.Enabled:=false;

      end;

end;



procedure TForm1.Timer1Timer(Sender: TObject);

var i:integer;

begin

       with richedit1 do

 begin

   //move caret to end

    SelStart := GetTextLen;

     SelAttributes.Style := [fsBold];

     SelAttributes.Color := clblack;

     SelAttributes.Size := 10;



       SelText := '(*** žvejkal***): (***(';



   seltext:=datetostr(now)+' :datum,čas:) '+timetostr(now)+' )***)';



               SelAttributes.Size := 8;







             selattributes.Color:=clred;



         SelText := #13#10;







    randomize();



    i:=abs(random(listbox1.Items.Count));



  Lines.Add(listbox1.Items[i]);

    selattributes.Color:=clblue;

  Lines.Add(listbox2.Items[i]);

  end;







end;





procedure TForm1.Timer2Timer(Sender: TObject);

var i:integer;

begin

      timer2.Interval:=20000;

if timer2.Interval=20000 then begin



    randomize();

    i:=random(3)+1;

            case i of

            1:richedit1.Lines.Add('Nespi!');

            2:richedit1.Lines.Add('Když budeš spát,tak sladký sny...');

            3:richedit1.Lines.Add('Dobrou...,sladký sny...:-)');

            end;

end;



end;



procedure TForm1.Timer3Timer(Sender: TObject);

begin

edit4.Text:=timetostr(now);

end;



end.

Nahlásit jako SPAM

IP: 213.19.108.–

Melamber777 0

Newbie

8. 5. 2010 #4

tady je zakladní kostra programu,zatím jsem si všiml chyby že špatně přidává do slovníků,dělám celý program znovu a tak se ptám jestli mi stím někdo přes icq nepomohl...

unit Unit1; 



{$mode objfpc}{$H+}



interface



uses

  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,

  StdCtrls;



type



  { TForm1 }



  TForm1 = class(TForm)

    Button1: TButton;

    Edit1: TEdit;

    ListBox1: TListBox;

    ListBox2: TListBox;

    Memo1: TMemo;

    procedure Button1Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);

    procedure FormCreate(Sender: TObject);

  private

    { private declarations }

  public

    { public declarations }

  end; 



var

  Form1: TForm1; 

  veta:string; nalezeno:boolean;//deklarace proměnných

implementation



{ TForm1 }



procedure TForm1.FormCreate(Sender: TObject);

var i:integer;

begin

 randomize();

 i:=random(5)+1;

 case i of //přivítání programu

 1:memo1.Lines.Add('Ahoj,vítej očem poklábosíme?');

 2:memo1.Lines.Add('Ahoj,kamaráde');

 3:memo1.Lines.Add('Ahoj,jak to jde?');

 4:memo1.Lines.Add('Zdar a sílu...jak to jde?');

 5:memo1.Lines.Add('Zdarec kámo,dáme řeč?')

 else showmessage('chyba programu!');

 end;

if(fileexists('slovnik1.txt'))and(fileexists('slovnik2.txt'))then

//kontrola jestli existují soubory

begin//načtení souborů

  listbox1.Items.LoadFromFile('slovnik1.txt');

  listbox2.Items.LoadFromFile('slovnik2.txt');

end

else showmessage('slovníky nenalezeny!'); //pokud nenalezne větu

//vyhodí hlašku...

end;



procedure TForm1.Button1Click(Sender: TObject);

var i,x:integer;

begin

  //zde budou pridávací vety

   if(nalezeno=false)then begin

   listbox2.Items.Add(edit1.Text);//opraveno

   //pro automatické pridání do slovníků

   end;

  nalezeno:=false;

  memo1.Lines.Add(edit1.Text);



  for x:=0 to listbox1.Items.Count-1 do

  begin

  i:=pos(edit1.Text,listbox1.Items[x]);

  if(i<>0)then

  begin

  memo1.Lines.Add(listbox2.Items[x]);

  nalezeno:=true;

  break;

  end; //nalezeno

  end;//cykl for

  if(nalezeno=false)then

  begin

  listbox1.Items.Add(edit1.Text); //opraveno

   memo1.Lines.Add(edit1.text+'...co je to?');

  end;



end;



procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);

begin

  listbox1.Items.SaveToFile('slovnik1.txt');

  listbox2.Items.SaveToFile('slovnik2.txt');

end;



initialization

  {$I unit1.lrs}



end.

Nahlásit jako SPAM

IP: 213.19.108.–

Melamber777 0

Newbie

30. 8. 2010 #5

prosím o lock tohoto topicku a zároveň jeho smazání

Nahlásit jako SPAM

IP: 213.19.108.–

deedx

~ Korektor

Stálý člen

Kultivátor příspěvků ve starém fóru – 3.24 % z celku

30. 8. 2010 #6

Mohl bych ještě předtím poprosit o vysvětlení smyslu topicu? Vypadá to jako poznámkový blok na zdroják...

Nahlásit jako SPAM

IP: 82.100.0.–

Zdejší chybolovec.

Melamber777 0

Newbie

19. 11. 2010 #7

no v těch prvních dvou jsou hrubé chyby a tak alespoň smáznout první dva zdrojáky,ale jinač schválně jestli najdete ony chyby(začátečníci by to mohli také najít).No jinač trošku mi zlobilo pc a tak jsem nemohl nic přidávat a poradit jsem tehdy opravdu potřeboval a poradění se mi dostalo až až...,programování zdar a sílu.

Nahlásit jako SPAM

IP: 213.19.108.–

← Zpět na seznam vláken ← Zpět do Fóra