⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 rm_grid.pas

📁 进销存·完整的·有数据库的·非常完整·只得参考
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        case HorizAlign of
          rmtaLeftJustify: liTextAlignMode := DT_TOP or DT_LEFT;
          rmtaRightJustify: liTextAlignMode := DT_TOP or DT_RIGHT;
        else
          liTextAlignMode := DT_CENTER;
        end;
        case VertAlign of
          rmtlBottom: ARect.Top := ARect.Bottom - liTestHeight;
          rmtlCenter: Inc(ARect.Top, liTestRect.Top);
        end;
        if AutoWordBreak then
          liTextAlignMode := liTextAlignMode or DT_WORDBREAK;
        Windows.DrawText(Canvas.Handle, liTextToDraw, -1, ARect, liTextAlignMode)
      end;
    end;
    RestoreClipRect(Canvas);
    SetClipRect(Canvas, AClipRect);
  end;

//  if Assigned(FOnDrawCell) then
//  begin
//    FOnDrawCell(Self, ACol, ARow, ARect, AState);
//  end;
end;

{$IFNDEF Delphi4}

function Max(Value1, Value2: Integer): Integer;
begin
  if Value1 > Value2 then
    Result := Value1
  else
    Result := Value2;
end;

function Min(Value1, Value2: Integer): Integer;
begin
  if Value1 > Value2 then
    Result := Value2
  else
    Result := Value1;
end;
{$ENDIF}

procedure TRMGridEx.Paint;
var
  DrawInfo: TRMGridDrawInfo;
  Sel: TRect;
  UpdateRect: TRect;
  DrawRect, ClipRect, IRect: TRect;
  PointsList: PIntArray;
  StrokeList: PIntArray;
  MaxStroke: Integer;
  FrameFlags1, FrameFlags2: DWORD;
  MaxHorzExtent, MaxVertExtent: Integer;
  MaxHorzCell, MaxVertCell: Integer;
  MinHorzCell, MinVertCell: Integer;

  procedure DrawLines(DoHorz, DoVert: Boolean; StartCol, StartRow, EndCol, EndRow: Longint;
    const CellBounds: array of Integer; OnColor, OffColor: TColor);
  const
    FlatPenStyle = PS_Geometric or PS_Solid or PS_EndCap_Flat or PS_Join_Miter;

    procedure DrawAxisLines(const AxisInfo: TRMGridAxisDrawInfo;
      MajorIndex: Integer; UseOnColor: Boolean);
    var
      LogBrush: TLOGBRUSH;
      Cell, Index: Integer;
      Points: PIntArray;
      StartMajor, StopMajor, StartMinor, StopMinor: Integer;
      MayHaveMerge: Boolean;
      TopIndex: Integer;
      MergePoint: TPoint;

      function FindHorzMerge(ARow, StartIndex: Integer): TPoint;
      var
        I: Integer;
        liCell: TRMCellInfo;
      begin
        Result.x := -1;
        Result.y := -1;
        for i := StartIndex to EndCol do
        begin
          liCell := Cells[i, ARow];
          if CellInMerge(i, ARow) and (ARow <> liCell.EndRow) then
          begin
            Result.x := liCell.StartCol;
            Result.y := liCell.EndCol;
            Exit;
          end;
        end;
      end;

      function FindVertMerge(ACol, StartIndex: Integer): TPoint;
      var
        i: Integer;
        liCell: TRMCellInfo;
      begin
        Result.x := -1;
        Result.y := -1;
        for i := StartIndex to EndRow do
        begin
          liCell := Cells[ACol, i];
          if CellInMerge(ACol, i) and (ACol <> liCell.EndCol) then
          begin
            Result.x := liCell.StartRow;
            Result.y := liCell.EndRow;
            Exit;
          end;
        end;
      end;

    begin
      with Canvas, AxisInfo do
      begin
        Pen.Style := psSolid;
        Pen.Mode := pmCopy;
        if EffectiveLineWidth <> 0 then
        begin
          Pen.Width := FGridLineWidth;
          if UseOnColor then
            Pen.Color := OnColor
          else
            Pen.Color := OffColor;
          if Pen.Width > 1 then
          begin
            LogBrush.lbStyle := BS_Solid;
            LogBrush.lbColor := Pen.Color;
            LogBrush.lbHatch := 0;
            Pen.Handle := ExtCreatePen(FlatPenStyle, Pen.Width, LogBrush, 0, nil);
          end;
          if MajorIndex = 0 then
            Cell := StartCol // 画竖线
          else
            Cell := StartRow; // 画横线
          // 第一根线的位置
          StartMajor := CellBounds[MajorIndex] + EffectiveLineWidth shr 1 +
            GetExtent(Cell);
          // 最后一根线的位置
          StopMajor := CellBounds[2 + MajorIndex] + EffectiveLineWidth;
          // 画线起点
          StartMinor := CellBounds[MajorIndex xor 1];
          // 画线终点
          StopMinor := CellBounds[2 + (MajorIndex xor 1)];
          MayHaveMerge := False;
          // 计算是否可能存在合并区域
          if ((StartMinor > 0) and (StartMajor > 0) or
            (StartMinor > 0) and (StartMajor > 0)) then
            MayHaveMerge := True;
          Points := PointsList;
          Index := 0;
          repeat
            if ((MajorIndex = 0) and (ColWidths[Cell] >= 0)) or
              ((MajorIndex = 1) and (RowHeights[Cell] >= 0)) then
            begin
              // 画线起点
              Points^[Index + MajorIndex] := StartMajor; { MoveTo }
              Points^[Index + (MajorIndex xor 1)] := StartMinor;
              Inc(Index, 2);
              // 如果可能存在合并区域
              if MayHaveMerge then
              begin
                if MajorIndex = 0 then // 画竖线
                begin
                  TopIndex := StartRow;
                  while TopIndex <= EndRow do
                  begin
                    MergePoint := FindVertMerge(Cell, TopIndex);
                    if MergePoint.x > 0 then //Have Merge
                    begin
                      Points^[Index + MajorIndex] := StartMajor; // LineTo
                      Points^[Index + (MajorIndex xor 1)] := CellRect(Cell, MergePoint.x).Top;
                      Inc(Index, 2);
                      Points^[Index + MajorIndex] := StartMajor; // MoveTo
                      Points^[Index + (MajorIndex xor 1)] := CellRect(Cell, MergePoint.y).Bottom;
                      Inc(Index, 2);
                      TopIndex := MergePoint.y + 1;
                    end
                    else
                      Inc(TopIndex);
                  end;
                end
                else // 画横线
                begin
                  TopIndex := StartCol;
                  while TopIndex <= EndCol do
                  begin
                    MergePoint := FindHorzMerge(Cell, TopIndex);
                    if MergePoint.x > 0 then
                    begin
                      Points^[Index + MajorIndex] := StartMajor; // LineTo
                      Points^[Index + (MajorIndex xor 1)] := CellRect(MergePoint.x, Cell).Left;
                      Inc(Index, 2);
                      Points^[Index + MajorIndex] := StartMajor; // MoveTo
                      Points^[Index + (MajorIndex xor 1)] := CellRect(MergePoint.y, Cell).Right;
                      Inc(Index, 2);
                      TopIndex := MergePoint.y + 1;
                    end
                    else
                      Inc(TopIndex);
                  end;
                end;
              end;
              // 画线终点
              Points^[Index + MajorIndex] := StartMajor;
              Points^[Index + (MajorIndex xor 1)] := StopMinor;
              Inc(Index, 2);
            end;
            Inc(Cell);
            Inc(StartMajor, GetExtent(Cell) + EffectiveLineWidth);
          until StartMajor > StopMajor;
          PolyPolyLine(Canvas.Handle, Points^, StrokeList^, Index shr 2);
        end;
      end;
    end;
  begin
    if (CellBounds[0] = CellBounds[2]) or (CellBounds[1] = CellBounds[3]) then
      Exit;
    if not DoHorz then
    begin
      DrawAxisLines(DrawInfo.Vert, 1, DoHorz); // 画水平线
      DrawAxisLines(DrawInfo.Horz, 0, DoVert); // 画竖直线
    end
    else
    begin
      DrawAxisLines(DrawInfo.Horz, 0, DoVert); // 画竖直线
      DrawAxisLines(DrawInfo.Vert, 1, DoHorz); // 画水平线
    end;
  end;

  procedure DrawCells(DrawRegion: Integer; StartCol, StartRow, EndCol, EndRow: Integer;
    Color: TColor; IncludeDrawState: TRMGridDrawState);
  var
    CurCol, CurRow: Longint;
    Where, TempRect: TRect;
    DrawState: TRMGridDrawState;
    Focused: Boolean;
    bDown: Boolean;
    liCell: TRMCellInfo;

    procedure CalcRegion;
    var
      i: Integer;
    begin
      with DrawInfo do
      begin
        case DrawRegion of
          6: // 固定区交叉区
            begin
              ClipRect := Rect(0, 0,
                Horz.FixedBoundary, Vert.FixedBoundary);
              DrawRect := ClipRect;
            end;
          7: // 顶部固定区
            begin
              ClipRect := Rect(Horz.FixedBoundary, 0,
                MaxHorzExtent, Vert.FixedBoundary);
              DrawRect := ClipRect;
              Dec(DrawRect.Left, FColOffset);
              for i := StartCol to LeftCol - 1 do
                Dec(DrawRect.Left, Horz.GetExtent(i) + Horz.EffectiveLineWidth);
            end;
          8: // 左部固定区
            begin
              ClipRect := Rect(0, Vert.FixedBoundary,
                Horz.FixedBoundary, MaxVertExtent);
              DrawRect := ClipRect;
              for i := StartRow to TopRow - 1 do
                Dec(DrawRect.Top, Vert.GetExtent(i) + Vert.EffectiveLineWidth);
            end;
          9: // 活动区域
            begin
              ClipRect := Rect(Horz.FixedBoundary, Vert.FixedBoundary,
                MaxHorzExtent, MaxVertExtent);
              DrawRect := ClipRect;
              Dec(DrawRect.Left, FColOffset);
              for i := StartCol to LeftCol - 1 do
                Dec(DrawRect.Left, Horz.GetExtent(i) + Horz.EffectiveLineWidth);
              for i := StartRow to TopRow - 1 do
                Dec(DrawRect.Top, Vert.GetExtent(i) + Vert.EffectiveLineWidth);
            end;
        end;
      end;
    end;

    function MergedExtent(AAxisDrawInfo: TRMGridAxisDrawInfo; StartIndex, EndIndex: Integer): Integer;
    var
      i: Integer;
    begin
      Result := 0;
      with AAxisDrawInfo do
      begin
        for i := StartIndex to EndIndex do
          Inc(Result, GetExtent(i) + EffectiveLineWidth);
      end;
      Dec(Result, AAxisDrawInfo.EffectiveLineWidth);
    end;

  begin
    CalcRegion; // 计算剪裁范围和绘画范围
    SetClipRect(Canvas, ClipRect);
    CurRow := StartRow;
    Where.Top := DrawRect.Top;
    while (Where.Top < DrawRect.Bottom) and (CurRow < RowCount) do
    begin
      CurCol := StartCol;
      Where.Left := DrawRect.Left;
      while (Where.Left < DrawRect.Right) and (CurCol <= EndCol) do
      begin
        liCell := Cells[CurCol, CurRow];
        Where.Right := Where.Left + MergedExtent(DrawInfo.Horz, CurCol, liCell.EndCol); //ColWidths[CurCol];
        Where.Bottom := Where.Top + MergedExtent(DrawInfo.Vert, CurRow, liCell.EndRow); //RowHeights[CurRow];
        if (Where.Right > Where.Left) and (Where.Bottom > Where.Top) and
          (CurCol = liCell.StartCol) and (CurRow = liCell.StartRow) and
          InterSectRect(IRect, Where, ClipRect) then
        begin
          DrawState := IncludeDrawState;
          Focused := IsActiveControl;
          if Focused and (CurRow = Row) and (CurCol = Col) then
            Include(DrawState, rmgdFocused);
          if GridRectInterSects(Rect(liCell.StartCol, liCell.StartRow, liCell.EndCol, liCell.EndRow), Sel) then
            Include(DrawState, rmgdSelected);
          if DefaultDrawing or (csDesigning in ComponentState) then
          begin
            with Canvas do
            begin
              Font := Self.Font;
              if (rmgdSelected in DrawState) and (not (rmgdFocused in DrawState) or
                ([rmgoDrawFocusSelected] * Options <> [])) then
              begin
                Brush.Color := clHighlight;
                Font.Color := clHighlightText;
              end
              else
              begin
                if Cells[CurCol, CurRow].FillColor = clNone then
                  Brush.Color := Color
                else
                  Brush.Color := Cells[CurCol, CurRow].FillColor;
              end;
              FillRect(Where);
            end;
          end;
          TempRect := Where;

          DrawCell(CurCol, CurRow, TempRect, ClipRect, DrawState);

          if DefaultDrawing and Ctl3D then
          begin
            if (rmgdFixed in DrawState) and ((FrameFlags1 or FrameFlags2) <> 0) then //draw 3D frame
            begin
              bDown := FPressed and (FPressedCell.X = CurCol) and (FPressedCell.Y = CurRow);
              begin
                if bDown then
                begin
                  with tempRect do
                    BitBlt(Canvas.Handle, Left, Top, Right - Left, Bottom - Top, 0, 0, 0, DSTINVERT);
                end
                else
                begin
                  tempRect.Right := tempRect.Right + 1;
                  tempRect.Bottom := tempRect.Bottom + 1;
                  DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, BF_RECT);
                end;
              end;
            end;
          end;

          if DefaultDrawing and not (csDesigning in ComponentState) and
            (rmgdFocused in DrawState) then
          begin
//            DrawFocusRect(Canvas.Handle, Where)
          end;
        end;
        Where.Left := Where.Left + ColWidths[CurCol] + DrawInfo.Horz.EffectiveLineWidth;
        Inc(CurCol);
      end;
      Where.Top := Where.Top + RowHeights[CurRow] + DrawInfo.Vert.EffectiveLineWidth;
      Inc(CurRow);
    end;
    RestoreClipRect(Canvas);
  end;

  function CalcMaxStroke: Integer;
  var
    i, j, HorzStroke, VertStroke: Integer;
  begin
    Result := Max(DrawInfo.Horz.LastFullVisibleCell - 1,
      DrawInfo.Vert.LastFullVisibleCell - 1) + 4;
    i := MinHorzCell;
    VertStroke := 0;
    while i <= MaxHorzCell do
    begin
      j := MinVertCell;
      while j <= MaxVertCell do
      begin
        if i <> Cells[i, j].EndCol then
        begin
          Inc(VertStroke);
          j := Cells[i, j].EndRow + 1;
        end
        else
          Inc(j);
      end;
      Inc(i);
    end;

    j := MinVertCell; HorzStroke := 0;
    while j <= MaxVertCell do
    begin
      i := MinHorzCell;
      while i <= MaxHorzCell do
      begin
        if j <> Cells[i, j].EndRow then
        begin
          Inc(HorzStroke);
          i := Cells[i, j].EndCol + 1;
        end
        else
          Inc(i);
      end;
      Inc(j);
    end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -