Задать прозрачность в TImage

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Задать прозрачность в TImage

Сообщение Jordan » 12.06.2020 13:25:22

Приветствую.

Создал форму, к ней по размеру формы TBitmap. Все рисование происходит в TBitmap, после чего копируется на форму.
Загружаю bmp изображение, задаю цвет прозрачности, но картинка выводится целиком.

Инициализация


Код: Выделить всё
  Manager := TResourceManager.Create();

  MainWindow.Width  := 800;
  MainWindow.Height := 600;

  Screen        := TBitmap.Create();
  Screen.Width  := 800;
  Screen.Height := 600;

  Image := Manager.GetPicture('bg1bg22c_0_0_0.bmp');
  Image.Picture.Bitmap.TransparentColor := Image.Picture.Bitmap.Canvas.Pixels[1, 1];
  Image.Picture.Bitmap.Transparent := true;

  Fps.Interval := Round(1000 / 30);
  Fps.Enabled  := true;


Рисование
Код: Выделить всё
procedure TMainWindow.FpsTimer(Sender: TObject);
begin
  Screen.Canvas.Clear();

  Screen.Canvas.Draw(Image.Top, Image.Left, Image.Picture.Graphic);

  MainWindow.Canvas.Draw(0, 0, Screen);
end;   


Изображение
Jordan
новенький
 
Сообщения: 13
Зарегистрирован: 19.12.2013 09:44:54

Re: Задать прозрачность в TImage

Сообщение Alex2013 » 13.06.2020 05:23:43

Код: Выделить всё
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;

type

  { TMForm1 }

  TMForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private

  public

  end;

var
  MForm1: TMForm1;

implementation

{$R *.lfm}

{ TMForm1 }

procedure TMForm1.Button1Click(Sender: TObject);
var
B:Tbitmap;
begin
  B:=Tbitmap.Create;
  b.SetSize(Image1.Width,Image1.Height);

  Image1.Picture.Bitmap.Assign(b);// Важно !

  With   b.canvas do
  begin
    Brush.Color:=clGreen;
    FillRect(0,0,b.Width,b.Height);
    Brush.Color:=clRed;
    FillRect(20,20,b.Width-20,b.Height-20);
    pen.Color:=clGreen;
    pen.Width:=2;
    Line(20,20,b.Width-20,b.Height-20);

  end;

  if CheckBox1.Checked then begin
   b.TransparentColor :=b.Canvas.Pixels[1, 1];
   b.Transparent := true;
  end;
  Image1.Picture.Bitmap.Canvas.Draw(0,0,b);
  b.free;
end;
end.

Так работает хотя я думал, что Transparent нужно для Canvas.Draw на "приемнике" ( то бишь Image1) включать.
"Доверяй но проверяй !" :idea: :D (Даже если это собственная память и логика)

CheckBox1: TCheckBox; и Image1: TImage; кинуть на форму .
При включении галки CheckBox1 рисует черню рамку( пустой битмап с заданным размером заполнен нулями ) , а не зеленую то есть игнорирует прозрачный цвет что и требовалось.
Alex2013
долгожитель
 
Сообщения: 1826
Зарегистрирован: 03.04.2013 11:59:44


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Yandex [Bot] и гости: 6

Рейтинг@Mail.ru