home *** CD-ROM | disk | FTP | other *** search
- {
-
- ╔══════════════════╗
- ║ Pure Power ║
- ║ VGA Graphical ║
- ║ User Interface ║
- ║ Rev. 1.30 ║
- ╚══════════════════╝
-
- }
-
- {$F+} {$O-} {$A+} {$G+}
- {$V-} {$B-} {$X-} {$N+} {$E+}
-
- {$I FINAL.PAS}
-
- {$IFDEF FINAL}
- {$I-} {$R-}
- {$D-} {$L-} {$S-}
- {$ENDIF}
-
- Unit PGUI;
-
- { ╔════════════════════════════════════════════════════════════════════════╗}
- { ║ ║}
- { ║ Pure Power VGA Object Orientated Graphical User Interface ║}
- { ║ ║}
- { ║ This unit controls Super VGA modes and mouse. The unit requires ║}
- { ║ Turbo Pascal Version 6 and Genius Mouse Driver Version 9.06 or later. ║}
- { ║ ║}
- { ║ Written by : Michael Gallias ║}
- { ║ Last Update : 16 December 1992 ║}
- { ║ ║}
- { ╚════════════════════════════════════════════════════════════════════════╝}
-
- Interface
-
- Uses Graph,CRT,DOS,Dirs,Strings,KeyDef,Icons,PGUIMDef,PGUIMSE,PGUIBMSE;
-
- Type {From MouseDef}
-
- BGIMouseShapePtr = ^BGIMouseShape;
-
- BGIMouseShape = Record
- Picture :Pointer;
- Mask :Pointer;
- XHot :Integer;
- YHot :Integer;
- End;
-
- STDMouseShapePtr = ^STDMouseShape;
-
- STDMouseShape = Record
- Picture :Array[1..32] of Byte;
- Mask :Array[1..32] of Byte;
- XHot :Integer;
- YHot :Integer;
- End;
-
-
- Type
-
- HideOrShow = (Hidden,Visible);
-
- OutLineSave = Record {Screen Save when dragging}
- Size1, {graphics box}
- Size2 :Word;
- Data :Array[1..4] Of Pointer;
- End;
-
- ButtonListPtr = ^ButtonList; {Buttons to click on}
-
- ButtonList = Record
- X1,Y1,X2,Y2:Word; {Screen Co-ordinate}
- Thickness :Word; {How thick it is}
- Background :Word; {Background it lies on}
- Special :Boolean; {Keyboard Keys}
- Key :Char; {Keyboard Character}
- Picture :Pointer; {If it has a Picture}
- Name :String[11]; {If it has a Name}
- Number :Word; {It's own Unique Number}
- Next :ButtonListPtr; {Next Button in Linked List}
- End;
-
- ButtonChain = Object
- Total :Word;
-
- Procedure Init;
- Function Position :Word;
- Function Number :Word;
- Procedure GotoPosition (Here:Word);
- Procedure GotoNumber (ButtonNumber:Word);
-
- Procedure DrawUp (ButtonNumber:Word);
- Procedure DrawDown (ButtonNumber:Word);
-
- Procedure Add (X1, Y1, X2, Y2:Word;
- Thickness, Background:Word;
- Picture:Pointer; Name:String;
- Special:Boolean; Key:Char);
-
-
- Procedure Move (X, Y:Integer;
- ButtonNumber:Word);
-
- Procedure MoveAll (X, Y:Integer);
-
- Procedure Create (X1, Y1, X2, Y2:Word;
- Thickness, Background:Word;
- Picture:Pointer; Name:String;
- Special:Boolean; Key:Char);
-
- Procedure WaitForClick (Var X, Y:Word;Var MouseButtons:Byte;
- Var Held,Doubled,Special:Boolean;
- Var Key:Char);
-
- Procedure KillAll;
- Procedure KillFrom;
- Procedure KillOne;
-
- Private
-
- Root :Pointer;
- Buttons :ButtonListPtr;
-
- Function NewButtonNumber:Word;
-
- End;
-
- MouseFunctions = Object
- Init :MouseProc_Init;
- Show :MouseProc_Show;
- Hide :MouseProc_Hide;
- SetSpeed :MouseProc_SetSpeed;
- SetXY :MouseProc_SetXY;
- SetBounds :MouseProc_SetBounds;
- SetShape :MouseProc_SetShape;
- GetPresses :MouseProc_GetPresses;
- GetXY :MouseProc_GetXY;
- GetStatus :MouseProc_GetStatus;
- GetClick :MouseProc_GetClick;
-
- Function ComputerSpeed:LongInt;
- Function Active :Boolean;
-
- End;
-
- GraphicWindow = Object
- HdrButtonNum, {Button Numbers}
-
- VSlideButtonNum, {The Little Button}
- VSlideBarButtonNum, {The Bar as a Button}
- VSlideButtonUpNum,
- VSlideButtonDownNum,
-
- HSlideButtonNum,
- HSlideBarButtonNum,
- HSlideButtonLeftNum,
- HSlideButtonRightNum,
-
- CloseButtonNum :Word;
- Buttons :ButtonChain; {The window's buttons}
- VSlideBarCurPos:LongInt;
- HSlideBarCurPos:LongInt;
-
- Status :HideOrShow; {Visible or Not}
- KeepBack :Boolean; {Background Saved or Not}
- Thickness :Byte; {Box Outline}
- Pattern, {Pascal Pattern Number}
- FillColor, {Pattern Colour}
- HdrPattern, {Heading Background Pattern}
- HdrFillColor, {Heading Pattern Colour}
- HdrFrg, {Header Text Forg}
- BoxFrg, {Box Colour}
- BoxBck, {Box Backgound OutLine}
- Size, {Memory Required for Save}
- X1,Y1, {Location on Screen}
- X2,Y2 :Word;
- Header :String; {Heading Text}
- HdrFmt :TextFormats; {Heading Format}
- VSlideBarPat,
- VSlideBarClr,
- VSlideButtonPos:Word;
-
- VSlideBarMaxPos:LongInt;
-
- HSlideBarPat,
- HSlideBarClr,
- HSlideButtonPos:Word;
-
- HSlideBarMaxPos:LongInt;
-
-
- Procedure Open (NX1,NY1,NX2,NY2,Forg,Back,
- Thick,Patrn,PatClr:Word;
- KeepBackground:Boolean);
- Procedure DisplayHeading;
- Procedure NewHeading(NewHead:String;NewMode:TextFormats;
- Forg,Patrn,PatClr:Word);
- Procedure Hide;
- Procedure Show;
- Procedure NewPosition(NewX,NewY:Word);
- Procedure Drag;
- Procedure DragVertSlideButton;
- Procedure DragHorzSlideButton;
- Procedure NewSize (NX1,NY1,NX2,NY2:Word);
- Procedure CloseIcon (Active:Boolean);
- Procedure HeadingIcon(Active:Boolean);
-
- Procedure VertSlideIcon (Active:Boolean);
- Procedure DrawVertSlideBar;
- Procedure VertSlideBar (CurPos,MaxPos:LongInt;
- Patrn,PatClr:Word);
- Procedure UpdateVertSlideBar (CurPos:LongInt);
-
- Procedure HorzSlideIcon (Active:Boolean);
- Procedure DrawHorzSlideBar;
- Procedure HorzSlideBar (CurPos,MaxPos:LongInt;
- Patrn,PatClr:Word);
- Procedure UpdateHorzSlideBar (CurPos:LongInt);
-
- Procedure CloseButtonPos (Var BX1,BY1,BX2,BY2:Word);
- Procedure HeadingPos (Var BX1,BY1,BX2,BY2:Word);
- Procedure VertSlideBarPos (Var BX1,BY1,BX2,BY2:Word);
- Procedure VertSlideButtonPos (Var BX1,BY1,BX2,BY2:Word);
- Procedure VertSlideButtonUpPos (Var BX1,BY1,BX2,BY2:Word);
- Procedure VertSlideButtonDownPos (Var BX1,BY1,BX2,BY2:Word);
- Procedure HorzSlideBarPos (Var BX1,BY1,BX2,BY2:Word);
- Procedure HorzSlideButtonPos (Var BX1,BY1,BX2,BY2:Word);
- Procedure HorzSlideButtonLeftPos (Var BX1,BY1,BX2,BY2:Word);
- Procedure HorzSlideButtonRightPos(Var BX1,BY1,BX2,BY2:Word);
-
- Procedure Lock;
- Procedure UnLock;
- Procedure Close;
-
- Private
-
- Save :Pointer; {Background Save}
-
- Procedure SaveBackground;
- Procedure DrawWindow;
- Procedure DrawOutLine(NewX,NewY:Word;
- Var OutLine:OutLineSave);
- Procedure NoOutLine (Var OutLine:OutLineSave);
- End;
-
-
- Procedure DefaultError (Num:Byte);
-
- Procedure InstallBGIMouse(Shape:Pointer);
- Procedure UnInstallBGIMouse;
-
- Procedure InitVGA (VPath:String);
- Procedure StandardScreen (Title:String);
- Procedure Box (X1,Y1,X2,Y2:Word;C1,C2,Thick:Byte);
- Procedure ShadeText (X,Y:Word;T:String);
- Procedure GraphicSpace (X,Y,Spot:Word);
- Procedure TwirlyCursor (X,Y,Spot:Word;Frame:Byte);
- Procedure LineCursor (X,Y,Spot:Word;OnOff:Boolean);
- Procedure CommentWindow (X,Y:Word;Comment:String);
- Procedure EditString (X,Y:Word;MaxLets:Byte;Upper:Boolean;Var MainStr:String);
-
- Procedure ShowDirList (Var Dir:DirList;ShowMore:Byte;
- X,Y,Current,Start,HowMany:Word;
- FileColor,DirColor,CurrentColor:Byte;
- Var PgUp,PgDn:Boolean);
-
- Procedure DrawButtonUp (X1,Y1,X2,Y2,Thickness,Background:Word;
- Picture:Pointer;Name:String);
- Procedure DrawButtonDown (X1,Y1,X2,Y2,Thickness:Word;
- Picture:Pointer;Name:String);
- Procedure DrwButtonDown (X,Y,Len,Depth,Thickness:Word;
- Picture:Pointer;Name:String);
- Procedure DrwButtonUp (X,Y,Len,Depth,Thickness,Background:Word;
- Picture:Pointer;Name:String);
-
- Var
- Mouse :MouseFunctions;
- Error :Procedure(Num:Byte);
-
- IconCloseButton :Pointer;
- IconSlideButtonVert :Pointer;
- IconSlideButtonHorz :Pointer;
- IconSlideButtonUp :Pointer;
- IconSlideButtonDown :Pointer;
- IconSlideButtonLeft :Pointer;
- IconSlideButtonRight :Pointer;
-
- IconMousePoint :Pointer;
- IconMouseClock :Pointer;
- IconMouseNote :Pointer;
-
- IconBGIMouseCursorA :Pointer;
- IconBGIMouseCursorB :Pointer;
- IconBGIMouseCursorC :Pointer;
-
- IconBGIMouseMaskA :Pointer;
- IconBGIMouseMaskB :Pointer;
- IconBGIMouseMaskC :Pointer;
-
- Implementation
-
- Procedure DefaultError(Num:Byte);
- Begin
- CloseGraph;
- ClrScr;
- WriteLn('Fatal Error Occurred');
- Halt;
- End;
-
- Function MouseFunctions.ComputerSpeed:LongInt;
- Begin
- ComputerSpeed:=PGUIMDef.ComputerSpeed;
- End;
-
- Function MouseFunctions.Active:Boolean;
- Begin
- Active:=PGUIMDef.Active;
- End;
-
- Procedure InstallBGIMouse(Shape:Pointer);
-
- Var
- P,Q :Pointer;
-
- Begin
- If Not Mouse.Active Then Exit;
-
- MouseMaxX :=GetMaxX;
- MouseMaxY :=GetMaxY;
-
- If (Shape=NIL) Or (BGIMouseShape(Shape^).Picture=NIL) Then
- MousePicture :=MouseDefaultPicture
- Else
- MousePicture :=BGIMouseShape(Shape^).Picture;
-
- If (Shape=NIL) Or (BGIMouseShape(Shape^).Mask=NIL) Then
- MouseMask :=MouseDefaultMask
- Else
- MouseMask :=BGIMouseShape(Shape^).Mask;
-
- P :=Ptr(Seg(MousePicture^),Ofs(MousePicture^)+0);
- Q :=Ptr(Seg(MouseMask^),Ofs(MouseMask^)+0);
- If Word(P^)<>Word(Q^) Then Halt;
- MouseSizeX :=Word(P^);
- P :=Ptr(Seg(MousePicture^),Ofs(MousePicture^)+2);
- Q :=Ptr(Seg(MouseMask^),Ofs(MouseMask^)+2);
- If Word(P^)<>Word(Q^) Then Halt;
- MouseSizeY :=Word(P^);
- MouseBackgroundSize:=ImageSize(0,0,MouseSizeX,MouseSizeY);
- GetMem(MouseBackgroundSave,MouseBackgroundSize);
- MouseX :=MouseMaxX Div 2;
- MouseY :=MouseMaxY Div 2;
- MouseHideCount :=254;
- P :=@PGUIBMSE.ControlMouse;
- Asm
- les dx, P
- mov ax, 0Ch
- mov cx, 1
- int 33h
- End;
- OldExitProc:=ExitProc;
- ExitProc:=@UnInstallBGIMouse;
-
- Mouse.Show :=PGUIBMSE.Show;
- Mouse.Hide :=PGUIBMSE.Hide;
- Mouse.SetXY :=PGUIBMSE.SetXY;
- Mouse.SetShape :=PGUIBMSE.SetShape;
- Mouse.SetBounds :=PGUIBMSE.SetBounds;
- Mouse.SetBounds(0,0,MouseMaxX,MouseMaxY);
- Mouse.SetXY(MouseX,MouseY);
- End;
-
- Procedure UnInstallBGIMouse;
- Begin
- If Not Mouse.Active Then Exit;
- ExitProc:=OldExitProc;
- Asm
- mov ax, 0Ch
- mov cx, 0
- int 33h
- End;
- FreeMem(MouseBackgroundSave,MouseBackgroundSize);
- Mouse.Show :=PGUIMSE.Show;
- Mouse.Hide :=PGUIMSE.Hide;
- Mouse.SetXY :=PGUIMSE.SetXY;
- Mouse.SetShape :=PGUIMSE.SetShape;
- Mouse.SetBounds :=PGUIMSE.SetBounds;
- End;
-
- {$I PGUIAPP}
-
- {$I PGUIBUT}
-
- {$I PGUIWIN}
-
- Begin
- Error :=DefaultError;
- Mouse.Init :=PGUIMSE.Init;
- Mouse.Show :=PGUIMSE.Show;
- Mouse.Hide :=PGUIMSE.Hide;
- Mouse.SetSpeed :=PGUIMSE.SetSpeed;
- Mouse.SetXY :=PGUIMSE.SetXY;
- Mouse.SetBounds :=PGUIMSE.SetBounds;
- Mouse.SetShape :=PGUIMSE.SetShape;
- Mouse.GetPresses :=PGUIMSE.GetPresses;
- Mouse.GetXY :=PGUIMSE.GetXY;
- Mouse.GetStatus :=PGUIMSE.GetStatus;
- Mouse.GetClick :=PGUIMSE.GetClick;
-
- Mouse.Init(False);
-
- IconCloseButton :=@Icons.IconCloseButton;
- IconSlideButtonVert :=@Icons.IconSlideButtonVert;
- IconSlideButtonHorz :=@Icons.IconSlideButtonHorz;
- IconSlideButtonUp :=@Icons.IconSlideButtonUp;
- IconSlideButtonDown :=@Icons.IconSlideButtonDown;
- IconSlideButtonLeft :=@Icons.IconSlideButtonLeft;
- IconSlideButtonRight :=@Icons.IconSlideButtonRight;
-
- IconMousePoint :=@Icons.IconMousePoint;
- IconMouseClock :=@Icons.IconMouseClock;
- IconMouseNote :=@Icons.IconMouseNote;
-
- IconBGIMouseCursorA :=@Icons.IconBGIMouseCursorA;
- IconBGIMouseCursorB :=@Icons.IconBGIMouseCursorB;
- IconBGIMouseCursorC :=@Icons.IconBGIMouseCursorC;
-
- IconBGIMouseMaskA :=@Icons.IconBGIMouseMaskA;
- IconBGIMouseMaskB :=@Icons.IconBGIMouseMaskB;
- IconBGIMouseMaskC :=@Icons.IconBGIMouseMaskC;
- End.
-
- { Copyright 1993, Michael Gallias }
-