Teknik menambahkan tulisan pada gambar
Terkadang kita butuh untuk membuat atau menambahkan tulisan pada gambar... misalnya kita ingin mengirimkan surat dengan gambar yang kita pilih dan diatasnya dituliskan nama penerimanya. Langkah sederhananya adalah mengambil pixel dari tulisan (misal dari komponen label) kemudian pixel itu di timpakan ke komponen gambar. Berikut saya berikan contohnya.
//potongan programnya
procedure TForm1.Button1Click(Sender: TObject);
var
pColor: TColor;
j,k, ATop, ALeft : integer;
PropWidth, PropHeight : Double;
S : TImage;
APath,p : string;
begin
txtNama.Visible := False;
APath := ExtractFileDir(Application.ExeName);
if not FileExists(APath+'\und51.bmp') then
begin
ShowMessage('File Not Found!!!');
Exit;
end;
image1.Picture.LoadFromFile(APath+'\und51.bmp');
pgBar.MaxValue := lblNama.Height;
pgBar.Progress := 0;
S := TImage(Form1.FindComponent('imglblNama'));
if ((S = NIL) ) then
begin
S := TImage.Create(Self);
S.Name := 'imglblNama';
S.Width := lblNama.Width;
S.Height := lblNama.Height;
S.Top := lblNama.Top;
S.Left := lblNama.Left;
S.Parent := lblNama.Parent;
end;
lblNama.Update;
S := TImage(Form1.FindComponent('imglblNama'));
S.Width := lblNama.Width;
S.Height:= lblNama.Height;
S.Update;
PropWidth := 1;
PropHeight := 1;
ATop := StrToInt(eY.Text);
ALeft:= StrToInt(eX.Text);
image1.Update;
for j := 00 to lblNama.Height-1 do
begin
for k := 00 to lblNama.Width-1 do
begin
pColor := GetPixel(lblNama.Canvas.Handle, k, j);
SetPixel(image1.Picture.Bitmap.Canvas.Handle, k+ALeft, j+ATop, pColor);
end;
pgBar.AddProgress(1);
end;
AFilename := APath+'\und_'+lblNama.Caption+'.bmp';
AFilename := StringReplace(AFilename,#13#10,'',[rfReplaceAll]);
image1.Picture.SaveToFile(AFilename);
ImgResult.Picture.LoadFromFile(AFilename);
txtNama.Visible := True;
end;
Dari program di atas saya implementasikan untuk membuat program aplikasi undangan pernikahan saya.
Download
Hasilnya.
