[gelöst] StringGrid Zellenverbinden(Colspan) funktioniert nicht richtig.

[Soner]

Ich verwende StringGrid für Jahresplaner und die Tage werden vom Jahresanfang bis Ende in Spalten dargestellt. Die 1. Zeile benutze ich für Monatsnamen und verbinden alle Spalten des Monats und zeige dort Monatsname. Dafür verwende ich mcgrid-Beispiel aus "\lazarus42\examples\gridexamples\merged_cells". Wenn alle Spalten eines Monats sichtbar sind, dann funktioniert alles funktioniert alles Gut, aber wenn Monatsanfang oder Ende oder beide nicht sichtbar sind, dann gibt es Darstellungsfehler.

Ich habe die Ursache nicht gefunden, hat jemand so etwas gemacht und kennt die Lösung des Problems?

Das ist mcgrid:

Code: Alles auswählen

  TMCStringGrid = class(TStringGrid)
  private
    FMergeLock: Integer;
    FOnMergeCells: TMergeCellsEvent;
    FOnDrawCellText: TDrawCellTextEvent;
  protected
    procedure CalcCellExtent(ACol, ARow: Integer; var ARect: TRect); override;
    procedure DoEditorShow; override;
    procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
    procedure DrawCellText(ACol, ARow: Integer; ARect: TRect;
      AState: TGridDrawState; AText: String); override;
    function GetCells(ACol, ARow: Integer): String; override;
    function GetEditText(ACol, ARow: Integer): String; override;
    function IsMerged(ACol, ARow: Integer): Boolean; overload;
    function IsMerged(ACol, ARow: Integer;
      out ALeft, ATop, ARight, ABottom: Integer): Boolean; overload;
    procedure MoveSelection; override;
    procedure PrepareCanvas(aCol, aRow: Integer; AState: TGridDrawState); override;
    procedure SetEditText(ACol, ARow: LongInt; const Value: String); override;
    function  MoveNextSelectable(Relative: Boolean; DCol, DRow: Integer): Boolean; override;
  published
    property OnDrawCelLText: TDrawCellTextEvent read FOnDrawCellText write FOnDrawCellText;
    property OnMergeCells: TMergeCellsEvent read FOnMergeCells write FOnMergeCells;
  end;


implementation

{ Calculates the size of the merged block }
procedure TMCStringGrid.CalcCellExtent(ACol, ARow: Integer; var ARect: TRect);
var
  L, T, R, B, dummy: Integer;
begin
  if IsMerged(ACol, ARow, L, T, R, B) then begin
    ColRowToOffset(true, true, L, ARect.Left, dummy);
    ColRowToOffset(true, true, R, dummy, ARect.Right);
    ColRowToOffset(false, true, T, ARect.Top, dummy);
    ColRowToOffset(false, true, B, dummy, ARect.Bottom);
  end else
    // Call the inherited procedure to handle non-merged cells
    inherited;
end;

{ Make sure that the cell editor of a merged block is the same size as the
  merged block }
procedure TMCStringGrid.DoEditorShow;
var
  R: TRect;
begin
  inherited;
  if (goColSpanning in Options) and Assigned(Editor) then begin
    R := CellRect(Col, Row);
    CalcCellExtent(Col, Row, R);
    Editor.SetBounds(R.Left, R.Top, R.Right-R.Left-1, R.Bottom-R.Top-1);
  end;
end;

procedure TMCStringGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
  aState: TGridDrawState);
var
  L, T, R, B: Integer;
begin
  if IsMerged(aCol, aRow, L, T, R, B) and ((aCol<>L) or (aRow<>T)) then
    // nothing to draw
  else
    inherited DrawCell(aCol, aRow, aRect, aState);
end;

{ Draws the cell text. Allows to hook in an external painting routine which
  will replace the built-in painting routine if it sets "Handled" to true. }
procedure TMCStringGrid.DrawCellText(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState; AText: String);
var
  handled: Boolean;
begin
  handled := false;
  if Assigned(FOnDrawCellText) then
    FOnDrawCellText(Self, ACol, ARow, ARect, AState, AText, handled);
  if not handled then
    inherited;
end;

{ Returns the string to be displayed in the specified cell. In case of a merged
  block only the text assigned to the top-left cell of the block is used. }
function TMCStringGrid.GetCells(ACol, ARow: Integer): String;
var
  L, T, R, B: Integer;
begin
  if (FMergeLock = 0) and IsMerged(ACol, ARow, L, T, R, B) then
    Result := inherited GetCells(L, T)
  else
    Result := inherited GetCells(ACol, ARow);
end;

{ Make sure to use only the topleft cell of a merged block for editing }
function TMCStringGrid.GetEditText(ACol, ARow: Integer): String;
begin
  Result := GetCells(ACol, ARow);
  if Assigned(OnGetEditText) then OnGetEditText(self, ACol, ARow, Result);
end;

{ Check whether the specified cell belongs to a merged block}
function TMCStringGrid.IsMerged(ACol, ARow: Integer): Boolean;
var
  L, T, R, B: Integer;
begin
  Result := IsMerged(ACol, ARow, L, T, R, B);
end;

{ Checks whether the specified cell belongs to a merged block and returns the
  cell coordinate of the block extent }
function TMCStringGrid.IsMerged(ACol,ARow: Integer;
  out ALeft, ATop, ARight, ABottom: Integer): Boolean;
var
  tmp: Integer;
begin
  Result := false;
  if not (goColSpanning in Options) then exit;
  if not Assigned(FOnMergeCells) then exit;
  inc(FMergeLock);

  ALeft := ACol;
  ARight := ACol;
  ATop := ARow;
  ABottom := ARow;
  FOnMergeCells(Self, ACol, ARow, ALeft, ATop, ARight, ABottom);
  if ALeft > ARight then begin
    tmp := ALeft;
    ALeft := ARight;
    ARight := tmp;
  end;
  if ATop > ABottom then begin
    tmp := ATop;
    ATop := ABottom;
    ABottom := tmp;
  end;
  Result := (ALeft <> ARight) or (ATop <> ABottom);
  dec(FMergeLock);
end;

{ Repaints the entire grid after the selection is moved because normally only
  the selected cell would be painted, and this would result in an imcompletely
  painted merged block }
procedure TMCStringGrid.MoveSelection;
begin
  if SelectActive then
    InvalidateGrid;
  inherited;
end;

{ Makes sure that all cells of the merged block are drawn as selected/focused,
  not just the active cell }
procedure TMCStringGrid.PrepareCanvas(aCol, aRow: Integer;
  AState: TGridDrawState);
var
  L, T, R, B: Integer;
begin
  if IsMerged(ACol, ARow, L, T, R, B) and not (gdFixed in AState) and
    (Col >= L) and (Col <= R) and (Row >= T) and (Row <= B) and
    not ((ACol = Col) and (ARow = Row))
  then
    AState := AState + [gdSelected, gdFocused];
  inherited;
end;

{ Writes the edited text back into the grid. Makes sure that, in case of a
  merged block, the edited text is assigned to the top/left cell }
procedure TMCStringGrid.SetEditText(ACol, ARow: LongInt; const Value: String);
var
  L, T, R, B: Integer;
begin
  if IsMerged(ACol, ARow, L,T,R,B) then
    inherited SetEditText(L, T, Value)
  else
    inherited SetEditText(ACol, ARow, Value);
end;

function TMCStringGrid.MoveNextSelectable(Relative: Boolean; DCol, DRow: Integer
  ): Boolean;
var
  L, T, R, B: Integer;
begin
  if Relative and IsMerged(Col, Row, L, T, R, B) then begin
    // we are only interested on relative movement (basically by keyboard)
    if DCol>0 then DCol := R - Col + 1 else
    if DCol<0 then DCol := L - Col - 1 else
    if DRow>0 then DRow := B - Row + 1 else
    if DRow<0 then DRow := T - Row - 1;
  end;
  Result := inherited MoveNextSelectable(Relative, DCol, DRow);
end;

Ich habe das Beispiel merged_cells umgebaut und hochgeladen.
Scrollt mal spaltenweise(mit Pfeil) oder seitenweise, klickt auf Button "Neu Zeichnen".
Wenn Anfang und Ende im unsichtbaren Bereich liegt, dann hilft auch "Neu Zeichnen" nicht.

[wp_xyz]

Generell fehlt in dem Beispiel im examples-Ordner das Clipping der verbundenen Zellen. Weil eine solche Zelle immer zumindest partiell in den fixed-Bereich geschoben werden kann, müsste man alle Rect-Parameter der Zeichen-Routinen noch mit dem gesamten Nicht-Fixed-Rechteck (*) des Grid schneiden. Auch ohne diesen Schritt wird das Verhalten verbessert, wenn man die Option goSmoothScroll deaktiviert, so dass nur um ganze Zellen gescrollt werden kann.

Die Textausgabe müsste etwas aufwendiger gemacht werden: Man holt sich den Text aus der linken oberen Ecke des merged-Blocks - ok. Wenn aber der Block teilweise nach links aus dem sichtbaren Bereich herausgescrollt ist, müsste man nur das sichtbare Rechteck (ARect-Parameter, geschnitten mit dem Nicht-Fixed-Rect) für die Textausgabe verwenden. Damit würde der Text "nachrutschen", wenn die linke/obere Zelle herausgescrollt worden ist).

Bei deinem Code habe ich die Details nicht verstanden. Auf jeden Fall wird dort das Verhalten besser, wenn die Option goSmoothScroll nicht aktiv ist.

(*)
Mit "Nicht-Fixed-Rechteck" meine ich das Rechteck zwischen dem rechten Rand der letzten FixedCol und dem rechten Rand des Grid-ClientRect, sowie zwischen dem unteren Rand der letzten Fixed-Row und dem unteren Rand des Grid-ClientRect

P.S.
Ein Year-Grid gibt es übrigens auch in den JVCL-Controls.

[Soner]

Mein Code ist eigentlich nicht besonders, es verbindet in der 2. Zeile viele Spalten zu einer Spalte um Monatsname zu simulieren.
Textausgabe hatte ich verzichtet, jetzt habe ich es hinzugefügt, das funktioniert gut, ich hatte auch ein Bereich falsch angegeben.
Was mir auffiel ist, das wenn die 1. verbundene Spalte nicht im sichtbaren Bereich ist, dann werden Ränder falsch gezeichnet, auch wenn man rechts scrollt und letzte Spalte nicht sichtbar ist.

Ich werde wahrscheinlich, erstmal weitermachen und später mich um dieses Problem kümmern, Ich neige dazu, die Monatsnamen in kleinen verbundenen Spalten mehrmals auszugeben, weil wenn man scrollt und am Ende des Monats arbeitet sieht man nich,t in welchem Monat man arbeitet, es kommt noch Summenspalten am Ende jeden Monats.
Ich wollte erst TsWorksheetGrid verwenden, bis auf Extradaten in einigen Spalten, enhält es alles was ich brauche, aber es ist für meine Tabelle sehr langsam.

[Soner]

Ich habe es gelöst in dem ich mein Anfangscode benutzt habe. Ich hatte wegen Bequemlichkeit zu MCGrid gewechselt und MCGrid war nicht komplett sowie wp schrieb.

Darstellungsfehler von Rahmen beim Scrollen gibt es auch nicht, nur Text wird nicht gezeichnet, man muss nach Scrollen neu Zeichnen. Ich muss nur noch Ereignis dafür finden, ich glaube es ist OnTopLeftChanged.

Falls jemand so etwas machen möchte, benutze OnCalcCellExtent, verwende aber in OnCalcCellExtent nie CellRect oder CalcCellExtent, weil es Recursion gibt. Ich brauchte CellRect, darum habe ich es von Grids.pas kopiert und im Programm als CellRect2 verwendet, wobei ich CalcCellExtent ausgeklammert habe.

[Soner]

Zu früh gefreut.
Wenn die erste Spalte nicht sichtbar ist, dann wird ja kein Text gezeichnet, ich glaube deshalb:

Code: Alles auswählen

procedure TCustomStringGrid.DrawColumnText(aCol, aRow: Integer; aRect: TRect;
  aState: TGridDrawState);
begin
  if Columns.Enabled then
    inherited
  else begin
    DrawColumnTitleImage(aRect, aCol);
    DrawCellText(aCol,aRow,aRect,aState,Cells[aCol,aRow])
  end;
end;

Meine Lösungsvorschlag war so:

Code: Alles auswählen

// neuer Event
TMergedEvent = procedure (Sender: TObject; var AMerged: Boolean; ACol, ARow, AFirstCol, AFirstRow: Integer) of object;

// DrawColumnText anpassen
procedure TPersplanGrid.DrawColumnText(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
var aMerged: Boolean;
    aFirstCol, aFirstRow: integer;
    aText: string;
begin
  if Columns.Enabled then
    inherited
  else begin
    //NEU
    if (goColSpanning  in Options)and Assigned(fOnMerged) then begin
      //Bei Merged soll der Benutzer selber setzen: AFirstCol:=aCol; AFirstRow:=ARow;
      AMerged:=false;
      fOnMerged(Self, aMerged, aCol, aRow, aFirstCol, aFirstRow);
      if AMerged and ((aCol<>aFirstCol)or(aRow<>aFirstRow)) then
        aText:=Cells[aFirstCol, aFirstRow]
      else
        aText:=Cells[aCol, aRow]
    end
    else
      aText:=Cells[aCol, aRow];
    //ENDE NEU
	
    DrawColumnTitleImage(aRect, aCol);
    DrawCellText(aCol,aRow,aRect,aState,aText); //Cells[aCol,aRow]
  end;
end

Nur ich habe den Eindruck wenn die Zelle leer ist, dann wird das gar nicht aufgerufen. Es muss noch irgendwo, irgendwas geändert werden.

[wp_xyz]

Ich konnte im "Examples"-Project eben eine Verbesserung erzielen, indem ich das dort unterbundene mehrfache Neuzeichnen der Zellen eines Merge-Blocks erlaubt habe:

Code: Alles auswählen

(*  // bisheriger code
procedure TMCStringGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
  aState: TGridDrawState);
var
  L, T, R, B: Integer;
begin
  if IsMerged(aCol, aRow, L, T, R, B) and ((aCol<>L) or (aRow<>T)) then
    // nothing to draw
  else
    inherited DrawCell(aCol, aRow, aRect, aState);
end;
*)
// geändert zu...
procedure TMCStringGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
  aState: TGridDrawState);
var
  L, T, R, B: Integer;
begin
  if IsMerged(aCol, aRow, L, T, R, B) then
    CalcCellExtent(L, T, aRect);
  inherited DrawCell(aCol, aRow, aRect, aState);
end;

Funktioniert, setzt allerdings voraus, dass SmoothScrolling nicht aktiv ist - da gibt es noch Update-Artefakte.