ezpreview.pas

很管用的GIS控件

  result := Inches2Units( FPaperUnits, FPrinterMarginTop );
End;

Function TEzPreviewBox.GetMarginBottom: Double;
Begin
  result := Inches2Units( FPaperUnits, FPrinterMarginBottom );
End;

Function TEzPreviewBox.GetMarginRight: Double;
Begin
  result := Inches2Units( FPaperUnits, FPrinterMarginRight );
End;

Function TEzPreviewBox.GetPaperWidth: Double;
Begin
  If FPaperSize = psPrinter Then
    result := FPrinterPaperWidth
  Else
    result := FCustomPaperWidth;
  result := Inches2Units( FPaperUnits, result );
End;

Function TEzPreviewBox.GetPaperHeight: Double;
Begin
  If FPaperSize = psPrinter Then
    result := FPrinterPaperHeight
  Else
    result := FCustomPaperHeight;
  result := Inches2Units( FPaperUnits, result );
End;

Procedure TEzPreviewBox.SetPaperWidth( Const Value: Double );
Begin
  FCustomPaperWidth := Units2Inches( FPaperUnits, abs( Value ) );
End;

Procedure TEzPreviewBox.SetPaperHeight( Const Value: Double );
Begin
  FCustomPaperHeight := Units2Inches( FPaperUnits, abs( Value ) );
End;

Procedure TEzPreviewBox.SetOrientation( Value: TPrinterOrientation );
Var
  temp: Double;
Begin
  If ( FPaperSize = psPrinter ) Or ( Value = FOrientation ) Then Exit;
  FOrientation := Value;
  temp := FCustomPaperWidth;
  FCustomPaperWidth := FCustomPaperHeight;
  FCustomPaperHeight := temp;
End;

Procedure TEzPreviewBox.SetPaperSize( Const Value: TEzPaperSize );
Var
  ps, pt: TPoint;
  GutterLeft: Integer;
  GutterTop: Integer;
  GutterRight: Integer;
  GutterBottom: Integer;
  PrinterDpiX: Integer;
  PrinterDpiY: Integer;
Begin
  FPaperSize := Value;
  { determine paper dimensions }
  Escape( Printer.Handle, GETPHYSPAGESIZE, 0, Nil, @ps );
  Escape( Printer.Handle, GETPRINTINGOFFSET, 0, Nil, @pt );
  GutterLeft := pt.X;
  GutterTop := pt.Y;
  GutterRight := ps.X - GutterLeft - Printer.PageWidth;
  GutterBottom := ps.Y - GutterTop - Printer.PageHeight;
  If Not EzLib.PrintersInstalled Then Exit;

  PrinterDpiX := GetDeviceCaps( Printer.Handle, LOGPIXELSX );
  PrinterDpiY := GetDeviceCaps( Printer.Handle, LOGPIXELSY );

  FPrinterMarginLeft := GutterLeft / PrinterDpiX;
  FPrinterMarginTop := GutterTop / PrinterDpiY;
  FPrinterMarginRight := GutterRight / PrinterDpiX;
  FPrinterMarginBottom := GutterBottom / PrinterDpiY;
  FPrinterPaperWidth := ps.X / PrinterDpiX;
  FPrinterPaperHeight := ps.Y / PrinterDpiY;

  Case Value Of
    psPrinter:
      Begin
        FCustomPaperWidth := FPrinterPaperWidth;
        FCustomPaperHeight := FPrinterPaperHeight;
      End;
    psLetter:
      Begin
        FCustomPaperWidth := 8.5;
        FCustomPaperHeight := 11;
      End;
    psLegal:
      Begin
        FCustomPaperWidth := 8.5;
        FCustomPaperHeight := 14;
      End;
    psLedger:
      Begin
        FCustomPaperWidth := 11;
        FCustomPaperHeight := 17;
      End;
    psStatement:
      Begin
        FCustomPaperWidth := 5.5;
        FCustomPaperHeight := 8.5;
      End;
    psExecutive:
      Begin
        FCustomPaperWidth := 7.25;
        FCustomPaperHeight := 10.5;
      End;
    psA3:
      Begin
        FCustomPaperWidth := 11.69;
        FCustomPaperHeight := 16.54;
      End;
    psA4:
      Begin
        FCustomPaperWidth := 8.27;
        FCustomPaperHeight := 11.69;
      End;
    psA5:
      Begin
        FCustomPaperWidth := 5.83;
        FCustomPaperHeight := 8.27;
      End;
    psB3:
      Begin
        FCustomPaperWidth := 14.33;
        FCustomPaperHeight := 20.28;
      End;
    psB4:
      Begin
        FCustomPaperWidth := 10.12;
        FCustomPaperHeight := 14.33;
      End;
    psB5:
      Begin
        FCustomPaperWidth := 7.17;
        FCustomPaperHeight := 10.12;
      End;
    psFolio:
      Begin
        FCustomPaperWidth := 8.5;
        FCustomPaperHeight := 13;
      End;
    psQuarto:
      Begin
        FCustomPaperWidth := 8.47;
        FCustomPaperHeight := 10.83;
      End;
    ps10x14:
      Begin
        FCustomPaperWidth := 10;
        FCustomPaperHeight := 14;
      End;
    ps11x17:
      Begin
        FCustomPaperWidth := 11;
        FCustomPaperHeight := 17;
      End;
    psCsize:
      Begin
        FCustomPaperWidth := 17;
        FCustomPaperHeight := 22;
      End;
    psUSStdFanfold:
      Begin
        FCustomPaperWidth := 11;
        FCustomPaperHeight := 14.88;
      End;
    psGermanStdFanfold:
      Begin
        FCustomPaperWidth := 8.5;
        FCustomPaperHeight := 12;
      End;
    psGermanLegalFanfold:
      Begin
        FCustomPaperWidth := 8.5;
        FCustomPaperHeight := 13;
      End;
    ps6x8:
      Begin
        FCustomPaperWidth := 6;
        FCustomPaperHeight := 8;
      End;
    psFoolscap:
      Begin
        FCustomPaperWidth := 13.5;
        FCustomPaperHeight := 17;
      End;
    psLetterPlus:
      Begin
        FCustomPaperWidth := 9;
        FCustomPaperHeight := 13.3;
      End;
    psA4Plus:
      Begin
        FCustomPaperWidth := 8.77;
        FCustomPaperHeight := 14;
      End;
  End;
End;

Procedure TEzPreviewBox.SetPaperPen( Value: TPen );
Begin
  FPaperPen.Assign( Value );
  SetPaperShapeAttributes;
End;

Procedure TEzPreviewBox.SetPaperBrush( Value: TBrush );
Begin
  FPaperBrush.Assign( Value );
  SetPaperShapeAttributes;
End;

Procedure TEzPreviewBox.SetShadowPen( Value: TPen );
Begin
  FShadowPen.Assign( Value );
  SetPaperShapeAttributes;
End;

Procedure TEzPreviewBox.SetShadowBrush( Value: TBrush );
Begin
  FShadowBrush.Assign( Value );
  SetPaperShapeAttributes;
End;

Procedure TEzPreviewBox.AddMap( Index: Integer; Const OutX, OutY, WidthOut, HeightOut,
  PlottedUnits, DrawingUnits, CoordX, CoordY: Double; IsAtCenter: Boolean );
Var
  Preview: TEzPreviewEntity;
  PrintView: TEzRect;
  DrawingScale, WidthArea, HeightArea: Double;
Begin
  If ( Index < 0 ) Or ( Index > FGISList.Count - 1 ) Then
    Raise Exception.Create( SGISListError );
  { calcula la escala de dibujo }
  DrawingScale := DrawingUnits / PlottedUnits;

  { ancho y alto del area en el mapa }
  WidthArea := WidthOut * DrawingScale;
  HeightArea := HeightOut * DrawingScale;

  If IsAtCenter Then
  Begin
    With PrintView Do
    Begin
      Emin.X := CoordX - WidthArea / 2;
      Emin.Y := CoordY - HeightArea / 2;
      Emax.X := CoordX + WidthArea / 2;
      Emax.Y := CoordY + HeightArea / 2;
    End;
  End
  Else
  Begin
    With PrintView Do
    Begin
      Emin.X := CoordX;
      Emin.Y := CoordY - HeightArea;
      Emax.X := CoordX + WidthArea;
      Emax.Y := CoordY;
    End;
  End;
  Preview := TEzPreviewEntity.CreateEntity( Point2D( OutX, OutY ),
    Point2D( OutX + WidthOut, ( OutY - HeightOut ) ), pmAll, Index );
  Try
    //Preview.PrintFrame:= False;
    //Preview.PenStyle.Style:= 0;         // don't draw the frame
    Preview.PaperUnits := Self.FPaperUnits;
    Preview.PlottedUnits := PlottedUnits;
    Preview.DrawingUnits := DrawingUnits;
    Preview.ProposedPrintArea := PrintView;
    Self.AddEntity( GIS.CurrentLayerName, Preview );
  Finally
    Preview.Free;
  End;
End;

Procedure TEzPreviewBox.SetGISList( Value: TEzGISList );
Begin
  FGISList.Assign( Value );
End;

procedure TEzPreviewBox.ZoomToFit;
var
  w,x1,y1,x2,margin:Double;
begin
  x1:=PaperShp.Points[0].X;
  x2:=PaperShp.Points[1].X;
  y1:=PaperShp.Points[0].Y;
  w:=abs(x2-x1);
  margin:= w/40;
  SetViewTo(x1-margin,y1+margin,(x1+w)+margin,y1-1);
end;


{ TEzHRuler }

Procedure MaxMinSeparation( PreviewBox: TEzPreviewBox; Var maxs, mins: Double );
Var
  azoom: integer;
  OriginalDX, CurrentDX: Double;
Begin
  With PreviewBox.Grapher Do
  Begin
    With OriginalParams.VisualWindow Do
      OriginalDX := Emax.X - Emin.X;
    With CurrentParams.VisualWindow Do
      CurrentDX := Emax.X - Emin.X;
    azoom := round( ( OriginalDX / CurrentDX ) * 100 )
  End;
  If PreviewBox.FPaperUnits = suMms Then
  Begin
    Case azoom Of
      0..24:
        Begin
          mins := 10;
          maxs := 100;
        End;
      25..49:
        Begin
          mins := 10;
          maxs := 50;
        End;
      50..100:
        Begin
          mins := 2;
          maxs := 20;
        End;
      101..MaxInt:
        Begin
          mins := 1;
          maxs := 10;
        End;
    End;
  End Else If PreviewBox.FPaperUnits = suCms Then
  Begin
    Case azoom Of
      0..24:
        Begin
          mins := 1;
          maxs := 10;
        End;
      25..49:
        Begin
          mins := 1;
          maxs := 5;
        End;
      50..100:
        Begin
          mins := 0.2;
          maxs := 2;
        End;
      101..MaxInt:
        Begin
          mins := 0.1;
          maxs := 1;
        End;
    End;
  End
  Else If PreviewBox.FPaperUnits = suInches Then
  Begin
    Case azoom Of
      0..24:
        Begin
          mins := 1 / 2;
          maxs := 4;
        End;
      25..32:
        Begin
          mins := 1 / 2;
          maxs := 2;
        End;
      33..100:
        Begin
          mins := 1 / 8;
          maxs := 1;
        End;
      101..MaxInt:
        Begin
          mins := 1 / 16;
          maxs := 1;
        End;
    End;
  End;
End;

Constructor TEzHRuler.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  Align := alTop;
  FRubberPenColor := clAqua;
  FMarksColor := clOlive;
End;

Procedure TEzHRuler.SetPreviewBox( Value: TEzPreviewBox );
Begin
{$IFDEF LEVEL5}
  if Assigned( FPreviewBox ) then FPreviewBox.RemoveFreeNotification( Self );
{$ENDIF}
  If ( Value <> Nil ) And ( Value <> FPreviewBox ) Then
  Begin
    Value.FreeNotification( Self );
    If FPreviewBox <> Nil Then
      With FPreviewBox Do
      Begin
        OnMouseMove := FBoxOnMouseMove;
        OnPaint := FBoxOnPaint;
      End;
    If Value <> Nil Then
      With value Do
      Begin
        FBoxOnMouseMove := OnMouseMove;
        FBoxOnPaint := OnPaint;

        OnMouseMove := MyOnMouseMove;
        OnPaint := MyOnPaint;
      End;
  End;
  FPreviewBox := value;
  Invalidate;
End;

Procedure TEzHRuler.MyOnMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer );
Begin
  If Assigned( FBoxOnMouseMove ) Then
    FBoxOnMouseMove( Sender, Shift, X, Y );
  If FPreviewBox = Nil Then
    Exit;
  DrawRulerPosition( FLastMousePosInRuler, pmXor );
  FLastMousePosInRuler := ScreenToClient( FPreviewBox.ClientToScreen( Point( X, Y ) ) );
  DrawRulerPosition( FLastMousePosInRuler, pmXor );
End;

Procedure TEzHRuler.MyOnPaint( Sender: TObject );
Begin
  If Assigned( FBoxOnPaint ) Then
    FBoxOnPaint( Sender );
  Self.Paint;
End;

Procedure TEzHRuler.DrawRulerPosition( p: TPoint; AMode: TPenMode );
Begin