Image1-re írás, kép behívás után Delphiben
2016-07-14T12:45:47+02:00
2016-07-16T19:06:42+02:00
2022-07-19T08:01:02+02:00
Retteket Iván
Üdv 

Lenne egy olyan gondom, hogy meglévő jpg képre rá kellene írnom egy kis szöveget. A jpg fájl behívása, mentése nem gond. A ráírás annál inkább gondot okoz. A google a barátom, de nem segített most. Köszi előre is a segítséget.

Eddig jutottam:

unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ExtDlgs, Vcl.Buttons; type TForm1 = class(TForm) btOpen: TButton; btWrite: TButton; btSave: TButton; Image1: TImage; OpenPD: TOpenPictureDialog; SavePD: TSavePictureDialog; procedure btWriteClick(Sender: TObject); procedure btOpenClick(Sender: TObject); procedure btSaveClick(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} uses Jpeg; procedure TForm1.btOpenClick(Sender: TObject); begin if OpenPD.Execute then if FileExists(OpenPD.FileName) then Image1.Picture.LoadFromFile(OpenPD.FileName) else raise Exception.Create('A fájl nem létezik.'); end; procedure TForm1.btSaveClick(Sender: TObject); begin if SavePD.Execute then if FileExists(SavePD.FileName) then raise Exception.Create('A fájl már létezik. Nem lehet felülírni.') else Image1.Picture.SaveToFile(SavePD.FileName); end; procedure TForm1.btWriteClick(Sender: TObject); begin Image1.Canvas.Brush.Style:=bsClear; Image1.Canvas.Pen.Color:=clWhite; Image1.Canvas.Font.Color := clRed; Image1.Canvas.Font.Size := 12; Image1.Canvas.TextOut(0,0,'Itt lesz a szöveg.'); end; procedure TForm1.FormCreate(Sender: TObject); begin Image1.Transparent := True; Form1.DoubleBuffered := True; end; end.
Mutasd a teljes hozzászólást!
unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ExtDlgs, Vcl.Buttons; type TForm1 = class(TForm) btOpen: TButton; btSave: TButton; Image1: TImage; OpenPD: TOpenPictureDialog; SavePD: TSavePictureDialog; Button1: TButton; procedure btOpenClick(Sender: TObject); procedure btSaveClick(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; fileDate : Integer; implementation {$R *.dfm} uses Jpeg, ShellApi; procedure TForm1.btOpenClick(Sender: TObject); var Jpg: TJPEGImage; Bmp: TBitmap; R: TRect; begin if OpenPD.Execute then if FileExists(OpenPD.FileName) then begin Jpg := TJPEGImage.Create; try Jpg.LoadFromFile(OpenPD.FileName); Caption := Format('%d × %d', [Jpg.Width, Jpg.Height]); Bmp := TBitmap.Create; try Bmp.Assign(Jpg); R := Rect(0, 0, Bmp.Width, Bmp.Height); Image1.Width := R.Width; Image1.Height := R.Height; Image1.Canvas.CopyRect(R, Bmp.Canvas, R); fileDate := FileAge(OpenPD.FileName); with Image1.Canvas do begin Brush.Style := bsClear; Pen.Color := clWhite; Font.Color := clRed; Font.Size := 12; TextOut(10,10,DateToStr(FileDateToDateTime(fileDate))); end; finally Bmp.Free; end; finally Jpg.Free; end; end else raise Exception.Create('A fájl nem létezik.'); end; procedure TForm1.btSaveClick(Sender: TObject); begin if SavePD.Execute then if FileExists(SavePD.FileName) then raise Exception.Create('A fájl már létezik. Nem lehet felülírni.') else Image1.Picture.SaveToFile(SavePD.FileName); end; procedure TForm1.FormCreate(Sender: TObject); begin Form1.DoubleBuffered := True; Form1.AutoScroll := True; Form1.AutoSize := False; end; end.
Mutasd a teljes hozzászólást!

  • És konkrétan mi a gond ? Ránézésre ez jó.
    Mutasd a teljes hozzászólást!
  • Szia, nem a bitmap-be írsz. Így kell:

    Image1.Picture.Bitmap.Canvas.TextOut(x,y,'text);
    Üdv.
    Zoli
    Mutasd a teljes hozzászólást!
  • Ezt kapom mindig hibaüzinek.

    http://kepfeltoltes.hu/160714/476842258hiba_www.kepfeltoltes.hu_.jpg

    A Write gomb megnyomása után.
    Mutasd a teljes hozzászólást!
  • Lefordítottad az üzenetet ?
    Mutasd a teljes hozzászólást!
  • Igen. Ezért nem értem és lépek előre, mert az uses jpeg-el már "lehetővé tettem" a jpg kezelést.
    Ennek ellenére problémázik a módosításnál. A kép behozatalnál, akkor miért nincs gondja?
    Mutasd a teljes hozzászólást!
  • Értem, de a hibaüzenet másról szól, szerintem ...

    Mindegy. Próbálj meg valami ilyesmit:

    if OpenPD.Execute then if FileExists(OpenPD.FileName) then begin Image1.Picture := nil; Image1.Canvas.Brush.Style:=bsClear; Image1.Canvas.Pen.Color:=clWhite; Image1.Canvas.Font.Color := clRed; Image1.Canvas.Font.Size := 12; Image1.Picture.Bitmap.Canvas.TextOut(0,0,'Itt lesz a szöveg.'); Image1.Picture.LoadFromFile(OpenPD.FileName); end else raise Exception.Create('A fájl nem létezik.');
    Mutasd a teljes hozzászólást!
  • Ez után is azt az üzit kapom
    Mutasd a teljes hozzászólást!
  • Szia, te write only módban vagy? Leírtam a megoldást.

    procedure TForm1.btWriteClick(Sender: TObject); begin Image1.Picture.Bitmap.Canvas.Brush.Style:=bsClear; Image1.Picture.Bitmap.Canvas.Pen.Color:=clWhite; Image1.Picture.Bitmap.Canvas.Font.Color := clRed; Image1.Picture.Bitmap.Canvas.Font.Size := 12; Image1.Picture.Bitmap.Canvas.TextOut(0,0,'Itt lesz a szöveg.'); end;
    vagy

    procedure TForm1.btWriteClick(Sender: TObject); begin with Image1.Picture.Bitmap.Canvas do begin Brush.Style:=bsClear; Pen.Color:=clWhite; Font.Color := clRed; Font.Size := 12; TextOut(0,0,'Itt lesz a szöveg.'); end; end;
    Ennyi a megoldás a problémádra.

    Üdv.
    Zoli
    Mutasd a teljes hozzászólást!
  • Ez sem jó, sajnos. Ugyanis mikor behívom a jpg képet és megnyomom a WRITE gombot, akkor a már behívott kép eltűnik és a szöveget sem jeleníti meg a prg. Igaz, nincs hibaüzenet, de nem jó.

    Nekem úgy kellene, hogy az OPEN gombra rá klikkelve be tudjak hozni egy tetszőleges jpg képet az Image1-be. A WRITE gomb megnyomásakor egy szöveget rá kellene tennem a képre, amit a SAVE gomb megnyomásakor szabadon menthető jpg formában.
    Az open, save részeket tokéletesen elkészítettem.
    Mutasd a teljes hozzászólást!
  • Van egy védett Bitmap tulajdonsága a jpeg osztálynak, amin keresztül tudsz rá rajzolni.
    Hogy a Te delphidben működ e, azt nem tudhatom.

    type TMyJPEGImage = class(TJPEGImage); ... TMyJPEGImage(Image1.Picture.Graphic).Bitmap.Canvas ...

    És még egy Image1.Refresh nem árt rajzolás után.
    Mutasd a teljes hozzászólást!
  • Ez nekem magas. 
    Ez ilyen eszeveszett kacifántos útvonalon lehet eljutni egy nyomi kép ráírásos program írásához...
    Végén még kiderül, hogy tömböt (array) is kell majd használnom vagy egy új komponenst írnom. Csúcs ez a Delphi.  
    Nem értek a Delphihez. Nincs tényleg egyszerű megoldás?
    Mutasd a teljes hozzászólást!
  • Az egyik legegyszerűbb programnyelven buktál meg a mondatoddal. Szóval, tessék gondolkodni, és nem kész kódokat várni. Nem olyan bonyolult.
    Mutasd a teljes hozzászólást!
  • Ezt olyan illető szokta írni (és hasonlókat) aki maga sem tudja a választ, de jó szokás szerint szeret "nagyon okosakat" írni. Én ritkán szoktam erre jönni, mert tudom, hogy segítséget itt nem nagyon szeretnek adni, mert tudják milyen pengék mindenben, (amíg meg nem szólalnak). 
    Inkább segítsél. Ja, bocs. Nem segítesz, mert csak rombolni tudsz. Az könnyebb.  
    Képzeld nem mindenki olyan nagy tudású, mint ti vagytok. Ahogy egy 4 éves sem fog kimenni a hűtőhöz, összepakolni magának egy szendvicset, ha éhes. Úgy Én sem fogok egy komplett  op. rendszert írni, de még ezt sem tudom megcsinálni, mert nincs meg hozzá az ismeretanyagom. Na, de mindegy. Ennyit a magyar segítőkészségről. 
    Köszönöm. Ígérem nem zavarom a köreiteket.
    Mutasd a teljes hozzászólást!
  • Egy képre írás azért messze van az operációs rendszertől; gondolom, azért érzed, hogy mennyire nem volt helyén való, amit írtál.

    Ráadásul, letöltöttél egy forráskódot a netről, ami nem működött neked, mert nem tudtál értelmezni egy mondatot. Pedig nem olyan bonyolult. És igen, tetszik vagy sem, gondolkodni kell és rájönni a megoldásra.

    Itt ül mellettem egy kolléga, aki nem fejlesztő. Tegnap elkezdett php. Pont így állt hozzá.
    Pedig hidd el, a leírtakban sok a segítség, még akkor is, ha felületesen olvasva nem tűnik annak.

    Ja kérem, más megvette az alapanyagot, még készítse is el a szendvicset ? A fejlesztés napi 12 óra gondolkodással jár. Ennyi.
    Mutasd a teljes hozzászólást!
  • Bitmap property, meg Jpeg unit ide, vagy oda nem kerülheted ki az explicit formátumkonverziókat:

    procedure TForm1.Button2Click(Sender: TObject); var bmp: TBitmap; jpeg: TJPEGImage; begin bmp := TBitmap.Create; try bmp.Assign(Image1.Picture.Graphic); bmp.Canvas.Brush.Style:=bsClear; bmp.Canvas.Pen.Color:=clWhite; bmp.Canvas.Font.Color := clRed; bmp.Canvas.Font.Size := 14; bmp.Canvas.Font.Style := [fsBold]; bmp.Canvas.TextOut(0,0,'Itt lesz a szöveg.'); jpeg := TJPEGImage.Create; try jpeg.Assign(bmp); Image1.Picture.Graphic := jpeg; finally jpeg.Free; end; finally bmp.Free; end; end;
    Mutasd a teljes hozzászólást!
  • Köszönöm mindenkinek, aki foglalkozott a gondommal, de egyik sem jó. Büszkén elmondhatom, hogy a saját problémámat végül magam oldottam meg.
    Mivel hiszek a segítség építő erejében, ha magamnak adhatok ezzel pontot, akkor a következő bejegyzésembe bemásolom az egész kódot.
    Mutasd a teljes hozzászólást!
  • unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ExtDlgs, Vcl.Buttons; type TForm1 = class(TForm) btOpen: TButton; btSave: TButton; Image1: TImage; OpenPD: TOpenPictureDialog; SavePD: TSavePictureDialog; Button1: TButton; procedure btOpenClick(Sender: TObject); procedure btSaveClick(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; fileDate : Integer; implementation {$R *.dfm} uses Jpeg, ShellApi; procedure TForm1.btOpenClick(Sender: TObject); var Jpg: TJPEGImage; Bmp: TBitmap; R: TRect; begin if OpenPD.Execute then if FileExists(OpenPD.FileName) then begin Jpg := TJPEGImage.Create; try Jpg.LoadFromFile(OpenPD.FileName); Caption := Format('%d × %d', [Jpg.Width, Jpg.Height]); Bmp := TBitmap.Create; try Bmp.Assign(Jpg); R := Rect(0, 0, Bmp.Width, Bmp.Height); Image1.Width := R.Width; Image1.Height := R.Height; Image1.Canvas.CopyRect(R, Bmp.Canvas, R); fileDate := FileAge(OpenPD.FileName); with Image1.Canvas do begin Brush.Style := bsClear; Pen.Color := clWhite; Font.Color := clRed; Font.Size := 12; TextOut(10,10,DateToStr(FileDateToDateTime(fileDate))); end; finally Bmp.Free; end; finally Jpg.Free; end; end else raise Exception.Create('A fájl nem létezik.'); end; procedure TForm1.btSaveClick(Sender: TObject); begin if SavePD.Execute then if FileExists(SavePD.FileName) then raise Exception.Create('A fájl már létezik. Nem lehet felülírni.') else Image1.Picture.SaveToFile(SavePD.FileName); end; procedure TForm1.FormCreate(Sender: TObject); begin Form1.DoubleBuffered := True; Form1.AutoScroll := True; Form1.AutoSize := False; end; end.
    Mutasd a teljes hozzászólást!
  • Akkor írj leírást és ne húzd le a másikat, ne szólj be.  
    Még egy példa a Te kedvedért.
      Almafa metszés.
    Almafát úgy kell metszeni, hogy erősen gondolkozol és már tudod is a metszési technikát és a  mikéntjét, ahogy a programozás alapjait is legtökéletesebben az erős gondolkodás és nem az alapok megismerésével lehet megtanulni. Szerintem meg jó könyvekből vagy (és) jó tanártól lehet megtanulni az alapokat és utána már csak rajtad áll, hogy hogy kombinálod ezeket az alapokat bonyolult egésszé... Mivel sok könyvem van, de inkább hagyjuk a szájkaratét. Nem vezet sehova. Azzal nem segítettél, hogy lehúztál.
    A többieknek meg nagyon szépen köszönöm, hogy foglalkoztak az ügyemmel.
    Segíts! Leírással, támpontok felállításával vagy kóddal. Azzal építesz. A leszólással, beszólással meg rombolsz. Ezt jegyezd meg.
    Mutasd a teljes hozzászólást!
abcd