Solved

qow 21 : Fading/Blending effects of Pictures

Posted on 2004-03-25
11
1,550 Views
Last Modified: 2010-04-05
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 ;-)

0
Comment
Question by:kretzschmar
  • 5
  • 3
  • 3
11 Comments
 
LVL 10

Accepted Solution

by:
Jacco earned 250 total points
Comment Utility
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
 
LVL 10

Expert Comment

by:Jacco
Comment Utility
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
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
thanks jacco,

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

meikl ;-)
0
 
LVL 33

Expert Comment

by:Slick812
Comment Utility
I thought there would be more entries for this. . . . you still looking for some blenders?
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
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
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 33

Assisted Solution

by:Slick812
Slick812 earned 250 total points
Comment Utility
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
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
sorry,
got no time for evaluation yet,
i will keep it open until next weekend.

be patient

meikl ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
if you both agree,
i would spent 250 pts each.

meikl ;-)
0
 
LVL 33

Expert Comment

by:Slick812
Comment Utility
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
 
LVL 10

Expert Comment

by:Jacco
Comment Utility
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
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
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

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now