ezmiscelentities.pas

很管用的GIS控件

  TmpMarginX: double;
  TmpMarginY: double;
  Rgn: HRgn;
  PenStyle: TEzPenStyle;
  PtArr: Array[0..5] of TPoint;
  Repit: Integer;
  e:TEzRect;
  GraphicLink: TEzGraphicLink;
  filnam: string;
  TheRowHeight:Double;

  procedure BitmapToPrinter(DestRect: TRect;
    ABitmap: TBitmap; L, T, W, H: Integer);
  var
    Info: PBitmapInfo;
    Image: Pointer;
    Tc: Integer;
    InfoSize, ImageSize: DWORD;
  begin
    GetDIBSizes(ABitmap.Handle, InfoSize, ImageSize);
    Info := AllocMem(InfoSize);
    Image := GlobalAllocPtr(HeapAllocFlags, ImageSize);
    try
      with ABitmap do
        GetDIB(Handle, Palette, Info^, Image^);
      Tc := T;
      if Info^.bmiHeader.biHeight > 0 then
        Tc := Info^.bmiHeader.biHeight - H - T;
      with DestRect do
        StretchDIBits(Canvas.Handle, Left, Top, (Right - Left), (Bottom - Top),
          L, Tc, W, H, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
    finally
      if InfoSize < 65535 then
        FreeMem(Info,InfoSize)
      else
        GlobalFreePtr(Info);
      GlobalFreePtr(Image);
    end;
  end;

  procedure MyPrintBitmap(abmp: TBitmap);
  var
    hPaintPal, hOldPal: HPalette;                  {Used for realizing the palette}
  begin
    InflateRect(R,-2,-2);
    hPaintPal:= abmp.Palette;
    hOldPal:= SelectPalette(Canvas.Handle, hPaintPal, False);
    try
      RealizePalette(Canvas.Handle);
      SetStretchBltMode(Canvas.Handle, STRETCH_DELETESCANS);
      if Grapher.Device = adScreen then    // this goes to the screen
      begin
        StretchBlt(Canvas.Handle, R.Left, R.Top,
          (R.Right - R.Left), (R.Bottom - R.Top),
          abmp.Canvas.Handle, 0, 0, abmp.Width, abmp.Height, SRCCOPY);
      end else    // this goes to the printer
      begin
          BitmapToPrinter(R,abmp,0,0,abmp.Width,abmp.Height);
      end;
    finally
      if hOldPal <> 0 then
        SelectPalette(Canvas.Handle, hOldPal, False);
    end;
  end;

Begin
  TmpR.Emin := FPoints[0];
  TmpR.Emax := FPoints[1];
  TmpR := ReorderRect2D( TmpR );
  GridRect := Grapher.RealToRect( TmpR );
  Inherited Draw( Grapher, Canvas, Clip, DrawMode );
  If ( DrawMode In [dmRubberPen, dmSelection] ) Or
     ( FRowCount < 1 ) Or ( Columns.Count < 1 ) Then
  Begin
    If DrawMode = dmNormal Then
    Begin
      txt := SEmptyTable;
      Canvas.Font.Size := 9;
      Canvas.Font.Color := clBlack;
      Canvas.Font.Style := [];
      DrawText( Canvas.Handle, PChar( txt ), -1, GridRect,
        dt_singleline Or dt_vcenter Or dt_center );
    End;
    Exit;
  End;

  // Calculate row height (FRowHeight is ignored because it is causing drawing problems )
  TheRowHeight:= Abs(TmpR.Emax.Y - TmpR.Emin.Y ) / Succ( FRowCount ) ;

  { calculate parameters }
  OuterLineWidth := Grapher.RealToDistX( PenTool.FPenStyle.Scale );
  OuterLineHeight := Grapher.RealToDistY( PenTool.FPenStyle.Scale );
  GridLineWidth := Grapher.RealToDistX( FGridStyle.Width );
  //GridLineHeight  := Grapher.RealToDistY(FGridStyle.Width);
  GridRowHeight := Grapher.RealToDistY( TheRowHeight );
  //GridRowHeight := Abs( GridRect.Bottom - GridRect.Top - OuterLineHeight ) Div ( FRowCount + 1 );
  GridWidth := Abs( GridRect.Right - GridRect.Left - OuterLineWidth );
  N := 0;
  For i := 0 To Columns.Count - 2 Do
  Begin
    GridColWidths[i] := Grapher.RealToDistX( Columns[i].Width );
    Inc( N, GridColWidths[i] );
  End;
  GridColWidths[Columns.Count - 1] := EzLib.IMax( 0, GridWidth - N );
  { calculate grid cells border width in pixels }
  If FBorderWidth > 0 Then
  Begin
    BorderWidthPix := Grapher.RealToDistX( FBorderWidth );
    BorderHeightPix := Grapher.RealToDistY( FBorderWidth );
  End
  Else
  Begin
    BorderWidthPix := 0;
    BorderHeightPix := 0;
  End;

  { now draw the text }
  X := GridRect.Left + ( OuterLineWidth Div 2 );
  N := Columns.Count;
  For J := 0 To N - 1 Do
  Begin
    Rect.Left := X;
    Rect.Right := X + GridColWidths[J] - 1;
    Y := GridRect.Top + ( OuterLineHeight Div 2 );
    For I := 1 To Succ( FRowCount ) Do
    Begin
      Rect.Top := Y;
      Rect.Bottom := Y + GridRowHeight - 1;
      R := Rect;
      If I = 1 Then
      Begin
        // the title
        //Canvas.brush.style:=bsclear;
        //with R do Canvas.rectangle(left,top,right,bottom);
        If Not FOwnerDraw Or FDefaultDrawing Then
        Begin
          If J = 0 Then
            R.Left := R.Left + BorderWidthPix
          Else
            R.Left := R.Left + ( BorderWidthPix Div 2 );
          R.Top := R.Top + BorderHeightPix;
          R.Right := R.Right - ( BorderWidthPix Div 2 );
          R.Bottom := R.Bottom - ( BorderHeightPix Div 2 );
          { pinta el relleno de la celda }
          With Canvas Do
          Begin
            If Not Columns[J].Title.FTransparent Then
            Begin
              Brush.Style := bsSolid;
              Brush.Color := Columns[J].Title.FColor;
              FillRect( R );
            End;
            { dibuja el rectangulo exterior de la celda }
            Pen.Style:=psSolid;
            Pen.Width := IMax( 1, GridLineWidth );
            Pen.Color := FGridStyle.Color;
            With R Do
            Begin
              if ezgoHorzLine in FOptions then
              begin
                MoveTo( Left, Top );
                LineTo( Right, Top );
              end;
              if ezgoVertLine in FOptions then
              begin
                MoveTo( Left, Top );
                LineTo( Left, Bottom );
              end;
            End;
            Pen.Color := FLoweredColor;
            With R Do
            Begin
              if ezgoHorzLine in FOptions then
              begin
                Moveto( Left, Bottom );
                Lineto( Right, Bottom );
              end;
              if ezgoVertLine in FOptions then
              begin
                Moveto( Right, Bottom );
                Lineto( Right, Top );
              end;
            End;
            InflateRect( R, -Pen.Width, -Pen.Width );
          End;
        End;
        If Not FOwnerDraw Then
        Begin
          With Columns[J].Title Do
          Begin
            TmpHeight := IMax( 1, Abs( Grapher.RealToDistY( FFont.Height ) ) );
            TmpHeight := IMin( TmpHeight, ( R.Bottom - R.Top ) - 2 );
            With Canvas.Font Do
            Begin
              Name := FFont.Name;
              Style := FFont.Style;
              Height := TmpHeight;
              Color := FFont.Color;
            End;
            Case FAlignment Of
              taLeftJustify: uFormat := DT_LEFT;
              taRightJustify: uFormat := DT_RIGHT;
              taCenter: uFormat := DT_CENTER;
            Else
              uFormat := DT_LEFT;
            End;
          End;
          SetBkMode( Canvas.Handle, TRANSPARENT );
          DrawText( Canvas.Handle, PChar( Columns[J].Title.FCaption ), -1, R,
            uFormat Or DT_VCENTER Or DT_SINGLELINE );
        End
        Else If Assigned( FOnDrawCell ) Then
          FOnDrawCell( Self, J, I - 1, Canvas, Grapher, R );
      End
      Else
      Begin
        // the row
        //Canvas.brush.style:=bsclear;
        //with R do Canvas.rectangle(left,top,right,bottom);
        If J = 0 Then
          R.Left := R.Left + BorderWidthPix
        Else
          R.Left := R.Left + ( BorderWidthPix Div 2 );
        R.Top := R.Top + ( BorderHeightPix Div 2 );
        R.Right := R.Right - ( BorderWidthPix Div 2 );
        R.Bottom := R.Bottom - ( BorderHeightPix Div 2 );
        { pinta el relleno de la celda }
        If FDefaultDrawing Then
        Begin
          With Canvas Do
          Begin
            If Not Columns[J].FTransparent Then
            Begin
              Brush.Style := bsSolid;
              Brush.Color := Columns[J].FColor;
              FillRect( R );
            End;
            { dibuja el rectangulo exterior de la celda }
            Pen.Style:=psSolid;
            Pen.Width := IMax( 1, GridLineWidth );
            Pen.Color := FGridStyle.Color;
            With R Do
            Begin
              if ezgoHorzLine in FOptions then
              begin
                MoveTo( Left, Top );
                LineTo( Right, Top );
              end;
              if ezgoVertLine in FOptions then
              begin
                MoveTo( Left, Top );
                LineTo( Left, Bottom );
              end;
            End;
            Pen.Color := FLoweredColor;
            With R Do
            Begin
              if ezgoHorzLine in FOptions then
              begin
                Moveto( Left, Bottom );
                Lineto( Right, Bottom );
              end;
              if ezgoVertLine in FOptions then
              begin
                Moveto( Right, Bottom );
                Lineto( Right, Top );
              end;
            End;
            InflateRect( R, -Pen.Width, -Pen.Width );
          End;
        End;
        If Not FOwnerDraw Then
        Begin
          uFormat := DT_LEFT;
          If I = 2 Then
          begin
            With Columns[J] Do
            Begin
              TmpHeight := IMax( 1, Abs( Grapher.RealToDistY( FFont.Height ) ) );
              TmpHeight := IMin( TmpHeight, ( R.Bottom - R.Top ) - 2 );
              With Canvas.Font Do
              Begin
                Name := FFont.Name;
                Style := FFont.Style;
                Height := TmpHeight;
                Color := FFont.Color;
              End;
            End;
          End;
          Case Columns[J].FAlignment Of
            taLeftJustify: uFormat := DT_LEFT;
            taRightJustify: uFormat := DT_RIGHT;
            taCenter: uFormat := DT_CENTER;
          End;
          txt := Columns[J].Strings[I - 2];
          case Columns[J].ColumnType of
            ctLabel:
              begin
                SetBkMode( Canvas.Handle, TRANSPARENT );
                DrawText( Canvas.Handle, PChar( txt ), -1, R, uFormat Or DT_VCENTER Or DT_SINGLELINE );
              end;
            ctColor:
              begin
                ValInteger:= StrToIntDef(txt,0);
                InflateRect( R, -2, -2 );
                Canvas.Brush.Style:= bsSolid;
                Canvas.Brush.Color:= ValInteger;
                with R do Canvas.Rectangle(left, top, right, bottom);
                Canvas.Brush.Style:= bsClear;
              end;
            ctLineStyle:
              begin
                ValInteger:= StrToIntDef(txt,0);
                { DRAW THE LINE TYPE }
                TmpGrapher:= TEzGrapher.Create(10,Grapher.Device);
                try
                  EzMiscelCtrls.DrawLinetype(TmpGrapher, Canvas, ValInteger,
                    R, [], clBlack, Columns[J].Color,False, 0, 2, false, true, false );
                finally
                  TmpGrapher.free;
                end;
              end;
            ctBrushStyle:
              begin
                ValInteger:= StrToIntDef(txt,0);

                InflateRect( R, -2, -2 );

                EzMiscelCtrls.DrawPattern( Canvas,ValInteger,clBlack,clWhite,
                  Columns[J].Color,R,false, [], false, true, false);

              end;
            ctSymbolStyle:
              begin
                ValInteger:= StrToIntDef(txt,0);
                TmpGrapher:= TEzGrapher.Create(10,Grapher.Device);
                try
                  EzMiscelCtrls.DrawSymbol( TmpGrapher, Canvas, ValInteger,
                    R, [], Columns[J].Color, false, true, false);
                finally
                  TmpGrapher.free;
                end;
              end;
            ctBitmap:
              begin
                GraphicLink:= TEzGraphicLink.Create;
                try
                  filnam := AddSlash( Ez_Preferences.CommonSubDir ) + txt;
                  If FileExists( filnam ) Then
                    GraphicLink.ReadGeneric( filnam );
                  MyPrintBitmap(GraphicLink.Bitmap);
                finally
                  GraphicLink.Free;
                end;
              end;
          end;
        End
        Else If Assigned( FOnDrawCell ) Then
          FOnDrawCell( Self, J, I - 1, Canvas, Grapher, R );
      End;

      Inc( Y, GridRowHeight - 1 );
    End;

    Inc( X, GridColWidths[J] - 1 );
  End;
End;

function TEzTableEntity.GetControlPoints(TransfPts: Boolean; Grapher: TEzGrapher=Nil): TEzVector;
Var
  TmpR: TEzRect;
  Movept: TEzPoint;
  i: Integer;
  Accum: TEzPoint;
  //TheRowHeight: Double;
Begin
  Result := TEzVector.Create( 8 );
  TmpR.Emin := FPoints[0];
  TmpR.Emax := FPoints[1];
  TmpR := ReorderRect2D( TmpR );
  With Result Do
  Begin
    Add( TmpR.Emin ); // LOWER LEFT
    AddPoint( ( TmpR.Emin.X + TmpR.Emax.X ) / 2, TmpR.