Blend 2 PNG images (morph from one to another)
I've come around with a few demos to do this like shown below, but those work only for bitmaps. I've tried doing this with Graphics32 library but to no avail. The first example shows pretty much the desired effect/
I want to blend 2 PNG images, morphing one into another (end result is only 2nd image)
It must work with alpha channel and remain transparent. I have D2009 so it can use either pngimage, G32's bitmap32 or delphi's bitmap (which now supports 32bit mode)
I want to blend 2 PNG images, morphing one into another (end result is only 2nd image)
It must work with alpha channel and remain transparent. I have D2009 so it can use either pngimage, G32's bitmap32 or delphi's bitmap (which now supports 32bit mode)
for a := 0 to 85 do
begin
MergeBitmaps(image1.Picture.bitmap,image2.Picture.bitmap,image3.Picture.bitmap,a*3);
Application.ProcessMessages;
end;
procedure MergeBitmaps(BM1, BM2, BM3 : TBitmap; Alpha : byte);
var
bf:TBlendFunction;
begin
//if not Assigned(BM3) then BM3:= TBitmap32.Create;
BM3.Assign(BM1);
bf.BlendOp:=AC_SRC_OVER;
bf.BlendFlags:=0;
bf.SourceConstantAlpha:=Alpha;//0-255
bf.AlphaFormat:=0;// not use alpha-channel of bmp2
//if sizes of your source bmps are different, try uncomment
// and see result
//BM2.Width:=BM3.Width;
//BM2.Height:=BM3.Height;
AlphaBlend(BM3.Canvas.Handle,0,0,BM3.Width,BM3.Height,
BM2.canvas.handle,0,0,BM2.Width,BM2.Height,bf);
end;
--------------------------------------------------------------------
This also works nicely, but again only 24b bitmaps
unit BSMorphButton;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs , extctrls;
const
Maxize = (1294967280 Div SizeOf(TPoint));
MaxPixelCount = 32768;
Mask0101 = $00FF00FF;
Mask1010 = $FF00FF00;
type
EMorphButton = class(Exception);
PRGBArray = ^TRGBArray;
TRGBArray = array[0..MaxPixelCount-1] of TRGBTriple;
TPnts = array[0..Maxize - 1] of TPoint;
TBSMorphButton = class(TGraphicControl)
private
{Private Declarations}
bmF : TBitmap;
bmT : TBitmap;
bmZ : TBitmap;
FPicFrom : TPicture;
FPicTo : TPicture;
FclFrom : TColor;
FclTo : TColor;
FBRate : integer;
FStretch : Boolean;
FProcMsg : Boolean;
FFinish : Boolean;
FOnBegin : TNotifyEvent;
FOnEnd : TNotifyEvent;
FOnReset : TNotifyEvent;
FAutoRev : Boolean;
FRevSwap : Boolean;
FReverst : Boolean;
FStrTmp : Boolean;
FDelay : integer;
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;
procedure CMMouseEnter(var Msg:TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg:TMessage); message CM_MOUSELEAVE;
procedure chgPicF(Sender : TObject);
procedure chgPicT(Sender : TObject);
procedure WMEraseBkgnd(Var Msg : TMessage); message WM_ERASEBKGND;
procedure SetpicFrom(Pic : TPicture);
procedure SetpicTo(Pic : TPicture);
procedure SetclFrom(Col : TColor);
procedure SetclTo(Col : TColor);
procedure SetBRate(Val : integer);
procedure SetStretch(Val : Boolean);
procedure SetProcMsg(Val : Boolean);
procedure Blend;
procedure UnBlend;
procedure Blendit(bFr,bTo,bLn : Pointer ; Width,Height : Integer ; Dens : LongInt);
protected
procedure WMPosChg(var Msg : TMessage); message WM_WINDOWPOSCHANGED;
public
{Public Declarations}
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Paint; override;
procedure Reset;
procedure Complete;
property Finish : Boolean read FFinish write FFinish default FALSE;
published
{Published Declarations}
property MorphPic1 : TPicture read FPicFrom write SetpicFrom;
property MorphPic2 : TPicture read FPicTo write SetpicTo;
property MorphColor1 : TColor read FclFrom write SetclFrom default clBlack;
property MorphColor2 : TColor read FclTo write SetclTo default clWhite;
property MorphRate : integer read FBRate write SetBRate default 32;
property StretchToFit : Boolean read FStretch write SetStretch default TRUE;
property ProcessMsgs : Boolean read FProcMsg write SetProcMsg default TRUE;
property Hint;
property OnClick;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
end;
procedure Register;
//{$R Data.res}
implementation
const HandCursor = 31;
Var
EBX, ESI, EDI, ESP, EBP,
FinA,
Dens1, Dens2 : Longint;
constructor TBSMorphButton.Create(AOwner : TComponent);
Var
Temp1:TBitmap;
begin
inherited Create(AOwner);
Screen.Cursors[HandCursor]:=LoadCursor (hInstance , 'CUR');
Cursor:=HandCursor;
FclFrom := clBlack;
FclTo := clWhite;
FBRate := 250;
FStretch := TRUE;
FStrTmp := TRUE;
FProcMsg := TRUE;
FFinish := FALSE;
FAutoRev := FALSE;
FRevSwap := TRUE;
FReverst := FALSE;
FDelay := 1;
ControlStyle := ControlStyle + [csOpaque] + [csNoStdEvents];
// Temp1:=TBitmap.Create;
// Temp1.LoadFromResourceName (HInstance,'B1');
FPicFrom := TPicture.Create;
// FPicFrom.Bitmap:=Temp1;
// Temp1.LoadFromResourceName (HInstance,'B2');
FPicTo := TPicture.Create;
// FPicTo.Bitmap:=Temp1;
bmF := TBitmap.Create;
bmT := TBitmap.Create;
bmZ := TBitmap.Create;
bmZ.PixelFormat := pf24bit;
bmF.Canvas.Brush.Color := clBlack;
FPicFrom.OnChange := chgPicF;
FPicTo.OnChange := chgPicT;
Width := 120;
Height := 50;
bmF.Width := Width;
bmF.Height := Height;
end;
procedure DoIco(I : TGraphic; B : TBitmap; C : TColor; W : integer; H : integer);
var
bmIco : TBitmap;
begin
bmIco := TBitmap.Create;
bmIco.Width := I.Width;
bmIco.Height := I.Height;
bmIco.Canvas.Brush.Color := C;
bmIco.Canvas.FillRect(RECT(0,0,bmIco.Width,bmIco.Height));
bmIco.Canvas.Draw(0,0,I);
B.Canvas.StretchDraw(RECT(0,0,W,H),bmIco);
bmIco.Free;
end;
procedure TBSMorphButton.Reset;
var
pTmp : TPicture;
cTmp : TColor;
begin
bmF.PixelFormat := pf24bit;
bmT.PixelFormat := pf24bit;
bmZ.PixelFormat := pf24bit;
if FReverst = TRUE then begin
cTmp := FclFrom;
FclFrom := FclTo;
FclTo := cTmp;
pTmp := TPicture.Create;
pTmp.Assign(FPicFrom);
FPicFrom.Assign(FPicTo);
FPicTo.Assign(pTmp);
bmF.Canvas.Brush.Color := FclFrom;
bmT.Canvas.Brush.Color := FclTo;
FReverst := FALSE;
pTmp.Free;
FStretch := FStrTmp;
end;
if FStretch = TRUE then begin
bmF.Width := Width;
bmF.Height := Height;
if FPicFrom.Graphic = nil then
bmF.Canvas.FillRect(RECT(0,0,Width,Height))
else begin
if FPicFrom.Graphic is TMetaFile then
bmF.Canvas.FillRect(RECT(0,0,Width,Height));
if FPicFrom.Graphic is TIcon then begin
DoIco(FPicFrom.Graphic, bmF, FclFrom, Width, Height);
end
else
bmF.Canvas.StretchDraw(RECT(0,0,Width,Height),FPicFrom.Graphic);
end;
bmT.Width := Width;
bmT.Height := Height;
if FPicTo.Graphic = nil then
bmT.Canvas.FillRect(RECT(0,0,Width,Height))
else begin
if FPicTo.Graphic is TMetaFile then
bmT.Canvas.FillRect(RECT(0,0,Width,Height));
if FPicTo.Graphic is TIcon then
DoIco(FPicTo.Graphic, bmT, FclTo, Width, Height)
else
bmT.Canvas.StretchDraw(RECT(0,0,Width,Height),FPicTo.Graphic);
end;
end;
if FStretch = FALSE then begin
if (FPicTo.Graphic <> nil) and (FPicFrom.Graphic = nil) then begin
Width := FPicTo.Width;
Height := FPicTo.Height;
bmT.Width := Width;
bmT.Height := Height;
if (FPicTo.Graphic is TMetaFile) or (FPicTo.Graphic is TIcon) then
bmT.Canvas.FillRect(RECT(0,0,Width,Height));
bmT.Canvas.Draw(0,0,FPicTo.Graphic);
bmF.Width := Width;
bmF.Height := Height;
bmF.Canvas.FillRect(RECT(0,0,Width,Height));
end;
if (FPicFrom.Graphic <> nil) and (FPicTo.Graphic = nil) then begin
Width := FPicFrom.Width;
Height := FPicFrom.Height;
bmF.Width := Width;
bmF.Height := Height;
if (FPicFrom.Graphic is TMetaFile) or (FPicFrom.Graphic is TIcon) then
bmF.Canvas.FillRect(RECT(0,0,Width,Height));
bmF.Canvas.Draw(0,0,FPicFrom.Graphic);
bmT.Width := Width;
bmT.Height := Height;
bmT.Canvas.FillRect(RECT(0,0,Width,Height));
end;
if (FPicFrom.Graphic = nil) and (FPicTo.Graphic = nil) then begin
bmF.Width := Width;
bmF.Height := Height;
bmF.Canvas.FillRect(RECT(0,0,Width,Height));
bmT.Width := Width;
bmT.Height := Height;
bmT.Canvas.FillRect(RECT(0,0,Width,Height));
end;
if (FPicFrom.Graphic <> nil) and (FPicTo.Graphic <> nil) then begin
Width := FPicFrom.Width;
Height := FPicFrom.Height;
bmF.Width := Width;
bmF.Height := Height;
if (FPicFrom.Graphic is TMetaFile) or (FPicFrom.Graphic is TIcon) then
bmF.Canvas.FillRect(RECT(0,0,Width,Height));
bmF.Canvas.Draw(0,0,FPicFrom.Graphic);
bmT.Width := Width;
bmT.Height := Height;
if FPicTo.Graphic is TMetaFile then
bmT.Canvas.FillRect(RECT(0,0,Width,Height));
if FPicTo.Graphic is TIcon then begin
DoIco(FPicTo.Graphic, bmT, FclTo, Width, Height);
end
else
bmT.Canvas.StretchDraw(RECT(0,0,Width,Height),FPicTo.Graphic);
end;
end;
bmZ.Width := bmF.Width;
bmZ.Height := bmF.Height;
Invalidate;
if Assigned (FOnReset) then FOnReset(Self);
end;
procedure TBSMorphButton.WMEraseBkgnd(var Msg:TMessage);
begin
Msg.Result := 1;
end;
procedure TBSMorphButton.Paint;
begin
Canvas.Draw(0,0,bmF);
Canvas.Brush.Style:=bsClear;
end;
procedure TBSMorphButton.Complete;
begin
Canvas.Draw(0,0,bmT);
if Assigned (FOnEnd) then FOnEnd(Self);
FFinish := FALSE;
end;
Function Pt(B : TBitmap) : Pointer;
Begin
Pt := B.Scanline[(B.Height-1)]
End;
procedure TBSMorphButton.Blendit(bFr,bTo,bLn : Pointer ; Width,Height : Integer ; Dens : LongInt); assembler;
ASM
MOV &EBX, EBX
MOV &EDI, EDI
MOV &ESI, ESI
MOV &ESP, ESP
MOV &EBP, EBP
MOV EBX, Dens
MOV Dens1, EBX
NEG BL
ADD BL, $20
MOV Dens2, EBX
CMP Dens1, 0
JZ @Final
MOV EDI, bFr
MOV ESI, bTo
MOV ECX, bLn
MOV EAX, Width
lea EAX, [EAX+EAX*2+3]
AND EAX, $FFFFFFFC
IMUL Height
ADD EAX, EDI
MOV FinA, EAX
MOV EBP,EDI
MOV ESP,ESI
MOV ECX,ECX
@LOOPA:
MOV EAX, [EBP]
MOV EDI, [ESP]
MOV EBX, EAX
AND EAX, Mask1010
AND EBX, Mask0101
SHR EAX, 5
IMUL EAX, Dens2
IMUL EBX, Dens2
MOV ESI, EDI
AND EDI, Mask1010
AND ESI, Mask0101
SHR EDI, 5
IMUL EDI, Dens1
IMUL ESI, Dens1
ADD EAX, EDI
ADD EBX, ESI
AND EAX, Mask1010
SHR EBX, 5
AND EBX, Mask0101
OR EAX, EBX
MOV [ECX], EAX
ADD EBP, 4
ADD ESP, 4
ADD ECX, 4
CMP EBP, FinA
JNE @LOOPA
@FINAL:
MOV EBX, &EBX
MOV EDI, &EDI
MOV ESI, &ESI
MOV ESP, &ESP
MOV EBP, &EBP
End;
procedure TBSMorphButton.Blend;
var
r : integer;
begin
Reset;
if FBRate < 1 then
raise EMorphButton.Create('BlendRate must be between 0 and 256');
if Assigned (FOnBegin) then FOnBegin(Self);
bmZ.Canvas.Draw(0, 0, bmF);
for r := 0 to FBRate do begin
Blendit(Pt(bmZ),Pt(bmT),Pt(bmF),bmF.Width,bmF.Height,(r*$20 Div FBRate));
RePaint;
if FProcMsg = TRUE then
Application.ProcessMessages;
if FFinish = TRUE then begin
Complete;
Exit;
end;
end;
if FAutoRev = TRUE then begin
Sleep(FDelay * 1000);
end;
if Assigned (FOnEnd) then FOnEnd(Self);
end;
procedure TBSMorphButton.UnBlend;
var
r : integer;
pTmp : TPicture;
cTmp : TColor;
begin
FStrTmp := FStretch;
FStretch := TRUE;
bmF.Canvas.Brush.Color := FclTo;
bmT.Canvas.Brush.Color := FclFrom;
cTmp := FclFrom;
FclFrom := FclTo;
FclTo := cTmp;
pTmp := TPicture.Create;
pTmp.Assign(FPicFrom);
FPicFrom.Assign(FPicTo);
FPicTo.Assign(pTmp);
pTmp.Free;
Reset;
FReverst := TRUE;
bmZ.Canvas.Draw(0, 0, bmF);
for r := 0 to FBRate do begin
Blendit(Pt(bmZ),Pt(bmT),Pt(bmF),bmF.Width,bmF.Height,(r*$20 Div FBRate));
RePaint;
if FProcMsg = TRUE then
Application.ProcessMessages;
if FFinish = TRUE then begin
Complete;
Exit;
end;
end;
Reset;
end;
procedure TBSMorphButton.WMPosChg(var Msg : TMessage);
begin
Reset;
Invalidate;
inherited;
end;
procedure TBSMorphButton.CMMouseEnter(var Msg:TMessage);
begin
inherited;
if Assigned (FOnMouseEnter) then FOnMouseEnter(Self);
Blend;
end;
procedure TBSMorphButton.CMMouseLeave(var Msg:TMessage);
begin
inherited;
if Assigned (FonMouseLeave) then FOnMouseLeave(Self);
UnBlend;
end;
procedure TBSMorphButton.chgPicF(Sender : TObject);
begin
if FReverst = TRUE then Exit;
Reset;
Invalidate;
end;
procedure TBSMorphButton.chgPicT(Sender : TObject);
begin
if FReverst = TRUE then Exit;
Reset;
Invalidate;
end;
procedure TBSMorphButton.SetpicFrom(Pic : TPicture);
begin
FPicFrom.Assign(Pic);
end;
procedure TBSMorphButton.SetpicTo(Pic : TPicture);
begin
FPicTo.Assign(Pic);
end;
procedure TBSMorphButton.SetclFrom(Col : TColor);
begin
if FclFrom <> Col then begin
FclFrom := Col;
bmF.Canvas.Brush.Color := Col;
Reset;
Invalidate;
end;
end;
procedure TBSMorphButton.SetclTo(Col : TColor);
begin
if FclTo <> Col then begin
FclTo := Col;
bmT.Canvas.Brush.Color := Col;
Reset;
Invalidate;
end;
end;
procedure TBSMorphButton.SetBRate(Val : integer);
begin
if FBRate <> Val then
FBRate := Val;
if FBRate < 1 then
FBRate := 1;
if FBRate > 255 then
FBRate := 255;
end;
procedure TBSMorphButton.SetStretch(Val : Boolean);
begin
if FStretch <> Val then begin
FStretch := Val;
Reset;
Invalidate;
end;
end;
procedure TBSMorphButton.SetProcMsg(Val : Boolean);
begin
if FProcMsg <> Val then
FProcMsg := Val;
end;
destructor TBSMorphButton.Destroy;
begin
FPicFrom.Free;
FPicTo.Free;
bmF.Free;
bmT.Free;
bmZ.Free;
inherited Destroy;
end;
procedure Register;
begin
RegisterComponents('Samples', [TBSMorphButton]);
end;
end.
I have 2 PNGs in a resource. The first one is always loaded to a TImage. Sometimes I will load the 2nd one to the TImage, then the 1st one again after a few seconds. I want the 1st to blend into/become the 2nd one, then the same back to the first one.
Hi,
you might want the same as I wanted for some weeks ago.
If you have access to the gr32 newsgroup then look in graphics32.general MessageID 8644
If not let me know I might find the source somewhere on my hdd's
Kindest regards
s!
you might want the same as I wanted for some weeks ago.
If you have access to the gr32 newsgroup then look in graphics32.general MessageID 8644
If not let me know I might find the source somewhere on my hdd's
Kindest regards
s!
ASKER
I subscribed to the newsgroups, how can I find that Message ID there?
Just search for my Nick stOrM! in the questions should be easy to find because there are only 2 questions there from myself...
regards
s!
regards
s!
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hi, sorry about the delay.
The example works great, but it has a problem: no transparency:
The picture at the left is the Image32. The other 2 are normal TImages using the source images Background and Foreground (using pngimage, since GraphicEx doesn't load the transparency properly even for those 2)
Cropped-Capture---00018.jpg
The example works great, but it has a problem: no transparency:
The picture at the left is the Image32. The other 2 are normal TImages using the source images Background and Foreground (using pngimage, since GraphicEx doesn't load the transparency properly even for those 2)
Cropped-Capture---00018.jpg
Hi,
from what I know you cant with Image32, maybe at least with layers but not sure about it. That questions was often asked in the newsgroup how to make e.g. the background of image32 transparent havent seen an answer yet.
regards
s!
from what I know you cant with Image32, maybe at least with layers but not sure about it. That questions was often asked in the newsgroup how to make e.g. the background of image32 transparent havent seen an answer yet.
regards
s!
btw thats my result also not much better then yours
Capture.png
Capture.png
ASKER
I'll try digging some more into TImage32, since delphi 2009 now supports 32bit bitmaps natively, maybe we can come up with a new solution.
By the way, that background and button look like those from Kaspersky
By the way, that background and button look like those from Kaspersky
Would be nice if you can come up with a better solution.
It would be fine if you let me know when you get it done, because I'm currently make use of the windows search api, where later my gui needs some touch ups :-)
In the moment I'm using the usuaally UpdateLayeredWindows stuff but thats not a good solution working with a fake window to get the controls drawn thought.
btw. Yep thats kaspersky I don't wanted to fire up photoshop and draw a button for this example :-)
regards
s!
It would be fine if you let me know when you get it done, because I'm currently make use of the windows search api, where later my gui needs some touch ups :-)
In the moment I'm using the usuaally UpdateLayeredWindows stuff but thats not a good solution working with a fake window to get the controls drawn thought.
btw. Yep thats kaspersky I don't wanted to fire up photoshop and draw a button for this example :-)
regards
s!
ASKER
"working with a fake window to get the controls drawn thought "
yeah I'm doing the same, it's kinda troublesome but does the trick for now
yeah I'm doing the same, it's kinda troublesome but does the trick for now
ASKER
Hi, haven't come up with anything better as of yet.
do you have the 2 images visible in your app and then wanting to show the morphed image.
It will make a difference on how we convert the png to a bitmap then back to png format.
John