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

made in programmersforum 7

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

18th
Мар

Delphi 7: замостить TImage маленьким изображением

Posted by obzor under Delphi

Нужно «замостить» TImage маленьким изображением.

hexor_boo

Бинго!

Код:

       bmpImage:=TBitmap.Create;
        Try
         imgBG.Picture:=Nil;//Эта строчка оказалась решающей
         bmpImage.LoadFromFile(SDBV.bg_pic_path);
         imgBG.Canvas.Brush.Bitmap:=bmpImage;
         imgBG.Canvas.FillRect(imgBG.BoundsRect);
        Finally
         imgBG.Canvas.Brush.Bitmap:=Nil;
         bmpImage.Free;
        End;

Осталось найти аналогичное решение для TJPEGImage (потому что файлы ощутимо меньше, чем BMP) и для TPNGObject (потому что нужна поддержка прозрачности, компонент с которым работаю прилагается). GIF возможно тоже буду добавлять.

Решение для TJPEGImage:

Код:

 Procedure TileBG_JPG(imgBG : TImage; SDBV : TServerDBVars);
  Var
   srcImg       : TImage;
   X, Y, dX, dY : Integer;
  Begin
   srcImg:=TImage.Create(frmMain);
    Try
     srcImg.Visible:=False;
     srcImg.AutoSize:=True;
     srcImg.Picture.LoadFromFile(SDBV.bg_pic_path);
     dX:=srcImg.Width;
     dY:=srcImg.Height;
     Y:=0;
     imgBG.Picture:=Nil;
      While (Y<SDBV.base_height) Do
       Begin
        X:=0;
         While (X<SDBV.base_width) Do
          Begin
           imgBG.Canvas.Draw(X, Y, srcImg.Picture.Graphic);
           Inc(X, dX);
          End;
        Inc(Y, dY);
       End;
    Finally
     srcImg.Free;
    End;
  End;