unit design;

interface
uses crt,windos;

procedure writexy(x,y : integer;s : string);
procedure rahmen(rt: byte;startx,starty,dx,dy : integer);
function select_datei(dir : string;mask : pchar;mtext,comment: string) : string;
function wrhexb(b : byte) : string;
function wrhexw(w : word) : string;
procedure save_screen;
procedure restore_screen;
Procedure Fenster(x,y,dx,dy : integer; s : string;rcol,bcol : byte);
procedure cursor_On;
procedure cursor_Off;

implementation

var filenames : array[1..512] of string[12];
const      Screen_Akt   : byte = 1;

procedure writexy(x,y : integer;s : string);
begin;
 gotoxy(x,y);
 write(s);
end;

procedure save_screen;
var Screen : array[1..4,1..8000] of byte absolute $b800:0000;
begin;
  if Screen_Akt <= 4 then begin;
    inc(Screen_Akt);
    move(screen[1],screen[Screen_Akt],8000);
  end;
end;

procedure restore_screen;
var Screen : array[1..4,1..8000] of byte absolute $b800:0000;
begin;
  if Screen_Akt >= 2 then begin;
    move(screen[Screen_Akt],screen[1],8000);
    dec(Screen_Akt);
  end;
end;

procedure rahmen(rt: byte;startx,starty,dx,dy : integer);
const frames : array[1..2,1..6] of char =
 (('�','�','�','�','�','�'),
  ('�','�','�','�','�','�'));
var lx,ly : integer;
    s : string;
begin;
  { obere Zeile }
  s := frames[rt,1];
  for lx := 1 to dx-2 do s := s + frames[rt,5];
  s := s + frames[rt,2];
  gotoxy(startx,starty);
  write(s);
  { mittleren Zeilen }
  for ly := 1 to dy-2 do begin;
    s := frames[rt,6];
    for lx := 1 to dx-2 do s := s + ' ';
    s := s + frames[rt,6];
    gotoxy(startx,starty+ly);
    write(s);
  end;
  { untere Zeile }
  s := frames[rt,4];
  for lx := 1 to dx-2 do s := s + frames[rt,5];
  s := s + frames[rt,3];
  gotoxy(startx,starty+dy-1);
  write(s);
end;

Procedure Fenster(x,y,dx,dy : integer; s : string;rcol,bcol : byte);
var tlaeng : byte;
    deltx,tstartpos : byte;
begin;
  tlaeng := length(s);
  tstartpos := x + ((dx-Tlaeng) SHR 1);
  textcolor(rcol);
  textbackground(bcol);
  rahmen(1,x,y,dx,dy);
  writexy(tstartpos,y,s);
end;

procedure sort_filenames(start,ende : integer);
{
 Hier sollte f�r gr��ere Verzeichnise Quick-Sort eingebaut werden !
}
var hilfe : string;
    l1,l2 : integer;
begin;
  for l1 := start to ende-1 do begin;
    for l2 := start to ende-1 do begin;
      if filenames[l2] > filenames[l2+1] then begin;
        hilfe := filenames[l2];
        filenames[l2] := filenames[l2+1];
        filenames[l2+1] := hilfe;
      end;
    end;
  end;
end;

function select_datei(dir : string;mask : pchar;mtext,comment: string) : string;
const  zeile : byte = 1;
  spalte : byte = 0;
  Start_fndisp : word = 0;
var
  DirInfo: TSearchRec;
  count : integer;
  Nullpos : byte;
var li,lj : integer;
    inp : char;
    retval : string;
    kasten_gefunden : boolean;
    select : byte;
    changed : boolean;
    End_fndisp : word;
begin
  {$I+}
  for li := 1 to 512 do filenames[li] := ' - - -';
  count := 1;
  FindFirst(mask, faArchive, DirInfo);
  while DosError = 0 do
  begin
    filenames[count] := (DirInfo.Name);
    Nullpos := pos(#0,filenames[count]);
    if Nullpos <> 0 then
      filenames[count] := copy(filenames[count],0,Nullpos-1);
    inc(count);
    FindNext(DirInfo);
  end;
  {$I-}

  sort_filenames(1,count-1);
  save_screen;
  Fenster(5,4,72,16,comment,black,7);
  textcolor(1);
  writexy(21,5,'         Bitte Datei ausw�hlen');
  textcolor(black);
  inp := #255;
  changed := true;
  repeat
    textcolor(black);
    if changed then begin;
      changed := false;
      for lj := 0 to 4 do begin;
        for li := 1 to 12 do begin;
          writexy(7+lj*14,5+li,'            ');
          writexy(7+lj*14,5+li,filenames[lj*12+li+Start_fndisp]);
        end;
      end;
      textcolor(14);
      writexy(7+Spalte*14,5+Zeile,filenames[Spalte*12+Zeile+Start_fndisp]);
    end;
    if keypressed then inp := readkey;
    if ord(inp) = 0 then inp := readkey;
    case ord(inp) of
      32,
      13: begin;
            inp := #13;
            changed := true;
            if (pos('- - -',filenames[Spalte*12+Zeile+Start_fndisp]) = 0) then
              retval := filenames[Spalte*12+Zeile+Start_fndisp]
            else
              retval := 'xxxx';
          end;
      27: begin;
            inp := #27;
            changed := true;
            retval := 'xxxx';
          end;
      71: begin; { Pos 1 }
            inp := #255;
            Zeile  := 1;
            Spalte := 0;
            changed := true;
          end;
      72: begin; { Pfeil up }
            inp := #255;
            changed := true;
            if not ((Zeile = 1) and (Spalte = 0)) then
              dec(Zeile);
            if Zeile = 0 then begin;
              dec(Spalte);
              Zeile := 12;
            end;
          end;
      73: begin; { Page UP }
            if Start_fndisp >= 12 then
              dec(Start_fndisp,12)
            else begin;
              Start_fndisp := 0;
              Zeile := 1;
            end;
            inp := #255;
            changed := true;
          end;
      81: begin; { Page Down }
            if ((Spalte+1)*12+Start_fndisp < count) and
            (Start_fndisp < 500) then
              inc(Start_fndisp,12)
            else
              Start_fndisp := count-11;
            inp := #255;
            changed := true;
          end;
      75: begin; { Pfeil links }
            inp := #255;
            changed := true;
            if Spalte = 0 then begin;
              if Start_fndisp >= 12 then dec(Start_fndisp,12);
            end else begin;
              if Spalte > 0 then dec(Spalte);
            end;
          end;
      77: begin; { Pfeil rechts }
            inp := #255;
            changed := true;
            if Spalte = 4 then begin;
              if ((Spalte+1)*12+Start_fndisp < count) and
              (Start_fndisp < 500) then inc(Start_fndisp,12);
            end else begin;
            if (Spalte < 4) and
              (Zeile+(Spalte+1)*12+Start_fndisp < count) then
                inc(Spalte);
            end;
          end;
      79: begin; { End }
            inp := #255;
            changed := true;
            Spalte := (count-Start_fndisp-12) div 12;
            Zeile := (count-Start_fndisp) - Spalte*12 -1;
          end;
      80: begin; { Pfeil down }
            inp := #255;
            changed := true;
            if ((Zeile = 12) and (Spalte = 4)) then begin;
              if (Start_fndisp+Zeile+Spalte*12 < count-1) then begin;
                inc(Start_fndisp,1);
              end;
            end else begin;
              if (Start_fndisp+Zeile+Spalte*12 < count-1) then
                inc(Zeile);
             end;
            if Zeile > 12 then begin;
              inc(Spalte);
              Zeile := 1;
            end;
          end;
      82 : begin;
            changed := true;
             save_screen;
             textcolor(black);
             rahmen(2,16,9,45,5);
             writexy(20,10,' Dateinamen eingeben ('+mtext+')');
             writexy(20,12,'Name: ');
             readln(retval);
             if retval = '' then retval := 'xxxx';
             restore_screen;
           end;
     end;
  until (inp = #13) or (inp = #27) or (inp = #32)
     or (inp = #82);
  restore_screen;
  textbackground(black);
  textcolor(7);
  select_datei := retval;
end;

function wrhexb(b : byte) : string;
const hexcar : array[0..15] of char =
 ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
begin;
  wrhexb := hexcar[(b shr 4)] + hexcar[(b AND $0F)];
end;

function wrhexw(w : word) : string;
begin;
  wrhexw := '$'+wrhexb(hi(w))+wrhexb(lo(w));
end;

procedure cursor_Off; assembler;
asm
  xor ax,ax
  mov ah,01h
  mov cx,2020h
  int 10h
end;

procedure cursor_on; assembler;
asm
 mov ah,01h
 mov cx,0607h
 int 10h
end;



begin;
end.