home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 08 / praxis / copymaus.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-05-23  |  10.3 KB  |  350 lines
  1. (* ------------------------------------------------------ *)
  2. (*                  COPYMAUS.PAS                          *)
  3. (*       (c) 1989 E.v.Pappenheim & TOOLBOX                *)
  4. (* ------------------------------------------------------ *)
  5. {$R-,S-,I-,D-,F-,V-,B-,N-,L+ }
  6. {$M 1024,0,0 }
  7. PROGRAM CopyMaus;
  8.  
  9. USES Crt, DOS;
  10.  
  11. CONST
  12.   version    = 'Copymaus Ver. 1.2';
  13.   hotkey     = $1E00;
  14.   hotkeyname = '<Alt><A>';
  15.   maxcol     = 80;
  16.   maxrow     = 25;
  17.  
  18. TYPE
  19.   ScreenType  = ARRAY [1..maxrow, 1..maxcol] OF WORD;
  20.  
  21. VAR
  22.   screen         : ^ScreenType;
  23.   saveint16      : POINTER;
  24.   savess, savesp,
  25.   progss, progsp,
  26.   videosegment,
  27.   ch             : WORD;
  28.   pageoffset     : WORD ABSOLUTE $0040:$004e;
  29.  
  30. CONST
  31.   cursor                     = #219;
  32.   num          : WORD        = 0;
  33.   written      : WORD        = 0;
  34.   cr                         = $1c0d;
  35.   crtl_q                     = $1011;
  36.   crtl_i                     = $1709;
  37.   titel1       : STRING[41]  =
  38.       '  C O P Y M A U S    Links => Blockanfang';
  39.   titel2       : STRING[40]  =
  40.       '   Rechts => Blockende   Ende => ░░░░░';
  41.   indentstr    : SET OF CHAR = ['I','n','d','e','n','t'];
  42.   mouseint                   = $33;
  43.   maxnum                     = 1024;
  44.  
  45. VAR
  46.   buffer       : ScreenType;
  47.   charbuffer   : ARRAY[1..maxnum] OF WORD;
  48.   y, xt,
  49.   a, b,
  50.   xa, ya,
  51.   xe, ye       : BYTE;
  52.   xm, ym,
  53.   n, m, x      : WORD;
  54.   indent,
  55.   again,
  56.   inverted     : BOOLEAN;
  57.   mregs        : Registers;
  58.  
  59.   FUNCTION GetKey : WORD;
  60.   INLINE($31/$c0/$9c/$ff/$1e/SaveInt16);
  61.  
  62.   PROCEDURE ReverseAttribut(col, row : BYTE);
  63.   VAR
  64.     VideoWord : RECORD CASE BYTE OF
  65.                   1: (v    : WORD);
  66.                   2: (c, a : BYTE);
  67.                 END;
  68.   BEGIN
  69.     WITH VideoWord DO BEGIN
  70.       v := screen^[row, col];
  71.       a := (a MOD 16) * 16 + a SHR 4;
  72.       screen^[row, col] := v;
  73.     END;
  74.     inverted := TRUE;
  75.   END;
  76.  
  77.   PROCEDURE InitCopyMaus;
  78.   VAR
  79.     regs : Registers;
  80.   BEGIN
  81.     regs.ah := $0f;
  82.     Intr($10, regs);
  83.     IF regs.al = 7 THEN VideoSegment := $b000
  84.                    ELSE VideoSegment := $b800;
  85.     screen := Ptr(VideoSegment + pageoffset shr 4, 0);
  86.     again  := FALSE;
  87.     inverted := FALSE;
  88.     indent   := FALSE;
  89.   END;
  90.  
  91.   FUNCTION TestMouse : INTEGER;     (* Maus installiert ? *)
  92.   BEGIN
  93.     mregs.ax := 0;
  94.     Intr(mouseint, mregs);
  95.     IF (mregs.ax = $FFFF) THEN TestMouse := mregs.bx
  96.                           ELSE TestMouse := 0;
  97.   END;
  98.  
  99.   PROCEDURE InitMouse;                      (* Maus-Reset *)
  100.   BEGIN
  101.     mregs.ax := 0;    Intr(mouseint, mregs);
  102.   END;
  103.  
  104.   PROCEDURE ShowMouse;       (* Mauscursor initialisieren *)
  105.   VAR
  106.     attr : BYTE;
  107.   BEGIN
  108.     mregs.ax := 4;                     (* Position setzen *)
  109.     mregs.cx := Pred(WhereX) * 8;
  110.     mregs.dx := Pred(WhereY) * 8;
  111.     Intr(mouseint, mregs);
  112.     mregs.ax := 7;       (* horizontaler Bewegungsbereich *)
  113.     mregs.cx := 0;
  114.     mregs.dx := 639;
  115.     Intr(mouseint, mregs);
  116.     mregs.ax := 8;         (* vertikaler Bewegungsbereich *)
  117.     mregs.cx := 0;
  118.     mregs.dx := 399;
  119.     Intr(mouseint, mregs);
  120.     mregs.ax := 10;          (* Mauscursor Form und Farbe *)
  121.     mregs.bx := 0;
  122.     attr     := 112;
  123.     mregs.cx := attr SHL 8;
  124.     mregs.dx := mregs.cx + Ord(cursor);
  125.     Intr(mouseint, mregs);
  126.     mregs.ax := 1;          (* Mauscursor sichtbar machen *)
  127.     intr(mouseint, mregs);
  128.   END;
  129.  
  130.   PROCEDURE HideMouse;    (* Mauscursor unsichtbar machen *)
  131.   BEGIN
  132.     mregs.ax := 2; Intr(mouseint, mregs);
  133.   END;
  134.  
  135.   PROCEDURE GetMouse(VAR x, y : WORD);
  136.   BEGIN                         (* Mausposition ermitteln *)
  137.     mregs.ax := 3;
  138.     Intr(mouseint, mregs);
  139.     x := mregs.cx;       y := mregs.dx;
  140.     x := Succ(x DIV 8);  y := Succ(y DIV 8);
  141.   END;
  142.  
  143.   FUNCTION WhichButton : WORD;
  144.   BEGIN                       (* Welcher Knopf gedrückt ? *)
  145.      mregs.ax := 3;
  146.      Intr(mouseint, mregs);
  147.      WhichButton := mregs.bx;
  148.   END;
  149.  
  150.   FUNCTION MouseinXY(x1, x2, y1, y2 : WORD) : BOOLEAN;
  151.   VAR
  152.     x, y : WORD;    (* Ist die Maus im angegebenen Feld ? *)
  153.   BEGIN
  154.     GetMouse(x,y);
  155.     MouseinXY := (x >= x1) AND (x <= x2) AND
  156.                  ( y >= y1) AND (y <= y2);
  157.   END;
  158.  
  159.   PROCEDURE Restore(x, y : BYTE);
  160.   BEGIN        (* Originalzeichen an x, y zurückschreiben *)
  161.     Move(buffer[y,x], screen^[y,x], 2);
  162.     inverted := FALSE;
  163.   END;
  164.  
  165.   PROCEDURE InvertBlock(xa, ya, xe, ye : BYTE;
  166.                         invers         : BOOLEAN);
  167.   VAR
  168.     xt, a, b, y, x : BYTE;
  169.   BEGIN  (* Invertiert einen Textblock bis zum Zeilenende *)
  170.     IF (NOT inverted) = invers THEN BEGIN
  171.       FOR y := ya TO ye DO BEGIN
  172.         a := 1;  b := 1;
  173.         IF y <> ye THEN
  174.           WHILE (b < 80) DO BEGIN
  175.             a := b;
  176.             WHILE (Lo(buffer[y,a]) <> Ord(' ')) AND
  177.                                          (a < 80) DO Inc(a);
  178.             b := a;  xt := a;
  179.             WHILE (Lo(buffer[y,b])  = Ord(' ')) AND
  180.                                          (b < 80) DO Inc(b);
  181.           END
  182.         ELSE xt := xe;
  183.         IF y <> ya THEN xa := 1;
  184.         FOR x := xa TO xt DO
  185.           IF invers THEN ReverseAttribut(x, y)
  186.                     ELSE Restore(x, y);
  187.       END;
  188.     END;
  189.   END;
  190.  
  191.   PROCEDURE Store(c : WORD);         (* Zeichen speichern *)
  192.   BEGIN
  193.     IF num <= maxnum THEN BEGIN
  194.       Inc(num); charbuffer[num] := c;
  195.     END;
  196.   END;
  197.  
  198.   PROCEDURE MoveCopyMaus;
  199.   BEGIN
  200.     InitCopyMaus;
  201.     FOR n := 1 TO 25 DO   (* Bildschirm in den Puffer ...*)
  202.       Move(screen^[n,1], buffer[n,1], 160);
  203.  { Die folgenden Zeilen testen, ob in TP 3.0 oder 4.0 die }
  204.  { automatische Tabulierung (Indent) eingeschaltet ist    }
  205.     n := 35;
  206.     WHILE Chr(Lo(screen^[1,n])) IN indentstr DO Inc(n);
  207.     m := 33;
  208.     WHILE Chr(Lo(screen^[2,m])) IN indentstr DO Inc(m);
  209.     x := 34;
  210.     WHILE Chr(Lo(screen^[3,x])) IN indentstr DO Inc(x);
  211.     IF (n > 38) OR (m > 35) OR (x > 36) THEN
  212.       indent := TRUE
  213.     ELSE indent := FALSE;
  214.     FOR n := 1 TO 80 DO BEGIN     (* Titelzeile schreiben *)
  215.       IF n <= 41 THEN
  216.         screen^[1,n] := 112 SHL 8 + Ord(titel1[n])
  217.       ELSE
  218.         screen^[1,n] := 112 SHL 8 + Ord(titel2[n - 41])
  219.     END;
  220.     ShowMouse;
  221.     xa := 0;  ya := 0;  xe := 0;  ye := 0;
  222.  { Die Hauptschleife des Programms: Setzen von Anfangs-    }
  223.  { und Endkoordinate und markieren                         }
  224.     REPEAT
  225.       GetMouse(xm, ym);
  226.       Move(buffer[ym, xm], screen^[ym, xm], 1);
  227.       IF WhichButton = 2 THEN BEGIN               (* Ende *)
  228.         InvertBlock(xa, ya, xe, ye, FALSE);
  229.         xe := xm;  ye := ym;
  230.       END;
  231.       IF WhichButton = 1 THEN BEGIN             (* Anfang *)
  232.         InvertBlock(xa, ya, xe, ye, FALSE);
  233.         xa := xm;   ya := ym;
  234.       END;
  235.       IF (ye < ya) OR ((xe < xa) AND (ye = ya)) THEN BEGIN
  236.         xe := xa;   ye := ya;
  237.       END;
  238.       InvertBlock(xa, ya, xe, ye, TRUE);
  239.       Hi(screen^[ya,xa]) := 112;       (* Anfang und Ende *)
  240.       Hi(screen^[ye,xe]) := 112;       (* markieren       *)
  241.     UNTIL MouseInXY(75, 80, 1, 1);
  242.     InvertBlock(xa, ya, xe, ye, FALSE); (* Markierung weg *)
  243.     HideMouse;                                (* Maus weg *)
  244.     Move(buffer[1,1], screen^[1,1], 160);    (* Titel weg *)
  245.     IF NOT ((xa = 0)        (* Überhaupt etwas markiert ? *)
  246.         AND (ya = 0) AND (xe = 0) AND (ye = 0)) THEN BEGIN
  247.       IF indent THEN BEGIN          (* Indent ausschalten *)
  248.         Store(crtl_q);
  249.         Store(crtl_i);
  250.       END;
  251.  { Markierten Block in den "Charbuffer" schreiben          }
  252.       FOR y := ya TO ye DO BEGIN
  253.         a := 1; b := 1;
  254.         IF y <> ye THEN
  255.           WHILE (b < 80) DO BEGIN
  256.             a := b;
  257.             WHILE (Lo(buffer[y,a]) <> Ord(' ')) and
  258.                                          (a < 80) DO Inc(a);
  259.             b := a;  xt := a;
  260.             WHILE (Lo(buffer[y,b])  = Ord(' ')) and
  261.                                          (b < 80) DO Inc(b);
  262.           END
  263.         ELSE xt := xe;
  264.         IF y <> ya THEN xa := 1;
  265.         FOR x := xa TO xt DO BEGIN
  266.           Store(Lo(buffer[y,x]));
  267.           IF (x = xt) AND (y <> ye) THEN Store(cr);
  268.         END;
  269.       END;
  270.       if indent then begin          (* Indent einschalten *)
  271.         Store(crtl_q);
  272.         Store(crtl_i);
  273.       END;
  274.       again := TRUE;
  275.     END ELSE InitMouse;
  276.   END;
  277.  
  278.   PROCEDURE PutChar(scancode : WORD);
  279.   VAR
  280.     KBDhead    : WORD ABSOLUTE $0040:$001A;
  281.     KBDtail    : WORD ABSOLUTE $0040:$001C;
  282.     KBDbuffer  : ARRAY [$1E..$3C] OF BYTE
  283.                                        ABSOLUTE $0040:$001E;
  284.   BEGIN
  285.     Move(scancode, KBDbuffer[KBDtail], 2);
  286.     KBDtail := KBDtail + 2;
  287.     IF KBDtail > $003C THEN KBDtail := $001E;
  288.   END;
  289.  
  290.   PROCEDURE GetCopyMausChar(VAR key : WORD);
  291.   BEGIN
  292.     IF num > 0 THEN BEGIN
  293.       Inc(written);
  294.       key := (CharBuffer[written]);
  295.       IF written = num THEN BEGIN
  296.         written := 0;
  297.         num := 0;
  298.         InitMouse;
  299.         again := FALSE;
  300.       END ELSE PutChar(hotkey);
  301.     END ELSE again := FALSE;
  302.   END;
  303.  
  304. {$F+}
  305.   PROCEDURE Int16(flags, cs, ip, ax, bx, cx, dx, si, di,
  306.                               ds, es, bp : WORD); INTERRUPT;
  307.     PROCEDURE SwitchStack;
  308.     INLINE ($8C/$16/saveSS/$89/$26/saveSP/$FA/
  309.             $8E/$16/progSS/$8B/$26/progSP/$FB);
  310.  
  311.     PROCEDURE SwitchBack;
  312.     INLINE ($FA/$8E/$16/saveSS/$8B/$26/saveSP/$FB);
  313.  
  314.     PROCEDURE ChainInt(address : POINTER);
  315.     INLINE ($5B/$58/$87/$5E/$0E/$87/$46/$10/$89/
  316.             $EC/$5D/$07/$1F/$5F/$5E/$5A/$59/$CB);
  317.   BEGIN
  318.     IF (Hi(ax) = 0) THEN BEGIN
  319.       ax := GetKey;
  320.       IF ax = hotkey THEN BEGIN
  321.         SwitchStack;
  322.         IF again THEN BEGIN
  323.           GetCopyMausChar(ch);
  324.           SwitchBack;
  325.           ax := ch;
  326.         END ELSE BEGIN
  327.           MoveCopyMaus;
  328.           SwitchBack;
  329.           IF again THEN PutChar(hotkey);
  330.         END;
  331.       END;
  332.     END ELSE ChainInt(saveint16);
  333.   END;
  334.  
  335. BEGIN
  336.   progSS := SSeg;
  337.   progsp := SPtr;
  338.   IF testmouse <> 0 THEN BEGIN
  339.     WriteLn(^M^J,version,' ist installiert, ',
  340.                           ^M^J'aktivieren mit ',hotkeyname);
  341.     GetIntVec($16, saveint16);
  342.     SetIntVec($16, @int16);
  343.     SetIntVec($1B, saveint1b);
  344.     again := FALSE;
  345.     Keep(0);
  346.     END ELSE
  347.       WriteLn('Keine Maus initialisiert ! ');
  348. END.
  349. (* ------------------------------------------------------ *)
  350. (*                  Ende von COPYMAUS.PAS                 *)
  351.