Тема: Поворот зображення

потрібно, щоб зображення поверталося на 90градусів в будь-який бік (не потрібно, щоб поверталося на певну задану величину градусів, просто на 90)

2

Re: Поворот зображення

Delphi World:

procedure RotateRight(BitMap: tImage);
var
  FirstC, LastC, c, r: integer;

  procedure FixPixels(c, r: integer);
  var
    SavePix, SavePix2: tColor;
    i, NewC, NewR: integer;
  begin
    SavePix := Bitmap.Canvas.Pixels[c, r];
    for i := 1 to 4 do
    begin
      newc := BitMap.Height - r + 1;
      newr := c;
      SavePix2 := BitMap.Canvas.Pixels[newc, newr];
      Bitmap.Canvas.Pixels[newc, newr] := SavePix;
      SavePix := SavePix2;
      c := Newc;
      r := NewR;
    end;
  end;

begin
  if BitMap.Width <> BitMap.Height then
    exit;
  BitMap.Visible := false;
  with Bitmap.Canvas do
  begin
    firstc := 0;
    lastc := BitMap.Width;
    for r := 0 to BitMap.Height div 2 do
    begin
      for c := firstc to lastc do
      begin
        FixPixels(c, r);
      end;
      inc(FirstC);
      Dec(LastC);
    end;
  end;
  BitMap.Visible := true;
end;

3

Re: Поворот зображення

Тільки варто пам'ятати, що Canvas.Pixels є досить повільним. І в FMX цей код мабуть не спрацює.

Подякували: koala1

4

Re: Поворот зображення

Дякую.
А що таке fmx?
а як це повільний (воно не моментально перевертається)?

5

Re: Поворот зображення

Щось мені транспонування матриць згадалося

6

Re: Поворот зображення

КиївОболонь
Майже моментально. Але коли картинка велика, і звертань до Canvas.Pixels багато, то уже буде відчутна затримка. Якщо обмежитися бітмапом з PixelFormat = pf32bit, то можна зробити в десять разів швидше через ScanLine.

FMX - це набір компонент, з яких в сучасних версіях Делфі можна робити програми для Windows, Mac OS, iOS та Android.

7

Re: Поворот зображення

Щось на зразок такого:

procedure RotateRight(BitMap: TBitmap);
  procedure FixPixels(c, r: integer);
  type
    TRGBQuadArray  = array[0..MaxInt div sizeof(TRGBQuad)-1] of TRGBQuad;
    PRGBQuadArray  = ^TRGBQuadArray;
  var
    SavePix, SavePix2: TRGBQuad;
    Row, NewRow: PRGBQuadArray;
    i, NewC, NewR: integer;
  begin
    Row := Bitmap.ScanLine[r];
    SavePix := Row[c];
    for i := 1 to 4 do
    begin
      newc := BitMap.Height - r - 1;
      newr := c;
      NewRow := Bitmap.ScanLine[newr];
      SavePix2 := NewRow[newc];
      NewRow[newc] := SavePix;
      SavePix := SavePix2;
      c := Newc;
      r := NewR;
    end;
  end;

var
  c, r: integer;
begin
  if BitMap.Width <> BitMap.Height then
    exit;
  BitMap.PixelFormat := pf32bit;

  for r := 0 to (BitMap.Height div 2) - 1 do
  begin
    for c := 0 to (BitMap.Width div 2) - 1 do
    begin
      FixPixels(c, r);
    end;
  end;
end;
Подякували: КиївОболонь1

8 Востаннє редагувалося КиївОболонь (21.11.2015 15:56:12)

Re: Поворот зображення

Torbins написав:

Щось на зразок такого:

Дякую
Тільки коли на намагаюся додати виклик цієї процедури в код кнопки, то пише що недостатньо параметрів (якщо вказувати лише імя процедури без bitmap:tbitmap) або ж каже, що очікується '(' замість ':'

Post's attachments

Безымянный.jpg 232.65 kb, 226 downloads since 2015-11-21 

9

Re: Поворот зображення

КиївОболонь написав:
Torbins написав:

Щось на зразок такого:

Дякую
Тільки коли на намагаюся додати виклик цієї процедури в код кнопки, то пише що недостатньо параметрів (якщо вказувати лише імя процедури без bitmap:tbitmap) або ж каже, що очікується '(' замість ':'

RotateRight(bitmap); //де бітмап - змінна типу TBitmap, яку ми і повертаємо

10 Востаннє редагувалося КиївОболонь (21.11.2015 18:43:04)

Re: Поворот зображення

DOP написав:
КиївОболонь написав:
Torbins написав:

Щось на зразок такого:

Дякую
Тільки коли на намагаюся додати виклик цієї процедури в код кнопки, то пише що недостатньо параметрів (якщо вказувати лише імя процедури без bitmap:tbitmap) або ж каже, що очікується '(' замість ':'

RotateRight(bitmap); //де бітмап - змінна типу TBitmap, яку ми і повертаємо

Тоді теж недостатньо параметрів
навіть не так - пише, що очікувалася така дужка '(' замість такої ')'

11

Re: Поворот зображення

Скиньте проект тоді сюди. Будемо розбиратись...

12 Востаннє редагувалося КиївОболонь (21.11.2015 22:24:17)

Re: Поворот зображення

DOP написав:

Скиньте проект тоді сюди. Будемо розбиратись...

Прихований текст
procedure RotateRight(BitMap: TBitmap);
  procedure FixPixels(c, r: integer);
  type
    TRGBQuadArray  = array[0..MaxInt div sizeof(TRGBQuad)-1] of TRGBQuad;
    PRGBQuadArray  = ^TRGBQuadArray;
  var
    SavePix, SavePix2: TRGBQuad;
    Row, NewRow: PRGBQuadArray;
    i, NewC, NewR: integer;
  begin
    Row := Bitmap.ScanLine[r];
    SavePix := Row[c];
    for i := 1 to 4 do
    begin
      newc := BitMap.Height - r - 1;
      newr := c;
      NewRow := Bitmap.ScanLine[newr];
      SavePix2 := NewRow[newc];
      NewRow[newc] := SavePix;
      SavePix := SavePix2;
      c := Newc;
      r := NewR;
    end;
  end;
 
var
  c, r: integer;
begin
  if BitMap.Width <> BitMap.Height then
    exit;
  BitMap.PixelFormat := pf32bit;
 
  for r := 0 to (BitMap.Height div 2) - 1 do
  begin
    for c := 0 to (BitMap.Width div 2) - 1 do
    begin
      FixPixels(c, r);
    end;
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
 rotateright(bitmap);
end;

Тобто спочатку йде сама процедура, потім вона викликається з кнопки button4

Post's attachments

Безымянный.JPG 90.8 kb, 216 downloads since 2015-11-21 

13

Re: Поворот зображення

А де у вас bitmap оголошено, звідки ви його берете? І в uses юніт Graphics має йти після Windows.

14 Востаннє редагувалося КиївОболонь (23.11.2015 17:01:38)

Re: Поворот зображення

Видає дану помилку (причому при обєднанні форм щось приблизно таке ж)
бітмап оголосив(на фото2 видно).
ось результат при натисканні запрограмованої кнопки(кидає на рядок, там де перевіряється, чи ширина бітмапа = його висоті)

Post's attachments

злам1.jpg 339.83 kb, 242 downloads since 2015-11-23 

15 Востаннє редагувалося КиївОболонь (23.11.2015 17:02:04)

Re: Поворот зображення

і це (кидок на рядок перевірки)

Post's attachments

злам2.jpg 308.27 kb, 249 downloads since 2015-11-23 

16

Re: Поворот зображення

Torbins написав:

І в uses юніт Graphics має йти після Windows.

А Графікс в мене був (просто не зразу після Віндовс)

17

Re: Поворот зображення

КиївОболонь написав:

А Графікс в мене був (просто не зразу після Віндовс)

Не важливо, чи є між ними інші юніти, головне хто з них ближчий до кінця списку.

КиївОболонь написав:

і це (кидок на рядок перевірки)

Бітмап ви оголосили, але нічим не заповнили. Спробуйте кинути на форму TImage, вставити туди квадратну картинку і тоді передати в RotateRight щось типу Image1.Picture.Bitmap.

18

Re: Поворот зображення

Що цікаво, спробував код Itari - то тут ситуація інша - замість вибивань кнопка просто не реагує

19

Re: Поворот зображення

Torbins написав:
КиївОболонь написав:

А Графікс в мене був (просто не зразу після Віндовс)

Не важливо, чи є між ними інші юніти, головне хто з них ближчий до кінця списку.

Тобто працювати не буде, якщо спочатку Графікс, а потім вже Віндовс? Компілятор просто вибирає по черзі і йому не все одно, що перше, а що останнє?

20

Re: Поворот зображення

...ще можна через ModifyWorldTransform() https://msdn.microsoft.com/ru-ru/librar … s.85).aspx та SetWorldTransform() https://msdn.microsoft.com/ru-ru/librar … s.85).aspx

var
  Form1: TForm1;
  b: TBitMap;

procedure TForm1.Rotat(angle: Double);
var
  M:TXFORM;
  HDC:THandle;
  a: Double;
begin
  Image1.Canvas.FillRect(Form1.Canvas.ClipRect);
  hDc := image1.Canvas.Handle;
  SetGraphicsMode(hDc, GM_ADVANCED);
  M.eM11 := 1;
  M.eM12 := 0;
  M.eM21 := 0;
  M.eM22 := 1;
  M.eDx := -B.Width div 2;
  M.eDy := -B.Height div 2;
  SetWorldTransform(hDc, M);
  a := (PI * angle) / 180;
  fillChar(M, sizeOf(M), 0);
  M.eM11 := Cos(a);
  M.eM12 := Sin(a);
  M.eM21 := -Sin(a);
  M.eM22 := Cos(a);
  M.eDx := 0;
  M.eDy := 0;
  ModifyWorldTransform(hDc, M, MWT_RIGHTMULTIPLY);
  M.eM11 := 1;
  M.eM12 := 0;
  M.eM21 := 0;
  M.eM22 := 1;
  M.eDx := B.Width div 2;
  M.eDy := B.Height div 2;
  ModifyWorldTransform(hDc, M, MWT_RIGHTMULTIPLY);
  image1.Canvas.Draw(0, 0, b);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  B := TBitMap.Create;
  B.LoadFromFile('1.bmp');
  Image1.Picture.bitmap.assign(b);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Rotat(TrackBar1.Position);
end;

...до речi тест зi сканлайн https://www.youtube.com/watch?v=3t5PBO3fF2o

Подякували: DOP, Torbins2