www.pudn.com > MapLegend.rar > MapLegend_LegendRenderer.pas
unit MapLegend_LegendRenderer;
interface
uses Classes, Graphics, ExtCtrls, Types, ActiveX, OleCtrls, MapObjects2_TLB;
type
TLegendItemRenderer = class(TBitmap)
private
{ Private declarations }
FBackColor : TColor;
FMapColor : TColor;
FRendererWidth : integer;
FRendererHeight : integer;
//FOldScaleMode : byte;
procedure DrawMarker(sym : IMoSymbol);
procedure DrawMarkerFont(color : longint; Size : integer; Font, Pattern : String);
procedure DrawLine(color : longint; Size : integer);
procedure DrawShade(color : longint; mstyle : integer; OutlineColor : longint = 0);
function MapToDelphiFillStyle(MoFillStyle : FillStyleConstants) : TBrushStyle;
protected
procedure SetWidth(AWidth : integer);
procedure SetHeight(AHeight : integer);
public
{ Public declarations }
property MapBackColor : TColor read FMapColor write FMapColor;
property BackgroundColor : TColor read FBackColor write FBackColor;
property RendererWidth : integer read FRendererWidth write SetWidth;
property RendererHeight : integer read FRendererHeight write SetHeight;
procedure AddEntry(IsMA : boolean; sym : IMoSymbol; Top, Left : longint);
constructor Create; override;
destructor Destroy; override;
end;
implementation
constructor TLegendItemRenderer.Create;
begin
inherited Create;
end;
destructor TLegendItemRenderer.Destroy;
begin
inherited Destroy;
end;
procedure TLegendItemRenderer.SetWidth(AWidth : integer);
begin
FRendererWidth := AWidth;
Width:= AWidth;
end;
procedure TLegendItemRenderer.SetHeight(AHeight : integer);
begin
FRendererHeight := AHeight;
Height:= AHeight;
end;
procedure TLegendItemRenderer.AddEntry(IsMA : boolean; sym : IMoSymbol; Top, Left : longint);
var
symboltype : integer;
Symbolcolor : longint;
SymbolStyle : integer;
begin
//Set the map layer name, then get layer info from
//the layerinfo file. Set the caption and draw the
//layer's symbol.
if (sym = NIL) then
exit;
if Not(IsMA) then
begin
symboltype := sym.symboltype;
Symbolcolor := sym.color;
SymbolStyle := sym.Style;
end
else
begin
symboltype := 2;
Symbolcolor := moMagenta;
SymbolStyle := 0;
end;
Case symboltype of
0: // Point
DrawMarker(sym);
1: // Line
DrawLine(Symbolcolor, sym.Size);
2: // Polygon fill
DrawShade(Symbolcolor, SymbolStyle, sym.OutlineColor);
end;
end;
procedure TLegendItemRenderer.DrawMarker(sym : IMoSymbol);
var
xCenter, yCenter, Radius, gap : integer;
color, olColor : longint;
mstyle : integer;
//lX , lY : longint;
sqPoints : array [0..3] of TPoint; //Square
trPoints : array [0..2] of TPoint;//Triangle
fnt:TFont;
r : TRect;
begin
// Draw a marker symbol in the legend box.
color := sym.color;
if (sym.Outline) then
olColor := sym.OutlineColor
else
olColor := color;
mstyle := sym.Style;
xCenter := FRendererWidth div 2;
yCenter := FRendererHeight div 2;
Canvas.Brush.Style := bsSolid;
CanVas.Brush.Color := FBackcolor;
CanVas.FillRect(Rect(0,0,Width,Height));
Canvas.Pen.Color := olColor;
Case mstyle of
0: //mocircle
begin
xCenter := FRendererWidth div 2;
yCenter := FRendererHeight div 2;
Radius := trunc(xCenter * 0.5);
//Draw outline of circle first.
r := Rect(xCenter - Radius, yCenter - Radius, xCenter + Radius, yCenter + Radius);
Canvas.Ellipse(r);
//Draw fill inside circle symblo.
Canvas.Brush.Color := Color;
Canvas.Ellipse(r);
end;
1: //mosquare
begin
gap := trunc(FRendererHeight * 0.7);
sqPoints[0].X := gap;
sqPoints[0].Y := gap;
sqPoints[1].X := FRendererWidth - gap;
sqPoints[1].Y := gap;
sqPoints[2].X := FRendererWidth - gap;
sqPoints[2].Y := FRendererHeight - gap;
sqPoints[3].X := gap;
sqPoints[3].Y := FRendererHeight - gap;
Canvas.Pen.Color := olcolor;
Canvas.Brush.Color := color;
canvas.Brush.Style := bsSolid;
Canvas.Polygon(sqPoints);
end;
2: //moTriangle
begin
gap := trunc(Height * 0.35);
trPoints[0].X := FRendererWidth div 2;
trPoints[0].Y := 0;
trPoints[1].X := FRendererWidth - gap;
trPoints[1].Y := gap;
trPoints[2].X := gap;
trPoints[2].Y := gap;
Canvas.Pen.Color := olcolor;
Canvas.Brush.Color := color;
canvas.Brush.Style := bsSolid;
Canvas.Polygon(trPoints);
end;
3 : //cross
begin
gap := trunc(Height * 0.15);
Canvas.Pen.Color := color;
Canvas.MoveTo (13, FRendererHeight div 2);
Canvas.LineTo (0, FRendererHeight div 2);
Canvas.MoveTo (FRendererWidth div 2, 13);
Canvas.LineTo (FRendererWidth div 2, 0);
end;
4: //true type font
begin
fnt := TFont.Create;
OleFontToFont(sym.Font, fnt);
//sym.Font.Name is not valid in Delphi. Uses fnt.name instead.
DrawMarkerFont(color, sym.Size, fnt.Name, Chr(sym.CharacterIndex))
end;
end; //case
end;
procedure TLegendItemRenderer.DrawMarkerFont(color : longint; Size : integer; Font : String; Pattern : String);
var
// Draw a marker symbol in the legend box.
//MsgBox Font
OldColor : longint;
OldFontName : string;
OldFontSize : byte;
CurX, CurY : integer;
begin
//Backup the old values
OldColor := Canvas.Font.Color;
OldFontName := Canvas.Font.Name;
OldFontSize := Canvas.Font.Size;
Canvas.Font.Color := color;
Canvas.Font.Name := TFontName(Font);
Canvas.Font.Size := Size;
CurX := (FRendererWidth div 2) - (Canvas.TextWidth(Pattern) div 2);
CurY := (FRendererHeight div 2) - (Canvas.TextHeight(Pattern) div 2);
Canvas.TextOut(CurX, CurY, Pattern);
Canvas.Font.Color := OldColor;
Canvas.Font.Name := OldFontName;
Canvas.Font.Size := OldFontSize;
end;
procedure TLegendItemRenderer.DrawLine(color : longint; Size : integer);
var
//Draw a sample of the layer's line symbol.
OldColor : longint;
OldDrawWidth : Byte;
CurX, CurY : integer;
begin
oldColor := Canvas.Pen.Color;
OldDrawWidth := Canvas.Pen.Width;
CurX := 0;//FCurrentX;
CurY := 0;//FCurrentY;
Canvas.Brush.Style := bsClear;
Canvas.Brush.Color := FBackColor;
Canvas.FillRect(Rect(0, 0, FRendererWidth, FRendererHeight));
if (Size > 0) then
if (Size < 10) then
Canvas.Pen.Width := Size
else
Canvas.Pen.Width := 5;
Canvas.Pen.Color := color;
Canvas.MoveTo (CurX, CurY + FRendererHeight);
Canvas.LineTo (CurX + trunc(FRendererWidth * 0.45), CurY + trunc(FRendererHeight * 0.3));
Canvas.MoveTo (CurX + trunc(FRendererWidth * 0.45), CurY + trunc(FRendererHeight * 0.3));
Canvas.LineTo (CurX + trunc(FRendererWidth * 0.55), CurY + trunc(FRendererHeight * 0.7));
Canvas.MoveTo (CurX + trunc(FRendererWidth * 0.55), CurY + trunc(FRendererHeight * 0.7));
Canvas.LineTo (CurX + FRendererWidth, CurY);
Canvas.Pen.Color := OldColor;
Canvas.Pen.Width := OldDrawWidth;
end;
function TLegendItemRenderer.MapToDelphiFillStyle(MoFillStyle : FillStyleConstants) : TBrushStyle;
begin
case MoFillStyle of
moSolidFill://Solid
result := bsSolid;
moTransparentFill://Transparent
result := bsClear;
moHorizontalFill://Horizontal
result := bsHorizontal;
moVerticalFill://Vertical
result := bsVertical;
moUpwardDiagonalFill://Upward Diagonal
result := bsFDiagonal;
moDownwardDiagonalFill://Downward Diagonal
result := bsBDiagonal;
moCrossFill://Cross
result := bsCross;
moDiagonalCrossFill://Diagonal Cross
result := bsDiagCross;
moLightGrayFill://Light Gray Fill
result := bsSolid;
moGrayFill://Gray Fill
result := bsSolid;
moDarkGrayFill://DarkGray Fill
result := bsSolid;
end;
end;
//fill the legend box with a shade.
procedure TLegendItemRenderer.DrawShade(color : longint; mstyle : integer; OutlineColor : longint = 0);
var
//FillStyle : TFillStyle;//fsBorder, fsSurface
BrushStyle : TBrushStyle; //bsSolid, bsClear, bsHorizontal, ...
FillColor : longint;
//CurX , CurY : longint;
begin
BrushStyle := MapToDelphiFillStyle(mstyle);
FillColor := Color;
if (mstyle = 1) then
begin
FillColor := OutlineColor;
Color := OutlineColor;
end;
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := FMapColor;
Canvas.Rectangle(Rect(0, 0, FRendererWidth, FRendererHeight));
Canvas.Brush.Style := BrushStyle;
Canvas.Brush.Color := Color;
Canvas.Pen.Color := Color;
Canvas.Rectangle(0, 0, FRendererWidth, FRendererHeight);
end;
end.