tebitmap.pas

这个东西的功能很强大

  for i := 0 to FWidth * FHeight - 1 do
  begin
    if (TteColorRec(C^).A > 0) and (TteColorRec(C^).A < $FF) then
    begin
      FAlphaBlend := true;
      Break;
    end;

    Inc(C);
  end;
end;

procedure TteBitmap.CheckingAlphaBlend(ARect: TRect);
var
  i, j: integer;
  C: PteColor;
begin
  FAlphaBlend := false;

  for i := 0 to FWidth - 1 do
    for j := 0 to FHeight - 1 do
    begin
      C := PixelPtr[i, j];
      if (TteColorRec(C^).A > 0) and (TteColorRec(C^).A < $FF) then
      begin
        FAlphaBlend := true;
        Break;
      end;
    end;
end;

procedure TteBitmap.CheckingTransparent(Color: TteColor = teTransparent);
var
  i: integer;
  C: PteColor;
begin
  FTransparent := false;

  C := @FBits[0];
  for i := 0 to FWidth * FHeight - 1 do
  begin
    if (Abs(TteColorRec(C^).R - TteColorRec(Color).R) < Quantity) and
       (Abs(TteColorRec(C^).G - TteColorRec(Color).G) < Quantity) and
       (Abs(TteColorRec(C^).B - TteColorRec(Color).B) < Quantity)
    then
    begin
      C^ := teTransparent;
      FTransparent := true;
    end;

    Inc(C);
  end;
end;

procedure TteBitmap.CheckingTransparent(ARect: TRect; Color: TteColor = teTransparent);
var
  i, j: integer;
  C: PteColor;
begin
  FAlphaBlend := false;

  for i := 0 to FWidth - 1 do
    for j := 0 to FHeight - 1 do
    begin
      C := PixelPtr[i, j];
      if (Abs(TteColorRec(C^).R - TteColorRec(Color).R) < Quantity) and
         (Abs(TteColorRec(C^).G - TteColorRec(Color).G) < Quantity) and
         (Abs(TteColorRec(C^).B - TteColorRec(Color).B) < Quantity)
      then
      begin
        C^ := teTransparent;
        FTransparent := true;
      end;
    end;
end;

procedure TteBitmap.SetAlpha(Alpha: byte);
begin
  if Empty then Exit;
  FillAlphaFunc(Bits, FWidth * FHeight - 1, Alpha);
end;

procedure TteBitmap.SetAlpha(Alpha: byte; Rect: TRect);
begin
  if RectWidth(Rect) = 0 then Exit;
  if RectHeight(Rect) = 0 then Exit;

  if Rect.Left < 0 then Rect.Left := 0;
  if Rect.Top < 0 then Rect.Top := 0;
  if Rect.Right > FWidth then Rect.Right := FWidth;
  if Rect.Bottom > FHeight then Rect.Bottom := FHeight;
  FillAlphaRectFunc(FBits, FWidth, FHeight, Rect.Left, Rect.Top, Rect.Right-1,
    Rect.Bottom - 1, Alpha);
end;

{ Access properties }

function TteBitmap.GetScanLine(Y: Integer): PteColorArray;
begin
  Result := @Bits[Y * FWidth];
end;

function TteBitmap.GetPixelPtr(X, Y: Integer): PteColor;
begin
  Result := @Bits[X + Y * FWidth];
end;

function TteBitmap.GetPixel(X, Y: Integer): TteColor;
begin
  if (FBits <> nil) and (X >= 0) and (Y >= 0) and (X < Width) and (Y < Height) then
    Result := PixelPtr[X, Y]^
  else
    Result := 0;
end;

procedure TteBitmap.SetPixel(X, Y: Integer; Value: TteColor);
begin
  if X < 0 then Exit;
  if Y < 0 then Exit;
  if X > Width then Exit;
  if Y > Height then Exit;

  if FBits <> nil then
    PixelPtr[X, Y]^ := Value;
end;

{ BitmapLink }

function TteBitmap.GetBitmapLink(Rect: TRect): TteBitmapLink;
begin
  Result := TteBitmapLink.Create;
  Result.Image := Self;
  Result.Name := Name;
  Result.Rect := Rect;
end;

function TteBitmap.GetBitmapLink(Rect: string): TteBitmapLink;
begin
  Result := TteBitmapLink.Create;
  Result.Image := Self;
  Result.Name := Name;
  Result.Rect := StringToRect(Rect);
end;

{ Color transition ============================================================}

procedure TteBitmap.ChangeBitmapBrightness(DeltaBrightness: integer);
var
  i: integer;
  Color: PteColor;
begin
  if FWidth * FHeight = 0 then Exit;

  for i := 0 to FWidth * FHeight - 1 do
  begin
    Color := @Bits[i];
    if (TteColorRec(Color^).A = 0) then Continue;
    Color^ := ChangeBrightness(Color^, DeltaBrightness);
  end;
end;

procedure TteBitmap.ChangeBitmapHue(DeltaHue: integer);
var
  i: integer;
  Color: PteColor;
begin
  if FWidth * FHeight = 0 then Exit;

  for i := 0 to FWidth * FHeight - 1 do
  begin
    Color := @Bits[i];
    if (TteColorRec(Color^).A = 0) then Continue;
    Color^ := ChangeHue(Color^, DeltaHue);
  end;
end;

{ Draw to XXX =================================================================}

procedure TteBitmap.Draw(DC: HDC; X, Y: integer);
begin
  Draw(DC, X, Y, Rect(0, 0, Width, Height));
end;

procedure TteBitmap.Draw(DC: HDC; X, Y: integer; SrcRect: TRect);
begin
  Draw(DC, Rect(X, Y, X + RectWidth(SrcRect), Y + RectHeight(SrcRect)), SrcRect);
end;

procedure TteBitmap.Draw(DC: HDC; DstRect: TRect);
begin
  Draw(DC, DstRect, Rect(0, 0, FWidth, FHeight));
end;

procedure TteBitmap.Draw(DC: HDC; DstRect, SrcRect: TRect);
{$WARNINGS OFF}
var
  Dst: TteBitmap;
  P: TPoint;
  BitmapW, BitmapH, BitmapBCount: integer;
  BitmapBits: PByteArray;
begin
  Dst := FindBitmapByDC(DC);
  if Dst <> nil then
  begin
    { Adjust WindowOrg }
    GetWindowOrgEx(DC, P);
    OffsetRect(DstRect, -P.X, -P.Y);
    { Destination is KS Bitmap }
    Draw(Dst, DstRect, SrcRect);
  end
  else
  begin
    BitmapBits := GetBitsFromDCFunc(DC, BitmapW, BitmapH, BitmapBCount);
    if EnableDibOperation and (BitmapBits <> nil) and (BitmapBCount = 32) and (BitmapH > 0) then
    begin
      { Adjust WindowOrg }
      GetWindowOrgEx(DC, P);
      OffsetRect(DstRect, -P.X, -P.Y);
      { Draw to DIB }
      if FAlphaBlend then
        StretchToDibAlphaBlendFunc(BitmapBits, DstRect, DstRect, BitmapW, BitmapH,
          Self, SrcRect)
      else
        if FTransparent then
          StretchToDibTransparentFunc(BitmapBits, DstRect, DstRect, BitmapW, BitmapH,
            Self, SrcRect)
        else
          StretchToDibOpaqueFunc(BitmapBits, DstRect, DstRect, BitmapW, BitmapH,
            Self, SrcRect);
    end
    else
    begin
      { Draw to DC }
      if FAlphaBlend then
        StretchToDCAlphaBlendFunc(DC, DstRect.Left, DstRect.Top, RectWidth(DstRect), RectHeight(DstRect),
          Self, SrcRect.Left, SrcRect.Top, RectWidth(SrcRect), RectHeight(SrcRect))
      else
        if FTransparent then
          StretchToDCTransparentFunc(DC, DstRect.Left, DstRect.Top, RectWidth(DstRect), RectHeight(DstRect),
            Self, SrcRect.Left, SrcRect.Top, RectWidth(SrcRect), RectHeight(SrcRect))
        else
          StretchToDCOpaqueFunc(DC, DstRect.Left, DstRect.Top, RectWidth(DstRect), RectHeight(DstRect),
            Self, SrcRect.Left, SrcRect.Top, RectWidth(SrcRect), RectHeight(SrcRect));
    end;
  end;
{$WARNINGS ON}
end;

procedure TteBitmap.Draw(Canvas: TCanvas; X, Y: integer);
begin
  {$IFNDEF KS_CLX}
  Draw(Canvas.Handle, X, Y);
  {$ELSE}
  Canvas.Start;
  try
    QPainter_drawImage(Canvas.Handle, X, Y, FImage, 0, 0, FWidth, FHeight, -1);
  finally
    Canvas.Stop;
  end;
  {$ENDIF}
end;

procedure TteBitmap.Draw(Canvas: TCanvas; X, Y: integer; SrcRect: TRect);
begin
  Draw(Canvas, Rect(X, Y, X + RectWidth(SrcRect), Y + RectHeight(SrcRect)), SrcRect);
end;

procedure TteBitmap.Draw(Canvas: TCanvas; DstRect: TRect);
begin
  Draw(Canvas, DstRect, Rect(0, 0, FWidth, FHeight));
end;

procedure TteBitmap.Draw(Canvas: TCanvas; DstRect, SrcRect: TRect);
begin
  {$IFNDEF KS_CLX}
  Draw(Canvas.Handle, DstRect, SrcRect);
  {$ELSE}
  Canvas.Start;
  try
    QPainter_drawImage(Canvas.Handle, X, Y, FImage, 0, 0, FWidth, FHeight, -1);
  finally
    Canvas.Stop;
  end;
  {$ENDIF}
end;

procedure TteBitmap.Draw(Bitmap: TteBitmap; X, Y: integer);
begin
  Draw(Bitmap, X, Y, Rect(0, 0, Width, Height));
end;

procedure TteBitmap.Draw(Bitmap: TteBitmap; X, Y: integer;
  SrcRect: TRect);
begin
  Draw(Bitmap, Rect(X, Y, X + RectWidth(SrcRect), Y + RectHeight(SrcRect)), SrcRect);
end;

procedure TteBitmap.Draw(Bitmap: TteBitmap; DstRect: TRect);
begin
  Draw(Bitmap, DstRect, Rect(0, 0, FWidth, FHeight));
end;

procedure TteBitmap.Draw(Bitmap: TteBitmap; DstRect, SrcRect: TRect);
begin
  if AlphaBlend then
    StretchAlphaBlendFunc(Bitmap, DstRect, DstRect, Self, SrcRect)
  else
    if Transparent then
      StretchTransparentFunc(Bitmap, DstRect, DstRect, Self, SrcRect)
    else
      StretchOpaqueFunc(Bitmap, DstRect, DstRect, Self, SrcRect)
end;

procedure TteBitmap.Tile(DC: HDC; 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(DC, R, R1);
      end
      else
        Draw(DC, R, SrcRect);
    end;
end;

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

procedure TteBitmap.Tile(Bitmap: TteBitmap; 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 TteBitmap.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 TteBitmap.TileClip(Canvas: TCanvas; DstRect, DstClip, SrcRect: TRect);
begin
  TileClip(Canvas.Handle, DstRect, DstClip, SrcRect);
end;

procedure TteBitmap.TileClip(Bitmap: TteBitmap; DstRect, DstClip, SrcRect: TRect);
var
  i, j: integer;
  R, R1, ClipRes, SrcR: TRect;
  Cx, Cy: integer;
  W, H, DW, DH: integer;
  IsClip: boolean;
begin