Компонент предназначен для вычерчивания линий на мнемосхемах и других целей, где количество ломаных линий, созданых одним компонентом, не должно превышать 255.
Инструмент - Delphi 5.1.

Введение даже списка (TList), не говоря уже о коллекции, заметно замедляло отрисовку, поэтому был выбран статический массив записей линий.

Компонент позволяет изменять тощину, стиль и цвет как в режиме разработки, так и в динамике.
Для редактирования используется стандартный редактор компонентов, запускаемый нажатием правой кнопкой мыши.
Редактирование нужно начинать с первой команды выпадающего меню (Edit Lines), а заканчивать - со второй (Exit from Editing). Редактирование заключается в добавлении линий (Add Line) и узлов (Add node), и удалении их (Remove Line и Remove Node).
Можно также менять цвет (Line Color) и стиль линии (LineStyle). Ввиду ограничений, накладываемых операционными системами Windows95 и 98, стили меняются только для линий с толщиной, равной 1. Для Windows NT и 2000 таких ограничений нет.

Для изменения координат узла нужно выбрать линию путем нажатия левой кнопки мыши над требуемым узлом или концом линии, и, удерживая ее, перетащить на нужное место. Выделенная линия обозначается черными квадратиками.

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

К сожалению, компонент имеет существенный недостаток - отсутствие блокировки манипулирования другими компонентами, находящимися на форме, до выхода из режима редактирования линий.
Автор будет глубоко благодарен за любые советы по преодолению указанного недостатка.

Автор приносит глубокую благодарность Сергею Губенко и Юрию Зотову за ценные советы по построению компонента.
Компонент могут использовать все без всяких ограничений, но со ссылкой на автора.

{
Copyright © 1999 by Delphi 5 Developer’s Guide - Xavier Pacheco and Steve Teixeira
}

unit MainFrm;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Menus, DB, DBCGrids, DBTables;

type
TMainForm = class(TForm)
mmMain: TMainMenu;
mmiMappingMode: TMenuItem;
mmiMM_ISOTROPIC: TMenuItem;
mmiMM_ANSITROPIC: TMenuItem;
mmiMM_LOENGLISH: TMenuItem;
mmiMM_HIINGLISH: TMenuItem;
mmiMM_LOMETRIC: TMenuItem;
mmiMM_HIMETRIC: TMenuItem; Read more »

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;

type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormActivate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
x, y: byte; // координаты центра окружности
dx: byte; // приращение координаты x при движении окружности

implementation

{$R *.dfm}
Read more »

Написать графический редактор, как Paint Brush, в Delphi очень просто. Но встает одна проблема. Чтобы нарисовать линию, пользователь нажимает мышью на поле, двигает ее, и отпускает кнопку. Во время движения мыши линия все время перерисовывается. Причем фон, после того, как линия переместилась, должен восстановиться. Для этого можно использовать логическую операцию XOR. Важное свойство этой операции заключается в том, что при любых A и B, A XOR B XOR B = A. Это означает, что если воспользоваться этой операцией для рисования линии, то при повторном ее рисовании на этом месте этим же цветом она сотрется, оставив за собой прежний фон.

procedure TForm1.XORLine;
begin
Form1.Canvas.MoveTo(xo, yo);
Form1.Canvas.LineTo(lx, ly);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Color := clWhite;
Form1.Canvas.Pen.Color := clRed;
Form1.Canvas.Pen.Width := 3;
end;
Read more »

Мерцание возникает, когда цвет точки меняется два раза подряд. Например, правильнее объект при его перемещении стирать и затем рисовать на новом месте не на экране, а в памяти, и выводить на форму уже готовое изображение поверх предыдущего. В таком случае смена цветов на экране происходит только один раз.

var
bm: TBitMap;

procedure TForm1.FormCreate(Sender: TObject);
begin
bm := TBitMap.Create;
bm.Width := Form1.ClientWidth;
bm.Height := Form1.ClientHeight;
with bm.Canvas do
begin
Font.name := ‘Arial’;
Font.Size := 50;
Font.Color := clBlue;
end;
Timer1.Interval := 100;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
s: string;
Hour, Min, Sec, MSec: Word;
begin
DecodeTime(Time, Hour, Min, Sec, MSec);
with bm.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := clWhite;
FillRect(ClipRect);
s := TimeToStr(Time);
TextOut((bm.Width - TextWidth(s)) div 2,
(bm.Height - TextHeight(s)) div 2, s);
Pen.Mode := pmMask;
Pen.Width := 20;
Pen.Color := clLime;
Brush.Style := bsClear;
Rectangle(bm.Width div 2 - (MSec * bm.Width) div 5000,
bm.Height div 2 - (MSec * bm.Height) div 5000,
bm.Width div 2 + (MSec * bm.Width) div 5000,
bm.Height div 2 + (MSec * bm.Height) div 5000);
end;
Form1.Canvas.Draw(0, 0, bm);
end;