unit GrpTools;
{
****************************************************
* GrpTools!! (Dessigned for Turbo pascal 7.0) *
* ----------- *
* Yotam's Graphics unit. (1997) *
* now you can use yotam's graphics procedures & *
* functions! *
****************************************************
This unit includes:
--------------------
A very usefull graphics procedures and functions
Like:
-----
Windows procedures & functions,
Applications(GYApplication),
Input Procedure(GRead, Intext or TEdit),
GRAPH.TPU procedures,
and more...
GYApplication
-------------
GYApplication it's an object to display windows,
dialogs messages and more.
it's works like windows 3.X programming.
To make this unit to .TPU file you need to have:
Files:
--------
GRAPH.TPU
BGIDRIV.TPU
BGIFONT.TPU
MOUSE.TPU
TURBO.TPL
DEFAULT.OBJ
WIN95BTN.PAS
MOUSELIB.PAS
Other:
--------
Turbo Pascal 6.0 - 7.0 or
TPC.EXE (Turbo Pascal Compiler) version 6.0 - 7.0
Compile GrpTools
------------------
If you have a Turbo Pascal 7.0, run the pascal
editor, open the file GRPTOOLS.PAS and then press F9.
If you have just the compiler (TPC.EXE) then
Set up your MS-DOS Command Prompt and Type:
TPC /m GRPTOOLS.PAS
(make shoure that you are in the compiler directory)
this will make the unit and you'l be able to use it.
I need HELP!!!
----------------
if you need some help, contact me
be E-Mail: [[Email Removed]]
}
Interface
uses Graph, Crt, BGIDriv, BGIFont, Mouse, Dos, Win95Btn;
Type
SingleChar = Array[1..10,1..10] of Boolean; {10x10}
TFont = Array[1..105] of SingleChar;
FontFile = file of TFont;
FPointer = ^TFont;
YPCHeader = Record
Buff : Array[1..90,1..90] of Byte;
End;
var
GDriver, GMode : Integer;
Yes, No, SvYes, SvNo, Ok : String;
GTextColor, GBkColor : Byte;
LastStatus : String;
BTC : Byte;
Font : TFont;
PixYSize : Integer;
PixXSize : Integer;
MaxScrX : Integer;
MaxScrY : Integer;
MinScrX : Integer;
MinScrY : Integer;
DispSColor : Byte;
Dc : Byte;
DisplayMode: byte;
Type
Buf = Array[1..20] of String;
Type
Pic = record
Asc: Array[1..50,1..80] of Char;
Color, BkColor: Array [1..50,1..80] of integer;
Password:String;
P: integer
End;
Const
Esc_Key : Char = Chr(27);
Enter_Key : Char = Chr(13);
No_Key : Char = Chr(0);
Up_Key : Char = #72;
Down_Key : Char = #80;
Right_Key : Char = #77;
Left_Key : Char = #75;
BackSpace : Char = #8;
PgUp_Key : Char = 'I';
PgDn_Key : Char = 'Q';
Home_Key : Char = 'G';
End_Key : Char = 'O';
Tab_Key : Char = #9;
F1_Key : Char = ';';
F2_Key : Char = '<';
F3_Key : Char = '=';
F4_Key : Char = '>';
F5_Key : Char = '?';
F6_Key : Char = '@';
F7_Key : Char = 'A';
F8_Key : Char = 'B';
{-----GYApplication constants----}
Const
ID_Exit = 1;
ID_Help = 2;
ID_New = 3;
ID_Abaut = 4;
ID_Ok = 5;
ID_Cancel = 6;
ID_Abort = 7;
ID_Retry = 8;
ID_Ignor = 9;
ID_Close = 10;
ID_Open = 11;
FMaxX = 10;
FMaxY = 10;
Errors : Array[1..3] of String =
('PIC: file not found',
'PIC: Picture number to big/small',
'PIC: Invalid file type');
NumErrors = 3;
{------------------------GYApplication types------------------------------}
Type
Button = record
X, Y, X1, Y1 : Integer;
Name, Status : String;
ID : Integer;
HotKey : Char;
PicFName : String[12];
Color : Byte;
End;
Boolean2 = (T, F, Pushed);
{---------------------Graphics Functions and procedures-------------------}
Procedure HalonGraph(X2,Y2,X1,Y1,Hef,Col,Mcol:integer); {Drawing window}
Procedure InText(var R:String;Max,Color,BColor:integer); {Input text}
Procedure Load_Pic_Grp(X,Y,X1,Y1,C0:integer;File_Name:String); {Display pictures (.PIC) type}
Procedure OutTextLn(S:String); {Like Graphics Writeln}
Procedure GrpView(FileName,Asc:String); {Text View (from file)}
Procedure InitGDriver; {Init the graphics screen}
Procedure Ln(Kir:Boolean); {Down line}
Procedure GRead(var S:String;Max:Byte); {An other input text procedure}
Procedure GDispStr(S:String); {Like OutText}
Procedure Disp(S : String); {A very cool display string procedure}
Procedure FlyText(Text : String; Y : Integer);
Function GOpenDialog(What : String) : String;
Procedure LoadPicComm(FName : String);
Function Password_Entery(P : String) : Boolean; {Passeord entery dialog}
Procedure GLoadFont(FntName : String);
Procedure LoadFontMem(F : FPointer);
Procedure GOutFont(Str : String);
Procedure GOutFontLn(Str : String);
Procedure LYpc(X,Y,X1,Y1 : Integer;C0: Boolean;File_Name:String);
Procedure DefaultYFont;
Procedure SetFontSize(SizeX, SizeY : Integer);
{--------------------GYapplication Functions & Procedures-------------------}
Function ChekButton(B : Button; X, Y : Integer):Boolean; {Cheking the mouse touch}
Procedure InitYesNo(Y, N:String); {Init the GYApp Yes and No defaults}
Procedure ReturnYesNo; {Return the old defaults (GYApp Yes and No)}
Procedure DrawStatusLine; {Status drawing}
Procedure ShowStatus(SStr : String); {Out status text}
Function GetMGX : Word; {Returns Graphics mouse X }
Function GetMGY : Word; {Returns Graphics mouse Y }
Procedure Draw_Button(B : Button; BColor : Byte ;Mesuman : Boolean2); {Drawing Button}
Function PressButton(var B : Button;BColor : Byte) : Boolean; {Chek Button Pressed}
Procedure ButtonRect(B:Button); {Drawing the button rectangle}
Function GQuestion(Msg, Title : String) : Boolean; {Ask the user question}
Procedure GMessage(Msg, Title : String); {Show message in a nice window}
Procedure ShowError(Num : Integer);
Function TPressButton(B : Button) : Boolean;
Function GSaveDialog(What : String) : String;
{----------------GRAPH.TPU Basic Procedures & Functions----------------------}
Procedure Rectangle(X,Y,X1,Y1 : Integer);
Procedure Circle(X,Y,Ratio : Integer);
Procedure PutPixel(X,Y,Color : Integer);
Procedure GPutPixel(X,Y : Integer);
Procedure Bar(X,Y,X1,Y1 : Integer);
Procedure Bar3D(x1, y1, x2, y2: Integer; Depth: Word; Top: Boolean);
Procedure Line(X,Y,X1,Y1 : Integer);
Procedure LineTo(X,Y : Integer);
Procedure SetFillStyle(I1, I2 : Byte);
Procedure FloodFill(X,Y,MC : Integer);
Procedure SetFont(Font, Godel : Integer);
Procedure CloseGraph;
Procedure InitSVGA256;
{--------------------------Other Functions & procedures--------------------}
Procedure ProcPrmStr (Prms : String; var Buffer : Buf);
{---------------------------------Types--------------------------------------}
Type
GrpScroll = object {To scroll lines and let the user to choose}
X1,Y1,X2,Y2,I,SX,SY,C: Integer;
From_P,To_P,Max,H:integer;
Col,BCol,SCol:integer;
EOFile:Boolean;
FileName:String;
Result:String;
Ok : Boolean;
List:Array[1..20] of String;
RoundBtn : Button;
UpB, DnB : Button;
Buttons : Array[1..20] of Button;
Procedure MoveSaman(A:integer);
Procedure Menu;
Procedure MoveScroll(A:integer);
Procedure ReadFile;
Procedure Drow(AA:integer);
Procedure Init(Hef, PMax, CC,B,S:integer; PFName : String);
End;
WinGrp = object {GYApplication window object}
X,Y,X1,Y1 : Integer;
CloseButton : Button;
Title : String;
Size : Word;
P : Pointer;
Saving : Boolean;
Fill, TFill, TC : Byte;
Procedure Init(PX, PY, PX1, PY1, PFill, PTFill, PTC:Integer;PTitle:String);
Procedure Disp;
Procedure Erase;
Procedure Move_Win;
End;
Dialog = Object {Buttons menu manager}
Buttons : Array[1..30] of Button;
Result : Integer;
R2 : Button;
BColor : Byte;
Count : Byte;
W : WinGrp;
Procedure Init(var PW : WinGrp);
Procedure Add_Button(X, Y : Integer; Name : String;ID : Integer);
Procedure Disp_Buttons;
Procedure Play;
End;
GYApplication = Object {Yotam's windows vision}
W : WinGrp;
D : Dialog;
QTitle : String;
QuitStr : String;
ExitApp : Boolean;
Constructor Init;
Procedure InitMainWindow; virtual;
Procedure InitButtons; virtual;
Procedure StartUp; virtual;
Procedure Case_Procedure; virtual;
Procedure Run;
Procedure Done; virtual;
Procedure InitQStr; virtual;
Procedure InitOther; virtual;
Procedure ExitApplication;
End;
Page2 = Object {Scrolling text}
FName : String;
FromP,ToP : Integer;
Max, Count: Integer;
Sx, Sy : Integer;
Color : Byte;
BColor : Byte;
Procedure Init(FN : String; Col, BCol : Byte; M : Integer);
Procedure Read_Page(N : Boolean);
Procedure Display;
End;
GPic = Object
P : Pic;
Image : Pointer;
Size : Word;
Error : Integer;
X, Y,
X1,Y1 : Integer;
PicBtn : Button;
Procedure Load(FName : String; PNum : Integer);
Procedure Disp(PX, PY, PX1, PY1: Integer);
Procedure Erase;
Procedure DispFullScr;
Procedure Load_Mem(Pic_Data : Pointer);
End;
RType = (Enter, Esc, ButtonD);
TEdit = Object
Sx, Sy : Integer;
Color : Byte;
BColor : Byte;
Max : Integer;
S : String;
Btn : Button;
SamanPos : Byte;
SLen : Byte;
Done : Boolean;
Ch : Char;
I : Byte;
Pass : Boolean;
SvS : String;
Result : RType;
Procedure DispLine(E : Boolean);
Procedure DrawSaman;
Procedure Init(PS : String; PBCol, PMax: Byte;X,Y : Integer);
Procedure DrawBox;
Procedure Edit;
End;
{---------------------------Here is the source...---------------------------}
{------------------<<<<<<<<<<}Implementation{>>>>>>>>>>---------------------}
Procedure Beep(SS,DD,D2: integer);
Begin
Sound(SS);
Delay(DD);
NoSound;
Delay(D2);
End;
Procedure UpCaseStr(var S:String);
var
I:integer;
Begin
for i := 1 to Length(S) do S[i] := UpCase(S[i]);
End;
Function Num(Ch: String) : integer;
var
I,I2,I3 : integer;
II,II2 : integer;
Begin
Num := 0;
II := 0;
II2 := 0;
I2 := Length(Ch);
I3 := 1;
for I := 1 to Length(Ch) do
Begin
II := (Ord(Ch[I2]) - Ord('0')) * I3;
II2 := II2 + II;
I2 := I2 - 1;
I3 := I3 * 10;
End;
Num := II2;
End;
Procedure DelayT(TD: integer);
var
h, m, s, h1, h2 : Word;
DoneD: Boolean;
I: integer;
Begin
I := 0;
DoneD := False;
repeat
h2 := h1;
GetTime(h, m, s, h1);
if h1 <> h2 then I := I + 1;
if I = TD then DoneD := True;
until DoneD;
End;
Function Exist(FName : String) : Boolean;
var
F : file;
Begin
Assign(F, FName);
{$I-}Reset(F);{$I+}
if IOResult = 0 then
Begin
Exist := True;
Close(F);
End
else Exist := False;
End;
Procedure SetSColor(D, C:Byte);
Begin
DispSColor := C;
Dc := D;
End;
Function YGetDir : String;
var
S:String;
Begin
GetDir(0, S);
if S[Length(S)] = '\' then
Delete(S, Length(S), 1);
YGetDir := S;
End;
Function ClearNum(Num : LongInt) : String;
var
S : String;
C, J, I : Byte;
Begin
Str(Num, S);
if Length(S) > 3 then
Begin
C := 1;
J := Length(S);
for I := 1 to Length(S) do
Begin
Inc(C);
J := J -1;
if (C = 3) and (J > 1) then
Begin
Insert(',',S,J);
C := 0;
End;
End;
End;
ClearNum := S;
End;
Procedure HalonGraph(X2,Y2,X1,Y1,Hef,Col,Mcol:integer);
begin
SetColor(15);
Rectangle(X1, Y1, X2, Y2);
Rectangle(X1 + Hef, Y1 + Hef, X2 - Hef, Y2 - Hef);
SetFillStyle(1,Col);
FloodFill(X2+1, Y2+1, GetMaxColor);
SetFillStyle(1,Mcol);
FloodFill(X2 - 3, Y2 - 3, GetMaxColor);
SetColor(0);
Rectangle(X1, Y1, X2, Y2);
SetColor(15);
Line(X1,Y1,X2,Y1);
Line(X2,Y2,X2,Y1);
SetColor(0);
Line(X1-Hef,Y1+Hef,X2-Hef,Y1+Hef);
Line(X1+Hef,Y1+Hef,X2+Hef,Y1+Hef);
Line(X2-Hef,Y2-Hef,X2-Hef,Y1+Hef);
end;
Procedure Load_Pic_Grp(X,Y,X1,Y1,C0:integer;File_Name:String);
var
P:Pic;
F:File of Pic;
I,J:integer;
Begin
if X1 > 79 then X1 := 79;
if Y1 > 49 then Y1 := 49;
Assign(F,File_Name);
Reset(F);
Read(F,P);
if IOResult <> 0 then Exit;
Close(F);
for I := 1 to Y1 do for J := 1 to X1 do
Begin
if C0 <> 1 then
if P.BkColor[I,J] <> 0 then PutPixel(J+X,I+Y,P.BkColor[I,J]);
if C0 = 1 then
if P.BkColor[I,J] <> 0 then PutPixel(J+X,I+Y,0);
End;
End;
Procedure InText(var R:String;Max,Color,BColor:integer);
var
S, X, Y, I:integer;
Ch : Char;
Het:Boolean;
Begin
Het := False;
X := GetX;
Y := GetY;
S := X;
SetColor(Color);
MoveTo(X,Y);
OutText('?');
MoveTo(X,Y);
if Length(R) <= Max then for I := 1 to Length(R) do
Begin
SetColor(0);
OutText('?');
SetColor(Color);
MoveTo(GetX-8,Y);
OutText(R[I]);
OutText('?');
MoveTo(GetX-8,Y);
X := X + 1;
End
else R := '';
Repeat
Ch := ReadKey;
if Ch = #0 then
Begin
Ch := ReadKey;
Ch := ' ';
Het := True;
End;
if (Ch<>#8)and(X<Max+S)and(Ch<>Enter_Key)and(Ch<>Esc_Key)and(Not Het)then
Begin
SetColor(0);
OutText('?');
SetColor(Color);
MoveTo(GetX-8,Y);
OutText(Ch);
OutText('?');
MoveTo(GetX-8,Y);
X := X + 1;
R := R + Ch;
End;
if (Ch = #8) and (X > S) then
Begin
X := X - 1;
MoveTo(GetX-8,Y);
SetColor(BColor);
OutText('?');
SetColor(Color);
MoveTo(GetX-8,Y);
OutText('?');
SetColor(BColor);
OutText('?');
SetColor(Color);
MoveTo(GetX-16,Y);
Delete(R,Length(R),1);
End;
Het := False;
until (Ch = Esc_Key) or (Ch = Enter_Key);
SetColor(BColor);
OutText('?');
SetColor(Color);
if Ch <> Enter_Key then R := '';
End;
Procedure OutTextLn(S:String);
var
X,Y:integer;
Begin
X := GetX;
Y := GetY+TextHeight(S);
OutText(S);
MoveTo(X,Y);
End;
Procedure GrpView(FileName,Asc:String);
var
F:Text;
Ln:String;
Done,S: Boolean;
Begin
Assign(F,FileName);
if Asc = 'no' then
Begin
Reset(F);
While Not Eof(F) do
Begin
Readln(F,Ln);
OutTextLn(Ln);
End;
End
else
Begin
S := False;
Done := False;
Reset(F);
While Not Done do
Begin
Readln(F,Ln);
if (S)and(Ln <> Asc) Then OutTextLn(Ln);
if (S) and (Ln = Asc) then Done := True;
if Ln = Asc then S := True;
if Eof(F) then Done := True;
End;
End;
End;
Procedure GrpScroll.Init(Hef, PMax, CC,B,S:integer; PFName : String);
var
II, BtnY : Integer;
Begin
Col := CC;
BCol := B;
SCol := S;
FileName := PFName;
H := Hef;
C := 1;
Max := PMax;
X1 := GetX;
Y1 := GetY;
X2 := X1 + Hef;
Y2 := Y1 + 9;
SX := X1;
SY := Y1;
for II := 0 to Max-1 do
Begin
BtnY := Y1 + II * 11;
with Buttons[II+1] do
Begin
Y := BtnY;
Y1 := Y + 9;
ID := II+1;
End;
Buttons[II+1].X := X1;
Buttons[II+1].X1 := X1 + Hef;
End;
RoundBtn.X := X1 - 1;
RoundBtn.Y := Y1 - 1;
RoundBtn.X1 := X2 + 1;
RoundBtn.Y1 := Y1 + Max * (TextHeight('?')+3);
UpB.X := RoundBtn.X1+1;
UpB.Y := RoundBtn.Y;
UpB.X1 := RoundBtn.X1+ 31;
UpB.Y1 := RoundBtn.Y+ 23;
DnB.X := RoundBtn.X1+1;
DnB.Y := RoundBtn.Y1-23;
DnB.X1 := RoundBtn.X1+ 31;
DnB.Y1 := RoundBtn.Y1;
SetFillStyle(1,BCol);
With RoundBtn do
Begin
Bar(X,Y,X1,Y1);
End;
ButtonRect(UpB);
ButtonRect(DnB);
With RoundBtn do
Begin
X1 := DnB.X1;
End;
ButtonRect(RoundBtn);
Line(UpB.X, UpB.Y1, (UpB.X+14), UpB.Y);
Line((UpB.X+14), UpB.Y,UpB.X1, UpB.Y1);
Line(DnB.X,DnB.Y, (DnB.X+14), DnB.Y1);
Line((DnB.X+14), DnB.Y1,DnB.X1, DnB.Y);
Line(UpB.X, UpB.Y1, DnB.X, DnB.Y);
Line(UpB.X1, UpB.Y1, DnB.X1, DnB.Y);
From_P := 1;
To_P := From_P + Max;
ReadFile;
Drow(1);
End;
Procedure GrpScroll.Drow(AA:integer);
var
W,J:integer;
Begin
HideMouse;
if AA = 1 then
Begin
MoveTo(SX+5,SY+1);
SetColor(Col);
For W := 1 to Max do
Begin
OutText(List[W]);
MoveTo(SX+5,GetY+11);
End;
End;
if AA = 2 then
Begin
MoveTo(SX+5,SY+1);
SetColor(BCol);
For W := 1 to Max do
Begin
OutText(List[W]);
MoveTo(SX+5,GetY+11);
End;
End;
ShowMouse;
End;
Procedure GrpScroll.ReadFile;
var
A:String;
F:Text;
II:integer;
Begin
EOFile := False;
Assign(F,FileName);
Reset(F);
for II := 1 to From_P-1 do Readln(F,A);
A := '';
for II := 1 to Max do
Begin
Readln(F,List[II]);
if Eof(F) then Max := II;
if Eof(F) then EOFile := True;
if Eof(F) Then Break;
End;
Close(F);
End;
Procedure GrpScroll.MoveSaman(A:integer);
Begin
HideMouse;
SetColor(BCol);
Rectangle(X1, Y1, X2, Y2);
SetColor(SCol);
if (A = 1) then
Begin
if (C=Max) then MoveScroll(1)
else
Begin
Y1 := Y1 + 11;
Y2 := Y2 + 11;
C := C + 1;
End;
End;
if A = 2 then
Begin
if (C = 1) then MoveScroll(2)
else
Begin
Y1 := Y1 - 11;
Y2 := Y2 - 11;
C := C - 1;
End;
End;
SetColor(SCol);
Rectangle(X1, Y1, X2, Y2);
ShowMouse;
End;
Procedure GrpScroll.MoveScroll(A:integer);
Begin
HideMouse;
if (A = 1) and (Not EOFile)then
Begin
Drow(2);
From_P := From_P+1;
To_P := From_P+Max;
ReadFile;
Drow(1);
End;
if (A = 2) and (From_P>1)then
Begin
Drow(2);
From_P := From_P-1;
To_P := From_P-Max;
ReadFile;
Drow(1);
End;
ShowMouse;
End;
Procedure GrpScroll.Menu;
var
Ch:Char;
II : Integer;
J : Integer;
begin
SetColor(SCol);
Rectangle(X1,Y1,X2,Y2);
Repeat
if KeyPressed then
Begin
Ch := ReadKey;
if Ch = #0 then
Begin
Ch := ReadKey;
if (Ch = Down_Key) Then MoveSaman(1);
if (Ch = Up_Key) then MoveSaman(2);
End;
if Ch = Enter_Key then Ok := True;
End;
if (ButtonDown) and (ChekButton(UpB, GetMGX, GetMGY)) then
Begin
MoveScroll(2);
DelayT(2);
End;
if (ButtonDown) and (ChekButton(DnB, GetMGX, GetMGY)) then
Begin
MoveScroll(1);
DelayT(2);
End;
if ButtonDown then
if ChekButton(RoundBtn, GetMGX, GetMGY) then
Begin
for II := 1 to Max do
Begin
if ChekButton(Buttons[II], GetMGX, GetMGY) then
Begin
Repeat Until ButtonUp;
if (C <> Buttons[II].ID) then
Begin
HideMouse;
SetColor(BCol);
Rectangle(X1,Y1,X2,Y2);
C := Buttons[II].ID;
Y1 := Sy + ((C-1)*11);
Y2 := Y1 + 9;
SetColor(SCol);
Rectangle(X1,Y1,X2,Y2);
ShowMouse;
Break;
End
else
Begin
Ch := Enter_Key;
Ok := True;
End;
End;
End;
End
else
Begin
Ch := Enter_Key;
Ok := False;
End;
until (Ch = Enter_Key);
if Ok then Repeat Until ButtonUp;
Result := List[C];
SetColor(BCol);
Rectangle(X1,Y1,X2,Y2);
SetColor(Col);
end;
function DetectVGA256 : Integer; FAR;
begin
DetectVGA256 := 0
end;
Procedure InitSVGA256;
begin
gdriver := installuserdriver('svga256',@detectvga256);
gmode := displaymode;
initgraph(gdriver,gmode,'');
setgraphmode(2);
end;
Procedure InitGDriver;
var
GError : Integer;
Dir : String;
Begin
GetDir(0,Dir);
InitGraph(GDriver, GMode, '');
GError := GraphResult;
While GError <> 0 do
Begin
Writeln('Graphics Error: ',GraphErrorMsg(GError));
Writeln('Enter the full path of your BGI driver (Ctrl+Break Aborts):');
Readln(Dir);
GDriver := Detect;
InitGraph(GDriver, GMode, Dir);
GError := GraphResult;
End;
End;
Procedure Ln(Kir:Boolean);
Begin
if
