Растягивание TImage без масштабирования

Posted by bullvinkle under Пост-обзор

Есть такая картинка:

Нужно превратить её в:

Как можно реализовать подобное?

=====================================

Код:


uses ImagingTypes, Imaging, ImagingComponents;
...
procedure TForm1.LoadImage(Filestr:String; Wdth,Hght:integer; NeedResize:Boolean);
var Img,Temp,Temp2: TImageData;
    ImgBitmap: TImagingBitmap;
    dynImage:TImage;
    i,w,h,iw,ih,tw,th:integer;
begin
  InitImage(Img);
  LoadImageFromFile(Edit2.Text, Img);
  if NeedResize then begin
    InitImage(Temp);
    NewImage(Wdth,Hght,Img.Format,Temp);
    iw := Img.Width;
    ih := Img.Height;
    tw := Temp.Width;
    th := Temp.Height;
    w := Round(Img.Width/2);
    h := Round(Img.Height/2);
    CopyRect(Img, 0, 0, iw-w, ih-h, Temp, 0, 0);
    CopyRect(Img, w, 0, iw-w, ih-h, Temp, tw-w, 0);
    CopyRect(Img, 0, h, iw-w, ih-h, Temp, 0, th-h);
    CopyRect(Img, w, h, iw-w, ih-h, Temp, tw-w, th-h);
    NewImage(Wdth,Hght,Temp.Format,Temp2);
    CopyRect(Temp,0,0,tw,th,Temp2,0,0);
    for i := 0 to Wdth - iw+1 do CopyRect(Temp2, w-1, 0, 1, th, Temp, w+i, 0);
    CopyRect(Temp,0,0,tw,th,Temp2,0,0);
    for i := 0 to Hght-ih+1 do CopyRect(Temp2, 0, h-1, tw,1, Temp, 0, h+i);
    FreeImage(Temp2);
    ImgBitmap := TImagingBitmap.Create;
    ImgBitmap.AssignFromImageData(Temp);
    FreeImage(Temp);
  end else begin
    ImgBitmap := TImagingBitmap.Create;
    ImgBitmap.AssignFromImageData(Img);
  end;
  dynImage := TImage.Create(Form1);
  dynImage.Parent := ScrollBox1;
  dynImage.Left := 0;
  dynImage.Top := 0;
  dynImage.Width := Wdth;
  dynImage.Height := Hght;
  dynImage.Picture.Graphic := ImgBitmap;
  FreeImage(Img);
end;

Картинка загружается в scrollbox, т.к. важно было увидеть всю картинку без подгонки.

Тема на форуме.

Последние записи

made in programmersforum 6

Растягивание TImage без масштабирования

Похожие статьи