home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ANIVGA11.ZIP / MAKES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-08-31  |  216.7 KB  |  6,568 lines
  1. {$UNDEF test}
  2.  
  3. {$IFDEF test}
  4.   {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}
  5.   {$M 16384,0,655360}
  6. {$ELSE}
  7.   {$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,R-,S-,V-,X-}
  8.   {$M 16384,150000,655360}
  9. {$ENDIF}
  10.  
  11. PROGRAM MakeSprite;
  12. {Zweck    : Erstellung von *.COD und *.PIC Dateien für ANIVGA        }
  13. {Autor    : Kai Rohrbacher    }
  14. {Sprache  : TurboPascal 6.0   }
  15. {Datum    : Juli 1992         }
  16. {Anmerkung: Hat manchmal Probleme bei der Mausinitialisierung - keine}
  17. {           Ahnung warum!}
  18.  
  19. {Erweiterungen um ein Tool:}
  20. { ein Event dafür definieren}
  21. { in "ToolTyp" mitaufnehmen }
  22. { in "Menu[]" aufnehmen (vor dem Sentineleintrag natürlich)}
  23. { DrawTool* Routine für Icondarstellung einfügen (inkl. FORWARD)}
  24. { DrawWorkArea* Routine einführen, die Objekt löschen, zeichnen & speichern kann}
  25. { Tooltyp in ClearOldObject(), DrawNewObject() und StoreObject() einfügen}
  26. { in WorkAreaAction() 2x einfügen: temporäres Objekt zeichnen, Objekt abschließen}
  27. { in SelectNewTool() und ShowActualTool() einfügen}
  28. { im Hauptprogramm bei Event-Abfrage berücksichtigen}
  29. { Wenn es den Inhalt der Workarea ändert, dann WorkAreaMaxUsedX|Y ändern}
  30.  
  31. USES Dos,Graph,crt,DATWAHL,Eingabe;
  32. const Titel1='MakeSprite V2.0 (c) - by Kai Rohrbacher';
  33.       GetMaxX=639;
  34.       GetMaxY=399; {da Graph.GetMaxY hier noch nicht zur Verfügung steht!}
  35.       Menumax=10;              {Anzahl Einträge im Hauptmenu}
  36.       WorkBreite=320; {Breite der Workarea}
  37.       WorkHoehe=200;
  38.       WorkStartX= 4;  WorkEndX=WorkStartX+Pred(WorkBreite);
  39.       WorkStartY=35;  WorkEndY=WorkStartY+Pred(WorkHoehe);
  40.       PaletteX=WorkStartX+WorkBreite+4; {Koord. für Palette}
  41.       PaletteY=30;
  42.       PalHoehe=15;    {Abmessungen einer Palettenkachel}
  43.       PalBreite=18;
  44.       MeldungX=390; MeldungY=GetMaxY-95;{Koordinaten für Meldungen}
  45.       InfoX=WorkStartX;                 {dto., für Sprite-Info}
  46.       InfoY=WorkEndy+10;
  47.       ToolsX=10; ToolsY=WorkEndY+65;    {dto., für Toolboxen  }
  48.       zoom:BYTE=2;    {Vergrößerungsfaktor}
  49.       StartVirtualX:INTEGER=0; {Verschiebung des Workarea-Inhaltes}
  50.       StartVirtualY:INTEGER=0;
  51.       MenuStartX=2; MenuStartY=GetMaxY-20; {Menu-Startkoordinaten}
  52.  
  53.       CursorMaxX=11;  {max. Abmessungen des Mauscursors}
  54.       CursorMaxY=13;
  55.       MausMinX=0;     {Koordinatenbereich für Maus}
  56.       MausMinY=20;
  57.       MausMaxX=GetMaxX-CursorMaxX;
  58.       MausMaxY=GetMaxY-CursorMaxY;
  59.  
  60.       MaxSpriteBreite=316; {sollte Vielfaches von 4 sein}
  61.       MaxSpriteHoehe =200;
  62.       Datenbytes=MaxSpriteHoehe*Succ(Pred(MaxSpriteBreite) div 4)*4;
  63.  
  64.       Kopf=50; {Größe des folgenden Spriteheaders in Bytes (ohne Data-Feld):}
  65.       VID640x400x256=1;
  66.       transparent=0;  {Farbe für durchsichtig = 0 per Definition!}
  67.  
  68. TYPE spritetyp= record case Integer of
  69.       0:(
  70.          Zeiger_auf_Plane:Array[0..3] OF Word;   {Diese...}
  71.          Breite_in_4er_Gruppen:WORD;             {...Daten}
  72.          Hoehe_in_Zeilen:WORD;                   {...brauchen}
  73.          Translate:Array[1..4] OF Byte;          {...alles}
  74.          SpriteLength:WORD;
  75.          Dummy:Array[1..10] OF Word;             {...zusammen}
  76.          Kennung:ARRAY[1..2] OF CHAR;
  77.          Version:BYTE;
  78.          Modus:BYTE;
  79.          ZeigerL,ZeigerR,ZeigerO,ZeigerU:Word;   {"Kopf" Bytes!}
  80.          Data:Array[1..Datenbytes
  81.                        +(WorkBreite*2)*2
  82.                        +(WorkHoehe *2)*2] OF Byte;
  83.         );
  84.       1:(
  85.          readin:Array[0..(Datenbytes-1)  {max. Größe der Planedaten}
  86.                       +(WorkBreite*2)*2  {dto., Y-Grenzen (2 Wort-Tabellen)}
  87.                       +(WorkHoehe *2)*2  {dto., X-Gr. (auch Worteinträge)}
  88.                       +Kopf] OF Byte;    {Zeiger am Anfang, immer!}
  89.         )
  90.      END;
  91.      {Datentyp zur Repräsentation der WorkArea; Achtung: WorkArea[y,x],}
  92.      {nicht WorkArea[x,y]!}
  93.      WorkAreatyp= record case Integer of
  94.       0:(data:ARRAY[0..WorkBreite*WorkHoehe-1] OF BYTE);
  95.       1:(feld:ARRAY[0..WorkHoehe-1,0..WorkBreite-1] OF BYTE);
  96.      END;
  97.  
  98.      Farbeck=RECORD
  99.               x1,y1,x2,y2:Integer;
  100.              END;
  101.  
  102.      BildTyp=(cod,pic,none);
  103.      ActionTyp=(clear,draw,store);
  104.  
  105.      ToolTyp=(Punkt,Rechteck,Ellipse_,FRechteck,FEllipse,Linie,FuellEimer,Kopie);
  106.      ObjektTyp=RECORD
  107.                 stage:BYTE;
  108.                 StartX,StartY,LastX,LastY:INTEGER;
  109.                 actX,actY:INTEGER; {Hilfskoordinaten, nur für "Kopie"-Tool}
  110.                 Typ:ToolTyp;
  111.                 Aligned:BOOLEAN;
  112.                END;
  113.      ButtonStringTyp=STRING[8];  {Meldung in Clickboxen}
  114.  
  115. CONST aktuellesTool:ToolTyp=Punkt; {aktuell gewähltes Tool}
  116.       aktuelleFarbe:BYTE=White;    {aktuelle Zeichenfarbe }
  117.       Objekt:ObjektTyp=(
  118.        stage:0;  {Objekt noch nicht begonnen, Rest uninteressant!}
  119.        StartX:0; StartY:0; LastX:0; LastY:0;
  120.        actX:0; actY:0;
  121.        Typ:Punkt;
  122.        Aligned:FALSE
  123.        );
  124.  
  125. VAR CRTAddress,      {Adresse des CRT-Ports, $3B4/$3D4 fuer monochrom/Farbe}
  126.     StatusReg:WORD;  {dto., fuer Statusregister, $3BA/$3DA}
  127.     Shift:BOOLEAN;   {gibt wieder, ob während Auswertung Shift gedrückt war}
  128.     BestWhite,       {Beste Näherungen der angeg. Farben}
  129.     BestBlack,
  130.     BestCyan,
  131.     BestLightGray,
  132.     BestDarkGray:BYTE;
  133.  
  134. {---------Menu-Felder---------}
  135. CONST EventNone=0;                 {gar nix}
  136.       EventError=1;                {Fehler }
  137.       EventQuit=2;                 {Programm vielleicht beenden}
  138.       EventScrollLeft=3;           {Scroll nach links }
  139.       EventScrollRight=4;          {Scroll nach rechts}
  140.       EventScrollUp=5;             {Scroll nach oben  }
  141.       EventScrollDown=6;           {Scroll nach unten }
  142.       EventZoomin=7;               {Workareainhalt vergrößern}
  143.       EventZoomout=8;              {dto., verkleinern}
  144.       EventHelp=9;                 {Hilfe}
  145.       EventLadeSprite=10;          {Sprite laden}
  146.       EventLadePalette=11;         {Palette laden}
  147.       EventResetColors=12;         {Defaultpalette}
  148.       EventLadeHintergrund=13;     {Hintergrundbild laden}
  149.       EventMapPalette=14;          {Workareainhalt auf Palette matchen}
  150.       EventMapToBIOSPalette=15;    {dto., aber auf Standardfarbenpalette}
  151.       EventInWorkArea=16;          {Maus in Workarea}
  152.       EventMouseMoved=17;          {Maus wurde bewegt}
  153.       EventSelectColor=18;         {Farbe wird ausgewählt}
  154.       EventToolPixel=19;           {Tool für Punkte selektiert}
  155.       EventToolLine=20;            {dto., für Linien}
  156.       EventToolRectangle=21;       {dto., für Quadrate+Rechtecke}
  157.       EventToolEllipse=22;         {dto., für Kreise+Ellipsen}
  158.       EventToolBar=23;             {dto., für ausgefüllte Quadrate+Rechtecke}
  159.       EventToolDisc=24;            {dto., für ausgefüllte Kreise+Ellipsen}
  160.       EventToolFill=25;            {dto., für Füllfunktion}
  161.       EventToolCopy=26;            {dto., für Ausschnittskopien}
  162.       EventBlinkColor=27;          {Eine Farbe blinken lassen}
  163.       EventChangeColor=28;         {Farbe austauschen}
  164.       EventShowBorder=29;          {Spritegrenzen zeigen}
  165.       EventSpeichereSprite=30;     {Sprite abspeichern}
  166.       EventSpeichereHintergrund=31;{Hintergrund abspeichern}
  167.       EventSpeicherePalette=32;    {Palette abspeichern}
  168.       EventRotateLeft=33;          {Workareainhalt um 1 nach links rotieren}
  169.       EventRotateRight=34;         {dto., rechts}
  170.       EventRotateUp=35;            {dto., nach oben}
  171.       EventRotateDown=36;          {dto., nach unten}
  172.       EventMirrorHorizontal=37;    {horizontal spiegeln}
  173.       EventMirrorVertical=38;      {vertikal spiegeln}
  174.       EventObenLinks=39;           {verschiebt Sprite soweit wie möglich links hoch}
  175.       EventEraseWorkarea=40;       {Workarea vollständig löschen}
  176.       EventEndProgram=41;          {Programm tatsächlich beenden}
  177.  
  178. VAR globalI:BYTE;
  179.  
  180. TYPE DrawBox=PROCEDURE;
  181.      box=RECORD  {Datentyp für ein Menufeld:}
  182.           x1,y1,                 {obere linke Boxecke}
  183.           x2,y2:WORD;            {untere rechte Ecke }
  184.           Name1,Name2:STRING[8]; {Beschriftung 1.+2.Zeile}
  185.           Show :DrawBox;         {Routine zum anzeigen des Icons}
  186.           Event:BYTE;            {zurückzugebender Wert}
  187.           Click:BOOLEAN;         {muß Maus geclickt werden für Event?}
  188.           Paint:BOOLEAN;         {Flag, ob Box zu zeichnen ist}
  189.          END;
  190.      boxes=ARRAY[1..32] OF box;  {alle Menufelder zusammen}
  191.  
  192. PROCEDURE Dummy; FAR; BEGIN END;
  193. PROCEDURE DrawToolPixels; FAR; FORWARD;
  194. PROCEDURE DrawToolLines; FAR; FORWARD;
  195. PROCEDURE DrawToolRectangles; FAR; FORWARD;
  196. PROCEDURE DrawToolEllipses; FAR; FORWARD;
  197. PROCEDURE DrawToolBars; FAR; FORWARD;
  198. PROCEDURE DrawToolDiscs; FAR; FORWARD;
  199. PROCEDURE DrawToolFill; FAR; FORWARD;
  200. PROCEDURE DrawToolCopy; FAR; FORWARD;
  201.  
  202. PROCEDURE DrawFunctionkey; FAR; FORWARD;
  203. PROCEDURE DrawBoxBorders; FAR; FORWARD;
  204. PROCEDURE DrawBoxBlinkColor; FAR; FORWARD;
  205. PROCEDURE DrawBoxChangeColor; FAR; FORWARD;
  206. PROCEDURE DrawBoxRotateLeft; FAR; FORWARD;
  207. PROCEDURE DrawBoxRotateRight; FAR; FORWARD;
  208. PROCEDURE DrawBoxRotateUp; FAR; FORWARD;
  209. PROCEDURE DrawBoxRotateDown; FAR; FORWARD;
  210. PROCEDURE DrawBoxMirrorHorizontal; FAR; FORWARD;
  211. PROCEDURE DrawBoxMirrorVertical; FAR; FORWARD;
  212. PROCEDURE DrawBoxObenLinks; FAR; FORWARD;
  213.  
  214. CONST ToolBoxWidth=45;
  215.       BoxWidth=63;
  216.       Menu:boxes=(
  217.  {F1}  (x1:MenuStartX+ 0*BoxWidth+8-1;           y1:MenuStartY-1;
  218.         x2:MenuStartX+ 0*BoxWidth+8+BoxWidth-14; y2:MenuStartY+18;
  219.         Name1:'Help'; Name2:'';
  220.         Show :DrawFunctionkey;
  221.         Event:EventHelp;
  222.         Click:TRUE;
  223.         Paint:TRUE),
  224.  {F2}  (x1:MenuStartX+ 1*BoxWidth+8-1;           y1:MenuStartY-1;
  225.         x2:MenuStartX+ 1*BoxWidth+8+BoxWidth-14; y2:MenuStartY+18;
  226.         Name1:'Save';Name2:'*.COD';
  227.         Show :DrawFunctionkey;
  228.         Event:EventSpeichereSprite;
  229.         Click:TRUE;
  230.         Paint:TRUE),
  231.  {F3}  (x1:MenuStartX+ 2*BoxWidth+8-1;           y1:MenuStartY-1;
  232.         x2:MenuStartX+ 2*BoxWidth+8+BoxWidth-14; y2:MenuStartY+18;
  233.         Name1:'Load';Name2:'*.COD';
  234.         Show :DrawFunctionkey;
  235.         Event:EventLadeSprite;
  236.         Click:TRUE;
  237.         Paint:TRUE),
  238.  {F4}  (x1:MenuStartX+ 3*BoxWidth+8-1;           y1:MenuStartY-1;
  239.         x2:MenuStartX+ 3*BoxWidth+8+BoxWidth-14; y2:MenuStartY+18;
  240.         Name1:'Save';Name2:'*.PAL';
  241.         Show :DrawFunctionkey;
  242.         Event:EventSpeicherePalette;
  243.         Click:TRUE;
  244.         Paint:TRUE),
  245.  {F5}  (x1:MenuStartX+ 4*BoxWidth+8-1;           y1:MenuStartY-1;
  246.         x2:MenuStartX+ 4*BoxWidth+8+BoxWidth-14; y2:MenuStartY+18;
  247.         Name1:'Load';Name2:'*.PAL';
  248.         Show :DrawFunctionkey;
  249.         Event:EventLadePalette;
  250.         Click:TRUE;
  251.         Paint:TRUE),
  252.  {F6}  (x1:MenuStartX+ 5*BoxWidth+8-1;           y1:MenuStartY-1;
  253.         x2:MenuStartX+ 5*BoxWidth+8+BoxWidth-14; y2:MenuStartY+18;
  254.         Name1:'Save';Name2:'*.PIC';
  255.         Show :DrawFunctionkey;
  256.         Event:EventSpeichereHintergrund;
  257.         Click:TRUE;
  258.         Paint:TRUE),
  259.  {F7}  (x1:MenuStartX+ 6*BoxWidth+8-1;           y1:MenuStartY-1;
  260.         x2:MenuStartX+ 6*BoxWidth+8+BoxWidth-14; y2:MenuStartY+18;
  261.         Name1:'Load';Name2:'*.PIC';
  262.         Show :DrawFunctionkey;
  263.         Event:EventLadeHintergrund;
  264.         Click:TRUE;
  265.         Paint:TRUE),
  266.  {F8}  (x1:MenuStartX+ 7*BoxWidth+8-1;           y1:MenuStartY-1;
  267.         x2:MenuStartX+ 7*BoxWidth+8+BoxWidth-14; y2:MenuStartY+18;
  268.         Name1:'Clear';Name2:'Screen';
  269.         Show :DrawFunctionkey;
  270.         Event:EventEraseWorkarea;
  271.         Click:TRUE;
  272.         Paint:TRUE),
  273.  {F9}  (x1:MenuStartX+ 8*BoxWidth+8-1;           y1:MenuStartY-1;
  274.         x2:MenuStartX+ 8*BoxWidth+8+BoxWidth-14; y2:MenuStartY+18;
  275.         Name1:'MapPal';Name2:'to Pal';
  276.         Show :DrawFunctionkey;
  277.         Event:EventMapPalette;
  278.         Click:TRUE;
  279.         Paint:TRUE),
  280.  {F10} (x1:MenuStartX+ 9*BoxWidth+8-1;           y1:MenuStartY-1;
  281.         x2:MenuStartX+ 9*BoxWidth+8+BoxWidth-14; y2:MenuStartY+18;
  282.         Name1:'QUIT';Name2:'';
  283.         Show :DrawFunctionkey;
  284.         Event:EventQuit;
  285.         Click:TRUE;
  286.         Paint:TRUE),
  287.  
  288.  {Jetzt die Toolboxen:}
  289.  {Punkte:}
  290.        (x1:ToolsX+0*ToolBoxWidth;      y1:ToolsY;
  291.         x2:ToolsX+1*ToolBoxWidth-5;    y2:ToolsY+32;
  292.         Name1:'';Name2:'';
  293.         Show :DrawToolPixels;
  294.         Event:EventToolPixel;
  295.         Click:TRUE;     {Anclicken nötig}
  296.         Paint:TRUE),    {wird gezeichnet}
  297.  
  298.  {Linien:}
  299.        (x1:ToolsX+1*ToolBoxWidth;      y1:ToolsY;
  300.         x2:ToolsX+2*ToolBoxWidth-5;    y2:ToolsY+32;
  301.         Name1:'';Name2:'';
  302.         Show :DrawToolLines;
  303.         Event:EventToolLine;
  304.         Click:TRUE;     {Anclicken nötig}
  305.         Paint:TRUE),    {wird gezeichnet}
  306.  
  307.  {Rechtecke&Quadrate:}
  308.        (x1:ToolsX+2*ToolBoxWidth;      y1:ToolsY;
  309.         x2:ToolsX+3*ToolBoxWidth-5;    y2:ToolsY+32;
  310.         Name1:'';Name2:'';
  311.         Show :DrawToolRectangles;
  312.         Event:EventToolRectangle;
  313.         Click:TRUE;     {Anclicken nötig}
  314.         Paint:TRUE),    {wird gezeichnet}
  315.  
  316.  {Kreise&Ellipsen:}
  317.        (x1:ToolsX+3*ToolBoxWidth;      y1:ToolsY;
  318.         x2:ToolsX+4*ToolBoxWidth-5;    y2:ToolsY+32;
  319.         Name1:'';Name2:'';
  320.         Show :DrawToolEllipses;
  321.         Event:EventToolEllipse;
  322.         Click:TRUE;     {Anclicken nötig}
  323.         Paint:TRUE),    {wird gezeichnet}
  324.  
  325.  {Fülltool:}
  326.        (x1:ToolsX+0*ToolBoxWidth;      y1:ToolsY+37;
  327.         x2:ToolsX+1*ToolBoxWidth-5;    y2:ToolsY+37+32;
  328.         Name1:'';Name2:'';
  329.         Show :DrawToolFill;
  330.         Event:EventToolFill;
  331.         Click:TRUE;     {Anclicken nötig}
  332.         Paint:TRUE),    {wird gezeichnet}
  333.  
  334.  {ausgefüllte Rechtecke&Quadrate:}
  335.        (x1:ToolsX+2*ToolBoxWidth;      y1:ToolsY+37;
  336.         x2:ToolsX+3*ToolBoxWidth-5;    y2:ToolsY+37+32;
  337.         Name1:'';Name2:'';
  338.         Show :DrawToolBars;
  339.         Event:EventToolBar;
  340.         Click:TRUE;     {Anclicken nötig}
  341.         Paint:TRUE),    {wird gezeichnet}
  342.  
  343.  {ausgefüllte Kreise&Ellipsen:}
  344.        (x1:ToolsX+3*ToolBoxWidth;      y1:ToolsY+37;
  345.         x2:ToolsX+4*ToolBoxWidth-5;    y2:ToolsY+37+32;
  346.         Name1:'';Name2:'';
  347.         Show :DrawToolDiscs;
  348.         Event:EventToolDisc;
  349.         Click:TRUE;     {Anclicken nötig}
  350.         Paint:TRUE),    {wird gezeichnet}
  351.  
  352.  {Kopie anfertigen:}
  353.        (x1:ToolsX+1*ToolBoxWidth;      y1:ToolsY+37;
  354.         x2:ToolsX+2*ToolBoxWidth-5;    y2:ToolsY+37+32;
  355.         Name1:'';Name2:'';
  356.         Show :DrawToolCopy;
  357.         Event:EventToolCopy;
  358.         Click:TRUE;     {Anclicken nötig}
  359.         Paint:TRUE),    {wird gezeichnet}
  360.  
  361.  
  362.  {---Jetzt die Funktionsbuttons---}
  363.  
  364.  {Grenzen anzeigen:}
  365.        (x1:ToolsX+8*ToolBoxWidth;      y1:ToolsY+37;
  366.         x2:ToolsX+9*ToolBoxWidth-5;    y2:ToolsY+37+32;
  367.         Name1:'';Name2:'';
  368.         Show :DrawBoxBorders;
  369.         Event:EventShowBorder;
  370.         Click:TRUE;     {Anclicken nötig}
  371.         Paint:TRUE),    {wird gezeichnet}
  372.  
  373.  {Farbe blinken lassen:}
  374.        (x1:ToolsX+4*ToolBoxWidth;      y1:ToolsY+37;
  375.         x2:ToolsX+5*ToolBoxWidth-5;    y2:ToolsY+37+32;
  376.         Name1:'';Name2:'';
  377.         Show :DrawBoxBlinkColor;
  378.         Event:EventBlinkColor;
  379.         Click:TRUE;     {Anclicken nötig}
  380.         Paint:TRUE),    {wird gezeichnet}
  381.  
  382.  {Farben austauschen:}
  383.        (x1:ToolsX+4*ToolBoxWidth;      y1:ToolsY;
  384.         x2:ToolsX+5*ToolBoxWidth-5;    y2:ToolsY+32;
  385.         Name1:'';Name2:'';
  386.         Show :DrawBoxChangeColor;
  387.         Event:EventChangeColor;
  388.         Click:TRUE;     {Anclicken nötig}
  389.         Paint:TRUE),    {wird gezeichnet}
  390.  
  391.  {Workareainhalt um 1 Spalte nach links rotieren:}
  392.        (x1:ToolsX+5*ToolBoxWidth;      y1:ToolsY;
  393.         x2:ToolsX+6*ToolBoxWidth-5;    y2:ToolsY+32;
  394.         Name1:'';Name2:'';
  395.         Show :DrawBoxRotateLeft;
  396.         Event:EventRotateLeft;
  397.         Click:TRUE;     {Anclicken nötig}
  398.         Paint:TRUE),    {wird gezeichnet}
  399.  
  400.  {Workareainhalt um 1 Spalte nach rechts rotieren:}
  401.        (x1:ToolsX+6*ToolBoxWidth;      y1:ToolsY;
  402.         x2:ToolsX+7*ToolBoxWidth-5;    y2:ToolsY+32;
  403.         Name1:'';Name2:'';
  404.         Show :DrawBoxRotateRight;
  405.         Event:EventRotateRight;
  406.         Click:TRUE;     {Anclicken nötig}
  407.         Paint:TRUE),    {wird gezeichnet}
  408.  
  409.  {Workareainhalt um 1 Spalte nach oben rotieren:}
  410.        (x1:ToolsX+5*ToolBoxWidth;      y1:ToolsY+37;
  411.         x2:ToolsX+6*ToolBoxWidth-5;    y2:ToolsY+37+32;
  412.         Name1:'';Name2:'';
  413.         Show :DrawBoxRotateUp;
  414.         Event:EventRotateUp;
  415.         Click:TRUE;     {Anclicken nötig}
  416.         Paint:TRUE),    {wird gezeichnet}
  417.  
  418.  {Workareainhalt um 1 Spalte nach unten rotieren:}
  419.        (x1:ToolsX+6*ToolBoxWidth;      y1:ToolsY+37;
  420.         x2:ToolsX+7*ToolBoxWidth-5;    y2:ToolsY+37+32;
  421.         Name1:'';Name2:'';
  422.         Show :DrawBoxRotateDown;
  423.         Event:EventRotateDown;
  424.         Click:TRUE;     {Anclicken nötig}
  425.         Paint:TRUE),    {wird gezeichnet}
  426.  
  427.  {Workareainhalt horizontal spiegeln:}
  428.        (x1:ToolsX+7*ToolBoxWidth;      y1:ToolsY;
  429.         x2:ToolsX+8*ToolBoxWidth-5;    y2:ToolsY+32;
  430.         Name1:'';Name2:'';
  431.         Show :DrawBoxMirrorHorizontal;
  432.         Event:EventMirrorHorizontal;
  433.         Click:TRUE;     {Anclicken nötig}
  434.         Paint:TRUE),    {wird gezeichnet}
  435.  
  436.  {Workareainhalt vertikal spiegeln:}
  437.        (x1:ToolsX+7*ToolBoxWidth;      y1:ToolsY+37;
  438.         x2:ToolsX+8*ToolBoxWidth-5;    y2:ToolsY+37+32;
  439.         Name1:'';Name2:'';
  440.         Show :DrawBoxMirrorVertical;
  441.         Event:EventMirrorVertical;
  442.         Click:TRUE;     {Anclicken nötig}
  443.         Paint:TRUE),    {wird gezeichnet}
  444.  
  445.  {Workareainhalt nach links oben schieben:}
  446.        (x1:ToolsX+8*ToolBoxWidth;      y1:ToolsY;
  447.         x2:ToolsX+9*ToolBoxWidth-5;    y2:ToolsY+32;
  448.         Name1:'';Name2:'';
  449.         Show :DrawBoxObenLinks;
  450.         Event:EventObenLinks;
  451.         Click:TRUE;     {Anclicken nötig}
  452.         Paint:TRUE),    {wird gezeichnet}
  453.  
  454.  {Workarea kann auch als "Menubox" realisiert werden:}
  455.        (x1:WorkStartX;    y1:WorkStartY;
  456.         x2:WorkEndX;      y2:WorkEndY;
  457.         Name1:'';Name2:'';
  458.         Show :Dummy;
  459.         Event:EventInWorkArea;
  460.         Click:FALSE;    {kein Anclicken nötig}
  461.         Paint:FALSE),   {...wird aber nicht gezeichnet}
  462.  
  463.  {Palettenbereich kann auch als "Menubox" realisiert werden:}
  464.        (x1:PaletteX+25;                y1:PaletteY+10;
  465.         x2:PaletteX+25+16*PalBreite-3; y2:PaletteY+10+16*PalHoehe-3;
  466.         Name1:'';Name2:'';
  467.         Show :Dummy;
  468.         Event:EventSelectColor;
  469.         Click:TRUE;     {Anclicken nötig}
  470.         Paint:FALSE),   {...wird aber nicht gezeichnet}
  471.  
  472.  {gesamter Mausbereich kann auch als "Menubox" realisiert werden:}
  473.        (x1:MausMinX;    y1:MausMinY;
  474.         x2:MausMaxX;    y2:MausMaxY;
  475.         Name1:'';Name2:'';
  476.         Show :Dummy;
  477.         Event:EventMouseMoved;
  478.         Click:FALSE;    {kein Anclicken nötig}
  479.         Paint:FALSE),   {...wird aber nicht gezeichnet}
  480.  
  481.  {Sentinelwert, da x1>x2!}
  482.        (x1:1; y1:0; x2:0; y2:0;    
  483.         Name1:'';Name2:'';
  484.         Show :Dummy;
  485.         Event:EventNone;
  486.         Click:TRUE;
  487.         Paint:TRUE)
  488.       );
  489.  
  490. VAR event:BYTE;
  491.  
  492. {Für alle folgenden Draw* -Routinen gilt: beim Aufruf steht in "globalI" }
  493. {der Index der darzustellenden Menubox und diese ist wirklich zu zeichnen}
  494.  
  495. PROCEDURE DrawBasicBox;
  496. {zeichnet eine "nackte" Box}
  497. BEGIN
  498.  WITH Menu[globalI] DO
  499.   BEGIN
  500.    SetFillStyle(SolidFill,BestLightGray);
  501.    Bar(x1,y1,x2,y2);
  502.    SetFillStyle(SolidFill,BestWhite);
  503.    Bar(x1,y1,x2-1,y1+1);
  504.    Bar(x1,y1,x1+1,y2-1);
  505.    SetFillStyle(SolidFill,BestDarkGray);
  506.    Bar(x1,y2-1,x2,y2);
  507.    Bar(x2-1,y1,x2,y2);
  508.   END;
  509. END;
  510.  
  511. PROCEDURE DrawToolPixels;
  512. BEGIN
  513.  DrawBasicBox;
  514.  WITH Menu[globalI] DO
  515.   BEGIN
  516.    SetFillStyle(SolidFill,BestBlack);
  517.    Bar(x1+4,y1+4,x1+4+2,y1+4+2);
  518.    Bar(x1+8,y1+15,x1+8+2,y1+15+2);
  519.    Bar(x1+5,y2-9,x1+5+2,y2-9+2);
  520.    Bar(x2-8,y2-7,x2-8+2,y2-7+2);
  521.    Bar(x1+17,y2-13,x1+17+2,y2-13+2);
  522.    Bar(x2-15,y1+8,x2-15+2,y1+8+2);
  523.    SetFillStyle(SolidFill,BestCyan);
  524.    Bar(x1+9,y1+4,x1+9+2,y1+4+2);
  525.    Bar(x1+15,y1+5,x1+15+2,y1+5+2);
  526.    Bar(x2-5,y2-9,x2-5+2,y2-9+2);
  527.    Bar(x2-13,y2-6,x2-13+2,y2-6+2);
  528.    Bar(x2-12,y1+12,x2-12+2,y1+12+2);
  529.   END;
  530. END;
  531.  
  532. PROCEDURE DrawToolLines;
  533. BEGIN
  534.  DrawBasicBox;
  535.  WITH Menu[globalI] DO
  536.   BEGIN
  537.    SetLineStyle(SolidLn,0,ThickWidth);
  538.    SetColor(BestBlack);
  539.    Line(x1+4,y2-8,x2-4,y1+12);
  540.    SetColor(BestDarkGray);
  541.    Line(x1+8,y1+5,x2-6,y2-7);
  542.    SetColor(BestCyan);
  543.    Line(x1+4,y1+5,x1+10,y2-3);
  544.    SetLineStyle(SolidLn,0,NormWidth);
  545.   END;
  546. END;
  547.  
  548. PROCEDURE DrawToolRectangles;
  549. BEGIN
  550.  DrawBasicBox;
  551.  WITH Menu[globalI] DO
  552.   BEGIN
  553.    SetFillStyle(SolidFill,BestBlack);
  554.    Bar(x1+ 4,y1+12,x1+20,y1+13);
  555.    Bar(x1+20,y1+12,x1+21,y1+27);
  556.    Bar(x1+20,y1+27,x1+ 4,y1+26);
  557.    Bar(x1+ 4,y1+27,x1+ 5,y1+12);
  558.  
  559.    SetFillStyle(SolidFill,BestCyan);
  560.    Bar(x1+ 8,y1+11,x1+ 9,y1+ 6);
  561.    Bar(x1+ 8,y1+ 6,x2- 4,y1+ 7);
  562.    Bar(x2- 4,y1+ 6,x2- 5,y2-12);
  563.    Bar(x2- 4,y2-12,x1+22,y2-13);
  564.   END;
  565. END;
  566.  
  567. PROCEDURE DrawToolEllipses;
  568. BEGIN
  569.  DrawBasicBox;
  570.  WITH Menu[globalI] DO
  571.   BEGIN
  572.    SetColor(BestCyan);
  573.    Ellipse(x1+22,y1+14,273,160,13,6);
  574.    Ellipse(x1+22,y1+14,273,160,14,7);
  575.    SetColor(BestBlack);
  576.    Circle(x1+13,y2-13, 8);
  577.    Circle(x1+13,y2-13, 8+1);
  578.   END;
  579. END;
  580.  
  581. PROCEDURE DrawToolBars;
  582. BEGIN
  583.  DrawBasicBox;
  584.  WITH Menu[globalI] DO
  585.   BEGIN
  586.    SetFillStyle(SolidFill,BestCyan);
  587.    Bar(x1+ 8,y1+ 6,x2- 4,y2-13);
  588.    SetFillStyle(SolidFill,BestBlack);
  589.    Bar(x1+ 4,y1+12,x1+20,y1+27);
  590.   END;
  591. END;
  592.  
  593. PROCEDURE DrawToolDiscs;
  594. VAR i:WORD;
  595. BEGIN
  596.  DrawBasicBox;
  597.  WITH Menu[globalI] DO
  598.   BEGIN
  599.    SetColor(BestCyan);
  600.    SetFillStyle(SolidFill,BestBlack);
  601.    FOR i:=1 TO 7 DO
  602.     Ellipse(x1+22,y1+14,273,160,7+i,i);
  603.    Line(x1+22-14,y1+14,x1+22+14,y1+14);
  604.    SetColor(BestBlack);
  605.    PieSlice(x1+13,y2-13,0,360, 8);
  606.    PieSlice(x1+13,y2-13,0,360, 8+1);
  607.   END;
  608. END;
  609.  
  610. PROCEDURE DrawToolFill;
  611. CONST width=7;
  612.       height=12;
  613. VAR i,tx,ty:WORD;
  614. BEGIN
  615.  DrawBasicBox;
  616.  WITH Menu[globalI] DO
  617.   BEGIN
  618.    tx:=x1+11; ty:=y1+16;
  619.    SetColor(BestWhite);
  620.    FOR i:=1 TO width DO Line(tx+i,ty-i,tx+height+i,ty+height-i);
  621.    SetColor(BestBlack);
  622.    Line(tx+0,ty-0,tx+succ(width),ty-succ(width));
  623.    SetLineStyle(SolidLn,0,ThickWidth);
  624.    Line(tx+0,ty-0,tx+height-1,ty+height-1);
  625.    Line(tx+succ(width),ty-succ(width),
  626.         tx+height+width,ty+height-succ(width)-1);
  627.    Line(tx+height,ty+height-1,tx+height+width,ty+height-succ(width));
  628.    SetLineStyle(SolidLn,0,NormWidth);
  629.    Circle(tx +width+1, ty,2);
  630.    Line(tx +width+1,ty,tx +width+1,ty-10);
  631.    Line(tx +width+7,ty-3,tx +width+7,ty-10-3);
  632.    Line(tx +width+1,ty-10,tx +width+7,ty-10-3);
  633.    SetColor(BestCyan);
  634.    Line(tx,ty-2,tx,ty+height);
  635.    Line(tx-1,ty-1,tx-1,ty+height-2);
  636.    Line(tx-1,ty+2,tx-1,ty+height-4);
  637.    Line(tx-1,ty-1,tx+1,ty-2);
  638.   END;
  639. END;
  640.  
  641. PROCEDURE DrawToolCopy;
  642. CONST
  643.  IconMaxX=23;
  644.  IconMaxY=21;
  645.  dx=10; dy=3;
  646.  s=Black;
  647.  w=White;
  648.  c=Cyan;
  649.  t=255; {transparent}
  650.  IconBorder:ARRAY[0..IconMaxY,0..IconMaxX] OF BYTE=
  651.  (
  652.    {0|0|0|0|0|0|0|0|0|0|1|1|1|1|1|1|1|1|1|1|2|2|2|2}
  653.    {0|1|2|3|4|5|6|7|8|9|0|1|2|3|4|5|6|7|8|9|0|1|2|3}
  654.  
  655.    (t,t,t,t,t,t,t,t,t,t,t,t,t,s,s,s,s,t,t,t,t,t,t,t),
  656.    (t,t,t,t,t,t,t,t,t,t,t,t,s,c,c,c,c,s,t,t,t,t,t,t),
  657.    (t,t,t,t,t,t,t,t,t,t,t,s,c,c,s,s,c,c,s,t,t,t,t,t),
  658.    (t,t,t,t,t,t,t,t,t,t,t,s,c,s,t,t,s,c,s,t,t,t,t,t),
  659.    (t,t,t,t,t,t,t,t,t,t,t,s,c,s,t,t,s,c,s,t,t,t,t,t),
  660.    (t,t,t,t,t,t,t,t,t,t,t,s,c,s,t,s,c,s,t,s,s,s,t,t),
  661.    (t,t,t,t,t,t,t,t,t,t,t,s,c,s,s,c,s,t,s,c,c,c,s,t),
  662.    (t,t,t,t,t,t,t,t,t,t,t,t,s,c,c,s,t,s,c,s,s,c,c,s),
  663.    (t,t,t,t,t,t,t,t,t,t,t,t,s,w,s,t,s,c,s,t,t,s,c,s),
  664.    (t,t,t,t,t,t,t,t,t,t,t,t,s,w,s,s,c,s,t,t,t,s,c,s),
  665.    (t,t,t,t,t,t,t,t,t,t,s,s,w,w,w,w,c,s,s,s,s,c,c,s),
  666.    (t,t,t,t,t,t,t,t,s,s,w,w,s,w,s,s,s,c,c,c,c,c,s,t),
  667.    (t,t,t,t,t,t,s,s,w,w,w,w,w,s,s,t,t,s,s,s,s,s,t,t),
  668.    (t,t,t,t,s,s,w,w,w,w,s,w,w,s,t,t,t,t,t,t,t,t,t,t),
  669.    (t,t,s,s,w,w,w,w,w,s,w,w,s,t,t,t,t,t,t,t,t,t,t,t),
  670.    (t,s,w,w,w,w,w,s,s,w,w,w,s,t,t,t,t,t,t,t,t,t,t,t),
  671.    (s,w,w,w,w,s,s,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t),
  672.    (s,w,w,s,s,t,t,s,w,w,w,s,t,t,t,t,t,t,t,t,t,t,t,t),
  673.    (t,s,s,t,t,t,t,s,w,w,s,t,t,t,t,t,t,t,t,t,t,t,t,t),
  674.    (t,t,t,t,t,t,s,w,w,w,s,t,t,t,t,t,t,t,t,t,t,t,t,t),
  675.    (t,t,t,t,t,t,s,w,w,s,t,t,t,t,t,t,t,t,t,t,t,t,t,t),
  676.    (t,t,t,t,t,t,s,s,s,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t)
  677.  );
  678. VAR x,y:WORD;
  679. BEGIN
  680.  DrawBasicBox;
  681.  WITH Menu[globalI] DO
  682.   BEGIN
  683.    SetColor(BestCyan);
  684.    Rectangle(x1+dx-6,y1+dy+16,x1+dx+16,y1+dy+26);
  685.    FOR y:=0 TO IconMaxY DO
  686.     FOR x:=0 TO IconMaxX DO
  687.      CASE IconBorder[y,x] OF
  688.       t:BEGIN END;
  689.       s:PutPixel(x1+x+dx,y1+y+dy,BestBlack);
  690.       w:PutPixel(x1+x+dx,y1+y+dy,BestWhite);
  691.       c:PutPixel(x1+x+dx,y1+y+dy,BestCyan);
  692.      END;
  693.   END;
  694. END;
  695.  
  696. {Folgende Menuboxen sind keine "Tools" in obigem Sinne, sondern Funktions-}
  697. {buttons:}
  698.  
  699. PROCEDURE DrawFunctionkey;
  700. VAR s:STRING[3];
  701. BEGIN
  702.  WITH Menu[globalI] DO
  703.   BEGIN
  704.    SetFillStyle(SolidFill,BestCyan);
  705.    IF (x1<x2) AND (Paint) THEN
  706.     BEGIN
  707.      SetColor(BestWhite);
  708.      OutTextXY(x1-8,y1+1,'F');
  709.      STR(globalI MOD 10,s);
  710.      OutTextXY(x1-8,y1+1+10,s);
  711.      Bar(x1,y1,x2,y2);
  712.      SetColor(BestBlack);
  713.      OutTextXY(x1+1,y1+1,Name1);
  714.      OutTextXY(x1+1,y1+1+10,Name2);
  715.     END;
  716.   END;
  717. END;
  718.  
  719. PROCEDURE DrawBoxBorders;
  720. CONST
  721.  IconMaxX=35;
  722.  IconMaxY=26;
  723.  dx=3; dy=3;
  724.  s=Black;
  725.  w=White;
  726.  c=Cyan;
  727.  d=DarkGray;
  728.  g=LightGray;
  729.  t=255; {transparent}
  730.  IconBorder:ARRAY[0..IconMaxY,0..IconMaxX] OF BYTE=
  731.  (
  732.    {0|0|0|0|0|0|0|0|0|0|1|1|1|1|1|1|1|1|1|1|2|2|2|2|2|2|2|2|2|2|3|3|3|3|3|3}
  733.    {0|1|2|3|4|5|6|7|8|9|0|1|2|3|4|5|6|7|8|9|0|1|2|3|4|5|6|7|8|9|0|1|2|3|4|5}
  734.  
  735.    (t,t,t,t,t,t,t,t,t,t,t,t,t,s,s,s,s,s,s,s,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t),
  736.    (t,t,t,t,t,t,t,t,t,t,t,s,s,c,c,c,c,c,c,g,s,s,t,t,t,t,t,t,t,t,t,t,t,t,t,t),
  737.    (t,t,t,t,t,t,t,t,t,t,s,c,c,w,w,w,w,w,c,c,c,g,s,t,t,t,t,t,t,t,t,t,t,t,t,t),
  738.    (t,t,t,t,t,t,t,t,t,s,c,c,w,w,c,c,c,c,c,c,c,c,d,s,t,t,t,t,t,t,t,t,t,t,t,t),
  739.    (t,t,t,t,t,t,t,t,t,s,c,w,w,c,g,d,d,d,g,c,c,c,g,s,t,t,t,t,t,t,t,t,t,t,t,t),
  740.    (t,t,t,t,t,t,t,t,s,c,w,w,c,g,d,s,s,s,d,g,c,c,c,d,s,t,t,t,t,t,t,t,t,t,t,t),
  741.    (t,t,t,t,t,t,t,t,s,c,w,w,c,g,s,t,t,t,s,d,c,c,c,d,s,t,t,t,t,t,t,t,t,t,t,t),
  742.    (t,t,t,t,t,t,t,t,s,g,c,c,g,d,s,t,t,t,t,s,c,c,c,d,s,t,t,t,t,t,t,t,t,t,t,t),
  743.    (t,t,t,t,t,t,t,t,t,s,d,d,d,s,t,t,t,t,t,s,c,c,c,d,s,t,t,t,t,t,t,t,t,t,t,t),
  744.    (t,t,t,t,t,t,s,t,t,t,s,s,s,t,t,t,t,t,t,s,c,c,c,d,s,t,t,t,t,s,t,t,t,t,t,t),
  745.    (t,t,t,t,t,s,s,t,t,t,t,t,t,t,t,t,t,s,s,c,c,c,g,d,s,t,t,t,t,s,s,t,t,t,t,t),
  746.    (t,t,t,t,s,w,s,s,s,s,t,t,t,t,t,t,s,c,c,c,c,c,d,s,t,t,s,s,s,s,w,s,t,t,t,t),
  747.    (t,t,t,s,w,w,w,w,w,s,t,t,t,t,t,s,c,c,c,c,c,g,d,s,t,t,s,w,w,w,w,w,s,t,t,t),
  748.    (t,t,s,w,w,w,w,w,w,s,t,t,t,t,s,c,c,w,c,c,g,d,s,t,t,t,s,w,w,w,w,w,w,s,t,t),
  749.    (t,s,w,w,w,w,w,w,w,s,t,t,t,s,c,c,w,c,c,g,d,s,t,t,t,t,s,w,w,w,w,w,w,w,s,t),
  750.    (t,t,s,w,w,w,w,w,w,s,t,t,t,s,c,w,w,c,g,d,s,t,t,t,t,t,s,w,w,w,w,w,w,s,t,t),
  751.    (t,t,t,s,w,w,w,w,w,s,t,t,t,s,c,w,c,g,d,s,t,t,t,t,t,t,s,w,w,w,w,w,s,t,t,t),
  752.    (t,t,t,t,s,w,s,s,s,s,t,t,t,s,c,c,c,c,d,s,t,t,t,t,t,t,s,s,s,s,w,s,t,t,t,t),
  753.    (t,t,t,t,t,s,s,t,t,t,t,t,t,s,g,c,c,g,d,s,t,t,t,t,t,t,t,t,t,s,s,t,t,t,t,t),
  754.    (t,t,t,t,t,t,s,t,t,t,t,t,t,t,s,d,d,d,s,t,t,t,t,t,t,t,t,t,t,s,t,t,t,t,t,t),
  755.    (t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,s,s,s,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t),
  756.    (t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t),
  757.    (t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,s,s,s,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t),
  758.    (t,t,t,t,t,t,t,t,t,t,t,t,t,t,s,c,c,g,s,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t),
  759.    (t,t,t,t,t,t,t,t,t,t,t,t,t,t,s,c,w,c,s,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t),
  760.    (t,t,t,t,t,t,t,t,t,t,t,t,t,t,s,g,c,g,s,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t),
  761.    (t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,s,s,s,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t)
  762.  );
  763. VAR x,y:WORD;
  764. BEGIN
  765.  DrawBasicBox;
  766.  WITH Menu[globalI] DO
  767.   BEGIN
  768.    FOR y:=0 TO IconMaxY DO
  769.     FOR x:=0 TO IconMaxX DO
  770.      CASE IconBorder[y,x] OF
  771.       t:BEGIN END;
  772.       s:PutPixel(x1+x+dx,y1+y+dy,BestBlack);
  773.       w:PutPixel(x1+x+dx,y1+y+dy,BestWhite);
  774.       c:PutPixel(x1+x+dx,y1+y+dy,BestCyan);
  775.       d:PutPixel(x1+x+dx,y1+y+dy,BestDarkGray);
  776.       g:PutPixel(x1+x+dx,y1+y+dy,BestLightGray);
  777.      END;
  778.   END;
  779. END;
  780.  
  781. PROCEDURE DrawBoxBlinkColor;
  782. CONST
  783.  IconMaxX=35;
  784.  IconMaxY=16;
  785.  dx=2; dy=8;
  786.  s=Black;
  787.  w=White;
  788.  d=DarkGray;
  789.  t=255; {transparent}
  790.  IconBorder:ARRAY[0..IconMaxY,0..IconMaxX] OF BYTE=
  791.  (
  792.    {0|0|0|0|0|0|0|0|0|0|1|1|1|1|1|1|1|1|1|1|2|2|2|2|2|2|2|2|2|2|3|3|3|3|3|3}
  793.    {0|1|2|3|4|5|6|7|8|9|0|1|2|3|4|5|6|7|8|9|0|1|2|3|4|5|6|7|8|9|0|1|2|3|4|5}
  794.  
  795.    (t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,s,t,t,t,t,t,t,s,t,t,t,t,t,t,t,t),
  796.    (t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,s,t,t,t,t,s,t,t,t,t,s,t,t,t,t,t,s,t,t,t),
  797.    (t,d,d,d,d,d,d,t,t,t,t,t,t,t,t,t,t,s,t,t,t,t,t,t,t,t,t,t,t,t,t,s,t,t,t,t),
  798.    (t,d,d,d,d,d,d,t,t,t,t,t,t,t,t,t,t,t,s,t,t,t,s,s,s,s,s,t,t,t,s,t,t,t,t,t),
  799.    (t,d,d,d,d,d,d,t,t,t,t,s,t,t,t,t,t,t,t,t,s,s,w,w,w,w,w,s,s,t,t,t,t,t,t,t),
  800.    (t,d,d,d,d,d,d,t,t,t,t,s,s,t,t,t,t,t,t,t,s,w,s,s,w,w,w,w,s,t,t,t,t,t,t,t),
  801.    (t,d,d,d,d,d,d,t,s,s,s,s,w,s,t,t,s,t,t,s,w,s,s,w,w,w,w,w,w,s,t,t,t,t,s,s),
  802.    (t,d,d,d,d,d,d,t,s,w,w,w,w,w,s,t,t,s,t,s,w,s,s,w,w,w,w,w,w,s,t,t,s,s,t,t),
  803.    (t,d,d,d,d,d,d,t,s,w,w,w,w,w,w,s,t,t,t,t,s,w,w,w,w,w,w,w,s,t,t,t,t,t,t,t),
  804.    (t,d,d,d,d,d,d,t,s,w,w,w,w,w,w,w,s,t,t,t,s,w,w,w,w,w,w,w,s,t,t,t,t,t,t,t),
  805.    (t,d,d,d,d,d,d,t,s,w,w,w,w,w,w,s,t,t,s,t,t,s,w,w,w,w,w,s,t,t,s,t,t,t,t,t),
  806.    (t,d,d,d,d,d,d,t,s,w,w,w,w,w,s,t,s,s,t,t,t,t,s,s,s,w,s,t,t,t,t,s,s,t,t,t),
  807.    (t,d,d,d,d,d,d,t,s,s,s,s,w,s,t,t,t,t,t,t,t,t,s,w,w,s,s,t,t,t,t,t,t,t,t,t),
  808.    (t,d,d,d,d,d,d,t,t,t,t,s,s,t,t,t,t,t,t,t,t,t,s,s,s,s,s,t,t,t,t,t,t,t,t,t),
  809.    (t,d,d,d,d,d,d,t,t,t,t,s,t,t,t,t,t,t,t,t,t,t,s,s,s,w,s,t,t,t,t,t,t,t,t,t),
  810.    (t,d,d,d,d,d,d,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,s,w,w,s,s,t,t,t,t,t,t,t,t,t),
  811.    (t,d,d,d,d,d,d,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,s,s,s,t,t,t,t,t,t,t,t,t,t)
  812.  );
  813. VAR x,y:WORD;
  814. BEGIN
  815.  DrawBasicBox;
  816.  WITH Menu[globalI] DO
  817.   BEGIN
  818.    FOR y:=0 TO IconMaxY DO
  819.     FOR x:=0 TO IconMaxX DO
  820.      CASE IconBorder[y,x] OF
  821.       t:BEGIN END;
  822.       s:PutPixel(x1+x+dx,y1+y+dy,BestBlack);
  823.       w:PutPixel(x1+x+dx,y1+y+dy,BestWhite);
  824.       d:PutPixel(x1+x+dx,y1+y+dy,BestDarkGray);
  825.      END;
  826.   END;
  827. END;
  828.  
  829. PROCEDURE DrawBoxChangeColor;
  830. CONST
  831.  IconMaxX=26;
  832.  IconMaxY=16;
  833.  dx=7; dy=8;
  834.  s=Black;
  835.  w=White;
  836.  d=DarkGray;
  837.  c=Cyan;
  838.  t=255; {transparent}
  839.  IconBorder:ARRAY[0..IconMaxY,0..IconMaxX] OF BYTE=
  840.  (
  841.    {0|0|0|0|0|0|0|0|0|0|1|1|1|1|1|1|1|1|1|1|2|2|2|2|2|2|2|2|2|2|3|3|3|3|3|3}
  842.    {0|1|2|3|4|5|6|7|8|9|0|1|2|3|4|5|6|7|8|9|0|1|2|3|4|5|6|7|8|9|0|1|2|3|4|5}
  843.  
  844.    (t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t),
  845.    (t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t),
  846.    (d,d,d,d,d,d,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,c,c,c,c,c,c),
  847.    (d,d,d,d,d,d,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,c,c,c,c,c,c),
  848.    (d,d,d,d,d,d,t,t,t,t,t,t,s,t,t,t,t,t,t,t,t,c,c,c,c,c,c),
  849.    (d,d,d,d,d,d,t,t,t,t,t,t,s,s,t,t,t,t,t,t,t,c,c,c,c,c,c),
  850.    (d,d,d,d,d,d,t,t,t,s,s,s,s,w,s,t,t,t,t,t,t,c,c,c,c,c,c),
  851.    (d,d,d,d,d,d,t,t,t,s,w,w,w,w,w,s,t,t,t,t,t,c,c,c,c,c,c),
  852.    (d,d,d,d,d,d,t,t,t,s,w,w,w,w,w,w,s,t,t,t,t,c,c,c,c,c,c),
  853.    (d,d,d,d,d,d,t,t,t,s,w,w,w,w,w,w,w,s,t,t,t,c,c,c,c,c,c),
  854.    (d,d,d,d,d,d,t,t,t,s,w,w,w,w,w,w,s,t,t,t,t,c,c,c,c,c,c),
  855.    (d,d,d,d,d,d,t,t,t,s,w,w,w,w,w,s,t,t,t,t,t,c,c,c,c,c,c),
  856.    (d,d,d,d,d,d,t,t,t,s,s,s,s,w,s,t,t,t,t,t,t,c,c,c,c,c,c),
  857.    (d,d,d,d,d,d,t,t,t,t,t,t,s,s,t,t,t,t,t,t,t,c,c,c,c,c,c),
  858.    (d,d,d,d,d,d,t,t,t,t,t,t,s,t,t,t,t,t,t,t,t,c,c,c,c,c,c),
  859.    (d,d,d,d,d,d,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,c,c,c,c,c,c),
  860.    (d,d,d,d,d,d,t,t,t,t,t,t,t,t,t,t,t,t,t,t,t,c,c,c,c,c,c)
  861.  );
  862. VAR x,y:WORD;
  863. BEGIN
  864.  DrawBasicBox;
  865.  WITH Menu[globalI] DO
  866.   BEGIN
  867.    FOR y:=0 TO IconMaxY DO
  868.     FOR x:=0 TO IconMaxX DO
  869.      CASE IconBorder[y,x] OF
  870.       t:BEGIN END;
  871.       s:PutPixel(x1+x+dx,y1+y+dy,BestBlack);
  872.       w:PutPixel(x1+x+dx,y1+y+dy,BestWhite);
  873.       d:PutPixel(x1+x+dx,y1+y+dy,BestDarkGray);
  874.       c:PutPixel(x1+x+dx,y1+y+dy,BestCyan);
  875.      END;
  876.   END;
  877. END;
  878.  
  879. PROCEDURE DrawBoxRotateLeft;
  880. VAR miX,miY:INTEGER;
  881. BEGIN
  882.  DrawBasicBox;
  883.  WITH Menu[globalI] DO
  884.   BEGIN
  885.    SetColor(BestBlack);
  886.    miX:=(x1+x2) SHR 1; miY:=(y1+y2) SHR 1;
  887.    Ellipse(miX,miY, 0,360, 13,5);
  888.    Ellipse(miX,miY, 0,360, 13-1,5-1);
  889.    Line(miX-3,miY+4,miX+3,miY+4-3);
  890.    Line(miX-2,miY+4,miX+4,miY+4-3);
  891.    Line(miX-3,miY+5,miX+3,miY+5+3);
  892.    Line(miX-2,miY+5,miX+4,miY+5+3);
  893.   END;
  894. END;
  895.  
  896. PROCEDURE DrawBoxRotateRight;
  897. VAR miX,miY:INTEGER;
  898. BEGIN
  899.  DrawBasicBox;
  900.  WITH Menu[globalI] DO
  901.   BEGIN
  902.    SetColor(BestBlack);
  903.    miX:=(x1+x2) SHR 1; miY:=(y1+y2) SHR 1;
  904.    Ellipse(miX,miY, 0,360, 13,5);
  905.    Ellipse(miX,miY, 0,360, 13-1,5-1);
  906.    Line(miX-3,miY+4-3,miX+3,miY+4);
  907.    Line(miX-2,miY+4-3,miX+4,miY+4);
  908.    Line(miX-3,miY+5+3,miX+3,miY+5);
  909.    Line(miX-2,miY+5+3,miX+4,miY+5);
  910.   END;
  911. END;
  912.  
  913. PROCEDURE DrawBoxRotateUp;
  914. VAR miX,miY:INTEGER;
  915. BEGIN
  916.  DrawBasicBox;
  917.  WITH Menu[globalI] DO
  918.   BEGIN
  919.    SetColor(BestBlack);
  920.    miX:=(x1+x2) SHR 1; miY:=(y1+y2) SHR 1;
  921.    Ellipse((x1+x2) SHR 1,(y1+y2) SHR 1, 0,360, 7,12);
  922.    Ellipse((x1+x2) SHR 1,(y1+y2) SHR 1, 0,360, 7-1,12-1);
  923.    Line(miX-7-4,miY+3,miX-7-1,miY-2);
  924.    Line(miX-7-4,miY+2,miX-7-1,miY-1);
  925.    Line(miX-7+5,miY+3,miX-7+2,miY-2);
  926.    Line(miX-7+5,miY+2,miX-7+2,miY-1);
  927.   END;
  928. END;
  929.  
  930. PROCEDURE DrawBoxRotateDown;
  931. VAR miX,miY:INTEGER;
  932. BEGIN
  933.  DrawBasicBox;
  934.  WITH Menu[globalI] DO
  935.   BEGIN
  936.    SetColor(BestBlack);
  937.    miX:=(x1+x2) SHR 1; miY:=(y1+y2) SHR 1;
  938.    Ellipse((x1+x2) SHR 1,(y1+y2) SHR 1, 0,360, 7,12);
  939.    Ellipse((x1+x2) SHR 1,(y1+y2) SHR 1, 0,360, 7-1,12-1);
  940.    Line(miX-7-4,miY-2,miX-7-1,miY+3);
  941.    Line(miX-7-4,miY-1,miX-7-1,miY+2);
  942.    Line(miX-7+5,miY-2,miX-7+2,miY+3);
  943.    Line(miX-7+5,miY-1,miX-7+2,miY+2);
  944.   END;
  945. END;
  946.  
  947. PROCEDURE DrawBoxMirrorHorizontal;
  948. CONST
  949.  IconMaxX=25;
  950.  IconMaxY=8;
  951.  dx=7; dy=3;
  952.  s=Black;
  953.  w=White;
  954.  t=255; {transparent}
  955.  IconBorder:ARRAY[0..IconMaxY,0..IconMaxX] OF BYTE=
  956.  (
  957.    {0|0|0|0|0|0|0|0|0|0|1|1|1|1|1|1|1|1|1|1|2|2|2|2|2|2}
  958.    {0|1|2|3|4|5|6|7|8|9|0|1|2|3|4|5|6|7|8|9|0|1|2|3|4|5}
  959.  
  960.    (t,s,t,t,t,t,s,t,t,t,t,t,t,t,t,t,s,t,t,t,t,s,t,t,t,t),
  961.    (s,s,t,t,t,t,s,s,t,t,t,t,t,t,t,s,s,t,t,t,t,s,s,t,t,t),
  962.    (w,s,s,s,s,s,s,w,s,t,t,t,t,t,s,w,s,s,s,s,s,s,w,s,t,t),
  963.    (w,w,w,w,w,w,w,w,w,s,t,t,t,s,w,w,w,w,w,w,w,w,w,w,s,t),
  964.    (w,w,w,w,w,w,w,w,w,w,s,t,s,w,w,w,w,w,w,w,w,w,w,w,w,s),
  965.    (w,w,w,w,w,w,w,w,w,s,t,t,t,s,w,w,w,w,w,w,w,w,w,w,s,t),
  966.    (w,s,s,s,s,s,s,w,s,t,t,t,t,t,s,w,s,s,s,s,s,s,w,s,t,t),
  967.    (s,s,t,t,t,t,s,s,t,t,t,t,t,t,t,s,s,t,t,t,t,s,s,t,t,t),
  968.    (t,s,t,t,t,t,s,t,t,t,t,t,t,t,t,t,s,t,t,t,t,s,t,t,t,t)
  969.  );
  970. VAR x,y:WORD;
  971. BEGIN
  972.  DrawBasicBox;
  973.  WITH Menu[globalI] DO
  974.   BEGIN
  975.    SetColor(BestBlack);
  976.    Line(x1+dx,y1+dy+9,x1+dx+19,y1+dy);
  977.    Line(x1+dx,y1+dy+9+18,x1+dx+19,y1+dy+18);
  978.    Line(x1+dx,y1+dy+9,x1+dx,y1+dy+9+18);
  979.    Line(x1+dx+19,y1+dy,x1+dx+19,y1+dy+18);
  980.    FOR y:=0 TO IconMaxY DO
  981.     FOR x:=0 TO IconMaxX DO
  982.      CASE IconBorder[y,x] OF
  983.       t:BEGIN END;
  984.       s:PutPixel(x1+x+dx+1,y1+y+dy+9,BestBlack);
  985.       w:PutPixel(x1+x+dx+1,y1+y+dy+9,BestWhite);
  986.      END;
  987.   END;
  988. END;
  989.  
  990. PROCEDURE DrawBoxMirrorVertical;
  991. CONST
  992.  IconMaxX=8;
  993.  IconMaxY=21;
  994.  dx=4; dy=5;
  995.  s=Black;
  996.  w=White;
  997.  t=255; {transparent}
  998.  IconBorder:ARRAY[0..IconMaxY,0..IconMaxX] OF BYTE=
  999.  (
  1000.    {0|1|2|3|4|5|6|7|8}
  1001.  
  1002.    (t,t,t,t,s,t,t,t,t),
  1003.    (t,t,t,s,w,s,t,t,t),
  1004.    (t,t,s,w,w,w,s,t,t),
  1005.    (t,s,w,w,w,w,w,s,t),
  1006.    (s,s,s,w,w,w,s,s,s),
  1007.    (t,t,s,w,w,w,s,t,t),
  1008.    (t,t,s,w,w,w,s,t,t),
  1009.    (t,t,s,w,w,w,s,t,t),
  1010.    (t,t,s,w,w,w,s,t,t),
  1011.    (s,s,s,w,w,w,s,s,s),
  1012.    (t,s,w,w,w,w,w,s,t),
  1013.    (t,t,s,w,w,w,s,t,t),
  1014.    (t,t,t,s,w,s,t,t,t),
  1015.    (t,t,t,t,s,t,t,t,t),
  1016.    (t,t,t,t,t,t,t,t,t),
  1017.    (t,t,t,t,s,t,t,t,t),
  1018.    (t,t,t,s,w,s,t,t,t),
  1019.    (t,t,s,w,w,w,s,t,t),
  1020.    (t,s,w,w,w,w,w,s,t),
  1021.    (s,s,s,w,w,w,s,s,s),
  1022.    (t,t,s,w,w,w,s,t,t),
  1023.    (t,t,s,w,w,w,s,t,t)
  1024.  );
  1025. VAR x,y:WORD;
  1026. BEGIN
  1027.  DrawBasicBox;
  1028.  WITH Menu[globalI] DO
  1029.   BEGIN
  1030.    SetColor(BestBlack);
  1031.    Line(x1+dx+11,y1+dy+11,x1+dx+32,y1+dy+11);
  1032.    Line(x1+dx,y1+dy+22,x1+dx+21,y1+dy+22);
  1033.    Line(x1+dx,y1+dy+22,x1+dx+11,y1+dy+11);
  1034.    Line(x1+dx+21,y1+dy+22,x1+dx+32,y1+dy+11);
  1035.    FOR y:=0 TO IconMaxY DO
  1036.     FOR x:=0 TO IconMaxX DO
  1037.      CASE IconBorder[y,x] OF
  1038.       t:BEGIN END;
  1039.       s:PutPixel(x1+x+dx+12,y1+y+dy,BestBlack);
  1040.       w:PutPixel(x1+x+dx+12,y1+y+dy,BestWhite);
  1041.      END;
  1042.   END;
  1043. END;
  1044.  
  1045. PROCEDURE DrawBoxObenLinks;
  1046. CONST
  1047.  IconMaxX=7;
  1048.  IconMaxY=6;
  1049.  dx=4; dy=3;
  1050.  s=Black;
  1051.  w=White;
  1052.  t=255; {transparent}
  1053.  IconBorder:ARRAY[0..IconMaxY,0..IconMaxX] OF BYTE=
  1054.  (
  1055.    {0|1|2|3|4|5|6|7}
  1056.  
  1057.    (s,s,s,s,s,s,s,t),
  1058.    (s,w,w,w,w,s,t,t),
  1059.    (s,w,w,w,w,w,s,t),
  1060.    (s,w,w,w,w,w,w,s),
  1061.    (s,s,w,w,w,w,s,t),
  1062.    (s,t,s,w,w,s,t,t),
  1063.    (t,t,t,s,s,t,t,t)
  1064.  );
  1065. VAR x,y:WORD;
  1066. BEGIN
  1067.  DrawBasicBox;
  1068.  WITH Menu[globalI] DO
  1069.   BEGIN
  1070.    SetColor(BestBlack);
  1071.    Line(x1+dx,y1+dy,x1+dx+30,y1+dy);
  1072.    Line(x1+dx,y1+dy,x1+dx,y1+dy+25);
  1073.    Rectangle(x1+dx+3,y1+dy+3,x1+dx+3+9,y1+dy+3+8);
  1074.    Rectangle(x1+dx+3+18,y1+dy+3+15,x1+dx+3+18+9,y1+dy+3+15+8);
  1075.    FOR y:=0 TO IconMaxY DO
  1076.     FOR x:=0 TO IconMaxX DO
  1077.      CASE IconBorder[y,x] OF
  1078.       t:BEGIN END;
  1079.       s:PutPixel(x1+x+dx+14,y1+y+dy+12,BestBlack);
  1080.       w:PutPixel(x1+x+dx+14,y1+y+dy+12,BestWhite);
  1081.      END;
  1082.   END;
  1083. END;
  1084.  
  1085. {----------Maus-Routinen----------}
  1086. CONST MouseMoved=1;
  1087.       LeftButtonPressed=2;
  1088.       LeftButtonReleased=4;
  1089.       RightButtonPressed=8;
  1090.       RightButtonReleased=16;
  1091.       w=White;
  1092.       b=Black;
  1093.       t=255; {durchsichtig}
  1094.       SuppressMouse:BOOLEAN=FALSE;
  1095. TYPE  MausCursor=RECORD
  1096.        data:ARRAY[0..CursorMaxY,0..CursorMaxX] OF BYTE;
  1097.        hotX,hotY:BYTE;
  1098.       END;
  1099.  
  1100. CONST CursorPfeil:MausCursor=
  1101.       ( data:(
  1102.         (w,b,t,t,t,t,t,t,t,t,t,t),
  1103.         (w,w,b,t,t,t,t,t,t,t,t,t),
  1104.         (w,w,w,w,b,t,t,t,t,t,t,t),
  1105.         (w,w,w,w,w,b,t,t,t,t,t,t),
  1106.         (w,w,w,w,w,w,w,b,t,t,t,t),
  1107.         (w,w,w,w,w,w,w,w,b,t,t,t),
  1108.         (w,w,w,w,w,w,w,w,w,w,b,t),
  1109.         (w,w,w,w,w,w,w,w,w,w,w,b),
  1110.         (w,w,w,t,w,w,w,b,t,t,t,t),
  1111.         (w,w,t,t,t,w,w,w,b,t,t,t),
  1112.         (t,t,t,t,t,w,w,w,b,t,t,t),
  1113.         (t,t,t,t,t,t,w,w,w,b,t,t),
  1114.         (t,t,t,t,t,t,w,w,w,b,t,t),
  1115.         (t,t,t,t,t,t,t,w,w,t,t,t));
  1116.         hotx:0; hoty:0);
  1117.  
  1118.       CursorKreuz:MausCursor=
  1119.       ( data:(
  1120.         (t,t,t,t,w,t,t,t,t,t,t,t),
  1121.         (t,t,t,t,w,t,t,t,t,t,t,t),
  1122.         (t,t,t,t,w,t,t,t,t,t,t,t),
  1123.         (t,t,t,t,t,t,t,t,t,t,t,t),
  1124.         (w,w,w,t,t,t,w,w,w,t,t,t),
  1125.         (t,t,t,t,t,t,t,t,t,t,t,t),
  1126.         (t,t,t,t,w,t,t,t,t,t,t,t),
  1127.         (t,t,t,t,w,t,t,t,t,t,t,t),
  1128.         (t,t,t,t,w,t,t,t,t,t,t,t),
  1129.         (t,t,t,t,t,t,t,t,t,t,t,t),
  1130.         (t,t,t,t,t,t,t,t,t,t,t,t),
  1131.         (t,t,t,t,t,t,t,t,t,t,t,t),
  1132.         (t,t,t,t,t,t,t,t,t,t,t,t),
  1133.         (t,t,t,t,t,t,t,t,t,t,t,t));
  1134.         hotx:4; hoty:4);
  1135.  
  1136. VAR   Aufrufmaske,Maustasten:WORD;
  1137.       MausX,MausY,MausAbsX,MausAbsY:INTEGER;
  1138.       mouseX2,mouseY2:INTEGER; {interne Mauskoordinaten}
  1139.       MouseMemSize:WORD;       {Größe des MouseMem-Speichers}
  1140.       oldMouse:RECORD
  1141.                 MouseMem:POINTER; {Speicher für Mauscursordaten}
  1142.                 oldX,oldY:WORD;   {alte Mauskoordinaten}
  1143.                END;
  1144.       MouseUpdate:BOOLEAN;
  1145.       LeftButton,RightButton:BOOLEAN;
  1146.       regs:REGISTERS;
  1147.  
  1148. FUNCTION min(a,b:INTEGER):INTEGER;
  1149. BEGIN
  1150.  IF a<=b THEN min:=a ELSE min:=b
  1151. END;
  1152.  
  1153. FUNCTION max(a,b:INTEGER):INTEGER;
  1154. BEGIN
  1155.  IF a>=b THEN max:=a ELSE max:=b
  1156. END;
  1157.  
  1158. FUNCTION min3(a,b,c:INTEGER):INTEGER;
  1159. BEGIN
  1160.  min3:=min(a,min(b,c))
  1161. END;
  1162.  
  1163. FUNCTION max3(a,b,c:INTEGER):INTEGER;
  1164. BEGIN
  1165.  max3:=max(a,max(b,c))
  1166. END;
  1167.  
  1168. FUNCTION InWorkArea:BOOLEAN;
  1169. { in: MausX,MausY = momentane Mauskoordinaten}
  1170. {     WorkStartX|Y, WorkEndX|Y = Koord. der Workarea}
  1171. {out: TRUE|FALSE, wenn Mauscursor in Workarea}
  1172. BEGIN
  1173.  InWorkArea:=(WorkStartX<=MausX) AND (MausX<=WorkEndX) AND
  1174.              (WorkStartY<=MausY) AND (MausY<=WorkEndY)
  1175. END;
  1176.  
  1177. FUNCTION MouseEvent(VAR menu):BYTE;
  1178. { in: MausX,MausY = aktuelle Mausposition}
  1179. {     LeftButton, RightButton = TRUE, wenn Mausbutton gedrückt}
  1180. {     Shift = TRUE, falls Shifttaste während des Mausclicks gedrückt  }
  1181. {             worden ist}
  1182. {     menu = Array vom Typ "boxes", das die Menuboxkoordinaten enthält}
  1183. {     EventNone = Rückgabewert, falls Maus in keinem der Felder steht }
  1184. {out: Der Index desjenigen "menu"-Eintrages, in dem die Maus steht;   }
  1185. {     sollte dies keiner sein, so wird "EventNone"=0 zurückgegeben    }
  1186. {rem: Das Ende der Menueinträge muß durch einen Eintrag mit x1>x2 an- }
  1187. {     gegeben werden!}
  1188. VAR i:BYTE;
  1189.     a:boxes ABSOLUTE menu;
  1190. BEGIN
  1191.  i:=1;
  1192.  WHILE (a[i].x1<=a[i].x2) DO
  1193.   BEGIN
  1194.    WITH a[i] DO
  1195.    IF (x1<=MausX) AND (MausX<=x2) AND (y1<=MausY) AND (MausY<=y2)
  1196.       AND ( (NOT click) OR (LeftButton OR RightButton) )
  1197.     THEN BEGIN
  1198.           IF NOT Shift THEN MouseEvent:=Event
  1199.           ELSE CASE Event OF
  1200.                 EventMapPalette :MouseEvent:=EventMapToBIOSPalette;
  1201.                 EventLadePalette:MouseEvent:=EventResetColors;
  1202.                 else MouseEvent:=Event
  1203.                END;
  1204.  
  1205.           exit
  1206.          END
  1207.     ELSE INC(i)
  1208.    END;
  1209.  MouseEvent:=EventNone;
  1210. END;
  1211.  
  1212. PROCEDURE DrawMaus(VAR Cursor:MausCursor);
  1213. { in: Cursor = aktueller, anzuzeigender Mauscursor}
  1214. {     MausX,MausY = Koordinaten für Mauscursor}
  1215. {     oldMouse.MouseMem^ = Platz für Grafikausschnitt unter Mauscursor}
  1216. {out: oldMouse.* = gerettete Grafikdaten}
  1217. {rem: Der Speicherplatz MouseMem^ muß bereits reserviert worden sein  }
  1218. {     Obwohl die Routine "Cursor" nicht verändert, wird als VAR-Para- }
  1219. {     meter übergeben, da dann nur ein Zeiger übergeben wird!}
  1220. VAR i,j,xr,yr:WORD;
  1221. BEGIN
  1222.  WITH Cursor DO
  1223.   BEGIN
  1224.    xr:=max(MausX-hotx,0); yr:=max(MausY-hoty,0); {nur Onscreen-Teile retten!}
  1225.    GetImage(xr,yr,xr+CursorMaxX,yr+CursorMaxY,oldMouse.MouseMem^);
  1226.    oldMouse.oldx:=xr; oldMouse.oldY:=yr;
  1227.    FOR i:=0 TO CursorMaxX DO
  1228.     FOR j:=0 TO CursorMaxY DO
  1229.      IF data[j,i]=Black THEN PutPixel(xr+i,yr+j,BestBlack)
  1230.      ELSE IF data[j,i]=White THEN PutPixel(xr+i,yr+j,BestWhite)
  1231.   END;
  1232. END;
  1233.  
  1234. PROCEDURE UnDrawMaus;
  1235. { in: oldMouse.* = zu restaurierende Grafikdaten}
  1236. BEGIN
  1237.  WITH oldMouse DO PutImage(oldX,oldY,MouseMem^,NormalPut)
  1238. END;
  1239.  
  1240. FUNCTION MouseInstalled : Boolean;
  1241. { in: - }
  1242. {out: TRUE|FALSE für: Maus gefunden/nicht gefunden}
  1243. VAR INT33h:POINTER;
  1244. BEGIN
  1245.  GetIntVec($33,INT33h);
  1246.  IF (BYTE(INT33h^)=$CF) OR (LONGINT(INT33h)=0)
  1247.   THEN MouseInstalled:=FALSE  {nur IRET oder Nullpointer}
  1248.   ELSE BEGIN {INT33h führt nicht ins Nirwana, trau dich!}
  1249.         WRITELN(10);
  1250.      (* regs.ax := 0;   {Ja hallo, gibt's hier ne Maus im System?}
  1251.         Intr($33,regs);
  1252.         MouseInstalled:=(regs.ax=$FFFF); *)
  1253.         ASM
  1254.           PUSHF
  1255.           CLI
  1256.           PUSH BX
  1257.           PUSH CX
  1258.           PUSH DX
  1259.           PUSH SI
  1260.           PUSH DI
  1261.           PUSH BP
  1262.           PUSH ES
  1263.           PUSH DS
  1264.  
  1265.           mov ax,0
  1266.           int 33h
  1267.  
  1268.           POP DS
  1269.           POP ES
  1270.           POP BP
  1271.           POP DI
  1272.           POP SI
  1273.           POP DX
  1274.           POP CX
  1275.           POP BX
  1276.           STI
  1277.           POPF
  1278.  
  1279.           CMP AX,$FFFF
  1280.           JNE @noMouse
  1281.           MOV @Result,TRUE
  1282.           JMP @done
  1283.          @noMouse:
  1284.           MOV @Result,FALSE
  1285.          @done:
  1286.         END;
  1287.         WRITELN(9);
  1288.        END;
  1289. END;
  1290.  
  1291. PROCEDURE DisableMouse;
  1292. inline($B0/<BYTE(TRUE)/     {MOV AL,TRUE}
  1293.        $A2/SuppressMouse);  {MOV SuppressMouse,AL}
  1294.  
  1295. PROCEDURE EnableMouse;
  1296. inline($B0/<BYTE(FALSE)/    {MOV AL,FALSE}
  1297.        $A2/SuppressMouse);  {MOV SuppressMouse,AL}
  1298.  
  1299. PROCEDURE ClearMouse;
  1300. BEGIN
  1301.  MouseUpdate:=FALSE; LeftButton:=FALSE; RightButton:=FALSE;
  1302.  EnableMouse;
  1303. END;
  1304.  
  1305. {$S-}
  1306. PROCEDURE MouseCallBack; FAR;
  1307. { in: mouseX2,mouseY2 = alte Mauskoordinaten}
  1308. {     SuppressMouse = TRUE falls Mausereignis ignoriert werden soll}
  1309. {     MausMinX,MausMinY = minimal zulässige Mauskoordinaten}
  1310. {     MausMaxX,MausMaxY = maximal zulässige Mauskoordinaten}
  1311. {out: Falls SuppressMouse=FALSE war, wurden folgende Variablen neugesetzt:}
  1312. {     MouseUpdate = TRUE}
  1313. {     MPressed = TRUE, falls linker Button gedrückt}
  1314. {     Shift = TRUE, falls eine der Shifttasten gedrückt wurde}
  1315. {     MausX,MausY = aktuelle Mauskoordinaten}
  1316. {     SuppressMouse = TRUE}
  1317. {rem: Diese Prozedur entspricht einer Interrupt-Service-Routine, die}
  1318. {     immer dann aufgerufen wird, wenn eine der bei ihrer Initialisierung}
  1319. {     angegebenen Aufrufbedingungen erfüllt ist}
  1320. {     MouseUpdate = TRUE impliziert SuppressMouse:=TRUE, d.h.: die weitere}
  1321. {     Aktualisierung von Mausdaten ist solange gesperrt, bis die alten   }
  1322. {     verarbeitet wurden und die Maus mit "EnableMouse()" wieder freige- }
  1323. {     geben wird!}
  1324. BEGIN
  1325.  ASM
  1326.   pushf
  1327.   push ax
  1328.   push bx
  1329.   push cx
  1330.   push dx
  1331.   push si
  1332.   push di
  1333.   push bp
  1334.   push ds
  1335.   push es
  1336.   mov bp,SEG @DATA
  1337.   mov DS,bp
  1338.  
  1339.   CMP SuppressMouse,TRUE {soll Maus überhaupt behandelt werden?}
  1340.   JE @quit
  1341.  
  1342.   MOV AufrufMaske,AX
  1343.   MOV MausTasten,BX
  1344.   MOV MausX,CX
  1345.   MOV MausY,DX
  1346.   MOV MausAbsX,SI
  1347.   MOV MausAbsY,DI
  1348.  
  1349.   MOV MouseUpdate,TRUE
  1350.   MOV DX,AX
  1351.   AND AX,LeftButtonPressed
  1352.   JE @noLeftButton
  1353.   MOV LeftButton,TRUE
  1354.  @noLeftButton:
  1355.   AND DX,RightButtonPressed
  1356.   JE @noRightButton
  1357.   MOV RightButton,TRUE
  1358.  @noRightButton:
  1359.  
  1360.   XOR AX,AX       {Shift-Status der Tastatur auslesen:}
  1361.   MOV ES,AX       {steht in mem[$40:$17] in den untersten 2 Bits}
  1362.   MOV SI,417h
  1363.   MOV AL,ES:[SI]
  1364.   AND AL,3
  1365.   JE @noShift
  1366.   MOV Shift,TRUE
  1367.   JMP @L1
  1368.  @noShift:
  1369.   MOV Shift,FALSE
  1370.  
  1371.  @L1:
  1372.   MOV AX,11
  1373.   INT 33h         {Koordinatenänderung einlesen}
  1374.   MOV AX,mouseX2  {und Mauskoordinaten aktualisieren}
  1375.   ADD AX,CX
  1376.   CMP AX,MausMinX*2  {mouseX2:=max(MausMinX*2,mouseX2)}
  1377.   JGE @noSmall1
  1378.   MOV AX,MausMinX*2
  1379.  @noSmall1:
  1380.   CMP AX,MausMaxX*2  {mouseX2:=min(MausMaxX*2,mouseX2)}
  1381.   JLE @noBig1
  1382.   MOV AX,MausMaxX*2
  1383.  @noBig1:
  1384.   MOV mouseX2,AX
  1385.   SHR AX,1        {dem doofen Treiber doch noch eine Auflösung}
  1386.   MOV MausX,AX    {von 640x400 Punkten abringen}
  1387.  
  1388.   MOV AX,mouseY2
  1389.   ADD AX,DX
  1390.   CMP AX,MausMinY*2  {mouseY2:=max(MausMinY*2,mouseY2)}
  1391.   JGE @noSmall2
  1392.   MOV AX,MausMinY*2
  1393.  @noSmall2:
  1394.   CMP AX,MausMaxY*2  {mouseY2:=min(MausMaxY*2,mouseY2)}
  1395.   JLE @noBig2
  1396.   MOV AX,MausMaxY*2
  1397.  @noBig2:
  1398.   MOV mouseY2,AX
  1399.   SHR AX,1
  1400.   MOV MausY,AX
  1401.  
  1402.   MOV SuppressMouse,TRUE
  1403.  
  1404.  @quit:
  1405.   pop es
  1406.   pop ds
  1407.   pop bp
  1408.   pop di
  1409.   pop si
  1410.   pop dx
  1411.   pop cx
  1412.   pop bx
  1413.   pop ax
  1414.   popf
  1415.  END;
  1416. END;
  1417. {$S+}
  1418.  
  1419. PROCEDURE PushAll;
  1420. INLINE(
  1421.   $9C/   { PUSHF     }
  1422.   $50/   { PUSH   AX }
  1423.   $53/   { PUSH   BX }
  1424.   $51/   { PUSH   CX }
  1425.   $52/   { PUSH   DX }
  1426.   $56/   { PUSH   SI }
  1427.   $57/   { PUSH   DI }
  1428.   $55/   { PUSH   BP }
  1429.   $06/   { PUSH   ES }
  1430.   $1E);  { PUSH   DS }
  1431.  
  1432. PROCEDURE PopAll;
  1433. INLINE(
  1434.   $1F/   { POP    DS }
  1435.   $07/   { POP    ES }
  1436.   $5D/   { POP    BP }
  1437.   $5F/   { POP    DI }
  1438.   $5E/   { POP    SI }
  1439.   $5A/   { POP    DX }
  1440.   $59/   { POP    CX }
  1441.   $5B/   { POP    BX }
  1442.   $58/   { POP    AX }
  1443.   $9D);  { POPF      }
  1444.  
  1445. PROCEDURE initmouse;
  1446. { in: MausMaxX,MausMaxY = max. zulässige Mausbildschirmkoordinaten}
  1447. {     MausCallBack = Maus-Event-Handler (FAR-Prozedur!) }
  1448. {out: mouseX|Y2=MausMinX|Y*2, MausX|Y=MausMinX|Y}
  1449. {     Koordinatenbereich für Maus wurde entsprechend initialisert }
  1450. {     MausCallBack wird bei jeder Mausbewegung/Buttonbetätigung gerufen}
  1451. {     Maus ist "abgeschaltet" und muß erst mit "EnableMouse" aktiviert }
  1452. {     werden}
  1453. {rem: Vorhandensein einer Maus muß vorher geprüft worden sein}
  1454. {     Koordinatenbereich wird verdoppelt, um Maustreiber eine echte }
  1455. {     Auflösung 0..MausMaxX,0..MausMaxY in Einerschritten abzuringen}
  1456. BEGIN
  1457.  writeln(8);
  1458.  
  1459.  DisableMouse;
  1460.  mouseX2:=MausMinX*2;  mouseY2:=MausMinY*2;
  1461.  MausX:=mouseX2 SHR 1; MausY:=mouseY2 SHR 1;
  1462.  MouseUpdate:=FALSE;   LeftButton:=FALSE; RightButton:=FALSE;
  1463.  
  1464.  writeln(7);
  1465.  
  1466.  ASM  (* regs.ax := 0; Intr($33,regs); {Maustreiber initialisieren} *)
  1467.    PUSHF
  1468.    CLI
  1469.    PUSH AX
  1470.    PUSH BX
  1471.    PUSH CX
  1472.    PUSH DX
  1473.    PUSH SI
  1474.    PUSH DI
  1475.    PUSH BP
  1476.    PUSH ES
  1477.    PUSH DS
  1478.  
  1479.    mov ax,0
  1480.    int 33h
  1481.  
  1482.    POP DS
  1483.    POP ES
  1484.    POP BP
  1485.    POP DI
  1486.    POP SI
  1487.    POP DX
  1488.    POP CX
  1489.    POP BX
  1490.    POP AX
  1491.    STI
  1492.    POPF
  1493.  END;
  1494.  
  1495.  
  1496.  writeln(6);
  1497.  
  1498.  ASM (* regs.ax := 2; Intr($33,regs); {Cursor aus} *)
  1499.    PUSHF
  1500.    CLI
  1501.    PUSH AX
  1502.    PUSH BX
  1503.    PUSH CX
  1504.    PUSH DX
  1505.    PUSH SI
  1506.    PUSH DI
  1507.    PUSH BP
  1508.    PUSH ES
  1509.    PUSH DS
  1510.  
  1511.    mov ax,2
  1512.    int 33h
  1513.  
  1514.    POP DS
  1515.    POP ES
  1516.    POP BP
  1517.    POP DI
  1518.    POP SI
  1519.    POP DX
  1520.    POP CX
  1521.    POP BX
  1522.    POP AX
  1523.    STI
  1524.    POPF
  1525.  END;
  1526.  
  1527.  writeln(5);
  1528.  
  1529.  ASM (* regs.ax := 4; regs.cx := 0; regs.dx := 0; *)
  1530.      (* Intr($33,regs); {Maus in die obere linke Ecke setzen...} *)
  1531.    PUSHF
  1532.    CLI
  1533.    PUSH AX
  1534.    PUSH BX
  1535.    PUSH CX
  1536.    PUSH DX
  1537.    PUSH SI
  1538.    PUSH DI
  1539.    PUSH BP
  1540.    PUSH ES
  1541.    PUSH DS
  1542.  
  1543.    mov ax,4
  1544.    mov cx,0
  1545.    mov dx,0
  1546.    int 33h
  1547.  
  1548.    POP DS
  1549.    POP ES
  1550.    POP BP
  1551.    POP DI
  1552.    POP SI
  1553.    POP DX
  1554.    POP CX
  1555.    POP BX
  1556.    POP AX
  1557.    STI
  1558.    POPF
  1559.  END;
  1560.  
  1561.  Writeln(4);
  1562.  
  1563.  ASM (* regs.ax := 7; regs.cx := 0; regs.dx := MausMaxX*2; *)
  1564.      (* Intr($33,regs); {x-Koordinatenbereich definieren}  *)
  1565.    PUSHF
  1566.    CLI
  1567.    PUSH AX
  1568.    PUSH BX
  1569.    PUSH CX
  1570.    PUSH DX
  1571.    PUSH SI
  1572.    PUSH DI
  1573.    PUSH BP
  1574.    PUSH ES
  1575.    PUSH DS
  1576.  
  1577.    mov ax,7
  1578.    mov cx,0
  1579.    mov dx,MausMaxX*2
  1580.    int 33h
  1581.  
  1582.    POP DS
  1583.    POP ES
  1584.    POP BP
  1585.    POP DI
  1586.    POP SI
  1587.    POP DX
  1588.    POP CX
  1589.    POP BX
  1590.    POP AX
  1591.    STI
  1592.    POPF
  1593.  END;
  1594.  
  1595.  Writeln(3);
  1596.  
  1597.  ASM (* regs.ax := 8; regs.cx := 0; regs.dx := MausMaxY*2; *)
  1598.      (* Intr($33,regs); {y-Koordinatenbereich definieren}  *)
  1599.    PUSHF
  1600.    CLI
  1601.    PUSH AX
  1602.    PUSH BX
  1603.    PUSH CX
  1604.    PUSH DX
  1605.    PUSH SI
  1606.    PUSH DI
  1607.    PUSH BP
  1608.    PUSH ES
  1609.    PUSH DS
  1610.  
  1611.    mov ax,8
  1612.    mov cx,0
  1613.    mov dx,MausMaxY*2
  1614.    int 33h
  1615.  
  1616.    POP DS
  1617.    POP ES
  1618.    POP BP
  1619.    POP DI
  1620.    POP SI
  1621.    POP DX
  1622.    POP CX
  1623.    POP BX
  1624.    POP AX
  1625.    STI
  1626.    POPF
  1627.  END;
  1628.  
  1629.  writeln(2);
  1630.  
  1631.  ASM (* regs.ax := 12; *)
  1632.      (* regs.cx := MouseMoved OR LeftButtonPressed OR RightButtonPressed; *)
  1633.      (* regs.es := seg(MouseCallBack); regs.dx := ofs(MouseCallBack); *)
  1634.      (* intr($33,regs); {Eigenen ISR installieren} *)
  1635.    PUSHF
  1636.    CLI
  1637.    PUSH AX
  1638.    PUSH BX
  1639.    PUSH CX
  1640.    PUSH DX
  1641.    PUSH SI
  1642.    PUSH DI
  1643.    PUSH BP
  1644.    PUSH ES
  1645.    PUSH DS
  1646.  
  1647.    mov ax,12
  1648.    mov cx,MouseMoved OR LeftButtonPressed OR RightButtonPressed
  1649.    mov dx,SEG MouseCallBack
  1650.    mov es,dx
  1651.    mov dx,OFFSET MouseCallBack
  1652.    int 33h
  1653.  
  1654.    POP DS
  1655.    POP ES
  1656.    POP BP
  1657.    POP DI
  1658.    POP SI
  1659.    POP DX
  1660.    POP CX
  1661.    POP BX
  1662.    POP AX
  1663.    STI
  1664.    POPF
  1665.  END;
  1666.  
  1667.  writeln(1);
  1668. END;
  1669.  
  1670. {------- noch ein paar Popup-Boxen definieren: --------}
  1671. CONST ButtonWidth=(SizeOf(ButtonStringTyp)-1)*8; {Länge einer Textbox}
  1672.       EventOk=100;
  1673.       abfrage:ARRAY[1..2] OF box=(
  1674.  {"Ok"-Box:}
  1675.        (x1:0; y1:0; x2:0; y2:0;
  1676.         Name1:'';Name2:'';
  1677.         Show :Dummy;
  1678.         Event:EventOk;
  1679.         Click:TRUE;     {Anclicken nötig}
  1680.         Paint:FALSE),   {zeichnen tun wir selber!}
  1681.  
  1682.        {Sentinelwert, da x1>x2!}
  1683.        (x1:1; y1:0; x2:0; y2:0;
  1684.         Name1:'';Name2:'';
  1685.         Show :Dummy;
  1686.         Event:EventNone;
  1687.         Click:TRUE;
  1688.         Paint:TRUE)
  1689.       );
  1690.  
  1691.       {-------------------}
  1692.  
  1693.       EventYes=101;
  1694.       EventNo=102;
  1695.       alternative:ARRAY[1..3] OF box=(
  1696.  {"Ja"/"Nein"-Box:}
  1697.        {"Ja"-Box:}
  1698.        (x1:0; y1:0; x2:0; y2:0;
  1699.         Name1:'';Name2:'';
  1700.         Show :Dummy;
  1701.         Event:EventYes;
  1702.         Click:TRUE;     {Anclicken nötig}
  1703.         Paint:FALSE),   {zeichnen tun wir selber!}
  1704.  
  1705.        {"Nein"-Box:}
  1706.        (x1:0; y1:0; x2:0; y2:0;
  1707.         Name1:'';Name2:'';
  1708.         Show :Dummy;
  1709.         Event:EventNo;
  1710.         Click:TRUE;
  1711.         Paint:FALSE),
  1712.  
  1713.        {Sentinelwert, da x1>x2!}
  1714.        (x1:1; y1:0; x2:0; y2:0;
  1715.         Name1:'';Name2:'';
  1716.         Show :Dummy;
  1717.         Event:EventNone;
  1718.         Click:TRUE;
  1719.         Paint:TRUE)
  1720.       );
  1721.  
  1722.       {-------------------}
  1723.       EventCancel=103;
  1724.       FarbenWahl:ARRAY[1..4] OF box=(
  1725.  {Cancel/Workarea/Palettenbereich-Abfrage:}
  1726.  
  1727.        {"Nein"-Box:}
  1728.        (x1:0; y1:0; x2:0; y2:0;
  1729.         Name1:'';Name2:'';
  1730.         Show :Dummy;
  1731.         Event:EventCancel;
  1732.         Click:TRUE;
  1733.         Paint:FALSE),
  1734.  
  1735.        {Workarea:}
  1736.        (x1:WorkStartX;    y1:WorkStartY;
  1737.         x2:WorkEndX;      y2:WorkEndY;
  1738.         Name1:'';Name2:'';
  1739.         Show :Dummy;
  1740.         Event:EventInWorkArea;
  1741.         Click:FALSE;    {Anclicken nicht nötig}
  1742.         Paint:FALSE),   {...wird aber nicht gezeichnet}
  1743.  
  1744.        {Palettenbereich:}
  1745.        (x1:PaletteX+25;                y1:PaletteY+10;
  1746.         x2:PaletteX+25+16*PalBreite-3; y2:PaletteY+10+16*PalHoehe-3;
  1747.         Name1:'';Name2:'';
  1748.         Show :Dummy;
  1749.         Event:EventSelectColor;
  1750.         Click:TRUE;     {Anclicken nötig}
  1751.         Paint:FALSE),   {...wird aber nicht gezeichnet}
  1752.  
  1753.        {Sentinelwert, da x1>x2!}
  1754.        (x1:1; y1:0; x2:0; y2:0;
  1755.         Name1:'';Name2:'';
  1756.         Show :Dummy;
  1757.         Event:EventNone;
  1758.         Click:TRUE;
  1759.         Paint:TRUE)
  1760.       );
  1761.       {-------------------}
  1762.  
  1763. VAR oldGraph:pointer;
  1764.     oldGraphSize:WORD;
  1765.  
  1766. PROCEDURE DrawOkBox(x1,y1,x2,y2:WORD; Text1:ButtonStringTyp;
  1767.           s1,s2,s3:STRING; VAR menu);
  1768. { in: s1|s2|s3 = auszugebende Strings}
  1769. {     Text1 = beschriftung für anzuzeigenden Button}
  1770. {     x1,y1 = linke obere Ecke der Meldungsbox (absolute Koord.)  }
  1771. {     x2,y2 = rechte untere Ecke der Meldungsbox (absolute Koord.)}
  1772. {     menu = auszugebende Menubox}
  1773. {out: oldGraph^ = alter Inhalt unter Meldebox}
  1774. {     oldGraphSize = deren Größe}
  1775. {     menu = um Koordinaten erweiterte Menubox (=für }
  1776. {     AskOkBox() vorbereitet}
  1777. {rem: Grafikmodus muß bereits aktiv sein!}
  1778. {     Length(s1|s2|s3)*8 >= x2-x1+1 !}
  1779. {     Der Meldungsboxbereich muß kleiner als 64K sein!}
  1780. {     Das Menu darf höchstens aus 10 Boxen bestehen}
  1781. VAR BoxBreite,BoxHoehe,disx,disy:INTEGER;
  1782.     x,y:WORD;
  1783.     mymenu:ARRAY[1..10] OF box ABSOLUTE menu;
  1784. BEGIN
  1785.  {alte Grafik sichern:}
  1786.  oldGraphSize:=ImageSize(x1,y1,x2,y2);
  1787.  GetMem(oldGraph,oldGraphSize);
  1788.  GetImage(x1,y1,x2,y2,oldGraph^);
  1789.  
  1790.  SetFillStyle(SolidFill,BestLightGray);
  1791.  Bar(x1,y1,x2,y2);
  1792.  SetFillStyle(SolidFill,BestWhite);
  1793.  Bar(x1,y1,x2-1,y1+1);
  1794.  Bar(x1,y1,x1+1,y2-1);
  1795.  SetFillStyle(SolidFill,BestDarkGray);
  1796.  Bar(x1,y2-1,x2,y2);
  1797.  Bar(x2-1,y1,x2,y2);
  1798.  
  1799.  BoxBreite:=Succ(x2-x1); BoxHoehe:=Succ(y2-y1);
  1800.  SetColor(BestBlack);
  1801.  y:=y1+10;
  1802.  IF s1<>''
  1803.   THEN BEGIN
  1804.         OutTextXY(x1+ (BoxBreite -(Length(s1) SHL 3)) SHR 1,y,s1);
  1805.         INC(y,10);
  1806.        END;
  1807.  IF s2<>''
  1808.   THEN BEGIN
  1809.         OutTextXY(x1+ (BoxBreite -(Length(s2) SHL 3)) SHR 1,y,s2);
  1810.         INC(y,10);
  1811.        END;
  1812.  IF s3<>''
  1813.   THEN BEGIN
  1814.         OutTextXY(x1+ (BoxBreite -(Length(s3) SHL 3)) SHR 1,y,s3);
  1815.         INC(y,10);
  1816.        END;
  1817.  
  1818.  disx:=(BoxBreite-ButtonWidth) DIV 2;
  1819.  disy:=(BoxHoehe-(y-y1)) DIV 4;
  1820.  mymenu[1].x1:=x1+disx; mymenu[1].y1:=y+disy;
  1821.  mymenu[1].x2:=x2-disx; mymenu[1].y2:=y2-disy;
  1822.  
  1823.  {Jetzt die Box einzeichnen:}
  1824.  y:=y+disy + ((y2-disy)-(y+disy)-8) SHR 1; {für's zentrieren des Textes...}
  1825.  WITH mymenu[1] DO
  1826.   BEGIN
  1827.    SetFillStyle(SolidFill,BestLightGray);
  1828.    Bar(x1,y1,x2,y2);
  1829.    SetFillStyle(SolidFill,BestWhite);
  1830.    Bar(x1,y1,x2-1,y1+1);
  1831.    Bar(x1,y1,x1+1,y2-1);
  1832.    SetFillStyle(SolidFill,BestDarkGray);
  1833.    Bar(x1,y2-1,x2,y2);
  1834.    Bar(x2-1,y1,x2,y2);
  1835.    OutTextXY(x1+ (ButtonWidth-(Length(Text1) SHL 3)) SHR 1,y,Text1);
  1836.   END;
  1837. END;
  1838.  
  1839. PROCEDURE AskOkBox(x1,y1:WORD; VAR menu);
  1840. { in: menu = komplett ausgefüllte Menubox}
  1841. {     oldGraph^ = alte Grafikdaten}
  1842. {     oldGraphSize = deren Größe  }
  1843. {out: Event = aufgetretenes Event }
  1844. {rem: Maus wird freigegeben, um lokales Menu bearbeiten zu können!}
  1845. {     Das Menu darf höchstens aus 10 Boxen bestehen}
  1846. VAR mymenu:ARRAY[1..10] OF box ABSOLUTE menu;
  1847. BEGIN;
  1848.  DrawMaus(CursorPfeil);
  1849.  Event:=EventNone;
  1850.  
  1851.  {Maus freigeben:}
  1852.  ClearMouse;
  1853.  
  1854.  REPEAT
  1855.   IF MouseUpdate
  1856.    THEN BEGIN
  1857.          UndrawMaus;
  1858.          Event:=MouseEvent(mymenu);
  1859.          IF (Event=EventNone)
  1860.       THEN BEGIN {das war nichts, nochmal!}
  1861.                 DrawMaus(CursorPfeil);
  1862.                 ClearMouse;
  1863.                END;
  1864.         END;
  1865.  UNTIL Event<>EventNone;
  1866.  
  1867.  UndrawMaus;
  1868.  {alte Grafik wiederherstellen:}
  1869.  PutImage(x1,y1,oldGraph^,NormalPut);
  1870.  FreeMem(oldGraph,oldGraphSize);
  1871. END;
  1872.  
  1873. PROCEDURE OkBox(x1,y1,x2,y2:WORD; Text1:ButtonStringTyp;
  1874.                 s1,s2,s3:STRING; VAR menu);
  1875. { in: s1|s2|s3 = auszugebende Strings}
  1876. {     x1,y1 = linke obere Ecke der Meldungsbox (absolute Koord.)  }
  1877. {     x2,y2 = rechte untere Ecke der Meldungsbox (absolute Koord.)}
  1878. {     Text1 = Beschriftung für auszugebenden Button}
  1879. {     menu = auszugebende Ok-Box}
  1880. {out: (In menu wurden die Koordinaten verändert, was aber ohne Bedeutung}
  1881. {     sein sollte, da die übergebenen Menus eh nur für diesen Zweck ge- }
  1882. {     dacht sind)}
  1883. {     Event = aufgetretenes Event}
  1884. {rem: Grafikmodus muß bereits aktiv sein!}
  1885. {     Length(s1|s2|s3)*8 >= x2-x1+1 !}
  1886. {     Maus wird freigegeben, um lokales Menu bearbeiten zu können!}
  1887. {     Der Meldungsboxbereich muß kleiner als 64K sein!}
  1888. {     Das Menu darf höchstens aus 10 Boxen bestehen}
  1889. BEGIN
  1890.  DrawOkBox(x1,y1,x2,y2,Text1,s1,s2,s3,menu);
  1891.  AskOkBox(x1,y1,menu);
  1892. END;
  1893.  
  1894. PROCEDURE DrawFirstOfTwoBoxes(x1,y1,x2,y2:WORD;
  1895.                               Text1,Text2:ButtonStringTyp;
  1896.                               s1,s2,s3:STRING;
  1897.                               VAR menu);
  1898. { in: s1|s2|s3 = auszugebende Strings}
  1899. {     Text1|2 = Beschriftung der beiden Buttons}
  1900. {     x1,y1 = linke obere Ecke der Meldungsbox (absolute Koord.)  }
  1901. {     x2,y2 = rechte untere Ecke der Meldungsbox (absolute Koord.)}
  1902. {     menu  = auszugebndes Menu}
  1903. {out: TRUE|FALSE für erste|zweite Box angeclickt}
  1904. {     menu = um Koordinaten erweitertes Menu}
  1905. {rem: Grafikmodus muß bereits aktiv sein!}
  1906. {     Length(s1|s2|s3)*8 >= x2-x1+1 !}
  1907. {     Maus wird freigegeben, um lokales Menu bearbeiten zu können!}
  1908. {     Der Meldungsboxbereich muß kleiner als 64K sein!}
  1909. {     Das Menu darf höchstens aus 10 Boxen bestehen}
  1910. VAR BoxBreite,BoxHoehe,disx,disy:INTEGER;
  1911.     x,y:WORD;
  1912.     mymenu:ARRAY[1..10] OF box ABSOLUTE menu;
  1913. BEGIN
  1914.  {alte Grafik sichern:}
  1915.  oldGraphSize:=ImageSize(x1,y1,x2,y2);
  1916.  GetMem(oldGraph,oldGraphSize);
  1917.  GetImage(x1,y1,x2,y2,oldGraph^);
  1918.  
  1919.  SetFillStyle(SolidFill,BestLightGray);
  1920.  Bar(x1,y1,x2,y2);
  1921.  SetFillStyle(SolidFill,BestWhite);
  1922.  Bar(x1,y1,x2-1,y1+1);
  1923.  Bar(x1,y1,x1+1,y2-1);
  1924.  SetFillStyle(SolidFill,BestDarkGray);
  1925.  Bar(x1,y2-1,x2,y2);
  1926.  Bar(x2-1,y1,x2,y2);
  1927.  
  1928.  BoxBreite:=Succ(x2-x1); BoxHoehe:=Succ(y2-y1);
  1929.  SetColor(BestBlack);
  1930.  y:=y1+10;
  1931.  IF s1<>''
  1932.   THEN BEGIN
  1933.         OutTextXY(x1+ (BoxBreite -(Length(s1) SHL 3)) SHR 1,y,s1);
  1934.         INC(y,10);
  1935.        END;
  1936.  IF s2<>''
  1937.   THEN BEGIN
  1938.         OutTextXY(x1+ (BoxBreite -(Length(s2) SHL 3)) SHR 1,y,s2);
  1939.         INC(y,10);
  1940.        END;
  1941.  IF s3<>''
  1942.   THEN BEGIN
  1943.         OutTextXY(x1+ (BoxBreite -(Length(s3) SHL 3)) SHR 1,y,s3);
  1944.         INC(y,10);
  1945.        END;
  1946.  
  1947.  disx:=(BoxBreite-(ButtonWidth SHL 1)) DIV 3;
  1948.  disy:=(BoxHoehe-(y-y1)) DIV 4;
  1949.  mymenu[1].x1:=x1+disx;             mymenu[1].y1:=y+disy;
  1950.  mymenu[1].x2:=x1+disx+ButtonWidth; mymenu[1].y2:=y2-disy;
  1951.  
  1952.  mymenu[2].x1:=x2-disx-ButtonWidth; mymenu[2].y1:=y+disy;
  1953.  mymenu[2].x2:=x2-disx;             mymenu[2].y2:=y2-disy;
  1954.  
  1955.  {Jetzt die beiden Boxen einzeichnen:}
  1956.  y:=y+disy + ((y2-disy)-(y+disy)-8) SHR 1; {für's zentrieren des Textes...}
  1957.  WITH mymenu[1] DO
  1958.   BEGIN
  1959.    SetFillStyle(SolidFill,BestLightGray);
  1960.    Bar(x1,y1,x2,y2);
  1961.    SetFillStyle(SolidFill,BestWhite);
  1962.    Bar(x1,y1,x2-1,y1+1);
  1963.    Bar(x1,y1,x1+1,y2-1);
  1964.    SetFillStyle(SolidFill,BestDarkGray);
  1965.    Bar(x1,y2-1,x2,y2);
  1966.    Bar(x2-1,y1,x2,y2);
  1967.    OutTextXY(x1+ (ButtonWidth-(Length(Text1) SHL 3)) SHR 1,y,Text1);
  1968.   END;
  1969.  
  1970.  WITH mymenu[2] DO
  1971.   BEGIN
  1972.    SetFillStyle(SolidFill,BestLightGray);
  1973.    Bar(x1,y1,x2,y2);
  1974.    SetFillStyle(SolidFill,BestWhite);
  1975.    Bar(x1,y1,x2-1,y1+1);
  1976.    Bar(x1,y1,x1+1,y2-1);
  1977.    SetFillStyle(SolidFill,BestDarkGray);
  1978.    Bar(x1,y2-1,x2,y2);
  1979.    Bar(x2-1,y1,x2,y2);
  1980.    OutTextXY(x1+ (ButtonWidth-(Length(Text2) SHL 3)) SHR 1,y,Text2);
  1981.   END;
  1982.  
  1983.  DrawMaus(CursorPfeil);
  1984.  {Maus freigeben:}
  1985.  ClearMouse;
  1986. END;
  1987.  
  1988. FUNCTION AskFirstOfTwoBoxes(x1,y1:WORD; Text1,Text2:ButtonStringTyp;
  1989.                             VAR menu):BOOLEAN;
  1990. { in: menu = komplett ausgefüllte Menubox}
  1991. {     oldGraph^ = alte Grafikdaten}
  1992. {     oldGraphSize = deren Größe  }
  1993. {out: Event = aufgetretenes Event }
  1994. {rem: Maus wird freigegeben, um lokales Menu bearbeiten zu können!}
  1995. {     Das Menu darf höchstens aus 10 Boxen bestehen}
  1996. VAR ch:CHAR;
  1997.     mymenu:ARRAY[1..10] OF box ABSOLUTE menu;
  1998. BEGIN
  1999.  Event:=EventNone;
  2000.  REPEAT
  2001.   IF MouseUpdate
  2002.    THEN BEGIN
  2003.          UndrawMaus;
  2004.          Event:=MouseEvent(mymenu);
  2005.          IF (Event=EventNone)
  2006.       THEN BEGIN {das war nichts, nochmal!}
  2007.                 DrawMaus(CursorPfeil);
  2008.                 ClearMouse;
  2009.                END;
  2010.         END
  2011.    ELSE IF (KeyPressed) AND (Upcase(Text1[1])<>Upcase(Text2[1])) THEN
  2012.         BEGIN
  2013.          WHILE KeyPressed DO ch:=Upcase(ReadKey);
  2014.          IF ch=Upcase(Text1[1]) THEN Event:=mymenu[1].Event
  2015.          ELSE IF ch=Upcase(Text2[1]) THEN Event:=mymenu[2].Event;
  2016.         END;
  2017.  UNTIL Event<>EventNone;
  2018.  
  2019.  UndrawMaus;
  2020.  {alte Grafik wiederherstellen:}
  2021.  PutImage(x1,y1,oldGraph^,NormalPut);
  2022.  FreeMem(oldGraph,oldGraphSize);
  2023.  
  2024.  AskFirstOfTwoBoxes:=Event=EventYes
  2025. END;
  2026.  
  2027. FUNCTION FirstOfTwoBoxes(x1,y1,x2,y2:WORD;
  2028.                          Text1,Text2:ButtonStringTyp;
  2029.                          s1,s2,s3:STRING;
  2030.                          VAR menu):BOOLEAN;
  2031. { in: s1|s2|s3 = auszugebende Strings}
  2032. {     Text1|2 = Beschriftung der beiden Buttons}
  2033. {     x1,y1 = linke obere Ecke der Meldungsbox (absolute Koord.)  }
  2034. {     x2,y2 = rechte untere Ecke der Meldungsbox (absolute Koord.)}
  2035. {     menu = auszugebendes Menu}
  2036. {out: TRUE|FALSE für erste|zweite Box angeclickt}
  2037. {     (In "menu" wurden die Koordinaten verändert, was aber keine }
  2038. {     Probleme verursachen sollte, da die übergebenen Menus eh nur}
  2039. {     für diesen Zweck gedacht sind)}
  2040. {     Event = aufgetretenes Event}
  2041. {rem: Grafikmodus muß bereits aktiv sein!}
  2042. {     Length(s1|s2|s3)*8 >= x2-x1+1 !}
  2043. {     Maus wird freigegeben, um lokales Menu bearbeiten zu können!}
  2044. {     Der Meldungsboxbereich muß kleiner als 64K sein!}
  2045. {     Das Menu darf höchstens aus 10 Boxen bestehen}
  2046. BEGIN
  2047.  DrawFirstOfTwoBoxes(x1,y1,x2,y2,Text1,Text2,s1,s2,s3,menu);
  2048.  FirstOfTwoBoxes:=AskFirstOfTwoBoxes(x1,y1,Text1,Text2,menu);
  2049. END;
  2050.  
  2051. {-----Hintergrundbildspeicher: -----------}
  2052. CONST XMAX=319; {Abmessungen einer Hintergrunddatei}
  2053.       YMAX=199;
  2054.       LINESIZE=(XMAX+1) DIV 4;    {Groesse einer Zeile=80 Bytes}
  2055.       PAGESIZE=(YMAX+1)*LINESIZE; {200 Zeilen zu je 320/4 Bytes}
  2056. TYPE bitmap=ARRAY[0..PAGESIZE-1] OF BYTE;
  2057.      bitmapPtr=^bitmap;
  2058.      bild=ARRAY[0..3] OF bitmapPtr;
  2059. VAR  WorkArea:^WorkAreatyp;
  2060. CONST WorkAreaMaxUsedX:INTEGER=0; {Hilfsvariablen für schnelleres Zeichnen:}
  2061.       WorkAreaMaxUsedY:INTEGER=0; {welches sind die Extremkoord. des Bildes}
  2062.  
  2063. {-----Fehlerbehandlung: ------------------}
  2064. CONST {Fehlercodes des Animationspaketes: }
  2065.       ErrNone=0;
  2066.       ErrNotEnoughMemory=1;
  2067.       ErrFileIO=2;
  2068.       ErrInvalidSpriteNumber=3;
  2069.       ErrNoSprite=4;
  2070.       ErrInvalidPageNumber=5;
  2071.       ErrNoVGA=6;
  2072.       ErrNoPicture=7;
  2073.       ErrInvalidPercentage=8;
  2074.       ErrNoTile=9;
  2075.       ErrInvalidTileNumber=10;
  2076.       ErrInvalidCoordinates=11;
  2077.       ErrBackgroundToBig=12;
  2078.       ErrInvalidMode=13;
  2079.       ErrInvalidSpriteLoadNumber=14;
  2080.       ErrNoPalette=15;
  2081.       ErrPaletteWontFit=16;
  2082.  
  2083.       Error:BYTE=ErrNone;
  2084.  
  2085. FUNCTION GetErrorMessage:STRING;
  2086. { in: Error = Nummer des aufgetretenen Fehlers}
  2087. {out: den Fehler in Worten}
  2088. BEGIN
  2089.  CASE Error OF
  2090.   ErrNone:GetErrorMessage:='No Error';
  2091.   ErrNotEnoughMemory:GetErrorMessage:='Not enough memory available on heap';
  2092.   ErrFileIO:GetErrorMessage:='I/O-error with file';
  2093.   ErrInvalidSpriteNumber:GetErrorMessage:='Invalid sprite number used';
  2094.   ErrNoSprite:GetErrorMessage:='No (or corrupted) sprite file';
  2095.   ErrInvalidPageNumber:GetErrorMessage:='Invalid page number used';
  2096.   ErrNoVGA:GetErrorMessage:='No VGA-card found';
  2097.   ErrNoPicture:GetErrorMessage:='No (or corrupted) picture file';
  2098.   ErrInvalidPercentage:GetErrorMessage:='Percentage value must be 0..100';
  2099.   ErrNoTile:GetErrorMessage:='No (or corrupted) tile/sprite file';
  2100.   ErrInvalidTileNumber:GetErrorMessage:='Invalid tile number used';
  2101.   ErrInvalidCoordinates:GetErrorMessage:='Invalid coordinates used';
  2102.   ErrBackgroundToBig:GetErrorMessage:='Background too big for tile-buffer';
  2103.   ErrInvalidMode:GetErrorMessage:='Only STATIC or SCROLLING allowed here';
  2104.   ErrInvalidSpriteLoadNumber:GetErrorMessage:='Invalid spriteload number used';
  2105.   ErrNoPalette:GetErrorMessage:='No (or corrupted) palette file';
  2106.   ErrPaletteWontFit:GetErrorMessage:='Palette indexes must be <256';
  2107.   ELSE GetErrorMessage:='Unknown error';
  2108.  END;
  2109. END;
  2110.  
  2111. {-----Palette: --------------------------}
  2112. TYPE PaletteEntry=RECORD red,green,blue:BYTE END;
  2113.      BigPalette=ARRAY[0..255] OF PaletteEntry;
  2114.      PalettePtr=^BigPalette;
  2115.      SmallPalette=ARRAY[0..15] OF BYTE;
  2116. CONST DefaultColors:BigPalette=  {Defaultfarben-Palette; erste 16-Farben}
  2117.  (                               {sind identisch zu 16-Farbmodi-Farben! }
  2118.   (red:  0; green:  0; blue:  0),  {Black}
  2119.   (red:  0; green:  0; blue: 42),  {Blue }
  2120.   (red:  0; green: 42; blue:  0),  {Green}
  2121.   (red:  0; green: 42; blue: 42),  {Cyan }
  2122.   (red: 42; green:  0; blue:  0),  {Red  }
  2123.   (red: 42; green:  0; blue: 42),  {Magenta   }
  2124.   (red: 42; green: 21; blue:  0),  {Brown}
  2125.   (red: 42; green: 42; blue: 42),  {LightGray }
  2126.   (red: 21; green: 21; blue: 21),  {DarkGray  }
  2127.   (red: 21; green: 21; blue: 63),  {LightBlue }
  2128.   (red: 21; green: 63; blue: 21),  {LightGreen}
  2129.   (red: 21; green: 63; blue: 63),  {LightCyan }
  2130.   (red: 63; green: 21; blue: 21),  {LightRed  }
  2131.   (red: 63; green: 21; blue: 63),  {LightMagenta}
  2132.   (red: 63; green: 63; blue: 21),  {Yellow}
  2133.   (red: 63; green: 63; blue: 63),  {White }
  2134.   (red:  0; green:  0; blue:  0),
  2135.   (red:  5; green:  5; blue:  5),
  2136.   (red:  8; green:  8; blue:  8),
  2137.   (red: 11; green: 11; blue: 11),
  2138.   (red: 14; green: 14; blue: 14),
  2139.   (red: 17; green: 17; blue: 17),
  2140.   (red: 20; green: 20; blue: 20),
  2141.   (red: 24; green: 24; blue: 24),
  2142.   (red: 28; green: 28; blue: 28),
  2143.   (red: 32; green: 32; blue: 32),
  2144.   (red: 36; green: 36; blue: 36),
  2145.   (red: 40; green: 40; blue: 40),
  2146.   (red: 45; green: 45; blue: 45),
  2147.   (red: 50; green: 50; blue: 50),
  2148.   (red: 56; green: 56; blue: 56),
  2149.   (red: 63; green: 63; blue: 63),
  2150.   (red:  0; green:  0; blue: 63),
  2151.   (red: 16; green:  0; blue: 63),
  2152.   (red: 31; green:  0; blue: 63),
  2153.   (red: 47; green:  0; blue: 63),
  2154.   (red: 63; green:  0; blue: 63),
  2155.   (red: 63; green:  0; blue: 47),
  2156.   (red: 63; green:  0; blue: 31),
  2157.   (red: 63; green:  0; blue: 16),
  2158.   (red: 63; green:  0; blue:  0),
  2159.   (red: 63; green: 16; blue:  0),
  2160.   (red: 63; green: 31; blue:  0),
  2161.   (red: 63; green: 47; blue:  0),
  2162.   (red: 63; green: 63; blue:  0),
  2163.   (red: 47; green: 63; blue:  0),
  2164.   (red: 31; green: 63; blue:  0),
  2165.   (red: 16; green: 63; blue:  0),
  2166.   (red:  0; green: 63; blue:  0),
  2167.   (red:  0; green: 63; blue: 16),
  2168.   (red:  0; green: 63; blue: 31),
  2169.   (red:  0; green: 63; blue: 47),
  2170.   (red:  0; green: 63; blue: 63),
  2171.   (red:  0; green: 47; blue: 63),
  2172.   (red:  0; green: 31; blue: 63),
  2173.   (red:  0; green: 16; blue: 63),
  2174.   (red: 31; green: 31; blue: 63),
  2175.   (red: 39; green: 31; blue: 63),
  2176.   (red: 47; green: 31; blue: 63),
  2177.   (red: 55; green: 31; blue: 63),
  2178.   (red: 63; green: 31; blue: 63),
  2179.   (red: 63; green: 31; blue: 55),
  2180.   (red: 63; green: 31; blue: 47),
  2181.   (red: 63; green: 31; blue: 39),
  2182.   (red: 63; green: 31; blue: 31),
  2183.   (red: 63; green: 39; blue: 31),
  2184.   (red: 63; green: 47; blue: 31),
  2185.   (red: 63; green: 55; blue: 31),
  2186.   (red: 63; green: 63; blue: 31),
  2187.   (red: 55; green: 63; blue: 31),
  2188.   (red: 47; green: 63; blue: 31),
  2189.   (red: 39; green: 63; blue: 31),
  2190.   (red: 31; green: 63; blue: 31),
  2191.   (red: 31; green: 63; blue: 39),
  2192.   (red: 31; green: 63; blue: 47),
  2193.   (red: 31; green: 63; blue: 55),
  2194.   (red: 31; green: 63; blue: 63),
  2195.   (red: 31; green: 55; blue: 63),
  2196.   (red: 31; green: 47; blue: 63),
  2197.   (red: 31; green: 39; blue: 63),
  2198.   (red: 45; green: 45; blue: 63),
  2199.   (red: 49; green: 45; blue: 63),
  2200.   (red: 54; green: 45; blue: 63),
  2201.   (red: 58; green: 45; blue: 63),
  2202.   (red: 63; green: 45; blue: 63),
  2203.   (red: 63; green: 45; blue: 58),
  2204.   (red: 63; green: 45; blue: 54),
  2205.   (red: 63; green: 45; blue: 49),
  2206.   (red: 63; green: 45; blue: 45),
  2207.   (red: 63; green: 49; blue: 45),
  2208.   (red: 63; green: 54; blue: 45),
  2209.   (red: 63; green: 58; blue: 45),
  2210.   (red: 63; green: 63; blue: 45),
  2211.   (red: 58; green: 63; blue: 45),
  2212.   (red: 54; green: 63; blue: 45),
  2213.   (red: 49; green: 63; blue: 45),
  2214.   (red: 45; green: 63; blue: 45),
  2215.   (red: 45; green: 63; blue: 49),
  2216.   (red: 45; green: 63; blue: 54),
  2217.   (red: 45; green: 63; blue: 58),
  2218.   (red: 45; green: 63; blue: 63),
  2219.   (red: 45; green: 58; blue: 63),
  2220.   (red: 45; green: 54; blue: 63),
  2221.   (red: 45; green: 49; blue: 63),
  2222.   (red:  0; green:  0; blue: 28),
  2223.   (red:  7; green:  0; blue: 28),
  2224.   (red: 14; green:  0; blue: 28),
  2225.   (red: 21; green:  0; blue: 28),
  2226.   (red: 28; green:  0; blue: 28),
  2227.   (red: 28; green:  0; blue: 21),
  2228.   (red: 28; green:  0; blue: 14),
  2229.   (red: 28; green:  0; blue:  7),
  2230.   (red: 28; green:  0; blue:  0),
  2231.   (red: 28; green:  7; blue:  0),
  2232.   (red: 28; green: 14; blue:  0),
  2233.   (red: 28; green: 21; blue:  0),
  2234.   (red: 28; green: 28; blue:  0),
  2235.   (red: 21; green: 28; blue:  0),
  2236.   (red: 14; green: 28; blue:  0),
  2237.   (red:  7; green: 28; blue:  0),
  2238.   (red:  0; green: 28; blue:  0),
  2239.   (red:  0; green: 28; blue:  7),
  2240.   (red:  0; green: 28; blue: 14),
  2241.   (red:  0; green: 28; blue: 21),
  2242.   (red:  0; green: 28; blue: 28),
  2243.   (red:  0; green: 21; blue: 28),
  2244.   (red:  0; green: 14; blue: 28),
  2245.   (red:  0; green:  7; blue: 28),
  2246.   (red: 14; green: 14; blue: 28),
  2247.   (red: 17; green: 14; blue: 28),
  2248.   (red: 21; green: 14; blue: 28),
  2249.   (red: 24; green: 14; blue: 28),
  2250.   (red: 28; green: 14; blue: 28),
  2251.   (red: 28; green: 14; blue: 24),
  2252.   (red: 28; green: 14; blue: 21),
  2253.   (red: 28; green: 14; blue: 17),
  2254.   (red: 28; green: 14; blue: 14),
  2255.   (red: 28; green: 17; blue: 14),
  2256.   (red: 28; green: 21; blue: 14),
  2257.   (red: 28; green: 24; blue: 14),
  2258.   (red: 28; green: 28; blue: 14),
  2259.   (red: 24; green: 28; blue: 14),
  2260.   (red: 21; green: 28; blue: 14),
  2261.   (red: 17; green: 28; blue: 14),
  2262.   (red: 14; green: 28; blue: 14),
  2263.   (red: 14; green: 28; blue: 17),
  2264.   (red: 14; green: 28; blue: 21),
  2265.   (red: 14; green: 28; blue: 24),
  2266.   (red: 14; green: 28; blue: 28),
  2267.   (red: 14; green: 24; blue: 28),
  2268.   (red: 14; green: 21; blue: 28),
  2269.   (red: 14; green: 17; blue: 28),
  2270.   (red: 20; green: 20; blue: 28),
  2271.   (red: 22; green: 20; blue: 28),
  2272.   (red: 24; green: 20; blue: 28),
  2273.   (red: 26; green: 20; blue: 28),
  2274.   (red: 28; green: 20; blue: 28),
  2275.   (red: 28; green: 20; blue: 26),
  2276.   (red: 28; green: 20; blue: 24),
  2277.   (red: 28; green: 20; blue: 22),
  2278.   (red: 28; green: 20; blue: 20),
  2279.   (red: 28; green: 22; blue: 20),
  2280.   (red: 28; green: 24; blue: 20),
  2281.   (red: 28; green: 26; blue: 20),
  2282.   (red: 28; green: 28; blue: 20),
  2283.   (red: 26; green: 28; blue: 20),
  2284.   (red: 24; green: 28; blue: 20),
  2285.   (red: 22; green: 28; blue: 20),
  2286.   (red: 20; green: 28; blue: 20),
  2287.   (red: 20; green: 28; blue: 22),
  2288.   (red: 20; green: 28; blue: 24),
  2289.   (red: 20; green: 28; blue: 26),
  2290.   (red: 20; green: 28; blue: 28),
  2291.   (red: 20; green: 26; blue: 28),
  2292.   (red: 20; green: 24; blue: 28),
  2293.   (red: 20; green: 22; blue: 28),
  2294.   (red:  0; green:  0; blue: 16),
  2295.   (red:  4; green:  0; blue: 16),
  2296.   (red:  8; green:  0; blue: 16),
  2297.   (red: 12; green:  0; blue: 16),
  2298.   (red: 16; green:  0; blue: 16),
  2299.   (red: 16; green:  0; blue: 12),
  2300.   (red: 16; green:  0; blue:  8),
  2301.   (red: 16; green:  0; blue:  4),
  2302.   (red: 16; green:  0; blue:  0),
  2303.   (red: 16; green:  4; blue:  0),
  2304.   (red: 16; green:  8; blue:  0),
  2305.   (red: 16; green: 12; blue:  0),
  2306.   (red: 16; green: 16; blue:  0),
  2307.   (red: 12; green: 16; blue:  0),
  2308.   (red:  8; green: 16; blue:  0),
  2309.   (red:  4; green: 16; blue:  0),
  2310.   (red:  0; green: 16; blue:  0),
  2311.   (red:  0; green: 16; blue:  4),
  2312.   (red:  0; green: 16; blue:  8),
  2313.   (red:  0; green: 16; blue: 12),
  2314.   (red:  0; green: 16; blue: 16),
  2315.   (red:  0; green: 12; blue: 16),
  2316.   (red:  0; green:  8; blue: 16),
  2317.   (red:  0; green:  4; blue: 16),
  2318.   (red:  8; green:  8; blue: 16),
  2319.   (red: 10; green:  8; blue: 16),
  2320.   (red: 12; green:  8; blue: 16),
  2321.   (red: 14; green:  8; blue: 16),
  2322.   (red: 16; green:  8; blue: 16),
  2323.   (red: 16; green:  8; blue: 14),
  2324.   (red: 16; green:  8; blue: 12),
  2325.   (red: 16; green:  8; blue: 10),
  2326.   (red: 16; green:  8; blue:  8),
  2327.   (red: 16; green: 10; blue:  8),
  2328.   (red: 16; green: 12; blue:  8),
  2329.   (red: 16; green: 14; blue:  8),
  2330.   (red: 16; green: 16; blue:  8),
  2331.   (red: 14; green: 16; blue:  8),
  2332.   (red: 12; green: 16; blue:  8),
  2333.   (red: 10; green: 16; blue:  8),
  2334.   (red:  8; green: 16; blue:  8),
  2335.   (red:  8; green: 16; blue: 10),
  2336.   (red:  8; green: 16; blue: 12),
  2337.   (red:  8; green: 16; blue: 14),
  2338.   (red:  8; green: 16; blue: 16),
  2339.   (red:  8; green: 14; blue: 16),
  2340.   (red:  8; green: 12; blue: 16),
  2341.   (red:  8; green: 10; blue: 16),
  2342.   (red: 11; green: 11; blue: 16),
  2343.   (red: 12; green: 11; blue: 16),
  2344.   (red: 13; green: 11; blue: 16),
  2345.   (red: 15; green: 11; blue: 16),
  2346.   (red: 16; green: 11; blue: 16),
  2347.   (red: 16; green: 11; blue: 15),
  2348.   (red: 16; green: 11; blue: 13),
  2349.   (red: 16; green: 11; blue: 12),
  2350.   (red: 16; green: 11; blue: 11),
  2351.   (red: 16; green: 12; blue: 11),
  2352.   (red: 16; green: 13; blue: 11),
  2353.   (red: 16; green: 15; blue: 11),
  2354.   (red: 16; green: 16; blue: 11),
  2355.   (red: 15; green: 16; blue: 11),
  2356.   (red: 13; green: 16; blue: 11),
  2357.   (red: 12; green: 16; blue: 11),
  2358.   (red: 11; green: 16; blue: 11),
  2359.   (red: 11; green: 16; blue: 12),
  2360.   (red: 11; green: 16; blue: 13),
  2361.   (red: 11; green: 16; blue: 15),
  2362.   (red: 11; green: 16; blue: 16),
  2363.   (red: 11; green: 15; blue: 16),
  2364.   (red: 11; green: 13; blue: 16),
  2365.   (red: 11; green: 12; blue: 16),
  2366.   (red:  0; green:  0; blue:  0),
  2367.   (red:  0; green:  0; blue:  0),
  2368.   (red:  0; green:  0; blue:  0),
  2369.   (red:  0; green:  0; blue:  0),
  2370.   (red:  0; green:  0; blue:  0),
  2371.   (red:  0; green:  0; blue:  0),
  2372.   (red:  0; green:  0; blue:  0),
  2373.   (red:  0; green:  0; blue:  0)
  2374.  );
  2375. VAR ActualColors,             {aktuelle Farben}
  2376.     ZielPalette  :BigPalette; {Zielfarben für MapPalette(), müssen im}
  2377.                               {Datensegment liegen!}
  2378.  
  2379. FUNCTION PalEqual(p1,p2:BigPalette):BOOLEAN;
  2380. { in: p1,p2 = zu vergleichende Paletten}
  2381. {out: p1=p2 }
  2382. VAR i:WORD;
  2383.     flag:BOOLEAN;
  2384. BEGIN
  2385.  i:=0;
  2386.  REPEAT
  2387.   flag:=    (p1[i].red  =p2[i].red)
  2388.         AND (p1[i].green=p2[i].green)
  2389.         AND (p1[i].blue =p2[i].blue);
  2390.   inc(i);
  2391.  UNTIL (i>255) OR (NOT flag);
  2392.  PalEqual:=flag
  2393. END;
  2394.  
  2395. PROCEDURE GetBigPalette(VAR pal:BigPalette); ASSEMBLER;
  2396. { in: pal = Zeiger auf Palette-Speicher}
  2397. {out: pal = momentan aktueller Inhalt der 256-Farben CLUT}
  2398. ASM
  2399.    CLI
  2400.    XOR AL,AL
  2401.    MOV DX,3C7h
  2402.    OUT DX,AL
  2403.    LES DI,pal
  2404.    MOV CX,768
  2405.    MOV DX,3C9h
  2406.   @L1:
  2407.    IN AL,DX
  2408.    STOSB
  2409.    LOOP @L1
  2410.    STI
  2411. END;
  2412.  
  2413. FUNCTION BestFit(Color:BYTE):BYTE; ASSEMBLER;
  2414. { in: Color = Farbnummer des 16 Farbmodus, die approximiert werden soll}
  2415. {     ActualColors = gerade gesetzte 256 Farben}
  2416. {     DefaultColors= Tabelle der Defaultfarben der 16 (256) Farbmodi}
  2417. {out: Farbnummer, deren Farbe am ehesten der uebergebenen Farbe entspricht}
  2418. {rem: von Defaultcolors werden nur die ersten 16 Eintraege benoetigt, um  }
  2419. {     die Umsetzung Farbname -> RGB-Tripel machen zu koennen!}
  2420. ASM
  2421.   MOV BL,Color
  2422.   XOR BH,BH
  2423.   MOV SI,BX
  2424.   SHL SI,1
  2425.   ADD SI,BX
  2426.   ADD SI,OFFSET DefaultColors
  2427.   MOV BX,[SI]
  2428.   MOV DH,[SI+2]    {BL/BH/DH = aktuelle Farbe, RGB}
  2429.  
  2430.   PUSH BP
  2431.   MOV DI,65535     {DI=bisher gefundenes minimales Fehlerquadrat}
  2432.   MOV CX,255
  2433.   MOV SI,OFFSET ActualColors  {DS:SI = Zeiger auf aktuelle Farben}
  2434.  
  2435.  @searchloop:
  2436.      MOV AL,BL
  2437.      SUB AL,[SI]   {Farbdifferenz im Rotanteil}
  2438.      IMUL AL       {Fehler*quadrat* optimieren}
  2439.      MOV BP,AX
  2440.  
  2441.      MOV AL,BH     {dto., Gruenanteil}
  2442.      SUB AL,[SI+1]
  2443.      IMUL AL
  2444.      ADD BP,AX
  2445.      JC @noNewMin
  2446.  
  2447.      MOV AL,DH     {dto., Blauanteil}
  2448.      SUB AL,[SI+2]
  2449.      IMUL AL
  2450.      ADD AX,BP
  2451.      JC @noNewMin
  2452.  
  2453.      CMP AX,DI
  2454.      JAE @noNewMin
  2455.      MOV DI,AX
  2456.      MOV DL,CL     {100h-DL=bisher optimale Farbe}
  2457.     @noNewMin:
  2458.      ADD SI,3      {naechste Farbe zum Vergleich}
  2459.      LOOP @searchloop
  2460.  
  2461.   POP BP
  2462.  
  2463.   MOV AL,DL
  2464.   NOT AL           {AL:=100h-DL = optimale Farbe}
  2465.   XOR AH,AH
  2466. END;
  2467.  
  2468. PROCEDURE SetPalette(pal:BigPalette);
  2469. { in: pal = Zeiger auf zu setzende Palette }
  2470. {     StatusReg = Statusregister der VGA-Karte}
  2471. {out: Best* = Farbnummern der gerade gesetzten}
  2472. {     Palette, die den Fraben am ähnlichsten sind }
  2473. {rem: Palette wurde uebernommen}
  2474. VAR p:PalettePtr;
  2475. BEGIN
  2476.  p:=@pal; {Trick, da der Assembler nicht mit dem SS-Segment klarkommt}
  2477.  ASM
  2478.    mov dx,StatusReg
  2479.  
  2480.    PUSH DS
  2481.    LDS SI,p
  2482.  
  2483.    CLI
  2484.   @WaitNotVSyncLoop:
  2485.     in   al,dx
  2486.     and  al,8
  2487.     jnz  @WaitNotVSyncLoop
  2488.   @WaitVSyncLoop:
  2489.     in   al,dx
  2490.     and  al,8
  2491.     jz   @WaitVSyncLoop
  2492.  
  2493.    MOV DX,3C8h
  2494.    XOR AL,AL
  2495.    OUT DX,AL
  2496.    INC DX
  2497.  
  2498.    MOV CX,256
  2499.   @L1:
  2500.    LODSB
  2501.    OUT DX,AL
  2502.    LODSB
  2503.    OUT DX,AL
  2504.    LODSB
  2505.    OUT DX,AL
  2506.    LOOP @L1
  2507.  
  2508.    STI
  2509.    POP DS
  2510.  END; {of ASM}
  2511.  BestWhite:=BestFit(White);
  2512.  BestBlack:=BestFit(Black);
  2513.  BestCyan :=BestFit(Cyan);
  2514.  BestLightGray:=BestFit(LightGray);
  2515.  BestDarkGray:=BestFit(DarkGray);
  2516. END;
  2517.  
  2518. PROCEDURE SetPaletteEntry(nr,rot,gruen,blau:BYTE); ASSEMBLER;
  2519. { in: nr = zu setzende Farbe}
  2520. {     rot,gruen,blau = deren RGB-Werte (0..63)}
  2521. {     StatusReg = Portadresse des VGA-Statusregisters}
  2522. {out: - }
  2523. {rem: Die entsprechende Farbe wurde verändert}
  2524. ASM
  2525.   MOV AH,rot
  2526.   MOV BL,gruen
  2527.   MOV BH,blau
  2528.   MOV SI,3C8h
  2529.   MOV CL,nr
  2530.   MOV DX,StatusReg
  2531.  
  2532.   CLI
  2533.  @WaitNotHSync:
  2534.   IN AL,DX
  2535.   TEST AL,1
  2536.   JNE @WaitNotHSync
  2537.  @WaitHSync:
  2538.   IN AL,DX
  2539.   TEST AL,1
  2540.   JE @WaitHSync
  2541.  
  2542.   MOV DX,SI
  2543.   MOV AL,CL
  2544.   OUT DX,AL    {Farbnr. an 3C8h}
  2545.   INC DX
  2546.   MOV AL,AH
  2547.   OUT DX,AL    {rot an 3C9h}
  2548.   MOV AL,BL
  2549.   OUT DX,AL    {gruen auch}
  2550.   MOV AL,BH
  2551.   OUT DX,AL    {blau auch}
  2552.   STI
  2553. END;
  2554.  
  2555. FUNCTION LoadPalette(name:String; number:BYTE; VAR pal:BigPalette):WORD;
  2556. { in: name   = Name des zu ladenden Palette-Files (Typ: "*.PAL" )}
  2557. {     number = Nummer, die die erste Farbe aus diesem File bekommen soll  }
  2558. {     ActualColors = gerade aktuelle Farbpalette}
  2559. {out: Anzahl der aus dem File gelesenen Farben (0 = Fehler trat auf)      }
  2560. {     pal = aus dem File gelesene Farbpalette, evtl. ergaenzt}
  2561. {rem: Alle nicht ueberschriebenen Farben werden in "pal" auf die Werte der}
  2562. {     gerade aktuellen Farben "ActualColors" gesetzt; die Palette wurde   }
  2563. {     nur geladen, nicht gesetzt!}
  2564. LABEL quitloop;
  2565. VAR len:LONGINT;
  2566.     f:File;
  2567.     i,count:WORD;
  2568.     TempPal:BigPalette;
  2569.     flag:BOOLEAN;
  2570. BEGIN
  2571.  count:=0;  {Zahl der bisher eingelesenen Paletteneinträge}
  2572.  assign(f,name);
  2573.  {$I-} reset(f,1); {$I+}
  2574.  if (ioresult<>0)
  2575.   THEN BEGIN  {Datei existiert nicht oder nicht unter diesem Pfad}
  2576.         Error:=ErrFileIO;
  2577.         LoadPalette:=0; exit
  2578.        END;
  2579.  len:=filesize(f);  {Dateilaenge ermitteln}
  2580.  if (len mod 3<>0) OR (len>3*256) OR (len<3)
  2581.   THEN BEGIN
  2582.         Error:=ErrNoPalette;
  2583.         goto quitloop;
  2584.        END;
  2585.  IF len+number*3>3*256
  2586.   THEN BEGIN
  2587.         Error:=ErrPaletteWontFit;
  2588.         goto quitloop;
  2589.        END;
  2590.  
  2591.  TempPal:=ActualColors; {temporaere Palette mit aktuellen Farben vorbesetzen}
  2592.  {$I-}
  2593.   blockread(f,TempPal[number],len);
  2594.  {$I+}
  2595.  
  2596.   IF (ioresult<>0)
  2597.    THEN BEGIN
  2598.          Error:=ErrFileIO;
  2599.          goto quitloop;
  2600.         END;
  2601.  
  2602.   flag:=FALSE;
  2603.   FOR i:=number TO Pred(number+(len DIV 3))
  2604.    DO flag:=flag OR (TempPal[i].red>63)
  2605.                  OR (TempPal[i].green>63)
  2606.                  OR (TempPal[i].blue>63);
  2607.   IF flag
  2608.    THEN BEGIN
  2609.          Error:=ErrNoPalette;
  2610.          goto quitloop;
  2611.         END;
  2612.  
  2613.   {Alles ging gut: Palette zurueckgeben}
  2614.   pal:=TempPal;
  2615.   count:=len DIV 3;
  2616.  
  2617. quitloop: ;
  2618.  close(f);
  2619.  LoadPalette:=count
  2620. END;
  2621.  
  2622. PROCEDURE SavePalette(name:String; VAR pal:BigPalette);
  2623. { in: name   = Name des zu ladenden Palette-Files (Typ: "*.PAL" )}
  2624. {     pal = (teilweise) abzuspeichernde Farbpalette}
  2625. {out: - }
  2626. {rem: Palette "pal" wurde unter dem Namen "name" auf Disk abgespeichert}
  2627. VAR f:FILE;
  2628.     fehler:BYTE;
  2629. BEGIN
  2630.  assign(f,name);
  2631.  {$I-} rewrite(f,1); {$I+}
  2632.  fehler:=IOResult;
  2633.  {$I-} blockwrite(f,pal[0],SizeOf(pal)); {$I+}
  2634.  fehler:=IOResult OR fehler;
  2635.  if (fehler<>0)
  2636.   THEN BEGIN  {Datei konnte nicht geschrieben werden}
  2637.         Error:=ErrFileIO;
  2638.         exit
  2639.        END;
  2640. END;
  2641.  
  2642. PROCEDURE FindVGARegisters; ASSEMBLER;
  2643. { in: - }
  2644. {out: CRTAddress = Adresse des CRT-Ports, $3B4/$3D4 für monochrom/Farbe}
  2645. {     StatusReg  = dto., für Statusregister, $3BA/$3DA}
  2646. ASM
  2647.   MOV DX,3CCh
  2648.   IN AL,DX
  2649.   TEST AL,1
  2650.   MOV DX,3D4h
  2651.   JNZ @L1
  2652.   MOV DX,3B4h
  2653.  @L1:
  2654.   MOV CRTAddress,DX
  2655.   ADD DX,6
  2656.   MOV StatusReg,DX
  2657. END;
  2658.  
  2659.  
  2660. {---------------------------------------------}
  2661. var n,x,y,button:integer;
  2662.     s:String[5];
  2663.     Farbplatz:Farbeck;
  2664.     ch,ch2:Char;
  2665.     buttonzahl,i,j:Integer;
  2666.     FarbenStartX,FarbenStartY,FarbenHoehegesamt,
  2667.     Koordmeldx,Koordmeldy,        {Koordinaten für X/Y-Angabe}
  2668.     FilenameStartX,FilenameStartY:Integer; {dto., für Filename}
  2669.     PalnameStartX ,PalnameStartY :Integer; {dto., für Filename}
  2670.     Filenamelang,Filenamekurz: PathStr; {Dateinamen mit/ohne Pfadangabe}
  2671.     Palnamelang ,Palnamekurz : PathStr; {Palettennnamen m/o Pfadangabe }
  2672.     Wahl:WORD;
  2673.  
  2674.  
  2675. PROCEDURE FindWorkAreaMaxUsed;
  2676. { in: Workarea^.* = aktuelle Grafikdaten}
  2677. {out: WorkAreaMaxUsedX|Y = benutzte Extremkoordinaten}
  2678. LABEL break1;
  2679. VAR x,y:INTEGER;
  2680.     flag:BOOLEAN;
  2681. BEGIN
  2682.  WorkAreaMaxUsedX:=0; WorkAreaMaxUsedY:=0;
  2683.  
  2684.  {max. benutzte Zeile suchen:}
  2685.  FOR y:=WorkHoehe-1 DOWNTO 0 DO
  2686.   BEGIN {Zeilen von unten nach oben durchsuchen}
  2687.    FOR x:=WorkBreite-1 DOWNTO 0 DO {Spalten von rechts nach links durchsuchen}
  2688.     IF Workarea^.feld[y,x]<>transparent
  2689.      THEN BEGIN {gesetzten Punkt gefunden!}
  2690.            WorkAreaMaxUsedY:=y;
  2691.            WorkAreaMaxUsedX:=max(WorkAreaMaxUsedX,x);
  2692.            goto break1
  2693.           END
  2694.   END;
  2695.  break1:;
  2696.  
  2697.  {nun noch max. benutzte Spalte suchen: Zeilen WorkHoehe-1..y sind bereits}
  2698.  {durchsucht, deren Maximum steht in WorkAreaMaxUsedX!}
  2699.  IF WorkAreaMaxUsedX=WorkBreite-1 THEN exit; 
  2700.  FOR y:=y-1 DOWNTO 0 DO
  2701.   BEGIN
  2702.    x:=pred(WorkBreite); {von rechts nach links durchsehen}
  2703.    WHILE x>WorkAreaMaxUsedX DO  {nur echte neue Maxima suchen!}
  2704.     BEGIN
  2705.      IF Workarea^.feld[y,x]<>transparent
  2706.       THEN WorkAreaMaxUsedX:=max(WorkAreaMaxUsedX,x) {damit terminiert WHILE!}
  2707.       ELSE dec(x)
  2708.     END;
  2709.   END;
  2710.  
  2711. END;
  2712.  
  2713.  
  2714. PROCEDURE ErrBeep;
  2715. BEGIN
  2716.  sound(100); delay(300); nosound;
  2717. END;
  2718.  
  2719. function DetectVGA256 : Integer; FAR;
  2720. begin
  2721.   DetectVGA256 := 0
  2722. end;
  2723.  
  2724. PROCEDURE init640x400x256;
  2725. VAR Gd,Gm  : integer;
  2726.     Fehler : integer;
  2727.     Size   : LongInt;
  2728. BEGIN
  2729.  Gd := InstallUserDriver('SVGA256',@DetectVGA256);
  2730.  Gm := VID640x400x256;
  2731.  InitGraph(Gd, gm ,'');
  2732.  Fehler:=GraphResult;
  2733.  
  2734.  IF Fehler<>GrOK
  2735.   THEN BEGIN
  2736.         restorecrtmode;
  2737.         WRITELN('*** Error while initializing graphic:');
  2738.         CASE Fehler OF
  2739.          -2:WRITELN('No graphic card found.');
  2740.          -3:WRITELN('Could not find *.BGI-driver.');
  2741.          -4:WRITELN('Graphic driver has wrong format.');
  2742.          -5:WRITELN('Not enough memory to load graphic driver.');
  2743.          else WRITELN('Errorcode: ',Fehler);
  2744.         END;
  2745.         Halt(1);
  2746.        END;
  2747.  
  2748.  setgraphmode(VID640x400x256);
  2749.  Fehler:=GraphResult;
  2750.  
  2751.  IF Fehler<>0
  2752.   THEN BEGIN
  2753.         restorecrtmode;
  2754.         WRITELN('*** Unknown graphic error (while trying to switch into'+
  2755.                 ' the 256-color-mode).');
  2756.         WRITELN('Errorcode: ',Fehler);
  2757.        END
  2758.   ELSE BEGIN
  2759.         ActualColors:=DefaultColors;
  2760.         SetPalette(ActualColors);   {aktuelle Farben=Defaultfarben}
  2761.        END;
  2762. END;
  2763.  
  2764. PROCEDURE Absolute2WorkArea(VAR rx,ry:INTEGER);
  2765. { in: MausX|Y = momentane Mauskoordinaten, innerhalb der Workarea}
  2766. {     WorkStartX|Y = Startkoord. der Workarea}
  2767. {     StartVirtualX|Y = aktuelle Verschiebung des Workareabeginns}
  2768. {     zoom = momentan gesetzter Zoomfaktor}
  2769. {out: rx,ry = Mauskoordinaten relativ bzgl. der Workarea}
  2770. BEGIN
  2771.  rx:=(MausX-WorkStartX) DIV zoom +StartVirtualX;
  2772.  ry:=(MausY-WorkStartY) DIV zoom +StartVirtualY
  2773. END;
  2774.  
  2775. PROCEDURE WorkArea2Absolute(rx,ry:INTEGER; VAR ax,ay:INTEGER);
  2776. { in: rx,ry = umzurechnende Workarea-Koordinaten}
  2777. {     WorkStartX|Y = Startkoord. der Workarea}
  2778. {     StartVirtualX|Y = aktuelle Verschiebung des Workareabeginns}
  2779. {     zoom = momentan gesetzter Zoomfaktor}
  2780. {out: ax,ay = absolute (=Bildschrm-)Koordinaten von rx,ry}
  2781. BEGIN
  2782.  ax:=(rx-StartVirtualX)*zoom +WorkStartX;
  2783.  ay:=(ry-StartVirtualY)*zoom +WorkStartY;
  2784. END;
  2785.  
  2786. PROCEDURE UmrandeWorkarea(xstep,ystep:WORD);
  2787. { in: WorkStartX|Y,WorkEndX|Y = zu umrandendes Rechteck}
  2788. {     xstep,ystep = Schrittweite für Markierungen}
  2789. {     zoom = aktueller Zoomfaktor}
  2790. {out: - }
  2791. {rem: evtl. alte Markierungen werden mit schwarz gelöscht bevor die neuen}
  2792. {     Markierungen in weiß aufgebracht werden}
  2793. VAR i:WORD;
  2794.     b:BYTE;
  2795. BEGIN
  2796.  b:=BestWhite;
  2797.  SetColor(BestBlack);
  2798.  Rectangle(WorkStartX-2,WorkStartY-2,WorkEndX+2,WorkEndY+2);
  2799.  SetColor(b);
  2800.  Rectangle(WorkStartX-1,WorkStartY-1,WorkEndX+1,WorkEndY+1);
  2801.  
  2802.  i:=WorkStartX + zoom SHR 1;
  2803.  WHILE i<=WorkEndX DO
  2804.   BEGIN
  2805.    putpixel(i,WorkStartY-2,b);
  2806.    putpixel(i,WorkEndY  +2,b);
  2807.    inc(i,xstep*zoom);
  2808.   END;
  2809.  
  2810.  j:=WorkStartY + zoom SHR 1;
  2811.  WHILE j<=WorkEndY DO
  2812.   BEGIN
  2813.    putpixel(WorkStartX-2,j,b);
  2814.    putpixel(WorkEndX  +2,j,b);
  2815.    inc(j,ystep*zoom);
  2816.   END;
  2817. END;
  2818.  
  2819. PROCEDURE ShowActualTool;
  2820. { in: aktuellesTool = aktuell selektiertes Tool}
  2821. {out: - }
  2822. {rem: aktuelles Tool wurde am Bildschirm ausgegeben}
  2823. VAR s:STRING[40];
  2824. BEGIN
  2825.  SetFillStyle(SolidFill,BestBlack);
  2826.  Bar(InfoX+WorkBreite-202,InfoY+25,InfoX+WorkBreite-10,InfoY+33);
  2827.  CASE aktuellesTool OF
  2828.   Punkt: s:='pixel';
  2829.   Rechteck: s:='rectangle';
  2830.   Ellipse_: s:='ellipse';
  2831.   FRechteck: s:='bar';
  2832.   FEllipse: s:='disc';
  2833.   Linie: s:='line';
  2834.   FuellEimer: s:='floodfill';
  2835.   Kopie: s:='duplicate';
  2836.   else s:='';
  2837.  END;
  2838.  SetColor(BestWhite);
  2839.  OutTextXY(InfoX+WorkBreite-202,InfoY+25,'selected tool: '+s);
  2840. END;
  2841.  
  2842. PROCEDURE ShowActualColor;
  2843. { in: aktuelleFarbe = aktuell gewählte Farbe}
  2844. {out: - }
  2845. {rem: aktuelle Zeichenfarbe wurde am Bildschirm ausgegeben}
  2846. VAR s:STRING[3];
  2847. BEGIN
  2848.  SetFillStyle(SolidFill,BestBlack);
  2849.  Bar(InfoX+WorkBreite-202,InfoY+10,InfoX+WorkBreite-17,InfoY+18);
  2850.  Str(aktuelleFarbe:2,s);
  2851.  SetColor(BestWhite);
  2852.  OutTextXY(InfoX+WorkBreite-202,InfoY+10,'drawing color:');
  2853.  SetFillStyle(SolidFill,aktuelleFarbe);
  2854.  Str(aktuelleFarbe:3,s);
  2855.  Bar(InfoX+WorkBreite-106+24,InfoY+10,InfoX+WorkBreite-106+38,InfoY+18);
  2856.  OutTextXY(InfoX+WorkBreite-106+42,InfoY+10,'('+s+')');
  2857. END;
  2858.  
  2859. PROCEDURE ShowZoom;
  2860. { in: zoom = aktueller Zoomfaktor}
  2861. {out: - }
  2862. {rem: aktueller Zoomfaktor wurde am Bildschirm ausgegeben}
  2863. {     Dies geschieht sowohl numerisch als auch als Skalierung entlang}
  2864. {     der Workarea}
  2865. VAR s:STRING[3];
  2866. BEGIN
  2867.  SetFillStyle(SolidFill,BestBlack);
  2868.  Bar(InfoX+WorkBreite-130,InfoY,InfoX+WorkBreite-57,InfoY+8);
  2869.  SetColor(BestWhite);
  2870.  Str(zoom:3,s); OutTextXY(InfoX+WorkBreite-130,InfoY,'zoom:'+s);
  2871.  UmrandeWorkarea(8,8);
  2872. END;
  2873.  
  2874. PROCEDURE ShowOffset;
  2875. { in: StartVirtualX|Y = aktuelle Ausschnittverschiebung}
  2876. {out: - }
  2877. {rem: aktueller Verschiebung wurde am Bildschirm ausgegeben}
  2878. VAR s:STRING[3];
  2879. BEGIN
  2880.  SetFillStyle(SolidFill,BestBlack);
  2881.  Bar(InfoX,InfoY+30,InfoX+95,InfoY+48);
  2882.  SetColor(BestWhite);
  2883.  Str(StartVirtualX:3,s); OutTextXY(InfoX,InfoY+30,'offset X:'+s);
  2884.  Str(StartVirtualY:3,s); OutTextXY(InfoX,InfoY+40,'offset Y:'+s);
  2885. END;
  2886.  
  2887. PROCEDURE ShowCursorDaten;
  2888. { in: MausX,MausY = aktuelle Mauskoordinaten, innerhalb der Workarea!}
  2889. {     zoom = aktueller Zoomfaktor}
  2890. {out: Ausgabe der relativen Mauskoordinaten bzgl. der Workarea am Schirm}
  2891. {     und der Farbe unter dem Mauscursor}
  2892. {rem: Dieselben Koordinaten werden im Hauptprogramm nochmals benötigt, }
  2893. {     bei einer Änderung dort also auch ändern!}
  2894. VAR relX,relY:INTEGER;
  2895.     b:BYTE;
  2896.     s:STRING[3];
  2897. BEGIN
  2898.  Absolute2WorkArea(relX,relY); {relative Koord. berechnen}
  2899.  SetFillStyle(SolidFill,BestBlack);
  2900.  Bar(InfoX,InfoY,InfoX+80,InfoY+29);
  2901.  SetColor(BestWhite);
  2902.  Str(relX:3,s); OutTextXY(InfoX,InfoY,'X:'+s);
  2903.  Str(relY:3,s); OutTextXY(InfoX,InfoY+10,'Y:'+s);
  2904.  b:=Workarea^.feld[relY,relX]; {Farbe des Punktes}
  2905.  Str(b:3,s);
  2906.  OutTextXY(InfoX,InfoY+20,'C:');
  2907.  SetFillStyle(SolidFill,b); Bar(InfoX+24,InfoY+20,InfoX+38,InfoY+28);
  2908.  OutTextXY(InfoX+42,InfoY+20,'('+s+')');
  2909. END;
  2910.  
  2911. PROCEDURE ShowFilename;
  2912. { in: Filename* = relevante Daten/Koordinaten}
  2913. {out: - }
  2914. {rem: Filenamekurz wurde angezeigt}
  2915. BEGIN
  2916.  SetFillStyle(SolidFill,BestBlack);
  2917.  Bar(FilenameStartX,FilenameStartY,
  2918.      FilenameStartX+12*8,FilenameStartY+7);
  2919.  SetColor(BestWhite);
  2920.  OutTextXY(FilenameStartX,FilenameStartY,Filenamekurz);
  2921. END;
  2922.  
  2923. PROCEDURE UpdateWorkArea(vonX,vonY,bisX,bisY:INTEGER; fill:BOOLEAN);
  2924. { in: vonX|Y, bisX|Y = zu restaurierender Workareaausschnitt in relativen}
  2925. {                      Koordinaten}
  2926. {     StartVirtualX|Y= aktuelle Ausschnittverschiebung}
  2927. {     zoom = aktueller Zoomfaktor}
  2928. {     WorkAreaMaxUsedX|Y = größte derzeit benutzte Koordinaten}
  2929. {     Workarea = Bildschirminhalt}
  2930. {     fill = TRUE, falls der nicht spezifizierte Workarea-Inhalt gelöscht}
  2931. {            werden soll}
  2932. {out: - }
  2933. {rem: spezifizierter Bildschirminhalt wurde restauriert}
  2934. {     vonX<=bisX, vonY<=bisY, d.h.: Punkte müssen geordnet sein!}
  2935. LABEL skipx,skipy;
  2936. VAR x,y,x1,y1,lowX,lowY,highX,highY:INTEGER;
  2937.     i:BYTE;
  2938. BEGIN
  2939.  IF fill
  2940.   THEN BEGIN
  2941.         SetFillStyle(SolidFill,BestBlack);
  2942.         Bar(WorkStartX,WorkStartY,WorkEndX,WorkEndY);
  2943.        END;
  2944.  
  2945.  lowX :=max(StartVirtualX,vonX);
  2946.  highX:=min(WorkAreaMaxUsedX,bisX);
  2947.  lowY :=max(StartVirtualY,vonY);
  2948.  highY:=min(WorkAreaMaxUsedY,bisY);
  2949.  IF zoom=1
  2950.   THEN FOR y:=lowY TO highY DO
  2951.         FOR x:=lowX TO highX DO
  2952.          PutPixel(x-StartVirtualX+WorkStartX,
  2953.                   y-StartVirtualY+WorkStartY,
  2954.                   WorkArea^.feld[y,x])
  2955.   ELSE BEGIN  {Zoomfaktor berücksichtigen}
  2956.         FOR y:=lowY TO highY DO
  2957.          BEGIN
  2958.           FOR x:=lowX TO highX DO
  2959.        BEGIN
  2960.             x1:=(x -StartVirtualX)*zoom +WorkStartX;
  2961.             IF x1>WorkEndx THEN goto skipx;
  2962.             y1:=(y -StartVirtualY)*zoom +WorkStartY;
  2963.             IF y1>WorkEndY THEN goto skipy;
  2964.             SetFillStyle(SolidFill,WorkArea^.feld[y,x]);
  2965.             Bar(x1,y1,
  2966.                 min(x1+pred(zoom),WorkEndX),min(y1+pred(zoom),WorkEndY));
  2967.            END; {of FOR x}
  2968.           skipx:;
  2969.          END; {of FOR y}
  2970.         skipy:;
  2971.        END; {of ELSE}
  2972. END;
  2973.  
  2974. PROCEDURE DrawWorkAreaPixel(X,Y:INTEGER; Farbe:BYTE; Art:ActionTyp;
  2975.                             check:BOOLEAN);
  2976. { in: X,Y = zu zeichnender Punkt (relative Koord.) }
  2977. {     Farbe = Zeichenfarbe }
  2978. {     Art = STORE, falls Linie in Workarea[] eingetragen werden soll}
  2979. {           DRAW , falls Linie gezeichnet werden soll}
  2980. {           CLEAR, falls Linie gelöscht werden soll (dann: Farbe uninteressant)}
  2981. {     Check = TRUE, falls WorkAreaMaxUsedX|Y neuberechnet werden sollen}
  2982. {             (Zählt eh nur, wenn Art=STORE ist!)}
  2983. {     zoom = aktueller Zoomfaktor}
  2984. {out: WorkAreaMaxUsedX|Y = evtl. neue Extremkoordinaten}
  2985. {rem: Es wird explizit geprüft, daß die Punkte onscreen sind!}
  2986. VAR x1,y1:INTEGER;
  2987. BEGIN
  2988.  IF (X<StartVirtualX) OR (X>WorkBreite-1) OR (Y<StartVirtualY) OR (Y>WorkHoehe-1) THEN exit;
  2989.  IF Art=store
  2990.   THEN BEGIN
  2991.         Workarea^.feld[y,x]:=Farbe;
  2992.         IF Check
  2993.          THEN BEGIN
  2994.                IF Farbe<>transparent
  2995.             THEN BEGIN {benutzte Workarea-Fläche größer geworden?}
  2996.                       WorkAreaMaxUsedX:=max(X,WorkAreaMaxUsedX);
  2997.                       WorkAreaMaxUsedY:=max(Y,WorkAreaMaxUsedY);
  2998.                      END
  2999.                 ELSE FindWorkAreaMaxUsed;
  3000.               END;
  3001.         exit
  3002.        END;
  3003.  IF zoom=1
  3004.   THEN BEGIN
  3005.         IF Art=draw THEN PutPixel(x-StartVirtualX+WorkStartX,
  3006.                                   y-StartVirtualY+WorkStartY,Farbe)
  3007.         ELSE {IF Art=clear THEN} PutPixel(x-StartVirtualX+WorkStartX,
  3008.                                           y-StartVirtualY+WorkStartY,
  3009.                                           Workarea^.feld[y,x])
  3010.        END
  3011.  
  3012.   ELSE BEGIN  {Zoomfaktor berücksichtigen}
  3013.         x1:=(x -StartVirtualX)*zoom +WorkStartX;
  3014.         IF x1>WorkEndx THEN exit;
  3015.         y1:=(y -StartVirtualY)*zoom +WorkStartY;
  3016.         IF y1>WorkEndY THEN exit;
  3017.         IF Art=draw THEN SetFillStyle(SolidFill,Farbe)
  3018.         ELSE {IF Art=clear THEN} SetFillStyle(SolidFill,Workarea^.feld[y,x]);
  3019.         Bar(x1,y1,min(x1+pred(zoom),WorkEndX),min(y1+pred(zoom),WorkEndY));
  3020.        END; {of ELSE}
  3021. END;
  3022.  
  3023. PROCEDURE DrawWorkAreaLine(x1,y1,x2,y2:INTEGER; Farbe:BYTE; Art:ActionTyp;
  3024.                            check:BOOLEAN);
  3025. { in: (x1,y1),(x2,y2) = Start- und Endpunkt der zu zeichnenden Linie,}
  3026. {                       in relativen (=Workarea-)Koordinaten         }
  3027. {     Farbe = Zeichenfarbe für Zeile}
  3028. {     Art = STORE, falls Linie in Workarea[] eingetragen werden soll}
  3029. {           DRAW , falls Linie gezeichnet werden soll}
  3030. {           CLEAR, falls Linie gelöscht werden soll (dann: Farbe uninteressant)}
  3031. {     Check = TRUE, falls WorkAreaMaxUsedX|Y neuberechnet werden sollen}
  3032. {             (Zählt eh nur, wenn Art=STORE ist!)}
  3033. {     Workarea = aktuelle Grafikdaten}
  3034. {out: Linie wurde gezeichnet _oder_ in Workarea eingetragen oder gelöscht}
  3035. {     WorkAreaMaxUsedX|Y = neue Extremkoordinaten (nur wenn Art=1)}
  3036. {rem: stinknormaler Bresenham-Algorithmus!}
  3037. {     Die übergebenen Koordinaten müssen relative Koord. sein!}
  3038. VAR x,y,z,dx,dy,dz,i,maxDelta:INTEGER;
  3039.  
  3040.   PROCEDURE DrawWorkAreaPixel(X,Y:INTEGER; Farbe:BYTE);
  3041.   { in: X,Y = zu zeichnender Punkt (relative Koord.) }
  3042.   {     Farbe = Zeichenfarbe }
  3043.   {     zoom = aktueller Zoomfaktor}
  3044.   {out: - }
  3045.   {rem: Das ist eine etwas schnellere Variante als die gleichnamige obige,}
  3046.   {     da sie nur _zeichnen_ muß!}
  3047.   VAR x1,y1:INTEGER;
  3048.   BEGIN
  3049.    IF (X<StartVirtualX) OR (X>WorkBreite-1) OR (Y<StartVirtualY) OR (Y>WorkHoehe-1) THEN exit;
  3050.    IF zoom=1
  3051.     THEN PutPixel(x-StartVirtualX+WorkStartX,y-StartVirtualY+WorkStartY,Farbe)
  3052.     ELSE BEGIN  {Zoomfaktor berücksichtigen}
  3053.           x1:=(x -StartVirtualX)*zoom +WorkStartX;
  3054.           IF x1>WorkEndx THEN exit;
  3055.           y1:=(y -StartVirtualY)*zoom +WorkStartY;
  3056.           IF y1>WorkEndY THEN exit;
  3057.           SetFillStyle(SolidFill,Farbe);
  3058.           Bar(x1,y1,min(x1+pred(zoom),WorkEndX),min(y1+pred(zoom),WorkEndY));
  3059.          END; {of ELSE}
  3060.   END;
  3061.  
  3062. BEGIN
  3063.  dx:=abs(x1-x2); dy:=abs(y1-y2);
  3064.  IF x1<x2  {Punkte nach x-Koordinate sortieren}
  3065.   THEN BEGIN
  3066.         x:=x1; y:=y1;
  3067.         IF y>y2 THEN z:=-1 ELSE z:=+1  {Y-Ri. von y zu y2 >0 oder <0 ?}
  3068.        END
  3069.   ELSE BEGIN
  3070.         x:=x2; y:=y2;
  3071.         IF y>y1 THEN z:=-1 ELSE z:=+1  {dto.: z=Schrittgröße in Y-Ri. }
  3072.        END;
  3073.  IF Art=store THEN Workarea^.feld[y,x]:=Farbe        {Startpunkt setzen}
  3074.  ELSE IF Art=draw THEN DrawWorkAreaPixel(x,y,Farbe)  {Startpunkt zeichnen}
  3075.  ELSE {IF Art=clear THEN} DrawWorkAreaPixel(x,y,Workarea^.feld[y,x]);
  3076.  IF dx>dy THEN maxDelta:=dx ELSE maxDelta:=dy;
  3077.  IF (dx=0) OR (dy=0)  {horizontale oder vertikale Linie?}
  3078.   THEN FOR i:=1 TO maxDelta DO {ja, schneller Sonderfall}
  3079.     BEGIN
  3080.          IF dx<>0 THEN inc(x) ELSE inc(y,z);
  3081.          IF Art=store THEN Workarea^.feld[y,x]:=Farbe
  3082.          ELSE IF Art=draw THEN DrawWorkAreaPixel(x,y,Farbe)
  3083.          ELSE {IF Art=clear THEN} DrawWorkAreaPixel(x,y,Workarea^.feld[y,x]);
  3084.         END
  3085.   ELSE BEGIN
  3086.         dz:=maxDelta SHR 1;
  3087.         FOR i:=1 TO maxDelta DO
  3088.      BEGIN
  3089.           IF dz<dx  THEN BEGIN inc(dz,dy); inc(x,1) END; {horiz. Segment}
  3090.           IF dz>=dx THEN BEGIN dec(dz,dx); inc(y,z) END; {vert.  Segment}
  3091.           IF Art=store THEN Workarea^.feld[y,x]:=Farbe
  3092.           ELSE IF Art=draw THEN DrawWorkAreaPixel(x,y,Farbe)
  3093.           ELSE {IF Art=clear THEN} DrawWorkAreaPixel(x,y,Workarea^.feld[y,x]);
  3094.          END;
  3095.        END;
  3096.  
  3097.  IF (Art=store) 
  3098.   THEN BEGIN {evtl. neue Extremkoord. setzen}
  3099.         IF Check
  3100.          THEN BEGIN
  3101.                IF (Farbe<>transparent)
  3102.             THEN BEGIN
  3103.                       WorkAreaMaxUsedX:=max(WorkAreaMaxUsedX,max(x1,x2));
  3104.                       WorkAreaMaxUsedY:=max(WorkAreaMaxUsedY,max(y1,y2))
  3105.                      END
  3106.                 ELSE FindWorkAreaMaxUsed;
  3107.               END;
  3108.        END;
  3109. END;
  3110.  
  3111. PROCEDURE DrawWorkAreaRectangle(x1,y1,x2,y2:INTEGER; Farbe:BYTE; Art:ActionTyp);
  3112. { in: (x1,y1),(x2,y2) = Start- und Endpunkt des zu zeichnenden Rechtecks    }
  3113. {                       (oder Quadrats) in relativen (=Workarea-)Koordinaten}
  3114. {     Farbe = Zeichenfarbe für Rechteck/Quadrat}
  3115. {     Art = STORE, falls Rechteck in Workarea[] eingetragen werden soll}
  3116. {           DRAW , falls Rechteck gezeichnet werden soll}
  3117. {           CLEAR, falls Rechteck gelöscht werden soll (dann: Farbe uninteressant)}
  3118. {     Workarea = aktuelle Grafikdaten}
  3119. {out: Rechteck wurde gezeichnet _oder_ in Workarea eingetragen oder gelöscht}
  3120. {     WorkAreaMaxUsedX|Y = neue Extremkoordinaten (nur wenn Art=1)}
  3121. {rem: Die übergebenen Koordinaten müssen relative Koord. sein!}
  3122. {     Die Entscheidung, ob ein Rechteck oder ein Quadrat gezeichnet wird, wurde}
  3123. {     bereits vor dem Aufruf entschieden und geclippt!}
  3124. BEGIN
  3125.  DrawWorkAreaLine(x1,y1,x2,y1,Farbe,Art,FALSE);  {Rechteck/Quadrat aus Linien}
  3126.  DrawWorkAreaLine(x2,y1,x2,y2,Farbe,Art,FALSE);  {zusammensetzen}
  3127.  DrawWorkAreaLine(x2,y2,x1,y2,Farbe,Art,FALSE);
  3128.  DrawWorkAreaLine(x1,y2,x1,y1,Farbe,Art,FALSE);
  3129.  IF Art=STORE THEN FindWorkAreaMaxUsed;
  3130. END;
  3131.  
  3132. PROCEDURE DrawWorkAreaEllipse(x1,y1,x2,y2:INTEGER; Farbe:BYTE; Art:ActionTyp);
  3133. { in: (x1,y1) = Kreismittelpunkt bzw. Ellipsenmittelpunkt}
  3134. {     (x2,y2) = Randpunkt des Kreises bzw.: Eckpunkt des der Ellipse umschrie-}
  3135. {               benen Rechtecks, so daß Halbachsen a:=|x2-x1|, b:=|y2-y1| sind}
  3136. {     Farbe = Zeichenfarbe für Kreis/Ellipse }
  3137. {     Art = STORE, falls Kreis/Ellipse in Workarea[] eingetragen werden soll}
  3138. {           DRAW , falls Kreis/Ellipse gezeichnet werden soll}
  3139. {           CLEAR, falls Kreis/Ellipse gelöscht werden soll (dann: Farbe uninteressant)}
  3140. {     Workarea = aktuelle Grafikdaten}
  3141. {     Objekt.aligned = TRUE|FALSE für: Kreis|Ellipse}
  3142. {out: Kreis/Ellipse wurde gezeichnet _oder_ in Workarea eingetragen oder gelöscht}
  3143. {     WorkAreaMaxUsedX|Y = neue Extremkoordinaten (nur wenn Art=1)}
  3144. {rem: Die übergebenen Koordinaten müssen relative Koord. sein!}
  3145. VAR a,b,r,rq,x,y,u1,u2,u3,u4,v1,v2,v3,v4:INTEGER;
  3146. BEGIN
  3147.  IF Objekt.aligned
  3148.   THEN BEGIN {Kreis}
  3149.         rq:=sqr(x2-x1)+sqr(y2-y1);
  3150.         r:=TRUNC(sqrt(rq)+1);
  3151.         FOR y:=0 TO TRUNC(r/sqrt(2)) DO
  3152.          BEGIN
  3153.           x:=TRUNC(sqrt(rq-sqr(y)));
  3154.           u1:=x1-x; v1:=y1-y;
  3155.           u2:=x1+x; v2:=y1+y;
  3156.           u3:=x1-y; v3:=y1-x;
  3157.           u4:=x1+y; v4:=y1+x;
  3158.           DrawWorkAreaPixel(u1,v1,Farbe,Art,FALSE);
  3159.           DrawWorkAreaPixel(u1,v2,Farbe,Art,FALSE);
  3160.           DrawWorkAreaPixel(u2,v1,Farbe,Art,FALSE);
  3161.           DrawWorkAreaPixel(u2,v2,Farbe,Art,FALSE);
  3162.           DrawWorkAreaPixel(u3,v3,Farbe,Art,FALSE);
  3163.           DrawWorkAreaPixel(u3,v4,Farbe,Art,FALSE);
  3164.           DrawWorkAreaPixel(u4,v3,Farbe,Art,FALSE);
  3165.           DrawWorkAreaPixel(u4,v4,Farbe,Art,FALSE);
  3166.          END;
  3167.         IF Art=STORE THEN FindWorkAreaMaxUsed;
  3168.        END
  3169.   ELSE BEGIN {Ellipse}
  3170.         a:=abs(x2-x1); b:=abs(y2-y1); {Halbachsen berechnen}
  3171.         IF (a=0) OR (b=0)
  3172.      THEN BEGIN {Sonderfall: Ellipse entartet zum Strich oder Punkt}
  3173.                IF a=0
  3174.                 THEN DrawWorkAreaLine(x1,min(max(y1-(y2-y1),0),WorkHoehe-1),
  3175.                                       x2,y2,Farbe,Art,TRUE)
  3176.                 ELSE DrawWorkAreaLine(min(max(x1-(x2-x1),0),WorkBreite-1),
  3177.                                       y1,x2,y2,Farbe,Art,TRUE);
  3178.                exit;
  3179.               END;
  3180.          {Punkte in x-Ri. durchgehen und y berechnen}
  3181.          FOR x:=0 TO a DO  {Ellipsengleichung x²/a² + y²/b² =1}
  3182.       BEGIN            {nach y auflösen!}
  3183.            y:=round(sqrt(1.0-sqr(x/a))*b);
  3184.            u1:=x1-x; v1:=y1-y;
  3185.            u2:=x1+x; v2:=y1+y;
  3186.            DrawWorkAreaPixel(u1,v1,Farbe,Art,FALSE);
  3187.            DrawWorkAreaPixel(u1,v2,Farbe,Art,FALSE);
  3188.            DrawWorkAreaPixel(u2,v1,Farbe,Art,FALSE);
  3189.            DrawWorkAreaPixel(u2,v2,Farbe,Art,FALSE);
  3190.           END;
  3191.          {Punkte in y-Ri. durchgehen und x berechnen}
  3192.          FOR y:=0 TO b DO  {Ellipsengleichung x²/a² + y²/b² =1}
  3193.       BEGIN            {nach x auflösen!}
  3194.            x:=round(sqrt(1.0-sqr(y/b))*a);
  3195.            u1:=x1-x; v1:=y1-y;
  3196.            u2:=x1+x; v2:=y1+y;
  3197.            DrawWorkAreaPixel(u1,v1,Farbe,Art,FALSE);
  3198.            DrawWorkAreaPixel(u1,v2,Farbe,Art,FALSE);
  3199.            DrawWorkAreaPixel(u2,v1,Farbe,Art,FALSE);
  3200.            DrawWorkAreaPixel(u2,v2,Farbe,Art,FALSE);
  3201.           END;
  3202.         IF Art=STORE THEN FindWorkAreaMaxUsed;
  3203.        END;
  3204. END;
  3205.  
  3206. PROCEDURE DrawWorkAreaBar(x1,y1,x2,y2:INTEGER; Farbe:BYTE; Art:ActionTyp);
  3207. { in: (x1,y1),(x2,y2) = Start- und Endpunkt des zu zeichnenden ausgefüllten}
  3208. {                       Rechtecks (oder Quadrats) in relativen (=Workarea-)}
  3209. {                       Koordinaten}
  3210. {     Farbe = Zeichenfarbe für Rechteck/Quadrat}
  3211. {     Art = STORE, falls Rechteck in Workarea[] eingetragen werden soll}
  3212. {           DRAW , falls Rechteck gezeichnet werden soll}
  3213. {           CLEAR, falls Rechteck gelöscht werden soll (dann: Farbe uninteressant)}
  3214. {     Workarea = aktuelle Grafikdaten}
  3215. {out: Rechteck wurde gezeichnet _oder_ in Workarea eingetragen oder gelöscht}
  3216. {     WorkAreaMaxUsedX|Y = neue Extremkoordinaten (nur wenn Art=1)}
  3217. {rem: Die übergebenen Koordinaten müssen relative Koord. sein!}
  3218. {     Die Entscheidung, ob ein Rechteck oder ein Quadrat gezeichnet wird, wurde}
  3219. {     bereits vor dem Aufruf entschieden und geclippt!}
  3220. VAR y:WORD;
  3221. BEGIN
  3222.  FOR y:=min(y1,y2) TO max(y1,y2) DO   {Rechteck/Quadrat aus Linien bilden}
  3223.   DrawWorkAreaLine(x1,y,x2,y,Farbe,Art,FALSE);
  3224.  IF Art=STORE THEN FindWorkAreaMaxUsed;
  3225. END;
  3226.  
  3227. PROCEDURE DrawWorkAreaDisc(x1,y1,x2,y2:INTEGER; Farbe:BYTE; Art:ActionTyp);
  3228. { in: (x1,y1) = Scheibenmittelpunkt bzw. Ellipsenmittelpunkt}
  3229. {     (x2,y2) = Randpunkt der Scheibe bzw.: Eckpunkt des der Ellipse umschrie-}
  3230. {               benen Rechtecks, so daß Halbachsen a:=|x2-x1|, b:=|y2-y1| sind}
  3231. {     Farbe = Zeichenfarbe für Scheibe/Ellipse }
  3232. {     Art = STORE, falls Scheibe/Ellipse in Workarea[] eingetragen werden soll}
  3233. {           DRAW , falls Scheibe/Ellipse gezeichnet werden soll}
  3234. {           CLEAR, falls Scheibe/Ellipse gelöscht werden soll (dann: Farbe uninteressant)}
  3235. {     Workarea = aktuelle Grafikdaten}
  3236. {     Objekt.aligned = TRUE|FALSE für: Scheibe|ausgefüllte Ellipse}
  3237. {out: Scheibe/Ellipse wurde gezeichnet _oder_ in Workarea eingetragen oder gelöscht}
  3238. {     WorkAreaMaxUsedX|Y = neue Extremkoordinaten (nur wenn Art=1)}
  3239. {rem: Die übergebenen Koordinaten müssen relative Koord. sein!}
  3240. VAR a,b,rq,x,y,u1,u2,u3,u4,v1,v2,v3,v4:INTEGER;
  3241. BEGIN
  3242.  IF Objekt.aligned
  3243.   THEN BEGIN {Scheibe}
  3244.         rq:=sqr(x2-x1)+sqr(y2-y1);
  3245.         FOR y:=0 TO ROUND(sqrt(rq/2)) DO
  3246.          BEGIN
  3247.           x:=TRUNC(sqrt(rq-sqr(y)));
  3248.           u1:=max(x1-x,0);            v1:=max(y1-y,0);
  3249.           u2:=min(x1+x,WorkBreite-1); v2:=min(y1+y,WorkHoehe-1);
  3250.           u3:=max(x1-y,0);            v3:=max(y1-x,0);
  3251.           u4:=min(x1+y,WorkBreite-1); v4:=min(y1+x,WorkHoehe-1);
  3252.           DrawWorkAreaLine(u1,v1,u2,v1,Farbe,Art,FALSE);
  3253.           DrawWorkAreaLine(u1,v2,u2,v2,Farbe,Art,FALSE);
  3254.           DrawWorkAreaLine(u3,v3,u4,v3,Farbe,Art,FALSE);
  3255.           DrawWorkAreaLine(u3,v4,u4,v4,Farbe,Art,FALSE);
  3256.          END;
  3257.         IF Art=STORE THEN FindWorkAreaMaxUsed;
  3258.        END
  3259.   ELSE BEGIN {Ellipse}
  3260.         a:=abs(x2-x1); b:=abs(y2-y1); {Halbachsen berechnen}
  3261.         IF (a=0) OR (b=0)
  3262.      THEN BEGIN {Sonderfall: Ellipse entartet zum Strich oder Punkt}
  3263.                IF a=0
  3264.                 THEN DrawWorkAreaLine(x1,min(max(y1-(y2-y1),0),WorkHoehe-1),
  3265.                                       x2,y2,Farbe,Art,TRUE)
  3266.                 ELSE DrawWorkAreaLine(min(max(x1-(x2-x1),0),WorkBreite-1),
  3267.                                       y1,x2,y2,Farbe,Art,TRUE);
  3268.                exit;
  3269.               END;
  3270.          {Punkte in y-Ri. durchgehen und x berechnen}
  3271.          FOR y:=0 TO b DO  {Ellipsengleichung x²/a² + y²/b² =1}
  3272.       BEGIN            {nach x auflösen!}
  3273.            x:=trunc(sqrt(1.0-sqr(y/b))*a);
  3274.            u1:=max(x1-x,0);            v1:=max(y1-y,0);
  3275.            u2:=min(x1+x,WorkBreite-1); v2:=min(y1+y,WorkHoehe-1);
  3276.            DrawWorkAreaLine(u1,v1,u2,v1,Farbe,Art,FALSE);
  3277.            DrawWorkAreaLine(u1,v2,u2,v2,Farbe,Art,FALSE);
  3278.           END;
  3279.         IF Art=STORE THEN FindWorkAreaMaxUsed;
  3280.        END;
  3281. END;
  3282.  
  3283. PROCEDURE DrawWorkAreaFill(x1,y1:INTEGER; Farbe:BYTE; Art:ActionTyp);
  3284. { in: (x1,y1) = Startpunkt, von dem aus gefüllt werden soll}
  3285. {     Farbe = Füllfarbe}
  3286. {     Art = STORE, falls Füllgebiet in Workarea[] eingetragen werden soll}
  3287. {           DRAW , falls Füllgebiet gezeichnet werden soll}
  3288. {           CLEAR, falls Füllgebiet gelöscht werden soll (dann: Farbe uninteressant)}
  3289. {     Workarea = aktuelle Grafikdaten}
  3290. {out: Workarea wurde von (x1,y1) ausgehend "geflutet" _oder_ in Workarea eingetragen}
  3291. {     oder gelöscht}
  3292. {     WorkAreaMaxUsedX|Y = neue Extremkoordinaten (nur wenn Art=1)}
  3293. {rem: Die übergebenen Koordinaten müssen relative Koord. sein!}
  3294. VAR aufFarbe:BYTE;
  3295.     tempArea:^WorkAreaTyp;
  3296.  
  3297.  PROCEDURE RecursiveFill(x,y:WORD);
  3298.  { in: (x,y)=Ausgangspunkt für das Füllen}
  3299.  {     aufFarbe=Farbe, die überschrieben werden darf}
  3300.  {     Farbe=Füllfarbe}
  3301.  {     Art=DRAW oder STORE}
  3302.  {     tempArea=Kopie der Workarea}
  3303.  {out: Alle von (x,y) aus erreichbaren Pixel der Farbe "aufFarbe" wurden}
  3304.  {     mit der Farbe "Farbe" überschrieben}
  3305.  {rem: Der Alg. sucht die längste horizontale Linie, die er durchgehend }
  3306.  {     zeichnen kann und ruft sich rekursiv für die dadurch entstehenden}
  3307.  {     oberen und unteren Hälften auf}
  3308.  VAR i,StartX,EndX:INTEGER;
  3309.  BEGIN
  3310.   IF tempArea^.feld[y,x]<>aufFarbe THEN exit; {Abbruch der Rekursion}
  3311.   StartX:=x; EndX:=x;
  3312.   WHILE (EndX<=WorkBreite-1) AND
  3313.         ( (EndX=WorkBreite-1) OR (tempArea^.feld[y,EndX+1]=aufFarbe))
  3314.    DO inc(EndX);     {boolesche Kurzschlußauswertung wichtig!}
  3315.   IF EndX=WorkBreite THEN dec(EndX);
  3316.   {damit: EndX=letztes X, das gefüllt werden darf}
  3317.   WHILE (StartX>=0) AND
  3318.         ( (StartX=0) OR (tempArea^.feld[y,StartX-1]=aufFarbe))
  3319.    DO dec(StartX);   {boolesche Kurzschlußauswertung wichtig!}
  3320.   IF StartX=-1 THEN inc(StartX);
  3321.   {damit: StartX=erstes X, das gefüllt werden darf}
  3322.  
  3323.   DrawWorkAreaLine(StartX,y,EndX,y,Farbe,Art,FALSE); {diese Linie zeichnen}
  3324.   FOR i:=StartX TO EndX DO tempArea^.feld[y,i]:=Farbe; {und merken!}
  3325.  
  3326.   IF y>0  {obere Hälfte abarbeiten}
  3327.    THEN FOR i:=StartX TO EndX DO RecursiveFill(i,pred(y));
  3328.   IF y<WorkHoehe-1  {untere Hälfte abarbeiten}
  3329.    THEN FOR i:=StartX TO EndX DO RecursiveFill(i,succ(y));
  3330.  END;
  3331.  
  3332. BEGIN
  3333.  IF (Art=DRAW) OR (Art=STORE)
  3334.   THEN BEGIN
  3335.         aufFarbe:=WorkArea^.feld[y1,x1]; {auf welcher Farbe soll gefüllt werden?}
  3336.         IF aufFarbe<>Farbe
  3337.      THEN BEGIN
  3338.                New(tempArea); Move(WorkArea^,tempArea^,SizeOf(WorkArea^));
  3339.                RecursiveFill(x1,y1); {na dann mach mal!}
  3340.                IF Art=STORE
  3341.                 THEN BEGIN
  3342.                       Move(tempArea^,WorkArea^,SizeOf(WorkArea^));
  3343.                       FindWorkAreaMaxUsed
  3344.                      END;
  3345.                Dispose(tempArea);
  3346.               END;
  3347.        END
  3348.   ELSE {IF Art=CLEAR THEN}
  3349.        BEGIN
  3350.         UpdateWorkArea(StartVirtualX,StartVirtualY,
  3351.                        WorkAreaMaxUsedX,WorkAreaMaxUsedY,TRUE);
  3352.        END;
  3353. END;
  3354.  
  3355. PROCEDURE DrawWorkAreaCopy(x1,y1,x2,y2,x3,y3:INTEGER; Art:ActionTyp);
  3356. { in: (x1,y1),(x2,y2) = Start- und Endpunkt des zu zeichnenden Bereichs}
  3357. {     (x3,y3)         = Zielpunkt dafür (nur für stage=2)}
  3358. {                       (alles in relativen (=Workarea-)Koordinaten) }
  3359. {     Art = STORE, falls Bereich in Workarea[] eingetragen werden soll}
  3360. {           DRAW , falls Bereich gezeichnet werden soll}
  3361. {           CLEAR, falls Bereich gelöscht werden soll  }
  3362. {     Workarea = aktuelle Grafikdaten }
  3363. {     Objekt.stage = aktueller Zustand (1 oder 2)}
  3364. {out: Bereich wurde gezeichnet _oder_ in Workarea eingetragen oder gelöscht}
  3365. {     WorkAreaMaxUsedX|Y = neue Extremkoordinaten (nur wenn Art=STORE)}
  3366. {rem: Die übergebenen Koordinaten müssen relative Koord. sein!}
  3367. {     Punkte der Farbe "transparent" werden als durchsichtig behandelt!}
  3368. VAR x,y:WORD;
  3369.     farbe:BYTE;
  3370. BEGIN
  3371.  IF x1>x2 THEN BEGIN x:=x1; x1:=x2; x2:=x END;
  3372.  IF y1>y2 THEN BEGIN y:=y1; y1:=y2; y2:=y END;
  3373.  IF (Art=DRAW) OR (Art=CLEAR)
  3374.   THEN BEGIN
  3375.         IF Objekt.stage=1
  3376.      THEN BEGIN {gepunktete Box aufspannen}
  3377.                farbe:=BestWhite;
  3378.                FOR x:=x1 TO x2 DO
  3379.         BEGIN
  3380.                  DrawWorkAreaPixel(x,y1,farbe,Art,FALSE);
  3381.                  DrawWorkAreaPixel(x,y2,farbe,Art,FALSE);
  3382.                  IF farbe=BestWhite
  3383.                   THEN farbe:=BestBlack
  3384.                   ELSE farbe:=BestWhite
  3385.                 END;
  3386.                farbe:=BestBlack;
  3387.                FOR y:=SUCC(y1) TO PRED(y2) DO
  3388.         BEGIN
  3389.                  DrawWorkAreaPixel(x1,y,farbe,Art,FALSE);
  3390.                  DrawWorkAreaPixel(x2,y,farbe,Art,FALSE);
  3391.                  IF farbe=BestWhite
  3392.                   THEN farbe:=BestBlack
  3393.                   ELSE farbe:=BestWhite
  3394.                 END;
  3395.               END
  3396.      ELSE BEGIN {Bereich (x1,y1)-(x2,y2) nach (x3,y3) kopieren oder löschen}
  3397.                FOR y:=y1 TO y2 DO
  3398.                 FOR x:=x1 TO x2 DO
  3399.                  IF WorkArea^.feld[y,x]<>transparent
  3400.                   THEN DrawWorkAreaPixel(x3+(x-x1),y3+(y-y1),
  3401.                                          WorkArea^.feld[y,x],Art,FALSE)
  3402.               END;
  3403.        END
  3404.   ELSE BEGIN {Art=Store (AND stage=2)}
  3405.         FOR y:=y1 TO y2 DO
  3406.          FOR x:=x1 TO x2 DO
  3407.           IF WorkArea^.feld[y,x]<>transparent
  3408.            THEN DrawWorkAreaPixel(x3+(x-x1),y3+(y-y1),
  3409.                                   WorkArea^.feld[y,x],STORE,FALSE);
  3410.         FindWorkAreaMaxUsed;
  3411.        END;
  3412. END;
  3413.  
  3414.  
  3415. FUNCTION sign(a:INTEGER):INTEGER;
  3416. BEGIN
  3417.  IF a<0 THEN sign:=-1
  3418.  ELSE IF a>0 THEN sign:=+1
  3419.  ELSE sign:=0
  3420. END;
  3421.  
  3422. PROCEDURE ClearOldObject;
  3423. { in: Objekt.Typ = zu restaurierender Typ}
  3424. {     Objekt.StartX,StartY,LastX,LastY = Start-/Endpunkte der Maus für}
  3425. {                                        dieses Objekt}
  3426. {out: - }
  3427. CONST DontCare=0;
  3428. VAR tempX,tempY:INTEGER;
  3429. BEGIN
  3430.  WITH Objekt DO
  3431.   BEGIN
  3432.    IF stage=0 THEN exit; {kein Objekt begonnen, also nichts zum löschen!}
  3433.    CASE Typ OF
  3434.     Punkt:DrawWorkAreaPixel(StartX,StartY,DontCare,CLEAR,FALSE);
  3435.     Linie:DrawWorkAreaLine(StartX,StartY,LastX,LastY,DontCare,CLEAR,FALSE);
  3436.     Rechteck:DrawWorkAreaRectangle(StartX,StartY,LastX,LastY,DontCare,CLEAR);
  3437.     Ellipse_:DrawWorkAreaEllipse(StartX,StartY,LastX,LastY,DontCare,CLEAR);
  3438.     FRechteck:DrawWorkAreaBar(StartX,StartY,LastX,LastY,DontCare,CLEAR);
  3439.     FEllipse:DrawWorkAreaDisc(StartX,StartY,LastX,LastY,DontCare,CLEAR);
  3440.     FuellEimer:DrawWorkAreaFill(LastX,LastY,DontCare,CLEAR);
  3441.     Kopie:DrawWorkAreaCopy(StartX,StartY,LastX,LastY,actX,actY,CLEAR);
  3442.     else ErrBeep;
  3443.    END; {of CASE}
  3444.   END; {of WITH}
  3445. END;
  3446.  
  3447. PROCEDURE DrawNewObject;
  3448. { in: Objekt.Typ = zu zeichnender Typ}
  3449. {     Objekt.StartX,StartY,LastX,LastY = Start-/Endpunkte der Maus für}
  3450. {                                        dieses Objekt}
  3451. {     Objekt.Farbe = Zeichenfarbe}
  3452. {out: - }
  3453. {rem: Aktuelles Objekt wurde im Bereich der Workarea gezeichnet, ohne }
  3454. {     aber in die Workarea[] aufgenommen worden zu sein}
  3455. VAR tempX,tempY:INTEGER;
  3456. BEGIN
  3457.  WITH Objekt DO
  3458.   BEGIN
  3459.    IF stage=0 THEN exit; {kein Objekt begonnen, also nichts zum zeichnen!}
  3460.    CASE Typ OF
  3461.     Punkt:DrawWorkAreaPixel(StartX,StartY,aktuelleFarbe,DRAW,FALSE);
  3462.     Linie:DrawWorkAreaLine(StartX,StartY,LastX,LastY,aktuelleFarbe,DRAW,FALSE);
  3463.     Rechteck:DrawWorkAreaRectangle(StartX,StartY,LastX,LastY,aktuelleFarbe,DRAW);
  3464.     Ellipse_:DrawWorkAreaEllipse(StartX,StartY,LastX,LastY,aktuelleFarbe,DRAW);
  3465.     FRechteck:DrawWorkAreaBar(StartX,StartY,LastX,LastY,aktuelleFarbe,DRAW);
  3466.     FEllipse:DrawWorkAreaDisc(StartX,StartY,LastX,LastY,aktuelleFarbe,DRAW);
  3467.     FuellEimer:DrawWorkAreaFill(LastX,LastY,aktuelleFarbe,DRAW);
  3468.     Kopie:DrawWorkAreaCopy(StartX,StartY,LastX,LastY,actX,actY,DRAW);
  3469.     else ErrBeep;
  3470.    END; {of CASE}
  3471.   END; {of WITH}
  3472. END;
  3473.  
  3474. PROCEDURE StoreObject;
  3475. { in: Objekt.Typ = zu zeichnender Typ}
  3476. {     Objekt.StartX,StartY,LastX,LastY = Start-/Endpunkte der Maus für}
  3477. {                                        dieses Objekt}
  3478. {     Objekt.Farbe = Zeichenfarbe}
  3479. {out: - }
  3480. {rem: Objekt wurde in Workarea[] übernommen; es ist dabei unerheblich,}
  3481. {     ob das Objekt auf dem Schirm sichtbar ist oder nicht (natürlich }
  3482. {     sollte es sichtbar sein, um den Benutzer nicht zu verwirren,    }
  3483. {     aber es ist eben nicht zwingend erforderlich)}
  3484. VAR tempX,tempY:INTEGER;
  3485. BEGIN
  3486.  WITH Objekt DO
  3487.   BEGIN
  3488.    CASE Typ OF
  3489.     Punkt:DrawWorkAreaPixel(StartX,StartY,aktuelleFarbe,STORE,TRUE);
  3490.     Linie:DrawWorkAreaLine(StartX,StartY,LastX,LastY,aktuelleFarbe,STORE,TRUE);
  3491.     Rechteck:DrawWorkAreaRectangle(StartX,StartY,LastX,LastY,aktuelleFarbe,STORE);
  3492.     Ellipse_:DrawWorkAreaEllipse(StartX,StartY,LastX,LastY,aktuelleFarbe,STORE);
  3493.     FRechteck:DrawWorkAreaBar(StartX,StartY,LastX,LastY,aktuelleFarbe,STORE);
  3494.     FEllipse:DrawWorkAreaDisc(StartX,StartY,LastX,LastY,aktuelleFarbe,STORE);
  3495.     FuellEimer:DrawWorkAreaFill(LastX,LastY,aktuelleFarbe,STORE);
  3496.     Kopie:DrawWorkAreaCopy(StartX,StartY,LastX,LastY,actX,actY,STORE);
  3497.     else ErrBeep;
  3498.    END; {of CASE}
  3499.  
  3500.    stage:=0; {Objekt beendet}
  3501.   END; {of WITH}
  3502. END;
  3503.  
  3504. PROCEDURE ShowPalName;
  3505. { in: Palnamekurz = Palettenname}
  3506. {     ActualColors = aktuelle Farben}
  3507. {out: - }
  3508. BEGIN
  3509.  SetFillStyle(SolidFill,BestBlack);
  3510.  Bar(PalnameStartX,PalnameStartY,PalnameStartX+(18 SHL 3),PalnameStartY+8);
  3511.  IF PalEqual(ActualColors,DefaultColors)
  3512.   THEN BEGIN {Standardpalette}
  3513.         SetColor(BestWhite);
  3514.         OutTextXY(PalnameStartX,PalnameStartY,'(Default palette)');
  3515.        END
  3516.   ELSE BEGIN {Palette wurde geladen, also darstellen!}
  3517.         SetColor(BestWhite);
  3518.         OutTextXY(PalnameStartX,PalnameStartY,Palnamekurz);
  3519.        END;
  3520. END;
  3521.  
  3522. PROCEDURE RestoreScreen;
  3523. { in: WorkArea = Spritedaten bzw. Bilddaten}
  3524. {     WorkAreaMaxUsedX|Y = vom Bild benutzte Extremkoordinaten}
  3525. {out: Grafikbildschirm wurde restauriert}
  3526. VAR s:STRING[5];
  3527.  
  3528.  PROCEDURE MenuZeigen;
  3529.  VAR s:STRING[3];
  3530.  BEGIN
  3531.   globalI:=1;
  3532.   WHILE (menu[globalI].x1<menu[globalI].x2) AND (menu[globalI].Paint) DO
  3533.    BEGIN
  3534.     menu[globalI].Show;
  3535.     INC(globalI)
  3536.    END;
  3537.  END;
  3538.  
  3539.  PROCEDURE WorkAreaDarstellen;
  3540.  BEGIN
  3541.   UpdateWorkArea(StartVirtualX,StartVirtualY,
  3542.                  WorkAreaMaxUsedX,WorkAreaMaxUsedY,FALSE);
  3543.   DrawNewObject;
  3544.   ShowFilename;
  3545.  END;
  3546.  
  3547.  PROCEDURE PaletteZeigen;
  3548.  VAR x,y:WORD;
  3549.      s:STRING[3];
  3550.      i:BYTE;
  3551.  BEGIN
  3552.   SetColor(BestWhite);
  3553.   FOR i:=0 TO 15 DO
  3554.    BEGIN
  3555.     STR(i:2,s);
  3556.     OutTextXY(PaletteX+25+i*PalBreite,PaletteY,s);
  3557.     STR(i*16:3,s);
  3558.     OutTextXY(PaletteX,PaletteY+10+3+i*PalHoehe,s);
  3559.    END;
  3560.   FOR y:=0 TO 15 DO
  3561.    BEGIN
  3562.     FOR x:=0 TO 15 DO
  3563.      BEGIN
  3564.       SetFillStyle(SolidFill,y*16+x);
  3565.       Bar(PaletteX+25+x*PalBreite,PaletteY+10+y*PalHoehe,
  3566.           PaletteX+25+succ(x)*PalBreite-3,PaletteY+10+succ(y)*PalHoehe-3);
  3567.      END;
  3568.    END;
  3569.  END;
  3570.  
  3571.  
  3572. BEGIN
  3573.  SetPalette(ActualColors);  {aktuelle Farben wieder einsetzen}
  3574.  SetFillStyle(SolidFill,BestBlack);
  3575.  Bar(0,0,GetMaxX,GetMaxY);
  3576.  
  3577.  MenuZeigen;
  3578.  PaletteZeigen;
  3579.  IF InWorkArea THEN ShowCursorDaten;
  3580.  
  3581.  UmrandeWorkarea(8,8);
  3582.  ShowFileName;
  3583.  WorkAreaDarstellen;
  3584.  
  3585.  ShowZoom;
  3586.  ShowActualColor;
  3587.  ShowOffset;
  3588.  ShowActualTool;
  3589.  DrawNewObject;
  3590.  ShowPalName;
  3591.  
  3592.  SetColor(BestWhite);
  3593.  SetTextStyle(DefaultFont,HorizDir,2);
  3594.  OutTextXY(0,0,Titel1);
  3595.  SetTextStyle(DefaultFont,HorizDir,1);
  3596.  
  3597. END;
  3598.  
  3599. PROCEDURE loescheWorkarea;
  3600. VAR i:Integer;
  3601. BEGIN
  3602.  SetColor(BestBlack);
  3603.  FOR i:=WorkStartY TO WorkEndY DO line(WorkStartX,i,WorkEndX,i);
  3604. END;
  3605.  
  3606. PROCEDURE ladeSprite;
  3607. { in: Workarea^ = alte Grafikdaten (uninteressant, wenn Shift=FALSE)}
  3608. {     Shift = TRUE|FALSE für: alten Inhalt überlagern/löschen}
  3609. {out: Filenamelang = gewählter Dateiname mit Pfadangabe}
  3610. {     Filenamekurz = dto., nur Name+Extension}
  3611. {     WorkArea = Bild der geladenen Datei    }
  3612. {     WorkAreaMaxUsedX|Y = Extremkoordinaten }
  3613. VAR s,name:String;
  3614.     Dirname : DirStr;
  3615.     Filename: NameStr;
  3616.     Extname : ExtStr;
  3617.     fehler:Boolean;
  3618.     GrafikBild:Pointer;
  3619.     Size,i,offset,vonwo:Word;
  3620.     zeile,spalte,startx,endx:INTEGER;
  3621.     plane:BYTE;
  3622.     sprite:^spritetyp;  {Hier steht das eigentliche Sprite drinnen}
  3623.  
  3624.     FUNCTION Spritedatenlesen(name:String):Boolean;
  3625.     { in: "name" ist der vollständige Name des einzulesenden Sprites   }
  3626.     {out: Die globale Variable "sprite^" enthält die Daten des Sprites }
  3627.     {     Ist "name" kein 256-Farben-Sprite oder zu groß, um in der    }
  3628.     {     Workarea bearbeitet zu werden, so wird "FALSE" zurückgegeben,}
  3629.     {     anderenfalls "TRUE"                                          }
  3630.     {rem: Das Sprite wird NICHT dargestellt, sondern nur eingelesen!   }
  3631.     VAR f:file;
  3632.         size:longint;
  3633.         i,j:Word;
  3634.  
  3635.         PROCEDURE FehlerMeldung(s:String);
  3636.         VAR ch:char;
  3637.         BEGIN
  3638.          WRITELN(#7);
  3639.          WRITE(s+' <any key>');
  3640.          ch:=readkey;
  3641.          while keypressed do ch:=readkey
  3642.         END;
  3643.  
  3644.     BEGIN
  3645.      assign(f,name);
  3646.      {$I-}
  3647.      reset(f,1); size:=FileSize(f);
  3648.      {$I+}
  3649.      if ioresult<>0
  3650.       THEN BEGIN
  3651.             FehlerMeldung('I/O-error while trying to open file!');
  3652.             Spritedatenlesen:=false;
  3653.             exit
  3654.            END;
  3655.      if size>SizeOF(sprite^.readin)
  3656.       THEN BEGIN
  3657.             FehlerMeldung('File too big!');
  3658.             close(f);
  3659.             Spritedatenlesen:=false;
  3660.             exit
  3661.            END;
  3662.      if size<Kopf
  3663.       THEN BEGIN
  3664.             FehlerMeldung('File to small to be a sprite file!');
  3665.             Spritedatenlesen:=false;
  3666.             exit
  3667.            END;
  3668.  
  3669.      blockread(f,sprite^.readin,size);
  3670.      close(f); WRITELN;
  3671.  
  3672.      WITH Sprite^ DO
  3673.       BEGIN  {Jetzt kommt die Fehlerprüfung:}
  3674.        IF (Kennung[1]<>'K') or (Kennung[2]<>'R')   {Kennung muss "KR" sein}
  3675.         or (SpriteLength<>size)                    {Groesse muss stimmen}
  3676.         or (Zeiger_auf_Plane[1]-Zeiger_auf_Plane[0]<>  {Planegröße muß mit}
  3677.             Breite_in_4er_Gruppen*Hoehe_in_Zeilen) {Abmessungen übereinstimmen}
  3678.         or (ZeigerR-ZeigerL<>Hoehe_in_Zeilen*2)  {X-Grenztabellengröße auch}
  3679.         or (ZeigerU-ZeigerO<>Breite_in_4er_Gruppen*8)  {dto., für Y-Gr.tab.}
  3680.         or (Translate[1]<>1)    {die 4 Translate-Einträge im Spriteheader}
  3681.         or (Translate[2]<>2)    {müssen die ersten 4 Zweierpotenzwerte haben}
  3682.         or (Translate[3]<>4)
  3683.         or (Translate[4]<>8)
  3684.          THEN BEGIN
  3685.                FehlerMeldung('This is no 256-color-sprite!');
  3686.                Spritedatenlesen:=false;
  3687.                exit
  3688.               END;
  3689.  
  3690.        IF (Hoehe_in_Zeilen>Workhoehe) or
  3691.           (Breite_in_4er_Gruppen*4>WorkBreite)
  3692.         THEN BEGIN
  3693.               FehlerMeldung('Sprite to big to fit into workarea!');
  3694.               Spritedatenlesen:=false;
  3695.               exit
  3696.              END;
  3697.       END;
  3698.  
  3699.      Spritedatenlesen:=true
  3700.     END;
  3701.  
  3702. BEGIN
  3703.  RestoreCRTMode;
  3704.  ClrScr;
  3705.  
  3706.  name:='*.COD';
  3707.  GotoXY(10,4);
  3708.  WRITE('Select your *.COD-file to load with the cursor keys,');
  3709.  GotoXY(10,5);
  3710.  WRITE('PageUP/PageDOWN, HOME/END and CR; <ESC> to cancel:');
  3711.  Dateiwahl(10,7,15,name,fehler);
  3712.  IF fehler THEN
  3713.   BEGIN
  3714.    setgraphmode(VID640x400x256);
  3715.    RestoreScreen;
  3716.    write(#7);
  3717.    OkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,'ok',
  3718.          '*** I/O-error! ***',
  3719.          'Couldn''t open file/device',name,Abfrage);
  3720.   END
  3721.  ELSE IF name=''
  3722.   THEN BEGIN {nichts ausgewählt (ESC gedrückt)}
  3723.         setgraphmode(VID640x400x256);
  3724.         RestoreScreen;
  3725.        END
  3726.  ELSE BEGIN {Spritedaten lesen}
  3727.        New(sprite);
  3728.        IF Spritedatenlesen(name)  {ok, Daten einlesen und prüfen}
  3729.         THEN BEGIN
  3730.               Filenamelang:=name;
  3731.               FSplit(Filenamelang, Dirname, Filename, Extname);
  3732.               Filenamekurz:=Filename+Extname;
  3733.  
  3734.               {Jetzt Spritedaten nach WorkArea decodieren:}
  3735.               IF NOT Shift
  3736.                THEN FillChar(WorkArea^,SizeOf(WorkArea^),transparent);
  3737.               WITH sprite^ DO
  3738.            BEGIN
  3739.                 FOR zeile:=0 TO Pred(Hoehe_in_Zeilen) DO
  3740.          BEGIN
  3741.                   startx:=zeigerL+zeile shl 1;
  3742.                   endx  :=zeigerR+zeile shl 1;
  3743.                   FOR spalte:=readin[succ(startx)] shl 8 +readin[startx]
  3744.                    TO readin[succ(endx)] shl 8 +readin[endx] DO
  3745.            BEGIN
  3746.                     plane:=spalte and 3;
  3747.                     offset:=spalte shr 2 +zeile*Breite_in_4er_Gruppen;
  3748.                     vonwo:=Zeiger_auf_Plane[plane];
  3749.                     IF readin[vonwo+offset]<>transparent
  3750.                      THEN WorkArea^.feld[zeile,spalte]:=readin[vonwo+offset]
  3751.                    END;
  3752.                  END;
  3753.              (* Folgende Zuweisungen wären zu ungenau, da Sprites    *)
  3754.              (* in X-Richtung immer als Vielfaches von 4 gespeichert *)
  3755.              (* werden: *)
  3756.                 (*
  3757.                 WorkAreaMaxUsedX:=min(Breite_in_4er_Gruppen*4-1,XMAX);
  3758.                 WorkAreaMaxUsedY:=pred(Hoehe_in_Zeilen);
  3759.                 *)
  3760.                 FindWorkAreaMaxUsed; (* ...deshalb lieber so! *)
  3761.                END;
  3762.  
  3763.               setgraphmode(VID640x400x256);
  3764.               RestoreScreen;
  3765.              END
  3766.         ELSE BEGIN {keine oder fehlerhafte *.COD-Datei}
  3767.               Filenamelang:=''; Filenamekurz:='';
  3768.               setgraphmode(VID640x400x256);
  3769.               RestoreScreen;
  3770.              END;
  3771.        Dispose(sprite);
  3772.       END;
  3773. END;
  3774.  
  3775. PROCEDURE ladePalette;
  3776. { in: -}
  3777. {out: Palnamelang = gewählter Dateiname mit Pfadangabe}
  3778. {     Palnamekurz = dto., nur Name+Extension}
  3779. {rem: Ist die geladene Palette gleich der Standardpalette, so werden}
  3780. {     Palname* auf '' gesetzt}
  3781. VAR s,name:String;
  3782.     Dirname : DirStr;
  3783.     Filename: NameStr;
  3784.     Extname : ExtStr;
  3785.     fehler:Boolean;
  3786.     neuPal:BigPalette;
  3787.     i:WORD;
  3788.  
  3789.         PROCEDURE FehlerMeldung(s:String);
  3790.         VAR ch:char;
  3791.         BEGIN
  3792.          WRITELN(#7);
  3793.          WRITE(s+' <any key>');
  3794.          ch:=readkey;
  3795.          while keypressed do ch:=readkey
  3796.         END;
  3797.  
  3798. BEGIN
  3799.  RestoreCRTMode;
  3800.  ClrScr;
  3801.  
  3802.  name:='*.PAL';
  3803.  GotoXY(10,4);
  3804.  WRITE('Select your *.PAL-file to load with the cursor keys,');
  3805.  GotoXY(10,5);
  3806.  WRITE('PageUP/PageDOWN, HOME/END and CR; <ESC> to cancel:');
  3807.  Dateiwahl(10,7,15,name,fehler);
  3808.  IF fehler THEN
  3809.   BEGIN
  3810.    setgraphmode(VID640x400x256);
  3811.    RestoreScreen;
  3812.    write(#7);
  3813.    OkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,'ok',
  3814.          '*** I/O-error! ***',
  3815.          'Couldn''t open file/device',name,Abfrage);
  3816.   END
  3817.  ELSE IF name=''
  3818.   THEN BEGIN {nichts ausgewählt (ESC gedrückt)}
  3819.         setgraphmode(VID640x400x256);
  3820.         RestoreScreen;
  3821.        END
  3822.  ELSE IF LoadPalette(name,0,neuPal)<>0  {ok, Daten einlesen und prüfen}
  3823.        THEN BEGIN
  3824.              Palnamelang:=name;
  3825.              FSplit(Palnamelang, Dirname, Filename, Extname);
  3826.              Palnamekurz:=Filename+Extname;
  3827.  
  3828.              setgraphmode(VID640x400x256);
  3829.              ActualColors:=neuPal;
  3830.              SetPalette(ActualColors);
  3831.              IF PalEqual(ActualColors,DefaultColors)
  3832.           THEN BEGIN  {geladene Palette = Standardpalette?}
  3833.                     Palnamelang:='';
  3834.                     Palnamekurz:='';
  3835.                    END;
  3836.              RestoreScreen;
  3837.  
  3838.             END
  3839.        ELSE BEGIN {keine oder fehlerhafte *.PAL-Datei}
  3840.              FehlerMeldung('Couldn''t read *.PAL-file!');
  3841.              Palnamelang:=''; Palnamekurz:='';
  3842.              setgraphmode(VID640x400x256);
  3843.              RestoreScreen;
  3844.             END;
  3845. END;
  3846.  
  3847. FUNCTION SelectZielPalette:BOOLEAN;
  3848. { in: -}
  3849. {out: Palnamelang = gewählter Dateiname mit Pfadangabe}
  3850. {     Palnamekurz = dto., nur Name+Extension}
  3851. {     ZielPalette  = geladene Palette}
  3852. {     TRUE|FALSE, falls Palette geladen|nicht geladen wurde}
  3853. {rem: Ist die geladene Palette gleich der Standardpalette, so werden}
  3854. {     Palname* auf '' gesetzt}
  3855. VAR s,name:String;
  3856.     Dirname : DirStr;
  3857.     Filename: NameStr;
  3858.     Extname : ExtStr;
  3859.     fehler:Boolean;
  3860.     neuPal:BigPalette;
  3861.     i:WORD;
  3862.  
  3863.         PROCEDURE FehlerMeldung(s:String);
  3864.         VAR ch:char;
  3865.         BEGIN
  3866.          WRITELN(#7);
  3867.          WRITE(s+' <any key>');
  3868.          ch:=readkey;
  3869.          while keypressed do ch:=readkey
  3870.         END;
  3871.  
  3872. BEGIN
  3873.  RestoreCRTMode;
  3874.  ClrScr;
  3875.  
  3876.  name:='*.PAL';
  3877.  GotoXY(10,4);
  3878.  WRITE('Select the destination palette to map to with the cursor keys,');
  3879.  GotoXY(10,5);
  3880.  WRITE('PageUP/PageDOWN, HOME/END and CR; <ESC> to cancel:');
  3881.  Dateiwahl(10,7,15,name,fehler);
  3882.  IF fehler THEN
  3883.   BEGIN
  3884.    SelectZielPalette:=FALSE;
  3885.    setgraphmode(VID640x400x256);
  3886.    RestoreScreen;
  3887.    write(#7);
  3888.    OkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,'ok',
  3889.          '*** I/O-error! ***',
  3890.          'Couldn''t open file/device',name,Abfrage);
  3891.   END
  3892.  ELSE IF name=''
  3893.   THEN BEGIN {nichts ausgewählt (ESC gedrückt)}
  3894.         SelectZielPalette:=FALSE;
  3895.         setgraphmode(VID640x400x256);
  3896.         RestoreScreen;
  3897.        END
  3898.  ELSE IF LoadPalette(name,0,neuPal)<>0  {ok, Daten einlesen und prüfen}
  3899.        THEN BEGIN
  3900.              SelectZielPalette:=TRUE;
  3901.              Palnamelang:=name;
  3902.              FSplit(Palnamelang, Dirname, Filename, Extname);
  3903.              Palnamekurz:=Filename+Extname;
  3904.              ZielPalette:=neuPal;
  3905.  
  3906.              IF PalEqual(ActualColors,DefaultColors)
  3907.           THEN BEGIN  {geladene Palette = Standardpalette?}
  3908.                     Palnamelang:='';
  3909.                     Palnamekurz:='';
  3910.                    END;
  3911.  
  3912.              setgraphmode(VID640x400x256);
  3913.              RestoreScreen;
  3914.             END
  3915.        ELSE BEGIN {keine oder fehlerhafte *.PAL-Datei}
  3916.              SelectZielPalette:=FALSE;
  3917.              FehlerMeldung('Couldn''t read *.PAL-file!');
  3918.              Palnamelang:=''; Palnamekurz:='';
  3919.              setgraphmode(VID640x400x256);
  3920.              RestoreScreen;
  3921.             END;
  3922. END;
  3923.  
  3924. PROCEDURE ladeHintergrund;
  3925. { in: -}
  3926. {out: Filenamelang = gewählter Dateiname mit Pfadangabe}
  3927. {     Filenamekurz = dto., nur Name+Extension}
  3928. {     WorkArea = Bitmaps der geladenen Datei  }
  3929. {     WorkAreaMaxUsedX|Y = max. benutzte Koordinaten}
  3930. VAR s,name:String;
  3931.     Dirname : DirStr;
  3932.     Filename: NameStr;
  3933.     Extname : ExtStr;
  3934.     fehler:Boolean;
  3935.     GrafikBild:Pointer;
  3936.     Size,i,t,x,y:Word;
  3937.     picture:Bild;
  3938.  
  3939.   FUNCTION LoadPage(name:STRING):BOOLEAN;
  3940.   { in: name = Filename fuer das zu ladende Bild}
  3941.   {out: pic  = Bitmaps des Bildes }
  3942.   {     TRUE/FALSE für Bild konnte geladen/nicht geladen werden}
  3943.   CONST PICHeader:STRING[3]='PIC'; {Kennung in Bilderdateien}
  3944.   VAR f:FILE;
  3945.       i:BYTE;
  3946.       fehler:BOOLEAN;
  3947.       s:STRING[3];
  3948.       x,y:WORD;
  3949.  
  3950.     PROCEDURE FehlerMeldung(s:String);
  3951.     VAR ch:char;
  3952.     BEGIN
  3953.      WRITELN(#7);
  3954.      WRITE(s+' <any key>');
  3955.      ch:=readkey;
  3956.      while keypressed do ch:=readkey
  3957.     END;
  3958.  
  3959.   BEGIN
  3960.    {$I-}
  3961.    Assign(f,name); fehler:=IOResult<>0;
  3962.    Reset(f,1);     fehler:=fehler OR (IOResult<>0);
  3963.    s[0]:=PICHeader[0];
  3964.    BlockRead(f,s[1],Length(PICHeader)); fehler:=fehler OR (IOResult<>0);
  3965.    {$I+}
  3966.    IF fehler
  3967.     THEN BEGIN
  3968.           {$I-} Close(f); {$I+}
  3969.           Error:=ErrFileIO;
  3970.           FehlerMeldung(GetErrorMessage);
  3971.           LoadPage:=FALSE;
  3972.           exit
  3973.          END
  3974.     ELSE IF (FileSize(f)<>4*PAGESIZE+Length(PICHeader)) OR (s<>PICHeader)
  3975.     THEN BEGIN
  3976.           {$I-} Close(f); {$I+}
  3977.           Error:=ErrNoPicture;
  3978.           FehlerMeldung(GetErrorMessage);
  3979.           LoadPage:=FALSE;
  3980.           exit
  3981.          END;
  3982.    FOR i:=0 TO 3 DO
  3983.     BEGIN
  3984.      {$I-}
  3985.      BlockRead(f,picture[i]^,PAGESIZE);
  3986.      {$I+}
  3987.      fehler:=fehler OR (IOResult<>0);
  3988.     END;
  3989.    {$I-}
  3990.    Close(f);
  3991.    {$I+}
  3992.    fehler:=fehler OR (IOResult<>0);
  3993.    IF fehler THEN Error:=ErrFileIO;
  3994.    IF fehler THEN FehlerMeldung(GetErrorMessage);
  3995.  
  3996.    LoadPage:=Error=ErrNone
  3997.   END;
  3998.  
  3999. BEGIN
  4000.  RestoreCRTMode;
  4001.  ClrScr;
  4002.  
  4003.  name:='*.PIC';
  4004.  GotoXY(10,4);
  4005.  WRITE('Select your *.PIC-file to load with the cursor keys,');
  4006.  GotoXY(10,5);
  4007.  WRITE('PageUP/PageDOWN, HOME/END and CR; <ESC> to cancel:');
  4008.  Dateiwahl(10,7,15,name,fehler);
  4009.  IF fehler THEN
  4010.   BEGIN
  4011.    setgraphmode(VID640x400x256);
  4012.    RestoreScreen;
  4013.    write(#7);
  4014.    OkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,'ok',
  4015.          '*** I/O-error! ***',
  4016.          'Couldn''t open file/device',name,Abfrage);
  4017.   END
  4018.  ELSE IF name=''
  4019.   THEN BEGIN {nichts ausgewählt (ESC gedrückt)}
  4020.         setgraphmode(VID640x400x256);
  4021.         RestoreScreen;
  4022.        END
  4023.  ELSE BEGIN {Bild laden}
  4024.        FOR i:=0 TO 3 DO New(picture[i]);
  4025.  
  4026.        IF LoadPage(name)  {ok, Daten einlesen und prüfen}
  4027.         THEN BEGIN
  4028.               Filenamelang:=name;
  4029.               FSplit(Filenamelang, Dirname, Filename, Extname);
  4030.               Filenamekurz:=Filename+Extname;
  4031.               {Bilddaten nach Array WorkArea decodieren:}
  4032.               FOR y:=0 TO YMAX DO
  4033.                FOR x:=0 TO XMAX SHR 2 DO
  4034.         BEGIN
  4035.                  t:=y*LINESIZE;
  4036.                  WorkArea^.feld[y,x shl 2+0]:=picture[0]^[t+x];
  4037.                  WorkArea^.feld[y,x shl 2+1]:=picture[1]^[t+x];
  4038.                  WorkArea^.feld[y,x shl 2+2]:=picture[2]^[t+x];
  4039.                  WorkArea^.feld[y,x shl 2+3]:=picture[3]^[t+x]
  4040.                 END;
  4041.  
  4042.               FindWorkAreaMaxUsed;
  4043.               setgraphmode(VID640x400x256);
  4044.               RestoreScreen;
  4045.              END
  4046.         ELSE BEGIN {keine oder fehlerhafte *.COD-Datei}
  4047.               Filenamelang:=''; Filenamekurz:='';
  4048.               setgraphmode(VID640x400x256);
  4049.               RestoreScreen;
  4050.              END;
  4051.         FOR i:=0 TO 3 DO Dispose(picture[i]);
  4052.        END;
  4053. END;
  4054.  
  4055. FUNCTION gueltig(VAR P:EingabeString; Ext:ExtStr):Boolean;
  4056. { in: P = vollständiger Dateiname}
  4057. {     Ext = gewünschte Defaultextension, falls P selber keine hat}
  4058. {out: TRUE/FALSE, wenn unter dem angegebenen Namen eine Datei angelegt}
  4059. {     werden kann und deren Endung "Ext" ist}
  4060. {     P = vollständiger Dateiname, um "Ext" erweitert, wenn keine Ex- }
  4061. {     tension angegeben wurde, evtl. Leerzeichen wurden entfernt      }
  4062. {rem: Eine schon bestehende Datei gleichen Namens wird überschrieben! }
  4063. {     P muß in Großschrift sein!}
  4064. VAR i:Byte;
  4065.     D: DirStr;
  4066.     N: NameStr;
  4067.     E: ExtStr;
  4068.  
  4069.      FUNCTION eroeffenbar(P:PathStr):Boolean;
  4070.      VAR f:file;
  4071.          temp:Boolean;
  4072.      BEGIN
  4073.       assign(f,P);
  4074.       {$I-}
  4075.       rewrite(f);
  4076.       {$I+}
  4077.       temp:=ioresult=0;
  4078.       if temp THEN close(f);
  4079.       eroeffenbar:=temp
  4080.      END;
  4081.  
  4082. BEGIN
  4083.  WHILE (P[1]=' ') DO delete(P,1,1);
  4084.  WHILE (P[Length(P)]=' ') DO delete(P,Length(P),1);
  4085.  
  4086.  FSplit(P, D, N, E);
  4087.  IF E='' THEN E:=Ext;
  4088.  P := D + N + E;
  4089.  
  4090.  if (n='')              {Kein Namen angegeben?}
  4091.   or (pos('*',p)>0)     {keine Wildcards erlaubt}
  4092.   or (pos('?',p)>0)
  4093.   or (pos(':',N+E)>0)   {LW-Angaben sind nur im Pfad erlaubt}
  4094.   or (E<>Ext)           {nur "Ext" als Endung erlaubt}
  4095.   or ( (pos(':',D)>0) and (pos(':',D)<>2) )   {":" muß an 2.Position sein}
  4096.   or (not eroeffenbar(P))
  4097.  THEN BEGIN gueltig:=false; exit END
  4098.  ELSE gueltig:=true
  4099. END;
  4100.  
  4101.  
  4102. PROCEDURE speichereSprite;
  4103. { in: Filenamelang = Defaultwert für Spritenamen}
  4104. {     Workarea^ = abzuspeichernde Daten}
  4105. {     WorkAreaMaxUsedX|Y = max. benutzte Extremkoordinaten}
  4106. {     ActualColors = gerade gesetzte Farben}
  4107. {     DefaultColors = Standardfarben des BIOS-256-Farbenmodus}
  4108. {out: Auf Disk wurde der Inhalt der Workarea als Sprite abgelegt }
  4109. {     Filename* = neue Filenamen}
  4110. {rem: Falls die Workarea leer war oder <ESC> gedrückt wurde, dann}
  4111. {     wurde keine Datei angelegt}
  4112. CONST x1=1; y1=4; x2=80; y2=y1+2; {Koordinaten für Eingabebox}
  4113. VAR temp:EingabeString;
  4114.     abbruch:Boolean;
  4115.     size:word;
  4116.     attr:Byte;
  4117.     i:Integer;
  4118.     ch:Char;
  4119.     oldNamelang,oldNamekurz,
  4120.     P: PathStr;
  4121.     D: DirStr;
  4122.     N: NameStr;
  4123.     E: ExtStr;
  4124.  
  4125.     PROCEDURE schreibe_Daten;
  4126.     { in: Filenamelang = Name der zu schreibenden Datei}
  4127.     {     oldName* = alte Dateinamen}
  4128.     {out: Falls Sprite nicht erstellt werden konnte, wurden die alten}
  4129.     {     Dateinamen für Filename* wieder eingesetzt!}
  4130.     {rem: Der Inhalt der Workarea wird in die Datei Filenamelang }
  4131.     {     geschrieben; der Dateiname wurde bereits auf Eröffenbar-}
  4132.     {     keit geprüft, ebenso, daß die Workarea nicht leer ist!  }
  4133.     LABEL quit;
  4134.     VAR f:file;
  4135.         i,j,offset,Plane_Groesse:WORD;
  4136.         Gesamtgroesse:LONGINT;
  4137.         temp,p:Byte;
  4138.         links,rechts,oben,unten:Integer;
  4139.         fertig_li,fertig_re,fertig_ob,fertig_un:Boolean;
  4140.         Sprite:^spritetyp;  {Hier steht das eigentliche Sprite drinnen}
  4141.         s:String[20];
  4142.         s1,s2:STRING[5];
  4143.         pp:POINTER;
  4144.         pplen:WORD;
  4145.     BEGIN
  4146.      SetColor(BestWhite); s:='just a moment...';
  4147.      pplen:=ImageSize(MeldungX+50,MeldungY,
  4148.                       MeldungX+50+length(s) SHL 3,MeldungY+9);
  4149.      GetMem(pp,pplen);
  4150.      GetImage(MeldungX+50,MeldungY,
  4151.               MeldungX+50+length(s) SHL 3,MeldungY+9,pp^);
  4152.      OutTextXY(MeldungX+50,MeldungY,s);
  4153.  
  4154.      New(Sprite);
  4155.      WITH Sprite^ DO
  4156.       BEGIN
  4157.        Translate[1]:=1; Translate[2]:=2; Translate[3]:=4; Translate[4]:=8;
  4158.        Kennung[1]:='K'; Kennung[2]:='R';
  4159.        Version:=1;
  4160.        Modus:=0;
  4161.        FOR i:=1 TO 10 DO dummy[i]:=0; {Dummywerte auf 0 setzen}
  4162.        Hoehe_in_Zeilen:=Succ(WorkAreaMaxUsedY);   {Y-Werte reichen von 0..MaxY}
  4163.        Breite_in_4er_Gruppen:=Succ(WorkAreaMaxUsedX shr 2); {0..3->1, 4..7->2, ...}
  4164.        {Anzahl Bytes pro Plane:}
  4165.        Plane_Groesse:=Hoehe_in_Zeilen*Breite_in_4er_Gruppen;
  4166.  
  4167.        {Indizes für Grenz- & Planedaten:}
  4168.        ZeigerL:=Kopf; {Fängt beim 1.Datenbyte an}
  4169.        ZeigerR:=ZeigerL+ (Hoehe_in_Zeilen*2);
  4170.        ZeigerO:=ZeigerR+ (Hoehe_in_Zeilen*2);
  4171.        ZeigerU:=ZeigerO+ (Breite_in_4er_Gruppen*4 *2);
  4172.        Zeiger_auf_Plane[0] :=ZeigerU+ (Breite_in_4er_Gruppen*4 *2);
  4173.        Zeiger_auf_Plane[1] :=Zeiger_auf_Plane[0]+ Plane_Groesse;
  4174.        Zeiger_auf_Plane[2] :=Zeiger_auf_Plane[1]+ Plane_Groesse;
  4175.        Zeiger_auf_Plane[3] :=Zeiger_auf_Plane[2]+ Plane_Groesse;
  4176.  
  4177.        {Das Sprite besteht aus: "Kopf" Bytes an Zeigern & speziellen Infos,}
  4178.        {4 Tabellen mit Planedaten, 2 Tabellen mit X-Grenzen (Wörter!),     }
  4179.        {2 Tabellen mit Y-Grenzen (Wörter, für jeden X-Wert einen!)         }
  4180.        Gesamtgroesse:=LONGINT(Kopf)+(Plane_Groesse*4)+
  4181.                       (Hoehe_in_Zeilen*2)*2+
  4182.                       (Breite_in_4er_Gruppen*4 *2)*2;
  4183.  
  4184.        IF Gesamtgroesse>SizeOf(SpriteTyp)
  4185.         THEN BEGIN
  4186.               Str(Gesamtgroesse:5,s1);
  4187.               Str(SizeOf(SpriteTyp):5,s2);
  4188.               Write(#7);
  4189.               OkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,'ok',
  4190.                     'Sprite would be to big!',
  4191.                     '(is:'+s1+', max:'+s2+')','',Abfrage);
  4192.               Filenamelang:=oldNamelang; Filenamekurz:=oldNamekurz;
  4193.               goto quit;
  4194.              END;
  4195.  
  4196.        SpriteLength:=Gesamtgroesse;
  4197.  
  4198.        {Jetzt die eigentlichen Spritedaten berechnen:}
  4199.        offset:=0;
  4200.        FOR j:=0 TO WorkAreaMaxUsedY DO
  4201.          FOR i:=0 TO Pred(Breite_in_4er_Gruppen) DO
  4202.           BEGIN
  4203.            FOR p:=0 TO 3 DO
  4204.              Readin[Zeiger_auf_Plane[p]+offset]:=
  4205.               Workarea^.feld[j,(i shl 2)+p];
  4206.            inc(offset);
  4207.           END;
  4208.  
  4209.        {Nun die X-Grenzdaten für jede Zeile:}
  4210.        offset:=0;
  4211.        FOR j:=0 TO WorkAreaMaxUsedY DO
  4212.         BEGIN
  4213.          links:=0;
  4214.          rechts:=Pred(Breite_in_4er_Gruppen shl 2);
  4215.          fertig_li:=false; fertig_re:=false;
  4216.          REPEAT
  4217.           if (not fertig_li and (WorkArea^.feld[j,links]=0))
  4218.            THEN inc(links) ELSE fertig_li:=true;
  4219.           if (not fertig_re and (WorkArea^.feld[j,rechts]=0))
  4220.            THEN dec(rechts) ELSE fertig_re:=true;
  4221.           if links>rechts THEN BEGIN fertig_li:=true; fertig_re:=true END;
  4222.          UNTIL fertig_li and fertig_re;
  4223.          if links>rechts
  4224.           THEN BEGIN {Leerzeile, Sentinelwerte eintragen}
  4225.                 readin[ZeigerL+offset]:=lo(+16000);
  4226.                 readin[Succ(ZeigerL+offset)]:=hi(+16000);
  4227.                 readin[ZeigerR+offset]:=lo(-16000);
  4228.                 readin[Succ(ZeigerR+offset)]:=hi(-16000)
  4229.                END
  4230.           ELSE BEGIN {normale Zeile, Grenzen eintragen}
  4231.                 readin[ZeigerL+offset]:=lo(links);
  4232.                 readin[Succ(ZeigerL+offset)]:=hi(links);
  4233.                 readin[ZeigerR+offset]:=lo(rechts);
  4234.                 readin[Succ(ZeigerR+offset)]:=hi(rechts)
  4235.                END;
  4236.          inc(offset,2)  {Grenzeinträge sind Wörter!}
  4237.         END;
  4238.  
  4239.        {Dasselbe für die Grenzdaten jeder Spalte:}
  4240.        offset:=0;
  4241.        FOR i:=0 TO Pred(Breite_in_4er_Gruppen shl 2) DO
  4242.         BEGIN
  4243.          oben :=0;
  4244.          unten:=WorkAreaMaxUsedY;
  4245.          fertig_ob:=false; fertig_un:=false;
  4246.          REPEAT
  4247.           if (not fertig_ob and (Workarea^.feld[oben,i]=0))
  4248.            THEN inc(oben) ELSE fertig_ob:=true;
  4249.           if (not fertig_un and (Workarea^.feld[unten,i]=0))
  4250.            THEN dec(unten) ELSE fertig_un:=true;
  4251.           if oben>unten THEN BEGIN fertig_ob:=true; fertig_un:=true END;
  4252.          UNTIL fertig_ob and fertig_un;
  4253.          if oben>unten
  4254.           THEN BEGIN {Leerspalte, Sentinelwerte eintragen}
  4255.                 readin[ZeigerO+offset]:=lo(+16000);
  4256.                 readin[Succ(ZeigerO+offset)]:=hi(+16000);
  4257.                 readin[ZeigerU+offset]:=lo(-16000);
  4258.                 readin[Succ(ZeigerU+offset)]:=hi(-16000)
  4259.                END
  4260.           ELSE BEGIN {normale Spalte, Grenzen eintragen}
  4261.                 readin[ZeigerO+offset]:=lo(oben);
  4262.                 readin[Succ(ZeigerO+offset)]:=hi(oben);
  4263.                 readin[ZeigerU+offset]:=lo(unten);
  4264.                 readin[Succ(ZeigerU+offset)]:=hi(unten)
  4265.                END;
  4266.          inc(offset,2)  {Grenzeinträge sind Wörter!}
  4267.         END;
  4268.  
  4269.       END; {of with}
  4270.  
  4271.      {Nun die Daten auf Disk schreiben:}
  4272.      assign(f,Filenamelang);
  4273.      rewrite(f,1);
  4274.      blockwrite(f,sprite^.readin,Gesamtgroesse);
  4275.      close(f);
  4276. quit:;
  4277.      Dispose(Sprite);
  4278.      PutImage(MeldungX+50,MeldungY,pp^,NormalPut);
  4279.      Dispose(pp);
  4280.      ShowFilename;
  4281.     END;
  4282.  
  4283. BEGIN
  4284.  IF (WorkAreaMaxUsedX=0) AND (WorkAreaMaxUsedY=0) AND
  4285.     (Workarea^.feld[0,0]=transparent)
  4286.   THEN BEGIN {Workarea leer!}
  4287.         ErrBeep;
  4288.         exit
  4289.        END;
  4290.  
  4291.  {evtl. alten Filenamen aufheben}
  4292.  oldNamelang:=Filenamelang; oldNamekurz:=Filenamekurz;
  4293.  
  4294.  RestoreCRTMode;
  4295.  ClrScr;
  4296.  
  4297.  GotoXY(x1,y1-2);
  4298.  WRITE('Please give a name (*.COD) for your sprite file; <ESC> to cancel');
  4299.  GotoXY(1,y2+4);
  4300.  WRITELN('Use the following keys to edit your input:'); WRITELN;
  4301.  WRITELN('HOME/END            : move cursor to the start/end of line');
  4302.  WRITELN('LEFT/RIGHT          : move cursor one char');
  4303.  WRITELN('^LEFT/^RIGHT, ^A/^F : move cursor one word');
  4304.  WRITELN;
  4305.  WRITELN('INS, ^V             : toggle insert/overwrite mode');
  4306.  WRITELN('UP/DOWN, ^E/^X      : review the last (up to 30) input lines');
  4307.  WRITELN;
  4308.  WRITELN('^T : delete word                  DEL, ^G : delete char under cursor');
  4309.  WRITELN('^K : delete to end of line        BSPC,^H : backspace');
  4310.  WRITELN('^Y : delete whole input line      ESC     : cancel input');
  4311.  WRITELN;
  4312.  WRITELN('F3 : use last input line');
  4313.  
  4314.  attr:=textattr; textattr:=boxcolor;
  4315.  window(x1,y1,x2,y2);
  4316.  clrscr;
  4317.  window(1,1,80,25);
  4318.  Rahmen(x1,y1,x2,y2);
  4319.  window(succ(x1),succ(y1),pred(x2),pred(y2));
  4320.  
  4321.   {Defaultwert für Namen aus Filenamelang bestimmen:}
  4322.   IF Filenamelang<>''
  4323.    THEN BEGIN {dafür sorgen, daß evtl. Extension '.COD' lautet}
  4324.          FSplit(Filenamelang,D,N,E);
  4325.          temp:=D+N+'.COD'
  4326.         END
  4327.    ELSE temp:='';
  4328.  
  4329.   abbruch:=false;         {heißt: behalte die letzten 30 gemachten Eingaben}
  4330.   GotoXY(1,1);            {= 1.Position in der Eingabetextbox}
  4331.   String_eingeben(temp,x2-x1-2,abbruch);
  4332.   window(1,1,80,25);
  4333.   textattr:=attr;
  4334.   IF abbruch
  4335.    THEN BEGIN {ESC gedrückt}
  4336.          Window(1,y2+1,80,25); ClrScr; Window(1,1,80,25);
  4337.          GotoXY(x1,y2+2);
  4338.          WRITE('You didn''t choose a file!  <any key>');
  4339.          ch:=readkey; while keypressed do ch:=readkey;
  4340.         END
  4341.    ELSE BEGIN {Dateinamen ausprobieren}
  4342.          FOR i:=1 TO Length(temp) DO
  4343.           CASE temp[i] OF
  4344.            'ä':temp[i]:='Ä';
  4345.            'ö':temp[i]:='Ö';
  4346.            'ü':temp[i]:='Ü'
  4347.            ELSE temp[i]:=upcase(temp[i])
  4348.           END;
  4349.  
  4350.          if not gueltig(temp,'.COD')
  4351.           THEN BEGIN {ungültiger Dateiname}
  4352.                 Window(1,y2+1,80,25); ClrScr; Window(1,1,80,25);
  4353.                 GotoXY(x1,y2+2);
  4354.                 ClrEol; WRITELN('*** Error! Couldn''t open file with name:');
  4355.                 ClrEol; WRITELN;
  4356.                 ClrEol; WRITELN(temp);
  4357.                 ClrEol; WRITELN;
  4358.                 ClrEol; WRITE('(invalid access path or filename)!  <any key>');
  4359.                 ch:=readkey; while keypressed do ch:=readkey;
  4360.                 abbruch:=true;  {Ist auch als Abbruch zu bewerten!}
  4361.                END
  4362.           ELSE BEGIN {gültiger Name, in Filename_* übernehmen}
  4363.                 P:=temp;
  4364.                 FSplit(P,D,N,E);
  4365.                 Filenamelang:=P;
  4366.                 Filenamekurz:=N+E;
  4367.                END;
  4368.         END;
  4369.  
  4370.  setgraphmode(VID640x400x256);
  4371.  RestoreScreen;
  4372.  
  4373.  IF not abbruch
  4374.   THEN BEGIN
  4375.         schreibe_Daten;  {Eigentliche Daten berechnen & schreiben}
  4376.         IF NOT PalEqual(ActualColors,DefaultColors)
  4377.          THEN OkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,'ok',
  4378.                     'The active palette differs',
  4379.                     'from the standard palette;',
  4380.                     'don''t forget to save it!'
  4381.                     ,Abfrage);
  4382.        END;
  4383. END;
  4384.  
  4385. PROCEDURE speicherePalette;
  4386. { in: Palnamelang = Defaultwert für Palettedaten}
  4387. {out: Auf Disk wurde der Inhalt der gerade aktuellen Palette "ActualColors"}
  4388. {     abgelegt }
  4389. {     Palname* = neue Palettennamen}
  4390. {rem: Falls <ESC> gedrückt wurde, dann wurde keine Datei angelegt}
  4391. CONST x1=1; y1=4; x2=80; y2=y1+2; {Koordinaten für Eingabebox}
  4392. VAR temp:EingabeString;
  4393.     abbruch:Boolean;
  4394.     size:word;
  4395.     attr:Byte;
  4396.     i:Integer;
  4397.     ch:Char;
  4398.     oldPalNamelang,oldPalNamekurz,
  4399.     P: PathStr;
  4400.     D: DirStr;
  4401.     N: NameStr;
  4402.     E: ExtStr;
  4403.  
  4404. BEGIN
  4405.  {evtl. alten Filenamen aufheben}
  4406.  oldPalNamelang:=Palnamelang; oldPalNamekurz:=Palnamekurz;
  4407.  
  4408.  RestoreCRTMode;
  4409.  ClrScr;
  4410.  
  4411.  GotoXY(x1,y1-2);
  4412.  WRITE('Please give a name (*.PAL) for your palette file; <ESC> to cancel');
  4413.  GotoXY(1,y2+4);
  4414.  WRITELN('Use the following keys to edit your input:'); WRITELN;
  4415.  WRITELN('HOME/END            : move cursor to the start/end of line');
  4416.  WRITELN('LEFT/RIGHT          : move cursor one char');
  4417.  WRITELN('^LEFT/^RIGHT, ^A/^F : move cursor one word');
  4418.  WRITELN;
  4419.  WRITELN('INS, ^V             : toggle insert/overwrite mode');
  4420.  WRITELN('UP/DOWN, ^E/^X      : review the last (up to 30) input lines');
  4421.  WRITELN;
  4422.  WRITELN('^T : delete word                  DEL, ^G : delete char under cursor');
  4423.  WRITELN('^K : delete to end of line        BSPC,^H : backspace');
  4424.  WRITELN('^Y : delete whole input line      ESC     : cancel input');
  4425.  WRITELN;
  4426.  WRITELN('F3 : use last input line');
  4427.  
  4428.  attr:=textattr; textattr:=boxcolor;
  4429.  window(x1,y1,x2,y2);
  4430.  clrscr;
  4431.  window(1,1,80,25);
  4432.  Rahmen(x1,y1,x2,y2);
  4433.  window(succ(x1),succ(y1),pred(x2),pred(y2));
  4434.  
  4435.   {Defaultwert für Namen aus Palnamelang bestimmen:}
  4436.   IF PalNamelang<>''
  4437.    THEN BEGIN {dafür sorgen, daß evtl. Extension '.PAL' lautet}
  4438.          FSplit(PalNamelang,D,N,E);
  4439.          temp:=D+N+'.PAL'
  4440.         END
  4441.    ELSE temp:='';
  4442.  
  4443.   abbruch:=false;         {heißt: behalte die letzten 30 gemachten Eingaben}
  4444.   GotoXY(1,1);            {= 1.Position in der Eingabetextbox}
  4445.   String_eingeben(temp,x2-x1-2,abbruch);
  4446.   window(1,1,80,25);
  4447.   textattr:=attr;
  4448.   IF abbruch
  4449.    THEN BEGIN {ESC gedrückt}
  4450.          Window(1,y2+1,80,25); ClrScr; Window(1,1,80,25);
  4451.          GotoXY(x1,y2+2);
  4452.          WRITE('You didn''t choose a file!  <any key>');
  4453.          ch:=readkey; while keypressed do ch:=readkey;
  4454.         END
  4455.    ELSE BEGIN {Dateinamen ausprobieren}
  4456.          FOR i:=1 TO Length(temp) DO
  4457.           CASE temp[i] OF
  4458.            'ä':temp[i]:='Ä';
  4459.            'ö':temp[i]:='Ö';
  4460.            'ü':temp[i]:='Ü'
  4461.            ELSE temp[i]:=upcase(temp[i])
  4462.           END;
  4463.  
  4464.          if not gueltig(temp,'.PAL')
  4465.           THEN BEGIN {ungültiger Dateiname}
  4466.                 Window(1,y2+1,80,25); ClrScr; Window(1,1,80,25);
  4467.                 GotoXY(x1,y2+2);
  4468.                 ClrEol; WRITELN('*** Error! Couldn''t open file with name:');
  4469.                 ClrEol; WRITELN;
  4470.                 ClrEol; WRITELN(temp);
  4471.                 ClrEol; WRITELN;
  4472.                 ClrEol; WRITE('(invalid access path or filename)!  <any key>');
  4473.                 ch:=readkey; while keypressed do ch:=readkey;
  4474.                 abbruch:=true;  {Ist auch als Abbruch zu bewerten!}
  4475.                END
  4476.           ELSE BEGIN {gültiger Name, in PalName_* übernehmen}
  4477.                 P:=temp;
  4478.                 FSplit(P,D,N,E);
  4479.                 PalNamelang:=P;
  4480.                 PalNamekurz:=N+E;
  4481.                END;
  4482.         END;
  4483.  
  4484.  setgraphmode(VID640x400x256);
  4485.  RestoreScreen;
  4486.  
  4487.  IF not abbruch
  4488.   THEN SavePalette(PalNamelang,ActualColors); {Eigentliche Daten schreiben}
  4489. END;
  4490.  
  4491.  
  4492. PROCEDURE speichereHintergrund;
  4493. { in: Filenamelang = Defaultwert für Hintergrunddaten}
  4494. {     Workarea^ = abzuspeichernde Daten}
  4495. {     WorkAreaMaxUsedX|Y = max. benutzte Extremkoordinaten}
  4496. {     ActualColors = gerade gesetzte Farben}
  4497. {     DefaultColors = Standardfarben des BIOS-256-Farbenmodus}
  4498. {out: Auf Disk wurde der Inhalt der Workarea als Bild abgelegt }
  4499. {     Filename* = neue Filenamen}
  4500. {rem: Falls die Workarea leer war oder <ESC> gedrückt wurde, dann}
  4501. {     wurde keine Datei angelegt}
  4502. CONST x1=1; y1=4; x2=80; y2=y1+2; {Koordinaten für Eingabebox}
  4503. VAR temp:EingabeString;
  4504.     abbruch:Boolean;
  4505.     size:word;
  4506.     attr:Byte;
  4507.     i:Integer;
  4508.     ch:Char;
  4509.     oldNamelang,oldNamekurz,
  4510.     P: PathStr;
  4511.     D: DirStr;
  4512.     N: NameStr;
  4513.     E: ExtStr;
  4514.  
  4515.     PROCEDURE SavePage;
  4516.     { in: Filenamelang = Name der zu schreibenden Datei}
  4517.     {     oldName* = alte Dateinamen}
  4518.     {     Workarea^.[] = zu schreibende Daten}
  4519.     {out: Falls Sprite nicht erstellt werden konnte, wurden die alten}
  4520.     {     Dateinamen für Filename* wieder eingesetzt!}
  4521.     {rem: Der Inhalt der Workarea wird in die Datei Filenamelang }
  4522.     {     geschrieben; der Dateiname wurde bereits auf Eröffenbar-}
  4523.     {     keit geprüft, ebenso, daß die Workarea nicht leer ist!  }
  4524.     CONST PICHeader:STRING[3]='PIC'; {Kennung in Bilderdateien}
  4525.     VAR f:file;
  4526.         s:String[20];
  4527.         i:BYTE;
  4528.         t,x,y:WORD;
  4529.         picture:Bild;
  4530.         pp:POINTER;
  4531.         pplen:WORD;
  4532.     BEGIN
  4533.      SetColor(BestWhite); s:='just a moment...';
  4534.      pplen:=ImageSize(MeldungX+50,MeldungY,
  4535.                       MeldungX+50+length(s) SHL 3,MeldungY+9);
  4536.      GetMem(pp,pplen);
  4537.      GetImage(MeldungX+50,MeldungY,
  4538.               MeldungX+50+length(s) SHL 3,MeldungY+9,pp^);
  4539.      OutTextXY(MeldungX+50,MeldungY,s);
  4540.  
  4541.      Assign(f,Filenamelang);
  4542.      Rewrite(f,1);
  4543.      BlockWrite(f,PICHeader[1],Length(PICHeader));
  4544.  
  4545.      {Bilddaten zusammenstellen:}
  4546.      FOR i:=0 TO 3 DO New(picture[i]);
  4547.      FOR y:=0 TO YMAX DO
  4548.       FOR x:=0 TO XMAX SHR 2 DO
  4549.        BEGIN
  4550.         t:=y*LINESIZE;
  4551.         picture[0]^[t+x]:=Workarea^.feld[y,x shl 2 +0];
  4552.         picture[1]^[t+x]:=Workarea^.feld[y,x shl 2 +1];
  4553.         picture[2]^[t+x]:=Workarea^.feld[y,x shl 2 +2];
  4554.         picture[3]^[t+x]:=Workarea^.feld[y,x shl 2 +3];
  4555.        END;
  4556.      FOR i:=0 TO 3 DO BlockWrite(f,picture[i]^,PAGESIZE);
  4557.      Close(f);
  4558.  
  4559.      FOR i:=0 TO 3 DO Dispose(picture[i]);
  4560.      PutImage(MeldungX+50,MeldungY,pp^,NormalPut);
  4561.      Dispose(pp);
  4562.      ShowFilename;
  4563.     END;
  4564.  
  4565. BEGIN
  4566.  IF (WorkAreaMaxUsedX=0) AND (WorkAreaMaxUsedY=0) AND
  4567.     (Workarea^.feld[0,0]=transparent)
  4568.   THEN BEGIN {Workarea leer!}
  4569.         ErrBeep;
  4570.         exit
  4571.        END;
  4572.  
  4573.  {evtl. alten Filenamen aufheben}
  4574.  oldNamelang:=Filenamelang; oldNamekurz:=Filenamekurz;
  4575.  
  4576.  RestoreCRTMode;
  4577.  ClrScr;
  4578.  
  4579.  GotoXY(x1,y1-2);
  4580.  WRITE('Please give a name (*.PIC) for your picture file; <ESC> to cancel');
  4581.  GotoXY(1,y2+4);
  4582.  WRITELN('Use the following keys to edit your input:'); WRITELN;
  4583.  WRITELN('HOME/END            : move cursor to the start/end of line');
  4584.  WRITELN('LEFT/RIGHT          : move cursor one char');
  4585.  WRITELN('^LEFT/^RIGHT, ^A/^F : move cursor one word');
  4586.  WRITELN;
  4587.  WRITELN('INS, ^V             : toggle insert/overwrite mode');
  4588.  WRITELN('UP/DOWN, ^E/^X      : review the last (up to 30) input lines');
  4589.  WRITELN;
  4590.  WRITELN('^T : delete word                  DEL, ^G : delete char under cursor');
  4591.  WRITELN('^K : delete to end of line        BSPC,^H : backspace');
  4592.  WRITELN('^Y : delete whole input line      ESC     : cancel input');
  4593.  WRITELN;
  4594.  WRITELN('F3 : use last input line');
  4595.  
  4596.  attr:=textattr; textattr:=boxcolor;
  4597.  window(x1,y1,x2,y2);
  4598.  clrscr;
  4599.  window(1,1,80,25);
  4600.  Rahmen(x1,y1,x2,y2);
  4601.  window(succ(x1),succ(y1),pred(x2),pred(y2));
  4602.  
  4603.   {Defaultwert für Namen aus Filenamelang bestimmen:}
  4604.   IF Filenamelang<>''
  4605.    THEN BEGIN {dafür sorgen, daß evtl. Extension '.PIC' lautet}
  4606.          FSplit(Filenamelang,D,N,E);
  4607.          temp:=D+N+'.PIC'
  4608.         END
  4609.    ELSE temp:='';
  4610.  
  4611.   abbruch:=false;         {heißt: behalte die letzten 30 gemachten Eingaben}
  4612.   GotoXY(1,1);            {= 1.Position in der Eingabetextbox}
  4613.   String_eingeben(temp,x2-x1-2,abbruch);
  4614.   window(1,1,80,25);
  4615.   textattr:=attr;
  4616.   IF abbruch
  4617.    THEN BEGIN {ESC gedrückt}
  4618.          Window(1,y2+1,80,25); ClrScr; Window(1,1,80,25);
  4619.          GotoXY(x1,y2+2);
  4620.          WRITE('You didn''t choose a file!  <any key>');
  4621.          ch:=readkey; while keypressed do ch:=readkey;
  4622.         END
  4623.    ELSE BEGIN {Dateinamen ausprobieren}
  4624.          FOR i:=1 TO Length(temp) DO
  4625.           CASE temp[i] OF
  4626.            'ä':temp[i]:='Ä';
  4627.            'ö':temp[i]:='Ö';
  4628.            'ü':temp[i]:='Ü'
  4629.            ELSE temp[i]:=upcase(temp[i])
  4630.           END;
  4631.  
  4632.          if not gueltig(temp,'.PIC')
  4633.           THEN BEGIN {ungültiger Dateiname}
  4634.                 Window(1,y2+1,80,25); ClrScr; Window(1,1,80,25);
  4635.                 GotoXY(x1,y2+2);
  4636.                 ClrEol; WRITELN('*** Error! Couldn''t open file with name:');
  4637.                 ClrEol; WRITELN;
  4638.                 ClrEol; WRITELN(temp);
  4639.                 ClrEol; WRITELN;
  4640.                 ClrEol; WRITE('(invalid access path or filename)!  <any key>');
  4641.                 ch:=readkey; while keypressed do ch:=readkey;
  4642.                 abbruch:=true;  {Ist auch als Abbruch zu bewerten!}
  4643.                END
  4644.           ELSE BEGIN {gültiger Name, in Filename_* übernehmen}
  4645.                 P:=temp;
  4646.                 FSplit(P,D,N,E);
  4647.                 Filenamelang:=P;
  4648.                 Filenamekurz:=N+E;
  4649.                END;
  4650.         END;
  4651.  
  4652.  setgraphmode(VID640x400x256);
  4653.  RestoreScreen;
  4654.  
  4655.  IF not abbruch
  4656.   THEN BEGIN
  4657.         SavePage;  {Eigentliche Daten berechnen & schreiben}
  4658.         IF NOT PalEqual(ActualColors,DefaultColors)
  4659.          THEN OkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,'ok',
  4660.                     'The active palette differs',
  4661.                     'from the standard palette;',
  4662.                     'don''t forget to save it!'
  4663.                     ,Abfrage);
  4664.        END;
  4665. END;
  4666.  
  4667. PROCEDURE ResetColors;
  4668. { in: DefaultColors = zu setzende Standardpalette}
  4669. {out: ActualColors = Standardfarben}
  4670. {     Palname* = ''}
  4671. BEGIN
  4672.  ActualColors:=DefaultColors;
  4673.  Palnamelang:=''; Palnamekurz:=''; {geladene Palette invalidieren}
  4674.  RestoreScreen; {neue Farben sichtbar machen, Menufarben & -namen anpassen}
  4675. END;
  4676.  
  4677. PROCEDURE init;
  4678. { prüft + initialisiert Maus, reserviert Platz für Mausmaske}
  4679. { initialisiert Grafik, sucht VGA-Karten-spezifische Grafikregister}
  4680. { reserviert Platz für Workarea-Inhalt}
  4681. { initialisiert Grafikbildschirm}
  4682. { initialisiert Variablen: Filename*, Palname*, Farben*, Koordmeld?}
  4683. { Event=EventNone}
  4684. BEGIN
  4685.  writeln(11);
  4686.  IF NOT MouseInstalled
  4687.   THEN BEGIN  {Ohne Maus läuft nix!}
  4688.         WRITELN(#7+'Error! Couldn''t detect mouse!');
  4689.         Halt(1)
  4690.        END
  4691.   ELSE BEGIN
  4692.         SwapVectors;
  4693.         initmouse;
  4694.        END;
  4695.  
  4696.  FindVGARegisters;
  4697.  init640x400x256;
  4698.  
  4699.  WITH oldMouse DO
  4700.   BEGIN
  4701.    MouseMemSize:=ImageSize(0,0,CursorMaxX,CursorMaxY);
  4702.    GetMem(MouseMem,MouseMemSize);
  4703.   END;
  4704.  Event:=EventNone;
  4705.  
  4706.  New(WorkArea);
  4707.  FillChar(WorkArea^,SizeOf(WorkArea^),transparent);
  4708.  Filenamelang:=''; Filenamekurz:='';
  4709.  Palnamelang:='';  Palnamekurz:='';
  4710.  FarbenStartX:=5;
  4711.  FarbenHoehegesamt:=20;
  4712.  FarbenStartY:=getmaxy-FarbenHoehegesamt-1;
  4713.  Koordmeldx:=FarbenStartX+265;
  4714.  Koordmeldy:=FarbenStartY-1;
  4715.  FilenameStartX:=(WorkEndX-WorkStartX-12*8) div 2+WorkStartX;
  4716.  FilenameStartY:=WorkStartY-10;
  4717.  PalnameStartX:=(25+15*PalBreite-12*8) div 2 +PaletteX;
  4718.  PalnameStartY:=PaletteY-10;
  4719.  RestoreScreen;
  4720. END;
  4721.  
  4722. PROCEDURE Help;
  4723. VAR ch:CHAR;
  4724. BEGIN
  4725.  RestoreCRTMode;
  4726.  TextColor(White); TextBackGround(Blue);
  4727.  ClrScr;
  4728.  
  4729.  WRITELN('Help');
  4730.  WRITELN('────');
  4731.  WRITELN('Besides the functions indicated by the function keys at the'+
  4732.          ' lower screen boun-');
  4733.  WRITELN('dary, you have the following options:');
  4734.  WRITELN;
  4735.  WRITELN(' "+", "-" = zoom in/out the workarea');
  4736.  WRITELN(' Shift-F3 = load sprite without erasing the workarea previously');
  4737.  WRITELN(' Shift-F5 = reset palette to default color palette');
  4738.  WRITELN(' Shift-F7 = load picture without erasing the workarea previously');
  4739.  WRITELN(' Shift-F9 = remap object''s colors to default color palette');
  4740.  WRITELN;
  4741.  WRITELN(' Use the cursor keys to scroll the graphic contents around'+
  4742.          ' (if it doesn''t fit');
  4743.  WRITELN(' on the screen because of zooming); use SHIFT in addition to'+
  4744.          ' scroll pixelwise.');
  4745.  WRITELN(' Similar, pressing SHIFT while clicking at one of the rotate'+
  4746.          ' buttons will');
  4747.  WRITELN(' rotate the screen by one pixel only.');
  4748.  WRITELN;
  4749.  WRITELN(' Hold down SHIFT while clicking in the workarea for aligned'+
  4750.          ' objects (circles');
  4751.  WRITELN(' instead of ellipses, etc.).');
  4752.  WRITELN;
  4753.  WRITELN(' Clicking at the "move to origin" button with Shift will scroll'+
  4754.          ' the workarea to');
  4755.  WRITELN(' point (0,0) instead');
  4756.  
  4757.  GotoXY(1,25); TextColor(Yellow);
  4758.  WRITE('[press any key]');
  4759.  WHILE KeyPressed DO ch:=ReadKey;
  4760.  ch:=ReadKey;
  4761.  WHILE KeyPressed DO ch:=ReadKey;
  4762.  
  4763.  TextColor(White); TextBackGround(Black);
  4764.  setgraphmode(VID640x400x256);
  4765.  RestoreScreen;
  4766. END;
  4767.  
  4768. PROCEDURE MapPalette;
  4769. { in: ZielPalette   = Zielfarben, auf die gemappt werden soll   }
  4770. {     ActualColors  = aktuelle Farben, die gemappt werden sollen}
  4771. {     WorkArea      = umzumappende Daten}
  4772. {out: WorkArea      = neue Grafikdaten, auf DefaultColors approximiert }
  4773. {     WorkAreaMaxUsedX|Y = evtl. neue Extremkoordinaten}
  4774. {rem: Die Farben wurden mit einer "Minimum-square-error"-Routine so gut}
  4775. {     wie möglich auf die Farben "ZielPalette" abgebildet, wodurch sich}
  4776. {     die Daten natürlich ändern!}
  4777. {     Grafikmodus muß gesetzt sein!}
  4778. {     Routine sollte nur aufgerufen werden, wenn Workarea nicht leer ist!}
  4779. VAR LookUp:ARRAY[0..255] OF BYTE;
  4780.  
  4781.   FUNCTION MapToDefaultColors(Color:BYTE):BYTE; ASSEMBLER;
  4782.   { in: Color = Farbnummer des 256 Farbmodus, die approximiert werden soll}
  4783.   {     ActualColors = gerade gesetzte 256 Farben}
  4784.   {     DefaultColors= Tabelle der Defaultfarben der 16 (256) Farbmodi}
  4785.   {out: Defaultfarbe des 256 Farbmodus, die am ehesten der uebergebenen   }
  4786.   {     Farbe entspricht}
  4787.   ASM
  4788.     MOV BL,Color
  4789.     XOR BH,BH
  4790.     MOV SI,BX
  4791.     SHL SI,1
  4792.     ADD SI,BX
  4793.     ADD SI,OFFSET ActualColors
  4794.     MOV BX,[SI]
  4795.     MOV DH,[SI+2]    {BL/BH/DH = aktuelle Farbe, RGB}
  4796.  
  4797.     PUSH BP
  4798.     MOV DI,65535     {DI=bisher gefundenes minimales Fehlerquadrat}
  4799.     MOV CX,255
  4800.     MOV SI,OFFSET ZielPalette    {DS:SI = Zeiger auf DefaultColors}
  4801.  
  4802.    @searchloop:
  4803.        MOV AL,BL
  4804.        SUB AL,[SI]   {Farbdifferenz im Rotanteil}
  4805.        IMUL AL       {Fehler*quadrat* optimieren}
  4806.        MOV BP,AX
  4807.  
  4808.        MOV AL,BH     {dto., Gruenanteil}
  4809.        SUB AL,[SI+1]
  4810.        IMUL AL
  4811.        ADD BP,AX
  4812.        JC @noNewMin
  4813.  
  4814.        MOV AL,DH     {dto., Blauanteil}
  4815.        SUB AL,[SI+2]
  4816.        IMUL AL
  4817.        ADD AX,BP
  4818.        JC @noNewMin
  4819.  
  4820.        CMP AX,DI
  4821.        JAE @noNewMin
  4822.        MOV DI,AX
  4823.        MOV DL,CL     {100h-DL=bisher optimale Farbe}
  4824.       @noNewMin:
  4825.        ADD SI,3      {naechste Farbe zum Vergleich}
  4826.        LOOP @searchloop
  4827.  
  4828.     POP BP
  4829.  
  4830.     MOV AL,DL
  4831.     NOT AL           {AL:=100h-DL = optimale Farbe}
  4832.     XOR AH,AH
  4833.   END;
  4834.  
  4835. BEGIN
  4836.  IF PalEqual(ZielPalette,ActualColors)
  4837.   THEN BEGIN {aktuelle Farben = Zielfarben, also kein Mapping nötig}
  4838.         ErrBeep;
  4839.         exit
  4840.        END
  4841.   ELSE BEGIN
  4842.         {Farbumsetztabelle bestimmen:}
  4843.         FOR i:=0 TO 255 DO LookUp[i]:=MapToDefaultColors(i);
  4844.         {Grafikdaten umsetzen:}
  4845.         FOR y:=0 TO YMAX DO
  4846.          FOR x:=0 TO XMAX DO
  4847.           WorkArea^.feld[y,x]:=LookUp[WorkArea^.feld[y,x]];
  4848.         {Änderungen anzeigen: Zielfarben setzen und Grafik zeigen}
  4849.         ActualColors:=ZielPalette;
  4850.         IF PalEqual(ActualColors,DefaultColors)
  4851.      THEN BEGIN {Bei Defaultfarbenpalette dies auch melden}
  4852.                Palnamekurz:='';
  4853.                Palnamelang:=''
  4854.               END;
  4855.  
  4856.         FindWorkAreaMaxUsed; {evtl. haben sich die Extremkoord. geändert}
  4857.         RestoreScreen; {neue Farben sichtbar machen, Menufarben & -namen anpassen}
  4858.        END;
  4859. END;
  4860.  
  4861. PROCEDURE MapToBIOSPalette;
  4862. { in: ZielPalette   = Zielfarben, auf die gemappt werden soll   }
  4863. {     ActualColors  = aktuelle Farben, die gemappt werden sollen}
  4864. {     WorkArea      = umzumappende Daten}
  4865. {out: WorkArea      = neue Grafikdaten, auf DefaultColors approximiert }
  4866. {     WorkAreaMaxUSedX|Y = evtl. neue Extremkoordinaten}
  4867. {rem: Die Farben wurden mit einer "Minimum-square-error"-Routine so gut}
  4868. {     wie möglich auf die Defaultfarben "DefaultColors" abgebildet, wo-}
  4869. {     durch sich die Daten natürlich ändern!}
  4870. {     Grafikmodus muß gesetzt sein!}
  4871. BEGIN
  4872.  ZielPalette:=DefaultColors;
  4873.  MapPalette
  4874. END;
  4875.  
  4876. PROCEDURE AdjustMouse;
  4877. { in: MausX,MausY = aktuelle Mauskoordinaten}
  4878. {     zoom = aktueller Zoomfaktor}
  4879. {     WorkStartX|Y, WorkEndX|Y = WorkArea-Begrenzungen}
  4880. {out: MausX,MausY wurden so justiert, daß sie nur in einem Raster der }
  4881. {     Breite und Höhe "zoom" bewegt werden können und dabei so genau  }
  4882. {     wie möglich in die Mitte eines solchen Rasterpunktes gesetzt    }
  4883. {     wurden; fiele der so generierte Punkt außerhalb der WorkArea,   }
  4884. {     so wird ein Kompromiß gefunden, so daß er wieder innerhalb liegt}
  4885. {     Vorher wird die Maus bereits so justiert, daß sie nicht aus dem }
  4886. {     Raster [0..319,0..199] fällt (ist durch das scrollen möglich)!  }
  4887. {rem: Diese Routine sollte nur gerufen werden, wenn MausX|Y innerhalb }
  4888. {     der Workarea liegen}
  4889. VAR rx,ry:INTEGER;
  4890. BEGIN
  4891.  IF NOT InWorkArea THEN exit;
  4892.  
  4893.  Absolute2Workarea(rx,ry);  {relative Koordinaten ermitteln}
  4894.  rx:=min(rx,WorkBreite-1);  {diese müssen im Bereich [0..319,0..199]}
  4895.  ry:=min(ry,WorkHoehe-1);   {liegen!}
  4896.  Workarea2Absolute(rx,ry,MausX,MausY); {in absolute Koord. zurückrechnen}
  4897.  
  4898.  MausX:=MausX-((MausX-WorkStartX) MOD zoom);
  4899.  IF MausX+zoom SHR 1>WorkEndX
  4900.   THEN BEGIN {Punktmitte wäre außerhalb}
  4901.         MausX:=MausX+ (WorkEndX-MausX) SHR 1
  4902.        END
  4903.   ELSE INC(MausX,zoom SHR 1);
  4904.  
  4905.  MausY:=MausY-((MausY-WorkStartY) MOD zoom);
  4906.  IF MausY+zoom SHR 1>WorkEndY
  4907.   THEN BEGIN {Punktmitte wäre außerhalb}
  4908.         MausY:=MausY+ (WorkEndY-MausY) SHR 1
  4909.        END
  4910.   ELSE INC(MausY,zoom SHR 1);
  4911. END;
  4912.  
  4913. PROCEDURE SelectColor;
  4914. { in: MausX,MausY = aktuelle Mauskoordinaten, irgendwo im Palettenbereich}
  4915. {out: aktuelleFarbe=gewählte Farbe, falls gültige Farbe angeclickt wurde }
  4916. {rem: aktuelle Farbe wird zugleich im dafür reservierten Feld angezeigt  }
  4917. VAR i,j:BYTE;
  4918. BEGIN
  4919.  i:=(MausX-PaletteX-25) DIV PalBreite;
  4920.  IF i<>(MausX-PaletteX-25+3) DIV PalBreite
  4921.   THEN exit; {knapp daneben ist auch vorbei: zwischen 2 Farben geclickt!}
  4922.  j:=(MausY-PaletteY-10) DIV PalHoehe;
  4923.  IF j<>(MausY-PaletteY-10+3) DIV PalHoehe
  4924.   THEN exit; {dto.}
  4925.  
  4926.  aktuelleFarbe:=j SHL 4 + i; {=j*16+i}
  4927.  ShowActualColor
  4928. END;
  4929.  
  4930.  
  4931. PROCEDURE ScrollLeft(amount:INTEGER);
  4932. BEGIN
  4933.  IF StartVirtualX>0
  4934.   THEN BEGIN
  4935.         StartVirtualX:=max(0,StartVirtualX-amount);
  4936.         {nur Workarea updaten - geht schneller als "RestoreScreen()"!}
  4937.         UpdateWorkArea(StartVirtualX,StartVirtualY,
  4938.                        WorkAreaMaxUsedX,WorkAreaMaxUsedY,TRUE);
  4939.         DrawNewObject; {evtl. Objekt neuzeichnen}
  4940.         ShowOffset;
  4941.        END
  4942.   ELSE ErrBeep
  4943. END;
  4944.  
  4945. PROCEDURE ScrollRight(amount:INTEGER);
  4946. BEGIN
  4947.  IF StartVirtualX<XMAX
  4948.   THEN BEGIN
  4949.         StartVirtualX:=min(XMAX,StartVirtualX+amount);
  4950.         {nur Workarea updaten - geht schneller als "RestoreScreen()"!}
  4951.         UpdateWorkArea(StartVirtualX,StartVirtualY,
  4952.                        WorkAreaMaxUsedX,WorkAreaMaxUsedY,TRUE);
  4953.         DrawNewObject; {evtl. Objekt neuzeichnen}
  4954.         ShowOffset;
  4955.        END
  4956.   ELSE ErrBeep
  4957. END;
  4958.  
  4959. PROCEDURE ScrollUp(amount:INTEGER);
  4960. BEGIN
  4961.  IF StartVirtualY>0
  4962.   THEN BEGIN
  4963.         StartVirtualY:=max(0,StartVirtualY-amount);
  4964.         {nur Workarea updaten - geht schneller als "RestoreScreen()"!}
  4965.         UpdateWorkArea(StartVirtualX,StartVirtualY,
  4966.                        WorkAreaMaxUsedX,WorkAreaMaxUsedY,TRUE);
  4967.         DrawNewObject; {evtl. Objekt neuzeichnen}
  4968.         ShowOffset;
  4969.        END
  4970.   ELSE ErrBeep
  4971. END;
  4972.  
  4973. PROCEDURE ScrollDown(amount:INTEGER);
  4974. BEGIN
  4975.  IF StartVirtualY<YMAX
  4976.   THEN BEGIN
  4977.         StartVirtualY:=min(YMAX,StartVirtualY+amount);
  4978.         {nur Workarea updaten - geht schneller als "RestoreScreen()"!}
  4979.         UpdateWorkArea(StartVirtualX,StartVirtualY,
  4980.                        WorkAreaMaxUsedX,WorkAreaMaxUsedY,TRUE);
  4981.         DrawNewObject; {evtl. Objekt neuzeichnen}
  4982.         ShowOffset;
  4983.        END
  4984.   ELSE ErrBeep
  4985. END;
  4986.  
  4987. PROCEDURE GotoUpLeft;
  4988. { in: StartVirtualX|Y = momentaner sichtbarer Beginn der Workarea}
  4989. {     WorkAreaMaxUsedX|Y = max. benutzte Koordinaten}
  4990. {out: StartVirtualX|Y = 0}
  4991. {rem: sichtbarer Workarea-Ausschnitt wurde zurückgesetzt auf 0,0 }
  4992. BEGIN
  4993.  IF (StartVirtualX<>0) OR (StartVirtualY<>0)
  4994.   THEN BEGIN
  4995.         StartVirtualX:=0;
  4996.         StartVirtualY:=0;
  4997.         {nur Workarea updaten - geht schneller als "RestoreScreen()"!}
  4998.         UpdateWorkArea(StartVirtualX,StartVirtualY,
  4999.                        WorkAreaMaxUsedX,WorkAreaMaxUsedY,TRUE);
  5000.         DrawNewObject; {evtl. Objekt neuzeichnen}
  5001.         ShowOffset;
  5002.        END
  5003. END;
  5004.  
  5005. PROCEDURE WorkAreaAction;
  5006. { in: Maus befindet sich in WorkArea}
  5007. {     MausX|Y = aktuelle Mauskoordinaten (bereits bzgl. Zooming justiert)}
  5008. {     LeftButton, RightButton = Mausbuttonzustände}
  5009. {     Objekt  = aktuelles Zeichenobjekt }
  5010. {     aktuelleFarbe = aktuelle Zeichenfarbe}
  5011. {     aktuellesTool = aktuelles Tool }
  5012. {     Workarea = aktuelle Grafikdaten}
  5013. {out: Workarea = evtl. veränderte Grafikdaten}
  5014. {     Objekt = evtl. veränderte Grafikdaten}
  5015. {rem: Maus ist noch abgeschaltet!}
  5016. VAR dx,dy,diff:INTEGER;
  5017. BEGIN
  5018.  WITH Objekt DO
  5019.   BEGIN
  5020.    IF (stage<>0) AND (RightButton)
  5021.     THEN BEGIN {Abbruch der begonnenen Aktion}
  5022.           ClearOldObject;
  5023.           stage:=0; {damit existiert kein Objekt mehr}
  5024.           exit
  5025.          END;
  5026.  
  5027.    IF (stage=0) AND (LeftButton) AND (aktuellesTool=Punkt)
  5028.     THEN BEGIN {einfachster Fall: einfach einen Punkt setzen}
  5029.           Absolute2WorkArea(StartX,StartY); {aktuelle relative Koord. holen}
  5030.  
  5031.           (* Die folgenden Zeilen wären ein schnellerer (aber konzeptionell  *)
  5032.           (* unschöner) Ersatz für die Zeilen ab "Typ:=..." bis "StoreObject"*)
  5033.           (* (jeweils einschließlich). Dies wäre deshalb möglich, weil einen *)
  5034.           (* Punkt zu setzen eine "unteilbare" Aktion darstellt, die nicht   *)
  5035.           (* über mehrere Hauptprogrammzyklen verschliffen ist! *)
  5036.           (*
  5037.           Workarea^.feld[StartY,StartX]:=aktuelleFarbe; {Punkt setzen}
  5038.           IF aktuelleFarbe<>transparent
  5039.        THEN BEGIN {benutzte Workarea-Fläche größer geworden?}
  5040.                  WorkAreaMaxUsedX:=max(StartX,WorkAreaMaxUsedX);
  5041.                  WorkAreaMaxUsedY:=max(StartY,WorkAreaMaxUsedY);
  5042.                 END
  5043.            ELSE FindWorkAreaMaxUsed;
  5044.           {nur diesen einen (logischen) Punkt auf dem Schirm neuzeichnen:}
  5045.           UpdateWorkArea(StartX,StartY,StartX,StartY,FALSE);
  5046.           *)
  5047.           Stage:=1;
  5048.           Typ  :=aktuellesTool; {=Punkt}
  5049.           DrawNewObject;
  5050.           StoreObject;
  5051.           exit
  5052.          END;
  5053.  
  5054.    IF (stage<>0) AND (NOT LeftButton)
  5055.     THEN BEGIN {temporäres Objekt zeichnen}
  5056.           CASE Typ OF
  5057.            {Punkt:DrawNewObject}
  5058.        Linie:BEGIN
  5059.                   ClearOldObject;
  5060.                   Absolute2WorkArea(LastX,LastY); {wo steht der Mauscursor?}
  5061.                   IF aligned
  5062.            THEN BEGIN {nur horiz., vert. oder diagonale Zeilen!}
  5063.                          dx:=abs(LastX-StartX); dy:=abs(LastY-StartY);
  5064.                          {Anhand der Steigung entscheiden, was für eine}
  5065.                          {Ausrichtung erfolgen soll: 0..0.5=horizontal,}
  5066.                          {0.5..2 = diagonal, 2..?? = vertikal}
  5067.                          IF dx>2*dy THEN LastY:=StartY      {horizontal}
  5068.                          ELSE IF dy>2*dx THEN LastX:=StartX {vertikal}
  5069.              ELSE BEGIN
  5070.                                {Diagonale, dafür wird aber auch das Vorzeichen}
  5071.                                {der Steigung benötigt!}
  5072.                                diff:=min(dx,dy);
  5073.                                LastX:=StartX+sign(LastX-StartX)*diff;
  5074.                                LastY:=StartY+sign(LastY-StartY)*diff
  5075.                               END;
  5076.                         END;
  5077.                   DrawNewObject;
  5078.                  END;
  5079.            Rechteck:BEGIN  {Quadrate auch!}
  5080.                      ClearOldObject;
  5081.                      Absolute2WorkArea(LastX,LastY);
  5082.                      IF aligned
  5083.                       THEN BEGIN {Quadrat!}
  5084.                             dx:=abs(LastX-StartX); dy:=abs(LastY-StartY);
  5085.                             diff:=min(dx,dy);
  5086.                             LastX:=StartX+sign(LastX-StartX)*diff;
  5087.                             LastY:=StartY+sign(LastY-StartY)*diff;
  5088.                            END;
  5089.                      DrawNewObject;
  5090.                     END;
  5091.            Ellipse_:BEGIN
  5092.                      ClearOldObject;
  5093.                      Absolute2WorkArea(LastX,LastY);
  5094.                      DrawNewObject;
  5095.                     END;
  5096.            FRechteck:BEGIN  {gefüllte Quadrate auch!}
  5097.                       ClearOldObject;
  5098.                       Absolute2WorkArea(LastX,LastY);
  5099.                       IF aligned
  5100.                        THEN BEGIN {Quadrat!}
  5101.                              dx:=abs(LastX-StartX); dy:=abs(LastY-StartY);
  5102.                              diff:=min(dx,dy);
  5103.                              LastX:=StartX+sign(LastX-StartX)*diff;
  5104.                              LastY:=StartY+sign(LastY-StartY)*diff;
  5105.                             END;
  5106.                       DrawNewObject;
  5107.                      END;
  5108.            FEllipse:BEGIN
  5109.                      ClearOldObject;
  5110.                      Absolute2WorkArea(LastX,LastY);
  5111.                      DrawNewObject;
  5112.                     END;
  5113.        FuellEimer:BEGIN
  5114.                        ClearOldObject;
  5115.                        Absolute2WorkArea(LastX,LastY);
  5116.                        DrawNewObject;
  5117.                       END;
  5118.        Kopie:BEGIN
  5119.                   ClearOldObject;
  5120.                   IF stage=1
  5121.                    THEN Absolute2WorkArea(LastX,LastY)
  5122.                    ELSE Absolute2WorkArea(actX,actY);  {stage=2!}
  5123.                   DrawNewObject
  5124.                  END;
  5125.            else ErrBeep;
  5126.           END; {of CASE}
  5127.          END;
  5128.  
  5129.    {------- neues Objekt beginnen? -------}
  5130.  
  5131.    IF LeftButton
  5132.     THEN BEGIN {Zustandswechsel des Objekts!}
  5133.           IF stage=0 THEN
  5134.            BEGIN {neues Objekt beginnen}
  5135.             stage:=1; {=begonnen, aber noch nicht fertig}
  5136.             Absolute2Workarea(StartX,StartY); {Startpunkt merken}
  5137.             LastX:=StartX; LastY:=StartY;     {Endpunkt = Startpunkt}
  5138.             Typ:=aktuellesTool;
  5139.             IF Shift THEN aligned:=TRUE ELSE aligned:=FALSE;
  5140.  
  5141.             {Sonderbehandlung Fülleimer: schon beim ersten Anclicken aktiv!}
  5142.             IF Typ=FuellEimer THEN DrawWorkAreaFill(LastX,LastY,aktuelleFarbe,DRAW);
  5143.  
  5144.            END
  5145.           ELSE IF stage=1 THEN
  5146.        BEGIN {begonnenes Objekt abschließen?}
  5147.             CASE Typ OF
  5148.          Linie,
  5149.              Rechteck,
  5150.              Ellipse_,
  5151.              FRechteck,
  5152.              FEllipse,
  5153.              FuellEimer: StoreObject;
  5154.              Kopie: BEGIN
  5155.                      ClearOldObject;
  5156.                      stage:=2;
  5157.                     END;
  5158.             END;
  5159.            END
  5160.           ELSE {IF stage=2 THEN}
  5161.        BEGIN {dto.}
  5162.             IF Typ=Kopie THEN StoreObject
  5163.            END;
  5164.          END;
  5165.   END; {of WITH}
  5166. END;
  5167.  
  5168. PROCEDURE Zoomin;
  5169. { in: zoom = momentaner Vergrößerungsfaktor}
  5170. {out: zoom = neuer Vergrößerungsfaktor     }
  5171. {rem: Bildschirminhalt wurde vergrößert    }
  5172. CONST MaxZoom=30;
  5173. BEGIN
  5174.  IF zoom<MaxZoom
  5175.   THEN BEGIN
  5176.         inc(zoom);
  5177.         {nur Workarea updaten - geht schneller als "RestoreScreen()"!}
  5178.         UpdateWorkArea(StartVirtualX,StartVirtualY,
  5179.                        WorkAreaMaxUsedX,WorkAreaMaxUsedY,TRUE);
  5180.         DrawNewObject; {evtl. Objekt wieder auf den Schirm bringen}
  5181.         ShowZoom;
  5182.        END
  5183.   ELSE ErrBeep
  5184. END;
  5185.  
  5186. PROCEDURE Zoomout;
  5187. { in: zoom = momentaner Vergrößerungsfaktor}
  5188. {out: zoom = neuer Vergrößerungsfaktor     }
  5189. {rem: Bildschirminhalt wurde verkleinert   }
  5190. BEGIN
  5191.  IF zoom>1
  5192.   THEN BEGIN
  5193.         dec(zoom);
  5194.         {nur Workarea updaten - geht schneller als "RestoreScreen()"!}
  5195.         UpdateWorkArea(StartVirtualX,StartVirtualY,
  5196.                        WorkAreaMaxUsedX,WorkAreaMaxUsedY,TRUE);
  5197.         DrawNewObject; {evtl. Objekt wieder auf den Schirm bringen}
  5198.         ShowZoom;
  5199.        END
  5200.   ELSE ErrBeep
  5201. END;
  5202.  
  5203.  
  5204. PROCEDURE SelectNewTool;
  5205. { in: Event=eines der EventTool* Events}
  5206. {out: aktuellesTool = neues, selektiertes Tool}
  5207. BEGIN
  5208.  CASE Event OF
  5209.   EventToolPixel:BEGIN
  5210.                   IF aktuellesTool=Punkt THEN exit; {nix zu tun!}
  5211.                   ClearOldObject;  {evtl. altes Objekt löschen}
  5212.                   Objekt.stage:=0; {intern natürlich auch}
  5213.                   aktuellesTool:=Punkt;
  5214.                   ShowActualTool;  {neues Tool anzeigen}
  5215.                  END;
  5216.   EventToolLine :BEGIN
  5217.                   IF aktuellesTool=Linie THEN exit;
  5218.                   ClearOldObject;
  5219.                   Objekt.stage:=0;
  5220.                   aktuellesTool:=Linie;
  5221.                   ShowActualTool;
  5222.                  END;
  5223.   EventToolRectangle:BEGIN
  5224.                       IF aktuellesTool=Rechteck THEN exit;
  5225.                       ClearOldObject;
  5226.                       Objekt.stage:=0;
  5227.                       aktuellesTool:=Rechteck;
  5228.                       ShowActualTool;
  5229.                      END;
  5230.   EventToolEllipse:BEGIN
  5231.                     IF aktuellesTool=Ellipse_ THEN exit;
  5232.                     ClearOldObject;
  5233.                     Objekt.stage:=0;
  5234.                     aktuellesTool:=Ellipse_;
  5235.                     ShowActualTool;
  5236.                    END;
  5237.   EventToolBar:BEGIN
  5238.                 IF aktuellesTool=FRechteck THEN exit;
  5239.                 ClearOldObject;
  5240.                 Objekt.stage:=0;
  5241.                 aktuellesTool:=FRechteck;
  5242.                 ShowActualTool;
  5243.                END;
  5244.   EventToolDisc: BEGIN
  5245.                   IF aktuellesTool=FEllipse THEN exit;
  5246.                   ClearOldObject;
  5247.                   Objekt.stage:=0;
  5248.                   aktuellesTool:=FEllipse;
  5249.                   ShowActualTool;
  5250.                  END;
  5251.   EventToolFill: BEGIN
  5252.                   IF aktuellesTool=FuellEimer THEN exit;
  5253.                   ClearOldObject;
  5254.                   Objekt.stage:=0;
  5255.                   aktuellesTool:=FuellEimer;
  5256.                   ShowActualTool;
  5257.                  END;
  5258.   EventToolCopy: BEGIN
  5259.                   IF aktuellesTool=Kopie THEN exit;
  5260.                   ClearOldObject;
  5261.                   Objekt.stage:=0;
  5262.                   aktuellesTool:=Kopie;
  5263.                   ShowActualTool;
  5264.                  END;
  5265.   else ErrBeep;
  5266.  END;
  5267. END;
  5268.  
  5269. PROCEDURE ShowBorder(Shift:BOOLEAN);
  5270. { in: Workarea = aktuelle Grafikdaten}
  5271. {     WorkAreaMaxUsedX|Y = aktuelle Extremkoordinaten}
  5272. {     Shift = TRUE für: auch transparentes Spriteinneres blinken lassen}
  5273. {out: - }
  5274. {rem: Grenzdaten wurden blinkend angezeigt}
  5275. TYPE Punkt=Record
  5276.             x,y:Word;
  5277.            END;
  5278. CONST DontCare=0;
  5279. VAR punkte:Array[1..2*WorkBreite+2*WorkHoehe] OF Punkt;
  5280.     Zeilen_Grenze_links,Zeilen_Grenze_rechts:Array[0..WorkHoehe-1] OF INTEGER;
  5281.     p_zahl,Anzahl,i,j,k,links,rechts,oben,unten,MinX,MaxX,MinY,MaxY:Integer;
  5282.     fertig_li,fertig_re,fertig_ob,fertig_un:Boolean;
  5283.     farbe:Byte;
  5284.     s1,s2:STRING[5];
  5285.  
  5286. BEGIN
  5287.  IF (WorkAreaMaxUsedX=0) AND (WorkAreaMaxUsedY=0) AND
  5288.     (Workarea^.feld[0,0]=transparent)
  5289.   THEN BEGIN {leere Workarea, also nichts da zum anzeigen!}
  5290.         ErrBeep;  {Ist aber nur notwendiges Kriterium, nicht hinreichend!}
  5291.         exit      {(Da gesamtes Sprite ja offscreen sein kann!}
  5292.        END;
  5293.  p_zahl:=0; MaxX:=0; MaxY:=0; MinX:=MaxInt; MinY:=MaxInt;
  5294.  
  5295.  {Nun die X-Grenzdaten für jede Zeile:}
  5296.  FOR j:=0 TO WorkAreaMaxUsedY DO
  5297.   BEGIN
  5298.    links:=0; rechts:=WorkAreaMaxUsedX;
  5299.    fertig_li:=false; fertig_re:=false;
  5300.    REPEAT
  5301.     if (not fertig_li and (Workarea^.feld[j,links]=transparent))
  5302.      THEN inc(links) ELSE fertig_li:=true;
  5303.     if (not fertig_re and (Workarea^.feld[j,rechts]=transparent))
  5304.      THEN dec(rechts) ELSE fertig_re:=true;
  5305.     if links>rechts THEN BEGIN fertig_li:=true; fertig_re:=true END;
  5306.    UNTIL fertig_li and fertig_re;
  5307.    Zeilen_Grenze_links[j] :=links;
  5308.    Zeilen_Grenze_rechts[j]:=rechts;
  5309.    if (links<=rechts)
  5310.     THEN BEGIN {normale Zeile, Grenzen eintragen}
  5311.           inc(p_zahl);
  5312.           punkte[p_zahl].x:=links;  punkte[p_zahl].y:=j;
  5313.           inc(p_zahl);
  5314.           punkte[p_zahl].x:=rechts; punkte[p_zahl].y:=j;
  5315.           IF links <MinX THEN MinX:=links;
  5316.           IF rechts>MaxX THEN MaxX:=rechts
  5317.          END;
  5318.   END;
  5319.  
  5320.  IF Shift
  5321.   THEN Anzahl:=p_zahl SHR 1;  {für Transparentes reichen die Zeilendaten aus!}
  5322.  
  5323.  {Dasselbe für die Grenzdaten jeder Spalte:}
  5324.  FOR i:=0 TO WorkAreaMaxusedX DO
  5325.   BEGIN
  5326.    oben :=0; unten:=WorkAreaMaxUsedY;
  5327.    fertig_ob:=false; fertig_un:=false;
  5328.    REPEAT
  5329.     if (not fertig_ob and (Workarea^.feld[oben,i]=transparent))
  5330.      THEN inc(oben) ELSE fertig_ob:=true;
  5331.     if (not fertig_un and (Workarea^.feld[unten,i]=transparent))
  5332.      THEN dec(unten) ELSE fertig_un:=true;
  5333.     if oben>unten THEN BEGIN fertig_ob:=true; fertig_un:=true END;
  5334.    UNTIL fertig_ob and fertig_un;
  5335.    if (oben<=unten)
  5336.     THEN BEGIN {normale Spalte, Grenzen eintragen}
  5337.           inc(p_zahl);
  5338.           punkte[p_zahl].x:=i;  punkte[p_zahl].y:=oben;
  5339.           inc(p_zahl);
  5340.           punkte[p_zahl].x:=i; punkte[p_zahl].y:=unten;
  5341.           IF oben <MinY THEN MinY:=oben;
  5342.           IF unten>MaxY THEN MaxY:=unten
  5343.          END;
  5344.   END;
  5345.  
  5346.  IF p_zahl=0
  5347.   THEN BEGIN
  5348.         ErrBeep;
  5349.         exit
  5350.        END
  5351.  
  5352.   ELSE BEGIN {Punkte blinken lassen}
  5353.         STR(WorkAreaMaxUsedX:3,s1);
  5354.         STR(WorkAreaMaxUsedY:3,s2);
  5355.         DrawOkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,'ok',
  5356.                   'used width : 0..'+s1,
  5357.                   'used height: 0..'+s2,'',Abfrage);
  5358.         DrawMaus(CursorPfeil);
  5359.         Event:=EventNone;
  5360.         {Maus freigeben:}
  5361.         ClearMouse;
  5362.  
  5363.         i:=0; farbe:=BestWhite;
  5364.         REPEAT
  5365.          i:=succ(i) mod 100;  {Jedes 100. Mal anzeigen reicht}
  5366.          delay(10);           {*10ms = Blinkfrequenz von 1Hz }
  5367.          if i=0 THEN BEGIN
  5368.                       UndrawMaus;
  5369.                       IF Shift
  5370.                        THEN FOR j:=1 TO Anzahl DO
  5371.                              FOR k:=punkte[j SHL 1-1].x TO punkte[j SHL 1].x DO
  5372.                               IF Workarea^.feld[punkte[j SHL 1].y,k]=transparent
  5373.                                THEN DrawWorkAreaPixel(k,punkte[j SHL 1].y,
  5374.                                                       farbe,DRAW,FALSE);
  5375.                        FOR j:=1 TO p_zahl DO
  5376.                         DrawWorkAreaPixel(punkte[j].x,punkte[j].y,
  5377.                                           farbe,DRAW,FALSE);
  5378.                       DrawMaus(CursorPfeil);
  5379.                       if farbe=BestWhite
  5380.                        THEN farbe:=BestBlack {Farbe alternieren lassen}
  5381.                        ELSE farbe:=BestWhite
  5382.                      END;
  5383.  
  5384.          IF MouseUpdate
  5385.           THEN BEGIN
  5386.                 UndrawMaus;
  5387.                 Event:=MouseEvent(abfrage);
  5388.                 IF (Event=EventNone)
  5389.              THEN BEGIN {das war nichts, nochmal!}
  5390.                        DrawMaus(CursorPfeil);
  5391.                        ClearMouse
  5392.                       END;
  5393.                END;
  5394.         UNTIL Event<>EventNone;
  5395.         UndrawMaus;
  5396.        END;
  5397.  
  5398.  {alten Inhalt wiederherstellen:}
  5399.  IF Shift
  5400.   THEN FOR j:=1 TO Anzahl DO
  5401.         FOR k:=punkte[j SHL 1-1].x TO punkte[j SHL 1].x DO
  5402.          IF Workarea^.feld[punkte[j SHL 1].y,k]=transparent
  5403.           THEN DrawWorkAreaPixel(k,punkte[j SHL 1].y,
  5404.                                  DontCare,CLEAR,FALSE);
  5405.  FOR j:=1 TO p_zahl DO
  5406.   DrawWorkAreaPixel(punkte[j].x,punkte[j].y,
  5407.                     DontCare,CLEAR,FALSE);
  5408.  
  5409.  {alte Grafik wiederherstellen:}
  5410.  PutImage(MeldungX,MeldungY,oldGraph^,NormalPut);
  5411.  FreeMem(oldGraph,oldGraphSize);
  5412. END;
  5413.  
  5414. PROCEDURE BlinkColor;
  5415. { in: Workarea^ = aktuelle Grafikdaten}
  5416. {     StartVirtualX|Y = Anfangskoordinaten der Bildschirmanzeige der Workarea}
  5417. {     zoom = momentan gesetzter Vergrößerungsfaktor}
  5418. {     FarbWahl = Menu für Cancel/Workarea/Palettenbereich-Abfrage}
  5419. {     Abfrage = Menu für Ok-Abfrage}
  5420. {out: - }
  5421. {ren: Der Benutzer wird nach einer Farbe gefragt und diese wird blinkend}
  5422. {     hervorgehoben}
  5423. LABEL nochmal;
  5424. VAR BlinkFarbe,farbe:BYTE;
  5425.     i,j,maxY,maxX:INTEGER;
  5426.     outer:BOOLEAN;
  5427. BEGIN
  5428.  DrawOkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,
  5429.            'cancel',
  5430.            'Click at the color you want',
  5431.            'to be shown blinking','',
  5432.            FarbenWahl);
  5433.  DrawMaus(CursorPfeil);
  5434.  Event:=EventNone;
  5435.  {Maus freigeben:}
  5436.  ClearMouse;
  5437.  REPEAT
  5438.   IF MouseUpdate
  5439.    THEN BEGIN
  5440.          UndrawMaus;
  5441.          {evtl. Cursordaten löschen:}
  5442.          IF NOT InWorkArea
  5443.           THEN BEGIN {evtentuelle Cursordaten vom Bildschirm löschen}
  5444.                 SetFillStyle(SolidFill,BestBlack);
  5445.                 Bar(InfoX,InfoY,InfoX+80,InfoY+29);
  5446.                END;
  5447.          Event:=MouseEvent(FarbenWahl);
  5448.          IF Event=EventSelectColor
  5449.       THEN BEGIN {Maus im Palettenbereich geclickt}
  5450.                 i:=(MausX-PaletteX-25) DIV PalBreite;
  5451.                 IF i<>(MausX-PaletteX-25+3) DIV PalBreite
  5452.                  THEN BEGIN {zwischen 2 Farben geclickt!}
  5453.                        ErrBeep;
  5454.                        Event:=EventNone;
  5455.                        goto nochmal;
  5456.                       END;
  5457.                 j:=(MausY-PaletteY-10) DIV PalHoehe;
  5458.                 IF j<>(MausY-PaletteY-10+3) DIV PalHoehe
  5459.                  THEN BEGIN {dto.}
  5460.                        ErrBeep;
  5461.                        Event:=EventNone;
  5462.                        goto nochmal;
  5463.                       END;
  5464.                 BlinkFarbe:=j SHL 4 + i; {=j*16+i}
  5465.                 nochmal:;
  5466.                END
  5467.          ELSE IF Event=EventInWorkArea
  5468.       THEN BEGIN {Maus in Workarea geclickt}
  5469.                 ShowCursorDaten; {zeige an, wo/auf was der Cursor steht}
  5470.                 IF LeftButton
  5471.                  THEN BEGIN
  5472.                        Absolute2WorkArea(i,j);
  5473.                        BlinkFarbe:=Workarea^.feld[j,i]
  5474.                       END
  5475.          ELSE Event:=EventNone;  {Button war nicht gedrückt}
  5476.                END;
  5477.          IF (InWorkArea) AND (zoom=1)
  5478.           THEN DrawMaus(CursorKreuz)
  5479.           ELSE DrawMaus(CursorPfeil);
  5480.          IF Event=EventNone THEN ClearMouse  {auf nächstes Mausevent warten}
  5481.         END;
  5482.  UNTIL Event<>EventNone;
  5483.  
  5484.  UndrawMaus;
  5485.  {alte Grafik wiederherstellen:}
  5486.  PutImage(MeldungX,MeldungY,oldGraph^,NormalPut);
  5487.  FreeMem(oldGraph,oldGraphSize);
  5488.  
  5489.  {Hier: entweder ist Event=EventCancel oder BlinkFarbe ist die selektierte Farbe}
  5490.  IF Event=EventCancel THEN exit;
  5491.  
  5492.  
  5493.  DrawOkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,
  5494.            'ok',
  5495.            'Seen enough?','','',
  5496.            Abfrage);
  5497.  DrawMaus(CursorPfeil);
  5498.  Event:=EventNone;
  5499.  {Maus freigeben:}
  5500.  ClearMouse;
  5501.  
  5502.  i:=0; farbe:=BestWhite;
  5503.  {berechne "EndVirtualX|Y", d.h.: die max. angezeigten Koordinaten}
  5504.  maxY:=min(WorkHoehe-1, StartVirtualY+(WorkHoehe  DIV zoom));
  5505.  maxX:=min(WorkBreite-1,StartVirtualX+(WorkBreite DIV zoom));
  5506.  REPEAT
  5507.   i:=succ(i) mod 200; {Jedes 200. Mal anzeigen reicht}
  5508.   delay(5);           {*5ms = Blinkfrequenz von 1Hz }
  5509.   if i=0 THEN BEGIN
  5510.                UndrawMaus;
  5511.                {Bei langdauernden Aufgaben wäre der Mauscursor längere Zeit}
  5512.                {nicht sichtbar; da sich außerhalb der Workarea nichts tut, }
  5513.                {können wir ihn aber dort auch während der Aktion sichtbar  }
  5514.                {machen: }
  5515.                outer:=NOT InWorkArea;
  5516.                IF outer THEN DrawMaus(CursorPfeil);
  5517.                FOR j:=StartVirtualY TO maxY DO
  5518.                 FOR i:=StartVirtualX TO maxX DO
  5519.                  IF Workarea^.feld[j,i]=BlinkFarbe
  5520.                   THEN DrawWorkAreaPixel(i,j,farbe,DRAW,FALSE);
  5521.                IF outer THEN UndrawMaus;
  5522.                IF (InWorkArea) AND (zoom=1)
  5523.                 THEN DrawMaus(CursorKreuz)
  5524.                 ELSE DrawMaus(CursorPfeil);
  5525.                if farbe=BestWhite
  5526.                 THEN farbe:=BestBlack {Farbe alternieren lassen}
  5527.                 ELSE farbe:=BestWhite
  5528.               END;
  5529.  
  5530.   IF MouseUpdate
  5531.    THEN BEGIN
  5532.          UndrawMaus;
  5533.          Event:=MouseEvent(Abfrage);
  5534.          IF (Event=EventNone)
  5535.       THEN BEGIN {das war nichts, nochmal!}
  5536.                IF (InWorkArea) AND (zoom=1)
  5537.                 THEN DrawMaus(CursorKreuz)
  5538.                 ELSE DrawMaus(CursorPfeil);
  5539.                 ClearMouse
  5540.                END;
  5541.         END;
  5542.  UNTIL Event<>EventNone;
  5543.  
  5544.  UndrawMaus;
  5545.  {Cursordaten vom Bildschirm löschen}
  5546.  SetFillStyle(SolidFill,BestBlack);
  5547.  Bar(InfoX,InfoY,InfoX+80,InfoY+29);
  5548.  UpdateWorkArea(StartVirtualX,StartVirtualY,maxX,maxY,TRUE);
  5549.  DrawNewObject; {evtl. begonnenes Objet zeigen}
  5550.  
  5551.  {alte Grafik wiederherstellen:}
  5552.  PutImage(MeldungX,MeldungY,oldGraph^,NormalPut);
  5553.  FreeMem(oldGraph,oldGraphSize);
  5554. END;
  5555.  
  5556. PROCEDURE ChangeColor;
  5557. { in: Workarea^ = aktuelle Grafikdaten}
  5558. {     StartVirtualX|Y = Anfangskoordinaten der Bildschirmanzeige der Workarea}
  5559. {     zoom = momentan gesetzter Vergrößerungsfaktor}
  5560. {     FarbWahl = Menu für Cancel/Workarea/Palettenbereich-Abfrage}
  5561. {     Abfrage = Menu für Ok-Abfrage}
  5562. {out: Workarae^ neue Grafikdaten}
  5563. {ren: Der Benutzer wird nach zwei Farben gefragt; die erste wird dann gegen}
  5564. {     die zweite ersetzt}
  5565. LABEL nochmal1,nochmal2;
  5566. VAR farbe,alteFarbe,neueFarbe:BYTE;
  5567.     alteFarbeS:STRING[3];
  5568.     i,j,maxY,maxX:INTEGER;
  5569.     outer:BOOLEAN;
  5570. BEGIN
  5571.  DrawOkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,
  5572.            'cancel',
  5573.            'Click at the color you',
  5574.            'to want to replace','',
  5575.            FarbenWahl);
  5576.  DrawMaus(CursorPfeil);
  5577.  Event:=EventNone;
  5578.  {Maus freigeben:}
  5579.  ClearMouse;
  5580.  
  5581.  REPEAT
  5582.   IF MouseUpdate
  5583.    THEN BEGIN
  5584.          UndrawMaus;
  5585.          {evtl. Cursordaten löschen:}
  5586.          IF NOT InWorkArea
  5587.           THEN BEGIN {evtentuelle Cursordaten vom Bildschirm löschen}
  5588.                 SetFillStyle(SolidFill,BestBlack);
  5589.                 Bar(InfoX,InfoY,InfoX+80,InfoY+29);
  5590.                END;
  5591.          Event:=MouseEvent(FarbenWahl);
  5592.          IF Event=EventSelectColor
  5593.       THEN BEGIN {Maus im Palettenbereich geclickt}
  5594.                 i:=(MausX-PaletteX-25) DIV PalBreite;
  5595.                 IF i<>(MausX-PaletteX-25+3) DIV PalBreite
  5596.                  THEN BEGIN {zwischen 2 Farben geclickt!}
  5597.                        ErrBeep;
  5598.                        Event:=EventNone;
  5599.                        goto nochmal1;
  5600.                       END;
  5601.                 j:=(MausY-PaletteY-10) DIV PalHoehe;
  5602.                 IF j<>(MausY-PaletteY-10+3) DIV PalHoehe
  5603.                  THEN BEGIN {dto.}
  5604.                        ErrBeep;
  5605.                        Event:=EventNone;
  5606.                        goto nochmal1;
  5607.                       END;
  5608.                 alteFarbe:=j SHL 4 + i; {=j*16+i}
  5609.                 nochmal1:;
  5610.                END
  5611.          ELSE IF Event=EventInWorkArea
  5612.       THEN BEGIN {Maus in Workarea geclickt}
  5613.                 ShowCursorDaten; {zeige an, wo/auf was der Cursor steht}
  5614.                 IF LeftButton
  5615.                  THEN BEGIN
  5616.                        Absolute2WorkArea(i,j);
  5617.                        alteFarbe:=Workarea^.feld[j,i]
  5618.                       END
  5619.          ELSE Event:=EventNone;
  5620.                END;
  5621.          IF (InWorkArea) AND (zoom=1)
  5622.           THEN DrawMaus(CursorKreuz)
  5623.           ELSE DrawMaus(CursorPfeil);
  5624.          IF Event=EventNone THEN ClearMouse
  5625.         END;
  5626.  UNTIL Event<>EventNone;
  5627.  
  5628.  UndrawMaus;
  5629.  {alte Grafik wiederherstellen:}
  5630.  PutImage(MeldungX,MeldungY,oldGraph^,NormalPut);
  5631.  FreeMem(oldGraph,oldGraphSize);
  5632.  
  5633.  {Hier: entweder ist Event=EventCancel oder alteFarbe ist die selektierte Farbe}
  5634.  IF Event=EventCancel THEN exit;
  5635.  
  5636.  STR(alteFarbe:3,alteFarbeS);
  5637.  {--------- jetzt dasselbe nochmal, für die neue Farbe: ---------}
  5638.  DrawOkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,
  5639.            'cancel',
  5640.            'Now select the new color',
  5641.            'for color '+alteFarbeS,'',
  5642.            FarbenWahl);
  5643.  DrawMaus(CursorPfeil);
  5644.  Event:=EventNone;
  5645.  {Maus freigeben:}
  5646.  ClearMouse;
  5647.  
  5648.  REPEAT
  5649.   IF MouseUpdate
  5650.    THEN BEGIN
  5651.          UndrawMaus;
  5652.          {evtl. Cursordaten löschen:}
  5653.          IF NOT InWorkArea
  5654.           THEN BEGIN {evtentuelle Cursordaten vom Bildschirm löschen}
  5655.                 SetFillStyle(SolidFill,BestBlack);
  5656.                 Bar(InfoX,InfoY,InfoX+80,InfoY+29);
  5657.                END;
  5658.          Event:=MouseEvent(FarbenWahl);
  5659.          IF Event=EventSelectColor
  5660.       THEN BEGIN {Maus im Palettenbereich geclickt}
  5661.                 i:=(MausX-PaletteX-25) DIV PalBreite;
  5662.                 IF i<>(MausX-PaletteX-25+3) DIV PalBreite
  5663.                  THEN BEGIN {zwischen 2 Farben geclickt!}
  5664.                        ErrBeep;
  5665.                        Event:=EventNone;
  5666.                        goto nochmal2;
  5667.                       END;
  5668.                 j:=(MausY-PaletteY-10) DIV PalHoehe;
  5669.                 IF j<>(MausY-PaletteY-10+3) DIV PalHoehe
  5670.                  THEN BEGIN {dto.}
  5671.                        ErrBeep;
  5672.                        Event:=EventNone;
  5673.                        goto nochmal2;
  5674.                       END;
  5675.                 neueFarbe:=j SHL 4 + i; {=j*16+i}
  5676.                 nochmal2:;
  5677.                END
  5678.          ELSE IF Event=EventInWorkArea
  5679.       THEN BEGIN {Maus in Workarea geclickt}
  5680.                 ShowCursorDaten; {zeige an, wo/auf was der Cursor steht}
  5681.                 IF LeftButton
  5682.                  THEN BEGIN
  5683.                        Absolute2WorkArea(i,j);
  5684.                        neueFarbe:=Workarea^.feld[j,i]
  5685.                       END
  5686.          ELSE Event:=EventNone
  5687.                END;
  5688.          IF (InWorkArea) AND (zoom=1)
  5689.           THEN DrawMaus(CursorKreuz)
  5690.           ELSE DrawMaus(CursorPfeil);
  5691.          IF Event=EventNone THEN ClearMouse
  5692.         END;
  5693.  UNTIL Event<>EventNone;
  5694.  
  5695.  UndrawMaus;
  5696.  {alte Grafik wiederherstellen:}
  5697.  PutImage(MeldungX,MeldungY,oldGraph^,NormalPut);
  5698.  FreeMem(oldGraph,oldGraphSize);
  5699.  
  5700.  {Hier: entweder ist Event=EventCancel oder neueFarbe ist die selektierte Farbe}
  5701.  IF Event=EventCancel THEN exit;
  5702.  
  5703.  
  5704.  {-------jetzt: alteFarbe=zu ersetzende Farbe, neueFarbe=Ersatz dafür -------}
  5705.  IF alteFarbe=neueFarbe
  5706.   THEN BEGIN
  5707.         ErrBeep;
  5708.         OkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,
  5709.               'ok',
  5710.               'You chose the same color',
  5711.               'twice, so there is nothing',
  5712.               'to change!',
  5713.               Abfrage);
  5714.        END
  5715.   ELSE BEGIN {Farbe austauschen!}
  5716.         FOR j:=0 TO WorkHoehe-1 DO
  5717.          FOR i:=0 TO WorkBreite-1 DO
  5718.           IF Workarea^.feld[j,i]=alteFarbe THEN Workarea^.feld[j,i]:=neueFarbe;
  5719.         IF (alteFarbe=transparent) OR (neueFarbe=transparent)
  5720.          THEN FindWorkAreaMaxUSed;
  5721.         maxY:=min(WorkHoehe-1, StartVirtualY+(WorkHoehe  DIV zoom));
  5722.         maxX:=min(WorkBreite-1,StartVirtualX+(WorkBreite DIV zoom));
  5723.         UpdateWorkArea(StartVirtualX,StartVirtualY,maxX,maxY,TRUE);
  5724.         DrawNewObject; {evtl. begonnenes Objet zeigen}
  5725.        END;
  5726. END;
  5727.  
  5728. PROCEDURE PaletteChange;
  5729. { in: MausX,MausY = irgendwo im Palettenbereich}
  5730. {out: - }
  5731. {rem: Die vom Benutzer angewählte Farbe wurde evtl. geändert}
  5732. LABEL nope;
  5733. CONST StartX=MeldungX;  {li. obere Ecke der Meldungsbox}
  5734.       StartY=MeldungY;
  5735.       EndX=StartX+220;
  5736.       EndY=StartY+65;
  5737.       sx=25;       {Größe einer Menubox}
  5738.       sy=15;
  5739.       ProbeX1=StartX+10;   {Koord. für Anzeige der gewählten Farbe}
  5740.       ProbeX2=ProbeX1+39;
  5741.       ProbeY1=StartY+12;
  5742.       ProbeY2=ProbeY1+36;
  5743.       EventIncRed=104;
  5744.       EventDecRed=105;
  5745.       EventIncGreen=106;
  5746.       EventDecGreen=107;
  5747.       EventIncBlue=108;
  5748.       EventDecBlue=109;
  5749.       PalMenu:ARRAY[1..11] OF box=(
  5750.  {Ok/Cancel/Workarea/Palettenbereich/inc&dec für R,G,B:}
  5751.  
  5752.        {"Ok"-Box:}
  5753.        (x1:StartX+150; y1:StartY+5; x2:StartX+150+55; y2:StartY+5+sy;
  5754.         Name1:'  ok  ';Name2:'';
  5755.         Show :Dummy;
  5756.         Event:EventYes;
  5757.         Click:TRUE;
  5758.         Paint:TRUE),
  5759.  
  5760.        {"Cancel"-Box:}
  5761.        (x1:StartX+150; y1:StartY+25; x2:StartX+150+55; y2:StartY+25+sy;
  5762.         Name1:'cancel';Name2:'';
  5763.         Show :Dummy;
  5764.         Event:EventCancel;
  5765.         Click:TRUE;
  5766.         Paint:TRUE),
  5767.  
  5768.        {"Rot-"-Box:}
  5769.        (x1:StartX+60; y1:StartY+5; x2:StartX+60+sx; y2:StartY+5+sy;
  5770.         Name1:'R-';Name2:'';
  5771.         Show :Dummy;
  5772.         Event:EventDecRed;
  5773.         Click:TRUE;
  5774.         Paint:TRUE),
  5775.  
  5776.        {"Rot+"-Box:}
  5777.        (x1:StartX+90; y1:StartY+5; x2:StartX+90+sx; y2:StartY+5+sy;
  5778.         Name1:'R+';Name2:'';
  5779.         Show :Dummy;
  5780.         Event:EventIncRed;
  5781.         Click:TRUE;
  5782.         Paint:TRUE),
  5783.  
  5784.  
  5785.        {"Grün-"-Box:}
  5786.        (x1:StartX+60; y1:StartY+25; x2:StartX+60+sx; y2:StartY+25+sy;
  5787.         Name1:'G-';Name2:'';
  5788.         Show :Dummy;
  5789.         Event:EventDecGreen;
  5790.         Click:TRUE;
  5791.         Paint:TRUE),
  5792.  
  5793.        {"Grün+"-Box:}
  5794.        (x1:StartX+90; y1:StartY+25; x2:StartX+90+sx; y2:StartY+25+sy;
  5795.         Name1:'G+';Name2:'';
  5796.         Show :Dummy;
  5797.         Event:EventIncGreen;
  5798.         Click:TRUE;
  5799.         Paint:TRUE),
  5800.  
  5801.  
  5802.        {"Blau-"-Box:}
  5803.        (x1:StartX+60; y1:StartY+45; x2:StartX+60+sx; y2:StartY+45+sy;
  5804.         Name1:'B-';Name2:'';
  5805.         Show :Dummy;
  5806.         Event:EventDecBlue;
  5807.         Click:TRUE;
  5808.         Paint:TRUE),
  5809.  
  5810.        {"Blau+"-Box:}
  5811.        (x1:StartX+90; y1:StartY+45; x2:StartX+90+sx; y2:StartY+45+sy;
  5812.         Name1:'B+';Name2:'';
  5813.         Show :Dummy;
  5814.         Event:EventIncBlue;
  5815.         Click:TRUE;
  5816.         Paint:TRUE),
  5817.  
  5818.        {Workarea:}
  5819.        (x1:WorkStartX;    y1:WorkStartY;
  5820.         x2:WorkEndX;      y2:WorkEndY;
  5821.         Name1:'';Name2:'';
  5822.         Show :Dummy;
  5823.         Event:EventInWorkArea;
  5824.         Click:FALSE;    {Anclicken nicht nötig}
  5825.         Paint:FALSE),   {...wird aber nicht gezeichnet}
  5826.  
  5827.        {Palettenbereich:}
  5828.        (x1:PaletteX+25;                y1:PaletteY+10;
  5829.         x2:PaletteX+25+16*PalBreite-3; y2:PaletteY+10+16*PalHoehe-3;
  5830.         Name1:'';Name2:'';
  5831.         Show :Dummy;
  5832.         Event:EventSelectColor;
  5833.         Click:TRUE;     {Anclicken nötig}
  5834.         Paint:FALSE),   {...wird aber nicht gezeichnet}
  5835.  
  5836.        {Sentinelwert, da x1>x2!}
  5837.        (x1:1; y1:0; x2:0; y2:0;
  5838.         Name1:'';Name2:'';
  5839.         Show :Dummy;
  5840.         Event:EventNone;
  5841.         Click:TRUE;
  5842.         Paint:FALSE)
  5843.       );
  5844.  
  5845. VAR FarbeZumAendern,Farbe,temp:BYTE;
  5846.     i,j:INTEGER;
  5847.     ch:CHAR;
  5848.     mymenu:ARRAY[1..10] OF box ABSOLUTE menu;
  5849.     ColorName:STRING[5];
  5850.     cred,cgreen,cblue,
  5851.     oldred,oldgreen,oldblue:BYTE;
  5852.     total,change:BOOLEAN;
  5853.  
  5854.   PROCEDURE zeichneMenu2;
  5855.   {rem: zeichnet die veränderlichen Menudinge}
  5856.   BEGIN
  5857.    SetFillStyle(SolidFill,FarbeZumAendern);
  5858.    Bar(ProbeX1+1,ProbeY1+1,ProbeX2-1,ProbeY2-1);
  5859.  
  5860.    SetFillStyle(SolidFill,BestLightGray);
  5861.    Bar(StartX+90+sx+5,StartY+5+4,StartX+90+sx+5+18,StartY+45+4+9);
  5862.    SetColor(BestBlack);
  5863.    Str(cred  :2,s); OutTextXY(StartX+90+sx+5,StartY+5+4,s);
  5864.    Str(cgreen:2,s); OutTextXY(StartX+90+sx+5,StartY+25+4,s);
  5865.    Str(cblue :2,s); OutTextXY(StartX+90+sx+5,StartY+45+4,s);
  5866.   END;
  5867.  
  5868.   PROCEDURE zeichneMenu1;
  5869.   {rem: zeichnet die unveränderlichen _und_ die veränderlichen Menudinge}
  5870.   VAR i:INTEGER;
  5871.       s:STRING[3];
  5872.   BEGIN
  5873.    SetFillStyle(SolidFill,BestLightGray);
  5874.    Bar(StartX,StartY,EndX,EndY);
  5875.    SetFillStyle(SolidFill,BestWhite);
  5876.    Bar(StartX,StartY,EndX-1,StartY+1);
  5877.    Bar(StartX,StartY,StartX+1,EndY-1);
  5878.    SetFillStyle(SolidFill,BestDarkGray);
  5879.    Bar(StartX,EndY-1,EndX,EndY);
  5880.    Bar(EndX-1,StartY,EndX,EndY);
  5881.  
  5882.    i:=1;
  5883.    WHILE PalMenu[i].x1<=PalMenu[i].x2 DO
  5884.     BEGIN
  5885.      WITH PalMenu[i] DO
  5886.       BEGIN
  5887.        IF Paint
  5888.         THEN BEGIN
  5889.               SetFillStyle(SolidFill,BestLightGray);
  5890.               Bar(x1,y1,x2,y2);
  5891.               SetFillStyle(SolidFill,BestWhite);
  5892.               Bar(x1,y1,x2-1,y1+1);
  5893.               Bar(x1,y1,x1+1,y2-1);
  5894.               SetFillStyle(SolidFill,BestDarkGray);
  5895.               Bar(x1,y2-1,x2,y2);
  5896.               Bar(x2-1,y1,x2,y2);
  5897.               SetColor(BestBlack);
  5898.               IF Name1<>'' THEN OutTextXY(x1+5,y1+4,Name1);
  5899.              END;
  5900.       END; {of WITH}
  5901.      inc(i);
  5902.     END; {of WHILE}
  5903.  
  5904.    SetColor(BestBlack);
  5905.    Rectangle(ProbeX1,ProbeY1,ProbeX2,ProbeY2);
  5906.    SetColor(BestBlack);
  5907.    OutTextXY(ProbeX1,ProbeY2+3,ColorName);
  5908.  
  5909.    zeichneMenu2;
  5910.   END;
  5911.  
  5912. BEGIN
  5913.  i:=(MausX-PaletteX-25) DIV PalBreite;
  5914.  IF i<>(MausX-PaletteX-25+3) DIV PalBreite
  5915.   THEN exit; {knapp daneben ist auch vorbei: zwischen 2 Farben geclickt!}
  5916.  j:=(MausY-PaletteY-10) DIV PalHoehe;
  5917.  IF j<>(MausY-PaletteY-10+3) DIV PalHoehe
  5918.   THEN exit; {dto.}
  5919.  
  5920.  FarbeZumAendern:=j SHL 4 + i; {=j*16+i}
  5921.  WITH ActualColors[FarbeZumAendern] DO
  5922.   BEGIN
  5923.    cred:=red; cgreen:=green; cblue:=blue;
  5924.   END;
  5925.  Str(FarbeZumAendern:3,ColorName); ColorName:='C:'+ColorName;
  5926.  
  5927.  oldred:=cred; oldgreen:=cgreen; oldblue:=cblue; {alte Farben für "CANCEL"!}
  5928.  {alte Grafik sichern:}
  5929.  oldGraphSize:=ImageSize(StartX,StartY,EndX,EndY);
  5930.  GetMem(oldGraph,oldGraphSize);
  5931.  GetImage(StartX,StartY,EndX,EndY,oldGraph^);
  5932.  
  5933.  
  5934.  zeichneMenu1;
  5935.  
  5936.  DrawMaus(CursorPfeil);
  5937.  Event:=EventNone;
  5938.  {Maus freigeben:}
  5939.  ClearMouse;
  5940.  
  5941.  total:=FALSE;   {wird wahr, wenn min. eine Menufarbe verändert wurde}
  5942.  REPEAT
  5943.   IF MouseUpdate
  5944.    THEN BEGIN
  5945.          UndrawMaus;
  5946.          IF NOT InWorkArea
  5947.           THEN BEGIN {evtentuelle Cursordaten vom Bildschirm löschen}
  5948.                 SetFillStyle(SolidFill,BestBlack);
  5949.                 Bar(InfoX,InfoY,InfoX+80,InfoY+29);
  5950.                END;
  5951.          Event:=MouseEvent(PalMenu);
  5952.          IF Event=EventNone THEN Event:=EventMouseMoved;
  5953.         END
  5954.    ELSE IF (KeyPressed) THEN
  5955.         BEGIN
  5956.          WHILE KeyPressed DO ch:=Upcase(ReadKey);
  5957.          IF ch='O' THEN Event:=EventYes          {okay?}
  5958.          ELSE IF ch='C' THEN Event:=EventCancel; {cancel?}
  5959.         END;
  5960.  
  5961.   CASE Event OF
  5962.    EventIncRed  :IF cred  <63 THEN Inc(cred);
  5963.    EventIncGreen:IF cgreen<63 THEN Inc(cgreen);
  5964.    EventIncBlue :IF cblue <63 THEN Inc(cblue);
  5965.    EventDecRed  :IF cred  >0  THEN Dec(cred);
  5966.    EventDecGreen:IF cgreen>0  THEN Dec(cgreen);
  5967.    EventDecBlue :IF cblue >0  THEN Dec(cblue);
  5968.    EventCancel  :BEGIN {alte Farben wiederherstellen}
  5969.                   cred:=oldred; cgreen:=oldgreen; cblue:=oldblue
  5970.                  END;
  5971.    EventSelectColor:
  5972.                  BEGIN
  5973.                   i:=(MausX-PaletteX-25) DIV PalBreite;
  5974.                   IF i<>(MausX-PaletteX-25+3) DIV PalBreite
  5975.                    THEN goto nope; {knapp daneben ist auch vorbei: zwischen 2 Farben geclickt!}
  5976.                   j:=(MausY-PaletteY-10) DIV PalHoehe;
  5977.                   IF j<>(MausY-PaletteY-10+3) DIV PalHoehe
  5978.                    THEN goto nope; {dto.}
  5979.  
  5980.                   temp:=j SHL 4 + i; {=j*16+i}
  5981.                   IF temp<>FarbeZumAendern
  5982.                    THEN WITH ActualColors[temp] DO
  5983.                     BEGIN {andere Farbe übernehmen}
  5984.                      cred:=red; cgreen:=green; cblue:=blue
  5985.                     END
  5986.                    ELSE ErrBeep;
  5987.  
  5988.                   nope:;
  5989.                  END;
  5990.    EventInWorkArea:
  5991.                  BEGIN
  5992.                   ShowCursorDaten; {zeige an, wo/auf was der Cursor steht}
  5993.                   IF LeftButton
  5994.                    THEN BEGIN
  5995.                          Absolute2Workarea(i,j);
  5996.                          temp:=Workarea^.feld[j,i];
  5997.                          IF temp<>FarbeZumAendern
  5998.                           THEN WITH ActualColors[temp] DO
  5999.                            BEGIN {andere Farbe übernehmen}
  6000.                             cred:=red; cgreen:=green; cblue:=blue
  6001.                            END
  6002.                           ELSE ErrBeep;
  6003.                         END
  6004.                  END;
  6005.   END;
  6006.  
  6007.   WITH ActualColors[FarbeZumAendern] DO
  6008.    BEGIN
  6009.     IF (cred<>red) OR (cgreen<>green) OR (cblue<>blue)
  6010.      THEN BEGIN {Farbe wurde verändert}
  6011.            SetPaletteEntry(FarbeZumAendern,cred,cgreen,cblue); {sichtbar machen}
  6012.            red:=cred;     {Änderung in aktueller Farbpalette vermerken}
  6013.            green:=cgreen;
  6014.            blue:=cblue;
  6015.  
  6016.            {nun evtl. neue Menufarben berechnen:}
  6017.            change:=FALSE;
  6018.            temp:=BestFit(White);
  6019.            IF temp<>BestWhite THEN BEGIN BestWhite:=temp; change:=TRUE END;
  6020.            temp:=BestFit(Black);
  6021.            IF temp<>BestBlack THEN BEGIN BestBlack:=temp; change:=TRUE END;
  6022.            temp:=BestFit(Cyan);
  6023.            IF temp<>BestCyan THEN BEGIN BestCyan:=temp; change:=TRUE END;
  6024.            temp:=BestFit(LightGray);
  6025.            IF temp<>BestLightGray THEN BEGIN BestLightGray:=temp; change:=TRUE END;
  6026.            temp:=BestFit(DarkGray);
  6027.            IF temp<>BestDarkGray THEN BEGIN BestDarkGray:=temp; change:=TRUE END;
  6028.  
  6029.            IF change           {falls veränderte Farbe eine der verwendeten}
  6030.             THEN zeichneMenu1  {Menufarben ist, dann ein "großes" Update   }
  6031.             ELSE zeichneMenu2; {durchführen, sonst ein "kleines"}
  6032.            total:=total OR change; {für Abschluß merken}
  6033.           END;
  6034.    END;
  6035.  
  6036.   IF (Event<>EventNone)
  6037.    THEN BEGIN
  6038.          IF (Event<>EventYes) AND (Event<>EventCancel)
  6039.           THEN Event:=EventNone;
  6040.          IF (InWorkArea) AND (zoom=1)
  6041.           THEN DrawMaus(CursorKreuz)
  6042.           ELSE DrawMaus(CursorPfeil);
  6043.          ClearMouse;
  6044.         END;
  6045.  UNTIL (Event=EventYes) OR (Event=EventCancel);
  6046.  
  6047.  UndrawMaus;
  6048.  {alte Grafik wiederherstellen:}
  6049.  PutImage(StartX,StartY,oldGraph^,NormalPut);
  6050.  FreeMem(oldGraph,oldGraphSize);
  6051.  
  6052.  IF PalEqual(ActualColors,DefaultColors)
  6053.   THEN BEGIN
  6054.         IF Palnamekurz<>''
  6055.      THEN BEGIN
  6056.                Palnamelang:=''; Palnamekurz:='';
  6057.               END;
  6058.        END;
  6059.  ShowPalName;
  6060.  IF total THEN RestoreScreen; {neue Menufarben überall ändern!}
  6061. END;
  6062.  
  6063. PROCEDURE RotateLeft(amount:WORD);
  6064. { in: Workarea^ = aktuelle Grafikdaten}
  6065. {     StartVirtualX|Y = aktuelle Anfangskoord. des sichtbaren Ausschnittes}
  6066. {     WorkHoehe, WorkBreite = Abmessungen der Workarea}
  6067. {     zoom = aktueller Vergrößerungsfaktor}
  6068. {     amount = #Spalten, um die rotiert werden soll: 1..WorkBreite-1}
  6069. {out: Workarea^ = neue Grafikdaten}
  6070. {     WorkAreaMaxUsedX|Y = neue Extremkoordinaten}
  6071. {rem: Workarea-Inhalt wurde um 1 Spalte nach links rotiert}
  6072. VAR maxX,maxY,y:INTEGER;
  6073.     p1,p2:POINTER;
  6074.     tempArea:^WorkAreaTyp;
  6075.     size:WORD;
  6076. BEGIN
  6077.  New(tempArea);
  6078.  FOR y:=0 TO WorkHoehe-1 DO
  6079.   move(Workarea^.feld[y,0],tempArea^.feld[y,0],amount);
  6080.  p1:=@Workarea^.feld[0,amount];
  6081.  p2:=@Workarea^.feld[0,0];
  6082.  size:=WorkHoehe*WorkBreite -amount;
  6083.  ASM
  6084.    MOV CX,size
  6085.    LES DI,p2
  6086.    LDS SI,p1
  6087.    CLD
  6088.    REP MOVSB
  6089.    MOV AX,SEG @DATA
  6090.    MOV DS,AX
  6091.  END;
  6092.  FOR y:=0 TO WorkHoehe-1 DO
  6093.   move(tempArea^.feld[y,0],Workarea^.feld[y,WorkBreite-amount],amount);
  6094.  Dispose(tempArea);
  6095.  
  6096.  FindWorkAreaMaxUsed;
  6097.  maxY:=min(WorkHoehe-1, StartVirtualY+(WorkHoehe  DIV zoom));
  6098.  maxX:=min(WorkBreite-1,StartVirtualX+(WorkBreite DIV zoom));
  6099.  UpdateWorkArea(StartVirtualX,StartVirtualY,maxX,maxY,TRUE);
  6100.  DrawNewObject; {evtl. begonnenes Objet zeigen}
  6101. END;
  6102.  
  6103. PROCEDURE RotateRight(amount:WORD);
  6104. { in: Workarea^ = aktuelle Grafikdaten}
  6105. {     StartVirtualX|Y = aktuelle Anfangskoord. des sichtbaren Ausschnittes}
  6106. {     WorkHoehe, WorkBreite = Abmessungen der Workarea}
  6107. {     zoom = aktueller Vergrößerungsfaktor}
  6108. {     amount = #Spalten, um die rotiert werden soll: 1..WorkBreite-1}
  6109. {out: Workarea^ = neue Grafikdaten}
  6110. {     WorkAreaMaxUsedX|Y = neue Extremkoordinaten}
  6111. {rem: Workarea-Inhalt wurde um 1 Spalte nach rechts rotiert}
  6112. VAR maxX,maxY,y:INTEGER;
  6113.     p1,p2:POINTER;
  6114.     tempArea:^WorkAreaTyp;
  6115.     size:WORD;
  6116. BEGIN
  6117.  New(tempArea);
  6118.  FOR y:=0 TO WorkHoehe-1 DO
  6119.   move(Workarea^.feld[y,WorkBreite-amount],tempArea^.feld[y,0],amount);
  6120.  p1:=@Workarea^.feld[WorkHoehe-1,WorkBreite-1-amount];
  6121.  p2:=@Workarea^.feld[WorkHoehe-1,WorkBreite-1];
  6122.  size:=WorkHoehe*WorkBreite -amount;
  6123.  ASM
  6124.    MOV CX,size
  6125.    LES DI,p2
  6126.    LDS SI,p1
  6127.    STD
  6128.    REP MOVSB
  6129.    CLD
  6130.    MOV AX,SEG @DATA
  6131.    MOV DS,AX
  6132.  END;
  6133.  FOR y:=0 TO WorkHoehe-1 DO
  6134.   move(tempArea^.feld[y,0],Workarea^.feld[y,0],amount);
  6135.  Dispose(tempArea);
  6136.  
  6137.  FindWorkAreaMaxUsed;
  6138.  maxY:=min(WorkHoehe-1, StartVirtualY+(WorkHoehe  DIV zoom));
  6139.  maxX:=min(WorkBreite-1,StartVirtualX+(WorkBreite DIV zoom));
  6140.  UpdateWorkArea(StartVirtualX,StartVirtualY,maxX,maxY,TRUE);
  6141.  DrawNewObject; {evtl. begonnenes Objet zeigen}
  6142. END;
  6143.  
  6144. PROCEDURE RotateUp(amount:WORD);
  6145. { in: Workarea^ = aktuelle Grafikdaten}
  6146. {     StartVirtualX|Y = aktuelle Anfangskoord. des sichtbaren Ausschnittes}
  6147. {     WorkHoehe, WorkBreite = Abmessungen der Workarea}
  6148. {     zoom = aktueller Vergrößerungsfaktor}
  6149. {     amount = #Zeilen, um die rotiert werden soll: 1..WorkHoehe-1}
  6150. {out: Workarea^ = neue Grafikdaten}
  6151. {     WorkAreaMaxUsedX|Y = neue Extremkoordinaten}
  6152. {rem: Workarea-Inhalt wurde um 1 Zeile nach oben rotiert}
  6153. VAR maxX,maxY,y:INTEGER;
  6154.     p1,p2:POINTER;
  6155.     tempArea:^WorkAreaTyp;
  6156.     size:WORD;
  6157. BEGIN
  6158.  New(tempArea);
  6159.  move(Workarea^.feld[0,0],tempArea^.feld[0,0],WorkBreite*amount);
  6160.  p1:=@Workarea^.feld[amount,0];
  6161.  p2:=@Workarea^.feld[0,0];
  6162.  size:=(WorkHoehe-amount)*WorkBreite;
  6163.  ASM
  6164.    MOV CX,size
  6165.    LES DI,p2
  6166.    LDS SI,p1
  6167.    CLD
  6168.    REP MOVSB
  6169.    MOV AX,SEG @DATA
  6170.    MOV DS,AX
  6171.  END;
  6172.  move(tempArea^.feld[0,0],Workarea^.feld[WorkHoehe-amount,0],WorkBreite*amount);
  6173.  Dispose(tempArea);
  6174.  
  6175.  FindWorkAreaMaxUsed;
  6176.  maxY:=min(WorkHoehe-1, StartVirtualY+(WorkHoehe  DIV zoom));
  6177.  maxX:=min(WorkBreite-1,StartVirtualX+(WorkBreite DIV zoom));
  6178.  UpdateWorkArea(StartVirtualX,StartVirtualY,maxX,maxY,TRUE);
  6179.  DrawNewObject; {evtl. begonnenes Objet zeigen}
  6180. END;
  6181.  
  6182. PROCEDURE RotateDown(amount:WORD);
  6183. { in: Workarea^ = aktuelle Grafikdaten}
  6184. {     StartVirtualX|Y = aktuelle Anfangskoord. des sichtbaren Ausschnittes}
  6185. {     WorkHoehe, WorkBreite = Abmessungen der Workarea}
  6186. {     zoom = aktueller Vergrößerungsfaktor}
  6187. {     amount = #Zeilen, um die rotiert werden soll: 1..WorkHoehe-1}
  6188. {out: Workarea^ = neue Grafikdaten}
  6189. {     WorkAreaMaxUsedX|Y = neue Extremkoordinaten}
  6190. {rem: Workarea-Inhalt wurde um 1 Zeile nach unten rotiert}
  6191. VAR maxX,maxY,y:INTEGER;
  6192.     p1,p2:POINTER;
  6193.     tempArea:^WorkAreaTyp;
  6194.     size:WORD;
  6195. BEGIN
  6196.  New(tempArea);
  6197.  move(Workarea^.feld[WorkHoehe-amount,0],tempArea^.feld[0,0],WorkBreite*amount);
  6198.  p1:=@Workarea^.feld[WorkHoehe-1-amount,WorkBreite-1];
  6199.  p2:=@Workarea^.feld[WorkHoehe-1  ,WorkBreite-1];
  6200.  size:=(WorkHoehe-amount)*WorkBreite;
  6201.  ASM
  6202.    MOV CX,size
  6203.    LES DI,p2
  6204.    LDS SI,p1
  6205.    STD
  6206.    REP MOVSB
  6207.    CLD
  6208.    MOV AX,SEG @DATA
  6209.    MOV DS,AX
  6210.  END;
  6211.  move(tempArea^.feld[0,0],Workarea^.feld[0,0],WorkBreite*amount);
  6212.  Dispose(tempArea);
  6213.  
  6214.  FindWorkAreaMaxUsed;
  6215.  maxY:=min(WorkHoehe-1, StartVirtualY+(WorkHoehe  DIV zoom));
  6216.  maxX:=min(WorkBreite-1,StartVirtualX+(WorkBreite DIV zoom));
  6217.  UpdateWorkArea(StartVirtualX,StartVirtualY,maxX,maxY,TRUE);
  6218.  DrawNewObject; {evtl. begonnenes Objet zeigen}
  6219. END;
  6220.  
  6221. PROCEDURE MirrorHorizontal;
  6222. { in: Workarea^ = aktuelle Grafikdaten}
  6223. {     StartVirtualX|Y = aktuelle Anfangskoord. des sichtbaren Ausschnittes}
  6224. {     WorkHoehe, WorkBreite = Abmessungen der Workarea}
  6225. {     zoom = aktueller Vergrößerungsfaktor}
  6226. {out: Workarea^ = neue Grafikdaten}
  6227. {rem: Inhalt der Workarea wurde horizontal gespiegelt}
  6228. VAR maxX,maxY,x,y:INTEGER;
  6229.     temp:BYTE;
  6230. BEGIN
  6231.  IF (WorkAreaMaxUsedX=0) AND (WorkAreaMaxUsedY=0) AND
  6232.     (Workarea^.feld[0,0]=transparent)
  6233.   THEN BEGIN {Workarea leer!}
  6234.         ErrBeep;
  6235.         exit
  6236.        END;
  6237.  
  6238.  FOR y:=0 TO WorkAreaMaxUsedY DO
  6239.   FOR x:=0 TO min(WorkAreaMaxUsedX,(WorkBreite-1) SHR 1) DO
  6240.    BEGIN {Punkte einer Zeile austauschen}
  6241.     temp:=Workarea^.feld[y,x];
  6242.     Workarea^.feld[y,x]:=Workarea^.feld[y,WorkBreite-1-x];
  6243.     Workarea^.feld[y,WorkBreite-1-x]:=temp
  6244.    END;
  6245.  
  6246.  FindWorkAreaMaxUsed;
  6247.  maxY:=min(WorkHoehe-1, StartVirtualY+(WorkHoehe  DIV zoom));
  6248.  maxX:=min(WorkBreite-1,StartVirtualX+(WorkBreite DIV zoom));
  6249.  UpdateWorkArea(StartVirtualX,StartVirtualY,maxX,maxY,TRUE);
  6250.  DrawNewObject; {evtl. begonnenes Objet zeigen}
  6251. END;
  6252.  
  6253. PROCEDURE MirrorVertical;
  6254. { in: Workarea^ = aktuelle Grafikdaten}
  6255. {     StartVirtualX|Y = aktuelle Anfangskoord. des sichtbaren Ausschnittes}
  6256. {     WorkHoehe, WorkBreite = Abmessungen der Workarea}
  6257. {     zoom = aktueller Vergrößerungsfaktor}
  6258. {out: Workarea^ = neue Grafikdaten}
  6259. {rem: Inhalt der Workarea wurde vertikal gespiegelt}
  6260. VAR maxX,maxY,x,y:INTEGER;
  6261.     temp:BYTE;
  6262. BEGIN
  6263.  IF (WorkAreaMaxUsedX=0) AND (WorkAreaMaxUsedY=0) AND
  6264.     (Workarea^.feld[0,0]=transparent)
  6265.   THEN BEGIN {Workarea leer!}
  6266.         ErrBeep;
  6267.         exit
  6268.        END;
  6269.  
  6270.  FOR x:=0 TO WorkAreaMaxUsedX DO
  6271.   FOR y:=0 TO min(WorkAreaMaxUsedY,(WorkHoehe-1) SHR 1) DO
  6272.    BEGIN {Punkte einer Spalte austauschen}
  6273.     temp:=Workarea^.feld[y,x];
  6274.     Workarea^.feld[y,x]:=Workarea^.feld[WorkHoehe-1-y,x];
  6275.     Workarea^.feld[WorkHoehe-1-y,x]:=temp
  6276.    END;
  6277.  
  6278.  FindWorkAreaMaxUsed;
  6279.  maxY:=min(WorkHoehe-1, StartVirtualY+(WorkHoehe  DIV zoom));
  6280.  maxX:=min(WorkBreite-1,StartVirtualX+(WorkBreite DIV zoom));
  6281.  UpdateWorkArea(StartVirtualX,StartVirtualY,maxX,maxY,TRUE);
  6282.  DrawNewObject; {evtl. begonnenes Objet zeigen}
  6283. END;
  6284.  
  6285. PROCEDURE ObenLinks;
  6286. { in: Workarea^ = aktuelle Grafikdaten}
  6287. {     StartVirtualX|Y = aktuelle Anfangskoord. des sichtbaren Ausschnittes}
  6288. {     WorkHoehe, WorkBreite = Abmessungen der Workarea}
  6289. {     zoom = aktueller Vergrößerungsfaktor}
  6290. {out: Workarea^ = neue Grafikdaten}
  6291. {rem: Inhalt der Workarea wurde soweit wie möglich nach links oben geschoben}
  6292. VAR minX,minY,maxX,maxY,x,y:INTEGER;
  6293.     tempArea:^WorkAreaTyp;
  6294. BEGIN
  6295.  IF (WorkAreaMaxUsedX=0) AND (WorkAreaMaxUsedY=0) AND
  6296.     (Workarea^.feld[0,0]=transparent)
  6297.   THEN BEGIN {Workarea leer!}
  6298.         ErrBeep;
  6299.         exit
  6300.        END;
  6301.  
  6302.  minX:=WorkAreaMaxUsedX;
  6303.  FOR y:=WorkAreaMaxUsedY DOWNTO 0 DO
  6304.   FOR x:=minX DOWNTO 0 DO
  6305.    IF Workarea^.feld[y,x]<>transparent
  6306.     THEN minX:=x;   {minimales X dieser Zeile bestimmen}
  6307.  
  6308.  minY:=WorkAreaMaxUsedY;
  6309.  FOR x:=WorkAreaMaxUsedX DOWNTO 0 DO
  6310.   FOR y:=minY DOWNTO 0 DO
  6311.    IF Workarea^.feld[y,x]<>transparent
  6312.     THEN minY:=y;   {minimales Y dieser Spalte bestimmen}
  6313.  
  6314.  IF (minX<>0) OR (minY<>0)
  6315.   THEN BEGIN {Inhalt hochschieben:}
  6316.         New(tempArea);
  6317.         Move(WorkArea^,tempArea^,SizeOf(WorkArea^));
  6318.         FillChar(WorkArea^,SizeOf(WorkArea^),transparent);
  6319.         FOR y:=minY TO WorkAreaMaxUsedY DO
  6320.          FOR x:=minX TO WorkAreaMaxUsedX DO
  6321.           Workarea^.feld[y-minY,x-minX]:=tempArea^.feld[y,x];
  6322.         Dispose(tempArea);
  6323.        END;
  6324.  
  6325.  FindWorkAreaMaxUsed;
  6326.  maxY:=min(WorkHoehe-1, StartVirtualY+(WorkHoehe  DIV zoom));
  6327.  maxX:=min(WorkBreite-1,StartVirtualX+(WorkBreite DIV zoom));
  6328.  UpdateWorkArea(StartVirtualX,StartVirtualY,maxX,maxY,TRUE);
  6329.  DrawNewObject; {evtl. begonnenes Objet zeigen}
  6330. END;
  6331.  
  6332.  
  6333. BEGIN
  6334.  init;
  6335.  
  6336.  DrawMaus(CursorPfeil); {...und anzeigen}
  6337.  EnableMouse;
  6338.  
  6339.  repeat
  6340.   IF KeyPressed
  6341.    THEN BEGIN
  6342.          ch:=ReadKey; Shift:=(mem[$0:$417] AND 3)<>0;
  6343.          IF ch=#0
  6344.           THEN Wahl:=ORD(ReadKey) SHL 8  {Funktionstasten -> >256}
  6345.           ELSE Wahl:=ORD(ch);
  6346.          CASE Wahl OF
  6347.           $4B00: Event:=EventScrollLeft;          {"<-" = Scroll nach links }
  6348.           $4D00: Event:=EventScrollRight;         {"->" = Scroll nach rechts}
  6349.           $4800: Event:=EventScrollUp;            {UP   = Scroll nach oben  }
  6350.           $5000: Event:=EventScrollDown;          {DOWN = Scroll nach unten }
  6351.           $2B  : Event:=EventZoomin;              {"+"  = vergrößern}
  6352.           $2D  : Event:=EventZoomout;             {"-"  = verkleinern}
  6353.           $3B00: Event:=EventHelp;                {F1   = Hilfe}
  6354.           $3C00: Event:=EventSpeichereSprite;     {F2   = Sprite speichern}
  6355.           $3D00,
  6356.           $5600: Event:=EventLadeSprite;          {(Sh-)F3 = Sprite laden}
  6357.           $3E00: Event:=EventSpeicherePalette;    {F4   = Palette speichern}
  6358.           $3F00: Event:=EventLadePalette;         {F5   = Palette laden}
  6359.           $5800: Event:=EventResetColors;         {Sh-F5= Defaultpalette}
  6360.           $4000: Event:=EventSpeichereHintergrund;{F6   = Bild speichern}
  6361.           $4100: Event:=EventLadeHintergrund;     {F7 = Hintergrundbild laden}
  6362.           $4200: Event:=EventEraseWorkarea;       {F8   = Workarea löschen}
  6363.           $4300: BEGIN                            {F9 = Palette auf Palette mappen }
  6364.                   IF (WorkAreaMaxUsedX<>0) OR
  6365.                      (WorkAreaMaxUsedY<>0)     {Workarea nicht leer? }
  6366.                    THEN BEGIN
  6367.                          IF SelectZielPalette  {Zielpalette auswählen}
  6368.                           THEN Event:=EventMapPalette
  6369.                         END
  6370.                    ELSE Event:=EventError
  6371.                  END;
  6372.           $5C00: Event:=EventMapToBIOSPAlette;    {Sh-F9 = Palette auf BIOS-Defaultfarben mappen}
  6373.           $4400: Event:=EventQuit;                {F10 = Beenden}
  6374.           else Event:=EventError;
  6375.          END;
  6376.         END;
  6377.  
  6378.   IF Event=EventNone  {keine Taste gedrückt, aber vielleicht Mausaktion?}
  6379.    THEN IF MouseUpdate
  6380.           THEN BEGIN {Mausaktion}
  6381.                 {N.B.: soll ein Event jetzt noch nachträglich "gelöscht"  }
  6382.                 {werden, so muß es auf "EventMouseMoved" gesetzt werden,  }
  6383.                 {nicht aber auf "EventNone", denn es ist ja was mit der }
  6384.                 {Maus passiert, (sie wurde zumindest bewegt oder geclickt)}
  6385.                 {Würde man dies ignorieren, so würde die Maus nicht mehr  }
  6386.                 {"enabled" werden!}
  6387.                 Event:=MouseEvent(menu);
  6388.  
  6389.                 {Folgende Mausaktionen müssen genauer untersucht werden,}
  6390.                 {ob sie im geg. Kontext zulässig sind:}
  6391.                 IF Event=EventMapPalette
  6392.                  THEN BEGIN  {Palette auf Palette mappen}
  6393.                        IF (WorkAreaMaxUsedX<>0) OR
  6394.                           (WorkAreaMaxUsedY<>0)    {Workarea nicht leer? }
  6395.                         THEN BEGIN
  6396.                               IF SelectZielPalette {Zielpalette auswählen}
  6397.                                THEN Event:=EventMapPalette
  6398.                              END
  6399.                         ELSE Event:=EventError
  6400.                       END
  6401.                END;
  6402.  
  6403.   IF Event<>EventNone
  6404.    THEN UnDrawMaus; {alten Bildschirminhalt unter Mauscursor restaurieren}
  6405.  
  6406.   CASE Event OF
  6407.    EventScrollLeft : BEGIN
  6408.                       IF Shift
  6409.                        THEN ScrollLeft(1)
  6410.                        ELSE ScrollLeft(max(1,(WorkBreite DIV zoom) SHR 2));
  6411.                       IF InWorkArea   {evtl. geriete die Maus sonst nämlich}
  6412.                        THEN BEGIN     {außerhalb des Bereiches Xε[0..319]  }
  6413.                              AdjustMouse; {deshalb Maus nachjustieren}
  6414.                              ShowCursorDaten
  6415.                             END;
  6416.                      END;
  6417.    EventScrollRight: BEGIN
  6418.                       IF Shift
  6419.                        THEN ScrollRight(1)
  6420.                        ELSE ScrollRight(max(1,(WorkBreite DIV zoom) SHR 2));
  6421.                       IF InWorkArea   {evtl. geriete die Maus sonst nämlich}
  6422.                        THEN BEGIN     {außerhalb des Bereiches Xε[0..319]  }
  6423.                              AdjustMouse; {deshalb Maus nachjustieren}
  6424.                              ShowCursorDaten
  6425.                             END;
  6426.                      END;
  6427.    EventScrollUp   : BEGIN
  6428.                       IF Shift
  6429.                        THEN ScrollUp(1) 
  6430.                        ELSE ScrollUp(max(1,(WorkBreite DIV zoom) SHR 2));
  6431.                       IF InWorkArea   {evtl. geriete die Maus sonst nämlich}
  6432.                        THEN BEGIN     {außerhalb des Bereiches Xε[0..319]  }
  6433.                              AdjustMouse; {deshalb Maus nachjustieren}
  6434.                              ShowCursorDaten
  6435.                             END;
  6436.                      END;
  6437.    EventScrollDown : BEGIN
  6438.                       IF Shift
  6439.                        THEN ScrollDown(1) 
  6440.                        ELSE ScrollDown(max(1,(WorkBreite DIV zoom) SHR 2));
  6441.                       IF InWorkArea   {evtl. geriete die Maus sonst nämlich}
  6442.                        THEN BEGIN     {außerhalb des Bereiches Xε[0..319]  }
  6443.                              AdjustMouse; {deshalb Maus nachjustieren}
  6444.                              ShowCursorDaten
  6445.                             END;
  6446.                      END;
  6447.    EventZoomin     : BEGIN
  6448.                       Zoomin;
  6449.                       IF InWorkArea       {zoomen verändert Punktkoord.,}
  6450.                        THEN BEGIN
  6451.                              AdjustMouse; {deshalb Maus nachjustieren}
  6452.                              ShowCursorDaten
  6453.                             END;
  6454.                      END;
  6455.    EventZoomout    : BEGIN
  6456.                       Zoomout;
  6457.                       IF InWorkArea       {zoomen verändert Punktkoord.,}
  6458.                        THEN BEGIN
  6459.                              AdjustMouse; {deshalb Maus nachjustieren}
  6460.                              ShowCursorDaten
  6461.                             END;
  6462.                      END;
  6463.    EventHelp       : Help;
  6464.    EventSpeichereSprite: speichereSprite;
  6465.    EventLadeSprite : ladeSprite;
  6466.    EventSpeicherePalette: speicherePalette;
  6467.    EventLadePalette: ladePalette;
  6468.    EventResetColors: ResetColors;
  6469.    EventSpeichereHintergrund: SpeichereHintergrund;
  6470.    EventLadeHintergrund: ladeHintergrund;
  6471.    EventMapPalette:MapPalette;
  6472.    EventMapToBIOSPalette:MapToBIOSPalette;
  6473.    EventNone:;
  6474.    EventError      : ErrBeep;
  6475.    EventInWorkArea : BEGIN
  6476.                       AdjustMouse;
  6477.                       ShowCursorDaten;
  6478.                       WorkAreaAction; {Aktion innerhalb der Workarea?}
  6479.                      END;
  6480.    EventMouseMoved:;
  6481.    EventSelectColor: IF LeftButton
  6482.                       THEN SelectColor    {linker Button = Farbe wählen}
  6483.                       ELSE PaletteChange; {recher Button = Farbe ändern}
  6484.    EventShowBorder : ShowBorder(Shift);
  6485.    EventBlinkColor : BlinkColor;
  6486.    EventChangeColor: ChangeColor;
  6487.    EventRotateLeft : IF Shift
  6488.                       THEN RotateLeft(1)
  6489.                       ELSE RotateLeft(max(1,(WorkBreite DIV zoom) SHR 2));
  6490.    EventRotateRight: IF Shift
  6491.                       THEN RotateRight(1)
  6492.                       ELSE RotateRight(max(1,(WorkBreite DIV zoom) SHR 2));
  6493.    EventRotateUp   : IF Shift
  6494.                       THEN RotateUp(1)
  6495.                       ELSE RotateUp(max(1,(WorkBreite DIV zoom) SHR 2));
  6496.    EventRotateDown : IF Shift
  6497.                       THEN RotateDown(1)
  6498.                       ELSE RotateDown(max(1,(WorkBreite DIV zoom) SHR 2));
  6499.    EventMirrorHorizontal: MirrorHorizontal;
  6500.    EventMirrorVertical  : MirrorVertical;
  6501.    EventObenLinks  : IF Shift
  6502.                       THEN GotoUpLeft {mit Shift: gehe in die linke obere Ecke}
  6503.                       ELSE ObenLinks; {ohne: verschiebe Inhalt in li. ob. Ecke}
  6504.  
  6505.    EventToolPixel,
  6506.    EventToolLine,
  6507.    EventToolRectangle,
  6508.    EventToolEllipse,
  6509.    EventToolBar,
  6510.    EventToolDisc,
  6511.    EventToolFill,
  6512.    EventToolCopy: SelectNewTool;
  6513.  
  6514.    EventEraseWorkarea: BEGIN {Bei "Löschen" lieber nochmal rückfragen}
  6515.                         ErrBeep;
  6516.                         IF FirstOfTwoBoxes(MeldungX,MeldungY,
  6517.                                            MeldungX+220,MeldungY+60,
  6518.                                            'yes','no',
  6519.                                            'DO YOU REALLY WANT',
  6520.                                            'TO ERASE THE WORKAREA?','',
  6521.                                            alternative)
  6522.                          THEN BEGIN
  6523.                                FillChar(WorkArea^,SizeOf(WorkArea^),transparent);
  6524.                                WorkAreaMaxUsedX:=0; WorkAreaMaxUsedY:=0;
  6525.                                UpdateWorkArea(StartVirtualX,StartVirtualY,
  6526.                                               WorkAreaMaxUsedX,WorkAreaMaxUsedY,TRUE);
  6527.                                DrawNewObject; {evtl. Objekt neuzeichnen}
  6528.                               END;
  6529.                         Event:=EventMouseMoved;
  6530.                        END;
  6531.  
  6532.  
  6533.    EventQuit : BEGIN  {Bei "Quit" lieber nochmal rückfragen}
  6534.                 IF FirstOfTwoBoxes(MeldungX,MeldungY,
  6535.                                    MeldungX+220,MeldungY+60,
  6536.                                    'yes','no',
  6537.                                    '','Really quit?','',
  6538.                                    alternative)
  6539.                         THEN Event:=EventEndProgram
  6540.                         ELSE Event:=EventMouseMoved
  6541.                END
  6542.  
  6543.    else ErrBeep;
  6544.   END;
  6545.  
  6546.   IF Event<>EventNone
  6547.    THEN BEGIN  {Mauszeiger wurde gelöscht, jetzt wieder neuzeichnen}
  6548.          IF NOT InWorkArea
  6549.           THEN BEGIN {evtentuelle Cursordaten vom Bildschirm löschen}
  6550.                 SetFillStyle(SolidFill,BestBlack);
  6551.                 Bar(InfoX,InfoY,InfoX+80,InfoY+29);
  6552.                END;
  6553.  
  6554.          IF (InWorkArea) AND (zoom=1)
  6555.           THEN DrawMaus(CursorKreuz)
  6556.           ELSE DrawMaus(CursorPfeil);
  6557.  
  6558.          ClearMouse; {Mausereignis abgearbeitet}
  6559.         END;
  6560.  
  6561.   IF Event<>EventEndProgram THEN Event:=EventNone;
  6562.  until Event=EventEndProgram; {Ende = F10 + Bestätigung}
  6563.  
  6564.  SetPalette(DefaultColors);
  6565.  restorecrtmode;
  6566.  SwapVectors
  6567. END.
  6568.