1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:

procedure TForm1.Button3Click(Sender: TObject);
var
  TempJPeg: TJpegImage;
  TempBitmap: TBitmap;
  TempBitmap2: TBitmap;
  TempBitmap3: TBitmap;
  TempBitmap4: TBitmap;
  i,tn_height,tn_width,tn_width2 : integer;
  nummer : string;

begin
 if (listbox2.count>0) and (B_Org.text<>'') and (B_Thumb.text<>'') and (H_Org.text<>'') and (H_Thumb.text<>'') and (Thumbnail.text<>'')then
  begin
      ProgressBar1.Max := listbox2.Count-1;
      ProgressBar1.Position := 0;
      for i:=(strtoint(edit2.text)-1) to (strtoint(edit2.text)+listbox2.Count - 2) do
      Begin
        nummer :=inttostr(i+1);
        if i+1 < 100 then nummer:='0' + nummer;
        if i+1 < 10 then nummer:='0' + nummer;
        TempJPeg:=TJPegImage.Create;
        TempBitmap:=TBitmap.Create;
        TempBitmap2:=TBitmap.Create;
        TempBitmap3:=TBitmap.Create;
        TempBitmap4:=TBitmap.Create;
        TempJPeg.LoadfromFile(Listbox2.items[0]);
        TempBitmap.width := strtoint(B_Org.text);

        if TempJpeg.Height>TempJpeg.Width then TempBitmap.height := round(strtoint(H_Org.text)*1.776811594202)
        else TempBitmap.height := strtoint(H_org.text);

        TempBitmap.Canvas.StretchDraw(Rect(0,0,TempBitmap.width,TempBitmap.height),TempJpeg);

        tn_height:=strtoint(H_Thumb.text);
        tn_width:=strtoint(B_Thumb.text);
        tn_width2:=round(tn_width*0.56);
        if TempJpeg.Height>TempJpeg.Width then TempBitmap2.width := tn_width2
        else TempBitmap2.width := tn_width;
        TempBitmap2.height:=tn_height;
        FThumbSize:=tn_width;
        Sharpen(TempBitMap,TempBitMap4,1.1);
        MakeThumbNail(Tempbitmap4,Tempbitmap2);
        Sharpen(TempBitMap2,TempBitMap3,1.1);
        TempJPeg.Assign(Tempbitmap3);
        TempJPeg.SaveToFile('C:\temp2.jpg');
        IdFTP1.put('C:\temp2.jpg',Thumbnail.Text + nummer + '.jpg', true);
        TempJpeg.Free;
        TempJPeg:=TJPegImage.Create;
        TempJPeg.Assign(Tempbitmap4);
        TempJPeg.SaveToFile('C:\temp.jpg');
        IdFTP1.put('C:\temp.jpg', nummer + '.jpg',true);
        TempJPeg.free;
        TempBitmap.free;
        TempBitmap2.free;
        TempBitmap3.free;
        TempBitmap4.free;
        ProgressBar1.Position := i+1 - strtoint(edit2.text);
        Listbox2.Items.Delete(0);
        Listbox2.Refresh;
      end;
      showmessage('Upload erfolgreich');
      Deletefile('C:\temp.jpg');
      Deletefile('C:\temp2.jpg');
      refresh;
  end
  else showmessage ('Keine Datein eingefügt oder nicht alle Felder ausgefüllt');
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:

procedure MakeThumbNail(src, dest: tBitmap);
type 
  PRGB24 = ^TRGB24; 
  TRGB24 = packed record 
    B: Byte; 
    G: Byte; 
    R: Byte; 
  end; 
var 
  x, y, ix, iy: integer; 
  x1, x2, x3: integer; 

  xscale, yscale: single; 
  iRed, iGrn, iBlu, iRatio: Longword; 
  p, c1, c2, c3, c4, c5: tRGB24; 
  pt, pt1: pRGB24; 
  iSrc, iDst, s1: integer; 
  i, j, r, g, b, tmpY: integer; 

  RowDest, RowSource, RowSourceStart: integer; 
  w, h: integer; 
  dxmin, dymin: integer; 
  ny1, ny2, ny3: integer; 
  dx, dy: integer; 
  lutX, lutY: array of integer; 

begin
  if src.PixelFormat <> pf24bit then src.PixelFormat := pf24bit;
  if dest.PixelFormat <> pf24bit then dest.PixelFormat := pf24bit;
  w := Dest.Width;
  h := Dest.Height;

  if (src.Width <= FThumbSize) and (src.Height <= FThumbSize) then
  begin
    dest.Assign(src);
    exit;
  end;
  iDst := (w * 24 + 31) and not 31;
  iDst := iDst div 8; //BytesPerScanline
  iSrc := (Src.Width * 24 + 31) and not 31;
  iSrc := iSrc div 8;
  xscale := 1 / (w / src.Width); 
  yscale := 1 / (h / src.Height); 

  // X lookup table 
  SetLength(lutX, w); 
  x1 := 0; 
  x2 := trunc(xscale); 
  for x := 0 to w - 1 do 
  begin 
    lutX[x] := x2 - x1; 
    x1 := x2; 
    x2 := trunc((x + 2) * xscale); 
  end; 

  // Y lookup table 
  SetLength(lutY, h); 
  x1 := 0; 
  x2 := trunc(yscale); 
  for x := 0 to h - 1 do 
  begin 
    lutY[x] := x2 - x1; 
    x1 := x2; 
    x2 := trunc((x + 2) * yscale); 
  end; 

  dec(w); 
  dec(h); 
  RowDest := integer(Dest.Scanline[0]); 
  RowSourceStart := integer(Src.Scanline[0]); 
  RowSource := RowSourceStart; 
  for y := 0 to h do 
  begin 
    dy := lutY[y]; 
    x1 := 0; 
    x3 := 0; 
    for x := 0 to w do 
    begin 
      dx:= lutX[x]; 
      iRed:= 0; 
      iGrn:= 0; 
      iBlu:= 0; 
      RowSource := RowSourceStart; 
      for iy := 1 to dy do 
      begin 
        pt := PRGB24(RowSource + x1); 
        for ix := 1 to dx do 
        begin 
          iRed := iRed + pt.R; 
          iGrn := iGrn + pt.G; 
          iBlu := iBlu + pt.B; 
          inc(pt); 
        end; 
        RowSource := RowSource - iSrc; 
      end; 
      iRatio := 65535 div (dx * dy); 
      pt1 := PRGB24(RowDest + x3); 
      pt1.R := (iRed * iRatio) shr 16; 
      pt1.G := (iGrn * iRatio) shr 16; 
      pt1.B := (iBlu * iRatio) shr 16; 
      x1 := x1 + 3 * dx; 
      inc(x3,3); 
    end; 
    RowDest := RowDest - iDst; 
    RowSourceStart := RowSource; 
  end; 

  if dest.Height < 3 then exit; 

  // Sharpening... 
  s1 := integer(dest.ScanLine[0]); 
  iDst := integer(dest.ScanLine[1]) - s1; 
  ny1 := Integer(s1); 
  ny2 := ny1 + iDst; 
  ny3 := ny2 + iDst; 
  for y := 1 to dest.Height - 2 do 
  begin 
    for x := 0 to dest.Width - 3 do 
    begin 
      x1 := x * 3; 
      x2 := x1 + 3; 
      x3 := x1 + 6; 

      c1 := pRGB24(ny1 + x1)^; 
      c2 := pRGB24(ny1 + x3)^; 
      c3 := pRGB24(ny2 + x2)^; 
      c4 := pRGB24(ny3 + x1)^; 
      c5 := pRGB24(ny3 + x3)^; 

      r := (c1.R + c2.R + (c3.R * -12) + c4.R + c5.R) div -8; 
      g := (c1.G + c2.G + (c3.G * -12) + c4.G + c5.G) div -8; 
      b := (c1.B + c2.B + (c3.B * -12) + c4.B + c5.B) div -8; 

      if r < 0 then r := 0 else if r > 255 then r := 255; 
      if g < 0 then g := 0 else if g > 255 then g := 255; 
      if b < 0 then b := 0 else if b > 255 then b := 255; 

      pt1 := pRGB24(ny2 + x2); 
      pt1.R := r; 
      pt1.G := g; 
      pt1.B := b; 
    end; 
    inc(ny1, iDst); 
    inc(ny2, iDst); 
    inc(ny3, iDst); 
  end; 
end;


procedure Sharpen(sbm, tbm: TBitmap; alpha: Single);
//to sharpen, alpha must be >1.
//pixelformat pf24bit
//sharpens sbm to tbm
var
  i, j, k: integer;
  sr: array[0..2] of PByte;
  st: array[0..4] of pRGBTriple;
  tr: PByte;
  tt, p: pRGBTriple;
  beta: Single;
  inta, intb: integer;
  bmh, bmw: integer;
  re, gr, bl: integer;
  BytesPerScanline: integer;

begin
  //sharpening is blending of the current pixel
  //with the average of the surrounding ones,
  //but with a negative weight for the average
  Assert((sbm.Width > 2) and (sbm.Height > 2), 'Bitmap must be at least 3x3');
  Assert((alpha > 1) and (alpha < 6), 'Alpha must be >1 and <6');
  beta := (alpha - 1) / 5; //we assume alpha>1 and beta<1
  intb := round(beta * $10000);
  inta := round(alpha * $10000); //integer scaled alpha and beta
  sbm.PixelFormat := pf24bit;
  tbm.PixelFormat := pf24bit;
  tbm.Width := sbm.Width;
  tbm.Height := sbm.Height;
  bmw := sbm.Width - 2;
  bmh := sbm.Height - 2;
  BytesPerScanline := (((bmw + 2) * 24 + 31) and not 31) div 8;

  tr := tbm.Scanline[0];
  tt := pRGBTriple(tr);

  sr[0] := sbm.Scanline[0];
  st[0] := pRGBTriple(sr[0]);
  for j := 0 to bmw + 1 do
  begin
    tt^ := st[0]^;
    inc(tt); inc(st[0]); //first row unchanged
  end;

  sr[1] := PByte(integer(sr[0]) - BytesPerScanline);
  sr[2] := PByte(integer(sr[1]) - BytesPerScanline);
  for i := 1 to bmh do
  begin
    Dec(tr, BytesPerScanline);
    tt := pRGBTriple(tr);
    st[0] := pRGBTriple(integer(sr[0]) + 3); //top
    st[1] := pRGBTriple(sr[1]); //left
    st[2] := pRGBTriple(integer(sr[1]) + 3); //center
    st[3] := pRGBTriple(integer(sr[1]) + 6); //right
    st[4] := pRGBTriple(integer(sr[2]) + 3); //bottom
    tt^ := st[1]^; //1st col unchanged
    for j := 1 to bmw do
    begin
    //calcutate average weighted by -beta
      re := 0; gr := 0; bl := 0;
      for k := 0 to 4 do
      begin
        re := re + st[k]^.rgbtRed;
        gr := gr + st[k]^.rgbtGreen;
        bl := bl + st[k]^.rgbtBlue;
        inc(st[k]);
      end;
      re := (intb * re + $7FFF) shr 16;
      gr := (intb * gr + $7FFF) shr 16;
      bl := (intb * bl + $7FFF) shr 16;

    //add center pixel weighted by alpha
      p := pRGBTriple(st[1]); //after inc, st[1] is at center
      re := (inta * p^.rgbtRed + $7FFF) shr 16 - re;
      gr := (inta * p^.rgbtGreen + $7FFF) shr 16 - gr;
      bl := (inta * p^.rgbtBlue + $7FFF) shr 16 - bl;

    //clamp and move into target pixel
      inc(tt);
      if re < 0 then
        re := 0
      else
        if re > 255 then
          re := 255;
      if gr < 0 then
        gr := 0
      else
        if gr > 255 then
          gr := 255;
      if bl < 0 then
        bl := 0
      else
        if bl > 255 then
          bl := 255;
      //this looks stupid, but avoids function calls

      tt^.rgbtRed := re;
      tt^.rgbtGreen := gr;
      tt^.rgbtBlue := bl;
    end;
    inc(tt);
    inc(st[1]);
    tt^ := st[1]^; //Last col unchanged
    sr[0] := sr[1];
    sr[1] := sr[2];
    Dec(sr[2], BytesPerScanline);
  end;
  // copy last row
  Dec(tr, BytesPerScanline);
  tt := pRGBTriple(tr);
  st[1] := pRGBTriple(sr[1]);
  for j := 0 to bmw + 1 do
  begin
    tt^ := st[1]^;
    inc(tt); inc(st[1]);
  end;
end;