home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / CPROG / DDJ1289.ZIP / MOUHANNA.LST < prev    next >
File List  |  1989-10-30  |  12KB  |  355 lines
  1. _THE QUICKPASCAL IN QUICKPASCAL_
  2. by Joseph Mouhanna and Michael Vose
  3.  
  4.  
  5. [LISTING ONE]
  6.  
  7. {Top Window Object}
  8. TWindow         =   OBJECT
  9.     Client  :   Rect;
  10.     Coord    :   Rect;
  11.     TCoord    :   Rect;
  12.     Handle  :   word;
  13.     Shadow  :   boolean;
  14.     Col     :   tWindowColors;
  15.     Captured:   boolean;
  16.     Class    :   WindowClasses;
  17.     Bitmap    :   pointer;
  18.  
  19.     TimeOutState: byte;
  20.     ForceTimeOut: boolean;
  21.     CursMode:   CursorModes;
  22.     CursX   :   word;
  23.     CursY   :   word;
  24.  
  25. procedure TWindow.OpenWindow (Class: WindowClasses; x,y,w,h: word;
  26.        Col: tWindowColors; Shadow: boolean);
  27. procedure TWindow.DrawWindow (Clip: lRect);
  28. procedure TWindow.CloseWindow;
  29. procedure TWindow.MoveWindow (x,y: word);
  30. procedure TWindow.ChangeWindow (x,y,w,h: word);
  31. procedure TWindow.MountWindow;
  32. procedure TWindow.UnMountWindow;
  33. procedure TWindow.GetClientArea (var Client: Rect);
  34. procedure TWindow.WrtChars (var C; Len,x,y: word);
  35. procedure TWindow.WrtCharsAttr (var C; Attr,Len,x,y: word);
  36. procedure TWindow.WrtExtendedCharsAttr (var C; Attr1,Attr2,Len,Width,x,y: word);
  37. procedure TWindow.WrtNAttr (Attr,Len,x,y: word);
  38. procedure TWindow.WrtCells (var C; Len,x,y: word);
  39. procedure TWindow.WrtFrame (F: FramePartsSet; Attr,x,y,w,h: word);
  40. procedure TWindow.WrtSeparator (RightCorner: boolean; Attr,y: word);
  41. procedure TWindow.ScrollUp (Lines, Attr,x,y,w,h: word);
  42. procedure TWindow.ScrollDown (Lines, Attr,x,y,w,h: word);
  43. procedure TWindow.ScrollLeft (Rows, Attr,x,y,w,h: word);
  44. procedure TWindow.ScrollRight (Rows, Attr,x,y,w,h: word);
  45. procedure TWindow.CaptureMouse;
  46. procedure TWindow.UnCaptureMouse;
  47. procedure TWindow.PressLMouse (DbleClicked: boolean; x,y: integer);
  48. procedure TWindow.ReleaseLMouse (x,y: integer);
  49. procedure TWindow.PressRMouse (DbleClicked: boolean; x,y: integer);
  50. procedure TWindow.ReleaseRMouse (x,y: integer);
  51. procedure TWindow.MoveMouse (x,y: integer);
  52. procedure TWindow.PosCursor (x,y: word);
  53. procedure TWindow.SetCursorMode (Mode: CursorModes);
  54. procedure TWindow.GetChar (Key: word);
  55. procedure TWindow.TimeOut;
  56. procedure TWindow.RefreshStatusLine;
  57. end;
  58.  
  59.  
  60.  
  61. [LISTING TWO]
  62.  
  63. TDialogBox =  object (TWindow)
  64.               First       :   pDialogBoxItem;
  65.               Current     :   pDialogBoxItem;
  66.               Command     :   function (Dialog: TDialogBox; ID:word): boolean;
  67.               ID      :   word;
  68.               HelpNO      :   word;
  69.               UndoID      :   word;
  70.               ValidID     :   word;
  71.               Appli       :   TDialogBoxAppli;
  72.               MouseAction :   MouseActions;
  73.               TitleColor  :   boolean;
  74. {$IFDEF DEBUG}
  75.                HeapPtr        :    pointer;
  76. {$ENDIF}            
  77.  
  78. procedure TDialogBox.OpenDialogBox (CheckPrevW  : boolean;
  79. w,h         : word;
  80. Command     : pointer;
  81. HelpNO      : word;
  82. UndoID      : word;
  83. ValidID     : word);
  84.  
  85. procedure TDialogBox.Call (var ID: word);
  86. procedure TDialogbox.GetChar (Key: word); override;
  87. procedure TDialogBox.CloseWindow; override;
  88. procedure TDialogBox.DrawWindow (Clip: lRect); override;
  89. procedure TDialogBox.PressLMouse (DbleClicked: boolean; x,y: integer); override;
  90. procedure TDialogBox.PressRMouse (DbleClicked: boolean; x,y: integer); override;
  91. procedure TDialogBox.ReleaseLMouse (x,y: integer); override;
  92. procedure TDialogBox.MoveMouse (x,y: integer); override;
  93. procedure TDialogBox.SelectDialogBoxItem (ID: word);
  94. procedure TDialogBox.TimeOut; override;
  95. procedure TDialogBox.DelDialogBoxItem (ID: word);
  96. procedure TDialogBox.AddComment (
  97.           CommID      : word;
  98.           AltID       : word;
  99.           x,y,w       : word;
  100.           Text        : String;
  101.           justif      : Justifications);
  102. procedure TDialogBox.AddFrame (
  103.           FrameID     : word;
  104.           AltID       : word;
  105.           x,y,w,h     : word;
  106.           Text        : String);
  107. procedure TDialogBox.AddSysButton (
  108.           TabID       : word;
  109.           SysID       : SysButtons;
  110.           justif      : Justifications);
  111. procedure TDialogBox.AddDlgText (
  112.           TabID       : word;
  113.           DlgID       : word;
  114.           Size        : word;
  115.           x,y,w       : word;è          Text        : String);
  116. procedure TDialogBox.AddPushButton (
  117.           TabID       : word;
  118.           PushID      : word;
  119.           x,y         : word;
  120.           State       : boolean);
  121. procedure TDialogBox.AddRadioButton (
  122.           TabID       : word;
  123.           GroupID     : word;
  124.           RadioID     : word;
  125.           LinkID      : word;
  126.           x,y         : word;
  127.           State       : boolean;
  128.           Trace       : pointer);
  129. procedure TDialogBox.AddListBox (
  130.           TabID       : word;
  131.           ListID      : word;
  132.           Columns     : word;
  133.           x,y,w,h     : word;
  134.           LinkID      : word;
  135.           Trace       : pointer);
  136. procedure TDialogBox.DrawComment (
  137.           p           : pDialogBoxItem);
  138. procedure TDialogBox.DrawFrame (
  139.           F           : FramePartsSet;
  140.           p           : pDialogBoxItem);
  141. procedure TDialogBox.DrawSysButton (
  142.       Hilite      : boolean;
  143.           p           : pDialogBoxItem);
  144. procedure TDialogBox.DrawDlgText (
  145.           p           : pDialogBoxItem);
  146. procedure TDialogBox.DrawPushButton (
  147.           p           : pDialogBoxItem);
  148. procedure TDialogBox.DrawRadioButton (
  149.           p           : pDialogBoxItem);
  150. procedure TDialogBox.DrawListBox (
  151.           p           : pDialogBoxItem);
  152. procedure TDialogBox.SetComment (
  153.           CommID      : word;
  154.           Text        : String);
  155. procedure TDialogBox.GetComment (
  156.           CommID      : word;
  157.       var Text        : String);
  158. procedure TDialogBox.GetDlgText (
  159.           DlgID       : word;
  160.       var Text        : string);
  161. procedure TDialogBox.SetDlgText (
  162.           DlgID       : word;
  163.           Text        : String);
  164. procedure TDialogBox.SetLockState (
  165.           DlgID       : word;
  166.           Lock        : Boolean);
  167. procedure TDialogBox.GetPushButton (
  168.           PushID      : word;
  169.       var State       : boolean);èprocedure TDialogBox.SetPushButton (
  170.           PushID      : word;
  171.              State       : boolean);
  172. procedure TDialogBox.GetRadioButton (
  173.           GroupID     : word;
  174.       var ID          : word);
  175. procedure TDialogBox.SetRadioButton (
  176.           GroupID     : word;
  177.           ID          : word);
  178. procedure TDialogBox.GetTextListBox (
  179.           ListID      : word;
  180.       var Text        : string);
  181. procedure TDialogBox.GetOffsetListBox (
  182.           ListID      : word;
  183.       var Offset      : word);
  184. procedure TDialogBox.SetTextListBox (
  185.           ListID      : word;
  186.           offset      : word;
  187.           Text        : string);
  188. procedure TDialogBox.SetOffsetListBox (
  189.           ListID      : longint;
  190.           offset      : word);
  191. procedure TDialogBox.ClearListBox (
  192.           ListID      : dword);
  193. function TDialogBox.AddListBoxItem (
  194.           ListID      : dword;
  195.           Text        : string): boolean;
  196. end;
  197.  
  198.  
  199.  
  200. [LISTING THREE]
  201.  
  202. EditWindow      =   object (TDocument)
  203.                   ewNext      :   EditWindow;
  204.                   ewPrev      :   EditWindow;
  205.                   ewWDW       :   word;
  206.                   ewDOC       :   word;
  207.                   ewType      :   DocTypes;
  208.                   ewUndo      :      record
  209.                   X           :   byte;
  210.                     Y            :   word;
  211.                      Len         :      word;
  212.                     Buf         :      MemHandle
  213.                   end;
  214.  
  215.                 ewFirstMark ,
  216.                 ewCursMark    :    record
  217.                    XY: word;
  218.                    dX: word
  219.                   end;
  220.  
  221. procedure EditWindow.OpenFile (
  222. var Status    :    QPErrors; 
  223. Col        :    tWindowColors;
  224. DOC        :    word;
  225. WDW        :    word;
  226. Locked            :    boolean;
  227.     dtType    :    DocTypes; 
  228.     IsNew    :    boolean; 
  229.     Time    :    LongInt; 
  230.     Coord    :    lRect;
  231.     Title    :    PathStr; 
  232.     TextHandle:     MemHandle; 
  233.     TextSize:    word);
  234.         
  235. procedure EditWindow.DuplicateWindow;
  236. procedure EditWindow.SaveFile (var Status: QPErrors; FileName: PathStr; 
  237.                                                            DefaultExt: ExtStr);
  238. procedure EditWindow.CloseWindow; override;
  239. procedure EditWindow.CloseDocument;
  240. function EditWindow.NbLines: word; override;
  241. function EditWindow.NbColumns: word; override;
  242. function EditWindow.GetLine (Column,Line,Len: word; var Buffer): word; override;
  243. function EditWindow.GetLineLength (Line: word): word; override;
  244. procedure EditWindow.GetPhysLine (Column,Line,Len: word; var Cells); override;
  245. procedure EditWindow.GetChar (Key: word); override;
  246. function EditWindow.CopyBlock2ClipBoard: boolean; override;
  247. procedure EditWindow.MountWindow; override;
  248. procedure EditWindow.UnMountWindow; override;
  249. procedure EditWindow.ModifyLine (Line: word;  PosX,PosY:  word);
  250. procedure EditWindow.ModifyEOF (Line: word;  PosX,PosY:  word);
  251. end;
  252.  
  253. {=====================
  254. An instance of an object of type EditWindow; here, the object Edit is passed èto the procedure InternalReplaceChar.
  255. =====================}
  256.  
  257. procedure InternalReplaceChar (
  258.                             Edit        :   EditWindow; { <== object declared}
  259.                             AtX,AtY     :   word;
  260.                             Ch          :   Char);
  261. var    
  262.     Pt        : pFileText;
  263.     Pl        : pFileLines;
  264.     Pi        : pFileLinesInfo;
  265. begin {InternalReplaceChar}
  266.     with Documents[Edit.ewDOC] do begin
  267.         __SaveLineForUndo (Edit, AtX,AtY);
  268.         FarLockMem2 (dLines,Pl, dText,Pt);
  269.         if __CheckAndExpandIfInTab (
  270.             EditorError,
  271.             Edit.ewDOC,
  272.             Pt, Pl,
  273.             AtX, AtX, AtY) then begin
  274.         Pt^[Pl^[AtY]+AtX] := Ch;
  275.             OneSourceModified := true;
  276.             dUsed := true;
  277.             dTime := GetDateTime;
  278.             FarUnLockMem2 (dLines,dText);
  279.             if dMarkModif then begin
  280.             {$IFDEF DEBUG}
  281.         Assertion (dInfo <> NullMemHandle, __LINE__, SourceName);
  282.             {$ENDIF}    
  283.                 FarLockMem1 (dInfo, Pi); 
  284.                 Pi^[AtY] := 0; 
  285.                 FarUnLockMem1 (dInfo)
  286.             end
  287.         end
  288.         else
  289.             ExtendedErrorBox (false, EditorError, true, dFileName)
  290.     end    
  291. end;  {InternalReplaceChar}
  292. *)
  293.  
  294. {================
  295. The Openfile [method?] [procedure declaration?].
  296. ================}
  297.  
  298. {-----------------------------------------------------------------------}
  299. { OpenFile}    
  300. {-----------------------------------------------------------------------}
  301. procedure OpenFile (
  302.     var Status            :    QPErrors;
  303.     var Edit            :    EditWindow;
  304.         Mode             :    OpenFileModes;
  305.         dtType            :    DocTypes; 
  306.                FileName        :    PathStr; 
  307.                DefaultExt        :    ExtStr);
  308. label Error;èvar    
  309.     H       :   FileHandle;
  310.     Size    :   dword;
  311.     wdw     :   word;
  312.     doc     :   word;
  313.     Time    :   LongInt;
  314.     Ht        :   MemHandle;
  315.     Pt      :   pFileText;
  316.     Dummy    :   QPErrors;
  317.     Locked    :   boolean;
  318. begin {OpenFile}
  319. {Check if it's possible to open a new document}
  320.     Edit := NIL; H := 0; Ht := NullMemHandle;
  321.     if CheckFileNameNotAlreadyLoaded (FileName, DefaultExt) <> 0 then begin
  322.         Status := ErrFileAlreadyLoaded;
  323.         goto Error
  324.     end;
  325.     
  326. {===================
  327. Using the OpenFile procedure
  328. ===================}
  329.  
  330.     New (Edit);     {Memory Allocated for the object Edit}
  331.     Edit.OpenFile (Status, 
  332.                     wcEditWindows,
  333.                     Doc, 
  334.                     wdw,
  335.                     Locked, 
  336.                     dtType, 
  337.                     Mode = ofUntitled, 
  338.                     Time, 
  339.                     NULL,
  340.                     FileName, 
  341.                     Ht, 
  342.                     Size);
  343.     if Status <> ErrNone then begin
  344. Error:
  345.         if Ht <> NullMemHandle then FarFreeMem (Ht);
  346.         if H <> 0 then DosCloseFile (Dummy, H); 
  347.         if Edit <> NIL then begin
  348.             Dispose (Edit); Edit := NIL
  349.         end;
  350.         {ExtendedErrorBox (false, Status, true, FileName)}
  351.     end    
  352. end;  {OpenFile}
  353.  
  354.  
  355.