Текущий архив: 2007.12.02;
Скачать: CL | DM;
Вниз
как сделать прозрачный pbitmap? Маска и DrawTransparent работают Найти похожие ветки
← →
Dy1 © (2007-03-09 20:46) [0]нужно нарисовать спрайт, растянув с заданным коэффициентом
uses
Windows, Messages, KOL, FastMM, JpegObj;
var
F: PControl;
timer: PMMTimer;
back: PJpeg;
airp, restore, mask: PBitmap;
restoreR, backR, airpR: TRect;
fps,fp, speed: cardinal;
koef: double;
//================================
procedure ResLoader;
var
p: PStream;
k: integer;
begin
p := NewMemoryStream;
// фон pjpeg
k := Resource2Stream(p, hInstance, "back", RT_RCDATA);
if k = 0 Then
Applet.Close;
p.Position := 0;
back := NewJpeg;
back.LoadFromStream(p);
if back.Empty Then
Applet.Close;
p.Size := 0;
koef := F.ClientHeight / back.Height;
backR.Left := 0;
backR.Top := 0;
backR.Right := F.ClientWidth;
backR.Bottom := F.ClientHeight;
// самолёт pbitmap
k := Resource2Stream(p, hInstance, "s", RT_RCDATA);
if k = 0 Then
Applet.Close;
p.Position := 0;
airp := NewBitmap(150,150);
airp.LoadFromStreamEx(p);
if airp.Empty Then
Applet.Close;
// восстановление фона pbitmap
restore := NewBitmap(airp.Width, airp.Height);
// создаём маску
mask := NewBitmap(airp.Width, airp.Height);
mask := airp;
mask.Convert2Mask(clWhite); // неправильно понимает цвет. Фон картинки именно белый
p.Free;
end;
//==========
Procedure ScrClose(Sender: PObj; var Accept: Boolean);
begin
timer.Enabled := False;
back.Free;
airp.Free;
mask.Free;
restore.Free;
end;
//------------------------------------------------------------------------------
Procedure ScrErase(Sender: PControl; DC: HDC);
begin end;
//------------------------------------------------------------------------------
Procedure Paint(Dummy: Pointer; Sender: PControl; DC: HDC);
begin
if back.Empty Then
Exit;
back.StretchDraw(F.Canvas.Handle, backR);
airp.DrawMasked(F.Canvas.Handle, 100,100, mask.Handle);
// airp.DrawTransparent(F.Canvas.Handle, 100,100, clWhite);
fps := fps + 1;
if(timer.Interval * timer.Tag) > 998 Then
begin
fp := fps;
timer.Tag := 0;
fps := 0;
end;
F.Canvas.TextOut(5,5,int2str(fp));
end;
//------------------------------------------------------------------------------
Procedure OnTimer(Dummy: Pointer; Sender: PMMTimer);
begin
timer.Tag := timer.Tag +1;
F.Invalidate;
end;
//==================
procedure Scr;
begin
F := NewForm(Applet, "WingRR");
F.Style := WS_POPUP or WS_MAXIMIZE or WS_VISIBLE; // None
F.OnPaint := TOnPaint( MakeMethod(nil, @Paint));
F.OnClose := TOnEventAccept(MakeMethod(nil, @ScrClose));
F.OnEraseBkgnd := TOnPaint( MakeMethod(nil, @ScrErase));
F.Canvas.Font.Color := clRed;
F.Canvas.Font.FontHeight := F.ClientHeight shr 5;
F.Canvas.Brush.BrushStyle := bsClear;
ResLoader;
timer := NewMMTimer(Speed); // ~5 ms
timer.Resolution := 1;
timer.OnTimer := TOnEvent( MakeMethod( nil, @OnTimer));
timer.Enabled := True;
Run(F);
end;
//===================
begin
Install_FastMM;
Scr;
end.
← →
имя (2007-03-21 17:46) [1]Удалено модератором
← →
Vladimir Kladov (2007-03-21 19:07) [2]версия какая
← →
Dy1 © (2007-03-23 22:50) [3]2.37 Единственная работающая у меня версия.
Сейчас сделал маску вручную.
На некоторых компах самолёт дёргается (прога ужЕ давно написана). Не пойму что тормозит. Либо таймер, либо очередное паранормальное явление :(
← →
имя (2007-03-24 02:44) [4]Удалено модератором
← →
Vladimir Kladov (2007-03-24 10:44) [5]Формат картинки, случаем, не pf8bit. Исправление было в 2.54.
← →
имя (2007-03-25 05:35) [6]Удалено модератором
← →
имя (2007-03-25 18:24) [7]Удалено модератором
← →
Galkov © (2007-03-25 18:39) [8]Что-то я совсем перестал понимать логику работы модера в этой конференции.
если это а) работа б) логика
← →
имя (2007-03-27 08:28) [9]Удалено модератором
← →
имя (2007-03-27 08:28) [10]Удалено модератором
← →
имя (2007-04-27 03:34) [11]Удалено модератором
← →
имя (2007-04-27 03:36) [12]Удалено модератором
← →
имя (2007-04-28 07:04) [13]Удалено модератором
← →
имя (2007-05-07 23:01) [14]Удалено модератором
← →
имя (2007-05-08 07:32) [15]Удалено модератором
← →
имя (2007-05-14 02:08) [16]Удалено модератором
← →
имя (2007-05-14 14:33) [17]Удалено модератором
← →
ANTPro © (2007-05-14 17:46) [18]А не проще ветку закрыть? : )
Страницы: 1 вся ветка
Текущий архив: 2007.12.02;
Скачать: CL | DM;
Память: 0.5 MB
Время: 0.029 c
