home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
drdobbs
/
1989
/
12
/
mouhanna.lst
< prev
next >
Wrap
File List
|
1989-10-30
|
12KB
|
355 lines
_THE QUICKPASCAL IN QUICKPASCAL_
by Joseph Mouhanna and Michael Vose
[LISTING ONE]
{Top Window Object}
TWindow = OBJECT
Client : Rect;
Coord : Rect;
TCoord : Rect;
Handle : word;
Shadow : boolean;
Col : tWindowColors;
Captured: boolean;
Class : WindowClasses;
Bitmap : pointer;
TimeOutState: byte;
ForceTimeOut: boolean;
CursMode: CursorModes;
CursX : word;
CursY : word;
procedure TWindow.OpenWindow (Class: WindowClasses; x,y,w,h: word;
Col: tWindowColors; Shadow: boolean);
procedure TWindow.DrawWindow (Clip: lRect);
procedure TWindow.CloseWindow;
procedure TWindow.MoveWindow (x,y: word);
procedure TWindow.ChangeWindow (x,y,w,h: word);
procedure TWindow.MountWindow;
procedure TWindow.UnMountWindow;
procedure TWindow.GetClientArea (var Client: Rect);
procedure TWindow.WrtChars (var C; Len,x,y: word);
procedure TWindow.WrtCharsAttr (var C; Attr,Len,x,y: word);
procedure TWindow.WrtExtendedCharsAttr (var C; Attr1,Attr2,Len,Width,x,y: word);
procedure TWindow.WrtNAttr (Attr,Len,x,y: word);
procedure TWindow.WrtCells (var C; Len,x,y: word);
procedure TWindow.WrtFrame (F: FramePartsSet; Attr,x,y,w,h: word);
procedure TWindow.WrtSeparator (RightCorner: boolean; Attr,y: word);
procedure TWindow.ScrollUp (Lines, Attr,x,y,w,h: word);
procedure TWindow.ScrollDown (Lines, Attr,x,y,w,h: word);
procedure TWindow.ScrollLeft (Rows, Attr,x,y,w,h: word);
procedure TWindow.ScrollRight (Rows, Attr,x,y,w,h: word);
procedure TWindow.CaptureMouse;
procedure TWindow.UnCaptureMouse;
procedure TWindow.PressLMouse (DbleClicked: boolean; x,y: integer);
procedure TWindow.ReleaseLMouse (x,y: integer);
procedure TWindow.PressRMouse (DbleClicked: boolean; x,y: integer);
procedure TWindow.ReleaseRMouse (x,y: integer);
procedure TWindow.MoveMouse (x,y: integer);
procedure TWindow.PosCursor (x,y: word);
procedure TWindow.SetCursorMode (Mode: CursorModes);
procedure TWindow.GetChar (Key: word);
procedure TWindow.TimeOut;
procedure TWindow.RefreshStatusLine;
end;
[LISTING TWO]
TDialogBox = object (TWindow)
First : pDialogBoxItem;
Current : pDialogBoxItem;
Command : function (Dialog: TDialogBox; ID:word): boolean;
ID : word;
HelpNO : word;
UndoID : word;
ValidID : word;
Appli : TDialogBoxAppli;
MouseAction : MouseActions;
TitleColor : boolean;
{$IFDEF DEBUG}
HeapPtr : pointer;
{$ENDIF}
procedure TDialogBox.OpenDialogBox (CheckPrevW : boolean;
w,h : word;
Command : pointer;
HelpNO : word;
UndoID : word;
ValidID : word);
procedure TDialogBox.Call (var ID: word);
procedure TDialogbox.GetChar (Key: word); override;
procedure TDialogBox.CloseWindow; override;
procedure TDialogBox.DrawWindow (Clip: lRect); override;
procedure TDialogBox.PressLMouse (DbleClicked: boolean; x,y: integer); override;
procedure TDialogBox.PressRMouse (DbleClicked: boolean; x,y: integer); override;
procedure TDialogBox.ReleaseLMouse (x,y: integer); override;
procedure TDialogBox.MoveMouse (x,y: integer); override;
procedure TDialogBox.SelectDialogBoxItem (ID: word);
procedure TDialogBox.TimeOut; override;
procedure TDialogBox.DelDialogBoxItem (ID: word);
procedure TDialogBox.AddComment (
CommID : word;
AltID : word;
x,y,w : word;
Text : String;
justif : Justifications);
procedure TDialogBox.AddFrame (
FrameID : word;
AltID : word;
x,y,w,h : word;
Text : String);
procedure TDialogBox.AddSysButton (
TabID : word;
SysID : SysButtons;
justif : Justifications);
procedure TDialogBox.AddDlgText (
TabID : word;
DlgID : word;
Size : word;
x,y,w : word;è Text : String);
procedure TDialogBox.AddPushButton (
TabID : word;
PushID : word;
x,y : word;
State : boolean);
procedure TDialogBox.AddRadioButton (
TabID : word;
GroupID : word;
RadioID : word;
LinkID : word;
x,y : word;
State : boolean;
Trace : pointer);
procedure TDialogBox.AddListBox (
TabID : word;
ListID : word;
Columns : word;
x,y,w,h : word;
LinkID : word;
Trace : pointer);
procedure TDialogBox.DrawComment (
p : pDialogBoxItem);
procedure TDialogBox.DrawFrame (
F : FramePartsSet;
p : pDialogBoxItem);
procedure TDialogBox.DrawSysButton (
Hilite : boolean;
p : pDialogBoxItem);
procedure TDialogBox.DrawDlgText (
p : pDialogBoxItem);
procedure TDialogBox.DrawPushButton (
p : pDialogBoxItem);
procedure TDialogBox.DrawRadioButton (
p : pDialogBoxItem);
procedure TDialogBox.DrawListBox (
p : pDialogBoxItem);
procedure TDialogBox.SetComment (
CommID : word;
Text : String);
procedure TDialogBox.GetComment (
CommID : word;
var Text : String);
procedure TDialogBox.GetDlgText (
DlgID : word;
var Text : string);
procedure TDialogBox.SetDlgText (
DlgID : word;
Text : String);
procedure TDialogBox.SetLockState (
DlgID : word;
Lock : Boolean);
procedure TDialogBox.GetPushButton (
PushID : word;
var State : boolean);èprocedure TDialogBox.SetPushButton (
PushID : word;
State : boolean);
procedure TDialogBox.GetRadioButton (
GroupID : word;
var ID : word);
procedure TDialogBox.SetRadioButton (
GroupID : word;
ID : word);
procedure TDialogBox.GetTextListBox (
ListID : word;
var Text : string);
procedure TDialogBox.GetOffsetListBox (
ListID : word;
var Offset : word);
procedure TDialogBox.SetTextListBox (
ListID : word;
offset : word;
Text : string);
procedure TDialogBox.SetOffsetListBox (
ListID : longint;
offset : word);
procedure TDialogBox.ClearListBox (
ListID : dword);
function TDialogBox.AddListBoxItem (
ListID : dword;
Text : string): boolean;
end;
[LISTING THREE]
EditWindow = object (TDocument)
ewNext : EditWindow;
ewPrev : EditWindow;
ewWDW : word;
ewDOC : word;
ewType : DocTypes;
ewUndo : record
X : byte;
Y : word;
Len : word;
Buf : MemHandle
end;
ewFirstMark ,
ewCursMark : record
XY: word;
dX: word
end;
procedure EditWindow.OpenFile (
var Status : QPErrors;
Col : tWindowColors;
DOC : word;
WDW : word;
Locked : boolean;
dtType : DocTypes;
IsNew : boolean;
Time : LongInt;
Coord : lRect;
Title : PathStr;
TextHandle: MemHandle;
TextSize: word);
procedure EditWindow.DuplicateWindow;
procedure EditWindow.SaveFile (var Status: QPErrors; FileName: PathStr;
DefaultExt: ExtStr);
procedure EditWindow.CloseWindow; override;
procedure EditWindow.CloseDocument;
function EditWindow.NbLines: word; override;
function EditWindow.NbColumns: word; override;
function EditWindow.GetLine (Column,Line,Len: word; var Buffer): word; override;
function EditWindow.GetLineLength (Line: word): word; override;
procedure EditWindow.GetPhysLine (Column,Line,Len: word; var Cells); override;
procedure EditWindow.GetChar (Key: word); override;
function EditWindow.CopyBlock2ClipBoard: boolean; override;
procedure EditWindow.MountWindow; override;
procedure EditWindow.UnMountWindow; override;
procedure EditWindow.ModifyLine (Line: word; PosX,PosY: word);
procedure EditWindow.ModifyEOF (Line: word; PosX,PosY: word);
end;
{=====================
An instance of an object of type EditWindow; here, the object Edit is passed èto the procedure InternalReplaceChar.
=====================}
procedure InternalReplaceChar (
Edit : EditWindow; { <== object declared}
AtX,AtY : word;
Ch : Char);
var
Pt : pFileText;
Pl : pFileLines;
Pi : pFileLinesInfo;
begin {InternalReplaceChar}
with Documents[Edit.ewDOC] do begin
__SaveLineForUndo (Edit, AtX,AtY);
FarLockMem2 (dLines,Pl, dText,Pt);
if __CheckAndExpandIfInTab (
EditorError,
Edit.ewDOC,
Pt, Pl,
AtX, AtX, AtY) then begin
Pt^[Pl^[AtY]+AtX] := Ch;
OneSourceModified := true;
dUsed := true;
dTime := GetDateTime;
FarUnLockMem2 (dLines,dText);
if dMarkModif then begin
{$IFDEF DEBUG}
Assertion (dInfo <> NullMemHandle, __LINE__, SourceName);
{$ENDIF}
FarLockMem1 (dInfo, Pi);
Pi^[AtY] := 0;
FarUnLockMem1 (dInfo)
end
end
else
ExtendedErrorBox (false, EditorError, true, dFileName)
end
end; {InternalReplaceChar}
*)
{================
The Openfile [method?] [procedure declaration?].
================}
{-----------------------------------------------------------------------}
{ OpenFile}
{-----------------------------------------------------------------------}
procedure OpenFile (
var Status : QPErrors;
var Edit : EditWindow;
Mode : OpenFileModes;
dtType : DocTypes;
FileName : PathStr;
DefaultExt : ExtStr);
label Error;èvar
H : FileHandle;
Size : dword;
wdw : word;
doc : word;
Time : LongInt;
Ht : MemHandle;
Pt : pFileText;
Dummy : QPErrors;
Locked : boolean;
begin {OpenFile}
{Check if it's possible to open a new document}
Edit := NIL; H := 0; Ht := NullMemHandle;
if CheckFileNameNotAlreadyLoaded (FileName, DefaultExt) <> 0 then begin
Status := ErrFileAlreadyLoaded;
goto Error
end;
{===================
Using the OpenFile procedure
===================}
New (Edit); {Memory Allocated for the object Edit}
Edit.OpenFile (Status,
wcEditWindows,
Doc,
wdw,
Locked,
dtType,
Mode = ofUntitled,
Time,
NULL,
FileName,
Ht,
Size);
if Status <> ErrNone then begin
Error:
if Ht <> NullMemHandle then FarFreeMem (Ht);
if H <> 0 then DosCloseFile (Dummy, H);
if Edit <> NIL then begin
Dispose (Edit); Edit := NIL
end;
{ExtendedErrorBox (false, Status, true, FileName)}
end
end; {OpenFile}