Текст под углом в StringGrid

[artemavd]

Как вывести в ячейке StringGrida текст под углом, например, 45 градусов? Например, пусть я ввожу число 01.01.2000 в ячейку и этот текст отобразился бы под углом от нижнего левого угла до правого верхнего. Как такое можно сделать? Чтобы я только ввел, а текст наклонился.

[VVM]

Прошу прощения, малость не то написал. Ошибся.
Вот. http://www.delphisources.ru/pages/fa...btn_angle.html

Этот код нужно использовать в событии:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin

end;

[artemavd]

Дык мне то надо рисовать не просто текст под углом, а именнно текст под углом в ячейке, а этот код не делает этого...

[VVM]

Я обновил предыдущее сообщение. Перечитайте.

[artemavd]

А если мне надо задать только определенный диапозон, в котором бы текст выводился бы под углом? В моем случае у меня это должно делаться в одной строке, в колонках начиная с 4ой и до 100ой.

[VVM]

В обработчике OnDrawCell есть параметры

ACol, ARow: Integer;

что есть Колонка и Ряд соответственно. Используйте их:

if (ACol > 3) and (ACol < 101) then ...

[artemavd]

Попробовал сделать так:

procedure TForm8.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
 LogFont: TLogFont;
 Angle:integer;
begin
  if (ACol > 3) and (ACol < 101) then
   begin
    GetObject(Canvas.Font.Handle,SIZEOF(TLogFont),@LogFont);
    LogFont.lfEscapement:=Angle*10;
    Canvas.Font.Handle:=CreateFontIndirect(LogFont);
   end;

end;

но ничего не получилось . Подскажите как надо.

[VVM]

Ну вот, стабильный результат. Остальные доработки - это уж на ваш вкус.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    logfont, OldFont: TLogFont;
    Font, OFont: Thandle;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  StringGrid1.Canvas.FillRect(Rect);
  if (ACol > 0) and (ACol < 3) then //0, 3 - это для теста, поправьте как вам надо.
  begin
    SelectObject(StringGrid1.Canvas.handle, Font);
    SetBKmode(StringGrid1.Canvas.Handle, TRANSPARENT);
    StringGrid1.Canvas.TextOut(ACol * StringGrid1.DefaultColWidth, ARow * StringGrid1.DefaultRowHeight, StringGrid1.Cells[ACol, ARow]);
  end
  else
  begin
    SelectObject(StringGrid1.Canvas.handle, OFont);
    SetBKmode(StringGrid1.Canvas.Handle, TRANSPARENT);
    StringGrid1.Canvas.TextOut(ACol * StringGrid1.DefaultColWidth, ARow * StringGrid1.DefaultRowHeight, StringGrid1.Cells[ACol, ARow]);    
  end;
end;


procedure TForm1.FormShow(Sender: TObject);
var
  X, Y: integer;
begin
  for X := 0 to StringGrid1.ColCount - 1 do
    for Y := 0 to StringGrid1.RowCount - 1 do
      StringGrid1.Cells[X, Y] := '232334';
  LogFont.lfheight := 10;
  logfont.lfwidth := 8;
  logfont.lfweight := 900;
  LogFont.lfEscapement := 200;
  LogFont.lfStrikeOut := 0;
  LogFont.lfUnderline := 0;
  logfont.lfcharset := ANSI_CHARSET;
  logfont.lfoutprecision := out_tt_precis;
  logfont.lfquality := draft_quality;
  logfont.lfpitchandfamily := FF_ROMAN;
  Font := CreateFontIndirect(logfont);
  LogFont.lfEscapement := 0;
  OFont := CreateFontIndirect(Oldfont);
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  DeleteObject(Font);
  DeleteObject(OFont);  
end;

procedure TForm1.StringGrid1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  StringGrid1.Repaint;
end;

procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  StringGrid1.Repaint;
end;

end.