ezthematics.pas

很管用的GIS控件

  FColor:= Value;
  InvalidateLegend;
end;

Procedure TEzLegendItem.InvalidateLegend;
begin
  If TEzLegendRanges( Collection ).Owner Is TEzLegend Then
    TEzLegend(TEzLegendRanges( Collection ).Owner).Invalidate;
end;

procedure TEzLegendItem.SetImageIndex(const Value: Integer);
begin
  FImageIndex := Value;
  InvalidateLegend;
end;

{ TEzLegendRanges }

constructor TEzLegendRanges.Create(AOwner: TPersistent);
begin
  Inherited Create( AOwner, TEzLegendItem );
end;

function TEzLegendRanges.Add: TEzLegendItem;
begin
  Result := TEzLegendItem( Inherited Add );
end;

function TEzLegendRanges.Up(Index: Integer): Boolean;
begin
  Result:= False;
  if ( Index <= 0 ) or ( Index > Count - 1 ) then Exit;
  GetItem( Index ).Index := Index - 1;
  Result:= True;
end;

function TEzLegendRanges.Down(Index: Integer): Boolean;
begin
  Result:= False;
  if ( Index < 0 ) or ( Index >= Count - 1 ) then Exit;
  GetItem( Index ).Index := Index + 1;
  Result:= True;
end;

function TEzLegendRanges.GetItem(Index: Integer): TEzLegendItem;
begin
  Result := TEzLegendItem( Inherited GetItem( Index ) );
end;

procedure TEzLegendRanges.SetItem(Index: Integer; Value: TEzLegendItem);
begin
  Inherited SetItem( Index, Value );
end;

function TEzLegendRanges.Owner: TPersistent;
begin
  Result:= Inherited GetOwner;
end;


{ TEzLegend class implementation }

{ TEzLegend }

constructor TEzLegend.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLegendRanges:= TEzLegendRanges.Create(Self);
  FixedCols:= 0;
  FixedRows:= 1;
  ColCount:= 3;
  Options:= [goFixedVertLine,goFixedHorzLine,goVertLine,goHorzLine];
  ShowTitle:= true;
  FTitleFont:= TFont.Create;
  FTitleColor:= clBlack;
  FTitleTransparent:= false;
  FTitleAlignment:= taCenter;
  FPenTool:= TEzPenTool.Create;
  FBrushTool:= TEzBrushTool.Create;
  FBorderWidth:= 1;
  FLoweredColor:= clGray;
end;

destructor TEzLegend.Destroy;
begin
  FLegendRanges.Free;
  FPentool.Free;
  FBrushtool.Free;
  FTitleFont.Free;
  inherited Destroy;
end;

procedure TEzLegend.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  uFormat: Word;
  AText: string;
  AIndex: Integer;
  AItem: TEzLegendItem;
  R: TRect;
  Image : TBitmap;
  Ax,Ay: Integer;

  Procedure DrawLineStyle;
  var
    FGrapher: TEzGrapher;
  begin
    FGrapher:= TEzGrapher.Create(10,adScreen);
    try
      if AItem.FPenStyle.Style < 0 then Exit;
      Canvas.Font.Assign( Self.Font );
      EzMiscelCtrls.DrawLineType( FGrapher, Canvas, AItem.FPenStyle.Style,
        ARect, [], AItem.FPenStyle.Color, Self.Color, False, 0, 2, False,
        True, False );
    finally
      FGrapher.free;
    end;
  end;

  Procedure DrawBrushStyle;
  var
    FGrapher: TEzGrapher;
  begin
    FGrapher:= TEzGrapher.Create(10,adScreen);
    try
      Canvas.Font.Assign( Self.Font );
      EzMiscelCtrls.DrawPattern( Canvas, AItem.FBrushStyle.Pattern,
        AItem.FBrushStyle.ForeColor, AItem.FBrushStyle.BackColor, Self.Color, ARect,
        False, [], False, True, False );
    finally
      FGrapher.free;
    end;
  end;

  Procedure DrawSymbolStyle;
  var
    FGrapher: TEzGrapher;
    ValInteger: Integer;
  begin
    ValInteger:= AItem.FSymbolStyle.Index;
    FGrapher:= TEzGrapher.Create(10,adScreen);
    try
      if ValInteger < 0 then Exit;
      EzMiscelCtrls.DrawSymbol( FGrapher, Canvas, ValInteger, ARect, [],
        Self.Color, False, False, true, False );
    finally
      FGrapher.free;
    end;
  end;

begin
  InitializeRows;
  if csDesigning in ComponentState then Exit;
  with Canvas do
  begin
    Font.Assign( Self.Font );
    if FShowTitle and (ARow = 0) then
    begin
      case ACol of
        0: AText:= FTitle0;
        1: AText:= FTitle1;
        2: AText:= FTitle2;
      end;
      Font.Style:= Font.Style + [fsBold];
      uFormat:= DT_CENTER or DT_VCENTER or DT_SINGLELINE;
      DrawText( Handle, PChar(AText), -1, ARect, uFormat );
    end;
    if (FShowTitle and (ARow > 0) ) Or (Not FShowTitle and (ARow >=0)) then
    begin
      InflateRect(ARect, -1, -1);
      if FShowTitle then AIndex:= ARow - 1 else AIndex := ARow;
      if AIndex > FLegendRanges.Count-1 then Exit;
      AItem:= FLegendRanges[AIndex];
      if ACol = 0 then
      begin
        Case FLegendStyle of
          ctLineStyle:
            begin
              DrawLineStyle;
            end;
          ctBrushStyle:
            begin
              DrawBrushStyle;
            end;
          ctColor:
            begin
              Pen.Width:= 1;
              Pen.Color:= clBlack;
              Brush.Style:= bsSolid;
              Brush.Color:= AItem.FColor;
              R:= ARect;
              Windows.InflateRect(R,-2,-2);
              with R do
                Rectangle(left, top, right, bottom );
            end;
          ctSymbolStyle:
            begin
              DrawSymbolStyle;
            end;
          ctBitmap:
            begin
              if FImageList = Nil then Exit;
              if AItem.FImageIndex > ImageList.Count-1 then exit;
              Image := TBitmap.Create;
              try
                ImageList.GetBitmap(AIndex, Image);
                Image.Transparent:= true;
                Image.TransparentMode := tmAuto;
                if FStretch then
                begin
                  R:= ARect;
                  Windows.InflateRect(R,-2,-2);
                  StretchDraw( R, Image );
                end else
                begin
                  Ax:= ARect.Left + IMax((( ARect.Right - ARect.Left ) - Image.Width ) div 2, 0);
                  Ay:= ARect.Top + IMax((( ARect.Bottom - ARect.Top ) - Image.Height ) div 2, 0);
                  Draw( Ax,Ay, Image );
                end;
              finally
                Image.free;
              end;
            end;
        end;
      end else if ACol=1 then
      begin
        AText:= AItem.FLegend;
        uFormat:= DT_LEFT or DT_VCENTER or DT_SINGLELINE;
        DrawText( Handle, PChar(AText), -1, ARect, uFormat );
      end else if ACol=2 then
      begin
        AText:= IntToStr( AItem.FFrequency );
        uFormat:= DT_RIGHT or DT_VCENTER or DT_SINGLELINE;
        DrawText( Handle, PChar(AText), -1, ARect, uFormat );
      end;
    end;
  end;
end;

procedure TEzLegend.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  Inherited Notification( AComponent, Operation );
  If ( Operation = opRemove ) And ( AComponent = FImageList ) Then
    FImageList := Nil;
end;

procedure TEzLegend.SetImageList(const Value: TImageList);
begin
  if FImageList = Value then Exit;
{$IFDEF LEVEL5}
  if Assigned( FImageList ) then FImageList.RemoveFreeNotification( Self );
{$ENDIF}
  If Value <> Nil Then
    Value.FreeNotification( Self );
  FImageList:= Value;
end;

procedure TEzLegend.SetLegendRanges(const Value: TEzLegendRanges);
begin
  FLegendRanges.Assign( Value );
end;

procedure TEzLegend.SetLegendStyle(const Value: TEzColumnType);
begin
  if FLegendStyle = Value then Exit;
  FLegendStyle := Value;
end;

procedure TEzLegend.SetShowTitle(const Value: Boolean);
begin
  if FShowTitle = Value then exit;
  FShowTitle := Value;
  InitializeRows;
end;

Procedure TEzLegend.InitializeRows;
begin
  if FShowTitle then
  begin
    if FLegendRanges.Count = 0 then
    begin
      if RowCount <> 2 then RowCount := 2;
    end else
    begin
      if RowCount <> FLegendRanges.Count + 1 then
        RowCount := FLegendRanges.Count + 1;
    end;
    if FixedRows <> 1 then FixedRows := 1;
  end else
  begin
    if FLegendRanges.Count = 0 then
    begin
      if RowCount <> 0 then RowCount := 0;
    end else
    begin
      if RowCount <> FLegendRanges.Count then
        RowCount := FLegendRanges.Count;
    end;
    if FixedRows <> 0 then FixedRows := 0;
  end;
end;

procedure TEzLegend.SetTitle0(const Value: string);
begin
  FTitle0 := Value;
  Invalidate;
end;

procedure TEzLegend.SetTitle1(const Value: string);
begin
  FTitle1 := Value;
  Invalidate;
end;

procedure TEzLegend.SetTitle2(const Value: string);
begin
  FTitle2 := Value;
  Invalidate;
end;

procedure TEzLegend.PopulateFrom(Source: TEzThematicBuilder);
var
  I: Integer;
  SourceItem: TEzThematicItem;
begin
  FLegendRanges.Clear;
  for I:= 0 to Source.FThematicRanges.Count -1 do
  begin
    SourceItem:= Source.FThematicRanges[I];
    with FLegendRanges.Add do
    begin
      FPenStyle.assign( SourceItem.FPenStyle );
      FBrushStyle.Assign( SourceItem.FBrushStyle );
      FSymbolStyle.Assign( SourceItem.FSymbolStyle );
      FLegend:= SourceItem.FLegend;
      FFrequency:= SourceItem.Frequency;
    end;
  end;
  FTitle1:= Source.Title;
  If Source.ApplyPen then
    FLegendStyle:= ctLineStyle
  else If Source.ApplyBrush then
    FLegendStyle:= ctBrushStyle
  else If Source.ApplyColor then
    FLegendStyle:= ctColor
  else If Source.ApplySymbol then
    FLegendStyle:= ctSymbolStyle;

  InitializeRows;
  Invalidate;
end;

procedure TEzLegend.SetStretch(const Value: Boolean);
begin
  if FStretch = Value then exit;
  FStretch := Value;
  Invalidate;
end;

procedure TEzLegend.AdjustColWidths;
begin
  if FInColChange then Exit;
  FInColChange:= true;
  try
    if ColWidths[0] >= MulDiv(ClientWidth,1,3) then
    begin
      ColWidths[0] := MulDiv(ClientWidth,1,3);
    end;
    ColWidths[2] := ClientWidth - ColWidths[0] - ColWidths[1] -
      GetSystemMetrics(SM_CXBORDER) * 1 - GridLineWidth * ColCount ;
  finally
    FInColChange:= false;
  end;
end;

procedure TEzLegend.ColWidthsChanged;
begin
  AdjustColWidths;
  inherited ColWidthsChanged;
end;

procedure TEzLegend.SetBrushTool(const Value: TEzBrushTool);
begin
  FBrushTool.Assign( Value );
end;

procedure TEzLegend.SetPenTool(const Value: TEzPenTool);
begin
  FPenTool.Assign( Value );
end;

procedure TEzLegend.SetTitleFont(const Value: TFont);
begin
  FTitleFont.Assign( Value );
end;

end.