/components/images/examples/mainform.pas

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