12. príklady


Posledná zmena: 6.11.2002

Banner Text myš, časovač

myš

náhodné obdĺžniky a elipsy

program, ktorý po kliknutí ľavým tlačidlom myši do grafickej plochy nakreslí na danej pozícii obdĺžnik náhodných rozmerov a po kliknutí pravým tlačidlom myši nakreslí elipsu náhodných rozmerov

ak je pri klikaní stlačnený kláves Shift kreslíme štvorec a kružnicu

 
var
  g:Tcanvas;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered:=true;
  g:=Image1.Canvas;
  g.Brush.Style:=bsClear;
end;

procedure TForm1.Image1MouseDown(...);
var
  a,b:integer;
begin
  a:=10+random(50);
  if ssShift in Shift then b:=a
  else b:=10+random(50);
  if ssLeft in Shift then
    g.Rectangle(x-a,y-b,x+a,y+b)
  else if ssRight in Shift then
    g.Ellipse(x-a,y-b,x+a,y+b);
end;

obdĺžnik:

ťahaním myši sa naťahuje obdĺžnik

 
var
  bmp:TBitmap;
  x0,y0:integer;
  taham:boolean = false;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered:=true;
  Image1.Canvas.Brush.Style:=bsClear;
end;

procedure TForm1.Image1MouseDown(...);
begin
  bmp:=TBitmap.Create;
  bmp.Assign(Image1.Picture);
  x0:=X; y0:=Y;
  taham:=true;
end;

procedure TForm1.Image1MouseMove(...);
begin
  if taham then begin
    Image1.Canvas.Draw(0,0,bmp);
    Image1.Canvas.Rectangle(x0,y0,X,Y);
  end;
end;

procedure TForm1.Image1MouseUp(...);
begin
  bmp.Free;
  taham:=false;
end;

Ďalšie úlohy

  • ťahaním sa kreslí kružnica so stredom v počiatočnom bode ťahania
  • kreslenie na slepo: kým sa niečo kreslí do plochy ťahaním myšou, v grafickej ploche sa nič nemení, až po pustení tlačidla myši sa naozaj nakreslí zadaná kresba
  • podobným mechanizmom sa dá zabezpečiť dodatočné prefarbenie nakreslenej čiary inou farbou, resp. inou hrúbkou

myš a korytnačka

čiara s hviezdičkami

ťahanie myšou kreslí malé hviezdičky (náhodná veľkosť od 10 do 30) pričom nová hviezdička sa nakreslí až keď jej vzdialenosť od predchádzajúcej je aspoň 20

porozmýšľajte, čo by sa muselo zmeniť, aby sa korytnačka hýbala spolu s myšou a pritom by sa kreslili hviezdičky

 
var
  k:TKor;
  kresli:boolean;

procedure TForm1.FormCreate(Sender: TObject);
begin
  k:=TKor.Create;
  kresli:=false;
end;

procedure hviezdicka(s,x,y:integer);
var
  i:integer;
begin
  k.PresunXY(x,y);
  // poly(5,s,144);
  for i:=1 to 5 do begin
    k.Dopredu(s); k.Vpravo(144);
  end;
end;

procedure TForm1.Image1MouseDown(...);
begin
  kresli:=Shift=[ssLeft];
  if kresli then
    hviezdicka(random(20)+10,X,Y);
end;

procedure TForm1.Image1MouseMove(...);
begin
  if kresli and (k.vzd(X,Y)>=20) then
    hviezdicka(random(20)+10,X,Y);
end;

procedure TForm1.Image1MouseUp(...);
begin
  kresli:=false;
end;
  • program, v ktorom korytnačka vždy pri stlačení tlačidla myši kreslí podľa pohybu myši. Súčasne s touto korytnačkou vytvorte jej kópie podľa osí x a y, ktoré budú kresliť zrkadlovo podľa príslušnej osi.

inicializácia

 

 
var
  k:array[1..4] of TKor;
  kresli:boolean;
  w,h:integer;    // širka a výška plochy

procedure TForm1.FormCreate(Sender: TObject);
begin
  zmaz;
  w:=Image1.Width; h:=Image1.Height;
  kresli:=false;
end;

zatlačenie ľavého tlačidla myši - vytvorí 4 korytnačky

 

 
procedure TForm1.Image1MouseDown(...);
begin
  kresli:=Shift=[ssLeft];
  if kresli then begin
    k[1]:=TKor.Create(X,Y);
    k[2]:=TKor.Create(w-X,h-Y);
    k[3]:=TKor.Create(w-X,Y);
    k[4]:=TKor.Create(X,h-Y);
  end;
end;

ťahanie myši posúva všetky 4 korytnačky:

 

 
procedure TForm1.Image1MouseMove(...);
begin
  if kresli then begin
    k[1].ZmenXY(X,Y);
    k[2].ZmenXY(w-X,h-Y);
    k[3].ZmenXY(w-X,Y);
    k[4].ZmenXY(X,h-Y);
  end;
end;

pustenie myši uvolní všetky 4 korytnačky

 

 
procedure TForm1.Image1MouseUp(...);
begin
  if kresli then begin
    k[1].Free; k[2].Free; k[3].Free; k[4].Free;
    kresli:=false;
  end;
end;

Ďalšie úlohy

  • kliknutie na prázdne miesto vytvorí novú korytnačku a na tomto mieste táto nakreslí veľkú bodku, z ktorej "trčí" úsečka vyjadrujúca sme natočenia korytnačky; takto zobrazená korytnačka v ploche sa dá presúvať na inú pozíciu ťahaním za veľkú bodku; ťahaním za úsečku korytnačka iba mení smer; zrejme pri prekresľovaní "tvaru" korytnačky (pre presúvaní a otáčaní) by sa mohla celá grafická plocha zmazávať a všetky korytnačky nakresliť odznova

časovač

blikanie textu

v pol sekundových intervaloch má v grafickej ploche blikať nejaký text, napr. "Delphi": bude sa striedať modrá a červená farba písma

Timer1 má nastavené

  • Enabled = True
  • Interval = 50
 
var
  typ:integer = 0;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if typ=0 then
    Image1.Canvas.Font.Color:=clRed
  else
    Image1.Canvas.Font.Color:=clBlue;
  Image1.Canvas.Font.Size:=50;
  Image1.Canvas.TextOut(50,50,'Delphi');
  typ:=1-typ;
end;

pruhovaná plocha

pri štarte programu sa postupne nakreslia modré obdĺžniky šírky 10 výšky skoro na výšku plochy - zaplnia s medzerami celú plochu

po zaplnení celej plochy časovač zastane

Timer1 má nastavené

  • Enabled = True
  • Interval = 500
 
var
  x:integer;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered:=true;
  Image1.Canvas.Brush.Color:=clBlue;
  x:=5;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Image1.Canvas.Rectangle(x,5,x+10,Image1.Height-10);
  inc(x,15);
  if x>Image1.Width then Timer1.Enabled:=false;
end;

sústredné kružnice

na mieste kliknutia sa začnú postupne kresliť sústredné kružnice s polomerom od 3 s krokom 2 nie väčšie ako 99

pri kliknutí počas kreslenia sa zruší momentálne kreslenie a začne nové na novom mieste

Timer1 má nastavené

  • Enabled = False
  • Interval = 50
 
var
  xx,yy,r:integer;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered:=true;
  Image1.Canvas.Brush.Style:=bsClear;
end;

procedure TForm1.Image1MouseDown(...);
begin
  xx:=X; yy:=Y; r:=3; Timer1.Enabled:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Image1.Canvas.Ellipse(xx-r,yy-r,xx+r,yy+r);
  inc(r,2);
  if r>99 then Timer1.Enabled:=false;
end;

semafor

v grafickej ploche sa najprv nakreslí červený kruh, ten sa o 5 sekúnd prefarbí na žlto a o ďalšie 2 sekundy na zeleno, zelená farba vydrží 8 sekúnd, opäť sa na 1 sekundu objaví žltá a celé sa to opakuje

takýto semafor sa naštartuje prvým kliknutím niekde do plochy, každé ďalšie kliknutie buď semafor zastaví, alebo znovu naštartuje

 
var
  stav:integer = 0;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  c:TColor;
begin
  case stav of
    0: begin
         c:=clRed; Timer1.Interval:=5000;
       end;
    1: begin
         c:=clYellow; Timer1.Interval:=2000;
       end;
    2: begin
         c:=clGreen; Timer1.Interval:=8000;
       end;
    3: begin
         c:=clYellow; Timer1.Interval:=1000;
       end;
  end;
  stav:=(stav+1) mod 4;
  with Image1.Canvas do begin
    Brush.Color:=c;
    Ellipse(100,100,300,300);
  end;
end;

procedure TForm1.Image1MouseDown(...);
begin
  Timer1.Enabled:=not Timer1.Enabled;
end;

Ďalšie úlohy

  • podobná úloha predchádzajúcej s klikaním a postupným kreslením sústredných kružníc: ak sa klikne počas kreslenia kružníc, toto kreslenie sa preruší, na novom mieste sa postupne nakreslia nové kružnice a po skončení tohoto kreslenia sa pokračuje v prerušenom kreslení

časovač a korytnačky

semafor

predchádzajúcu úlohu riešte pomocou korytnačky: pri kliknutí do plochy na danom mieste vznikne korytnačka, tá bliká ako semafor (bodka s hrúbkou pera 100) a ďalšie kliknutie ju zruší

 
var
  stav:integer = 0;
  k:TKor = nil;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  case stav of
    0: begin
         k.FP:=clRed; Timer1.Interval:=5000;
       end;
    1: begin
         k.FP:=clYellow; Timer1.Interval:=2000;
       end;
    2: begin
         k.FP:=clGreen; Timer1.Interval:=8000;
       end;
    3: begin
         k.FP:=clYellow; Timer1.Interval:=1000;
       end;
  end;
  stav:=(stav+1) mod 4;
  k.Dopredu(0);
end;

procedure TForm1.Image1MouseDown(... X, Y: Integer);
begin
  if k<>nil then begin
    k.Free; k:=nil; Timer1.Enabled:=false; zmaz;
  end
  else begin
    k:=TKor.Create(X,Y); k.HP:=100;
    Timer1.Enabled:=true;
    stav:=0;
  end;
end;
  • program, v ktorom sa pri kliknutí do plochy vygeneruje korytnačka a hneď korytnačka začne vykresľovať na svojom mieste vždy väčší a väčší binárny strom (ako keby rástol: nový strom bude mať dlhšie konáre a bude mať viac úrovní), až po strom úrovne MaxUroven; korytnačky si udržiavajte v poli a vždy, keď niektorá korytnačka skončí kreslenie, vyhoďte ju z poľa (nahraďte ju poslednou) a skráťte pole

binárny strom

najprv rekurzívnu procedúru strom, ktorá má jeden parameter typu TKor - daná korytnačka nakreslí binárny strom

 
procedure strom(k:TKor; n:integer; v:real);
begin
  with k do begin
    Dopredu(v);
    if n>0 then begin
      Vlavo(45);
      strom(k,n-1,v*0.6);
      Vpravo(90);
      strom(k,n-1,v*0.6);
      Vlavo(45);
    end;
    Dopredu(-v);
  end;
end;

globálne deklarácie

vytvoríme pole korytnačiek - záznamov, ktoré obsahujú aj informácie o momentálnej úrovni a veľkosti stromu

 
const
  MaxUroven = 7;

type
  polekor = array [1..100] of record
    uroven:integer;
    dl:real;
    k:TKor;
  end;

var
  p:polekor;
  poc:integer = 0;    // počet korytnačiek

kliknutie

kliknutie do grafickej plochy vytvorí na tomto mieste novú korytnačku

 
procedure TForm1.Image1MouseDown(...);
begin
  if Shift=[ssLeft] then begin
    inc(poc);
    p[poc].k:=TKor.Create(X,Y);
    p[poc].uroven:=0;
    p[poc].dl:=20;
  end;
end;

časovač

v časovači (Interval nech môže byť napr. 300) sa

  • najprv zmaže obrazovka
  • potom sa vyhodia korytnačky s privysokou úrovňou
  • nakoniec sa nakreslia nové stromy so zvýšenou úrovňou aj veľkosťou
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  i:integer;
begin
  i:=1; zmaz;
  while i<=poc do
    with p[i] do
      if uroven>=MaxUroven then begin
        k.Free;
        p[i]:=p[poc];
        dec(poc);
      end
      else inc(i);
  for i:=1 to poc do
    with p[i] do begin
      inc(uroven);
      dl:=dl*1.2;
      strom(k,uroven,dl);
    end;
end;

Ďalšie úlohy

  • upravte program s rastom stromov tak, aby sa úroveň stromu v časovači zvyšovala napr. o 0.4 ale do procedúry strom sa pošle zaokrúhlená hodnota
  • korytnačka sa pomaly pohybuje za kurzorom myši: vždy sa otočí smerom ku kurzoru a prejde dopredu dĺžku 3, resp. kratšiu ak je blízko

© 2002 AB, KVI
blaho@fmph.uniba.sk