scalebar.pas

ScaleBar比例尺；基于MapX 4.5的比例尺类。 并演示了Delphi中如何利用接口技术在DLL中封装对象。

unit ScaleBar;
{* |<PRE>
================================================================================
* 软件名称：FHT GPS车辆监控管理系统
* 单元名称：地图比例尺单元
* 单元作者：[e-mail]
* 备    注：
* 开发平台：PWin2003Standard + Delphi 7.1
* 修改记录：
*           2007.03.22 比例尺精确到厘米
*           2007.03.14 创建单元,主要代码从MapX的Demo中修改而来。以千米为单位
================================================================================
|</PRE>}

interface

uses
  Windows, SysUtils, StdCtrls, Forms, MapXLib_TLB,IScaleBar;

type
  TScaleBar = class(TInterfacedObject, IScaleBarObject)
  private
    FMap: TMap;
    FEdit: TEdit;
    FScaleBarForm: TForm;
    procedure CreateUserDrawLayer;
    procedure RemoveUserDrawLayer;
  protected
    procedure DrawUserLayer(Sender: TObject;
      const Layer: IDispatch; hOutputDC, hAttributeDC: Cardinal;
      const RectFull, RectInvalid: IDispatch);
  public
    constructor Create(AOwner: TMap);
    destructor Destroy; override;
  end;

const
  BS_SOLID = 0;
  WHITE = 16777215;
  RED = 255;
  BLACK = 0;
  BLUE = 16711680;
  TRANSPARENT = 1;
  SYSTEM_FONT = 13;
  SScaleBarLayerName = 'ScaleBarLayer';

implementation

constructor TScaleBar.Create(AOwner: TMap);
begin
  FMap := AOwner;
  FEdit := TEdit.Create(AOwner);
  FScaleBarForm := TForm.Create(nil);
  CreateUserDrawLayer;
  AOwner.OnDrawUserLayer := DrawUserLayer;
end;

procedure TScaleBar.CreateUserDrawLayer;
begin
  FMap.Layers.AddUserDrawLayer(SScaleBarLayerName, 1);
end;

procedure TScaleBar.RemoveUserDrawLayer;
var
  I: Integer;
begin
  for I := 1 to FMap.Layers.Count do
  begin
    if FMap.Layers.Item(I).Name = SScaleBarLayerName then
    begin
      FMap.Layers.Remove(SScaleBarLayerName);
      Break;
    end;
  end;
end;

procedure TScaleBar.DrawUserLayer(Sender: TObject;
  const Layer: IDispatch; hOutputDC, hAttributeDC: Cardinal;
  const RectFull, RectInvalid: IDispatch);
var
  barWidth, barHeight: Single;
  screenX, screenY: Single;
  startX, startY: Single;
  mapX1, mapX2, mapY1, mapY2: Double;
  totalDistance: LongInt;
  realTotalDistance: Double;
  MapUnit: string;
  ptArray: array[0..1] of TPoint;
  I: SmallInt;
  x1, x2, y1, y2: Integer;
  m_LogBrush: TLogBrush;
  midPoint: LongInt;
  centerCorrection: Integer;
  scaleWidth, scaleHeight: single;
  text: string;
  pText: PChar;
  size: Integer;
begin
  //set the x increment to be 1/2 an inch
  barWidth := 0.5;
  //set the y increment to be 1/10 of an inch
  barHeight := 0.08;

  // Set start of scaleBar
  StartX := 0.15;
  StartY := 0.25;
  // Set the mapMode of Device Context
  SetMapMode(hOutputDC, MM_HIENGLISH);
  //Set the current Pen of the Device Context
  SelectObject(hOutputDC, CreatePen(0, 1, BLACK));

  // The conversion factor is needed because one HIENGLISH unit is .001 inch
  x1 := Round(StartX * 1000);
  y1 := Round(StartY * 1000);
  barWidth := barWidth * 1000;
  barHeight := barHeight * 1000;
  for i := 0 to 1 do
  begin
    // Set start and end locations of first section of scaleBar.
    x2 := Round(barWidth + x1);
    y2 := Round(barHeight + y1);

    // Set Brush Type
    // if loop count is 1 then first section so set brush to red
    if i = 1 then
    begin
      m_LogBrush.lbStyle := BS_SOLID;
      m_LogBrush.lbColor := RED;
    end
    else                                // Second section, so set brush to white
    begin
      m_LogBrush.lbStyle := BS_SOLID;
      m_LogBrush.lbColor := WHITE;
    end;

    SelectObject(hOutputDC, CreateBrushIndirect(m_LogBrush));
    // with mapMode HIENGLISH, positive x is to the right, positive y is up
    Windows.Rectangle(hOutputDC, x1, -y1, x2, -y2);
    //Draw Second Section, y stays constant
    if i = 1 then
    begin
      m_LogBrush.lbStyle := BS_SOLID;
      m_LogBrush.lbColor := WHITE;
    end
    else
    begin
      m_LogBrush.lbStyle := BS_SOLID;
      m_LogBrush.lbColor := RED;
    end;

    SelectObject(hOutputDC, CreateBrushIndirect(m_LogBrush));
    x1 := x2;
    x2 := Round(barWidth + x1);
    Windows.Rectangle(hOutputDC, x1, -y1, x2, -y2);

    // Draw third section
    if i = 1 then
    begin
      m_LogBrush.lbStyle := BS_SOLID;
      m_LogBrush.lbColor := RED;
    end
    else
    begin
      m_LogBrush.lbStyle := BS_SOLID;
      m_LogBrush.lbColor := WHITE;
    end;

    SelectObject(hOutputDC, CreateBrushIndirect(m_LogBrush));
    x1 := x2;
    x2 := Round(barWidth * 2 + x1);
    Windows.Rectangle(hOutputDC, x1, -y1, x2, -y2);

    x1 := Round(StartX * 1000);
    y1 := y2
  end;                                  // For Loop
  //Fill array to use for distance later
  //Calculate distance at the center of map.  1 inch in each direction for the x value
  // 1000 HIENGLISH = 1 inch
  ScaleWidth := FScaleBarForm.ClientWidth / FScaleBarForm.PixelsPerInch;
  ScaleHeight := FScaleBarForm.ClientHeight / FScaleBarForm.PixelsPerInch;

  ptArray[0].x := Round((ScaleWidth * 1000 / 2) - 1000);
  ptArray[0].y := Round(-ScaleHeight * 1000 / 2);
  // 1000 HIENGLISH = 1 inch
  ptArray[1].x := Round((ScaleWidth * 1000 / 2) + 1000);
  ptArray[1].y := Round(-ScaleHeight * 1000 / 2);

  // Call API to get pixel values for first section HIENGLISH screen Coordinates
  // Store these values in map values to be used in Distance Function
  LPtoDP(hOutputDC, ptArray[0], 2);
  screenX := ptArray[0].x;
  screenY := ptArray[0].y;
  FMap.ConvertCoord(screenX, screenY, mapX1, mapY1, miScreenToMap);

  screenX := ptArray[1].x;
  screenY := ptArray[1].y;
  FMap.ConvertCoord(screenX, screenY, mapX2, mapY2, miScreenToMap);

  // Modified by Hsu 2007-3-22 20:16:06
  realTotalDistance := FMap.Distance(mapX1, mapY1, mapX2, mapY2);
  if realTotalDistance < 1 then
  begin
    if realTotalDistance <= 0.001 then
    begin
      totalDistance := Round(realTotalDistance * 100000);
      MapUnit := 'cm';
    end
    else
    begin
      totalDistance := Round(realTotalDistance * 1000);
      MapUnit := 'm';
    end;
  end
  else
  begin
    totalDistance := Round(realTotalDistance);
    MapUnit := 'km';
  end;
  //-----------------------------------------------------------------

  //Set up font, Text color and text Background Color
  SelectObject(hOutputDC, GetStockObject(SYSTEM_FONT));
  SetTextColor(hOutputDC, BLACK);
  SetBkMode(hOutputDC, TRANSPARENT);

  // Place text on scaleBar
  x1 := Round(StartX * 1000);
  y1 := Round((StartY - 0.19) * 1000);
  // y1 := (FMap.Height * 11) - 200;
  TextOut(hOutputDC, x1, -y1, '0', 1);

  x1 := Round(barWidth * 2 + StartX * 1000);
  midPoint := Round(totalDistance / 2);

  // Value to center mile text on top of partition line
  centerCorrection := 60 * Length(IntToStr(midPoint));

  text := IntToStr(midPoint);
  // Assign to invisible text box to use functions to
  // convert string to PChar
  FEdit.Text := Text;                   //Get length of text
  Size := FEdit.GetTextLen;             //Add room for null character
  Inc(Size);                            //Creates Buffer dynamic variable
  GetMem(pText, Size);
  try
    FEdit.GetTextBuf(pText, Size);      //Puts Text into Buffer
    TextOut(hOutputDC, x1 - centerCorrection, -y1, pText, Length(intToStr(midPoint)));
  finally
    FreeMem(pText, Size);               //Frees memory allocated to Buffer
  end;
  x1 := Round(barWidth * 4 + StartX * 1000);
  centerCorrection := 60 * Length(IntToStr(totalDistance)) + 25;
  text := intToStr(totalDistance);
  // Assign to invisible text box to use functions to
  // convert string to PChar
  FEdit.Text := text;                   //Get length of text
  Size := FEdit.GetTextLen;             //Add room for null character
  Inc(Size);                            //Creates Buffer dynamic variable
  GetMem(pText, Size);
  try
    FEdit.GetTextBuf(pText, Size);      //Puts Text into Buffer
    TextOut(hOutputDC, x1 - centerCorrection, -y1, pText, Length(intToStr(totalDistance)));
  finally
    FreeMem(pText, Size);               //Frees memory allocated to Buffer
  end;

  // Place MapUnit Description under scalebar
  x1 := Round(barWidth * 2 + StartX * 1000);
  centerCorrection := 60 * Length(MapUnit);
  y1 := Round((StartY + 0.2) * 1000) - 55;
  TextOut(hOutputDC, x1 - centerCorrection, -y1, PChar(MapUnit), Length(MapUnit));
end;

destructor TScaleBar.Destroy;
begin
  RemoveUserDrawLayer;
  FreeAndNil(FEdit);
  FreeAndNil(FScaleBarForm);
  inherited Destroy;
end;

end.