You've already forked lazarus-ccr
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6614 8e941d3f-bd1b-0410-a28a-d453659cc2b4
871 lines
25 KiB
ObjectPascal
871 lines
25 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvThumbImage.PAS, released on 2002-07-03.
|
|
|
|
The Initial Developer of the Original Code is John Kozikopulos [Stdreamer att Excite dott com]
|
|
Portions created by John Kozikopulos are Copyright (C) 2002 John Kozikopulos.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.delphi-jedi.org
|
|
|
|
Known Issues:
|
|
|
|
Changes form the previous Version:
|
|
|
|
Converted the rotation Functions to use scanlines for faster results
|
|
I have converted the movement from an array of TRGBTriple to an
|
|
an array of bytes. Right now it must rotate the following formats
|
|
without big speed differences and problems pf8bit,pf24bit,pf32bit
|
|
the pf4bit,pf1bit is converted to pf8bit.
|
|
The Pfdevice,pfcustom is converted into pf24bit.
|
|
all the Color conversions do not revert to the primary state after the
|
|
rotation
|
|
|
|
Added the Mirror routines
|
|
Removed the 180 degree rotation and replaced by the mirror(mtBoth) call.
|
|
this let the GDI engine to make the rotation and it is faster than any
|
|
rotation I have tested until now I have tested this routine with
|
|
and image of 2300x3500x24bit without any problems on Win2K.
|
|
I must test it on Win98 before release.
|
|
-----------------------------------------------------------------------------}
|
|
// $Id$
|
|
|
|
{$MODE objfpc}{$H+}
|
|
|
|
unit JvThumbImage;
|
|
|
|
interface
|
|
|
|
uses
|
|
LCLIntf, LCLType,
|
|
Classes, Controls, ExtCtrls, SysUtils, Graphics, Forms, Dialogs, IntfGraphics,
|
|
JvBaseThumbnail;
|
|
|
|
type
|
|
TAngle = (AT0, AT90, AT180, AT270);
|
|
|
|
// (rom) renamed elements
|
|
TMirror = (mtHorizontal, mtVertical, mtBoth);
|
|
|
|
TCurveArray = array [0..255] of Byte;
|
|
TRotateNotify = procedure(Sender: TObject; Percent: Byte; var Cancel: Boolean) of object;
|
|
TFilterEmpty = function: Byte;
|
|
TFilterArray = array [1..9] of Byte;
|
|
|
|
TJvTransformProc = procedure (AIntfImage: TLazIntfImage;
|
|
ARedData, AGreenData, ABlueData: Pointer);
|
|
|
|
TJvTransformProc2 = procedure (ASourceIntfImage, ADestIntfImage: TLazIntfImage;
|
|
ARedData, AGreenData, ABlueData: Pointer);
|
|
|
|
{ TJvThumbImage }
|
|
|
|
TJvThumbImage = class(TJvBaseThumbImage)
|
|
private
|
|
FAngle: TAngle;
|
|
FModified: Boolean;
|
|
FOnRotate: TRotateNotify;
|
|
FZoom: Word;
|
|
FOnLoad: TNotifyEvent;
|
|
FFileName: string;
|
|
FClass: TGraphicClass;
|
|
FOnInvalidImage: TInvalidImageEvent;
|
|
procedure SetAngle(AAngle: TAngle);
|
|
function GetModify: Boolean;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Mirror(MirrorType: TMirror);
|
|
procedure ChangeRGB(R, G, B: Longint);
|
|
procedure ChangeRGBCurves(R, G, B: TCurveArray);
|
|
procedure ScaleDown(MaxW, MaxH: Longint);
|
|
procedure LoadFromFile(AFile: string); //virtual;
|
|
procedure LoadFromStream(AStream: TStream; AType: TGRFKind); // needs more tests
|
|
procedure SaveToStream(AStream: TStream; AType: TGRFKind); // testing it
|
|
procedure SaveToFile(AFile: string);
|
|
procedure Save;
|
|
procedure Transform(TransformProc: TJvTransformProc; ARedData: Pointer = nil;
|
|
AGreenData: Pointer = nil; ABlueData: Pointer = nil); overload;
|
|
procedure Transform(TransformProc: TJvTransformProc2; ARedData: Pointer = nil;
|
|
AGreenData: Pointer = nil; ABlueData: Pointer = nil); overload;
|
|
procedure BitmapNeeded;
|
|
// Procedure FilterFactory(Filter: TFilterArray; Divider: Byte);
|
|
procedure Invert;
|
|
procedure Contrast(const Percent: TPercent);
|
|
procedure Lightness(const Percent: TPercent);
|
|
procedure Grayscale;
|
|
procedure Rotate(AAngle: TAngle);
|
|
function GetFilter: string;
|
|
property FileName: String read FFileName;
|
|
//property JpegScale: TJPegScale read vJPegScale write vJpegScale;
|
|
published
|
|
property Angle: TAngle read FAngle write SetAngle;
|
|
property Modified: Boolean read FModified;
|
|
//Property OnRelease : TdestroyNotify read EVonrelease write Evonrelease;
|
|
property CanModify: Boolean read GetModify;
|
|
property Zoom: Word read FZoom write FZoom;
|
|
// (rom) should be called in the implementation more often
|
|
property OnRotate: TRotateNotify read FOnRotate write FOnRotate;
|
|
property OnLoaded: TNotifyEvent read FOnLoad write FOnLoad;
|
|
property OnInvalidImage: TInvalidImageEvent read FOnInvalidImage write FOnInvalidImage;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
FPImage,
|
|
JvThumbnails, JvTypes, JvResources;
|
|
|
|
procedure GrayScaleProc(AImg: TLazIntfImage; {%H-}ARedData, {%H-}AGreenData, {%H-}ABlueData: Pointer);
|
|
var
|
|
r, c: Integer;
|
|
col: TFPColor;
|
|
intens: Integer;
|
|
begin
|
|
for r := 0 to AImg.Height - 1 do
|
|
for c := 0 to AImg.Width - 1 do begin
|
|
col := AImg.Colors[c, r];
|
|
intens := (integer(col.Red) + col.Green + col.Blue) div 3;
|
|
AImg.Colors[c, r] := FPColor(intens, intens, intens, col.Alpha);
|
|
end;
|
|
end;
|
|
|
|
procedure InvertProc(AImg: TLazIntfImage; {%H-}ARedData, {%H-}AGreenData, {%H-}ABlueData: Pointer);
|
|
const
|
|
MX: word = $FFFF;
|
|
var
|
|
r, c: Integer;
|
|
col: TFPColor;
|
|
a: Word;
|
|
begin
|
|
for r := 0 to AImg.Height - 1 do
|
|
for c := 0 to AImg.Width - 1 do begin
|
|
col := AImg.Colors[c, r];
|
|
a := col.Alpha;
|
|
AImg.Colors[c, r] := FPColor(MX-col.Red, MX-col.Green, MX-col.Blue, a);
|
|
end;
|
|
end;
|
|
|
|
procedure MirrorHorProc(AImg: TLazIntfImage; {%H-}ARedData, {%H-}AGreenData, {%H-}ABlueData: Pointer);
|
|
var
|
|
r, c, w, h: Integer;
|
|
col1, col2: TFPColor;
|
|
begin
|
|
w := AImg.Width;
|
|
h := AImg.Height;
|
|
for r := 0 to h - 1 do
|
|
for c := 0 to w div 2 do begin
|
|
col1 := AImg.Colors[c, r];
|
|
col2 := AImg.Colors[w-1-c, r];
|
|
AImg.Colors[c, r] := col2;
|
|
AImg.Colors[w-1-c, r] := col1;
|
|
end;
|
|
end;
|
|
|
|
procedure MirrorVertProc(AImg: TLazIntfImage; {%H-}ARedData, {%H-}AGreenData, {%H-}ABlueData: Pointer);
|
|
var
|
|
r, c, w, h: Integer;
|
|
col1, col2: TFPColor;
|
|
begin
|
|
w := AImg.Width;
|
|
h := AImg.Height;
|
|
for c := 0 to w - 1 do
|
|
for r := 0 to h div 2 do begin
|
|
col1 := AImg.Colors[c, r];
|
|
col2 := AImg.Colors[c, h-1-r];
|
|
AImg.Colors[c, r] := col2;
|
|
AImg.Colors[c, h-1-r] := col1;
|
|
end;
|
|
end;
|
|
|
|
procedure Rotate90Proc(ASrcImg, ADestImg: TLazIntfImage;
|
|
{%H-}ARedData, {%H-}AGreenData, {%H-}ABlueData: Pointer);
|
|
var
|
|
r, c, w, h: Integer;
|
|
col: TFPColor;
|
|
begin
|
|
w := ASrcImg.Width;
|
|
h := ASrcImg.Height;
|
|
ADestImg.SetSize(h, w);
|
|
for r := 0 to h - 1 do
|
|
for c := 0 to w - 1 do begin
|
|
col := ASrcImg.Colors[c, r];
|
|
ADestImg.Colors[r, w-1-c] := col;
|
|
end;
|
|
end;
|
|
|
|
procedure Rotate180Proc(ASrcImg, ADestImg: TLazIntfImage;
|
|
{%H-}ARedData, {%H-}AGreenData, {%H-}ABlueData: Pointer);
|
|
var
|
|
r, c, w, h: Integer;
|
|
col: TFPColor;
|
|
begin
|
|
w := ASrcImg.Width;
|
|
h := ASrcImg.Height;
|
|
for r := 0 to h - 1 do
|
|
for c := 0 to w - 1 do begin
|
|
col := ASrcImg.Colors[c, r];
|
|
ADestImg.Colors[w-1-c, h-1-r] := col;
|
|
end;
|
|
end;
|
|
|
|
procedure Rotate270Proc(ASrcImg, ADestImg: TLazIntfImage;
|
|
{%H-}ARedData, {%H-}AGreenData, {%H-}ABlueData: Pointer);
|
|
var
|
|
r, c, w, h: Integer;
|
|
col: TFPColor;
|
|
begin
|
|
w := ASrcImg.Width;
|
|
h := ASrcImg.Height;
|
|
ADestImg.SetSize(h, w);
|
|
for r := 0 to h - 1 do
|
|
for c := 0 to w - 1 do begin
|
|
col := ASrcImg.Colors[c, r];
|
|
ADestImg.Colors[h-1-r, c] := col;
|
|
end;
|
|
end;
|
|
|
|
procedure RGBProc(AImg: TLazIntfImage; ARedData, AGreenData, ABlueData: Pointer);
|
|
var
|
|
r, c: Integer;
|
|
clr: TColor;
|
|
col: TFPColor;
|
|
a: Word;
|
|
rVal, gVal, bVal: Byte;
|
|
deltaR, deltaG, deltaB: Integer;
|
|
begin
|
|
deltaR := {%H-}PtrUInt(ARedData);
|
|
deltaG := {%H-}PtrUInt(AGreenData);
|
|
deltaB := {%H-}PtrUInt(ABlueData);
|
|
for r := 0 to AImg.Height - 1 do
|
|
for c := 0 to AImg.Width - 1 do begin
|
|
a := AImg.Colors[c, r].Alpha;
|
|
clr := AImg.TColors[c, r];
|
|
rVal := BoundByte(0, 255, GetBValue(clr) + deltaR);
|
|
gVal := BoundByte(0, 255, GetGValue(clr) + deltaG);
|
|
bVal := BoundByte(0, 255, GetBValue(clr) + deltaB);
|
|
col := FPColor(rval shl 8, gval shl 8, bval shl 8, a);
|
|
AImg.Colors[c, r] := col;
|
|
end;
|
|
end;
|
|
|
|
procedure RGBCurveProc(AImg: TLazIntfImage; ARedData, AGreenData, ABlueData: Pointer);
|
|
var
|
|
r, c: Integer;
|
|
clr: TColor;
|
|
rVal, gVal, bVal: Byte;
|
|
a: Word;
|
|
col: TFPColor;
|
|
begin
|
|
for r := 0 to AImg.Height - 1 do
|
|
for c := 0 to AImg.Width - 1 do begin
|
|
a := AImg.Colors[c, r].Alpha;
|
|
clr := AImg.TColors[c, r];
|
|
rVal := TCurveArray(ARedData^)[GetRValue(clr)];
|
|
gVal := TCurveArray(AGreenData^)[GetGValue(clr)];
|
|
bVal := TCurveArray(ABlueData^)[GetBValue(clr)];
|
|
col := FPColor(rVal shl 8, gVal shl 8, bVal shl 8, a);
|
|
AImg.Colors[c, r] := col;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TJvThumbImage }
|
|
|
|
constructor TJvThumbImage.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FAngle := AT0;
|
|
// FClass := Graphics.TBitmap;
|
|
FModified := False;
|
|
end;
|
|
|
|
destructor TJvThumbImage.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvThumbImage.Lightness(const Percent: TPercent);
|
|
var
|
|
Amount: Integer;
|
|
RCurve: TCurveArray;
|
|
I: Integer;
|
|
begin
|
|
Amount := Round((255 / 100) * Percent);
|
|
if Amount > 0 then
|
|
for I := 0 to 255 do
|
|
RCurve[I] := BoundByte(0, 255, I + ((Amount * (I xor 255)) shr 8))
|
|
else
|
|
for I := 0 to 255 do
|
|
RCurve[I] := BoundByte(0, 255, I - ((Abs(Amount) * I) shr 8));
|
|
ChangeRGBCurves(RCurve, RCurve, RCurve);
|
|
end;
|
|
|
|
procedure TJvThumbImage.Rotate(AAngle: TAngle);
|
|
begin
|
|
case AAngle of
|
|
AT90:
|
|
Transform(@Rotate90Proc);
|
|
AT180:
|
|
Transform(@Rotate180Proc);
|
|
AT270:
|
|
Transform(@Rotate270Proc);
|
|
end;
|
|
end;
|
|
|
|
function TJvThumbImage.GetFilter: string;
|
|
var
|
|
// a: string;
|
|
P: Longint;
|
|
begin
|
|
Result := Graphics.GraphicFilter(TGraphic);
|
|
// (rom) better clean that up
|
|
P := Pos('(', Result);
|
|
InsertStr(Result, RsPcxTga, P);
|
|
P := Pos('|', Result);
|
|
InsertStr(Result, RsPcxTga, P);
|
|
Result := Result + RsFileFilters;
|
|
//Graphics.GraphicFilter(TGraphic)+'|PCX File|*.PCX|Targa File|*.TGA';
|
|
{ TODO : Add in the filter the rest of the images we support but are not registered to the Graphics unit }
|
|
end;
|
|
|
|
procedure TJvThumbImage.Contrast(const Percent: TPercent);
|
|
var
|
|
Amount: Integer;
|
|
Counter: Integer;
|
|
Colors: TCurveArray;
|
|
begin
|
|
Amount := Round((256 / 100) * Percent);
|
|
for Counter := 0 to 127 do
|
|
Colors[Counter] := BoundByte(0, 255, Counter - ((Abs(128 - Counter) * Amount) div 256));
|
|
for Counter := 127 to 255 do
|
|
Colors[Counter] := BoundByte(0, 255, Counter + ((Abs(128 - Counter) * Amount) div 256));
|
|
ChangeRGBCurves(Colors, Colors, Colors);
|
|
end;
|
|
|
|
procedure TJvThumbImage.LoadFromStream(AStream: TStream; AType: TGRFKind);
|
|
var
|
|
Bmp: Graphics.TBitmap;
|
|
Jpg: TJpegImage;
|
|
Ico: TIcon;
|
|
(*********** NOT CONVERTED ***
|
|
Wmf: TMetafile;
|
|
****************************)
|
|
begin
|
|
//testing the stream load capabilities;
|
|
// (rom) deactivated because LoadFromStream is not defined that way
|
|
//AStream.Seek(0, soFromBeginning); //most of the stream error are generated because this is not at the proper position
|
|
case AType of
|
|
grBMP:
|
|
begin
|
|
Bmp := Graphics.TBitmap.Create;
|
|
try
|
|
Bmp.LoadFromStream(AStream);
|
|
Bmp.PixelFormat := pf24bit;
|
|
Picture.Assign(Bmp);
|
|
finally
|
|
FreeAndNil(Bmp);
|
|
end;
|
|
end;
|
|
grJPG:
|
|
begin
|
|
Jpg := TJpegImage.Create;
|
|
try
|
|
Jpg.LoadFromStream(AStream);
|
|
Picture.Assign(Jpg);
|
|
finally
|
|
FreeAndNil(Jpg);
|
|
end;
|
|
end;
|
|
(**************** NOT CONVERTED ***
|
|
grWMF, grEMF:
|
|
begin
|
|
Wmf := Graphics.TMetafile.Create;
|
|
try
|
|
Wmf.LoadFromStream(AStream);
|
|
Picture.Assign(Wmf);
|
|
finally
|
|
FreeAndNil(Wmf);
|
|
end;
|
|
end;
|
|
******************************)
|
|
grICO:
|
|
begin
|
|
Ico := Graphics.TIcon.Create;
|
|
try
|
|
Ico.LoadFromStream(AStream);
|
|
Picture.Assign(Ico);
|
|
finally
|
|
FreeAndNil(Ico);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThumbImage.SaveToStream(AStream: TStream; AType: TGRFKind);
|
|
var
|
|
Bmp: Graphics.TBitmap;
|
|
Jpg: TJpegImage;
|
|
Ico: TIcon;
|
|
(******************** NOT CONVERTED ***
|
|
Wmf: TMetafile;
|
|
**************************************)
|
|
begin
|
|
//testing the stream Save capabilities;
|
|
// (rom) deactivated because SaveToStream is not defined that way
|
|
//AStream.Seek(0, soFromBeginning); //most of the stream error are generated because this is not at the proper position
|
|
case AType of
|
|
grBMP:
|
|
begin
|
|
Bmp := Graphics.TBitmap.Create;
|
|
// (rom) secured
|
|
try
|
|
Bmp.Assign(Picture.Graphic);
|
|
Bmp.PixelFormat := pf24bit;
|
|
Bmp.SaveToStream(AStream);
|
|
finally
|
|
FreeAndNil(Bmp);
|
|
end;
|
|
end;
|
|
grJPG:
|
|
begin
|
|
Jpg := TJpegImage.Create;
|
|
try
|
|
Jpg.Assign(Picture.Graphic);
|
|
Jpg.SaveToStream(AStream);
|
|
finally
|
|
FreeAndNil(Jpg);
|
|
end;
|
|
end;
|
|
(******************************* NOT CONVERTED ***
|
|
grWMF, grEMF:
|
|
begin
|
|
Wmf := Graphics.TMetafile.Create;
|
|
try
|
|
Wmf.Assign(Picture.Graphic);
|
|
Wmf.SaveToStream(AStream);
|
|
finally
|
|
FreeAndNil(Wmf);
|
|
end;
|
|
end;
|
|
**********************************************)
|
|
grICO:
|
|
begin
|
|
Ico := Graphics.TIcon.Create;
|
|
try
|
|
Ico.Assign(Picture.Graphic);
|
|
Ico.SaveToStream(AStream);
|
|
finally
|
|
FreeAndNil(Ico);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThumbImage.LoadFromFile(AFile: string);
|
|
var
|
|
JpegImage: TJpegImage;
|
|
// Fl: TFileStream;
|
|
begin
|
|
try
|
|
if UpperCase(ExtractFileExt(AFile)) = '.JPG' then
|
|
begin
|
|
JpegImage := TJpegImage.Create;
|
|
|
|
{************************ NOT CONVERTED *************
|
|
if Parent is TJvThumbnail then
|
|
begin
|
|
Fl := TFileStream.Create(AFile, fmOpenRead or fmShareDenyWrite);
|
|
// (rom) this is idiotic
|
|
try
|
|
case Fl.Size of
|
|
0..1000000:
|
|
JpegImage.Scale := jsFullSize;
|
|
1000001..4000000:
|
|
JpegImage.Scale := jsHalf;
|
|
4000001..7000000:
|
|
JpegImage.Scale := jsQuarter;
|
|
else
|
|
JpegImage.Scale := jsEighth;
|
|
end;
|
|
finally
|
|
Fl.Free;
|
|
end;
|
|
end
|
|
else
|
|
JpegImage.Scale := jsFullSize;
|
|
*********************************************************}
|
|
JpegImage.LoadFromFile(AFile);
|
|
// Picture.Bitmap := Graphics.TBitmap.Create;
|
|
with Picture.Bitmap do
|
|
begin
|
|
Width := JpegImage.Width;
|
|
Height := JpegImage.Height;
|
|
Picture.Bitmap.Canvas.Draw(0, 0, JpegImage);
|
|
Self.FClass := TJpegImage;
|
|
end;
|
|
FreeAndNil(JpegImage);
|
|
end
|
|
else
|
|
begin
|
|
try
|
|
Picture.LoadFromFile(AFile);
|
|
except
|
|
if Assigned(FOnInvalidImage) then
|
|
begin
|
|
FOnInvalidImage(Self, AFile);
|
|
Exit;
|
|
end
|
|
else
|
|
raise;
|
|
end;
|
|
Self.FClass := TGraphicClass(Picture.Graphic.ClassType);
|
|
end;
|
|
FFileName := AFile;
|
|
FAngle := AT0;
|
|
if Assigned(FOnLoad) then
|
|
FOnLoad(Self);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FFileName := '';
|
|
Self.FClass := nil;
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThumbImage.SaveToFile(AFile: string);
|
|
var
|
|
Ext: string;
|
|
Jpg: TJpegImage;
|
|
Bmp: TBitmap;
|
|
png: TPortableNetworkGraphic;
|
|
{*************** NOT CONVERTED ***
|
|
Wmf: TMetafile;
|
|
********************************}
|
|
begin
|
|
// (rom) enforcing a file extension is bad style
|
|
Ext := LowerCase(ExtractFileExt(AFile));
|
|
if (Ext = '.jpg') or (Ext = '.jpeg') then
|
|
try
|
|
Jpg := TJpegImage.Create;
|
|
Jpg.Assign(Picture.Graphic);
|
|
Jpg.CompressionQuality := 75;
|
|
{ *************** NOT CONVERTED ***
|
|
Jpg.Compress;
|
|
**********************************}
|
|
Jpg.SaveToFile(AFile);
|
|
finally
|
|
Jpg.Free;
|
|
end
|
|
else
|
|
if Ext = '.bmp' then
|
|
try
|
|
Bmp := Graphics.TBitmap.Create;
|
|
Bmp.Assign(Picture.Graphic);
|
|
Bmp.Canvas.Draw(0, 0, Picture.Graphic);
|
|
Bmp.SaveToFile(AFile);
|
|
finally
|
|
Bmp.Free;
|
|
end
|
|
else
|
|
if Ext = '.png' then
|
|
try
|
|
png := TPortableNetworkGraphic.Create;
|
|
png.Assign(Picture.Graphic);
|
|
png.Canvas.Draw(0, 0, Picture.Graphic);
|
|
png.SaveToFile(AFile);
|
|
finally
|
|
png.Free;
|
|
end
|
|
{ ********************** NOT CONVERTED ***
|
|
else
|
|
if Ext = '.WMF' then
|
|
try
|
|
Wmf := TMetafile.Create;
|
|
Wmf.Assign(Picture.Graphic);
|
|
Wmf.Enhanced := False;
|
|
Wmf.SaveToFile(AFile);
|
|
finally
|
|
FreeAndNil(Wmf);
|
|
end
|
|
else
|
|
if Ext = '.EMF' then
|
|
try
|
|
Wmf := Graphics.TMetafile.Create;
|
|
Wmf.Assign(Picture.Graphic);
|
|
Wmf.Enhanced := True;
|
|
Wmf.SaveToFile(AFile);
|
|
finally
|
|
FreeAndNil(Wmf);
|
|
end
|
|
***************************************}
|
|
else
|
|
raise EJVCLException.CreateResFmt(@RsEUnknownFileExtension, [Ext]);
|
|
end;
|
|
|
|
procedure TJvThumbImage.Save;
|
|
var
|
|
Temp: TGraphic;
|
|
begin
|
|
if FClass <> nil then
|
|
begin
|
|
Temp := FClass.Create;
|
|
Temp.Assign(Self.Picture.Graphic);
|
|
Temp.SaveToFile(FFileName);
|
|
FreeAndNil(Temp);
|
|
end
|
|
else
|
|
SaveToFile(FFileName);
|
|
end;
|
|
|
|
procedure TJvThumbImage.BitmapNeeded;
|
|
var
|
|
Bmp: Graphics.TBitmap;
|
|
begin
|
|
Bmp := Graphics.TBitmap.Create;
|
|
try
|
|
Bmp.HandleType := bmDIB;
|
|
// Bmp.PixelFormat := pf24Bit;
|
|
// Bmp.Width := Picture.Graphic.Width;
|
|
// Bmp.Height := Picture.Graphic.Height;
|
|
// Bmp.Canvas.Draw(0,0,Picture.Graphic);
|
|
Bmp.Assign(Picture.Graphic);
|
|
Picture.Graphic.Assign(Bmp);
|
|
finally
|
|
Bmp.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThumbImage.ScaleDown(MaxW, MaxH: Longint);
|
|
var
|
|
NewSize: TPoint;
|
|
Bmp: Graphics.TBitmap;
|
|
begin
|
|
NewSize := ProportionalSize(Point(Picture.Width, Picture.Height), Point(MaxW, MaxH));
|
|
if (NewSize.X > Picture.Width) and (NewSize.Y > Picture.Height) then
|
|
Exit;
|
|
// SomeTimes when the resize is bigger than 1600% then the strechDraw
|
|
// doesn't produce any results at all so do it more than once to make
|
|
// absolutly sure the will have an image in any case.
|
|
if ((Picture.Width div NewSize.X) > 16) or ((Picture.Height div NewSize.Y) > 16) then
|
|
ScaleDown(2 * MaxW, 2 * MaxH);
|
|
Bmp := Graphics.TBitmap.Create;
|
|
try
|
|
Bmp.Width := NewSize.X;
|
|
Bmp.Height := NewSize.Y;
|
|
Bmp.HandleType := bmDIB;
|
|
Bmp.PixelFormat := pf24bit;
|
|
Bmp.Canvas.StretchDraw(Rect(0, 0, Bmp.Width, Bmp.Height), Picture.Graphic);
|
|
Picture.Assign(Bmp);
|
|
{ wp
|
|
Picture.Bitmap.Dormant;
|
|
Picture.Bitmap.FreeImage;
|
|
}
|
|
finally
|
|
FreeAndNil(Bmp);
|
|
end;
|
|
FModified := True;
|
|
end;
|
|
|
|
function TJvThumbImage.GetModify: Boolean;
|
|
begin
|
|
Result := False;
|
|
if not Assigned(Picture) or not Assigned(Picture.Graphic) then
|
|
Exit;
|
|
if Picture.Graphic.Empty then
|
|
Result := False
|
|
{ ********************* NOT CONVERTED *************
|
|
else
|
|
if Picture.Graphic is Graphics.TMetafile then
|
|
Result := False
|
|
*************************************************}
|
|
else
|
|
Result := not (Picture.Graphic is Graphics.TIcon);
|
|
end;
|
|
|
|
procedure TJvThumbImage.GrayScale;
|
|
begin
|
|
Transform(@GrayscaleProc);
|
|
end;
|
|
|
|
procedure TJvThumbImage.Invert;
|
|
begin
|
|
Transform(@InvertProc);
|
|
end;
|
|
|
|
{ This procedure substitutes the values of R,G,B acordinally to the arrays the
|
|
user passes in it. This is the simplest way to change the curve of a Color
|
|
depending on an algorithm created by the user.
|
|
The substitute value of a red 0 is the value which lies in the R[0] position.
|
|
for a simple example have a look at the invert procedure above. }
|
|
procedure TJvThumbImage.ChangeRGBCurves(R, G, B: TCurveArray);
|
|
begin
|
|
Transform(@RGBCurveProc, @R, @G, @B);
|
|
end;
|
|
(*
|
|
var
|
|
MemBmp: TBitmap;
|
|
Row, Col: Word;
|
|
IntfImg: TLazIntfImage;
|
|
clr: TColor;
|
|
cr, cg, cb: Byte;
|
|
ImgHandle, ImgMaskHandle: HBitmap;
|
|
begin
|
|
if CanModify then
|
|
begin
|
|
IntfImg := TLazIntfImage.Create(0, 0);
|
|
MemBmp := TBitmap.Create;
|
|
try
|
|
MemBmp.PixelFormat := pf32bit;
|
|
MemBmp.SetSize(Picture.Width, Picture.Height);
|
|
MemBmp.Canvas.Brush.Color := clWhite;
|
|
MemBmp.Canvas.FillRect(0, 0, MemBmp.Width, MemBmp.Height);;
|
|
MemBmp.Assign(Picture);
|
|
IntfImg.LoadFromBitmap(MemBmp.Handle, MemBmp.MaskHandle);
|
|
for Row := 0 to IntfImg.Height-1 do
|
|
for Col := 0 to IntfImg.Width - 1 do begin
|
|
clr := IntfImg.TColors[Col, Row];
|
|
cr := R[GetRValue(clr)];
|
|
cg := G[GetGValue(clr)];
|
|
cb := B[GetBValue(clr)];
|
|
IntfImg.TColors[Col, Row] := RGBToColor(cr, cg, cb);
|
|
end;
|
|
IntfImg.CreateBitmaps(ImgHandle, ImgMaskHandle);
|
|
MemBmp.Handle := ImgHandle;
|
|
MemBmp.MaskHandle := ImgMaskHandle;
|
|
if Picture.Graphic is TJpegImage then
|
|
TJpegImage(Picture.Graphic).Assign(MemBmp)
|
|
else if Picture.Graphic is Graphics.TBitmap then
|
|
Picture.Bitmap.Assign(MemBmp);
|
|
Invalidate;
|
|
finally
|
|
MemBmp.Free;
|
|
IntfImg.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
*)
|
|
|
|
procedure TJvThumbImage.Mirror(MirrorType: TMirror);
|
|
begin
|
|
if Assigned(Picture.Graphic) and CanModify then begin
|
|
case MirrorType of
|
|
mtHorizontal: Transform(@MirrorHorProc);
|
|
mtVertical : Transform(@MirrorVertProc);
|
|
mtBoth : Transform(@Rotate180Proc);
|
|
end;
|
|
Invalidate;
|
|
{
|
|
RotateByDelta(ord(AAngle) - ord(FAngle));
|
|
FAngle := AAngle;
|
|
FModified := FAngle <> AT0;
|
|
}
|
|
end;
|
|
end;
|
|
|
|
{ Just a simple procedure to increase or decrease the values of the each channel
|
|
in the image independendly from each other. E.g., lets say the R,G,B variables
|
|
have the values of 5, -3, 7. This means that the red channel should be
|
|
increased by 5 points in the entire image, the green value will be decreased
|
|
by 3 points and the blue value will be increased by 7 points.
|
|
This will happen to the entire image by the same value. Color luminosity is
|
|
not preserved or values calculations depending on the current channel values. }
|
|
procedure TJvThumbImage.ChangeRGB(R, G, B: Longint);
|
|
begin
|
|
Transform(@RGBProc, {%H-}Pointer(PtrUInt(R)), {%H-}Pointer(PtrUInt(G)), {%H-}Pointer(PtrUInt(B)));
|
|
end;
|
|
|
|
{ General bitmap transformation method using LazIntfImages. The operation is
|
|
specified by the procedure pointer TransformProc. }
|
|
procedure TJvThumbImage.Transform(TransformProc: TJvTransformProc;
|
|
ARedData: Pointer = nil; AGreenData: Pointer = nil; ABlueData: Pointer = nil);
|
|
var
|
|
IntfImg: TLazIntfImage;
|
|
ImgHandle, ImgMaskHandle: HBitmap;
|
|
begin
|
|
if Assigned(Picture.Graphic) and CanModify then begin
|
|
IntfImg := TPortableNetworkGraphic(Picture.Graphic).CreateIntfImage;
|
|
try
|
|
TransformProc(IntfImg, ARedData, AGreenData, ABlueData);
|
|
IntfImg.CreateBitmaps(ImgHandle, ImgMaskHandle);
|
|
Picture.Bitmap.LoadFromIntfImage(IntfImg);
|
|
FModified := true;
|
|
finally
|
|
IntfImg.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ General bitmap transformation method using LazIntfImages. The operation is
|
|
specified by the procedure pointer TransformProc. }
|
|
procedure TJvThumbImage.Transform(TransformProc: TJvTransformProc2;
|
|
ARedData: Pointer = nil; AGreenData: Pointer = nil; ABlueData: Pointer = nil);
|
|
var
|
|
SrcIntfImg, DestIntfImg: TLazIntfImage;
|
|
DestImgHandle, DestImgMaskHandle: HBitmap;
|
|
begin
|
|
if Assigned(Picture.Graphic) and CanModify then begin
|
|
SrcIntfImg := TPortableNetworkGraphic(Picture.Graphic).CreateIntfImage;
|
|
DestIntfImg := TPortableNetworkGraphic(Picture.Graphic).CreateIntfImage;
|
|
try
|
|
TransformProc(SrcIntfImg, DestIntfImg, ARedData, AGreenData, ABlueData);
|
|
DestIntfImg.CreateBitmaps(DestImgHandle, DestImgMaskHandle);
|
|
Picture.Bitmap.LoadFromIntfImage(DestIntfImg);
|
|
FModified := true;
|
|
finally
|
|
DestIntfImg.Free;
|
|
SrcIntfImg.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ Procedure to actually decide what should be the rotation in conjuction with the
|
|
image's physical Angle}
|
|
procedure TJvThumbImage.SetAngle(AAngle: TAngle);
|
|
|
|
procedure RotateByDelta(ADiff: integer);
|
|
begin
|
|
if ADiff < 0 then inc(ADiff, 4);
|
|
case TAngle(ADiff mod 4) of
|
|
AT90:
|
|
begin
|
|
Transform(@Rotate90Proc);
|
|
if Parent is TJvThumbnail then
|
|
SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0);
|
|
end;
|
|
AT180:
|
|
Transform(@Rotate180Proc);
|
|
AT270:
|
|
begin
|
|
Transform(@Rotate270Proc);
|
|
if Parent is TJvThumbnail then
|
|
SendMessage(TJvThumbnail(Parent).Handle, TH_IMAGESIZECHANGED, 0, 0);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if Assigned(Picture.Graphic) and CanModify and (AAngle <> FAngle) then begin
|
|
RotateByDelta(ord(AAngle) - ord(FAngle));
|
|
FAngle := AAngle;
|
|
FModified := FAngle <> AT0;
|
|
end;
|
|
end;
|
|
|
|
|
|
end.
|