| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
DelphiX - ;FadeIn/FadeOut
greenrul © (2003-04-19 11:31:00)Как сделать затемнение/осветление экрана? Чтоб эффектно перейти с одного меню на другое?
Пробовал пример 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)), но все равно экран не "осветляется". Где я допустил ошибку? Или есть альтернативные способы?
Карлсон (2003-04-29 16:09:00) [1]>subusb mm0,mm1 ( 30)
>subusb mm0,mm1 //addusb mm0,mm1 для FadeOut
не работает.
[Error] DDFade.pas(30): Undeclared identifier: "addusb"
mad (2003-04-29 10:54:00) [2]...выкинь 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.
greenrul (2003-04-26 20:52:00) [3]
а для DelphiX?
Sword-Fish (2003-04-21 09:22:00) [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-20 13:09:00) [5]
help please
greenrul (2003-04-19 23:01:00) [6]
А можно примерчик?
TButton (2003-04-19 20:34:00) [7]
есть альтернативный способ - меняй гамма коррекцию...
| |
