home *** CD-ROM | disk | FTP | other *** search
- unit graf;
-
- interface
-
-
- uses graph,crt,dos,generic,graf3;
-
-
-
- type imgrec=record
- p:pointer;
- size:longint;
- end;
-
- pointarray=array[1..10] of pointtype;
-
- poly=record
- pt:pointarray;
- size:integer;
- end;
-
-
-
-
-
- { NOTE: 1. all coords for routines are in video device independant
- graf coords (0-1000 by 0-1000).
- 2. all areas are given by coords of UL and LR corners.
- 3. all drawing routines are graphics, not text.
- 4. vid coords are video device dependant (ega coords, vga coords,
- etc).
- 5. on PCs, the mouse uses vid coords in graphics mode (in vidmodes
- up thru vga).
- 6. all message boxes, menus, etc. save and restore the screen behind
- them automatically.
- 7. routines with a doclick boolean will make a click sound when a
- mouse button is pressed or released if doclick is true.
- 8. menus and message boxes use the global array m in the generic
- unit. }
-
-
-
-
-
- {############################## conversions ##############################}
-
- function y2vidy(y:integer):integer;
- { converts graf y to vid (ega, vga, etc) y }
- function x2vidx(x:integer):integer;
- { converts graf x to vid (ega, vga, etc) x }
- function mousey2y(y:integer):integer;
- { converts mouse (or vid) y to graf y. }
- function mousex2x(x:integer):integer;
- { converts mouse (or vid) x to graf x. }
-
-
-
-
-
- {################################# mouse ##################################}
-
- procedure select(var x,y:integer; donobutton:boolean);
- { shows mouse, waits for mouse click, hides mouse, returns x,y
- coords of mouse click in graf coords. Automactically draws mouse
- cursor for 800x600, 1024x768, and 1280x1024 vidmodes. }
- function gmx:integer;
- { returns current mouse x in graf coords. works for hi res vid modes too. }
- function gmy:integer;
- { returns current mouse y in graf coords. works for hi res vid modes too. }
- procedure startmouse; { turns on mouse in hi res vid modes. }
- procedure movemouse; { moves mouse in hi res vid modes. }
- procedure stopmouse; { hides mouse in hi res vid modes. }
-
-
-
-
-
-
-
- {############################ clearscreens ################################}
-
- procedure clsstars; { clears screen to black with stars }
- procedure clsgraf(color,fillstyle:integer);
- { clears screen in color,fillstyle }
-
-
-
-
-
-
-
- {################################# fills ###################################}
-
- procedure fillstars(x1,y1,x2,y2:integer);
- { fills an area with stars on black }
- procedure fillgraf(x1,y1,x2,y2,color,fillstyle:integer);
- { fills area in color,fillstyle }
-
-
-
-
-
-
-
- {################################ drawing #################################}
-
- procedure grafpix(x,y,color:integer);
- { sets pixel @ x,y (graf coords) to color }
- function getpix(x,y:integer):integer;
- { returns color of pixel @ x,y (graf cooords) }
- procedure grafline(x1,y1,x2,y2,color,style,thickness:integer);
- { draws line from x1,y1 to x2,y2 in color,style,thickness. line
- style and thickness are as in graph unit.}
- procedure grafpie(x,y,sa,ea,r,fore,bak,style:integer);
- { draws filled pieslice at x,y from sa to ea degrees, radius r, in
- colors fore,bak. style is fillstyle. borders are solid thin
- lines. }
- procedure grafcircle(x,y,r,fore,style,thickness:integer);
- { draw a circle of style,thickness at x,y with radius r. fore is
- circle color. }
- procedure grafbar(x1,y1,x2,y2,depth,fore,bak,style,thickness,fill:integer; top:boolean);
- { draws a 3d wireframe bar with style,thickness in colors fore,bak
- with fillpattern fill on the face. x1,y1,x2,y2 is face. depth is
- depth of bar. if top=true then draws top of bar. }
- procedure grafbox(x1,y1,x2,y2,fore,bak,style,thickness,fill:integer);
- { draws filled rectangle in area x1,y1,x2,y2. fore is border color.
- bak is fill color. style is border linestyle. thickness is border
- thickness. fill is fillstyle. }
- procedure grafquad(x1,y1,x2,y2,x3,y3,x4,y4,fore,bak,style,thickness,fill:longint; doedge:boolean);
- { draws a filled quadrangle. x1 thru y4 are coords of 4 corners.
- assumes edges from corners 1 to 2 to 3 to 4 to 1. fore, style,
- and thickness are border color, linestyle, and line thickness.
- bak and fill are background color and fillstyle. }
- procedure grafcube(x1,y1,x2,y2,depth,fore,bak,style,thickness,fill:integer);
- { draws a 3d solid box. x1 thru y2 are face coords. depth is depth
- of box. fore, style, and thicknes are edge color, linestyle and
- line thickness. bak and fill are fill color and style. }
- procedure grafrect(x1,y1,x2,y2,fore,style,thickness:integer);
- { draws unfilled rectangle in area x1,y1,x2,y2. fore is border
- color. style is border linestyle. thickness is border
- thickness. }
- procedure graftri(x1,y1,x2,y2,x3,y3,fore,bak,style,thickness,fill:integer);
- { draws a filled triangle. x1 thru y3 are coords of 3 corners.
- assumes edges from corners 1 to 2 to 3 to 1. fore, style,
- and thickness are border color, linestyle, and line thickness.
- bak and fill are fill color and fillstyle. }
- procedure panel(x1,y1,x2,y2,width,color:integer; pressed:boolean);
- { draws a 3d beveled panel. x1 thru y2 are panel area. width is
- bevel width. color is panel color. if shadow=true, draws shadow
- for the panel. if pressed=true, draws panel pressed in instead of
- sticking out. }
- procedure grafpoly(p:poly; fore,bak,style,thickness,fill:longint; doedge:boolean);
- { draws a filled polygon. poly is list of corners.
- assumes edges from one corner to the next, and from last corner
- to the 1st. fore, style, and thickness are border color,
- linestyle, and line thickness. bak and fill are background
- color and fillstyle. }
-
-
-
-
-
-
-
- {################################### text #################################}
-
- procedure saygraf(x,y,color,font,size,orientation,hjustify,vjustify,multx,
- divx,multy,divy:integer; s:string);
- { draws text at x,y. color,font,size,orientation (horiz/vert), and
- text justifications, are as in graph unit. mults and divs control
- graph unit`s setusercharsize. set mults and divs to 1 for no
- setusercharsize. }
- procedure saygraf3d(x,y,color,font,size,orientation,hjustify,vjustify,multx,
- divx,multy,divy:integer; s:string);
- { as saygraf, does 3d text. }
-
- function textwidthof(s:string; font,size,orientation,hjustify,vjustify,multx,
- divx,multy,divy:integer):integer;
- { returns the width of a string in graf coords. all parameters are as in
- saygraf. }
-
-
-
-
-
- {################################ buttons ################################}
-
- procedure btn(x,y,fore,bak:integer; s:string; pressed:boolean);
- { draws a button at x,y in colors fore,bak with 3d text s on it.
- if pressed=true, draws button pressed in instead of sticking out.
- button is 150 wide and 50 tall. }
- procedure btn2(x,y,fore,bak:integer; s:string; pressed:boolean);
- { draws a button at x,y in colors fore,bak with 3d text s on it.
- if pressed=true, draws button pressed in instead of sticking out.
- button is 100 wide and 50 tall. }
- procedure btn3(x,y,fore,bak:integer; s:string; pressed:boolean);
- { draws a button at x,y in colors fore,bak with 3d text s on it.
- if pressed=true, draws button pressed in instead of sticking out.
- button is 50 wide and 50 tall. }
- function isbtn(x,y,bx,by:integer):boolean;
- { returns true if x,y lies within the area of a btn at bx,by. }
- function isbtn2(x,y,bx,by:integer):boolean;
- { returns true if x,y lies within the area of a btn2 at bx,by. }
- function isbtn3(x,y,bx,by:integer):boolean;
- { returns true if x,y lies within the area of a btn3 at bx,by. }
-
-
- procedure pressbtn(x,y,fore,bak:integer; s:string; doclick:boolean);
- { draws a button pressed in, waits for no mouse button, draws button
- unpressed. does click sounds if doclick is true. }
-
- procedure pressbtn2(x,y,fore,bak:integer; s:string; doclick:boolean);
- { as pressbtn but for btn2's }
- procedure pressbtn3(x,y,fore,bak:integer; s:string; doclick:boolean);
- { as pressbtn but for btn3's }
-
-
- {############################### gets & puts ###############################}
-
- function grafget(x1,y1,x2,y2:integer; var p:pointer):longint;
- { copies area of screen to memory. x1 thru y2 are area cooords.
- allocates memory for image. copies image to memory. sets p to point
- to image in memory. returns memory allocated (size of image). }
- procedure grafput(x1,y1,put:integer; p:pointer);
- { copies image from memory to screen at x1,y1. put is a put method as in
- graph unit putimage. p points to image in memory. }
- procedure grafnuke(var p:pointer; size:longint);
- { deallocates an image in memory. p points to image. size is size of
- image. }
- procedure grafsave(s:string; p:pointer; size:longint);
- { saves image pointed to by p in file with name s. size is size of image }
- procedure grafload(s:string; var p:pointer; var size:longint);
- { loads image in file S into memory. alloactes memory for image. sets P
- to point to image. sets SIZE to size of image. }
- procedure getarea(x1,y1,x2,y2:integer);
- { allocates memory and saves area of screen to memory. must putarea before
- you getarea again. }
- procedure putarea(x1,y1,x2,y2:integer);
- { restores area of screen from memory and deallocates memory. must getarea
- first. x1,y1,x2,y2 are same as in getarea. }
-
-
-
- {################################ viewports ##############################}
-
- procedure grafport(x1,y1,x2,y2:integer; clip:boolean);
- { sets viewport to an area. if clip=true, viweport will clip
- things drawn in it. }
- procedure grafportoff;
- { sets viewport to full screen }
-
-
-
-
-
-
- {############################## interface parts ###########################}
-
- function popupmenu(x,y,i,fore,bak:integer; doclick:boolean):integer;
- { x=-1 centers left to right. y=-1 centers top to bottom. does menu at
- x,y in colors fore,bak. uses global array m from generic unit. i is # of
- items in menu. m[0] is menu title. m[1] thru m[i] are menu options. }
- function getorientation(s:string; fore,bak:integer; doclick:boolean):integer;
- { does a menu in colors fore,bak to get a text orientation from the user.
- s is menu prompt. }
- function gettextsize(s:string; font,fore,bak,size:integer):integer;
- { does a dialog box in colors fore,bak to get a text size from the user.
- s is prompt. font is the font to get the size of. size is text size that
- the dialog box starts at. }
- function getnum(s:string; fore,bak:integer; doclick:boolean):integer;
- { does a popup numeric keypad in colors fore,bak to get an integer from
- the user. s is prompt. }
- function getlnum(s:string; fore,bak:integer; doclick:boolean):longint;
- { does a popup numeric keypad in colors fore,bak to get an longint from
- the user. s is prompt. }
- function getfont(s:string; fore,bak:integer):integer;
- { does a menu in colors fore,bak to get a font from the user. s is prompt.}
- function getfillstyle(s:string; fore,bak,fillcolor:integer):integer;
- { does a menu in colors fore,bak,fillcolor to get a fillstyle from the user.
- s is prompt. }
- function getcolor(x,y,fore,bak:integer; s:string; doclick:boolean):integer;
- { does a menu at x,y in colors fore,bak to get a color from the user. s is
- prompt. x=-1 for center horiz. y=-1 for center vert. returns -1 for
- cancel. }
- procedure grafmsg(x,y,i,fore,bak:integer; doclick,dopause,doprint:boolean);
- { does a message box at x,y in colors fore,bak. x=-1 for center horiz.
- y=-1 for center vert. uses global array m. i is # of lines in message.
- If dopause is true, adds "Press P to print or mouse button to
- continue..." to message and waits for mouse button before disappearing.
- pressing P prints message to PRN. If dopause is false, message doesnt
- disappear, and control returns immediately to caller. If doprint is
- true, message is printed to PRN instead of being displayed. }
- function getstring(s,s2:string; forecolor,bakcolor,curfore,curbak:integer):string;
- { does a string edit box in colors forecolor,bakcolor to get a string
- from the user. s is string that initially appears for editing. s2 is
- prompt. curfore,curbak are cursor colors. }
- function getfile(s,filespec:string; fore,bak:integer; doclick:boolean):string;
- { does a menu (file listing) in colors fore,bak to get a filename from the
- user. s is prompt. filespec is the search filespec for file listing. }
- function getdir2(s,filespec:string; fore,bak:integer; doclick:boolean):string;
- { does a menu (dir listing) in colors fore,bak to get a directory name
- from the user. s is prompt. filespec is the search filespec for dir
- listing. }
- function getdrive(s:string; fore,bak:integer; doclick:boolean):char;
- { does a menu (drive listing) in colors fore,bak to get a drive letter
- from the user. s is prompt. }
-
-
-
-
-
- implementation
-
-
-
-