Форма по Bitmap-у

Тема в разделе "Delphi - Multimedia, Графика, Игры", создана пользователем Pavelbej, 16 фев 2006.

Статус темы:
Закрыта.
  1. Pavelbej

    Pavelbej Гость

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

    Код (Text):
    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;
     
  2. Chernobyl

    Chernobyl Гость

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

    Код (Text):
    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;
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей