Форум: "Начинающим";
Текущий архив: 2006.11.05;
Скачать: [xml.tar.bz2];

Вниз

вопрос про строку   Найти похожие ветки 

← →
Adios ©   (2006-10-18 18:04) [0]

когда пытаюсь компилировать то компилятор ругается на строку
function FontToStr(font: TFont): string;
 procedure yes(var str: string);
 begin

   str := str + "y";
 end;
 procedure no(var str: string);
 begin

   str := str + "n";
 end;
begin

 {êîäèðóåì âñå àòðèáóòû TFont â ñòðîêó}
 Result := "";
 Result := Result + IntToStr(font.Color) + "|";
 Result := Result + IntToStr(font.Height) + "|";
 Result := Result + font.Name + "|";
 Result := Result + IntToStr(Ord(font.Pitch)) + "|";
 Result := Result + IntToStr(font.PixelsPerInch) + "|";
 Result := Result + IntToStr(font.size) + "|";
 if fsBold in font.style then
   yes(Result)
 else
   no(Result);
 if fsItalic in font.style then
   yes(Result)
 else
   no(Result);
 if fsUnderline in font.style then
   yes(Result)
 else
   no(Result);
 if fsStrikeout in font.style then
   yes(Result)
 else
   no(Result);
ini.WriteString("RichEdit","font",Result);
end;
function tok(sep: string; var s: string): string;

 function isoneof(c, s: string): Boolean;
 var
   iTmp: integer;
 begin
   Result := False;
   for iTmp := 1 to Length(s) do
   begin
     if c = Copy(s, iTmp, 1) then
     begin
       Result := True;
       Exit;
     end;
   end;
 end;
var

 c, t: string;
begin

 if s = "" then
 begin
   Result := s;
   Exit;
 end;
 c := Copy(s, 1, 1);
 while isoneof(c, sep) do
 begin
   s := Copy(s, 2, Length(s) - 1);
   c := Copy(s, 1, 1);
 end;
 t := "";
 while (not isoneof(c, sep)) and (s <> "") do
 begin
   t := t + c;
   s := Copy(s, 2, length(s) - 1);
   c := Copy(s, 1, 1);
 end;
 Result := t;
end;

procedure StrToFont(str: string; font: TFont);
begin

 if str = "" then
   Exit;
 font.Color := StrToInt(tok("|", str));
 font.Height := StrToInt(tok("|", str));
 font.Name := tok("|", str);
 font.Pitch := TFontPitch(StrToInt(tok("|", str)));
 font.PixelsPerInch := StrToInt(tok("|", str));
 font.Size := StrToInt(tok("|", str));
 font.Style := [];
ОШИБКА ЗДЕСЬ======>  if str[0] = "y" then
   font.Style := font.Style + [fsBold];
 if str[1] = "y" then
   font.Style := font.Style + [fsItalic];
 if str[2] = "y" then
   font.Style := font.Style + [fsUnderline];
 if str[3] = "y" then
   font.Style := font.Style + [fsStrikeout];
end;

---

← →
@!!ex ©   (2006-10-18 18:06) [1]

Может фича в том, что у строк нумерация начинается с 1? :))

---

← →
icWasya ©   (2006-10-18 18:09) [2]

ОШИБКА ЗДЕСЬ======>  if str[0] = "y" then

символы в строке нумеруются с единицы

if (length(str)>0)and(str[1] = "y") then
и соответственно исправить индексы в следующих четырёх строках

---

← →
@!!ex ©   (2006-10-18 18:09) [3]

Кстати, код местами не очень. Тя жело читать, нехватает редактирования.
Например есть isoneof, а должно быть IsOneOf
Лесенка опять же непонятная.
Иногда 1 пробел, иногда два.... От чего зависит????
НЕпонятное использование пустой строки. Чето она разделяет не то что нужно...

ИМХО.

---

← →
Kolan ©   (2006-10-18 18:43) [4]

> procedure yes(var str: string);
>  begin
>
>    str := str + "y";
>  end;
>  procedure no(var str: string);
>  begin
>
>    str := str + "n";
>  end;


procedure ОБХСС; :)

---

← →
Ketmar ©   (2006-10-18 18:56) [5]

ужос, а не код...

---

← →
Loginov Dmitry ©   (2006-10-18 19:00) [6]

Adios ©   (18.10.06 18:04)
if fsBold in font.style then
  yes(Result)
else
  no(Result);
if fsItalic in font.style then
  yes(Result)
else
  no(Result);
if fsUnderline in font.style then
  yes(Result)
else
  no(Result);
if fsStrikeout in font.style then
  yes(Result)
else
  no(Result);

А непроще ли так:

Result := Result + IntToStr(Byte(font.style));

---

← →
Kolan ©   (2006-10-18 19:04) [7]

> Loginov Dmitry ©   (18.10.06 19:00) [6]

Так смотришь и думаешь- бедные компилятор все терпит..

Adios
Интересно зачем Фонт в строку преврашать?

---

← →
Anatoly Podgoretsky ©   (2006-10-18 19:43) [8]

И нафига ты весь код сюда вывалил, хватило бы той строки.

---

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

Форум: "Начинающим";
Текущий архив: 2006.11.05;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.041 c