paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-15 11:49:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented TPixmap and TPortableNetworkGraphic with fpImage

Browse Source 
git-svn-id: trunk@4505 -
This commit is contained in:
mattias 2003-08-20 17:07:50 +00:00
parent 09f667c569
commit ffa38d9925
6 changed files with 250 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -809,6 +809,7 @@ lcl/include/paintbox.inc svneol=native#text/pascal
lcl/include/pen.inc svneol=native#text/pascal
lcl/include/picture.inc svneol=native#text/pascal
lcl/include/pixmap.inc svneol=native#text/pascal
lcl/include/png.inc svneol=native#text/pascal
lcl/include/popupmenu.inc svneol=native#text/pascal
lcl/include/progressbar.inc svneol=native#text/pascal
lcl/include/promptdialog.inc svneol=native#text/pascal

27
lcl/graphics.pp
View File

@ -34,7 +34,9 @@ interface
uses
SysUtils, Classes,
LCLStrConsts, vclGlobals, LMessages, LCLType, LCLProc, LCLLinux, LResources,
GraphType, GraphMath;
GraphType, GraphMath
{$IFDEF UseFPImage}, FPReadPNG, IntfGraphics{$ENDIF}
;
{$IFDEF NewGraphType}
type
@ -825,7 +827,7 @@ type
{$IFNDEF NewGraphType}
TTransparentMode = (tmAuto, tmFixed);
{$ENDIF}
TBitmapInternalStateFlag = (
bmisCreateingCanvas
);
@ -878,6 +880,7 @@ type
procedure SetWidth(NewWidth: Integer); override;
procedure WriteData(Stream: TStream); override;
procedure WriteStream(Stream: TStream; WriteSize: Boolean); virtual;
procedure StoreOriginalStream(Stream: TStream); virtual;
public
constructor VirtualCreate; override;
destructor Destroy; override;
@ -911,17 +914,21 @@ type
{ TPixmap }
{
@abstract()
Introduced by Marc Weustink <weus@quicknet.nl>
Currently maintained by ?
}
TPixmap = class(TBitmap)
public
procedure LoadFromLazarusResource(const ResName: String); override;
procedure WriteStream(Stream: TStream; WriteSize: Boolean); override;
end;
{ TPortableNetworkGraphic }
TPortableNetworkGraphic = class(TBitmap)
public
procedure LoadFromLazarusResource(const ResName: String); override;
procedure ReadStream(Stream: TStream; Size: Longint); override;
procedure WriteStream(Stream: TStream; WriteSize: Boolean); override;
end;
{ TIcon }
{
@abstract()
@ -1156,6 +1163,7 @@ end;
{$I font.inc}
{$I canvas.inc}
{$I pixmap.inc}
{$I png.inc}
initialization
@ -1173,6 +1181,9 @@ end.
{ =============================================================================
$Log$
Revision 1.82 2003/08/20 17:03:47 mattias
implemented TPixmap and TPortableNetworkGraphic with fpImage
Revision 1.81 2003/08/19 12:23:23 mattias
moved types from graphtype.pp back to graphics.pp

32
lcl/include/bitmap.inc
View File

@ -429,22 +429,14 @@ var
begin
UnshareImage;
if Size = 0 then
begin
if Size = 0 then begin
CreateEmptyBitmap;
exit;
end;
// store original stream
if Stream<>FImage.SaveStream then begin
MemStream:=TMemoryStream.Create;
MemStream.CopyFrom(Stream,Stream.Size-Stream.Position);
FreeAndNil(FImage.FSaveStream);
FImage.SaveStream:=MemStream;
end else
MemStream:=FImage.SaveStream;
FImage.SaveStreamType:=bnNone;
MemStream.Position:=0;
StoreOriginalStream(Stream);
MemStream:=FImage.SaveStream;
// determine stream type
FImage.SaveStreamType:=TestStreamBitmapNativeType(MemStream);
@ -619,6 +611,21 @@ begin
end;
end;
procedure TBitmap.StoreOriginalStream(Stream: TStream);
var
MemStream: TMemoryStream;
begin
if Stream<>FImage.SaveStream then begin
MemStream:=TMemoryStream.Create;
MemStream.CopyFrom(Stream,Stream.Size-Stream.Position);
FreeAndNil(FImage.FSaveStream);
FImage.SaveStream:=MemStream;
end else
MemStream:=FImage.SaveStream;
FImage.SaveStreamType:=bnNone;
MemStream.Position:=0;
end;
procedure TBitMap.SaveToStream(Stream: TStream);
begin
WriteStream(Stream, False);
@ -731,6 +738,9 @@ end;
{ =============================================================================
$Log$
Revision 1.40 2003/08/20 17:03:48 mattias
implemented TPixmap and TPortableNetworkGraphic with fpImage
Revision 1.39 2003/08/16 15:29:56 mattias
fixed TBitmap.GetHandle

61
lcl/include/pixmap.inc
View File

@ -281,11 +281,72 @@ begin
end;
end;
procedure TPixmap.WriteStream(Stream: TStream; WriteSize: Boolean);
{$IFDEF UseFPImage}
Procedure DoWriteStreamSize(DestStream: TStream; Size: longint);
begin
if WriteSize then
DestStream.WriteBuffer(Size, SizeOf(Size));
end;
procedure DoWriteOriginal;
begin
DoWriteStreamSize(Stream,FImage.SaveStream.Size);
FImage.SaveStream.Position:=0;
Stream.CopyFrom(FImage.SaveStream,FImage.SaveStream.Size);
end;
var
MemStream: TMemoryStream;
IntfImg: TLazIntfImage;
XPMWriter: TLazWriterXPM;
begin
if (FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0)
and (FImage.SaveStreamType=bnXPixmap) then begin
DoWriteOriginal;
exit;
end;
// write image in XPM format to temporary stream
MemStream:=TMemoryStream.Create;
IntfImg:=nil;
XPMWriter:=nil;
try
IntfImg:=TLazIntfImage.Create(0,0);
IntfImg.LoadFromBitmap(Handle,0);
XPMWriter:=TLazWriterXPM.Create;
IntfImg.SaveToStream(MemStream,XPMWriter);
FreeAndNil(XPMWriter);
FreeAndNil(IntfImg);
// save stream, so that further saves will be fast
MemStream.Position:=0;
FreeAndNil(FImage.FSaveStream);
FImage.SaveStream:=MemStream;
MemStream:=nil;
FImage.SaveStreamType:=bnXPixmap;
// copy savestream to destination stream
Stream.CopyFrom(FImage.SaveStream,FImage.SaveStream.Size);
finally
MemStream.Free;
IntfImg.Free;
XPMWriter.Free;
end;
end;
{$ELSE}
begin
inherited WriteStream(Stream,WriteSize);
end;
{$ENDIF}
// included by graphics.pp
{ =============================================================================
$Log$
Revision 1.20 2003/08/20 17:03:48 mattias
implemented TPixmap and TPortableNetworkGraphic with fpImage
Revision 1.19 2003/06/25 10:38:28 mattias
implemented saving original stream of TBitmap

147
lcl/include/png.inc Normal file
View File

@ -0,0 +1,147 @@
// included by graphics.pp
{******************************************************************************
TPortableNetworkGraphic
******************************************************************************
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.LCL, included in this distribution, *
* for details about the copyright. *
* *
* 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. *
* *
*****************************************************************************
}
{ TPortableNetworkGraphic }
procedure TPortableNetworkGraphic.LoadFromLazarusResource(const ResName: String
);
var
ms:TMemoryStream;
res:TLResource;
begin
res:=LazarusResources.Find(ResName);
if (res<>nil) and (res.Value<>'') and (res.ValueType='PNG') then begin
ms:=TMemoryStream.Create;
try
ms.Write(res.Value[1],length(res.Value));
ms.Position:=0;
LoadFromStream(ms);
finally
ms.Free;
end;
end;
end;
procedure TPortableNetworkGraphic.ReadStream(Stream: TStream; Size: Longint);
{$IFDEF UseFPImage}
var
IntfImg: TLazIntfImage;
PNGReader: TFPReaderPNG;
ImgHandle, ImgMaskHandle: HBitmap;
begin
UnshareImage;
if Size = 0 then begin
Width:=0;
Height:=0;
exit;
end;
StoreOriginalStream(Stream);
IntfImg:=nil;
PNGReader:=nil;
try
IntfImg:=TLazIntfImage.Create(0,0);
PNGReader:=TFPReaderPNG.Create;
FImage.SaveStream.Position:=0;
IntfImg.LoadFromStream(FImage.SaveStream,PNGReader);
IntfImg.CreateBitmap(ImgHandle,ImgMaskHandle);
Handle:=ImgHandle;
MaskHandle:=ImgMaskHandle;
finally
IntfImg.Free;
PNGReader.Free;
end;
end;
{$ELSE}
begin
RaiseGDBException('TPortableNetworkGraphic.ReadStream needs FPImage');
end;
{$ENDIF}
procedure TPortableNetworkGraphic.WriteStream(Stream: TStream;
WriteSize: Boolean);
{$IFDEF UseFPImage}
Procedure DoWriteStreamSize(DestStream: TStream; Size: longint);
begin
if WriteSize then
DestStream.WriteBuffer(Size, SizeOf(Size));
end;
procedure DoWriteOriginal;
begin
DoWriteStreamSize(Stream,FImage.SaveStream.Size);
FImage.SaveStream.Position:=0;
Stream.CopyFrom(FImage.SaveStream,FImage.SaveStream.Size);
end;
var
MemStream: TMemoryStream;
IntfImg: TLazIntfImage;
{$IFDEF HasPNGWriter}
PNGWriter: TFPWriterPNG;
{$ENDIF}
begin
if (FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0) then begin
DoWriteOriginal;
exit;
end;
RaiseGDBException('TPortableNetworkGraphic.WriteStream png writer not implemented yet');
// write image in XPM format to temporary stream
MemStream:=TMemoryStream.Create;
IntfImg:=nil;
{$IFDEF HasPNGWriter}
PNGWriter:=nil;
{$ENDIF}
try
IntfImg:=TLazIntfImage.Create(0,0);
IntfImg.LoadFromBitmap(Handle,0);
{$IFDEF HasPNGWriter}
PNGWriter:=TFPWriterPNG.Create;
IntfImg.SaveToStream(MemStream,PNGWriter);
FreeAndNil(PNGWriter);
{$ENDIF}
FreeAndNil(IntfImg);
// save stream, so that further saves will be fast
MemStream.Position:=0;
FreeAndNil(FImage.FSaveStream);
FImage.SaveStream:=MemStream;
MemStream:=nil;
// copy savestream to destination stream
Stream.CopyFrom(FImage.SaveStream,FImage.SaveStream.Size);
finally
MemStream.Free;
IntfImg.Free;
{$IFDEF HasPNGWriter}
PNGWriter.Free;
{$ENDIF}
end;
end;
{$ELSE}
begin
RaiseGDBException('TPortableNetworkGraphic.WriteStream needs FPImage');
end;
{$ENDIF}
// included by graphics.pp

3
lcl/intfgraphics.pas
View File

@ -31,8 +31,7 @@ unit IntfGraphics;
interface
uses
Classes, SysUtils, fpImage, AvgLvlTree, LCLLinux, LCLType, LCLProc, Graphics,
GraphType;
Classes, SysUtils, fpImage, AvgLvlTree, LCLLinux, LCLType, LCLProc, GraphType;
type
{ TLazIntfImage }