Category : Pascal Source Code
Archive   : GRAPHIN.ZIP
Filename : GRAPHS.PAS

 
Output of file : GRAPHS.PAS contained in archive : GRAPHIN.ZIP
Unit Graphs;
Interface
Uses
Crt,
Dos,
Graph;

Type
Keys = (NullKey, F1, F2, F3, F4, F5, F6, F7, F8, F9, F10,
CarriageReturn, Tab, ShiftTab, Bksp, UpArrow,
DownArrow, RightArrow, LeftArrow, DeleteKey,
InsertKey, HomeKey, Esc, EndKey, TextKey, FooBarKey,
NumberKey, Space, PgUp, PgDn, AltA, AltB, AltC, AltD,
AltE, AltF, AltG, AltH, AltI, AltL, AltM, AltN, AltO,
AltP, AltU, AltV, AltR, AltS, AltT, AltW, AltX, AltZ);

var
LowMode,
HighMode: Integer;

procedure InitGraphics;
function Int2Str(L : LongInt) : string;
Procedure FlushKeyBuffer;
Function StrEdit(X,Y : Integer; TotalLength : Integer;
S : String;Title : String) : String;
Implementation
var
Key : Keys;

procedure InitGraphics;
var
GraphMode,
GraphDriver: Integer;
begin
GraphDriver := Detect;
InitGraph(GraphDriver, GraphMode, 'C:\Tp\Bgi');
if GraphResult <> grOk then Halt(1);
GetModeRange(GraphDriver, LowMode, HighMode);
SetGraphMode(LowMode); {********* Enter HighMode or LowMode ******** }
SetColor(14);
SetBkColor(1);
SetFillStyle(SolidFill, 1);
end;

Procedure InKey(Var FunctionKey : Boolean;
Var ch : Char;
BeginCursor,
EndCursor : Char);


Begin
FunctionKey := False;
ch := Readkey;
If (ch = #0) Then
Begin
FunctionKey := True;
ch := Readkey;
End;

If FunctionKey Then
Case Ord(ch) Of
15: key := ShiftTab;
72: key := UpArrow;
80: key := DownArrow;
82: key := Insertkey;
75: key := LeftArrow;
77: key := RightArrow;
73: key := PgUp;
81: key := PgDn;
71: key := HomeKey;
79: key := EndKey;
83: key := DeleteKey;
82: key := InsertKey;
59: key := F1;
60: key := F2;
61: key := F3;
62: key := F4;
63: key := F5;
64: key := F6;
65: key := F7;
66: key := F8;
67: key := F9;
68: key := F10;
50: key := AltM;
49: key := AltN;
48: key := AltB;
47: key := AltV;
46: key := AltC;
45: key := AltX;
44: key := AltZ;
38: key := AltL;
35: key := AltH;
34: key := AltG;
33: key := AltF;
32: key := AltD;
31: key := AltS;
30: key := AltA;
25: key := AltP;
24: key := AltO;
23: key := AltI;
22: key := AltU;
20: key := AltT;
19: key := AltR;
18: key := AltE;
17: key := AltW;
End
Else
Case Ord(ch) Of
8: key := Bksp;
9: key := Tab;
13: key := CarriageReturn;
27: key := Esc;
32: key := Space;
33..34, 47, 58..254:
key := TextKey;
45..46, 48..57:
key := NumberKey;
End;
End;


Procedure FlushKeyBuffer;
var Recpack : registers;
begin
with recpack do
begin
Ax := ($0c shl 8) or 6;
Dx := $00ff;
end;
Intr($21,recpack);
end;

Procedure Beep(Freq, Time : Integer);
Begin
Sound(Freq);
Delay(Time);
NoSound;
End;

function Int2Str(L : LongInt) : string;
{ Converts an integer to a string for use with OutText, OutTextXY }
var
S : string;
begin
Str(L, S);
Int2Str := S;
end; { Int2Str }

Function StrEdit(X,Y : Integer; TotalLength : Integer;
S : String;Title : String) : String;
{
I put this in to edit a single field such as the field in
CSearch procedure. It does not affect any of the existing
records, or at least, that is my plan.
}
var
P: Integer;
Ch: Char;
FuncKey, Start, Stop, ScrnMe: Boolean;
CharHeight,
CharWidth: Integer;

begin
CharHeight := TextHeight('S');
CharWidth := TextWidth('S');
Key := F1;
Ch := #1;
P := 0;
Start := True;
Stop := False;
MoveTo(X * CharWidth,Y);
OutText(Title);
X := X + Length(Title);
repeat
MoveTo(X * CharWidth + 1, Y);
Bar((X * CharWidth), Y, (X * CharWidth) + TextWidth(S) + (CharWidth * 2), Y + (CharHeight * 2));
OutText(S);
MoveTo((X + p) * CharWidth + 1, Y + CharHeight);
OutText('^');
MoveTo(X+p+1, Y);
InKey(FuncKey,Ch,'S','S');
If (Not FuncKey) and (Key <> CarriageReturn) and (Key <> BkSp) then begin
If (ch > #31) and (ch < #122) Then Begin
if Start then S := '';
If Length(S) < TotalLength Then Begin
Inc(P);
Insert(Ch, S, P);
End
Else Beep(20,20);
End
end
Else Begin
Case Key of
LeftArrow : if P > 0 then Dec(P);
RightArrow : if P < Length(S) then Inc(P) else;
HomeKey: P := 0;
EndKEy: P := Length(S);
DeleteKey: Delete(S, P + 1, 1);
Bksp: if P > 0 then
begin
Delete(S, P, 1);
Dec(P);
end;
PgUp:
begin
S := '';
P := 0;
end;
PgDn:
begin
P := 0;
end;
CarriageReturn :
begin
Stop := True;
Beep(20,20);
P := 0;
end;
Esc: Stop := True;
else
Beep(20,20);
end;
End;
Start := False;
if Length(S) > TotalLength Then Beep(20,20);
until Stop;
StrEdit := S;
end;
End.

  3 Responses to “Category : Pascal Source Code
Archive   : GRAPHIN.ZIP
Filename : GRAPHS.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/