| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Как вращать строку с центром посредине строки? [D7, WinXP]
DAndrew © (2003-11-19 08:56:00)Как вращать строку с центром вращения посредине строки, а не в верхне-левом углу?
Вариант - рисовать текст на битмапе, а затем его вращать на заданный угол приводит к резким искажениям шрифта. Применение алгоритма антиалиазинга к битмапу сглаживает прорисовку, но резко тормозит систему.
Пожалуйста, практический пример или ссылку на подобный алгоритм!
Заранее благодарен!
Андрей!
_Zergey (2003-11-22 11:00:00) [1]воощет я полагал почемута, что названия процедур грят сами за себя и написать их код, как 2б обнулить!
_Zergey (2003-11-22 10:52:00) [2]и есче :)...
procedure TextToStrArr(List:TList;Text:PChar);
var
p:PChar;
begin
List.Clear;
p:=Text;
while p^<>#0 do
if p^=#13 then
begin
p^:=#0;
List.Add(Text);
Inc(p);
Inc(p);
Text:=p
end
else Inc(p);
List.Add(Text)
end;
_Zergey (2003-11-22 10:48:00) [3]Не обратил внимания исправляюсь :)
На основе того чем делюсь был мной написан компонент на основе TLabel с возможностью вращения текста на любой угол с работающим при етом AutoSize!
procedure AngledTextOut(DC:HDC;const Text:string;cx,cy:integer;Angle:single;
Alignment:TAlignment);
var
Pt:array of TPoint;
ps:PChar;
psa:TList;
i:integer;
s:string;
begin
SetString(s,PChar(Text),Length(Text));
psa:=TList.Create;
try
TextToStrArr(psa,PChar(s));
SetLength(Pt,psa.Count+1);
Int64(Pt[0]):=0;
for i:=1 to psa.Count do
begin
ps:=psa[i-1];
GetTextExtentPoint(DC,ps,StrLen(ps),TSize(Pt[i]));
with Pt[0] do
begin
x:=Max(x,Pt[i].x);
ps:=Pointer(Pt[i].y);
Pt[i].y:=y;
Inc(y,Integer(ps))
end
end;
for i:=1 to psa.Count do
with Pt[i] do
case Alignment of
taCenter:x:=(Pt[0].x-x) shr 1;
taRightJustify:x:=Pt[0].x-x
else x:=0
end;
with Pt[0] do
begin
x:=x shr 1;
y:=y shr 1
end;
RotatePt(Pt,Angle);
with Pt[0] do OffsetPt(Pt,cx-x,cy-y);
for i:=1 to psa.Count do
begin
ps:=psa[i-1];
with Pt[i] do TextOut(DC,x,y,ps,StrLen(ps))
end
finally
psa.Free
end
end;
procedure RotatePt(var Pt:array of TPoint;Angle:single);
var
i,x0,y0,xb:integer;
s,c:extended;
begin
if Length(Pt)>0 then
begin
x0:=Pt[0].x;
y0:=Pt[0].y;
SinCos(Angle,s,c);
for i:=1 to High(Pt) do
with Pt[i] do
begin
Dec(x,x0);
Dec(y,y0);
xb:=x;
x:=Round((xb*c)-(y*s))+x0;
y:=Round((y*c)+(xb*s))+y0
end
end
end;
function PolygonRect(const Pt:array of TPoint):TRect;
var
i:integer;
begin
Result.TopLeft:=Pt[0];
Result.BottomRight:=Pt[0];
if High(Pt)>0 then
for i:=1 to High(Pt) do
with Result,Pt[i] do
begin
if x<Left then Left:=x else
if x>Right then Right:=x;
if y<Top then Top:=y else
if y>Bottom then Bottom:=y
end
end;
DAndrew (2003-11-19 19:40:00) [4]default, MBo!
Спасибо!
Всем спасибо за общение!
Андрей!
default (2003-11-19 18:41:00) [5]" Inc(FAngle, 20);
FAngle:= -FAngle;" --> Dec(FAngle, 20)
DAndrew (2003-11-19 16:38:00) [6]Ниже код (пробую вращать строку по часовой стрелке - не получается):
procedure TForm1.Button1Click(Sender: TObject);
var LogFont: TLogFont;
s: string;
w, h, X, Y:Integer;
FGrad: Extended;
begin
Inc(FAngle, 20);
FAngle:= -FAngle;
s:= 'My name Andrew';
with Image1.Canvas do begin
Font.Name := 'Times New Roman';
Font.Size := 36;
Font.Style:= [fsBold];
GetObject(Font.Handle, SizeOf(LogFont), @LogFont);
with LogFont do begin
lfOrientation := FAngle*10;
lfEscapement := lfOrientation; end;
Font.Handle:= CreateFontIndirect(LogFont);
Ellipse(195, 195, 205, 205);
w:= TextWidth (s);
h:= TextHeight(s);
Brush.Color:= clInfoBk; //clWhite;
FillRect(ClientRect);
Brush.Style:= bsClear;
FGrad:= DegToRad(FAngle);
X:= 200 - Round( cos(FGrad)*w + h*sin(FGrad)) div 2;
Y:= 200 - Round(-sin(FGrad)*w + h*cos(FGrad)) div 2;
TextOut(X, Y, s);
Ellipse(200 - 5, 200 - 5, 200 + 5, 200 + 5); end;
Image1.Invalidate;
end;
Что не так?
Андрей!
DAndrew (2003-11-19 16:37:00) [7]Ниже код (пробую вращать строку по часовой стрелке - не получается):
procedure TForm1.Button1Click(Sender: TObject);
var LogFont: TLogFont;
s: string;
w, h, X, Y:Integer;
FGrad: Extended;
begin
Inc(FAngle, 20);
FAngle:= -FAngle;
s:= 'My name Andrew';
with Image1.Canvas do begin
Font.Name := 'Times New Roman';
Font.Size := 36;
Font.Style:= [fsBold];
GetObject(Font.Handle, SizeOf(LogFont), @LogFont);
with LogFont do begin
lfOrientation := FAngle*10;
lfEscapement := lfOrientation; end;
Font.Handle:= CreateFontIndirect(LogFont);
Ellipse(195, 195, 205, 205);
w:= TextWidth (s);
h:= TextHeight(s);
Brush.Color:= clInfoBk; //clWhite;
FillRect(ClientRect);
Brush.Style:= bsClear;
FGrad:= DegToRad(FAngle);
X:= 200 - Round( cos(FGrad)*w + h*sin(FGrad)) div 2;
Y:= 200 - Round(-sin(FGrad)*w + h*cos(FGrad)) div 2;
TextOut(X, Y, s);
Ellipse(200 - 5, 200 - 5, 200 + 5, 200 + 5); end;
Image1.Invalidate;
end;
Что не так?
Андрей!
default (2003-11-19 16:21:00) [8]сделай себе класс...с таймером, через определённый интервал времени у тебя будет надпись вертеться, скорость тем самым сможешь задавать(вращения), крутить по часовой, против часовой, угловой размер одного поворота надписи...
default (2003-11-19 16:13:00) [9]код покажи
DAndrew (2003-11-19 16:11:00) [10]Пробовал задать переменную FAngle с отрицательным значением - неполучается.
Что-то еще необходимо изменить?
Андрей.
default (2003-11-19 15:51:00) [11]DAndrew (19.11.03 15:46) [25]
а говоришь понял...угол в обратном направлении менять
DAndrew (2003-11-19 15:46:00) [12]MBo!
Извините, сразу не понял Вашего кода.
Против часовой стрелки у меня получилось, подскажите, что необходимо скорректировать в Вашем коде ( MBo © (19.11.03 13:02) [13]), чтобы вращение строки было по часовой стрелке.
Спасибо!
Андрей!
default (2003-11-19 15:08:00) [13]MBo © (19.11.03 14:54) [23]
да действительно
MBo (2003-11-19 14:54:00) [14]>default © (19.11.03 14:24) [20]
>а ресурс здесь не теряется?Font.Handle не надо сохранять?
Насколько я помню, при назначении нового дескриптора граф. объекту (TFont.SetHandle) старый освобождается с пом. FreeResource.
Можно оттрассировать.
default (2003-11-19 14:43:00) [15]DAndrew (19.11.03 14:37) [21]
млин, FAngle ты даже нигде не используешь, а хочешь чтобы что-то менялось...
"Как решить практически проблему?"
MBo тебе всё написал, осталось только обобщить, непонял код?нарисуй на бумажке - поймёшь
DAndrew (2003-11-19 14:37:00) [16]И все же, Мастера!
Как решить практически проблему?
Есть еще мнения?
Можно по email.
Андрей!
default (2003-11-19 14:24:00) [17]MBo © (19.11.03 13:02) [13]
"Font.Handle := CreateFontIndirect(LogFont);"
а ресурс здесь не теряется?Font.Handle не надо сохранять?
default (2003-11-19 14:22:00) [18]DAndrew (19.11.03 13:43) [15]
inc(FAngle, 200);
этим ты меняешь точку относительно которой под заданным углом выводится строка...
см MBo © (19.11.03 14:11) [18]
MBo (2003-11-19 14:11:00) [19]>Спасибо, но это все же не то...
Это именно то, что требовалось, просто кое-кто не обдумал приведенный код.
Pi/6 - это не случайная абстракция, а 30 градусов (соответствует 300 в LogFont).
DAndrew (2003-11-19 14:00:00) [20]_Zergey!
Коды не компилируются, компилятор выдает следующие ошибки (возможно их больше):
[Error] Unit1.pas(78): Undeclared identifier: 'RotatePt'
[Error] Unit1.pas(79): Undeclared identifier: 'PolygonRect'
[Error] Unit1.pas(100): Undeclared identifier: 'AngledTextOut'
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'
Функция WidthOf из библиотеки RXLib? А можно обойти эту библиотеку, у меня строки с символами юникодов?
Как и какими другими функциями можно заменить некоторые из примененных в Вашем коде.
Вы можете привести полные коды, если Вам удобно отошлите мне их на мой email! И еще вопрос могут ли данные коды поворота строки работать с юникодными символами, это очень важно для меня. Так как строка у меня содержит символы юникодов.
Спасибо!
Андрей!
| |
Страницы: 