Author |
Topic |
|
yogiyang
India
727 Posts |
Posted - Sep 07 2012 : 05:27:45
|
I want to water mark images with text entered by user.
How can I do this.
I have attached a sample showing what I want to achieve.
TIA
Yogi Yang
Yogi Yang |
|
w2m
USA
1990 Posts |
Posted - Sep 07 2012 : 09:05:09
|
Hi Yogi:
Try this:
uses ImageEnProc, HYIEutils, HYIEdefs;
procedure IETextOut(Canvas: TCanvas; x, y: integer; angle: integer; const Text: string);
var
LogFont: TLogFont;
begin
with Canvas do
begin
GetObject(Font.Handle, SizeOf(TLogFont), @LogFont);
LogFont.lfEscapement := angle * 10;
LogFont.lfQuality := NONANTIALIASED_QUALITY;
LogFont.lfWeight := FW_BOLD;
Font.Handle := CreateFontIndirect(LogFont);
TextOut(x, y, Text);
DeleteObject(Font.Handle);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ImageEnView1.EnableAlphaChannel := True;
ImageEnView1.LayersSync := True;
end;
procedure TForm1.Watermark1Click(Sender: TObject);
var
i: integer;
j: integer;
iLayer: integer;
iSpacing: integer;
iText: string;
iRows: integer;
begin
Screen.Cursor := crHourGlass;
try
iLayer := ImageEnView1.LayersAdd;
ImageEnView1.Proc.Fill(CreateRGB(255, 255, 255));
ImageEnView1.Bitmap.Canvas.Font.Name := 'Arial';
ImageEnView1.Bitmap.Canvas.Font.Height := 25;
ImageEnView1.Bitmap.Canvas.Font.Color := clGray;
for i := 0 to 60 do
iText := iText + ' ' + Text1.Text;
iRows := 100;
for j := 0 to iRows do
begin
iSpacing := 150;
iSpacing := iSpacing * j;
IETextOut(ImageEnView1.Bitmap.Canvas, -60, iSpacing, 45, iText); // draw text on second layer
end;
// remove the white, making it as transparent
ImageEnView1.Proc.SetTransparentColors(CreateRGB(255, 255, 255), CreateRGB(255, 255, 255), 0);
ImageEnView1.LayersMergeAll;
ImageEnView1.Update;
finally
Screen.Cursor := crDefault;
end;
end;
I am sure this could be improved and optimised, but it seems to give you what you are looking for.
William Miller Adirondack Software & Graphics Email: w2m@frontiernet.net EBook: http://www.imageen.com/ebook/ Apprehend: http://www.frontiernet.net/~w2m/index.html |
|
|
yogiyang
India
727 Posts |
Posted - Sep 10 2012 : 07:43:48
|
Hello William,
Thanks for the solution.
Yogi Yang |
|
|
giancarlo
Italy
65 Posts |
Posted - Sep 19 2016 : 13:37:28
|
just a fix (for batch use and IE6.x):
procedure TForm1.Watermark1Click(Sender: TObject);
var
i: integer;
j: integer;
iLayer: integer;
iSpacing: integer;
iText: string;
iRows: integer;
begin
Screen.Cursor := crHourGlass;
try
iLayer := ImageEnView1.LayersAdd;
ImageEnView1.Proc.Fill(CreateRGB(255, 255, 255));
ImageEnView1.IEBitmap.Canvas.Font.Name := 'Arial';
ImageEnView1.IEBitmap.Canvas.Font.Height := 25;
ImageEnView1.IEBitmap.Canvas.Font.Color := clGray;
iText:='';
for i := 0 to 60 do
iText := iText + ' ' + Text1.Text;
iRows := 100;
for j := 0 to iRows do
begin
iSpacing := 150;
iSpacing := iSpacing * j;
IETextOut(ImageEnView1.IEBitmap.Canvas, -60, iSpacing, 45, iText); // draw text on second layer
end;
// remove the white, making it as transparent
ImageEnView1.Proc.SetTransparentColors(CreateRGB(255, 255, 255), CreateRGB(255, 255, 255), 0);
ImageEnView1.LayersMergeAll;
ImageEnView1.Update;
finally
Screen.Cursor := crDefault;
end;
end; |
|
|
abbasiali
5 Posts |
Posted - Sep 20 2016 : 14:01:48
|
Hi
Which code I most be write for print watermark with above procedure for image?
Best regards
Ali Abbasi |
|
|
xequte
38615 Posts |
|
abbasiali
5 Posts |
Posted - Sep 23 2016 : 03:55:54
|
Hi
Please help me I call above Watermark1Click procedure and I can not call it procedure!
I cannot make a watermark in a image with it procedure. For call watermark which I most write code for watermark "this is DEMO version"?
Best regards
Ali Abbasi |
|
|
xequte
38615 Posts |
Posted - Sep 23 2016 : 11:42:43
|
Hi Ali
If Text1.Text = 'this is DEMO version'
Then the code above should work fine for you.
Nigel Xequte Software www.xequte.com nigel@xequte.com
|
|
|
abbasiali
5 Posts |
Posted - Sep 23 2016 : 15:43:54
|
Hi Nigel
Watermark1Click(................); Please help me for arguments for it procedure for make similar Yogi Yang image.
Best regards
Ali Abbasi |
|
|
w2m
USA
1990 Posts |
Posted - Sep 23 2016 : 15:56:55
|
I tested the code here and found it functions correctly. What problem are you having? How does it not work? Show the code you are using.
Bill Miller Adirondack Software & Graphics Email: w2m@hughes.net EBook: http://www.imageen.com/ebook/ Custom Commercial ImageEn Development |
|
|
abbasiali
5 Posts |
Posted - Sep 23 2016 : 16:14:32
|
Hi Bill
Sorry, I Found my problem and fixed my problem. I think "procedure TForm1.Watermark1Click(Sender: TObject);" is procedure which working with "procedure IETextOut(Canvas: TCanvas; x, y: integer; angle: integer; const Text: string);"! Your sample is good and it was my mistake.
Best regards
Ali Abbasi |
|
|
john_siggy@yahoo.com
USA
158 Posts |
Posted - Nov 27 2016 : 18:28:14
|
I tried drawing text at an angle and it only worked on empty black images. I have a TImageEnVect being video refreshed in the NewFrame event of an TImageEnMView. The code is:
ImageEnVect1.IEBitmap.Assign(ImageEnMView1.GetTIEBitmap(idx)); ImageEnVect1.Update;
Cant see the text over the image;
Thanks |
|
|
xequte
38615 Posts |
|
john_siggy@yahoo.com
USA
158 Posts |
Posted - Nov 28 2016 : 14:07:45
|
Thank you for your excellent response. The watermark code works well but is very slow even putting out one line: "Demo Program",
Seems adding a layer and then merging layers is too slow. Is there some way to use IETextOut to the bitmap more directly.
Thanks again,
John |
|
|
xequte
38615 Posts |
|
|
Topic |
|