Home » Source Code » » MAKES.PAS

MAKES.PAS ( File view )

From:
  • By 2010-07-21
  • View(s):9
  • Download(s):0
  • Point(s): 1
			{
$UNDEF StackCheck
}
{
$DEFINE test
}

{
$IFDEF test
}
  {
$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-
}
  {
$M 16384,0,655360
}
{
$ELSE
}
  {
$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,R-,S-,V-,X-
}
  {
$M 16384,150000,655360
}
{
$ENDIF
}

PROGRAM MakeSprite;
{
Zweck    : Erstellung von *.COD und *.PIC Dateien fr ANIVGA        
}
{
Autor    : Kai Rohrbacher    
}
{
Sprache  : TurboPascal 6.0   
}
{
Datum    : Mrz 1993         
}
{
Anmerkung: Hat manchmal Probleme bei der Mausinitialisierung - keine
}
{
           Ahnung warum!
}

{
Erweiterungen um ein Tool:
}
{
 ein Event dafr definieren
}
{
 in "ToolTyp" mitaufnehmen 
}
{
 in "Menu[]" aufnehmen (vor dem Sentineleintrag natrlich)
}
{
 DrawTool* Routine fr Icondarstellung einfgen (inkl. FORWARD)
}
{
 DrawWorkArea* Routine einfhren, die Objekt lschen, zeichnen & speichern kann
}
{
 Tooltyp in ClearOldObject(), DrawNewObject() und StoreObject() einfgen
}
{
 in WorkAreaAction() 2x einfgen: temporres Objekt zeichnen, Objekt abschlieen
}
{
 in SelectNewTool() und ShowActualTool() einfgen
}
{
 im Hauptprogramm bei Event-Abfrage bercksichtigen
}
{
 Wenn es den Inhalt der Workarea ndert, dann WorkAreaMaxUsedX|Y ndern
}

USES Dos,Graph,crt,Dateien,Eingaben,Compression;
const Titel1='MakeSprite V2.2 (c) - by Kai Rohrbacher';
      GetMaxX=639;
      GetMaxY=399; {
da Graph.GetMaxY hier noch nicht zur Verfgung steht!
}
      Menumax=10;              {
Anzahl Eintrge im Hauptmenu
}
      WorkBreite=320; {
Breite der Workarea
}
      WorkHoehe=200;
      WorkStartX= 4;  WorkEndX=WorkStartX+Pred(WorkBreite);
      WorkStartY=35;  WorkEndY=WorkStartY+Pred(WorkHoehe);
      PaletteX=WorkStartX+WorkBreite+4; {
Koord. fr Palette
}
      PaletteY=30;
      PalHoehe=15;    {
Abmessungen einer Palettenkachel
}
      PalBreite=18;
      MeldungX=390; MeldungY=GetMaxY-95;{
Koordinaten fr Meldungen
}
      InfoX=WorkStartX;                 {
dto., fr Sprite-Info
}
      InfoY=WorkEndy+10;
      ToolsX=10; ToolsY=WorkEndY+65;    {
dto., fr Toolboxen  
}
      zoom:BYTE=2;    {
Vergrerungsfaktor
}
      StartVirtualX:INTEGER=0; {
Verschiebung des Workarea-Inhaltes
}
      StartVirtualY:INTEGER=0;
      MenuStartX=2; MenuStartY=GetMaxY-20; {
Menu-Startkoordinaten
}

      CursorMaxX=11;  {
max. Abmessungen des Mauscursors
}
      CursorMaxY=13;
      MausMinX=0;     {
Koordinatenbereich fr Maus
}
      MausMinY=20;
      MausMaxX=GetMaxX-CursorMaxX;
      MausMaxY=GetMaxY-CursorMaxY;

      MaxSpriteBreite=316; {
sollte Vielfaches von 4 sein
}
      MaxSpriteHoehe =200;
      Datenbytes=MaxSpriteHoehe*Succ(Pred(MaxSpriteBreite) div 4)*4;

      Kopf=50; {
Gre des folgenden Spriteheaders in Bytes (ohne Data-Feld):
}
      VID640x400x256=1;
      VID640x480x256=2;
      transparent=0;  {
Farbe fr durchsichtig = 0 per Definition!
}

      {
Farben fr Text-Selektionsboxen:
}
      ChoseColor=blue shl 4 + white;   {
weie Schrift auf blauem Hintergrund
}

TYPE spritetyp= record case Integer of
      0:(
         Zeiger_auf_Plane:Array[0..3] OF Word;   {
Diese...
}
         Breite_in_4er_Gruppen:WORD;             {
...Daten
}
         Hoehe_in_Zeilen:WORD;                   {
...brauchen
}
         Translate:Array[1..4] OF Byte;          {
...alles
}
         SpriteLength:WORD;
         Dummy:Array[1..10] OF Word;             {
...zusammen
}
         Kennung:ARRAY[1..2] OF CHAR;
         Version:BYTE;
         Modus:BYTE;
         ZeigerL,ZeigerR,ZeigerO,ZeigerU:Word;   {
"Kopf" Bytes!
}
         Data:Array[1..Datenbytes
                       +(WorkBreite*2)*2
                       +(WorkHoehe *2)*2] OF Byte;
        );
      1:(
         readin:Array[0..(Datenbytes-1)  {
max. Gre der Planedaten
}
                      +(WorkBreite*2)*2  {
dto., Y-Grenzen (2 Wort-Tabellen)
}
                      +(WorkHoehe *2)*2  {
dto., X-Gr. (auch Worteintrge)
}
                      +Kopf] OF Byte;    {
Zeiger am Anfang, immer!
}
        )
     END;
     {
Datentyp zur Reprsentation der WorkArea; Achtung: WorkArea[y,x],
}
     {
nicht WorkArea[x,y]!
}
     WorkAreatyp= record case Integer of
      0:(data:ARRAY[0..WorkBreite*WorkHoehe-1] OF BYTE);
      1:(feld:ARRAY[0..WorkHoehe-1,0..WorkBreite-1] OF BYTE);
     END;

     Farbeck=RECORD
              x1,y1,x2,y2:Integer;
             END;

     BildTyp=(cod,pic,none);
     ActionTyp=(clear,draw,store);

     ToolTyp=(Punkt,Rechteck,Ellipse_,FRechteck,FEllipse,Linie,FuellEimer,Kopie);
     ObjektTyp=RECORD
                stage:BYTE;
                StartX,StartY,LastX,LastY:INTEGER;
                actX,actY:INTEGER; {
Hilfskoordinaten, nur fr "Kopie"-Tool
}
                Typ:ToolTyp;
                Aligned:BOOLEAN;
               END;
     ButtonStringTyp=STRING[8];  {
Meldung in Clickboxen
}

CONST aktuellesTool:ToolTyp=Punkt; {
aktuell gewhltes Tool
}
      aktuelleFarbe:BYTE=White;    {
aktuelle Zeichenfarbe 
}
      Objekt:ObjektTyp=(
       stage:0;  {
Objekt noch nicht begonnen, Rest uninteressant!
}
       StartX:0; StartY:0; LastX:0; LastY:0;
       actX:0; actY:0;
       Typ:Punkt;
       Aligned:FALSE
       );

VAR CRTAddress,      {
Adresse des CRT-Ports, $3B4/$3D4 fuer monochrom/Farbe
}
    StatusReg:WORD;  {
dto., fuer Statusregister, $3BA/$3DA
}
    Shift:BOOLEAN;   {
gibt wieder, ob whrend Auswertung Shift gedrckt war
}
    BestWhite,       {
Beste Nherungen der angeg. Farben
}
    BestBlack,
    BestCyan,
    BestLightGray,
    BestDarkGray:BYTE;
    DisplayMode:BYTE;

{
---------Menu-Felder---------
}
CONST EventNone=0;                 {
gar nix
}
      EventError=1;                {
Fehler 
}
      EventQuit=2;                 {
Programm vielleicht beenden
}
      EventScrollLeft=3;           {
Scroll nach links 
}
      EventScrollRight=4;          {
Scroll nach rechts
}
      EventScrollUp=5;             {
Scroll nach oben  
}
      EventScrollDown=6;           {
Scroll nach unten 
}
      EventZoomin=7;               {
Workareainhalt vergrern
}
      EventZoomout=8;              {
dto., verkleinern
}
      EventHelp=9;                 {
Hilfe
}
      EventLadeSprite=10;          {
Sprite laden
}
      EventLadePalette=11;         {
Palette laden
}
      EventResetColors=12;         {
Defaultpalette
}
      EventLadeHintergrund=13;     {
Hintergrundbild laden
}
      EventMapPalette=14;          {
Workareainhalt auf Palette matchen
}
      EventMapToBIOSPalette=15;    {
dto., aber auf Standardfarbenpalette
}
      EventInWorkArea=16;          {
Maus in Workarea
}
      EventMouseMoved=17;          {
Maus wurde bewegt
}
      EventSelectColor=18;         {
Farbe wird ausgewhlt
}
      EventToolPixel=19;           {
Tool fr Punkte selektiert
}
      EventToolLine=20;            {
dto., fr Linien
}
      EventToolRectangle=21;       {
dto., fr Quadrate+Rechtecke
}
      EventToolEllipse=22;         {
dto., fr Kreise+Ellipsen
}
      EventToolBar=23;             {
dto., fr ausgefllte Quadrate+Rechtecke
}
      EventToolDisc=24;            {
dto., fr ausgefllte Kreise+Ellipsen
}
      EventToolFill=25;            {
dto., fr Fllfunktion
}
      EventToolCopy=26;            {
dto., fr Ausschnittskopien
}
      EventBlinkColor=27;          {
Eine Farbe blinken lassen
}
      EventChangeColor=28;         {
Farbe austauschen
}
      EventShowBorder=29;          {
Spritegrenzen zeigen
}
      EventSpeichereSprite=30;     {
Sprite abspeichern
}
      EventSpeichereHintergrund=31;{
Hintergrund abspeichern
}
      EventSpeicherePalette=32;    {
Palette abspeichern
}
      EventRotateLeft=33;          {
Workareainhalt um 1 nach links rotieren
}
      EventRotateRight=34;         {
dto., rechts
}
      EventRotateUp=35;            {
dto., nach oben
}
      EventRotateDown=36;          {
dto., nach unten
}
      EventMirrorHorizontal=37;    {
horizontal spiegeln
}
      EventMirrorVertical=38;      {
vertikal spiegeln
}
      EventObenLinks=39;           {
verschiebt Sprite soweit wie mglich links hoch
}
      EventEraseWorkarea=40;       {
Workarea vollstndig lschen
}
      EventEndProgram=41;          {
Programm tatschlich beenden
}

VAR globalI:BYTE;

TYPE DrawBox=PROCEDURE;
     box=RECORD  {
Datentyp fr ein Menufeld:
}
          x1,y1,                 {
obere linke Boxecke
}
          x2,y2:WORD;            {
untere rechte Ecke 
}
          Name1,Name2:STRING[8]; {
Beschriftung 1.+2.Zeile
}
          Show :DrawBox;         {
Routine zum anzeigen des Icons
}
          Event:BYTE;            {
zurckzugebender Wert
}
          Click:BOOLEAN;         {
mu Maus geclickt werden fr Event?
}
          Paint:BOOLEAN;         {
Flag, ob Box zu zeichnen ist
}
         END;
     boxes=ARRAY[1..32] OF box;  {
alle Menufelder zusammen
}

PROCEDURE Dummy; FAR; BEGIN END;
PROCEDURE DrawToolPixels; FAR; FORWARD;
PROCEDURE DrawToolLines; FAR; FORWARD;
PROCEDURE DrawToolRectangles; FAR; FORWARD;
PROCEDURE DrawToolEllipses; FAR; FORWARD;
PROCEDURE DrawToolBars; FAR; FORWARD;
PROCEDURE DrawToolDiscs; FAR; FORWARD;
PROCEDURE DrawToolFill; FAR; FORWARD;
PROCEDURE DrawToolCopy; FAR; FORWARD;

PROCEDURE DrawFunctionkey; FAR; FORWARD;
PROCEDURE DrawBoxBorders; FAR; FORWARD;
PROCEDURE DrawBoxBlinkColor; FAR; FORWARD;
PROCEDURE DrawBoxChangeColor; FAR; FORWARD;
PROCEDURE DrawBoxRotateLeft; FAR; FORWARD;
PROCEDURE DrawBoxRotateRight; FAR; FORWARD;
PROCEDURE DrawBoxRotateUp; FAR; FORWARD;
PROCEDURE DrawBoxRotateDown; FAR; FORWARD;
PROCEDURE DrawBoxMirrorHorizontal; FAR; FORWARD;
PROCEDURE DrawBoxMirrorVertical; FAR; FORWARD;
PROCEDURE DrawBoxObenLinks; FAR; FORWARD;

CONST ToolBoxWidth=45;
      BoxWidth=63;
      Menu:boxes=(
 {
F1
}  (x1:MenuStartX+ 0*BoxWidth+8-1;           y1:MenuStartY-1;
        x2:MenuStartX+ 0*BoxWidth+8+BoxWidth-14; y2:MenuStartY+18;
        Name1:'Help'; Name2:'';
        Show :DrawFunctionkey;
        Event:EventHelp;
        Click:TRUE;
        Paint:TRUE),
 {
F2
}  (x1:MenuStartX+ 1*BoxWidth+8-1;           y1:MenuStartY-1;
        x2:MenuStartX+ 1*BoxWidth+8+BoxWidth-14; y2:MenuStartY+18;
        Name1:'Save';Name2:'*.COD';
        Show :DrawFunctionkey;
        Event:EventSpeichereSprite;
        Click:TRUE;
        Paint:TRUE),
 {
F3
}  (x1:MenuStartX+ 2*BoxWidth+8-1;           y1:MenuStartY-1;
        x2:MenuStartX+ 2*BoxWi
...
...
(Not finished, please download and read the complete file)
			
...
Expand> <Close

Want complete source code? Download it here

Point(s): 1

Download
0 lines left, continue to read
Sponsored links

File list

Tips: You can preview the content of files by clicking file names^_^
Name Size Date
ANIVGA.DOC220.35 kB07-11-93|18:45
ANIVGA.ENG320.98 kB07-11-93|18:45
ANIVGA.PAS318.61 kB07-11-93|18:45
ANIVGA.TUT12.66 kB07-11-93|18:45
BFFFFFFF.PAS2.02 kB07-11-93|18:45
CHANGES.TXT4.76 kB07-11-93|18:45
COMPRESS.PAS38.98 kB07-11-93|18:45
DATEIEN.PAS45.08 kB07-11-93|18:45
DUMP_SPR.PAS10.05 kB07-11-93|18:45
EINGABEN.PAS8.68 kB07-11-93|18:45
EXAMPL12.PAS3.77 kB07-11-93|18:45
EXAMPLE1.PAS1.58 kB07-11-93|18:45
EXAMPLE2.PAS1.89 kB07-11-93|18:45
EXAMPLE3.PAS3.24 kB07-11-93|18:45
EXAMPLE4.PAS1.64 kB07-11-93|18:45
EXAMPLE5.PAS2.92 kB07-11-93|18:45
EXAMPLE6.PAS3.98 kB07-11-93|18:45
EXAMPLE7.PAS3.03 kB07-11-93|18:45
EXAMPLE8.PAS2.82 kB07-11-93|18:45
EXAMPLE9.PAS1.38 kB07-11-93|18:45
FAQ.TXT11.99 kB07-11-93|18:45
07.00 B
2_HEBREW.FNT3.51 kB11-03-92|10:38
30.FNT3.26 kB11-03-92|10:39
33Q.FNT3.01 kB11-03-92|10:39
36.FNT2.76 kB11-03-92|10:39
44.FNT2.26 kB11-03-92|10:39
8X10.FNT2.51 kB11-03-92|10:38
8X11SNSF.FNT2.76 kB11-03-92|10:38
8X14.FNT3.51 kB11-03-92|10:38
ALPS.FNT3.51 kB11-03-92|10:37
ALPS10.FNT2.51 kB11-03-92|10:37
ALPS11.FNT2.76 kB11-03-92|10:37
ALPS6.FNT1.51 kB11-03-92|10:37
ALPS7.FNT1.76 kB11-03-92|10:37
ALPS8.FNT2.01 kB11-03-92|10:37
ANTIQUE.FNT3.51 kB11-03-92|10:38
APLS9.FNT2.26 kB11-03-92|10:37
B814.FNT3.51 kB11-03-92|10:39
BIGSERIF.FNT3.51 kB11-03-92|10:38
BLCKSNSF.FNT2.51 kB11-03-92|10:38
BLOCK.FNT3.51 kB11-03-92|10:38
BOLD.FNT3.51 kB11-03-92|10:38
BROADWAY.FNT3.51 kB11-03-92|10:38
CNTDOWN.FNT3.51 kB11-03-92|10:37
COMPUTER.FNT3.51 kB11-03-92|10:38
COURIER.FNT3.51 kB11-03-92|10:38
CYRILLIC.FNT3.51 kB11-03-92|10:38
DEFAULT.FNT1.51 kB11-03-92|10:39
FIRE.FNT52.26 kB11-03-92|18:45
FIRE.PAL768.00 B11-03-92|18:45
FRANKFRT.FNT3.51 kB11-03-92|10:37
FRESNO.FNT3.51 kB11-03-92|10:38
FUTURE.FNT3.51 kB11-03-92|10:38
GAELIC.FNT3.51 kB11-03-92|10:37
GEORGIAN.FNT3.51 kB11-03-92|10:37
GREEK.FNT3.51 kB11-03-92|10:38
HOLLOW.FNT3.51 kB11-03-92|10:38
HUGE.FNT4.01 kB11-03-92|10:39
HYLAS.FNT3.51 kB11-03-92|10:38
ITALIC.FNT3.51 kB11-03-92|10:37
ITALICS.FNT3.51 kB11-03-92|10:37
ITT.FNT3.51 kB11-03-92|10:38
LCD.FNT3.51 kB11-03-92|10:38
MEDIEVAL.FNT3.51 kB11-03-92|10:38
MODERNFO.FNT4.01 kB11-03-92|10:39
OCR.FNT3.51 kB11-03-92|10:37
OLDENG.FNT3.51 kB11-03-92|10:37
ROMAN.FNT3.51 kB11-03-92|10:39
SANSERIF.FNT3.51 kB11-03-92|10:39
SCRIBBLE.FNT4.01 kB11-03-92|10:39
SCRIPT.FNT3.51 kB11-03-92|10:37
SCRIPT2.FNT3.51 kB11-03-92|10:39
SENAPL.FNT3.51 kB11-03-92|10:37
SIDE.FNT2.51 kB11-03-92|10:37
SIMILITE.FNT3.51 kB11-03-92|10:39
SMALCAPS.FNT3.51 kB11-03-92|10:39
STRETCH.FNT3.51 kB11-03-92|10:39
SUPER.FNT2.01 kB11-03-92|10:39
THAI.FNT3.51 kB11-03-92|10:39
THIN.FNT3.51 kB11-03-92|10:39
THIN8X8.FNT2.01 kB11-03-92|10:39
_BROADWA.FNT8.01 kB11-02-92|12:06
_OCR.FNT3.51 kB11-03-92|10:39
GRAB.EXE14.53 kB07-11-93|18:45
GRAB.PAS45.71 kB07-11-93|18:45
07.00 B
AEGYPTEN.COD1.30 kB06-12-92|21:42
BLACK.COD434.00 B06-12-92|21:54
FLOWER.COD3.26 kB03-20-92|14:04
FRACTAL.PAL768.00 B07-03-93|16:12
FRACTAL1.PIC62.50 kB07-03-93|16:12
FRACTAL2.PIC62.50 kB07-03-93|16:13
FRACTAL3.PIC62.50 kB07-03-93|16:13
FRACTAL4.PIC62.50 kB07-03-93|16:14
HANTEL.LIB4.77 kB11-10-91|15:20
MARMOR.COD8.80 kB06-13-92|18:38
RANDOM.PAL768.00 B07-17-92|19:31
TILE2.COD1.30 kB10-20-91|13:57
WHATSNEW.LIB1.72 kB06-12-93|20:09
07.00 B
APPLE.COD290.00 B10-02-92|05:34
ESP.COD4.55 kB10-05-92|15:06
GAME.EXE43.13 kB07-04-93|12:21
GAME.PAS12.00 kB07-04-93|13:46
LINE.COD1.02 kB09-25-92|18:55
MUSIC.PAS20.14 kB09-24-92|16:52
MUSIC.TPU4.89 kB07-04-93|12:21
QUEST.LIB4.53 kB10-05-92|15:51
README.TXT549.00 B07-04-93|13:47
SMALLNUM.LIB13.00 kB09-27-92|16:24
SPOOK.LIB3.57 kB10-02-92|07:36
STANDARD.PAL768.00 B09-25-92|18:53
MAKE.BAT165.00 B07-11-93|18:45
MAKES.PAS218.08 kB07-11-93|18:45
PCX2COD.DOC852.00 B07-11-93|18:45
PCX2COD.PAS77.98 kB07-11-93|18:45
README.1ST2.87 kB07-11-93|18:45
README.2ND4.12 kB07-11-93|18:45
SHOWPIC.PAS995.00 B07-11-93|18:45
SVGA256.BGI6.19 kB07-11-93|18:45
UNCHAIN.ASM11.60 kB07-11-93|18:45
UNCHAIN.EXE1.20 kB07-11-93|18:45
UNLIB.PAS5.86 kB07-11-93|18:45
WHATSNEW.EXE37.36 kB07-11-93|18:45
WHATSNEW.PAS9.10 kB07-11-93|18:45
...
Sponsored links

MAKES.PAS (678.56 kB)

Need 1 point
Your Point(s)

Your Point isn't enough.

Get point immediately by PayPal

More(Debit card / Credit card / PayPal Credit / Online Banking)

Submit your source codes. Get more point

LOGIN

Don't have an account? Register now
Need any help?
Mail to: support@codeforge.com

切换到中文版?

CodeForge Chinese Version
CodeForge English Version

Where are you going?

^_^"Oops ...

Sorry!This guy is mysterious, its blog hasn't been opened, try another, please!
OK

Warm tip!

CodeForge to FavoriteFavorite by Ctrl+D