Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 20

Раздел: Delphi » Графика (2D и 3D) в приложениях
/ вопрос открыт /

Здравствуйте, эксперты!
Вопрос таков:
Подскажите как можно инвертировать, вращать, устанавливать фоновый цвет изображения, загруженного в TImage?

Ситников Константин Евгеньевич Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Ситников Константин Евгеньевич (статус: Посетитель)
Вопрос отправлен: 7 мая 2006, 19:24
Состояние вопроса: открыт, ответов: 5.

Ответ #1. Отвечает эксперт: Степанов Игорь Николаевич

Посмотри, возможно поможет:

Приложение:
  1. procedure RotateRight(BitMap: tImage);
  2. var
  3. FirstC, LastC, c, r: integer;
  4.  
  5. procedure FixPixels(c, r: integer);
  6. var
  7. SavePix, SavePix2: tColor;
  8. i, NewC, NewR: integer;
  9. begin
  10. SavePix := Bitmap.Canvas.Pixels[c, r];
  11. for i := 1 to 4 do
  12. begin
  13. newc := BitMap.Height - r + 1;
  14. newr := c;
  15. SavePix2 := BitMap.Canvas.Pixels[newc, newr];
  16. Bitmap.Canvas.Pixels[newc, newr] := SavePix;
  17. SavePix := SavePix2;
  18. c := Newc;
  19. r := NewR;
  20. end;
  21. end;
  22.  
  23. begin
  24. if BitMap.Width <> BitMap.Height then
  25. exit;
  26. BitMap.Visible := false;
  27. with Bitmap.Canvas do
  28. begin
  29. firstc := 0;
  30. lastc := BitMap.Width;
  31. for r := 0 to BitMap.Height div 2 do
  32. begin
  33. for c := firstc to lastc do
  34. begin
  35. FixPixels(c, r);
  36. end;
  37. inc(FirstC);
  38. Dec(LastC);
  39. end;
  40. end;
  41. BitMap.Visible := true;
  42. end;


Ответ отправил: Степанов Игорь Николаевич (статус: 2-ой класс)
Время отправки: 7 мая 2006, 20:31

Ответ #2. Отвечает эксперт: Матвеев Игорь Владимирович

На счет вращения и инверсии все понятно - см. приложение, но что Вы имели ввиду под установкой фонового цвета? Может Вам нужно просто залить какую-то область нужным цветом - это функция FloodFill:
Canvas.FloodFill(10, 10, clBlack, fsBorder);

Приложение:
  1. procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor);
  2. var
  3. x, y, W, H, v1, v2: Integer;
  4. Dest, Src: pRGB;
  5. VertArray: array of pByteArray;
  6. Bmp: TBitmap;
  7.  
  8. procedure SinCos(AngleRad: Double; var ASin, ACos: Double);
  9. begin
  10. ASin := Sin(AngleRad);
  11. ACos := Cos(AngleRad);
  12. end;
  13.  
  14. function RotateRect(const Rect: TRect; const Center: TPoint; Angle: Double):
  15. TRectList;
  16. var
  17. DX, DY: Integer;
  18. SinAng, CosAng: Double;
  19. function RotPoint(PX, PY: Integer): TPoint;
  20. begin
  21. DX := PX - Center.x;
  22. DY := PY - Center.y;
  23. Result.x := Center.x + Round(DX * CosAng - DY * SinAng);
  24. Result.y := Center.y + Round(DX * SinAng + DY * CosAng);
  25. end;
  26. begin
  27. SinCos(Angle * (Pi / 180), SinAng, CosAng);
  28. Result[1] := RotPoint(Rect.Left, Rect.Top);
  29. Result[2] := RotPoint(Rect.Right, Rect.Top);
  30. Result[3] := RotPoint(Rect.Right, Rect.Bottom);
  31. Result[4] := RotPoint(Rect.Left, Rect.Bottom);
  32. end;
  33.  
  34. function Min(A, B: Integer): Integer;
  35. begin
  36. if A < B then
  37. Result := A
  38. else
  39. Result := B;
  40. end;
  41.  
  42. function Max(A, B: Integer): Integer;
  43. begin
  44. if A > B then
  45. Result := A
  46. else
  47. Result := B;
  48. end;
  49.  
  50. function GetRLLimit(const RL: TRectList): TRect;
  51. begin
  52. Result.Left := Min(Min(RL[1].x, RL[2].x), Min(RL[3].x, RL[4].x));
  53. Result.Top := Min(Min(RL[1].y, RL[2].y), Min(RL[3].y, RL[4].y));
  54. Result.Right := Max(Max(RL[1].x, RL[2].x), Max(RL[3].x, RL[4].x));
  55. Result.Bottom := Max(Max(RL[1].y, RL[2].y), Max(RL[3].y, RL[4].y));
  56. end;
  57.  
  58. procedure Rotate;
  59. var
  60. x, y, xr, yr, yp: Integer;
  61. ACos, ASin: Double;
  62. Lim: TRect;
  63. begin
  64. W := Bmp.Width;
  65. H := Bmp.Height;
  66. SinCos(-Angle * Pi / 180, ASin, ACos);
  67. Lim := GetRLLimit(RotateRect(Rect(0, 0, Bmp.Width, Bmp.Height), Point(0, 0),
  68. Angle));
  69. Bitmap.Width := Lim.Right - Lim.Left;
  70. Bitmap.Height := Lim.Bottom - Lim.Top;
  71. Bitmap.Canvas.Brush.Color := BackColor;
  72. Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
  73. for y := 0 to Bitmap.Height - 1 do
  74. begin
  75. Dest := Bitmap.ScanLine[y];
  76. yp := y + Lim.Top;
  77. for x := 0 to Bitmap.Width - 1 do
  78. begin
  79. xr := Round(((x + Lim.Left) * ACos) - (yp * ASin));
  80. yr := Round(((x + Lim.Left) * ASin) + (yp * ACos));
  81. if (xr > -1) and (xr < W) and (yr > -1) and (yr < H) then
  82. begin
  83. Src := Bmp.ScanLine[yr];
  84. Inc(Src, xr);
  85. Dest^ := Src^;
  86. end;
  87. Inc(Dest);
  88. end;
  89. end;
  90. end;
  91.  
  92. begin
  93. Bitmap.PixelFormat := pf24Bit;
  94. Bmp := TBitmap.Create;
  95. try
  96. Bmp.Assign(Bitmap);
  97. W := Bitmap.Width - 1;
  98. H := Bitmap.Height - 1;
  99. if Frac(Angle) <> 0.0 then
  100. Rotate
  101. else
  102. case Trunc(Angle) of
  103. -360, 0, 360, 720: Exit;
  104. 90, 270:
  105. begin
  106. Bitmap.Width := H + 1;
  107. Bitmap.Height := W + 1;
  108. SetLength(VertArray, H + 1);
  109. v1 := 0;
  110. v2 := 0;
  111. if Angle = 90.0 then
  112. v1 := H
  113. else
  114. v2 := W;
  115. for y := 0 to H do
  116. VertArray[y] := Bmp.ScanLine[Abs(v1 - y)];
  117. for x := 0 to W do
  118. begin
  119. Dest := Bitmap.ScanLine[x];
  120. for y := 0 to H do
  121. begin
  122. v1 := Abs(v2 - x) * 3;
  123. with Dest^ do
  124. begin
  125. B := VertArray[y, v1];
  126. G := VertArray[y, v1 + 1];
  127. R := VertArray[y, v1 + 2];
  128. end;
  129. Inc(Dest);
  130. end;
  131. end
  132. end;
  133. 180:
  134. begin
  135. for y := 0 to H do
  136. begin
  137. Dest := Bitmap.ScanLine[y];
  138. Src := Bmp.ScanLine[H - y];
  139. Inc(Src, W);
  140. for x := 0 to W do
  141. begin
  142. Dest^ := Src^;
  143. Dec(Src);
  144. Inc(Dest);
  145. end;
  146. end;
  147. end;
  148. else
  149. Rotate;
  150. end;
  151. finally
  152. Bmp.Free;
  153. end;
  154. end;
  155.  
  156. procedure InvertBitmap(Bitmap: TBitmap);
  157. var
  158. x, y : Integer;
  159. Dest : pRGB;
  160. begin
  161. Bitmap.PixelFormat := pf24Bit;
  162. for y := 0 to Bitmap.Height - 1 do
  163. begin
  164. Dest := Bitmap.ScanLine[y];
  165. for x := 0 to Bitmap.Width - 1 do
  166. begin
  167. with Dest^ do
  168. begin
  169. R := not R;
  170. G := not G;
  171. B := not B;
  172. end;
  173. Inc(Dest);
  174. end;
  175. end;
  176. end;


Ответ отправил: Матвеев Игорь Владимирович (статус: Студент)
Время отправки: 8 мая 2006, 00:28

Ответ #3. Отвечает эксперт: bruder

Здравствуйте, Ситников Константин Евгеньевич!
Инвертировать - код в приложении. Удачи!

Приложение:
  1. function InvertBitmap(MyBitmap: TBitmap): TBitmap;
  2. var
  3. x, y: Integer;
  4. ByteArray: PByteArray;
  5. begin
  6. MyBitmap.PixelFormat := pf24Bit;
  7. for y := 0 to MyBitmap.Height - 1 do
  8. begin
  9. ByteArray := MyBitmap.ScanLine[y];
  10. for x := 0 to MyBitmap.Width * 3 - 1 do
  11. begin
  12. ByteArray[x] := 255 - ByteArray[x];
  13. end;
  14. end;
  15. Result := MyBitmap;
  16. end; Example:
  17.  
  18. procedure TForm1.Button1Click(Sender: TObject);
  19. begin
  20. Image1.Picture.Bitmap := InvertBitmap(Image1.Picture.Bitmap);
  21. Image1.Refresh;
  22. end;
  23.  
  24.  
  25.  
  26. procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor);
  27. type
  28. TRGB = record
  29. B, G, R: Byte;
  30. end;
  31. pRGB = ^TRGB;
  32. pByteArray = ^TByteArray;
  33. TByteArray = array[0..32767] of Byte;
  34. TRectList = array[1..4] of TPoint;
  35.  
  36. var
  37. x, y, W, H, v1, v2: Integer;
  38. Dest, Src: pRGB;
  39. VertArray: array of pByteArray;
  40. Bmp: TBitmap;
  41.  
  42. procedure SinCos(AngleRad: Double; var ASin, ACos: Double);
  43. begin
  44. ASin := Sin(AngleRad);
  45. ACos := Cos(AngleRad);
  46. end;
  47.  
  48. function RotateRect(const Rect: TRect; const Center: TPoint; Angle: Double):
  49. TRectList;
  50. var
  51. DX, DY: Integer;
  52. SinAng, CosAng: Double;
  53. function RotPoint(PX, PY: Integer): TPoint;
  54. begin
  55. DX := PX - Center.x;
  56. DY := PY - Center.y;
  57. Result.x := Center.x + Round(DX * CosAng - DY * SinAng);
  58. Result.y := Center.y + Round(DX * SinAng + DY * CosAng);
  59. end;
  60. begin
  61. SinCos(Angle * (Pi / 180), SinAng, CosAng);
  62. Result[1] := RotPoint(Rect.Left, Rect.Top);
  63. Result[2] := RotPoint(Rect.Right, Rect.Top);
  64. Result[3] := RotPoint(Rect.Right, Rect.Bottom);
  65. Result[4] := RotPoint(Rect.Left, Rect.Bottom);
  66. end;
  67.  
  68. function Min(A, B: Integer): Integer;
  69. begin
  70. if A &lt; B then
  71. Result := A
  72. else
  73. Result := B;
  74. end;
  75.  
  76. function Max(A, B: Integer): Integer;
  77. begin
  78. if A &gt; B then
  79. Result := A
  80. else
  81. Result := B;
  82. end;
  83.  
  84. function GetRLLimit(const RL: TRectList): TRect;
  85. begin
  86. Result.Left := Min(Min(RL[1].x, RL[2].x), Min(RL[3].x, RL[4].x));
  87. Result.Top := Min(Min(RL[1].y, RL[2].y), Min(RL[3].y, RL[4].y));
  88. Result.Right := Max(Max(RL[1].x, RL[2].x), Max(RL[3].x, RL[4].x));
  89. Result.Bottom := Max(Max(RL[1].y, RL[2].y), Max(RL[3].y, RL[4].y));
  90. end;
  91.  
  92. procedure Rotate;
  93. var
  94. x, y, xr, yr, yp: Integer;
  95. ACos, ASin: Double;
  96. Lim: TRect;
  97. begin
  98. W := Bmp.Width;
  99. H := Bmp.Height;
  100. SinCos(-Angle * Pi / 180, ASin, ACos);
  101. Lim := GetRLLimit(RotateRect(Rect(0, 0, Bmp.Width, Bmp.Height), Point(0, 0),
  102. Angle));
  103. Bitmap.Width := Lim.Right - Lim.Left;
  104. Bitmap.Height := Lim.Bottom - Lim.Top;
  105. Bitmap.Canvas.Brush.Color := BackColor;
  106. Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
  107. for y := 0 to Bitmap.Height - 1 do
  108. begin
  109. Dest := Bitmap.ScanLine[y];
  110. yp := y + Lim.Top;
  111. for x := 0 to Bitmap.Width - 1 do
  112. begin
  113. xr := Round(((x + Lim.Left) * ACos) - (yp * ASin));
  114. yr := Round(((x + Lim.Left) * ASin) + (yp * ACos));
  115. if (xr &gt; -1) and (xr &lt; W) and (yr &gt; -1) and (yr &lt; H) then
  116. begin
  117. Src := Bmp.ScanLine[yr];
  118. Inc(Src, xr);
  119. Dest^ := Src^;
  120. end;
  121. Inc(Dest);
  122. end;
  123. end;
  124. end;
  125.  
  126. begin
  127. Bitmap.PixelFormat := pf24Bit;
  128. Bmp := TBitmap.Create;
  129. try
  130. Bmp.Assign(Bitmap);
  131. W := Bitmap.Width - 1;
  132. H := Bitmap.Height - 1;
  133. if Frac(Angle) &lt;&gt; 0.0 then
  134. Rotate
  135. else
  136. case Trunc(Angle) of
  137. -360, 0, 360, 720: Exit;
  138. 90, 270:
  139. begin
  140. Bitmap.Width := H + 1;
  141. Bitmap.Height := W + 1;
  142. SetLength(VertArray, H + 1);
  143. v1 := 0;
  144. v2 := 0;
  145. if Angle = 90.0 then
  146. v1 := H
  147. else
  148. v2 := W;
  149. for y := 0 to H do
  150. VertArray[y] := Bmp.ScanLine[Abs(v1 - y)];
  151. for x := 0 to W do
  152. begin
  153. Dest := Bitmap.ScanLine[x];
  154. for y := 0 to H do
  155. begin
  156. v1 := Abs(v2 - x) * 3;
  157. with Dest^ do
  158. begin
  159. B := VertArray[y, v1];
  160. G := VertArray[y, v1 + 1];
  161. R := VertArray[y, v1 + 2];
  162. end;
  163. Inc(Dest);
  164. end;
  165. end
  166. end;
  167. 180:
  168. begin
  169. for y := 0 to H do
  170. begin
  171. Dest := Bitmap.ScanLine[y];
  172. Src := Bmp.ScanLine[H - y];
  173. Inc(Src, W);
  174. for x := 0 to W do
  175. begin
  176. Dest^ := Src^;
  177. Dec(Src);
  178. Inc(Dest);
  179. end;
  180. end;
  181. end;
  182. else
  183. Rotate;
  184. end;
  185. finally
  186. Bmp.Free;
  187. end;
  188. end;
  189.  
  190. Example:
  191.  
  192. procedure TForm1.Button1Click(Sender: TObject);
  193. begin
  194. RotateBitmap(Image1.Picture.Bitmap, 17.23, clWhite);
  195. end;


Ответ отправил: bruder (статус: 4-ый класс)
Время отправки: 8 мая 2006, 15:40

Ответ #4. Отвечает эксперт: Zeon

Для вращения: (см. приложение)

А для заливки одним цветом лучше использовать:

procedureTForm1.Button1Click(Sender: TObject);
begin
PatBlt(Form1.Canvas.Handle,
0,
0,
Form1.ClientWidth,
Form1.ClientHeight,
WHITENESS);
end;

побыстрее работает.

Приложение:
  1. Const PixelMax = 32768;
  2. Type
  3. pPixelArray = ^TPixelArray;
  4. TPixelArray = Array[0..PixelMax-1] Of TRGBTriple;
  5.  
  6. Procedure RotateBitmap_ads(
  7. SourceBitmap : TBitmap;
  8. out DestBitmap : TBitmap;
  9. Center : TPoint;
  10. Angle : Double);
  11. Var
  12. cosRadians : Double;
  13. inX : Integer;
  14. inXOriginal : Integer;
  15. inXPrime : Integer;
  16. inXPrimeRotated : Integer;
  17. inY : Integer;
  18. inYOriginal : Integer;
  19. inYPrime : Integer;
  20. inYPrimeRotated : Integer;
  21. OriginalRow : pPixelArray;
  22. Radians : Double;
  23. RotatedRow : pPixelArray;
  24. sinRadians : Double;
  25. begin
  26. DestBitmap.Width := SourceBitmap.Width;
  27. DestBitmap.Height := SourceBitmap.Height;
  28. DestBitmap.PixelFormat := pf24bit;
  29. Radians := -(Angle) * PI / 180;
  30. sinRadians := Sin(Radians);
  31. cosRadians := Cos(Radians);
  32. For inX := DestBitmap.Height-1 Downto 0 Do
  33. Begin
  34. RotatedRow := DestBitmap.Scanline[inX];
  35. inXPrime := 2*(inX - Center.y) + 1;
  36. For inY := DestBitmap.Width-1 Downto 0 Do
  37. Begin
  38. inYPrime := 2*(inY - Center.x) + 1;
  39. inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians);
  40. inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians);
  41. inYOriginal := (inYPrimeRotated - 1) Div 2 + Center.x;
  42. inXOriginal := (inXPrimeRotated - 1) Div 2 + Center.y;
  43. If
  44. (inYOriginal >= 0) And
  45. (inYOriginal <= SourceBitmap.Width-1) And
  46. (inXOriginal >= 0) And
  47. (inXOriginal <= SourceBitmap.Height-1)
  48. Then
  49. Begin
  50. OriginalRow := SourceBitmap.Scanline[inXOriginal];
  51. RotatedRow[inY] := OriginalRow[inYOriginal]
  52. End
  53. Else
  54. Begin
  55. RotatedRow[inY].rgbtBlue := 255;
  56. RotatedRow[inY].rgbtGreen := 0;
  57. RotatedRow[inY].rgbtRed := 0
  58. End;
  59. End;
  60. End;
  61. End;
  62.  
  63. {Usage:}
  64. procedure TForm1.Button1Click(Sender: TObject);
  65. Var
  66. Center : TPoint;
  67. Bitmap : TBitmap;
  68. begin
  69. Bitmap := TBitmap.Create;
  70. Try
  71. Center.y := (Image.Height div 2)+20;
  72. Center.x := (Image.Width div 2)+0;
  73. RotateBitmap_ads(
  74. Image.Picture.Bitmap,
  75. Bitmap,
  76. Center,
  77. Angle);
  78. Angle := Angle + 15;
  79. Image2.Picture.Bitmap.Assign(Bitmap);
  80. Finally
  81. Bitmap.Free;
  82. End;
  83. end;


Ответ отправил: Zeon (статус: 2-ой класс)
Время отправки: 9 мая 2006, 19:20

Ответ #5. Отвечает эксперт: Вадим К

В обычном изображении фоновый цвет никак не отличается от всех остальных. Определить его можно только "зрительно". Причём в разных людей это может быть разный цвет. К примеру, возмём изображение флага. Где там фон? (При условии, что всё изображение занимает флаг).
А теперь ответ На вопрос, как изменить фон.
Изменить фон - значит заменить пиксели с цветом, который мы признали фоном на новый цвет.
Компонент TImage, если ему выставить свойство Transparent, прозрачным считает левый нижний пиксель.

Ответ отправил: Вадим К (статус: Академик)
Время отправки: 10 мая 2006, 12:22


Мини-форум вопроса

Всего сообщений: 6; последнее сообщение — 27 октября 2011, 02:17; участников в обсуждении: 4.
Егор

Егор (статус: 10-ый класс), 12 июня 2010, 19:03 [#1]:

Цитата (Ситников Константин Евгеньевич):

как можно инвертировать, вращать, устанавливать фоновый цвет изображения, загруженного в TImage?

мамочки мои...
ВРАЩАТЬ фоновый цвет?!
Опасайтесь багов в приведенном выше коде; я только доказал корректность, но не запускал его.
— Donald E. Knuth.
padonak

padonak (статус: Посетитель), 22 июня 2010, 15:03 [#2]:

помойму это просто нереально... такое реализовать невозможно...
Мережников Андрей

Мережников Андрей (статус: Абитуриент), 24 апреля 2011, 13:36 [#3]:

что значит "вращать" цвет?
Надежда1286

Надежда1286 (статус: Посетитель), 26 октября 2011, 02:52 [#4]:

Помогите решить задачи:
Дан файл f, компоненты которого являются целыми числами. Количество компонентов файла кратно 10. Записать в файл g наибольшее значение первых 10 компонент, затем следующих 10 компонент и так далее. Полученный файл отсортировать в порядке возрастания.

Дан линейный массив A[1..N], содержащий целые числа. Отсортировать его элементы указанным способом: в порядке убывания – элементы, стоящие на местах с индексами, дающими при делении на 3 остаток 2, в порядке возрастания – элементы, стоящие на местах с индексами, дающими при делении на 3 остаток 1.Остальные элементы оставить без изменения места расположения.
Мережников Андрей

Мережников Андрей (статус: Абитуриент), 26 октября 2011, 18:12 [#5]:

Цитата (Надежда1286):

Помогите решить задачи:

На создание отдельного вопроса тоже УМАения не хватает?
Надежда1286

Надежда1286 (статус: Посетитель), 27 октября 2011, 02:17 [#6]:

А по-культурнее никак...

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 11:26
Выполнено за 0.02 сек.