rm_grid.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,110 行 · 第 1/5 页

    UnionRect(Union, R1, R2);
    if Build(XorRects[0],
      Point(Union.Left, Union.Top),
      Point(Union.Left, Intersect.Top),
      Point(Union.Left, Intersect.Bottom)) then
      XorRects[0].Right := Intersect.Left;
    if Build(XorRects[1],
      Point(Intersect.Left, Union.Top),
      Point(Intersect.Right, Union.Top),
      Point(Union.Right, Union.Top)) then
      XorRects[1].Bottom := Intersect.Top;
    if Build(XorRects[2],
      Point(Union.Right, Intersect.Top),
      Point(Union.Right, Intersect.Bottom),
      Point(Union.Right, Union.Bottom)) then
      XorRects[2].Left := Intersect.Right;
    if Build(XorRects[3],
      Point(Union.Left, Union.Bottom),
      Point(Intersect.Left, Union.Bottom),
      Point(Intersect.Right, Union.Bottom)) then
      XorRects[3].Top := Intersect.Bottom;
  end;
end;

procedure ModifyExtents(var Extents: Pointer; Index, Amount: Longint;
  Default: Integer);
var
  LongSize, OldSize: LongInt;
  NewSize: Integer;
  I: Integer;
begin
  if Amount <> 0 then
  begin
    if not Assigned(Extents) then
      OldSize := 0
    else
      OldSize := PIntArray(Extents)^[0];
    if (Index < 0) or (OldSize < Index) then
      InvalidOp(SIndexOutOfRange);
    LongSize := OldSize + Amount;
    if LongSize < 0 then
      InvalidOp(STooManyDeleted)
    else if LongSize >= MaxListSize - 1 then
      InvalidOp(SGridTooLarge);
    NewSize := Cardinal(LongSize);
    if NewSize > 0 then
      Inc(NewSize);
    ReallocMem(Extents, NewSize * SizeOf(Integer));
    if Assigned(Extents) then
    begin
      I := Index + 1;
      while I < NewSize do
      begin
        PIntArray(Extents)^[I] := Default;
        Inc(I);
      end;
      PIntArray(Extents)^[0] := NewSize - 1;
    end;
  end;
end;

procedure UpdateExtents(var Extents: Pointer; NewSize: Longint;
  Default: Integer);
var
  OldSize: Integer;
begin
  OldSize := 0;
  if Assigned(Extents) then
    OldSize := PIntArray(Extents)^[0];
  ModifyExtents(Extents, OldSize, NewSize - OldSize, Default);
end;

procedure MoveExtent(var Extents: Pointer; FromIndex, ToIndex: Longint);
var
  Extent: Integer;
begin
  if Assigned(Extents) then
  begin
    Extent := PIntArray(Extents)^[FromIndex];
    if FromIndex < ToIndex then
      Move(PIntArray(Extents)^[FromIndex + 1], PIntArray(Extents)^[FromIndex],
        (ToIndex - FromIndex) * SizeOf(Integer))
    else if FromIndex > ToIndex then
      Move(PIntArray(Extents)^[ToIndex], PIntArray(Extents)^[ToIndex + 1],
        (FromIndex - ToIndex) * SizeOf(Integer));
    PIntArray(Extents)^[ToIndex] := Extent;
  end;
end;

{ Private. LongMulDiv multiplys the first two arguments and then
  divides by the third.  This is used so that real number
  (floating point) arithmetic is not necessary.  This routine saves
  the possible 64-bit value in a temp before doing the divide.  Does
  not do error checking like divide by zero.  Also assumes that the
  result is in the 32-bit range (Actually 31-bit, since this algorithm
  is for unsigned). }

function LongMulDiv(Mult1, Mult2, Div1: Longint): Longint; stdcall;
  external 'kernel32.dll' name 'MulDiv';

{ TRMGridEx }

constructor TRMGridEx.Create(AOwner: TComponent);
const
  GridStyle = [csCaptureMouse, csOpaque, csDoubleClicks];
begin
  inherited Create(AOwner);
  if NewStyleControls then
    ControlStyle := GridStyle
  else
    ControlStyle := GridStyle + [csFramed];

  FEditorMode := False;
  FInplaceEdit := nil;
  FAutoCreateName := True;
  FSaveLastNameIndex := 1;
  FInLoadSaveMode := False;
  FCanEditModify := True;
  FColCount := 10;
  FRowCount := 6;
  FFixedCols := 1;
  FFixedRows := 1;
  FGridLineWidth := 1;
  FDefaultColWidth := 64;
  FDefaultRowHeight := 24;
  FOptions := [rmgoFixedVertLine, rmgoFixedHorzLine, rmgoVertLine, rmgoHorzLine,
    rmgoRangeSelect, rmgoRowSizing, rmgoColSizing, rmgoDrawFocusSelected,
    rmgoEditing];
  FScrollBars := ssBoth;
  FBorderStyle := bsSingle;
  FSaveCellExtents := True;
  ParentColor := False;
  TabStop := True;
  FDefaultDrawing := True;
  FAutoDraw := True;

  Color := clWindow;
  FFixedColor := clBtnFace;
  FTitleColor := clBtnFace;
  FHighLightColor := clBlack;
  FHighLightTextColor := clWhite;
  FFocusedTitleColor := clBlack;
  FFixedLineColor := clBlack;
  FClientLineColor := clSilver;

  FAutoUpdate := True;
  FGridCanCopyMove := False;
  FGridCanFill := False;

  if RMIsChineseGB then
    Font.Name := '宋体'
  else
    Font.Name := 'Arial';
  Font.Charset := StrToInt(RMLoadStr(SCharset));
  Font.Size := 10;

  FCells := TRMCells.Create(FColCount, FRowCount, Self);
  SetBounds(Left, Top, FColCount * FDefaultColWidth, FRowCount * FDefaultRowHeight);
  Initialize;
end;

destructor TRMGridEx.Destroy;
begin
  FreeAndNil(FInplaceEdit);
  FAutoDraw := False;
  FCells.Free;
  inherited Destroy;
  FreeMem(FColWidths);
  FreeMem(FRowHeights);
end;

procedure TRMGridEx.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_TABSTOP;
    if FScrollBars in [ssVertical, ssBoth] then
      Style := Style or WS_VSCROLL;
    if FScrollBars in [ssHorizontal, ssBoth] then
      Style := Style or WS_HSCROLL;
    WindowClass.style := CS_DBLCLKS;
    if FBorderStyle = bsSingle then
    begin
      if NewStyleControls and Ctl3D then
      begin
        Style := Style and not WS_BORDER;
        ExStyle := ExStyle or WS_EX_CLIENTEDGE;
      end
      else
        Style := Style or WS_BORDER;
    end;
  end;
end;

procedure TRMGridEx.ClearGrid;
begin
  FInLoadSaveMode := True;
  try
    Initialize;
    FCells.Free;
    FreeMem(FColWidths);
    FreeMem(FRowHeights);
    FColWidths := nil;
    FRowHeights := nil;

    FColCount := 2;
    FRowCount := 2;
    FCells := TRMCells.Create(FColCount, FRowCount, Self);
    SetBounds(Left, Top, FColCount * FDefaultColWidth, FRowCount * FDefaultRowHeight);
    ColWidths[0] := 100;
    Initialize;
  finally
    FInLoadSaveMode := False;
  end;
end;

procedure TRMGridEx.Assign(Source: TPersistent);
var
  i, liCol, liRow: Integer;
begin
  if not (Source is TRMGridEx) then Exit;

  ColCount := TRMGridEx(Source).ColCount;
  RowCount := TRMGridEx(Source).RowCount;
  FixedColor := TRMGridEx(Source).FixedColor;
  Font.Assign(TRMGridEx(Source).Font);
  DefaultRowHeight := TRMGridEx(Source).DefaultRowHeight;
  DefaultColWidth := TRMGridEx(Source).DefaultColWidth;
  for i := 1 to TRMGridEx(Source).ColCount - 1 do
    ColWidths[i] := TRMGridEx(Source).ColWidths[i];

  for i := 1 to TRMGridEx(Source).RowCount - 1 do
    RowHeights[i] := TRMGridEx(Source).RowHeights[i];

  for liCol := 1 to TRMGridEx(Source).ColCount - 1 do
  begin
    for liRow := 1 to TRMGridEx(Source).RowCount - 1 do
    begin
      Cells[liCol, liRow].Assign(TRMGridEx(Source).Cells[liCol, liRow]);
    end;
  end;
end;

procedure TRMGridEx.CreateViewsName;
var
  i, j: Integer;
  sl: TStringList;
  lPage: TRMCustomPage;
  lCell: TRMCellInfo;
  str, str1: string;
  lPageObjects: TList;

  procedure _GetObjects;
  var
    i, j: Integer;
  begin
    if sl <> nil then Exit;

    sl := TStringList.Create;
    sl.BeginUpdate;
    for i := 0 to ParentReport.Pages.Count - 1 do
    begin
      lPage := ParentReport.Pages[i];
      lPageObjects := lPage.PageObjects;
      for j := 0 to lPageObjects.Count - 1 do
      begin
        if TRMView(lPageObjects[j]).Name <> '' then
          sl.Add(UpperCase(TRMView(lPageObjects[j]).Name));
        THackPage(lPage).AddChildView(sl, True);
      end;
    end;

    sl.Sort;
    sl.Sorted := True;
    sl.EndUpdate;
  end;

  procedure _CreateName;
  var
    lIndex: Integer;
  begin
    _GetObjects;
    str1 := THackView(lCell.View).BaseName;
    while True do
    begin
      str := str1 + IntToStr(FSaveLastNameIndex);
      if not sl.Find(UpperCase(str), lIndex) then
      begin
        lCell.View.Name := str;

        Inc(FSaveLastNameIndex);
        sl.Add(UpperCase(str));
        Break;
      end;
      Inc(FSaveLastNameIndex);
    end;
  end;

begin
  if not AutoCreateName then Exit;

  sl := nil;
  try
    for i := 1 to RowCount - 1 do
    begin
      j := 1;
      while j < ColCount do
      begin
        lCell := Cells[j, i];
        if (lCell.StartRow = i) and (lCell.View.Name = '') then
        begin
          _CreateName;
        end;
        j := lCell.EndCol + 1;
      end;
    end;
  finally
    sl.Free;
  end;
end;

function TRMGridEx.GetCellInfo(ACol, Arow: Integer): TRMCellinfo;
var
  liCell: TRMCellInfo;
begin
  liCell := Cells[ACol, ARow];
  Result := Cells[liCell.StartCol, liCell.StartRow];
end;

function TRMGridEx.BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
var
  GridRect: TRect;
begin
  GridRect.Left := ALeft;
  GridRect.Right := ARight;
  GridRect.Top := ATop;
  GridRect.Bottom := ABottom;
  GridRectToScreenRect(GridRect, Result, False);
end;

function TRMGridEx.CellRect(ACol, ARow: Longint): TRect;
begin
  Result := BoxRect(ACol, ARow, ACol, ARow);
end;

function TRMGridEx.IsActiveControl: Boolean;
var
  H: Hwnd;
  ParentForm: TCustomForm;
begin
  Result := False;
  ParentForm := GetParentForm(Self);
  if Assigned(ParentForm) then
  begin
    if (ParentForm.ActiveControl = Self) then
      Result := True
  end
  else
  begin
    H := GetFocus;
    while IsWindow(H) and (Result = False) do
    begin
      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;