[img]][img=http
//www.sanalresim.com/rs/64589.jpg] Resim: [/url][/img]
{$R *.dfm}
var
sl, gr, ab: TStringlist;
im:
array of TImage;
pct: TPicture;
bmp: TBitmap;
procedure freigeben;
var x: integer;
begin
for x := 0
to length(im) - 1
do
im[x].free;
im :=
nil;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
pct := TPicture.create;
bmp := TBitmap.create;
sl := TStringlist.create;
gr := TStringlist.create;
ab := TStringlist.create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
freigeben;
ab.free;
gr.free;
sl.free;
pct.free;
bmp.free;
end;
procedure anpassen(datei:
string; mass: integer;
Image: TImage; Hintergrund, rand: TColor);
var
faktor: double;
fehler: boolean;
const s = '
FEHLER';
begin
fehler := false;
try
pct.loadfromfile(datei);
except
fehler := true;
end;
ab.add(Inttostr(pct.width) + '
x ' + inttostr(pct.height));
if pct.width > pct.Height
then begin
faktor := pct.height / pct.width;
bmp.width := mass - 2;
bmp.height := trunc(mass * faktor) - 2;
end else begin
faktor := pct.width / pct.height;
bmp.height := mass - 2;
bmp.width := trunc(mass * faktor) - 2;
end;
bmp.canvas.brush.color := hintergrund;
bmp.canvas.fillrect(bmp.canvas.cliprect);
if not fehler
then
bmp.canvas.stretchdraw(rect(0, 0, bmp.width, bmp.height), pct.graphic);
with image.picture.bitmap
do begin
width := mass;
height := mass;
canvas.font.color := clred;
canvas.pen.color := rand;
canvas.brush.color := hintergrund;
canvas.rectangle(0, 0, image.width, image.height);
if fehler
then
canvas.textout((mass - canvas.textwidth(s))
div 2, (mass -
canvas.textheight(s))
div 2, '
FEHLER')
else
canvas.draw((width - bmp.width)
div 2, (height - bmp.height)
div 2, bmp);
end;
end;
//________________
procedure suchen(pfad, filter:
string);
var sr: TWin32FindData;
h: THandle;
begin
sl.clear;
gr.clear;
ab.clear;
if ansilastchar(pfad) <> '
'
then pfad := pfad + '
';
h := FindFirstFile(PChar(pfad + '
*.*'), sr);
if h <> INVALID_HANDLE_VALUE
then repeat
if (sr.dwFileAttributes
and FILE_ATTRIBUTE_DIRECTORY = 0)
and (pos(lowercase(extractfileext(sr.cFileName)), filter) > 0)
then begin
sl.add(pfad + sr.cFileName);
gr.add(inttostr(round(
(sr.nFileSizeHigh * MAXDWORD + sr.nFileSizeLow) / 1024 + 0.49)))
end;
until Findnextfile(h, sr) = false;
windows.FindClose(h);
end;
procedure TForm1.MDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button= mbleft
then
//LÄD NUR DAS LETZTE BILD VOM THUMBNAILS !IN ORGINAL GRÖSSE
Image1.Picture.Assign(pct.Create);
//läd jedem angeklicktes bild ,aber nicht in Orginal grösse!
{ Image1.Picture.Assign(TImage(Sender).Picture); }
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
// BILDER LADEN
var
abstand, groesse, nebeneinander, untereinander, x, y, z: integer;
begin
screen.cursor := crHourglass;
groesse := 90;
{ Thumbnailgröße }
abstand := 2;
freigeben;
suchen('
', '
.bmp.wmf.jpg.jpeg');
{ '.bmp.emf.wmf.jpg.jpeg' }
if sl.count > 0
then begin
setlength(im, sl.count);
progressbar1.max := sl.count;
z := 0;
nebeneinander := (scrollbox1.clientwidth - abstand)
div (groesse +
abstand);
{ oder frei festlegen, z.B.: nebeneinander:=20; }
if sl.count < nebeneinander
then nebeneinander := sl.count;
untereinander := (sl.count
div nebeneinander) +
ord(sl.count
mod nebeneinander > 0);
for y := 0
to untereinander - 1
do
for x := 0
to nebeneinander - 1
do begin
if z < sl.count
then begin
im[z] := TImage.create(scrollbox1);
im[z].tag := z;
im[z].width := groesse;
im[z].height := groesse;
im[z].parent := scrollbox1;
im[z].left := abstand + x * (groesse + abstand);
im[z].top := abstand + y * (groesse + abstand);
im[z].OnMouseDown := MDown;
anpassen(sl[z], groesse, im[z], scrollbox1.color, clBtnShadow);
inc(z);
progressbar1.position := z;
end;
end;
{ falls "nebeneinander" nicht frei festgelegt wurde, dann z.B.: }
scrollbox1.clientwidth := (groesse + abstand) * nebeneinander + abstand;
end;
progressbar1.position := 0;
screen.cursor := crDefault;
end;