preport.~pas

是 delphi6的函数库

Begin
  FPRControl := Nil;
  FCells := TList.Create;
  FIndex := 0;

  FMinHeight := 0;
  FDragHeight := 0;
  FLineTop := 0;
  FLineRect.left := 0;
  FLineRect.top := 0;
  FLineRect.right := 0;
  FLineRect.bottom := 0;
End;

Destructor TReportLine.Destroy;
Var
  I: Integer;
  ThisCell: TReportCell;
Begin
  For I := FCells.Count - 1 Downto 0 Do
  Begin
    ThisCell := TReportCell(FCells[I]);
    ThisCell.Free;
  End;

  FCells.Free;
  FCells := Nil;

  Inherited Destroy;
End;

Procedure TReportLine.CreateLine(LineLeft, CellNumber, PageWidth: Integer);
Var
  I: Integer;
  NewCell: TReportCell;
  CellWidth: Integer;
Begin
  CellWidth := trunc(PageWidth / CellNumber + 0.5);
  //CellWidth:=33; //李
  For I := 0 To CellNumber - 1 Do
  Begin
    NewCell := TReportCell.Create;
    FCells.Add(NewCell);
    NewCell.OwnerLine := Self;
    NewCell.CellIndex := I;
    NewCell.CellLeft := I * CellWidth + LineLeft;
    NewCell.CellWidth := CellWidth;
  End;
End;

Function TReportLine.GetLineHeight: Integer;
Begin
  If FMinHeight > FDragHeight Then Result := FMinHeight
      Else Result := FDragHeight;
End;

Function TReportLine.GetLineRect: TRect;
Var
  I: Integer;
Begin
  // 重新由各个CELL计算出该行的矩形来
  // 通知每个CELL重新计算坐标
  For I := 0 To FCells.Count - 1 Do
  Begin
    TReportCell(FCells[I]).CellIndex := I;
    TReportCell(FCells[I]).CalcCellRect;
  End;

  If FCells.Count > 0 Then
    Result.Left := TReportCell(FCells.First).CellLeft;
  Result.Top := FLineTop;
  Result.Bottom := Result.Top + LineHeight;
  Result.Right := Result.Left;

  For I := 0 To FCells.Count - 1 Do
    Result.Right := Result.Right + TReportCell(FCells[I]).CellWidth;

  FLineRect := Result;
End;

Procedure TReportLine.SetDragHeight(Const Value: Integer);
Begin
  FDragHeight := Value;
End;

Procedure TReportLine.SetLineTop(Const Value: Integer);
Var
  I: Integer;
Begin
  If FLineTop = Value Then
    Exit;

  FLineTop := Value;

  For I := 0 To FCells.Count - 1 Do
  Begin
    TReportCell(FCells[I]).CalcCellRect;
  End;
End;

//TPRClass*****************************************
Procedure TPRClass.CreateWnd;
Begin
  Inherited;

  If Handle <> INVALID_HANDLE_VALUE Then
    SetClassLong(Handle, GCL_HCURSOR, 0);
End;

Constructor TPRClass.Create(AOwner: TComponent);
Var
  hDesktopDC: HDC;
  nPixelsPerInch: Integer;
Begin
  Inherited Create(AOwner);
  // 设定为无光标，防止光标闪烁。
  //  Cursor := crNone;
  Cpreviewedit := true;                 //预览时是否允许编辑单元格中的字符
  FPreviewStatus := False;
  FPrintLine:=true;//非套打
  Color := clWhite;
  FLineList := TList.Create;
  FSelectCells := TList.Create;

  CellSelected := Nil;
  cellline_d := Nil;
  FEditCell := Nil;

  FNewTable := True;
  FDataLine := 0;
  FTablePerPage := 1;                   //
  FDatasourceList := TList.Create;
  //
  cp_pgw := 0;
  cp_pgh := 0;

  FReportScale := 100;
  scale := FReportScale;
  FPageWidth := 0;
  FPageHeight := 0;

  hDesktopDC := GetDC(0);
  nPixelsPerInch := GetDeviceCaps(hDesktopDC, LOGPIXELSX);

  FLeftMargin1 := 20;
  FRightMargin1 := 10;
  FTopMargin1 := 20;
  FBottomMargin1 := 15;

  FLeftMargin := trunc(nPixelsPerInch * FLeftMargin1 / 25 + 0.5);
  FRightMargin := trunc(nPixelsPerInch * FRightMargin1 / 25 + 0.5);
  FTopMargin := trunc(nPixelsPerInch * FTopMargin1 / 25 + 0.5);
  FBottomMargin := trunc(nPixelsPerInch * FBottomMargin1 / 25 + 0.5);

  ReleaseDC(0, hDesktopDC);

  // 鼠标操作支持
  FMousePoint.x := 0;
  FMousePoint.y := 0;

  // 编辑、颜色及字体
  FEditWnd := INVALID_HANDLE_VALUE;
  FEditBrush := INVALID_HANDLE_VALUE;
  FEditFont := INVALID_HANDLE_VALUE;
  CalcWndSize;
End;

Destructor TPRClass.Destroy;
Var
  I: Integer;
  ThisLine: TReportLine;
Begin
  FSelectCells.Free;
  FSelectCells := Nil;

  For I := FLineList.Count - 1 Downto 0 Do
  Begin
    ThisLine := TReportLine(FLineList[I]);
    ThisLine.Free;
  End;

  FLineList.Free;
  FLineList := Nil;
  Inherited Destroy;
End;

Procedure TPRClass.SetPageSize(w, h: integer); //  动态报表设置纸张大小
Var
  hClientDC: HDC;
Begin

End;

Procedure TPRClass.CalcWndSize;
Var
  hClientDC: HDC;
Begin
  isprint := 0;
  If printer.Printers.Count <= 0 Then
  Begin
    isprint := 1;                       //未安装打印机
    If cp_pgw <> 0 Then
    Begin
      FPageWidth := cp_pgw;
      FPageHeight := cp_pgh;
    End;
  End;

  // 根据用户选择的纸来确定报表窗口的大小并对该窗口进行设置。
  hClientDC := GetDC(0);
  If cp_pgw = 0 Then
  Begin
    If isprint = 1 Then
    Begin
      FPageWidth := 768;                //未安装打印机时，设置默认纸宽
      FPageHeight := 1058;              //未安装打印机时，设置默认纸高
    End
    Else
    Begin
      FPageWidth := trunc(Printer.PageWidth / GetDeviceCaps(Printer.Handle,
        LOGPIXELSX)
        * GetDeviceCaps(hClientDC, LOGPIXELSX) + 0.5);
      FPageHeight := trunc(Printer.PageHeight / GetDeviceCaps(Printer.Handle,
        LOGPIXELSY)
        * GetDeviceCaps(hClientDC, LOGPIXELSY) + 0.5);
    End;
  End;
  cp_pgw := FPageWidth;                 //cp_pgw,cp_pgh用于打印
  cp_pgh := FPageHeight;
  Width := trunc(FPageWidth * FReportScale / 100 + 0.5); //width,heght用于显示
  Height := trunc(FPageHeight * FReportScale / 100 + 0.5);
  ReleaseDC(0, hClientDC);
End;

Procedure TPRClass.WMPaint(Var Message: TMessage);
Var
  hPaintDC: HDC;
  ps: TPaintStruct;
  I, J: Integer;
  TempRect: TRect;
  hGrayPen, hPrevPen: HPEN;
  ThisLine: TReportLine;
  ThisCell: TReportCell;
  WndSize: TSize;
  RectPaint: TRect;
  ACanvas: TCanvas;
  LTempRect: TRect;
  iTop,iBottom,iLeft,iRight:integer;
Begin

  hPaintDC := BeginPaint(Handle, ps); //Canvas Handle1030

  SetMapMode(hPaintDC, MM_ISOTROPIC);
  WndSize.cx := Width;
  WndSize.cy := Height;
  SetWindowExtEx(hPaintDC, FPageWidth, FPageHeight, @WndSize);
  SetViewPortExtEx(hPaintDC, Width, Height, @WndSize);

  RectPaint := ps.rcPaint;

  If FReportScale <> 100 Then
  Begin
    RectPaint.Left := trunc(RectPaint.Left * 100 / FReportScale + 0.5);
    RectPaint.Top := trunc(RectPaint.Top * 100 / FReportScale + 0.5);
    RectPaint.Right := trunc(RectPaint.Right * 100 / FReportScale + 0.5);
    RectPaint.Bottom := trunc(RectPaint.Bottom * 100 / FReportScale + 0.5);
  End;

  Rectangle(hPaintDC, 0, 0, FPageWidth, FPageHeight);  //画矩形
    //CreatePen(Pen风格,宽度,颜色)   返回笔对象句柄
  hGrayPen := CreatePen(PS_SOLID, 1, RGB(128, 128, 128)); //一个像素宽度
  hPrevPen := SelectObject(hPaintDC, hGrayPen);

  // 左上 边角
  MoveToEx(hPaintDC, FLeftMargin, FTopMargin, Nil);
  LineTo(hPaintDC, FLeftMargin, FTopMargin - 25);  //竖线
  MoveToEx(hPaintDC, FLeftMargin, FTopMargin, Nil);
  LineTo(hPaintDC, FLeftMargin - 25, FTopMargin); //横线
  // 右上  边角
  MoveToEx(hPaintDC, FPageWidth - FRightMargin, FTopMargin, Nil);
  LineTo(hPaintDC, FPageWidth - FRightMargin, FTopMargin - 25);
  MoveToEx(hPaintDC, FPageWidth - FRightMargin, FTopMargin, Nil);
  LineTo(hPaintDC, FPageWidth - FRightMargin + 25, FTopMargin);
  // 左下 边角
  MoveToEx(hPaintDC, FLeftMargin, FPageHeight - FBottomMargin, Nil);
  LineTo(hPaintDC, FLeftMargin, FPageHeight - FBottomMargin + 25);
  MoveToEx(hPaintDC, FLeftMargin, FPageHeight - FBottomMargin, Nil);
  LineTo(hPaintDC, FLeftMargin - 25, FPageHeight - FBottomMargin);
  // 右下 边角
  MoveToEx(hPaintDC, FPageWidth - FRightMargin, FPageHeight - FBottomMargin,
    Nil);
  LineTo(hPaintDC, FPageWidth - FRightMargin, FPageHeight - FBottomMargin + 25);
  MoveToEx(hPaintDC, FPageWidth - FRightMargin, FPageHeight - FBottomMargin,
    Nil);
  LineTo(hPaintDC, FPageWidth - FRightMargin + 25, FPageHeight - FBottomMargin);
  //删除  灰线对象 hGrayPen
  SelectObject(hPaintDC, hPrevPen);
  DeleteObject(hGrayPen);
if not FAncientStyle then
begin
 // 绘制所有与失效区相交的矩形
  For I := 0 To FLineList.Count - 1 Do
  Begin //
    ThisLine := TReportLine(FLineList[I]);
    For J := 0 To TReportLine(FLineList[i]).FCells.Count - 1 Do
    Begin //
      ThisCell := TReportCell(ThisLine.FCells[J]);

      If ThisCell.CellRect.Left > RectPaint.Right Then  Break;

      If ThisCell.CellRect.Right < RectPaint.Left Then Continue;

      If ThisCell.CellRect.Top > RectPaint.Bottom Then Break;

      If ThisCell.CellRect.Bottom < RectPaint.Top Then Continue;
      ACanvas := TCanvas.Create;
      ACanvas.Handle := getdc(Handle);
      // 处理图片显示
      LTempRect := ThisCell.FCellRect;
      LTempRect.Left := trunc((Thiscell.FCellRect.Left) * FReportScale / 100 +
        0.5) + 3;
      LTempRect.Top := trunc((Thiscell.FCellRect.Top) * FReportScale / 100 + 0.5)
        + 3;
      LTempRect.Right := trunc((Thiscell.FCellRect.Right) * FReportScale / 100 +
        0.5) - 3;
      LTempRect.Bottom := trunc((Thiscell.FCellRect.Bottom) * FReportScale / 100
        + 0.5) - 3;
      aCanvas.StretchDraw(LTempRect, loadbmp(thiscell));
      ReleaseDC(Handle, ACanvas.Handle);
      ACanvas.Free;  //

       If ThisCell.OwnerCell = Nil Then ThisCell.PaintCell(hPaintDC, FPreviewStatus,FPrintLine);
    End; //for i
  End; // For I := 0   绘制所有与失效区相交的矩形
end else//if not AncientStyle
begin  // 绘制竖式报表
  For I := 0 To FLineList.Count - 1 Do
  Begin //
    ThisLine := TReportLine(FLineList[I]);
    For J := 0 To TReportLine(FLineList[i]).FCells.Count - 1 Do
    Begin //
      ThisCell := TReportCell(ThisLine.FCells[J]);

      If ThisCell.CellRect.Left > RectPaint.Right Then  Break;

      If ThisCell.CellRect.Right < RectPaint.Left Then Continue;

      If ThisCell.CellRect.Top > RectPaint.Bottom Then Break;

      If ThisCell.CellRect.Bottom < RectPaint.Top Then Continue;
      //
      iLeft:=ThisCell.FCellRect.Left;
      iRight:=ThisCell.FCellRect.Right ;
      iTop:=ThisCell.FCellRect.Top ;
      iBottom:=ThisCell.FCellRect.Bottom;

      ThisCell.FCellRect.Left:=FPageWidth-iTop;
      ThisCell.FCellRect.Right:=ThisCell.FCellRect.Left+(iBottom-iTop);
      ThisCell.FCellRect.Top:=FPageHeight-iLeft;
      ThisCell.FCellRect.Bottom:=ThisCell.FCellRect.Top+(iRight-iLeft);
      //
      iLeft:=ThisCell.CellLeft;
      iRight:=ThisCell.CellWidth;
      iTop:=ThisCell.CellTop ;
      iBottom:=ThisCell.CellHeight;
      ThisCell.CellLeft:=FPageWidth-iTop;
      ThisCell.CellWidth:=ThisCell.FCellRect.Left+iBottom;
      ThisCell.CellTop:=FPageHeight-iLeft;
      ThisCell.CellHeight:=ThisCell.FCellRect.Top+iRight;
      //
       If ThisCell.OwnerCell = Nil Then ThisCell.PaintCell(hPaintDC, FPreviewStatus,FPrintLine);
    End; //for i
  End; // For I := 0   绘制所有与失效区相交的矩形
end; //if not AncientStyle


  If Not FPreviewStatus Then  //打印状态 非预览
  Begin //
    For I := 0 To FSelectCells.Count - 1 Do
    Begin //   这个函数在lpDestRect里载入一个矩形，它是lpSrc1Rect与lpSrc2Rect两个矩形的交
      IntersectRect(TempRect, ps.rcPaint,TReportCell(FSelectCells[I]).CellRect);
      If (TempRect.right >= TempRect.Left) And (TempRect.bottom >= TempRect.top)
        Then  InvertRect(hPaintDC, TempRect);//通过反转每个像素的值，从而反转一个设备场景中指定的矩形 
    End;// For I := 0
  End;//
  // 划线的算法目前还没有想出来  各个CELL之间表线重叠的部分如何处理，如何存储这些线的设置呢？显然，现在的方法太土了。
  // 改乐，如果右面的CELL或下面的CELL的左边线或上边线为0时，不画不就得乐
  EndPaint(Handle, ps);
End;

Procedure TPRClass.WMLButtonDBLClk(Var Message: TMessage);
Var
  ThisCell: TReportCell;
  TempPoint: TPoint;
  dwStyle: DWORD;
Begin
  If Not Cpreviewedit Then
  Begin
    Inherited;
    exit;
  End;
  RemoveAllSelectedCell;
  GetCursorPos(TempPoint);
  Windows.ScreenToClient(Handle, TempPoint);

  ThisCell := CellFromPoint(TempPoint);

  If (ThisCell <> Nil) And (ThisCell.CellWidth > 10) Then
  Begin
    FEditCell := ThisCell;

    If FEditFont <> INVALID_HANDLE_VALUE Then
      DeleteObject(FEditFont);

    FEditFont := CreateFontIndiRect(ThisCell.LogFont);

    // 设置编辑窗的字体
    If IsWindow(FEditWnd) Then
    Begin
      DestroyWindow(FEditWnd);
    End;

    //// Edit Window's Position
    Case ThisCell.HorzAlign Of
      TEXT_ALIGN_LEFT:
        dwStyle := WS_VISIBLE Or WS_CHILD Or ES_MULTILINE Or ES_LEFT Or
          ES_AUTOVSCROLL;
      TEXT_ALIGN_CENTER:
        dwStyle