Code:

uses

  {...} Grids;

 

type

  TForm1 = class(TForm)

    StringGrid1: TStringGrid;

    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

      Rect: TRect; State: TGridDrawState);

  end;

 

{...}

 

implementation

 

{...}

 

// Display text vertically in StringGrid cells

// Vertikale Textausgabe in den Zellen eines StringGrid

procedure StringGridRotateTextOut(Grid: TStringGrid; ARow, ACol: Integer; Rect: TRect;

  Schriftart: string; Size: Integer; Color: TColor; Alignment: TAlignment);

var

  lf: TLogFont;

  tf: TFont;

begin

  // if the font is to big, resize it

// wenn Schrift zu gro? dann anpassen

if (Size > Grid.ColWidths[ACol] div 2) then

    Size := Grid.ColWidths[ACol] div 2;

  with Grid.Canvas do

  begin

    // Replace the font

   // Font setzen

   Font.Name := Schriftart;

    Font.Size := Size;

    Font.Color := Color;

    tf := TFont.Create;

    try

      tf.Assign(Font);

      GetObject(tf.Handle, SizeOf(lf), @lf);

      lf.lfEscapement  := 900;

      lf.lfOrientation := 0;

      tf.Handle := CreateFontIndirect(lf);

      Font.Assign(tf);

    finally

      tf.Free;

    end;

    // fill the rectangle

   // Rechteck fullen

   FillRect(Rect);

    // Align text and write it

   // Text nach Ausrichtung ausgeben

   if Alignment = taLeftJustify then

      TextRect(Rect, Rect.Left + 2,Rect.Bottom - 2,Grid.Cells[ACol, ARow]);

    if Alignment = taCenter then

      TextRect(Rect, Rect.Left + Grid.ColWidths[ACol] div 2 - Size +

        Size div 3,Rect.Bottom - 2,Grid.Cells[ACol, ARow]);

    if Alignment = taRightJustify then

      TextRect(Rect, Rect.Right - Size - Size div 2 - 2,Rect.Bottom -

        2,Grid.Cells[ACol, ARow]);

  end;

end;

 

// 2. Alternative: Display text vertically in StringGrid cells

// 2. Variante: Vertikale Textausgabe in den Zellen eines StringGrid

procedure StringGridRotateTextOut2(Grid:TStringGrid;ARow,ACol:Integer;Rect:TRect;

          Schriftart:String;Size:Integer;Color:TColor;Alignment:TAlignment);

var

    NewFont, OldFont : Integer;

    FontStyle, FontItalic, FontUnderline, FontStrikeout: Integer;

begin

   // if the font is to big, resize it

  // wenn Schrift zu gro? dann anpassen

  If (Size > Grid.ColWidths[ACol] DIV 2) Then

       Size := Grid.ColWidths[ACol] DIV 2;

   with Grid.Canvas do

   begin

       // Set font

      // Font setzen

      If (fsBold IN Font.Style) Then

          FontStyle := FW_BOLD

       Else

          FontStyle := FW_NORMAL;

 

       If (fsItalic IN Font.Style) Then

          FontItalic := 1

       Else

          FontItalic := 0;

 

       If (fsUnderline IN Font.Style) Then

          FontUnderline := 1

       Else

          FontUnderline := 0;

 

       If (fsStrikeOut IN Font.Style) Then

          FontStrikeout:=1

       Else

          FontStrikeout:=0;

 

       Font.Color := Color;

 

       NewFont := CreateFont(Size, 0, 900, 0, FontStyle, FontItalic,

                             FontUnderline, FontStrikeout, DEFAULT_CHARSET,

                             OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,

                             DEFAULT_PITCH, PChar(Schriftart));

 

       OldFont := SelectObject(Handle, NewFont);

       // fill the rectangle

      // Rechteck fullen

      FillRect(Rect);

       // Write text depending on the alignment

      // Text nach Ausrichtung ausgeben

      If Alignment = taLeftJustify Then

          TextRect(Rect,Rect.Left+2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);

       If Alignment = taCenter Then

          TextRect(Rect,Rect.Left+Grid.ColWidths[ACol] DIV 2 - Size + Size DIV 3,

            Rect.Bottom-2,Grid.Cells[ACol,ARow]);

       If Alignment = taRightJustify Then

          TextRect(Rect,Rect.Right-Size - Size DIV 2 - 2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);

 

       // Recreate reference to the old font

      // Referenz auf alten Font wiederherstellen

      SelectObject(Handle, OldFont);

       // Recreate reference to the new font

      // Referenz auf neuen Font loschen

      DeleteObject(NewFont);

   end;

end;

 

// Call the method in OnDrawCell

// Methode im OnDrawCell aufrufen

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol,

  ARow: Integer; Rect: TRect; State: TGridDrawState);

begin

  // In the second column: Rotate Text by 90° and left align the text

// Text um 90°gedreht ausgeben, linksbundig in der zweiten Spalte

if ACol = 1 then

    StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL',

      12,clRed, taLeftJustify);

 

  // In the third column: Center the text

// Ausgabe zentriert in der dritten Spalte

if ACol = 2 then

    StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clBlue, taCenter);

 

  // In all other columns third row: right align the text

// Ausgabe rechtsbundig in den restlichen Spalten

if ACol > 2 then

    StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clGreen,

      taRightJustify);

end;

 

end.

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить