{
Name:DreamView
Date:11th May 93

Update Info:
12th May 93 - Added Insert and Delete methods to DView
12th May 93 - Added REMs
12th May 93 - Recovered some bugs...
12th May 93 - Added DInputLine object
12th May 93 - Added IconButton (file based) object
13th May 93 - Embedded LoadIcon and MyPutImage to source
13th May 93 - Recovered some bugs...(About 216)
13th May 93 - 1:50 Successful compilation...
13th May 93 - 3:02 Successful compilation of DListViewer...
}

unit DV;   {DreamView}

interface

uses graph,
     objects,  {TRect,TPoint etc etc}
     drivers,  {TEvent}
     ssgmouse,
     ssgtools, {Exists function}
     bgilink;  {Built-in BGI libraries}

const

Version='1.1';
Cursor:char=#219;

type

PIconBuffer  = ^TIconBuffer;
TIconBuffer  = Array[1..512] of Byte;

hdr=string[80];
BitMapType=array[0..1023] of byte;

PView=^DView;         {Base Object}

PStrRec=^TStringCollection;

PVRec=^DVRec;         {DreamView Child Object Structure}
DVRec=record
  ChildView:PView;
  Next:PVRec;
end;

DView=object
  Origin    :TPoint;
  Bounds    :TRect;
  View      :TRect;
  Event     :TEvent;
  Header    :hdr;
  TW,TH     :word;
  Layers    :PVRec;
  LayerStart:PVRec;

  constructor Init;
  procedure   Insert(p:PView);virtual;       {Insert View to View}
  procedure   Delete(p:PView);virtual;       {Delete View from View}
  procedure   Draw;virtual;
  function    MouseInView:boolean;virtual;
  procedure   HandleEvent(var T:TEvent);virtual;
  destructor Done;

end;

DWindow=object(DView)       {Base Window Object}
  Buffer  :Pointer;
  BufSize :Word;
  Buffered:boolean;

  constructor Init(ABounds:TRect;AHeader:hdr;ABuffered:boolean);
  procedure   Draw;virtual;
  procedure   HandleEvent(var T:TEvent);virtual;
  destructor  Done;
end;

DListWindow=object(DWindow)
  Descriptor  :hdr;
  Data        :PStrRec;
  HighLight   :integer;
  Top         :integer;
  VisibleItems:integer;

  constructor Init(ABounds:TRect;AHeader:hdr;ADescriptor:hdr;AData:PStrRec;AItems:integer);
  procedure   Draw;virtual;
  procedure   HandleEvent(var T:TEvent);virtual;
  procedure   RefreshList;virtual;
end;

DButton=object(DView)        {Header Init}
  Pressed:Boolean;

  constructor Init(APoint:TPoint;AHeader:hdr);
  procedure   Draw;virtual;
  procedure   HandleEvent(var T:TEvent);virtual;
end;

DIconButton=object(DView)
  BitMap  :TIconBuffer;
  Pressed :Boolean;

  constructor Init(s:string;APoint:TPoint);
  procedure   Draw;virtual;
  procedure   HandleEvent(var T:TEvent);virtual;
end;

DInputLine=object(DView)
  Buffer :String;
  MaxLen :Byte;
  CurPos :Integer;

  constructor Init(ABounds:TRect;AMaxLen:Byte);
  procedure   Draw;virtual;
  procedure   DelChar(x:integer);virtual;
  procedure   HandleEvent(var T:TEvent);virtual;
end;

var
DEvent:TEvent;
DVTH,DVTW:integer;

procedure DVInit;
procedure DVDone;
procedure DVError(s:string);
Procedure MyPutImage(X,Y : Integer;Bitmap : TIconBuffer);
Function LoadIcon(FName : String; Var ABuffer : TIconBuffer) : Boolean;

implementation

Procedure MyPutImage(X,Y : Integer;ABitmap : TIconBuffer);
 Var
  k,t : Integer;
  A   : Byte;
  XX  : Integer;
  YY  : Integer;

    Begin
      XX:=1;YY:=Y;
      Repeat
       For t:=1 to 16 do
        Begin
         A:=ABitMap[XX];Inc(XX);
          if (A and $F0)>0 then PutPixel(X+t*2,YY,A div 16);
          if (A and $0F)>0 then PutPixel(X+t*2+1,YY,A mod 16);
          if XX>512 then Exit;
        End; { For t }
       Inc(YY);
      Until XX=512;
    End;

Function LoadIcon(FName : String; Var ABuffer : TIconBuffer) : Boolean;
 Var
  F       : File;
  Buffer  : PIconBuffer;
  AA,BB   : Integer;

    Begin
     {****************************************
      ICON Format
       ilk 126 header
       638 byte a pixel color
       1 line of 16 Byte Hi(Byte) and Lo(Byte) 1 pixel
       638 to 126 decrements line (16 byte)  DEC(16);
      ***************************************}
     LoadIcon:=False;
     {$I-}
      Assign(F,FName);
      Reset(F,1);
      If IOResult<>0 then Exit;
     {$I+}
     LoadIcon:=True;
     GetMem(Buffer,SizeOf(Buffer));
      AA:=638;BB:=1;
      Repeat
       Dec(AA,16);
       Seek(F,AA);
       BlockRead(F,Buffer^[BB],16);
       Inc(BB,16);
      Until AA=126;
     ABuffer:=Buffer^;
     FreeMem(Buffer,SizeOf(Buffer));
    End;

procedure DVError(s:string);
begin
  closegraph;
  writeln(s);
  halt;
end;

procedure DVInit;
var gd,gm:integer;
begin
   gd:=vga;
   gm:=vgahi;
   linkdrivers;
   initgraph(gd,gm,'');
   ShowMouse;
   DVTW:=textwidth('X');
   DVTH:=textheight('X');
   outtextxy(0,getmaxy-8,'DreamView '+Version+' - Programmed by Sedat Kapanoglu');
end;

procedure DVDone;
begin
  closegraph;
end;

procedure ShadowBox(R:TRect;shadow:boolean);
var c1,c2:integer;
begin
  if shadow then begin
     c1:=white;c2:=darkgray;
  end else begin
     c1:=darkgray;c2:=white;
  end;
  with r do begin
    moveto(b.x,a.y);
    setcolor(c1);
    lineto(a.x,a.y);
    lineto(a.x,b.y);
    setcolor(c2);
    lineto(b.x,b.y);
    lineto(b.x,a.y);
  end;
end;

constructor DView.Init;
var oldv:ViewPortType;
begin
  new(Layers);
  LayerStart:=Layers;
  GetViewSettings(OLDV);
  with Origin do begin
    X:=oldv.x1;
    y:=oldv.x2;
  end;
end;

function DView.MouseInView:boolean;
begin
  GetMouse(Event);
  if Bounds.Contains(Event.Where) then
    MouseInView:=true else MouseInView:=false;
end;

procedure DView.HandleEvent;
begin
end;

procedure DView.Insert(p:PView);
var newrec:PVRec;
begin
  new(newrec);
  NewRec^.ChildView:=p;
  NewRec^.Next:=LayerStart;
  LayerStart:=NewRec;
end;

procedure DView.Delete(p:PView);
var t:PVRec;
    b:PVRec;
begin
  t:=LayerStart;
  while t^.ChildView<>p do begin
    b:=t;
    t:=t^.Next;
  end;
  t^.ChildView^.Done;
  b^.Next:=t^.Next;
end;

procedure DView.Draw;
begin
end;

destructor DView.Done;
begin
  SetFillStyle(solidfill,GetBkColor);
  With Bounds do Bar(a.x,a.y,b.x,b.y);
end;

constructor DWindow.Init(ABounds:TRect;AHeader:hdr;ABuffered:boolean);
begin
  DView.Init;
  Buffered:=ABuffered;
  Bounds:=ABounds;
  Header:=AHeader;
  with Bounds do begin
    if Buffered then begin
     BufSize:=ImageSize(a.x,a.y,b.x,b.y);
     if (BufSize>65535) or (BufSize>MaxAvail) then DVError('Not enough memory');
     GetMem(Buffer,BufSize);
     GetImage(a.x,a.y,b.x,b.y,Buffer^);
    end;
    View.Assign(a.x+2,a.y+18,b.x-2,b.y-2);
  end;
end;

procedure DWindow.HandleEvent(var T:TEvent);
var p:PVRec;
begin
  if MouseInView then
  p:=LayerStart;
  while p^.ChildView<>NIL do begin
    p^.ChildView^.HandleEvent(Event);
    p:=p^.Next;
  end;
end;

procedure DWindow.Draw;
var tx,ty,l:integer;
   oldv:ViewPortType;
   p:PVRec;
begin
  HideMouse;
  setfillstyle(solidfill,lightgray);
  with Bounds do bar(a.x,a.y,b.x,b.y);

  setfillstyle(solidfill,black);
  with View do bar(a.x,a.y,b.x,b.y);

  ShadowBox(Bounds,true);
  ShadowBox(View,false);

  l:=dvtw*length(header);

  tx:=((Bounds.b.x-Bounds.a.x-l) div 2)+Bounds.a.x;
  ty:=Bounds.a.x+5;

  setcolor(black);
  outtextxy(tx,ty,header);
  ShowMouse;
  GetViewSettings(Oldv);
  with View do SetViewPort(a.x+1,a.y+1,b.x-1,b.y-1,true);
  p:=LayerStart;
  while p^.ChildView<>NIL do begin
    p^.ChildView^.Draw;
    p:=p^.Next;
  end;
  with Oldv do SetViewPort(x1,y1,x2,y2,clip);
end;

destructor DWindow.Done;
var p:PVRec;
begin
  HideMouse;
  p:=LayerStart;
  while p^.ChildView<>NIL do begin
    p^.ChildView^.Done;
    p:=p^.Next;
  end;
  if Buffered then begin
    with Bounds do PutImage(a.x,a.y,buffer^,CopyPut);
    freemem(Buffer,BufSize);
  end else begin
    setfillstyle(solidfill,black);
    with Bounds do bar(a.x,a.y,b.x,b.y);
  end;
  ShowMouse;
end;

constructor DButton.Init(APoint:TPoint;AHeader:hdr);
begin
  DView.Init;
  with APoint do
    Bounds.Assign(X,Y,X+(2+Length(AHeader))*DVTW,Y+DVTH*3);
  Header:=AHeader;
end;

procedure DButton.HandleEvent(var T:TEvent);
begin
  if MouseInView then begin
    GetMouse(T);
    if T.Buttons>0 then Pressed:=true else Pressed:=false;
  end;
end;

procedure DButton.Draw;
begin
  HideMouse;
  setfillstyle(solidfill,lightgray);
  with Bounds do bar(a.x,a.y,b.x,b.y);
  ShadowBox(Bounds,not Pressed);
  setcolor(0);
  with Bounds do outtextxy(a.x+dvtw,a.y+(b.y-a.y) div 2,header);
  ShowMouse;
end;

constructor DInputLine.Init(ABounds:TRect;AMaxLen:Byte);
begin
  DView.Init;
  Bounds:=ABounds;
  Bounds.B.Y:=Bounds.A.Y+th*3;
  MaxLen:=AMaxLen;
  if MaxLen=0 then MaxLen:=((Bounds.B.Y-Bounds.A.Y) div dvtw)-2;
  with Bounds do View.Assign(a.x+dvtw,a.y+dvth,b.x-dvtw,b.y-dvth);
  Buffer:='';
  CurPos:=0;
end;

procedure DInputLine.Draw;
var oldv:ViewPortType;
begin
  HideMouse;
  SetFillStyle(SolidFill,LightGray);
  with Bounds do bar(a.x,a.y,b.x,b.y);
  ShadowBox(Bounds,false);
  GetViewSettings(oldv);
  with View do SetViewPort(a.x,a.y,b.x,b.y,true);
  with Bounds do OutTextXY(0,0,Buffer+#219);
  with Oldv do SetViewPort(x1,y1,x2,y2,clip);
end;

procedure DInputLine.DelChar(x:integer);
begin
  SetFillStyle(SolidFill,GetBkColor);
  Bar(X,0,X+DVTW,DVTH);
end;

procedure DInputLine.HandleEvent(var T:TEvent);
var oldv:ViewPortType;
begin
  GetKeyEvent(T);

  if T.What=evNothing then exit;

  GetViewSettings(Oldv);

  with View do SetViewPort(a.x,a.y,b.x,b.y,true);
  if Length(Buffer)<MaxLen then begin
     if T.CharCode>#31 then begin
        Buffer:=Buffer+T.CharCode;
        DelChar(CurPos*DVTW);
        OutTextXY(CurPos*DVTW,0,T.CharCode);
        inc(CurPos,DVTW);
        OutTextXY(CurPos*DVTW,0,Cursor);
        end else
        case T.CharCode of
          #13:Buffer:=Buffer+#13;
          #8:if Length(Buffer)>0 then begin
                DelChar(CurPos*DVTW);
                System.Delete(Buffer,Length(Buffer),1);
                Dec(CurPos,DVTW);
                OutTextXY(CurPos*DVTW,0,T.CharCode);
             end;
     end;
   end;
end;

constructor DIconButton.Init(s:string;APoint:TPoint);
begin
  DView.Init;
  if not LoadIcon(s,BitMap) then DVError('Unable to init icons');
  Pressed:=false;
  with APoint do Bounds.Assign(x,y,x+32,y+32);
end;

procedure DIconButton.Draw;
begin
  MyPutImage(Bounds.a.x,Bounds.a.y,BitMap);
end;

procedure DIconButton.HandleEvent;
begin
  if MouseInView then begin
    GetMouse(Event);
    if Event.Buttons>0 then Pressed:=true else Pressed:=false;
  end;
end;

constructor DListWindow.Init(ABounds:TRect;AHeader:hdr;ADescriptor:hdr;AData:PStrRec;AItems:integer);
begin
  DWindow.Init(ABounds,AHeader,true);
  Descriptor:=ADescriptor;
  Data:=AData;
  HighLight:=1;
  Top:=1;
  VisibleItems:=AItems;
end;

procedure DListWindow.Draw;
var oldv:ViewPortType;
begin
  DWindow.Draw;
  HideMouse;
  GetViewSettings(oldv);
  with View do SetViewPort(a.x,a.y,b.x,b.y,true);
  RefreshList;
  with oldv do SetViewPort(x1,y1,x2,y2,clip);
  ShowMouse;
end;

{H=72,P=80 ,K=75 ,M=77 }

procedure DListWindow.RefreshList;
var p,LastItem:integer;
    pstr:^string;
begin
  if Data^.Count-Top>VisibleItems then LastItem:=VisibleItems else LastItem:=Data^.Count-Top;
  for p:=Top to Top+LastItem do begin
             if p=HighLight then begin
              setcolor(Black);
              setbkcolor(LightGreen);
             end else begin
               setcolor(LightGreen);
               setbkcolor(Black);
             end;
             pstr:=Data^.Items^[p];
             outtextxy(0,(p-1)*DVTH,pstr^); {<<<<<<***************}
           end;
end;

procedure DListWindow.HandleEvent(var T:TEvent);
var p:integer;

procedure PrepareScroll;
var pll:^string;
begin
  SetWriteMode(XorPut);
  SetColor(LightGreen);
  SetBkColor(LightGreen);
  pll:=Data^.Items^[HighLight];
  OutTextXY(0,(Highlight-Top)*dvth,pll^);
end;

begin
  DWindow.HandleEvent(T);
  GetKeyEvent(T);
  case T.ScanCode of
    72:begin
         PrepareScroll;
         dec(HighLight);
         if HighLight<Top then begin
           dec(Top);
           RefreshList;
         end;
       end;
    80:begin
         PrepareScroll;
         Inc(HighLight);
         if HighLight>Top+VisibleItems then begin
            inc(Top);
            RefreshList;
         end;
       end;
  end;
end;

end.