home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
nvdc87
/
exbined
/
demo0a.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-08-31
|
9KB
|
283 lines
{ DEMO0.PAS Binary Editor 2.00A }
{Copyright 1986,87 (c) Borland International }
{Modified by Jeff Duntemann for Turbo Technix 8/31/87 }
program BinaryEditorDemo0;
uses
bined,
crt,
dos; {JD}
{***************************************************************}
{****************** demonstration follows **********************}
{***************************************************************}
{* This demonstration shows the use of one editor window which *}
{********* works just like a standalone Turbo editor. **********}
{***************************************************************}
const
{Coordinates of the editor window}
Windx1 = 1;
Windy1 = 1;
Windx2 = 80;
Windy2 = 25; {Change to 43 for EGA 43-line operation}
MakeBackup = True; {True to create .BAK files}
var
EdData : EdCB; {Editor control block}
ExitCode : Word; {Status code set by bin. ed. functions}
ExitCommand : Integer; {Code for command used to leave editor}
Fname : string; {Input name of file being edited}
Junk : Boolean;
XSave,YSave : Integer; {JD}
VidSegment : Word; {JD}
VideoBufferSize : Word; {JD}
SavePtr : ^Word; {JD}
VideoPtr : ^Word; {JD}
VideoSeg : Word; {JD}
Now : DateTime; {JD}
const
{Commands other than ^K^D to exit editor}
ExitCommands : array[0..3] of Char =
(#2, ^K, ^Q, #0);
{Procedures and functions used as part of the demo}
procedure WriteStatus(msg : string);
{-Write a status message}
begin {WriteStatus}
GoToXY(1, Windy2);
TextColor(White);
Write(msg);
end; {WriteStatus}
procedure CheckInitBinary(ExitCode : Word);
{-Check the results of the editor load operation}
begin {CheckInitBinary}
if ExitCode <> 0 then begin
{Couldn't load editor}
case ExitCode of
1 : WriteStatus('Insufficient heap space for text buffer');
else
WriteStatus('Unknown load error');
end;
GoToXY(1, Windy2);
Halt(1);
end;
end; {CheckInitBinary}
procedure CheckReadFile(ExitCode : Word; Fname : string);
{-Check the results of the file read}
var
f : file;
begin {CheckReadFile}
if ExitCode <> 0 then begin
{Couldn't read file}
case ExitCode of
1 : begin
{New file, assure valid file name}
{$I-}
Assign(f, Fname);
Rewrite(f);
if IOResult <> 0 then begin
Close(f);
WriteStatus('Illegal file name '+Fname);
end else begin
Close(f);
Erase(f);
Write('New File');
Delay(2000);
Write(^M);
ClrEol;
GoToXY(1, 1);
ClrEol;
Exit;
end;
{$I+}
end;
2 : WriteStatus('Insufficient text buffer size');
else
WriteStatus('Unknown read error');
end;
GoToXY(1, Windy2);
Halt(1);
end;
GoToXY(1, 1);
ClrEol;
end; {CheckReadFile}
procedure CheckSaveFile(ExitCode : Word; Fname : string);
{-Check the results of a file save}
begin {CheckSaveFile}
if ExitCode <> 0 then begin
{Couldn't save file}
case ExitCode of
1 : WriteStatus('Unable to create output file '+Fname);
2 : WriteStatus('Error while writing output to '+Fname);
3 : WriteStatus('Unable to close output file '+Fname);
else
WriteStatus('Unknown write error');
end;
GoToXY(1, Windy2);
Halt(1);
end;
end; {CheckSaveFile}
function GetFileName : string;
{-Return a file name either from the command line or a prompt}
var
Fname : string;
begin {GetFileName}
if ParamCount > 0 then
Fname := ParamStr(1)
else begin
Write('Enter file name to edit: ');
ReadLn(Fname);
end;
if Fname = '' then
Halt;
GetFileName := Fname;
end; {GetFileName}
function ExitBinaryEditor(var EdData : EdCB;
ExitCommand : Integer) : Boolean;
{-Handle an editor exit - save or abandon file}
var
ExitCode : Word;
function YesAnswer(prompt : string) : Boolean;
{-Return true for a yes answer to the prompt}
var
ch : Char;
begin {YesAnswer}
WriteStatus(prompt);
repeat
ch := UpCase(readkey);
until ch in ['Y', 'N'];
Write(ch);
YesAnswer := (ch = 'Y');
end; {YesAnswer}
begin {ExitBinaryEditor}
case ExitCommand of
-1 : {^K^D}
begin
ExitCode := SaveFileBinaryEditor(EdData, MakeBackup);
CheckSaveFile(ExitCode, FileNameBinaryEditor(EdData));
ExitBinaryEditor := True;
GoToXY(1, Windy2);
end;
0 : {^K^Q}
begin
if ModifiedFileBinaryEditor(EdData) then
if YesAnswer('File modified. Save it? (Y/N) ') then begin
ExitCode := SaveFileBinaryEditor(EdData, MakeBackup);
CheckSaveFile(ExitCode, FileNameBinaryEditor(EdData));
end;
ExitBinaryEditor := True;
GoToXY(1, Windy2);
end;
end;
end; {ExitBinaryEditor}
{$F+} { All User-Event procesudures must be FAR calls!}
PROCEDURE Clocker(EventNo,Info : Integer);
VAR
Hours,Minutes,Seconds,Hundredths : Integer;
TimeBuf,TimeTemp : String;
BEGIN
GetTime(Hours,Minutes,Seconds,Hundredths);
Str(Hours:2,TimeBuf);
Str(Minutes:2,TimeTemp);
IF TimeTemp[1] = ' ' THEN TimeTemp[1] := '0';
TimeBuf := TimeBuf+':'+TimeTemp;
Str(Seconds:2,TimeTemp);
IF TimeTemp[1] = ' ' THEN TimeTemp[1] := '0';
TimeBuf := TimeBuf+':'+TimeTemp;
CRTPutFast(65,1,TimeBuf)
END;
{$F-}
{<<<< Monochrome >>>>}
{ From: COMPLETE TURBO PASCAL by Jeff Duntemann }
{ Scott, Foresman & Co. 1986 ISBN 0-673-18600-8 }
{ Described in section 17.2 -- Last mod 2/1/86 }
{ HIGHLY specific to the IBM PC! }
FUNCTION Monochrome : Boolean;
VAR
Regs : Registers;
BEGIN
INTR(17,Regs);
IF (Regs.AX AND $0030) = $30 THEN Monochrome := True
ELSE Monochrome := False
END;
begin {Demo0}
XSave := WhereX; YSave := WhereY; {JD}
VideoBufferSize := Windx2*Windy2*2; {JD}
GetMem(SavePtr,VideoBufferSize); {JD}
IF Monochrome THEN VidSegment := $B000 ELSE {JD}
VidSegment := $B800; {JD}
VideoPtr := Ptr(VidSegment,0); {JD}
Move(VideoPtr^,SavePtr^,VideoBufferSize); {JD}
{Get a file name}
Fname := GetFileName;
{Initialize a window for the file}
ExitCode :=
InitBinaryEditor(
EdData, {Editor control block }
MaxFileSize, {Size of data area to reserve for}
{binary editor text buffer, $FFE0 max}
Windx1, {X of upper left corner; 1..80}
Windy1, {Y of upper left corner}
Windx2, {X of lower right corner}
Windy2, {Y of lower right corner}
True, {True = wait for retrace on CGA cards}
EdOptInsert+EdOptIndent, {Initial editor toggles}
'.PAS', {Default extension for file names}
ExitCommands, {Commands which will exit the editor}
Addr(Clocker)); {JD: Add a clock in the corner}
CheckInitBinary(ExitCode);
{Read the file}
ExitCode := ReadFileBinaryEditor(EdData, Fname);
CheckReadFile(ExitCode, FileNameBinaryEditor(EdData));
{Reset the editor for the new file}
ResetBinaryEditor(EdData);
{Edit the file}
ExitCommand :=
UseBinaryEditor(
EdData, {Editor control block for this window}
''); {No startup commands passed to editor}
{Handle the exit by saving the file or whatever}
Junk := ExitBinaryEditor(EdData, ExitCommand);
{Release heap space used by the editor data structure}
ReleaseBinaryEditorHeap(EdData);
Move(SavePtr^,VideoPtr^,VideoBufferSize); {JD}
FreeMem(SavePtr,VideoBufferSize); {JD}
GotoXY(XSave,YSave-1); {JD}
end. {Demo0}