Bild verkleinern

comes · Beiträge: 40

Quelltext

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:

procedure TForm1.Button1Click(Sender: TObject); 
var x,y,w,h:integer; 
    bild,neu:tBitmap; 
    tmp:tcolor; 
    r,g,b: array of integer; 
    rneu,gneu,bneu:array of integer; 
begin 
    bild:=TBitmap.Create; 
    bild.loadfromfile('C:\dollesBild.BMP'); 
    w:=bild.Width; 
    h:=bild.height; 
    setlength(r,w*h*2); 
    setlength(g,w*h*2); 
    setlength(b,w*h*2); 
    for y:=0 to h-1 do 
        for x:=0 to w-1 do 
        begin 
            tmp:=bild.Canvas.Pixels[x,y]; 
            // Stück für Stück die RGB Werte auslesen 
            // Guck dir die Definition von Tcolor an, dann sollte klar sein, was ich hier mache 
            r[x + y*w]:=tmp MOD 256; 
            tmp:=tmp DIV 256; 
            g[x + y*w]:=tmp MOD 256; 
            tmp:=tmp DIV 256; 
            b[x + y*w]:=tmp MOD 256; 
        end; 

    // Neues Bild erzeugen 
    neu:=tbitmap.Create; 
    neu.Height:=2*h-1; 
    neu.Width:=2*w-1; 

    // Jetzt wirds ein bissel kompliziert mit den Indizes. 
    for y:=0 to h-2 do 
    begin 
        for x:=0 to w-2 do 
        begin 
            neu.Canvas.Pixels[2*x,2*y]:=$00000000 
                + 256*256*b[x + y*w] 
                +     256*g[x + y*w] 
                +         r[x + y*w]; 
            neu.Canvas.Pixels[2*x+1,2*y]:=$00000000 
                +256*256* ((b[x + y*w] +  b[x+1 + y*w])DIV 2) 
                    +256* ((g[x + y*w] +  g[x+1 + y*w])DIV 2) 
                    +     ((r[x + y*w] +  r[x+1 + y*w])DIV 2); 
            neu.Canvas.Pixels[2*x,2*y+1]:=$00000000 
                +256*256* ((b[x + y*w] +  b[x + (y+1)*w])DIV 2) 
                    +256* ((g[x + y*w] +  g[x + (y+1)*w])DIV 2) 
                    +     ((r[x + y*w] +  r[x + (y+1)*w])DIV 2); 
            neu.Canvas.Pixels[2*x+1,2*y+1]:=$00000000 
                +256*256* ((b[x + y*w] +  b[x + (y+1)*w]+b[x+1 + y*w] +  b[x+1 + (y+1)*w])DIV 4) 
                    +256* ((g[x + y*w] +  g[x + (y+1)*w]+g[x+1 + y*w] +  g[x+1 + (y+1)*w])DIV 4) 
                    +     ((r[x + y*w] +  r[x + (y+1)*w]+r[x+1 + y*w] +  r[x+1 + (y+1)*w])DIV 4); 
        end; 
        // lezten Pixel der beiden neuen Zeilen schreiben 
        neu.Canvas.Pixels[2*w-2,2*y]:=$00000000 
                + 256*256*b[w-1 + y*w] 
                +     256*g[w-1 + y*w] 
                +         r[w-1 + y*w]; 
        neu.Canvas.Pixels[2*w-2,2*y+1]:=$00000000 
                + 256*256* ((b[w-1 + y*w] +  b[w-1 + (y+1)*w])DIV 2) 
                +     256* ((g[w-1 + y*w] +  g[w-1 + (y+1)*w])DIV 2) 
                +          ((r[w-1 + y*w] +  r[w-1 + (y+1)*w])DIV 2); 
    end; 
    //Jetzt noch die Letzte Zeile 
    y:=h-1; 
    for x:=0 to w-2 do 
    begin 
        neu.Canvas.Pixels[2*x,2*y]:=$00000000 
                + 256*256*b[x + y*w] 
                +     256*g[x + y*w] 
                +         r[x + y*w]; 
            neu.Canvas.Pixels[2*x+1,2*y]:=$00000000 
                +256*256* ((b[x + y*w] +  b[x+1 + y*w])DIV 2) 
                    +256* ((g[x + y*w] +  g[x+1 + y*w])DIV 2) 
                    +     ((r[x + y*w] +  r[x+1 + y*w])DIV 2); 
    end; 
    // Und den Allerletzten Pixel 
    neu.Canvas.Pixels[2*w-2,2*y]:=$00000000 
            + 256*256*b[w-1 + y*w] 
            +     256*g[w-1 + y*w] 
            +         r[w-1 + y*w]; 

    neu.SaveToFile('C:\dollesgrossesBild.bmp'); 
    neu.Free; 
    bild.Free; 
end;

Hallo erstmal!

ich hab unter www.delphi-forum.de/...2&highlight=jpeg den obenstehenden code gefunden.
Der code funktioniert super solange man ein bild VERGRÖSSERN will, leider aber nicht, wenn ich eines VERKLEINERN will.
Da erhalte ich immer ein leeres (weißes) image. WARUM? was is da falsch?
wie pass ich die fkt an, dass sie mir ein bild verkleinert mit dem selben effekt?

mfg, comes

Raphael O. · Beiträge: 1596 VS 2013

du könntest das Bild einfach mit CopyRect verkleinern... schau dir mal in der Hilfe an, wie man das macht

Keldorn · Verfasst: Fr 05.12.03 09:07

Zitat:

nein, das geht leider nicht!

da is das bild ja verpixelt, dass will ich ja nicht, hab ich ja alles schon ausprobiert

mit stretchdraw und copyrect ist das ergebnis meist nicht berauschend.

interpolation heißt das Zauberwort.
es gibt fertige Routinen (Jedi oder www.g32.org) oder du suchst mal im Forum danach (interpolation). ich hab hier mal einen Link gepostet wo Interpolation besprochen wird.
gugg dort mal, bzw sag ob du eine fertige Routine verwenden willst oder was selber zusammenbasteln willst

Mfg Frank

_________________
Lükes Grundlage der Programmierung: Es wird nicht funktionieren.
(Murphy)

comes · Beiträge: 40

das ganze soll letzen endes in ein ActivX Applet... aber das is ja weniger das prob, bzw hab ich das schon.

wäre schon ganz net,wenn ich da irgendwie ne ftk hätte die ich mir selber basteln kann, zumal die anpassbarkeit einfacher is.

Es müssen aber definitiv jpeg verwendet werden, dass müsste man doch einfach mit uses jpeg lösen, gell?

cu, comes

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

ich glaube (bin mir nicht gans sicher) im hilfe verzeichnis von delphi befinden sich beispiel schau sie dir mal an, ich meine da war sowas auch dabei.....

_________________
MFG
Michael Springwald, "kann kein englisch...."

Phantom1 · Beiträge: 390

Keldorn hat folgendes geschrieben:

mit stretchdraw und copyrect ist das ergebnis meist nicht berauschend.

jo das stimmt, aber versuche mal StretchBlt das liefert eine wesentlich bessere qualität und schnell isses auch, hier mal ein beispiel:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

Procedure BmpResize(Bmp: TBitmap; w, h: Integer);
Var TmpBmp: TBitmap;
Begin
  TmpBmp := TBitmap.Create;
  Try
    TmpBmp.PixelFormat:=pf24bit;
    TmpBmp.Width:=w;
    TmpBmp.Height:=h;
    SetStretchBltMode(TmpBmp.Canvas.Handle, HALFTONE);
    StretchBlt(TmpBmp.Canvas.Handle,0,0,w,h,Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,SRCCOPY);
    Bmp.Assign(TmpBmp);
  Finally
    TmpBmp.Free;
  End;
End;

broesis · Beiträge: 19

@phantom1:

Funktioniert dein Beispiel mit StretchBlt nur mit bmp oder auch mit jpg?

Tschau
Broesis

_________________
"Wer andern eine Grube graebt ist Bauarbeiter"

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme