jvcllaz: Add new component JvImageTransform (transition effects between two pictures)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7201 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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

@@ -1,3 +1,7 @@
+tjvimagetransform.png
+tjvimagetransform_150.png
+tjvimagetransform_200.png
+
 tjvspecialimage.png
 tjvspecialimage_150.png
 tjvspecialimage_200.png

components/jvcllaz/design/JvMM/jvmmreg.pas

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

components/jvcllaz/examples/JvImageTransform/JvImageTransformDemo.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="JvImageTransformDemo"/>
+      <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="JvImageTransformDemo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="jvimagetransformform.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="MainForm"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="JvImageTransformForm"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="../../bin/$(TargetCPU)-$(TargetOS)/JvImageTransformDemo"/>
+    </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/JvImageTransform/JvImageTransformDemo.lpr

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

components/jvcllaz/examples/JvImageTransform/jvimagetransformform.pas

@@ -0,0 +1,81 @@
+unit JvImageTransformForm;
+
+{ The images of this demo are taken from the Lazarus mushroom database example
+  in folder (lazarus)/examples/database/image_mushrooms
+}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
+  JvImageTransform;
+
+type
+
+  { TMainForm }
+
+  TMainForm = class(TForm)
+    Bevel1: TBevel;
+    btnTransform: TButton;
+    ComboBox1: TComboBox;
+    Image1: TImage;
+    Image2: TImage;
+    Image3: TImage;
+    JvImageTransform1: TJvImageTransform;
+    Label1: TLabel;
+    Panel1: TPanel;
+    Panel2: TPanel;
+    procedure btnTransformClick(Sender: TObject);
+    procedure ComboBox1Change(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+    FCurrImage: Integer;
+
+  public
+
+  end;
+
+var
+  MainForm: TMainForm;
+
+implementation
+
+{$R *.lfm}
+
+{ TMainForm }
+
+procedure TMainForm.btnTransformClick(Sender: TObject);
+var
+  pic: TPicture;
+begin
+  // Execute the transformation
+  JvImageTransform1.Transform;
+
+  // Load next image
+  FCurrImage := (FCurrImage + 1) mod 3;
+  case FCurrImage of
+    0: pic := Image1.Picture;
+    1: pic := Image2.Picture;
+    2: pic := Image3.Picture;
+  end;
+  if JvImageTransform1.ImageShown = 1 then
+    JvImageTransform1.Picture2.Assign(pic)
+  else
+    JvImageTransform1.Picture1.Assign(pic);
+end;
+
+procedure TMainForm.ComboBox1Change(Sender: TObject);
+begin
+  JvImageTransform1.TransformType := TJvTransformationKind(ComboBox1.ItemIndex);
+end;
+
+procedure TMainForm.FormCreate(Sender: TObject);
+begin
+  JvImageTransform1.Picture1.Assign(Image1.Picture);
+  JvImageTransform1.Picture2.Assign(Image2.Picture);
+end;
+
+end.
+

components/jvcllaz/packages/jvmmlazr.lpk

@@ -16,87 +16,91 @@
     <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="18">
+    <Files>
-      <Item1>
+      <Item>
         <Filename Value="..\run\JvMM\jvspecialprogress.pas"/>
         <UnitName Value="JvSpecialProgress"/>
-      </Item1>
+      </Item>
-      <Item2>
+      <Item>
         <Filename Value="..\run\JvMM\jvgradient.pas"/>
         <UnitName Value="JvGradient"/>
-      </Item2>
+      </Item>
-      <Item3>
+      <Item>
         <Filename Value="..\run\JvMM\jvgradientheaderpanel.pas"/>
         <UnitName Value="JvGradientHeaderPanel"/>
-      </Item3>
+      </Item>
-      <Item4>
+      <Item>
         <Filename Value="..\run\JvMM\jvid3v1.pas"/>
         <UnitName Value="JvId3v1"/>
-      </Item4>
+      </Item>
-      <Item5>
+      <Item>
         <Filename Value="..\run\JvMM\jvid3v2types.pas"/>
         <UnitName Value="JvId3v2Types"/>
-      </Item5>
+      </Item>
-      <Item6>
+      <Item>
         <Filename Value="..\run\JvMM\jvid3v2base.pas"/>
         <UnitName Value="JvId3v2Base"/>
-      </Item6>
+      </Item>
-      <Item7>
+      <Item>
         <Filename Value="..\run\JvMM\jvid3v2.pas"/>
         <UnitName Value="JvId3v2"/>
-      </Item7>
+      </Item>
-      <Item8>
+      <Item>
         <Filename Value="..\run\JvMM\jvbmpanimator.pas"/>
         <UnitName Value="JvBmpAnimator"/>
-      </Item8>
+      </Item>
-      <Item9>
+      <Item>
         <Filename Value="..\run\JvMM\jvfullcolorspaces.pas"/>
         <UnitName Value="JvFullColorSpaces"/>
-      </Item9>
+      </Item>
-      <Item10>
+      <Item>
         <Filename Value="..\run\JvMM\jvfullcolorrotate.pas"/>
         <UnitName Value="JvFullColorRotate"/>
-      </Item10>
+      </Item>
-      <Item11>
+      <Item>
         <Filename Value="..\run\JvMM\jvfullcolorctrls.pas"/>
         <UnitName Value="JvFullColorCtrls"/>
-      </Item11>
+      </Item>
-      <Item12>
+      <Item>
         <Filename Value="..\run\JvMM\jvfullcolorform.lfm"/>
         <Type Value="LFM"/>
-      </Item12>
+      </Item>
-      <Item13>
+      <Item>
         <Filename Value="..\run\JvMM\jvfullcolorform.pas"/>
         <UnitName Value="JvFullColorForm"/>
-      </Item13>
+      </Item>
-      <Item14>
+      <Item>
         <Filename Value="..\run\JvMM\jvfullcolorcircleform.pas"/>
         <UnitName Value="JvFullColorCircleForm"/>
-      </Item14>
+      </Item>
-      <Item15>
+      <Item>
         <Filename Value="..\run\JvMM\jvfullcolordialogs.pas"/>
         <UnitName Value="JvFullColorDialogs"/>
-      </Item15>
+      </Item>
-      <Item16>
+      <Item>
         <Filename Value="..\run\JvMM\jvanimatedimage.pas"/>
         <UnitName Value="JvAnimatedImage"/>
-      </Item16>
+      </Item>
-      <Item17>
+      <Item>
         <Filename Value="..\run\JvMM\jvpicclip.pas"/>
         <UnitName Value="JvPicClip"/>
-      </Item17>
+      </Item>
-      <Item18>
+      <Item>
         <Filename Value="..\run\JvMM\jvspecialimage.pas"/>
         <UnitName Value="JvSpecialImage"/>
-      </Item18>
+      </Item>
+      <Item>
+        <Filename Value="..\run\JvMM\jvimagetransform.pas"/>
+        <UnitName Value="JvImageTransform"/>
+      </Item>
     </Files>
-    <RequiredPkgs Count="2">
+    <RequiredPkgs>
-      <Item1>
+      <Item>
         <PackageName Value="JvCoreLazR"/>
-      </Item1>
+      </Item>
-      <Item2>
+      <Item>
         <PackageName Value="FCL"/>
-      </Item2>
+      </Item>
     </RequiredPkgs>
     <UsageOptions>
       <UnitPath Value="$(PkgOutDir)"/>

components/jvcllaz/run/JvMM/jvimagetransform.pas

@@ -0,0 +1,312 @@
+{-----------------------------------------------------------------------------
+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: JvImageTransform.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 JvImageTransform;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  LCLType,
+  SysUtils, Classes,
+  //Windows,
+  Graphics, Controls, ExtCtrls,
+  JvComponent;
+
+type
+  TJvTransformationKind = (ttWipeLeft, ttWipeRight, ttWipeUp, ttWipeDown,
+    ttTurnLeft, ttTurnRight, ttTurnUp, ttTurnDown,
+    ttWipeDownRight, ttWipeDownLeft, ttWipeUpRight, ttWipeUpLeft);
+
+  TJvImageTransform = class(TJvGraphicControl)
+  private
+    FPicture1: TPicture;
+    FPicture2: TPicture;
+    FTimer: TTimer;
+    FInterval: Integer;
+    FImageShown: Byte;
+    FSteps: Integer;
+    FType: TJvTransformationKind;
+    StepNum: Integer;
+    FOnFinished: TNotifyEvent;
+    procedure PictureChanged(Sender: TObject);
+    procedure SetPicture1(Value: TPicture);
+    procedure SetPicture2(Value: TPicture);
+    procedure SetImageShown(Value: Byte);
+    procedure SetInterval(Value: Integer);
+    procedure SetType(Value: TJvTransformationKind);
+  protected
+    procedure SetAutoSize(Value: Boolean);  override;
+    function GetPalette: HPALETTE; override;
+    procedure Paint; override;
+    procedure TimerTick(Sender: TObject);
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property Align;
+    property Anchors;
+    property AutoSize;
+    property BorderSpacing;
+    property Constraints;
+    property DragCursor;
+    property DragMode;
+    property Enabled;
+    property ImageShown: Byte read FImageShown write SetImageShown default 1;
+    property Interval: Integer read FInterval write SetInterval default 1;
+    property ParentShowHint;
+    property Picture1: TPicture read FPicture1 write SetPicture1;
+    property Picture2: TPicture read FPicture2 write SetPicture2;
+    property PopupMenu;
+    property ShowHint;
+    property Steps: Integer read FSteps write FSteps default 10;
+    property TransformType: TJvTransformationKind read FType write SetType default ttWipeLeft;
+    property Visible;
+    property OnClick;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnFinished: TNotifyEvent read FOnFinished write FOnFinished;
+    procedure Transform;
+  end;
+
+
+implementation
+
+constructor TJvImageTransform.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FImageShown := 1;
+  FPicture1 := TPicture.Create;
+  FPicture1.OnChange := @PictureChanged;
+  FPicture2 := TPicture.Create;
+  FPicture2.OnChange := @PictureChanged;
+  FTimer := TTimer.Create(Self);
+  FTimer.OnTimer := @TimerTick;
+  FTimer.Enabled := False;
+  FInterval := 1;
+  FType := ttWipeLeft;
+  FSteps := 10;
+  Height := 105;
+  Width := 105;
+end;
+
+destructor TJvImageTransform.Destroy;
+begin
+  FPicture1.Free;
+  FPicture2.Free;
+  FTimer.Free;
+  inherited Destroy;
+end;
+
+function TJvImageTransform.GetPalette: HPALETTE;
+begin
+  if FPicture1.Graphic is TBitmap then
+    Result := TBitmap(FPicture1.Graphic).Palette
+  else
+    Result := 0;
+end;
+
+
+procedure TJvImageTransform.SetAutoSize(Value: Boolean);
+begin
+  inherited SetAutoSize(Value);
+  PictureChanged(Self);
+end;
+
+procedure TJvImageTransform.SetPicture1(Value: TPicture);
+begin
+  FPicture1.Assign(Value);
+end;
+
+procedure TJvImageTransform.SetPicture2(Value: TPicture);
+begin
+  FPicture2.Assign(Value);
+end;
+
+procedure TJvImageTransform.SetImageShown(Value: Byte);
+begin
+  if Value in [1, 2] then
+  begin
+    FImageShown := Value;
+    Invalidate;
+  end;
+end;
+
+procedure TJvImageTransform.SetInterval(Value: Integer);
+begin
+  FInterval := Value;
+  if Value > 1000 then
+    FInterval := 1000;
+  if Value < 1 then
+    FInterval := 1;
+  {Reset the timer interval}
+  if FTimer <> nil then
+    FTimer.Interval := FInterval;
+end;
+
+procedure TJvImageTransform.SetType(Value: TJvTransformationKind);
+begin
+  FType := Value;
+end;
+
+procedure TJvImageTransform.PictureChanged(Sender: TObject);
+begin
+  if AutoSize and (Picture1.Width > 0) and (Picture1.Height > 0) then
+    SetBounds(Left, Top, Picture1.Width, Picture1.Height);
+  if (Picture1.Graphic is TBitmap) and (Picture1.Width = Width) and (Picture1.Height = Height) then
+    ControlStyle := ControlStyle + [csOpaque]
+  else
+    ControlStyle := ControlStyle - [csOpaque];
+  Invalidate;
+end;
+
+procedure TJvImageTransform.Transform;
+begin
+  StepNum := 0;
+  {Turn on the timer}
+  if FTimer <> nil then
+  begin
+    FTimer.Interval := 1;
+    FTimer.Enabled := True;
+  end;
+end;
+
+procedure TJvImageTransform.TimerTick(Sender: TObject);
+begin
+  if FTimer <> nil then
+    FTimer.Interval := FInterval;
+  Inc(StepNum);
+  Repaint;
+  if FTimer <> nil then
+    if FTimer.Enabled then
+      if StepNum >= Steps then
+      begin
+        FTimer.Enabled := False;
+        if ImageShown = 1 then
+          ImageShown := 2
+        else
+          ImageShown := 1;
+        if Assigned(FOnFinished) then
+          FOnFinished(Self);
+      end;
+end;
+
+procedure TJvImageTransform.Paint;
+var
+  PctDone: Real;
+  PctLeft: Real;
+  DestRect: TRect;
+  ShowCurrentImage: Boolean;
+  Other: TGraphic;
+begin
+  with inherited Canvas do
+  begin
+    if csDesigning in ComponentState then
+    begin
+      Pen.Style := psDash;
+      Brush.Style := bsClear;
+      Rectangle(0, 0, Width, Height);
+    end;
+    ShowCurrentImage := False;
+    if FTimer <> nil then
+      if not FTimer.Enabled then
+        ShowCurrentImage := True;
+    if StepNum < 1 then
+      ShowCurrentImage := True;
+    if ShowCurrentImage then
+    begin
+      if ImageShown = 1 then
+        Draw(0, 0, Picture1.Graphic)
+      else
+        Draw(0, 0, Picture2.Graphic);
+      Exit;
+    end;
+    if FSteps > 0 then
+      PctDone := (StepNum / FSteps)
+    else
+      PctDone := 0.0;
+    PctLeft := 1 - PctDone;
+    // (rom) simplified with variable Other
+    if ImageShown = 1 then
+      Other := Picture2.Graphic
+    else
+      Other := Picture1.Graphic;
+    if PctDone > 0.0 then
+      case TransformType of
+        ttWipeLeft:
+          Draw(Round(Picture1.Width * PctLeft), 0, Other);
+        ttWipeRight:
+          Draw(-Round(Picture1.Width * PctLeft), 0, Other);
+        ttWipeUp:
+          Draw(0, Round(Picture1.Height * PctLeft), Other);
+        ttWipeDown:
+          Draw(0, -Round(Picture1.Height * PctLeft), Other);
+        ttTurnLeft:
+          begin
+            with Picture1 do
+              DestRect := Rect(Round(Width * PctLeft), 0,
+                Round(Width * PctLeft) +
+                Round(Width * PctDone), Height);
+            StretchDraw(DestRect, Other);
+          end;
+        ttTurnRight:
+          begin
+            with Picture1 do
+              DestRect := Rect(0, 0, Round(Width * PctDone), Height);
+            StretchDraw(DestRect, Other);
+          end;
+        ttTurnUp:
+          begin
+            with Picture1 do
+              DestRect := Rect(0, Round(Height * PctLeft),
+                Width, Round(Height * PctLeft) +
+                Round(Height * PctDone));
+            StretchDraw(DestRect, Other);
+          end;
+        ttTurnDown:
+          begin
+            with Picture1 do
+              DestRect := Rect(0, 0, Width, Round(Height * PctDone));
+            StretchDraw(DestRect, Other);
+          end;
+        ttWipeDownRight:
+          Draw(-Round(Picture1.Width * PctLeft), -Round(Picture1.Height * PctLeft), Other);
+        ttWipeDownLeft:
+          Draw(Round(Picture1.Width * PctLeft), -Round(Picture1.Height * PctLeft), Other);
+        ttWipeUpRight:
+          Draw(-Round(Picture1.Width * PctLeft), Round(Picture1.Height * PctLeft), Other);
+        ttWipeUpLeft:
+          Draw(Round(Picture1.Width * PctLeft), Round(Picture1.Height * PctLeft), Other);
+      end;
+  end;
+end;
+
+end.