paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-13 17:59:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ added "Images For Lazarus" package which allow handling all FCL supported Image formats

Browse Source 
git-svn-id: trunk@5857 -
This commit is contained in:
mazen 2004-08-26 07:34:45 +00:00
parent 631040fd94
commit a06f3320e8
14 changed files with 998 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
.gitattributes vendored
View File

@ -78,6 +78,19 @@ components/htmllite/litereadthd.pas svneol=native#text/pascal
components/htmllite/litesbs1.pas svneol=native#text/pascal
components/htmllite/litesubs.pas svneol=native#text/pascal
components/htmllite/liteun2.pas svneol=native#text/pascal
components/images/examples/README.txt svneol=native#text/plain
components/images/examples/imagesexample.lpi svneol=native#text/plain
components/images/examples/imagesexample.lpr svneol=native#text/pascal
components/images/examples/lazarus.jpg -text svneol=unset#image/jpeg
components/images/examples/mainform.lfm svneol=native#text/plain
components/images/examples/mainform.lrs svneol=native#text/pascal
components/images/examples/mainform.pas svneol=native#text/pascal
components/images/imagesforlazarus.lpk svneol=native#text/pascal
components/images/imagesforlazarus.pas svneol=native#text/pascal
components/images/lazjpg.pas svneol=native#text/pascal
components/images/lazpng.pas svneol=native#text/pascal
components/images/lazpnm.pas svneol=native#text/pascal
components/images/readme.txt svneol=native#text/plain
components/interbase/interbaselaz.lpk svneol=native#text/pascal
components/interbase/interbaselaz.pas svneol=native#text/pascal
components/interbase/registerinterbase.lrs svneol=native#text/pascal

27
components/images/examples/README.txt Normal file
View File

@ -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

238
components/images/examples/imagesexample.lpi Normal file
View File

@ -0,0 +1,238 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="3"/>
<General>
<ProjectType Value="Application"/>
<MainUnit Value="0"/>
<ActiveEditorIndexAtStart Value="1"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
<Title Value="jpegexample"/>
</General>
<JumpHistory Count="1" HistoryIndex="0">
<Position1>
<Filename Value="mainform.pas"/>
<Caret Line="38" Column="21" TopLine="38"/>
</Position1>
</JumpHistory>
<Units Count="24">
<Unit0>
<CursorPos X="65" Y="11"/>
<EditorIndex Value="3"/>
<Filename Value="imagesexample.lpr"/>
<IsPartOfProject Value="True"/>
<Loaded Value="True"/>
<TopLine Value="1"/>
<UnitName Value="JPEGExample"/>
<UsageCount Value="33"/>
</Unit0>
<Unit1>
<CursorPos X="21" Y="38"/>
<EditorIndex Value="0"/>
<Filename Value="mainform.pas"/>
<ComponentName Value="ImagesExampleForm"/>
<IsPartOfProject Value="True"/>
<Loaded Value="True"/>
<ResourceFilename Value="mainform.lrs"/>
<TopLine Value="38"/>
<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="2"/>
<Filename Value="README.txt"/>
<IsPartOfProject Value="True"/>
<Loaded Value="True"/>
<SyntaxHighlighter Value="None"/>
<TopLine Value="1"/>
<UsageCount Value="21"/>
</Unit22>
<Unit23>
<CursorPos X="1" Y="468"/>
<EditorIndex Value="1"/>
<Filename Value="/home/neifer/FPC/Demo/src/lazarus/lcl/include/picture.inc"/>
<Loaded Value="True"/>
<TopLine Value="454"/>
<UsageCount Value="10"/>
</Unit23>
</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>
<Version Value="2"/>
<SearchPaths>
<OtherUnitFiles Value="$(LazarusDir)/components/units/$(TargetCPU)/$(TargetOS)/"/>
<SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<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>

14
components/images/examples/imagesexample.lpr Normal file
View File

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

BIN
components/images/examples/lazarus.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 8.4 KiB

87
components/images/examples/mainform.lfm Normal file
View File

@ -0,0 +1,87 @@
object ImagesExampleForm: TImagesExampleForm
Caption = 'Example for package "Images For Lazarus"'
ClientHeight = 416
ClientWidth = 425
PixelsPerInch = 101
HorzScrollBar.Page = 426
VertScrollBar.Page = 417
Left = 544
Height = 416
Top = 187
Width = 425
object ImageGroupBox: TGroupBox
Align = alTop
Anchors = [akTop, akLeft, akBottom]
Caption = '...'
ClientHeight = 315
ClientWidth = 421
ParentColor = True
ParentCtl3D = False
TabOrder = 0
Height = 336
Width = 425
object Image1: TImage
Align = alClient
Proportional = True
Transparent = True
Height = 315
Width = 421
end
end
object LoadJPEGButton: TButton
Anchors = [akLeft, akBottom]
Caption = 'Load JPEG from file'
OnClick = LoadJPEGButtonClick
TabOrder = 1
Left = 229
Height = 25
Top = 346
Width = 173
end
object SaveJPEGButton: TButton
Anchors = [akLeft, akBottom]
Caption = 'Save as JPEG to file'
OnClick = SaveJPEGButtonClick
TabOrder = 2
Left = 229
Height = 25
Top = 380
Width = 173
end
object LoadImageButton: TButton
Anchors = [akLeft, akBottom]
Caption = 'Load Image'
OnClick = LoadImageButtonClick
TabOrder = 3
Left = 24
Height = 25
Top = 346
Width = 163
end
object SaveImageButton: TButton
Anchors = [akLeft, akBottom]
Caption = 'Save Image'
OnClick = SaveImageButtonClick
TabOrder = 4
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'
Title = 'Open existing file'
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'
Title = 'Save file as'
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

37
components/images/examples/mainform.lrs Normal file
View File

@ -0,0 +1,37 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TImagesExampleForm','FORMDATA',[
'TPF0'#18'TImagesExampleForm'#17'ImagesExampleForm'#7'Caption'#6'(Example for'
+' package "Images For Lazarus"'#12'ClientHeight'#3#160#1#11'ClientWidth'#3
+#169#1#13'PixelsPerInch'#2'e'#18'HorzScrollBar.Page'#3#170#1#18'VertScrollBa'
+'r.Page'#3#161#1#4'Left'#3' '#2#6'Height'#3#160#1#3'Top'#3#187#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'Caption'#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'TImage'#6'Image1'#5'Align'#7#8'alClie'
+'nt'#12'Proportional'#9#11'Transparent'#9#6'Height'#3';'#1#5'Width'#3#165#1#0
+#0#0#7'TButton'#14'LoadJPEGButton'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'C'
+'aption'#6#19'Load JPEG from file'#7'OnClick'#7#19'LoadJPEGButtonClick'#8'Ta'
+'bOrder'#2#1#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'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Cap'
+'tion'#6#20'Save as JPEG to file'#7'OnClick'#7#19'SaveJPEGButtonClick'#8'Tab'
+'Order'#2#2#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'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Capt'
+'ion'#6#10'Load Image'#7'OnClick'#7#20'LoadImageButtonClick'#8'TabOrder'#2#3
+#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'akLeft'#8'akBottom'#0#7'Caption'#6#10'Save'
+' Image'#7'OnClick'#7#20'SaveImageButtonClick'#8'TabOrder'#2#4#4'Left'#2#24#6
+'Height'#2#25#3'Top'#3'|'#1#5'Width'#3#163#0#0#0#18'TOpenPictureDialog'#18'O'
+'penPictureDialog1'#6'Filter'#6#143'All files (*)|*|Graphic (*.png;*.xpm;*.b'
+'mp)|*.png;*.xpm;*.bmp|Portable Network Graphic (*.png)|*.png|Pixmap (*.xpm)'
+'|*.xpm|Bitmaps (*.bmp)|*.bmp'#5'Title'#6#18'Open existing file'#6'Filter'#6
+#143'All files (*)|*|Graphic (*.png;*.xpm;*.bmp)|*.png;*.xpm;*.bmp|Portable '
+'Network Graphic (*.png)|*.png|Pixmap (*.xpm)|*.xpm|Bitmaps (*.bmp)|*.bmp'#11
+'FilterIndex'#2#0#4'left'#2'X'#3'top'#2'@'#0#0#18'TSavePictureDialog'#18'Sav'
+'ePictureDialog1'#6'Filter'#6#143'All files (*)|*|Graphic (*.png;*.xpm;*.bmp'
+')|*.png;*.xpm;*.bmp|Portable Network Graphic (*.png)|*.png|Pixmap (*.xpm)|*'
+'.xpm|Bitmaps (*.bmp)|*.bmp'#5'Title'#6#12'Save file as'#6'Filter'#6#143'All'
+' files (*)|*|Graphic (*.png;*.xpm;*.bmp)|*.png;*.xpm;*.bmp|Portable Network'
+' Graphic (*.png)|*.png|Pixmap (*.xpm)|*.xpm|Bitmaps (*.bmp)|*.bmp'#11'Filte'
+'rIndex'#2#0#4'left'#2'X'#3'top'#2'p'#0#0#0
]);

193
components/images/examples/mainform.pas Normal file
View File

@ -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
TImagesExampleForm = 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
ImagesExampleForm: TImagesExampleForm;
implementation
{ TImagesExampleForm }
procedure TImagesExampleForm.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 TImagesExampleForm.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 TImagesExampleForm.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 TImagesExampleForm.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 TImagesExampleForm.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.

55
components/images/imagesforlazarus.lpk Normal file
View File

@ -0,0 +1,55 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="2">
<Name Value="ImagesForLazarus"/>
<Author Value="Mazen NEIFER"/>
<CompilerOptions>
<Version Value="2"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="Images for Lazarus.
"/>
<License Value="LGPL"/>
<Version Major="1" Release="1"/>
<Files Count="4">
<Item1>
<Filename Value="lazpng.pas"/>
<UnitName Value="lazpng"/>
</Item1>
<Item2>
<Filename Value="readme.txt"/>
<Type Value="Text"/>
</Item2>
<Item3>
<Filename Value="lazpnm.pas"/>
<UnitName Value="Lazpnm"/>
</Item3>
<Item4>
<Filename Value="lazjpg.pas"/>
<UnitName Value="Lazjpg"/>
</Item4>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)/"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

21
components/images/imagesforlazarus.pas Normal file
View File

@ -0,0 +1,21 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install
the package ImagesForLazarus 1.0.1.
}
unit ImagesForLazarus;
interface
uses
Lazpng, Lazpnm, Lazjpg, LazarusPackageIntf;
implementation
procedure Register;
begin
end;
initialization
RegisterPackage('ImagesForLazarus', @Register)
end.

128
components/images/lazjpg.pas Normal file
View File

@ -0,0 +1,128 @@
{ Copyright (C) 2003 Mattias Gaertner
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library 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 Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit Lazjpg;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, FPImage, IntfGraphics, Graphics,
FPReadJPEG, FPWriteJPEG,
ClipBrd;
type
TJPEGQualityRange = TFPJPEGCompressionQuality;
TJPEGPerformance = TJPEGReadPerformance;
TJPEGImage = class(TFPImageBitmap)
private
FPerformance: TJPEGPerformance;
FProgressiveEncoding: boolean;
FQuality: TJPEGQualityRange;
protected
procedure InitFPImageReader(ImgReader: TFPCustomImageReader); override;
procedure FinalizeFPImageReader(ImgReader: TFPCustomImageReader); override;
procedure InitFPImageWriter(ImgWriter: TFPCustomImageWriter); override;
public
constructor Create; 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;
property Performance: TJPEGPerformance read FPerformance write FPerformance;
end;
const
DefaultJPEGMimeType = 'image/jpeg';
implementation
{ TJPEGImage }
procedure TJPEGImage.InitFPImageReader(ImgReader: TFPCustomImageReader);
var
JPEGReader: TFPReaderJPEG;
begin
if ImgReader is TFPReaderJPEG then begin
JPEGReader:=TFPReaderJPEG(ImgReader);
JPEGReader.Performance:=Performance;
end;
inherited InitFPImageReader(ImgReader);
end;
procedure TJPEGImage.FinalizeFPImageReader(ImgReader: TFPCustomImageReader);
var
JPEGReader: TFPReaderJPEG;
begin
if ImgReader is TFPReaderJPEG then begin
JPEGReader:=TFPReaderJPEG(ImgReader);
FProgressiveEncoding:=JPEGReader.ProgressiveEncoding;
end;
inherited FinalizeFPImageReader(ImgReader);
end;
procedure TJPEGImage.InitFPImageWriter(ImgWriter: TFPCustomImageWriter);
var
JPEGWriter: TFPWriterJPEG;
begin
if ImgWriter is TFPWriterJPEG then begin
JPEGWriter:=TFPWriterJPEG(ImgWriter);
if JPEGWriter<>nil then ;
JPEGWriter.ProgressiveEncoding:=ProgressiveEncoding;
JPEGWriter.CompressionQuality:=CompressionQuality;
end;
inherited InitFPImageWriter(ImgWriter);
end;
function TJPEGImage.GetDefaultFPReader: TFPCustomImageReaderClass;
begin
Result:=TFPReaderJPEG;
end;
function TJPEGImage.GetDefaultFPWriter: TFPCustomImageWriterClass;
begin
Result:=TFPWriterJPEG;
end;
constructor TJPEGImage.Create;
begin
inherited Create;
FPerformance:=jpBestQuality;
FProgressiveEncoding:=false;
FQuality:=75;
end;
function TJPEGImage.GetFileExtensions: string;
begin
Result:='jpg;jpeg';
WriteLn('Sending result=',result);
end;
initialization
TPicture.RegisterFileFormat('jpg', 'JPEG Image File', TJPEGImage);
TPicture.RegisterFileFormat('jpeg', 'JPEG Image File', TJPEGImage);
TPicture.RegisterClipboardFormat(RegisterClipboardFormat(DefaultJPEGMimeType),
TJPEGImage);
finalization
TPicture.UnregisterGraphicClass(TJPEGImage);
end.

73
components/images/lazpng.pas Normal file
View File

@ -0,0 +1,73 @@
{ Copyright (C) 2003 Mattias Gaertner
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library 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 Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit Lazpng;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, FPImage, IntfGraphics, Graphics,
FPReadPNG, FPWritePNG,
ClipBrd;
type
TPNGImage = class(TFPImageBitmap)
public
constructor Create; override;
class function GetFileExtensions: string; override;
class function GetDefaultFPReader: TFPCustomImageReaderClass; override;
class function GetDefaultFPWriter: TFPCustomImageWriterClass; override;
end;
const
DefaultPNGMimeType = 'image/png';
implementation
{ TPNGImage }
function TPNGImage.GetDefaultFPReader: TFPCustomImageReaderClass;
begin
Result:=TFPReaderPNG;
end;
function TPNGImage.GetDefaultFPWriter: TFPCustomImageWriterClass;
begin
Result:=TFPWriterPNG;
end;
constructor TPNGImage.Create;
begin
inherited Create;
end;
function TPNGImage.GetFileExtensions: string;
begin
Result:='png';
end;
initialization
TPicture.RegisterFileFormat('png', 'PNG Image File', TPNGImage);
TPicture.RegisterClipboardFormat(RegisterClipboardFormat(DefaultPNGMimeType),
TPNGImage);
finalization
TPicture.UnregisterGraphicClass(TPNGImage);
end.

83
components/images/lazpnm.pas Normal file
View File

@ -0,0 +1,83 @@
{ Copyright (C) 2003 Mattias Gaertner
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library 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 Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit Lazpnm;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, FPImage, IntfGraphics, Graphics,
FPReadPNM, FPWritePNM,
ClipBrd;
type
TPNMImage = class(TFPImageBitmap)
public
constructor Create; override;
class function GetFileExtensions: string; override;
class function GetDefaultFPReader: TFPCustomImageReaderClass; override;
class function GetDefaultFPWriter: TFPCustomImageWriterClass; override;
end;
const
DefaultPPMMimeType = 'image/ppm';
DefaultPGMMimeType = 'image/pgm';
DefaultPBMMimeType = 'image/pbm';
implementation
{ TPNMImage }
function TPNMImage.GetDefaultFPReader: TFPCustomImageReaderClass;
begin
Result:=TFPReaderPNM;
end;
function TPNMImage.GetDefaultFPWriter: TFPCustomImageWriterClass;
begin
Result:=TFPWriterPNM;
end;
constructor TPNMImage.Create;
begin
inherited Create;
end;
function TPNMImage.GetFileExtensions: string;
begin
Result:='ppm;pgm;pbm';
WriteLn('Sending result=',result);
end;
initialization
TPicture.RegisterFileFormat('ppm', 'PNM Image File', TPNMImage);
TPicture.RegisterFileFormat('pgm', 'PNM Image File', TPNMImage);
TPicture.RegisterFileFormat('pbm', 'PNM Image File', TPNMImage);
TPicture.RegisterClipboardFormat(RegisterClipboardFormat(DefaultPPMMimeType),
TPNMImage);
TPicture.RegisterClipboardFormat(RegisterClipboardFormat(DefaultPGMMimeType),
TPNMImage);
TPicture.RegisterClipboardFormat(RegisterClipboardFormat(DefaultPBMMimeType),
TPNMImage);
finalization
TPicture.UnregisterGraphicClass(TPNMImage);
end.

29
components/images/readme.txt Normal file
View File

@ -0,0 +1,29 @@
WARNING WARNING WARNING WARNING WARNING
This package is broken. Read further.
The pasjpeg code in the current fpc sources have a bug.
If you want jpeg, then you must use an older fpc and the jpeg from lazarus-ccr
on sourceforge. Not this package.
-------------------------------------------------------------------------------
The lazarus TJPEGImage is in lazjpeg.pas
It uses the pasjpeg and fpimage libs provided by FreePascal. See there for in
more detailed jpeg handling.
JPEG (pronounced "jay-peg") is a standardized familly of algorithms for
compression of continous tone still images. Most JPEG processes are lossy,
the output image is not exactly identical to the input image. However, on
typical photographic images, very good compression levels can be obtained
with no visible change, and remarkably high compression levels are possible
if you can tolerate a low-quality image. The Independent JPEG Group (IJG) has
created a free, portable C library for JPEG compression and decompression of
JPEG images.