Zoom og image

hmm sidder ikke lige med delphi, så kan ikke lige prøve det. men har du kigget på google. måske:

http://www.google.com/search?q=zoom+image+delphi&sourceid=opera&num=0&ie=utf-8&oe=utf-8

/ZIRON

Jeg kan ikke rigtig finde noget der virker :-(

Er det virkelig umuligt at lave ordentlig zoom med Delphi?
Der er mange programmer der kan...

http://www.psychology.nottingham.ac.uk/staff/cr1/ezdicom.html

Der er et link til programmet + source ca. midt på siden

Stoney

Stoney -> Det ser meget interessant ud, jeg vil kigge nærmere på det og vende tilbage en af de nærmeste dage :-)

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)...

Har hævet til 120 point (før: 60 point)...

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.

dkn -> Det vil jeg kigge på :-)

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...

Jeg lukker her og græder over Delphi :-(