Avatar billede lanstorp Nybegynder
01. oktober 2003 - 13:40 Der er 9 kommentarer og
2 løsninger

Addere hvid kant til bitmap

Skal addere en hvid 'ramme' på et TBitmap. Dvs. gøre bitmappet større, hvor det oprindelige billed bevares i midten. Det tager tid at loop alle pixels igennem for at opdatere deres værdi. Kender nogen en mere simpel og hurtigere metode til at få adderet nogle perifere hvide rækker og kolonner af pixels til en TBitmap.
Avatar billede borrisholt Novice
01. oktober 2003 - 13:43 #1
DVS du vil bare have en hvid ramme omkring ?

Jens B
Avatar billede athlon-pascal Juniormester
01. oktober 2003 - 13:56 #2
Prøv det her:

procedure AddBorder(var aBitmap: TBitmap; aBorderWidth: Integer; aBorderColor: TColor);
var
  tmpBitmap: TBitmap;
begin
  tmpBitmap := TBitmap.Create;
  try
    tmpBitmap.Width := aBitmap.Width + 2 * aBorderWidth;
    tmpBitmap.Height := aBitmap.Height + 2 * aBorderWidth;
    with tmpBitmap.Canvas do
    begin
      Brush.Style := bsSolid;
      Brush.Color := aBorderColor;
      FillRect(Rect(0, 0, tmpBitmap.Width, tmpBitmap.Height));
      Draw(aBorderWidth, aBorderWidth, aBitmap);
    end;
      aBitmap.Assign(tmpBitmap);
  finally
    tmpBitmap.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  if OpenPictureDialog1.Execute then
  begin
    Bitmap := TBitmap.Create;
    try
      Bitmap.LoadFromFile(OpenPictureDialog1.FileName);
      AddBorder(Bitmap, StrToIntDef(Edit1.Text, 1), clRed); //Du kan ændre clRed til den farve du vil have :-)
      Image1.Picture.Bitmap.Assign(Bitmap);
    finally
      Bitmap.Free;
    end;
  end;
end;
Avatar billede borrisholt Novice
01. oktober 2003 - 13:57 #3
prøv det her :

uses
  JPEG;

function AddBorder(const aBitmap: TBitmap; const FrameColor: TColor = clWhite; const FrameWidth: Integer = 20): TBitmap;
begin
  Result := TBitmap.Create;
  with Result do
  begin
    Width := aBitmap.Width + FrameWidth * 2;
    Height := aBitmap.Height + FrameWidth * 2;
    Canvas.Brush.Color := FrameColor;
    Canvas.FillRect(RECT(0, 0, Width, Height));
    BitBlt(Canvas.Handle, FrameWidth, FrameWidth, aBitmap.Width, aBitmap.Height, aBitmap.Canvas.Handle, 0, 0, SRCCOPY); 
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  aJPEGIMage: TJpegImage;
  aBitmap, aBitmap1: TBitmap;
begin
  aJPEGIMage := TJpegImage.Create;
  aJPEGIMage.LoadFromFile('D:\HEST.jpg');
  aBitmap := TBitmap.Create;
  aBitmap.Assign(aJPEGIMage);

  FreeAndNil(aJPEGIMage);
  aBitmap1 := AddBorder(aBitmap);
  Image1.Picture.Assign(aBitmap1);
  FreeAndNil(aBitmap);
  FreeAndNil(aBitmap1);

end;
Avatar billede athlon-pascal Juniormester
01. oktober 2003 - 13:59 #4
Jens -> For langsom :-p
Avatar billede lanstorp Nybegynder
01. oktober 2003 - 13:59 #5
Ja. Rammen skal være en del af bitmappet. Som hvis man hårdt og kontant gør width og height større på bitmappet, hvor der kommer en hvid kant nederst og til højre.
..
Er ved at rotere bitmappet med D kode, bliver derfor nød til at ændre størrelsen inden rotation så hjørnerne ikke bliver skåret af.
..
Kunne faktisk springe dette spørgsmål over, hvis nogen kender noget delphi kode der kan rotere et bitmap, uden at kappe hjørnerne af.
Avatar billede lanstorp Nybegynder
01. oktober 2003 - 14:00 #6
Så ikke jeres indlæg. Kikker lige ........
Avatar billede borrisholt Novice
01. oktober 2003 - 14:03 #7
unit UnitBitmap;

interface
uses
  Windows, Graphics, Math, Sysutils, Classes;

type
  DegreeType = 0..360;
function RotateBitmap(const Bitmap: TBitmap; Angle: DegreeType; XAsisOffset: Integer = 0; YAsisOffset: Integer = 0): TBitmap;

implementation

//specify which real format we want
type
  //specify the format we want for Points
  PointType = TPoint;
  CoordType = Integer;
  RealType = Single;
  AngleType = RealType;

  //a structure to hold sine,cosine,distance (faster than angle)
  SiCoDiType = record
    si, co, di: RealType; {sine, cosine, distance 6/29/98}
  end;

  {Calculate sine/cosine/distance from Integer coordinates}

function SiCoDiPoint(const p1, p2: PointType): SiCoDiType; {out}
{
  This is MUCH faster than using angle functions such as arctangent
  Use hypot from math.pas
}
var
  dx, dy: CoordType;
begin
  dx := (p2.x - p1.x);
  dy := (p2.y - p1.y);

  with Result do
  begin
    di := HyPot(dx, dy);

    if abs(di) < 1 then
    begin
      si := 0.0;
      co := 1.0
    end //Zero length line
    else
    begin
      si := dy / di;
      co := dx / di
    end;
  end;
end;

// read time stamp in CPU Cycles for Pentium

function RDTSC: Int64;
asm
  DB 0FH, 31H  //allows out-of-sequence execution, caching
end;

{$WARNINGS OFF}

procedure Internal_RotateBitmap(
  const BitmapOriginal: TBitmap; //input bitmap (possibly converted)
  out BitMapRotated: TBitmap; //output bitmap
  const Angle: AngleType; // rotn angle in radians counterclockwise in windows
  const oldAxis: TPOINT; // center of rotation in pixels, rel to bmp origin
  var newAxis: TPOINT); // center of rotated bitmap, relative to bmp origin
{
Notes...
  Coordinates and rotation are adjusted for 'flipped' Y axis (+Y is down)
  Bitmap origins are (0,0) in top-left.

  BitMapRotated is enlarged to contain the rotated bitmap
  BitMapOriginal may be changed from 1,2,4 bit to pf8Bit, if needed.

  rotate about center, Oldaxis:=POINT( bmp.width div 2, bmp.height div 2 );
  rotate about origin top-left, Oldaxis:=POINT( 0,0 );
  rotate about bottom-center, Oldaxis:=POINT( bmp.width div 2, bmp.height )

  NewAxis: is the new center of rotation for BitMapRotated;
}

{
  Features/ improvements over original EFG RotateBitMap:
  This is generalized procedure; application independent.
  Does NOT clip corners; Enlarges Output bmp if needed.
  Output keeps same transparency and pallette as set by BitMapOriginal.
  Handles all pixel formats, format converted to least one byte per pixel.
  Axis of rotation specified by caller, but new axis will differ from oldaxis.
  Minor Delphi performance optimizations (about 8 instructions per pixel)
  Skips "null" angles which have no discernable effect.
}
{
  ToDo.. use pointer arithmetic instead of type subscripting for faster pixels.
  Test pfDevice and pfCustom, test palettes. <no data>. }
type // from Delphi
  TRGBTripleArray = array[0..32767] of TRGBTriple; //allow Integer subscript
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBQuadArray = array[0..32767] of TRGBQuad; //allow Integer subscript
  pRGBQuadArray = ^TRGBQuadArray;

var
  cosTheta: Single; {in windows}
  sinTheta: Single;
  i: Integer;
  iOriginal: Integer;
  iPrime: Integer;
  j: Integer;
  jOriginal: Integer;
  jPrime: Integer;
  NewWidth: Integer;
  NewHeight: Integer;
  nBytes, nBits: Integer; //no. bytes per pixelformat
  Oht, Owi, Rht, Rwi: Integer; //Original and Rotated subscripts to bottom/right

  //each of the following points to the same scanlines
  RowRotatedB: pByteArray; //1 byte
  RowRotatedW: pWordArray; //2 bytes
  RowRotatedT: pRGBtripleArray; //3 bytes
  RowRotatedQ: pRGBquadArray; //4 bytes

  //a single pixel for each format
  TransparentB: Byte;
  TransparentW: Word;
  TransparentT: TRGBTriple;
  TransparentQ: TRGBQuad;

  DIB: TDIBSection;
  SiCoPhi: SiCoDiType; //sine,cosine, distance
begin
  with BitMapOriginal do
  begin
    //Decipher the appropriate pixelformat to use Delphi byte subscripting 1/6/00
    //pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32bit,pfCustom;
    case PixelFormat of
      pfDevice: //handle only pixelbits= 1..8,16,24,32 //10/31/00
        begin
          nbits := GetDeviceCaps(Canvas.Handle, BITSPIXEL) + 1;
          nbytes := nbits div 8; //no. bytes for bits per pixel

          if (nbytes > 0) and (nbits mod 8 <> 0) then
            exit; //ignore if invalid
        end;

      pf1bit:
        nBytes := 0; // 1bit, TByteArray      //2 color pallete , re-assign byte value to 8 pixels, for entire scan line
      pf4bit:
        nBytes := 0; // 4bit, PByteArray    // 16 color pallette; build nibble for pixel pallette index; convert to 8 pixels
      pf8bit:
        nBytes := 1; // 8bit, PByteArray    // byte pallette, 253 out of 256 colors; depends on display mode, needs truecolor ;
      pf15bit:
        nBytes := 2; // 15bit,PWordArrayType // 0rrrrr ggggg bbbbb  0+5+5+5
      pf16bit:
        nBytes := 2; // 16bit,PWordArrayType // rrrrr gggggg bbbbb  5+6+5
      pf24bit:
        nBytes := 3; // 24bit,pRGBtripleArray// bbbbbbbb gggggggg rrrrrrrr  8+8+8
      pf32bit:
        nBytes := 4; // 32bit,pRGBquadArray  // bbbbbbbb gggggggg rrrrrrrr aaaaaaaa 8+8+8+alpha
      // can assign 'Single' reals to this for generating displays/plasma!
      pfCustom: //handle only pixelbits= 1..8,16,24,32
        begin
          GetObject(Handle, SizeOf(DIB), @DIB);
          nbits := DIB.dsBmih.biSizeImage;
          nbytes := nbits div 8;

          if (nbytes > 0) and (nbits mod 8 <> 0) then
            exit; //ignore if invalid
        end; // pfcustom
    else
      exit;
    end; // case

    // BitmapRotated.PixelFormat is the same as BitmapOriginal.PixelFormat;
    // IF PixelFormat is less than 8 bit, then BitMapOriginal.PixelFormat = pf8Bit,
    // because Delphi can't index to bits, just bytes;
    // The next time BitMapOriginal is used it will already be converted.
    //( bmp storage may increase by factor of n*n, where n=8/(no. bits per pixel)  )
    if nBytes = 0 then
      PixelFormat := pf8bit; //note that input bmp is changed

    //assign copies all properties, including pallette and transparency
    BitmapRotated.Assign(BitMapOriginal);

    //COUNTERCLOCKWISE rotation angle in radians. 12/10/99
    sinTheta := SIN(Angle);
    cosTheta := COS(Angle);

    //calculate the enclosing rectangle
    NewWidth := ABS(Round(Height * sinTheta)) + ABS(Round(Width * cosTheta));
    NewHeight := ABS(Round(Width * sinTheta)) + ABS(Round(Height * cosTheta));

    //diff size bitmaps have diff resolution of angle, ie r*sin(theta)<1 pixel
    //use the small angle approx: sin(theta) ~~ theta  //11/7/00
    if (ABS(Angle) * MAX(Width, Height)) > 1 then //non-zero rotation
    begin
      //set output bitmap formats; we do not assume a fixed format or size 1/6/00
      BitmapRotated.Width := NewWidth; //resize it for rotation
      BitmapRotated.Height := NewHeight;
      //center of rotation is center of bitmap
      //    iRotationAxis := width div 2;
      //    jRotationAxis := height div 2;

      //local constants for loop, each was hit at least width*height times  1/8/00
      Rwi := NewWidth - 1; //right column index
      Rht := NewHeight - 1; //bottom row index
      Owi := Width - 1; //transp color column index
      Oht := Height - 1; //transp color row  index

      //Transparent pixel color used for out of range pixels 1/8/00
      //how to translate a Bitmap.TransparentColor=Canvas.Pixels[0, Height - 1];
      // from Tcolor into pixelformat..
      case nBytes of
        0, 1:
          TransparentB := PByteArray(Scanline[Oht])[0];
        2:
          TransparentW := PWordArray(Scanline[Oht])[0];
        3:
          TransparentT := pRGBtripleArray(Scanline[Oht])[0];
        4:
          TransparentQ := pRGBquadArray(Scanline[Oht])[0];
      end; //case

      // Step through each row of rotated image.
      for j := Rht downto 0 do //1/8/00
      begin //for j
        case nBytes of //1/6/00
          0, 1: RowRotatedB := BitmapRotated.Scanline[j];
          2: RowRotatedW := BitmapRotated.Scanline[j];
          3: RowRotatedT := BitmapRotated.Scanline[j];
          4: RowRotatedQ := BitmapRotated.Scanline[j];
        end; //case

        // offset origin by the growth factor
        jPrime := 2 * j - NewHeight + 1;

        // Step through each column of rotated image
        for i := Rwi downto 0 do //1/8/00
        begin //for i

          // offset origin by the growth factor  //12/25/99
          //iPrime := 2*(i - (NewWidth - Width) div 2 - iRotationAxis ) + 1;
          iPrime := 2 * i - NewWidth + 1;

          // Rotate (iPrime, jPrime) to location of desired pixel    (iPrimeRotated,jPrimeRotated)
          // Transform back to pixel coordinates of image, including translation
          // of origin from axis of rotation to origin of image.
          iOriginal := (Round(iPrime * CosTheta - jPrime * sinTheta) - 1 + Width) div 2;
          jOriginal := (Round(iPrime * sinTheta + jPrime * cosTheta) - 1 + Height) div 2;

          // Make sure (iOriginal, jOriginal) is in BitmapOriginal.  If not,
          // assign backgRound color to corner points.
          if (iOriginal >= 0) and (iOriginal <= Owi) and
            (jOriginal >= 0) and (jOriginal <= Oht) {//1/8/00} then
          begin //inside
            // Assign pixel from rotated space to current pixel in BitmapRotated
            //( nearest neighbor interpolation)
            case nBytes of //get pixel bytes according to pixel format  1/6/00
              0, 1: RowRotatedB[i] := pByteArray(scanline[joriginal])[iOriginal];
              2: RowRotatedW[i] := pWordArray(Scanline[jOriginal])[iOriginal];
              3: RowRotatedT[i] := pRGBtripleArray(Scanline[jOriginal])[iOriginal];
              4: RowRotatedQ[i] := pRGBquadArray(Scanline[jOriginal])[iOriginal];
            end; //case
          end //inside
          else
          begin //outside

            //12/10/99 set backgRound corner color to transparent (lower left corner)
            //    RowRotated[i]:=tpixelformat(BitMapOriginal.TRANSPARENTCOLOR) ; wont work
            case nBytes of
              0, 1: RowRotatedB[i] := TransparentB;
              2: RowRotatedW[i] := TransparentW;
              3: RowRotatedT[i] := TransparentT;
              4: RowRotatedQ[i] := TransparentQ;
            end; //case
          end //if inside

        end //for i
      end; //for j
    end; //non-zero rotation

    //offset to the apparent center of rotation  11/12/00 12/25/99
    //rotate/translate the old bitmap origin to the new bitmap origin,FIXED 11/12/00
    sicoPhi := sicodiPoint(POINT(Width div 2, Height div 2), oldaxis);
    //sine/cosine/dist of axis point from center point
    with sicoPhi do
    begin
      //NewAxis := NewCenter + dist* <sin( theta+phi ),cos( theta+phi )>
      NewAxis.x := newWidth div 2 + Round(di * (CosTheta * co - SinTheta * si));
      NewAxis.y := newHeight div 2 - Round(di * (SinTheta * co + CosTheta * si)); //flip yaxis
    end;

  end; //with

end; {Internal_RotateImage}
{$WARNINGS ON}

function RotateBitmap(const Bitmap: TBitmap; Angle: DegreeType; XAsisOffset: Integer = 0; YAsisOffset: Integer = 0): TBitmap;
var
  Center, NewCenter: TPOINT;
  RADAngle: AngleType;
begin
  Center := POINT(XAsisOffset + Bitmap.Width div 2, YAsisOffset + Bitmap.Height div 2);
  Result := TBitmap.Create;
  RADAngle := GradToRad(Angle);
  ; //the angle of rotation in radians
  Internal_RotateBitmap(Bitmap, Result, RADAngle, Center, NewCenter);
end;
end.
Avatar billede borrisholt Novice
01. oktober 2003 - 14:04 #8
unit GraphFlip;

interface

uses Windows, Classes, Sysutils, Graphics;

function RotateBitmap270 (const bitmap : TBitmap) : TBitmap;
function RotateBitmap90 (const bitmap : TBitmap) : TBitmap;
function ConvertToGrayscale (const bitmap : TBitmap) : TBitmap;
function ConvertToNegative (const bitmap : TBitmap) : TBitmap;

implementation

function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
begin
  Dec(Alignment);
  Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
  Result := Result div 8;
end;


function RotateBitmap270 (const bitmap : TBitmap) : TBitmap;
var
  x, y : Integer;
  ps, ps1, pr, pr1 : PRGBTriple;
  bpss, bpsr : Integer;

begin
  if bitmap.PixelFormat <> pf24Bit then
    raise Exception.Create ('Invalid pixel format');
  result := TBitmap.Create;
  result.PixelFormat := bitmap.PixelFormat;
  result.Height := bitmap.Width;
  result.Width := bitmap.Height;

  ps1 := bitmap.ScanLine [0];
  pr1 := result.ScanLine [bitmap.Width - 1];

  bpss := BytesPerScanLine (bitmap.Width, 24, 32);
  bpsr := BytesPerScanLine (result.Width, 24, 32);

  for y := 0 to bitmap.Height - 1 do
  begin
    ps := PRGBTriple (PChar (ps1) - bpss * y);

    for x := 0 to bitmap.Width - 1 do
    begin
      pr := PRGBTriple (PChar (pr1) + bpsr * x);
      Inc (pr, y);
      pr^ := ps^;
      Inc (ps)
    end
  end;
  GDIFlush
end;

function RotateBitmap90 (const bitmap : TBitmap) : TBitmap;
var
  x, y : Integer;
  ps, ps1, pr, pr1 : PRGBTriple;
  bpss, bpsr : Integer;

begin
  if bitmap.PixelFormat <> pf24Bit then
    raise Exception.Create ('Invalid pixel format');
  result := TBitmap.Create;
  result.PixelFormat := bitmap.PixelFormat;
  result.Height := bitmap.Width;
  result.Width := bitmap.Height;

  ps1 := bitmap.ScanLine [bitmap.Height - 1];
  pr1 := result.ScanLine [0];

  bpss := BytesPerScanLine (bitmap.Width, 24, 32);
  bpsr := BytesPerScanLine (result.Width, 24, 32);

  for y := 0 to bitmap.Height - 1 do
  begin
    ps := PRGBTriple (PChar (ps1) + bpss * y);

    for x := 0 to Bitmap.Width - 1 do
    begin
      pr := PRGBTriple (PChar (pr1) - bpsr * x);
      Inc (pr, y);
      pr^ := ps^;
      Inc (ps)
    end
  end;
  GDIFlush
end;


function ConvertToGrayscale (const bitmap : TBitmap) : TBitmap;
var
  x, y : Integer;
  ps, ps1, pr, pr1 : PRGBTriple;
  bps : Integer;
  n : Integer;

begin
  if bitmap.PixelFormat <> pf24Bit then
    raise Exception.Create ('Invalid pixel format');
  result := TBitmap.Create;
  result.PixelFormat := bitmap.PixelFormat;
  result.Height := bitmap.Height;
  result.Width := bitmap.Width;

  ps1 := bitmap.ScanLine [0];
  pr1 := result.ScanLine [0];

  bps := BytesPerScanLine (bitmap.Width, 24, 32);

  for y := 0 to bitmap.Height - 1 do
  begin
    ps := PRGBTriple (PChar (ps1) - bps * y);
    pr := PRGBTriple (PChar (pr1) - bps * y);

    for x := 0 to Bitmap.Width - 1 do
    begin
      n := (ps^.rgbtBlue + ps^.rgbtGreen + ps^.rgbtRed) div 3;
      pr^.rgbtBlue := n;
      pr^.rgbtGreen := n;
      pr^.rgbtRed := n;

      Inc (pr);
      Inc (ps)
    end
  end;
  GDIFlush
end;

function ConvertToNegative (const bitmap : TBitmap) : TBitmap;
var
  x, y : Integer;
  ps, ps1, pr, pr1 : PRGBTriple;
  bps : Integer;
begin
  if bitmap.PixelFormat <> pf24Bit then
    raise Exception.Create ('Invalid pixel format');
  result := TBitmap.Create;
  result.PixelFormat := bitmap.PixelFormat;
  result.Height := bitmap.Height;
  result.Width := bitmap.Width;

  ps1 := bitmap.ScanLine [0];
  pr1 := result.ScanLine [0];

  bps := BytesPerScanLine (bitmap.Width, 24, 32);

  for y := 0 to bitmap.Height - 1 do
  begin
    ps := PRGBTriple (PChar (ps1) - bps * y);
    pr := PRGBTriple (PChar (pr1) - bps * y);

    for x := 0 to Bitmap.Width - 1 do
    begin
      pr^.rgbtBlue := 255 - ps^.rgbtBlue;
      pr^.rgbtGreen := 255 - ps^.rgbtGreen;
      pr^.rgbtRed := 255 - ps^.rgbtRed;

      Inc (pr);
      Inc (ps)
    end
  end;
  GDIFlush
end;

end.
Avatar billede athlon-pascal Juniormester
01. oktober 2003 - 14:04 #9
Hvis ikke Jens'es smarte kode kan bruges (hvilket det sikkert kan), så kig lidt på det her:

procedure AddBorderLeftAndRight(var aBitmap: TBitmap; aLeftBorderWidth, aBottomBorderWidth: Integer; aBorderColor: TColor);
var
  tmpBitmap: TBitmap;
begin
  tmpBitmap := TBitmap.Create;
  try
    tmpBitmap.Width := aBitmap.Width + aLeftBorderWidth;
    tmpBitmap.Height := aBitmap.Height + 2 * aBottomBorderWidth;
    with tmpBitmap.Canvas do
    begin
      Brush.Style := bsSolid;
      Brush.Color := aBorderColor;
      FillRect(Rect(0, 0, tmpBitmap.Width, tmpBitmap.Height));
      Draw(0, 0, aBitmap);
    end;
      aBitmap.Assign(tmpBitmap);
  finally
    tmpBitmap.Free;
  end;
end;
Avatar billede borrisholt Novice
01. oktober 2003 - 14:06 #10
Den her kan også resize dit billede og give dig en kant omkring

unit JpegConv;

interface

uses Windows, Graphics, SysUtils, Classes;

procedure CreateThumbnail(InStream, OutStream: TStream; Width, Height: Integer; FillColor: TColor = clWhite); overload;
procedure CreateThumbnail(const InFileName, OutFileName: string; Width, Height: Integer; FillColor: TColor = clWhite); overload;

implementation

uses Jpeg;

procedure CreateThumbnail(InStream, OutStream: TStream; Width, Height: Integer; FillColor: TColor = clWhite);
var
  JpegImage: TJpegImage;
  Bitmap: TBitmap;
  Ratio: Double;
  ARect: TRect;
  AHeight, AHeightOffset: Integer;
  AWidth, AWidthOffset: Integer;
begin
  //  Check for invalid parameters
  if Width < 1 then
    raise Exception.Create('Invalid Width');
  if Height < 1 then
    raise Exception.Create('Invalid Height');
  JpegImage := TJpegImage.Create;
  try
    //  Load the image
    JpegImage.LoadFromStream(InStream);
    // Create bitmap, and calculate parameters
    Bitmap := TBitmap.Create;
    try
      Ratio := JpegImage.Width / JpegImage.Height;
      if Ratio > 1 then
      begin
        AHeight := Round(Width / Ratio);
        AHeightOffset := (Height - AHeight) div 2;
        AWidth := Width;
        AWidthOffset := 0;
      end
      else
      begin
        AWidth := Round(Height * Ratio);
        AWidthOffset := (Width - AWidth) div 2;
        AHeight := Height;
        AHeightOffset := 0;
      end;
      Bitmap.Width := Width;
      Bitmap.Height := Height;
      Bitmap.Canvas.Brush.Color := FillColor;
      Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
      // StretchDraw original image
      ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset);
      Bitmap.Canvas.StretchDraw(ARect, JpegImage);
      // Assign back to the Jpeg, and save to the file
      JpegImage.Assign(Bitmap);
      JpegImage.SaveToStream(OutStream);
    finally
      Bitmap.Free;
    end;
  finally
    JpegImage.Free;
  end;
end;

procedure CreateThumbnail(const InFileName, OutFileName: string;
  Width, Height: Integer; FillColor: TColor = clWhite); overload;
var
  InStream, OutStream: TFileStream;
begin
  InStream := TFileStream.Create(InFileName, fmOpenRead);
  try
    OutStream := TFileStream.Create(OutFileName, fmOpenWrite or fmCreate);
    try
      CreateThumbnail(InStream, OutStream, Width, Height, FillColor);
    finally
      OutStream.Free;
    end;
  finally
    InStream.Free;
  end;
end;

end.
Avatar billede lanstorp Nybegynder
01. oktober 2003 - 14:14 #11
Det rykker nu. Takker begge meget.
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester