Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум программистов _ Delphi - Multimedia, Графика, Игры _ Форма по Bitmap-у

Автор: Pavelbej 16:02:2006, 19:55

Есть форма, на ней два 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;

Автор: Chernobyl 6:01:2008, 17:44

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

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;