Ver Mensaje Individual
  #14  
Antiguo 08-09-2006
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Reputación: 24
seoane Va por buen camino
Continuando mi mensaje anterior, para que nadie caiga en la tentación de usar el photoshop para eliminar la marca de agua, vamos a complicarlo un poquito mas:

Código Delphi [-]
// Esto provoca un efecto muy bonito y dificil de reproducir con el photshop
procedure Colorear(Bitmap: TBitmap);
var
  P: PByte;
  i,j: Integer;
begin
  Bitmap.PixelFormat:= pf24bit;
  for j:= 0 to Bitmap.Height - 1 do
  begin
    P:= Bitmap.ScanLine[j];
    for i := 0 to (Bitmap.Width*3)-1 do
    begin
      if P^ > 0 then
        P^:= Byte(i * j);
      inc(P);
    end;
  end;
end;

procedure Marcar(Bitmap: TBitmap; Texto: String);
var
  Marca: TBitmap;
  i,j: Integer;
begin
  Marca:= TBitmap.Create;
  try
    Marca.Canvas.Brush.Color:= clBlack;
    Marca.Canvas.Font.Name:= 'Arial';
    // Ajusta el tamaño de la fuente si es necesario
    Marca.Canvas.Font.Size:= 72;
    Marca.Canvas.Font.Color:= clWhite;
    Marca.Canvas.Font.Style:= [fsBold, fsItalic];
    Marca.Width:= Marca.Canvas.TextWidth(Texto);
    Marca.Height:= Marca.Canvas.TextHeight(Texto);
    Marca.Canvas.TextOut(0,0,Texto);
    Colorear(Marca);  // Esto es lo nuevo
    i:= (Bitmap.Width - Marca.Width) div 2;
    j:= (Bitmap.Height - Marca.Height) div 2;
    Bitblt(Bitmap.Canvas.Handle,i,j,Marca.Width,Marca.Height,
      Marca.Canvas.Handle, 0, 0, SRCINVERT);
  finally
    Marca.Free;
  end;
end;
Responder Con Cita