Форум: "Основная";
Текущий архив: 2005.10.16;
Скачать: [xml.tar.bz2];
ВнизКак в StringGrid-e рисовать перевернутый текст на 90 градусов? Найти похожие ветки
← →
tytus (2005-09-28 10:08) [0]Пытаюсь делать в 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;
← →
ЮЮ © (2005-09-28 10:19) [1]>// вот ОНО-поворот на 90 гр.
В какую сторону?
>TextOut(Rect.Left,Rect.Top,"Some Text");
Похоже на "рисование" выше верхнй стороны Rect
← →
tytus (2005-09-28 10:24) [2]ЮЮ>Поворот против часовой стрелки (да какая разница - главное чтобы текст был вертикальним).
>Дак как же правильно рисовать?
Рисует какие-то полосы...
← →
ЮЮ © (2005-09-28 10:57) [3]Это не полосы, а всё что видно от первых букв
TextOut(Rect.Left, Rect.Bottom, "Some Text");
← →
ЮЮ © (2005-09-28 11:08) [4]Да, и lfWidth подбери получше или лставь равным нулю.
← →
jack128 © (2005-09-28 11:34) [5]
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;
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2005.10.16;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.043 c