Неквадратный компонент

var
  R: HRgn;
  P: Array[0..2] of TPoint;
begin
  P[0] := Point(0,0);    // определим точки для полигона и
  P[1] := Point(200,0);
  P[2] := Point(100,200);
  R := CreatePolygonRgn(P, 3, WINDING); // зададим его
  SetWindowRgn(Handle, R, True);
end;

unit Main;

interface

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

const
  N = 10; {количество точек}
  L = 2; {допустимый зазор}

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TMyLine = record
    BP, EP: TPoint;
  end;

var
  Form1: TForm1;
  MyLines: array[0..N - 1] of TMyLine;
  NML: Integer;
  OldX, OldY: Integer;
  OldBP, OldEP: TPoint;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to N - 1 do
    with MyLines do begin
      with BP do begin
        X := Random(ClientWidth);
        Y := Random(ClientHeight);
      end;
      with EP do begin
        X := Random(ClientWidth);
        Y := Random(ClientHeight);
      end;
    end;
  NML := -1;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  i: Integer;
begin
  with Canvas do
    for i := 0 to N - 1 do
      with MyLines do begin
        MoveTo(BP.X, BP.Y);
        LineTo(EP.X, EP.Y);
      end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
  d: Extended;
begin
  for i := 0 to N - 1 do
    with MyLines do
      if (((X > BP.X - L) and (X < EP.X + L)) or ((X > EP.X - L) and (X < BP.X + L))) and
       (((Y > BP.Y - L) and (Y < EP.Y + L)) or ((Y > EP.Y - L) and (Y < BP.Y + L))) then begin
        d := Abs(((BP.Y - EP.Y) * X + (EP.X - BP.X) * Y + (BP.X * EP.Y - EP.X * BP.Y)) /
         Sqrt(Sqr(EP.X - BP.X) + Sqr(EP.Y - BP.Y)));
        if d <= L then begin
          NML := i;
          Break;
        end;
      end;
  if NML >= 0 then begin
    OldX := X;
    OldY := Y;
    OldBP := MyLines[NML].BP;
    OldEP := MyLines[NML].EP;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
  NML := -1;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState;
 X, Y: Integer);
var
  dX, dY: Integer;
begin
  if NML >= 0 then begin
    dX := X - OldX;
    dY := Y - OldY;
    MyLines[NML].BP.X := OldBP.X + dX;
    MyLines[NML].BP.Y := OldBP.Y + dY;
    MyLines[NML].EP.X := OldEP.X + dX;
    MyLines[NML].EP.Y := OldEP.Y + dY;
    Repaint;
  end;
end;

end.

unit Main;

interface

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

type
    {Объявляем свой класс как дочерний от TImage}
    TMyImage1=class(TDBImage) //используем DBImage т.к. он явялется потомком TWinControl а не TControl и ->
    public                    //-> следовательно имеет дескриптор Handle для ипользования регионов !!!
     Number:Integer;//Порядковый номер элемента
     NameImageActive:String; //Название активной картинки в .res
     NameImageDeactive:String; //Название неактивной картинки в .res
     {и т.д. ...}
     procedure MouseLeave(var msg: TMessage); message CM_MOUSELEAVE;//процедура перехватывает покидание элемента мышью
     procedure MouseEnter(var msg: TMessage); message CM_MOUSEENTER;//процедура перехватывает переход мыши на элемент
    end;
    {*******************************************}

  TForm1=class(TForm)
   procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
   procedure MyImageClick(Sender: TObject);
   procedure MyImageDblClick(Sender: TObject);
   procedure MyImageMouseDown(Sender: TObject;Button: TMouseButton;Shift: TShiftState; X,Y: Integer);
   procedure MyImageMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
   procedure MyImageMouseUp(Sender: TObject;Button: TMouseButton;Shift: TShiftState; X,Y: Integer);
  public
   MasMyImage:array of TMyImage1;
  end;
var
  Form1: TForm1;

implementation

{$R *.dfm}

var {Для перемещения элементов}
     POS_X,POS_Y:Integer;
     FMyImageMove:Boolean;//флаг режима перемещения

procedure TMyImage1.MouseLeave(var msg: TMessage);
begin
//Деактивируем элемент
Picture.Bitmap.LoadFromResourceName(HInstance, NameImageDeactive);
end;

procedure TMyImage1.MouseEnter(var msg: TMessage);
begin
//Активируем элемент
Picture.Bitmap.LoadFromResourceName(HInstance, NameImageActive);
BringToFront;
end;

procedure TForm1.FormShow(Sender: TObject);
 //Формирует регион по контуру картинки в битмэпе
 function CreateRgnFromBitmap(RgnBitmap:TBitmap):HRGN;
 var
  TransColor:TColor;
  i,j: Integer;
  i_width,i_height:Integer;
  i_left,i_right:Integer;
  rectRgn: HRGN;
 begin
 Result:=0;
 i_width:=rgnBitmap.Width;
 i_height:=rgnBitmap.Height;
 transColor := rgnBitmap.Canvas.Pixels[0, 0];
 for i:=0 to i_height-1 do
  begin
   i_left:=-1;
   for j:=0 to i_width-1 do
    begin
     if i_left<0 then
      begin
       if rgnBitmap.Canvas.Pixels[j,i]<>transColor then
        i_left :=j;
      end
     else
      if rgnBitmap.Canvas.Pixels[j,i]=transColor then
       begin
        i_right:=j;
        rectRgn:=CreateRectRgn(i_left, i, i_right, i+1);
        if Result=0 then
         Result:=rectRgn
        else
         begin
          CombineRgn(Result, Result, rectRgn, RGN_OR);
          DeleteObject(rectRgn);
         end;
        i_left:=-1;
       end;
    end;
   if i_left>=0 then
    begin
     rectRgn:=CreateRectRgn(i_left, i, i_width, i + 1);
     if Result=0 then
      Result:=rectRgn
     else
      begin
       CombineRgn(Result,Result,rectRgn,RGN_OR);
       DeleteObject(rectRgn);
      end;
    end;
  end;
 end;

var BitBuffer:TBitmap;
    WindowRgn:HRGN; //переменная типа регион
    i:SmallInt;
begin
SetLength(MasMyImage, 60); //инициализируем массив элементов: 60 шт.

for i:=1 to Length(MasMyImage) do {Для примера делаем 60 одинаковых элементов}
 begin
 {Создаем динамически элемент-1 типа TMyImage1 на форме-1}
 //1. Предварительно: Формируем регион по контуру картинки, которая будет потом загружена в элемент-1
 BitBuffer:=TBitmap.Create; //инициализируем битмап
 BitBuffer.LoadFromResourceName(HInstance, 'Pic1_Active'); //загружаем из ресурса картинку "Pic1" в битмап
 WindowRgn:=CreateRgnFromBitmap(BitBuffer); //Используем самодельную процедуру создания региона по контуру битмапа

 //2. Создаем динамически элемент-1 на форме-1 и настраиваем его
 MasMyImage[i-1]:=TMyImage1.Create(Form1);//создаем компенент типа TMyImage1 динамически на первой форме
 with MasMyImage[i-1] do
                 begin
                 {ПАРАМЕТРЫ}
                 Visible:=false; //пока настраиваем пусть его никто не видит
                 Parent:=Form1; //указываем имя компонета-родителя
                 Name:='MyImage'+IntToStr(i); //задаем имя элементу
                 BorderStyle:=bsNone; //ОБЯЗАТЕЛЬНО - сброс стиля !!!
                 SetBounds(10*i-form1.HorzScrollBar.Position, {позиция верхнего левого угла по X с учетом прокрутки. Покрутку нужно учитывать при сохр. и загрузки данных из INI-файла}
                           10*i-form1.VertScrollBar.Position, {позиция верхнего левого угла по Y с учетом прокрутки. Покрутку нужно учитывать при сохр. и загрузки данных из INI-файла}
                           BitBuffer.Width,                  {задаем ширину элемента}
                           BitBuffer.Height);                {задаем высоту элемента}
                 SetWindowRgn(MasMyImage[i-1].Handle,WindowRgn,true); //применяем регион к элементу как окну
                 Picture.Bitmap.LoadFromResourceName(HInstance, 'Pic1_Deactive');
                 TabStop:=false; //запрет табуляции
                 {СПЕЦИАЛЬНЫЕ ПАРАМЕТРЫ ЗАЯВЛЕННЫЕ НАМИ их нужно заполнять информацей из INI-файла}
                 Number:=i;
                 NameImageActive:='Pic1_Active';
                 NameImageDeactive:='Pic1_Deactive';
                 {СОБЫТИЯ}
                 OnClick:=form1.MyImageClick; //назначем свои процедуры, если конечно эти события обрабатываются
                 OnDblClick:=form1.MyImageDblClick;
                 OnMouseDown:=form1.MyImageMouseDown;
                 OnMouseMove:=form1.MyImageMouseMove;
                 OnMouseUp:=form1.MyImageMouseUp;
                 //и т.д. ...
                 {ОСТАЛЬНОЕ}
                 Hint:='Delph-еры всех стран объединяйтесь'+IntToStr(i); //заполням всплывающий ярлычок
                 ShowHint:=true;
                 //и т.д. ...
                 Visible:=true; //делаем элемент видимым
                 end;
 end;
end;

procedure TForm1.MyImageClick(Sender: TObject);
begin
{...}
end;

procedure TForm1.MyImageDblClick(Sender: TObject);
begin
{...}
end;

procedure TForm1.MyImageMouseDown(Sender: TObject;Button: TMouseButton;Shift: TShiftState; X,Y: Integer);
begin
//Запоминаем коорд. мыши
POS_X:=X+form1.HorzScrollBar.Position;
POS_Y:=Y+form1.VertScrollBar.Position;
FMyImageMove:=true;//Актив. флаг перемешения
end;

procedure TForm1.MyImageMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
if FMyImageMove=true then
 begin
 //смещаем элемент
 (Sender as TMyImage1).Left:=(Sender as TMyImage1).Left+X-(POS_X-form1.HorzScrollBar.Position);
 (Sender as TMyImage1).Top:=(Sender as TMyImage1).Top+Y-(POS_Y-form1.VertScrollBar.Position);
 end;
end;

procedure TForm1.MyImageMouseUp(Sender: TObject;Button: TMouseButton;Shift: TShiftState; X,Y: Integer);
begin
if FMyImageMove=true then
 begin
 //конец перемещениям элемента
 FMyImageMove:=false;
 POS_X:=0;
 POS_Y:=0;
 end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var i:SmallInt;
begin
//Пример удаления всех элементов
if MasMyImage<>nil then
 for i:=1 to Length(MasMyImage) do
  if MasMyImage[0]<>nil then begin
                             MasMyImage[0].Destroy;
                             MasMyImage[0]:=nil;
                             end;
end;

end.