Форум: "Прочее";
Текущий архив: 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.064 c