?? earthmap.pas
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -