透明位图的问题

Question

我有二个位图，一个是正常的位图，一个是mask位图，请问如何将两个图片全成一个，并根据mask的黑色部分，把第一个位图对应位置设为透明色
两个位图一样大小。。

Answer 1

回复人： xzhifei(饭桶超人(抵制日货)) ( ) 信誉：127  2004-12-17 17:09:00  得分: 0     加点分行不行，加到100我就来告诉你源码!!
>>>同意。现在很多贴不是发在非技术区就是分N少，呵~~~
  
 

Answer 2

procedure DrawTransparent(var sBmp: TBitMap; dBmp: TBitMap; PosX, PosY: Integer; TranColor: TColor = -1);
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..32767] of TRGBTriple;
  function GetSLCOlor(pRGB: TRGBTriple): TColor;
  begin
    Result := RGB(pRGB.rgbtRed, pRGB.rgbtGreen, pRGB.rgbtBlue);
  end;
var
  b, p: PRGBTripleArray;
  x, y: Integer;
  BaseColor: TColor;
begin
  sBmp.PixelFormat := pf24Bit;
  dBmp.PixelFormat := pf24Bit;
  p := dBmp.scanline[0];  if TranColor = -1 then
    BaseCOlor := GetSLCOlor(p[0])
  else
    BaseCOlor := TranColor;  if (PosY > sBmp.Width) or (PosY > sBmp.Height) then
    Exit;  for y := 0 to dBmp.Height - 1 do
  begin
    p := dBmp.scanline[y];
    b := sBmp.ScanLine[y + PosY];
    for x := 0 to (dBmp.Width - 1) do
    begin
      if GetSLCOlor(p[x]) <> BaseCOlor then
        b[x + PosX] := p[x];
    end;
  end;end;procedure TForm1.Button1Click(Sender: TObject);
var
  bmp:TBitMap;
begin
  bmp:=TBitMap.Create ;
  bmp.Assign(Image1.Picture);
  DrawTransparent(bmp,Image2.Picture.Bitmap ,10,10);
  image1.Picture.Assign(bmp);
  image1.Refresh ;end;

Answer 3

unit Unit1;
  
  interface
  
  uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons;
  
  type
  TForm1 = class(TForm)
  Image1: TImage;
  Button1: TButton;
  procedure FormCreate(Sender: TObject);
  procedure Button1Click(Sender: TObject);
  procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  private
  function CreateRegion(wMask: TBitmap; wColor: TColor;
  hControl: THandle): HRGN;
  { Private declarations }
  public
  { Public declarations }
  end;
  
  var
  Form1: TForm1;
  
  implementation
  
  {$R *.DFM}
  
  function Tform1.CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN;
  var
  dc, dc_c: HDC;
  Rgn, TempRgn: HRGN;
  X, Y, BeginY: Integer;
  line: boolean;
  color: TColor;
  begin{代码风格不统一，因为有些是照抄那个外国人的。
  dc := GetWindowDC(hControl);
  dc_c := CreateCompatibleDC(dc);
  SelectObject(dc_c, wMask.Handle);
  BeginY := 0;{这句可以不要，有了可以避免编译器警告。}
  Rgn := CreateRectRgn(0, 0, 0, 0);{先初始化一个空的区域给Rgn。}
  for X := 0 to wMask.Width - 1 do
begin
  line := False;
  for Y := 0 to wMask.Height - 1 do
  begin
  color := GetPixel(dc_c, X, Y);
  if not (color = wColor) then
  begin
  if not line then
  begin
  line := True;
  BeginY:= Y;
  end;
  end;
  if (color = wColor) or (Y = wMask.Height - 1) then
  begin
  if line then
  begin
  line := False;
  TempRgn := CreateRectRgn(X, BeginY, X + 1, Y);
  CombineRgn(Rgn, Rgn, TempRgn, RGN_OR);
  {把图形以连续得线段为单位生成区域，并且合并到总的区域中}
  end;
  end;
  end;
  end;
  ReleaseDC(hControl, dc);
  DeleteObject(dc);
  Result := Rgn;
  end;
  
  procedure TForm1.FormCreate(Sender: TObject);
  var
  w1:TBitmap;
  w2:TColor;
  rgn: HRGN;
  begin
  w1:=TBitmap.Create;
  w1.Assign(image1.Picture.Bitmap);
  w2:=w1.Canvas.Pixels[0,0];
  rgn := CreateRegion(w1,w2,Handle);
  if rgn<>0 then
  begin
  SetWindowRgn(Handle, rgn, true);
  end;
  w1.Free;
  end;