program bitmapzeichner; {Beschreibung Bedienung am Ende}
uses dos, crt, graph, maus, textobjz, fxxfenst;

{$i d:\tp\tppas1\bgi\svga256.inc} {Verzeichnisse in Zeile 82, 101 beachten}

type koord_bmp = array[1..1286] of byte;


{*** Prozeduren fuer Beginn des Programms ***********************************}

procedure Vorspann;        {Zeichnet Buchstaben in Farbreihenfolge 'farbfeld'}
                           { und an Punkten 'punktfeld'}
  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 3 do                        {Hintergrund-m”gliche Fllmuster}
      for j:=0 to 4 do
        begin
          newsetfillstyle(i*5+j+1, 8);
          bar(128*j, 120*i, 128*(j+1), 120*(i+1));
        end;

    settextstyle(3, 0, 2);                  {farbwechselnde Buchstaben}
    settextjustify(1, 2);
    setcolor(15);
    outtextxy(320, 450, 'Taste drcken');
    settextstyle(3, 0, 10);
    k:=0;
    repeat
      for i:=1 to 15 do
        begin
          j:=32+(i-1)+k;         {(i-1)+k}
          setcolor(j); {farbfeld[j]}
          outtextxy(punktfeld[i*2-1], punktfeld[i*2], textstring[i]);
        end;
      delay(100);
      k:=k+1;
      if k=50 then k:=0;
    until keypressed;
    settextjustify(0, 0);
  end;

{$F+}
function DetectVGA256 : Integer;
  begin
    DetectVGA256 := 2;
  end;
{$F-}

procedure initfont(fontdatei: string50);

var fontf : file;
    fontp : pointer;

  begin
    assign(fontf, 'd:\tp\bgi\'+fontdatei);
    reset(fontf, 1);
    getmem(fontp, filesize(fontf));
    blockread(fontf, fontp^, filesize(fontf));
    if registerbgifont(fontp)<0 then writeln('Fehler');
  end;

procedure Start {Graphik und Maus starten};

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

  begin
    gdinit:= Installuserdriver('SVGA256', @DetectVGA256);       {Graphik}
    gd:=detect;
    initfont('sans.chr');
    initfont('litt.chr');
    initgraph(gd, gm, 'd:\tp\tppas1\bgi');
    cleardevice;
    Vorspann;
    while keypressed do ch:=readkey;
    cleardevice;

    inst:=true; tasten:=3; grafik:=true;     {Maus}
    init_maus(inst, tasten, grafik);
    select_maus(8);
    set_maus(320, 240);
  end;

{*** Mausdarstellung ********************************************************}

procedure bereich(bool : boolean; xv, yv: integer;
                  var xmaus, ymaus: word; var xz, yz: integer);

  begin
    if bool then
      begin
        xz:=xz+xv;
        yz:=yz+yv;
        set_maus(xmaus-xv, ymaus-yv);
        xmaus:=xmaus-xv;
        ymaus:=ymaus-yv;
      end;
  end;

procedure mauscursorpkt(bool: boolean; xyz, xv1, xv2: integer;
                        var xy : integer);

  begin
    if bool then xy:=xyz+xv1
            else xy:=xv2;
  end;

procedure koordinaten(xmz, ymz, xk: integer; objchar: char);

  var xstr, ystr : string[3];

  begin
    if xk<>320 then {=320 dann keine Darstellung}
      begin
        str(xmz, xstr); str(ymz, ystr);
        setcolor(0);
        setfillstyle(1, 0);
        bar(xk, 0, xk+79, 15);
        setcolor(15);
        outtextxy(xk+2, 13, xstr+','+ystr+','+objchar);  {+0, +15 sonst falscher Ausgabeort}
      end;{of while}
  end;{of procedure}

procedure rand(bool: boolean; xz, yz, xmax, ymax: integer;
               var xmaus, ymaus: word);

  begin
    if bool then
      begin
        xmaus:=xmax-xz;
        ymaus:=ymax-yz;
        set_maus(xmax-xz, ymax-yz);
      end;
  end;

procedure mauszeichnen(x1, y1, x2, y2, xl, yl: integer);

  var mausflaeche : array[1..182] of char;

  begin
    getimage(x1, y1, x2, y2, mausflaeche);
    setcolor(helldunkel(x1+5, y1+5));
    line(x1, yl, x2, yl);
    line(xl, y1, xl, y2);
    delay(20);
    putimage(x1, y1, mausflaeche, 0);
  end;

procedure koord_aendern(var xk: word; var koord_bereich: koord_bmp);

  begin             {=320 dann keine Darstellung}
    if xk<>320 then putimage(xk, 0, koord_bereich, 0);
    if xk=0 then xk:=320
            else begin
                   if xk=560 then xk:=0
                             else xk:=560;
                 end;
    if xk<>320 then getimage(xk, 0, xk+79, 15, koord_bereich);
  end;

procedure maus_darstellung(var xz, yz: integer; var xk, xmaus, ymaus, tasten: word; objchar: char);

  var x1, y1, x2, y2: integer;

  begin
    maus_status(xmaus, ymaus, tasten);
    bereich(ymaus<  30,    0, -100, xmaus, ymaus, xz, yz);
    bereich(ymaus> 170,    0,  100, xmaus, ymaus, xz, yz);
    bereich(xmaus< 200, -300,    0, xmaus, ymaus, xz, yz);
    bereich(xmaus> 400,  301,    0, xmaus, ymaus, xz, yz);
    koordinaten(xmaus+xz, ymaus+yz, xk, objchar);
    rand(ymaus+yz> 479,  0, yz, xmaus,   479, xmaus, ymaus);
    rand(ymaus+yz<   0,  0, yz, xmaus,     0, xmaus, ymaus);
    rand(xmaus+xz> 639, xz,  0,   639, ymaus, xmaus, ymaus);
    rand(xmaus+xz<   0, xz,  0,     0, ymaus, xmaus, ymaus);
    mauscursorpkt(xmaus+xz> 5,   xmaus+xz, -5, 0,   x1);
    mauscursorpkt(xmaus+xz< 634, xmaus+xz,  5, 639, x2);
    mauscursorpkt(ymaus+yz> 5,   ymaus+yz, -5, 0,   y1);
    mauscursorpkt(ymaus+yz< 474, ymaus+yz,  5, 479, y2);
    mauszeichnen(x1, y1, x2, y2, xmaus+xz, ymaus+yz);
    xmaus:=xmaus+xz; ymaus:=ymaus+yz;
  end;

{*** Kontrolle der Zeichenfunktionen ****************************************}

{--- Was zeichnen / tun ? ---------------------------------------------------}

procedure Zweitetaste(xk:word; farbmuster: farbmustertyp;
                          objdat2: objdaten; var xz, yz: integer);

  var xm2, ym2, tasten2  : word;

  begin {Koordinaten fr zweiten Punkt einlesen per Maus}
    tasten2:=0;
    xm2:=0; ym2:=0;
    repeat
      delay(2);
      maus_darstellung(xz, yz, xk, xm2, ym2, tasten2, objdat2.objchar);
    until (tasten2=0);
    objdat2.x2:=xm2; objdat2.y2:=ym2;
    Objekt(farbmuster, objdat2);
  end;

procedure Ablauf;
  {steuert Ablauf w„hrend des Programms, Buchstaben siehe Ende}

  var farbe, i                        : byte;
      xmaus, ymaus, tasten, xk, xkalt : word;
      xz, yz                          : integer;
      beenden, objektja, abbruch      : boolean;
      zeichen, objchar, zeichen2      : char;
      farbmuster                      : farbmustertyp;
      objdat3                         : objdaten;
      koord_bereich                   : koord_bmp;

  begin
    settextstyle(2, 0, 5);
    set_maus(320, 90);
    yz:=150;
    xz:=0; xk:=560;
    getimage(xk, 0, xk+79, 15, koord_bereich);
    farbmuster.vorder:=15;                 {Voreinstellungen}
    farbmuster.hinter:=0;
    farbmuster.fuell:=15;
    farbmuster.muster:=1;
    farbmuster.linie:=0;
    farbmuster.dicke:=1;
    repeat                                 {Ablaufschleife}
      maus_status(xmaus, ymaus, tasten);
      settextstyle(2, 0, 5);                {Reset der Werte fr Maus, Tasten}
      tasten:=0; zeichen:=chr(0);
      {xmaus:=0; ymaus:=0;}
      setfillstyle(1, 0); settextjustify(0, 0);     
      setlinestyle(0, 0, 1);
      zeichen:=chr(0);
      zeichen2:=chr(0);

      repeat                               {auf Eingaben warten}
        delay(2);
        maus_darstellung(xz, yz, xk, xmaus, ymaus, tasten, objchar);
        if keypressed then zeichen:=readkey;
        if keypressed and (zeichen=chr(0)) then zeichen2:=readkey;
      until (tasten=1) or (zeichen>chr(0)) or (zeichen2>chr(0));

      if zeichen>chr(0) then                  {Eingaben auswerten}
        case zeichen of
            'C', 'c' : begin
                         zeichen:=readkey;
                         if zeichen=chr(13) then cleardevice;
                       end;
            'E' : begin objektja:=true; objchar:='E'; end;      {gefuellte Ellipse}
            'e' : begin objektja:=true; objchar:='e'; end;      {Ellipse}
            'F', 'f' : begin objektja:=true; objchar:='F'; end; {Flaeche fuellen}
            'K' : begin objektja:=true; objchar:='K'; end;      {gefuellter Kreis}
            'k' : begin objektja:=true; objchar:='k'; end;      {Kreis}
            'L' : begin objektja:=true; objchar:='L'; end;      {gerade Linie}
            'l' : begin objektja:=true; objchar:='l'; end;      {Linie}
            'P', 'p' : begin objektja:=false; objchar:='P'; end;{Punkt}
            'R' : begin objektja:=true; objchar:='R'; end;      {gefuelltes Rechteck}
            'r' : begin objektja:=true; objchar:='r'; end;      {Rechteck}
            'V', 'v' : begin objektja:=true; objchar:='V'; end; {Vergroessern}
            'W' : begin objektja:=true; objchar:='W'; end;      {Wuerfel (Bar3d)}
            'w' : begin objektja:=true; objchar:='w'; end;      {Wuerfel ohne Deckel}
            chr(13)  : koord_aendern(xk, koord_bereich);      {Enter}
            chr(27)  : beenden:=true; {Escape-Taste}          {Esc}
            else       Beep(500);
          end;
      if zeichen2>chr(0) then
        case zeichen2 of
            chr(59) : hilfe;                           {F1}
            chr(60) : beenden:=true;                   {F2}
            chr(61) : bildspeichern(abbruch);          {F3}
            chr(62) : bildladen;                       {F4}
            chr(63) : muster_und_farben(farbmuster);   {F5}
            chr(64) : farbpalette_muster(farbmuster);  {F6}
            chr(65) : farbe_setrgb(farbmuster.vorder); {F7}
            chr(66) : eig_fuellmuster(farbmuster);     {F8}
            chr(67) : eig_linienmuster(farbmuster);    {F9}
            else      Beep(500);
          end;

      objdat3.x1:=xmaus; objdat3.y1:=ymaus;
      objdat3.objchar:=objchar;
      if (objektja=false) and (upcase(objdat3.objchar)='P') and (tasten=1)
        then putpixel(xmaus, ymaus, farbmuster.vorder);
      if (tasten=1) and (objektja=true) then    {šbergabe zur Zeichenprozedur}
        Zweitetaste (xk, farbmuster, objdat3, xz, yz);
      if beenden=true then
        begin
          bildspeichern(abbruch);
          if abbruch=true then beenden:=false;
        end;
    until beenden=true;
  end;

{*** Hauptprogramm **********************************************************}

procedure Ende {Graphik und Maus ausschalten};

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

begin
  Start;
  hide_maus;
  Ablauf;
  Ende;
end.

{ siehe Hilfe, Neu: Schrift, Koordinaten
                                      Ā
\ C : Bildschirmloesche/\n (cleardevice) ³ (0/\0-15 : Vordergrundfa/\rbe)
 \L : Linie , G: gerad/e \Linie          ³ (/20\-35 : Hintergrundf/ar\be)
 B\ : Balken (gefuell/tes \Rechteck)     ³ /(40-\55 : Fuellfarbe /  ) \
 P \: Punkt         /      \             ³/ (60-7\2 : Fuellmuste/r  )  \
 R :\ Rechteck     /        \            /³ (80-83\ : Linienmus/ter)    \
 K : \Kreis       /          \          / ³ (90/93 \: Liniendi/cke )     \
 I : g\efuellter /Kreis (Piesl\ice)    /  ĆÄÄÄÄÄÄÄÄÄ\ÄÄÄÄÄÄÄÄ/ÄÄÄÄÄÄÄÄÄÄÄÄ\ÄÄÄÄÄÄ“
 S : ge\fuellte /Ellipse       \      /   ³       F1 \: Hilf/e             \
 F : Fla\eche f/uellen          \    /    ³ Esc / F2 :\ End/e               \
ĆÄÄÄÄÄÄÄÄ\ÄÄÄÄ/ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ\ÄÄ/ÄÄÄÄÄ“       F3 : \sp/eichern (save)    \
 V : Vergr\”į/ern                 \/      ³       F4 : L\/aden                \
aktuell: Procedur Hilfe 'F1'  im Programm (Unit fxxfenst.pas)
                                      Į
Immer linke Maustaste druecken und gedrueckt Maus zum Endpunkt schieben.
Dort loslassen, damit sind die 2 Punkte festgelegt, mit der die
Zeichenfunktionen auskommen(z.B. Rechteck: linke obere Ecke, rechte untere
Kreis: Mittelpunkt und Radius aus Abstand zum 1.)
Bei Punkt nur einmal klicken
Dateiformat: 20x20 Bitmaps hintereinander-> nicht kompatibel mitbekannten
Programmen, aber Windows paintbrush bmp sehr einfach: nur Pixelfarbe als
Byte/Halbbyte gespeichert, davor 'BM' >Groesse und Farbpalette, sehr einfach
siehe Programm bmpbild.pas}