You've already forked lazarus-ccr
jvcllaz: Add component TJvSpecialImage (incl sample project)
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7200 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
369
components/jvcllaz/run/JvMM/jvspecialimage.pas
Normal file
369
components/jvcllaz/run/JvMM/jvspecialimage.pas
Normal file
@ -0,0 +1,369 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
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: JvSpecialImage.PAS, released on 2001-02-28.
|
||||
|
||||
The Initial Developer of the Original Code is S�bastien Buysse [sbuysse att buypin dott com]
|
||||
Portions created by S�bastien Buysse are Copyright (C) 2001 S�bastien Buysse.
|
||||
All Rights Reserved.
|
||||
|
||||
Contributor(s): Michael Beck [mbeck att bigfoot dott com].
|
||||
|
||||
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:
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id$
|
||||
|
||||
unit JvSpecialImage;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, {Windows,} Graphics, Controls, ExtCtrls, Forms,
|
||||
JvTypes;
|
||||
|
||||
type
|
||||
TJvBright = -100..100;
|
||||
TJvFadingEnd = (feBlack, feWhite);
|
||||
|
||||
TJvSpecialImage = class(TImage)
|
||||
private
|
||||
FInverted: Boolean;
|
||||
FFadingEnd: TJvFadingEnd;
|
||||
FFadingSpeed: Integer;
|
||||
FFadingIn: Boolean;
|
||||
FFlipped: Boolean;
|
||||
FBrightness: TJvBright;
|
||||
FOriginal: TPicture;
|
||||
FMirrored: Boolean;
|
||||
FWorking: Boolean;
|
||||
FTimer: TTimer;
|
||||
FChangingLocalProperty: Boolean;
|
||||
FOnFadingComplete: TNotifyEvent;
|
||||
procedure SetBright(Value: TJvBright);
|
||||
procedure SetFadingSpeed(const Value: Integer);
|
||||
procedure SetFlipped(const Value: Boolean);
|
||||
procedure SetInverted(const Value: Boolean);
|
||||
procedure SetMirrored(const Value: Boolean);
|
||||
procedure ApplyChanges;
|
||||
procedure FadeTimerHandler(Sender: TObject);
|
||||
function GetPicture: TPicture;
|
||||
procedure SetPicture(const Value: TPicture);
|
||||
protected
|
||||
procedure Loaded; override;
|
||||
procedure PictureChanged(Sender: TObject); override; // wp: moved from "private"
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
published
|
||||
property Brightness: TJvBright read FBrightness write SetBright default 0;
|
||||
property Inverted: Boolean read FInverted write SetInverted default False;
|
||||
property FadingEnd: TJvFadingEnd read FFadingEnd write FFadingEnd default feBlack;
|
||||
property FadingSpeed: Integer read FFadingSpeed write SetFadingSpeed default 2;
|
||||
property Flipped: Boolean read FFlipped write SetFlipped default False;
|
||||
property Mirrored: Boolean read FMirrored write SetMirrored default False;
|
||||
property Picture: TPicture read GetPicture write SetPicture;
|
||||
procedure FadeIn;
|
||||
procedure FadeOut;
|
||||
procedure Reset;
|
||||
property OnFadingComplete: TNotifyEvent read FOnFadingComplete write FOnFadingComplete;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
FPImage, IntfGraphics;
|
||||
|
||||
constructor TJvSpecialImage.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FOriginal := TPicture.Create;
|
||||
FBrightness := 0;
|
||||
FInverted := False;
|
||||
FFlipped := False;
|
||||
FMirrored := False;
|
||||
FWorking := False;
|
||||
FChangingLocalProperty := False;
|
||||
Picture.OnChange := @PictureChanged;
|
||||
FTimer := TTimer.Create(self);
|
||||
FTimer.Enabled := false;
|
||||
FTimer.Interval := 1;
|
||||
FTimer.OnTimer := @FadeTimerHandler;
|
||||
FFadingSpeed := 2;
|
||||
end;
|
||||
|
||||
destructor TJvSpecialImage.Destroy;
|
||||
begin
|
||||
Picture.Assign(FOriginal);
|
||||
FOriginal.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
FOriginal.Assign(Picture);
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.ApplyChanges;
|
||||
var
|
||||
I, J: Integer;
|
||||
C, C2: TFPColor;
|
||||
Dest: TBitmap;
|
||||
Val: Integer;
|
||||
Tmp: TFPColor;
|
||||
IntfImg: TLazIntfImage;
|
||||
begin
|
||||
if FWorking or (csLoading in ComponentState) or (csDestroying in ComponentState) then
|
||||
Exit;
|
||||
FWorking := True;
|
||||
|
||||
IntfImg := TLazIntfImage.Create(FOriginal.Width, FOriginal.Height);
|
||||
try
|
||||
IntfImg.LoadFromBitmap(FOriginal.Bitmap.Handle, FOriginal.Bitmap.MaskHandle);
|
||||
Val := Integer(65535) * FBrightness div 100;
|
||||
if Val > 0 then
|
||||
begin
|
||||
for J := 0 to IntfImg.Height - 1 do
|
||||
for I := 0 to IntfImg.Width - 1 do
|
||||
begin
|
||||
C := IntfImg.Colors[I, J];
|
||||
if C.Blue + Val > 65535 then C.Blue := 65535 else C.Blue := C.Blue + Val;
|
||||
if C.Green + Val > 65535 then C.Green := 65535 else C.Green := C.Green + Val;
|
||||
if C.Red + Val > 65535 then C.Red := 65535 else C.Red := C.Red + Val;
|
||||
IntfImg.Colors[I, J] := C;
|
||||
end;
|
||||
end else
|
||||
if Val < 0 then
|
||||
begin
|
||||
for J := 0 to IntfImg.Height - 1 do
|
||||
for I := 0 to IntfImg.Width - 1 do
|
||||
begin
|
||||
C := IntfImg.Colors[I, J];
|
||||
if C.Blue + Val < 0 then C.Blue := 0 else C.Blue := C.Blue + Val;
|
||||
if C.Green + Val < 0 then C.Green := 0 else C.Green := C.Green + Val;
|
||||
if C.Red + Val < 0 then C.Red := 0 else C.Red := C.Red + Val;
|
||||
IntfImg.Colors[I, J] := C;
|
||||
end;
|
||||
end;
|
||||
|
||||
//Set Flipped
|
||||
if FFlipped then
|
||||
for J := 0 to (IntfImg.Height - 1) div 2 do
|
||||
for I := 0 to IntfImg.Width - 1 do
|
||||
begin
|
||||
C := IntfImg.Colors[I, J];
|
||||
C2 := IntfImg.Colors[I, IntfImg.Height - J - 1];
|
||||
IntfImg.Colors[I, J] := C2;
|
||||
IntfImg.Colors[I, IntfImg.Height - J - 1] := C;
|
||||
end;
|
||||
|
||||
//Set inverted
|
||||
if FInverted then
|
||||
for J := 0 to IntfImg.Height - 1 do
|
||||
for I := 0 to IntfImg.Width - 1 do
|
||||
begin
|
||||
C := IntfImg.Colors[I, J];
|
||||
C.Red := 65535 - C.Red;
|
||||
C.Green := 65535 - C.Green;
|
||||
C.Blue := 65535 - C.Blue;
|
||||
IntfImg.Colors[I, J] := C;
|
||||
end;
|
||||
|
||||
//Set mirrored
|
||||
if FMirrored then
|
||||
for J := 0 to IntfImg.Height - 1 do
|
||||
for I := 0 to (IntfImg.Width - 1) div 2 do
|
||||
begin
|
||||
C := IntfImg.Colors[I, J];
|
||||
C2 := IntfImg.Colors[IntfImg.Width - I - 1, J];
|
||||
IntfImg.Colors[I, J] := C2;
|
||||
IntfImg.Colors[IntfImg.Width - I - 1, J] := C;
|
||||
end;
|
||||
|
||||
Dest := TBitmap.Create;
|
||||
try
|
||||
Dest.LoadFromIntfImage(IntfImg);
|
||||
if FChangingLocalProperty then
|
||||
inherited Picture.Assign(Dest);
|
||||
finally
|
||||
Dest.Free;
|
||||
end;
|
||||
|
||||
finally
|
||||
IntfImg.Free;
|
||||
FWorking := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.FadeIn;
|
||||
begin
|
||||
FFadingIn := true;
|
||||
FTimer.Enabled := true;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.FadeOut;
|
||||
begin
|
||||
FFadingIn := false;
|
||||
FTimer.Enabled := true;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.FadeTimerHandler(Sender: TObject);
|
||||
const
|
||||
FADE_END_BRIGHTNESS: Array[TJvFadingEnd, boolean] of Integer = (
|
||||
{ jeBlack } (-100, 0), // fading out/in }
|
||||
{ jeWhite } ( 100, 0) // fading out/in
|
||||
);
|
||||
SGN: array[TJvFadingEnd, boolean] of Integer = (
|
||||
{ jeBlack } (-1, +1),
|
||||
{ jeWhite } (+1, -1)
|
||||
);
|
||||
|
||||
function AwayFromEndPoint(AFadingEnd: TJvFadingEnd): Boolean;
|
||||
begin
|
||||
case AFadingEnd of
|
||||
feBlack:
|
||||
if FFadingIn then
|
||||
Result := FBrightness < -FFadingSpeed
|
||||
else
|
||||
Result := FBrightness >= -100 + FFadingSpeed;
|
||||
feWhite:
|
||||
if FFadingIn then
|
||||
Result := FBrightness > FFadingSpeed
|
||||
else
|
||||
Result := FBrightness <= 100 - FFadingSpeed;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure EndPointReached(AFadingEnd: TJvFadingEnd);
|
||||
begin
|
||||
Brightness := FADE_END_BRIGHTNESS[AFadingEnd, FFadingIn];
|
||||
FTimer.Enabled := false;
|
||||
if Assigned(FOnFadingComplete) then
|
||||
FOnFadingComplete(Self);
|
||||
end;
|
||||
|
||||
function NextFadingEnd: TJvFadingEnd;
|
||||
begin
|
||||
Result := TJvFadingEnd((ord(FFadingEnd) + 1) mod 2);
|
||||
end;
|
||||
|
||||
var
|
||||
lFadingEnd: TJvFadingEnd;
|
||||
begin
|
||||
if FInverted then
|
||||
lFadingEnd := NextFadingEnd
|
||||
else
|
||||
lFadingEnd := FFadingEnd;
|
||||
if AwayFromEndPoint(lFadingEnd) then
|
||||
Brightness := FBrightness + SGN[lFadingEnd, FFadingIn] * FFadingSpeed
|
||||
else
|
||||
EndPointReached(lFadingEnd);
|
||||
end;
|
||||
|
||||
function TJvSpecialImage.GetPicture: TPicture;
|
||||
begin
|
||||
Result := inherited Picture;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.PictureChanged(Sender: TObject);
|
||||
begin
|
||||
if FWorking = False then
|
||||
begin
|
||||
FOriginal.Assign(inherited Picture);
|
||||
ApplyChanges; // SetBright(FBrightness);
|
||||
end;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.Reset;
|
||||
begin
|
||||
FWorking := True;
|
||||
Brightness := 0;
|
||||
Inverted := False;
|
||||
Flipped := False;
|
||||
Mirrored := False;
|
||||
FWorking := False;
|
||||
Picture.Assign(FOriginal);
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.SetBright(Value: TJvBright);
|
||||
begin
|
||||
FChangingLocalProperty := True;
|
||||
try
|
||||
FBrightness := Value;
|
||||
ApplyChanges;
|
||||
finally
|
||||
FChangingLocalProperty := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.SetFadingSpeed(const Value: Integer);
|
||||
begin
|
||||
if Value <> FFadingSpeed then begin
|
||||
FFadingSpeed := abs(Value);
|
||||
if FFadingSpeed = 0 then FFadingSpeed := 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.SetFlipped(const Value: Boolean);
|
||||
begin
|
||||
if Value <> FFlipped then
|
||||
begin
|
||||
FChangingLocalProperty := True;
|
||||
try
|
||||
FFlipped := Value;
|
||||
ApplyChanges;
|
||||
finally
|
||||
FChangingLocalProperty := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.SetInverted(const Value: Boolean);
|
||||
begin
|
||||
if Value <> FInverted then
|
||||
begin
|
||||
FChangingLocalProperty := True;
|
||||
try
|
||||
FInverted := Value;
|
||||
ApplyChanges;
|
||||
finally
|
||||
FChangingLocalProperty := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.SetMirrored(const Value: Boolean);
|
||||
begin
|
||||
if Value <> FMirrored then
|
||||
begin
|
||||
FChangingLocalProperty := True;
|
||||
try
|
||||
FMirrored := Value;
|
||||
ApplyChanges;
|
||||
finally
|
||||
FChangingLocalProperty := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialImage.SetPicture(const Value: TPicture);
|
||||
begin
|
||||
FOriginal.Assign(Value);
|
||||
inherited Picture := Value;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user