Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

qow 21 : Fading/Blending effects of Pictures

Posted on 2004-03-25
11
Medium Priority
?
1,576 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
  • 3
11 Comments
 
LVL 10

Accepted Solution

by:
Jacco earned 1000 total points
ID: 10681837
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
ID: 10685598
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
ID: 10685708
thanks jacco,

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

meikl ;-)
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 34

Expert Comment

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

Author Comment

by:kretzschmar
ID: 10729819
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
 
LVL 34

Assisted Solution

by:Slick812
Slick812 earned 1000 total points
ID: 10735443
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
ID: 10756357
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
ID: 10857465
if you both agree,
i would spent 250 pts each.

meikl ;-)
0
 
LVL 34

Expert Comment

by:Slick812
ID: 10862547
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
ID: 10864191
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
ID: 10867031
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

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
In response to a need for security and privacy, and to continue fostering an environment members can turn to for support, solutions, and education, Experts Exchange has created anonymous question capabilities. This new feature is available to our Pr…
Is your data getting by on basic protection measures? In today’s climate of debilitating malware and ransomware—like WannaCry—that may not be enough. You need to establish more than basics, like a recovery plan that protects both data and endpoints.…
Suggested Courses

610 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