screenshot.lpr 3.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151
  1. {
  2. Demonstration software for image resizing and screenshot using PascalMagick
  3. Created by: Felipe Monteiro de Carvalho
  4. This software takes a screenshot of the screen and enlarges it using anti-aliasing
  5. or not depending on what the user select.
  6. Notes: This software uses X11 to take the screenshot so it will only work on UNIXes
  7. More information on this page:
  8. http://wiki.lazarus.freepascal.org/index.php/PascalMagick
  9. April/2006
  10. }
  11. program screenshot;
  12. {$mode objfpc}{$H+}
  13. uses SysUtils, magick_wand, ImageMagick, Unix;
  14. type
  15. TCommand = (cmdQuit, cmdSample, cmdAntiAliase);
  16. {
  17. Catches exceptions from ImageMagick
  18. }
  19. procedure ThrowWandException(wand: PMagickWand);
  20. var
  21. description: PChar;
  22. severity: ExceptionType;
  23. begin
  24. description := MagickGetException(wand, @severity);
  25. WriteLn(Format('An error ocurred. Description: %s', [description]));
  26. description := MagickRelinquishMemory(description);
  27. Abort;
  28. end;
  29. {
  30. Shows the main screen
  31. }
  32. function MainScreen: TCommand;
  33. var
  34. i: Integer;
  35. Continuar: Boolean;
  36. begin
  37. Continuar := False;
  38. WriteLn('=========================================================');
  39. WriteLn(' Welcome to PascalMagick demo software 2');
  40. WriteLn('=========================================================');
  41. while not Continuar do
  42. begin
  43. WriteLn('');
  44. WriteLn('The following commands are available:');
  45. WriteLn(' 0 - Quit');
  46. WriteLn(' 1 - Capture screenshot and resize it to 2024x1536');
  47. WriteLn(' 2 - Same as #1 except that uses Anti-Aliasing');
  48. Write(': ');
  49. ReadLn(i);
  50. case i of
  51. 0:
  52. begin
  53. Result := cmdQuit;
  54. Continuar := True;
  55. end;
  56. 1:
  57. begin
  58. Result := cmdSample;
  59. Continuar := True;
  60. end;
  61. 2:
  62. begin
  63. Result := cmdAntiAliase;
  64. Continuar := True;
  65. end;
  66. else
  67. WriteLn('Wrong Command!!');
  68. end;
  69. end;
  70. end;
  71. {
  72. Main procedure
  73. }
  74. var
  75. status: MagickBooleanType;
  76. wand: PMagickWand;
  77. TempDir, shellStr: string;
  78. Antes: TTimeStamp;
  79. Command: TCommand;
  80. begin
  81. { Presentation screen and user options }
  82. Command := MainScreen;
  83. if Command = cmdQuit then Exit;
  84. { Create the image }
  85. Antes := DateTimeToTimeStamp(Now);
  86. TempDir := GetTempDir(False);
  87. shellStr := 'xwd -root -out ' + TempDir + 'display.xwd';
  88. WriteLn(shellStr);
  89. shell(shellStr);
  90. { Read an image. }
  91. MagickWandGenesis;
  92. wand := NewMagickWand;
  93. try
  94. status := MagickReadImage(wand, PChar(TempDir + 'display.xwd'));
  95. if (status = MagickFalse) then ThrowWandException(wand);
  96. { Enlarge the Image }
  97. WriteLn('Enlarging');
  98. if Command = cmdAntiAliase then MagickResizeImage(wand, 2024, 1536, BoxFilter, 1.0)
  99. else MagickSampleImage(wand, 2024, 1536);
  100. WriteLn(IntToStr(DateTimeToTimeStamp(Now).Time - Antes.Time));
  101. WriteLn('Saving');
  102. { Write the image as MIFF and destroy it. }
  103. status := MagickWriteImages(wand, PChar(TempDir + 'enlarged.jpg'), MagickTrue);
  104. if (status = MagickFalse) then ThrowWandException(wand);
  105. WriteLn(IntToStr(DateTimeToTimeStamp(Now).Time - Antes.Time));
  106. finally
  107. wand := DestroyMagickWand(wand);
  108. MagickWandTerminus;
  109. end;
  110. end.