Форум: "Игры";
Текущий архив: 2003.11.03;
Скачать: [xml.tar.bz2];

Вниз

DelphiX - FadeIn/FadeOut   Найти похожие ветки 

← →
greenrul   (2003-04-19 11:31) [0]

Как сделать затемнение/осветление экрана? Чтоб эффектно перейти с одного меню на другое?

Пробовал пример delphix/Samples/Graphic/PalleteAnimation, вставил в код следующие процедуры:
MainForm.OnCreate:
DxImageList1.Items.MakeColorTable;
DXDraw1.DefColorTable := DXImageList1.Items.ColorTable;
DXDraw1.ColorTable := DXImageList1.Items.ColorTable;

function ComposeColor(Dest, Src: TRGBQuad; Percent: Integer): TRGBQuad;
begin
with Result do
begin
rgbRed := Src.rgbRed+((Dest.rgbRed-Src.rgbRed)*Percent div 256);
rgbGreen := Src.rgbGreen+((Dest.rgbGreen-Src.rgbGreen)*Percent div 256);
rgbBlue := Src.rgbBlue+((Dest.rgbBlue-Src.rgbBlue)*Percent div 256);
rgbReserved := 0;
end;
end;

procedure FadeOut(Time: Integer; Col: Integer);
var
t: DWORD;
i, p, o: Integer;
begin
if not MainForm.DXDraw1.CanDraw then Exit;
if not MainForm.DXDraw1.CanPaletteAnimation then Exit;
t := GetTickCount;
o := 0;
while Abs(GetTickCount-t)<Time do
begin
p := Min(Max(Abs(GetTickCount-t)*255 div Time, 0), 255);
if p<>o then
begin
o := p;
for i:=0 to 255 do
MainForm.DXDraw1.ColorTable[i] := ComposeColor(RGBQuad(GetRValue(Col), GetGValue(Col), GetBValue(Col)),
MainForm.DXDraw1.DefColorTable[i], p);
MainForm.DXDraw1.UpdatePalette;
end;
end;
end;

procedure FadeIn(Time: Integer; Col: Integer);
var
t: DWORD;
i, p, o: Integer;
begin
if not MainForm.DXDraw1.CanDraw then Exit;
if not MainForm.DXDraw1.CanPaletteAnimation then Exit;
t := GetTickCount;
o := 0;
while Abs(GetTickCount-t)<Time do
begin
p := 255-Min(Max(Abs(GetTickCount-t)*255 div Time, 0), 255);
if p<>o then
begin
o := p;
for i:=0 to 255 do
MainForm.DXDraw1.ColorTable[i] := ComposeColor(RGBQuad(GetRValue(Col), GetGValue(Col), GetBValue(Col)),
MainForm.DXDraw1.DefColorTable[i], p);
MainForm.DXDraw1.UpdatePalette;
( 500, RGB(0, 0, 0) Как сделать затемнение/осветление экрана? Чтоб эффектно перейти с одного меню на другое?

Пробовал пример delphix/Samples/Graphic/PalleteAnimation, вставил в код следующие процедуры:
MainForm.OnCreate:
DxImageList1.Items.MakeColorTable;
DXDraw1.DefColorTable := DXImageList1.Items.ColorTable;
DXDraw1.ColorTable := DXImageList1.Items.ColorTable;

function ComposeColor(Dest, Src: TRGBQuad; Percent: Integer): TRGBQuad;
begin
with Result do
begin
rgbRed := Src.rgbRed+((Dest.rgbRed-Src.rgbRed)*Percent div 256);
rgbGreen := Src.rgbGreen+((Dest.rgbGreen-Src.rgbGreen)*Percent div 256);
rgbBlue := Src.rgbBlue+((Dest.rgbBlue-Src.rgbBlue)*Percent div 256);
rgbReserved := 0;
end;
end;

procedure FadeOut(Time: Integer; Col: Integer);
var
t: DWORD;
i, p, o: Integer;
begin
if not MainForm.DXDraw1.CanDraw then Exit;
if not MainForm.DXDraw1.CanPaletteAnimation then Exit;
t := GetTickCount;
o := 0;
while Abs(GetTickCount-t)<Time do
begin
p := Min(Max(Abs(GetTickCount-t)*255 div Time, 0), 255);
if p<>o then
begin
o := p;
for i:=0 to 255 do
MainForm.DXDraw1.ColorTable[i] := ComposeColor(RGBQuad(GetRValue(Col), GetGValue(Col), GetBValue(Col)),
MainForm.DXDraw1.DefColorTable[i], p);
MainForm.DXDraw1.UpdatePalette;
end;
end;
end;

procedure FadeIn(Time: Integer; Col: Integer);
var
t: DWORD;
i, p, o: Integer;
begin
if not MainForm.DXDraw1.CanDraw then Exit;
if not MainForm.DXDraw1.CanPaletteAnimation then Exit;
t := GetTickCount;
o := 0;
while Abs(GetTickCount-t)<Time do
begin
p := 255-Min(Max(Abs(GetTickCount-t)*255 div Time, 0), 255);
if p<>o then
begin
o := p;
for i:=0 to 255 do
MainForm.DXDraw1.ColorTable[i] := ComposeColor(RGBQuad(GetRValue(Col), GetGValue(Col), GetBValue(Col)),
MainForm.DXDraw1.DefColorTable[i], p);
MainForm.DXDraw1.UpdatePalette;
end;
end;
end;

Но не помогло - вызываю FadeOut(500, RGB(0, 0, 0)), но все равно экран не "осветляется". Где я допустил ошибку? Или есть альтернативные способы?

---

← →
TButton   (2003-04-19 20:34) [1]

есть альтернативный способ - меняй гамма коррекцию...

---

← →
greenrul   (2003-04-19 23:01) [2]

А можно примерчик?

---

← →
greenrul   (2003-04-20 13:09) [3]

help please

---

← →
Sword-Fish   (2003-04-21 09:22) [4]

Сделай вот так !!!
Здесь используется 256 цветов а тебе надо 16 бит ...

unit DX_Special;
// Специальный модуль для эффектов !!!
interface
Uses DirectX, Windows, Forms;
// Затухание
procedure FadeOut(FDDSPrimary : IDirectDrawSurface7; Time : integer; Mode : boolean);
// Зажигание
procedure FadeIn(FDDSPrimary : IDirectDrawSurface7; Time : integer);
implementation

var
Gamma : IDirectDrawGammaControl;
NewGamma,OldGamma : TDDGammaRamp;

procedure FadeOut(FDDSPrimary : IDirectDrawSurface7; Time : integer; Mode : boolean);
var
i,j : integer;
begin
FDDSPrimary.QueryInterface(IID_IDirectDrawGammaControl,Gamma);//Получаем интерфейс
Gamma.GetGammaRamp(0,OldGamma);//Сораняем старое
Gamma.GetGammaRamp(0,NewGamma);//И новое - надо!
//Гасим экран за 100 циклов.
for j := 100 downto 1 do
begin
//Получаем новые значения
for i :=0 to 255 do
begin
NewGamma.red[i] := (OldGamma.red[i] *j)div 100;
NewGamma.green[i] := (OldGamma.green[i]*j)div 100;
NewGamma.blue[i] := (OldGamma.blue[i] *j)div 100;
end;
Gamma.SetGammaRamp(0,NewGamma);//Применяем новые значения
Sleep(Time) //Немного ждем и далле по циклу
end;

if Mode=true then
Gamma.SetGammaRamp(0,oldGamma);//Возвращаем старые значения(если надо)
Gamma := nil //Уничтожаем интерфейс

end;

procedure FadeIn(FDDSPrimary : IDirectDrawSurface7; Time : integer);
var
i,j : integer;
begin
FDDSPrimary.QueryInterface(IID_IDirectDrawGammaControl,Gamma);//Получаем интерфейс
Gamma.GetGammaRamp(0,NewGamma);//И новое - надо!
//Зажигаем экран за 100 циклов.
for j := 1 to 100 do
begin
//Получаем новые значения
for i :=0 to 255 do
begin
NewGamma.red[i] := (OldGamma.red[i] *j)div 100;
NewGamma.green[i] := (OldGamma.green[i]*j)div 100;
NewGamma.blue[i] := (OldGamma.blue[i] *j)div 100;
end;
Gamma.SetGammaRamp(0,NewGamma);//Применяем новые значения
( Time) Сделай вот так !!!
Здесь используется 256 цветов а тебе надо 16 бит ...

unit DX_Special;
// Специальный модуль для эффектов !!!
interface
Uses DirectX, Windows, Forms;
// Затухание
procedure FadeOut(FDDSPrimary : IDirectDrawSurface7; Time : integer; Mode : boolean);
// Зажигание
procedure FadeIn(FDDSPrimary : IDirectDrawSurface7; Time : integer);
implementation

var
Gamma : IDirectDrawGammaControl;
NewGamma,OldGamma : TDDGammaRamp;

procedure FadeOut(FDDSPrimary : IDirectDrawSurface7; Time : integer; Mode : boolean);
var
i,j : integer;
begin
FDDSPrimary.QueryInterface(IID_IDirectDrawGammaControl,Gamma);//Получаем интерфейс
Gamma.GetGammaRamp(0,OldGamma);//Сораняем старое
Gamma.GetGammaRamp(0,NewGamma);//И новое - надо!
//Гасим экран за 100 циклов.
for j := 100 downto 1 do
begin
//Получаем новые значения
for i :=0 to 255 do
begin
NewGamma.red[i] := (OldGamma.red[i] *j)div 100;
NewGamma.green[i] := (OldGamma.green[i]*j)div 100;
NewGamma.blue[i] := (OldGamma.blue[i] *j)div 100;
end;
Gamma.SetGammaRamp(0,NewGamma);//Применяем новые значения
Sleep(Time) //Немного ждем и далле по циклу
end;

if Mode=true then
Gamma.SetGammaRamp(0,oldGamma);//Возвращаем старые значения(если надо)
Gamma := nil //Уничтожаем интерфейс

end;

procedure FadeIn(FDDSPrimary : IDirectDrawSurface7; Time : integer);
var
i,j : integer;
begin
FDDSPrimary.QueryInterface(IID_IDirectDrawGammaControl,Gamma);//Получаем интерфейс
Gamma.GetGammaRamp(0,NewGamma);//И новое - надо!
//Зажигаем экран за 100 циклов.
for j := 1 to 100 do
begin
//Получаем новые значения
for i :=0 to 255 do
begin
NewGamma.red[i] := (OldGamma.red[i] *j)div 100;
NewGamma.green[i] := (OldGamma.green[i]*j)div 100;
NewGamma.blue[i] := (OldGamma.blue[i] *j)div 100;
end;
Gamma.SetGammaRamp(0,NewGamma);//Применяем новые значения
Sleep(Time) //Немного ждем и далле по циклу
end;

Gamma := nil //Уничтожаем интерфейс

end;

end.

---

← →
greenrul   (2003-04-26 20:52) [5]

а для DelphiX?

---

← →
mad   (2003-04-29 10:54) [6]

...выкинь DelphiX, пиши на асме :-(((

unit DDFade;

uses DirectDraw;

interface

procedure FadeIn (Target:IDirectDrawSurface7; Step:Byte

implementation

procedure FadeIn (Target:IDirectDrawSurface7; Step:Byte);
//Fade - эффект в режиме 32bpp с ускорением MMX
var Desc:TDDSurfaceDesc2;
ReAddress:Integer;
Mask:Cardinal;
begin
Step:=Lo (Step);
Mask:=Step+Step shl 8+Step shl 16;
Target.Lock (nil,Desc,nil);
ReAddress:=Desc.lPitch-Desc.Width*4;
asm
push edi
mov edi,Desc.lpSurface
mov ecx,Desc.dwHeight
movd mm1,Mask
@Line: push ecx
mov ecx,Desc.dwWidth
@Pixel: movd mm0,[edi]
subusb mm0,mm1 ( nil) ...выкинь DelphiX, пиши на асме :-(((

unit DDFade;

uses DirectDraw;

interface

procedure FadeIn (Target:IDirectDrawSurface7; Step:Byte

implementation

procedure FadeIn (Target:IDirectDrawSurface7; Step:Byte);
//Fade - эффект в режиме 32bpp с ускорением MMX
var Desc:TDDSurfaceDesc2;
ReAddress:Integer;
Mask:Cardinal;
begin
Step:=Lo (Step);
Mask:=Step+Step shl 8+Step shl 16;
Target.Lock (nil,Desc,nil);
ReAddress:=Desc.lPitch-Desc.Width*4;
asm
push edi
mov edi,Desc.lpSurface
mov ecx,Desc.dwHeight
movd mm1,Mask
@Line: push ecx
mov ecx,Desc.dwWidth
@Pixel: movd mm0,[edi]
subusb mm0,mm1 //addusb mm0,mm1 для FadeOut
movd eax,mm0
stosd
loop @Pixel

pop ecx
add edi,ReAddress
loop @Line

emms
pop edi
end;

Target.UnLock (nil);

end;

end.

---

← →
Карлсон   (2003-04-29 16:09) [7]

>subusb mm0,mm1 ( 30) >subusb mm0,mm1 //addusb mm0,mm1 для FadeOut
не работает.
[Error] DDFade.pas(30): Undeclared identifier: "addusb"

---

Страницы: 1 вся ветка

Форум: "Игры";
Текущий архив: 2003.11.03;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.008 c