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