Some time ago, I posted a request for help regarding watermarks on
photos. The only reply was for text with transparent background. After
a lot of frustration, I have come up with an answer, be it slow. If
anyone can suggest a quicker way, or code the Colour adjustment in
assembler it would be appreciated.
How it works: On a hidden image, sized to suit the final text, print
text in black. Then by using the Pixels[] property, interrogate the
hidden image. Where a pixel is black, adjust the red/green/blue
settings of a corresponding pixel in the photograph.
The following procedure MakeWatermark will do just that, placing the
text where you want it.
type
wmType=(
wmTopLeft,wmTopCentre,wmTopRight,
wmCentreLeft,wmCentre,wmCentreRight,
wmBottomLeft,wmBottomCentre,wmBottomRight,
wmRndXRndY,wmSetXRndY,wmRndXSetY,wmSetXSetY);
function Limit256(I:integer):integer;
begin
if I<0 then I:=0;
if I>255 then I:=255;
Limit256:=I;
end;
function ColourAdjust(Z,R,G,B:integer):integer;
var B1,G1,R1:integer;
begin {shl 1 = Multiply by 2} {TColor}
R1:=Limit256((Z and $000000FF) +R);
G1:=Limit256(((Z and $0000FF00) shr 8) +G);
B1:=Limit256(((Z and $00FF0000) shr 16) +B);
ColourAdjust:=(B1 shl 16) + (G1 shl 8) +R1;
end;
procedure TForm1.MakeWatermark( const wmMode:wmType;
var vImage:TImage;
const Txt,FntName:string; FntStyle:TFontStyles;
FntSize,X,Y,AdjRed,AdjGrn,AdjBlu:integer);
var
I,J,IH,IW,TH,TW,Z:integer;
TmpImg:TImage;
begin
TmpImg:=TImage.Create(Form1);
TmpImg.Picture:=nil;
with TmpImg do
begin
Canvas.Pen.Color:=clWhite;
Canvas.Pen.Style:=psSolid;
Canvas.Font.Name:=FntName;
Canvas.Font.Color:=clBlack;
Canvas.Font.Style:=FntStyle;
if FntSize>0 then
begin
Canvas.Font.Size:=FntSize;
TW:=Canvas.TextWidth(Txt);
TH:=Canvas.TextHeight(Txt);
end
else
begin
TW:=vImage.Width;
TH:=vImage.Height;
I:=7;
repeat
inc(I);
Canvas.Font.Size:=I;
until (Canvas.TextWidth(Txt)>TW) or
(Canvas.TextHeight(Txt)>TH);
dec(I);
Canvas.Font.Size:=I;
TW:=Canvas.TextWidth(Txt);
TH:=Canvas.TextHeight(Txt);
end;
end;
TmpImg.Width:=TW;
TmpImg.Picture.Bitmap.Width:=TW;
TmpImg.Height:=TH;
TmpImg.Picture.Bitmap.Height:=TH;
TmpImg.Repaint;
TmpImg.Canvas.TextOut(0,0,Txt);
TmpImg.Refresh;
if TmpImg.Canvas.Pixels[0,0]<0 then
ShowMessage('TmpImg pixel error.');
if vImage.Picture.Bitmap.Canvas.Pixels[0,0]<0 then
ShowMessage('vImage pixel error.');
IW:=vImage.Picture.Width;
IH:=vImage.Picture.Height;
case wmMode of
wmTopLeft:
begin
X:=0;
Y:=0;
end;
wmTopCentre:
begin
X:=IW div 2 - TW div 2;
Y:=0;
end;
wmTopRight:
begin
X:=IW -TW;
Y:=0;
end;
wmCentreLeft:
begin
X:=0;
Y:=IH div 2 - TH div 2;
end;
wmCentre:
begin
X:=IW div 2 - TW div 2;
Y:=IH div 2 - TH div 2;
end;
wmCentreRight:
begin
X:=IW -TW;
Y:=IH div 2 - TH div 2;
end;
wmBottomLeft:
begin
X:=0;
Y:=IH -TH;
end;
wmBottomCentre:
begin
X:=IW div 2 - TW div 2;
Y:=IH -TH;
end;
wmBottomRight:
begin
X:=IW -TW;
Y:=IH -TH;
end;
wmRndXRndY:
begin
X:=Random(IW-TW);
Y:=Random(IH-TH);
end;
wmSetXRndY:
begin
{X passed}
Y:=Random(IH-TH);
end;
wmRndXSetY:
begin
X:=Random(IW-TW);
{Y passed}
end;
wmSetXSetY:
begin
{X passed}
{Y passed}
DoNothing;
end;
end;
for I:=0 to TW do
for J:= 0 to TH do
if TmpImg.Canvas.Pixels[I,J]=clBlack then
begin
Z:=vImage.Picture.Bitmap.Canvas.Pixels[I+X,J+Y];
Z:=ColourAdjust(Z,AdjRed,AdjGrn,AdjBlu);
vImage.Picture.Bitmap.Canvas.Pixels[I+X,J+Y]:=Z;
end;
TmpImg.Free;
end;
Call MakeWatermark with the following parameters:
* watermark type eg wmTopLeft places the watermark in the top left of
the image;
* Image to be watermarked;
* Text to be shown;
* Name of the font to use;
* style of the font eg [fsBold,fsItalic];
* size of the text, use -1 for maximum size;
* X & Y co-ordinates (used only in wmSetXRndY, wmRndXSetY and
wmSetXSetY, X being only used where type contains "SetX";
* adjustments for Red, Green, and Blue, negative = darken.
If the image you wish to watermark objects to reading the pixels then
an error message will be given and the procedure exited.
This may not be be the best solution, but it works and is offered as a
community thank you to all those who have in the past and will in the
future answer a question or two from me.
