added jpeg example

git-svn-id: trunk@5248 -

.gitattributes

@@ -83,6 +83,13 @@ components/interbase/tibdatabase.xpm -text svneol=native#image/x-xpixmap
 components/interbase/tibquery.ico -text svneol=unset#image/x-icon
 components/interbase/tibquery.xpm -text svneol=native#image/x-xpixmap
 components/interbase/tibtransaction.xpm -text svneol=native#image/x-xpixmap
+components/jpeg/examples/README.txt svneol=native#text/plain
+components/jpeg/examples/jpegexample.lpi svneol=native#text/plain
+components/jpeg/examples/jpegexample.lpr svneol=native#text/pascal
+components/jpeg/examples/lazarus.jpg -text svneol=unset#image/jpeg
+components/jpeg/examples/mainform.lfm svneol=native#text/plain
+components/jpeg/examples/mainform.lrs svneol=native#text/pascal
+components/jpeg/examples/mainform.pas svneol=native#text/pascal
 components/jpeg/jpegforlazarus.lpk svneol=native#text/pascal
 components/jpeg/jpegforlazarus.pas svneol=native#text/pascal
 components/jpeg/lazjpeg.pas svneol=native#text/pascal

components/jpeg/examples/README.txt

@@ -0,0 +1,27 @@
+
+Important:
+
+  This example uses the JPEGForLazarus package (see in the directory above).
+  You must first open once the package jpegforlazarus.lpk in the IDE, so that
+  the IDE knows, where to find the lpk file.
+
+
+To use jpeg in your own applications:
+
+ - Add JPEGForLazarus to the dependencies of your project.
+
+   Project Menu -> Project Inspector -> Add -> New Requirement -> Package Name:
+     JPEGForLazarus
+   Click OK.
+   
+ - Add "lazjpeg" to the uses section of any unit, where jpeg is needed.
+   Add this unit at least once, so that jpeg is registered and
+   Open/SavePictureDialogs and TPicture can open jpeg.
+     
+
+The code is under LGPL2. That means you can use it freely in your
+applications, even commercial ones.
+  
+
+For further questions:
+  lazarus@miraclec.com

components/jpeg/examples/jpegexample.lpi

@@ -0,0 +1,221 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="3"/>
+    <General>
+      <ProjectType Value="Application"/>
+      <MainUnit Value="0"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <Title Value="jpegexample"/>
+    </General>
+    <JumpHistory Count="0" HistoryIndex="-1"/>
+    <Units Count="23">
+      <Unit0>
+        <CursorPos X="10" Y="14"/>
+        <EditorIndex Value="2"/>
+        <Filename Value="jpegexample.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <Loaded Value="True"/>
+        <TopLine Value="1"/>
+        <UnitName Value="JPEGExample"/>
+        <UsageCount Value="33"/>
+      </Unit0>
+      <Unit1>
+        <CursorPos X="3" Y="6"/>
+        <EditorIndex Value="0"/>
+        <Filename Value="mainform.pas"/>
+        <ComponentName Value="JPEGExampleForm"/>
+        <IsPartOfProject Value="True"/>
+        <Loaded Value="True"/>
+        <ResourceFilename Value="mainform.lrs"/>
+        <TopLine Value="1"/>
+        <UnitName Value="MainForm"/>
+        <UsageCount Value="33"/>
+      </Unit1>
+      <Unit2>
+        <CursorPos X="20" Y="156"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/lcl/dialogs.pp"/>
+        <TopLine Value="134"/>
+        <UnitName Value="Dialogs"/>
+        <UsageCount Value="10"/>
+      </Unit2>
+      <Unit3>
+        <CursorPos X="7" Y="48"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/components/jpeg/lazjpeg.pas"/>
+        <TopLine Value="21"/>
+        <UnitName Value="LazJPEG"/>
+        <UsageCount Value="15"/>
+      </Unit3>
+      <Unit4>
+        <CursorPos X="9" Y="167"/>
+        <Filename Value="/home/mattias/pascal/fpc_sources/19/fpc/fcl/image/fpreadjpeg.pas"/>
+        <TopLine Value="141"/>
+        <UnitName Value="FPReadJPEG"/>
+        <UsageCount Value="14"/>
+      </Unit4>
+      <Unit5>
+        <CursorPos X="17" Y="171"/>
+        <Filename Value="/home/mattias/pascal/fpc_sources/19/fpc/packages/base/pasjpeg/jdapimin.pas"/>
+        <TopLine Value="139"/>
+        <UnitName Value="JdAPImin"/>
+        <UsageCount Value="10"/>
+      </Unit5>
+      <Unit6>
+        <CursorPos X="3" Y="2543"/>
+        <Filename Value="/home/mattias/pascal/fpc_sources/19/fpc/packages/base/pasjpeg/jdmarker.pas"/>
+        <TopLine Value="2529"/>
+        <UnitName Value="JdMarker"/>
+        <UsageCount Value="10"/>
+      </Unit6>
+      <Unit7>
+        <CursorPos X="1" Y="116"/>
+        <Filename Value="/home/mattias/pascal/fpc_sources/19/fpc/packages/base/pasjpeg/jconfig.inc"/>
+        <TopLine Value="74"/>
+        <UsageCount Value="14"/>
+      </Unit7>
+      <Unit8>
+        <CursorPos X="5" Y="1137"/>
+        <Filename Value="/home/mattias/pascal/fpc_sources/19/fpc/packages/base/pasjpeg/jpeglib.pas"/>
+        <TopLine Value="1096"/>
+        <UnitName Value="JPEGLib"/>
+        <UsageCount Value="10"/>
+      </Unit8>
+      <Unit9>
+        <CursorPos X="1" Y="43"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/components/codetools/memcheck.pas"/>
+        <TopLine Value="20"/>
+        <UnitName Value="MemCheck"/>
+        <UsageCount Value="16"/>
+      </Unit9>
+      <Unit10>
+        <CursorPos X="25" Y="34"/>
+        <Filename Value="/home/mattias/pascal/fpc_sources/19/fpc/packages/base/pasjpeg/jdatasrc.pas"/>
+        <TopLine Value="11"/>
+        <UnitName Value="JDataSrc"/>
+        <UsageCount Value="13"/>
+      </Unit10>
+      <Unit11>
+        <CursorPos X="1" Y="37"/>
+        <Filename Value="/home/mattias/pascal/fpc_sources/19/fpc/packages/base/pasjpeg/jinclude.pas"/>
+        <TopLine Value="17"/>
+        <UnitName Value="jinclude"/>
+        <UsageCount Value="13"/>
+      </Unit11>
+      <Unit12>
+        <CursorPos X="6" Y="14"/>
+        <Filename Value="/home/mattias/pascal/sf_lazarus/jpeg/jerror.pas"/>
+        <TopLine Value="1"/>
+        <UnitName Value="Jerror"/>
+        <UsageCount Value="10"/>
+      </Unit12>
+      <Unit13>
+        <CursorPos X="12" Y="113"/>
+        <Filename Value="/home/mattias/pascal/sf_lazarus/jpeg/jconfig.inc"/>
+        <TopLine Value="74"/>
+        <UsageCount Value="10"/>
+      </Unit13>
+      <Unit14>
+        <CursorPos X="13" Y="134"/>
+        <Filename Value="/home/mattias/pascal/sf_lazarus/jpeg/lazjpeg.pas"/>
+        <TopLine Value="109"/>
+        <UnitName Value="LazJPEG"/>
+        <UsageCount Value="10"/>
+      </Unit14>
+      <Unit15>
+        <CursorPos X="37" Y="728"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/lcl/graphics.pp"/>
+        <TopLine Value="707"/>
+        <UnitName Value="Graphics"/>
+        <UsageCount Value="11"/>
+      </Unit15>
+      <Unit16>
+        <CursorPos X="1" Y="217"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/lcl/include/graphic.inc"/>
+        <TopLine Value="191"/>
+        <UsageCount Value="11"/>
+      </Unit16>
+      <Unit17>
+        <CursorPos X="1" Y="1064"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/lcl/include/bitmap.inc"/>
+        <TopLine Value="1041"/>
+        <UsageCount Value="11"/>
+      </Unit17>
+      <Unit18>
+        <CursorPos X="16" Y="306"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/lcl/intfgraphics.pas"/>
+        <TopLine Value="287"/>
+        <UnitName Value="IntfGraphics"/>
+        <UsageCount Value="10"/>
+      </Unit18>
+      <Unit19>
+        <CursorPos X="1" Y="284"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/lcl/include/pixmap.inc"/>
+        <TopLine Value="262"/>
+        <UsageCount Value="11"/>
+      </Unit19>
+      <Unit20>
+        <CursorPos X="74" Y="34"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/lcl/include/png.inc"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="11"/>
+      </Unit20>
+      <Unit21>
+        <CursorPos X="13" Y="1932"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/lcl/lcltype.pp"/>
+        <TopLine Value="1909"/>
+        <UnitName Value="LCLType"/>
+        <UsageCount Value="11"/>
+      </Unit21>
+      <Unit22>
+        <CursorPos X="2" Y="4"/>
+        <EditorIndex Value="1"/>
+        <Filename Value="README.txt"/>
+        <IsPartOfProject Value="True"/>
+        <Loaded Value="True"/>
+        <SyntaxHighlighter Value="None"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="21"/>
+      </Unit22>
+    </Units>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="LCL"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="JPEGForLazarus"/>
+      </Item2>
+    </RequiredPackages>
+  </ProjectOptions>
+  <CompilerOptions>
+    <SearchPaths>
+      <OtherUnitFiles Value="$(LazarusDir)/components/units/$(TargetCPU)/$(TargetOS)/"/>
+      <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/>
+    </SearchPaths>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="1">
+      <Item1>
+        <Source Value="/home/satan/pascal/lazarus/lcl/interfaces/gtk2/gtk2int.pas"/>
+        <Line Value="34"/>
+      </Item1>
+    </BreakPoints>
+  </Debugging>
+</CONFIG>

components/jpeg/examples/jpegexample.lpr

@@ -0,0 +1,14 @@
+program JPEGExample;
+
+{$mode objfpc}{$H+}
+
+uses
+  Interfaces,
+  Forms, MainForm;
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TJPEGExampleForm, JPEGExampleForm);
+  Application.Run;
+end.
+

components/jpeg/examples/mainform.lfm

@@ -0,0 +1,82 @@
+object JPEGExampleForm: TJPEGExampleForm
+  Caption = 'Example for JPEG for Lazarus'
+  ClientHeight = 416
+  ClientWidth = 425
+  HorzScrollBar.Page = 426
+  VertScrollBar.Page = 417
+  Left = 291
+  Height = 416
+  Top = 163
+  Width = 425
+  object ImageGroupBox: TGroupBox
+    Align = alTop
+    Anchors = [akTop, akLeft, akBottom]
+    Caption = '...'
+    ClientHeight = 319
+    ClientWidth = 421
+    ParentColor = True
+    ParentCtl3D = False
+    TabOrder = 0
+    Height = 336
+    Width = 425
+    object Image1: TImage
+      Align = alClient
+      Transparent = True
+      Proportional = True
+      Height = 319
+      Width = 421
+    end
+  end
+  object LoadJPEGButton: TButton
+    Anchors = [akLeft, akBottom]
+    Caption = 'Load JPEG from file'
+    TabOrder = 1
+    OnClick = LoadJPEGButtonClick
+    Left = 229
+    Height = 25
+    Top = 346
+    Width = 173
+  end
+  object SaveJPEGButton: TButton
+    Anchors = [akLeft, akBottom]
+    Caption = 'Save as JPEG to file'
+    TabOrder = 2
+    OnClick = SaveJPEGButtonClick
+    Left = 229
+    Height = 25
+    Top = 380
+    Width = 173
+  end
+  object LoadImageButton: TButton
+    Anchors = [akLeft, akBottom]
+    Caption = 'Load Image'
+    TabOrder = 3
+    OnClick = LoadImageButtonClick
+    Left = 24
+    Height = 25
+    Top = 346
+    Width = 163
+  end
+  object SaveImageButton: TButton
+    Anchors = [akLeft, akBottom]
+    Caption = 'Save Image'
+    TabOrder = 4
+    OnClick = SaveImageButtonClick
+    Left = 24
+    Height = 25
+    Top = 380
+    Width = 163
+  end
+  object OpenPictureDialog1: TOpenPictureDialog
+    Filter = 'All files (*)|*|Graphic (*.png;*.xpm;*.bmp)|*.png;*.xpm;*.bmp|Portable Network Graphic (*.png)|*.png|Pixmap (*.xpm)|*.xpm|Bitmaps (*.bmp)|*.bmp'
+    FilterIndex = 0
+    left = 88
+    top = 64
+  end
+  object SavePictureDialog1: TSavePictureDialog
+    Filter = 'All files (*)|*|Graphic (*.png;*.xpm;*.bmp)|*.png;*.xpm;*.bmp|Portable Network Graphic (*.png)|*.png|Pixmap (*.xpm)|*.xpm|Bitmaps (*.bmp)|*.bmp'
+    FilterIndex = 0
+    left = 88
+    top = 112
+  end
+end

components/jpeg/examples/mainform.lrs

@@ -0,0 +1,31 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TJPEGExampleForm','FORMDATA',[
+  'TPF0'#16'TJPEGExampleForm'#15'JPEGExampleForm'#7'Caption'#6#28'Example for J'
+  +'PEG for Lazarus'#12'ClientHeight'#3#160#1#11'ClientWidth'#3#169#1#18'HorzSc'
+  +'rollBar.Page'#3#170#1#18'VertScrollBar.Page'#3#161#1#4'Left'#3'#'#1#6'Heigh'
+  +'t'#3#160#1#3'Top'#3#163#0#5'Width'#3#169#1#0#9'TGroupBox'#13'ImageGroupBox'
+  +#5'Align'#7#5'alTop'#7'Anchors'#11#5'akTop'#6'akLeft'#8'akBottom'#0#7'Captio'
+  +'n'#6#3'...'#12'ClientHeight'#3'?'#1#11'ClientWidth'#3#165#1#11'ParentColor'
+  +#9#11'ParentCtl3D'#8#8'TabOrder'#2#0#6'Height'#3'P'#1#5'Width'#3#169#1#0#6'T'
+  +'Image'#6'Image1'#5'Align'#7#8'alClient'#11'Transparent'#9#12'Proportional'#9
+  +#6'Height'#3'?'#1#5'Width'#3#165#1#0#0#0#7'TButton'#14'LoadJPEGButton'#7'Anc'
+  +'hors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#19'Load JPEG from file'#8'Tab'
+  +'Order'#2#1#7'OnClick'#7#19'LoadJPEGButtonClick'#4'Left'#3#229#0#6'Height'#2
+  +#25#3'Top'#3'Z'#1#5'Width'#3#173#0#0#0#7'TButton'#14'SaveJPEGButton'#7'Ancho'
+  +'rs'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#20'Save as JPEG to file'#8'TabO'
+  +'rder'#2#2#7'OnClick'#7#19'SaveJPEGButtonClick'#4'Left'#3#229#0#6'Height'#2
+  +#25#3'Top'#3'|'#1#5'Width'#3#173#0#0#0#7'TButton'#15'LoadImageButton'#7'Anch'
+  +'ors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#10'Load Image'#8'TabOrder'#2#3
+  +#7'OnClick'#7#20'LoadImageButtonClick'#4'Left'#2#24#6'Height'#2#25#3'Top'#3
+  +'Z'#1#5'Width'#3#163#0#0#0#7'TButton'#15'SaveImageButton'#7'Anchors'#11#6'ak'
+  +'Left'#8'akBottom'#0#7'Caption'#6#10'Save Image'#8'TabOrder'#2#4#7'OnClick'#7
+  +#20'SaveImageButtonClick'#4'Left'#2#24#6'Height'#2#25#3'Top'#3'|'#1#5'Width'
+  +#3#163#0#0#0#18'TOpenPictureDialog'#18'OpenPictureDialog1'#6'Filter'#6#143'A'
+  +'ll files (*)|*|Graphic (*.png;*.xpm;*.bmp)|*.png;*.xpm;*.bmp|Portable Netwo'
+  +'rk Graphic (*.png)|*.png|Pixmap (*.xpm)|*.xpm|Bitmaps (*.bmp)|*.bmp'#11'Fil'
+  +'terIndex'#2#0#4'left'#2'X'#3'top'#2'@'#0#0#18'TSavePictureDialog'#18'SavePi'
+  +'ctureDialog1'#6'Filter'#6#143'All files (*)|*|Graphic (*.png;*.xpm;*.bmp)|*'
+  +'.png;*.xpm;*.bmp|Portable Network Graphic (*.png)|*.png|Pixmap (*.xpm)|*.xp'
+  +'m|Bitmaps (*.bmp)|*.bmp'#11'FilterIndex'#2#0#4'left'#2'X'#3'top'#2'p'#0#0#0
+]);

components/jpeg/examples/mainform.pas

@@ -0,0 +1,193 @@
+{ Copyright (C) 2004 Mattias Gaertner
+
+  Example for loading and saving jpeg images.
+  
+  Important:
+    This example uses the JPEGForLazarusPackage (see in the directory above).
+    You must first open once this package so that the IDE knows, where to find
+    the lpk file.
+    
+  See the README.txt.
+
+
+  This program is free software; you can redistribute it and/or modify it
+  under the terms of the GNU General Public License as published by the Free
+  Software Foundation; either version 2 of the License, or (at your option)
+  any later version.
+
+  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. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU General Public License along with
+  this program; if not, write to the Free Software Foundation, Inc., 59 Temple
+  Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit MainForm;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  ExtCtrls, Buttons, ExtDlgs, LazJPEG;
+
+type
+  TJPEGExampleForm = class(TForm)
+    LoadImageButton: TButton;
+    SaveImageButton: TButton;
+    LoadJPEGButton: TButton;
+    OpenPictureDialog1: TOpenPictureDialog;
+    SaveJPEGButton: TButton;
+    ImageGroupBox: TGroupBox;
+    Image1: TImage;
+    SavePictureDialog1: TSavePictureDialog;
+    procedure LoadJPEGButtonClick(Sender: TObject);
+    procedure LoadImageButtonClick(Sender: TObject);
+    procedure SaveJPEGButtonClick(Sender: TObject);
+    procedure SaveImageButtonClick(Sender: TObject);
+  private
+    procedure UpdateInfo(const Filename: string);
+  end;
+
+var
+  JPEGExampleForm: TJPEGExampleForm;
+
+implementation
+
+{ TJPEGExampleForm }
+
+procedure TJPEGExampleForm.LoadJPEGButtonClick(Sender: TObject);
+var
+  JPEG: TJPEGImage;
+begin
+  OpenPictureDialog1.Options:=OpenPictureDialog1.Options+[ofFileMustExist];
+  if not OpenPictureDialog1.Execute then exit;
+  try
+    //--------------------------------------------------------------------------
+    // Create a TJPEGImage and load the file, then copy it to the TImage.
+    // A TJPEGImage can only load jpeg images.
+    JPEG:=TJPEGImage.Create;
+    try
+      JPEG.LoadFromFile(OpenPictureDialog1.Filename);
+      // copy jpeg content to a TImage
+      Image1.Picture.Assign(JPEG);
+    finally
+      JPEG.Free;
+    end;
+    //--------------------------------------------------------------------------
+    UpdateInfo(OpenPictureDialog1.Filename);
+  except
+    on E: Exception do begin
+      MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0);
+    end;
+  end;
+end;
+
+procedure TJPEGExampleForm.LoadImageButtonClick(Sender: TObject);
+var
+  JPEG: TJPEGImage;
+begin
+  OpenPictureDialog1.Options:=OpenPictureDialog1.Options+[ofFileMustExist];
+  if not OpenPictureDialog1.Execute then exit;
+  try
+    //--------------------------------------------------------------------------
+    // Loading directly into a TImage. This will load any registered image
+    // format. .bmp, .xpm, .png are the standard LCL formats.
+    // The jpeg units register .jpeg and .jpg.
+    Image1.Picture.LoadFromFile(OpenPictureDialog1.Filename);
+    //--------------------------------------------------------------------------
+
+    UpdateInfo(OpenPictureDialog1.Filename);
+  except
+    on E: Exception do begin
+      MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0);
+    end;
+  end;
+end;
+
+procedure TJPEGExampleForm.SaveJPEGButtonClick(Sender: TObject);
+var
+  JPEG: TJPEGImage;
+begin
+  if Image1.Picture.Graphic=nil then begin
+    MessageDlg('No image','Please open an image, before save',mtError,
+      [mbOk],0);
+    exit;
+  end;
+  
+  SavePictureDialog1.Options:=SavePictureDialog1.Options+[ofPathMustExist];
+  if not SavePictureDialog1.Execute then exit;
+  try
+    //--------------------------------------------------------------------------
+    // Create a TImage1 and copy the TImage into it. Then save to file.
+    // This will ignore the file extension. TImage1 will always save as jpeg.
+    JPEG:=TJPEGImage.Create;
+    try
+      // copy content of the TImage to jpeg
+      JPEG.Assign(Image1.Picture.Graphic);
+      // save to file
+      JPEG.SaveToFile(SavePictureDialog1.Filename);
+    finally
+      JPEG.Free;
+    end;
+    //--------------------------------------------------------------------------
+
+    UpdateInfo(SavePictureDialog1.Filename);
+  except
+    on E: Exception do begin
+      MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0);
+    end;
+  end;
+end;
+
+procedure TJPEGExampleForm.SaveImageButtonClick(Sender: TObject);
+var
+  JPEG: TJPEGImage;
+begin
+  if Image1.Picture.Graphic=nil then begin
+    MessageDlg('No image','Please open an image, before save',mtError,
+      [mbOk],0);
+    exit;
+  end;
+
+  SavePictureDialog1.Options:=SavePictureDialog1.Options+[ofPathMustExist];
+  if not SavePictureDialog1.Execute then exit;
+  try
+    //--------------------------------------------------------------------------
+    // Saving directly from a TImage to a file. This will save in any registered
+    // image format. .bmp, .xpm, .png are the standard LCL formats.
+    // The jpeg units register .jpeg and .jpg.
+    // So, saving as file1.jpg will save as jpeg, while saving a file1.bmp will
+    // save as bmp.
+    Image1.Picture.SaveToFile(SavePictureDialog1.Filename);
+
+    //--------------------------------------------------------------------------
+
+    UpdateInfo(SavePictureDialog1.Filename);
+  except
+    on E: Exception do begin
+      MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0);
+    end;
+  end;
+end;
+
+procedure TJPEGExampleForm.UpdateInfo(const Filename: string);
+var
+  Info: String;
+begin
+  if Image1.Picture.Graphic<>nil then begin
+    Info:=Image1.Picture.Graphic.ClassName+':'+Filename;
+  end else begin
+    Info:=Filename;
+  end;
+  ImageGroupBox.Caption:=Info;
+end;
+
+initialization
+  {$I mainform.lrs}
+
+end.
+

components/jpeg/lazjpeg.pas

@@ -28,7 +28,7 @@ type
   TJPEGQualityRange = TFPJPEGCompressionQuality;
   TJPEGPerformance = TJPEGReadPerformance;
 
-  TJPEGImage = class(TBitmap)
+  TJPEGImage = class(TFPImageBitmap)
   private
     FPerformance: TJPEGPerformance;
     FProgressiveEncoding: boolean;
@@ -37,16 +37,11 @@ type
     procedure InitFPImageReader(ImgReader: TFPCustomImageReader); override;
     procedure FinalizeFPImageReader(ImgReader: TFPCustomImageReader); override;
     procedure InitFPImageWriter(ImgWriter: TFPCustomImageWriter); override;
-    procedure ReadStream(Stream: TStream; UseSize: boolean; Size: Longint); override;
-    procedure WriteStream(Stream: TStream; WriteSize: Boolean); override;
   public
     constructor Create; override;
-    function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
-    function GetDefaultMimeType: string; override;
-    class function GetFPReaderForFileExt(
-      const FileExtension: string): TFPCustomImageReaderClass; override;
-    class function GetFPWriterForFileExt(
-      const FileExtension: string): TFPCustomImageWriterClass; override;
+    class function GetFileExtensions: string; override;
+    class function GetDefaultFPReader: TFPCustomImageReaderClass; override;
+    class function GetDefaultFPWriter: TFPCustomImageWriterClass; override;
   public
     property CompressionQuality: TJPEGQualityRange read FQuality write FQuality;
     property ProgressiveEncoding: boolean read FProgressiveEncoding;
@@ -56,6 +51,7 @@ type
 const
   DefaultJPEGMimeType = 'image/jpeg';
 
+
 implementation
 
 
@@ -96,40 +92,16 @@ begin
   inherited InitFPImageWriter(ImgWriter);
 end;
 
-function TJPEGImage.LazarusResourceTypeValid(const ResourceType: string
-  ): boolean;
-begin
-  Result:=(ResourceType='JPG') or (ResourceType='JPEG');
-end;
-
-function TJPEGImage.GetDefaultMimeType: string;
-begin
-  Result:=DefaultJPEGMimeType;
-end;
-
-function TJPEGImage.GetFPReaderForFileExt(const FileExtension: string
-  ): TFPCustomImageReaderClass;
+function TJPEGImage.GetDefaultFPReader: TFPCustomImageReaderClass;
 begin
   Result:=TFPReaderJPEG;
 end;
 
-function TJPEGImage.GetFPWriterForFileExt(const FileExtension: string
-  ): TFPCustomImageWriterClass;
+function TJPEGImage.GetDefaultFPWriter: TFPCustomImageWriterClass;
 begin
   Result:=TFPWriterJPEG;
 end;
 
-procedure TJPEGImage.ReadStream(Stream: TStream; UseSize: boolean;
-  Size: Longint);
-begin
-  ReadStreamWithFPImage(Stream,UseSize,Size,TFPReaderJPEG);
-end;
-
-procedure TJPEGImage.WriteStream(Stream: TStream; WriteSize: Boolean);
-begin
-  WriteStreamWithFPImage(Stream,WriteSize,TFPWriterJPEG);
-end;
-
 constructor TJPEGImage.Create;
 begin
   inherited Create;
@@ -138,6 +110,11 @@ begin
   FQuality:=75;
 end;
 
+function TJPEGImage.GetFileExtensions: string;
+begin
+  Result:='jpg;jpeg';
+end;
+
 initialization
   TPicture.RegisterFileFormat('jpg', 'JPEG Image File', TJPEGImage);
   TPicture.RegisterFileFormat('jpeg', 'JPEG Image File', TJPEGImage);

lcl/graphics.pp

@@ -608,11 +608,14 @@ type
       FormatID: TClipboardFormat); virtual;
     procedure GetSupportedSourceMimeTypes(List: TStrings); virtual;
     function GetDefaultMimeType: string; virtual;
+    class function GetFileExtensions: string; virtual;
     {$IFNDEF DisableFPImage}
     class function GetFPReaderForFileExt(
       const FileExtension: string): TFPCustomImageReaderClass; virtual;
     class function GetFPWriterForFileExt(
       const FileExtension: string): TFPCustomImageWriterClass; virtual;
+    class function GetDefaultFPReader: TFPCustomImageReaderClass; virtual;
+    class function GetDefaultFPWriter: TFPCustomImageWriterClass; virtual;
     {$ENDIF}
   public
     property Empty: Boolean read GetEmpty;
@@ -1020,6 +1023,7 @@ type
     procedure LoadFromMimeStream(Stream: TStream; const MimeType: string); override;
     procedure GetSupportedSourceMimeTypes(List: TStrings); override;
     function GetDefaultMimeType: string; override;
+    class function GetFileExtensions: string; override;
     Procedure LoadFromXPMFile(const Filename : String);
     procedure Mask(ATransparentColor: TColor);
     procedure SaveToStream(Stream: TStream); override;
@@ -1032,6 +1036,8 @@ type
       const FileExtension: string): TFPCustomImageReaderClass; override;
     class function GetFPWriterForFileExt(
       const FileExtension: string): TFPCustomImageWriterClass; override;
+    class function GetDefaultFPReader: TFPCustomImageReaderClass; override;
+    class function GetDefaultFPWriter: TFPCustomImageWriterClass; override;
     {$ENDIF}
   public
     property Canvas: TCanvas read GetCanvas write FCanvas;
@@ -1054,18 +1060,28 @@ type
   public
     function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
     procedure WriteStream(Stream: TStream; WriteSize: Boolean); override;
+    {$IFNDEF DisableFPImage}
+    class function GetDefaultFPReader: TFPCustomImageReaderClass; override;
+    class function GetDefaultFPWriter: TFPCustomImageWriterClass; override;
+    {$ENDIF}
   end;
 
 
-  { TPortableNetworkGraphic }
-
-  TPortableNetworkGraphic = class(TBitmap)
+  { TFPImageBitmap }
+  { Use this class to easily create a TBitmap descendent for FPImage
+    reader and writer }
+  
+  TFPImageBitmap = class(TBitmap)
   public
+    class function GetFileExtensions: string; override;
+    class function IsFileExtensionSupported(const FileExtension: string): boolean;
     {$IFNDEF DisableFPImage}
     class function GetFPReaderForFileExt(
       const FileExtension: string): TFPCustomImageReaderClass; override;
     class function GetFPWriterForFileExt(
       const FileExtension: string): TFPCustomImageWriterClass; override;
+    class function GetDefaultFPReader: TFPCustomImageReaderClass; override;
+    class function GetDefaultFPWriter: TFPCustomImageWriterClass; override;
     {$ENDIF}
     function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
     procedure ReadStream(Stream: TStream; UseSize: boolean; Size: Longint); override;
@@ -1073,6 +1089,19 @@ type
     function GetDefaultMimeType: string; override;
   end;
 
+
+  { TPortableNetworkGraphic }
+
+  TPortableNetworkGraphic = class(TFPImageBitmap)
+  public
+    class function GetFileExtensions: string; override;
+    {$IFNDEF DisableFPImage}
+    class function GetDefaultFPReader: TFPCustomImageReaderClass; override;
+    class function GetDefaultFPWriter: TFPCustomImageWriterClass; override;
+    {$ENDIF}
+  end;
+
+
   { TIcon }
   {
     TIcon reads and writes .ICO file format.
@@ -1082,6 +1111,7 @@ type
   end;
 
 
+
 function GraphicFilter(GraphicClass: TGraphicClass): string;
 function GraphicExtension(GraphicClass: TGraphicClass): string;
 function GraphicFileMask(GraphicClass: TGraphicClass): string;
@@ -1432,6 +1462,115 @@ end;
 {$I png.inc}
 
 
+{ TFPImageBitmap }
+
+function TFPImageBitmap.GetFileExtensions: string;
+begin
+  Result:='';
+end;
+
+function TFPImageBitmap.IsFileExtensionSupported(
+  const FileExtension: string): boolean;
+var
+  Extensions: String;
+  StartPos: Integer;
+  EndPos: Integer;
+  i: Integer;
+begin
+  Result:=false;
+  if FileExtension='' then exit;
+  Extensions:=GetFileExtensions;
+  StartPos:=1;
+  while StartPos<=length(Extensions) do begin
+    if not (Extensions[StartPos] in [';',' ']) then begin
+      EndPos:=StartPos;
+      while (EndPos<=length(Extensions)) and (Extensions[EndPos]<>';') do
+        inc(EndPos);
+      if EndPos-StartPos=length(FileExtension) then begin
+        i:=1;
+        while (i<=length(FileExtension))
+        and (upcase(Extensions[StartPos+i-1])=upcase(FileExtension[i])) do
+          inc(i);
+        if i>length(FileExtension) then begin
+          Result:=true;
+          exit;
+        end;
+      end;
+      StartPos:=EndPos;
+    end else
+      inc(StartPos);
+  end;
+end;
+
+{$IFNDEF DisableFPImage}
+function TFPImageBitmap.GetFPReaderForFileExt(const FileExtension: string
+  ): TFPCustomImageReaderClass;
+begin
+  if IsFileExtensionSupported(FileExtension) then
+    Result:=GetDefaultFPReader
+  else
+    Result:=nil;
+end;
+
+function TFPImageBitmap.GetFPWriterForFileExt(const FileExtension: string
+  ): TFPCustomImageWriterClass;
+begin
+  if IsFileExtensionSupported(FileExtension) then
+    Result:=GetDefaultFPWriter
+  else
+    Result:=nil;
+end;
+
+function TFPImageBitmap.GetDefaultFPReader: TFPCustomImageReaderClass;
+begin
+  Result:=nil;
+end;
+
+function TFPImageBitmap.GetDefaultFPWriter: TFPCustomImageWriterClass;
+begin
+  Result:=nil;
+end;
+{$ENDIF}
+
+function TFPImageBitmap.LazarusResourceTypeValid(const ResourceType: string
+  ): boolean;
+begin
+  Result:=IsFileExtensionSupported(ResourceType);
+end;
+
+procedure TFPImageBitmap.ReadStream(Stream: TStream; UseSize: boolean;
+  Size: Longint);
+begin
+{$IFNDEF DisableFPImage}
+  ReadStreamWithFPImage(Stream,UseSize,Size,GetDefaultFPReader);
+{$ELSE}
+  RaiseGDBException('TFPImageBitmap.ReadStream needs FPImage');
+{$ENDIF}
+end;
+
+procedure TFPImageBitmap.WriteStream(Stream: TStream; WriteSize: Boolean);
+begin
+{$IFNDEF DisableFPImage}
+  WriteStreamWithFPImage(Stream,WriteSize,GetDefaultFPWriter);
+{$ELSE}
+  RaiseGDBException('TFPImageBitmap.WriteStream needs FPImage');
+{$ENDIF}
+end;
+
+function TFPImageBitmap.GetDefaultMimeType: string;
+var
+  DefaultFileExt: String;
+  i: Integer;
+begin
+  DefaultFileExt:=GetFileExtensions;
+  i:=1;
+  while (i<=length(DefaultFileExt)) and (DefaultFileExt[i]<>';') do
+    inc(i);
+  if i<=length(DefaultFileExt) then
+    DefaultFileExt:=copy(DefaultFileExt,1,i);
+  Result:='image/'+DefaultFileExt;
+end;
+
 initialization
   PicClipboardFormats:=nil;
   PicFileFormats:=nil;
@@ -1453,6 +1592,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.123  2004/02/29 22:51:54  mattias
+  added jpeg example
+
   Revision 1.122  2004/02/29 10:34:00  mattias
   fixed bmp reader reader skipping header
 

lcl/include/bitmap.inc

@@ -348,6 +348,11 @@ begin
     Result:=inherited GetDefaultMimeType;
 end;
 
+function TBitmap.GetFileExtensions: string;
+begin
+  Result:='bmp;xpm';
+end;
+
 Procedure TBitmap.LoadFromXPMFile(const Filename : String);
 var
   pstr : PChar;
@@ -1024,7 +1029,7 @@ begin
   or (AnsiCompareText(ClassName,'TPixmap')=0) then begin
     if (AnsiCompareText(FileExtension,'.bmp')=0)
     or (AnsiCompareText(FileExtension,'bmp')=0) then
-      Result:=TFPReaderBMP
+      Result:=TLazReaderBMP
     else if (AnsiCompareText(FileExtension,'.xpm')=0)
     or (AnsiCompareText(FileExtension,'xpm')=0) then
       Result:=TLazReaderXPM;
@@ -1045,6 +1050,22 @@ begin
       Result:=TLazWriterXPM;
   end;
 end;
+
+function TBitmap.GetDefaultFPReader: TFPCustomImageReaderClass;
+begin
+  if (AnsiCompareText(ClassName,'TBitmap')=0) then
+    Result:=TLazReaderBMP
+  else
+    Result:=nil;
+end;
+
+function TBitmap.GetDefaultFPWriter: TFPCustomImageWriterClass;
+begin
+  if (AnsiCompareText(ClassName,'TBitmap')=0) then
+    Result:=TFPWriterBMP
+  else
+    Result:=nil;
+end;
 {$ENDIF}
 
 function TBitmap.GetEmpty: boolean;
@@ -1107,6 +1128,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.76  2004/02/29 22:51:54  mattias
+  added jpeg example
+
   Revision 1.75  2004/02/29 10:34:00  mattias
   fixed bmp reader reader skipping header
 

lcl/include/graphic.inc

@@ -155,6 +155,17 @@ begin
   Result:='';
 end;
 
+{-------------------------------------------------------------------------------
+  function TGraphic.GetFileExtensions: string;
+
+  Returns standard file extensions for reading and writing separated by
+  semicolon and without point. For example: "bmp;xpm"
+-------------------------------------------------------------------------------}
+function TGraphic.GetFileExtensions: string;
+begin
+  Result:='';
+end;
+
 procedure TGraphic.LoadFromFile(const Filename: string);
 var
   Stream: TStream;
@@ -197,6 +208,16 @@ function TGraphic.GetFPWriterForFileExt(const FileExtension: string
 begin
   Result:=nil;
 end;
+
+function TGraphic.GetDefaultFPReader: TFPCustomImageReaderClass;
+begin
+  Result:=nil;
+end;
+
+function TGraphic.GetDefaultFPWriter: TFPCustomImageWriterClass;
+begin
+  Result:=nil;
+end;
 {$ENDIF}
 
 procedure TGraphic.SetTransparent(Value: Boolean);

lcl/include/imglist.inc

@@ -876,8 +876,8 @@ begin
           Img.Height := Height;
           Img.Canvas.CopyRect(SrcRect, Image.Canvas,
                               Bounds(Col * Width, Row * Height, Width, Height));
-          Img.Canvas.Brush.Color:=clRed;
-          Img.Canvas.Fillrect(Rect(3,3,10,8));
+          //Img.Canvas.Brush.Color:=clRed;
+          //Img.Canvas.Fillrect(Rect(3,3,10,8));
           //Img.SaveToFile('debug_imglist_i'+IntToStr(Count)+'.bmp');
 
           if Mask<>nil then begin
@@ -1162,6 +1162,9 @@ end;
 {
 
   $Log$
+  Revision 1.27  2004/02/29 22:51:54  mattias
+  added jpeg example
+
   Revision 1.26  2004/02/28 00:34:35  mattias
   fixed CreateComponent for buttons, implemented basic Drag And Drop
 

lcl/include/pixmap.inc

@@ -268,24 +268,39 @@ begin
   Result:=(ResourceType='XPM');
 end;
 
-procedure TPixmap.WriteStream(Stream: TStream; WriteSize: Boolean);
 {$IFNDEF DisableFPImage}
+procedure TPixmap.WriteStream(Stream: TStream; WriteSize: Boolean);
 begin
   WriteStreamWithFPImage(Stream,WriteSize,TFPWriterBMP);
   if (FImage.SaveStream<>nil) and (FImage.SaveStreamType=bnNone) then
     FImage.SaveStreamType:=bnXPixmap;
 end;
-{$ELSE}
+
+function TPixmap.GetDefaultFPReader: TFPCustomImageReaderClass;
+begin
+  Result:=TLazReaderXPM;
+end;
+
+function TPixmap.GetDefaultFPWriter: TFPCustomImageWriterClass;
+begin
+  Result:=TLazWriterXPM;
+end;
+{$ELSE DisableFPImage}
+procedure TPixmap.WriteStream(Stream: TStream; WriteSize: Boolean);
 begin
   inherited WriteStream(Stream,WriteSize);
 end;
 {$ENDIF}
 
+
 // included by graphics.pp
 
 { =============================================================================
 
   $Log$
+  Revision 1.27  2004/02/29 22:51:54  mattias
+  added jpeg example
+
   Revision 1.26  2004/02/27 00:42:41  marc
   * Interface CreateComponent splitup
   * Implemented CreateButtonHandle on GTK interface

lcl/include/png.inc

@@ -21,50 +21,22 @@
 { TPortableNetworkGraphic }
 
 {$IFNDEF DisableFPImage}
-function TPortableNetworkGraphic.GetFPReaderForFileExt(
-  const FileExtension: string): TFPCustomImageReaderClass;
+function TPortableNetworkGraphic.GetFileExtensions: string;
+begin
+  Result:='png';
+end;
+
+function TPortableNetworkGraphic.GetDefaultFPReader: TFPCustomImageReaderClass;
 begin
   Result:=TFPReaderPNG;
 end;
 
-function TPortableNetworkGraphic.GetFPWriterForFileExt(
-  const FileExtension: string): TFPCustomImageWriterClass;
+function TPortableNetworkGraphic.GetDefaultFPWriter: TFPCustomImageWriterClass;
 begin
   Result:=TFPWriterPNG;
 end;
 {$ENDIF}
 
-function TPortableNetworkGraphic.LazarusResourceTypeValid(
-  const ResourceType: string): boolean;
-begin
-  Result:=(ResourceType='PNG');
-end;
-
-procedure TPortableNetworkGraphic.ReadStream(Stream: TStream; UseSize: boolean;
-  Size: Longint);
-begin
-{$IFNDEF DisableFPImage}
-  ReadStreamWithFPImage(Stream,UseSize,Size,TFPReaderPNG);
-{$ELSE}
-  RaiseGDBException('TPortableNetworkGraphic.ReadStream needs FPImage');
-{$ENDIF}
-end;
-
-procedure TPortableNetworkGraphic.WriteStream(Stream: TStream;
-  WriteSize: Boolean);
-begin
-{$IFNDEF DisableFPImage}
-  WriteStreamWithFPImage(Stream,WriteSize,TFPWriterPNG);
-{$ELSE}
-  RaiseGDBException('TPortableNetworkGraphic.WriteStream needs FPImage');
-{$ENDIF}
-end;
-
-function TPortableNetworkGraphic.GetDefaultMimeType: string;
-begin
-  Result:='image/png';
-end;
-
 
 // included by graphics.pp