由位图生成区域

思路:
  扫描图象的scanline, 取不是背景色的连续坐标, 认为是一个height=1的rect,
用CreateRectRgn生成region, 再用CombineRgn(.....RGN_OR)与先前生成
的region合并生成新的region.  
重复扫描完所有扫描线后就得到一个region了.

function CreateRgnFromBmp(ABmp: TBitmap; ARect: TRect; TransColor: TColor): HRGN;
var
  b, e: Integer;
  i, j: Integer;
  p: PChar;
  rg: HRGN;
  rgbcolor: longint;
begin
  result := 0;
  if not assigned(ABmp) or ABmp.Empty then exit; // 返回空region
  rgbcolor := ColorToRGB(transcolor);
  rgbcolor := (
           rgbcolor and $0000ff00
           or (rgbcolor shr 16)
           or (rgbcolor shl 16)
           ) and $00ffffff;  // 交换RGB颜色值中的R与B, 使之与scanline中顺序相同 
  if IsRectEmpty(ARect) then
    ARect := bounds(0, 0, abmp.width, abmp.height)
  else
    IntersectRect(arect, arect, bounds(0, 0, abmp.width, abmp.height));
  if IsRectEmpty(arect) then exit;
  ABmp.PixelFormat := pf24Bit;  // 转换图象成24bit
  for i := ARect.Top to ARect.Bottom - 1 do
  begin
    b := ARect.Left;
    e := b - 1;
    p := Pointer(Integer(ABmp.ScanLine[i]) + ARect.Left * 3); // scanline中起始位置
    for j := ARect.Left to ARect.Right - 1 do
    begin
      if CompareMem(p, @rgbcolor, 3) then  // 透明色
        if b >= e then Inc(b)
        else
        begin
          if result = 0 then
            result := CreateRectRgn(b, i, e, i+1)
          else begin
            rg := CreateRectRgn(b, i, e, i+1);
            CombineRgn(result, result, rg, RGN_OR);
            DeleteObject(rg);
          end;
          b := e;
        end
      else if b >=e then e := b + 1
      else Inc(e);
      p := p + 3;
    end;
    if b < e then
      if result = 0 then
            result := CreateRectRgn(b, i, e, i+1)
      else begin
            rg := CreateRectRgn(b, i, e, i+1);
            CombineRgn(result, result, rg, RGN_OR);
            DeleteObject(rg);
      end;
  end;
  if result <> 0 then              // 将region定到(0,0)坐标
    OffsetRgn(result, -arect.left, -arect.top);
end;
///////////////////////////////////////////////
const
  BitMask: array[0..7] of byte = (128, 64, 32, 16, 8, 4, 2, 1);

function fcThisThat(const Clause: Boolean; TrueVal, FalseVal: Integer): Integer;
begin
  if Clause then result := TrueVal else Result := FalseVal;
end;

function fcIsTrueColorBitmap(Bitmap: TBitmap): boolean;
begin
  result:= Bitmap.PixelFormat = Graphics.pf24bit;
end;

function fcCreateRegionFromBitmap(ABitmap: TBitmap; TransColor: TColor): HRgn;
var
  TempBitmap: TBitmap;
  Rgn1, Rgn2: HRgn;
  Col, StartCol, Row: integer;
  Line: PByteArray;

  function ColToColor(Col: integer): TColor;
  begin
    if fcIsTrueColorBitmap(TempBitmap) then
      result:= Line[Col * 3] * 256 * 256 + Line[Col * 3 + 1] * 256 + Line[Col * 3 + 2]
    else result := TColor(fcThisThat((Line[Col div 8] and BitMask[Col mod 8]) <> 0, clBlack, clWhite));
  end;
begin
  result := 0;
  if (ABitmap <> nil) and (ABitmap.Width = 0) or (ABitmap.Height = 0) then Exit;
  Rgn1 := 0;

  TempBitmap := TBitmap.Create;

  TempBitmap.Assign(ABitmap);
  if not fcIsTrueColorBitmap(TempBitmap) then
  begin
    TempBitmap.Mask(TransColor);
    TransColor := clBlack;
  end;

  with TempBitmap do
  begin
    for Row := 0 to TempBitmap.height-1 do
    begin
      Line:= scanLine[row];

      Col := 0;
      while Col < TempBitmap.Width do
      begin
        while (Col < TempBitmap.Width) and (ColToColor(Col) = TransColor) do inc(Col);
        if Col >= TempBitmap.Width then Continue;

        StartCol := Col;
        while (Col < TempBitmap.Width) and (ColToColor(Col) <> TransColor) do inc(Col);
        if Col >= TempBitmap.Width then Col := TempBitmap.Width;

        if Rgn1 = 0 then Rgn1 := CreateRectRgn(StartCol, Row, Col, Row + 1)
        else begin
          Rgn2 := CreateRectRgn(StartCol, Row, Col, Row + 1);
          if (Rgn2 <> 0) then CombineRgn(Rgn1,Rgn1,Rgn2,RGN_OR);
            Deleteobject(Rgn2);
        end;
      end;
    end;
  end;
  result := Rgn1;
  TempBitmap.Free;
end;