Алгоритм Грэхема / Source / CHILDWIN

unit CHILDWIN;

interface

uses Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls,
ComCtrls,SysUtils,List, RandomForm;

type

TMDIChild = class(TForm)
View: TPaintBox;
ScrollBarHorisontal: TScrollBar;
ScrollBarVertical: TScrollBar;
StatusBar: TStatusBar;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormPaint(Sender: TObject);
procedure ViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ViewMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
procedure ScrollBarHorisontalScroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
procedure ScrollBarVerticalScroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
procedure FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
procedure ViewMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormActivate(Sender: TObject);

private
{ Private declarations }
a: array[1..1000] of vertex;
coverTop,coverBottom:array[1..1000] of vertex;
count,countTopCover,countBottomCover,CountCover: integer;
coverList:TListVertex;
ShiftX,ShiftY:integer;
MaxViewX,CurrentViewX:integer;
BWidth,BHeight,zX,zY:integer;
Scale : real;
filedata : file of integer;
fStill:boolean;
f:boolean;
w:plVertex;
StillcoverListcurrent:plVertex;
BitMap:TBitMap;
al:integer;
mouseX0,mouseY0,mouseX,mouseY:integer;
RightBPressed:boolean;
function CreateCoverAndry():TListVertex;
function CreateCover():TListVertex;
public
{ Public declarations }
procedure SetScale(S:real);
procedure Zoom(Z:real);
procedure ReDraw(Sender: TObject);
procedure Graham(Sender: TObject);
function StillGraham(Sender: TObject): boolean;
procedure LoadFromFile(Name:String);
procedure SaveToFile(Name:String);
procedure SaveToBMPFile(Name:String);
procedure RandomVertex(num,xl,yl,xr,yr:integer);
procedure ClearCover();
procedure SetAlgorithm(a:integer);
end;

implementation

uses MAIN;
{$R *.dfm}


procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;

procedure TMDIChild.LoadFromFile(Name:String);
begin
AssignFile(filedata,Name);
{$I-}
Reset(filedata);
{$I+}
if IOResult=0 then
begin
count:=0; Scale:=1;
MaxViewX:=200;CurrentViewX:=0; CountCover:=0;
ScrollBarHorisontal.Max:=MaxViewX; ScrollBarHorisontal.Min:=0;
BWidth:=View.Width; BHeight:=View.Height; zX:=0; zY:=0; count:=0;
while not EOF(filedata) do
begin
inc(count);
read(filedata,a[count].x);
read(filedata,a[count].y);
read(filedata,a[count].number);
end;
CloseFile(FileData);
end;
end;

procedure TMDIChild.SaveToFile(Name:String);
var i:integer;
begin
AssignFile(filedata,Name);
{$I-}
rewrite(filedata);
{$I+}
if IOResult=0 then
begin
for i:=1 to count do
begin
write(filedata,a[i].x);
write(filedata,a[i].y);
write(filedata,a[i].number);
end;
CloseFile(filedata);
Caption := Name;
end;
end;

{************************************************}

procedure TMDIChild.SaveToBMPFile(Name:String);
var MyRect: TRect;
begin
BitMap:= TBitmap.Create;
BitMap.Height:=View.height;
BitMap.Width:=View.Width;
MyRect := Rect(0,0,View.width,View.height);
Bitmap.Canvas.CopyRect(MyRect,View.Canvas,MyRect);
BitMap.SaveToFile(Name);
end;


procedure TMDIChild.RandomVertex(num,xl,yl,xr,yr:integer);
var i,x,y:integer;
begin
if (num>0) and (count+num<1000) then
begin
Randomize;
for i:=1 to num do
begin
x:=random(xr-xl)+xl;
y:=random(yr-yl)+yl;
a[count+i].x:=x;
a[count+i].y:=y;
a[count+i].number:=i+count;
end;
count:=count+num; CountCover:=0; fstill:=false;
CountTopCover:=0; CountBottomCover:=0;
end;
end;

procedure TMDIChild.ClearCover();
begin
fstill:=false;
if CountCover>0 then CoverList.Free();
countTopCover:=0;
countBottomCover:=0;
CountCover:=0;
end;

procedure TMDIChild.FormPaint(Sender: TObject);
var i,x,y:integer;
begin
// Очистка области рисования
canvas.Brush.Color:=clWhite;
canvas.Pen.Style:=psSolid;
View.canvas.Pen.Width := 1;
View.canvas.Pen.Style:=psSolid;
View.canvas.Rectangle(0,0,View.Width,View.Height);

if (countTopCover>0) then
begin
View.Canvas.Pen.Color:=clSilver;
x:=round((CoverTop[1].x-View.Width/2+ShiftX)*Scale+View.Width/2);
y:=round((CoverTop[1].y-View.Height/2+ShiftY)*Scale+View.Height/2);
View.Canvas.MoveTo(x,y);
for i:=1 to countTopCover do
begin
x:=round((CoverTop[i].x-View.Width/2+ShiftX)*Scale+View.Width/2);
y:=round((CoverTop[i].y-View.Height/2+ShiftY)*Scale+View.Height/2);
View.Canvas.LineTo(x,y);
end;
View.Canvas.Pen.Style:=psDashDot;
View.Canvas.MoveTo(x,y);
x:=round((CoverTop[1].x-View.Width/2+ShiftX)*Scale+View.Width/2);
y:=round((CoverTop[1].y-View.Height/2+ShiftY)*Scale+View.Height/2);
View.Canvas.LineTo(x,y);
end;


View.Canvas.Pen.Style:=psSolid;
if (countBottomCover>0) then
begin
x:=round((CoverBottom[1].x-View.Width/2+ShiftX)*Scale+View.Width/2);
y:=round((CoverBottom[1].y-View.Height/2+ShiftY)*Scale+View.Height/2);
View.Canvas.MoveTo(x,y);
for i:=1 to countBottomCover do
begin
x:=round((CoverBottom[i].x-View.Width/2+ShiftX)*Scale+View.Width/2);
y:=round((CoverBottom[i].y-View.Height/2+ShiftY)*Scale+View.Height/2);
View.Canvas.LineTo(x,y);
end;
end;

if (countCover>0) then
begin
CoverList.current:=CoverList.beginList;
View.Canvas.Pen.Color:=clRed;
x:=round((CoverList.current.x-View.Width/2+ShiftX)*Scale+View.Width/2);
y:=round((CoverList.current.y-View.Height/2+ShiftY)*Scale+View.Height/2);
View.Canvas.MoveTo(x,y);
repeat
CoverList.current:=CoverList.current.next;
x:=round((CoverList.current.x-View.Width/2+ShiftX)*Scale+View.Width/2);
y:=round((CoverList.current.y-View.Height/2+ShiftY)*Scale+View.Height/2);
View.Canvas.Pen.Style:=psSolid;
if (CoverList.current^.next.used=3) then
begin
View.Canvas.Pen.Width:=2; //2
View.Canvas.Pen.Color:=$000000FF;//$0000FF00;
View.Canvas.Ellipse(x-5,y-5,x+5,y+5);
View.Canvas.Pen.Width:=1;//1
end;

if (CoverList.current^.used=1) then View.Canvas.Pen.Color:=clRed
else
if (CoverList.current^.used=2) then View.Canvas.Pen.Color:=$000000FF //$0000FF00
else
if (CoverList.current^.used=0) then View.Canvas.Pen.Color:=clGray
else
begin
View.Canvas.Pen.Width:=2; //2
View.Canvas.Pen.Color:=$000000FF;//$0000FF00;
View.Canvas.Ellipse(x-4,y-4,x+5,y+5);
View.Canvas.Pen.Style:=psDot;
View.Canvas.Pen.Width:=1; //1
end;
View.Canvas.LineTo(x,y);
View.Canvas.Pen.Style:=psSolid;
until (CoverList.current=CoverList.beginList);
end;

View.Canvas.Pen.Color:=clBlack;
for i:=1 to count do
with View.canvas do
begin
x:=round((a[i].x-View.Width/2+ShiftX)*Scale+View.Width/2);
y:=round((a[i].y-View.Height/2+ShiftY)*Scale+View.Height/2);
View.Canvas.Font.Name:='Arial';
View.Canvas.Font.Size:=7;

View.Canvas.Pen.Width:=2; //2
View.Canvas.Pen.Color:=clTeal ;
View.Canvas.Ellipse(x-2,y-2,x+3,y+3);
View.Canvas.Pen.Style:=psDot;


View.Canvas.TextOut(x+1,y+1,IntToStr(a[i].number)) ;
end;
end;

procedure TMDIChild.ViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Button=mbLeft) then
begin
with View.canvas do
begin
View.Canvas.Font.Name:='Arial';
View.Canvas.Font.Size:=7;
{Pixels[x,y]:=clBlack;
Pixels[x+1,y]:=clSilver;
Pixels[x-1,y]:=clSilver;
Pixels[x,y+1]:=clSilver;
Pixels[x,y-1]:=clSilver;}

View.Canvas.Pen.Width:=2; //2
View.Canvas.Pen.Color:=clTeal ;
View.Canvas.Ellipse(x-2,y-2,x+3,y+3);
View.Canvas.Pen.Style:=psDot;
inc(count);
a[count].x:=round((x-View.Width/2)/Scale+View.Width/2-ShiftX);
a[count].y:=round((y-View.Height/2)/Scale+View.Height/2-ShiftY);
a[count].number:=count;
View.Canvas.TextOut(x+1,y+1,IntToStr(a[count].number)) ;
end;
fstill:=false;
end;
if (Button=mbRight) then
begin
RightBPressed:=true; MouseX0:=x; MouseY0:=y;
MouseX:=x;MouseY:=y;
end;
end;

procedure TMDIChild.ViewMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var XX,YY:integer;
begin
if RightBPressed then
begin
{FormPaint(Sender);
Update();}

View.Canvas.Pen.Width:=1;
View.Canvas.Pen.Style:=psDot;
View.Canvas.Pen.Mode:=pmNotXor;
View.Canvas.Brush.Style := bsClear;
View.Canvas.Pen.Color:=clBlack;
View.Canvas.Polygon([point(MouseX0,MouseY0),point(MouseX0,MouseY),
point(MouseX,MouseY),point(Mousex,MouseY0)]);

//View.Canvas.Pen.Mode:=pmMaskNotPen;
View.Canvas.Pen.Color:=clBlack;
View.Canvas.Polygon([point(MouseX0,MouseY0),point(MouseX0,Y),
point(X,Y),point(x,MouseY0)]);
MouseX:=x;MouseY:=y;
View.Canvas.Pen.Mode:=pmCopy;
View.Canvas.Brush.Style := bsSolid;
end;
{
XX:=round((X-View.Width/2)/Scale+View.Width/2-ShiftX);
YY:=round((Y-View.Height/2)/Scale+View.Height/2-ShiftY);
}

XX:=round((X-View.Width/2-ShiftX)/Scale+View.Width/2);
YY:=round((Y-View.Height/2-ShiftY)/Scale+View.Height/2);
StatusBar.SimpleText:='X:'+IntToStr(XX)+' Y:'+IntToStr(YY);
end;

procedure TMDIChild.FormCreate(Sender: TObject);
begin
RightBPressed:=false;
count:=0; Scale:=1;
MaxViewX:=200;CurrentViewX:=0; CountCover:=0;
ScrollBarHorisontal.Max:=MaxViewX; ScrollBarHorisontal.Min:=0;
BWidth:=View.Width; BHeight:=View.Height; zX:=0; zY:=0;
end;

procedure TMDIChild.ScrollBarHorisontalScroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
ShiftX:=round(-ScrollPos); ShiftX:=ShiftX+zX;
FormPaint(Sender);
end;

procedure TMDIChild.ScrollBarVerticalScroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
ShiftY:=round(-ScrollPos); ShiftY:=ShiftY+zY;
FormPaint(Sender);
end;

procedure TMDIChild.SetScale(S:real);
begin
Scale:=S;
end;

procedure TMDIChild.Zoom(Z:real);
begin
if (((Z<1) and (Scale>0.4)) or
((Z>1) and (Scale<100)))
then
begin
Scale:=Scale*Z;
end;
end;

procedure TMDIChild.ReDraw(Sender: TObject);
begin
FormPaint(Sender);
end;

function isAngleLeft(V1,V2,V3:plVertex):boolean;
var ax,ay,bx,by:integer;
begin
ax:=V3.x-V2.x; ay:=V3.y-V2.y;
bx:=V1.x-V2.x; by:=V1.y-V2.y;
if (ax*by-ay*bx<=0) then isAngleLeft:=true
else isAngleLeft:=false;
end;

function isAngleLeftInt(x1,y1,x2,y2,x3,y3:integer):boolean;
var ax,ay,bx,by:integer;
begin
ax:=x3-x2; ay:=y3-y2;
bx:=x1-x2; by:=y1-y2;
if (ax*by-ay*bx<0) then isAngleLeftInt:=true
else isAngleLeftInt:=false;
end;

function TMDIChild.CreateCover():TListVertex;
var i,j,minY,minCount,tx,ty,tn:integer;
list : TListVertex;
begin
countBottomCover:=Count;CountTopCover:=1;
CountCover:=Count;
for i:=1 to count do
begin
coverBottom[i].x:=a[i].x;
coverBottom[i].y:=a[i].y;
coverBottom[i].number:=a[i].number;
end;
{======= Поиск нижней точки - ищем и записываем ее на первое место ====}
minY:=a[1].y; minCount:=1;
for i:=2 to count do
if coverBottom[i].y<minY then
begin
minY:=coverBottom[i].y; minCount:=i;
end;
coverBottom[minCount].y:=coverBottom[1].y; coverBottom[1].y:=minY;
i:=coverBottom[minCount].x; coverBottom[minCount].x:=coverBottom[1].x;
coverBottom[1].x:=i;
coverTop[1].x:=coverBottom[1].x; coverTop[1].y:=coverBottom[1].y;
coverTop[1].number:=coverBottom[1].number;
{======= Сортировка массива точек по углу отн. нижней точки ===========}
for i:=1 to CountBottomCover-1 do
for j:=i+1 to CountBottomCover do
begin
if (isAngleLeftInt(coverBottom[i].x,coverBottom[i].y,
coverBottom[1].x,coverBottom[1].y,
coverBottom[j].x,coverBottom[j].y)) then
begin
tx:=coverBottom[i].x; ty:=coverBottom[i].y; tn:=coverBottom[i].number;
coverBottom[i].x:=coverBottom[j].x; coverBottom[i].y:=coverBottom[j].y;
coverBottom[i].number:=coverBottom[j].number;
coverBottom[j].x:=tx; coverBottom[j].y:=ty;
coverBottom[j].number:=tn;
end;
end;

list:=TListVertex.Create;
for i:=1 to countBottomCover
do list.AddVector(coverBottom[i].x,coverBottom[i].y,coverBottom[i].number);
CreateCover:=list;
end;

function TMDIChild.CreateCoverAndry(): TListVertex;
var k,b : real;
i,j,tx,ty,tn : integer;
minX,minCountX,maxX,maxCountX:integer;
list : TListVertex;
begin
{======= Поиск минимальной и максимальной по х точек ===================}
minX:=a[1].x ;minCountX:=1;
maxX:=a[1].x ;maxCountX:=1;
for i:=2 to count do
begin
if (a[i].x<minX) then
begin
minX:=a[i].x; minCountX:=i;
end;
if (a[i].x>maxX) then
begin
maxX:=a[i].x; maxCountX:=i;
end;
end;
{======== Вычисление параметров прямой через точки min и max ===========}
if (a[maxCountX].x-a[minCountX].x)<>0 then
begin
k:=(a[maxCountX].y-a[minCountX].y)/(a[maxCountX].x-a[minCountX].x);
b:=a[maxCountX].y-k*a[maxCountX].x;
{======== Создание неупорядоченной верхней и нижней оболочки ===========}
coverTop[1].x:=a[minCountX].x;
coverTop[1].y:=a[minCountX].y;
coverTop[1].number:=a[minCountX].number;
coverBottom[1].x:=a[minCountX].x;
coverBottom[1].y:=a[minCountX].y;
coverBottom[1].number:=a[minCountX].number;
countTopCover:=1; countBottomCover:=1;
for i:=1 to count do
if ((i<>maxCountX) and (i<>minCountX)) then
begin
if (a[i].y>=k*a[i].x+b) then
begin
inc(countTopCover);
coverTop[countTopCover].x:=a[i].x;
coverTop[countTopCover].y:=a[i].y;
coverTop[countTopCover].number:=a[i].number;
end
else
begin
inc(countBottomCover);
coverBottom[countBottomCover].x:=a[i].x;
coverBottom[countBottomCover].y:=a[i].y;
coverBottom[countBottomCover].number:=a[i].number;
end;
end;
inc(countTopCover); inc(countBottomCover);
coverTop[countTopCover].x:=a[maxCountX].x;
coverTop[countTopCover].y:=a[maxCountX].y;
coverTop[countTopCover].number:=a[maxCountX].number;
coverBottom[countBottomCover].x:=a[maxCountX].x;
coverBottom[countBottomCover].y:=a[maxCountX].y;
coverBottom[countBottomCover].number:=a[maxCountX].number;
end;
{============== Сортировка верхней оболочки =================}
for i:=1 to CountTopCover-2 do
for j:=i+1 to CountTopCover-1 do
begin
if (coverTop[i].x>coverTop[j].x) then
begin
tx:=coverTop[i].x; ty:=coverTop[i].y;
tn:=coverTop[i].number;
coverTop[i].x:=coverTop[j].x;
coverTop[i].y:=coverTop[j].y;
coverTop[i].number:=coverTop[j].number;
coverTop[j].x:=tx; coverTop[j].y:=ty;
coverTop[j].number:=tn;
end;
end;
{============== Сортировка нижней оболочки =================}
for i:=1 to CountBottomCover-2 do
for j:=i+1 to CountBottomCover-1 do
begin
if (coverBottom[i].x>coverBottom[j].x) then
begin
tx:=coverBottom[i].x; ty:=coverBottom[i].y; tn:=coverBottom[i].number;
coverBottom[i].x:=coverBottom[j].x; coverBottom[i].y:=coverBottom[j].y;
coverBottom[i].number:=coverBottom[j].number;
coverBottom[j].x:=tx; coverBottom[j].y:=ty;
coverBottom[j].number:=tn;
end;
end;
{=============== Переводим массив в список =================}
// if (CountCover<>0) then list.Free;
list:=TListVertex.Create;
for i:=1 to countTopCover
do list.AddVector(coverTop[i].x,coverTop[i].y,coverTop[i].number);
for i:=countBottomCover-1 downto 2
do list.AddVector(coverBottom[i].x,coverBottom[i].y,coverBottom[i].number);
CountCover:=CountTopCover+CountBottomCover;
CreateCoverAndry:=list;
end;

procedure TMDIChild.Graham(Sender: TObject);
var f:boolean;
w:plVertex;
begin
if (Count>1) then
begin
if (al=1) then
coverList:=CreateCover
else
coverList:=CreateCoverAndry;

coverList.current:=coverList.beginList;
w:=coverList.current.previos;
f:=false;
while ((CoverList.current.next<>CoverList.beginList) or (f=false)) do
begin
if (Coverlist.current.next=w)
then f:=true;
if (isAngleLeft(CoverList.current,CoverList.current.next,
CoverList.current.next.next))
then CoverList.current:=CoverList.current.next
else
begin
CoverList.DeleteVector(CoverList.current.next);
CoverList.current:=CoverList.current.previos;
end;
end;
coverList.current:=coverList.beginList;
repeat
coverList.current.used:=1;
coverList.current:=coverList.current^.next;
until coverList.current=coverList.beginList;
end;
end;

function TMDIChild.StillGraham(Sender: TObject):boolean;
begin
if (Count>1) then
if (not fstill) then
begin
if (al=1) then
coverList:=CreateCover
else
coverList:=CreateCoverAndry;

StillcoverListcurrent:=coverList.beginList;
w:=coverList.current.previos;
f:=false; fstill:=true;

coverList.current:=coverList.beginList;
repeat
coverList.current.used:=0;
coverList.current:=coverList.current^.next;
until coverList.current=coverList.beginList;
FormPaint(Sender);
end
else
begin
if ( (al = 2) and (StillCoverListcurrent^.next^.x = coverTop[countTopCover].x) and (StillCoverListcurrent^.next^.y = coverTop[countTopCover].y) ) then
StillGraham := true
else
StillGraham := false;

if ((StillCoverListcurrent^.next<>CoverList.beginList) or (f=false)) then
begin
if (StillCoverlistcurrent^.next=w)
then f:=true;
if (StillCoverListCurrent^.used=3) then
StillCoverListCurrent^.used:=2;
StillCoverListCurrent^.next^.used:=3;
StillCoverListCurrent^.next^.next.used:=3;
FormPaint(Sender);

if (isAngleLeft(StillCoverListcurrent,StillCoverListcurrent^.next,
StillCoverListcurrent^.next.next))
then
begin
StillCoverListcurrent:=StillCoverListcurrent^.next;
end
else
begin
CoverList.DeleteVector(StillCoverListcurrent^.next);
StillCoverListcurrent:=StillCoverListcurrent^.previos;
end;
end
else
begin
coverList.current:=coverList.beginList;
repeat
coverList.current.used:=1;
coverList.current:=coverList.current^.next;
until coverList.current=coverList.beginList;
FormPaint(Sender);
end;
end;
end;


procedure TMDIChild.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
zX:=zX+round((View.Width-BWidth)/2);
zY:=zY+round((View.Height-BHeight)/2);
ShiftX:=ShiftX+round((View.Width-BWidth)/2);
ShiftY:=ShiftY+round((View.Height-BHeight)/2);
BWidth:=View.Width; BHeight:=View.Height;
end;

procedure TMDIChild.SetAlgorithm(a:integer);
begin
al:=a;

if ( al = 1 ) then
MainForm.N3.Checked := true
else
MainForm.N4.Checked := true;

end;

procedure TMDIChild.ViewMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var XX,YY,XX2,YY2,tmp:integer;
begin
if Button=mbRight then
begin
RightBPressed:=false;
XX:=round((mouseX0-View.Width/2)/Scale+View.Width/2-ShiftX);
YY:=round((mouseY0-View.Height/2)/Scale+View.Height/2-ShiftY);
XX2:=round((X-View.Width/2)/Scale+View.Width/2-ShiftX);
YY2:=round((Y-View.Height/2)/Scale+View.Height/2-ShiftY);

if(XX > XX2) then
begin
tmp := XX2;
XX2 := XX;
XX :=tmp;
end;

if(YY > YY2) then
begin
tmp := YY2;
YY2 := YY;
YY :=tmp;
end;

RandForm.ShowModal;
if ((RandForm.ModalResult=1) and (RandForm.EditNumRND.Text<>'')) then
RandomVertex(StrToInt(RandForm.EditNumRND.Text), XX, YY, XX2, YY2);
FormPaint(Sender);
end;
end;

procedure TMDIChild.FormActivate(Sender: TObject);
begin
if ( al = 1 ) then
MainForm.N3.Checked := true
else
MainForm.N4.Checked := true;
end;

end.