• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 282
  • Last Modified:

Dissort Effect With 2 Pictures

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
Snody
Asked:
Snody
  • 12
  • 7
  • 4
  • +2
1 Solution
 
LischkeCommented:
I recommend that you look at http://www.efg2.com/lab/ for all kinds of image manipulation problems/tasks.

Ciao, Mike
0
 
SnodyAuthor Commented:
i found there much stuff... but i don't search a blend effect.. i want to use a dissort effect....

thx anyway
0
 
TheNeilCommented:
Can you define what a dissort effect actually does?

The Neil
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
SnodyAuthor Commented:
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
 
TheNeilCommented:
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
 
SnodyAuthor Commented:
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
 
wmckieCommented:
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
 
SnodyAuthor Commented:
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
 
TheNeilCommented:
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
 
SnodyAuthor Commented:
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
 
SnodyAuthor Commented:
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
 
TheNeilCommented:
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
 
SnodyAuthor Commented:
Your component only does a fade... I need a dissolve effect... Can u do that?

0
 
TheNeilCommented:
Can you define the dissolve effect? Do you mean fade the image out?

The Neil
0
 
SnodyAuthor Commented:
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
 
JaymolCommented:
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
 
LischkeCommented:
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
 
TheNeilCommented:
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
 
SnodyAuthor Commented:
but the program should have settings... your function does it as fast as possible...
0
 
TheNeilCommented:
What sort of settings?

The Neil
0
 
SnodyAuthor Commented:
timeout, timesteps... see asm sample above
0
 
LischkeCommented:
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
 
SnodyAuthor Commented:
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
 
LischkeCommented:
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
 
SnodyAuthor Commented:
I don't used this, because the Harmfade-Component gives more possibilities.... I think it's very usefull
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 12
  • 7
  • 4
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now