fpusrscr.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. User screen support routines
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$i globdir.inc}
  13. unit FPUsrScr;
  14. interface
  15. uses
  16. {$ifdef win32}
  17. windows,
  18. {$endif win32}
  19. video,Objects;
  20. type
  21. PScreen = ^TScreen;
  22. TScreen = object(TObject)
  23. function GetWidth: integer; virtual;
  24. function GetHeight: integer; virtual;
  25. procedure GetLine(Line: integer; var Text, Attr: string); virtual;
  26. procedure GetCursorPos(var P: TPoint); virtual;
  27. { copy the initial video screen in the ide screen }
  28. procedure Capture; virtual;
  29. { move up or down if supported by OS }
  30. function Scroll(i : integer) : integer; virtual;
  31. { saves the current IDE screen }
  32. procedure SaveIDEScreen; virtual;
  33. { saves the current console screen }
  34. procedure SaveConsoleScreen; virtual;
  35. { restores the saved console screen }
  36. procedure SwitchToConsoleScreen; virtual;
  37. { restores the saved IDE screen }
  38. procedure SwitchBackToIDEScreen; virtual;
  39. end;
  40. {$ifdef DOS}
  41. TDOSVideoInfo = record
  42. Mode : word;
  43. ScreenSize: word;
  44. Page : byte;
  45. Rows,Cols : integer;
  46. CurPos : TPoint;
  47. CurShapeT : integer;
  48. CurShapeB : integer;
  49. StateSize : word;
  50. StateBuf : pointer;
  51. end;
  52. PDOSScreen = ^TDOSScreen;
  53. TDOSScreen = object(TScreen)
  54. constructor Init;
  55. destructor Done; virtual;
  56. public
  57. function GetWidth: integer; virtual;
  58. function GetHeight: integer; virtual;
  59. procedure GetLine(Line: integer; var Text, Attr: string); virtual;
  60. procedure GetCursorPos(var P: TPoint); virtual;
  61. procedure Capture; virtual;
  62. procedure SaveIDEScreen; virtual;
  63. procedure SaveConsoleScreen; virtual;
  64. procedure SwitchToConsoleScreen; virtual;
  65. procedure SwitchBackToIDEScreen; virtual;
  66. private
  67. ConsoleVideoInfo : TDOSVideoInfo;
  68. VBufferSize : longint;
  69. VIDEBufferSize : longint;
  70. VBuffer : PByteArray;
  71. VIDEBuffer : PByteArray;
  72. IDEVideoInfo : TDOSVideoInfo;
  73. ctrl_c_state : boolean;
  74. function GetLineStartOfs(Line: integer): word;
  75. procedure GetBuffer(Size: word);
  76. procedure FreeBuffer;
  77. procedure GetVideoMode(var MI: TDOSVideoInfo);
  78. procedure SetVideoMode(MI: TDOSVideoInfo);
  79. end;
  80. {$endif}
  81. {$ifdef Unix}
  82. PLinuxScreen = ^TLinuxScreen;
  83. TLinuxScreen = object(TScreen)
  84. constructor Init;
  85. destructor Done; virtual;
  86. public
  87. function GetWidth: integer; virtual;
  88. function GetHeight: integer; virtual;
  89. procedure GetLine(Line: integer; var Text, Attr: string); virtual;
  90. procedure GetCursorPos(var P: TPoint); virtual;
  91. procedure Capture; virtual;
  92. procedure SaveIDEScreen; virtual;
  93. procedure SaveConsoleScreen; virtual;
  94. procedure SwitchToConsoleScreen; virtual;
  95. procedure SwitchBackToIDEScreen; virtual;
  96. private
  97. IDE_screen: pvideobuf;
  98. IDE_size : longint;
  99. end;
  100. {$endif}
  101. {$ifdef win32}
  102. PWin32Screen = ^TWin32Screen;
  103. TWin32Screen = object(TScreen)
  104. constructor Init;
  105. destructor Done; virtual;
  106. public
  107. function GetWidth: integer; virtual;
  108. function GetHeight: integer; virtual;
  109. procedure GetLine(Line: integer; var Text, Attr: string); virtual;
  110. procedure GetCursorPos(var P: TPoint); virtual;
  111. function Scroll(i : integer) : integer; virtual;
  112. procedure Capture; virtual;
  113. procedure SaveIDEScreen; virtual;
  114. procedure SaveConsoleScreen; virtual;
  115. procedure SwitchToConsoleScreen; virtual;
  116. procedure SwitchBackToIDEScreen; virtual;
  117. private
  118. DosScreenBufferHandle,
  119. IDEScreenBufferHandle,
  120. StartScreenBufferHandle,
  121. NewScreenBufferHandle : THandle;
  122. IDEActive : boolean;
  123. ConsoleMode,IdeMode : Dword;
  124. procedure BufferCopy(src,dest : THandle);
  125. end;
  126. {$endif}
  127. procedure InitUserScreen;
  128. procedure DoneUserScreen;
  129. const UserScreen : PScreen = nil;
  130. implementation
  131. uses
  132. Dos
  133. (* {$ifdef TP}
  134. {$ifdef DPMI}
  135. ,WinAPI
  136. {$endif}
  137. {$endif}*)
  138. {$ifdef FPC}
  139. {$ifdef GO32V2}
  140. ,Dpmiexcp, Go32
  141. {$endif}
  142. {$endif}
  143. {$ifdef VESA}
  144. ,VESA
  145. {$endif}
  146. ;
  147. function TScreen.GetWidth: integer;
  148. begin
  149. Getwidth:=0;
  150. Abstract;
  151. end;
  152. function TScreen.GetHeight: integer;
  153. begin
  154. Getheight:=0;
  155. Abstract;
  156. end;
  157. procedure TScreen.GetLine(Line: integer; var Text, Attr: string);
  158. begin
  159. Abstract;
  160. end;
  161. procedure TScreen.GetCursorPos(var P: TPoint);
  162. begin
  163. Abstract;
  164. end;
  165. procedure TScreen.Capture;
  166. begin
  167. Abstract;
  168. end;
  169. procedure TScreen.SwitchToConsoleScreen;
  170. begin
  171. Abstract;
  172. end;
  173. procedure TScreen.SwitchBackToIDEScreen;
  174. begin
  175. Abstract;
  176. end;
  177. procedure TScreen.SaveIDEScreen;
  178. begin
  179. Abstract;
  180. end;
  181. function TScreen.Scroll(i : integer) : integer;
  182. begin
  183. Scroll:=0;
  184. end;
  185. procedure TScreen.SaveConsoleScreen;
  186. begin
  187. Abstract;
  188. end;
  189. {****************************************************************************
  190. TDOSScreen
  191. ****************************************************************************}
  192. {$ifdef DOS}
  193. constructor TDOSScreen.Init;
  194. begin
  195. inherited Init;
  196. Capture;
  197. { get the current ctrl-C state }
  198. Ctrl_c_state:=djgpp_set_ctrl_c(false);
  199. djgpp_set_ctrl_c(Ctrl_c_state);
  200. end;
  201. destructor TDOSScreen.Done;
  202. begin
  203. FreeBuffer;
  204. if assigned(VIDEBuffer) then
  205. FreeMem(VIDEBuffer,VIDEBufferSize);
  206. inherited Done;
  207. end;
  208. function TDOSScreen.GetWidth: integer;
  209. begin
  210. GetWidth:=ConsoleVideoInfo.Cols;
  211. end;
  212. function TDOSScreen.GetHeight: integer;
  213. begin
  214. GetHeight:=ConsoleVideoInfo.Rows;
  215. end;
  216. procedure TDOSScreen.GetLine(Line: integer; var Text, Attr: string);
  217. var X: integer;
  218. W: word;
  219. begin
  220. Text:=''; Attr:='';
  221. if Line<GetHeight then
  222. begin
  223. W:=GetLineStartOfs(Line);
  224. for X:=0 to GetWidth-1 do
  225. begin
  226. {Text:=Text+chr(VBuffer^[W+X*2]);
  227. Attr:=Attr+chr(VBuffer^[W+X*2+1]);}
  228. System.Insert(chr(VBuffer^[W+X*2]),Text,Length(Text)+1);
  229. System.Insert(chr(VBuffer^[W+X*2+1]),Attr,Length(Attr)+1);
  230. end;
  231. end;
  232. end;
  233. procedure TDOSScreen.GetCursorPos(var P: TPoint);
  234. begin
  235. P:=ConsoleVideoInfo.CurPos;
  236. end;
  237. procedure TDOSScreen.Capture;
  238. begin
  239. SaveConsoleScreen;
  240. end;
  241. procedure TDosScreen.SaveIDEScreen;
  242. var
  243. VSeg,SOfs: word;
  244. begin
  245. GetVideoMode(IDEVideoInfo);
  246. { First keep a copy of IDE screen }
  247. if ConsoleVideoInfo.Mode=7 then
  248. VSeg:=SegB000
  249. else
  250. VSeg:=SegB800;
  251. SOfs:=MemW[Seg0040:$4e];
  252. if not assigned(VIDEBuffer) or (VIDEBufferSize<>IDEVideoInfo.ScreenSize) then
  253. begin
  254. if assigned(VIDEBuffer) then
  255. FreeMem(VIDEBuffer,VIDEBufferSize);
  256. GetMem(VIDEBuffer,IDEVideoInfo.ScreenSize);
  257. VIDEBufferSize:=IDEVideoInfo.ScreenSize;
  258. end;
  259. {$ifdef FPC}
  260. DosmemGet(VSeg,SOfs,VIDEBuffer^,IDEVideoInfo.ScreenSize);
  261. {$else}
  262. Move(ptr(VSeg,SOfs)^,VIDEBuffer^,IDEVideoInfo.ScreenSize);
  263. {$endif}
  264. end;
  265. procedure TDosScreen.SaveConsoleScreen;
  266. var
  267. VSeg,SOfs: word;
  268. begin
  269. GetVideoMode(ConsoleVideoInfo);
  270. GetBuffer(ConsoleVideoInfo.ScreenSize);
  271. if ConsoleVideoInfo.Mode=7 then
  272. VSeg:=SegB000
  273. else
  274. VSeg:=SegB800;
  275. SOfs:=MemW[Seg0040:$4e];
  276. {$ifdef FPC}
  277. DosmemGet(VSeg,SOfs,VBuffer^,ConsoleVideoInfo.ScreenSize);
  278. {$else}
  279. Move(ptr(VSeg,SOfs)^,VBuffer^,ConsoleVideoInfo.ScreenSize);
  280. {$endif}
  281. end;
  282. procedure TDOSScreen.SwitchToConsoleScreen;
  283. var
  284. VSeg,SOfs: word;
  285. begin
  286. SetVideoMode(ConsoleVideoInfo);
  287. if ConsoleVideoInfo.Mode=7 then
  288. VSeg:=SegB000
  289. else
  290. VSeg:=SegB800;
  291. SOfs:=MemW[Seg0040:$4e];
  292. {$ifdef FPC}
  293. DosmemPut(VSeg,SOfs,VBuffer^,ConsoleVideoInfo.ScreenSize);
  294. djgpp_set_ctrl_c(Ctrl_c_state);
  295. {$else}
  296. Move(VBuffer^,ptr(VSeg,SOfs)^,ConsoleVideoInfo.ScreenSize);
  297. {$endif}
  298. end;
  299. procedure TDOSScreen.SwitchBackToIDEScreen;
  300. var
  301. VSeg,SOfs: word;
  302. begin
  303. SetVideoMode(IDEVideoInfo);
  304. if ConsoleVideoInfo.Mode=7 then
  305. VSeg:=SegB000
  306. else
  307. VSeg:=SegB800;
  308. SOfs:=MemW[Seg0040:$4e];
  309. if assigned(VIDEBuffer) then
  310. {$ifdef FPC}
  311. DosmemPut(VSeg,SOfs,VIDEBuffer^,IDEVideoInfo.ScreenSize);
  312. Ctrl_c_state := djgpp_set_ctrl_c(false);
  313. {$else}
  314. Move(VIDEBuffer^,ptr(VSeg,SOfs)^,IDEVideoInfo.ScreenSize);
  315. {$endif}
  316. end;
  317. function TDOSScreen.GetLineStartOfs(Line: integer): word;
  318. begin
  319. GetLineStartOfs:=(ConsoleVideoInfo.Cols*Line)*2;
  320. end;
  321. procedure TDOSScreen.GetBuffer(Size: word);
  322. begin
  323. if (VBuffer<>nil) and (VBufferSize=Size) then Exit;
  324. if VBuffer<>nil then FreeBuffer;
  325. VBufferSize:=Size;
  326. GetMem(VBuffer,VBufferSize);
  327. end;
  328. procedure TDOSScreen.FreeBuffer;
  329. begin
  330. if (VBuffer<>nil) and (VBufferSize>0) then FreeMem(VBuffer,VBufferSize);
  331. VBuffer:=nil;
  332. end;
  333. procedure TDOSScreen.GetVideoMode(var MI: TDOSVideoInfo);
  334. var
  335. r: registers;
  336. {$ifdef TP}
  337. P: pointer;
  338. Sel: longint;
  339. (* {$I realintr.inc} *)
  340. {$endif}
  341. begin
  342. if (MI.StateSize>0) and (MI.StateBuf<>nil) then
  343. begin FreeMem(MI.StateBuf,MI.StateSize); MI.StateBuf:=nil; end;
  344. MI.ScreenSize:=MemW[Seg0040:$4c];
  345. r.ah:=$0f;
  346. intr($10,r);
  347. MI.Mode:=r.al;
  348. MI.Page:=r.bh;
  349. MI.Cols:=r.ah;
  350. {$ifdef VESA}
  351. VESAGetMode(MI.Mode);
  352. {$endif}
  353. MI.Rows:=MI.ScreenSize div (MI.Cols*2);
  354. if MI.Rows=51 then MI.Rows:=50;
  355. r.ah:=$03;
  356. r.bh:=MI.Page;
  357. intr($10,r);
  358. with MI do
  359. begin
  360. CurPos.X:=r.dl; CurPos.Y:=r.dh;
  361. CurShapeT:=r.ch; CurShapeB:=r.cl;
  362. end;
  363. (*
  364. {$ifdef TP}
  365. { check VGA functions }
  366. MI.StateSize:=0;
  367. r.ah:=$1c; r.al:=0; r.cx:=7; intr($10,r);
  368. if (r.al=$1c) and ((r.flags and fCarry)=0) and (r.bx>0) then
  369. begin
  370. MI.StateSize:=r.bx;
  371. GetMem(MI.StateBuf,MI.StateSize); FillChar(MI.StateBuf^,MI.StateSize,0);
  372. P:=MI.StateBuf;
  373. {$ifdef DPMI}
  374. Sel:=GlobalDosAlloc(MI.StateSize);
  375. P:=Ptr(Sel shr 16,0);
  376. {$endif}
  377. r.ah:=$1c; r.al:=1; r.cx:=7;
  378. r.es:=PtrRec(P).Seg; r.bx:=PtrRec(P).Ofs;
  379. {$ifdef DPMI}realintr($10,r);{$else}intr($10,r);{$endif}
  380. {$ifdef DPMI}
  381. Move(Ptr(Sel and $ffff,0)^,MI.StateBuf^,MI.StateSize);
  382. GlobalDosFree(Sel and $ffff);
  383. {$endif}
  384. end;
  385. {$endif}
  386. *)
  387. end;
  388. procedure TDOSScreen.SetVideoMode(MI: TDOSVideoInfo);
  389. var r: registers;
  390. CM: TDOSVideoInfo;
  391. {$ifdef TP}
  392. P: pointer;
  393. Sel: longint;
  394. {$I realintr.inc}
  395. {$endif}
  396. begin
  397. FillChar(CM,sizeof(CM),0);
  398. GetVideoMode(CM);
  399. if (CM.Mode<>MI.Mode) or (CM.Cols<>MI.Cols) or (CM.Rows<>MI.Rows) then
  400. begin
  401. {$ifdef VESA}
  402. if MI.Mode>=$100 then
  403. VESASetMode(MI.Mode)
  404. else
  405. {$endif}
  406. begin
  407. r.ah:=$00; r.al:=MI.Mode; intr($10,r);
  408. end;
  409. if (MI.Mode=3) and (MI.Cols=80) and (MI.Rows=50) then
  410. begin
  411. r.ax:=$1112; r.bx:=$0;
  412. intr($10,r);
  413. end;
  414. end;
  415. r.ah:=$05; r.al:=MI.Page; intr($10,r);
  416. r.ah:=$02; r.bh:=MI.Page; r.dl:=MI.CurPos.X; r.dh:=MI.CurPos.Y; intr($10,r);
  417. r.ah:=$01; r.ch:=MI.CurShapeT; r.cl:=MI.CurShapeB; intr($10,r);
  418. (*
  419. {$ifdef TP}
  420. if (MI.StateSize>0) and (MI.StateBuf<>nil) then
  421. begin
  422. P:=MI.StateBuf;
  423. {$ifdef DPMI}
  424. Sel:=GlobalDosAlloc(MI.StateSize);
  425. Move(MI.StateBuf^,ptr(Sel and $ffff,0)^,MI.StateSize);
  426. P:=Ptr(Sel shr 16,0);
  427. {$endif}
  428. r.ah:=$1c; r.al:=2; r.cx:=7;
  429. r.es:=PtrRec(P).Seg; r.bx:=PtrRec(P).Ofs;
  430. {$ifdef DPMI}realintr($10,r);{$else}intr($10,r);{$endif}
  431. {$ifdef DPMI}
  432. GlobalDosFree(Sel and $ffff);
  433. {$endif}
  434. end;
  435. {$endif}
  436. *)
  437. end;
  438. {$endif}
  439. {****************************************************************************
  440. TLinuxScreen
  441. ****************************************************************************}
  442. {$ifdef Unix}
  443. constructor TLinuxScreen.Init;
  444. begin
  445. inherited Init;
  446. IDE_screen := nil;
  447. end;
  448. destructor TLinuxScreen.Done;
  449. begin
  450. inherited Done;
  451. end;
  452. function TLinuxScreen.GetWidth: integer;
  453. begin
  454. GetWidth:=ScreenWidth;
  455. end;
  456. function TLinuxScreen.GetHeight: integer;
  457. begin
  458. GetHeight:=ScreenHeight;
  459. end;
  460. procedure TLinuxScreen.GetLine(Line: integer; var Text, Attr: string);
  461. begin
  462. Text:='';
  463. Attr:='';
  464. end;
  465. procedure TLinuxScreen.GetCursorPos(var P: TPoint);
  466. begin
  467. P.X:=0;
  468. P.Y:=0;
  469. end;
  470. procedure TLinuxScreen.Capture;
  471. begin
  472. end;
  473. procedure TLinuxScreen.SaveIDEScreen;
  474. begin
  475. if assigned(IDE_screen) then
  476. dispose(IDE_screen);
  477. getmem(IDE_screen,videobufsize);
  478. Ide_size:=videobufsize;
  479. move(videobuf^,IDE_screen^,videobufsize);
  480. end;
  481. procedure TLinuxScreen.SaveConsoleScreen;
  482. begin
  483. end;
  484. procedure TLinuxScreen.SwitchToConsoleScreen;
  485. begin
  486. end;
  487. procedure TLinuxScreen.SwitchBackToIDEScreen;
  488. begin
  489. if IDE_screen = nil then
  490. exit;
  491. move(IDE_screen^,videobuf^,videobufsize);
  492. freemem(IDE_screen,Ide_size);
  493. IDE_screen := nil;
  494. end;
  495. {$endif}
  496. {****************************************************************************
  497. TWin32Screen
  498. ****************************************************************************}
  499. {$ifdef win32}
  500. procedure UpdateFileHandles;
  501. begin
  502. {StdInputHandle:=longint(GetStdHandle(STD_INPUT_HANDLE));}
  503. StdOutputHandle:=longint(GetStdHandle(STD_OUTPUT_HANDLE));
  504. {StdErrorHandle:=longint(GetStdHandle(STD_ERROR_HANDLE));}
  505. TextRec(Output).Handle:=StdOutputHandle;
  506. TextRec(StdOut).Handle:=StdOutputHandle;
  507. {TextRec(StdErr).Handle:=StdErrorHandle;}
  508. end;
  509. constructor TWin32Screen.Init;
  510. var
  511. SecurityAttr : Security_attributes;
  512. BigWin : Coord;
  513. res : longbool;
  514. Error : dword;
  515. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  516. begin
  517. inherited Init;
  518. {if GetConsoleOutputCP<>437 then
  519. res:=SetConsoleOutputCP(437);}
  520. SecurityAttr.nLength:=SizeOf(Security_attributes);
  521. SecurityAttr.lpSecurityDescriptor:=nil;
  522. SecurityAttr.bInheritHandle:=true;
  523. NewScreenBufferHandle:=CreateConsoleScreenBuffer(
  524. GENERIC_READ or GENERIC_WRITE,
  525. FILE_SHARE_READ or FILE_SHARE_WRITE,SecurityAttr,
  526. CONSOLE_TEXTMODE_BUFFER,nil);
  527. StartScreenBufferHandle:=GetStdHandle(STD_OUTPUT_HANDLE);
  528. GetConsoleMode(GetStdHandle(Std_Input_Handle), @ConsoleMode);
  529. IdeMode:=ConsoleMode;
  530. {$ifdef debug}
  531. {define win32bigwin}
  532. {$endif debug}
  533. {$ifdef win32bigwin}
  534. GetConsoleScreenBufferInfo(StartScreenBufferHandle,
  535. @ConsoleScreenBufferInfo);
  536. BigWin.X:=ConsoleScreenBufferInfo.dwSize.X;
  537. BigWin.Y:=200;
  538. { Try to allow to store more info }
  539. res:=SetConsoleScreenBufferSize(NewScreenBufferHandle,BigWin);
  540. if not res then
  541. error:=GetLastError;
  542. res:=SetConsoleScreenBufferSize(StartScreenBufferHandle,BigWin);
  543. if not res then
  544. error:=GetLastError;
  545. {$endif win32bigwin}
  546. { make sure that both Screen Handle have the sme buffer }
  547. GetConsoleScreenBufferInfo(StartScreenBufferHandle,
  548. @ConsoleScreenBufferInfo);
  549. res:=SetConsoleScreenBufferSize(NewScreenBufferHandle,
  550. ConsoleScreenBufferInfo.dwSize);
  551. if not res then
  552. error:=GetLastError;
  553. IDEScreenBufferHandle:=NewScreenBufferHandle;
  554. DosScreenBufferHandle:=StartScreenBufferHandle;
  555. Capture;
  556. SwitchBackToIDEScreen;
  557. end;
  558. destructor TWin32Screen.Done;
  559. begin
  560. { copy the Dos buffer content into the original ScreenBuffer
  561. which remains the startup std_output_handle PM }
  562. {if StartScreenBufferHandle=IDEScreenBufferHandle then}
  563. BufferCopy(DosScreenBufferHandle,IDEScreenBufferHandle);
  564. SetConsoleActiveScreenBuffer(StartScreenBufferHandle);
  565. SetStdHandle(Std_Output_Handle,StartScreenBufferHandle);
  566. UpdateFileHandles;
  567. CloseHandle(NewScreenBufferHandle);
  568. inherited Done;
  569. end;
  570. function TWin32Screen.GetWidth: integer;
  571. var
  572. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  573. begin
  574. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  575. @ConsoleScreenBufferInfo);
  576. GetWidth:=ConsoleScreenBufferInfo.dwSize.X;
  577. end;
  578. function TWin32Screen.GetHeight: integer;
  579. var
  580. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  581. begin
  582. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  583. @ConsoleScreenBufferInfo);
  584. GetHeight:=ConsoleScreenBufferInfo.dwSize.Y;
  585. end;
  586. function TWin32Screen.Scroll(i : integer) : integer;
  587. var
  588. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  589. ConsoleWindow : Small_rect;
  590. begin
  591. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  592. @ConsoleScreenBufferInfo);
  593. if (ConsoleScreenBufferInfo.srWindow.Top + i < 0) then
  594. i:= -ConsoleScreenBufferInfo.srWindow.Top;
  595. if (ConsoleScreenBufferInfo.srWindow.Bottom + i > ConsoleScreenBufferInfo.dwSize.Y) then
  596. i:= ConsoleScreenBufferInfo.dwSize.Y - ConsoleScreenBufferInfo.srWindow.Bottom;
  597. if i<>0 then
  598. begin
  599. ConsoleWindow.Left:=ConsoleScreenBufferInfo.srWindow.Left;
  600. ConsoleWindow.Right:=ConsoleScreenBufferInfo.srWindow.Right;
  601. ConsoleWindow.Top:=ConsoleScreenBufferInfo.srWindow.Top+i;
  602. ConsoleWindow.Bottom:=ConsoleScreenBufferInfo.srWindow.Bottom+i;
  603. SetConsoleWindowInfo(DosScreenBufferHandle,true,ConsoleWindow);
  604. Scroll:=i;
  605. end
  606. else
  607. Scroll:=0;
  608. end;
  609. procedure TWin32Screen.GetLine(Line: integer; var Text, Attr: string);
  610. type
  611. CharInfoArray = Array [0..255] of Char_Info;
  612. var
  613. LineBuf : ^CharInfoArray;
  614. BufSize,BufCoord : Coord;
  615. i,LineSize : longint;
  616. WriteRegion : SMALL_RECT;
  617. begin
  618. GetMem(LineBuf,SizeOf(CharInfoArray));
  619. LineSize:=ScreenWidth;
  620. If LineSize>256 then
  621. LineSize:=256;
  622. BufSize.X:=LineSize;
  623. BufSize.Y:=1;
  624. BufCoord.X:=0;
  625. BufCoord.Y:=0;
  626. with WriteRegion do
  627. begin
  628. Top :=Line;
  629. Left :=0;
  630. Bottom := Line+1;
  631. Right := LineSize-1;
  632. end;
  633. ReadConsoleOutput(DosScreenBufferHandle, PChar_info(LineBuf),
  634. BufSize, BufCoord, @WriteRegion);
  635. for i:=1 to LineSize do
  636. begin
  637. Text[i]:=LineBuf^[i-1].AsciiChar;
  638. Attr[i]:=char(byte(LineBuf^[i-1].Attributes));
  639. end;
  640. FreeMem(LineBuf,SizeOf(CharInfoArray));
  641. Text[0]:=char(byte(LineSize));
  642. Attr[0]:=char(byte(LineSize));
  643. end;
  644. procedure TWin32Screen.GetCursorPos(var P: TPoint);
  645. var
  646. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  647. begin
  648. GetConsoleScreenBufferInfo(DosScreenBufferHandle,
  649. @ConsoleScreenBufferInfo);
  650. P.X:=ConsoleScreenBufferInfo.dwCursorPosition.X;
  651. P.Y:=ConsoleScreenBufferInfo.dwCursorPosition.Y;
  652. end;
  653. procedure TWin32Screen.BufferCopy(Src, Dest : THandle);
  654. type
  655. CharInfoArray = Array [0..256*255-1] of Char_Info;
  656. var
  657. LineBuf : ^CharInfoArray;
  658. BufSize,BufCoord : Coord;
  659. Error, LineSize,
  660. Part, OnePartY: longint;
  661. res : boolean;
  662. WriteRegion : SMALL_RECT;
  663. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  664. DestConsoleScreenBufferInfo : Console_screen_buffer_info;
  665. begin
  666. GetConsoleScreenBufferInfo(Src,
  667. @ConsoleScreenBufferInfo);
  668. GetConsoleScreenBufferInfo(Dest,
  669. @DestConsoleScreenBufferInfo);
  670. GetMem(LineBuf,SizeOf(CharInfoArray));
  671. FillChar(LineBuf^,SizeOf(CharInfoArray),#0);
  672. LineSize:=ConsoleScreenBufferInfo.dwSize.X;
  673. If LineSize>256 then
  674. LineSize:=256;
  675. BufSize.X:=LineSize;
  676. BufSize.Y:=ConsoleScreenBufferInfo.dwSize.Y;
  677. BufCoord.X:=0;
  678. BufCoord.Y:=0;
  679. with WriteRegion do
  680. begin
  681. Top :=0;
  682. Left :=0;
  683. Bottom := ConsoleScreenBufferInfo.dwSize.Y-1;
  684. Right := LineSize-1;
  685. end;
  686. if BufSize.X*BufSize.Y*Sizeof(CHAR_INFO) >= $8000 then
  687. begin
  688. OnePartY := ($8000 -1) div (BufSize.X * SizeOf(Char_Info) );
  689. BufSize.Y:=OnePartY;
  690. Part:=0;
  691. while ((Part+1)*OnePartY < ConsoleScreenBufferInfo.dwSize.Y) do
  692. begin
  693. WriteRegion.Top := Part*OnePartY;
  694. WriteRegion.Bottom := (Part+1)*OnePartY-1;
  695. res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
  696. BufSize, BufCoord, @WriteRegion);
  697. if not res then
  698. Error:=GetLastError;
  699. res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
  700. BufSize, BufCoord, @WriteRegion);
  701. if not res then
  702. Error:=GetLastError;
  703. Inc(Part);
  704. end;
  705. BufSize.Y:=ConsoleScreenBufferInfo.dwSize.Y - Part*OnePartY;
  706. WriteRegion.Top := Part*OnePartY;
  707. WriteRegion.Bottom := ConsoleScreenBufferInfo.dwSize.Y-1;
  708. res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
  709. BufSize, BufCoord, @WriteRegion);
  710. if not res then
  711. Error:=GetLastError;
  712. res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
  713. BufSize, BufCoord, @WriteRegion);
  714. if not res then
  715. Error:=GetLastError;
  716. end
  717. else
  718. begin
  719. res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
  720. BufSize, BufCoord, @WriteRegion);
  721. if not res then
  722. Error:=GetLastError;
  723. res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
  724. BufSize, BufCoord, @WriteRegion);
  725. if not res then
  726. Error:=GetLastError;
  727. end;
  728. FreeMem(LineBuf,SizeOf(CharInfoArray));
  729. SetConsoleCursorPosition(Dest, ConsoleScreenBufferInfo.dwCursorPosition);
  730. end;
  731. procedure TWin32Screen.Capture;
  732. begin
  733. {if StartScreenBufferHandle=IdeScreenBufferHandle then
  734. BufferCopy(IDEScreenBufferHandle,DosScreenBufferHandle)
  735. else
  736. BufferCopy(DosScreenBufferHandle,IDEScreenBufferHandle);}
  737. SaveConsoleScreen;
  738. end;
  739. { dummy for win32 as the Buffer screen
  740. do hold all the info }
  741. procedure TWin32Screen.SaveIDEScreen;
  742. begin
  743. GetConsoleMode(GetStdHandle(Std_Input_Handle), @IdeMode);
  744. end;
  745. { dummy for win32 as the Buffer screen
  746. do hold all the info }
  747. procedure TWin32Screen.SaveConsoleScreen;
  748. begin
  749. GetConsoleMode(GetStdHandle(Std_Input_Handle), @ConsoleMode);
  750. { set the IDE buffer as active already now PM }
  751. SetStdHandle(Std_Output_Handle,IDEScreenBufferHandle);
  752. UpdateFileHandles;
  753. end;
  754. procedure TWin32Screen.SwitchToConsoleScreen;
  755. begin
  756. SetConsoleActiveScreenBuffer(DosScreenBufferHandle);
  757. SetStdHandle(Std_Output_Handle,DosScreenBufferHandle);
  758. IDEActive:=false;
  759. SetConsoleMode(GetStdHandle(Std_Input_Handle), ConsoleMode);
  760. UpdateFileHandles;
  761. end;
  762. procedure TWin32Screen.SwitchBackToIDEScreen;
  763. var
  764. ConsoleScreenBufferInfo : Console_screen_buffer_info;
  765. WindowPos : Small_rect;
  766. res : boolean;
  767. error : longint;
  768. begin
  769. GetConsoleScreenBufferInfo(IDEScreenBufferHandle,
  770. @ConsoleScreenBufferInfo);
  771. SetConsoleActiveScreenBuffer(IDEScreenBufferHandle);
  772. IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT) and not ENABLE_PROCESSED_INPUT;
  773. SetConsoleMode(GetStdHandle(Std_Input_Handle), IdeMode);
  774. WindowPos.left:=0;
  775. WindowPos.right:=ConsoleScreenBufferInfo.srWindow.right
  776. -ConsoleScreenBufferInfo.srWindow.left;
  777. WindowPos.top:=0;
  778. WindowPos.bottom:=ConsoleScreenBufferInfo.srWindow.bottom
  779. -ConsoleScreenBufferInfo.srWindow.top;
  780. with ConsoleScreenBufferInfo.dwMaximumWindowSize do
  781. begin
  782. if WindowPos.Right<X-1 then
  783. WindowPos.right:=X-1;
  784. if WindowPos.Bottom<Y-1 then
  785. WindowPos.Bottom:=Y-1;
  786. end;
  787. res:=SetConsoleWindowInfo(IDEScreenBufferHandle,true,WindowPos);
  788. if not res then
  789. error:=GetLastError;
  790. IDEActive:=true;
  791. end;
  792. {$endif}
  793. {****************************************************************************
  794. Initialize
  795. ****************************************************************************}
  796. procedure InitUserScreen;
  797. begin
  798. {$ifdef DOS}
  799. UserScreen:=New(PDOSScreen, Init);
  800. {$else}
  801. {$ifdef Unix}
  802. UserScreen:=New(PLinuxScreen, Init);
  803. {$else}
  804. {$ifdef Win32}
  805. UserScreen:=New(PWin32Screen, Init);
  806. {$else}
  807. UserScreen:=New(PScreen, Init);
  808. {$endif Win32}
  809. {$endif Unix}
  810. {$endif Dos}
  811. end;
  812. procedure DoneUserScreen;
  813. begin
  814. if UserScreen<>nil then
  815. begin
  816. UserScreen^.SwitchToConsoleScreen;
  817. Dispose(UserScreen, Done);
  818. UserScreen:=nil;
  819. end;
  820. end;
  821. end.
  822. {
  823. $Log$
  824. Revision 1.8 2002-01-22 16:29:52 pierre
  825. * try to fix win32 problem with Dos program ouptut in command shell
  826. Warning, to debug under win32 with GDB you must use "set new-console on"
  827. Revision 1.7 2001/11/08 17:06:22 pierre
  828. * impose the correct size for win32 console window
  829. Revision 1.6 2001/11/08 16:38:25 pierre
  830. * fix win32 scrolling
  831. + always go back to 0,0 position in IDE mode
  832. Revision 1.5 2001/11/08 16:07:41 pierre
  833. * overcome buffer win32 problem due to a bug in ReadConsoleOutput
  834. Revision 1.4 2001/10/24 14:17:27 pierre
  835. * try to fix the Win2000 mouse problem
  836. Revision 1.3 2001/09/09 20:44:53 carl
  837. * bugfix of console sharing mode (on NT this would bug all
  838. std_input access).
  839. Revision 1.2 2001/08/12 00:04:50 pierre
  840. * some speed improvements for string operations
  841. Revision 1.1 2001/08/04 11:30:24 peter
  842. * ide works now with both compiler versions
  843. Revision 1.1.2.10 2001/06/14 09:15:16 pierre
  844. TScreen methods reorganized:
  845. SwitchTo method renamed SwitchToConsoleScreen
  846. SwitchBack method renamed SwitchBackToIDEScreen
  847. + method Scroll added
  848. + SaveIDEScreen and SaveConsoleScreen methods added
  849. Revision 1.1.2.9 2001/04/04 08:52:01 pierre
  850. * allow inheritance for win32 DosScreenBufferHandle
  851. Revision 1.1.2.8 2001/03/16 17:45:54 pierre
  852. * free VIDEBuffer of TDosScreen
  853. Revision 1.1.2.7 2000/11/30 13:04:01 pierre
  854. * fix for bug 1205
  855. Revision 1.1.2.6 2000/11/29 00:54:45 pierre
  856. + preserve window number and save special windows
  857. Revision 1.1.2.5 2000/11/22 12:47:21 pierre
  858. * fix the screen saving at start for win32
  859. Revision 1.1.2.4 2000/11/14 09:23:56 marco
  860. * Second batch
  861. Revision 1.1.2.3 2000/10/10 21:24:56 pierre
  862. * avoid writing past IDE_screen buffer length
  863. Revision 1.1.2.2 2000/08/21 12:10:19 jonas
  864. * fixed errors in my previous commit, it now works properly
  865. Revision 1.1.2.1 2000/08/21 10:51:13 jonas
  866. * IDE screen saving/restoring implemented for Linux
  867. Revision 1.1 2000/07/13 09:48:36 michael
  868. + Initial import
  869. Revision 1.13 2000/06/16 15:00:20 pierre
  870. * accord to new WriteConsoleOuput declarations
  871. Revision 1.12 2000/04/25 08:42:33 pierre
  872. * New Gabor changes : see fixes.txt
  873. Revision 1.11 2000/04/18 11:42:37 pierre
  874. lot of Gabor changes : see fixes.txt
  875. Revision 1.10 2000/03/13 20:30:37 pierre
  876. + stores IDE screen before Switching for DOS
  877. Revision 1.9 2000/02/04 23:17:25 pierre
  878. * Keep the entry ScreenBuffer at exit
  879. Revision 1.8 1999/12/01 16:17:18 pierre
  880. * Restore std_output_handle correctly at exit for GDB
  881. Revision 1.7 1999/11/10 17:12:00 pierre
  882. * Win32 screen problems solved
  883. Revision 1.6 1999/09/22 13:02:00 pierre
  884. + Twin32Screen added
  885. Revision 1.5 1999/08/16 18:25:24 peter
  886. * Adjusting the selection when the editor didn't contain any line.
  887. * Reserved word recognition redesigned, but this didn't affect the overall
  888. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  889. The syntax scanner loop is a bit slow but the main problem is the
  890. recognition of special symbols. Switching off symbol processing boosts
  891. the performance up to ca. 200%...
  892. * The editor didn't allow copying (for ex to clipboard) of a single character
  893. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  894. * Compiler Messages window (actually the whole desktop) did not act on any
  895. keypress when compilation failed and thus the window remained visible
  896. + Message windows are now closed upon pressing Esc
  897. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  898. only when neccessary
  899. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  900. + LineSelect (Ctrl+K+L) implemented
  901. * The IDE had problems closing help windows before saving the desktop
  902. Revision 1.4 1999/06/28 19:32:25 peter
  903. * fixes from gabor
  904. Revision 1.3 1999/02/02 16:41:42 peter
  905. + automatic .pas/.pp adding by opening of file
  906. * better debuggerscreen changes
  907. Revision 1.2 1999/01/04 11:49:51 peter
  908. * 'Use tab characters' now works correctly
  909. + Syntax highlight now acts on File|Save As...
  910. + Added a new class to syntax highlight: 'hex numbers'.
  911. * There was something very wrong with the palette managment. Now fixed.
  912. + Added output directory (-FE<xxx>) support to 'Directories' dialog...
  913. * Fixed some possible bugs in Running/Compiling, and the compilation/run
  914. process revised
  915. Revision 1.1 1998/12/28 15:47:53 peter
  916. + Added user screen support, display & window
  917. + Implemented Editor,Mouse Options dialog
  918. + Added location of .INI and .CFG file
  919. + Option (INI) file managment implemented (see bottom of Options Menu)
  920. + Switches updated
  921. + Run program
  922. Revision 1.0 1998/12/24 09:55:49 gabor
  923. Original implementation
  924. }