earthmap.pas

想在DELPHI中应用GoogleMap吗

procedure TEarthMap.CMExit(var Msg: TCMExit);
begin
  inherited;
end;

constructor TEarthMap.Create(AOwner: TComponent);
var
  Bitmap: TBitmap;
begin
  inherited Create(AOwner);
  DoubleBuffered := True;
  TabStop := True;     //可以是控件获得焦点信息，从而可以接收滚轴消息
  FWinWidth := 512;
  FWinHeight := 512;
  Width := FWinWidth;
  Height := FWinHeight;
  FImage := TImage.Create(Self);
  FImage.Parent := Self;
  FImage.AutoSize := True;
  FImage.Cursor := crCross;
  FImage.OnMouseDown := OmImgMouseDown;
  FImage.OnMouseMove := OnImgMouseMove;
  Bitmap := TBitmap.Create;
  FImage.Picture.Graphic := Bitmap;
  Bitmap.Free;
  FDefMap := TBitmap.Create;
  FDefMap.Width := 256;
  FDefMap.Height := 256;
  FDefMap.Canvas.Pen.Color := clSkyBlue;
  FDefMap.Canvas.Brush.Style := bsClear;
  FDefMap.Canvas.Rectangle(0, 0, 256, 256);
  FDefMap.Canvas.Font.Color := clSkyBlue;
  FDefMap.Canvas.Font.Style := [fsBold];
  FDefMap.Canvas.TextOut(10, 10, 'Loading...');
  MapZoom := 0;
  FMapRect.Left := 0;
  FMapRect.Top := 0;
  FMapRect.Right := 0;
  FMapRect.Bottom := 0;
  FMapVector.X := (Width - CMapWidth) div 2;
  FMapVector.Y := (Height - CMapHeight) div 2;
  FMapPath := ExtractFilePath(GetModuleName(HInstance)) + 'FileMap\';
  FMapURL := CMapURL;
  FProxy.Proxy := False; 
  FGetThread := TGetThread.Create;
  FGetThread.FEarthMap := Self;
  FGetThread.MapPath := FMapPath;
  FGetThread.MapURL := FMapURL;
  FGetThread.Proxy := FProxy;
  DrawMap;
end;

procedure TEarthMap.CursorToMap(AMouse: TPoint; var x, y: Integer);
begin
  x := AMouse.X div CMapWidth + FMapRect.Left;
  y := AMouse.Y div CMapHeight + FMapRect.Top;
end;

destructor TEarthMap.Destroy;
begin
  FImage.Free;
  FGetThread.Terminate;
  FGetThread.Free;
end;

function TEarthMap.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
var
  IsNeg: Boolean;
begin
  Result := False;
  if csDesigning in ComponentState then Exit;
  if Assigned(OnMouseWheel) then
    OnMouseWheel(Self, Shift, WheelDelta, MousePos, Result);
  if not Result then
  begin
    if WheelDelta > 0 then
      Result := DoMouseWheelUp(Shift, MousePos)
    else
      Result := DoMouseWheelDown(Shift, MousePos);
  end;
end;

function TEarthMap.DoMouseWheelDown(Shift: TShiftState;
  MousePos: TPoint): Boolean;
var
  ImgMousePos: TPoint;
  xMap, yMap, xMouse, yMouse, xLeft, yTop: Integer;
begin
  inherited DoMouseWheelDown(Shift, MousePos);
  Result := True; //防止两次触发消息
  GetCursorPos(MousePos);
  MousePos := Self.ScreenToClient(MousePos);
  if MapZoom = 0 then Exit;   //如果是最小的则不缩小
  ImgMousePos.X := MousePos.X - FImage.Left;
  ImgMousePos.Y := MousePos.Y - FImage.Top;
  if ((ImgMousePos.X < 0) or (ImgMousePos.X > FImage.Width)) or
     ((ImgMousePos.Y < 0) or (ImgMousePos.Y > FImage.Height)) then  //如果超出范围，则取中间点
  begin
    ImgMousePos.X := FImage.Width div 2 - 1;
    ImgMousePos.Y := FImage.Height div 2 - 1;
  end;
  //获得地图参数
  CursorToMap(ImgMousePos, xMap, yMap);
  xMouse := (ImgMousePos.X + FMapRect.Left * CMapWidth) mod (CMapWidth*2);
  yMouse := (ImgMousePos.Y + FMapRect.Top * CMapHeight) mod (CMapHeight*2);
  xLeft := FMapVector.X + (xMap - xMap mod 2 - FMapRect.Left)*CMapWidth;
  yTop := FMapVector.Y + (yMap - yMap mod 2 - FMapRect.Top)*CMapHeight;
  //获得缩小后的地图参数
  MapZoom := MapZoom - 1;
  FMapRect.Left := xMap div 2;
  FMapRect.Top := yMap div 2;
  FMapRect.Right := xMap div 2;
  FMapRect.Bottom := yMap div 2;
  FMapVector.X := xLeft + xMouse div 2;
  FMapVector.Y := yTop + yMouse div 2;
//  FMapVector.X := FMapVector.X + xMouse div 2;
//  FMapVector.Y := FMapVector.Y + yMouse div 2;
  StrechMap;
  DrawMap;
end;

function TEarthMap.DoMouseWheelUp(Shift: TShiftState;
  MousePos: TPoint): Boolean;
var
  ImgMousePos: TPoint;
  xMap, yMap, xMouse, yMouse, xLeft, yTop: Integer;
begin
  inherited DoMouseWheelUp(Shift, MousePos);
  Result := True;  //防止两次触发消息
  GetCursorPos(MousePos);
  MousePos := Self.ScreenToClient(MousePos);
  if MapZoom = 17 then Exit; //如果是最大的则不放大
  ImgMousePos.X := MousePos.X - FImage.Left;
  ImgMousePos.Y := MousePos.Y - FImage.Top;
  if ((ImgMousePos.X < 0) or (ImgMousePos.X > FImage.Width)) or
     ((ImgMousePos.Y < 0) or (ImgMousePos.Y > FImage.Height)) then  //如果超出范围，则取中间点
  begin
    ImgMousePos.X := FImage.Width div 2 - 1;
    ImgMousePos.Y := FImage.Height div 2 - 1;
  end;
  //获得地图参数
  CursorToMap(ImgMousePos, xMap, yMap);
  xMouse := ImgMousePos.X mod CMapWidth;
  yMouse := ImgMousePos.Y mod CMapHeight;
  xLeft := FMapVector.X + (xMap - FMapRect.Left)*CMapWidth;
  yTop := FMapVector.Y + (yMap - FMapRect.Top) * CMapHeight;
  //获得放大后的地图参数
  MapZoom := MapZoom + 1;
  FMapRect.Left := xMap * 2;
  FMapRect.Top := yMap * 2;
  FMapRect.Right := xMap * 2 + 1;
  FMapRect.Bottom := yMap * 2 + 1;
  FMapVector.X := xLeft - xMouse;
  FMapVector.Y := yTop - yMouse;
  StrechMap;
  DrawMap;
end;

procedure TEarthMap.DrawMap;
var
  BmpMap: TBitmap;
  i, j, xInv, yInv: Integer;
begin
  BmpMap := TBitmap.Create;
  try
    BmpMap.Width := (FMapRect.Right - FMapRect.Left + 1) * CMapWidth;
    BmpMap.Height := (FMapRect.Bottom - FMapRect.Top + 1) * CMapHeight;
    for i := FMapRect.Top to FMapRect.Bottom do    //画图
    begin
      for j := FMapRect.Left to FMapRect.Right do
      begin
        DrawOneMap(MapZoom, j, i, BmpMap);
      end;
    end;
    //调整图的位置
    FImage.Picture.Graphic := BmpMap;
    xInv := FMapVector.X - FImage.Left;
    yInv := FMapVector.Y - FImage.Top;
    ScrollBy(xInv, yInv); 
//    FImage.Left := FMapVector.X;
//    FImage.Top := FMapVector.Y;
  finally
    BmpMap.Free;
  end;
end;

procedure TEarthMap.DrawOneMap(const AZoom, AX, AY: Integer; var ABmp: TBitmap);
var
  GraphicClass: TGraphicExGraphicClass;
  Graphic: TGraphic;
  sFileName: string;
  iLeft, iTop, Zoom, x, y: Integer;
  BmpZoom: TBitmap;
  DestRect, SrcRect: TRect;
begin
  sFileName := FMapPath + Format(CMapFile, [AZoom, AX, AY]);
  try
    iLeft := (AX - FMapRect.Left) * CMapWidth;
    iTop := (AY - FMapRect.Top) * CMapHeight;
    if FileExists(sFileName) and FGetThread.CheckFileHeader(sFileName) then            //如果存在则直接画
    begin
      try
        GraphicClass := FileFormatList.GraphicFromContent(sFileName);
        Graphic := GraphicClass.Create;
        Graphic.LoadFromFile(sFileName);
        ABmp.Canvas.Draw(iLeft, iTop, Graphic);
      finally
        if Graphic <> nil then FreeAndNil(Graphic);
      end;
    end
    else                                     //如果不存在则找下一级放大的图片画 
    begin
      if not (csDesigning in ComponentState) then
        FGetThread.AddTask(AZoom, AX, AY);
      Zoom := AZoom - 1;
      x := AX div 2;
      y := AY div 2;
      sFileName := FMapPath + Format(CMapFile, [Zoom, x, y]);
      if FileExists(sFileName) then
      begin
        try
          GraphicClass := FileFormatList.GraphicFromContent(sFileName);
          Graphic := GraphicClass.Create;
          Graphic.LoadFromFile(sFileName);
          BmpZoom := TBitmap.Create;
          BmpZoom.Width := 2*CMapWidth;
          BmpZoom.Height := 2*CMapHeight;
          BmpZoom.Canvas.StretchDraw(Rect(0, 0, 2*CMapWidth, 2*CMapHeight), Graphic);  //放大
          DestRect.Left := iLeft+1;
          DestRect.Top := iTop+1;
          DestRect.Right := DestRect.Left + CMapWidth - 1;
          DestRect.Bottom := DestRect.Top + CMapHeight - 1;
          SrcRect.Left := (AX mod 2) * CMapWidth;
          SrcRect.Top := (AY mod 2) * CMapHeight;
          SrcRect.Right := SrcRect.Left + CMapWidth - 1;
          SrcRect.Bottom := SrcRect.Top + CMapHeight - 1;
          ABmp.Canvas.CopyRect(DestRect, BmpZoom.Canvas, SrcRect);  //然后复制放大之后的区域
        finally
          if Graphic <> nil then FreeAndNil(Graphic);
          if BmpZoom <> nil then FreeAndNil(BmpZoom);
        end;
      end
      else
        ABmp.Canvas.Draw(iLeft, iTop, FDefMap);
    end;
  except
    on E: Exception do ;
  end;
end;

procedure TEarthMap.SetMapZoom(AZoom: TMapZoom);
begin
  if FMapZoom <> AZoom then
  begin
    FMapZoom := AZoom;
    if Assigned(FOnMapZoomChange) then FOnMapZoomChange(Self, FMapZoom);
  end;
end;

procedure TEarthMap.SetProxy(AProxy: TProxy);
begin
  if (AProxy.Proxy <> FProxy.Proxy) or (not SameText(AProxy.Host, FProxy.Host))
    or (not SameText(AProxy.Port, FProxy.Port)) then
  begin
    FProxy := AProxy;
    FGetThread.Proxy := AProxy;
  end;
end;

function TEarthMap.StrechMap: Boolean;
begin
  Result := False;
  if (FMapVector.X > 0) and (FMapRect.Left > 0) then  //在放大的时候，而且左边还有空余的地图
  begin
    while (FMapRect.Left > 0) and (FMapVector.X > 0) do
    begin
      FMapRect.Left := FMapRect.Left - 1;
      FMapVector.X := FMapVector.X - CMapWidth;
    end;
    Result := True;
  end;
  if (FMapVector.Y > 0) and (FMapRect.Top > 0) then  //在放大的时候，而且上面还有空余的地图
  begin
    while (FMapRect.Top > 0) and (FMapVector.Y > 0) do
    begin
      FMapRect.Top := FMapRect.Top - 1;
      FMapVector.Y := FMapVector.Y - CMapHeight;
    end;
    Result := True;
  end;
  if ((FMapVector.X + (FMapRect.Right-FMapRect.Left+1)*CMapWidth) < Width) //在放大的时候，而且右边还有空余的地图
    and (FMapRect.Right < GetMapCount(MapZoom)) then
  begin
    while ((FMapVector.X + (FMapRect.Right-FMapRect.Left+1)*CMapWidth) < Width)
      and (FMapRect.Right < GetMapCount(MapZoom)) do
    begin
      FMapRect.Right := FMapRect.Right + 1;
    end;
    Result := True;
  end;
  if ((FMapVector.Y + (FMapRect.Bottom-FMapRect.Top+1)*CMapHeight) < Height) //下面
    and (FMapRect.Bottom < GetMapCount(MapZoom)) then
  begin
    while ((FMapVector.Y + (FMapRect.Bottom-FMapRect.Top+1)*CMapHeight) < Height)
    and (FMapRect.Bottom < GetMapCount(MapZoom)) do
    begin
      FMapRect.Bottom := FMapRect.Bottom + 1;
    end;
    Result := True;
  end;
end;

procedure TEarthMap.WMMap(var AMsg: TMessage);
var
  sFileName: string;
  Zoom, x, y: Integer;
  Bitmap: TBitmap;
  procedure AnalyseParam;
  var
    iPos: Integer;
    sTmp: string;
  begin
    sTmp := ExtractFileName(sFileName);
    iPos := Pos('-', sTmp);
    Zoom := StrToIntDef(Copy(sTmp, 1, iPos-1), 0);
    Delete(sTmp, 1, iPos);
    iPos := Pos('-', sTmp);
    X := StrToIntDef(Copy(sTmp, 1, iPos-1), 0);
    Delete(sTmp, 1, iPos);
    iPos := Pos('.', sTmp);
    Y := StrToIntDef(Copy(sTmp, 1, iPos-1), 0);
  end;
begin
  sFileName := PChar(AMsg.WParam);
  AnalyseParam;
  if Zoom = MapZoom then
  begin
    Bitmap := FImage.Picture.Bitmap;
    DrawOneMap(Zoom, X, Y, Bitmap);
  end;
end;

procedure TEarthMap.WMSize(var AMsg: TWMSize);
begin
  inherited;
  FMapVector.X := FMapVector.X - (FWinWidth - AMsg.Width) div 2;
  FMapVector.Y := FMapVector.Y - (FWinHeight - AMsg.Height) div 2;
  StrechMap;
  DrawMap;
  FWinWidth := AMsg.Width;
  FWinHeight := AMsg.Height;
end;

function TEarthMap.GetMapCount(AZoom: Integer): Integer;
begin       //获取地图块的坐标最大值
  if AZoom <= 0 then
  begin
    Result := 0;
  end
  else
  begin
    Result := 2 shl (AZoom - 1) - 1;
  end;
end;

procedure TEarthMap.OmImgMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FOrganMouse.X := X;
  FOrganMouse.Y := Y;
end;

procedure TEarthMap.OnImgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  TargetPoint: TPoint;
  xInv, yInv: Integer;
  dLongitude, dLatitude: Double;
begin
  inherited;
  if csDesigning in ComponentState then Exit; 
  TargetPoint.X := X;
  TargetPoint.Y := Y;
  
  if Shift = [ssLeft] then
  begin
    xInv := TargetPoint.X - FOrganMouse.X;
    yInv := TargetPoint.Y - FOrganMouse.Y;
    FMapVector.X := FMapVector.X + xInv;
    FMapVector.Y := FMapVector.Y + yInv;
    if StrechMap then
      DrawMap
    else
      ScrollBy(xInv, yInv);
  end;
//  FOrganMouse := TargetPoint;
  if Assigned(FOnMapGPS) then
  begin
    PelsToLongLat(MapZoom, FMapRect.Left*CMapWidth+X,
      FMapRect.Top*CMapHeight+Y, dLongitude, dLatitude);
    FOnMapGPS(Self, dLongitude, dLatitude);
  end;
end;

end.