Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как в StringGrid-e рисовать перевернутый текст на 90 градусов? [D7, WinXP]


tytus ©   (2005-09-28 10:08:00) 

Пытаюсь делать в DrawCell по аналогии с OnPaint на форме:
var
 LF:LogFont;
 Fnt:HFont;
begin
FillChar(LF,SizeOf(LF),0);
with LF do begin
 lfHeight:=10;
 lfWidth:=fw_Medium;
 lfEscapement:=900;// вот ОНО-поворот на 90 гр.
 StrPCopy(lfFaceName,'Courier New Cyr');
end;
Fnt:=CreateFontIndirect(LF);
with StringGrid1.Canvas do begin
 Font.Handle:=Fnt;
 TextOut(Rect.Left,Rect.Top,'Some Text');
end;
DeleteObject(Fnt);
end;

Пробывал SelectObject-не помогает.
Высоту ячеек задаю при создании формы:
StringGrid1.RowHeight[0]:=100;


jack128   (2005-09-28 11:34:00) [1]

procedure TForm1.FormPaint(Sender: TObject);
 procedure DrawCaption(PP1,PP2: TPoint; AText: string);
 var X, Y, W, H, dX, dY, b: Integer;
     TTM: TTextMetric;
     TLF: TLogFont;
     Ft: hFont;
 begin
   dX := PP2.X - PP1.X;
   dY := PP2.Y - PP1.Y;
   b := 0;
   if dX <> 0 then
     b := Round(ArcTan(dY/dX)*180/PI)
   else
     if dY <> 0 then
       b := Round(ArcTan(dX/dY)*180/PI + 90);
   b := 180 - b;
   b := b + 180;
   while b < 0 do
     Inc(b, 360);
   b := b mod 360;

   GetTextMetrics(Canvas.Handle, TTM);
   if (TTM.tmPitchAndFamily and TMPF_TRUETYPE) = 0 then
     Canvas.Font.Name := 'Arial';

   H := Canvas.TextHeight(AText){ + 2 + FLineWidth};
   W := Canvas.TextWidth(AText);

   GetObject(Canvas.Font.Handle, SizeOf(TLF), @TLF);
   TLF.lfEscapement := b*10;
   Ft := CreateFontIndirect(TLF);
   Canvas.Font.Handle := Ft;

   if PP1.X > PP2.X then
     X := PP2.X + (PP1.X - PP2.X) div 2
   else
     X := PP1.X + (PP2.X - PP1.X) div 2;
   if PP1.Y > PP2.Y then
     Y := PP2.Y + (PP1.Y - PP2.Y) div 2
   else
     Y := PP1.Y + (PP2.Y - PP1.Y) div 2;

   X := X - Round(W/2  * Cos(b*PI/180)) - Round(H * Sin(b*PI/180));
   Y := Y + Round(W/2 * Sin(b*PI/180)) - Round(H * Cos(b*PI/180));

   with Canvas do
   begin
     Brush.Style := bsClear;
     TextOut(X, Y, AText);
     Brush.Style := bsSolid;
   end;
 end;
begin
 DrawCaption(Point(100, 100), Point(100, 300), 'Test Test Test')
end;

Но сразу говорю - выглядит убожески. Лично я использую GDIPlus:

uses
 Graphics, GDIPAPI, GDIPOBJ;

function GDIPlusCheck(Res: Status): boolean;
const
 Errors: array[Status] of string =
   (
      'Неизвестная ошибка',   // Ok
      'Общая ошибка GDIPlus', //GenericError,
      'Неверный параметр',    //InvalidParameter,
      'Недостаточно памяти',  //OutOfMemory,
      'Объект занят',         //ObjectBusy,
      'Слишком маленький буфер',            //InsufficientBuffer,
      'Не реализованно',      //NotImplemented,
      'Ошибка Win32',         //Win32Error,
      'Ошибочное состояние',  //WrongState,
      'Отменено',             //Aborted,
      'Файл не найден',       //FileNotFound,
      'Переполнение',         //ValueOverflow,
      'Доступ запрещен',      //AccessDenied,
      'Неизвестный формат изображения',     //UnknownImageFormat,
      'Шрифт не найден',      //FontFamilyNotFound,
      'Стиль шрифта не найден',             //FontStyleNotFound,
      'Шрифт - не True Type', //NotTrueTypeFont,
      'Версия GDIPlus не поддерживается',  //UnsupportedGdiplusVersion,
      'GDIPlus не инициализирован',         //GdiplusNotInitialized,
      'Свойство не найдено',  //PropertyNotFound,
      'Свойство не поддерживается'          //PropertyNotSupported
   );
begin
 Result := Res = Ok;
 if not Result then
   raise Exception.CreateFmt(Errors[Res] + #13#10 + 'Ошибка GDIPlus %x', [Integer(Res)]);
end;

function GetCanvasFromGraphics(Graphics: TGPGraphics): TCanvas;
var
 dc: HDC;
begin
 dc := Graphics.GetHDC;
 GDIPlusCheck(Graphics.GetLastStatus);
 Result := TCanvas.Create;
 Result.Handle := dc;
end;

procedure ReleaseCanvasFromGraphics(Graphics: TGPGraphics; Canvas: TCanvas);
var
 dc: THandle;
begin
 dc := Canvas.Handle;
 Canvas.Handle := 0;
 Canvas.Free;
 if dc <> 0 then
   Graphics.ReleaseHDC(dc);
end;

procedure DrawText(Graphics: TGPGraphics; Color: TColor; P1, P2: TPoint; const S: string); overload;
var
 Temp: TPoint;
 Ang: Double;
 StringFormat: TGPStringFormat;
 Rect: TGPRectF;
 Brush: TGPBrush;
 H: Integer;
 Canvas: TCanvas;
 Font: TGPFont;
begin
 if p1.X > p2.X then
 begin
   Temp := p1; p1 := p2; p2 := Temp;
 end;
 Brush := nil; StringFormat := nil; Font := nil;
 try

 GDIPlusCheck(Graphics.ResetTransform);
 GDIPlusCheck(Graphics.TranslateTransform(p1.X, p1.Y));
 if p1.Y <> p2.Y then
 begin
   if p2.X = p1.X then
     if p1.Y < p2.Y then
       Ang := 90
     else
       Ang := -90
   else
     Ang := ArcTan((P2.Y - P1.Y)/ (P2.X - P1.X)) * 180/pi;
   GDIPlusCheck(Graphics.RotateTransform(Ang));
 end;

 StringFormat := TGPStringFormat.Create(0, 0);
 GDIPlusCheck(StringFormat.SetAlignment(StringAlignmentCenter)); // по горизонт. - центр
 GDIPlusCheck(StringFormat.SetLineAlignment(StringAlignmentCenter)); // по вертикали - центр..

 Brush := TGPSolidBrush.Create(ColorToGDIPlusColor(Color));
 Canvas := GetCanvasFromGraphics(Graphics);
 try
   H := Canvas.TextHeight(S);
 finally
   ReleaseCanvasFromGraphics(Graphics, Canvas);
 end;
 Rect := MakeRect(0, -H, sqrt(sqr(P2.X - P1.X) + sqr(P2.Y - P1.Y)), H);
 Graphics.SetTextRenderingHint(TextRenderingHintAntiAlias);
 Font := TGPFont.Create('Arial', 8);
 GDIPlusCheck(Graphics.DrawString(S,
   -1,
   Font,
   Rect,
   StringFormat,
   Brush));
 finally
   Font.Free;
   Brush.Free;
   StringFormat.Free;
 end;
end;


ЮЮ   (2005-09-28 11:08:00) [2]

Да, и lfWidth подбери получше или лставь равным нулю.


ЮЮ   (2005-09-28 10:57:00) [3]

Это  не полосы, а всё что видно от первых букв

TextOut(Rect.Left, Rect.Bottom, 'Some Text');


tytus   (2005-09-28 10:24:00) [4]

ЮЮ>Поворот против часовой стрелки (да какая разница - главное чтобы текст был вертикальним).
>Дак как же правильно рисовать?
Рисует какие-то полосы...


ЮЮ   (2005-09-28 10:19:00) [5]

>// вот ОНО-поворот на 90 гр.
В какую сторону?

>TextOut(Rect.Left,Rect.Top,'Some Text');
Похоже на "рисование" выше верхнй стороны Rect


Наверх

Титульная страница Поиск, карта сайта Написать письмо