ezpreview.pas

很管用的GIS控件

        EffectiveW := ( Width - 4 );
        DX := 0;
        If FPreviewBox.PaperUnits = suMms Then
        Begin
          If YM = MaxSep / 2 Then
            DX := EffectiveW Div 2
          Else
            DX := EffectiveW Div 4;
        End Else If FPreviewBox.PaperUnits = suCms Then
        Begin
          If YM = MaxSep / 2 Then
            DX := EffectiveW Div 2
          Else
            DX := EffectiveW Div 4;
        End
        Else
        Begin
          If MinSep = 1 / 2 Then
          Begin
            If n * MinSep = int( n * MinSep ) Then
              DX := EffectiveW Div 2
            Else
              DX := EffectiveW Div 4;
          End
          Else If MinSep = 1 / 8 Then
          Begin
            If n = 4 Then
              DX := EffectiveW Div 2
            Else
              DX := EffectiveW Div 4
          End
          Else If MinSep = 1 / 16 Then
          Begin
            If n = 8 Then
              DX := EffectiveW Div 2
            Else If n Mod 2 = 0 Then
              DX := EffectiveW Div 3
            Else
              DX := EffectiveW Div 5;
          End;
        End;
        X := Width - 2;
        MoveTo( X, pt.Y );
        LineTo( X - DX, pt.Y );

        YM := YM + MinSep;
      End;

      Inc( m );
    End;
  End;
  DrawRulerPosition( FLastMousePosInRuler, pmNotXor );
End;

Procedure TEzVRuler.SetRubberPenColor( Const Value: TColor );
Begin
  FRubberPenColor := Value;
  Invalidate;
End;

Procedure TEzVRuler.SetMarksColor( Const Value: TColor );
Begin
  FMarksColor := Value;
  Invalidate;
End;

{$IFDEF BCB}
function TEzVRuler.GetMarksColor: TColor;
begin
  Result := FMarksColor;
end;

function TEzVRuler.GetPreviewBox: TEzPreviewBox;
begin
  Result := FPreviewBox;
end;

function TEzVRuler.GetRubberPenColor: TColor;
begin
  Result := FRubberPenColor;
end;
{$ENDIF}


function TEzVRuler.GetAbout: TEzAbout;
begin
  Result:= SEz_GisVersion;
end;

procedure TEzVRuler.SetAbout(const Value: TEzAbout);
begin
end;

{ TEzMosaicView }

Constructor TEzMosaicView.Create( AOwner: TComponent );
Begin
  Inherited Create( Aowner );
  ZoomWithMargins:= False;
  FInnerColor := clGreen;
  FOuterColor := clBlack;
  FPrintedInnerColor := clRed;
  FPrintedOuterColor := clBlack;
  FShowInverted := False;
  IsAerial := True;
  ScrollBars := ssNone;
  FX1List:= TEzDoubleList.create;
  FY1List:= TEzDoubleList.create;
  FX2List:= TEzDoubleList.create;
  FY2List:= TEzDoubleList.create;
End;

Destructor TEzMosaicView.Destroy;
Begin
  Inherited Destroy;
  FX1List.free;
  FY1List.free;
  FX2List.free;
  FY2List.free;
End;

{$IFDEF BCB}
Function TEzMosaicView.GetX1List: TEzDoubleList;
Begin
  Result:=FX1List;
End;

Function TEzMosaicView.GetY1List: TEzDoubleList;
Begin
  Result:=FY1List;
End;

Function TEzMosaicView.GetX2List: TEzDoubleList;
Begin
Result:=FX2List;
End;

Function TEzMosaicView.GetY2List: TEzDoubleList;
Begin
  Result:=FY2List;
End;

Function TEzMosaicView.GetShowInverted: boolean;
Begin
  Result:=FShowInverted;
End;

procedure TEzMosaicView.SetShowInverted(Value: boolean);
Begin
  FShowInverted:=value;
End;

Function TEzMosaicView.GetPrintedInnerColor: TColor;
Begin
  Result:=FPrintedInnerColor
End;

procedure TEzMosaicView.SetPrintedInnerColor(Value: TColor);
Begin
  FPrintedInnerColor:=value;
End;

Function TEzMosaicView.GetPrintedOuterColor: TColor;
Begin
  Result:=FPrintedOuterColor
End;

procedure TEzMosaicView.SetPrintedOuterColor(Value: TColor);
Begin
  PrintedOuterColor:=value;
End;

Function TEzMosaicView.GetInnerColor: TColor;
Begin
  Result:=FInnerColor;
End;

procedure TEzMosaicView.SetInnerColor(Value: TColor);
Begin
  FInnerColor:=Value;
End;

Function TEzMosaicView.GetOuterColor: TColor;
Begin
  Result:=FOuterColor;
End;

procedure TEzMosaicView.SetOuterColor(Value: TColor);
Begin
  FOuterColor:=Value;
End;

Function TEzMosaicView.GetParentView: TEzPreviewBox;
Begin
  Result:=FParentView;
End;
{$ENDIF}

Function TEzMosaicView.CurrentPrintArea(Ent: TEzEntity;
  Advance: TEzPageAdvance): TEzRect;
var
  MapWidthArea, MapHeightArea, DrawingScale, X, Y: Double;
  PaperAreaWidth, PaperAreaHeight: Double;
  PreviewArea, MapDrawingArea: TEzRect;
begin
  PreviewArea.Emin := Ent.Points[0];
  PreviewArea.Emax := Ent.Points[1];
  PreviewArea := ReorderRect2D( PreviewArea );
  PaperAreaWidth := Abs( PreviewArea.X2 - PreviewArea.X1 );
  PaperAreaHeight := Abs( PreviewArea.Y2 - PreviewArea.Y1 );
  MapDrawingArea := ReorderRect2D( TEzPreviewEntity( Ent ).ProposedPrintArea );
  With TEzPreviewEntity( Ent ) Do
    DrawingScale := DrawingUnits / PlottedUnits;
  With MapDrawingArea Do
  Begin
    Emax.X := Emin.X + PaperAreaWidth * DrawingScale;
    Emin.Y := Emax.Y - PaperAreaHeight * DrawingScale;
  End;
  { just in case you want to resave this entity }
  TEzPreviewEntity( Ent ).ProposedPrintArea:= MapDrawingArea;

  MapWidthArea := Abs( MapDrawingArea.X2 - MapDrawingArea.X1 );
  MapHeightArea := Abs( MapDrawingArea.Y2 - MapDrawingArea.Y1 );
  Y := MapDrawingArea.Y2;
  X := MapDrawingArea.X1;
  Result.X1 := X;
  Result.X2 := X + MapWidthArea;
  Result.Y1 := Y - MapHeightArea;
  Result.Y2 := Y;
  if Advance = padvNone then Exit;
  case Advance of
    padvLeft:
      begin
        Result.X1 := Result.X1 - MapWidthArea;
        Result.X2 := Result.X2 - MapWidthArea;
      end;
    padvRight:
      begin
        Result.X1 := Result.X1 + MapWidthArea;
        Result.X2 := Result.X2 + MapWidthArea;
      end;
    padvDown:
      begin
        Result.Y1 := Result.Y1 - MapHeightArea;
        Result.Y2 := Result.Y2 - MapHeightArea;
      end;
    padvUp:
      begin
        Result.Y1 := Result.Y1 + MapHeightArea;
        Result.Y2 := Result.Y2 + MapHeightArea;
      end;
  end;
end;

Procedure TEzMosaicView.GoAdvance( Advance: TEzPageAdvance );
var
  Ent: TEzEntity;
  Layer: TEzBaseLayer;
  Index, Recno: Integer;
begin
  Ent:= GetPreviewEntity(Layer,Recno);
  if Ent = Nil then Exit;
  try
    Index:= TEzPreviewEntity( Ent ).FileNo;
    if (Index < 0 ) or (Index > FParentView.GisList.Count - 1) then Exit;
    TEzPreviewEntity( Ent ).ProposedPrintArea := CurrentPrintArea( Ent, Advance );
    Layer.UpdateEntity( Recno, Ent );
    FParentView.Repaint;
  finally
    Ent.free;
  end;
end;

procedure TEzMosaicView.AddCurrentToPrintList;
var
  Curr: TEzRect;
  Ent: TEzEntity;
  Layer: TEzBaseLayer;
  Recno: Integer;
begin
  Ent:= GetPreviewEntity(Layer,Recno);
  if Ent = Nil then Exit;
  try
    Curr:= CurrentPrintArea( Ent, padvNone );
    FX1List.Add( Curr.X1 );
    FY1List.Add( Curr.Y1 );
    FX2List.Add( Curr.X2 );
    FY2List.Add( Curr.Y2 );
    Refresh;
  finally
    Ent.free;
  end;
end;

procedure TEzMosaicView.ClearPrintList;
begin
  FX1List.Clear;
  FY1List.Clear;
  FX2List.Clear;
  FY2List.Clear;
  Refresh;
end;

Function TEzMosaicView.GetPreviewEntity(var Layer: TEzBaseLayer; var Recno: Integer) : TEzEntity;
var
  Ent: TEzEntity;
begin
  Ent:= Nil;
  { Search for first entity that is a preview entity }
  Layer:= FParentView.Gis.Layers[0];  // just one layer on the preview box
  Layer.First;
  while not Layer.Eof do
  begin
    try
      if Layer.RecIsDeleted then Continue;
      Ent:= Layer.RecLoadEntity;
      if Ent= Nil then Continue;
      if Ent is TEzPreviewEntity then
      begin
        Recno:= Layer.Recno;
        Break;
      end else Ent.Free;
    finally
      Layer.Next;
    end;
  end;
  Result:= Ent;
end;

Function TEzMosaicView.FindGis: TEzBaseGis;
var
  Ent: TEzEntity;
  Index: Integer;
  Layer: TEzBaseLayer;
  Recno: Integer;
begin
  Result:= Nil;
  if (FParentView = Nil) or (FParentView.Gis = Nil) Then Exit;
  Ent:= GetPreviewEntity(Layer,Recno);
  if Ent = Nil then Exit;
  try
    Index:= TEzPreviewEntity( Ent ).FileNo;
    if (Index < 0 ) or (Index > FParentView.GisList.Count - 1) then Exit;
    Result:= FParentView.GisList[Index].Gis;
  finally
    Ent.free;
  end;
end;

Procedure TEzMosaicView.UpdateViewport( WCRect: TEzRect );
Var
  TheCanvas: TCanvas;
  VisualWindow: TEzRect;
Begin
  //If Not Showing then Exit;

  { check if WCRect is bigger than current view area }
  VisualWindow := Grapher.CurrentParams.VisualWindow;
  if (WCRect.X1 < VisualWindow.X1) or (WCRect.Y1 < VisualWindow.Y1) or
     (WCRect.X2 > VisualWindow.X2) or (WCRect.Y2 > VisualWindow.Y2) then
  begin
    WCRect:= IntersectRect2D(WCRect, VisualWindow);
    if EqualRect2D(WCRect, NULL_EXTENSION) then Exit;
  end;

  Inherited UpdateViewport( WCRect );

  TheCanvas := Canvas;
  If odBitmap In OutputDevices Then
    TheCanvas := ScreenBitmap.Canvas;

  Gis:= FindGis;

  With TEzPainterObject.Create(Nil) Do
    Try
      DrawEntities( WCRect,
                    GIS,
                    TheCanvas,
                    Grapher,
                    Selection,
                    True,
                    False,
                    pmAll,
                    Self.ScreenBitmap );
    Finally
      Free;
    End;

End;

Procedure TEzMosaicView.SetParentView( Const Value: TEzPreviewBox );
Begin
{$IFDEF LEVEL5}
  if Assigned( FParentView ) then FParentView.RemoveFreeNotification( Self );
{$ENDIF}
  if Value <> Nil then
  begin
    Value.FreeNotification( Self );
    //Color := value.Color;
    RubberPen.Color := clRed;
    ScrollBars := ssNone;
    Cursor := crDefault;
    IsAerial := True;
  end;
  FParentView:= Value;
  if not (csDesigning in ComponentState) then
  begin
    Gis:= FindGis;
    If Gis <> Nil Then
      ZoomToExtension;
  end;
End;

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

procedure TEzMosaicView.BeginRepaint;
begin
  FSavedDrawLimit:= Ez_Preferences.MinDrawLimit;
  Ez_Preferences.MinDrawLimit:= Ez_Preferences.AerialMinDrawLimit;
  inherited;
end;

procedure TEzMosaicView.EndRepaint;
begin
  Ez_Preferences.MinDrawLimit:= FSavedDrawLimit;
  inherited;
end;

function TEzMosaicView.GetAbout: TEzAbout;
begin
  Result:= SEz_GisVersion;
end;

procedure TEzMosaicView.SetAbout(const Value: TEzAbout);
begin
end;

end.