Форум: "Начинающим";
Текущий архив: 2006.04.09;
Скачать: [xml.tar.bz2];
ВнизОкно-заставка Найти похожие ветки
← →
Quattro © (2006-03-21 21:01) [0]Добрый вечер, уважаемые мастера....здесь относительно недавно промелькнула тема, про заставки, и в качестве примера была приведена ссылка на пример....пример я скачал, но , вот беда !, не могу разобраться как это все работает..а посему прошу у Вас помощи.....ниже приведен код проекта, состоящий из двух юнитов....
[code]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;
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
end;
procedure TFormSplash.RenderForm;
var zsize:TSize; zpoint:TPoint; zbf:TBlendFunction;
TopLeft: TPoint; DC:HDC;
begin
SetWindowLong(FormSplash.Handle,GWL_EXSTYLE, GetWindowLong(FormSplash.Handle,GWL_EXSTYLE) or WS_EX_LAYERED);
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;
DC:= GetDC(0);
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.[/code] Объясните, пожалуйста, что делает процедура procedure TFormSplash.BuildCopy24to32(_B_in,_B_mask:TBitmap; var _B_out: TBitmap) и procedure TFormSplash.RenderForm ..=))
← →
antonn © (2006-03-22 06:03) [1]
> TFormSplash.BuildCopy24to32(_B_in,_B_mask:TBitmap; var
> _B_out: TBitmap)
создает 32 битный битмап из 2х 24хбитных.
у 32 битного битмапа пиксел состоит из 4 байтов - R,G,B и байт альфаканала (задает прозрачность). Именно такой битмап нужен, чтобы окно могло быть полупрозрачным, и чтобы его можно было передать в UpdateLayeredWindow(); Для его создания в примере используются 2 обычных битмапа в 24 бита (у которых пиксель состоит только из 3х байтов - R,G,B), у _B_in - "забираем" каналы цвета, а _B_mask используем для четвертого байта - альфаканала (поэтому _B_mask, кстати, и "чернобелый", у него R,G,B равны).
Эту процедуру я написал от того, что просто не знаю, как еще у себя на компьютере создать 32ух битный битмап:)
> procedure TFormSplash.RenderForm;
выставляет окну св-во поддержки слоев (WS_EX_LAYERED) и замещает "изображение" формы на битмап BT (который 32ух битный). Теперь окно само перерисовываться не будет, нужно в ручную делать самому, для заставки это и не очень критично. кстатиSourceConstantAlpha := 255;
это общая прозрачность получившегося окна, от 0 до 255.
← →
Quattro © (2006-03-22 13:02) [2]antonn! добый день....не могли бы Вы дать ссылку на какую нибудь теоию по этому вопросу...ибо вопросов слишком много, проще наверное почитать...но не знаю что именно искать =)
← →
antonn © (2006-03-22 13:49) [3]даже не знаю, что предложить... я ничего в свое время не нашел, поэтому не читал:)
в яндексе "шерстил", на http://www.rsdn.ru/ и http://www.delphikingdom.com/ искал...
← →
Quattro © (2006-03-22 21:59) [4]а что такое TRGBQuad и TRGBTriple??
← →
Quattro © (2006-03-22 22:03) [5]const
MaxPixelCountA = MaxInt div SizeOf(TRGBQuad);
MaxPixelCount = MaxInt div SizeOf(TRGBTriple)
и для чего вот эти константы??....извините за непонятливость=)
← →
Quattro © (2006-03-22 22:11) [6]что такое var _B_out: TBitmap предающееся в TFormSplash.BuildCopy24to32....при вызове этой процедуре Вы передаете нечто под именем FormSplash.BuildCopy24to32( ImageMain.Picture.Bitmap,ImageMask.Picture.Bitmap,FormSplash.bt )...объясните, пожалуйста :)
← →
balepa © (2006-03-23 05:37) [7]Надо предпологать что B_out это получившаяся 32bit картинка
см. antonn © (22.03.06 06:03) [1]
> FormSplash.BTtype
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;
Ты в коде вообще пытался разобраться (смотрел хотябы) ?
← →
Quattro © (2006-03-23 10:06) [8]да, действительно,..проглядел :)
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2006.04.09;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.014 c