![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Как в 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