Nigel
I have hacked the SlippyMap demo and introduce some code to allow rubber band zooming. Its rather crude, but it works. What would be nice would be to either fill the rubber banded rectangle with a transparent color fill (30% yellow), or better still to fill the background with a transparent color fill (30% grey to give it a kind of monochrome appearance) and leave the rubber band rectangle clear.
I'm not sure how I could do this without introducing a new transparent layer and still work within the DrawBackbuffer event, or if its even possible.
Bruce.
unit Main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, hyieutils, hyiedefs,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Buttons, imageenview, ieview;
type
TfmMain = class(TForm)
ImageEnView1: TImageEnView;
procedure FormCreate(Sender: TObject);
procedure ImageEnView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImageEnView1Resize(Sender: TObject);
procedure ImageEnView1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure ImageEnView1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ImageEnView1DrawBackBuffer(Sender: TObject);
private
map: TIESlippyMap;
mouseDownPoint: TPoint;
mouseDownCoords: TIE2DPoint;
xbmp : integer;
ybmp : integer;
FMouseDown : boolean;
public
end;
var
fmMain: TfmMain;
implementation
{$R *.dfm}
//------------------------------------------------------------------------------------------------------------------------------
procedure TfmMain.FormCreate(Sender: TObject);
begin
map:=TIESlippyMap.Create(iesmpMapQuest, 'cache');
map.Zoom:=4;
map.Latitude:=55;
map.Longitude:=-5;
ImageEnView1.IEBitmap.VirtualBitmapProvider:=map;
ImageEnView1.MouseWheelParams.Action:=iemwNone;
ImageEnView1Resize(self);
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TfmMain.ImageEnView1DrawBackBuffer(Sender: TObject);
begin
if FMouseDown then
begin
with ImageEnView1.BackBuffer.Canvas do
begin
Brush.Style:=bsClear;
Pen.Style:=psDot;
Rectangle(mouseDownPoint.X,mouseDownPoint.Y,xbmp,ybmp);
end;
end;
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TfmMain.ImageEnView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button=mbRight then FMouseDown:=True;
xbmp := ImageEnView1.XScr2Bmp(X);
ybmp := ImageEnView1.YScr2Bmp(Y);
mouseDownPoint := Point(xbmp, ybmp);
mouseDownCoords := IE2DPoint(map.Longitude, map.Latitude);
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TfmMain.ImageEnView1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
xbmp := ImageEnView1.XScr2Bmp(X);
ybmp := ImageEnView1.YScr2Bmp(Y);
if ImageEnView1.MouseCapture then
begin
map.Longitude := map.BmpXToLongitude( map.LongitudeToBmpX(mouseDownCoords.X) + (mouseDownPoint.X - xbmp) );
map.Latitude := map.BmpYToLatitude( map.LatitudeToBmpY(mouseDownCoords.Y) + (mouseDownPoint.Y - ybmp) );
end;
ImageEnView1.Update();
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TfmMain.ImageEnView1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
x1 : integer;
y1 : integer;
w : integer;
h : integer;
begin
if FMouseDown then
begin
FMouseDown:=False;
w:=abs(mouseDownPoint.X-xbmp) div 2;
h:=abs(mouseDownPoint.Y-ybmp) div 2;
if mouseDownPoint.X<xbmp then
x1:=mouseDownPoint.X+w
else
x1:=xbmp+w;
if mouseDownPoint.Y<ybmp then
y1:=mouseDownPoint.Y+h
else
y1:=ybmp+h;
map.Longitude:=map.BmpXToLongitude(x1);
map.Latitude:=map.BmpYToLatitude(y1);
if (mouseDownPoint.Y<ybmp) and (mouseDownPoint.X<xbmp) then
begin
if map.Zoom<12 then map.Zoom:=map.Zoom+1;
end
else
begin
if map.Zoom>2 then map.Zoom:=map.Zoom-1;
end;
ImageEnView1.Update;
end;
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TfmMain.ImageEnView1Resize(Sender: TObject);
var
bmpw, bmph: integer;
begin
bmpw := ImageEnView1.Width;
bmph := ImageEnView1.Height;
ImageEnView1.IEBitmap.Allocate(bmpw, bmph);
map.PointPosition := Point(bmpw div 2, bmph div 2);
ImageEnView1.Update;
end;
//------------------------------------------------------------------------------------------------------------------------------
end.
Search
