Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  4 648

•  TDictionary Custom Sort  6 651

•  Fast Watermark Sources  6 432

•  3D Designer  9 370

•  Sik Screen Capture  6 758

•  Patch Maker  7 151

•  Айболит (remote control)  7 162

•  ListBox Drag & Drop  6 014

•  Доска для игры Реверси  97 610

•  Графические эффекты  7 343

•  Рисование по маске  6 631

•  Перетаскивание изображений  5 499

•  Canvas Drawing  5 883

•  Рисование Луны  5 606

•  Поворот изображения  5 109

•  Рисование стержней  3 683

•  Paint on Shape  2 913

•  Генератор кроссвордов  3 809

•  Головоломка Paletto  3 062

•  Теорема Монжа об окружностях  3 866

•  Пазл Numbrix  2 547

•  Заборы и коммивояжеры  3 264

•  Игра HIP  2 237

•  Игра Go (Го)  2 171

•  Симулятор лифта  2 548

•  Программа укладки плитки  2 185

•  Генератор лабиринта  2 686

•  Проверка числового ввода  2 331

•  HEX View  2 667

•  Физический маятник  2 302

 
скрыть

Delphi Sources

Изменить размер Bitmap



Оформил: DeeCo

{ 
This function resizes a bitmap calculating the average color of a rectangular 
area of pixels from source bitmap to a pixel or a rectangular area to target 
bitmap. 

It produces a soft-color and undistorsioned result image unlike the StretchDraw 
method 

I think that this method have a tenichal name, but I am not sure. 

As you can see, this function could be very optimized :p 
}

 procedure TFormConvertir.ResizeBitmap(imgo, imgd: TBitmap; nw, nh: Integer);
 var
   xini, xfi, yini, yfi, saltx, salty: single;
   x, y, px, py, tpix: integer;
   PixelColor: TColor;
   r, g, b: longint;

   function MyRound(const X: Double): Integer;
   begin
     Result := Trunc(x);
     if Frac(x) >= 0.5 then
       if x >= 0 then Result := Result + 1
       else
         Result := Result - 1;
     // Result := Trunc(X + (-2 * Ord(X < 0) + 1) * 0.5); 
  end;

 begin
   // Set target size 

  imgd.Width  := nw;
   imgd.Height := nh;

   // Calcs width & height of every area of pixels of the source bitmap 

  saltx := imgo.Width / nw;
   salty := imgo.Height / nh;


   yfi := 0;
   for y := 0 to nh - 1 do
   begin
     // Set the initial and final Y coordinate of a pixel area 

    yini := yfi;
     yfi  := yini + salty;
     if yfi >= imgo.Height then yfi := imgo.Height - 1;

     xfi := 0;
     for x := 0 to nw - 1 do
     begin
       // Set the inital and final X coordinate of a pixel area 

      xini := xfi;
       xfi  := xini + saltx;
       if xfi >= imgo.Width then xfi := imgo.Width - 1;


       // This loop calcs del average result color of a pixel area 
      // of the imaginary grid 

      r := 0;
       g := 0;
       b := 0;
       tpix := 0;

       for py := MyRound(yini) to MyRound(yfi) do
       begin
         for px := MyRound(xini) to MyRound(xfi) do
         begin
           Inc(tpix);
           PixelColor := ColorToRGB(imgo.Canvas.Pixels[px, py]);
           r := r + GetRValue(PixelColor);
           g := g + GetGValue(PixelColor);
           b := b + GetBValue(PixelColor);
         end;
       end;

       // Draws the result pixel 

      imgd.Canvas.Pixels[x, y] :=
         rgb(MyRound(r / tpix),
         MyRound(g / tpix),
         MyRound(b / tpix)
         );
     end;
   end;
 end;




Похожие по теме исходники

Bitmap Sharpen Filter

Simple Bitmap Rotation

Bitmap 32Bit Demo

Thread Bitmap (pencil drawings)