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