sf_bitmap.pas

smartflash ,delphi vcl组件 ,可以实现透明flash窗体

procedure TsfBitmap.Tile(DC: HDC; DstRect, SrcRect: TRect);
var
  i, j: integer;
  R, R1, SrcR: TRect;
  Cx, Cy: integer;
  W, H, DW, DH: integer;
  Dst: TsfBitmap;
  BitmapW, BitmapH, BitmapBCount: integer;
  BitmapBits: PByteArray;

  procedure Draw( SrcRect: TRect);
  var
    P: TPoint;
  begin
    if Dst <> nil then
    begin
      { Adjust WindowOrg }
      GetWindowOrgEx(DC, P);
      OffsetRect(R, -P.X, -P.Y);
      { Destination is TsfBitmap }
      self.Draw(Dst, R, SrcRect);
    end
    else
    begin
      if EnableDibOperation and (BitmapBits <> nil) and (BitmapBCount = 32) and (BitmapH > 0) then
      begin
        { Adjust WindowOrg }
        GetWindowOrgEx(DC, P);
        OffsetRect(R, -P.X, -P.Y);
        { Draw to DIB }
        if FAlphaBlend then
          StretchToDibAlphaBlendFunc(BitmapBits, R, R, BitmapW, BitmapH,
            Self, SrcRect)
        else
          if FTransparent then
            StretchToDibTransparentFunc(BitmapBits, R, R, BitmapW, BitmapH,
              Self, SrcRect)
          else
            StretchToDibOpaqueFunc(BitmapBits, R, R, BitmapW, BitmapH,
              Self, SrcRect);
      end
      else
      begin
        { Draw to DC }
        if FAlphaBlend then
          StretchToDCAlphaBlendFunc(DC, R.Left, R.Top, RectWidth(R), RectHeight(R),
            Self, SrcRect.Left, SrcRect.Top, RectWidth(SrcRect), RectHeight(SrcRect))
        else
          if FTransparent then
            StretchToDCTransparentFunc(DC, R.Left, R.Top, RectWidth(R), RectHeight(R),
              Self, SrcRect.Left, SrcRect.Top, RectWidth(SrcRect), RectHeight(SrcRect))
          else
            StretchToDCOpaqueFunc(DC, R.Left, R.Top, RectWidth(R), RectHeight(R),
              Self, SrcRect.Left, SrcRect.Top, RectWidth(SrcRect), RectHeight(SrcRect));
      end;
    end;
  end;

begin
  W := RectWidth(SrcRect);
  H := RectHeight(SrcRect);
  if (W=0) or (H=0) then Exit;

  Dst := FindBitmapByDC(DC);
  if Dst=nil then
    BitmapBits := GetBitsFromDCFunc(DC, BitmapW, BitmapH, BitmapBCount);

  SrcR := Rect(0, 0, W, H);
  OffsetRect(SrcR, DstRect.Left, DstRect.Top);

  Cx := RectWidth(DstRect) div W;
  if RectWidth(DstRect) mod W <> 0 then Inc(Cx);
  Cy := RectHeight(DstRect) div H;
  if RectHeight(DstRect) mod H <> 0 then Inc(Cy);

  for i := 0 to Cx do
    for j := 0 to Cy do
    begin
      R := SrcR;
      OffsetRect(R, i * W, j * H);

      IntersectRect(R, R, DstRect);

      DW := RectWidth(R);
      DH := RectHeight(R);

      if (DW = 0) or (DH = 0) then Break;

      R1 := SrcRect;
      if (DW <> W) or (DH <> H) then
      begin
        R1.Right := R1.Left + DW;
        R1.Bottom := R1.Top + DH;
        Draw( R1);
      end
      else
        Draw( R1);
    end;
end;

procedure TsfBitmap.Tile(Canvas: TCanvas; DstRect, SrcRect: TRect);
begin
  Tile(Canvas.Handle, DstRect, SrcRect);
end;

procedure TsfBitmap.Tile(Bitmap: TsfBitmap; DstRect, SrcRect: TRect);
var
  i, j: integer;
  R, R1, SrcR: TRect;
  Cx, Cy: integer;
  W, H, DW, DH: integer;
begin
  W := RectWidth(SrcRect);
  H := RectHeight(SrcRect);
  if W * H = 0 then Exit;

  SrcR := Rect(0, 0, W, H);
  OffsetRect(SrcR, DstRect.Left, DstRect.Top);

  Cx := RectWidth(DstRect) div W;
  if RectWidth(DstRect) mod W <> 0 then Inc(Cx);
  Cy := RectHeight(DstRect) div H;
  if RectHeight(DstRect) mod H <> 0 then Inc(Cy);

  for i := 0 to Cx do
    for j := 0 to Cy do
    begin
      R := SrcR;
      OffsetRect(R, i * W, j * H);

      IntersectRect(R, R, DstRect);

      DW := RectWidth(R);
      DH := RectHeight(R);

      if (DW = 0) or (DH = 0) then Break;

      if (DW <> W) or (DH <> H) then
      begin
        R1 := SrcRect;
        R1.Right := R1.Left + DW;
        R1.Bottom := R1.Top + DH;
        Draw(Bitmap, R, R1);
      end
      else
        Draw(Bitmap, R, SrcRect);
    end;
end;

procedure TsfBitmap.TileClip(DC: HDC; DstRect, DstClip, SrcRect: TRect);
var
  i, j: integer;
  R, R1, SrcR, ClipRes: TRect;
  Cx, Cy: integer;
  W, H, DW, DH: integer;
  IsClip: boolean;
begin
  W := RectWidth(SrcRect);
  H := RectHeight(SrcRect);
  if W * H = 0 then Exit;

  if IsRectEmpty(DstClip) then
    IsClip := false
  else
    IsClip := true;
  SrcR := Rect(0, 0, W, H);
  OffsetRect(SrcR, DstRect.Left, DstRect.Top);

  Cx := RectWidth(DstRect) div W;
  if RectWidth(DstRect) mod W <> 0 then Inc(Cx);
  Cy := RectHeight(DstRect) div H;
  if RectHeight(DstRect) mod H <> 0 then Inc(Cy);

  for i := 0 to Cx do
    for j := 0 to Cy do
    begin
      R := SrcR;
      OffsetRect(R, i * W, j * H);

      IntersectRect(R, R, DstRect);

      DW := RectWidth(R);
      DH := RectHeight(R);

      if (DW = 0) or (DH = 0) then Break;

      if (DW <> W) or (DH <> H) then
      begin
        R1 := SrcRect;
        R1.Right := R1.Left + DW;
        R1.Bottom := R1.Top + DH;
        if IsClip then
        begin
          if IntersectRect(ClipRes, DstClip, R) then
            Draw(DC, R, R1);
        end
        else
          Draw(DC, R, R1);
      end
      else
        if IsClip then
        begin
          if IntersectRect(ClipRes, DstClip, R) then
            Draw(DC, R, SrcRect);
        end
        else
          Draw(DC, R, SrcRect);
    end;
end;

procedure TsfBitmap.TileClip(Canvas: TCanvas; DstRect, DstClip, SrcRect: TRect);
begin
  TileClip(Canvas.Handle, DstRect, DstClip, SrcRect);
end;

procedure TsfBitmap.TileClip(Bitmap: TsfBitmap; DstRect, DstClip, SrcRect: TRect);
var
  i, j: integer;
  R, R1, ClipRes, SrcR: TRect;
  Cx, Cy: integer;
  W, H, DW, DH: integer;
  IsClip: boolean;
begin
  W := RectWidth(SrcRect);
  H := RectHeight(SrcRect);
  if W * H = 0 then Exit;

  SrcR := Rect(0, 0, W, H);
  OffsetRect(SrcR, DstRect.Left, DstRect.Top);

  if IsRectEmpty(DstClip) then
    IsClip := false
  else
    IsClip := true;

  Cx := RectWidth(DstRect) div W;
  if RectWidth(DstRect) mod W <> 0 then Inc(Cx);
  Cy := RectHeight(DstRect) div H;
  if RectHeight(DstRect) mod H <> 0 then Inc(Cy);

  for i := 0 to Cx do
    for j := 0 to Cy do
    begin
      R := SrcR;
      OffsetRect(R, i * W, j * H);

      IntersectRect(R, R, DstRect);

      DW := RectWidth(R);
      DH := RectHeight(R);

      if (DW = 0) or (DH = 0) then Break;

      if (DW <> W) or (DH <> H) then
      begin
        R1 := SrcRect;
        R1.Right := R1.Left + DW;
        R1.Bottom := R1.Top + DH;
        if IsClip then
        begin
          if IntersectRect(ClipRes, DstClip, R) then
            Draw(Bitmap, R, R1);
        end
        else
          Draw(Bitmap, R, R1);
      end
      else
        if IsClip then
        begin
          if IntersectRect(ClipRes, DstClip, R) then
            Draw(Bitmap, R, SrcRect);
        end
        else
          Draw(Bitmap, R, SrcRect);
    end;
end;

procedure TsfBitmap.MergeDraw(Bitmap: TsfBitmap; X, Y: integer; SrcRect: TRect);
var
  Index: integer;
  i, j: integer;
  B, F: PsfColor;
  Alpha: byte;
begin
  if SrcRect.Left < 0 then
  begin
    X := X + Abs(SrcRect.Left);
    SrcRect.Left := 0;
  end;
  if SrcRect.Top < 0 then
  begin
    Y := Y + Abs(SrcRect.Top);
    SrcRect.Top := 0;
  end;
  if SrcRect.Right > Bitmap.FWidth then SrcRect.Right := Bitmap.FWidth;
  if SrcRect.Bottom > Bitmap.FHeight then SrcRect.Bottom := Bitmap.FHeight;
  { Draw bitmap rect to another bitmap }
  try
    for i := SrcRect.Left to SrcRect.Right-1 do
      for j := SrcRect.Top to SrcRect.Bottom-1 do
      begin
        { Get Back pixel from Bitmap }
        B := Bitmap.PixelPtr[i, j];
        { Get fore pixel }
        Index := (X + i-SrcRect.Left) + (Y + (j-SrcRect.Top)) * FWidth;
        if Index >= FWidth * FHeight then Continue;
        F := @FBits[Index];

        { Blend }
        Alpha := F^ shr 24;
        if Alpha = 0 then
          F^ := B^
        else
          if Alpha < $FF then
            F^ := PixelAlphaBlendFunc(F^, B^);
      end;
  finally
    EMMS;
  end;
end;

{ Painting Routines ===========================================================}

procedure TsfBitmap.DrawGraphic(Graphic: TGraphic; DstRect: TRect);
var
  Bitmap: TBitmap;
  SL: PsfColorArray;
  i, j: integer;
begin
  { Create DIB copy }
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;
    Bitmap.Width := FWidth;
    Bitmap.Height := FHeight;
    Bitmap.Canvas.Brush.Color := RGB(255, 0, 255);
    Bitmap.Canvas.Rectangle(-1, -1, FWidth + 1, FHeight + 1);
    Bitmap.Canvas.StretchDraw(DstRect, Graphic);

    { Copy to bitmap }
    for j := 0 to FHeight - 1 do
    begin
      SL := Bitmap.Scanline[j];
      for i := 0 to FWidth - 1 do
        if (TsfColorRec(SL[i]).R = $FF) and (TsfColorRec(SL[i]).G = 0) and (TsfColorRec(SL[i]).B = $FF) then
          Continue
        else
          Pixels[i, j] := SL[i];
    end;
  finally
    Bitmap.Free;
  end;
end;

procedure TsfBitmap.DrawBevel(R: TRect; Color: TsfColor; Width: integer;
  Down: boolean);
begin

end;

procedure TsfBitmap.DrawEdge(R: TRect; RaisedColor,
  SunkenColor: TsfColor);
begin

end;

procedure TsfBitmap.DrawEllipse(R: TRect; Color: TsfColor);
begin

end;

procedure TsfBitmap.DrawFocusRect(R: TRect; Color: TsfColor);
begin

end;

procedure TsfBitmap.DrawLine(R: TRect; Color: TsfColor);
begin

end;

procedure TsfBitmap.DrawPolygon(Points: array of TPoint; Color: TColor);
begin

end;

procedure TsfBitmap.DrawRect(R: TRect; Color: TsfColor);
begin

end;

procedure TsfBitmap.DrawRoundRect(R: TRect; Radius: integer;
  Color: TsfColor);
begin

end;

function TsfBitmap.DrawText(AText: WideString; var Bounds: TRect;
  Flag: cardinal): integer;
begin
  Result := 0;
end;

function TsfBitmap.DrawText(AText: WideString; X, Y: integer): integer;
begin
  Result := 0;
end;

function TsfBitmap.DrawVerticalText(AText: WideString; Bounds: TRect;
  Flag: cardinal; FromTop: boolean): integer;
begin
  Result := 0;
end;

procedure TsfBitmap.FillEllipse(R: TRect; Color: TsfColor);
begin

end;

procedure TsfBitmap.FillGradientRect(Rect: TRect; BeginColor,
  EndColor: TsfColor; Vertical: boolean);
begin

end;

procedure TsfBitmap.FillHalftonePolygon(Points: array of TPoint; Color,
  HalfColor: TsfColor);
begin

end;

procedure TsfBitmap.FillHalftoneRect(R: TRect; Color,
  HalfColor: TsfColor);
begin

end;

procedure TsfBitmap.FillPolygon(Points: array of TPoint; Color: TColor);
begin

end;

procedure TsfBitmap.FillRadialGradientRect(Rect: TRect; BeginColor,
  EndColor: TsfColor; Pos: TPoint);
begin

end;

procedure TsfBitmap.FillRect(R: TRect; Color: TsfColor);
var
  Size, j: integer;
  AlphaLine: PsfColor;
begin
  if R.Left < 0 then R.Left := 0;
  if R.Top < 0 then R.Top := 0;
  if R.Right > Width then R.Right := Width;
  if R.Bottom > Height then R.Bottom := Height;
  if RectWidth(R) <= 0 then Exit;
  if RectHeight(R) <= 0 then Exit;

  if AlphaBlend then
  begin
    Size := RectWidth(R);
    GetMem(AlphaLine, SizeOf(TsfColor) * Size);
    try
      FillLongwordFunc(AlphaLine, Size, Color);
      for j := R.Top to R.Bottom-1 do
        LineAlphaBlendFunc(AlphaLine, PixelPtr[R.Left, j], Size);
    finally
      FreeMem(AlphaLine, SizeOf(TsfColor) * Size);
      EMMS;
    end;
  end
  else
    FillLongwordRectFunc(FBits