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

Планы, идеология, архитектура и т.п.

Модератор: Модераторы

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

Сообщение Лекс Айрин » 16.10.2017 13:26:22

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

Код: Выделить всё
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.

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

Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 4170
Зарегистрирован: 19.02.2013 16:54:51

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

Сообщение Лекс Айрин » 09.11.2017 14:54:54

Интересно, а как сделать в 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/
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 4170
Зарегистрирован: 19.02.2013 16:54:51

Пред.

Вернуться в Разработки на нашем сайте

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3

Рейтинг@Mail.ru