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

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

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

Delphi.int.ru Expert

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

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

#   

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


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

Подробнее »



Вопрос # 1 388

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

Здравствуйте!
У меня такой вопрос. Пишу програму и мне нужно что бы грузилось кактинка из dll а потом можно было ее поворачивать и самое главое растяговать

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

Вопрос задал: Yura (статус: Посетитель)
Вопрос отправлен: 1 марта 2008, 23:15
Состояние вопроса: открыт, ответов: 2.

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

Здравствуйте, Yura!
Итак, первым долгом нужно положить изображение в dll - это можно сделать например с помощью ресурсов.
здесь http://www.programmersclub.ru/simply-art-resursi/ есть пример как положить картинку в ресурс, как её отудова загрузить и отобразить.
можно и ещё здесь почитать http://articles.org.ru/docum/resurs.php и здесь http://oblivioncoders.net/2007/11/21/zagruzka-iz-res-fajla/
Теперь, когда картинка уже в Image, растянуть её очень просто - достаточно установить свойство Streach равным True. С поворотами немного сложнее. Вот здесь есть пример и исходники библиотечки для разворота изображения
http://www.sql.ru/forum/actualthread.aspx?tid=42227

P.S. Стараемся писать грамотно.

Ответ отправил: Вадим К (статус: Академик)
Время отправки: 2 марта 2008, 14:18

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

Здравствуйте, Yura!
За грамотность и формулировку вопроса ставлю -1 ! Уважаемый, мы ведь тут не телепаты. Знаете пословицу: "Каков вопрос, таков и ответ" ? Поэтому, на свое усмотрение, даю вам несколько примеров в Приложении.

Приложение:
  1.  
  2. {
  3. This function resizes a bitmap calculating the average color of a rectangular
  4. area of pixels from source bitmap to a pixel or a rectangular area to target
  5. bitmap.
  6.  
  7. It produces a soft-color and undistorsioned result image unlike the StretchDraw
  8. method
  9.  
  10. I think that this method have a tenichal name, but I am not sure.
  11.  
  12. As you can see, this function could be very optimized :p
  13. }
  14.  
  15. procedure TFormConvertir.ResizeBitmap(imgo, imgd: TBitmap; nw, nh: Integer);
  16. var
  17. xini, xfi, yini, yfi, saltx, salty: single;
  18. x, y, px, py, tpix: integer;
  19. PixelColor: TColor;
  20. r, g, b: longint;
  21.  
  22. function MyRound(const X: Double): Integer;
  23. begin
  24. Result := Trunc(x);
  25. if Frac(x) >= 0.5 then
  26. if x >= 0 then Result := Result + 1
  27. else
  28. Result := Result - 1;
  29. // Result := Trunc(X + (-2 * Ord(X < 0) + 1) * 0.5);
  30. end;
  31.  
  32. begin
  33. // Set target size
  34.  
  35. imgd.Width := nw;
  36. imgd.Height := nh;
  37.  
  38. // Calcs width & height of every area of pixels of the source bitmap
  39.  
  40. saltx := imgo.Width / nw;
  41. salty := imgo.Height / nh;
  42.  
  43.  
  44. yfi := 0;
  45. for y := 0 to nh - 1 do
  46. begin
  47. // Set the initial and final Y coordinate of a pixel area
  48.  
  49. yini := yfi;
  50. yfi := yini + salty;
  51. if yfi >= imgo.Height then yfi := imgo.Height - 1;
  52.  
  53. xfi := 0;
  54. for x := 0 to nw - 1 do
  55. begin
  56. // Set the inital and final X coordinate of a pixel area
  57.  
  58. xini := xfi;
  59. xfi := xini + saltx;
  60. if xfi >= imgo.Width then xfi := imgo.Width - 1;
  61.  
  62.  
  63. // This loop calcs del average result color of a pixel area
  64. // of the imaginary grid
  65.  
  66. r := 0;
  67. g := 0;
  68. b := 0;
  69. tpix := 0;
  70.  
  71. for py := MyRound(yini) to MyRound(yfi) do
  72. begin
  73. for px := MyRound(xini) to MyRound(xfi) do
  74. begin
  75. Inc(tpix);
  76. PixelColor := ColorToRGB(imgo.Canvas.Pixels[px, py]);
  77. r := r + GetRValue(PixelColor);
  78. g := g + GetGValue(PixelColor);
  79. b := b + GetBValue(PixelColor);
  80. end;
  81. end;
  82.  
  83. // Draws the result pixel
  84.  
  85. imgd.Canvas.Pixels[x, y] :=
  86. rgb(MyRound(r / tpix),
  87. MyRound(g / tpix),
  88. MyRound(b / tpix)
  89. );
  90. end;
  91. end;
  92. end;
  93. ----------------------------------------------------
  94.  
  95. // This function stretches a bitmap with specified number of pixels
  96. // in horizontal, vertical dimension
  97. // Example Call : ResizeBmp(Image1.Picture.Bitmap , 200 , 200);
  98.  
  99. function TForm1.ResizeBmp(bitmp: TBitmap; wid, hei: Integer): Boolean;
  100. var
  101. TmpBmp: TBitmap;
  102. ARect: TRect;
  103. begin
  104. Result := False;
  105. try
  106. TmpBmp := TBitmap.Create;
  107. try
  108. TmpBmp.Width := wid;
  109. TmpBmp.Height := hei;
  110. ARect := Rect(0,0, wid, hei);
  111. TmpBmp.Canvas.StretchDraw(ARect, Bitmp);
  112. bitmp.Assign(TmpBmp);
  113. finally
  114. TmpBmp.Free;
  115. end;
  116. Result := True;
  117. except
  118. Result := False;
  119. end;
  120. end;
  121.  
  122. ----------------------------------------------------
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129. x = xo + r * cos(alpha + beta)
  130. y = yo + r * sin(alpha + beta)
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138. uses Math;
  139.  
  140. procedure TForm1.Button1Click(Sender: TObject);
  141. var
  142. bm, bm1: TBitMap;
  143. x, y: integer;
  144. r, a: single;
  145. xo, yo: integer;
  146. s, c: extended;
  147. begin
  148. bm := TBitMap.Create;
  149. bm.LoadFromFile('ex.bmp');
  150. xo := bm.Width div 2;
  151. yo := bm.Height div 2;
  152. bm1 := TBitMap.Create;
  153. bm1.Width := bm.Width;
  154. bm1.Height := bm.Height;
  155. a := 0;
  156. repeat
  157. for y := 0 to bm.Height - 1 do begin
  158. for x := 0 to bm.Width - 1 do begin
  159. r := sqrt(sqr(x - xo) + sqr(y - yo));
  160. SinCos(a + arctan2((y - yo), (x - xo)), s, c);
  161. bm1.Canvas.Pixels[x,y] := bm.Canvas.Pixels[
  162. round(xo + r * c), round(yo + r * s)];
  163. end;
  164. Application.ProcessMessages;
  165. end;
  166. Form1.Canvas.Draw(xo, yo, bm1);
  167. a := a + 0.05;
  168. Application.ProcessMessages;
  169. until Form1.Tag <> 0;
  170. bm.Destroy;
  171. bm1.Destroy;
  172. end;
  173.  
  174. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  175. begin
  176. Form1.Tag := 1;
  177. end;


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 3 марта 2008, 13:03


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

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

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

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