Рисунок 4.15 - Пустой документ MS Visio

Рисунок 4.16 - Отрисованная карта

Причем элементы карты в процессе рисовки группируются таким образом, что в проводнике рисунков можно выбрать отдельно элемент карты и провести с ним какую-нибудь манипуляцию (см. Рисунок 4.17)

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

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

Целью курсовой работы являлось разработать приложение в среде Delphi, взаимодействующее с базами данных в СУБД Oracle, выполняющее визуализацию картографической информации о местности. В частности, на карте отображаются типы контуров карты, информация о местности и легенда карты.

В ходе выполнения курсовой работы были решены следующие задачи:

1) Проработана структура базы данных для визуализации картографической информации

2) Разработан алгоритм рисовки контуров карты

3) Разработан алгоритм отображения отдельных элементов карты

4) Разработан алгоритм для задания параметров каждому контуру карты

5) Разработан алгоритм сохранения картографической информации в XML-документе

6) Разработан алгоритм визуализации картографической информации в MS Visio на языке программирования Visual Basic

7) Налажена работа между приложением и СУБД Oracle.

Все задачи, поставленные на курсовое проектирование, выполнены полностью.

Список использованных источников

1 Архангельский, А.Я. Программирование в Delphi / А.Я. Архангельский М.: ООО «Бином-Пресс», 2003. - 1152 с.

2 Сухарев, М.В. Основы Delphi. Профессиональный подход/ М.В. Сухарев СПб.: Наука и Техника, 2004. - 600 с.

3 Кенту, М. Delphi 7. Для профессионалов/ М. Кенту СПб.: Питер, 2004. - 1101 с.

4 Архангельский, А.Я. Работа с локальными базами данных в Delphi 5/ А.Я. Архангельский М.: ЗАО «Издательство БИНОМ», 2000. - 192 с.

5 Архангельский, А.Я. Язык SQL в Delphi 5/ А.Я. Архангельский М.: ЗАО «Издательство БИНОМ», 2000. - 208 с.

6 Понамарев, В. Базы данных в Delphi 7. Самоучитель/ В. Понамарев СПб.: Питер, 2003. - 224 с.

7 Аллен, К. 101: Oracle PL/SQL / К. Ален М.: Издательство «Лори», 2001. - 369 с.

8 Луни, К., Брила, Б. 101: Oracle Database 10g Настольная книга администратора / К. Луни, Б. Брила М.: Издательство «Лори», 2008. - 729 с.

9 Клайн, К. SQL. Справочник. 2-е издание/ К. Клайн М.: КУДИЦ-ОБРАЗ, 2006. - 832 с.

10 Браун, С. Visual Basic 6. Учебный курс/ С. Браун СПб.: Питер, 2007. - 576 с.

Приложение А

В приложении А представлен исходный код разработанных функций и процедур в среде Delphi

procedure TFormMap.FormCreate(Sender: TObject);

begin

mfOrig:=TMetafile.Create;

GranImg:=TGranImg.Create;

DateTimeLoad.Date:=Today;

ListParamTypeLine:=TListParamTypeLine.Create(True);

DataModuleMap.ADODataSetMapSlv.Active:=True;

DataModuleMap.ADODataSetMapSlvm.Active:=True;

DataModuleMap.ADODataSetWellHdr.Active:=False;

ListNomSkv:=TStringList.Create;

ClearDataPanel;

end;

procedure TFormMap.FormDestroy(Sender: TObject);

begin

mfOrig.Free;

GranImg.Free;

DataModuleMap.ADODataSetLayerHdr.Active:=False;

DataModuleMap.ADODataSetMapSlv.Active:=False;

DataModuleMap.ADODataSetMapSlvm.Active:=False;

DataModuleMap.ADODataSetWellHdr.Active:=False;

ListParamTypeLine.Free;

ListNomSkv.Free;

end;

procedure TFormMap.DrawLabelToLine(koor : TKoor; ugol : Integer; str : String; var mc : TMetafileCanvas);

var

lf : TLogFont;

begin

if str<>'0' then

begin

FillChar(lf, SizeOf(lf), 0);

with lf do

begin

lfHeight := 60;

lfWidth := 30;

lfEscapement := ugol;

lfWeight := 0;

end;

mc.Font.Handle := CreateFontIndirect(lf);

mc.Font.Color:=clBlack;

mc.TextOut(koor.x,koor.y,str);

end;

end;

procedure TFormMap.AllShpToTextFile;

var

i : Integer;

begin

for i:=0 to ListParamTypeLine.Count-1 do

ShpToTextFile(i);

end;

procedure TFormMap.ShpToTextFile(i : Integer);

var

pShapefile : IShapefile;

pShape : IShape;

pTable : MapWinGis_TLB.ITable;

cb : ICallBack;

strX,strY, filename, znLine, filedbf : String;

j,m,q, numShapes : Integer;

koorX,koorY : Double;

f : TextFile;

typeLine : Integer;

begin

pShapefile:=CoShapefile.Create;

pTable:=MapWinGis_TLB.CoTable.Create;

typeLine:=ListParamTypeLine.GetTypeLine(i);

filename:=ListParamTypeLine.GetFullName(i);

filedbf:=ChangeFileExt(filename,'.dbf');

case typeLine of

-1,1..16:

begin

if ((typeLine=16) and (bSkv=True)) or (typeLine<>16) then

begin

if not pShapefile.Open(filename,cb) then

MessageBox(0,PChar('Не удалось открыть файл '+filename), 'Внимание',MB_OK or MB_ICONHAND)

else

if not pTable.Open(filename,cb) then

MessageBox(0,PChar('Не удалось открыть файл '+filedbf), 'Внимание',MB_OK or MB_ICONHAND)

else

begin

numShapes:=pShapefile.NumShapes;

filename:=ListParamTypeLine.GetFileName(i);

filename:=DirTempFolder+filename;

AssignFile(f,filename);

ReWrite(f);

Writeln(f,'FFASCI 0 1 "LINES" 0 1e+10');

Writeln(f,'FFATTR 0 1');

for j:=0 To numShapes-1 do

begin

pShape:=pShapefile.Shape[j];

Writeln(f,'->'+IntToStr(j+1));

znLine:=pTable.CellValue[0,j];

for q:=0 to pShape.numPoints-1 do

begin

koorX:=pShape.Point[q].x;

koorY:=pShape.Point[q].y;

StrX:=FloatToStr(koorX);

for m:=StrLen(PChar(StrX)) to 11 do

StrX:=StrX+' ';

StrY:=FloatToStr(koorY);

for m:=StrLen(PChar(StrY)) to 11 do

StrY:=StrY+' ';

Writeln(f,StrX,StrY,znLine);

end;

end;

CloseFile(f);

end;

pShapefile.Close;

end;

end;

end;

end;

function TFormMap.FileToHex(fname : String) : String;

var

fStream : TFileStream;

total,col_byte : Integer;

s : String;

Buf : array [1..100] of Char;

Buf2 : array [1..200] of Char;

begin

if not FileExists(fname) then

begin

ShowMessage('Ошибка открытия файла '+ fname);

Result:='';

end

else

begin

fStream:=TFileStream.Create(fname,fmOpenRead);

s:='';

total:=0;

col_byte:=100;

while total<fStream.Size do

begin

if fStream.Size-col_byte-total<0 then

col_byte:=fStream.Size-total;

fStream.Read(Buf,col_byte);

BinToHex(@Buf,@Buf2,col_byte);

s:=s+Copy(Buf2,1,col_byte*2);

total:=total+col_byte;

end;

fStream.Free;

Result:=s;

end;

end;

procedure TFormMap.LoadWmfToScr(filename : String);

var

k1 : Double;

mf : TMetafile;

mfc : TMetafileCanvas;

RectM : TRect;

begin

mf:=TMetafile.Create;

mf.LoadFromFile(filename);

mf.Width:=abs(mf.Width);

k1:=mf.Width/mf.Height;

RectM:=Rect(0,0,ImageWmf.Width,Round(ImageWmf.Width/k1));

mfOrig.Width:=ImageWmf.Width;

mfOrig.Height:=Round(ImageWmf.Width/k1);

mfc:=TMetafileCanvas.Create(mfOrig,0);

mfc.StretchDraw(RectM,mf);

mfc.Free;

mf.Free;

PanelImg.Height:=mfOrig.Height;

ImageWmf.Picture.Metafile:=mfOrig;

end;

function TFormMap.LoadShp(filename : String; kodmest : Integer; InnerCall : Boolean = False) : String;

begin

fileext:=ExtractFileExt(filename);

Self.Caption:='Загрузка карты';

kod_mest:=kodmest;

TypeAction:=taInsert;

cur_step:=1;

folder:=ExtractFilePath(filename);

if fileext='.apr' then

begin

GetInfoFromApr(filename);

GetInfoFromReadme;

end;

AddPanelToListTypeLine;

namewmf:=DirTempFolder+LEMapName.Text+'.wmf';

if not InnerCall then

StartDBParam;

StartTypeLine;

ParamPanelLabel;

ParamPanelLegend;

ReDrawAll;

ParamPanelLegend;

AllShpToTextFile;

FillTreeKont;

DataSourceMapSlv.DataSet.RecNo:=ListParamTypeLine.GetTypeLine(0);

if not InnerCall then

ShowModal;

Result:=StrXml;

end;

procedure TFormMap.FileSaveAs(oldName,newName : String);

var

fstream1, fstream2 : TFileStream;

begin

fstream1:=TFileStream.Create(oldName,fmOpenRead);

fstream2:=TFileStream.Create(newName,fmCreate);

fstream2.CopyFrom(fstream1,fstream1.Size);

fstream1.Free;

fstream2.Free;

end;

procedure TFormMap.ClearDataPanel;

var

iGuid : TGuid;

begin

CreateGuid(iGuid);

DirTempFolder:=DirTempFolder+GUIDToString(iGuid)+'\';

CreateDir(DirTempFolder);

DateTimeLoad.Date:=Today;

if DataModuleMap.DataSourceLayerHdr.DataSet.Active then

DataModuleMap.DataSourceLayerHdr.DataSet.First;

PanelLabel.Visible:=False;

PanelLegend.Visible:=False;

BBigImg.Enabled:=True;

BSmallImg.Enabled:=True;

TrackBarLabel.Position:=5;

TrackBarLegend.Position:=5;

FillComboBox;

end;

procedure TFormMap.TBLoadClick(Sender: TObject);

begin

if OpenDialogApr.Execute then

begin

ClearDataPanel;

LoadShp(OpenDialogApr.FileName,0,True);

end;

end;

function TFormMap.CheckOutputData : Boolean;

var

bCheck : Boolean;

begin

bCheck:=True;

If (Trim(LEMapName.Text)='') or

(Trim(LEAvtor.Text)='')

then

bCheck:=False;

Result:=bCheck;

end;

procedure TFormMap.TBSaveClick(Sender: TObject);

begin

if not CheckOutputData then

MessageBox(0,'Данные не корректны!','Внимание',MB_OK or MB_ICONSTOP)

else

begin

ReDrawAll;

PanelToTextFile;

AddAllParamToWmf(nameWmf);

MapToXml(nameWmf);

Close;

end;

end;

function TFormMap.GenerateIdm : String;

var

idm : TGuid;

strGuid : String;

pos1,i : Integer;

begin

CreateGuid(idm);

strGuid:=GUIDToString(idm);

strGuid:=Copy(strGuid,2,36);

for i:=0 to 3 do

begin

pos1:=Pos('-',strGuid);

strGuid:=Copy(strGuid,1,pos1-1)+Copy(strGuid,pos1+1,StrLen(PChar(strGuid))-pos1);

end;

Result:=strGuid;

end;

procedure TFormMap.BSmallImgClick(Sender: TObject);

var

k : Double;

begin

cur_step:=cur_step-step;

if not WmfZoom then

cur_step:=cur_step+step

else

begin

k:=cur_step/(cur_step+step);

DrawPanelLabel(k);

DrawPanelLegend(k);

end;

end;

procedure TFormMap.BBigImgClick(Sender: TObject);

var

k : Double;

begin

cur_step:=cur_step+step;

if not WmfZoom then

cur_step:=cur_step-step

else

begin

k:=cur_step/(cur_step-step);

DrawPanelLabel(k);

DrawPanelLegend(k);

end;

end;

procedure TFormMap.AddNameMapToWmf(var mfc : TMetafileCanvas; mfWidth, mfHeight : Integer);

var

s, maxStr : string;

i,x_new, y_new, maxSymbol, k, totalHeight, delX : Integer;

lf : TLogFont;

labeltmp : TLabel;

begin

x_new:=Round(mfWidth*(PanelLabel.Left/PanelImg.Width));

y_new:=Round(mfHeight*(PanelLabel.Top/PanelImg.Height));

maxSymbol:=0;

for i:=0 to ListLabelMap.Count-1 do

begin

s:=TLabelMap(ListLabelMap.Items[i]).Caption;

k:=StrLen(PChar(s));

if maxSymbol<k then

begin

maxSymbol:=k;

maxStr:=s;

end;

end;

totalHeight:=0;

labeltmp:=TLabel.Create(nil);

delX:=Round(mfWidth*PanelLabel.Width*0.5/PanelImg.Width);

for i:=0 to ListLabelMap.Count-1 do

begin

labeltmp.Font.Assign(TLabelMap(ListLabelMap.Items[i]).Font);

labeltmp.Caption:='H';

labeltmp.AutoSize:=True;

with lf do

begin

lfWidth := Round(mfWidth*(labeltmp.Width/PanelImg.Width));

lfHeight := Round(mfHeight*(labeltmp.Height/PanelImg.Height));

end;

mfc.Font.Handle := CreateFontIndirect(lf);

case TLabelMap(ListLabelMap.Items[i]).TypeLabel of

tlMest, tlMap, tlZaleg : mfc.Font.Style:=[fsBold];

tlMashtab : mfc.Font.Style:=mfc.Font.Style-[fsBold]-[fsItalic];

end;

mfc.TextOut(Round(x_new+delX-mfc.TextWidth(TLabelMap(ListLabelMap.Items[i]).Caption)/2),

y_new+totalHeight,

TLabelMap(ListLabelMap.Items[i]).Caption);

totalHeight:=totalHeight+mfc.TextHeight('H');

end;

labeltmp.Free;

ListLabelMap.Free;

end;

procedure TFormMap.SetListStr(var ListNameMap : TObjectList; s : string; TypeLabel : TTypeLabel);

var

num_total,len,pos1,num_str : integer;

s1,str : string;

begin

num_total:=0;

len:=StrLen(PChar(s));

pos1:=1;

while (num_total<=len-1) and (pos1>0) do

begin

num_str:=0;

str:='';

repeat

pos1:=Pos(' ', s);

s1:=Copy(s,1,pos1);

str:=str+s1;

s:=Copy(s,pos1+1,StrLen(PChar(s))-pos1);

num_str:=num_str+StrLen(PChar(s1));

if pos1=0 then

str:=str+s;

until (num_str>maxSymb) or (pos1=0);

num_total:=num_total+StrLen(PChar(str));

ListLabelMap.Add(TLabelMap.Create(nil));

TLabelMap(ListLabelMap.Last).Caption:=str;

TLabelMap(ListLabelMap.Last).TypeLabel:=TypeLabel;

end;

end;

function TFormMap.WmfZoom : Boolean;

var

mfCur : TMetafile;

mfc : TMetafileCanvas;

RectM : TRect;

begin

mfCur:=TMetafile.Create;

if (cur_step>=1) and (cur_step<=6*step) then

begin

mfCur.Width:=Round(mfOrig.Width*cur_step);

mfCur.Height:=Round(mfOrig.Height*cur_step);

RectM:=Rect(0,0,mfCur.Width,mfCur.Height);

mfc:=TMetafileCanvas.Create(mfCur,0);

mfc.StretchDraw(RectM,mfOrig);

mfc.Free;

PanelImg.Width:=mfCur.Width;

PanelImg.Height:=mfCur.Height;

ImageWmf.Picture.Metafile:=mfCur;

Result:=True;

end

else

Result:=False;

mfCur.Free;

end;

procedure TFormMap.DefineUgol(ListKoor : TObjectList; str : string;

var koor : TKoor; numstart : integer;

var ugol : Double);

var

rast,widthStr,heightStr,rastPred,rast1,rast2 : Double;

x,y,delX,delY,numBest,k,num1,num2 : integer;

mf : TMetafile;

mfc : TMetafileCanvas;

lf : TLogFont;

begin

mf:=TMetafile.Create; //определение ширины метки

mfc:=TMetafileCanvas.Create(mf,0);

FillChar(lf, SizeOf(lf), 0);

with lf do

begin

lfHeight := 60;

lfWidth := 30;

lfWeight := 0;

end;

mfc.Font.Handle := CreateFontIndirect(lf);

widthStr:=mfc.TextWidth(str);

heightStr:=mfc.TextHeight(str);

mfc.Free;

mf.Free;

k:=numStart;

rast:=0;

rastPred:=0;

while (rast<widthStr) and (k<ListKoor.Count-1) do

begin

Inc(k);

rastPred:=rast;

x:=TKoor(ListKoor.Items[k]).X;

y:=TKoor(ListKoor.Items[k]).Y;

rast:=sqrt(sqr(koor.x-x)+sqr(koor.y-y));

end;

if (rast-widthStr)>(widthStr-rastPred) then

begin

rast1:=rastPred;

num1:=k-1;

end

else

begin

rast1:=rast;

num1:=k;

end;

k:=numStart;

rast:=0;

while (rast<widthStr) and (k>0) do

begin

Dec(k);

rastPred:=rast;

x:=TKoor(ListKoor.Items[k]).x;

y:=TKoor(ListKoor.Items[k]).y;

rast:=sqrt(sqr(koor.x-x)+sqr(koor.y-y));

end;

if (rast-widthStr)>(widthStr-rastPred) then

begin

rast2:=rastPred;

num2:=k+1;

end

else

begin

rast2:=rast;

num2:=k;

end;

if abs(rast1-widthStr)>abs(rast2-widthStr) then

numBest:=num2

else

numBest:=num1;

x:=TKoor(ListKoor.Items[numBest]).x;

y:=TKoor(ListKoor.Items[numBest]).y;

if x-koor.x<>0 then

ugol:=ArcTan((koor.y-y)/(x-koor.x))

else

ugol:=0;

delY:=Round(heightStr/2*cos(ugol));

delX:=Round(heightStr/2*sin(ugol));

If x>koor.x Then

begin

koor.x := koor.x - delX;

koor.y := koor.y - delY;

end

Else

begin

koor.x := x - delX;

koor.y := y - delY;

end;

ugol:=ugol*180/Pi;

end;

procedure TFormMap.DrawElem(pShape : IShape;

startShp, endShp,typeLine : Integer;

var mc : TMetafileCanvas;

znLine : String);

var

numstart,predX, predY,x,y,j: integer;

ListKoor : TObjectList;

koor : TKoor;

ugol : Double;

begin

ListKoor:=TObjectList.Create(True);

predX :=Round(pShape.Point[startShp].x-GranImg.left);

predY :=Round(GranImg.bottom-pShape.Point[startShp].y);

ListKoor.Add(TKoor.Create(predX,predY));

for j:=startShp+1 to endShp-1 do

begin

x := Round(pShape.Point[j].x-GranImg.left);

y := Round(GranImg.bottom-pShape.Point[j].y);

ListKoor.Add(TKoor.Create(x,y));

ListParamTypeLine.DrawShape(mc,x,y,predX,predY);

predX:=x;

predY:=y;

end;

if typeLine=5 then

begin

numstart:=Round((endShp-startShp)/2)-1;

if numstart=0 then

numstart:=1;

koor:=TKoor.Create( TKoor(ListKoor.Items[numstart]).x,

TKoor(ListKoor.Items[numstart]).y);

DefineUgol(ListKoor,znLine,koor,numstart,ugol);

DrawLabelToLine(koor,Round(ugol*10),znLine,mc);

koor.Free;

end;

ListKoor.Free;

end;

procedure TFormMap.DrawElemEdit(pShape : IShape;

startShp, endShp,typeLine : Integer;

var mc : TMetafileCanvas;

znLine : String);

var

numstart,predX, predY,x,y,j: integer;

ListKoor : TObjectList;

koor : TKoor;

ugol : Double;

begin

ListKoor:=TObjectList.Create(True);

predX :=Round(pShape.Point[startShp].x-GranImg.left);

predY :=Round(GranImg.bottom-pShape.Point[startShp].y);

ListKoor.Add(TKoor.Create(predX,predY));

for j:=startShp+1 to endShp-1 do

begin

x := Round(pShape.Point[j].x-GranImg.left);

y := Round(GranImg.bottom-pShape.Point[j].y);

ListKoor.Add(TKoor.Create(x,y));

ListParamTypeLine.DrawShapeEdit(mc,x,y,predX,predY);

predX:=x;

predY:=y;

end;

if typeLine=5 then

begin

numstart:=Round((endShp-startShp)/2)-1;

if numstart=0 then

numstart:=1;

koor:=TKoor.Create( TKoor(ListKoor.Items[numstart]).x,

TKoor(ListKoor.Items[numstart]).y);

DefineUgol(ListKoor,znLine,koor,numstart,ugol);

DrawLabelToLine(koor,Round(ugol*10),znLine,mc);

koor.Free;

end;

ListKoor.Free;

end;

procedure TFormMap.DrawPanelLabel(k : Double=1);

var

i: integer;

maxWidth, totalHeight : integer;

begin

if ListLabelMap=nil then ListLabelMap:=TObjectList.Create(True);

ListLabelMap.Clear;

SetListStr(ListLabelMap,LEMest.Text, tlMest);

SetListStr(ListLabelMap,LEZaleg.Text, tlZaleg);

SetListStr(ListLabelMap,LEMapName.Text, tlMap);

ListLabelMap.Add(TLabelMap.Create(nil));

TLabelMap(ListLabelMap.Last).Caption:='Масштаб '+EdMashFir.Text+':'+EdMashSec.Text;

TLabelMap(ListLabelMap.Last).TypeLabel:=tlMashtab;

PanelLabel.Color:=clWhite;

PanelLabel.Top:=Round(PanelLabel.Top*k);

PanelLabel.Left:=Round(PanelLabel.Left*k);

for i:=0 to ListLabelMap.Count-1 do

begin

TLabel(ListLabelMap.Items[i]).Parent:=PanelLabel;

TLabel(ListLabelMap.Items[i]).Alignment:=taCenter;

TLabel(ListLabelMap.Items[i]).Left:=0;

TLabel(ListLabelMap.Items[i]).AutoSize:=True;

TLabel(ListLabelMap.Items[i]).Visible:=True;

TLabel(ListLabelMap.Items[i]).Enabled:=False;

case TLabelMap(ListLabelMap.Items[i]).TypeLabel of

tlMest:

begin

TLabel(ListLabelMap.Items[i]).Font.Size:=Round((18+delSizeLabel)*cur_step);

TLabel(ListLabelMap.Items[i]).Font.Style:=[fsBold];

end;

tlZaleg:

begin

TLabel(ListLabelMap.Items[i]).Font.Size:=Round((14+delSizeLabel)*cur_step);

TLabel(ListLabelMap.Items[i]).Font.Style:=[fsBold];

end;

tlMap:

begin

TLabel(ListLabelMap.Items[i]).Font.Size:=Round((12+delSizeLabel)*cur_step);

TLabel(ListLabelMap.Items[i]).Font.Style:=[fsBold];

end;

tlMashtab:

begin

TLabel(ListLabelMap.Items[i]).Font.Size:=Round((12+delSizeLabel)*cur_step);

TLabel(ListLabelMap.Items[i]).Font.Style:=

TLabel(ListLabelMap.Items[i]).Font.Style-[fsBold];

end;

end;

end;

maxWidth:=0;

totalHeight:=0;

for i:=0 to ListLabelMap.Count-1 do

begin

TLabel(ListLabelMap.Items[i]).Top:=totalHeight;

if maxWidth<TLabel(ListLabelMap.Items[i]).Width then