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

components/jvcllaz/design/JvMM/images/images.txt

@@ -1,3 +1,7 @@
+tjvspecialimage.png
+tjvspecialimage_150.png
+tjvspecialimage_200.png
+
 tjvid3v1.png
 tjvid3v1_150.png
 tjvid3v1_200.png

components/jvcllaz/design/JvMM/jvmmreg.pas

@@ -20,12 +20,12 @@ uses
   JvGradientHeaderPanel, JvSpecialProgress,
   JvFullColorSpaces, JvFullColorCtrls, JvFullColorEditors, JvFullColorSpacesEditors,
   JvFullColorDialogs,
-  JvAnimatedImage, JvBmpAnimator, JvPicClip;
+  JvAnimatedImage, JvBmpAnimator, JvPicClip, JvSpecialImage;
 
 procedure Register;
 begin
   RegisterComponents(RsPaletteJvclVisual, [
-    TJvAnimatedImage, TJvBmpAnimator, TJvPicClip,
+    TJvAnimatedImage, TJvBmpAnimator, TJvPicClip, TJvSpecialImage,
     TJvGradient, TJvGradientHeaderPanel,
     TJvSpecialProgress,
     TJvFullColorPanel, TJvFullColorTrackBar, TJvFullColorGroup, TJvFullColorLabel,

components/jvcllaz/examples/JvSpecialImage/JvSpecialImageDemo.lpi

@@ -0,0 +1,81 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="JvSpecialImageDemo"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="JvMMLazR"/>
+      </Item>
+      <Item>
+        <PackageName Value="LCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="JvSpecialImageDemo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="jvspecialimagedemoform.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="JvSpecialImageDemoForm"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="../../bin/$(TargetCPU)-$(TargetOS)/JvSpecialImageDemo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

components/jvcllaz/examples/JvSpecialImage/JvSpecialImageDemo.lpr

@@ -0,0 +1,22 @@
+program JvSpecialImageDemo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, JvSpecialImageDemoForm
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

components/jvcllaz/examples/JvSpecialImage/jvspecialimagedemoform.pas

@@ -0,0 +1,131 @@
+unit JvSpecialImageDemoForm;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
+  Spin, JvSpecialImage;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    btnFadeIn: TButton;
+    btnFadeOut: TButton;
+    cbFlipped: TCheckBox;
+    cbMirrored: TCheckBox;
+    cbInverted: TCheckBox;
+    JvSpecialImage1: TJvSpecialImage;
+    lblFadingSpeed: TLabel;
+    lblBrightness: TLabel;
+    Panel1: TPanel;
+    rbFadeBlack: TRadioButton;
+    rbFadeWhite: TRadioButton;
+    sbBrightness: TScrollBar;
+    seFadingSpeed: TSpinEdit;
+    procedure btnFadeInClick(Sender: TObject);
+    procedure btnFadeOutClick(Sender: TObject);
+    procedure cbFlippedChange(Sender: TObject);
+    procedure cbInvertedChange(Sender: TObject);
+    procedure cbMirroredChange(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure JvSpecialImage1FadingComplete(Sender: TObject);
+    procedure rbFadeBlackChange(Sender: TObject);
+    procedure rbFadeWhiteChange(Sender: TObject);
+    procedure sbBrightnessChange(Sender: TObject);
+    procedure seFadingSpeedChange(Sender: TObject);
+  private
+    FStartTime: TDateTime;
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.btnFadeInClick(Sender: TObject);
+begin
+  Caption := 'Fading in...';
+  (*
+  sbBrightness.OnChange := nil;
+  sbBrightness.Position := 0;
+  lblBrightness.Caption := 'Brightness ' + IntToStr(sbBrightness.Position);
+  sbBrightness.OnChange := @sbBrightnessChange;
+   *)
+  FStartTime := Now;
+  JvSpecialImage1.FadeIn;
+
+  btnFadeOut.Enabled := true;
+  btnFadeIn.Enabled := false;
+  sbBrightness.Enabled := btnFadeOut.Enabled;
+end;
+
+procedure TForm1.btnFadeOutClick(Sender: TObject);
+begin
+  Caption := 'Fading out...';
+  FStartTime := Now;
+  JvSpecialImage1.FadeOut;
+
+  btnFadeOut.Enabled := false;
+  btnFadeIn.Enabled := true;
+  sbBrightness.Enabled := btnFadeOut.Enabled;
+end;
+
+procedure TForm1.cbFlippedChange(Sender: TObject);
+begin
+  JvSpecialImage1.Flipped := cbFlipped.Checked;
+end;
+
+procedure TForm1.cbInvertedChange(Sender: TObject);
+begin
+  JvSpecialImage1.Inverted := cbInverted.Checked;
+end;
+
+procedure TForm1.cbMirroredChange(Sender: TObject);
+begin
+  JvSpecialImage1.Mirrored := cbMirrored.Checked;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  sbBrightness.Position := JvSpecialImage1.Brightness;
+end;
+
+procedure TForm1.JvSpecialImage1FadingComplete(Sender: TObject);
+begin
+  Caption := 'Time for fading: ' + IntToStr(Round((Now - FStartTime)*24*60*60*1000)) + 'ms';
+end;
+
+procedure TForm1.rbFadeBlackChange(Sender: TObject);
+begin
+  if rbFadeBlack.Checked then JvSpecialImage1.FadingEnd := feBlack;
+end;
+
+procedure TForm1.rbFadeWhiteChange(Sender: TObject);
+begin
+  if rbFadeWhite.Checked then JvSpecialImage1.FadingEnd := feWhite;
+end;
+
+procedure TForm1.sbBrightnessChange(Sender: TObject);
+begin
+  JvSpecialImage1.Brightness := sbBrightness.Position;
+  lblBrightness.caption := Format('Brightness: %d', [JvSpecialImage1.Brightness]);
+end;
+
+procedure TForm1.seFadingSpeedChange(Sender: TObject);
+begin
+  JvSpecialImage1.FadingSpeed := seFadingSpeed.Value;
+end;
+
+end.
+

components/jvcllaz/packages/jvmmlazr.lpk

@@ -1,6 +1,6 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
-  <Package Version="4">
+  <Package Version="5">
     <PathDelim Value="\"/>
     <Name Value="JvMMLazR"/>
     <Author Value="Various authors - see header of each unit for original author."/>
@@ -16,7 +16,7 @@
     <Description Value="JVCL Multimedia and image components (Run-time package): bmp animator, id3v1 and id3v2 tags,  full color components and dialogs, gradient, gradient header, special progress bar, animated image"/>
     <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
     <Version Major="1" Release="6"/>
-    <Files Count="17">
+    <Files Count="18">
       <Item1>
         <Filename Value="..\run\JvMM\jvspecialprogress.pas"/>
         <UnitName Value="JvSpecialProgress"/>
@@ -85,6 +85,10 @@
         <Filename Value="..\run\JvMM\jvpicclip.pas"/>
         <UnitName Value="JvPicClip"/>
       </Item17>
+      <Item18>
+        <Filename Value="..\run\JvMM\jvspecialimage.pas"/>
+        <UnitName Value="JvSpecialImage"/>
+      </Item18>
     </Files>
     <RequiredPkgs Count="2">
       <Item1>

components/jvcllaz/run/JvCore/jvtypes.pas

@@ -75,12 +75,15 @@ type
   {$IFDEF CLR}
   [StructLayout(LayoutKind.Sequential)]
   {$ENDIF CLR}
+  ***************************)
+
   TJvRGBTriple = packed record
     rgbBlue: Byte;
     rgbGreen: Byte;
     rgbRed: Byte;
   end;
 
+  (**************************
 const
   NullHandle = 0;
   // (rom) deleted fbs constants. They are already in JvConsts.pas.
@@ -184,7 +187,6 @@ type
     Result: Longint;
   end;
 
-(********************
   PJvRGBArray = ^TJvRGBArray;
   TJvRGBArray = array [0..MaxPixelCount] of TJvRGBTriple;
   PRGBQuadArray = ^TRGBQuadArray;
@@ -192,6 +194,7 @@ type
   PRGBPalette = ^TRGBPalette;
   TRGBPalette = array [Byte] of TRGBQuad;
 
+(********************
   { (rom) unused
   TJvPoint = class(TPersistent)
   protected

components/jvcllaz/run/JvMM/jvspecialimage.pas

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