prndbgeh.pas

来自「EHlib CN For Delphi2009」· PAS 代码 · 共 1,912 行 · 第 1/5 页

          else
          begin
            APBm.bm := Pointer(0); //Pointer(0);
            APBm.EOF := False;
          end
        end else
        begin
          APBm.bm := DBGridEh.DataSource.DataSet.Bookmark;
          APBm.EOF := False;
        end;
      end else
      begin
        DBGridEh.DataSource.DataSet.Next;
        if DBGridEh.DataSource.DataSet.Eof then
        begin
          APBm.InDS := False;
          APBm.bm := nil; //nil;
          if (DBGridEh.FooterRowCount = 0)
            then APBm.EOF := True
          else
          begin
            APBm.bm := Pointer(0); //Pointer(0);
            APBm.EOF := False;
          end;
        end else
        begin
          APBm.bm := DBGridEh.DataSource.DataSet.Bookmark;
          APBm.EOF := False;
        end
      end
    end
    else
    begin
      if (DBGridEh.FooterRowCount - 1 <= Byte(APBm.bm)) then
      begin
        APBm.EOF := True;
        APBm.bm := Pointer(0); //Pointer(0);
        APBm.InDS := False;
      end else
      begin
        APBm.bm[0] := APBm.bm[0] + 1;
      end;
    end;
  end;

{  function ComparePolyBookmark(var APBm1,APBm2:TPolyBookmark):Boolean;
  begin
    if (APBm1.bm = APBm2.bm) and (APBm1.InDS = APBm2.InDS) then
      Result := True
    else Result := False;
  end;}

  procedure AddPolyline(const Args: array of const);
  var
    AFrom, i: Integer;
  begin
    AFrom := Length(PolyPolyPoints);
    SetLength(PolyPolyPoints, Length(PolyPolyPoints) + (Length(Args) div 2));
    i := 0;
    while i < (Length(Args) div 2) do
    begin
{$IFDEF CIL}
      PolyPolyPoints[i + AFrom] := Point(Integer(Args[i*2]), Integer(Args[i*2+1]));
{$ELSE}
      PolyPolyPoints[i + AFrom] := Point(Args[i*2].VInteger, Args[i*2+1].VInteger);
{$ENDIF}
      Inc(i);
    end;
    SetLength(PolyLengths, Length(PolyLengths) + 1);
    PolyLengths[Length(PolyLengths)-1] := (High(Args) + 1) div 2;
  end;

  procedure CalcColumnWidths;
  var i, w, w1, tw: Integer;
    PM: TPolyBookmark;
    NewBackgrnd: TColor;
    Text: String;
    AAlignment: TAlignment;
    ACursor: TCursor;
    function GetTitleText(Column: TColumnEh): String;
    var i: Integer;
    begin
      if DBGridEh.UseMultiTitle then
        for i := Length(Column.Title.Caption) downto 1 do
          if (Column.Title.Caption[i] = '|') and (ByteType(Column.Title.Caption, i) = mbSingleByte) then
          begin
            Result := Copy(Column.Title.Caption, i, Length(Column.Title.Caption));
            Exit;
          end;
      Result := Column.Title.Caption;
    end;
  begin
    w := 0;
    for i := 0 to PrnColumns.Count - 1 do
    begin
//      PrnColumnWidths.Add(Pointer(Round((PrnColumns[i].Width + 1) * fScaleX)));
      SetLength(PrnColumnWidths, Length(PrnColumnWidths) + 1);
      PrnColumnWidths[Length(PrnColumnWidths)-1] :=
         (Round((PrnColumns[i].Width + 1) * fScaleX));

      Inc(w, Integer(PrnColumnWidths[i]));
    end;

    if (pghOptimalColWidths in Options) then
    begin
      CreateRenderCanvas;
      for i := 0 to PrnColumns.Count - 1 do
      begin
        PrnColumnWidths[i] := 10;
        if (DBGridEh.TitleImages <> nil) and (PrnColumns[i].Title.ImageIndex <> -1) then
          tw := Trunc(DBGridEh.TitleImages.Width * fScaleX) + PSX2 * 2
        else
        begin
          VPrinter_Canvas.Font := PrnColumns[i].Title.Font;
          if (PrintFontName <> '') then VPrinter_Canvas.Font.Name := PrintFontName;
          tw := GetTextWidth(VPrinter_Canvas, GetTitleText(PrnColumns[i])) + PSX2 * 2;
        end;
        if tw > Integer(PrnColumnWidths[i]) then
          PrnColumnWidths[i] := tw;
      end;
      DBGridEh.DataSource.DataSet.First;
      InitPolyBookmark(PM);
      ACursor := Screen.Cursor;
      Screen.Cursor := crHourGlass;
      try
        while not PM.Eof do
        begin
          for i := 0 to PrnColumns.Count - 1 do
          begin
            if PM.InDS then //Data
            begin
              case PrnColumns[i].GetColumnType of
                ctCheckboxes: tw := Trunc(FCheckBoxWidth * fScaleX) + PSX2 * 2;
                ctKeyImageList: tw := Trunc(PrnColumns[i].ImageList.Width * fScaleX) + PSX2 * 2;
              else
                VPrinter_Canvas.Font := PrnColumns[i].Font;
                if (PrintFontName <> '') then VPrinter_Canvas.Font.Name := PrintFontName;


                NewBackgrnd := clWhite;

                with FColCellParamsEh do
                begin
                  Row := -1;
                  Col := -1;
                  State := [];
                  Font := VPrinter_Canvas.Font;
                  Background := clWhite;
                  Alignment := taLeftJustify;
                  ImageIndex := -1;
                  Text := PrnColumns[i].DisplayText;
                  CheckboxState := PrnColumns[i].CheckboxState;

                  if Assigned(DBGridEh.OnGetCellParams) then
                    DBGridEh.OnGetCellParams(DBGridEh, PrnColumns[i], Font, NewBackgrnd, []);

                  Background := NewBackgrnd;
                  PrnColumns[i].GetColCellParams(False, FColCellParamsEh);

                  tw := GetTextWidth(VPrinter_Canvas, FColCellParamsEh.Text) + PSX2 * 2;
                  if (PrnColumns[i].ImageList <> nil) and PrnColumns[i].ShowImageAndText then
                    Inc(tw, Trunc(PrnColumns[i].ImageList.Width * fScaleX + 4 * fScaleX + fScaleX));
                  if (PrnColumns[i] = DBGridEh.VisibleColumns[0]) and (DBGridEh.GetCellTreeElmentsAreaWidth > 0) then
                    Inc(tw, Trunc(DBGridEh.GetCellTreeElmentsAreaWidth * fScaleX + fScaleX));
                end;
              end;
            end else
            begin //Footer
              VPrinter_Canvas.Font := PrnColumns[i].UsedFooter(Byte(PM.bm)).Font;
              if (PrintFontName <> '') then VPrinter_Canvas.Font.Name := PrintFontName;
              Text := DBGridEh.GetFooterValue(Byte(PM.bm), PrnColumns[i]);
              AAlignment := PrnColumns[i].UsedFooter(Byte(PM.bm)).Alignment;
              if Assigned(DBGridEh.OnGetFooterParams) then
                DBGridEh.OnGetFooterParams(DBGridEh, PrnColumns[i].Index, Byte(PM.bm), PrnColumns[i],
                  VPrinter_Canvas.Font, NewBackgrnd, AAlignment, [], Text);
              tw := GetTextWidth(VPrinter_Canvas, Text) + PSX2 * 2;
            end;
            if tw > Integer(PrnColumnWidths[i]) then
              PrnColumnWidths[i] := tw;
          end;
          SetNextPolyBookmark(PM);
        end;
      finally
        Screen.Cursor := ACursor;
      end;
      DBGridEh.DataSource.DataSet.First;
      w := 0;
      for i := 0 to PrnColumns.Count - 1 do
        Inc(w, Integer(PrnColumnWidths[i]));
      FreeRenderCanvas;
    end;

    if ([pghFitingByColWidths, pghFitGridToPageWidth] * Options = [pghFitingByColWidths, pghFitGridToPageWidth]) and
      (w > DataPrintRec.Right - DataPrintRec.Left - PenW) then
    begin
      w1 := 0;
      for i := 0 to PrnColumns.Count - 1 do
      begin
        PrnColumnWidths[i] := MulDiv(Integer(PrnColumnWidths[i]), DataPrintRec.Right - DataPrintRec.Left - PenW, w);
        Inc(w1, Integer(PrnColumnWidths[i]));
      end;
      if w1 > DataPrintRec.Right - DataPrintRec.Left - PenW then
        PrnColumnWidths[PrnColumns.Count - 1] :=
          Integer(PrnColumnWidths[PrnColumns.Count - 1]) -
          w1 + (DataPrintRec.Right - DataPrintRec.Left - PenW);
    end;
  end;

  procedure CalcColsToPages;
  var curX, w: Integer;
    i: Integer;
  begin
    curX := DataPrintRec.Left + PenW;
    // PrnColWIdths.Clear;
    SetLength(PrnColWIdths, 0);
    SetLength(ColsToPages, 0);
    for i := 0 to PrnColumns.Count - 1 do
    begin
      w := Integer(PrnColumnWidths[i]);
      if (w > DataPrintRec.Right - DataPrintRec.Left)
        then w := DataPrintRec.Right - DataPrintRec.Left;
//      PrnColWidths.Add(Pointer(w));
      SetLength(PrnColWidths, Length(PrnColWidths) + 1);
      PrnColWidths[Length(PrnColWidths)-1] := w;
      curX := curX + w;
      if (curX > DataPrintRec.Right) and (i > 0) then
      begin
//        ColsToPages.Add(Pointer(i - 1));
        SetLength(ColsToPages, Length(ColsToPages)+1);
        ColsToPages[Length(ColsToPages)-1] := i - 1;

        curX := DataPrintRec.Left + w + PenW;
      end;
    end;
//    ColsToPages.Add(Pointer(PrnColumns.Count - 1));
    SetLength(ColsToPages, Length(ColsToPages)+1);
    ColsToPages[Length(ColsToPages)-1] := PrnColumns.Count - 1;
  end;

  function GetScaledRealGridWidth: Integer;
  var i: Integer;
  begin
    Result := PenW;
    for i := 0 to PrnColumns.Count - 1 do
    begin
      Result := Result + Integer(PrnColumnWidths[i]);
    end;
  end;

  function GetPrintGridWidth: Integer;
  var i: Integer;
  begin
    Result := 0;
    for i := 0 to Length(PrnColWidths) - 1 do
    begin
      Result := Result + Integer(PrnColWidths[i]);
    end;
  end;

  procedure DrawClipped(imList: TCustomImageList;
    ACanvas: TCanvas; ARect: TRect; Index: Integer; Align: TAlignment);
  var CheckedRect, AUnionRect: TRect;
    OldRectRgn, RectRgn: HRGN;
    r, x, y: Integer;
    ImHeight, ImWidth: Integer;
    bm: TBitmap;
{$IFDEF CIL}
    Info: IntPtr;
    BMPInfo: TBitmapInfo;
    InfoSize: DWORD;
    Image: TBytes;
    I: Integer;
{$ELSE}
    Info: PBitmapInfo;
    InfoSize: DWORD;
    Image: Pointer;
{$ENDIF}
    ImageSize: DWORD;
    Bits: HBITMAP;
    DIBWidth, DIBHeight: Longint;
    PrintWidth, PrintHeight: Longint;
    RealRect: TRect;
  begin
    if CalcInfoMode then Exit;
    if (Index < 0) or (Index >= imList.Count) then Exit;
    ImHeight := Trunc(imList.Height * fScaleY);
    ImWidth := Trunc(imList.Width * fScaleX);
    case Align of
      taLeftJustify: x := ARect.Left;
      taRightJustify: x := ARect.Right - ImWidth;
    else
      x := (ARect.Right + ARect.Left - ImWidth) div 2;
    end;
    y := (ARect.Bottom + ARect.Top - ImHeight) div 2;
    CheckedRect := Rect(X, Y, X + ImWidth, Y + ImHeight);
    UnionRect(AUnionRect, CheckedRect, ARect);
    bm := TBitmap.Create;
    r := 0;
    OldRectRgn := 0;
    try
      //imList.BkColor := VPrinter_Canvas.Brush.Color; to avoid ImageListChange event //??? to avoid ImageListChange event
      bm.Canvas.Brush.Color := VPrinter_Canvas.Brush.Color;
      imList.GetBitmap(Index, bm);
      if EqualRect(AUnionRect, ARect) then // ARect containt image
//        VPrinter_Canvas.StretchDraw(CheckedRect,bm)
      else
      begin // Need clip
        OldRectRgn := CreateRectRgn(0, 0, VPrinter.PageWidth, VPrinter.PageHeight);
        r := GetClipRgn(ACanvas.Handle, OldRectRgn);
        RealRect := ARect;
        if (pghFitGridToPageWidth in Options) and (GridWidth > (RealRight - RealLeft)) then
        begin
         // CreateRectRgn don't support viewport
          RealRect.Right := MulDiv(RealRect.Right, RealRight - RealLeft, GridWidth);
          RealRect.Left := MulDiv(RealRect.Left, RealRight - RealLeft, GridWidth);
          RealRect.Top := MulDiv(RealRect.Top, RealRight - RealLeft, GridWidth);
          RealRect.Bottom := MulDiv(RealRect.Bottom, RealRight - RealLeft, GridWidth);
        end;
        RectRgn := CreateRectRgn(RealRect.Left, RealRect.Top, RealRect.Right, RealRect.Bottom);
        SelectClipRgn(ACanvas.Handle, RectRgn);
        DeleteObject(RectRgn);
//        VPrinter_Canvas.StretchDraw(CheckedRect,bm);
//        I have problem with StretchDraw when metafile is based on Printer.Handle
//        I will use StretchDIBits
      end;

      ACanvas.Lock;
      try
        { Paint bitmap to the printer }
        with VPrinter, ACanvas do
        begin
          Bits := bm.Handle;
          GetDIBSizes(Bits, InfoSize, ImageSize);
{$IFDEF CIL}
          Info := Marshal.AllocHGlobal(InfoSize);
          try
            for I := 0 to InfoSize - 1 do
              Marshal.WriteByte(Info, I, 0);
            SetLength(Image, ImageSize);
            GetDIB(Bits, 0, Info, Image);
            BMPInfo := TBitmapInfo(Marshal.PtrToStructure(Info, TypeOf(TBitmapInfo)));
            with BMPInfo.bmiHeader do
            begin
              DIBWidth := biWidth;
              DIBHeight := biHeight;
            end;
            PrintWidth := CheckedRect.Right - CheckedRect.Left;
            PrintHeight := CheckedRect.Bottom - CheckedRect.Top;
            Marshal.StructureToPtr(TObject(BMPInfo), Info, True);
            StretchDIBits(Canvas.Handle, 0, 0, PrintWidth, PrintHeight, 0, 0,
              DIBWidth, DIBHeight, Image, Info, DIB_RGB_COLORS, SRCCOPY);
          finally
            Marshal.FreeHGlobal(Info);
          end;
{$ELSE}
          Info := AllocMem(InfoSize);
          try
            Image := AllocMem(ImageSize);
            try
              GetDIB(Bits, 0, Info^, Image^);
              with Info^.bmiHeader do
              begin
                DIBWidth := biWidth;
                DIBHeight := biHeight;
              end;
              PrintWidth := CheckedRect.Right - CheckedRect.Left;
              PrintHeight := CheckedRect.Bottom - CheckedRect.Top;
              StretchDIBits(Canvas.Handle, CheckedRect.Left, CheckedRect.Top, PrintWidth, PrintHeight, 0, 0,
                DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
            finally
              FreeMem(Image, ImageSize);
            end;
          finally
            FreeMem(Info, InfoSize);
          end;
{$ENDIF}
        end;
      finally
        ACanvas.Unlock;
      end;

      if not EqualRect(AUnionRect, ARect) then // ARect containt image
      begin