Zum Tool JPG-Verkleinern.
Zurück zu Delphi-Code.

Delphi Code vom JPG Verkleinern mit Drag'n'Drop

 Hier wird die Möglichkeit genutzt einfach vom Explorer JPG oder JPEG-Dateien rüber zu ziehen peer Drag'n'Drop,
 und dann zu verkleiner.

     	   

Wer Fehler findet kann die behalten!

//--------------------------------------------------------------------------------------------- unit JPEGU1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StylesButton, Spin, StdCtrls, ExtCtrls, MyPanel2, jpeg, Menus; type TForm1 = class(TForm) Panel2: TPanel; BildPanel2: TBildPanel; Edit3: TEdit; Label9: TLabel; SpinEdit1: TSpinEdit; Panel3: TPanel; ListBox2: TListBox; ListBox3: TListBox; Label6: TLabel; StylesButton1: TStylesButton; Panel4: TPanel; Label7: TLabel; StylesButton2: TStylesButton; ListBox1: TListBox; BildPanel1: TBildPanel; Bevel1: TBevel; Label3: TLabel; Label10: TLabel; Label11: TLabel; Label1: TLabel; Label2: TLabel; Edit1: TEdit; Edit2: TEdit; Splitter1: TSplitter; Label4: TLabel; Label5: TLabel; Label8: TLabel; PopupMenu1: TPopupMenu; Delte1: TMenuItem; procedure FormCreate(Sender: TObject); procedure StylesButton1Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure StylesButton2Click(Sender: TObject); procedure ListBox2DblClick(Sender: TObject); procedure Edit1Change(Sender: TObject); procedure ListBox1Click(Sender: TObject); procedure ListBox1DblClick(Sender: TObject); procedure ListBox2Click(Sender: TObject); procedure Delte1Click(Sender: TObject); private // Um von den Explorer Botschaften empfangen zu können procedure WMDROPFILES(var Msg: TMessage); message WM_DROPFILES; public { Public-Deklarationen } end; var Form1: TForm1; implementation uses ShellAPI; {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin Application.HintColor := $004DE160; Application.HintPause := 1500; Application.HintHidePause := 3500; //Für Drag'n'Drop auserhalb von diesen Windows Fenster in diese Fenster DragAcceptFiles(Listbox1.Handle, true); end; // DragAcceptFiles DragQueryFiles DragFinish const DF_NUMBEROFFILES = $FFFFFFFF; {die Funktion DragQueryFile. Sie erwartet folgende Parameter: Drop: Identifiert die Struktur die die Dateinamen enthält. FileIndex: Index der Datei, die in den Puffer geladen werden soll. Wenn für diesen Parameter $FFFFFFFF übergeben wird, erhält man als Rückgabewert die Anzahl der Dateien. FileName: PChar, in den der Dateiname geladen wird. Wird für diesen Parameter nil übergeben, erhält man als Rückgabewert die erforderliche Größe für den Dateinamen. cb: Länge des Teilstückes, das gelesen werden soll Nach der Initialisierung der Puffervariablen Dateiname bestimmen wir die Anzahl der übergebenen Dateien. Dabei muss der zweite Parameter von DragQueryFile auf $FFFFFFFF gesetzt werden. Wir übergeben DF_NUMBEROFFILES. Diese Konstante haben wir zuvor als $FFFFFFFF definiert.} procedure TForm1.WMDROPFILES(var Msg: TMessage); var i, anzahl, size: Integer; Dateiname: PChar; s, s2: String; begin inherited; anzahl := DragQueryFile(Msg.WParam, DF_NUMBEROFFILES, Dateiname, 255); for i := 0 to (anzahl - 1) do begin size := DragQueryFile(Msg.WParam, i, nil, 0) + 1; Dateiname := StrAlloc(size); DragQueryFile(Msg.WParam, i, Dateiname, size); s := StrPas(Dateiname); // Filter : Dateiendung auslesen und in Klein Buchstaben umwandeln s2 := LowerCase(ExtractFileExt(s)); // if s2 = '.jpg' then Listbox1.Items.Add(s); if s2 = '.jpeg' then Listbox1.Items.Add(s); StrDispose(Dateiname); // String vom Heap entfernen end; DragFinish(Msg.WParam); end; procedure TForm1.StylesButton1Click(Sender: TObject); begin Listbox2.Clear; end; procedure TForm1.FormShow(Sender: TObject); begin // ListBox3.Brush.Color := $0000FF80; // ListBox1.Brush.Color := $0000FF80; // ListBox2.Brush.Color := $0000FF80; end; procedure TForm1.StylesButton2Click(Sender: TObject); var s: String; i: Integer; begin for i := 0 to Listbox3.Items.Count -1 do begin if FileExists(ListBox3.Items.Strings[i]) then begin s := ListBox3.Items.Strings[i]; DeleteFile(s); end; // if end; // for Listbox3.Clear; end; procedure TForm1.ListBox2DblClick(Sender: TObject); var s: String; begin if FileExists(ListBox2.Items.Strings[ListBox2.ItemIndex]) then begin s := ListBox2.Items.Strings[ListBox2.ItemIndex]; ShellExecute(handle, nil, Pchar(s), nil, nil, SW_SHOW); end; end; procedure TForm1.Edit1Change(Sender: TObject); begin Edit2.Text := Edit1.Text; end; procedure TForm1.ListBox1Click(Sender: TObject); var Bild1: Tbitmap; jpg: TJpegImage; s: String; begin Screen.Cursor := crHourGlass; s := ''; s := ListBox1.Items.Strings[ListBox1.ItemIndex]; // Höhe und Breite vom Bild ausgeben Bild1 := TBitmap.Create; try jpg := TJpegImage.Create; try Bild1.PixelFormat := pf24Bit; jpg.LoadFromFile(s); // Bild laden Pfad und DateiName übergeben Bild1.Assign(jpg); // JPG den Bitmap zuweisen Label11.Caption := 'Pixel: ' + Inttostr(Bild1.Width); Label10.Caption := 'Pixel: ' + Inttostr(Bild1.Height); finally Bild1.Free; end; finally jpg.free; end; Screen.Cursor := crDefault; end; procedure TForm1.ListBox1DblClick(Sender: TObject); var Bild1, Bild2: Tbitmap; jpg, jpg2 : TJpegImage; i: Integer; Hoehe, Breite: Real; s, s2, s3: String; begin Screen.Cursor := crHourGlass; s := ''; s2 := ''; Hoehe := 10; Breite := 10; s := ListBox1.Items.Strings[ListBox1.ItemIndex]; //-------------------------------------------------------- Bild1 := TBitmap.Create; Bild2 := TBitmap.Create; jpg := TJpegImage.Create; jpg2 := TJpegImage.Create; try Bild1.PixelFormat := pf24Bit; jpg.LoadFromFile(s); // Bild laden Pfad und DateiName übergeben ListBox3.Items.Add(s); // Pfad und Alte-Dateien in Listbox zum Löschen sichern Bild1.Assign(jpg); // JPG den Bitmap zuweisen s2 := ExtractFilePath(s); // Pfad bekommen // Prozente ausrechnen für Verkleinerung if Bild1.Width > Bild1.Height then begin Breite := Bild1.Width / 100; Breite := Breite * StrtoInt(Edit2.text); Hoehe := Bild1.Height / 100; Hoehe := Hoehe * StrtoInt(Edit1.text); Bild2.Width := Trunc(Breite); Bild2.Height := Trunc(Hoehe); end //if else begin Breite := Bild1.Width / 100; Breite := Breite * StrtoInt(Edit2.text); Hoehe := Bild1.Height / 100; Hoehe := Hoehe * StrtoInt(Edit1.text); Bild2.Width := Trunc(Breite); Bild2.Height := Trunc(Hoehe); end; // else SetStretchBltMode(Bild2.Canvas.Handle, HALFTONE); StretchBlt(Bild2.Canvas.Handle, 0, 0, Bild2.Width, Bild2.Height, Bild1.Canvas.Handle, 0, 0, Bild1.Width, Bild1.Height, SRCCOPY); // Pfad mit neuen Dateinamen und Nummerierung zusammen stellen s3 := s2 + Edit3.Text + IntTostr(SpinEdit1.Value) +'.jpg'; SpinEdit1.Value := SpinEdit1.Value +1; // Zähler erhöhen i := 0; // Zur Sicherheit fahls eine Datei mit diesen namen schon vorhanden ist if FileExists(s3) then begin while i = 0 do begin // Pfad mit neuen Dateinamen und Nummerierung zusammen stellen s3 := s2 + Edit3.Text + IntTostr(SpinEdit1.Value) +'.jpg'; SpinEdit1.Value := SpinEdit1.Value +1; // Zähler erhöhen if not FileExists(s3) then i := 1; end; // while end; // if ListBox2.Items.Add(s3); // Pfad und Neuen-Dateiname in Listbox zu Überprüfen der Bilder. jpg2.Assign(Bild2); // Bitmap wieder JPG zuweisen jpg2.SaveToFile(s3); finally Bild1.Free; Bild2.Free; jpg.free; jpg2.free; end; Screen.Cursor := crDefault; end; procedure TForm1.ListBox2Click(Sender: TObject); var Bild1: Tbitmap; jpg: TJpegImage; s: String; begin Screen.Cursor := crHourGlass; s := ''; s := ListBox2.Items.Strings[ListBox2.ItemIndex]; // Höhe und Breite vom Bild ausgeben Bild1 := TBitmap.Create; try jpg := TJpegImage.Create; try Bild1.PixelFormat := pf24Bit; jpg.LoadFromFile(s); // Bild laden Pfad und DateiName übergeben Bild1.Assign(jpg); // JPG den Bitmap zuweisen Label4.Caption := 'Pixel: ' + Inttostr(Bild1.Width); Label5.Caption := 'Pixel: ' + Inttostr(Bild1.Height); finally Bild1.Free; end; finally jpg.free; end; Screen.Cursor := crDefault; end; procedure TForm1.Delte1Click(Sender: TObject); var s: String; begin if ListBox3.Items.Count > 0 then begin try if ListBox3.Selected[ListBox3.ItemIndex] then begin s := ListBox3.Items.Strings[ListBox3.ItemIndex]; if FileExists(s) then begin DeleteFile(s); Listbox3.Items.Delete(ListBox3.ItemIndex); end; // if end; // wenn Kein Eintrag selectiert ist muss der Fehler abgefangen werden except ShowMessage('Sie müssen erst eienen Eintrag wählen'); end; end; end; end. //------------------------------------------------------------------------------------------------