Форум: "Прочее";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Вниз

Не могу нарисовать сетку крест на крест.   Найти похожие ветки 

← →
Use_R   (2012-11-30 23:15) [0]

Т.е. штриховка по диагонали.
Count - кол-во ячеек.
W, H   - высота и ширина ячейки.

Штриховка в правую сторону выводиться корректно.
В левую криво.

Понять не могу где ошибка.


procedure DrawMesh;
var
 i          : LongWord;
 Count, W, H: LongWord;
begin
 Count:= 200;
 W    := 10;
 H    := 10;

 For i:= 0 to Count do
   MyCanvas.Line(i * W, 0, 0, i * H);

 For i:= 0 to Count do
   MyCanvas.Line(i * W, 0, Count * W, i * H);
end;



---

← →
Sha ©   (2012-11-30 23:24) [1]

должна помочь бумага в клеточку

---

← →
Use_R   (2012-11-30 23:35) [2]

Первый цикл рисует правильно.
Второй цикл, такой же, только конец линии уже справа.

Рисуется какая-то арка!

---

← →
xayam ©   (2012-11-30 23:44) [3]

> Count * W

?

---

← →
xayam ©   (2012-11-30 23:49) [4]

вообще подход какой-то неправильный.
Два цикла вложенных по всем ячейкам и внутри сразу крест рисуется. Не?

---

← →
Use_R   (2012-11-30 23:50) [5]

> xayam ©   (30.11.12 23:44) [3]
>
>
> > Count * W


Это самая правая граница для X.
0 - самая левая граница для Х.

---

← →
DVM ©   (2012-11-30 23:55) [6]

> Use_R   (30.11.12 23:15) 

Не поможет? (На вещественные координаты не смотри)


procedure TECADDiagCrossFillPattern.Paint(Canvas: TECADCanvas; Rect: TECADFloatRect);
var
 X1, Y1: Extended;

 procedure DrawFrom1(X1, Y1, Width, Height: Extended);
 var
   M, D, X2, Y2: Extended;
 begin
   M := Min(Width, Height);
   X2 := X1 + M;
   Y2 := Y1 + M;
   D := Max(0, Max(Y2 - Rect.Bottom, X2 - Rect.Right));
   X2 := X2 - D;
   Y2 := Y2 - D;
   Canvas.DrawLine(X1, Y1, X2, Y2);
 end;

 procedure DrawFrom2(X1, Y1, Width, Height: Extended);
 var
   M, D, X2, Y2: Extended;
 begin
   M := Min(Width, Height);
   X2 := X1 + M;
   Y2 := Y1 - M;
   D := Max(0, Max(Rect.Top - Y2, X2 - Rect.Right));
   X2 := X2 - D;
   Y2 := Y2 + D;
   Canvas.DrawLine(X1, Y1, X2, Y2);
 end;

begin
 X1 := Rect.Left;
 Y1 := Rect.Top;
 while Y1 < Rect.Bottom do begin
   DrawFrom1(X1, Y1, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
   Y1 := Y1 + Period;
 end;
 X1 := Rect.Left + Period;
 Y1 := Rect.Top;
 while X1 < Rect.Right do begin
   DrawFrom1(X1, Y1, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
   X1 := X1 + Period;
 end;
 X1 := Rect.Left;
 Y1 := Rect.Bottom;
 while Y1 > Rect.Top do begin
   DrawFrom2(X1, Y1, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
   Y1 := Y1 - Period;
 end;
 X1 := Rect.Left + Period;
 Y1 := Rect.Bottom;
 while X1 < Rect.Right do begin
   DrawFrom2(X1, Y1, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
   X1 := X1 + Period;
 end;
end;



---

← →
Use_R   (2012-12-01 00:17) [7]

> DVM ©   (30.11.12 23:55) [6]


Тормозит аццки.

Вот мой код, закрашивает прямоугольник в косую линию, наклон в право.
Быстро работает.

Такое же, но в левую сторону не могу написать. :)



For i:= 0 to Count do
begin
  Line(i * W, 0,       0,                 i * H);
  Line(i * W, Row * H, Count * W, i * H);
end;



---

← →
DVM ©   (2012-12-01 00:25) [8]

> Use_R   (01.12.12 00:17) [7]


> Тормозит аццки.

Странно, у меня оно не тормозит совсем.

---

← →
antonn ©   (2012-12-01 00:26) [9]

For i:= 0 to Count do
  MyCanvas.Line(0, 0, Count * W, i * H);

---

← →
kilkennycat ©   (2012-12-01 00:37) [10]

Brush.Style := bsDiagCross;

---

← →
DVM ©   (2012-12-01 00:39) [11]

> kilkennycat ©   (01.12.12 00:37) [10]
> Brush.Style := bsDiagCross;

там не регулируется период

---

← →
kilkennycat ©   (2012-12-01 00:53) [12]

> DVM ©   (01.12.12 00:39) [11]

а вдруг он совпадает с требуемым? ;)

---

Страницы: 1 вся ветка

Форум: "Прочее";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.071 c