p align="left"> begin CurNode:= CurNode^.YV; X1:= midX; Y1:= midY; end; end; //Собственно удаление------------------------------------------------------- N:= CurNode^.PointsCount; //Проверить, есть ли в массиве удаляемая точка: there:= false; for i:=1 to M do if (CurNode^.Points[i].X = Point.X)and(CurNode^.Points[i].Y = Point.Y) then begin there:= true; break; end; //Удаляем точку (либо выходим, если таковой не имеется) if there then begin CurNode^.Points[i]:= CurNode^.Points[N]; CurNode^.PointsCount:= CurNode^.PointsCount - 1; end else Exit; if Node^.Kind = nkLeaf then Exit; //Посмотрим, можно ли объединить соседние узлы numSZ:= ParentNode^.SZ^.PointsCount; numSV:= ParentNode^.SV^.PointsCount; numYZ:= ParentNode^.YZ^.PointsCount; numYV:= ParentNode^.YV^.PointsCount; PointsInNodes:= numSZ + numSV + numYZ + numYV; if PointsInNodes <= M then begin //Точки из всех листьев переносим в вышестоящий узел i:=1; CopyPoints(ParentNode^.SZ, DopArray, i); CopyPoints(ParentNode^.SV, DopArray, i); CopyPoints(ParentNode^.YZ, DopArray, i); CopyPoints(ParentNode^.YV, DopArray, i); //Удаляем старые листья Dispose(ParentNode^.SZ); Dispose(ParentNode^.SV); Dispose(ParentNode^.YZ); Dispose(ParentNode^.YV); ParentNode^.Kind:= nkLeaf; ParentNode^.Points:= DopArray; end; end; //УДАЛЕНИЕ ДЕРЕВА ============================================================ procedure ClearTree(var Node: PNode); begin if Node = nil then Exit; if Node^.Kind = nkBranch then begin ClearTree(Node^.SZ); ClearTree(Node^.SV); ClearTree(Node^.YZ); ClearTree(Node^.YV); end; Dispose(Node); Node:= nil; end; //ПОИСК ТОЧЕК В ЗАДАННОЙ ОБЛАСТИ ============================================= function Find(Node: PNode; const Bounds, Rect: TRect): TList; var NewBounds: TRect; i: integer; begin Result:= TList.Create; if Node = nil then Exit; with Bounds do if (X2 >= Rect.X1)and(X1 <= Rect.X2)and(Y2 >= Rect.Y1)and(Y1 <= Rect.Y2) then if Node^.Kind = nkBranch then begin NewBounds.X1:= X1; NewBounds.X2:= (X2 - X1)/2 + X1; NewBounds.Y1:= Y1; NewBounds.Y2:= (Y2 - Y1)/2 + Y1; Result.Assign(Find(Node^.SZ, NewBounds, Rect), laOr); NewBounds.X1:= (X2 - X1)/2 + X1; NewBounds.X2:= X2; NewBounds.Y1:= Y1; NewBounds.Y2:= (Y2 - Y1)/2 + Y1; Result.Assign(Find(Node^.SV, NewBounds, Rect), laOr); NewBounds.X1:= X1; NewBounds.X2:= (X2 - X1)/2 + X1; NewBounds.Y1:= (Y2 - Y1)/2 + Y1; NewBounds.Y2:= Y2; Result.Assign(Find(Node^.YZ, NewBounds, Rect), laOr); NewBounds.X1:= (X2 - X1)/2 + X1; NewBounds.X2:= X2; NewBounds.Y1:= (Y2 - Y1)/2 + Y1; NewBounds.Y2:= Y2; Result.Assign(Find(Node^.YV, NewBounds, Rect), laOr); end else begin for i:=1 to Node^.PointsCount do if (Node^.Points[i].X >= Rect.X1)and (Node^.Points[i].X <=Rect.X2)and (Node^.Points[i].Y >= Rect.Y1)and (Node^.Points[i].Y <= Rect.Y2) then Result.Add(@(Node^.Points[i])); end; end; end. unit UnitMainForm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, UnitModel, ComCtrls, Buttons; const Xmax = 1024; //ширина всего квадрата, отведенного под квадродерево type TMainForm = class(TForm) MaxImage: TImage; ShapeMax: TShape; MinImage: TImage; ShapeView: TShape; Shape3: TShape; LabelTop: TLabel; LabelLeft: TLabel; LabelRight: TLabel; LabelBottom: TLabel; StatusBar: TStatusBar; SBtnCursor: TSpeedButton; SBtnPoints: TSpeedButton; ButtonClear: TBitBtn; ButtonDelete: TBitBtn; procedure DrawPoint(const Point: TPoint; PointColor: TColor); procedure ClearBackground(Image: TImage); procedure DrawRegion(const Node: PNode; const Bounds: TRect); procedure ShapeViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ShapeViewMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ShapeViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure MaxImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure MaxImageClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ButtonClearClick(Sender: TObject); procedure ButtonDeleteClick(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private { Private declarations } public { Public declarations } end; var MainForm: TMainForm; implementation {$R *.dfm} const K = 10.56; //масштаб (MaxImage.Width/MinImage.Width) R = 3; //радиус точки на форме LightColor = clLime; //цвет подсветки точек SelectColor = clRed; //цвет выделенной точки BackColor = clWhite; //цвет фона var Tree: PNode; X0, Y0: integer; drag: boolean = false; //флажок перетаскивания окна просмотра PointCount: integer = 0; //число точек в дереве mainBounds, Query: TRect; //главный квадрант и окно просмотра LightPoint, SelectedPoint: TPoint; //Отрисовка точки ============================================================ procedure TMainForm.DrawPoint(const Point: TPoint; PointColor: TColor); var dopX, dopY: integer; begin //В большом окне... with Point do begin with MaxImage.Canvas do begin Brush.Color:= PointColor; Brush.Style:= bsSolid; Pen.Color:= PointColor; dopX:= round(X - Query.X1); dopY:= round(Y - Query.Y1); Ellipse(dopX-R, dopY-R, dopX+R, dopY+R); end; //...и в малом: with MinImage.Canvas do begin Brush.Color:= PointColor; Brush.Style:= bsSolid; Pen.Color:= PointColor; Ellipse(round(X/K)-1, round(Y/K)-1, round(X/K)+1, round(Y/K)+1); end; end; end; //"Очистка" фона ============================================================= procedure TMainForm.ClearBackground(Image: TImage); begin with Image.Canvas do begin Brush.Style:= bsSolid; Brush.Color:= BackColor; Rectangle(-1,-1,Image.Width + 1,Image.Height + 1); end; end; //Отрисовка просматриваемой области ========================================== procedure TMainForm.DrawRegion(const Node: PNode; const Bounds: TRect); var FindedPoints: TList; dopPoint: TPoint; i: integer; begin FindedPoints:= TList.Create; with FindedPoints do begin Assign(Find(Node, mainBounds, Bounds), laOr); if Capacity <> 0 then for i:= 0 to Count - 1 do begin dopPoint:= TPoint(FindedPoints[i]^); if (dopPoint.X = SelectedPoint.X)and(dopPoint.Y = SelectedPoint.Y) then DrawPoint(dopPoint, SelectColor) else DrawPoint(dopPoint, clBlack); end; Free; end; end; //Задание начальных координат областей и точек =============================== procedure TMainForm.FormCreate(Sender: TObject); begin with mainBounds do begin X1:= 0; Y1:= 0; X2:= Xmax; Y2:= Xmax; end; with Query do begin X1:= 0; Y1:= 0; X2:= MaxImage.Width; Y2:= MaxImage.Width; end; with LightPoint do begin X:= -4; Y:= -4; end; with SelectedPoint do begin X:= -3; Y:= -3; end; end; //НАВИГАЦИЯ В МАЛОМ ОКНЕ ===================================================== procedure TMainForm.ShapeViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin X0:= X; Y0:= Y; drag:= true; end; procedure TMainForm.ShapeViewMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin drag:= false; end; procedure TMainForm.ShapeViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var newLeft, newTop: integer; begin if drag then with Sender as TShape do begin newLeft:= Left + X - X0; newTop:= Top + Y - Y0; if newLeft + Width >= MinImage.Left + MinImage.Width + 1 then newLeft:= MinImage.Left + MinImage.Width + 1 - Width; if newLeft <= MinImage.Left - 1 then newLeft:= MinImage.Left - 1; Left:= newLeft; if newTop + Height >= MinImage.Top + MinImage.Height + 1 then newTop:= MinImage.Top + MinImage.Height + 1 - Height; if newTop <= MinImage.Top - 1 then newTop:= MinImage.Top - 1; Top:= newTop; //Границы просматриваемой области----------------------------------- Query.X1:= round((Left - MinImage.Left + 1)*K); Query.X2:= round((Left - MinImage.Left + Width + 1)*K); Query.Y1:= round((Top - MinImage.Top + 1)*K); Query.Y2:= round((Top - MinImage.Top + Height + 1)*K); LabelLeft.Caption:= FloatToStr(Query.X1); LabelRight.Caption:= FloatToStr(Query.X2); LabelTop.Caption:= FloatToStr(Query.Y1); LabelBottom.Caption:= FloatToStr(Query.Y2); ClearBackground(MaxImage); DrawRegion(Tree, Query); end; end; //Отображение координат точек в строке состояния ============================= procedure TMainForm.MaxImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var Point: TPoint; Rect: TRect; str: string[30]; List: TList; begin if SBtnCursor.Down then MaxImage.Cursor:= crDefault else MaxImage.Cursor:= crCross; with StatusBar do with MaxImage.Canvas do begin //Координаты указателя мыши Panels[0].Text := 'X: ' + FloatToStr(X + Query.X1); Panels[1].Text := 'Y: ' + FloatToStr(Y + Query.Y1); //Если указатель наведен на точку: if (Pixels[X,Y] = clBlack)or(Pixels[X,Y] = LightColor)or (Pixels[X,Y] = SelectColor) then begin Point.X:= X + Query.X1; Point.Y:= Y + Query.Y1; with Point do begin Rect.X1:= X - R; Rect.X2:= X + R; Rect.Y1:= Y - R; Rect.Y2:= Y + R; end; List:= TList.Create; List.Assign(Find(Tree, mainBounds, Rect), laOr); if List.Capacity <> 0 then begin Point:= TPoint(List[0]^); Panels[3].Text:= 'Точка ' + FloatToStr(Point.X) + '; ' + FloatToStr(Point.Y); //"Подсветка" точки---------------------------------------------- if Pixels[round(Point.X - Query.X1),round(Point.Y - Query.Y1)] <> LightColor then with LightPoint do begin if X >= 0 then if (X <> SelectedPoint.X)or(Y <> SelectedPoint.Y) then DrawPoint(LightPoint, clBlack) else DrawPoint(LightPoint, SelectColor); str:= StatusBar.Panels[3].Text; X:= StrToFloat(Copy(str, Pos(' ', str)+1, Pos(';', str)- Pos(' ', str)-1)); Y:= StrToFloat(Copy(str, Pos(';', str)+2, 10)); DrawPoint(LightPoint, LightColor); end; List.Free; end; end else //Долой "подсветку": with LightPoint do begin Panels[3].Text:= ''; if Tree = nil then Exit; if Pixels[round(X - Query.X1), round(Y - Query.Y1)] = LightColor then if (X = SelectedPoint.X)and(Y = SelectedPoint.Y) then DrawPoint(LightPoint, SelectColor) else DrawPoint(LightPoint, clBlack); end; end; end; //Клик по большому окну ====================================================== procedure TMainForm.MaxImageClick(Sender: TObject); var Point: TPoint; str: string[30]; i, j: integer; begin Point.X:= StrToInt(copy(StatusBar.Panels[0].Text, 4, 10)); Point.Y:= StrToInt(copy(StatusBar.Panels[1].Text, 4, 10)); if SBtnPoints.Down then //В режиме добавления точек ----------------------- begin //Добавление точки в дерево if InsertPoint(Tree, mainBounds, Point) then PointCount:= PointCount + 1; ClearBackground(MaxImage); ClearBackground(MinImage); //Перерисовка области просмотра DrawRegion(Tree, Query); DrawRegion(Tree, mainBounds); StatusBar.Panels[2].Text:= 'Количество точек: ' + IntToStr(PointCount); end else begin if (Point.X = SelectedPoint.X)and(Point.Y = SelectedPoint.Y) then Exit; i:= round(Point.X - Query.X1); j:= round(Point.Y - Query.Y1); with MaxImage.Canvas do begin if (Pixels[i,j] = LightColor)or(Pixels[i,j] = clBlack) then //"Запомнить" выбранную точку ------------------------------------- with SelectedPoint do begin str:= StatusBar.Panels[3].Text; if str = '' then Exit; if X >= 0 then DrawPoint(SelectedPoint, clBlack); X:= StrToFloat(Copy(str, Pos(' ', str)+1, Pos(';', str)-Pos(' ', str)-1)); Y:= StrToFloat(Copy(str, Pos(';', str)+2, 10)); StatusBar.Panels[4].Text:= 'Выбрано: ' + FloatToStr(X) + '; ' + FloatToStr(Y); DrawPoint(SelectedPoint, SelectColor); ButtonDelete.Enabled:= true; end; end; end; end; //Удаление точки ============================================================= procedure TMainForm.ButtonDeleteClick(Sender: TObject); begin DeletePoint(Tree, mainBounds, SelectedPoint); if (SelectedPoint.X >= Query.X1)and(SelectedPoint.X <= Query.X2)and (SelectedPoint.Y >= Query.Y1)and(SelectedPoint.Y <= Query.Y2) then begin SelectedPoint.X:= -3; LightPoint.X:= -4; ClearBackground(MaxImage); ClearBackground(MinImage); DrawRegion(Tree, mainBounds); end; PointCount:= PointCount - 1; StatusBar.Panels[4].Text:= ''; ButtonDelete.Enabled:= false; end; //Удаление дерева ============================================================ procedure TMainForm.ButtonClearClick(Sender: TObject); begin ClearTree(Tree); ClearBackground(MaxImage); ClearBackground(MinImage); DrawRegion(Tree, mainBounds); PointCount:= 0; with StatusBar do begin Panels[2].Text:= ''; Panels[3].Text:= ''; Panels[4].Text:= ''; end; SelectedPoint.X:= -3; LightPoint.X:= -4; StatusBar.Panels[4].Text:= ''; ButtonDelete.Enabled:= false; end; //Перемещение окошка с помощью клавиш ======================================== procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); const dif = 4; begin drag:= true; with ShapeView do begin X0:= Left + round(Width/2); Y0:= Top + round(Height/2); end; if Key = VK_UP then ShapeViewMouseMove(ShapeView, Shift, X0, Y0 - dif) else if Key = VK_DOWN then ShapeViewMouseMove(ShapeView, Shift, X0, Y0 + dif) else if Key = VK_LEFT then ShapeViewMouseMove(ShapeView, Shift, X0 - dif, Y0) else ShapeViewMouseMove(ShapeView, Shift, X0 + dif, Y0); drag:= false; end; end.
Страницы: 1, 2, 3, 4
|