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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
{
Demonstration software for image resizing and screenshot using PascalMagick
Created by: Felipe Monteiro de Carvalho
This software takes a screenshot of the screen and enlarges it using anti-aliasing
or not depending on what the user select.
Notes: This software uses X11 to take the screenshot so it will only work on UNIXes
More information on this page:
http://wiki.lazarus.freepascal.org/index.php/PascalMagick
April/2006
}
program screenshot;
{$mode objfpc}{$H+}
uses SysUtils, magick_wand, ImageMagick, Unix;
type
TCommand = (cmdQuit, cmdSample, cmdAntiAliase);
{
Catches exceptions from ImageMagick
}
procedure ThrowWandException(wand: PMagickWand);
var
description: PChar;
severity: ExceptionType;
begin
description := MagickGetException(wand, @severity);
WriteLn(Format('An error ocurred. Description: %s', [description]));
description := MagickRelinquishMemory(description);
Abort;
end;
{
Shows the main screen
}
function MainScreen: TCommand;
var
i: Integer;
Continuar: Boolean;
begin
Continuar := False;
WriteLn('=========================================================');
WriteLn(' Welcome to PascalMagick demo software 2');
WriteLn('=========================================================');
while not Continuar do
begin
WriteLn('');
WriteLn('The following commands are available:');
WriteLn(' 0 - Quit');
WriteLn(' 1 - Capture screenshot and resize it to 2024x1536');
WriteLn(' 2 - Same as #1 except that uses Anti-Aliasing');
Write(': ');
ReadLn(i);
case i of
0:
begin
Result := cmdQuit;
Continuar := True;
end;
1:
begin
Result := cmdSample;
Continuar := True;
end;
2:
begin
Result := cmdAntiAliase;
Continuar := True;
end;
else
WriteLn('Wrong Command!!');
end;
end;
end;
{
Main procedure
}
var
status: MagickBooleanType;
wand: PMagickWand;
TempDir, shellStr: string;
Antes: TTimeStamp;
Command: TCommand;
begin
{ Presentation screen and user options }
Command := MainScreen;
if Command = cmdQuit then Exit;
{ Create the image }
Antes := DateTimeToTimeStamp(Now);
TempDir := GetTempDir(False);
shellStr := 'xwd -root -out ' + TempDir + 'display.xwd';
WriteLn(shellStr);
shell(shellStr);
{ Read an image. }
MagickWandGenesis;
wand := NewMagickWand;
try
status := MagickReadImage(wand, PChar(TempDir + 'display.xwd'));
if (status = MagickFalse) then ThrowWandException(wand);
{ Enlarge the Image }
WriteLn('Enlarging');
if Command = cmdAntiAliase then MagickResizeImage(wand, 2024, 1536, BoxFilter, 1.0)
else MagickSampleImage(wand, 2024, 1536);
WriteLn(IntToStr(DateTimeToTimeStamp(Now).Time - Antes.Time));
WriteLn('Saving');
{ Write the image as MIFF and destroy it. }
status := MagickWriteImages(wand, PChar(TempDir + 'enlarged.jpg'), MagickTrue);
if (status = MagickFalse) then ThrowWandException(wand);
WriteLn(IntToStr(DateTimeToTimeStamp(Now).Time - Antes.Time));
finally
wand := DestroyMagickWand(wand);
MagickWandTerminus;
end;
end.
|
