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

Сообщество программистов
Общение, помощь, обмен опытом

Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

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

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

#   

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


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

Подробнее »



Вопрос # 1 459

/ вопрос открыт /

Приветствую, уважаемые эксперты!
Можно ли поворачивать Image на форме?

Hi-tek Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Hi-tek (статус: 1-ый класс)
Вопрос отправлен: 30 марта 2008, 07:45
Состояние вопроса: открыт, ответов: 2.

Ответ #1. Отвечает эксперт: min@y™

Ну, сам TImage повернуть не получится, зато можно крутить хранящееся в нём изображение.

Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 31 марта 2008, 08:20
Оценка за ответ: 4

Комментарий к оценке: Сейчас попробую разобраться )

Ответ #2. Отвечает эксперт: Feniks

Здравствуйте, Hi-tek!
Смотрите в Пиролежении несколько примеров по:
1. Алгоритм поворота изображения;
2. Вращение изображения;
3. Вращать Bitmap вокруг точки;
4. Зеркальное преобразование.
А так же смотрите вопрос #1388.

P.S. Могу, в личном порядке, еще подкинуть разные эффекты для картинок.

Приложение:
  1.  
  2.  
  3.  
  4.  
  5.  
  6. x = xo + r * cos(alpha + beta)
  7. y = yo + r * sin(alpha + beta)
  8.  
  9.  
  10.  
  11.  
  12.  
  13.  
  14.  
  15. uses Math;
  16.  
  17. procedure TForm1.Button1Click(Sender: TObject);
  18. var
  19. bm, bm1: TBitMap;
  20. x, y: integer;
  21. r, a: single;
  22. xo, yo: integer;
  23. s, c: extended;
  24. begin
  25. bm := TBitMap.Create;
  26. bm.LoadFromFile('ex.bmp');
  27. xo := bm.Width div 2;
  28. yo := bm.Height div 2;
  29. bm1 := TBitMap.Create;
  30. bm1.Width := bm.Width;
  31. bm1.Height := bm.Height;
  32. a := 0;
  33. repeat
  34. for y := 0 to bm.Height - 1 do begin
  35. for x := 0 to bm.Width - 1 do begin
  36. r := sqrt(sqr(x - xo) + sqr(y - yo));
  37. SinCos(a + arctan2((y - yo), (x - xo)), s, c);
  38. bm1.Canvas.Pixels[x,y] := bm.Canvas.Pixels[
  39. round(xo + r * c), round(yo + r * s)];
  40. end;
  41. Application.ProcessMessages;
  42. end;
  43. Form1.Canvas.Draw(xo, yo, bm1);
  44. a := a + 0.05;
  45. Application.ProcessMessages;
  46. until Form1.Tag <> 0;
  47. bm.Destroy;
  48. bm1.Destroy;
  49. end;
  50.  
  51. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  52. begin
  53. Form1.Tag := 1;
  54. end;
  55.  
  56.  
  57.  
  58. procedure RotateRight(BitMap: tImage);
  59. var
  60. FirstC, LastC, c, r: integer;
  61.  
  62. procedure FixPixels(c, r: integer);
  63. var
  64. SavePix, SavePix2: tColor;
  65. i, NewC, NewR: integer;
  66. begin
  67. SavePix := Bitmap.Canvas.Pixels[c, r];
  68. for i := 1 to 4 do
  69. begin
  70. newc := BitMap.Height - r + 1;
  71. newr := c;
  72. SavePix2 := BitMap.Canvas.Pixels[newc, newr];
  73. Bitmap.Canvas.Pixels[newc, newr] := SavePix;
  74. SavePix := SavePix2;
  75. c := Newc;
  76. r := NewR;
  77. end;
  78. end;
  79.  
  80. begin
  81. if BitMap.Width <> BitMap.Height then
  82. exit;
  83. BitMap.Visible := false;
  84. with Bitmap.Canvas do
  85. begin
  86. firstc := 0;
  87. lastc := BitMap.Width;
  88. for r := 0 to BitMap.Height div 2 do
  89. begin
  90. for c := firstc to lastc do
  91. begin
  92. FixPixels(c, r);
  93. end;
  94. inc(FirstC);
  95. Dec(LastC);
  96. end;
  97. end;
  98. BitMap.Visible := true;
  99. end;
  100.  
  101.  
  102. // Vector from FromP to ToP
  103.  
  104. function TForm1.Vektor(FromP, Top: TPoint): TPoint;
  105. begin
  106. Result.x := Top.x - FromP.x;
  107. Result.y := Top.y - FromP.y;
  108. end;
  109.  
  110. // neue x Komponente des Verktors
  111. // new x-component of the vector
  112. function TForm1.xComp(Vektor: TPoint; Angle: Extended): Integer;
  113. begin
  114. Result := Round(Vektor.x * cos(Angle) - (Vektor.y) * sin(Angle));
  115. end;
  116.  
  117. // neue Y-Komponente des Vektors
  118. // new y-component of the vector
  119. function TForm1.yComp(Vektor: TPoint; Angle: Extended): Integer;
  120. begin
  121. Result := Round((Vektor.x) * (sin(Angle)) + (vektor.y) * cos(Angle));
  122. end;
  123.  
  124.  
  125. function TForm1.RotImage(srcbit: TBitmap; Angle: Extended; FPoint: TPoint;
  126. Background: TColor): TBitmap;
  127. {
  128. srcbit: TBitmap; // Bitmap dass gedreht werden soll ; Bitmap to be rotated
  129. Angle: extended; // Winkel in Bogenma?, angle
  130. FPoint: TPoint; // Punkt um den gedreht wird ; Point to be rotated around
  131. Background: TColor): TBitmap; // Hintergrundfarbe des neuen Bitmaps ;
  132. // Backgroundcolor of the new bitmap
  133. }
  134. var
  135. highest, lowest, mostleft, mostright: TPoint;
  136. topoverh, leftoverh: integer;
  137. x, y, newx, newy: integer;
  138. begin
  139. Result := TBitmap.Create;
  140.  
  141. // Drehwinkel runterrechnen auf eine Umdrehung, wenn notig
  142. // Calculate angle down on one rotation, if necessary
  143. while Angle >= (2 * pi) do
  144. begin
  145. angle := Angle - (2 * pi);
  146. end;
  147.  
  148. // neue Ausma?e festlegen
  149. // specify new size
  150. if (angle <= (pi / 2)) then
  151. begin
  152. highest := Point(0,0); //OL
  153. Lowest := Point(Srcbit.Width, Srcbit.Height); //UR
  154. mostleft := Point(0,Srcbit.Height); //UL
  155. mostright := Point(Srcbit.Width, 0); //OR
  156. end
  157. else if (angle <= pi) then
  158. begin
  159. highest := Point(0,Srcbit.Height);
  160. Lowest := Point(Srcbit.Width, 0);
  161. mostleft := Point(Srcbit.Width, Srcbit.Height);
  162. mostright := Point(0,0);
  163. end
  164. else if (Angle <= (pi * 3 / 2)) then
  165. begin
  166. highest := Point(Srcbit.Width, Srcbit.Height);
  167. Lowest := Point(0,0);
  168. mostleft := Point(Srcbit.Width, 0);
  169. mostright := Point(0,Srcbit.Height);
  170. end
  171. else
  172. begin
  173. highest := Point(Srcbit.Width, 0);
  174. Lowest := Point(0,Srcbit.Height);
  175. mostleft := Point(0,0);
  176. mostright := Point(Srcbit.Width, Srcbit.Height);
  177. end;
  178.  
  179. topoverh := yComp(Vektor(FPoint, highest), Angle);
  180. leftoverh := xComp(Vektor(FPoint, mostleft), Angle);
  181. Result.Height := Abs(yComp(Vektor(FPoint, lowest), Angle)) + Abs(topOverh);
  182. Result.Width := Abs(xComp(Vektor(FPoint, mostright), Angle)) + Abs(leftoverh);
  183.  
  184. // Verschiebung des FPoint im neuen Bild gegenuber srcbit
  185. // change of FPoint in the new picture in relation on srcbit
  186. Topoverh := TopOverh + FPoint.y;
  187. Leftoverh := LeftOverh + FPoint.x;
  188.  
  189. // erstmal mit Hintergrundfarbe fullen
  190. // at first fill with background color
  191. Result.Canvas.Brush.Color := Background;
  192. Result.Canvas.pen.Color := background;
  193. Result.Canvas.Fillrect(Rect(0,0,Result.Width, Result.Height));
  194.  
  195. // Start des eigentlichen Rotierens
  196. // Start of actual rotation
  197. for y := 0 to srcbit.Height - 1 do
  198. begin // Zeilen ; Rows
  199. for x := 0 to srcbit.Width - 1 do
  200. begin // Spalten ; Columns
  201. newX := xComp(Vektor(FPoint, Point(x, y)), Angle);
  202. newY := yComp(Vektor(FPoint, Point(x, y)), Angle);
  203. newX := FPoint.x + newx - leftoverh;
  204. // Verschieben wegen der neuen Ausma?e
  205. newy := FPoint.y + newy - topoverh;
  206. // Move beacause of new size
  207. Result.Canvas.Pixels[newx, newy] := srcbit.Canvas.Pixels[x, y];
  208. // auch das Pixel daneben fullen um Leerpixel bei Drehungen zu verhindern
  209. // also fil lthe pixel beside to prevent empty pixels
  210. if ((angle < (pi / 2)) or
  211. ((angle > pi) and
  212. (angle < (pi * 3 / 2)))) then
  213. begin
  214. Result.Canvas.Pixels[newx, newy + 1] := srcbit.Canvas.Pixels[x, y];
  215. end
  216. else
  217. begin
  218. Result.Canvas.Pixels[newx + 1,newy] := srcbit.Canvas.Pixels[x, y];
  219. end;
  220. end;
  221. end;
  222. end;
  223.  
  224.  
  225. procedure TForm1.Button1Click(Sender: TObject);
  226. var
  227. mybitmap, newbit: TBitMap;
  228. begin
  229. if OpenDialog1.Execute then
  230. begin
  231. mybitmap := TBitmap.Create;
  232. mybitmap.LoadFromFile(OpenDialog1.FileName);
  233. newbit := RotImage(mybitmap, DegToRad(45),
  234. Point(mybitmap.Width div 2, mybitmap.Height div 2), clBlack);
  235. Image1.Canvas.Draw(0,0, newBit);
  236. end;
  237. end;
  238.  
  239. end;
  240.  
  241.  
  242.  
  243. procedure flip_horizontal(Quelle, Ziel: TBitMap);
  244. begin
  245. Ziel.Assign(nil);
  246. Ziel.Width := Quelle.Width;
  247. Ziel.Height := Quelle.Height;
  248. StretchBlt(Ziel.Canvas.Handle, 0, 0, Ziel.Width, Ziel.Height, Quelle.Canvas.Handle,
  249. 0, Quelle.Height, Quelle.Width, Quelle.Height, srccopy);
  250. end;
  251.  
  252. procedure flip_vertikal(Quelle, Ziel: TBitMap);
  253. begin
  254. Ziel.Assign(nil);
  255. Ziel.Width := Quelle.Width;
  256. Ziel.Height := Quelle.Height;
  257. StretchBlt(Ziel.Canvas.Handle, 0, 0, Ziel.Width, Ziel.Height, Quelle.Canvas.Handle,
  258. Quelle.Width, 0, Quelle.Width, Quelle.Height, srccopy);
  259. end;
  260.  
  261. procedure TForm1.Button1Click(Sender: TObject);
  262. var
  263. temp: TBitMap;
  264. begin
  265. temp := TBitMap.Create;
  266. try
  267. temp.Assign(Image1.Picture.BitMap);
  268. flip_vertikal(Temp, Image1.Picture.Bitmap);
  269. finally
  270. Temp.Free;
  271. end;
  272. end;
  273. ============================
  274. { **** UBPFD *********** by delphibase.endimus.com ****
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281. ***************************************************** }
  282.  
  283. procedure FlipBitmap(Bitmap: TBitmap; FlipHor: Boolean);
  284.  
  285.  
  286.  
  287. var
  288. x, y, W, H: Integer;
  289. Pixel_1, Pixel_2: PRGBTriple;
  290. MemPixel: TRGBTriple;
  291. begin
  292. Bitmap.PixelFormat := pf24Bit;
  293. W := Bitmap.Width - 1;
  294. H := Bitmap.Height - 1;
  295.  
  296. for y := 0 to H do
  297. begin
  298.  
  299. Pixel_1 := Bitmap.ScanLine[y];
  300. Pixel_2 := Bitmap.ScanLine[y];
  301.  
  302. Inc(Pixel_2, W);
  303.  
  304. for x := 0 to W div 2 do
  305. begin
  306.  
  307. MemPixel := Pixel_1^;
  308. Pixel_1^ := Pixel_2^;
  309. Pixel_2^ := MemPixel;
  310.  
  311.  
  312. end;
  313. end
  314.  
  315.  
  316. for y := 0 to H div 2 do
  317. begin
  318.  
  319.  
  320. Pixel_1 := Bitmap.ScanLine[y];
  321. Pixel_2 := Bitmap.ScanLine[H - y];
  322. for x := 0 to W do
  323. begin
  324.  
  325. MemPixel := Pixel_1^;
  326. Pixel_1^ := Pixel_2^;
  327. Pixel_2^ := MemPixel;
  328.  
  329.  
  330. end;
  331. end;
  332. end;


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 31 марта 2008, 10:45
Оценка за ответ: 4

Комментарий к оценке: Хотелось бы взглянить на эффекты :)

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

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)
Текущее время: 21 октября 2017, 11:39
Выполнено за 0.14 сек.
Рейтинг@Mail.ru