Mega Code Archive

 
Categories / Delphi / VCL
 

Rotate the text in a stringgrid cell by 90°

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 füllen 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 füllen 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 löschen 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, linksbündig 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 rechtsbündig in den restlichen Spalten if ACol > 2 then StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clGreen, taRightJustify); end; end.