Полупрозрачность - как?

[t3ns0r]

Как реализовать полупрозрачность с BMP или PNG?

[Alex21]

Объясни более популярно, чего ты хочешь от программы

[t3ns0r]

Хочу сделать модуль для создания эффектов (взрывы, пламя и т.д.) по типу Parctile Illusion,
для этого полупрозрачность, имхо, необходима

[Alex21]

var Bitmap:TBitmap;
begin
Bitmap:=TBitmap.Create;
try
 with Bitmap do
  begin
    LoadFromFile('h:\123.bmp');
    Transparent:=true;
    TransparentColor:=Bitmap.Canvas.Pixels[10,10];
    transparentMode:=tmAuto;
{прозрачный цвет о умолчанию устанавливается в
clDefault = TColor($20000000)}
    Form1.Canvas.Draw(0,0,bitmap);
  end;
finally
 Bitmap.Free;
 end;

Думаю, пояснять не надо.

[t3ns0r]

Не в этом дело, я не знаю как использовать alpha канал изображения.
Мне нужно сделать так, чтобы одновременно было видно и изображение, и фон за ним, то есть сделать в некоторых местах изображение ПОЛУпрозрачным.

[andrey4623]

а если перебирать все пиксели canvas.pixels[x,y], у первого цвет оставить, у второго - прозрачный, у третьего оставить, у четвертого - прозрачный, и т.д.

[BOBAH13]

чтобы прозрачность работала нужно смешивать пиксель с фоновым пикселем вот однажды обнаружил такое

procedure BlendBitmap(Src, Dest: TBitmap; Amount: Byte; BackColor: TColor);
  function CandC(C1, C2: TRGBTriple): Boolean;
  begin {Сравнение двух цветов}
    Result := (C1.rgbtBlue = C2.rgbtBlue) and
      (C1.rgbtGreen = C2.rgbtGreen) and
      (C1.rgbtRed = C2.rgbtRed);
  end;
var
  x, y: Integer;
  ps, pd: pRGBTriple;
  rgb: TRGBTriple;
  A1, A2: Double;
begin
  if (Dest.Width > Src.Width) or (Dest.Height > Src.Height) then exit;
  Src.PixelFormat := pf24Bit;
  Dest.PixelFormat := pf24Bit;
  A1 := Amount / 255;
  A2 := 1 - A1;
  rgb.rgbtRed := Lo(BackColor);
  rgb.rgbtGreen := Lo(BackColor shr 8);
  rgb.rgbtBlue := Lo((BackColor shr 8) shr 8);
  for y := 0 to Src.Height-1 do
  begin
    ps := Src.ScanLine[y];
    pd := Dest.ScanLine[y];
    for x := 0 to Src.Width-1 do
    begin
      if not CandC(pd^, rgb) then
        with pd^ do
        begin
          rgbtBlue := Round(A1 * ps^.rgbtBlue + A2 * rgbtBlue);
          rgbtGreen := Round(A1 * ps^.rgbtGreen + A2 * rgbtGreen);
          rgbtRed := Round(A1 * ps^.rgbtRed + A2 * rgbtRed);
        end;
      Inc(pd);
      Inc(ps);
    end;
  end;
end;

работает на ура

смысл такой, ну а каждый пиксель на Api пербрать думаю не составит проблем если знаеш указатель на массив DIB

[t3ns0r]

to andrey4623
canvas.pixels[x,y] слишком медленный, если в цикле с ним больше 1000 повторений, FPS падает катастрофически.


to BOBAH13
Всё прекрасно работает и без тормозов, респект!

[ElenaA]

Ребята, а можно как-нибудь, попроще, текст на картинку наложить? Текст формируется в проге, и нужно, чтобы фон был при этом виден.

[Stilet]

Elena я правильно тебя понял, тебе это надо? :

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var tb:TBitmap;
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormPaint(Sender: TObject);
begin

Form1.Canvas.Draw(0,0, tb);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
tb:=TBitmap.Create;
tb.LoadFromFile('c:\мой файл.bmp');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
tb.Canvas.Brush.Style:=bsClear;
tb.Canvas.TextOut(100,100,Edit1.Tex t);
Repaint;
end;

end.