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

[Лекс Айрин]

Не пойму где косяк? для удобства попробовал изменить пример...

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

unit mainform;
{
Richmemo Inline demo

Author: Dmitry 'skalogryz' Boyarintsev

*****************************************************************************
*                                                                           *
*  This file is part of the Rich Memo package                               *
*  You're free to use the project and the file in anyway you find fit.      *
*  You're free to copy and modify the file. No need to keep the refernce    *
*  to the origin of the file.                                               *
*                                                                           *
*  Cheetah logo image has been aquired from freepascal site.                *
*  http://www.freepascal.org/pic/logo.gif                                   *
*                                                                           *
*****************************************************************************
}

{$mode objfpc}{$H+}

interface

uses
  Types, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  LCLIntf, StdCtrls, ExtCtrls, RichMemo, RichMemoUtils;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Img: TImage;
    ImgCanvas:TCanvas;
    OpenDialog1: TOpenDialog;
    RichMemo1: TRichMemo;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    //framecnt : Integer;
    anims : TList;
    procedure AnimRemove(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

type
  { TInlineImage }

  TInlineImage = class(TRichMemoInline)
  public
    BitMap:TBitmap;
    visible   : Boolean;
    OnRemove  : TNotifyEvent; //?
    destructor Destroy; override;
    procedure Draw(Canvas: TCanvas; const ASize: TSize); override;
    procedure SetVisible(AVisible: Boolean); override;
  end;

{ TInlineImage }

destructor TInlineImage.Destroy;
begin
  if Assigned(OnRemove) then OnRemove(self);
  inherited Destroy;
end;


procedure TInlineImage.Draw(Canvas: TCanvas; const ASize: TSize);
begin
  Canvas.Draw(ASize.cx,ASize.cy, Bitmap);
  Canvas.Refresh;
end;

procedure TInlineImage.SetVisible(AVisible: Boolean);
begin
  visible:=AVisible;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    LoadRTFFile( RichMemo1, OpenDialog1.FileName );
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  inlineimg : TInlineImage;
begin
  inlineimg := TInlineImage.Create;
  inlineimg.BitMap:=Form1.Img.Picture.Bitmap;
  RichMemo1.InDelInline(inlineimg, RichMemo1.SelStart, 0, Size(round(Form1.Img.Width),round(Form1.Img.Height)));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  anims:=TList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  anims.Free;
  anims:=nil;
end;

procedure TForm1.AnimRemove(Sender: TObject);
begin
  if Assigned(anims) then anims.Remove(Sender);
end;

end.

Картинка не пустая, но в результате вставляется пустое место(((



[Лекс Айрин]

Интересно, а как сделать в richEdit текст по центру абзаца?

Добавлено спустя 8 минут 42 секунды:
Да и отступы хотелось бы выставлять руками.

Добавлено спустя 2 часа 1 минуту 54 секунды:
Выравнивание по центру нашел.

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

Editors.SetParaAlignment(Editors.SelStart, Editors.SelLength, paCenter);


Будем искать отступ.

Добавлено спустя 23 часа 9 минут 45 секунд:
Разобрался. Set/GetParaMetric. Немного смутило, что как и в первом случае идет неявное использование абзаца. И не совсем понятно зачем нужна длинна текста... для того чтобы можно было захватить несколько абзацев?

Добавлено спустя 5 часов 12 минут 41 секунду:
Не могу понять почему метод не срабатывает полностью при первом нажатии. Требуется 2-3 раза, что напрягает.
определение формы

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

  TFStyle = class(TForm)
    BColorPicker1: TBColorPicker;
    btGrab: TButton;
    cbItalic: TCheckBox;
    cbBold: TCheckBox;
    cbUnderline: TCheckBox;
    cbStrikeOut: TCheckBox;
    GColorPicker1: TGColorPicker;
    HexaColorPicker1: THexaColorPicker;
    lbFamily: TListBox;
    mbColorPreview1: TmbColorPreview;
    mbDeskPickerButton1: TmbDeskPickerButton;
    RColorPicker1: TRColorPicker;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    Splitter1: TSplitter;

    procedure btGrabClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure HexaColorPicker1Change(Sender: TObject);
    procedure lbFamilySelectionChange(Sender: TObject );
    procedure mbDeskPickerButton1SelColorChange(Sender: TObject);
    procedure RColorPicker1Change(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure SpinEdit2Change(Sender: TObject);
  private
   F:TFont;
  public
    Constructor Create(TheOwner: TComponent); override;
    Destructor Destroy; override;
  end;

var
  FStyle: TFStyle;     

проблемный метод

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


procedure TFStyle.btGrabClick(Sender: TObject);
Var
// OnOff:Boolean;
tmp:integer;
FParams:TFontParams;
begin
    if not Assigned(FEditors) then Exit;
    FStyle.BeginFormUpdate;
    FEditors.Editors.GetTextAttributes(FEditors.Editors.SelStart, FParams);
    SelectedFont(FParams, F);
    FStyle.mbColorPreview1.Color:=F.Color;
    SetColorLines;
    FStyle.cbItalic.Checked    := F.Italic;
    FStyle.cbBold.Checked      := F.Bold;
    FStyle.cbUnderline.Checked := F.Underline;
    FStyle.cbStrikeOut.Checked := F.StrikeThrough;// ?возможно неправильно
    FStyle.SpinEdit2.Value     := F.Size;
    FStyle.SpinEdit1.Value:=FEditors.FirstLine;
    FStyle.EndFormUpdate;
    tmp:= FStyle.lbFamily.Items.IndexOf(F.Name);
    if tmp<>-1 then // нет смысла продолжать, если шрифт не выбран
    FStyle.lbFamily.ItemIndex:=tmp;
    FStyle.Repaint;
end;     


для понимания текста, определение SelectedFont(FParams, F);

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

Procedure SelectedFont(const FParams: TFontParams; Var Result:TFont);
begin
      Result.Style:=FParams.Style;
      Result.Name:=FParams.Name;
      Result.Size:=FParams.Size;
      Result.Color:=FParams.Color;
end; 



Для остальных неясных моментов можно залезть в SVN https://mysvn.ru/Arinelex/lexeditor/trunk/

[Лекс Айрин]

Интересно, можно ли сделать стандартными методами в RichEdit многоуровневые undo/redo или придется самому делать?
Пугает, что в случае глобальных перемен в тексте, отмена/откат дают слишком много накладных расходов. Если их реализовать тупо в качестве стека.
Планируется сделать элемент стека чем-то вроде объекта/записи типа

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

TUndoRedo= record
       Pos,
       Lenght:Integer;
       Text,            // фрагмент  который изменяется
       Text2:String;// используется только при замене
       Command: множество команд: удаление, вставка, замена
       Next:PTUndoRedo;
End;

ну и соответствующие команды управления стеком.



Добавлено спустя 5 минут 23 секунды:
В RichEdit можно многократно отменять/возвращать, только очень уж мало раз в глубину(((
Сейчас это только страховка от случайного удаления.

[Лекс Айрин]

вдруг вылезла ошибка в давно отлаженном коде при закрытии программы

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

procedure TFMain.FormPaint(Sender: TObject);
//создание картинки
Bgr:=TPicture.Create;
    if {$IFDEF MSWINDOWS} fileExists(OptionsPath+'skin.png')=true {$ENDIF}
    {$IFDEF LINUX} fileExists('skin.png')=true {$ENDIF} then
    begin
      Bgr.LoadFromFile('skin.png');
      FMain.ClientWidth := Bgr.Width;// чтобы окно не было больше картинки
      FMain.ClientHeight:=Bgr.Height
                       +20; // сие магическое число исправляет
      //непонятно как возникшую  зависимость от выставления
      // максимального размера окна

    end else
    begin  end;  //финт ушами)))) если файла нет, то и фиг с ним, создадим при закрытии программы.
    ..
// место возникновения
begin
  if not Assigned(Bgr.Graphic) then exit;
  FMain.Canvas.Draw(0, 0, Bgr.Graphic);//рисовать надо после фона
end;
//удаление
...
if (Bgr.Height>FMain.ClientHeight) or
               (Bgr.Width>FMain.ClientWidth) then
     Begin
          Bgr.Bitmap.Width:=FMain.ClientWidth; //обрезка скина по границе
          Bgr.Bitmap.Height:=FMain.ClientHeight;// окна
     End;
     bgr.SaveToFile('skin.png','');
     FreeAndNil(FMain.Bgr);   
...



ну и текст ошибки

Проект Блокнот Графомана вызвал класс исключения 'External: SIGSEGV'.

В файле 'main.pas' на строке 637:
if not Assigned(Bgr.Graphic) then exit;

Хоть и видно ее только под отладчиком, но сам факт(((

[Лекс Айрин]

Что-то я не пойму как из TBitmap перенести часть картинки в TImage.

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

procedure TFMain.FormCreate(Sender: TObject); // надо что-то делать с этой процедурой!!!
begin
...
//Bgr.Picture.PNG.LoadFromFile('skin.png');//загружаем в буфер
      Buff:=TPicture.Create;
      Buff.PNG.Transparent:=false;
      Buff.PNG.LoadFromFile('skin.png');
      FMain.Repaint;           
...
End;
procedure TFMain.FormPaint(Sender: TObject);
Var
   BGRW,BGRH:integer;
   ARect:TRect;
begin
  {У нас есть:
  BGR -- картинка фона окна (TImage)
  Buff -- буфер             (TPicture)
  FMain.Canvas -- фон окна  (TCanvas)
  задача загрузить картинку в BGR по размерам канваса окна
  Предполагаю загрузить фон в buff и здесь его отображать по нужным размерам
  двигаясь по буферу. После нажатия fixed переписать картинку в BGR и сбросить
  координаты области отрисовки (BGRLeft, BGRTop)
  к оконным   }
   //BGR.Picture.Bitmap.Canvas.Draw(BGRLeft, BGRtop, Buff.Graphic); //устарела
  BGRW:=Fmain.Width+BGRLeft;
  BGRH:=FMain.Height+BGRTop;
    ARect.Create(BGRLeft ,BGRTop, BGRW,BGRH );//проаерить!!!
     Buff.Bitmap.Canvas.CopyRect(Arect,FMain.Bgr.Picture.Bitmap.Canvas,FMain.ClientRect);
end;                       


[Лекс Айрин]

Понял в чем проблема. По крайней мере, повтор в тестовом примере показал, что я пытаюсь сохранить часть вне картинки, так как значения переменных BGRLeft и BGRTop отрицательны, а я их невольно считал положительными . Теперь осталось проверить все это в основном коде.