Разтягане на текст

Трябват ми идеи за плавно разтягане на текст върху платно (Canvas).

За какво иде реч? Размерът на даден надпис на платното зависи от размера на шрифта, а той се задава целочислено (чрез Font.Size и Font.Height). Проблемът е, че промяна във височината с един пиксел може да доведе до промяна с 10 и повече пиксела в ширината на даден дълъг низ, а това не ме устройва. Трябва ми нещо, което работи подобно на разтягането на текстове в CorelDraw.

Това, за което се сетих в началото е изчертаване в Bitmap и скалиране със StretchDraw върху платното, но резултатът ще е доста грозен. Има и вариант за antialiasing с допълнителна функция, но когато текстът бъде изведен върху шарен фон, ще се виждат полутоновете към бяло по краищата, където е бил загладен.

Всякакви идеи са добре дошли.

Mixy

"Идея" нямам, но има готови реализации - не си първия сблъскал се с нуждата да разтяга/върти/суче текст. Малко теория - шрифтовете са поредици от криви, съответно изчертаването им зависи от редица параметри, включително широчина, височина и т.н. Ключова дума за търсене - TLogFont.

Тук има примери:

[линк]
[линк]

чети и дишай по-леко

Мерси, ще ги прегледам.

Mixy

Едно решение, което може би ще ми свърши работа е API функцията ExtTextOut. Последният параметър е масив, с който могат да се променят отместванията на всеки символ в извеждания низ и така текстът може да се разтяга или да се кондензира. Това работи добре при хоризонтални текстове, по-късно ще го пробвам и при произволно завъртяни низове.

Mixy

:)
Не, че ми трябва в момента, но ще е добре да постнеш малък пример :) - за пълнота .

ОК, ето го примерчето. Пускаш нов проект и прехващаш OnCreate, OnMouseWheel и OnPaint. Kопираш handler-ите и пускаш. Почваш да въртиш колелцето на мишката и гледаш как текстът се конднзира или се разширява. Ако нямаш колелце, става и с клавиши, просто прехвани OnKeyPress и си избери с кои клавиши ще увеличаваш или намаляваш Form.Tag:

procedure TForm1.FormPaint(Sender: TObject);



const Tx = 'This is sample text';



var FloatPos: double;

    Step: double;

    R: TRect;  // Не се използва, но трябва да се подаде на ExtTextOut



    PosArr: array of integer;  // Позиционнен масив

    A: integer;  // боряч, понеже I понякога чупи форматирането във форума



begin

  FloatPos:=0;

  Step:=Tag / length(Tx);



  setlength(PosArr, length(Tx));

  for A:=0 to length(Tx)-1 do  // Изчисляване позицията на всеки символ

    begin

      FloatPos:=FloatPos+Step;

      PosArr[A]:=Canvas.TextWidth(Tx[A+1])+trunc(FloatPos);

      FloatPos:=FloatPos-trunc(FloatPos);

    end;



  if Tag = 0 then  // Нормален размер

    begin

      Canvas.Font.Color:=clBlack;

      Canvas.Font.Style:=[fsUnderline]

    end

  else  // Кондензиран или разширен

    begin

      Canvas.Font.Color:=clMaroon;

      Canvas.Font.Style:=[];

    end;



  ExtTextOut(Canvas.Handle, 25, 25, 0, @R, PChar(Tx), length(Tx), @PosArr[0]);

end;



procedure TForm1.FormCreate(Sender: TObject);

begin

  Canvas.Font.Name:='Arial';

  Canvas.Font.Size:=20;

  Canvas.Brush.Color:=Color;

end;



procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;

  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);

begin

  if WheelDelta > 0 then  // Разширяване

    Tag:=Tag+1

  else  // Свиване (кондензиране)

    Tag:=Tag-1;

  Invalidate;

end;

Mixy

Да, благодаря!
В знак на благодарност качих твоя пример, заедно с още един проект, който е пример за свободен текст над приложенията.
Използва
desk:=TCanvas.Create; // Създава Canvas
desk.Handle:=GetDC(0); // Прикрепя Canvas към Desktop-а

[линк]