Перевернуть текст в TStringGrid на 90 градусов

Delphi , Компоненты и Классы , TStringGrid и TDrawGrid

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

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.

Приведенный код - это программный проект на языке Delphi, использующий компонент TStringGrid для отображения текста в таблице. Процедура StringGridRotateTextOut используется для поворота текста в ячейках таблицы на 90 градусов и выравнивания его по указанному направлению.

Описание работы кода:

1. Процедура StringGridRotateTextOut принимает несколько параметров:
   • Grid: компонент TStringGrid, содержащий текст.
   • ARow, ACol: индексы строки и столбца ячейки, которую нужно заполнить текстом.
   • Rect: прямоугольник, представляющий границы ячейки.
   • Schriftart: имя шрифта для отображения текста.
   • Size: размер шрифта для отображения текста.
   • Color: цвет для отображения текста.
   • Alignment: направление выравнивания текста (лево, по центру или правое).
2. Процедура сначала проверяет, является ли шрифт слишком большим, и если да, то уменьшает его размер.
3. Затем она создает новый шрифт с указанным именем, размером и цветом.
4. Процедура заполняет прямоугольник фоном.
5. В зависимости от направления выравнивания, она записывает текст в ячейку с помощью функции TextRect.

Альтернативное решение, StringGridRotateTextOut2, похоже, но использует другой подход для поворота текста. Вместо создания нового шрифта и заполнения прямоугольника, она использует функции CreateFont и SelectObject для создания нового объекта шрифта и выбора его как текущего шрифта для канваса.

В обработчике события OnDrawCell, код вызывает процедуру StringGridRotateTextOut для поворота текста в конкретных столбцах (1 и 2) и выравнивания его по указанному направлению. Для всех других столбцов текст правее выравнивается.

Для улучшения кода можно рассмотреть следующие предложения:

• Вместо жесткого кодирования имен шрифтов, размеров, цветов и направлений выравнивания можно использовать файл настроек или диалог настройки для позволения пользователям изменять эти значения.
• Можно также добавить больше гибкости в параметрах выравнивания, позволяя пользователям указать custom alignment (например, верхний левый, нижний правый).
• Если вам нужно улучшить производительность, можно рассмотреть кэширование объектов шрифта и повторное использование их вместо создания новых для каждой ячейки.

В целом, код хорошо структурирован и легко понятен. Однако он может быстрее развиваться с дополнительными комментариями и документацией для помощи другим разработчикам в понимании его цели и функциональности.

Перевернуть текст в TStringGrid на 90 градусов, выполнить через изменение свойств шрифта и выравнивания текста в ячейках грида.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: TStringGrid и TDrawGrid ::