[Snake22]

Посмотрите пожалуйста,по нажатию на конпку программа сканирует файлы/папки в своей директории,и выводит названия в ричедит. Если встречается папка то она выделяется жирным.
Но у меня почемутои папки и файлы выделяются,и еще,если после того как все папки показались,попробовать просто написать в этот ричедит,то написанный текст жирный.хотя жиирность задаю вродебы только к выделенной области

Код:

procedure TForm1.Button1Click(Sender: TObject);
var sr: TSearchRec;
x,strt,lengt:integer;
begin
RichEdit1.lines.Add('');
x:= RichEdit1.Lines.Count;
 if FindFirst(ExtractFilePath(ParamStr(0))+'\*.*', faAnyFile, sr) = 0 then
  begin
  repeat
  if FileExists(sr.Name) then lengt:=length(sr.Name);
  strt:=Length(RichEdit1.Text); //запоминаем позицию с которой выделять.
  RichEdit1.Lines[x]:=RichEdit1.Lines[x]+   (sr.Name)+'  ';
  if DirectoryExists(sr.Name) then //если папка то делаем её жирной
    begin
    //ShowMessage(sr.Name);
    RichEdit1.SelStart:=strt;
    RichEdit1.SelLength:=lengt;
    RichEdit1.SelAttributes.Style:= [fsBold];
    end;
  until FindNext(sr) <> 0;
  FindClose(sr);
 end;
end;

[angvelem]

Примерно так:

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  sr    : TSearchRec;
  Len  : Integer;
begin
  Len := 0;
  RichEdit1.Lines.Clear;
  if FindFirst(ExtractFilePath(ParamStr(0)) + '\*.*', faAnyFile, sr) = 0 then
  begin
    repeat
      if sr.Attr and faDirectory <> 0 then
        RichEdit1.SelAttributes.Style := [fsBold]
      else
        RichEdit1.SelAttributes.Style := [];

      RichEdit1.Lines.Add(sr.Name);
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
  RichEdit1.Lines.Add('');
  RichEdit1.Lines.Add('Сканирование завершено.');
end;

[Snake22]

не такой способ не подходит.
надо чтоб в строчку имена писались.

[angvelem]

Не смеши, замени RichEdit1.Lines.Add(sr.Name) на то, что было у тебя. А свой бредовый способ выделения выкинь.

[Janom]

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  sr: TSearchRec;
  i:integer;
  sDir:array of array [0..1] of Cardinal;
begin
RichEdit1.Clear;
 if (FindFirst(ExtractFilePath(ParamStr(0))+'\*.*', faAnyFile, sr) = 0) then
  begin
  repeat
  RichEdit1.Text:=RichEdit1.Text+sr.Name+' ';
  if sr.Attr and faDirectory <> 0 then //если папка то делаем её жирной
    begin
      SetLength(sDir,Length(sDir)+1);
      sDir[Length(sDir)-1,0]:=length(sr.Name);
      sDir[Length(sDir)-1,1]:=length(RichEdit1.Text)-length(sr.Name)-1;
    end;

  until FindNext(sr) <> 0;
  for i:=0 to Length(sDir)-1 do
    begin
      RichEdit1.SelStart:=sDir[i,1];
      RichEdit1.SelLength:=sDir[i,0];
      RichEdit1.SelAttributes.Style := [fsBold];
    end;
  FindClose(sr);
  sDir:=nil;
 end;
end;

[angvelem]

Слишком усложнёно, смотри выше.

[Snake22]

Сообщение от angvelem

Не смеши, замени RichEdit1.Lines.Add(sr.Name) на то, что было у тебя. А свой бредовый способ выделения выкинь.

заменял,

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  sr    : TSearchRec;
  Len  : Integer;
begin
  Len := 0;
  if FindFirst(ExtractFilePath(ParamStr(0)) + '\*.*', faAnyFile, sr) = 0 then
  begin
    repeat
      RichEdit1.Text:= RichEdit1.Text+ sr.Name+'  ';
      if sr.Attr and faDirectory <> 0 then
       begin
        RichEdit1.SelStart:=Length(RichEdit1.Text)-length(sr.Name)-2;
        RichEdit1.SelLength:=Length(sr.Name);
        RichEdit1.SelAttributes.Style := [fsBold];
        end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
  RichEdit1.Lines.Add('');
end;

и выделяет только последнюю папку,
всё прежнее форматирование сбрасывается(
Janom спс работает)

[Snake22]

ага,врубился,это оказывается при добавлени текста с сохранением предыдущего, форматирование сбрасывается!!
richedit1.text:=richedit1.text+'text';
блиин!
можно както сохранить форматирование? а то если нельзято это пипец((

[angvelem]

Сообщение от Snake22

можно както сохранить форматирование? а то если нельзято это пипец((

Форматирование добавляется к строке или выделенному фрагменту. При использовании

Код:

  RichEdit1.Text := RichEdit1.Text + sr.Name + '  ';

затирается старое значение формата из-за особенностей реализации RichEdit-а в VCL. Приходится использовать POST-форматирование, когда вся строка сформирована. Если не подходит по-строчное добавление, то вариант Janom или вот похожий вариант (по сути, тоже самое).

Код:

procedure TForm1.Button2Click(Sender: TObject);
type
  TPos = TPoint;
var
  sr : TSearchRec;
  I  : Integer;
  fp : array of TPos;
begin
  RichEdit1.Lines.Clear;
  I := 0;
  if FindFirst(ExtractFilePath(ParamStr(0)) + '\*.*', faAnyFile, sr) = 0 then
    with RichEdit1.SelAttributes do
    begin
      repeat
        if sr.Attr and faDirectory <> 0 then
        begin
          inc(I);
          SetLength(fp, I);
          fp[I - 1].X := Length(RichEdit1.Text);
          fp[I - 1].Y := Length(sr.Name);
        end;
        RichEdit1.Text := RichEdit1.Text + sr.Name + ' ';
      until FindNext(sr) <> 0;
      FindClose(sr);

      for I := 0 to Length(fp) - 1 do
      begin
        RichEdit1.SelStart  := fp[i].X;
        RichEdit1.SelLength := fp[i].Y;
        Style := [fsBold];
        Color := clRed;
      end;

      RichEdit1.Lines.Add('');
      RichEdit1.Lines.Add('Сканирование завершено.');
    end;
end;

[Snake22]

да я чёто разочаровался( прост планирую еще много другого текста в ричедит вводить и там много форматирования должно быть,а если форматирование все время слетает при добавлении текста то не подходит ричедит,буду с веббровсером химичить тогда наверное.

[angvelem]

Планируй форматирование для уже готовой строки и проблемы исчезнут.

[Snake22]

нашел способ как добалвять без потери предыдущего форматирования.
посылаем сообщение

Код:

SendMessage(RichEdit1.Handle, EM_REPLACESEL, 0, integer(PCHAR('Текст!')));

текст вставляется от курсора,т.е. курсор должен в конце находится.
может кому пригодится =)