Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Перевернуть текст в TStringGrid на 90 градусов

Оформил: 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 World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.