• Курсы Академии Кодебай, стартующие в мае - июне, от команды The Codeby

    1. Цифровая криминалистика и реагирование на инциденты
    2. ОС Linux (DFIR) Старт: 16 мая
    3. Анализ фишинговых атак Старт: 16 мая Устройства для тестирования на проникновение Старт: 16 мая

    Скидки до 10%

    Полный список ближайших курсов ...

Форма по Bitmap-у

  • Автор темы Pavelbej
  • Дата начала
Статус
Закрыто для дальнейших ответов.
P

Pavelbej

Есть форма, на ней два Timage. В одном изображение, в другом - его маска. Форма создается по рисунку. Проблема в том что если на форму добавить другие компоненты, то они не отображаются. Вот привел код, может поможете, не могу понять.

Код:
procedure TForm1.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 TForm1.RenderForm;
var zsize:TSize; zpoint:TPoint; zbf:TBlendFunction;
 TopLeft: TPoint; DC:HDC;
begin
SetWindowLong(Form1.Handle,GWL_EXSTYLE, GetWindowLong(Form1.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(Form1.Handle,DC,@TopLeft,@zsize,BT.Canvas.Handle,@zpoint,0,@zbf, ULW_ALPHA);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Picture.Bitmap.PixelFormat:=pf24bit;
Image2.Picture.Bitmap.PixelFormat:=pf24bit;
BT:=Tbitmap.Create;
BT.PixelFormat:=pf32bit;
BuildCopy24to32( Image1.Picture.Bitmap,Image2.Picture.Bitmap, Form1.bt );
RenderForm;
end;
 
C

Chernobyl

Я пользуюсь другим

Код:
type
TRGBArray = array[0..32767] of TRGBTriple;
PRGBArray = ^TRGBArray;

...
private
FRegion: THandle;
function CreateRegion(Bmp: TBitmap): THandle;
...

function TForm1.CreateRegion(Bmp: TBitmap): THandle;
var
X, Y, StartX: Integer;
Excl: THandle;
Row: PRGBArray;
TransparentColor: TRGBTriple;
Color: Longint;
r, g, b: Byte;
begin

Bmp.PixelFormat := pf24Bit;

Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);

for Y := 0 to Bmp.Height - 1 do
begin
Row := Bmp.Scanline[Y];

StartX := -1;

if Y = 0 then begin
Color := ColorToRGB(clWhite);
r	 := Color;
g	 := Color shr 8;
b	 := Color shr 16;
TransparentColor.rgbtRed:=r;
TransparentColor.rgbtGreen:=g;
TransparentColor.rgbtBlue:=b;
end;

for X := 0 to Bmp.Width - 1 do
begin
if (Row[X].rgbtRed = TransparentColor.rgbtRed) and
(Row[X].rgbtGreen = TransparentColor.rgbtGreen) and
(Row[X].rgbtBlue = TransparentColor.rgbtBlue) then
begin
if StartX = -1 then StartX := X;
end
else
begin
if StartX > -1 then
begin
Excl := CreateRectRGN(StartX, Y, X + 1, Y + 1);
try
CombineRGN(Result, Result, Excl, RGN_DIFF);
StartX := -1;
finally
DeleteObject(Excl);
end;
end;
end;
end;

if StartX > -1 then
begin
Excl := CreateRectRGN(StartX, Y, Bmp.Width, Y + 1);
try
CombineRGN(Result, Result, Excl, RGN_DIFF);
finally
DeleteObject(Excl);
end;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
Bmp: TBitmap;
begin
if openDialog1.Execute=false then exit;
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile(openDialog1.FileName);
FRegion := CreateRegion(Bmp);
SetWindowRGN(BitBtn1.Handle, FRegion, True);
finally
Bmp.Free;
end;
Form1.Width:= Bmp.Width;
Form1.Height:= Bmp.Height;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(FRegion);
end;
 
Статус
Закрыто для дальнейших ответов.
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!