rm_grid.pas

这是一个功能强大

      if H = WindowHandle then
        Result := True
      else
        H := GetParent(H);
    end;
  end;
end;

function TRMGridEx.MouseCoord(X, Y: Integer): TPoint;
var
  DrawInfo: TRMGridDrawInfo;
begin
  CalcDrawInfo(DrawInfo);
  Result := CalcCoordFromPoint(X, Y, DrawInfo);
  if Result.X < 0 then
    Result.Y := -1
  else if Result.Y < 0 then
    Result.X := -1;
end;

procedure TRMGridEx.MoveColRow(ACol, ARow: Longint; MoveAnchor,
  Show: Boolean);
begin
  MoveCurrent(ACol, ARow, MoveAnchor, Show);
end;

function TRMGridEx.SelectCell(ACol, ARow: Longint): Boolean;
begin
  Result := True;
  if Assigned(FOnSelectCell) then
    FOnSelectCell(Self, ACol, ARow, Result);
end;

procedure TRMGridEx.SizeChanged(OldColCount, OldRowCount: Longint);
begin
end;

function TRMGridEx.Sizing(X, Y: Integer): Boolean;
var
  DrawInfo: TRMGridDrawInfo;
  State: TRMGridState;
  Index: Longint;
  Pos, Ofs: Integer;
begin
  State := FGridState;
  if State = rmgsNormal then
  begin
    CalcDrawInfo(DrawInfo);
    CalcSizingState(X, Y, State, Index, Pos, Ofs, DrawInfo);
  end;
  Result := State <> rmgsNormal;
end;

procedure TRMGridEx.TopLeftChanged;
begin
  if FEditorMode and (FInplaceEdit <> nil) then
    FInplaceEdit.UpdateLoc(CellRect(Col, Row));
end;

procedure FillDWord(var Dest; Count, Value: Integer); register;
asm
  XCHG  EDX, ECX
  PUSH  EDI
  MOV   EDI, EAX
  MOV   EAX, EDX
  REP   STOSD
  POP   EDI
end;

{ StackAlloc allocates a 'small' block of memory from the stack by
  decrementing SP.  This provides the allocation speed of a local variable,
  but the runtime size flexibility of heap allocated memory.  }

function StackAlloc(Size: Integer): Pointer; register;
asm
  POP   ECX          { return address }
  MOV   EDX, ESP
  ADD   EAX, 3
  AND   EAX, not 3   // round up to keep ESP dword aligned
  CMP   EAX, 4092
  JLE   @@2
@@1:
  SUB   ESP, 4092
  PUSH  EAX          { make sure we touch guard page, to grow stack }
  SUB   EAX, 4096
  JNS   @@1
  ADD   EAX, 4096
@@2:
  SUB   ESP, EAX
  MOV   EAX, ESP     { function result = low memory address of block }
  PUSH  EDX          { save original SP, for cleanup }
  MOV   EDX, ESP
  SUB   EDX, 4
  PUSH  EDX          { save current SP, for sanity check  (sp = [sp]) }
  PUSH  ECX          { return to caller }
end;

procedure StackFree(P: Pointer); register;
asm
  POP   ECX                     { return address }
  MOV   EDX, DWORD PTR [ESP]
  SUB   EAX, 8
  CMP   EDX, ESP                { sanity check #1 (SP = [SP]) }
  JNE   @@1
  CMP   EDX, EAX                { sanity check #2 (P = this stack block) }
  JNE   @@1
  MOV   ESP, DWORD PTR [ESP+4]  { restore previous SP  }
@@1:
  PUSH  ECX                     { return to caller }
end;

procedure TRMGridEx.SetClipRect(ACanvas: TCanvas; ClipR: TRect);
begin
  FOldRgn := 0;
  FOldRgn := CreateRectRgn(0, 0, 0, 0);
  FHaveClip := GetClipRgn(ACanvas.Handle, FOldRgn);

  FNewRgn := CreateRectRgnIndirect(ClipR);
  SelectClipRgn(ACanvas.Handle, FNewRgn);
  DeleteObject(FNewRgn);
end;

procedure TRMGridEx.RestoreClipRect(ACanvas: TCanvas);
begin
  if FHaveClip > 0 then
    SelectClipRgn(ACanvas.Handle, FOldRgn)
  else
    SelectClipRgn(ACanvas.Handle, 0);
  DeleteObject(FOldRgn);
end;

procedure TRMGridEx.ShowFrame(t: TRMView; aCanvas: TCanvas; x, y, x1, y1: Integer;
  aDrawSubReport: Boolean);

  procedure _Line1(x, y, x1, y1: Integer);
  begin
    aCanvas.MoveTo(x, y);
    aCanvas.LineTo(x1, y1);
  end;

  procedure _DrawFrame(const x, y, x1, y1: Integer; b: TRMFrameLine; aFlag: Byte);
  begin
    aCanvas.Pen.Width := Round(b.Width);
    aCanvas.Pen.Style := b.Style;
    aCanvas.Pen.Color := b.Color;
    aCanvas.MoveTo(x, y);
    aCanvas.LineTo(x1, y1);
  end;

begin
  if t.LeftFrame.Visible then
    Inc(x, Round(t.LeftFrame.Width) div 2 - 1);
  if t.TopFrame.Visible then
    Inc(y, Round(t.TopFrame.Width) div 2 - 1);
  if t.RightFrame.Visible then
    Dec(x1, Round(t.RightFrame.Width) div 2);
  if t.BottomFrame.Visible then
    Dec(y1, Round(t.BottomFrame.Width) div 2);

  if t.LeftFrame.Visible then
    _DrawFrame(x, y, x, y1, t.LeftFrame, 1);
  if t.TopFrame.Visible then
    _DrawFrame(x, y, x1, y, t.TopFrame, 2);
  if t.RightFrame.Visible then
    _DrawFrame(x1, y, x1, y1, t.RightFrame, 3);
  if t.BottomFrame.Visible then
    _DrawFrame(x, y1, x1, y1, t.BottomFrame, 4);

  if t.LeftRightFrame > 0 then
  begin
    aCanvas.Brush.Style := bsSolid;
    aCanvas.Pen.Style := psSolid;
    aCanvas.Pen.Width := 1;
    aCanvas.Pen.Color := t.LeftFrame.Color;
    case t.LeftRightFrame of
      1: _Line1(x, y, x1, y1);
      2:
        begin
          _Line1(x, y, x1 div 2, y1);
          _Line1(x, y, x1, y1 div 2);
        end;
      3:
        begin
          _Line1(x, y, x1, y1);
          _Line1(x, y, x1 div 2, y1);
          _Line1(x, y, x1, y1 div 2);
        end;
      4: _Line1(x, y1, x1, y);
      5:
        begin
          _Line1(x, y1 div 2, x1, y);
          _Line1(x1 div 2, y1, x1, y);
        end;
      6:
        begin
          _Line1(x, y1, x1, y);
          _Line1(x, y1 div 2, x1, y);
          _Line1(x1 div 2, y1, x1, y);
        end;
    end;
  end;

  if (t is TRMSubReportView) and aDrawSubReport then
  begin
    aCanvas.Pen.Width := 1;
    aCanvas.Pen.Color := clBlack;
    aCanvas.Pen.Style := psSolid;
    aCanvas.Brush.Color := clSilver; //clWhite;
    aCanvas.Rectangle(x, y, x1 + 1, y1 + 1);
    aCanvas.Brush.Style := bsClear;
  end;

end;

procedure TRMGridEx.DrawCell(ACol, ARow: Longint; ARect, AClipRect: TRect; AState: TRMGridDrawState);
var
  lSaveRect: TRect;
  liTextAlignMode: UINT;
  liTextToDraw: PChar;
  liTestRect: TRect; // 边框范围与文本试输出范围
  liTestWidth, liTestHeight: Integer; // 实际宽高
  liDrawWidth, liDrawHeight: Integer; // 绘画区宽高
  lView: TRMView;
  lBmp1, lBmp2: TBitmap;

  procedure _DrawAsPicture;
  var
    lSaveOffsetLeft, lSaveOffsetTop: Integer;
    lSave1, lSave2, lSave3, lSave4: Boolean;
    lSaveFillColor: TColor;
    lBitmap: TBitmap;
  begin
    lBitmap := TBitmap.Create;
    lSaveOffsetLeft := THackView(lView).OffsetLeft;
    lSaveOffsetTop := THackView(lView).OffsetTop;
    lSave1 := THackView(lView).LeftFrame.Visible;
    lSave2 := THackView(lView).TopFrame.Visible;
    lSave3 := THackView(lView).RightFrame.Visible;
    lSave4 := THackView(lView).BottomFrame.Visible;
    lSaveFillColor := THackView(lView).FillColor;
    try
      lBitmap.Width := aRect.Right - aRect.Left + 1;
      lBitmap.Height := aRect.Bottom - aRect.Top + 1;
      if rmgdSelected in AState then
        THackView(lView).FillColor := FFocusedFillColor;

      THackView(lView).DrawFocusedFrame := False;
      THackView(lView).LeftFrame.Visible := False;
      THackView(lView).TopFrame.Visible := False;
      THackView(lView).RightFrame.Visible := False;
      THackView(lView).BottomFrame.Visible := False;
      THackView(lView).OffsetLeft := 0;
      THackView(lView).OffsetTop := 0;
      lView.SetspBounds(0, 0, lBitmap.Width - 1, lBitmap.Height - 1);
      lView.Draw(lBitmap.Canvas);
      lView.SetspBounds(lView.spLeft, lView.spTop, lView.spWidth, lView.spHeight);

      Canvas.Draw(aRect.Left, aRect.Top, lBitmap);
      if THackView(lView).HaveEventProp then
        Canvas.Draw(aRect.Left + 1, aRect.Top + 1, lBmp1);

      if (lView is TRMCustomMemoView) and (TRMCustomMemoView(lView).Highlight.Condition <> '') then
        Canvas.Draw(aRect.Left + 1 + 8, aRect.Top + 1, lBmp2);
    finally
      THackView(lView).OffsetLeft := lSaveOffsetLeft;
      THackView(lView).OffsetTop := lSaveOffsetTop;
      THackView(lView).LeftFrame.Visible := lSave1;
      THackView(lView).TopFrame.Visible := lSave2;
      THackView(lView).RightFrame.Visible := lSave3;
      THackView(lView).BottomFrame.Visible := lSave4;
      THackView(lView).FillColor := lSaveFillColor;
      THackView(lView).DrawFocusedFrame := True;
      lBitmap.Free;
    end;
  end;

  procedure CalcTestRect;
  var
    CalcMode: Cardinal;
  begin
    liTestRect := ARect;
    with liTestRect do
    begin
      Dec(Right, Left);
      Dec(Bottom, Top);
      Left := 0;
      Top := 0;
    end;
    CalcMode := DT_CALCRECT;
    if Cells[ACol, ARow].AutoWordBreak then
      CalcMode := CalcMode or DT_WORDBREAK;

    DrawText(Canvas.Handle, liTextToDraw, -1, liTestRect, CalcMode);
    liTestWidth := liTestRect.Right - liTestRect.Left;
    liTestHeight := liTestRect.Bottom - liTestRect.Top;
    liDrawWidth := ARect.Right - ARect.Left;
    liDrawHeight := ARect.Bottom - ARect.Top;
    liTestRect.Left := (liDrawWidth - liTestWidth) div 2;
    liTestRect.Right := liTestRect.Left + liTestWidth;
    liTestRect.Top := (liDrawHeight - liTestHeight) div 2;
    liTestRect.Bottom := liTestRect.Top + liTestHeight;
  end;

  procedure _DrawDropDownField;
  var
    lBmp: TBitmap;
  begin
    lBmp := TBitmap.Create;
    try
      lBmp.LoadFromResourceName(hInstance, 'RM_DropDownField');
      Canvas.Draw(lSaveRect.Right - 16, lSaveRect.Top, lBmp);
    finally
      lBmp.Free;
    end;
  end;

begin
  if (aCol > 0) and (aRow > 0) then
  begin
    ShowFrame(Cells[ACol, ARow].View, Canvas, aRect.Left, aRect.Top,
      aRect.Right, aRect.Bottom, (not (rmgdSelected in AState)));
  end;

  lBmp1 := TBitmap.Create;
  lBmp2 := TBitmap.Create;
  try
    lBmp1.LoadFromResourceName(hInstance, 'RM_SCRIPT');
    lBmp2.LoadFromResourceName(hInstance, 'RM_HIGHLIGHT');

    if (ARow = 0) and (ACol <> 0) then
    begin
      Canvas.Brush.Style := bsClear;
    //    Canvas.Font.Name := 'MS Sans Serif';
    //    Canvas.Font.Size := 8;
    //    Canvas.Font.Style := [];
      Canvas.Font.Color := clWindowText;
      DrawText(Canvas.Handle, PChar(ColTitle(ACol - 1)), -1, ARect, DT_CENTER or DT_VCENTER or DT_SINGLELINE)
    end
    else if (ACol = 0) and (ARow <> 0) then
    begin
      Canvas.Brush.Style := bsClear;
    //    Canvas.Font.Name := 'MS Sans Serif';
    //    Canvas.Font.Size := 8;
    //    Canvas.Font.Style := [];
      Canvas.Font.Color := clWindowText;
      aRect.Right := aRect.Right - 2;
      liTestRect := Rect(ARect.Left + 2, ARect.Top + 2, ARect.Right, ARect.Bottom);
      DrawText(Canvas.Handle, PChar(IntToStr(ARow)), -1, liTestRect, DT_LEFT or DT_TOP or DT_SINGLELINE);
      DrawText(Canvas.Handle, PChar(Cells[0, aRow].Text), -1, aRect, DT_RIGHT {DT_CENTER} or DT_VCENTER or DT_SINGLELINE)
      //    DrawText(Canvas.Handle, PChar(IntToStr(ARow)), -1, ARect, DT_CENTER or DT_VCENTER or DT_SINGLELINE)
    end
    else if (ARow <> 0) and (ACol <> 0) then
    begin
      InflateRect(ARect, -1, -1);
      IntersectClipRect(Canvas.Handle, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
      lView := Cells[aCol, aRow].FView;
      lSaveRect := ARect;
      if (lView <> nil) {and THackView(lView).DrawAsPicture} and FDrawPicture then
      begin
        _DrawAsPicture;
        if (FCurrentCol = aCol) and (FCurrentRow = aRow) then
          _DrawDropDownField;
      end
      else
      begin
        if (lView <> nil) and THackView(lView).HaveEventProp then
          Canvas.Draw(aRect.Left + 1, aRect.Top + 1, lBmp1);

        with Cells[ACol, ARow] do
        begin
          if Text <> '' then
          begin
            liTextToDraw := PChar(Text);
            Canvas.Font.Assign(Font);
            if rmgdSelected in AState then //and ((ACol <> FCurrent.X) or (ARow <> FCurrent.Y)) then
              Canvas.Font.Color := FHighLightTextColor;

            CalcTestRect;
            case HAlign of
              rmHLeft: liTextAlignMode := DT_TOP or DT_LEFT;
              rmHRight: liTextAlignMode := DT_TOP or DT_RIGHT;
            else
              liTextAlignMode := DT_CENTER;
            end;
            case VAlign of
              rmVBottom: ARect.Top := ARect.Bottom - liTestHeight;
              rmVCenter: Inc(ARect.Top, liTestRect.Top);
            end;
            if AutoWordBreak then
              liTextAlignMode := liTextAlignMode or DT_WORDBREAK;

            Windows.DrawText(Canvas.Handle, liTextToDraw, -1, ARect, liTextAlignMode);
          end;
        end;

        if (FCurrentCol = aCol) and (FCurrentRow = aRow) then
          _DrawDropDownField;
      end;

      RestoreClipRect(Canvas);
      SetClipRect(Canvas, AClipRect);
    end;

  //  if Assigned(FOnDrawCell) then
  //  begin
  //    FOnDrawCell(Self, ACol, ARow, ARect, AState);
  //  end;
  finally
    lBmp1.Free;
    lBmp2.Free;
  end;
end;

{$IFNDEF COMPILER4_UP}

function Max(Value1, Value2: Integer): Integer;
begin
  if Valu