1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
{
This file is part of the Free Pascal Integrated Development Environment
Copyright (c) 2000 by Pierre Muller
Ansi dump capability
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
procedure TIDEApp.CreateAnsiFile;
var
f : text;
Buf : PVideoBuf;
re : word;
p : longint;
UL,LR : TPoint;
SaveAsText : boolean;
Name, DefExt : string;
function GetPoint(var P :TPoint) : boolean;
var
E : TEvent;
begin
repeat
GetEvent(E);
until (E.What=evMouseDown) or
((E.What=evKeyDown) and ((E.KeyCode=kbEsc) or (E.KeyCode=kbEnter)));
if (E.What=evMouseDown) then
begin
GetPoint:=true;
P:=E.Where;
end
else if (E.KeyCode=kbEnter) then
GetPoint:=true
else
GetPoint:=false;
end;
begin
{ First copy the whole screen untouched }
GetMem(Buf,VideoBufSize);
Move(VideoBuf^,Buf^,VideoBufSize);
{ partial screen save ? }
PushStatus(msg_click_upper_left);
UL.X:=0;UL.Y:=0;
if not GetPoint(UL) then
begin
PopStatus;
exit;
end;
PopStatus;
PushStatus(msg_click_lower_right);
LR.X:=Size.X-1;LR.Y:=Size.Y-1;
if not GetPoint(LR) then
begin
PopStatus;
exit;
end;
PopStatus;
{ How should we do this ?? }
{ after ask for a file name to save }
DefExt:='*.ans';
Name:='screen.ans';
PushStatus(msg_saveansifile);
Re:=Application^.ExecuteDialog(New(PFileDialog, Init(DefExt,
dialog_savefileas, label_name, fdOkButton, FileId)), @Name);
if Re<>cmCancel then
begin
Assign(f,Name);
Rewrite(f);
p:=system.pos('.',Name);
SaveAsText:=Copy(Name,p+1,High(Name))='txt';
ExportBufferToAnsiFile(Buf^,UL.X,LR.X,UL.Y,LR.Y,
Size.X,SaveAsText,f);
Close(f);
end;
PopStatus;
end;
|
