## 2008. július 22., kedd

### Create a watermark

Problem/Question/Abstract:

How to create a watermark

Solve 1:

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 > 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;
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];
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 and 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.

Solve 2:

If you sport a company (or other) logo, you might want to display it on your program's GUI, but unobtrusively and matching the user's color preferences. This can be done by displaying it as a "watermark" with colors only slightly different from the background color. All you have to do is to add a Timage with a 2- or 3-color bitmap. One color (usually the one at the lower left corner of the bitmap) becomes the transparent color (be sure to set Image.Transparent := True), the other one or two are changed at runtime to the watermark colors:

var
clWatermd: TColor;
clWaterml: TColor;
begin
{Set watermark colors slightly off parent}
clWatermd := ColorToRGB(Panel1.Color) - \$101010;
clWaterml := ColorToRGB(Panel1.Color) + \$080808;
with Image2 do
begin
{Modify moon color to watermark color}
Canvas.Brush.Color := clWaterml;
Canvas.FloodFill(20, 20, clSilver, fsSurface);
Canvas.FloodFill(51, 42, clSilver, fsSurface);
{Modify wolf color to watermark color}
Canvas.Brush.Color := clWatermd;
Canvas.FloodFill(60, 60, clBlack, fsSurface);
end;
end;

In the example above, clSilver in the original bitmap is displayed slightly brighter than the background, clBlack slightly darker. The point coordinates lie somewhere within the colored areas, separate areas must all be separately handled. On 256 color displays, the watermark colors may be 'slightly' off the desired effect, so use is only recommended on higher color resolutions.