home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 06 / ldm / filebox.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-03-14  |  17.0 KB  |  518 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     FILEBOX.PAS                        *)
  3. (*           Datei-Selektion im Grafikmodus               *)
  4. (*          (c) 1991 Thorsten Huck & TOOLBOX              *)
  5. (* ------------------------------------------------------ *)
  6. UNIT FileBox;
  7.  
  8. INTERFACE
  9.  
  10.   PROCEDURE OpenGraph;
  11.  
  12.   PROCEDURE MouseOn;
  13.  
  14.   PROCEDURE MouseOff;
  15.  
  16.   PROCEDURE MouseSpeed(horRatio, verRatio : INTEGER);
  17.  
  18.   PROCEDURE MouseState(VAR St : INTEGER);
  19.  
  20.   PROCEDURE Mouse(VAR hPos, vPos, Status : INTEGER);
  21.  
  22.   PROCEDURE SetMouseArea(Left, Up, Right, Down : INTEGER);
  23.  
  24.   PROCEDURE SetMouse(hPos, vPos : INTEGER);
  25.  
  26.   PROCEDURE MouseClick(    Button : INTEGER;
  27.                        VAR Count  : INTEGER);
  28.  
  29.   PROCEDURE FileSelect(x, y : INTEGER; VAR fName : STRING;
  30.                        BoxName, Path, Mask       : STRING;
  31.                        hg, vg                    : INTEGER);
  32.  
  33.  
  34. IMPLEMENTATION
  35.  
  36. USES Graph, Crt, Dos;
  37.  
  38. CONST
  39.   MaxFiles = 180;
  40.  
  41. VAR
  42.   Regs  : Registers;
  43.   fName : STRING;
  44.  
  45.   PROCEDURE OpenGraph;
  46.   VAR
  47.     driver,
  48.     Mode,
  49.     errcode : INTEGER;
  50.     BGIPath : STRING;
  51.   BEGIN
  52.     BGIPath := GetEnv('BGIPATH');
  53.     DetectGraph(driver, Mode);
  54.     InitGraph(driver, Mode, BGIPath);
  55.     errcode := GraphResult;
  56.     IF errcode <> 0 THEN BEGIN
  57.       WriteLn('Grafiktreiber nicht gefunden!');
  58.       WriteLn;  WriteLn('Fehlercode', errcode);
  59.       REPEAT UNTIL KeyPressed;
  60.       Halt(errcode);
  61.     END;
  62.   END;
  63.  
  64.   PROCEDURE MouseOn;
  65.   BEGIN                          (* MausCursor darstellen *)
  66.     Regs.AX := 1;
  67.     Intr($33, Regs);
  68.   END;
  69.  
  70.   PROCEDURE MouseOff;
  71.   BEGIN                          (* MausCursor löschen    *)
  72.     Regs.AX := 2;
  73.     Intr($33, Regs);
  74.   END;
  75.  
  76.   PROCEDURE MouseSpeed(horRatio, verRatio : INTEGER);
  77.   BEGIN          (* Verhältnis Mickey/Bildpunkt bestimmen *)
  78.     Regs.AX := 15;
  79.     Regs.CX := horRatio;
  80.     Regs.DX := verRatio;
  81.     Intr($33,Regs);
  82.   END;
  83.  
  84.   PROCEDURE MouseState(VAR St : INTEGER);
  85.   BEGIN                                     (* Maus Reset *)
  86.     Regs.AX := 0;
  87.     Intr($33, Regs);
  88.     St := Regs.AX;     (* -1, wenn Maus nicht installiert *)
  89.   END;
  90.  
  91.   PROCEDURE Mouse(VAR hPos, vPos, Status : INTEGER);
  92.   BEGIN                   (* Status und Position der Maus *)
  93.     Regs.AX := 3;
  94.     Intr($33, Regs);
  95.     hPos   := Regs.CX;
  96.     vPos   := Regs.DX;
  97.     Status := Regs.BX;
  98.   END;
  99.  
  100.   PROCEDURE SetMouseArea(Left, Up, Right, Down : INTEGER);
  101.   BEGIN   (* Festlegen der horizontalen/vertikalen Grenze *)
  102.     Regs.AX := 7;
  103.     Regs.CX := Left;
  104.     Regs.DX := Right;
  105.     Intr($33, Regs);
  106.     Regs.AX := 8;
  107.     Regs.CX := Up;
  108.     Regs.DX := Down;
  109.     Intr($33, Regs);
  110.   END;
  111.  
  112.   PROCEDURE SetMouse(hPos, vPos : INTEGER);
  113.   BEGIN             (* Position des Mauszeigers festlegen *)
  114.     Regs.AX := 4;
  115.     Regs.CX := hPos;
  116.     Regs.DX := vPos;
  117.     Intr($33, Regs);
  118.   END;
  119.  
  120.   PROCEDURE MouseClick(    Button : INTEGER;
  121.                        VAR Count  : INTEGER);
  122.   BEGIN                            (* Maustasten gedrückt *)
  123.     Regs.AX := 5;
  124.     Regs.BX := Button;
  125.     Intr($33, Regs);
  126.     Count   := Regs.BX;
  127.   END;
  128.  
  129.   PROCEDURE FileSelect(x, y : INTEGER; VAR fName : STRING;
  130.                        BoxName, Path, Mask       : STRING;
  131.                        hg, vg                    : INTEGER);
  132.   VAR
  133.     xx, yy, k, mo, ii, i,
  134.     FileCnt, xFile, xPos    : INTEGER;
  135.     OldPath, helpV, helpV1  : STRING;
  136.     DirName                 : ARRAY [1..MaxFiles] OF
  137.                               STRING [15];
  138.     ColorBuffer, PrKey      : BYTE;
  139.     LwC, LwD, LwE, ok, Jump : BOOLEAN;
  140.     z, z1                   : WORD;
  141.     scroll, back            : Pointer;
  142.     DirInfo                 : SearchRec;
  143.  
  144.     FUNCTION IsDirectory : BOOLEAN;
  145.     BEGIN
  146.       IsDirectory := ((DosError     = 0)         AND
  147.                       (DirInfo.Attr = Directory) AND
  148.                       (DirInfo.Name <> '.'));
  149.     END;
  150.  
  151.     FUNCTION IsArchive : BOOLEAN;
  152.     BEGIN               (* Diese Dateien werden angezeigt *)
  153.       IsArchive := ((DosError     = 0) AND
  154.                     (DirInfo.Attr = Archive));
  155.     END;
  156.  
  157.     PROCEDURE Select(Path : STRING);
  158.     VAR
  159.       i    : INTEGER;
  160.       Name : STRING;
  161.     BEGIN
  162.       FileCnt := 0;
  163.       FOR i := 1 TO MaxFiles DO DirName[i] := '';
  164.                                     (* Unterverzeichnisse *)
  165.       FindFirst(Path + '*.*', AnyFile, DirInfo);
  166.       IF IsDirectory THEN BEGIN
  167.         INC(FileCnt);
  168.         DirName[FileCnt] := Chr(10) + ' ' + DirInfo.Name;
  169.       END;
  170.       REPEAT
  171.         FindNext(DirInfo);
  172.         IF IsDirectory THEN BEGIN
  173.           INC(FileCnt);
  174.           DirName[FileCnt] := Chr(10) + ' ' + DirInfo.Name;
  175.         END;
  176.       UNTIL DosError = 18;    (* keine Dateien gefunden.. *)
  177.                               (* Dateinamen mit Suchmaske *)
  178.       FindFirst(Path + Mask, AnyFile, DirInfo);
  179.       IF IsArchive THEN BEGIN
  180.         INC(FileCnt);
  181.         DirName[FileCnt] := '  ' + DirInfo.Name;
  182.       END;
  183.       REPEAT
  184.         FindNext(DirInfo);
  185.         IF IsArchive THEN BEGIN
  186.           INC(FileCnt);
  187.           DirName[FileCnt] := '  ' + DirInfo.Name;
  188.         END;
  189.       UNTIL DosError = 18;    (* keine Dateien gefunden.. *)
  190.     END;
  191.  
  192.     PROCEDURE ShowIt;
  193.     BEGIN                             (* Anzeige Laufwerk *)
  194.       helpV1 := '';
  195.       SetColor(vg);
  196.       SetFillStyle(1, hg);
  197.       Bar(x+8, y+16, x+395, y+25);
  198.       helpV := 'Suchpfad : ' + Path + Mask;
  199.       OutTextXY(x+10, y+16, helpV);
  200.       Bar(x+31, y+46, x+164, y+142);
  201.       Jump := TRUE;
  202.     END;
  203.  
  204.   BEGIN          (* Kontrolle, welche Laufwerke verfügbar *)
  205.     LwC := FALSE;  LwD := FALSE;  LwE := FALSE;
  206.     GetDir(0, OldPath);
  207.     {$I-}
  208.     ChDir('C:\');  IF IOResult <> 15 THEN LwC := TRUE;
  209.     ChDir('D:\');  IF IOResult <> 15 THEN LwD := TRUE;
  210.     ChDir('E:\');  IF IOResult <> 15 THEN LwE := TRUE;
  211.     {$I+}
  212.     ChDir(OldPath);
  213.     IF (Path = '') OR (Path = ' ') THEN Path := FExpand('');
  214.     IF (Mask = '') OR (Mask = ' ') THEN Mask := '*.*';
  215.     helpV1 := '';
  216.     fName  := '';
  217.     ok     := FALSE;
  218.     ColorBuffer := GetColor;
  219.     MouseState(mo);
  220.     z  := ImageSize(x+35, y+59, x+160, y+138);
  221.     GetMem(scroll, z);
  222.     z1 := ImageSize(x,    y,    x+400, y+400);
  223.     GetMem(back, z);
  224.     GetImage(x, y, x+400, y+150, back^);
  225.     xPos  := 1;
  226.     xFile := 1;
  227.     SetFillStyle(1, hg);
  228.     Bar(x, y, x+400, y+150);
  229.     SetColor(vg);
  230.     Rectangle(x+2, y+2, x+398, y+148);
  231.     Rectangle(x+4, y+4, x+396, y+146);
  232.     i := TextWidth(BoxName);
  233.     OutTextXY(x + 200 - (i DIV 2), y+7, BoxName);
  234.     Rectangle(x+30, y+45, x+165, y+143);
  235.     i := TextWidth(Mask);
  236.     i := 72 - (i DIV 2);
  237.     OutTextXY(x+30+i, y+37, Mask);
  238.     Rectangle(x+ 30, y+ 35, x+185, y+45);
  239.     Rectangle(x+165, y+143, x+185, y+45);
  240.     OutTextXY(x+172, y+ 50, Chr(30));
  241.     OutTextXY(x+172, y+130, Chr(31));
  242.     Rectangle(x+165, y+60, x+185, y+128);
  243.     helpV := 'Suchpfad : ' + Path + Mask;
  244.     OutTextXY(x+ 10, y+16, helpV);
  245.     OutTextXY(x+200, y+26, 'Auswahl:');
  246.     OutTextXY(x+200, y+32, '         ------------');
  247.     OutTextXY(x+250, y+70, '   O K    ');
  248.     OutTextXY(x+250, y+90, 'Abbrechen');
  249.     Rectangle(x+240, y+66, x+340, y+80);
  250.     Rectangle(x+242, y+68, x+338, y+78);
  251.     Rectangle(x+240, y+86, x+340, y+100);
  252.     OutTextXY(x+205, y+45, 'A:');                (* LW A: *)
  253.     Rectangle(x+195, y+40, x+225, y+55);
  254.     Rectangle(x+193, y+38, x+227, y+57);
  255.     OutTextXY(x+245, y+45, 'B:');                (* LW B: *)
  256.     Rectangle(x+235, y+40, x+265, y+55);
  257.     Rectangle(x+233, y+38, x+267, y+57);
  258.     IF LwC THEN BEGIN
  259.       OutTextXY(x+285, y+45, 'C:');              (* LW C: *)
  260.       Rectangle(x+275, y+40, x+305, y+55);
  261.       Rectangle(x+273, y+38, x+307, y+57);
  262.     END;
  263.     IF LwD THEN BEGIN
  264.       OutTextXY(x+325, y+45, 'D:');              (* LW D: *)
  265.       Rectangle(x+315, y+40, x+345, y+55);
  266.       Rectangle(x+313, y+38, x+347, y+57);
  267.     END;
  268.     IF LwE THEN BEGIN
  269.       OutTextXY(x+365, y+45, 'E:');              (* LW E: *)
  270.       Rectangle(x+355, y+40, x+385, y+55);
  271.       Rectangle(x+353, y+38, x+387, y+57);
  272.     END;
  273.     OutTextXY(x+248, y+110, 'FileSelect ');
  274.     OutTextXY(x+210, y+122, '(c) 1991 Thorsten Huck');
  275.     OutTextXY(x+240, y+134, ' & TOOLBOX');
  276.     k := 0;
  277.     REPEAT
  278.       Jump := FALSE;
  279.       SetColor(vg);
  280.       Select(Path);
  281.       FOR i := 1 TO 9 DO
  282.         OutTextXY(x+40, y+40+(i*10), DirName[i]);
  283.       SetFillStyle(1, vg);
  284.       Bar(x+35, y+49, x+160, y+58);
  285.       SetColor(hg);
  286.       OutTextXY(x+40, y+50, DirName[1]);
  287.       xPos := 1;  xFile := 1;
  288.       IF DirName[1,1] = Chr(10) THEN
  289.         helpV1 := ''
  290.       ELSE BEGIN
  291.         helpV1 := DirName[1];
  292.         Delete(helpV1, 1, 2);
  293.       END;
  294.       SetFillStyle(1, hg);
  295.       SetColor(vg);
  296.       Bar(x+270, y+26, x+395, y+34);
  297.       helpV := helpV1 + Chr(219);
  298.       OutTextXY(x+272, y+26, helpV);
  299.       IF mo = -1 THEN MouseOn;
  300.       IF k  =  1 THEN Delay(100);
  301.       REPEAT
  302.         Mouse(xx, yy, k);  PrKey := 0;
  303.         IF k = 1 THEN BEGIN
  304.           FOR i := 1 TO 9 DO
  305.             IF (xx > x+35) AND (xx < x+160) AND
  306.                (yy > y+39+(i*10)) AND
  307.                (yy < y+48+(i*10)) AND (k = 1) THEN BEGIN
  308.               IF mo = -1 THEN MouseOff;
  309.               SetFillStyle(1, hg);
  310.               Bar(x+ 35, y+39+(xPos*10),
  311.                   x+160, y+48+(xPos*10));
  312.               SetColor(vg);
  313.               OutTextXY(x+40, y+40+(xPos*10),
  314.                         DirName[xFile]);
  315.               xFile := xFile-(xPos-i);  xPos:=i;
  316.               SetFillStyle(1, vg);
  317.               Bar(x+ 35, y+39+(xPos*10),
  318.                   x+160, y+48+(xPos*10));
  319.               SetColor(hg);
  320.               OutTextXY(x+40, y+40+(xPos*10),
  321.                         DirName[xFile]);
  322.               IF DirName[xFile,1] = Chr(10) THEN
  323.                 helpV1 := ''
  324.               ELSE BEGIN
  325.                 helpV1 := DirName[xFile];
  326.                 Delete(helpV1, 1, 2);
  327.               END;
  328.               SetFillStyle(1, hg);
  329.               SetColor(vg);
  330.               Bar(x+270, y+26, x+395,y +34);
  331.               helpV := helpV1 + Chr(219);
  332.               OutTextXY(x+272, y+26, helpV);
  333.               IF k  =  1 THEN MouseClick(0, ii);
  334.               IF mo = -1 THEN MouseOn;
  335.               Delay(200);
  336.               IF k = 1 THEN BEGIN
  337.                 MouseClick(0, ii);
  338.                 IF ii > 0 THEN ok := TRUE;
  339.               END;
  340.             END;
  341.         END;
  342.         IF KeyPressed OR (k <> 0) THEN BEGIN
  343.           IF k = 0 THEN PrKey := Ord(ReadKey);
  344.           IF (PrKey = 13) OR
  345.              ((xx > x+240) AND (xx < x+340) AND
  346.               (yy > y+ 66) AND (yy < y+ 80) AND
  347.               (k = 1)) OR ok THEN BEGIN
  348.             IF helpV1 <> '' THEN BEGIN
  349.               fName := Path + helpV1;
  350.               DirName[xFile,1] := ' ';
  351.             END;
  352.             IF DirName[xFile,1] = Chr(10) THEN BEGIN
  353.               IF (DirName[xFile,3] = '.') AND
  354.                  (DirName[xFile,4] = '.') THEN BEGIN
  355.                 i := Length(Path);
  356.                 Delete(Path, i, 1);
  357.                 REPEAT
  358.                   DEC(i);  Delete(Path, i, 1);
  359.                 UNTIL Path[i-1] = '\';
  360.               END ELSE BEGIN
  361.                 Delete(DirName[xFile], 1, 2);
  362.                 Path := Path + DirName[xFile] + '\';
  363.               END;
  364.               SetFillStyle(1, hg);
  365.               IF mo = -1 THEN MouseOff;
  366.               Bar(x+31, y+46, x+164, y+142);
  367.               helpV := 'Suchpfad :' + Path + Mask;
  368.               SetColor(vg);
  369.               Bar(x+8, y+16, x+395, y+25);
  370.               OutTextXY(x+10, y+16, helpV);
  371.               ok := FALSE;  helpV1 := '';  Jump := TRUE;
  372.             END;
  373.           END;
  374.           IF (PrKey IN [32..90, 92, 95, 97..122]) AND
  375.              (Length(helpV1) < 12) THEN BEGIN
  376.             SetFillStyle(1, hg);
  377.             helpV1 := helpV1 + Chr(PrKey);
  378.             SetColor(vg);
  379.             Bar(x+270, y+26, x+395, y+34);
  380.             helpV := helpV1 + Chr(219);
  381.             OutTextXY(x+272, y+26, helpV);
  382.           END;
  383.           IF (PrKey = 8) AND (Length(helpV1) > 0) THEN BEGIN
  384.             SetFillStyle(1, hg);
  385.             Delete(helpV1, Length(helpV1), 1);
  386.             SetColor(vg);
  387.             Bar(x+270, y+26, x+395, y+34);
  388.             helpV := helpV1 + Chr(219);
  389.             OutTextXY(x+272, y+26, helpV);
  390.           END;
  391.           IF (PrKey = 0) OR (k <> 0) THEN BEGIN
  392.             IF k = 0 THEN PrKey := Ord(ReadKey);
  393.             IF (PrKey = 59) OR
  394.                ((xx > x+195) AND (xx < x+225) AND
  395.                 (yy > y+ 40) AND (yy < y+ 55) AND
  396.                 (k = 1)) THEN BEGIN
  397.               Path := 'A:\';  ShowIt;
  398.             END;
  399.             IF (PrKey = 60) OR
  400.                ((xx > x+235) AND (xx < x+265) AND
  401.                 (yy > y+ 40) AND (yy < y+ 55) AND
  402.                 (k = 1)) THEN BEGIN
  403.               Path := 'B:\';  ShowIt;
  404.             END;
  405.             IF ((PrKey = 61) OR
  406.                ((xx > x+275) AND (xx < x+305) AND
  407.                 (yy > y+ 40) AND (yy < y+ 55) AND
  408.                 (k = 1))) AND LwC THEN BEGIN
  409.               Path := 'C:\';  ShowIt;
  410.             END;
  411.             IF ((PrKey = 62) OR
  412.                ((xx > x+315) AND (xx < x+345) AND
  413.                 (yy > y+ 40) AND (yy < y+ 55) AND
  414.                 (k = 1))) AND LwD THEN BEGIN
  415.               Path := 'D:\';  ShowIt;
  416.             END;
  417.             IF ((PrKey = 63) OR
  418.                ((xx > x+355) AND (xx < x+385) AND
  419.                 (yy > y+ 40) AND (yy < y+ 55) AND
  420.                 (k = 1))) AND LwE THEN BEGIN
  421.               Path := 'E:\';  ShowIt;
  422.             END;
  423.             IF ((PrKey = 80) AND (xFile < FileCnt)) OR
  424.                ((xx > x+165) AND (xx < x+185) AND
  425.                 (yy > y+128) AND (yy < y+143) AND
  426.                 (k = 1) AND (xFile < FileCnt)) THEN BEGIN
  427.               IF mo = -1 THEN MouseOff;
  428.               SetFillStyle(1, hg);
  429.               Bar(x+ 35, y+39+(xPos*10),
  430.                   x+160, y+48+(xPos*10));
  431.               SetColor(vg);
  432.               OutTextXY(x+40, y+40+(xPos*10),
  433.                         DirName[xFile]);
  434.               INC(xFile);
  435.               IF xPos < 9 THEN
  436.                 INC(xPos)
  437.               ELSE BEGIN
  438.                 GetImage(x+35, y+59, x+160, y+138, scroll^);
  439.                 PutImage(x+35, y+49, scroll^, 0);
  440.               END;
  441.               SetFillStyle(1, vg);
  442.               Bar(x+ 35, y+39+(xPos*10),
  443.                   x+160, y+48+(xPos*10));
  444.               SetColor(hg);
  445.               OutTextXY(x+40, y+40+(xPos*10),
  446.                         DirName[xFile]);
  447.               IF DirName[xFile,1] = Chr(10) THEN
  448.                 helpV1 := ''
  449.               ELSE BEGIN
  450.                 helpV1 := DirName[xFile];
  451.                 Delete(helpV1, 1, 2);
  452.               END;
  453.               SetFillStyle(1, hg);
  454.               SetColor(vg);
  455.               Bar(x+270, y+26, x+395, y+34);
  456.               helpV := helpV1 + Chr(219);
  457.               OutTextXY(x+272, y+26, helpV);
  458.               IF mo = -1 THEN MouseOn;
  459.               IF k <>  0 THEN Delay(35);
  460.             END;
  461.             IF ((PrKey = 72) AND (xFile > 1)) OR
  462.                ((xx > x+165) AND (xx < x+185) AND
  463.                 (yy > y+ 45) AND (yy < y+ 60) AND
  464.                 (k = 1) AND (xFile > 1))THEN BEGIN
  465.               IF mo = -1 THEN MouseOff;
  466.               SetFillStyle(1, hg);
  467.               Bar(x+ 35, y+39+(xPos*10),
  468.                   x+160, y+48+(xPos*10));
  469.               SetColor(vg);
  470.               OutTextXY(x+40, y+40+(xPos*10),
  471.                         DirName[xFile]);
  472.               DEC(xFile);
  473.               IF xPos > 1 THEN
  474.                 DEC(xPos)
  475.               ELSE BEGIN
  476.                 GetImage(x+35, y+49, x+160, y+128, scroll^);
  477.                 PutImage(x+35,y+59,scroll^,0);
  478.               END;
  479.               SetFillStyle(1, vg);
  480.               Bar(x+ 35, y+39+(xPos*10),
  481.                   x+160, y+48+(xPos*10));
  482.               SetColor(hg);
  483.               OutTextXY(x+40, y+40+(xPos*10),
  484.                         DirName[xFile]);
  485.               IF DirName[xFile,1] = Chr(10) THEN
  486.                 helpV1 := ''
  487.               ELSE BEGIN
  488.                 helpV1 := DirName[xFile];
  489.                 Delete(helpV1, 1, 2);
  490.               END;
  491.               SetFillStyle(1, hg);
  492.               SetColor(vg);
  493.               Bar(x+270, y+26, x+395, y+34);
  494.               helpV := helpV1 + Chr(219);
  495.               OutTextXY(x+272, y+26, helpV);
  496.               IF mo = -1 THEN MouseOn;
  497.               IF k <>  0 THEN Delay(35);
  498.             END;
  499.           END;
  500.         END;
  501.       UNTIL (PrKey = 27) OR
  502.             ((xx > x+240) AND (xx < x+340) AND
  503.              (yy > y+ 86) AND (yy < y+100) AND (k = 1)) OR
  504.             (fName <> '') OR Jump;
  505.     UNTIL NOT Jump;
  506.     IF mo = -1 THEN MouseOff;
  507.     PutImage(x, y, back^, 0);
  508.     FreeMem(back, z1);
  509.     FreeMem(scroll, z);
  510.     IF mo = -1 THEN MouseOn;
  511.     PrKey := 0;
  512.     SetColor(ColorBuffer);
  513.   END;
  514.  
  515. END.
  516. (* ------------------------------------------------------ *)
  517. (*                 Ende von FILEBOX.PAS                   *)
  518.