11. april 2003 - 21:00
Der er
10 kommentarer og
1 løsning
Zoom og image
Jeg er ved at lave en billedekigger. Jeg har lavet en zoom-funktion der næsten virker.
Problemet er at det er begrænset hvor meget der kan zoomes ind, afhængigt af billedets størrelse. Jeg kan f.eks. kun zoome lidt mere end 300% med et billede på 1024x1536 pixels. Jeg bruger StrechDraw, er det der begrænsningen ligger?
Her er et lidt rodet, sammenklippet udklip af min kode, jeg håber i kan finde rundt i det:
function ZoomWidth: Integer;
var
X: Extended;
begin
X := Picture.Width * FZoom / 100;
Result := RealRound(X);
end;
function ZoomHeight: Integer;
var
X: Extended;
begin
X := Picture.Height * FZoom / 100;
Result := RealRound(X);
end;
//når jeg tegner billedet:
DestRect := Rect(0, 0, ZoomWidth, ZoomHeight);
StretchDraw(DestRect, Picture.Graphic);
Jeg bruger D4 Standard under Win98 (har også prøvet med D6 Personal).
16. april 2003 - 22:37
#6
Stoney -> Der er samme problem: Et billede på 1536x1024 kan max blive vist ved 328% zoom, hvis man vælger 329% zoom viser den bare en grå flade (som om hele billedet er gråt, hvad det naturligvis ikke er) :-(
Jeg har kun prøvet med StandAlone-demoen (ezDicom.exe), og kun med den exe-fil der på forhånd ligger i zip-filen (jeg brugte ikke Delphi)...
18. april 2003 - 00:56
#8
Fandt denne unit, måske den kan bruges?
unit ManipulateBitmaps;
interface
uses ShellAPI, Windows, SysUtils, Graphics, ExtCtrls;
procedure StretchBitmap(const Source, Destination : TBitmap);
{
This proceedure takes stretches the image in Source
and puts it in Destination.
The width and height of Destination must be specified before
calling StretchBitmap.
The PixelFormat of both Source and Destination are changed to pf32bit.
}
implementation
type
PLongIntArray = ^TLongIntArray;
TLongIntArray = array[0..16383] of longint;
procedure GetIndicies(const DestinationLength, SourceLength,
DestinationIndex : integer;
Out FirstIndex, LastIndex : integer;
Out FirstFraction, LastFraction : double);
{
This proceedure compares the length of two pixel arrays and determines
which pixels in the destination are covered by those in the source.
It also determines what fraction of the first and last pixels are covered
in the destination.
}
var
Index1A : double;
Index2A : double;
Index2B : integer;
begin
Index1A := DestinationIndex/DestinationLength*SourceLength;
FirstIndex := Trunc(Index1A);
FirstFraction := 1-Frac(Index1A);
Index2A := (DestinationIndex+1)/DestinationLength*SourceLength;
Index2B := Trunc(Index2A);
if Index2A = Index2B then
begin
LastIndex := Index2B-1;
LastFraction := 1;
end
else
begin
LastIndex := Index2B;
LastFraction := Frac(Index2A);
end;
if FirstIndex = LastIndex then
begin
FirstFraction := FirstFraction - (1 - LastFraction);
LastFraction := FirstFraction;
end;
end;
procedure StretchBitmap(const Source, Destination : TBitmap);
{
This proceedure takes stretches the image in Source
and puts it in Destination.
The width and height of Destination must be specified
before calling StretchBitmap.
The PixelFormat of both Source and Destination are changed to pf32bit.
}
var
P, P1, P2: PLongIntArray;
X, Y : integer;
FirstY, LastY, FirstX, LastX : integer;
FirstYFrac, LastYFrac, FirstXFrac, LastXFrac : double;
YFrac, XFrac : double;
YIndex, XIndex : integer;
AColor : TColor;
Red, Green, Blue : integer;
RedTotal, GreenTotal, BlueTotal, FracTotal : double;
begin
Source.PixelFormat := pf32bit;
Destination.PixelFormat := Source.PixelFormat;
for Y := 0 to Destination.height -1 do
begin
P := Destination.ScanLine[y];
GetIndicies(Destination.Height,Source.Height, Y,
FirstY, LastY, FirstYFrac, LastYFrac);
for x := 0 to Destination.width -1 do
begin
GetIndicies(Destination.width,Source.width, X,
FirstX, LastX, FirstXFrac, LastXFrac);
RedTotal := 0;
GreenTotal := 0;
BlueTotal := 0;
FracTotal := 0;
for YIndex := FirstY to LastY do
begin
P1 := Source.ScanLine[YIndex];
if YIndex = FirstY then
begin
YFrac := FirstYFrac;
end
else if YIndex = LastY then
begin
YFrac := LastYFrac;
end
else
begin
YFrac := 1;
end;
for XIndex := FirstX to LastX do
begin
AColor := P1[XIndex];
Red := AColor mod $100;
AColor := AColor div $100;
Green := AColor mod $100;
AColor := AColor div $100;
Blue := AColor mod $100;
if XIndex = FirstX then
begin
XFrac := FirstXFrac;
end
else if XIndex = LastX then
begin
XFrac := LastXFrac;
end
else
begin
XFrac := 1;
end;
RedTotal := RedTotal + Red*XFrac*YFrac;
GreenTotal := GreenTotal + Green*XFrac*YFrac;
BlueTotal := BlueTotal + Blue*XFrac*YFrac;
FracTotal := FracTotal + XFrac*YFrac;
end;
end;
Red := Round(RedTotal/FracTotal);
Green := Round(GreenTotal/FracTotal);
Blue := Round(BlueTotal/FracTotal);
AColor := Blue* $10000 + Green*$100 + Red;
P[X] := AColor;
end;
end;
end;
end.
19. april 2003 - 21:04
#10
dkn -> Der er desværre flere problemer med din procedure :-(
1) Der er problemer med store billeder og høj zoom (200-300%), den kommer med fejl...
2) Procedureren forringer billedets kvalitet...
