Umetanje podataka na sliku, i snimanje takve slike?!

Evo, mene opet! :)
Zelim da na sliku (jpg) velicine 1280x1024, snimim sa istom ekstenzijom, ali sa nekim podacima (Label) dodatim na tu sliku. Pokusavala sam to da uradim sa GetFormImage (tako sto na formu postavim sliku, i podatke pa onda upotrijebim tu funkciju), ali u tom slucaju, posto je rezolucija mog monitora manja od velicine slike, slika mi se odsjece, tj. dobijem samo dio slike koji tokom postavljanja forme postavljen kao vidljiv, a onog dijela sto se dobije pomicanjem scrollbara nema... Jos jedan problem s ovim mojim pokusajem jeste i taj sto mi se konverzijom iz bmp (koji dobijem sa GetFormImage) u jpg potpuno narusi kvalitet slike...

Da li postoji neki drugi način na koji bi se to moglo uraditi, da snimim samo sliku sa dodatim podacima na odredjenom mjestu na slici, bez toga da sliku ubacujem na formu, i kako u tom slucaju da dodam te podatke?!

Ili postoji neko rjesenje kako da mi se tom GetFormImage f-jom ne odsjeca slika i ne mijenja toliko primjetno kvaliteta slike...?!


Tenks in advans!

Potpis

Carpe diem!

opet ja sa delphi3000, ali ima tamo clanak kako da TJpegImage prebacis u TBitmap...onda tu mozes da koristis Bitmap.Canvas.TextOut(X, Y, 'Neki Text) i da posle ponovo kompresujes u jpg. mislim da ces naci sve primere za to tamo
pozdrav

Potpis

Ride the rainbow, crack the sky

DIY gitare, pojacala i efekti www.diy-fever.com

Hvala ti Bancika, uspjela sam se snaci! :)

Evo, primjera koji konvertuje sliku .jpg u .bmp, ispisuje na odredjenom mjestu 'Hello!', a zatim tu sliku konvertuje ponovo u .jpg, bez većih gubitaka na kvaliteti slike.
***********************************************************
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, JPEG, StdCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
Button2: TButton;
OpenDialog1: TOpenDialog;
Image1: TImage;
SaveDialog1: TSaveDialog;

procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }

end;

var
Form1: TForm1;
Bitmap: TBitmap;

implementation

{$R *.dfm}
Function Jpeg2Bitmap(JPEGFile : String) : TBitmap; //osim konverzije, ovdje se vrsi
//i ispis teksta na konvertovani
//.bmp file
var
oJPEG : TJPEGImage;
objLogFont: TLogFont;
fntSaveFont: TFont;
begin
oJPEG := TJPEGImage.Create ;
oJPEG.LoadFromFile(JPEGFile);
Result := TBitmap.Create;
Result.Assign(oJPEG);
fntSaveFont := TFont.Create;
Form1.Label1.Caption:='Hello!';
fntSaveFont.Assign(result.Canvas.Font);

with result.Canvas do begin
Font.Handle := CreateFontIndirect(objLogFont);
SetBkMode(Handle, TRANSPARENT);
Font.Assign(fntSaveFont);
Font.Size:=35;
Font.Name:='Arial';
Font.Color:=clGreen;

end;
result.Canvas.TextOut(10,240,Form1.Label1.Caption);
fntSaveFont.Free;
oJPEG.Free;

end;



procedure TForm1.FormCreate(Sender: TObject); //tokom kreiranja forme, ucitava se
//.jpg slika iz odredjenog direktorija
//te se pozivom fje Jpeg2Bitmap
//konvertuje u .bmp
var
oJPEG : tBitmap;
oBitmap: TBitmap;
begin
oJPEG := tBitmap.Create;

//Call the function to get the JPEG object.
oJPEG :=Jpeg2Bitmap('D:\LampOn.jpg');

//Now you can save it to a file or do something else with it.
oJPEG.SaveToFile('d:\LampOff.bmp');
oJPEG.Free;

end;

procedure TForm1.Button1Click(Sender: TObject); //ovim ucitavamo .bmp fajl

begin
if OpenDialog1.Execute then
begin
Bitmap:=TBitmap.Create;
Bitmap.LoadFromFile(OpenDialog1.FileName);
Image1.Picture.LoadFromFile(OpenDialog1.FileName);
end;
end;


procedure TForm1.Button2Click(Sender: TObject); //konvertuje se .bmp u .jpg
var
JPEGImage: TJPEGImage;
begin
try
JPEGImage:=TJPEGImage.Create;
JPEGImage.CompressionQuality:=80;
JPEGImage.Assign(Bitmap);
if SaveDialog1.Execute then
JPEGImage.SaveToFile(SaveDialog1.FileName);
Label1.Caption:='Konverzija izvrsena!';
finally
Bitmap.Free;
JPEGImage.Free;
end;
end;


end.

Potpis

Carpe diem!

ono za transparentan canvas bg nisam znao...cool :)
znas kako sam ja to radio? napravim bitmapu sa nekim textom pa je stavim u TImageList pa je onda iscrtam i ne vidi se pozadina.

PS platices mi zbog onih 100 klikova :)

Potpis

Ride the rainbow, crack the sky

DIY gitare, pojacala i efekti www.diy-fever.com

Tu ideju sam "ukrala" iz jednog primjera sto sam nasla na onom tvom linku! :) Evo, taj cijeli primjer koji ispisuje tekst sa transparentnom pozadinom, i to pod zadanim uglom.

CLICK! :)
***************************************************************


// this proc draws a text angled on specified canvas
procedure TextOutAngled(const Canvas: TCanvas; const X, Y: integer; const strText: string; intAngle, intFontSize: integer );
var
objLogFont: TLogFont;
fntSaveFont: TFont;
begin
// creates a new temp TFont object
fntSaveFont := TFont.Create;
fntSaveFont.Assign(Canvas.Font);

// get the font "properties"
GetObject(fntSaveFont.Handle, SizeOf(TLogFont), @objLogFont);

with objLogFont do begin
lfHeight := intFontSize * 2;
lfEscapement := intAngle * 10;
lfQuality := PROOF_QUALITY;
lfPitchAndFamily := DEFAULT_PITCH or FF_DONTCARE;
end;

with Canvas do begin
Font.Handle := CreateFontIndirect(objLogFont);
SetBkMode(Handle, TRANSPARENT);
TextOut(X, Y, strText);
Font.Assign(fntSaveFont);
end;

// destroys the "save" font
fntSaveFont.Free;
end;

{---------------------------------------------------------------------}

Sample of use:

TextOutAngled(Form1.Canvas, 200, 200, 'Sample of Angled Text', 10, 36);
//predzadnji parametar predstavlja ugao pod kojim se tekst ispisuje

Potpis

Carpe diem!