Solved

Dissort Effect With 2 Pictures

Posted on 2000-03-02
25
270 Views
Last Modified: 2010-04-04
I'm searching for a dissort effect (with pixels). I don't want to use a component. Plz post me a function/procedure for that...

Thx a lot
0
Comment
Question by:Snody
  • 12
  • 7
  • 4
  • +2
25 Comments
 
LVL 10

Expert Comment

by:Lischke
ID: 2575760
I recommend that you look at http://www.efg2.com/lab/ for all kinds of image manipulation problems/tasks.

Ciao, Mike
0
 

Author Comment

by:Snody
ID: 2575802
i found there much stuff... but i don't search a blend effect.. i want to use a dissort effect....

thx anyway
0
 
LVL 5

Expert Comment

by:TheNeil
ID: 2575806
Can you define what a dissort effect actually does?

The Neil
0
 

Author Comment

by:Snody
ID: 2575840
It's hard to say in enlish and my english is bad, but I will try it:

A dissort is a special type of a blend effect for two pictures. But it's not as smooth as a normal blend effect... It's a special fade...

In German: Ein Dissort-Effekt ist ein spezieller Typ eines Blend-Effektes. Das bild wird realtiv pixelig und ist nicht so smooth wie bei einem normalen Blend-Effekt.

I nope you know what I mean if not ask me again...

Thx for your interest
0
 
LVL 5

Expert Comment

by:TheNeil
ID: 2575876
Ahhh. I think I know what you mean. If I understand you correctly then you want to merge one picture into another. i.e. Image 1 is on the left edge and it blends into image 2 so that image 2 is on the right edge

Am I close? If so then I can help you with this problem

The Neil
0
 

Author Comment

by:Snody
ID: 2575883
Yeap that's it... Or from above to below... It would be fine if you can send me an example or/and post code here.

Thx a lot
Greetz
Andy

Email: snody@bluewin.ch
0
 
LVL 1

Expert Comment

by:wmckie
ID: 2575889
Does HarmFade help you?

It can be found at:

http://www.users.uswest.net/~sharman1/

as well as a blend effect between two pictures it also does a dissolve.

Cheers - Walter McKie
0
 

Author Comment

by:Snody
ID: 2575898
ups.. yeah that's true... I need only the funtion but the harmfade component is really big... can u extract me only the dissolve function/procedure...

to theneil: your solution is very interesting too
0
 
LVL 5

Expert Comment

by:TheNeil
ID: 2575901
Ok, here goes (bear in mind that this uses pixels rather than scanlines but it WILL work either way)

PROCEDURE GetRGB(VAR r, g, b : INTEGER; Colour : LONGINT);
BEGIN
  r := Colour MOD 256;
  g := (Colour DIV 256) MOD 256;
  b := Colour DIV (256 * 256);
END;

....
VAR
  scale : REAL;
  n : LONGINT;
  m : LONGINT;
  r, g, b, r1, g1, b1, r2, g2, b2 : LONGINT;

....
FOR m := 0 TO (Image1.Height - 1)
DO
  FOR n := 0 TO (Image1.Width - 1)
  DO
  BEGIN
    scale := n * (1 / Image1.Width);
    GetRGB(r1, g1, b1, Image1.Canvas.Pixels[n, m]);
    GetRGB(r2, g2, b2, Image2.Canvas.Pixels[n, m]);

    r := ROUND(scale * r1 + (1 - scale) * r2);
    g := ROUND(scale * g1 + (1 - scale) * g2);
    b := ROUND(scale * b1 + (1 - scale) * b2);

    IF r > 255 THEN r := 255;
    IF g > 255 THEN g := 255;
    IF b > 255 THEN b := 255;
    IF r < 0 THEN r := 0;
    IF g < 0 THEN g := 0;
    IF b < 0 THEN b := 0;

    Image3.Canvas.Pixels[n, m] := RGB(r, g, b);
  END;

This will do a merge from left to right but to do the merge vertically, just update how the scale is calculated to this

scale := m * (1 / Image1.Height);

You can also move this out of the inner loop to save a few precious ticks of the processor

The Neil
0
 

Author Comment

by:Snody
ID: 2575932
thx for your code... it looks really kewl but it isn't what i want.. sorry I though you meaned another thing... I need something like the dissolve function of harmfade... I don't wan't 2 use components... can u help me?
0
 

Author Comment

by:Snody
ID: 2575975
it's ok i use the harmfade component...  it's to complicated to create all those settings self... if you've got an ez solution, TheNeil, post it... Else i'l give you the points in 2h
0
 
LVL 5

Expert Comment

by:TheNeil
ID: 2575990
What does the harmfade component do that my code doesn't? Iy could be possible to code it (I have all sorts of routines up my sleeve). If not then no problem

The Neil
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!

 

Author Comment

by:Snody
ID: 2576002
Your component only does a fade... I need a dissolve effect... Can u do that?

0
 
LVL 5

Expert Comment

by:TheNeil
ID: 2576018
Can you define the dissolve effect? Do you mean fade the image out?

The Neil
0
 

Author Comment

by:Snody
ID: 2576061
it's to hard to describe... take a look @ the harm fade component....

or:

a few pixels (of the imager) changes to the target pixels then more and more...
0
 
LVL 6

Expert Comment

by:Jaymol
ID: 2576081
Neil - The dissolve on HarmFade swaps one image for another, pixel by pixel, as opposed to fading the pixels all at the same time.  Get it?

John.
0
 
LVL 10

Accepted Solution

by:
Lischke earned 50 total points
ID: 2576092
Dissolve? Warum hast du das nicht gleich gesagt?

Look here:

procedure DissolveBMP(TargetDC: HDC; XPos,YPos: Integer; BMP: TBitmap);
const  { Filterbits zur Paritätsprüfung }
  BIT0  = $1; BIT2  = $4; BIT15 = $8000; BIT16 = $10000;
  SEQ = $20000;  { Bit 17 }
  TimeOut = 400;  { Minimalzeit (mSec) fürs Dissolve }
  TimeSteps = 40;  { jeweils nach 1/20 der Operation: Delay }
var
  RandVal, RandMax: LongInt;  { erzeugte Zahl, gewünschter Maximalwert }
  pX,pY: Integer;  { zu ersetzender Punkt (RandVal mod/div PWidth) }
  SEQ1: LongInt;
  STime: Cardinal;
  PixelCounter: Word;  { Runterzähler. Init: Pixelzahl div TimeSteps }
  MemDC: HDC; OldMemBMP: HBitmap; BMWidth: Integer;
begin
  MemDC := CreateCompatibleDC(TargetDC);
  OldMemBMP := SelectObject(MemDC,BMP.Handle);

  STime := timeGetTime+TimeOut div TimeSteps;
  { Pseudo-Zufallszahlengenerator, liefert jeden Wert im gewünschten
    Bereich exakt einmal }
  RandVal := SEQ-1; SEQ1 := SEQ-1;
  { Maximaler "Zufalls"wert ist Bitmap-Größe }
  BMWidth := BMP.Width; RandMax := LongInt(BMWidth) * BMP.Height;
  PixelCounter := RandMax div TimeSteps;

  while (True) do
  begin
(*  Logik des asm-Teils:
    repeat
      { a) Parität der vier Filterbits }
      ParCnt := 0;
      if RandVal and BIT0 <> 0 then Inc(ParCnt);
      if RandVal and BIT2 <> 0 then Inc(ParCnt);
      if RandVal and BIT15 <> 0 then Inc(ParCnt);
      if RandVal and BIT16 <> 0 then Inc(ParCnt);

      { b ) Linksschieben und bei Odd(Filterbits) eine 1 einfüllen }
      RandVal := ((RandVal shl 1) OR (ParCnt AND $01)) AND (SEQ-1);
    until (RandVal < RandMax) or (RandVal = SEQ1);
*)
{$IFNDEF WIN32}
    asm
      db $66; mov cx, Word Ptr [SEQ1]  { Endwert/Oberkante }
      db $66; mov dx, Word Ptr [RandMax]
      db $66; mov ax, Word Ptr [RandVal]
    @@1:
      db $66; mov bx,ax
      { AND $00018005, d.h. B16, B15, B2 und B0 stehenlassen und dann
        Paritätsprüfung. PF nur für die untersten 8 Bit einer Operation }
      db $66; and ax, $8005; db $01, $00;  { and eax, $00018005 (Mask) }
      xchg al,ah;  { $8005 -> $0580, das B0 ist immer 0 }
      db $66; shr ax,1 { 1|0000 0101|1000 0000 (EAX) -> 1000 0010|1000 0000 (AX) }
      shr al,1  { 1000 0000 -> 0100 0000, Platz fürs MSB }
      or al,ah  { MSB und B1 aus AH dazu }
      jpe @@2
      stc                      { Odd Parity -> 1-Bit einschieben }
    @@2:
      db $66; mov ax,bx
      db $66; rcl ax,1
      db $66; and ax,cx                { Oberkante }
      db $66; cmp ax,cx
      jz @@Done
      db $66; cmp ax,dx                { größer RandMax? }
      jae @@1                          { ja -> gleich nächster Wert }
    @@Done:   { Wert gefunden oder Generator durchgelaufen }
      db $66; mov Word Ptr [RandVal],ax
    end;
{$ELSE}  { den ganzen Käse nochmal, aber ohne die Präfixe }
   asm
      push eax; push ebx; push ecx; push edx;  // teilweise sind das lokale Variablen
      mov ecx, [SEQ1]; mov edx, [RandMax]; mov eax, [RandVal]
    @@1:
      mov ebx,eax; and eax,$18005;
      xchg al,ah;  { $8005 -> $0580, das B0 ist immer 0 }
      shr eax,1 { 1|0000 0101|1000 0000 (EAX) -> 1000 0010|1000 0000 (AX) }
      shr al,1  { 1000 0000 -> 0100 0000, Platz fürs MSB }
      or al,ah  { MSB und B1 aus AH dazu }
      jpe @@2
      stc                      { Odd Parity -> 1-Bit einschieben }
    @@2:
      mov eax,ebx; rcl eax,1
      and eax,ecx                { Oberkante }
      cmp eax,ecx
      jz @@Done
      cmp eax,edx                { größer RandMax? }
      jae @@1                          { ja -> gleich nächster Wert }
    @@Done:   { Wert gefunden oder Generator durchgelaufen }
      mov [RandVal],eax
      pop edx; pop ecx; pop ebx; pop eax;
   end;
{$ENDIF}
    if RandVal = SEQ-1 then Break; { Durchlauf komplett }

    { Zufallswert in Bitmap-Koordinaten umrechnen und auf den Bildschirm }
    pY := RandVal div BMWidth; pX := RandVal mod BMWidth;
    BitBlt(TargetDC, XPos+pX,YPos+pY, 1, 1, MemDC, pX, pY, SRCCOPY);

    { 13-OCT-98: Für Bitmaps mit mehr als 128K }
    if RandMax >= SEQ then
    begin
      pY := (RandVal + SEQ) div BMWidth; pX := (RandVal+SEQ) mod BMWidth;
      BitBlt(TargetDC, XPos+pX,YPos+pY, 1, 1, MemDC, pX, pY, SRCCOPY);
    end;

    Dec(PixelCounter);
    if PixelCounter = 0 then  { ein TimeStep abgelaufen }
    begin
      while timeGetTime < STime do  { falls die Kiste es zu eilig hat: }
        ;                           { Verschnaufpause einlegen }
      STime := timeGetTime+TimeOut div TimeSteps;
      PixelCounter := RandMax div TimeSteps;
    end;
  end; { while }

  BitBlt(TargetDC, XPos,YPos, 1, 1, MemDC, 0, 0, SRCCOPY);  { 0,0 nicht im Generator }
  SelectObject(MemDC,OldMemBMP); DeleteDC(MemDC);
end;

Sorry, the code is quite old (from 1995 actually) so there's the 16 bit part included.

Ciao, Mike
0
 
LVL 5

Expert Comment

by:TheNeil
ID: 2576127
Ahhh I understand now. Give this a try then (amazingly it seems to work)

  FOR m := 0 TO (Image1.Height - 1)
  DO
  BEGIN
    Error := 1 + (Random(10) / 10);
    FOR n := 0 TO (Image1.Width - 1)
    DO
    BEGIN
      Error := Error + ((Image1.Width - n) / Image1.Width) * (Random(2) + 1);
      IF Error > 1
      THEN
      BEGIN
        Error := Error - Trunc(Error);
        Image3.Canvas.Pixels[n, m] := Image1.Canvas.Pixels[n, m];
      END
      ELSE
        Image3.Canvas.Pixels[n, m] := Image2.Canvas.Pixels[n, m];
    END;
  END;

The Neil
0
 

Author Comment

by:Snody
ID: 2576429
but the program should have settings... your function does it as fast as possible...
0
 
LVL 5

Expert Comment

by:TheNeil
ID: 2576453
What sort of settings?

The Neil
0
 

Author Comment

by:Snody
ID: 2576602
timeout, timesteps... see asm sample above
0
 
LVL 10

Expert Comment

by:Lischke
ID: 2576667
If I'm not totally wrong then I think The Neil's code is not what you actually want. It paints two pictures on a third where the left "half" (it's kind of dithered all the way down) is covered by picture one and the right "half" by picture two.

My code dynamically replaces whatever is on the target DC with the content of the given bitmap, whereas pixels are drawn in a random fashion. The result is that the given bitmap is shown the same way as it would when just drawing it.

Ciao, Mike
0
 

Author Comment

by:Snody
ID: 2576693
To Lischke:

You're code does the same thing as the Harmfade Component?... Can I use it with JPG Images too? When I've to convert the JPG 2 BMP what's the best way?
0
 
LVL 10

Expert Comment

by:Lischke
ID: 2576808
1) I have not completely tried it because I would have to install the components (what I don't want), but from what I saw in the sources I think it is the same.

2) Yes of course, but you need to convert it into a BMP.

3) TBitmap.Assign(TJPEGImage);

Ciao, Mike
0
 

Author Comment

by:Snody
ID: 2583427
I don't used this, because the Harmfade-Component gives more possibilities.... I think it's very usefull
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
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 discusses moving either the default database or any database to a new volume.

760 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

20 Experts available now in Live!

Get 1:1 Help Now