Ви не увійшли. Будь ласка, увійдіть або зареєструйтесь.
Ласкаво просимо вас на україномовний форум з програмування, веб-дизайну, SEO та всього пов'язаного з інтернетом та комп'ютерами.
Будемо вдячні, якщо ви поділитись посиланням на Replace.org.ua на інших ресурсах.
Для того щоб створювати теми та надсилати повідомлення вам потрібно Зареєструватись.
Український форум програмістів → Pascal/Delphi → Поворот зображення
Для відправлення відповіді ви повинні увійти або зареєструватися
потрібно, щоб зображення поверталося на 90градусів в будь-який бік (не потрібно, щоб поверталося на певну задану величину градусів, просто на 90)
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;
Тільки варто пам'ятати, що Canvas.Pixels є досить повільним. І в FMX цей код мабуть не спрацює.
Дякую.
А що таке fmx?
а як це повільний (воно не моментально перевертається)?
Щось мені транспонування матриць згадалося
КиївОболонь
Майже моментально. Але коли картинка велика, і звертань до Canvas.Pixels багато, то уже буде відчутна затримка. Якщо обмежитися бітмапом з PixelFormat = pf32bit, то можна зробити в десять разів швидше через ScanLine.
FMX - це набір компонент, з яких в сучасних версіях Делфі можна робити програми для Windows, Mac OS, iOS та Android.
Щось на зразок такого:
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;Щось на зразок такого:
Дякую
Тільки коли на намагаюся додати виклик цієї процедури в код кнопки, то пише що недостатньо параметрів (якщо вказувати лише імя процедури без bitmap:tbitmap) або ж каже, що очікується '(' замість ':'
Torbins написав:Щось на зразок такого:
Дякую
Тільки коли на намагаюся додати виклик цієї процедури в код кнопки, то пише що недостатньо параметрів (якщо вказувати лише імя процедури без bitmap:tbitmap) або ж каже, що очікується '(' замість ':'
RotateRight(bitmap); //де бітмап - змінна типу TBitmap, яку ми і повертаємоКиївОболонь написав:Torbins написав:Щось на зразок такого:
Дякую
Тільки коли на намагаюся додати виклик цієї процедури в код кнопки, то пише що недостатньо параметрів (якщо вказувати лише імя процедури без bitmap:tbitmap) або ж каже, що очікується '(' замість ':'RotateRight(bitmap); //де бітмап - змінна типу TBitmap, яку ми і повертаємо
Тоді теж недостатньо параметрів
навіть не так - пише, що очікувалася така дужка '(' замість такої ')'
Скиньте проект тоді сюди. Будемо розбиратись...
Тобто спочатку йде сама процедура, потім вона викликається з кнопки button4
А де у вас bitmap оголошено, звідки ви його берете? І в uses юніт Graphics має йти після Windows.
Видає дану помилку (причому при обєднанні форм щось приблизно таке ж)
бітмап оголосив(на фото2 видно).
ось результат при натисканні запрограмованої кнопки(кидає на рядок, там де перевіряється, чи ширина бітмапа = його висоті)
і це (кидок на рядок перевірки)
І в uses юніт Graphics має йти після Windows.
А Графікс в мене був (просто не зразу після Віндовс)
А Графікс в мене був (просто не зразу після Віндовс)
Не важливо, чи є між ними інші юніти, головне хто з них ближчий до кінця списку.
і це (кидок на рядок перевірки)
Бітмап ви оголосили, але нічим не заповнили. Спробуйте кинути на форму TImage, вставити туди квадратну картинку і тоді передати в RotateRight щось типу Image1.Picture.Bitmap.
Що цікаво, спробував код Itari - то тут ситуація інша - замість вибивань кнопка просто не реагує
КиївОболонь написав:А Графікс в мене був (просто не зразу після Віндовс)
Не важливо, чи є між ними інші юніти, головне хто з них ближчий до кінця списку.
Тобто працювати не буде, якщо спочатку Графікс, а потім вже Віндовс? Компілятор просто вибирає по черзі і йому не все одно, що перше, а що останнє?
...ще можна через 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
Для відправлення відповіді ви повинні увійти або зареєструватися