qow 21 : Fading/Blending effects of Pictures

hi experts,

i will restart again qow (question of the week)
(thanks robert_marquardt for remembering :-))

each week i will introduce a new simple? question.

now qow 21

against the rules of the previous qows
all expert are allowed to solving this question.

the rule are:
- you must post your source here in this question.
- each different solution gets the points provided with this question
(means one expert can get multiple points, if the solutions are different)
- bonus (only for one solution), if a solution is special simple or clever,
or provides mutliple effects, this solution gets double-double-points (4x)


well the question is:

How to make fading/blending effects with two pictures?

Scenario Description:
i have two pictures, and want to see one after one with a nice noticeable,
fading/blending effect on my form.


for fast Validations, if you can, additional to the source-posting here,
send me your compiled project to
kretzschmar@experts-exchange.com

each different solution may get 125 pts (a-graded).

this question will be closed after 7 days.

have fun and let see

meikl ;-)

LVL 27
kretzschmarAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

JaccoCommented:
Hi all,

I don't have much inspiration jet for stunning fade effects, but I did come up with an easy to use testbed. Just add a published method and do your stuff with the three TImages on the form. (The new published method will be listed automagically in the combobox).

The rules for using the testbed are simple:
- The method must be of type function: Boolean
- Should return False if the fade is finished
- Should use Step and Speed to keep track of state
- When the fade has finished "img" should look exactly like "dst"

I hope the testbed will work for some of the contestents!

Regards Jacco

P.S: Maybe a simple HIRES - timer is needed?

<<< Start of Unit1.DFM >>>
object frmFade: TfrmFade
  Left = 192
  Top = 114
  Width = 696
  Height = 480
  Caption = 'frmFade'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = _FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object src: TImage
    Left = 8
    Top = 8
    Width = 273
    Height = 193
  end
  object dst: TImage
    Left = 288
    Top = 8
    Width = 297
    Height = 193
  end
  object img: TImage
    Left = 144
    Top = 208
    Width = 329
    Height = 233
  end
  object lbSpeed: TLabel
    Left = 488
    Top = 240
    Width = 31
    Height = 13
    Caption = '&Speed'
    FocusControl = edSpeed
  end
  object lbFade: TLabel
    Left = 488
    Top = 216
    Width = 24
    Height = 13
    Caption = '&Fade'
    FocusControl = cbFade
  end
  object btnFade: TButton
    Left = 8
    Top = 208
    Width = 75
    Height = 25
    Caption = 'Fade'
    TabOrder = 0
    OnClick = _btnFadeClick
  end
  object edSpeed: TEdit
    Left = 536
    Top = 240
    Width = 65
    Height = 21
    TabOrder = 1
    Text = '5'
  end
  object mmStats: TMemo
    Left = 480
    Top = 296
    Width = 185
    Height = 145
    TabOrder = 2
  end
  object cbFade: TComboBox
    Left = 536
    Top = 216
    Width = 113
    Height = 21
    Style = csDropDownList
    ItemHeight = 13
    TabOrder = 3
  end
  object tmrTimer: TTimer
    Enabled = False
    Interval = 20
    OnTimer = _tmrTimerTimer
    Left = 16
    Top = 240
  end
end
<<< End of Unit1.DFM >>>

<<< Start of Unit1.PAS >>>
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TFadeFunction = function: Boolean of object;

  TfrmFade = class(TForm)
    src: TImage;
    dst: TImage;
    img: TImage;
    btnFade: TButton;
    tmrTimer: TTimer;
    edSpeed: TEdit;
    lbSpeed: TLabel;
    mmStats: TMemo;
    cbFade: TComboBox;
    lbFade: TLabel;
    procedure _btnFadeClick(Sender: TObject);
    procedure _FormCreate(Sender: TObject);
    procedure _tmrTimerTimer(Sender: TObject);
  private
    function GetDC(aImage: TImage): HDC;
  public
    Fade: TFadeFunction;
    Step: Integer;
    StepCount: Integer;
    Time: TDateTime;
    Speed: Integer;
    imgWidth: Integer;
    imgHeight: Integer;
  published
    function VerticalCurtain: Boolean;
    function HorizontalCurtain: Boolean;
    function HorizontalSlide: Boolean;
  end;

var
  frmFade: TfrmFade;

implementation

uses
  Math;

{$R *.dfm}

function TfrmFade.VerticalCurtain: Boolean;
begin
  Result := Step <= imgWidth;
  BitBlt(GetDc(img), Step, 0, Speed, imgHeight, GetDc(dst), Step, 0, SRCCOPY);
  Inc(Step, Speed);
end;

function TfrmFade.HorizontalSlide: Boolean;
var
  liWidth: Integer;
begin
  Result := Step <= imgWidth;
  liWidth := Min(Step, imgWidth);
  BitBlt(GetDC(img), 0, 0, liWidth, imgHeight, GetDC(dst), imgWidth - liWidth, 0, SRCCOPY);
  Inc(Step, Speed);
end;

function TfrmFade.HorizontalCurtain: Boolean;
begin
  Result := Step <= imgHeight;
  BitBlt(GetDC(img), 0, Step, imgWidth, Speed, GetDC(dst), 0, Step, SRCCOPY);
  Inc(Step, Speed);
end;

procedure TfrmFade._FormCreate(Sender: TObject);
type
  TMethodTable = packed record
    count: SmallInt;
  //[...methods...]
  end;
var
  table: ^TMethodTable;
  name:  ^ShortString;
  i:  Integer;
  aclass: TClass;
begin
  src.Picture.Bitmap.LoadFromFile('c:\program files\common files\borland shared\images\splash\256color\chemical.bmp');
  dst.Picture.Bitmap.LoadFromFile('c:\program files\common files\borland shared\images\splash\256color\handshak.bmp');
  src.Picture.Bitmap.PixelFormat := pf32bit;
  dst.Picture.Bitmap.PixelFormat := pf32bit;
  DoubleBuffered := True;
  aclass := Self.ClassType;
  asm
    mov  EAX, [aclass]
    mov  EAX,[EAX].vmtMethodTable { fetch pointer to method table }
    mov  [table], EAX
  end;
  if table <> nil then
  begin
    name  := Pointer(PChar(table) + 8);
    for i := 1 to table.count do
    begin
      if name^[1] <> '_' then
        cbFade.Items.AddObject(name^, MethodAddress(name^));
      name := Pointer(PChar(name) + length(name^) + 7)
    end;
  end;
  cbFade.ItemIndex := 0;
  TMethod(Fade).Data := Self;
  imgWidth := src.Picture.Bitmap.Width;
  imgHeight := src.Picture.Bitmap.Height;
end;

function TfrmFade.GetDC(aImage: TImage): HDC;
begin
  Result := aImage.Picture.Bitmap.Canvas.Handle;
end;

procedure TfrmFade._btnFadeClick(Sender: TObject);
begin
  img.Picture.Assign(src.Picture);
  TMethod(Fade).Code := cbFade.Items.Objects[cbFade.ItemIndex];
  Step := 0;
  StepCount := 0;
  Speed := StrToIntDef(edSpeed.Text, 1);
  btnFade.Enabled := False;
  tmrTimer.Enabled := True;
  Time := Now;
end;

procedure TfrmFade._tmrTimerTimer(Sender: TObject);
begin
  tmrTimer.Enabled := False;
  Inc(StepCount);
  if not Fade then
  begin
    Time := Now - Time;
    mmStats.Lines.Add('Time: ' + FloatToStrF(Time * MSecsPerDay, ffFixed, 15, 5) + ' ms');
    mmStats.Lines.Add('Steps: ' + IntToStr(StepCount));
    mmStats.Lines.Add('Tm/Stp: ' + FloatToStrF(Time * MSecsPerDay / StepCount, ffFixed, 15, 5) + ' ms');
    tmrTimer.Enabled := False;
    btnFade.Enabled := True;
    dst.Picture.Assign(src.Picture);
    src.Picture.Assign(img.Picture);
  end else
  begin
    img.Invalidate;
    tmrTimer.Enabled := True;
  end;
end;

end.
<<< End of Unit1.PAS >>>

<<< Start of Project1.DPR >>>
program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {frmFade};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TfrmFade, frmFade);
  Application.Run;
end.
<<< End of Project1.DPR >>>
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
JaccoCommented:
Here is a blend for use with the framework.

Regards Jacco

PS: There is a small bug in the framework:
  ...
  if not Fade then
  begin
    img.Invalidate; <<<< need to be inserted to show the last step to user
    ...

function TfrmFade.Blend: Boolean;
type
  TRGBQuadArray = array[0..0] of TRGBQuad;
  PRGBQuadArray = ^TRGBQuadArray;
var
  i, s, d: PRGBQuadArray;
  liX, liY, liSteps: Integer;
begin
  liSteps := 500 div Speed;
  for liY := 0 to imgHeight-1 do
  begin
    i := img.Picture.Bitmap.ScanLine[liY];
    s := src.Picture.Bitmap.ScanLine[liY];
    d := dst.Picture.Bitmap.ScanLine[liY];
    for liX := 0 to imgWidth-1 do
    begin
      i[liX].rgbRed   := EnsureRange(Round(s[liX].rgbRed   + (d[liX].rgbRed   - s[liX].rgbRed  ) * (Step / liSteps)), 0, 255);
      i[liX].rgbGreen := EnsureRange(Round(s[liX].rgbGreen + (d[liX].rgbGreen - s[liX].rgbGreen) * (Step / liSteps)), 0, 255);
      i[liX].rgbBlue  := EnsureRange(Round(s[liX].rgbBlue  + (d[liX].rgbBlue  - s[liX].rgbBlue ) * (Step / liSteps)), 0, 255);
    end;
  end;
  Inc(Step);
  Result := not (Step = liSteps + 1);
end;
0
kretzschmarAuthor Commented:
thanks jacco,

i will validate your solutions later,
but a preview over your source looks good

meikl ;-)
0
Cloud Class® Course: Microsoft Exchange Server

The MCTS: Microsoft Exchange Server 2010 certification validates your skills in supporting the maintenance and administration of the Exchange servers in an enterprise environment. Learn everything you need to know with this course.

Slick812Commented:
I thought there would be more entries for this. . . . you still looking for some blenders?
0
kretzschmarAuthor Commented:
well,
i expected also more participants :-(

>you still looking for some blenders?
yes, but selfmade

this question will be closed in about 10 hours.

meikl ;-)
0
Slick812Commented:
OK, since there does not seem to be any special effect blends so far, here's my "Enlarging Circle Blender", This has a blend that moves out from the center in a circular blend. This uses some trigonometry (I think) math to get the distance from the center point, in the FOR Loops, ,
 and this will use processor power, so slower processors or larger images will have slower circle growth (I use a TTimer so if it's slower than the Timer interval it won't matter except the movement will be slower).
This uses a button, a Panel and a Timer
The Bitmap size should be smaller than 640x480




type
  Pbgra = ^Tbgra;
  Tbgra = packed record
    b, g, r, a: Byte;
    end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    sbut_RoundScan: TSpeedButton;
    Timer7: TTimer;

  private
    { Private declarations }
    BlendNum, EndBlend: Integer;
    Center: TPoint;
    StartBmp, EndBmp, FadeBmp: TBitmap;
    procedure RoundScan;


var
  Form1: TForm1;

implementation

{$R *.DFM}

uses math;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Timer7.Enabled := False;
FreeAndNil(StartBmp);
FreeAndNil(EndBmp);
FreeAndNil(FadeBmp);
end;





procedure TForm1.sbut_RoundScanClick(Sender: TObject);
begin
{this is the button click that starts the blender}
if Fading then Exit; // make sure not running
StartBmp := TBitmap.Create;
StartBmp.LoadFromFile('E:\Blend11.bmp');
//StartBmp.Width := 640;
//StartBmp.Height := 480;

StartBmp.PixelFormat := pf32Bit;
{need to be 32 bit for scanline opps}
Panel1.SetBounds(Panel1.left,Panel1.top, StartBmp.Width, StartBmp.Height);
{I need speed for this, so I use a TPanel for visual output}

EndBmp := TBitmap.Create;
EndBmp.LoadFromFile('E:\Blend12.bmp');
EndBmp.PixelFormat := pf32Bit;
EndBmp.Canvas.brush.Color := clGray;
EndBmp.Width := StartBmp.Width;
EndBmp.Height := StartBmp.Height;


FadeBmp := TBitmap.Create;
FadeBmp.PixelFormat := pf32Bit;
FadeBmp.Width := StartBmp.Width;
FadeBmp.Height := StartBmp.Height;

Center.x := StartBmp.Width shr 1;
Center.y := StartBmp.Height shr 1;
{get the center point of bitmap}

EndBlend := (Round(Sqrt(SumOfSquares([Center.x,Center.y]))) shr 1)+14{8};
{need a number to finish blend, this is the EndBlend number}
BlendNum := 0;
Timer7.Interval := 55;
Timer7.Enabled := True;
Fading := True;
end;

procedure TForm1.RoundScan;
var
Y, X, aDC, fDC, CirPos: Integer;
pPixelFade, pPixelEnd, pPixelStart: Pbgra;
SA, EA, Len1: Single;
PerCount0, PerCount1: Int64;
begin
QueryPerformanceCounter(PerCount0);
{I needed perfomance info}

CirPos := (BlendNum shl 1)+20;

for Y := 0 to FadeBmp.Height -1 do
  begin
  pPixelEnd := EndBmp.ScanLine[y];
  pPixelFade := FadeBmp.ScanLine[y];
  pPixelStart := StartBmp.ScanLine[y];
  for X := 0 to FadeBmp.Width -1 do
    begin
    Len1 := Sqrt(SumOfSquares([abs(Y-Center.y),abs(X-Center.x)]));
{to do an enlarging Circle fade in, I need the length from the center Point. .
 I use a 64 pixel wide fade so the effect will seem gradual, but smaller images
 may not view full effect}
    if Len1 < CirPos-64 then
      begin
      EA := 1.0; // all EndBmp
      SA := 0.0;
      end else
      if Len1 < CirPos then
      begin
      EA := (CirPos - Len1) / 64;
      SA := 1.0 - EA;
      end else
      begin
      EA := 0.0;
      SA := 1.0; // all StartBmp
      end;

    pPixelFade.r := ROUND((SA * pPixelStart.r) + (EA * pPixelEnd.r));
    pPixelFade.g := ROUND((SA * pPixelStart.g)  + (EA * pPixelEnd.g));
    pPixelFade.b := ROUND((SA * pPixelStart.b)  + (EA * pPixelEnd.b));

    Inc(pPixelStart);
    Inc(pPixelEnd);
    Inc(pPixelFade);
    end; // X to width
  end; // Y to height


{because of the processor time of the math used for pixel density
in the for loops, I needed all the speed I could get. Because the Canvas
drawing is slower than the API DC operations, I used the API DC functions}
fDC := CreateCompatibleDC(0);
SelectObject(fDC, FadeBmp.Handle);
aDC := GetDC(Panel1.Handle);
BitBlt(aDC, 0, 0, FadeBmp.Width, FadeBmp.Height, fDC, 0, 0, SRCCOPY);
DeleteDC(fDC);
QueryPerformanceCounter(PerCount1);
TextOut(aDC,30,20,PChar(IntToStr(PerCount1-PerCount0)),
          Length(IntToStr(PerCount1-PerCount0)));
ReleaseDC(Panel1.Handle, aDC);
end;

procedure TForm1.Timer7Timer(Sender: TObject);
var
aDC: Integer;
begin
if BlendNum < EndBlend then
  Inc(BlendNum) else
  begin
  Timer7.Enabled := False;
  aDC := GetDC(Panel1.Handle);
  // BitBlt(aDC,0, 0, FadeBmp.Width, StartBmp.Height, EndBmp.Canvas.Handle, 0,0, SRCCOPY);
{I don't draw the EndBmp to see perfomance, but working code should draw it}
  TextOut(aDC,30,40,'DONE', 4);
  ReleaseDC(Panel1.Handle, aDC);
  FreeAndNil(StartBmp);
  FreeAndNil(EndBmp);
  FreeAndNil(FadeBmp);
  Fading := False;
  Exit;
  end;
RoundScan;
end;

0
kretzschmarAuthor Commented:
sorry,
got no time for evaluation yet,
i will keep it open until next weekend.

be patient

meikl ;-)
0
kretzschmarAuthor Commented:
if you both agree,
i would spent 250 pts each.

meikl ;-)
0
Slick812Commented:
It seems you are a busy person   :-)
Thank you  meikl,  for the time and effort you have put here at EE ! !

you can do whatever seems best to you, I do not really need the points. . . .  I put this fade thing here so it might help somebody. . .

I was really hoping  for some more partisipation, entries,  for this qow
but EE seems so different now to me? ?
0
JaccoCommented:
I agree with Slick812.

I had hoped for some more response too. Maybe the stakes aren't high enough?

It might work with 1 high price and low frequency maybe monthly.

Regards Jacco
0
kretzschmarAuthor Commented:
well, thanks both :-))

>It might work with 1 high price and low frequency maybe monthly.
usually i have not the time to do it weekly, so i will take this suggestion

>I was really hoping  for some more partisipation, entries
i hoped this too, well maybe nexttime i will reask this q again

meikl ;-)
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.