Текущий архив: 2006.10.08;
Скачать: CL | DM;

Вниз

Выравнивание по ширине...   Найти похожие ветки 

← →
.ruslan ©   (2006-08-28 16:21) [0]

Добрый день!
Можно ли как-нибудь выровнить текст в Label по ширине?

justify

---

← →
Fay ©   (2006-08-28 16:29) [1]

2 .ruslan ©   (28.08.06 16:21)
> Можно ли как-нибудь выровнить текст в Label по ширине?
Можно выровнять.

---

← →
.ruslan ©   (2006-08-28 16:33) [2]

у кого-нибудь есть ещё предложения?

---

← →
Fay ©   (2006-08-28 16:34) [3]

2 .ruslan ©   (28.08.06 16:33) [2]
> у кого-нибудь есть ещё предложения?
Тебе уже ответили.

---

← →
.ruslan ©   (2006-08-28 16:38) [4]

хорошо! как это можно реализовать?

---

← →
TUser ©   (2006-08-28 16:39) [5]

Alignment := taCenter

---

← →
Fay ©   (2006-08-28 16:40) [6]

2 .ruslan ©   (28.08.06 16:38) [4]
Можно сделать наследника и перекрыть DoDrawText

---

← →
Fay ©   (2006-08-28 16:40) [7]

2 TUser ©   (28.08.06 16:39) [5]
Возможно я ошибаюсь, но taCenter - это, кажется, "по центру"...

---

← →
.ruslan ©   (2006-08-28 16:46) [8]

TUser, это по центру... мне нужно по ширине

---

← →
Ega23 ©   (2006-08-28 17:43) [9]

А что есть ширина? И каков тебе видится алгоритм выравнивания? Заполнять пробелами? Менять в ран-тайм размер фонта?

---

← →
TUser ©   (2006-08-28 17:45) [10]

Опс, забей пробел после каждого слова, если останутся еще пробелы - опять после каждого слова. И т.д.

---

← →
antonn ©   (2006-08-28 18:43) [11]

пробулы некузяво, лучше [6]

---

← →
Fay ©   (2006-08-28 19:01) [12]

Грубо, но пашет 8)
type
 TJopa = class(TLabel)
 protected
   procedure DoDrawText(var Rect : TRect; Flags : Longint); override;
 end;
 TLabel = class(TJopa);

 TForm1 = class(TForm)
   ToolBar1 : TToolBar;
   Button1 : TButton;
   Label1 : TLabel;
 end;

var
 Form1 : TForm1;

implementation

{$R *.dfm}

procedure TJopa.DoDrawText(var Rect : TRect; Flags : Integer);
var
 i, dx, n : Longint;
 s : string;
begin
 Canvas.Font := Font;
 s := Text;
 dx := Rect.Right;
 DrawText(Canvas.Handle, PChar(Text), -1, Rect, DT_CALCRECT);
 if s <> "" then
 dx := (dx - Rect.Right) div Length(s);

 for i := 1 to Length(s) do
   begin
     DrawText(Canvas.Handle, @s[i], 1, Rect, DT_CALCRECT);
     n := rect.Right - Rect.Left;
     DrawText(Canvas.Handle, @s[i], 1, Rect, 0);
     Inc(Rect.Left, dx + n);
   end;
end;

---

← →
.ruslan ©   (2006-08-29 11:39) [13]

да уж слишком грубо

---

← →
Anatoly Podgoretsky ©   (2006-08-29 15:53) [14]

Это очень сложно, поскольку надо управлять характеристиками шрифта для пробела. Задачка большинству здель присутствующих не по зубам. Остальные предложенные методы очень грубые. Я надеюсь, что ты хочешь как в Ворде.

---

← →
novill ©   (2006-08-29 16:19) [15]

> [13] .ruslan ©   (29.08.06 11:39)
> да уж слишком грубо


Этот же алгоритм применяешь, но не для букв, а для слов, и  все будет так, как ты хочешь.

А алгоритм там простой.

---

← →
han_malign ©   (2006-08-29 16:34) [16]

> Это очень сложно, поскольку надо управлять характеристиками шрифта для пробела.

- задача не кажется мне нетривиальной. Рассчитать проправку для межсимвольных интервалов не так сложно, зная откуда их взять и куда положить:
GetTextExtentExPoint
ExtTextOut

---

← →
Anatoly Podgoretsky ©   (2006-08-29 16:52) [17]

han_malign ©   (29.08.06 16:34) [16]
Может быть, но за эти годы конкретного кода не видел.

---

← →
novill ©   (2006-08-29 18:20) [18]

Fay, Anatoly Podgoretsky
Чем плох [12] если интервалы делать между словами, а не между символами?

Кстати, ворд внутри слов межсимвольное расстояние не меняет (только что проверил при Times New Roman 12)

---

← →
Loginov Dmitry ©   (2006-08-29 19:16) [19]


procedure TJopa.DoDrawText(var Rect: TRect; Flags: Integer);
var
 Delta, I, SpaceSize, LastPos: Integer;
 Text: string;
begin
 if not FIsNotFirstDraw then {private: FIsNotFirstDraw: Boolean}
 begin
   FIsNotFirstDraw := not FIsNotFirstDraw;
   Exit;
 end;

 Text := GetLabelText;

 if Text = "" then Exit;
 Canvas.Font := Font;

 Delta := Width - Canvas.TextWidth(Text);
 SpaceSize := Delta div Length(Text);

 if Delta > 0 then
 begin
   LastPos := Rect.Left;
   for I := 1 to Length(Text) do
   begin
     Canvas.TextOut(LastPos, Rect.Top, Text[I]);
     LastPos := LastPos + Canvas.TextWidth(Text[I]) + SpaceSize;
   end;
 end;
end;


---

← →
Anatoly Podgoretsky ©   (2006-08-29 20:08) [20]

novill ©   (29.08.06 18:20) [18]
Я ничего не говорил об межсимвольных растояниях, меняется ширина пробела в строке.

---

← →
tButton ©   (2006-08-30 07:26) [21]

> novill ©   (29.08.06 18:20) [18]
> ...
> Кстати, ворд внутри слов межсимвольное расстояние не меняет
> (только что проверил при Times New Roman 12)


кстати, ворд вооще выравнивает строку по ширине, только если за ней следует ещё одна строка. если строки нет (строка последняя или единственная) - то она выравнивается по умолчанию.

а раньше, кстати, ворд тупо увеличивал межсимвольные расстояния.

---

← →
novill ©   (2006-08-30 10:44) [22]

Anatoly Podgoretsky, специально для вас )

На основе [19]

procedure TJopa.DoDrawText(var Rect: TRect; Flags: Integer);
var
Delta, I, SpaceSize, LastPos: Integer;
Text: string;

 sl:TStringList;

begin
if FIsFirstDraw then //private: FIsNotFirstDraw: Boolean
begin
  FIsFirstDraw := not FIsFirstDraw;
  Exit;
end;
Text := GetLabelText;
if Text = "" then Exit;
Canvas.Font := Font;
Delta := Width - Canvas.TextWidth(stringreplace(Text," ","",[rfReplaceAll]));
sl:=TStringList.Create;
sl.DelimitedText:=Text;
if Delta > 0
 then
  if sl.Count=1
   then
    begin
     Canvas.TextOut(width-Canvas.TextWidth(Text), Rect.Top, sl[0]);
    end
   else
    begin
     SpaceSize := Delta div (sl.Count-1);
     LastPos := Rect.Left;
     for I := 0 to sl.Count-1 do
      begin
       Canvas.TextOut(LastPos, Rect.Top, sl[i]);
       LastPos := LastPos + Canvas.TextWidth(sl[i]) + SpaceSize;
      end;
    end
 else
  Canvas.TextOut(0, Rect.Top, Text);

sl.free;
end;

---

← →
han_malign ©   (2006-08-30 14:19) [23]

Звиняйте, табуляции не отрабатываются, а так практически как в Word-е.
С параграфами и красной строкой(висячую строку не делал, хотя это не сложно добавить)
Количество "отработанных" символов возвращается, так что текст можно распихивать по нескольким регионам(прямоугольным)...
unit uWAlignOut;

interface
uses Windows;
function width_aligned_text_draw(aDC: HDC;
  var aRect: TRect;//aRect.Bottom - adjusted to drawn text rect bottom
  aClipPartialLine: boolean;//stop on clipped line
  aVertSpacing, //add 1/2 of font height (1 - 1,5; 2 - 2)
  aIndent: integer;//first line indent
  aText: string): integer;//return processed char count
implementation

function parseLine(aText: PChar; aLength: integer; var aOffs: integer): integer;
begin
  Result:= 0;
  inc(aText, aOffs);
  if(aOffs > 0)then begin//prevouse CRLF
     if((aOffs + 1 < aLength)and
        (aText[0] in [ #10, #13])and
        (aText[1] in [ #10, #13])and
        (aText[0] <> aText[1])
     )then begin//skip CRLF/LFCR
        inc(aOffs);
        inc(aText);
     end;
     if(aText[0] in [ #0, #10, #13])then begin//skip CRLF/LFCR
        inc(aOffs);
        inc(aText);
     end;
  end;
  dec(aLength, aOffs);
  while((Result < aLength)and not (aText[Result] in [ #0, #10, #13])) do inc(Result);
end;

function _draw_line(aDC: HDC; X, Y, width: integer;  aLine: PChar; aLineLength: integer;
  aPtsT: PIntegerArray): integer;//return passed chars
var pt_cnt, i, spaces, ext, add, spc: integer;
   _size: TSize;
begin
  Result:= 0;
  if(aPtsT = nil)then exit;
  pt_cnt:= aLineLength;
  if( GetTextExtentExPointA(aDC, aLine, aLineLength, width, @pt_cnt, @aPtsT[0], _size) and
      (pt_cnt > 0)
  )then begin
     if(pt_cnt < aLineLength)then begin
        Result:= pt_cnt - 1;
        //offset, not count
        if(aLine[pt_cnt] <> " ")then
           while((Result >= 0)and(aLine[Result]<>" "))do dec(Result);
        spc:= Result + 1;
        while((Result >= 0)and(aLine[Result] = " "))do dec(Result);
        if(Result >= 0)then begin
           spaces:= 0;
           ext:= width - aPtsT[Result];
           for i:= Result downto 1 do begin
              dec(aPtsT[i], aPtsT[i - 1]);//absolute origin to spasing
              if(aLine[i] = " ")then inc(spaces);
           end;
           if(aLine[0] = " ")then inc(spaces);
           if(spaces > 0)then begin
              add:= ext div spaces;
              spaces:= ext mod spaces;//extra alignment points
              for i:= 0 to Result do begin
                 if(aLine[i] = " ")then begin
                    inc(aPtsT[i], add);
                    if(spaces > 0)then begin
                       inc(aPtsT[i]);
                       dec(spaces);
                    end;
                 end;
              end;
              inc(Result);
              ExtTextOut(aDc, X, Y, 0, nil, aLine, Result, @aPtsT[0]);
           end else begin
              inc(Result);
              TextOut(aDc, X, Y, aLine, Result);
           end;
           Result:= spc;
        end else begin
           if(aLine[0] <> " ")then begin//all alpfa
              Result:= pt_cnt - 1;
              ext:= width - aPtsT[Result];
              for i:= Result downto 1 do begin
                 dec(aPtsT[i], aPtsT[i - 1]);//absolute origin to spasing
              end;
              add:= ext div pt_cnt;
              spaces:= ext mod pt_cnt;//extra alignment points
              for i:= 0 to Result do begin
                 inc(aPtsT[i], add);
                 if(spaces > 0)then begin
                    inc(aPtsT[i]);
                    dec(spaces);
                 end;
              end;
              inc(Result);
              ExtTextOut(aDc, X, Y, 0, nil, aLine, Result, @aPtsT[0]);
           end;//else all spaces
        end;
        if(aLine[pt_cnt] = " ")then begin
           Result:= pt_cnt;
           while((Result < aLineLength)and(aLine[Result] = " "))do inc(Result);
        end
     end else begin
        TextOut(aDc, X, Y, aLine, aLineLength);
        Result:= aLineLength;
     end;
  end;
end;

function width_aligned_text_draw(aDC: HDC; var aRect: TRect;
  aClipPartialLine: boolean;
  aVertSpacing, aIndent: integer;
  aText: string
  ): integer;
var pPts: PIntegerArray;
   nPts: integer;
   function _growPts(cnt: integer): PIntegerArray;
   begin
      if(nPts < cnt)then begin
         if(pPts = nil)then Result:= SysGetMem(cnt)
         else Result:= SysReallocMem(pPts, cnt);
         if(Result <> nil)then begin
            nPts:= cnt;
            pPts:= Result;
         end;
      end else Result:= pPts;
   end;

var height, width, vindent, offs, len, llen, _dlen: integer;
   _size: TSize;
   aln: DWORD;
   pc: PChar;
   clip_stop, top: integer;
begin
  aln:= GetTextAlign(aDC);
  SetTextAlign(aDC, TA_LEFT or TA_TOP or TA_NOUPDATECP);
  nPts:= 0; pPts:= nil;
  GetTextExtentPoint(aDC, "Wy", 2, _size);
  height:= (_size.cy * (2 + aVertSpacing)) div 2;
  offs:= 0; len:= Length(aText);
  aRect:= aRect;

  width:= aRect.Right - aRect.Left;
  if(aIndent < 0)then aIndent:= 0;
  vindent:= 0;
  while(aIndent >= width)do begin
     dec(aIndent, width);
     inc(vindent, height);
  end;
  Result:= 0;
  pc:= PChar(aText);
  top:= aRect.Top;
  clip_stop:= aRect.Bottom;
  if(aClipPartialLine)then dec(clip_stop, height);
  while((offs < len)and(top < clip_stop))do begin
     llen:= parseLine(pc, len, offs);
     if(llen = 0)then inc(top, height)
     else if((top + vindent < clip_stop)and (_growPts(llen) <> nil))then begin
        inc(top, vindent);
        inc(pc, offs); dec(len, offs);
        inc(Result, offs);
        offs:= 0;
        if(aIndent > 0)then begin
           _dlen:= _draw_line(aDC, aRect.Left + aIndent, top, width - aIndent, pc, llen, pPts);
        end else begin
           _dlen:= _draw_line(aDC, aRect.Left, top, width, pc, llen, pPts);
        end;

        while((_dlen > 0) and (llen > _dlen) and (top < clip_stop))do begin
           inc(top, height);
           inc(offs, _dlen);
           dec(llen, _dlen);
           if(top < clip_stop)then
              _dlen:= _draw_line(aDC, aRect.Left, top, width, pc + offs, llen, pPts)
           else _dlen:= 0;
        end;
        if(_dlen > 0)then inc(top, height);
     end;
     if(top < clip_stop)then inc(offs, llen);//just in case
  end;
  if(offs > 0)then begin
     if(offs < len)then begin
        inc(pc, offs);
        if((offs + 1 < len)and
           (pc[0] in [ #10, #13])and
           (pc[1] in [ #10, #13])and
           (pc[0] <> pc[1])
        )then begin//skip CRLF/LFCR
           inc(offs);
        end;
        if(pc[0] in [ #0, #10, #13])then begin//skip CR/LF/Z
           inc(offs);
        end;
     end;
     inc(Result, offs);
  end;
  aRect.Bottom:= top;
  if(pPts <> nil)then FreeMem(pPts);
  SetTextAlign(aDC, aln);
end;

end.

---

← →
han_malign ©   (2006-08-30 14:30) [24]

ээ... очепятки в комментах:
alpfa ==> alpha
spasing ==> spacing

---

← →
Ketmar ©   (2006-08-30 18:45) [25]

> [14] Anatoly Podgoretsky ©   (29.08.06 15:53)
не знаю, уже не первый год печатаю строку по словам. пока тормозов и кривостей не замечено. %-)

---

Страницы: 1 вся ветка

Текущий архив: 2006.10.08;
Скачать: CL | DM;

Наверх

Память: 0.54 MB
Время: 0.05 c