You've already forked lazarus-ccr
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
This commit is contained in:
wp_xxyyzz
312
components/jvcllaz/run/JvMM/jvimagetransform.pas
Normal file
312
components/jvcllaz/run/JvMM/jvimagetransform.pas
Normal file
@ -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.
|
||||
Reference in New Issue
Block a user