reportcontrol.pas

delphi编程控件

  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 := 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, 1000, 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..1000] Of Char;
  TempMsg : TMSG;
  TempRect : TRect;
Begin
  MousePoint.x := LOWORD(Message.lParam);
  MousePoint.y := HIWORD(Message.lParam);
  ThisCell := CellFromPoint(MousePoint);

  If IsWindowVisible(FEditWnd) Then
    Begin
      If FEditCell <> Nil Then
        Begin
          GetWindowText(FEditWnd, TempChar, 1000);
          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)
  Else
    Begin
      TempRect := ThisCell.CellRect;

      If (abs(TempRect.Bottom - MousePoint.y) <= 3) Or
        (abs(TempRect.Right - MousePoint.x) <= 3) Then
        StartMouseDrag(MousePoint)
      Else
        StartMouseSelect(MousePoint, True);
      {
          else if abs(TempRect.left - MousePoint.x) <= 5 then
            StartMouseSelect(MousePoint, True)
          else
            StartMouseSelect(MousePoint, False);
      }
    End;
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;

      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 If abs(RectCell.left - MousePoint.x) <= 5 Then
        SetCursor(LoadCursor(0, IDC_UPARROW))
      Else
        SetCursor(LoadCursor(0, IDC_IBEAM));
    End
  Else
    SetCursor(LoadCursor(0, IDC_ARROW));
  Inherited;
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