VPF::Нарисовать - Форум программистов

Zorak

Дата 10.2.2009, 19:18 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 720
Регистрация: 13.11.2007

Репутация: нет
Всего: 3

Вот написал програму, которая рисует кривие безье... факт в том, что роботает она нормально, но.... НЕ рисует линий(((... при запуске проги появляется вот такое: Вот, а должно появится вот ето: вот, я уже не знаю что думать и как его сделать(((.. помогите пжлста, я подозреваю, что ничего сложного в етом нету, но никак нимагу вникнуть(((...
З.Ы. рисует не от точки к точке, а через две точки... тоесть с нулевой линия идет в третю точку.. на месте третей стоит четвертая, откуда линия идет в седьмую и т п).. вот рисунок: вот)
З.Ы. проект виложил в архиве

Это сообщение отредактировал(а) Zorak - 10.2.2009, 19:19

Присоединённый файл ( Кол-во скачиваний: 8 )

123.rar 171,97 Kb

--------------------

Знание - сила. А сила есть, ума не надо...
Занимаюсь интернет бизнесом и ищу новых партнеров. Кому интересно - обращайтесь в ЛС, скайп или мыло.

Snowy

Дата 10.2.2009, 19:49 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Код


     if RGroupDrawMethod.ItemIndex=0 then
      begin
       Canvas.Pen.Style:=psDot;
       Canvas.Pen.Width:=1;
       Canvas.Pen.Color:=clDkGray;
       for i := 0 to High(Curve) - 1 do
       begin
         Canvas.MoveTo(Curve[i].X,Curve[i].Y);
         Canvas.LineTo(Curve[i+1].X,Curve[i+1].Y);
       end;
       { // Сам так рисуешь
       Canvas.MoveTo(Curve[0].X,Curve[0].Y);
       Canvas.LineTo(Curve[1].X,Curve[1].Y);
       Canvas.MoveTo(Curve[3].X,Curve[3].Y);
       Canvas.LineTo(Curve[2].X,Curve[2].Y);
       Canvas.MoveTo(Curve[4].X,Curve[4].Y);
       Canvas.LineTo(Curve[5].X,Curve[5].Y);
       Canvas.MoveTo(Curve[7].X,Curve[7].Y);
       Canvas.LineTo(Curve[6].X,Curve[6].Y)
       }

Zorak

Дата 10.2.2009, 19:55 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 720
Регистрация: 13.11.2007

Репутация: нет
Всего: 3

Snowy , ти меня немного неправильно понял... вот аналогичная програма, только для 4 точок и 1 линии.. =)... мне из етого надо сделать две линии...

Цитата

рисует не от точки к точке, а через две точки... тоесть с нулевой линия идет в третю точку.. на месте третей стоит четвертая, откуда линия идет в седьмую и т п).. вот рисунок: вот)

Это сообщение отредактировал(а) Zorak - 10.2.2009, 19:57

Присоединённый файл ( Кол-во скачиваний: 8 )

124.rar 171,12 Kb

--------------------

Snowy

Дата 10.2.2009, 20:32 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Ну ты сам просил линии...
Значит не рисует не линии, а кривые.
Значит не отрабатывает Canvas.PolyBezier
Что-то ты с точками напутал.
Например перетаскивание точек даёт странный эффект.
Вобщем что-то не так с точками. Тут сам разбирайся, выверяй, где напутал.
Например, урезав массив до 7 точек, всё работает.
Canvas.PolyBezier(Slice(LCurve, 7));
4 точки - Canvas.PolyBezier(Slice(LCurve, 4)); - тоже рисует.
Копни в эту сторону. Может где найдёшь ляп..

Zorak

Дата 10.2.2009, 20:34 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 720
Регистрация: 13.11.2007

Репутация: нет
Всего: 3

Ок, спс, буду искать.. может кто первый додумается, то не молчите =) ... smile

З.Ы. у мну чёт даже с твоим примером не рисует =)

Это сообщение отредактировал(а) Zorak - 10.2.2009, 20:37

--------------------

Snowy

Дата 10.2.2009, 20:38 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Если я правильно понял описание, то 3-я совпадает с 4-й.
Тогда в массиве должно быть не 8, а 7 точек.
Если 3-я и 4-я не совпадают, то получается дырка.
Значит каждая 4-я точка должна удаляться, при условии, что она не последняя.

Zorak

Дата 10.2.2009, 20:52 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 720
Регистрация: 13.11.2007

Репутация: нет
Всего: 3

Цитата(Snowy @ 10.2.2009, 20:38)

Да, ти правильно рассуждаеш), но я не могу вловить что ти хотел етим сказать....
З.Ы. Ти говорил, что када урезаеш масив, то всё работает.. не мог бы ти исходник выложить ?)

--------------------

Zorak

Дата 10.2.2009, 22:12 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 720
Регистрация: 13.11.2007

Репутация: нет
Всего: 3

Вообщем ету проблему решил.. но както так получилось, что перестало работать второе((... smile

вщитуя то, что сопадают 3 и 4, 7 и 8, 11 и 12, 15 и 1 точки... - то не правильно рисует кривую в 7 и 8 точках ((... с индексами точок в коде всё в порядке, раз 10 проверил... что здесь не так ?(... Помогите пжлста добить ету програму) smile

...
ТиЦ

Присоединённый файл ( Кол-во скачиваний: 6 )

124.rar 173,23 Kb

--------------------

rounin

Дата 11.2.2009, 17:37 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 10.5.2006

Репутация: нет
Всего: 1

У тебя такой код, что сам чёрт ногу сломит.
Там можно до посинения глюки ловить.
Зачем такие сложности, почему бы не написать что-нибудь простенькое, вроде

Код


type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    FCurve: array of TPoint;
    FDragIndex: Integer;
  public
    procedure InitPoints(const APoints: array of TPoint);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function PtNearPt(X, Y: Integer; const Pt: TPoint): Boolean;
begin
  Result := (X>=Pt.X-3)and(X<=Pt.X+3)and(Y>=Pt.Y-3)and(Y<=Pt.Y+3);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];

  InitPoints(
    [Point(100, 100), Point(200, 100), Point(300, 100),
     Point(400, 100), Point(400, 200), Point(400, 300),
     Point(400, 400), Point(300, 400), Point(200, 400),
     Point(100, 400), Point(100, 300), Point(100, 200),
     Point(100, 100)]);
end;

procedure TForm1.InitPoints(const APoints: array of TPoint);
var i, L: Integer;
begin
  L := Length(APoints);
  if L mod 3 <> 1 then
    raise Exception.Create('Bezier: Invalid point number');

  SetLength(FCurve, L);
  for i := 0 to L-1 do
    FCurve[i] := APoints[i];
end;


procedure TForm1.PaintBox1Paint(Sender: TObject);
var i, k, L, N: Integer;
    pt: TPoint;
begin
  with Sender as TPaintBox do
  begin
    Canvas.Pen.Style := psSolid;
    Canvas.Pen.Color := clBlack;
    Canvas.Brush.Style := bsSolid;
    Canvas.Rectangle(ClientRect);

    {-- Bezier itself --}
    Canvas.PolyBezier(FCurve);

    L := Length(FCurve);

    {-- Point markers --}
    Canvas.Pen.Color := clRed;
    for i := 0 to L-1 do
    begin
      pt := FCurve[i];
      Canvas.Rectangle(pt.X - 3, pt.Y - 3, pt.X + 3, pt.Y + 3);
    end;

    {-- Dotted lines ---}
    N := L div 3;
    Canvas.Pen.Style := psDot;
    Canvas.Pen.Color := clBlue;
    Canvas.Brush.Style := bsClear;
    for i := 0 to N-1 do
    begin
      k := i*3;
      Canvas.MoveTo(FCurve[k].X,   FCurve[k].Y);
      Canvas.LineTo(FCurve[k+1].X, FCurve[k+1].Y);
      Canvas.MoveTo(FCurve[k+2].X, FCurve[k+2].Y);
      Canvas.LineTo(FCurve[k+3].X, FCurve[k+3].Y);
    end;
    Canvas.Pen.Style := psSolid;
  end;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i: Integer;
begin
  FDragIndex := -1;
  for i := 0 to Length(FCurve)-1 do
    if PtNearPt(X, Y, FCurve[i]) then
    begin
      FDragIndex := i;
      Break;
    end;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if (ssLeft in Shift)and(FDragIndex <> -1)then
  begin
    FCurve[FDragIndex] := Point(X, Y);
    (Sender as TPaintBox).Refresh;
  end;
end;

Zorak

Дата 21.2.2009, 14:32 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 720
Регистрация: 13.11.2007

Репутация: нет
Всего: 3

Спасибо. диствительно проще...))

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »