Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Работа для программиста > Фриланс
Регистрация

Восстановить пароль
Повторная активизация e-mail


Ответ
 
Опции темы
Старый 22.02.2012, 19:51   #1
Victor1963
Пользователь
 
Регистрация: 27.02.2011
Сообщений: 31
По умолчанию ускорить процесс поворота эллипса на Delphi ( Платная консультация )

Как ускорить процесс поворота эллипса? вопросы и о цене на victor1963@mail.ru
Я рисую мышкой эллипс, задача найти вершину эллипса, на оси OX, центр O в средине эллипса. Повара-
чивая эллипс на 0,0001 радиана, по часовой стрелке, произвожу сканирование вершины эллипса на оси OX, for x:=605 downto {593}501 do, при достижение max x, прог. заканчиваиться. Можно изменить алгоритм, но нужно более радикальное, что-то через буфер OpenGL
Код:Delphi

unit Krug;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Math, StdCtrls,winsock,Buttons,ShlObj,Ole Server,DB,MSHTML,ShellAPI,clipbrd,E xtCtrls,
MPlayer;

type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
PaintBox1: TPaintBox;
procedure Button1Click(Sender: TObject);


private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
bm:TBitMap;
Bitmap1:TBitMap;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);// DelphiWorld6/Изображение/Алгоритм опворота изображения.

Label k1,k2,k3;
type mas=array[0..1111] of integer;
var
f:TFileStream;
bm:TBitMap;
a:single;
ang:real;
W,H, x,c,r,m,l,count,count1,y:integer;
OperBegin, OperEnd: TTimeStamp;
Total: LongWord;
mas1:array of mas;



begin
setlength(mas1,1111);
bm:=TBitMap.Create;
bm.Width:=Form1.ClientWidth;
bm.Height:=Form1.ClientHeight;
bm.LoadFromFile('c:\Program Files\Borland\Delphi6\Projects\Bitm ap1.bmp');

bm.Canvas.Draw(0,0,Bitmap1);
with {Buf}bm.Canvas do
begin
OperBegin:=DateTimeToTimeStamp(Now) ;
a:=0;
bm.Canvas.Pixels[606,300]:=clBlack;
bm.Canvas.Pixels[607,300]:=clBlack;
bm.Canvas.Pixels[608,300]:=clBlack;
bm.Canvas.Pixels[609,300]:=clBlack;

bm.Canvas.Pixels[594,291]:=clBlack;
bm.Canvas.Pixels[596,294]:=clBlack;
bm.Canvas.Pixels[598,297]:=clBlack;
bm.Canvas.Pixels[600,300]:=clBlack;
bm.Canvas.Pixels[598,303]:=clBlack;
bm.Canvas.Pixels[596,306]:=clBlack;
bm.Canvas.Pixels[594,309]:=clBlack;
for x{i1}:=0 to 1024 do
for y{i2}:=0 to 656 do
begin
mas1[x{i1},y{i2}]:=bm.Canvas.Pixels[x{i1},y{i2}];//paintbox1.Canvas.Pixels[i1,i2]:=mas1[i1,i2];
end;

l:=0;
k1:count:=0;
k2:x:=500;
y:=300;
m:=0;
ang:=6.28218;
for r:=102 downto {93}1 do
begin
c:=mas1[round(x+r*cos(6.28318)),round(y+r*s in(6.28318))];
if c=clBlack then
begin
m:=r;
mas1[round(x+r*cos(6.28318)),round(y+r*s in(6.28318))]:=clWhite;
end;
end;
While ang>(0.01) do
begin
for r:={50}1 to 105 do
begin
c:=mas1[round(x+r*cos(ang)),round(y+r*sin(a ng))];
if c=clBlack then
begin
mas1[round(x+r*cos(ang+0.01)),round(y+r* sin(ang+0.01))]:=clBlack;
mas1[round(x+r*cos(ang)),round(y+r*sin(a ng))]:=clWhite;
end;
end;
ang:=ang-{0.01}0.0001;
end;
mas1[round(x+m*cos(6.28318+0.01)),round( y+m*sin(6.28318+0.01))]:=clBlack;//Установка первой точки по час.
begin
for x:=605 downto {593}501 do
begin
c:=mas1[x,300];
if (c=clBlack) and (x>=l) then
begin
l:=x;
goto k1;
end;
end;
count:=count+1;
if count<5 then
begin
goto k2;
end
else
begin
goto k3;
end;
end;
k3:count1:=0;
ListBox1.Items.Add('Финиш');
OperEnd:=DateTimeToTimeStamp(Now);
Total:=OperEnd.Time-OperBegin.Time;
ListBox1.Items.Add(IntToStr(Total)+ ' MSec');

bm.SaveToFile('c:\Program Files\Borland\Delphi6\Projects\Form Image.bmp');
end;
for x{i1}:=0 to 1024 do
for y{i2}:=0 to 656 do
bm.Canvas.Pixels[x{i1},y{i2}]:=mas1[x{i1},y{i2}];
Form1.Canvas.Draw(0,0,{Buf}bm);

end;
Victor1963 вне форума Ответить с цитированием
Ответ

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Опции темы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Платная консультация Victor1963 Помощь студентам 0 21.02.2012 12:57
Ускорить процесс Victor1963 Помощь студентам 0 15.11.2011 12:06
Нужна платная консультация! Lef Фриланс 0 26.10.2011 01:17
Ускорить процесс. Victor1963 Общие вопросы Delphi 3 23.06.2011 21:51