lazarus-ccr/components/jvcllaz/run/JvMM/jvspecialimage.pas

{-----------------------------------------------------------------------------
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;
  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.