program bitmapzeichner;
uses crt, graph, maus;

type farbmustertyp = record
                         vorder : byte;
                         hinter : byte;
                         fuell  : byte;
                         muster : byte;
                         linie  : byte;
                         dicke  : byte;
                       end;

type punkt = 0..639;

{****************************************************************************}

procedure Vorspann;

  const textstring : string = 'Bitmap-zeichner';
        punktfeld  : array [1..30] of punkt =
                       (108,  70, 160,  70, 200,  70, 280,  70, 372,  70, 444,
                         70, 524,  70, 104, 220, 172, 220, 222, 220, 272, 220,
                        340, 220, 408, 220, 476, 220, 540, 220);
        farbfeld   : array [0..28] of byte =
                       (1, 2, 3, 4, 5, 6, 7,  9, 10, 11, 12, 13, 14, 15, 1,
                        2, 3, 4, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15, 1);

  var i, j, k : byte;

  begin
    for i:=0 to 2 do
      for j:=0 to 3 do
        begin
          setfillstyle(i*4+j, 8);
          bar(160*j, 160*i, 160*(j+1), 160*(i+1));
        end;
    settextstyle(3, 0, 10);
    settextjustify(1, 2);
    k:=0;
    repeat
      for i:=1 to 15 do
        begin
          j:=(i-1)+k;
          setcolor(farbfeld[j]);
          outtextxy(punktfeld[i*2-1], punktfeld[i*2], textstring[i]);
        end;
      delay(400);
      k:=k+1;
      if k=15 then k:=0;
    until keypressed;
  end;

procedure Start {Graphik und Maus starten};

  var gd, gm       : integer;
      inst, grafik : boolean;
      tasten       : word;
      ch           : char;

  begin
    gd:=9; gm:=2;
    initgraph(gd, gm, 'd:\tp\bgi');
    cleardevice;
    Vorspann;
    ch:=readkey;
    cleardevice;
    inst:=true; tasten:=3; grafik:=true;
    init_maus(inst, tasten, grafik);
    select_maus(8);
    set_maus(320, 240);
    show_maus;
  end;

{****************************************************************************}

procedure Beep(hoehe: integer); {Ton bestimmter Hoehe spielen}

  begin
    sound(hoehe);
    delay(200);
    nosound;
  end;

procedure Farben(zeichen: char; var farbmuster: farbmustertyp);
  {Festlegen der Farben}

  var code, farbe : integer;
      zeichen2    : char;

  begin
    zeichen2:=readkey;
    if zeichen='0'
      then val(zeichen2, farbe, code)
      else val(zeichen+zeichen2, farbe, code);
    if farbe<20 then farbmuster.vorder:=farbe;
    if (farbe<40) and (farbe>=20) then farbmuster.hinter:=farbe-20;
    if (farbe<60) and (farbe>=40) then farbmuster.fuell:=farbe-40;
    if (farbe<80) and (farbe>=60) then farbmuster.muster:=farbe-60;
    if (farbe<84) and (farbe>=80) then farbmuster.linie:=farbe-80;
    if (farbe<94) and (farbe>=90) then farbmuster.dicke:=farbe-90;
    if farbe>93 then beep(500);
  end;

procedure Objekt(objchar: char; farbmuster: farbmustertyp; x1, y1, x2, y2 : integer);

  var mx, my, radius1, radius2 : integer;

  begin {Zeichnen der Objekte}
    hide_maus;
    with farbmuster do
      begin
        setcolor(vorder);
        setbkcolor(hinter);
        setlinestyle(linie, 0, dicke);
      end;
    if (objchar='B') or (objchar='I') or (objchar='S') or (objchar='F') then
      setfillstyle(farbmuster.muster, farbmuster.fuell);
    if objchar='L' then line(x1, y1, x2, y2);
    if objchar='R' then rectangle(x1, y1, x2, y2);
    if objchar='B' then bar(x1, y1, x2, y2);
    if objchar='F' then floodfill(x1, y1, getpixel(x2, y2));
    if objchar='K' then
      begin
        if x2>x1 then radius2:=x2-x1 else radius2:=x1-x2; {Dummy}
        if y2>y1 then radius1:=y2-y1 else radius1:=y1-y2; {Dummy}
        radius1:=round(sqrt(radius1*radius1+radius2*radius2));
        circle(x1, y1, radius1);
      end;
    if objchar='I' then
      begin
        if x2>x1 then radius2:=x2-x1 else radius2:=x1-x2; {Dummy}
        if y2>y1 then radius1:=y2-y1 else radius1:=y1-y2; {Dummy}
        radius1:=round(sqrt(radius1*radius1+radius2*radius2));
        pieslice(x1, y1, 0, 360, radius1);
      end;
    if objchar='E' then
      begin
        mx:=x2; my:=y1;
        radius1:=x2-x1;
        if radius1<0 then radius1:=-1*radius1;
        radius2:=y1-y2;
        if radius2<0 then radius2:=-1*radius2;
        ellipse(mx, my, 0, 360, radius1, radius2);
      end;
    if objchar='S' then
      begin
        mx:=x2; my:=y1;
        radius1:=x2-x1;
        if radius1<0 then radius1:=-1*radius1;
        radius2:=y1-y2;
        if radius2<0 then radius2:=-1*radius2;
        ellipse(mx, my, 0, 360, radius1, radius2);
        floodfill(mx, my, farbmuster.vorder);
      end;
    show_maus;
  end;

{----------------------------------------------------------------------------}

procedure Zweitetaste(objchar : char; farbmuster: farbmustertyp; xmaus, ymaus: word);

  var tasten2, xm2, ym2 : word;
      i                 : byte;
      zeichen           : char;
      farb2             : farbmustertyp;

  begin {Koordinaten f�r zweiten Punkt einlesen per Maus}
    tasten2:=0;
    xm2:=0; ym2:=0;
    repeat
      delay(50);
      maus_status(xm2, ym2, tasten2);
    until (tasten2=0);
    Objekt(objchar, farbmuster, xmaus, ymaus, xm2, ym2);{beep(600);}
  end;

procedure Ablauf {steuert Ablauf w„hrend des Programms};

  var xmaus, ymaus, tasten : word;
      beenden, objektja    : boolean;
      zeichen, objchar     : char;
      farbe, i             : byte;
      farbmuster           : farbmustertyp;

  begin
    farbmuster.vorder:=15;
    farbmuster.hinter:=0;
    farbmuster.fuell:=15;
    farbmuster.muster:=1;
    farbmuster.linie:=0;
    farbmuster.dicke:=1;
    repeat
      maus_status(xmaus, ymaus, tasten);
      tasten:=0; zeichen:=chr(0);
      xmaus:=0; ymaus:=0;
      zeichen:=chr(0);
      repeat
        delay(10);
        maus_status(xmaus, ymaus, tasten);
        if keypressed then zeichen:=readkey;
      until (tasten=1) or (zeichen>chr(0));
      if zeichen>chr(0) then
      case zeichen of
          '0'..'9' : Farben (zeichen, farbmuster);
          'B', 'b' : begin objektja:=true; objchar:='B'; end;
          'C', 'c' : cleardevice;
          'E', 'e' : begin objektja:=true; objchar:='E'; end;
          'F', 'f' : begin objektja:=true; objchar:='F'; end;
          'I', 'i' : begin objektja:=true; objchar:='I'; end;
          'K', 'k' : begin objektja:=true; objchar:='K'; end;
          'L', 'l' : begin objektja:=true; objchar:='L'; end;
          'R', 'r' : begin objektja:=true; objchar:='R'; end;
          'S', 's' : begin objektja:=true; objchar:='S'; end;
          'X', 'x' : beenden:=true;
          else       Beep(500);
        end;
      if (tasten=1) and (objektja=true) then
        Zweitetaste (objchar, farbmuster, xmaus, ymaus);
    until beenden=true;
  end;

{****************************************************************************}

procedure Ende {Graphik und Maus ausschalten};

  begin
    Beep(400);
    delay(500);
    hide_maus;
    cleardevice;
    closegraph;
  end;

begin
  Start;
  Ablauf;
  Ende;
end.
{C : Bildschirml”schen (cleardevice) ³ 00-15  : Vordergrundfarbe
 L : Linie                           ³ 20-35 : Hintergrundfarbe
 B : Balken (gef�lltes Rechteck)     ³ 40-55 : Fuellfarbe
     Punkt : L / R                   ³ 60-72 : Fuellmuster
 R : Rechteck                        ³ 80-83 : Linienmuster
 K : Kreis                           ³ 90/93 : Liniendicke
 I : gef�llter Kreis (Pieslice)
 E : Ellipse                         ³ X : Ende
 S : gef�llte Ellipse;               ³ V : speichern (save)
 F : Fl„che fuellen}