Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   StringGrid, Dibujar mas de una celda o columna (https://www.clubdelphi.com/foros/showthread.php?t=88013)

olbeup 01-04-2015 13:50:34

StringGrid, Dibujar mas de una celda o columna
 
Hola Compañer@s,

A la hora de dibujar un cuadrado en una o varias celdas de un StingGrid no hay ningún problemas.
El problema está cuando selecciona la celda que tiene dibujado mas de una celda y sólo me dibuja la primera, no veo la luz al final del tunel.

Código Delphi [-]
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  objSG: TGridCell;
  SndSG: TStringGrid;
  RectDraw, RectText: TRect;
begin
  SndSG := (Sender as TStringGrid);

  RectDraw := Rect;
    InflateRect(RectDraw, -1, -1);

  RectText := RectDraw;
    InflateRect(RectText, -1, -1);

  objSG := (SndSG.Objects[ACol, ARow] as TGridCell);

  if (not Assigned(objSG)) then
    Exit;

  case objSG.Alignment of
    taLeftJustify:
      Inc(RectText.Left, 2);
    taRightJustify:
      Dec(RectText.Right, 2);
  end;

  with SndSG do
  begin
    if (ACol = objSG.CoordCell.Col) and (ARow = objSG.CoordCell.Row) and (objSG.CoordCell.ColUnion <= 0) then
      Exit;

    if (ACol = objSG.CoordCell.Col) and (ARow = objSG.CoordCell.Row) and (objSG.CoordCell.ColUnion > 1) then
    begin
      RectDraw.Right := (RectDraw.Right + objSG.CoordCell.ColUnion -1) + (objSG.CoordCell.DefaultColWidth * (objSG.CoordCell.ColUnion -1));
      RectText.Right := RectDraw.Right;
    end;

    if (gdSelected in State) then
      Canvas.RoundRect(RectDraw.Left, RectDraw.Top, RectDraw.Right, RectDraw.Bottom, 3, 3) <--- AQUÍ ES CUANDO DIBUJA SOLO UNA CUANDO TIENE QUE DIBUJAR MAS DE UNA
    else
      Canvas.Rectangle(RectDraw);  <--- AQUÍ LO HACE BIEN

    DrawText(Canvas.Handle, PChar(objSG.TextCell), StrLen(PChar(objSG.TextCell)), RectText, objSG.DrawAlign OR DT_VCENTER OR DT_SINGLELINE);
  end;
end;
Un saludo.

ecfisa 01-04-2015 14:30:01

Hola olbeup.

Una consulta, ¿ que clase es TGridCell ? no pude encontrar referencias.

Saludos :)

olbeup 01-04-2015 15:13:13

Cita:

Empezado por ecfisa (Mensaje 490750)
Hola olbeup.

Una consulta, ¿ que clase es TGridCell ? no pude encontrar referencias.

Saludos :)

Esta clase es creada por mi, la información de cada celda la tiene TGridCell, que es:

Código Delphi [-]
type
  TGridCell = class(TObject)
  private
    FAlignment: TAlignment;       // Alineación
    FCoordCell: TCoordCell;       // Coordenadas de la celda
    FFontCell: TFontCell;         // Fuente, Tamaño y color de la celda
    FTextCell: String;            // Texto de la celda
    FServiceCell: TServiceCell;   // Datos del Servicio
  protected
    FStrGrid: TStringGrid;        // Objecto que apunta al StringGrid
    function GetDrawAlign: Integer;
  public
    constructor Create(StrGrid: TStringGrid);
    destructor Destroy; override;

    procedure RefreshCell;
  published
    property Alignment: TAlignment read FAlignment write FAlignment;
    property DrawAlign: Integer read GetDrawAlign;

    property CoordCell: TCoordCell read FCoordCell write FCoordCell;
    property FontCell: TFontCell read FFontCell write FFontCell;
    property TextCell: String read FTextCell write FTextCell;
    property ServiceCell: TServiceCell read FServiceCell write FServiceCell;
  end;

El problemas es cuando al dibujar el cuadro de las celdas, sólo dibuja la primera al hacer click en la celda que tiene dibujado varias celdas.

Un saludo.

olbeup 02-04-2015 22:55:34

Hola Compañer@s,

Conseguido, :D:D^\||/

Me ha costado pero lo he conseguido, si alguien le interesa:
Código Delphi [-]
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  objSG: TGridCell;
  SndSG: TStringGrid;
  RectDraw, RectText: TRect;
begin
  SndSG := (Sender as TStringGrid);

  RectDraw := Rect;
    InflateRect(RectDraw, -1, -1);

  RectText := RectDraw;
    InflateRect(RectText, -1, -1);

  objSG := (SndSG.Objects[ACol, ARow] as TGridCell);

  if (not Assigned(objSG)) then
    Exit;

  case objSG.Alignment of
    taLeftJustify:
      Inc(RectText.Left, 2);
    taRightJustify:
      Dec(RectText.Right, 2);
  end;

  with SndSG do
  begin
    if (ACol = objSG.CoordCell.Col) and (ARow = objSG.CoordCell.Row) and (objSG.CoordCell.ColUnion <= 0) then
      Exit;

    if (ACol = objSG.CoordCell.Col) and (ARow = objSG.CoordCell.Row) and (objSG.CoordCell.ColUnion > 1) then
    begin
      RectDraw.Right := (RectDraw.Right + objSG.CoordCell.ColUnion -1) + (objSG.CoordCell.DefaultColWidth * (objSG.CoordCell.ColUnion -1));
      RectText.Right := RectDraw.Right;
    end;

    Options := Options - [goRowSelect];
    if (gdSelected in State) and (gdFocused in State) then
      if (objSG.CoordCell.ColUnion > 1) then
      begin
        Options := Options + [goRowSelect];
        Exit;
      end;

    if (gdSelected in State) then
      Canvas.RoundRect(RectDraw.Left, RectDraw.Top, RectDraw.Right, RectDraw.Bottom, 5, 5)
    else
      Canvas.FillRect(RectDraw);

    DrawText(Canvas.Handle, PChar(objSG.TextCell), StrLen(PChar(objSG.TextCell)), RectText, objSG.DrawAlign OR DT_VCENTER OR DT_SINGLELINE);
  end;
end;
Un saludo.


La franja horaria es GMT +2. Ahora son las 08:08:32.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi