Плавный переход одного изображения в другое

Скачать в архиве (ZIP;317Kb);

- DEMO.DESIGN (2:5032/7.32) -------------- DEMO.DESIGN -
Msg : 1 из 59 Scn
From : Lubarsky Oleg V. 2:5020/400 Срд 16 Июн 99 12:46
To : All Чтв 17 Июн 99 00:46
Subj : Re: Плавный переход одного изображения в другое.
--------------------------------------------------------
From: "Lubarsky Oleg V." <drlove@impuls.zhitomir.ua>
AlexMc пишет в сообщении <929442601@p122.f98.n5055.z2.ftn> ...
А> В демах, (особенно на AMIGA) часто используется сабж.
А> Пpичем эффект такой: одно изобpажение постепенно гаснет,
А> а дpугое пpоявляется. Как сделать?
Вариант 1:
Линейно интерполировать каждую компоненту (R1,G1,B1) цвета пиксела,
одного изображения, в соответстующие ему (R2,G2,B2) другого изображения,
результат и тыкать на экран:
R = R1 + k*(R2 - R1);
G = G1 + k*(G2 - G1);
B = B1 + k*(B2 - B1);
0 <= k <= 1
Вариант 2:
Рисовать вторую картинку поверх второй с использованием альфа-канала,
постепенно уменьшая прозрачность второго изображения.
Что в принципе одно и тоже :)
Bye!
Best regards, respectfully yours <Dr.L0V>...
--- ifmail v.2.14dev3
* Origin: Unknown (2:5020/400)

Download this code: twopic.txt

Угораздило меня прочитать это сообщение….ну не мог же я его оставить без внимания. Родилось вот это (TMTPAS):

twopic.pas

program BLUR;
uses Crt,mVBE;
var Scr,Scr2 :Array[0..192000] of Byte; {Виртуальный видео-буффер}
F :File;
RSize,X :DWord;
Procedure Print2Buf(K:Word); {Копирование виртуального видео-буфера в реальный}
var I,S:DWord;
Begin
{ R=R1+k*(R2-R1); }
{ G=G1+k*(G2-G1); }
{ B=B1+k*(B2-B1); }
{ 0<=k<=1 }
For I:=1 to 192000 do
mem[VBE_VideoMem+I]:=Scr[I]+round(((Scr2[I]-Scr[I])*K) shr 8);
End;
Begin
{Инициалтзация 320x200x24}
mVESAInit;If VesaError<>0 then mVesaErrorMessage;
mInitVESAMode($410F);If VesaError<>0 then mVesaErrorMessage;
mSetVESAMode($410F);If VesaError<>0 then mVesaErrorMessage;
mSetVMemory;If VesaError<>0 then mVesaErrorMessage;
{Чтение BMP'эхи}
Assign(F,'april.bmp');
Reset(F);
Seek(F,54);
BlockRead(F,Scr,192000,RSize);
Close(F);
{Чтение BMP'эхи}
Assign(F,'february.bmp');
Reset(F);
Seek(F,54);
BlockRead(F,Scr2,192000,RSize);
Close(F);
Print2Buf(1);
ReadKey;
X:=1;
Repeat
Print2Buf(X);
X:=X+1;
Until (Keypressed) or (X>255);
ReadKey;
mSetVGAMode;
WriteLn(' ¦ Coded by Misha Krivij 1999');
End.

Download this code: twopic.pas

mvbe.pas

unit mVBE;
interface
uses DPMILib;
(* VBE info block structure *)
type TVbeInfo = record
VbeSignature : DWord;
VbeVersion : Word;
OemStringPtr : DWord;
Capabilities : DWord;
VideoModePtr : DWord;
TotalMemory : Word;
OEMSoftwareRev : Word;
OEMVendorNamePtr : DWord;
OEMProductNamePtr : DWord;
OEMProductRevPtr : DWord;
Reserved : array [0..221] of Byte;
OEMData : array [0..255] of Byte;
end;
TVbeModeInfo = record
ModeAttributes : Word;
WinAAttributes : Byte;
WinBAttributes : Byte;
WinGranularity : Word;
WinSize : Word;
WinASegment : Word;
WinBSegment : Word;
WinFuncPtr : Pointer;
BytesPerScanLine : Word;
XResolution : Word;
YResolution : Word;
XCharSize : Byte;
YCharSize : Byte;
NumberOfPlanes : Byte;
BitsPerPixel : Byte;
NumberOfBanks : Byte;
MemoryModel : Byte;
BankSize : Byte;
NumberOfImagePages : Byte;
Reserved : Byte;
RedMaskSize : Byte;
RedFieldPosition : Byte;
GreenMaskSize : Byte;
GreenFieldPosition : Byte;
BlueMaskSize : Byte;
BlueFieldPosition : Byte;
RsvdMaskSize : Byte;
RsvdFieldPosition : Byte;
DirectColorModeInfo: Byte;
PhysBasePtr : DWord;
OffScreenMemOffset : DWord;
OffScreenMemSize : Word;
Reserved2 : Array [0..205] of Byte;
end;
var VesaError :Byte;
Regs :TRmRegs;
VESAInfo :TVBEInfo;
VESAModeInfo :TVBEModeInfo;
VideoMem,VBE_VideoMem :DWord;
Procedure mVESAInit;
Procedure mInitVESAMode(Mode:Word);
Procedure mSetVESAMode(Mode:Word);
Procedure mSetVGAMode;
Function mPutVESAMode(X,Y,BPP:Word):Word;
Procedure mVesaErrorMessage;
Procedure mSetVMemory;
implementation
{ Инициализация VESA }
Procedure mVESAInit;
Begin
VesaError:=0;
ClearRmRegs(Regs);
Regs.AX:=$4F00;
Regs.ES:=Buf_16;
RealModeInt($10,Regs);
Move(Pointer(Buf_32)^,VESAInfo,256);
if (Regs.AX<>$004F) or (VESAInfo.VbeSignature<>$41534556) then VesaError=1;
End;
{ Инициализация графического режима VESA }
Procedure mInitVESAMode(Mode:Word);
Begin
VesaError:=0;
ClearRmRegs(Regs);
Regs.ES:=Buf_16;
Regs.ax:=$4F01;
Regs.di:=$0000;
Regs.cx:=Mode;
RealModeInt($10,Regs);
Move(Pointer(Buf_32)^,VESAModeInfo,256);
if (Regs.AX<>$004F) or (VESAModeInfo.PhysBasePtr=0) then VESAError:=2;
End;
{ Установка графического режима VESA }
Procedure mSetVESAMode(Mode:Word);
Begin
VesaError:=0;
ClearRmRegs(Regs);
Regs.AX:=$4F02;
Regs.BX:=Mode;
RealModeInt($10,Regs);
if (Regs.AX<>$004F) then VESAError:=3;
End;
{ Установка стандартного режима EGA }
Procedure mSetVGAMode;
Begin
ClearRmRegs(Regs);
Regs.AX:=$0003;
RealModeInt($10,Regs);
End;
Function mPutVESAMode(X,Y,BPP:Word):Word;
var M:Word;
Begin
For M:=$4100 to $4200 do
Begin
mInitVESAMode(M);
If (VesaModeInfo.XResolution=X) and
(VesaModeInfo.YResolution=Y) and
(VesaModeInfo.BitsPerPixel=BPP) and
(VesaError=0) then mPutVESAMode:=M;
End;
End;
{ Вывод сообщения об ошибке }
Procedure mVesaErrorMessage;
Begin
mSetVGAMode;
WriteLn('VesaError:',VesaError);
Halt(1);
End;
{ Узнаем логический адресс }
Procedure mSetVMemory;
var Tmp1,Tmp2 :Word;
Begin
Vbe_VideoMem:=MapPhysicalToLinear(VESAModeInfo.PhysBasePtr,4096*1024);
If Vbe_VideoMem=0 then VESAError=4;
VideoMem:=Vbe_VideoMem;
End;
end.

Download this code: mvbe.pas

Плавный переход одного изображения в другое

Плавный переход одного изображения в другое

Плавный переход одного изображения в другое

twopic.pas

mvbe.pas

Подписаться

Комментарии