tebitmap.pas

这个东西的功能很强大

  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 TteBitmap.MergeDraw(Bitmap: TteBitmap; X, Y: integer; SrcRect: TRect);
var
  Index, i, j: integer;
  B, F: PteColor;
  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 TteBitmap.DrawGraphic(Graphic: TGraphic; DstRect: TRect);
var
  Bitmap: TBitmap;
  SL: PteColorArray;
  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 (TteColorRec(SL[i]).R = $FF) and (TteColorRec(SL[i]).G = 0) and (TteColorRec(SL[i]).B = $FF) then
          Continue
        else
          Pixels[i, j] := SL[i];
    end;
  finally
    Bitmap.Free;
  end;
end;

procedure TteBitmap.DrawBevel(R: TRect; Color: TteColor; Width: integer;
  Down: boolean);
begin

end;

procedure TteBitmap.DrawEdge(R: TRect; RaisedColor,
  SunkenColor: TteColor);
begin

end;

procedure TteBitmap.DrawEllipse(R: TRect; Color: TteColor);
begin

end;

procedure TteBitmap.DrawFocusRect(R: TRect; Color: TteColor);
begin

end;

procedure TteBitmap.DrawLine(R: TRect; Color: TteColor);
begin

end;

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

end;

procedure TteBitmap.DrawRect(R: TRect; Color: TteColor);
begin

end;

procedure TteBitmap.DrawRoundRect(R: TRect; Radius: integer;
  Color: TteColor);
begin

end;

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

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

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

procedure TteBitmap.FillEllipse(R: TRect; Color: TteColor);
begin

end;

procedure TteBitmap.FillGradientRect(Rect: TRect; BeginColor,
  EndColor: TteColor; Vertical: boolean);
begin

end;

procedure TteBitmap.FillHalftonePolygon(Points: array of TPoint; Color,
  HalfColor: TteColor);
begin

end;

procedure TteBitmap.FillHalftoneRect(R: TRect; Color,
  HalfColor: TteColor);
begin

end;

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

end;

procedure TteBitmap.FillRadialGradientRect(Rect: TRect; BeginColor,
  EndColor: TteColor; Pos: TPoint);
begin

end;

procedure TteBitmap.FillRect(R: TRect; Color: TteColor);
var
  Size, j: integer;
  AlphaLine: PteColor;
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(TteColor) * 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(TteColor) * Size);
      EMMS;
    end;
  end
  else
    FillLongwordRectFunc(FBits, FWidth, FHeight, R.Left, R.Top, R.Right-1, R.Bottom - 1, Color);
end;

procedure TteBitmap.FillRoundRect(R: TRect; Radius: integer;
  Color: TteColor);
begin

end;

procedure TteBitmap.LineTo(X, Y: integer; Color: TteColor);
begin

end;

procedure TteBitmap.MoveTo(X, Y: integer);
begin

end;

function TteBitmap.TextHeight(AText: WideString): integer;
begin
  Result := 0;
end;

function TteBitmap.TextWidth(AText: WideString; Flags: Integer): integer;
begin
  Result := 0;
end;

procedure TteBitmap.FlipHorz;
var
 J, J2: Integer;
 Buffer: PteColorArray;
 P1, P2: PteColor;
begin
   J2 := Height - 1;
   GetMem(Buffer, Width shl 2);
   for J := 0 to Height div 2 - 1 do
   begin
     P1 := PixelPtr[0, J];
     P2 := PixelPtr[0, J2];
     MoveLongwordFunc(P1, PteColor(Buffer), Width);
     MoveLongwordFunc(P2, P1, Width);
     MoveLongwordFunc(PteColor(Buffer), P2, Width);
     Dec(J2);
   end;
   FreeMem(Buffer);
end;

{ TteBitmapLink ================================================================}

constructor TteBitmapLink.Create;
begin
  inherited Create;
end;

destructor TteBitmapLink.Destroy;
begin
  inherited Destroy;
end;

procedure TteBitmapLink.Assign(Source: TPersistent);
begin
  if Source is TteBitmapLink then
  begin
    FImage := (Source as TteBitmapLink).FImage;
    FRect := (Source as TteBitmapLink).FRect;
    FName := (Source as TteBitmapLink).FName;
    FMasked := (Source as TteBitmapLink).FMasked;
    FMaskedBorder := (Source as TteBitmapLink).FMaskedBorder;
    FMaskedAngles := (Source as TteBitmapLink).FMaskedAngles;
  end
  else
    inherited;
end;

procedure TteBitmapLink.LoadFromStream(Stream: TStream);
begin
  FName := ReadString(Stream);
  Stream.Read(FRect, SizeOf(FRect));
end;

procedure TteBitmapLink.SaveToStream(Stream: TStream);
begin
  WriteString(Stream, FName);
  Stream.Write(FRect, SizeOf(FRect));
end;

procedure TteBitmapLink.CheckingMasked(Margin: TRect);
var
  i, j: integer;
  P: TteColor;
  Pt: TPoint;
begin
  FMasked := false;
  FMaskedBorder := false;
  FMaskedAngles := false;

  if (Margin.Left = 0) and (Margin.Top = 0) and (Margin.Right = 0) and (Margin.Right = 0) then
  begin
    for i := Left to Right - 1 do
      for j := Top to Bottom - 1 do
      begin
        if (FImage.Bits <> nil) and (i >= 0) and (j >= 0) and (i < FImage.Width) and (j < FImage.Height) then
          P := PteColor(@FImage.Bits[i + j * FImage.Width])^
        else
          P := 0;

        if P <> teNone then
        begin
          if P = teTransparent then
          begin
            FMasked := true;
            Break;
          end;
          if TteColorRec(P).A < $FF then
          begin
            FMasked := true;
            Break;
          end;
        end;
      end;
  end
  else
  begin
    for i := Left to Right - 1 do
      for j := Top to Bottom - 1 do
      begin
        if (FImage.Bits <> nil) and (i >= 0) and (j >= 0) and (i < FImage.Width) and (j < FImage.Height) then
          P := PteColor(@FImage.Bits[i + j * FImage.Width])^
        else
          P := 0;

        if P <> teNone then
        begin
          if (P = teTransparent) or (TteColorRec(P).A < $FF) then
          begin
            Pt := Point(i - Left, j - Top);
            { Check angles }
            if PtInRect(Classes.Rect(0, 0, Margin.Left, Margin.Top), Pt) then
              FMaskedAngles := true;
            if PtInRect(Classes.Rect(Right - Margin.Right, 0, Right, Margin.Top), Pt) then
              FMaskedAngles := true;
            if PtInRect(Classes.Rect(Right - Margin.Right, Bottom - Margin.Bottom, Right, Bottom), Pt) then
              FMaskedAngles := true;
            if PtInRect(Classes.Rect(0, Bottom - Margin.Bottom, Margin.Left, Bottom), Pt) then
              FMaskedAngles := true;

            { Check borders }
            if PtInRect(Classes.Rect(Margin.Left, 0, Right - Margin.Right, Margin.Top), Pt) then
              FMaskedBorder := true;
            if PtInRect(Classes.Rect(Margin.Left, Bottom - Margin.Bottom, Right - Margin.Right, Bottom), Pt) then
              FMaskedBorder := true;
            if PtInRect(Classes.Rect(0, Margin.Top, Margin.Left, Bottom - Margin.Bottom), Pt) then
              FMaskedBorder := true;
            if PtInRect(Classes.Rect(Right - Margin.Right, Margin.Top, Right, Bottom - Margin.Bottom), Pt) then
              FMaskedBorder := true;

            if PtInRect(Classes.Rect(Margin.Left, Margin.Top, Right - Margin.Right, Bottom - Margin.Bottom), Pt) then
              FMasked := true;
          end;
        end;
      end;
  end;
end;

procedure TteBitmapLink.CheckingMasked;
begin
  CheckingMasked(Classes.Rect(0, 0, 0, 0));
end;

procedure TteBitmapLink.Draw(Bitmap: TteBitmap; X, Y: integer);
begin
  if FImage = nil then Exit;
  if FImage.Empty then Exit;
  if FRect.Right - FRect.Left <= 0 then Exit;
  if FRect.Bottom - FRect.Top <= 0 then Exit;
  { Draw bitmap link }
  FImage.Draw(Image, X, Y, FRect);
end;

procedure TteBitmapLink.Draw(Canvas: TCanvas; X, Y: integer);
begin
  if FImage = nil then Exit;
  if FImage.Empty then Exit;
  if FRect.Right - FRect.Left <= 0 then Exit;
  if FRect.Bottom - FRect.Top <= 0 then Exit;
  { Draw bitmap link }
  FImage.Draw(Canvas, X, Y, FRect);
end;

function TteBitmapLink.GetAssigned: boolean;
begin
  Result := (FImage <> nil) and ((FRect.Right - FRect.Left) * (FRect.Bottom - FRect.Top) > 0);
end;

function TteBitmapLink.GetBottom: integer;
begin
  Result := FRect.Bottom;
end;

function TteBitmapLink.GetLeft: integer;
begin
  Result := FRect.Left;
end;

function TteBitmapLink.GetRight: integer;
begin
  Result := FRect.Right;
end;

function TteBitmapLink.GetTop: integer;
begin
  Result := FRect.Top;
end;

procedure TteBitmapLink.SetBottom(const Value: integer);
begin
  FRect.Bottom := Value;
end;

procedure TteBitmapLink.SetLeft(const Value: integer);
begin
  FRect.Left := Value;
end;

procedure Tte