Всем известно, что в стандартном Canvas средствами Delphi нарисовать пунктирную линию, толщиной больше единицы, невозможно. На самом деле возможно. Просто надо добавить самую малость GDI API.
Зачем нужна пунктирная линия толще единицы
Если пишете серьёзный софт, связанный с графикой, да ещё с соблюдением разных ГОСТов, СП и прочих идиотских специфических формальностей, где необходимо масштабировать, соблюдать все миллиметры, жирная пунктирная линия ой как нужна.
Про масштаб и GDI+ чуть подробнее в конце статьи.
Собственно, статья для тех, кто не хочет лезть в дебри GDI+ и хочет выжать из стандартного GDI максимум.
Почему нельзя
Потому что Delphi.Canvas по умолчанию использует так называемое косметическое перо. Оно не позволяет всяких там излишеств, зато быстро работает. Создаётся оно функцией CreatePenIndirect. Параметром функции выступает структура TLogPen. По ссылкам можно прочитать чуть больше.
Если заглянем под капот Delphi.TPen можно увидеть следующее:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
function TPen.GetHandle: HPen; const PenStyles: array [TPenStyle] of Word = (PS_SOLID, PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT, PS_NULL, PS_INSIDEFRAME, PS_USERSTYLE, PS_ALTERNATE); var LogPen: TLogPen; begin ... with LogPen do try if Handle = 0 then begin lopnStyle := PenStyles[Pen.Style]; lopnWidth.X := Pen.Width; lopnColor := ColorToRGB(Pen.Color); Handle := CreatePenIndirect(LogPen); end; ... Result := Handle; ... end; |
Также, создать перо можно функцией CreatePen. Параметры функции имеют ровно тот же смысл, что и поля структуры TLogPen.
Чтобы использовать перо в Delphi через функции GDI API, рекомендую придерживаться следующей структуры кода. Это касается любого GDI-объекта, не только пера. Рекомендация, не значит правило, всё зависит от замысла автора и здравого смысла )))
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 |
// Это не надо копипастить, это просто шаблон // var NewPen, OldPen: HPEN; clr: TColor; with Canvas do begin // Создаём косметическое "дельфовое" перо NewPen := CreatePen( PS_DOT, // Перо пунктирное. 1, // Ширина ColorToRGB(clBlue)); // Цвет // Устанавливаем новое перо в контекст // В OldPen будет находиться дескриптор предыдущего пера OldPen := SelectObject(Handle, NewPen); // Рисуем обычными методами Canvas try Ellipse(10,10, 150,150); Rectangle(Random(50), Random(50), Random(200)+ 80, Random(200)+ 80); // И так далее, рисуем что угодно ... finally // Возвращаем старое перо в контекст // Если специально не инициализировать Canvas.Pen // после этого блока, будет чёрт знает что SelectObject(Handle, OldPen); // Просим удалить перо за ненадобностью DeleteObject(NewPen); end; end; |
- Создали hNew := Create…();
- Установили в контекст hOld := SelectObject(Handle, hNew);
- Поставили блок try … finally … end;
- В try … finally рисуем что угодно;
- В finally … end восстанавливаем сохраненное значение hOld — SelectObject(Handle, hOld) и удаляем hNew — DeleteObject(hNew).
Как сделать можно
Для этого надо использовать геометрическое перо, которое обладает приличным набором излишеств и работает чутка помедленней. Всех излишеств мы конечно не коснёмся, затронем лишь небольшую часть.
Для создания геометрического пера необходимо воспользоваться функцией ExtCreatePen (еще можно глянуть тут). Строго говоря, этой же функцией можно создать и косметическое перо, правда, при условии, что толщина пера будет равна единице.
1 2 3 4 |
function ExtCreatePen(PenStyle, Width: DWORD; const Brush: TLogBrush; StyleCount: DWORD; Style: Pointer): HPEN; stdcall; |
PenStyle | Стиль пера | |
Width | Толщина пера | |
Brush | Атрибуты кисти | |
StyleCount | Длина массива настроек стиля | |
Style | Массив пользовательского стиля |
StyleCount и Style мы здесь использовать не будем, поэтому они будут равны 0 и nil соответственно.
Результатом будет дескриптор геометрического пера.
Стиль геометрического пера
Стиль геометрического пера формируется объединением атрибутов типа, стиля, наконечников линий и соединения линий с помощью побитового оператора OR. Например:
PenStyle := PS_GEOMETRIC OR PS_DOT OR PS_ENDCAP_FLAT OR PS_JOIN_MITER.
Тип пера
Мы не будем создавать косметическое перо этой функцией. Это параметр у нас будет равен всегда PS_GEOMETRIC.
Стили пера
Стиль пера может быть одним из следующих значений.
PS_SOLID | Сплошная линя. |
PS_DASH | Линия из отрезков. |
PS_DOT | Линия из точек. |
PS_DASHDOT | Чередование тире и точки. |
PS_DASHDOTDOT | Чередование тире и двойной точки. |
PS_NULL | Невидимая линия. |
PS_INSIDEFRAME | Сплошное перо. Если этот перо используется в любой функции рисования GDI, которая принимает ограничивающий прямоугольник, размеры фигуры сжимаются таким образом, чтобы он полностью вписывался в ограничивающий прямоугольник, учитывая ширину пера. Это относится только к геометрическим перьям. |
PS_USERSTYLE | Перо использует массив стилей, предоставленный пользователем. |
PS_ALTERNATE | Стиль используется только косметическим пером, и определяется набором пикселов. |
Типы наконечников линий
Позволяет задать поведение на концах отрезков, из которых состоит линия.

Типы соединения линий
Определяет, как линии состыкуются друг с другом.
PS_JOIN_BEVEL | Усечённое соединение. |
PS_JOIN_ROUND | Закруглённое соединение. |
PS_JOIN_MITER | Соединение линий образует угол. Остриё ограничивается функцией SetMiterLimit . Если значение превышает это ограничение, соединение будет обрезано. При превышении углового предела MiterLimit угол отсекается полностью, превращаясь в BEVEL-соединение. |

Угловой предел MiterLimit
Очень нужный и по факту нелогичный параметр. При MITER-соединении линии могут образовать очень острый угол, который может испортить всю картину. Поэтому наличие такого параметра сильно напрашивается. Но нелогичность заключается в том, что при превышении этого параметра, отбрасывается вся «угловая» часть, обрубая все под BEVEL. Логичней было бы обрубать под величину этого параметра.

Угловой предел — это максимальное отношение длины заострения к толщине линии. При превышении этого параметра MITER превратится в отсеченный BEVEL. Без компромиссов. Сказал, как отрезал.
Слева угловой предел равен 1, справа — 2. Правой стрелке повезло больше.
Устанавливается функцией:
1 |
function SetMiterLimit(DC: HDC; NewLimit: Single; OldLimit: PSingle): BOOL; stdcall; |
Всегда можно поинтересоваться текущим угловым пределом функцией:
1 |
function GetMiterLimit(DC: HDC; var Limit: Single): BOOL; stdcall; |
Угловой предел по умолчанию равен 10.
Атрибуты кисти
Представляет собой структуру TLogBrush. Мы не будем сейчас использовать все возможности. Давайте рассмотрим два режима — заливка цветом и заливка растром.
Чтобы указать перу цвет заливки необходимо сделать следующее:
1 2 3 |
// var b: TLogBrush; Color : LongInt; b.lbStyle := BS_SOLID; // Сплошная кисть b.lbColor := Color; // Цвет кисти (RGB) |
Чтобы указать перу, что заливка будет происходить растром, делаем так:
1 2 3 4 |
// var b: TLogBrush; ABitmap: TBitmap; // Устанавливаем заливку растром b.lbStyle := BS_PATTERN; // Кисть, определяемая растровым изображением памяти b.lbHatch := ABitmap.Handle; // Дескриптор растра HBITMAP |
Функция создания геометрического пера
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 |
type // Соединение линий TxLineJoin = ( xljRound // Закругленное соединение ,xljBevel // Соединение с отсечением ,xljMiter // Заостренное соединение ); // Наконечники линий TxLineCap = ( xlcRound // Скругленный ,xlcSquare // Квадратный ,xlcFlat // Плоский ); // Создать геометрическое перо function CreateGeometricPen( AStyle: TPenStyle; // стиль пера AWidth: DWORD; // толщина пера AColor: Longint; // цвет пера ALineJoin: TxLineJoin = xljRound; // тип соединения линий ALineCap: TxLineCap = xlcRound; // тип наконечника линий ABitmap: TBitmap = nil // растр для заливки ): HPEN; // дескриптор нового геометрического пера const // константы типов соединения линий CNS_JOINS: array[TxLineJoin] of DWORD = (PS_JOIN_ROUND, PS_JOIN_BEVEL, PS_JOIN_MITER); // константы типов наконечников линий CNS_CAPS: array[TxLineCap] of DWORD = (PS_ENDCAP_ROUND, PS_ENDCAP_SQUARE, PS_ENDCAP_FLAT); var b: TLogBrush; s: UINT; begin if ABitmap = nil then begin // Устанавливаем заливку цветом b.lbStyle := BS_SOLID; b.lbColor := AColor; end else begin // Устанавливаем заливку растром b.lbStyle := BS_PATTERN; b.lbHatch := ABitmap.Handle; end; // Формирование стиля s := PS_GEOMETRIC OR DWORD(AStyle) OR CNS_JOINS[ALineJoin] OR CNS_CAPS[ALineCap]; // Создать геометрическое перо Result := ExtCreatePen(s, AWidth, b, 0, nil); end; |
Как видим, всё до умопомрачения просто. Теперь как использовать это сокровище.
Геометрическое перо и Canvas
Предположим, у нас есть список точек
1 2 |
// Список точек FPoints: TList<TPoint>; |
И мы хотим его нарисовать в виде ломаной с заданными параметрами цвета (ColorBox1), толщины (SpinEdit1), стиля пера (ComboBox1), а также типами соединения (ComboBox2) и окончания (ComboBox3) отрезков. В особом случае (WithPattern.Checked) , вместо цвета заливки используется подготовленный ранее растр.
1 2 3 4 5 |
// Кешированное изображение для заливки FBitmapCache: TBitmap; // Метод, возвращающий в зависимости от WithPattern // либо nil, либо отмасштабированный растр function BitmapCache: TBitmap; |
Работа с кэшированным растром происходит следующим образом. При изменении размера окна, растр уничтожается. При обращении к методу, он создаётся, если это требуется.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
TFmMain = class (TForm) ... private ... // Изменились размеры, очистили кеш procedure WMSize(var Msg: TWMSize); message WM_Size; end; procedure TFmMain.WMSize(var Msg: TWMSize); begin FreeAndNil(FBitmapCache); inherited; end; function TFmMain.BitmapCache: TBitmap; var rct: TRect; begin // Если растр не требуется, удаляем его if not WithPattern.Checked then FreeAndNil(FBitmapCache) else // Если растр требуется, создаём его, если не был создан if FBitmapCache = nil then begin rct := pb.ClientRect; FBitmapCache := TBitmap.Create; FBitmapCache.SetSize(rct.Width, rct.Height); FBitmapCache.Canvas.StretchDraw(rct, Image1.Picture.Graphic); end; // Результатом будет либо растр, либо nil Result := FBitmapCache; end; |
Отрисовка происходит в обработчике события OnPaint компонента pb: TPaintBox.
Таким образом, суммируя всё вышесказанное, можно написать такой небольшой код. Небольшой, если убрать все комментарии. Их тут больше, чем кода.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 |
procedure TFmMain.pbPaint(Sender: TObject); var bmp: TBitmap; rct: TRect; clr: TColor; i,v,n,m: Integer; NewPen, OldPen: HPEN; begin // Инициализация битмап-буфера, куда будем рисовать rct := pb.ClientRect; bmp := TBitmap.Create; bmp.SetSize(rct.Width, rct.Height); v := ComboBox1.ItemIndex; // Стиль n := ComboBox2.ItemIndex; // Соединение m := ComboBox3.ItemIndex; // Окончания // Если еще только строим траекторию - красным clr := IfThen(FFinish, ColorBox1.Selected, clRed); try with bmp.Canvas do begin // Подготовка холста, заливка белым rct := ClipRect; Brush.Color := clWhite; FillRect(rct); // Специально установили параметры рамки до создания // геометрического пера, чтобы продемонстрировать // надёжность метода Brush.Style := bsClear; Pen.Color := clBtnShadow; Pen.Width := 1; // Список точек пуст, больше сдесь делать нечего if FPoints.Count=0 then exit; //*** СОЗДАЁМ ПЕРО ************************* if not Geometric.Checked then // Создаём косметическое "дельфовое" перо NewPen := CreatePen( v, // Стиль SpinEdit1.Value, // Ширина ColorToRGB(clr)) // Цвет else // Создаём геометрическое перо NewPen := CreateGeometricPen( TPenStyle(v), // Стиль SpinEdit1.Value, // Ширина ColorToRGB(clr), // Цвет TxLineJoin(n), // Соединение TxLineCap(m), // Окончания BitmapCache); // Растр // Устанавливаем новое перо в контекст // В OldPen будет находиться дескриптор предыдущего пера // Того самого, которое clBtnShadow с толщиной 1 OldPen := SelectObject(Handle, NewPen); //****************************************** // Рисуем список точек новым пером try // Рисуем трассу целиком одной ломаной if ToArray.Checked then Polyline(FPoints.ToArray) else // Рисуем ломаную отрезками линий begin MoveTo(FPoints[0].X, FPoints[0].Y); for i := 1 to FPoints.Count - 1 do LineTo(FPoints[i].X, FPoints[i].Y); end; finally //*** ОСВОБОЖДАЕМ ПЕРО ******************* // Возвращаем старое перо в контекст // Если специально не инициализировать перо в канвасе // перед отрисовкой рамки, и не выполнить эту строку, // может быть чёрт знает что SelectObject(Handle, OldPen); // Просим удалить геометрическое перо за ненадобностью DeleteObject(NewPen); //**************************************** end; end; finally // Рисуем рамку обычным пером, котрое было до создания нового пера bmp.Canvas.Rectangle(rct); // Рисуем битмап-буфер на холсте компонента pb.Canvas.Draw(0,0,bmp); // Освобождаем битмап-буфер bmp.Free; end; end; |
Что тут есть хорошего. Хорошее то, что мы рисуем привычными методами Canvas’а, просто подменили косметическое перо на геометрическое.
Комментарии к программе
Зачем переключатель ToArray
Чтобы увидеть прелести тонкой настройки геометрического пера, необходимо рисовать одной линией. Например, так:
1 |
Polyline(FPoints.ToArray) |
И тогда, с заданными настройками, увидим то, что и ожидали увидеть — заострённые уголки, отрезки равной длины:

Если же мы будем рисовать отрезками, как, например тут:
1 2 3 |
MoveTo(FPoints[0].X, FPoints[0].Y); for i := 1 to FPoints.Count - 1 do LineTo(FPoints[i].X, FPoints[i].Y); |
То увидим не совсем то, что ожидалось. И возникают вопросы, типа: «Я сделала всё так, как вы сказали, но у меня не получается». Поэтому заостряю тут внимание — что сделали, то и получили. В этом случае каждая отдельная линия — это прямая, которая ничего не знает про другие линии ломаной, с которыми надо соединяться. Параметр LineJoin, равный Miter, при таком подходе не значит ровным счётом ничего.
Также, размеры «тире» тут непредсказуемы, в отличие от «сплошной» ломаной.

Как нарисовать свою ломаную
Вот прямо сейчас кликаем в окне. Текущая линия сбросится и за курсором потянулась линия — клик, вершина зафиксировалась, двигаем курсор мыши дальше. Чтобы закончить линию, необходимо снова кликнуть в её последнюю точку, либо двойной клик, либо нажать Enter. Если нажать Esc, поле очистится.
Пока линия строится, она красного цвета.
Что это за картинка снизу
Это изображение, которое можно использовать в качестве заливки линии, вместо цвета. Для того, чтобы выбрать изображение в качестве заливки, необходимо установит галку в WithPattern.
Если угрюмая постапокалиптическая картинка не нравится, заходим в браузер, находим жизнерадостную картинку, копируем, вызываем на картинке в программе правой кнопкой мыши контекстное меню и жмём «Paste«. Новая картинка вставится.
Что такое CrazyMouse
Это когда линия формируется без кликов, на каждое движение мышки. То есть получается не ломаная, а прям произвольная линия, как бы от руки.
Допустим, мы выбрали картинку и теперь хотим сделать какой-нибудь эффект, наподобие этого:

Если снять галку с ToArray, то будет по другому. И ещё не факт, что первое баловство лучше.

Для любознательных: Как строится ломаная
На PaintBox’е отрабатываем два события: OnMouseDown и OnMouseMove.
Приватное поле формы FFinish: Boolean отвечает на вопрос — строится ли сейчас линия или уже построена. Если True, значит уже построена.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 |
{$Region 'Дела мышиные'} function PtEqual(const P1, P2: TPoint): Boolean; begin Result := (P1.Distance(P2) < 6); end; procedure TFmMain.pbMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // Не левая кнопка мышки - до свидания if not (ssLeft in Shift) then exit; // Если построение траектории закончено, и снова нажатие, // стартуем новую траекторию if FFinish then FPoints.Clear; // Если в траектории больше одной точки и клик недалеко от последней, // значит конец построению траектории FFinish := (FPoints.Count > 1) and PtEqual(FPoints[FPoints.Count-2],Point(X,Y)); FFinish := FFinish or (ssDouble in Shift); // Если всё ещё строим, добавляем точку if not FFinish then FPoints.Add(Point(X,Y)); // И рисуем pbPaint(pb); end; procedure TFmMain.pbMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin // Построение закончено - до свидания if FFinish then exit; // Если всего одна точка - сразу добавляем вторую if (FPoints.Count=1) or (CrazyMouse.Checked and not PtEqual(FPoints[FPoints.Count-1],Point(X,Y))) then FPoints.Add(Point(X,Y)); // Меняем координаты последней точки FPoints[FPoints.Count-1] := Point(X,Y); // И рисуем pbPaint(pb); end; {$EndRegion} |
Что будет если применить масштаб к косметическому перу
Давайте не будем сами считать толщину и прочую самодеятельность. Для масштабирования есть аффинное преобразование масштаба. Как применять аффинное преобразование в GDI можно подсмотреть тут. Правда, там преобразование поворота. Но суть понятна.
Преобразование применяется к точке начала координат (0,0), поэтому никаких дополнительных преобразований не нужно, просто масштаб:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
// Аффинное преобразование масштаба function SetScaleTransform(DC: HDC; AScale: Single; out XFormOld: TXForm; out GModeOld: Integer): Boolean; var XForm: TXForm; begin // матрица масштаба XForm.eM11 := AScale; XForm.eM12 := 0; XForm.eM21 := 0; XForm.eM22 := AScale; XForm.eDx := 0; XForm.eDy := 0; // перевод контекста в продвинутый режим, иначе преобразование не сработает GModeOld := SetGraphicsMode(DC, GM_ADVANCED); if GModeOld = 0 then exit(False); // произвести аффинное преобразование на плоскости Result := GetWorldTransform(DC, XFormOld); if Result then SetWorldTransform(DC, XForm); end; |
Перед рисованием ломаной вставляем такой код (перед try):
1 2 3 |
// Перед отрисовкой применяем аффинное преобразование масштаба Transform := (FZoom > 1) and SetScaleTransform(Handle, FZoom, XFormOld, GModeOld); |
А в блоке finally добавляем следующее:
1 2 3 4 5 6 7 |
// Если было преобразование, возвращаем всё взад if Transform then begin // вернуть режим и матрицу преобразования в контекст SetWorldTransform(Handle, XFormOld); SetGraphicsMode(Handle, GModeOld); end; |
В контекстном меню на поле отрисовки можно выбрать масштаб. Получаем следующее:


Как видно на рисунке 9, толщина пера по-прежнему 1, и по идее он должен рисоваться пунктиром, но нет, при масштабировании он рисуется сплошной линией. GDI API не обманешь.

А вот геометрическое перо спокойной переносит смену масштаба.
Для получения такого приятного бонуса, как жирная пунктирная линия, люди прикручивают GDI+. В этом есть смысл, потому что главный недостаток всего GDI — это целочисленные параметры. А в GDI+ координаты — это вещественные числа. И работает он только с вещественными числами. Просто не включаем анти-алиас, чтобы не тормозило, и пользуем GDI+.
Если мы в GDI применим дробный масштаб, то рискуем получить не сильно привлекательный результат:

Поэтому умеет смысл поглядеть в сторону GDI+, там всё чётко и ровно при любом масштабе.
А где MiterLimit?
А нету ))) Показалось лишним в этом контексте. Качайте, экспериментируйте. Исходник очень маленький, пространство для экспериментов огромное.
Один мужик сказал в коворкинге «Тот случай дал мне ценный опыт» вместо «Тот кейс дал мне ценный экспириенс» и его тут же осмеяли, облили смузи и перевели в чуханы
Скачать
Друзья, спасибо за внимание!
Исходник (zip) 231 Кб. Delphi XE 7, XE 10, XE 11
Исполняемый файл (zip) 1.06 Мб.
Друзья! Буду чрезвычайно признателен за комментарии, регистрацию на сайте, подписку в телеге. Это очень значимая моральная поддержка для меня.