1 Тема від 1a1ka

  • 1a1ka
  • Новий користувач
  • Поза форумом
  • Дата реєстрації: 02.03.2023
  • Повідомлень: 10
    • Репутація: 1

Тема: (FMX) ScrollBox - Timage Zoom - порожні границi

Доброго дня, шановні.
Відразу прошу вибачення за мою тупість - років 5 не кодив, та й особливо Делфі не знав i не знаю). Зараз ще й довелося працювати з FMX.
Моє завдання зробити переглядач фотографій (не саму галерею) як стандартний на Андроїді: зум та скролінг фото.

На формі є ScrollBox( Align: Client ) i в ньому Timage( Align: Center, WrapMode: Fit ).
Є робочий код зуму з папки Samples, все працює як треба:

procedure TViewForm.Image1Gesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
var
  LObj: IControl;
  LImageCenter: TPointF;
begin
 
if EventInfo.GestureID = igiZoom then
  begin
 
    LObj := Self.ObjectAtPoint(ClientToScreen(EventInfo.Location));
 
    if LObj is TImage then
      begin
      if (not(TInteractiveGestureFlag.gfBegin in EventInfo.Flags)) and (not(TInteractiveGestureFlag.gfEnd in EventInfo.Flags)) then
        begin
         LImageCenter := Image1.Position.Point + PointF(Image1.Width / 2, Image1.Height / 2);
         Image1.Width := Max(Image1.Width + (EventInfo.Distance - FLastDistance), 10);
         Image1.Height := Max(Image1.Height + (EventInfo.Distance - FLastDistance), 10);
         Image1.Position.X := LImageCenter.X - Image1.Width / 2;
         Image1.Position.Y := LImageCenter.Y - Image1.Height / 2;
        end;
        FLastDistance := EventInfo.Distance;
   end;
  end;
end;

Проблема в тому, що я не можу зробити, щоб ScrollBox був повністю заповнений фотографією.
Тобто, коли завантажену фотографію збільшую, то по краях зліва та справа (або зверху та знизу - залежить від співвідношення сторін у фотографії) з'являються порожні границi, які збільшуються разом із фотографією ( див. скрiн ).

https://i.stack.imgur.com/GcPTi.jpg

Що я не так роблю? І як це можна виправити?
Дякую хто допоможе

2 Відповідь від Betterthanyou Востаннє редагувалося Betterthanyou (03.03.2023 15:10:53)

  • Звідки: Київ
  • Дата реєстрації: 16.05.2014
  • Повідомлень: 1 695
    • Репутація: 1022

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

А можна зробити залежність з Image1 з ScrollBox1 при Resize ?

procedure TViewForm.FormResize(Sender: TObject);
begin
  Image1.Width := ScrollBox1.Width;
  Image1.Height := ScrollBox1.Height;
end;

Я не Delphi програміст, не можу перевірити. Просто ідея виникла...

Подякували: 1a1ka1

Betterthanyou вебсайт

3 Відповідь від 1a1ka

  • 1a1ka
  • Новий користувач
  • Поза форумом
  • Дата реєстрації: 02.03.2023
  • Повідомлень: 10
    • Репутація: 1

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

Betterthanyou написав:

А можна зробити залежність з Image1 з ScrollBox1 при Resize ?

Нажаль, нi. Зум тодi не буде працювати

4 Відповідь від Torbins

  • Torbins
  • Torbins
  • Replace Team
  • Поза форумом
  • Дата реєстрації: 07.05.2012
  • Повідомлень: 3 086
    • Репутація: 2280

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

Неправильна відповідь: чорні рамки з'явились тому, що пропорції фотки і Image1 не співпадають. Після завантаження фотки треба змінити розміри Image1, щоб картинка акуратно в нього поміщалась.

Правильна відповідь: спробуйте використати TImageViewer, він створений саме для перегляду картинок.

Подякували: Betterthanyou, 1a1ka2

5 Відповідь від 1a1ka

  • 1a1ka
  • Новий користувач
  • Поза форумом
  • Дата реєстрації: 02.03.2023
  • Повідомлень: 10
    • Репутація: 1

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

Torbins написав:

Неправильна відповідь: чорні рамки з'явились тому, що пропорції фотки і Image1 не співпадають. Після завантаження фотки треба змінити розміри Image1, щоб картинка акуратно в нього поміщалась.

Правильна відповідь: спробуйте використати TImageViewer, він створений саме для перегляду картинок.

Вже пробував і щось у мене не вийшло.
1. Коли гружу великий Bitmap в TImageViewer, то зображення відразу відображається у реальних розмірах + скроллбари. В принципі, як і має бути, але тільки я не знайшов як у FMX прописати розміри зображення під ClientWidth/ClientHeight.

Є код зуму для TimageViewer, але вiн не працює в мене чомусь, хоча в iнспекторi установив Zoom в InteractiveGesture:

procedure TForm1.ImageViewer1Gesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
  case EventInfo.GestureID of
    igiZoom:
    begin
      if (EventInfo.Distance - fDistance)/2 > 0 then ImageViewer1.BitmapScale:=ImageViewer1.BitmapScale + 0.01  else
      if (EventInfo.Distance - fDistance)/2 < 0 then ImageViewer1.BitmapScale:=ImageViewer1.BitmapScale - 0.01;
      fDistance:=EventInfo.Distance;
      Handled:=True;
    end;
  end;
end;

6 Відповідь від 1a1ka

  • 1a1ka
  • Новий користувач
  • Поза форумом
  • Дата реєстрації: 02.03.2023
  • Повідомлень: 10
    • Репутація: 1

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

1a1ka написав:

тільки я не знайшов як у FMX прописати розміри зображення під ClientWidth/ClientHeight

Є BitmapScale, але як підлаштувати під розміри екрану? Це мабуть не то.
Все одно, якщо й виставлю BitmapScale під свій екран - всеодно зум не працює

7 Відповідь від 1a1ka

  • 1a1ka
  • Новий користувач
  • Поза форумом
  • Дата реєстрації: 02.03.2023
  • Повідомлень: 10
    • Репутація: 1

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

1a1ka написав:

Все одно, якщо й виставлю BitmapScale під свій екран - всеодно зум не працює

працює, це я накосячив. Але працює неналежно - завжди перекидає в центр зображення, треба якось прописати координати з точки зуму.

Ще й залишилось якось прописати розмiри

8 Відповідь від Torbins

  • Torbins
  • Torbins
  • Replace Team
  • Поза форумом
  • Дата реєстрації: 07.05.2012
  • Повідомлень: 3 086
    • Репутація: 2280

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

1a1ka написав:
1a1ka написав:

тільки я не знайшов як у FMX прописати розміри зображення під ClientWidth/ClientHeight

Є BitmapScale, але як підлаштувати під розміри екрану?

Порівняйте розміри ImageViewer1 і його ImageViewer1.Bitmap, тоді буде зрозуміло, який ставити зум.

1a1ka написав:
1a1ka написав:

Все одно, якщо й виставлю BitmapScale під свій екран - всеодно зум не працює

працює, це я накосячив. Але працює неналежно - завжди перекидає в центр зображення, треба якось прописати координати з точки зуму.

Точку, яку збільшує юзер можна дізнатись з EventInfo.Location, а прокрутити картинку в потрібне місце за допомогою ImageViewer1.ViewportPosition.

Подякували: 1a1ka1

9 Відповідь від 1a1ka

  • 1a1ka
  • Новий користувач
  • Поза форумом
  • Дата реєстрації: 02.03.2023
  • Повідомлень: 10
    • Репутація: 1

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

Torbins написав:

Порівняйте розміри ImageViewer1 і його ImageViewer1.Bitmap, тоді буде зрозуміло, який ставити зум.

Represents the scale of the image.

BitmapScale represents a Single value used to determine the image's size. The Height and Width of the displayed image are calculated by multiplying the original height and width with the BitmapScale value.

    Note: The minimum value for BitmapScale is 0.01 and the maximum value is 10. If a value smaller than the minimum value is assigned, then the property is set to the minimum value. Similarly, if a value greater than the maximum value is assigned, then the property is set to the maximum value.

--
Щось я не зрозумів який BitmapScale у такому разі виставляти(


Torbins написав:

Точку, яку збільшує юзер можна дізнатись з EventInfo.Location, а прокрутити картинку в потрібне місце за допомогою ImageViewer1.ViewportPosition.

Не могли б ви допомогти з кодом? Буду дуже вдячним

10 Відповідь від Torbins

  • Torbins
  • Torbins
  • Replace Team
  • Поза форумом
  • Дата реєстрації: 07.05.2012
  • Повідомлень: 3 086
    • Репутація: 2280

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

1a1ka написав:

Щось я не зрозумів який BitmapScale у такому разі виставляти(

ImageViewer1.BitmapScale := ImageViewer1.ClientWidth / ImageViewer1.Bitmap.Width;

Потім те саме для висоти і залишити менше з двох значень.

1a1ka написав:
Torbins написав:

Точку, яку збільшує юзер можна дізнатись з EventInfo.Location, а прокрутити картинку в потрібне місце за допомогою ImageViewer1.ViewportPosition.

Не могли б ви допомогти з кодом? Буду дуже вдячним

Перед зміною масштабу картинки вирахуйте поточне положення:

var
  HorizontalPercent: Single;
//...
HorizontalPercent := (ImageViewer1.ViewportPosition.X + ImageViewer1.ClientWidth/2) / (ImageViewer1.Bitmap.Width * ImageViewer1.BitmapScale);

А після зміни масштабу відновіть його:

var
  NewPos: TPointF;
//...
NewPos.X := ImageViewer1.Bitmap.Width * ImageViewer1.BitmapScale * HorizontalPercent - ImageViewer1.ClientWidth/2;
ImageViewer1.ViewportPosition := NewPos;

В цьому коді я припускаю, що користувач збільшує центр картинки, тому роблю ImageViewer1.ClientWidth/2 і не використовую EventInfo.Location.
Щоб картинка не смикалася через декілька послідовних прокруток (перша під час зміни BitmapScale, а друга ViewportPosition), перед початком усіх змін варто викликати ImageViewer1.BeginUpdate, а в кінці - ImageViewer1.EndUpdate.

Подякували: 1a1ka, leofun012

11 Відповідь від 1a1ka

  • 1a1ka
  • Новий користувач
  • Поза форумом
  • Дата реєстрації: 02.03.2023
  • Повідомлень: 10
    • Репутація: 1

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

Torbins написав:
ImageViewer1.BitmapScale := ImageViewer1.ClientWidth / ImageViewer1.Bitmap.Width;

Потім те саме для висоти і залишити менше з двох значень.

Велике дякую. Те, що треба

Torbins написав:

А після зміни масштабу відновіть його:

var
  NewPos: TPointF;
//...
NewPos.X := ImageViewer1.Bitmap.Width * ImageViewer1.BitmapScale * HorizontalPercent - ImageViewer1.ClientWidth/2;
ImageViewer1.ViewportPosition := NewPos;

invalid floating point operation delphi

12 Відповідь від Firefox is dead

  • Дата реєстрації: 11.01.2023
  • Повідомлень: 191
    • Репутація: 84

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

me:  *CRAZY*
try it:

procedure TViewForm.Image1Gesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
var
  LObj: IControl;
  LImageCenter: TPointF;
  BoxWidth, BoxHeight, ImageWidth, ImageHeight: Integer;
  Scale, ScaleX, ScaleY: Single;
begin
  if EventInfo.GestureID = igiZoom then
  begin
    LObj := Self.ObjectAtPoint(ClientToScreen(EventInfo.Location));
    if LObj is TImage then
    begin
      if (not(TInteractiveGestureFlag.gfBegin in EventInfo.Flags)) and
         (not(TInteractiveGestureFlag.gfEnd in EventInfo.Flags)) then
      begin
        LImageCenter := Image1.Position.Point + PointF(Image1.Width / 2, Image1.Height / 2);
        Image1.Width := Max(Image1.Width + (EventInfo.Distance - FLastDistance), 10);
        Image1.Height := Max(Image1.Height + (EventInfo.Distance - FLastDistance), 10);
        Image1.Position.X := LImageCenter.X - Image1.Width / 2;
        Image1.Position.Y := LImageCenter.Y - Image1.Height / 2;
      end;
      FLastDistance := EventInfo.Distance;

      // Scale and center the image in the ScrollBox
      BoxWidth := ScrollBox1.ClientWidth;
      BoxHeight := ScrollBox1.ClientHeight;
      ImageWidth := Image1.Bitmap.Width;
      ImageHeight := Image1.Bitmap.Height;
      ScaleX := BoxWidth / ImageWidth;
      ScaleY := BoxHeight / ImageHeight;
      Scale := Min(ScaleX, ScaleY);
      Image1.Scale.X := Scale;
      Image1.Scale.Y := Scale;
      Image1.Width := Round(ImageWidth * Scale);
      Image1.Height := Round(ImageHeight * Scale);
      Image1.Position.X := (BoxWidth - Image1.Width) / 2;
      Image1.Position.Y := (BoxHeight - Image1.Height) / 2;
    end;
  end;
end;
Подякували: 1a1ka1

13 Відповідь від 1a1ka

  • 1a1ka
  • Новий користувач
  • Поза форумом
  • Дата реєстрації: 02.03.2023
  • Повідомлень: 10
    • Репутація: 1

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

1a1ka написав:

invalid floating point operation

Вибачаюсь, без слова "delphi".

14 Відповідь від 1a1ka

  • 1a1ka
  • Новий користувач
  • Поза форумом
  • Дата реєстрації: 02.03.2023
  • Повідомлень: 10
    • Репутація: 1

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

Firefox is dead написав:

try it

Нажаль(

15 Відповідь від 1a1ka

  • 1a1ka
  • Новий користувач
  • Поза форумом
  • Дата реєстрації: 02.03.2023
  • Повідомлень: 10
    • Репутація: 1

Re: (FMX) ScrollBox - Timage Zoom - порожні границi

Torbins, велике дякую. Начебто робить:

procedure TViewForm.VImageGesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
var
  LObj: IControl;
  HorizontalPercent, VerticalPercent: Single;
  NewPos: TPointF;
begin

 if EventInfo.GestureID = igiZoom then
  begin

    LObj := Self.ObjectAtPoint(ClientToScreen(EventInfo.Location));

    if LObj is TImageViewer then
    begin
      if (not(TInteractiveGestureFlag.gfBegin in EventInfo.Flags)) and
        (not(TInteractiveGestureFlag.gfEnd in EventInfo.Flags)) then
    begin
      VImage.BeginUpdate;

      HorizontalPercent := (VImage.ViewportPosition.X + VImage.ClientWidth/2) / (VImage.Bitmap.Width * VImage.BitmapScale);
      VerticalPercent := (VImage.ViewportPosition.Y + VImage.ClientHeight/2) / (VImage.Bitmap.Height * VImage.BitmapScale);

        if (EventInfo.Distance - FLastDistance)/2 > 0 then VImage.BitmapScale:=VImage.BitmapScale + 0.03  else
        if (EventInfo.Distance - FLastDistance)/2 < 0 then VImage.BitmapScale:=VImage.BitmapScale - 0.03;


      NewPos.X := VImage.Bitmap.Width * VImage.BitmapScale * HorizontalPercent - VImage.ClientWidth/2;
      NewPos.Y := VImage.Bitmap.Height * VImage.BitmapScale * VerticalPercent - VImage.ClientHeight/2;
      VImage.ViewportPosition := NewPos;

      VImage.EndUpdate;

    end;
      FLastDistance:=EventInfo.Distance;
      Handled:=True;

  end;
end;
Подякували: Torbins1