Author: Reinhard Schatzl
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids;
type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure StringGrid1Click(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
//////////////////////////////////////////////////////////////////////////////////////
//Zellen im StringGrid mit einem Fadenkreuz markieren und einfacher Zellformatierung
//Textausrichten mit oder ohne Zeilenumbruch im StringGrid
procedure GridAlignment(Grid: TStringGrid; Rect: TRect; ACol, ARow: Integer;
  Alignment: TAlignment; LineBreak: Boolean);
var
  TextOut: string;
begin
  Grid.Canvas.FillRect(Rect);
  TextOut := Grid.Cells[ACol, ARow];
  if LineBreak = False then
  begin
    if Alignment = taLeftJustify then
      DrawText(Grid.Canvas.Handle, PChar(TextOut), StrLen(PChar(TextOut)),
        Rect, DT_LEFT);
    if Alignment = taCenter then
      DrawText(Grid.Canvas.Handle, PChar(TextOut), StrLen(PChar(TextOut)),
        Rect, DT_CENTER);
    if Alignment = taRightJustify then
      DrawText(Grid.Canvas.Handle, PChar(TextOut), StrLen(PChar(TextOut)),
        Rect, DT_RIGHT);
  end
  else
  begin
    if Alignment = taLeftJustify then
      DrawText(Grid.Canvas.Handle, PChar(TextOut), StrLen(PChar(TextOut)),
        Rect, DT_LEFT or DT_WORDBREAK);
    if Alignment = taCenter then
      DrawText(Grid.Canvas.Handle, PChar(TextOut), StrLen(PChar(TextOut)),
        Rect, DT_CENTER or DT_WORDBREAK);
    if Alignment = taRightJustify then
      DrawText(Grid.Canvas.Handle, PChar(TextOut), StrLen(PChar(TextOut)),
        Rect, DT_RIGHT or DT_WORDBREAK);
  end;
end;
//Fadenkreuz im Stringgrid erzeugen
procedure DrawReticle(Grid: TStringGrid; ACol, ARow: Integer; Rect: TRect;
  ReticleFontColor, ReticleBackColor,
  GridFontColor, GridBackColor,
  SelFontColor, SelBackColor: TColor);
begin
  if (ACol > Grid.FixedCols - 1) and (ARow > Grid.FixedRows - 1) then
  begin
    with Grid do
    begin
      //Zellen im Fadenkreuz
      if (ACol = Grid.Col) or (ARow = Grid.Row) then
      begin
        Canvas.Font.Color  := ReticleFontColor;
        Canvas.Brush.Color := ReticleBackColor;
        //Zellentext ausgeben
        GridAlignment(Grid, Rect, ACol, ARow, taCenter, False);
        Canvas.FrameRect(Rect);
      end
      else
      //Zellen auserhalb des Fadenkreuz
      begin
        Canvas.Font.Color  := GridFontColor;
        Canvas.Brush.Color := GridBackColor;
        //Zellentext ausgeben
        GridAlignment(Grid, Rect, ACol, ARow, taLeftJustify, False);
        Canvas.FrameRect(Rect);
      end;
      //markierte Zelle
      if (ACol = Grid.Col) and (ARow = Grid.Row) then
      begin
        Canvas.Font.Color  := SelFontColor;
        Canvas.Brush.Color := SelBackColor;
        //Zellentext ausgeben
        GridAlignment(Grid, Rect, ACol, ARow, taCenter, False);
        Canvas.FrameRect(Rect);
      end;
    end;
  end;
end;
//Example
//Procedure im OnDrawCell des Grid aufrufen
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  //Fadenkreuz erzeugen
  DrawReticle(StringGrid1, ACol, ARow, Rect,
    clWindow, clNavy, clWindowText, clInfoBk, clWindowText, clWindow);
end;
 //Für neue Zellenselektion, Grid neu Zeichnen
procedure TForm1.StringGrid1Click(Sender: TObject);
begin
  StringGrid1.Invalidate;
end;
end.
printed from
  www.swissdelphicenter.ch
  developers knowledge base