Skip to content

Instantly share code, notes, and snippets.

@ssg

ssg/dv.pas

Created August 17, 2018 18:50
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save ssg/12fe77c65d7232b7491fec1dcc4de27d to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save ssg/12fe77c65d7232b7491fec1dcc4de27d to your computer and use it in GitHub Desktop.
Download ZIP
Initial draft of my first attempt at developing a object-oriented GUI library, DreamView, back in 93.
Raw
dv.pas
{
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.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment