Giriş Yap

**RAD Coder** · (Son Düzenleme: 09-02-2022, Saat: 15:49, Düzenleyen: RAD Coder.)

(09-02-2022, Saat: 15:39)Blacklord Adlı Kullanıcıdan Alıntı:
(09-02-2022, Saat: 15:28)RAD Coder Adlı Kullanıcıdan Alıntı: Component Kullanmadım.
Delphi 11 ile test ettim.

delphi 7 kullanıyorum hocam component için yardım

↑↑↑↑↑

**Blacklord** · (Son Düzenleme: 09-02-2022, Saat: 16:00, Düzenleyen: Blacklord.)

(09-02-2022, Saat: 13:41)RAD Coder Adlı Kullanıcıdan Alıntı: 1- Yeni bir uygulama oluşturun.
2- Formun üzerine birer adet button, image ve OpenDialog yerleştirin.
3- Image Stretch özelliğini True yapın (isteğe bağlı, resmi çerçeve sığdıracaktır).
4- Aşağıdaki metod ile bir resim seçin.
5- Resmi seçtiğiniz anda seçtiğiniz dizine 1500x1125 ebadında yeni bir jpg resmi üretecektir.

procedure TForm1.Button1Click(Sender: TObject);
const
 imgW = 1500;
 imgH = 1125;
var
 imgBMP: TBitmap;
 imgJPG: TJPEGImage;
 Uyumsuz: boolean;
 imgBoyut: Double;
 posSolUst, posUst, posSagAlt, posAlt: integer;
 strYol: String;
begin
 if OpenDialog1.Execute then
 begin
   imgJPG := TJPEGImage.Create;
   Uyumsuz := false;
   try
     imgJPG.LoadFromFile(OpenDialog1.FileName);
     if (imgJPG.Height >= imgJPG.Width) AND (imgH <= imgJPG.Height) then
     begin
       imgBoyut := imgW / imgJPG.Height;
     end
     else if (imgJPG.Height <= imgJPG.Width) AND (imgW <= imgJPG.Width) then
     begin
       imgBoyut := imgH / imgJPG.Width;
     end
     else
     begin
       Uyumsuz := true;
     end;
     imgBMP := TBitmap.Create;
     try
       imgBMP.SetSize(imgW, imgH);
       if not Uyumsuz then
       begin
         posSolUst := (imgW - Round(imgJPG.Width * imgBoyut)) div 2;
         posUst := (imgH - Round(imgJPG.Height * imgBoyut)) div 2;
         posSagAlt := Round(imgJPG.Width * imgBoyut) + posSolUst;
         posAlt := Round(imgJPG.Height * imgBoyut) + posUst;
         imgBMP.Canvas.StretchDraw(Rect(posSolUst, posUst, posSagAlt, posAlt), imgJPG);
       end
       else
       begin
         posSolUst := (imgW - imgJPG.Width) div 2;
         posUst := (imgH - imgJPG.Height) div 2;
         posSagAlt := imgJPG.Width + posSolUst;
         posAlt := imgJPG.Height + posUst;
         imgBMP.Canvas.StretchDraw(Rect(posSolUst, posUst, posSagAlt, posAlt), imgJPG);
       end;
       Image1.Picture.Assign(imgBMP);
       imgJPG.Assign(imgBMP);
       imgJPG.SaveToFile(Format('%s_%sx%s.jpg', [OpenDialog1.FileName, imgW.ToString, imgH.ToString]));
     finally
       imgBMP.free;
     end;
   finally
     imgJPG.free;
   end;
 end;
end;

Not: Uses bölümüne Vcl.Imaging.jpeg ekleyin.

Hocam delphi 7 kullanıyorum component için yardım edermisiniz

(09-02-2022, Saat: 15:28)RAD Coder Adlı Kullanıcıdan Alıntı:
(09-02-2022, Saat: 14:28)Blacklord Adlı Kullanıcıdan Alıntı: hocam componetini alabilirmiyim

Hocam delphi 7 kullanıyorum component sorunu var

Component Kullanmadım.
Delphi 11 ile test ettim.

Vcl.Imaging.jpeg olmadıgı için hata veriyor hocam

**RAD Coder** · 09-02-2022, Saat: 16:08

Vcl.Imaging.jpeg.pas dosyası pek işinize yaramayacaktır.
Kullandığı bir çok referans (unit) var ve bir çoğu da Delphi 7 için uyumlu olmayabilir.

**Blacklord** · 09-02-2022, Saat: 16:21

(09-02-2022, Saat: 16:08)RAD Coder Adlı Kullanıcıdan Alıntı: Vcl.Imaging.jpeg.pas dosyası pek işinize yaramayacaktır.
Kullandığı bir çok referans (unit) var ve bir çoğu da Delphi 7 için uyumlu olmayabilir.

Peki hocam delphi 7 de bu işlemi yapabileceğim kodlar için yardımcı olurmusunuz

**RAD Coder** · 09-02-2022, Saat: 16:26

(09-02-2022, Saat: 16:21)Blacklord Adlı Kullanıcıdan Alıntı:
(09-02-2022, Saat: 16:08)RAD Coder Adlı Kullanıcıdan Alıntı: Vcl.Imaging.jpeg.pas dosyası pek işinize yaramayacaktır.
Kullandığı bir çok referans (unit) var ve bir çoğu da Delphi 7 için uyumlu olmayabilir.

Peki hocam delphi 7 de bu işlemi yapabileceğim kodlar için yardımcı olurmusunuz

Maalesef.
Delphi'nin yeni sürümü çıktığında bir önceki sürümünü bırakıyorum.
Umarım, Delphi 7 için de başka bir üyemiz size yardımcı olacaktır.

**COMMANDX** · (Son Düzenleme: 10-02-2022, Saat: 08:48, Düzenleyen: COMMANDX.)

Şu kodu bi deneyin

procedure ResizeBmp(Dest: TBitmap; const WMax, HMax: Word);
type
 pRGBArray = ^TRGBArray;
 TRGBArray = array[Word] of TRGBTriple;
var
 TBmp: TBitmap;
 DstGap: Integer;
 WNew, HNew: Integer;
 X, Y, T3: Integer;
 Z1, Z2, IZ2: Integer;
 W1, W2, W3, W4: Integer;
 XP, XP2, YP, YP2: Integer;
 SrcLine1, SrcLine2, DstLine: pRGBArray;
Begin
 TBmp := TBitmap.Create;
 try
   try
     WNew := (Dest.Width * HMax) div Dest.Height;
     HNew := (WMax * Dest.Height) div Dest.Width;
     if (WMax < WNew) then
     begin
       TBmp.Width := WMax;
       TBmp.Height := HNew;
     end else
     begin
       TBmp.Width := WNew;
       TBmp.Height := HMax;
     end;
     Dest.PixelFormat := pf24Bit;
     TBmp.PixelFormat := pf24bit;
     DstLine := TBmp.ScanLine[0];
     DstGap  := Integer(TBmp.ScanLine[1]) - Integer(DstLine);
     XP2 := MulDiv(Pred(Dest.Width), $10000, TBmp.Width);
     YP2 := MulDiv(Pred(Dest.Height), $10000, TBmp.Height);
     YP  := 0;
     for Y := 0 to Pred(TBmp.Height) do
     begin
       XP := 0;
       SrcLine1 := Dest.ScanLine[YP shr 16];
       if (YP shr 16 < Pred(Dest.Height))
         then SrcLine2 := Dest.ScanLine[Succ(YP shr 16)]
         else SrcLine2 := Dest.ScanLine[YP shr 16];
       Z2  := Succ(YP and $FFFF);
       IZ2 := Succ((not YP) and $FFFF);
       for X := 0 to Pred(TBmp.Width) do
       begin
         T3 := XP shr 16;
         Z1 := XP and $FFFF;
         W2 := MulDiv(Z1, IZ2, $10000);
         W1 := IZ2 - W2;
         W4 := MulDiv(Z1, Z2, $10000);
         W3 := Z2 - W4;
         DstLine[X].rgbtRed   := (SrcLine1[T3].rgbtRed   * W1 + SrcLine1[T3 + 1].rgbtRed   * W2 + SrcLine2[T3].rgbtRed   * W3 + SrcLine2[T3 + 1].rgbtRed   * W4) shr 16;
         DstLine[X].rgbtGreen := (SrcLine1[T3].rgbtGreen * W1 + SrcLine1[T3 + 1].rgbtGreen * W2 + SrcLine2[T3].rgbtGreen * W3 + SrcLine2[T3 + 1].rgbtGreen * W4) shr 16;
         DstLine[X].rgbtBlue  := (SrcLine1[T3].rgbtBlue  * W1 + SrcLine1[T3 + 1].rgbtBlue  * W2 + SrcLine2[T3].rgbtBlue  * W3 + SrcLine2[T3 + 1].rgbtBlue  * W4) shr 16;
         Inc(XP, XP2);
       end;
       Inc(YP, YP2);
       DstLine := pRGBArray(Integer(DstLine) + DstGap);
     end;
     Dest.Assign(TBmp);
   except
   end;
 finally
   TBmp.Free;
 end;
end;

Denemedim
Kullanımı

resizebmp(image1.picture.bitmap,640,480)

veya...

  
   

procedure TForm1.Button2Click(Sender: TObject);
var
 bmp: TBitmap;
 jpg: TJPEGImage;
 scale: Double;
 widthL, HeightL, pt1, pt2, pt3, pt4: integer;
 verdd : boolean;
begin
 if OpenDialog1.Execute then
 begin
 try
         jpg := TJPEGImage.Create;
         verdd := false;
         try
           //Dimensões
           widthL := 98;
           HeightL := 98;
           jpg.LoadFromFile(OpenDialog1.FileName);
           if (jpg.Height >= jpg.Width) AND (HeightL <= jpg.Height) then begin
             scale := widthL / jpg.Height;
           end else if (jpg.Height <= jpg.Width) AND (widthL <=  jpg.Width) then begin
             scale := HeightL / jpg.Width;
           end else begin
             verdd := true;
           end;
               bmp := TBitmap.Create;
               try
                 {Create thumbnail bitmap, keep pictures aspect ratio}
                 bmp.SetSize( widthL,HeightL);
                 if not verdd then begin
                     pt1 := (widthL - Round(jpg.Width * scale)) div 2;
                     pt2 := (HeightL - Round(jpg.Height * scale)) div 2;
                     pt3 := Round(jpg.Width * scale) + pt1;
                     pt4 := Round(jpg.Height * scale) + pt2;
                     bmp.Canvas.StretchDraw(Rect(pt1, pt2, pt3, pt4), jpg);
                 end else begin
                     pt1 := (widthL - jpg.Width) div 2;
                     pt2 := (HeightL - jpg.Height) div 2;
                     pt3 := jpg.Width + pt1;
                     pt4 := jpg.Height + pt2;
                     bmp.Canvas.StretchDraw(Rect(pt1, pt2, pt3, pt4), jpg);
                 end;

                 Logo.Picture.Assign(bmp);
                 {Convert back to JPEG and save to file}
                 jpg.Assign(bmp);
                 jpg.SaveToFile(ChangeFileExt(OpenDialog1.FileName, '_thumb.JPG'));
               finally
                 bmp.free;
               end;
         finally
           jpg.free;
         end;
 except
      showMessage('Erro ao carregar imagem');    ///////////////////////////////////
 end;
 end;
end;

veya

Title: 
How to get/set JPG resolution
procedure GetResJpg(JPGFile: string);
const
 BufferSize = 50;
var
 Buffer: string;
 Index: integer;
 FileStream: TFileStream;
 HorzRes, VertRes: Word;
 DP: Byte;
 Measure: string;
begin
 FileStream := TFileStream.Create(JPGFile,
   fmOpenReadWrite);
 try
   SetLength(Buffer, BufferSize);
   FileStream.Read(buffer[1], BufferSize);
   Index := Pos('JFIF' + #$00, buffer);
   if Index  0 then
   begin
     FileStream.Seek(Index + 6, soFromBeginning);
     FileStream.Read(DP, 1);
     case DP of
       1: Measure := 'DPI'; //Dots Per Inch
       2: Measure := 'DPC'; //Dots Per Cm.
     end;
     FileStream.Read(HorzRes, 2); // x axis
     HorzRes := Swap(HorzRes);
     FileStream.Read(VertRes, 2); // y axis
     VertRes := Swap(VertRes);
   end
 finally
   FileStream.Free;
 end;
end;

procedure SetResJpg(name: string; dpix, dpiy: Integer);
const
 BufferSize = 50;
 DPI = 1; //inch
 DPC = 2; //cm
var
 Buffer: string;
 index: INTEGER;
 FileStream: TFileStream;
 xResolution: WORD;
 yResolution: WORD;
 _type: Byte;
begin
 FileStream := TFileStream.Create(name,
   fmOpenReadWrite);
 try
   SetLength(Buffer, BufferSize);
   FileStream.Read(buffer[1], BufferSize);
   index := POS('JFIF' + #$00, buffer);
   if index  0
     then begin
     FileStream.Seek(index + 6, soFromBeginning);
     _type := DPI;
     FileStream.write(_type, 1);
     xresolution := swap(dpix);
     FileStream.write(xresolution, 2);
     yresolution := swap(dpiy);
     FileStream.write(yresolution, 2);
   end
 finally
   FileStream.Free;
 end;
end;

**Blacklord** · 10-02-2022, Saat: 09:47

(09-02-2022, Saat: 17:57)COMMANDX Adlı Kullanıcıdan Alıntı: Şu kodu bi deneyin

procedure ResizeBmp(Dest: TBitmap; const WMax, HMax: Word);
type
 pRGBArray = ^TRGBArray;
 TRGBArray = array[Word] of TRGBTriple;
var
 TBmp: TBitmap;
 DstGap: Integer;
 WNew, HNew: Integer;
 X, Y, T3: Integer;
 Z1, Z2, IZ2: Integer;
 W1, W2, W3, W4: Integer;
 XP, XP2, YP, YP2: Integer;
 SrcLine1, SrcLine2, DstLine: pRGBArray;
Begin
 TBmp := TBitmap.Create;
 try
   try
     WNew := (Dest.Width * HMax) div Dest.Height;
     HNew := (WMax * Dest.Height) div Dest.Width;
     if (WMax < WNew) then
     begin
       TBmp.Width := WMax;
       TBmp.Height := HNew;
     end else
     begin
       TBmp.Width := WNew;
       TBmp.Height := HMax;
     end;
     Dest.PixelFormat := pf24Bit;
     TBmp.PixelFormat := pf24bit;
     DstLine := TBmp.ScanLine[0];
     DstGap  := Integer(TBmp.ScanLine[1]) - Integer(DstLine);
     XP2 := MulDiv(Pred(Dest.Width), $10000, TBmp.Width);
     YP2 := MulDiv(Pred(Dest.Height), $10000, TBmp.Height);
     YP  := 0;
     for Y := 0 to Pred(TBmp.Height) do
     begin
       XP := 0;
       SrcLine1 := Dest.ScanLine[YP shr 16];
       if (YP shr 16 < Pred(Dest.Height))
         then SrcLine2 := Dest.ScanLine[Succ(YP shr 16)]
         else SrcLine2 := Dest.ScanLine[YP shr 16];
       Z2  := Succ(YP and $FFFF);
       IZ2 := Succ((not YP) and $FFFF);
       for X := 0 to Pred(TBmp.Width) do
       begin
         T3 := XP shr 16;
         Z1 := XP and $FFFF;
         W2 := MulDiv(Z1, IZ2, $10000);
         W1 := IZ2 - W2;
         W4 := MulDiv(Z1, Z2, $10000);
         W3 := Z2 - W4;
         DstLine[X].rgbtRed   := (SrcLine1[T3].rgbtRed   * W1 + SrcLine1[T3 + 1].rgbtRed   * W2 + SrcLine2[T3].rgbtRed   * W3 + SrcLine2[T3 + 1].rgbtRed   * W4) shr 16;
         DstLine[X].rgbtGreen := (SrcLine1[T3].rgbtGreen * W1 + SrcLine1[T3 + 1].rgbtGreen * W2 + SrcLine2[T3].rgbtGreen * W3 + SrcLine2[T3 + 1].rgbtGreen * W4) shr 16;
         DstLine[X].rgbtBlue  := (SrcLine1[T3].rgbtBlue  * W1 + SrcLine1[T3 + 1].rgbtBlue  * W2 + SrcLine2[T3].rgbtBlue  * W3 + SrcLine2[T3 + 1].rgbtBlue  * W4) shr 16;
         Inc(XP, XP2);
       end;
       Inc(YP, YP2);
       DstLine := pRGBArray(Integer(DstLine) + DstGap);
     end;
     Dest.Assign(TBmp);
   except
   end;
 finally
   TBmp.Free;
 end;
end;

Denemedim
Kullanımı

resizebmp(image1.picture.bitmap,640,480)

veya...

  
   

procedure TForm1.Button2Click(Sender: TObject);
var
 bmp: TBitmap;
 jpg: TJPEGImage;
 scale: Double;
 widthL, HeightL, pt1, pt2, pt3, pt4: integer;
 verdd : boolean;
begin
 if OpenDialog1.Execute then
 begin
 try
         jpg := TJPEGImage.Create;
         verdd := false;
         try
           //Dimensões
           widthL := 98;
           HeightL := 98;
           jpg.LoadFromFile(OpenDialog1.FileName);
           if (jpg.Height >= jpg.Width) AND (HeightL <= jpg.Height) then begin
             scale := widthL / jpg.Height;
           end else if (jpg.Height <= jpg.Width) AND (widthL <=  jpg.Width) then begin
             scale := HeightL / jpg.Width;
           end else begin
             verdd := true;
           end;
               bmp := TBitmap.Create;
               try
                 {Create thumbnail bitmap, keep pictures aspect ratio}
                 bmp.SetSize( widthL,HeightL);
                 if not verdd then begin
                     pt1 := (widthL - Round(jpg.Width * scale)) div 2;
                     pt2 := (HeightL - Round(jpg.Height * scale)) div 2;
                     pt3 := Round(jpg.Width * scale) + pt1;
                     pt4 := Round(jpg.Height * scale) + pt2;
                     bmp.Canvas.StretchDraw(Rect(pt1, pt2, pt3, pt4), jpg);
                 end else begin
                     pt1 := (widthL - jpg.Width) div 2;
                     pt2 := (HeightL - jpg.Height) div 2;
                     pt3 := jpg.Width + pt1;
                     pt4 := jpg.Height + pt2;
                     bmp.Canvas.StretchDraw(Rect(pt1, pt2, pt3, pt4), jpg);
                 end;

                 Logo.Picture.Assign(bmp);
                 {Convert back to JPEG and save to file}
                 jpg.Assign(bmp);
                 jpg.SaveToFile(ChangeFileExt(OpenDialog1.FileName, '_thumb.JPG'));
               finally
                 bmp.free;
               end;
         finally
           jpg.free;
         end;
 except
      showMessage('Erro ao carregar imagem');    ///////////////////////////////////
 end;
 end;
end;

veya

Title: 
How to get/set JPG resolution
procedure GetResJpg(JPGFile: string);
const
 BufferSize = 50;
var
 Buffer: string;
 Index: integer;
 FileStream: TFileStream;
 HorzRes, VertRes: Word;
 DP: Byte;
 Measure: string;
begin
 FileStream := TFileStream.Create(JPGFile,
   fmOpenReadWrite);
 try
   SetLength(Buffer, BufferSize);
   FileStream.Read(buffer[1], BufferSize);
   Index := Pos('JFIF' + #$00, buffer);
   if Index  0 then
   begin
     FileStream.Seek(Index + 6, soFromBeginning);
     FileStream.Read(DP, 1);
     case DP of
       1: Measure := 'DPI'; //Dots Per Inch
       2: Measure := 'DPC'; //Dots Per Cm.
     end;
     FileStream.Read(HorzRes, 2); // x axis
     HorzRes := Swap(HorzRes);
     FileStream.Read(VertRes, 2); // y axis
     VertRes := Swap(VertRes);
   end
 finally
   FileStream.Free;
 end;
end;

procedure SetResJpg(name: string; dpix, dpiy: Integer);
const
 BufferSize = 50;
 DPI = 1; //inch
 DPC = 2; //cm
var
 Buffer: string;
 index: INTEGER;
 FileStream: TFileStream;
 xResolution: WORD;
 yResolution: WORD;
 _type: Byte;
begin
 FileStream := TFileStream.Create(name,
   fmOpenReadWrite);
 try
   SetLength(Buffer, BufferSize);
   FileStream.Read(buffer[1], BufferSize);
   index := POS('JFIF' + #$00, buffer);
   if index  0
     then begin
     FileStream.Seek(index + 6, soFromBeginning);
     _type := DPI;
     FileStream.write(_type, 1);
     xresolution := swap(dpix);
     FileStream.write(xresolution, 2);
     yresolution := swap(dpiy);
     FileStream.write(yresolution, 2);
   end
 finally
   FileStream.Free;
 end;
end;

Hocam yapamadım size zahmet olmazsa proje olarakgöderebilirmisiniz

**COMMANDX** · (Son Düzenleme: 11-02-2022, Saat: 10:29, Düzenleyen: COMMANDX.)

// Biraz Düzenledim ... Bi REP esirgemezsen Sevinirim +++

program Project1;

uses
 Forms,
 Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
 Application.Initialize;
 Application.CreateForm(TForm1, Form1);
 Application.Run;
end.

//--------- unit1.pas-----------


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    OpenDialog1: TOpenDialog;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    TrackBar3: TTrackBar;
    Label3: TLabel;
    Edit3: TEdit;
    StatusBar1: TStatusBar;
    StatusBar2: TStatusBar;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure TrackBar3Change(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  orhann:string;
implementation

{$R *.dfm}
function Dosya_Boyut_Ogren(Dosya_Adi:String): string;
var
   f: file of Byte;
   size : Longint;
   S: string;
 begin
     AssignFile(f, Dosya_Adi);
     Reset(f);
     size := FileSize(f);
     Dosya_Boyut_Ogren := IntToStr(size DIV 1024)+' Kb';
     CloseFile(f);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 bmp: TBitmap;
 jpg: TJPEGImage;
 scale: Double;
 widthL, HeightL, pt1, pt2, pt3, pt4: integer;
 verdd : boolean;
begin
 if OpenDialog1.Execute then
 begin
  try
 STATUSBAR1.Panels.Items[1].Text:=OpenDialog1.FileName;
 STATUSBAR1.Panels.Items[0].Text:='Eski: '+Dosya_Boyut_Ogren(OpenDialog1.FileName);
         jpg := TJPEGImage.Create;
         verdd := false;
         try
           widthL := strtoint(edit1.Text);
           HeightL := strtoint(edit2.Text);
           jpg.LoadFromFile(OpenDialog1.FileName);
           if (jpg.Height >= jpg.Width) AND (HeightL <= jpg.Height) then begin
             scale := widthL / jpg.Height;
           end else if (jpg.Height <= jpg.Width) AND (widthL <=  jpg.Width) then begin
             scale := HeightL / jpg.Width;
           end else begin
             verdd := true;
           end;
               bmp := TBitmap.Create;
               try
                 {thumbnail oluşturma, sıkıştırma orhanı, orhaannn...}
                 bmp.Width:= widthL;   // hede
                 bmp.Height:= HeightL; // hödö
                 if not verdd then begin
                     pt1 := (widthL - Round(jpg.Width * scale)) div 2;
                     pt2 := (HeightL - Round(jpg.Height * scale)) div 2;
                     pt3 := Round(jpg.Width * scale) + pt1;
                     pt4 := Round(jpg.Height * scale) + pt2;
                     bmp.Canvas.StretchDraw(Rect(pt1, pt2, pt3, pt4), jpg);
                 end else begin
                     pt1 := (widthL - jpg.Width) div 2;
                     pt2 := (HeightL - jpg.Height) div 2;
                     pt3 := jpg.Width + pt1;
                     pt4 := jpg.Height + pt2;
                     bmp.Canvas.StretchDraw(Rect(pt1, pt2, pt3, pt4), jpg);
                 end;
 
                 jpg.Assign(bmp);
                 {Convert back to JPEG and save to file}
                 jpg.CompressionQuality:=strtoint(edit3.text); // burası sıkıştırma kalitesi, isteğe göre trackbardan ayarlanabilir
                 jpg.Compress;
                 jpg.SaveToFile(ChangeFileExt(OpenDialog1.FileName, '_thumb.JPG'));
               finally
                 bmp.free;
               end;
         finally
           jpg.free;
         end;
 except
      showMessage('Geçerli JPG değil');    ///////////////////////////////////
 end;
 end;
image1.Picture.LoadFromFile(ChangeFileExt(OpenDialog1.FileName,'_thumb.jpg'));
STATUSBAR2.Panels.Items[1].Text:=ChangeFileExt(OpenDialog1.FileName,'_thumb.jpg');
STATUSBAR2.Panels.Items[0].Text:='Yeni: '+Dosya_Boyut_Ogren(ChangeFileExt(OpenDialog1.FileName,'_thumb.jpg'));
orhann:= ChangeFileExt(OpenDialog1.FileName,'_thumb.jpg');
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
edit1.Text:=inttostr(TrackBar1.Position);
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
edit2.Text:=inttostr(TrackBar2.Position);
end;

procedure TForm1.TrackBar3Change(Sender: TObject);
begin
edit3.Text:=inttostr(trackbar3.position);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
sc_DragMove=$F012;
begin
ReleaseCapture;
form1.Perform(WM_SYSCOMMAND, sc_DragMove, 0);
end;

procedure TForm1.Image1DblClick(Sender: TObject);
begin
ShellExecute(0, nil, pchar(orhann), nil, nil, SW_SHOWDEFAULT);
end;

end.

// -------------- unit1.dfm-------------------

object Form1: TForm1
  Left = 447
  Top = 128
  Width = 459
  Height = 333
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnMouseDown = FormMouseDown
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 8
    Top = 8
    Width = 193
    Height = 201
    Proportional = True
    OnDblClick = Image1DblClick
  end
  object Label1: TLabel
    Left = 263
    Top = 48
    Width = 8
    Height = 13
    Caption = 'w'
  end
  object Label2: TLabel
    Left = 267
    Top = 85
    Width = 6
    Height = 13
    Caption = 'h'
  end
  object Label3: TLabel
    Left = 264
    Top = 120
    Width = 26
    Height = 13
    Caption = 'Kalite'
  end
  object Label4: TLabel
    Left = 72
    Top = 88
    Width = 89
    Height = 13
    Caption = #199'ift T'#305'kla'
  end
  object Button1: TButton
    Left = 288
    Top = 8
    Width = 75
    Height = 25
    Caption = 'dosya'
    TabOrder = 0
    OnClick = Button1Click
  end
  object TrackBar1: TTrackBar
    Left = 0
    Top = 208
    Width = 193
    Height = 45
    Max = 2000
    PageSize = 1
    Position = 700
    SelEnd = 2000
    TabOrder = 1
    OnChange = TrackBar1Change
  end
  object TrackBar2: TTrackBar
    Left = 208
    Top = 8
    Width = 45
    Height = 201
    Max = 3333
    Orientation = trVertical
    Position = 1600
    SelEnd = 3333
    TabOrder = 2
    OnChange = TrackBar2Change
  end
  object Edit1: TEdit
    Left = 280
    Top = 48
    Width = 81
    Height = 21
    TabOrder = 3
    Text = '1600'
  end
  object Edit2: TEdit
    Left = 280
    Top = 80
    Width = 81
    Height = 21
    TabOrder = 4
    Text = '700'
  end
  object TrackBar3: TTrackBar
    Left = 392
    Top = 0
    Width = 45
    Height = 150
    Max = 100
    Orientation = trVertical
    PageSize = 1
    Position = 70
    SelEnd = 100
    TabOrder = 5
    OnChange = TrackBar3Change
  end
  object Edit3: TEdit
    Left = 312
    Top = 112
    Width = 41
    Height = 21
    TabOrder = 6
    Text = '70'
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 276
    Width = 443
    Height = 19
    Panels = <
      item
        Width = 150
      end
      item
        Width = 150
      end>
  end
  object StatusBar2: TStatusBar
    Left = 0
    Top = 257
    Width = 443
    Height = 19
    Panels = <
      item
        Width = 150
      end
      item
        Width = 150
      end>
  end
  object OpenDialog1: TOpenDialog
    Left = 248
    Top = 8
  end
end

Giriş Yap
Kullanıcı Adı:
Şifreniz:	Şifremi Unuttum?
	Beni Hatırla

Konu ile Alakalı Benzer Konular
Konular		Yazar	Yorumlar	Okunma	Son Yorum
	delphi 10.4	deutsch1988	0	107	18-04-2024, Saat: 11:46 Son Yorum: deutsch1988
	Delphi virus gibi	deutsch1988	11	587	12-04-2024, Saat: 17:36 Son Yorum: deutsch1988
	Delphi 7 Unrar	mcuyan	12	753	19-03-2024, Saat: 10:30 Son Yorum: frmman
	Delphi 7zip Password lü Dosya Sıkıştırma ve Açma + Bonus RAR5 Desteği	frmman	6	354	16-03-2024, Saat: 17:55 Son Yorum: delphi.developer
	delphi 12 ile TFileStream çalışmıyor	aegean	5	553	05-03-2024, Saat: 22:23 Son Yorum: aegean