/components/images/examples/mainform.pas

http://github.com/graemeg/lazarus · Pascal · 208 lines · 121 code · 24 blank · 63 comment · 8 complexity · 4e9a246c60d74768720f8d12a2996726 MD5 · raw file

  1. { Copyright (C) 2004 Mattias Gaertner
  2. Example for loading and saving images.
  3. Important:
  4. This example uses the ImagesForLazarus Package (see in the directory above).
  5. You must first open once this package so that the IDE knows, where to find
  6. the lpk file.
  7. See the README.txt.
  8. This program is free software; you can redistribute it and/or modify it
  9. under the terms of the GNU General Public License as published by the Free
  10. Software Foundation; either version 2 of the License, or (at your option)
  11. any later version.
  12. This program is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
  15. for more details.
  16. You should have received a copy of the GNU General Public License along with
  17. this program; if not, write to the Free Software Foundation, Inc., 59 Temple
  18. Place - Suite 330, Boston, MA 02111-1307, USA.
  19. }
  20. unit MainForm;
  21. {$mode objfpc}{$H+}
  22. interface
  23. uses
  24. Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
  25. ExtCtrls, Buttons, ExtDlgs;
  26. type
  27. TImagesExampleForm = class(TForm)
  28. LoadImageButton: TButton;
  29. SaveImageButton: TButton;
  30. LoadJPEGButton: TButton;
  31. OpenPictureDialog1: TOpenPictureDialog;
  32. SaveJPEGButton: TButton;
  33. ImageGroupBox: TGroupBox;
  34. Image1: TImage;
  35. SavePictureDialog1: TSavePictureDialog;
  36. procedure LoadJPEGButtonClick(Sender: TObject);
  37. procedure LoadImageButtonClick(Sender: TObject);
  38. procedure SaveJPEGButtonClick(Sender: TObject);
  39. procedure SaveImageButtonClick(Sender: TObject);
  40. private
  41. procedure UpdateInfo(const Filename: string);
  42. end;
  43. var
  44. ImagesExampleForm: TImagesExampleForm;
  45. implementation
  46. {$R mainform.lfm}
  47. uses
  48. {Units of package "Images For Lazarus"}
  49. LazJPG, LazTGA; //, LazPNM, LazPNG, LazXPM, LazBMP;
  50. { TImagesExampleForm }
  51. procedure TImagesExampleForm.LoadJPEGButtonClick(Sender: TObject);
  52. var
  53. JPEG: TJPGImage;
  54. begin
  55. OpenPictureDialog1.Options:=OpenPictureDialog1.Options+[ofFileMustExist];
  56. if not OpenPictureDialog1.Execute then exit;
  57. try
  58. //--------------------------------------------------------------------------
  59. // Create a TJPEGImage and load the file, then copy it to the TImage.
  60. // A TJPEGImage can only load jpeg images.
  61. JPEG:=TJPGImage.Create;
  62. try
  63. JPEG.LoadFromFile(OpenPictureDialog1.Filename);
  64. // copy jpeg content to a TImage
  65. Image1.Picture.Assign(JPEG);
  66. finally
  67. JPEG.Free;
  68. end;
  69. //--------------------------------------------------------------------------
  70. UpdateInfo(OpenPictureDialog1.Filename);
  71. except
  72. on E: Exception do begin
  73. MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0);
  74. end;
  75. end;
  76. end;
  77. procedure TImagesExampleForm.LoadImageButtonClick(Sender: TObject);
  78. begin
  79. OpenPictureDialog1.Options:=OpenPictureDialog1.Options+[ofFileMustExist];
  80. if not OpenPictureDialog1.Execute then exit;
  81. try
  82. //--------------------------------------------------------------------------
  83. // Loading directly into a TImage. This will load any registered image
  84. // format. .bmp, .xpm, .png are the standard LCL formats.
  85. // The jpeg units register .jpeg and .jpg.
  86. Image1.Picture.LoadFromFile(OpenPictureDialog1.Filename);
  87. //--------------------------------------------------------------------------
  88. UpdateInfo(OpenPictureDialog1.Filename);
  89. except
  90. on E: Exception do begin
  91. MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0);
  92. end;
  93. end;
  94. end;
  95. procedure TImagesExampleForm.SaveJPEGButtonClick(Sender: TObject);
  96. var
  97. JPEG: TJPGImage;
  98. begin
  99. if Image1.Picture.Graphic=nil then begin
  100. MessageDlg('No image','Please open an image, before save',mtError,
  101. [mbOk],0);
  102. exit;
  103. end;
  104. SavePictureDialog1.Options:=SavePictureDialog1.Options+[ofPathMustExist];
  105. if not SavePictureDialog1.Execute then exit;
  106. try
  107. //--------------------------------------------------------------------------
  108. // Create a TImage1 and copy the TImage into it. Then save to file.
  109. // This will ignore the file extension. TImage1 will always save as jpeg.
  110. JPEG:=TJPGImage.Create;
  111. try
  112. // copy content of the TImage to jpeg
  113. JPEG.Assign(Image1.Picture.Graphic);
  114. // save to file
  115. JPEG.SaveToFile(SavePictureDialog1.Filename);
  116. finally
  117. JPEG.Free;
  118. end;
  119. //--------------------------------------------------------------------------
  120. UpdateInfo(SavePictureDialog1.Filename);
  121. except
  122. on E: Exception do begin
  123. MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0);
  124. end;
  125. end;
  126. end;
  127. procedure TImagesExampleForm.SaveImageButtonClick(Sender: TObject);
  128. begin
  129. if Image1.Picture.Graphic=nil then begin
  130. MessageDlg('No image','Please open an image, before save',mtError,
  131. [mbOk],0);
  132. exit;
  133. end;
  134. SavePictureDialog1.Options:=SavePictureDialog1.Options+[ofPathMustExist];
  135. if not SavePictureDialog1.Execute then exit;
  136. try
  137. //--------------------------------------------------------------------------
  138. // Saving directly from a TImage to a file. This will save in any registered
  139. // image format. .bmp, .xpm, .png are the standard LCL formats.
  140. // The jpeg units register .jpeg and .jpg.
  141. // So, saving as file1.jpg will save as jpeg, while saving a file1.bmp will
  142. // save as bmp.
  143. Image1.Picture.SaveToFile(SavePictureDialog1.Filename);
  144. //--------------------------------------------------------------------------
  145. UpdateInfo(SavePictureDialog1.Filename);
  146. except
  147. on E: Exception do begin
  148. MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0);
  149. end;
  150. end;
  151. end;
  152. procedure TImagesExampleForm.UpdateInfo(const Filename: string);
  153. var
  154. Info: String;
  155. begin
  156. if Image1.Picture.Graphic<>nil then begin
  157. Info:=Image1.Picture.Graphic.ClassName+':'+Filename;
  158. end else begin
  159. Info:=Filename;
  160. end;
  161. ImageGroupBox.Caption:=Info;
  162. end;
  163. initialization
  164. // LazPNG.Register;
  165. // LazXPM.Register;
  166. // LazBMP.Register;
  167. // LazPNM.Register;
  168. LazTGA.Register;
  169. // LazJPG.Register;
  170. finalization
  171. // LazPNG.UnRegister;
  172. // LazXPM.UnRegister;
  173. // LazBMP.UnRegister;
  174. // LazPNM.UnRegister;
  175. LazTGA.UnRegister;
  176. // LazJPG.UnRegister;
  177. end.