| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
UpdateLayerWindow [XP]
Nightmare © (2007-11-16 20:05:00)Здравствуйте, я использую в своей программе для вывода интерфейса ULW и возникла такая проблема, как только в таймере начинает работать ULW и курсор не находится в области формы, то загрузка процессора составляет 0%, а как только я навожу курсор на форму то загрузка процессора увеличивается до 50%, хотя ничего по сути не меняется и обновление происходит точно также.
Может кто нибудь знает как это убрать?
P.S. для работы потребуется GDI+, и img я брал размером 1024Х768
var
pt1, pt2: TPoint;
sz: TSize;
bf: TBlendFunction;
DC: HDC;
Bmp: TBitmap;
procedure TFrm.FormCreate(Sender: TObject);
begin
Timer1.enabled:=False;
end;
procedure TFrm.Button1Click(Sender: TObject);
var
H: HBitmap;
Bitmap: TGPBitmap;
begin
Bitmap:=TGPBitmap.Create('Img.png');
Bmp:=TBitmap.Create;
Bitmap.GetHBITMAP(0,H);
Bmp.Handle:=H;
Timer1.Enabled:=true;
end;
procedure TFrm.Timer1Timer(Sender: TObject);
begin
if SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or
WS_EX_LAYERED) = 0 then ShowMessage(SysErrorMessage(GetLastError));
Width:=bmp.Width;
Height:=bmp.Height;
DC := GetDC(0);
sz.cx := Width;
sz.cy := Height;
pt1 := Point(Left, Top);
pt2 := Point(0,0);
with bf do begin
BlendOp := AC_SRC_OVER;
BlendFlags := 0;
SourceConstantAlpha := 255;
AlphaFormat := AC_SRC_ALPHA;
end;
UpdateLayeredWindow(Handle, DC, @pt1, @sz, bmp.Canvas.Handle, @pt2, 0, @bf, ULW_ALPHA);
ReleaseDC(0,DC);
end;
Nightmare (2007-11-17 20:39:00) [1]Ну а по сути то что можно сказать, как избежать этого глюка?
antonn (2007-11-17 19:55:00) [2]да, например бесконечный прерываемый цикл :)
Nightmare (2007-11-17 19:16:00) [3]а что??? есть другие более удобные варианты???
Anatoly Podgoretsky (2007-11-17 19:07:00) [4]> Nightmare (17.11.2007 19:04:47) [47]
Кто же делает анимацию с помощью TTimer
Nightmare (2007-11-17 19:04:00) [5]И согласитесь 4 кадра в секунду это не анимация.
Nightmare (2007-11-17 18:56:00) [6]да 250-500 конечно поменьше ест, но факт остаётся фактом, различие между мышкой на форме и вне формы есть.
antonn (2007-11-17 18:53:00) [7]не более 30 - это от 0 до 30?? :))) и это нормальное состояние работы? попробуй поставить 250-500.
Nightmare (2007-11-17 18:52:00) [8]да ставь любой не более 30мс.
antonn (2007-11-17 18:50:00) [9]а в обысном состоянии какой должен быть интервал?
Nightmare (2007-11-17 18:48:00) [10]Я думал что там что-то серьёзнее
P.S. все битмапы должны быть 1024* 768 и такой интервал сделан для того чтобы по нагрузить систему, что было видно различие меду мышкой на форме, и вне формы.
antonn (2007-11-17 18:47:00) [11]
> ну это естественно, но суть не в таймере.
т.е. ты понимаешь, что поставил таймер на теоретические 1мс??
Nightmare (2007-11-17 18:41:00) [12]ну это естественно, но суть не в таймере.
Anatoly Podgoretsky (2007-11-17 18:41:00) [13]> Nightmare (17.11.2007 18:41:39) [39]
Зачем же тогда спрашиваешь?
Anatoly Podgoretsky (2007-11-17 18:38:00) [14]Если повезет, то в лучшем случае раз в 10 мс, для платформы НТ
Nightmare (2007-11-17 18:35:00) [15]а как он будет работать?
Anatoly Podgoretsky (2007-11-17 18:29:00) [16]> antonn (17.11.2007 18:24:35) [35]
Это интервал, работать будет, но не так как думает автор
antonn (2007-11-17 18:24:00) [17]
> Timer1.Interval:=1;
это чего такое? %)
Nightmare (2007-11-17 18:22:00) [18]Ну свой исходник я выложить не смогу т.к. в нём много компонентов и кода, я доработал твой пример.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ImageMain: TImage;
ImageMask: TImage;
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var bmp,bmp2:TBitmap;
begin
bmp:=TBitmap.Create;
bmp2:=TBitmap.Create;
bmp.LoadFromFile('fon.bmp');
bmp2.LoadFromFile('mask.bmp');
Bmp.PixelFormat:=pf24bit;
Bmp2.PixelFormat:=pf24bit;
FormSplash.Show;
FormSplash.BuildCopy24to32( bmp,Bmp2, FormSplash.bt );
Timer1.Enabled:=true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Enabled:=False;
Timer1.Interval:=1;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FormSplash.RenderForm;
end;
end.
{---------------------------------------------------------------------------------}
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TFormSplash = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
protected
procedure WMWINDOWPOSCHANGING(var Msg: TWMWINDOWPOSCHANGING); message WM_WINDOWPOSCHANGING;
public
BT:Tbitmap;
procedure RenderForm;
procedure BuildCopy24to32(_B_in,_B_mask:TBitmap; var _B_out: TBitmap);
end;
var
FormSplash: TFormSplash;
DC:HDC;
implementation
{$R *.dfm}
procedure TFormSplash.FormCreate(Sender: TObject);
begin
BT:=Tbitmap.Create;
BT.PixelFormat:=pf32bit;
end;
procedure TFormSplash.BuildCopy24to32(_B_in,_B_mask:TBitmap; var _B_out: TBitmap);
const
MaxPixelCountA = MaxInt div SizeOf(TRGBQuad);
MaxPixelCount = MaxInt div SizeOf(TRGBTriple);
type
PRGBArray = ^TRGBArray;
TRGBArray = array[0..MaxPixelCount-1] of TRGBTriple;
PRGBAArray = ^TRGBAArray;
TRGBAArray = array[0..MaxPixelCountA-1] of TRGBQuad;
var x, y: Integer; RowOut: PRGBAArray; RowIn,RowInMask:PRGBArray;
begin
_B_out.Width:=_B_in.Width;
_B_out.Height:=_B_in.Height;
for y:=0 to _B_in.Height-1 do begin
RowOut:= _B_out.ScanLine[y];
RowIn:= _B_in.ScanLine[y];
RowInMask:= _B_mask.ScanLine[y];
for x:=0 to _B_in.Width-1 do begin
RowOut[x].rgbReserved:=trunc((RowInMask[x].rgbtBlue+RowInMask[x].rgbtGreen+RowInMask[x].rgbtRed)/3);
RowOut[x].rgbBlue:=byte(trunc(RowIn[x].rgbtBlue*RowOut[x].rgbReserved/255));
RowOut[x].rgbGreen:=byte(trunc(RowIn[x].rgbtGreen*RowOut[x].rgbReserved/255));
RowOut[x].rgbRed:=byte(trunc(RowIn[x].rgbtRed*RowOut[x].rgbReserved/255));
end;
end;
SetWindowLong(FormSplash.Handle,GWL_EXSTYLE, GetWindowLong(FormSplash.Handle,GWL_EXSTYLE) or WS_EX_LAYERED);
DC:= GetDC(0);
end;
procedure TFormSplash.RenderForm;
var zsize:TSize; zpoint:TPoint; zbf:TBlendFunction;
TopLeft: TPoint;
begin
width:=BT.Width;
height:=BT.Height;
zsize.cx := BT.Width;
zsize.cy := BT.Height;
zpoint := Point(0,0);
with zbf do begin
BlendOp := AC_SRC_OVER;
BlendFlags := 0;
AlphaFormat := AC_SRC_ALPHA;
SourceConstantAlpha := 255;
end;
TopLeft:=BoundsRect.TopLeft;
UpdateLayeredWindow(FormSplash.Handle,DC,@TopLeft,@zsize,BT.Canvas.Handle,@zpoin t,0,@zbf, ULW_ALPHA);
end;
procedure TFormSplash.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const SC_DRAGMOVE : Longint = $F012;
begin
if Button <> mbRight then begin
ReleaseCapture;
SendMessage(Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;
end;
procedure TFormSplash.WMWINDOWPOSCHANGING(var Msg: TWMWINDOWPOSCHANGING);
begin
SetWindowPos(Handle,HWND_TOPmost,Left,Top,Width,Height, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE );
end;
end.
antonn (2007-11-17 17:44:00) [19]уже бы давно скинул полный проект (исходники)...
Anatoly Podgoretsky (2007-11-17 17:02:00) [20]> Nightmare (17.11.2007 17:00:31) [31]
Напрашивается совсем другой вывод, это не Дельфи хреновая.
| |
Страницы: 