reportcontrol.pas

国产的报表控件

    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 := WS_VISIBLE or WS_CHILD or ES_MULTILINE or ES_CENTER or ES_AUTOVSCROLL;
      TEXT_ALIGN_RIGHT:
        dwStyle := WS_VISIBLE or WS_CHILD or ES_MULTILINE or ES_RIGHT or ES_AUTOVSCROLL;
    else
      dwStyle := WS_VISIBLE or WS_CHILD or ES_MULTILINE or ES_LEFT or ES_AUTOVSCROLL;
    end;

    FEditWnd := CreateWindow('EDIT', '', dwStyle, 0, 0, 0, 0, Handle, 1, hInstance, nil);

    SendMessage(FEditWnd, WM_SETFONT, FEditFont, 1); // 1 means TRUE here.
    SendMessage(FEditWnd, EM_LIMITTEXT, 3000, 0);

    MoveWindow(FEditWnd, ThisCell.TextRect.left, ThisCell.TextRect.Top,
      ThisCell.TextRect.Right - ThisCell.TextRect.Left,
      ThisCell.TextRect.Bottom - ThisCell.TextRect.Top, True);
    SetWindowText(FEditWnd, PChar(ThisCell.CellText));
    ShowWindow(FEditWnd, SW_SHOWNORMAL);
    Windows.SetFocus(FEditWnd);
  end;
end;

procedure TReportControl.WMLButtonDown(var Message: TMessage);
var
  ThisCell: TReportCell;
  MousePoint: TPoint;
  TempChar: array[0..3000] of Char;
  TempMsg: TMSG;
  TempRect: TRect;
  sh_down: byte;
begin
  sh_down := message.wparam; //当拖动时，按下SHIFT键时不取消已选单元格
  if freportscale <> 100 then //按下Mouse键，并缩放率<>100时，恢复为正常
  begin //1999.1.23
    freportscale := 100;
    CalcWndSize;
    Update;
    exit;
  end;
  MousePoint.x := LOWORD(Message.lParam);
  MousePoint.y := HIWORD(Message.lParam);
  ThisCell := CellFromPoint(MousePoint);

  //  FcellFont_d:=thiscell.flogfont;

  if IsWindowVisible(FEditWnd) then
  begin
    if FEditCell <> nil then
    begin
      GetWindowText(FEditWnd, TempChar, 3000);
      FEditCell.CellText := TempChar;
    end;
    // 奇怪，ReportControl窗口一旦得到焦点就移动自己
    Windows.SetFocus(0);
    DestroyWindow(FEditWnd);
    FEditCell := nil;
  end;

  // 清除消息队列中的WM_PAINT消息，防止画出飞线
  while PeekMessage(TempMsg, 0, WM_PAINT, WM_PAINT, PM_NOREMOVE) do
  begin
    if not GetMessage(TempMsg, 0, WM_PAINT, WM_PAINT) then
      Break;

    DispatchMessage(TempMsg);
  end;

  if ThisCell = nil then
    StartMouseSelect(MousePoint, True, sh_down)
  else
  begin
    TempRect := ThisCell.CellRect;

//    if (abs(TempRect.top - MousePoint.y) <= 5) or (abs(TempRect.Bottom - MousePoint.y) <= 5) or
//      (abs(TempRect.Right - MousePoint.x) <= 5) or (abs(TempRect.left - MousePoint.x) <= 5) then
    if (abs(TempRect.Bottom - MousePoint.y) <= 3) or
      (abs(TempRect.Right - MousePoint.x) <= 3) then
      StartMouseDrag(MousePoint)
    else
      StartMouseSelect(MousePoint, True, sh_down);
    {
        else if abs(TempRect.left - MousePoint.x) <= 5 then
          StartMouseSelect(MousePoint, True)
        else
          StartMouseSelect(MousePoint, False);
    }
  end;
//  inherited;
end;

procedure TReportControl.WMMouseMove(var Message: TMessage);
var
  ThisCell: TReportCell;
  MousePoint: TPoint;
  RectCell: TRect;
begin
  MousePoint.x := LOWORD(Message.lParam);
  MousePoint.y := HIWORD(Message.lParam);
  ThisCell := CellFromPoint(MousePoint);

  if ThisCell <> nil then
  begin
    RectCell := ThisCell.CellRect;

//    CellDisp:=ThisCell;
    FcellFont := thiscell.flogfont; //取Mouse所指单元的字体类型 1999.1.23
//    if (abs(RectCell.Right - MousePoint.x) <= 1) or (abs(RectCell.left - MousePoint.x) <= 1) then
//      SetCursor(LoadCursor(0, IDC_SIZEWE))
//    else if (abs(RectCell.Bottom - MousePoint.y) <= 1) or (abs(RectCell.top - MousePoint.y)<=1) then
//      SetCursor(LoadCursor(0, IDC_SIZENS))
    if (abs(RectCell.Right - MousePoint.x) <= 3) then
      SetCursor(LoadCursor(0, IDC_SIZEWE))
    else if (abs(RectCell.Bottom - MousePoint.y) <= 3) then
      SetCursor(LoadCursor(0, IDC_SIZENS))
    else
      SetCursor(LoadCursor(0, IDC_IBEAM));
  end
  else SetCursor(LoadCursor(0, IDC_ARROW));
  inherited; //将mouse的消息返回   1999.1.23
end;

procedure TReportControl.WMContextMenu(var Message: TMessage);
var
  ThisCell: TReportCell;
  TempPoint: TPoint;
begin
  GetCursorPos(TempPoint);
  Windows.ScreenToClient(Handle, TempPoint);
  ThisCell := CellFromPoint(TempPoint);

  if not IsCellSelected(ThisCell) then
  begin
    RemoveAllSelectedCell;
    if ThisCell <> nil then
    begin
      AddSelectedCell(ThisCell);
    end;
  end;
end;

procedure TReportControl.StartMouseDrag(point: TPoint);
var
  TempCell, TempNextCell, ThisCell, NextCell: TReportCell;
  ThisCellsList: TList;
  TempRect, RectBorder, RectCell, RectClient: TRect;
  hClientDC: HDC;
  hInvertPen, hPrevPen: HPEN;
  PrevDrawMode, PrevCellWidth, Distance: Integer;
  I, J: Integer;
  bHorz, bSelectFlag: Boolean;
  ThisLine, TempLine: TReportLine;
  TempMsg: TMSG;
  BottomCell: TReportCell;
  Top: Integer;
  //  CellList : TList;
  DragBottom: Integer;
begin
  ThisCell := CellFromPoint(point);
  RectCell := ThisCell.CellRect;
  FMousePoint := point;
  Windows.GetClientRect(Handle, RectClient);
  ThisCellsList := TList.Create;

  // 设置线形和绘制模式
  hClientDC := GetDC(Handle);
  hInvertPen := CreatePen(PS_DOT, 1, RGB(0, 0, 0));
  hPrevPen := SelectObject(hClientDC, hInvertPen);

  PrevDrawMode := SetROP2(hClientDC, R2_NOTXORPEN);

  // 置横向标志
  if abs(RectCell.Bottom - point.y) <= 3 then
    bHorz := True
  else
    bHorz := False;
  // 计算上下左右边界
  ThisLine := ThisCell.OwnerLine;
  RectBorder.Top := ThisLine.LineTop + 5;
  RectBorder.Bottom := Height - 10;
  RectBorder.Right := ClientRect.Right;

  NextCell := nil;

  for I := 0 to ThisLine.FCells.Count - 1 do
  begin
    TempCell := TReportCell(ThisLine.FCells[I]);

    if ThisCell = TempCell then
    begin
      RectBorder.Left := ThisCell.CellLeft + 10;

      if I < ThisLine.FCells.Count - 1 then
      begin
        NextCell := TReportCell(ThisLine.FCells[I + 1]);
        RectBorder.Right := NextCell.CellLeft + NextCell.CellWidth - 10;
      end
      else
        RectBorder.Right := ClientRect.Right - 10;
    end;
  end;

  if not bHorz then
  begin
    // 若无选中的CELL,或者要改变宽度的CELL和NEXTCELL不在选中区中
    bSelectFlag := False;

    if FSelectCells.Count <= 0 then
      bSelectFlag := True;

    if NextCell = nil then
    begin
      if (not IsCellSelected(ThisCell)) and (not IsCellSelected(NextCell)) then
        bSelectFlag := True;
    end
    else
      if (not IsCellSelected(ThisCell)) and (not IsCellSelected(NextCell)) and
        (not IsCellSelected(NextCell.OwnerCell)) then
        bSelectFlag := True;

    if bSelectFlag then
    begin
      for I := 0 to FLineList.Count - 1 do
      begin
        TempLine := TReportLine(FLineList[I]);
        for J := 0 to TempLine.FCells.Count - 1 do
        begin
          TempCell := TReportCell(TempLine.FCells[J]);
          // 若该CELL的右边等于选中的CELL的右边，将该CELL和NEXTCELL加入到两个LIST中去
          if TempCell.CellRect.Right = ThisCell.CellRect.Right then
          begin
            ThisCellsList.Add(TempCell);

            if TempCell.CellLeft + 10 > RectBorder.Left then
              RectBorder.Left := TempCell.CellLeft + 10;

            if J < TempLine.FCells.Count - 1 then
            begin
              TempNextCell := TReportCell(TempLine.FCells[J + 1]);
              if TempNextCell.CellRect.Right - 10 < RectBorder.Right then
                RectBorder.Right := TempNextCell.CellRect.Right - 10;
            end;
          end;
        end;
      end;
    end
    else
    begin
      for I := 0 to FLineList.Count - 1 do
      begin
        TempLine := TReportLine(FLineList[I]);
        TempNextCell := nil;
        for J := 0 to TempLine.FCells.Count - 1 do
        begin
          TempCell := TReportCell(TempLine.FCells[J]);
          // 若该CELL的右边等于选中的CELL的右边，将该CEL加入到LIST中去
          // 前提是CELL或NEXTCELL在选中区内
          if (TempCell.CellRect.Right = ThisCell.CellRect.Right) then
          begin
            if J < TempLine.FCells.Count - 1 then
              TempNextCell := TReportCell(TempLine.FCells[J + 1]);

            if (not IsCellSelected(TempNextCell)) and (not IsCellSelected(TempCell)) then
              Break;

            if TempNextCell <> nil then
            begin
              if TempNextCell.CellRect.Right - 10 < RectBorder.Right then
                RectBorder.Right := TempNextCell.CellRect.Right - 10;
            end;

            ThisCellsList.Add(TempCell);

            if TempCell.CellLeft + 10 > RectBorder.Left then
              RectBorder.Left := TempCell.CellLeft + 10;

            Break;
          end;
        end;
      end;
    end;
  end;

  // 画第一条线
  if bHorz then
  begin
    FMousePoint.y := trunc(FMousePoint.y / 5 * 5 + 0.5);

    if FMousePoint.y < RectBorder.Top then
      FMousePoint.y := RectBorder.Top;

    if FMousePoint.y > RectBorder.Bottom then
      FMousePoint.y := RectBorder.Bottom;

    MoveToEx(hClientDC, 0, FMousePoint.y, nil);
    LineTo(hClientDC, RectClient.Right, FMousePoint.y);
    SetCursor(LoadCursor(0, IDC_SIZENS));
  end
  else
  begin
    FMousePoint.x := trunc(FMousePoint.x / 5 * 5 + 0.5);

    if FMousePoint.x < RectBorder.Left then
      FMousePoint.x := RectBorder.Left;

    if FMousePoint.x > RectBorder.Right then
      FMousePoint.x := RectBorder.Right;

    MoveToEx(hClientDC, FMousePoint.x, 0, nil);
    LineTo(hClientDC, FMousePoint.x, RectClient.Bottom);
    SetCursor(LoadCursor(0, IDC_SIZEWE));
  end;

  SetCapture(Handle);

  // 取得鼠标输入，进入第二个消息循环
  while GetCapture = Handle do
  begin
    if not GetMessage(TempMsg, Handle, 0, 0) then
    begin
      PostQuitMessage(TempMsg.wParam);
      Break;
    end;

    case TempMsg.message of
      WM_LBUTTONUP:
        ReleaseCapture;
      WM_MOUSEMOVE:
        if bHorz then
        begin
          MoveToEx(hClientDC, 0, FMousePoint.y, nil);
          LineTo(hClientDC, RectClient.Right, FMousePoint.y);
          FMousePoint := TempMsg.pt;
          Windows.ScreenToClient(Handle, FMousePoint);

          // 边界检查
          FMousePoint.y := trunc(FMousePoint.y / 5 * 5 + 0.5);

          if FMousePoint.y < RectBorder.Top then
            FMousePoint.y := RectBorder.Top;

          if FMousePoint.y > RectBorder.Bottom then
            FMousePoint.y := RectBorder.Bottom;

          MoveToEx(hClientDC, 0, FMousePoint.y, nil);
          LineTo(hClientDC, RectClient.Right, FMousePoint.y);
        end
        else
        begin
          MoveToEx(hClientDC, FMousePoint.x, 0, nil);
          LineTo(hClientDC, FMousePoint.x, RectClient.Bottom);
          FMousePoint := TempMsg.pt;
          Windows.ScreenToClient(Handle, FMousePoint);

          // 边界检查
          FMousePoint.x := trunc(FMousePoint.x / 5 * 5 + 0.5);

          if FMousePoint.x < RectBorder.Left then
            FMousePoint.x := RectBorder.Left;
          if FMousePoint.x > RectBorder.Right then
            FMousePoint.x := RectBorder.Right;

          MoveToEx(hClientDC, FMousePoint.x, 0, nil);
          LineTo(hClientDC, FMousePoint.x, RectClient.Bottom);
        end;
      WM_SETCURSOR:
        ;
    else
      DispatchMessage(TempMsg);
    end;
  end;

  if GetCapture = Handle then
    ReleaseCapture;

  if bHorz then
  begin
    // 将反显的线去掉
    MoveToEx(hClientDC, 0, FMousePoint.y, nil);
    LineTo(hClientDC, RectClient.Right, FMousePoint.y);

    // 改变行高
    // 改变行高
    if ThisCell.FCellsList.Count <= 0 then
    begin
      // 不跨越其他CELL时
      BottomCell := ThisCell;
    end
    else
    begin
      // 跨越其他CELL时，取得最下一行的CELL
      BottomCell := nil;
      Top := 0;
      for I := 0 to ThisCell.FCellsList.Count - 1 do
      begin
        if TReportCell(ThisCell.FCellsList[I]).CellTop > Top then
        begin
          BottomCell := TReportCell(ThisCell.FCellsList[I]);
          Top := BottomCell.CellTop;
        end;
      end;
    end;

    BottomCell.CalcMinCellHeight;
    BottomCell.OwnerLine.LineHeight := FMousePoint.Y - BottomCell.OwnerLine.LineTop;
    UpdateLines;
  end
  else
  begin
    // 将反显的线去掉
    MoveToEx(hClientDC, FMousePoint.x, 0, nil);
    LineTo(hClientDc, FMousePoint.x, RectClient.Bottom);

    // 在此处判断对CELL宽度的设定是否有效
    DragBottom := ThisCellsList.Count;

    for I := 0 to DragBottom - 1 do
    begin
      for J := 0 to TReportCell(ThisCellsList[I]).FCellsList.Count - 1 do
      begin
        ThisCellsList.Add(TReportCell(ThisCellsList[I]).FCellsList[J]);
      end;
    end;

    // 取得NEXTCELL
    if ThisCellsList.Count > 0 then
    begin
      ThisCell := TReportCell(ThisCellsList[0]);
      if ThisCell.CellIndex < ThisCell.OwnerLine.FCells.Count - 1 then
        NextCell := TReportCell(ThisCell.OwnerLine.FCells[ThisCell.CellIndex + 1]);

      // 右边的CELL不为空且隶属与某一CELL
      if NextCell <> nil then
      begin
        if NextCell.OwnerCell <> nil then
        begin
          SelectObject(hClientDC, hPrevPen);
          DeleteObject(hInvertPen);
          SetROP2(hClientDc, PrevDrawMode);
          ReleaseDC(Handle, hClientDC);
          Exit;
        end;
      end;

      DragBottom := 0;
      for I := 0 to ThisCellsList.Count - 1 do
      begin
        if TReportCell(ThisCellsList[I]).CellRect.Bottom > DragBottom then
          DragBottom := TReportCell(ThisCellsList[I]).CellRect.Bottom;
      end;

      for I := 0 to ThisCellsList.Count - 1 do
      begin
        ThisCell := TReportCell(ThisCellsList[I]);
        if ThisCel