Блокнот Графомана

[Лекс Айрин]

обновил версию и сбросил код в архив.

[Лекс Айрин]

Что-то я запутался при создании класса. Причем, подозреваю, что по глупому

Код: Выделить всё

unit wordsUnits;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,Types, Dialogs;


Type

  PList=^List;
  List=record
    PForwards, PNext:PList;
    Words:String;
  end;



{ TListWords}


TListWords = class
private
    Start,PosList, Finish:PList;
    procedure SetItems(value:PList);virtual;

protected

public

   property first:PList read start;  // нет смысла в изменении данного указателя,
                                 // если только не  удаляется первый элемент
   property Item:PList read PosList write SetItems;    // указывает на текущий элемент списка
   property Last:PList read Finish;// write SetFinish;
   function next(value:Plist):PList;
   function next:PList;                // перегружено для удобства использования
   function pred (value:Plist):Plist;
   function pred:Plist;              // перегружено для удобства использования
   procedure Add (Str:String);   //добавляет в конец списка
   procedure Insert (Str:String);virtual; //добавляет в середину списка
   procedure Del (index:PList); virtual;
   function Cut (index:PList):Plist; virtual;
   function CopyWords (index:PList):PList; virtual;
   Procedure Clear; //очищает строку
   procedure readString (Str:String);virtual; //преобразование строки во внутренний формат
   Function WriteString:String;virtual;
   procedure writeWords(index:PList; Str:String);virtual; //работа с отдельными словами
   Function readWords (index:PList): String; virtual;
   constructor Create;
   destructor Destroy; override;
published
end;

TArrayWords=array of TListWords;// для вставки создания рабочей копии текста.
//

implementation

{ TListWords }

procedure TListWords.SetItems(value: PList);
begin
      PosList:=Value;
end;

function TListWords.next(value:Plist): PList;
begin
     Result:=value^.PNext;
end;

function TListWords.next: PList;
begin
      Result:=PosList^.PNext;
end;

function TListWords.pred (value:Plist): Plist;
begin
   Result:=value^.PForwards;
end;

function TListWords.pred: Plist;
begin
      Result:=PosList^.PForwards;
end;

procedure TListWords.Add(Str: String);
begin
      PosList:=Finish;
      Insert(Str);
end;

procedure TListWords.Insert(Str: String);
var
   point:PList;
begin
   New (Point);
   //проверка на пустоту списка
   //(в этом случае указатели нельзя просто перенести)
   if Start=nil then
   begin
     Start:=Point;
     Finish:=Point;
     PosList:=Point;
     //с заполнением полей немного неудобно, но думаю обойдется
     PosList^.Words:=Str;
     PosList^.PForwards:=nil; //можно start, но пока не буду
     PosList^.PNext:=nil;     //можно Finish, но пока не буду
   end

   else // что делать когда элемент один?

   //стандартная вставка
   Begin
        Point^.PNext:=PosList^.PNext; //переносим ссылки    Start=PosList!
        PosList^.PNext:=Point;
        PosList:=Point^.PNext;//"шагаем" на следующий после Point элемент
        Point^.PForwards:=PosList^.PForwards; //переносим ссылки
        PosList^.PForwards:=Point;
        PosList:=Point;  // указатель должен стоять на вставляемом элементе
        PosList^.Words:=Str;
   end;


end;

procedure TListWords.Del(index: PList);
begin
   if index=PosList then PosList:= next(PosList);//сдвигаем текущую позицию указателя чтобы он не повис
   Index^.PForwards^.PNext:=Index^.PForwards^.PNext^.PNext;  //обходим элемент
   Index^.PNext^.PForwards:=Index^.PNext^.PForwards^.PForwards;
   Dispose(Index);

end;

  function TListWords.Cut(index: PList): Plist;
begin
      Result:=CopyWords(Index);
      Del (index);

end;

  function TListWords.CopyWords(index: PList): PList;  //по идее, это должна быть функцияч, но((
begin
       Result^.PForwards:=nil;    // нас не интересуют адреса
       Result^.PNext:=nil;
       Result^.Words:=index^.Words;
end;

procedure TListWords.Clear;
begin


      while Start=finish do del(Start);  //проверить условие
         Start:=nil;
      PosList:=nil;
      Finish:=nil;
end;

//{
procedure TListWords.readString(Str: String);   //строка преобразуется в набор слов
var
  // tmpStr:String;
   count:integer;
begin
      //здесь потребуется создать элементы строки
      if Str='' then exit //на выход
      else
        begin
          if pos(' ',Str)=0 then
          begin //пробел не найден все в результат
            add (Str);
          end
          else
          begin
               //добавить проверку на пустоту строки
               count:=pos(' ',Str);
               if count=1 then begin end  // пробел на первой позиции
               else begin
               Add(System.Copy(Str,1,count-1));  //-1 чтобы не копировать пробел
               System.Delete(Str,1,count);
             end;
          end;
        end;
end;

function TListWords.WriteString: String;
begin
   PosList:=Start;
   Result:='';
   while PosList=Finish do  result:=Result+''+PosList^.Words;  //при использовании readString  пробелы убираются.

end;

  procedure TListWords.writeWords(index: PList; Str: String);
begin
   index^.Words:=Str;
end;

function TListWords.readWords (index:PList): String;
begin
        result:=index^.Words; //реально в "слове" могут быть пробелы и др. сисмволы
end;

constructor TListWords.Create;
begin
   inherited Create;
   ShowMessage('Ave!!!'); // окно не показывается!!!
   Start:=nil;
   PosList:=nil;
   Finish:=nil;

end;

destructor TListWords.Destroy;
begin

   Clear;

   inherited Destroy;
end;
//}

end.


и использование

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  WordsUnits;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  Lisp:TListWords;//проверяемый класс

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
    Lisp.Create;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Lisp.Add(Form1.Edit1.Caption);//.Destroy; здесь выбрасывает ошибку.
end;

end.

[MysticCoder]

Lisp := TListWords.Create;

[Лекс Айрин]

Спасибо.

[Ichthyander]

Не стал изучать тему глубже. Вопрос, насколько удобен этот блокнот для работы с исходными текстами (PHP, HTML, JS, XML и т.д.)? Пользуюсь давно PSPad, с которого я перешел когда-то c NOtePad++ (не нравится он мне). Обилие функционала PSPad в принципе впечатляет. Почти все что нужно там есть, но вот есть за ним досадный глюк, иногда вставляет абракадабру в исходный текст. Иногда из-за этого возникают серьезные проблемы.
А тут вроде как бы и самому подправить можно, если что.Или он пока сыроват?

[Лекс Айрин]

Ichthyander, Глюк есть один -- не всегда до конца преобразует текст в html формат. Есть не до конца реализованный функционал. Да и тегов, если честно, маловато. Вообще, я буду расширять поддержку html.
Поддержки XML, JS, PHP нет, но никто не запрещает вбить на вкладке "Теги" все, что угодно. Или в заметки. Или можно добавить дополнительные вкладки.

В принципе, Добавить можно любой набор инструкций -- только долго. Если захочешь , то конечно можно и исходники подправить, только кинь патчик .

[Лекс Айрин]

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

Код для дельфи не рабочий.

[pupsik]

т.е. перемещать форму используя контейнер?

т.е. нечто такого?

Код: Выделить всё

var
  MouseIsDown: boolean;
  PX, PY: integer;

procedure TForm1.<Component>MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    MouseIsDown := True;
    PX := X;
    PY := Y;
  end;
end;

procedure TForm1.<Component>MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if MouseIsDown then
  begin
    SetBounds(Form1.Left + (X - PX), Form1.Top + (Y - PY), Form1.Width, Form1.Height);
  end;
end;

procedure TForm1.<Component>MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MouseIsDown:=False;
end;


[Лекс Айрин]

Идеально получилось. Спасибо.

[Лекс Айрин]

Заметил особенность при работе функции убирающей теги, что она при маленьком размере файла отрабатывает намного быстрее (построчно), чем при большом (иногда вообще практически замирает и вентилятор начинает верещать). Есть подозрение, что мне надо настроить размер кучи и/или стека. Я прав или есть какой-то еще нюанс(ы)?

ЗЫ: Есть ли какой-нибудь способ узнать плавающий конец конкретной строки в memo или нет? А то при большом размере текста преобразования портят разметку((

[zub]

>>Я прав или есть какой-то еще нюанс(ы)?
Неправ. Нелинейная зависимость затрат времени от длины данных - типичное следствие "очень удобного" подхода viewtopic.php?f=5&t=11036#p95771

[Лекс Айрин]

zub, а ничего, что у меня идет отображение в мемо и добавление тегов не тормозит? Хотя согласно ВАШИМ словам должно точно так же должно подвешивать комп?
К тому же, преобразование в формат удобный для работы в ВАШЕМ стиле (с учетом слива результата в Мемо) должно добавить накладные расходы снижающие пользу от такого подхода. Возможно даже до нуля. (результат все равно придется присваивать обратно)

[zub]

>>zub, а ничего, что у меня идет...
ничего)) Настраивайте стек\кучу наздоровье - они тут совершенно непричем.

>>(с учетом слива результата в Мемо) должно добавить накладные расходы снижающие пользу от такого подхода. Возможно даже до нуля.
Если писать нормально - никто никому ничего не должен, просто программа работает максимально быстро

[Лекс Айрин]

Настраивайте стек\кучу наздоровье - они тут совершенно непричем.

Это недолго проверить... заодно проверил и влияние оптимизации. И тоже нет взаимосвязи

Если писать нормально - никто никому ничего не должен, просто программа работает максимально быстро

К сожалению, код не оторван от остальной программы. Поэтому нельзя просто взять и поменять реализацию процедуры. Отображать то все-равно придется в Мемо, а значит, и "неправильный подход" все равно вылезает. Вы то у себя работали с файлом/строками напрямую, а значит, в обход этих накладных расходов.
Я сейчас проверил, прямое преобразование тоже тормозит при большом размере, но не так сильно. А значит, придется все же менять реализацию(( К сожалению, тогда вылезет другой косяк -- тормоза до конца преобразования, что, для текстового редактора, практически сводит на нет возможность использования подобного функционала.

Я, кстати, проверил -- тормоза идут при работе со строками в целом, а не при выкусывании тегов.

[zub]

>>Я, кстати, проверил -- тормоза идут при работе со строками в целом, а не при выкусывании тегов.
Чуть чуть поправлю - тормоза идут при неправильной работе - необязательно со строками (но с ними в первую очередь) - в целом))

Я сейчас проверил, ... . А значит, ... К сожалению, ..., что, для ... , практически сводит на нет возможность ...

Типичный отмазон.