Rotate the text in a StringGrid cell by 90° (Views: 29)
Problem/Question/Abstract: How to rotate the text in a StringGrid cell by 90° Answer: Solve 1: 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 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 if (Size > Grid.ColWidths[ACol] div 2) then Size := Grid.ColWidths[ACol] div 2; with Grid.Canvas do begin // Replace the font 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 FillRect(Rect); // Align text and write it 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; Solve 2: Display text vertically in StringGrid cells 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 if (Size > Grid.ColWidths[ACol] div 2) then Size := Grid.ColWidths[ACol] div 2; with Grid.Canvas do begin // Set font 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 FillRect(Rect); // Write text depending on the alignment 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 SelectObject(Handle, OldFont); // Recreate reference to the new font DeleteObject(NewFont); end; end; // Call the method in OnDrawCell 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 if ACol = 1 then StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clRed, taLeftJustify); // In the third column: Center the text if ACol = 2 then StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clBlue, taCenter); // In all other columns third row: right align the text if ACol > 2 then StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clGreen, taRightJustify); end; end. |