fpmansi.inc 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 2000 by Pierre Muller
  5. Ansi dump capability
  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. procedure TIDEApp.CreateAnsiFile;
  13. var
  14. f : text;
  15. Buf : PVideoBuf;
  16. re : word;
  17. p : longint;
  18. UL,LR : TPoint;
  19. SaveAsText : boolean;
  20. Name, DefExt : string;
  21. function GetPoint(var P :TPoint) : boolean;
  22. var
  23. E : TEvent;
  24. begin
  25. repeat
  26. GetEvent(E);
  27. until (E.What=evMouseDown) or
  28. ((E.What=evKeyDown) and ((E.KeyCode=kbEsc) or (E.KeyCode=kbEnter)));
  29. if (E.What=evMouseDown) then
  30. begin
  31. GetPoint:=true;
  32. P:=E.Where;
  33. end
  34. else if (E.KeyCode=kbEnter) then
  35. GetPoint:=true
  36. else
  37. GetPoint:=false;
  38. end;
  39. begin
  40. { First copy the whole screen untouched }
  41. GetMem(Buf,VideoBufSize);
  42. Move(VideoBuf^,Buf^,VideoBufSize);
  43. { partial screen save ? }
  44. PushStatus(msg_click_upper_left);
  45. UL.X:=0;UL.Y:=0;
  46. if not GetPoint(UL) then
  47. begin
  48. PopStatus;
  49. exit;
  50. end;
  51. PopStatus;
  52. PushStatus(msg_click_lower_right);
  53. LR.X:=Size.X-1;LR.Y:=Size.Y-1;
  54. if not GetPoint(LR) then
  55. begin
  56. PopStatus;
  57. exit;
  58. end;
  59. PopStatus;
  60. { How should we do this ?? }
  61. { after ask for a file name to save }
  62. DefExt:='*.ans';
  63. Name:='screen.ans';
  64. PushStatus(msg_saveansifile);
  65. Re:=Application^.ExecuteDialog(New(PFileDialog, Init(DefExt,
  66. dialog_savefileas, label_name, fdOkButton, FileId)), @Name);
  67. if Re<>cmCancel then
  68. begin
  69. Assign(f,Name);
  70. Rewrite(f);
  71. p:=system.pos('.',Name);
  72. SaveAsText:=Copy(Name,p+1,High(Name))='txt';
  73. ExportBufferToAnsiFile(Buf^,UL.X,LR.X,UL.Y,LR.Y,
  74. Size.X,SaveAsText,f);
  75. Close(f);
  76. end;
  77. PopStatus;
  78. end;
  79. {
  80. $Log$
  81. Revision 1.3 2001-11-15 13:30:14 pierre
  82. + save ansi dump as text is filename suffix is '.txt'
  83. Revision 1.2 2001/10/12 14:20:11 pierre
  84. * use correct video buffer size
  85. Revision 1.1 2001/08/04 11:30:23 peter
  86. * ide works now with both compiler versions
  87. Revision 1.1.2.2 2000/11/22 11:03:32 pierre
  88. + window selection for Ansi Dump
  89. Revision 1.1.2.1 2000/11/21 17:43:24 pierre
  90. + first version of dump ansi file
  91. }