прога для геокодировки

[kyzia.ua]

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, Wininet, Jpeg, axCtrls, XPMan,
  ComCtrls, RXSpin, XMLDoc, XMLIntf, XmlDOM, msxmldom, Contnrs;

type
  TfmMain = class(TForm)
    Panel1: TPanel;
    btRefersh: TButton;
    XPManifest: TXPManifest;
    lbLatitude: TLabel;
    lbLongitude: TLabel;
    edLatitude: TRxSpinEdit;
    edLongitude: TRxSpinEdit;
    tbScale: TTrackBar;
    PageControl: TPageControl;
    tsMap: TTabSheet;
    tsReverseGeocoding: TTabSheet;
    ScrollBox: TScrollBox;
    Image: TImage;
    TreeView: TTreeView;
    XMLDocument: TXMLDocument;
    StatusBar: TStatusBar;
    tsGeocoding: TTabSheet;
    paSearch: TPanel;
    btSearch: TButton;
    lbSearch: TLabel;
    edSearch: TEdit;
    ListView: TListView;
    ScrollBoxGeocoding: TScrollBox;
    ImageGeocoding: TImage;
    procedure btRefershClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btSearchClick(Sender: TObject);
  private
    function DoGeocodingRequest(SearchString:String):TObjectList;
    procedure DoReverseGeocodingRequest(Latitude:Double;Longitude:Double);
    procedure FillGeocodingTree;
    procedure FillGeocodingListView(Points:TObjectList);
  public
    { Public declarations }
  end;

  TMapPoint=class
  public
    Lat:Double;
    Lon:Double;
    Address:String;
  end;

var
  fmMain: TfmMain;

implementation

{$R *.dfm}

procedure TfmMain.FormCreate(Sender: TObject);
begin
  DecimalSeparator:='.';
  btRefersh.Click;
end;

// îòïðàâêà çàïðîñà è ïîëó÷åíèå îòâåòà
function GetInetFile(const FileURL:String; Stream:TMemoryStream): boolean;
const
  BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of Byte;
  BufferLen: DWORD;
  sAppName: string;
  Utf8FileUrl:UTF8String; // Ãóãë ïðèíèìàåò è îòäàåò UTF8 êîäèðîâêó!!!
  Headers:String;
begin
  // ïåðåâîäèì â ïðèíèìàåìóþ Ãóãëåì êîäèðîâêó
  Utf8FileUrl:=AnsiToUtf8(FileURL);
  sAppName:= ExtractFileName(Application.ExeName);
  hSession:= InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);
  try
    // ðàññêàçûâåì Ãóãëþ, ÷òî ðóññêèå ìû
    Headers:='Accept-Language: ru';
    hURL := InternetOpenURL(hSession,PChar(Utf8FileUrl),PChar(Headers),Length(Headers),0,0);
    try
      Stream.Clear;
      repeat
        InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen);
        Stream.Write(Buffer,BufferLen);
      until BufferLen = 0;
      Result:=True;
    finally
      InternetCloseHandle(hURL)
    end;
  finally
    InternetCloseHandle(hSession)
  end;
end;

// çàìåíà äàííûõ â ïîòîêå ñ êîäèðîâêè 1251 íà UTF-8
function StreamToUtf8Stream(Stream:TStream):UTF8String;
var
  s:String;
begin
  SetLength(s,Stream.Size);
  Stream.Seek(0,0);
  Stream.Read(s[1],Stream.Size);
  Result:=AnsiToUtf8(s);
  Stream.Size:=0;
  Stream.Write(Result[1],Length(Result));
end;

// ïîëó÷åíèå êàðòû ñ çàäàííûì öåíòðîì, ìàñøòàáîì è ñ ìàðêåðîì â öåíòðå
function GetMap(Latitude:Double;Longitude:Double;Scale:Integer):TOleGraphic;overload;
var
  FileOnNet: String;
  Stream:TMemoryStream;
begin
  // ñîçäàåì ïîòîê
  Stream:=TMemoryStream.Create;
  try
    // ôîðìèðóåì url äëÿ çàïðîñà
    FileOnNet:='http://maps.google.com/staticmap?center=%.6f,%.6f&zoom=%d&size=640x640'
      +'&markers=%.6f,%.6f,blues'
      +'&maptype=mobile&key=MAPS_API_KEY';
    FileOnNet:=Format(FileOnNet,[Latitude,Longitude,Scale,Latitude,Longitude]);
    // ïîëó÷åíèå ïîòîêà ñ äàííûìè îòâåòà
    if GetInetFile(FileOnNet,Stream) = True then begin
      // ñîçäàåì ãðàôè÷åñêèé îáúåêò
      Stream.Position:=0;
      Result:=TOleGraphic.Create;
      Result.LoadFromStream(Stream);
    end else
      Result:=nil;
  finally
    Stream.Free;
  end;
end;

[kyzia.ua]

// ïîëó÷åíèå êàðòû ñî ñïèñêîì òî÷åê
function GetMap(Points:TObjectList):TOleGraphic;overload;
var
  FileOnNet: String;
  Stream:TMemoryStream;
  Markers:String;
  i:Integer;
  Point:TMapPoint;
begin
  // ïðîâåðÿåì íàëè÷èå òî÷åê
  if Points.Count<1 then begin
    Result:=nil;
    Exit;
  end;
  Markers:='';
  // ôîðìèðóåì ñïèñîê ìàðêåðîâ
  for i:=0 to Points.Count-1 do
    if (Points[i] is TMapPoint) then begin
      Point:=TMapPoint(Points[i]);
      Markers:=Markers+Format('%.6f,%.6f|',[Point.Lat,Point.Lon]);
    end;
  // ñîçäàåì ïîòîê
  Stream:=TMemoryStream.Create;
  try
    // ôîðìèðóåì url äëÿ çàïðîñà
    FileOnNet:='http://maps.google.com/staticmap?size=640x640'
      +'&markers=%s'
      +'&maptype=mobile&key=MAPS_API_KEY';
    FileOnNet:=Format(FileOnNet,[Markers]);
    // ïîëó÷åíèå ïîòîêà ñ äàííûìè îòâåòà
    if GetInetFile(FileOnNet,Stream) = True then begin
      // ñîçäàåì ãðàôè÷åñêèé îáúåêò
      Stream.Position:=0;
      Result:=TOleGraphic.Create;
      Result.LoadFromStream(Stream);
    end else
      Result:=nil;
  finally
    Stream.Free;
  end;
end;
// îáðàáîòêà íàæàòèÿ êíîïêè "Îáíîâèòü"
procedure TfmMain.btRefershClick(Sender: TObject);
var
  OleGraphic: TOleGraphic;
begin
  // ïîëó÷àåì èçîáðàæåíèå
  OleGraphic:=GetMap(edLatitude.Value,edLongitude.Value,tbScale.Position);
  if OleGraphic<>nil then begin
    // ïåðåäàåì èçîáðàæåíèå íà Image
    Image.Picture.Assign(OleGraphic);
    OleGraphic.Free;
  end;
  DoReverseGeocodingRequest(edLatitude.Value,edLongitude.Value);
end;

// íàæàòèå êíîïêè ïîèñêà ãåîêîäèíãà
procedure TfmMain.btSearchClick(Sender: TObject);
var
  SearchString:String;
  Points:TObjectList;
  OleGraphic: TOleGraphic;
begin
  SearchString:=StringReplace(Trim(edSearch.Text),' ','+',[rfReplaceAll	]);
  Points:=DoGeocodingRequest(SearchString);
  try
    if Points.Count>0 then begin
      // çàïîëíåíèå ñïèñêà òî÷åê
      FillGeocodingListView(Points);
      // çàïðîñ êàðòû
      OleGraphic:=GetMap(Points);
      if OleGraphic<>nil then begin
        // ðèñóåì êàðòó
        ImageGeocoding.Picture.Assign(OleGraphic);
        OleGraphic.Free;
      end;
    end;
  finally
    Points.Free;
  end;
end;

// ïîëó÷åíèå ñïèñêà òî÷åê ïî çàïðîñó
function TfmMain.DoGeocodingRequest(SearchString:String):TObjectList;
var
  Point:TMapPoint;
  FileOnNet:String;
  Stream:TMemoryStream;
  Utf8Content:UTF8String;
  Node:IXMLNode;
  PlacemarkNode, PointNode, AddressNode:IXMLNode;
  i:Integer;
  sCoordinates:String;
  StringList:TStringList;
begin
  // ñîçäàåì õðàíèëèùå ðåçóëüòàòîâ
  Result:=TObjectList.Create(True);
  // ñîçäàåì ïîòîê
  Stream:=TMemoryStream.Create;
  StringList:=TStringList.Create;
  try
    // ôîðìèðóåì url äëÿ çàïðîñà
    FileOnNet:='http://maps.google.com/maps/geo?q=%s&output=xml&key=abcdefg&gl=ru';
    FileOnNet:=Format(FileOnNet,[SearchString]);
    // ïîëó÷åíèå ïîòîêà ñ äàííûìè îòâåòà
    if GetInetFile(FileOnNet,Stream) = True then begin
      // êîìó íàäî - ðàññêîìåíòèðîâàòü è ñìîòðåòü ñîäåðæèìîå ïðè îòëàäêå
      //Stream.SaveToFile('c:\geo.xml');

      StreamToUtf8Stream(Stream);
      // çàïîëíÿåì XMLDocument
      XMLDocument.LoadFromStream(Stream);
      // ôîðìèðóåì ñîäåðæèìîå ñïèñêà òî÷åê
      Node:=XMLDocument.DocumentElement;
      Node:=Node.ChildNodes.FindNode('Response');
      if (Node<>nil) and (Node.ChildNodes.Count>0) then
        for i:=0 to Node.ChildNodes.Count-1 do
          if Node.ChildNodes[i].NodeName='Placemark' then begin
            // íàõîäèì óçåë òî÷êè
            PlacemarkNode:=Node.ChildNodes[i];
            // ïîëó÷àåì óçåë àäðåñà
            AddressNode:=PlacemarkNode.ChildNodes.FindNode('address');
            //ïîëó÷àåì óçåë êîîðäèíàò
            PointNode:=PlacemarkNode.ChildNodes.FindNode('Point');
            PointNode:=PointNode.ChildNodes.FindNode('coordinates');
            if (AddressNode<>nil) and (PointNode<>nil) then begin
              Point:=TMapPoint.Create;
              // ïîëó÷àåì àäðåñ
              Point.Address:=AddressNode.Text;
              // ïîëó÷àåì êîîðäèíàòû
              sCoordinates:=PointNode.Text;
              // ðàçáèðàåì êîîðäèíàòû
              ExtractStrings([','],[],PChar(sCoordinates),StringList);
              if StringList.Count>1 then begin
                // Ôîðìèðóåì òî÷êó
                Point.Lon:=StrToFloatDef(StringList[0],-1);
                Point.Lat:=StrToFloatDef(StringList[1],-1);
                // äîáàâëÿåì òî÷êó â ñïèñîê 
                if (Point.Lat<>-1) and (Point.Lon<>-1) then
                  Result.Add(Point);
                StringList.Clear;
              end else
                Point.Free;
            end;
          end;
    end;
  finally
    StringList.Free;
    Stream.Free;
  end;
end;

[kyzia.ua]

// çàïîëíåíèå ListView ñî ñïèñêîì òî÷åê
procedure TfmMain.FillGeocodingListView(Points:TObjectList);
var
  i:Integer;
  Item:TListItem;
  Point:TMapPoint;
begin
  ListView.Items.BeginUpdate;
  try
    ListView.Items.Clear;
    if Points.Count>0 then
      for i:=0 to Points.Count-1 do
        if (Points[i] is TMapPoint) then begin
          Point:=TMapPoint(Points[i]);
          Item:=ListView.Items.Add;
          Item.Caption:=Point.Address;
          Item.SubItems.Text:=Format('%.6f'#13#10'%.6f',[Point.Lat,Point.Lon]);
        end;
  finally
    ListView.Items.EndUpdate;
  end;
end;

// çàïðîñ îáðàòíîãî ãåîêîäèðîâàíèÿ
procedure TfmMain.DoReverseGeocodingRequest;
var
  FileOnNet: String;
  Stream:TMemoryStream;
begin
  // ñîçäàåì ïîòîê
  Stream:=TMemoryStream.Create;
  try
    // ôîðìèðóåì url äëÿ çàïðîñà
    FileOnNet:='http://maps.google.com/maps/geo?ll=%.6f,%.6f&output=xml&key=abcdefg&gl=ru';
    FileOnNet:=Format(FileOnNet,[Latitude,Longitude]);
    // ïîëó÷åíèå ïîòîêà ñ äàííûìè îòâåòà
    if GetInetFile(FileOnNet,Stream) = True then begin
      StreamToUtf8Stream(Stream);
      // çàïîëíÿåì XMLDocument
      XMLDocument.LoadFromStream(Stream);

      // îòîáðàæàåì íà äåðåâî
      FillGeocodingTree;
    end;
  finally
    Stream.Free;
  end;
end;

// çàïîëíÿåì äåðåâî ïî XMLDocument
procedure TfmMain.FillGeocodingTree;

  procedure FillNode(Node:IXMLNode;ParentNode:TTreeNode);
  var
    i:Integer;
    TreeNode:TTreeNode;
    NodeText:String;
  begin
    NodeText:='';

    if Node.IsTextElement then
      NodeText:=Node.NodeName+'='+Node.Text
    else
      NodeText:=Node.NodeName;

    TreeNode:=TreeView.Items.AddChild(ParentNode,NodeText);
    if (Node.ChildNodes<>nil) and (Node.ChildNodes.Count>0) then
      for i:=0 to Node.ChildNodes.Count-1 do begin
        FillNode(Node.ChildNodes.Nodes[i],TreeNode);
        // ñàìûé ïåðâûé àäðåñ íàèáîëåå ïîäðîáíûé, áåðåì åãî
        if (StatusBar.SimpleText='') and (Node.NodeName='address') then
          StatusBar.SimpleText:=Node.Text;
      end;
  end;

var
  Node:IXMLNode;
begin
  StatusBar.SimpleText:='';
  TreeView.Items.BeginUpdate;
  try
    TreeView.Items.Clear;

    Node:=XMLDocument.DocumentElement;

    FillNode(Node,nil);

    if TreeView.Items.Count>0 then begin
      TreeView.Items[0].Expand(False);
      if TreeView.Items.Count>1 then
        TreeView.Items[1].Expand(False);

      TreeView.Items[0].Selected:=True;
    end;

  finally
    TreeView.Items.EndUpdate;
  end;
end;

end.

помогите разобратца почему не работает

[evg_m]

1. при написании кода использовать #.
2. для больших объемов использовать вложения (расширенный режим редактора).
3. при формировании вложения (желательно архив) почисти архив от "мусора" (*.~*; *.exe; *.dcu).
4. Указывать конкретную проблему, желаемые результаты и тестовые данные.

[Stilet]

А какие ошибки выдает и на какой строке?

[kyzia.ua]

Сообщение от Stilet

А какие ошибки выдает и на какой строке?

клас trxspinedit not found
ну и всё что связано с trxspin

[Аватар]

Это компонент из RX. Для D7 я качал его из сети. В uses нет ссылки

[kyzia.ua]

Сообщение от Аватар

Это компонент из RX. Для D7 я качал его из сети. В uses нет ссылки

извини за глупый вопрос но куда нужно его установить, в какой каталог

[Аватар]

Это когдато писал для себя для D4, для D7 аналогично (возможно с help-ами чтото не так)

   10.3. H:\Setup\10_Delphi4Add\RXLIB.275\RXINST.EXE - инсталяция RxLib
         H:\Setup\10_Delphi4Add\RXLib.275\HELP\RXFULL.HLP скопировать в
           C:\Program Files\Borland\Delphi4\Help
         H:\Setup\10_Delphi4Add\RXLib.275\HELP\RXFULL.CNT скопировать в
           C:\Program Files\Borland\Delphi4\Help
         В конец C:\Program Files\Borland\Delphi4\Help\delphi4.cfg добавить
           :Link RXFULL.HLP
         В конец C:\Program Files\Borland\Delphi4\Help\delphi4.cnt добавить
           :Include RXFULL.CNT
         Для C:\Program Files\Borland\Delphi4\RX\Units\RXCTL4.DPK в DELPHI4
           выполнить Compile
         Для C:\Program Files\Borland\Delphi4\RX\Units\RXDB4.DPK в DELPHI4
           выполнить Compile
         C:\Program Files\Borland\Delphi4\RX\Units\RXCTL4.BPL скопировать в
           C:\WIN2000\system32
         C:\Program Files\Borland\Delphi4\RX\Units\RXDB4.BPL скопировать в
           C:\WIN2000\system32
         Для C:\Program Files\Borland\Delphi4\RX\Units\DCLRX4.DPK в DELPHI4
           выполнить Compile и Install 
         Для C:\Program Files\Borland\Delphi4\RX\Units\DCLRXDB4.DPK в DELPHI4
           выполнить Compile и Install

[Аватар]

Вот нашел для D7:

5. H:\Setup\Delphi7Add\RX скопировать в
     E:\Program Files\Borland\Delphi7
   H:\Setup\Delphi7Add\RX\HELP\RXD6.HLP скопировать в
     E:\Program Files\Borland\Delphi7\Help
   H:\Setup\Delphi7Add\RX\HELP\RXD6.CNT скопировать в
     E:\Program Files\Borland\Delphi7\Help
   H:\Setup\Delphi7Add\RX\HELP\RXD6.TOC скопировать в
     E:\Program Files\Borland\Delphi7\Help
   В Library Path добавить:
     $(DELPHI)\RX\UNITS
   Для E:\Program Files\Borland\Delphi7\RX\Units\RXCTL7.DPK в DELPHI7
      выполнить Compile
   Для E:\Program Files\Borland\Delphi7\RX\Units\RXDB7.DPK в DELPHI7
      выполнить Compile
   Для E:\Program Files\Borland\Delphi7\RX\Units\RXBDE7.DPK в DELPHI7
      выполнить Compile
   E:\Program Files\Borland\Delphi7\RX\Units\RXCTL7.BPL скопировать в
     C:\WIN2000\system32
   E:\Program Files\Borland\Delphi7\RX\Units\RXDB7.BPL скопировать в
     C:\WIN2000\system32
   E:\Program Files\Borland\Delphi7\RX\Units\RXBDE7.BPL скопировать в
     C:\WIN2000\system32
   Для E:\Program Files\Borland\Delphi7\RX\Units\DCLRX7.DPK в DELPHI7
      выполнить Compile и Install 
   Для E:\Program Files\Borland\Delphi7\RX\Units\DCLRXDB7.DPK в DELPHI7
      выполнить Compile и Install 
   Для E:\Program Files\Borland\Delphi7\RX\Units\DCLRXBD7.DPK в DELPHI7
      выполнить Compile и Install