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

Вниз

Проблема с событием OnPaint в TKOLMemo   Найти похожие ветки 

← →
imp   (2009-04-13 22:18) [0]

Всем привет. Помогите. Есть задача: нада в memo задать область вводимого текста с отступом слева, в котором будет выводится нумерация строк.
Делаю это так:

{ KOL MCK } // Do not remove this line!
{$DEFINE KOL_MCK}
unit Unit1;

interface

{$IFDEF KOL_MCK}
uses Windows, Messages, KOL {$IF Defined(KOL_MCK)}{$ELSE}, mirror, Classes, Controls, mckCtrls, mckObjs, Graphics {$IFEND (place your units here->)};
{$ELSE}
{$I uses.inc}
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs;
{$ENDIF}

type
 {$IF Defined(KOL_MCK)}
 {$I MCKfakeClasses.inc}
 {$IFDEF KOLCLASSES} {$I TForm1class.inc} {$ELSE OBJECTS} PForm1 = ^TForm1; {$ENDIF CLASSES/OBJECTS}
 {$IFDEF KOLCLASSES}{$I TForm1.inc}{$ELSE} TForm1 = object(TObj) {$ENDIF}
   Form: PControl;
 {$ELSE not_KOL_MCK}
 TForm1 = class(TForm)
 {$IFEND KOL_MCK}
   KOLProject1: TKOLProject;
   KOLForm1: TKOLForm;
   Memo1: TKOLMemo;
   procedure KOLForm1FormCreate(Sender: PObj);
   procedure SetEditRect;
   procedure Memo1Paint(Sender: PControl; DC: HDC);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1 {$IFDEF KOL_MCK} : PForm1 {$ELSE} : TForm1 {$ENDIF} ;

{$IFDEF KOL_MCK}
procedure NewForm1( var Result: PForm1; AParent: PControl );
{$ENDIF}

implementation

{$IF Defined(KOL_MCK)}{$ELSE}{$R *.DFM}{$IFEND}

{$IFDEF KOL_MCK}
{$I Unit1_1.inc}
{$ENDIF}

procedure TForm1.KOLForm1FormCreate(Sender: PObj);
begin
 Form1.SetEditRect;
end;

procedure TForm1.SetEditRect;
var
 //H: HWND;
 Rect: TRect;
begin
 SendMessage( Memo1.Handle, EM_GETRECT, 0, LongInt(@Rect));
 Rect.Left:= 20;
 SendMessage(Memo1.Handle, EM_SETRECT, 0, LongInt(@Rect));
 Memo1.Update;
end;

procedure TForm1.Memo1Paint(Sender: PControl; DC: HDC);
var
 i,y,n:integer;
 t:string;
begin
 n:=Memo1.Perform(EM_GETFIRSTVISIBLELINE,0,0);
 y:=1;
 i:=0;
 while (y<Memo1.ClientHeight) do
   begin
     Memo1.Canvas.TextOut(1,y,Int2Str(1+i+n));
     y:=y+16;
     inc(i);
   end;
 Memo1.Invalidate;
end;

end.


Однако, контрол при этом не перерисовывается.
ПОМОГИТЕ РАЗОБРАТЬСЯ ГДЕ ПРИЧИНА И В ЧЕМ!!!!!

---

← →
imp   (2009-04-13 22:25) [1]

Memo1.Invalidate; в procedure TForm1.Memo1Paint(Sender: PControl; DC: HDC); считать коментарием, так как она приводит к постоянному перерисовыванию и некорректной работе.

---

← →
MTsv DN   (2009-04-14 07:37) [2]

> Однако, контрол при этом не перерисовывается.
Если я правильно понял, то контрол должен перерисовываться ровно настолько,  насколько Вы его перерисовываете, а именно:
Memo1.Canvas.TextOut(1,y,Int2Str(1+i+n));
По идее, должны отображаться только цифры...

А что за задача, что memo задействовать пришлось? Есть же ричэдит, листвью...

---

← →
L`Autour ©   (2009-04-14 09:34) [3]

вот так работает:

{ KOL MCK } // Do not remove this line!
{$DEFINE KOL_MCK}
unit Unit1;

interface

{$IFDEF KOL_MCK}
uses Windows, Messages, KOL {$IF Defined(KOL_MCK)}{$ELSE}, mirror, Classes, Controls, mckCtrls, mckObjs, Graphics {$IFEND (place your units here->)};
{$ELSE}
{$I uses.inc}
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs;
{$ENDIF}

type
 {$IF Defined(KOL_MCK)}
 {$I MCKfakeClasses.inc}
 {$IFDEF KOLCLASSES} {$I TForm1class.inc} {$ELSE OBJECTS} PForm1 = ^TForm1; {$ENDIF CLASSES/OBJECTS}
 {$IFDEF KOLCLASSES}{$I TForm1.inc}{$ELSE} TForm1 = object(TObj) {$ENDIF}
   Form: PControl;
 {$ELSE not_KOL_MCK}
 TForm1 = class(TForm)
 {$IFEND KOL_MCK}
   KOLProject1: TKOLProject;
   KOLForm1: TKOLForm;
   Memo1: TKOLMemo;
   procedure KOLForm1FormCreate(Sender: PObj);
   procedure SetEditRect;
   function Memo1Message(var Msg: tagMSG; var Rslt: Integer): Boolean;
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1 {$IFDEF KOL_MCK} : PForm1 {$ELSE} : TForm1 {$ENDIF} ;

{$IFDEF KOL_MCK}
procedure NewForm1( var Result: PForm1; AParent: PControl );
{$ENDIF}

implementation

{$IF Defined(KOL_MCK)}{$ELSE}{$R *.DFM}{$IFEND}

{$IFDEF KOL_MCK}
{$I Unit1_1.inc}
{$ENDIF}

const
 WM_MEMOUPD = WM_USER + 100;

procedure TForm1.KOLForm1FormCreate(Sender: PObj);
begin
Form1.SetEditRect;
end;

procedure TForm1.SetEditRect;
var
//H: HWND;
Rect: TRect;
begin
SendMessage( Memo1.Handle, EM_GETRECT, 0, LongInt(@Rect));
Rect.Left:= 20;
SendMessage(Memo1.Handle, EM_SETRECT, 0, LongInt(@Rect));
Memo1.Update;
end;

procedure Memo1Paint(Memo1: PControl; DC: HDC);
var
i,y,n:integer;
t:string;
begin
n:=Memo1.Perform(EM_GETFIRSTVISIBLELINE,0,0);
y:=1;
i:=0;
while (y<Memo1.ClientHeight) do
  begin
    Memo1.Canvas.TextOut(1,y,Int2Str(1+i+n));
    y:=y+16;
    inc(i);
  end;
//Memo1.Invalidate;
end;

function TForm1.Memo1Message(var Msg: tagMSG; var Rslt: Integer): Boolean;
begin
 if (Msg.message = WM_PAINT) then
   Memo1.Postmsg(WM_MEMOUPD,0,0)
 else if (Msg.message = WM_MEMOUPD) then
   Memo1Paint(Memo1, GetDC(Memo1.Handle)) ;
 Result := False;  
end;

end.


---

← →
L`Autour ©   (2009-04-14 10:14) [4]

Еще по Memo1.Canvas.TextOut(1,y,Int2Str(1+i+n));
Он не затирает фон перед отрисовкой номеров, поэтому после прокрутки номера первых строк будут содержать лишние цифры от номеров старших строк.
Нужно будет добавить закраску фона перед выводом номеров строк.

---

← →
imp   (2009-04-14 10:26) [5]

Спасибо, работает. Но это еще не вся задача.
Все это должно работать и при создании Memo1: TKOLMemo; в рантайм да ещё и Memo1:array of TKOLMemo;
Очень надеюсь на Вашу помощь.

---

← →
L`Autour ©   (2009-04-14 11:32) [6]

Динамическое добавление контролов никогда не использовал, а так где-то так:

Вызов процедуры после создания нового KOLMemo

procedure SetEditRect (Memo: PControl);
var
//H: HWND;
Rect: TRect;
begin
 SendMessage( Memo.Handle, EM_GETRECT, 0, LongInt(@Rect));
 Rect.Left:= 20;
 SendMessage(Memo.Handle, EM_SETRECT, 0, LongInt(@Rect));
 Memo.Update;
end;


Общая процедура для всех новых KOLMemo


procedure MemoPaint(Memo: PControl; DC: HDC);
var
i,y,n:integer;
t:string;
begin
n:=Memo.Perform(EM_GETFIRSTVISIBLELINE,0,0);
y:=1;
i:=0;
while (y<Memo.ClientHeight) do
 begin
   Memo.Canvas.TextOut(1,y,Int2Str(1+i+n));
   y:=y+16;
   inc(i);
 end;
end;


Обработчик OnMessage для каждого нового KOLMemo


function TForm1.MemoMessage(var Msg: tagMSG; var Rslt: Integer): Boolean;
var
Memo: PControl;
begin
if
... здесь проверяем от какого KOLMemo сообщение
    и определяем значение Memo
then
begin
  if (Msg.message = WM_PAINT) then
    Memo.Postmsg(WM_MEMOUPD,0,0)
  else if (Msg.message = WM_MEMOUPD) then
    MemoPaint(Memo, GetDC(Memo.Handle)) ;
Result := False;  
end;


---

← →
L`Autour ©   (2009-04-14 11:38) [7]

может можно и красивее, но для себя я определяю контролы для общего обработчика сообщений так:

if (Msg.hwnd = Memo1.GetWindowHandle) ...

---

← →
Дмитрий   (2009-04-14 11:39) [8]

Назначить создаваемому компоненту события, вроде OnEvent := TOnEvent(MakeMethod(nil, @MyEvent))
Внутри события работать не с именем компонента, а с передаваемым PControl

---

← →
Дмитрий   (2009-04-14 11:40) [9]

тфу, и тут опоздал :)

---

← →
Дмитрий   (2009-04-14 11:43) [10]

> может можно и красивее,

Можно использовать поле Tag...

И ещё момент - при динамическом назначении объявление процедуры procedure MemoPaint(Memo: PControl; DC: HDC); должно выглядеть так:
procedure MemoPaint(Dummy, Memo: PControl; DC: HDC); а то уже многие на грабли наступили :)

---

← →
imp   (2009-04-14 12:40) [11]

А зачем в function TForm1.MemoMessage(var Msg: tagMSG; var Rslt: Integer): Boolean; проверять
if
... здесь проверяем от какого KOLMemo сообщение
   и определяем значение Memo
then

???

1) Разве OnMessage не прикрепляется к каждому новому контролу???
2) Как все это реализовать в отдельный класс (контрол, наследник Мемо)??? (PS: у мя не получается до конца правильно)

---

← →
imp   (2009-04-14 12:48) [12]

И еще помогите. Вот сделал код, но он выдает ошибку при выходе из програмки (если запускать не из IDE). Где причина???


{ KOL MCK } // Do not remove this line!
{$DEFINE KOL_MCK}
unit Unit1;

interface

{$IFDEF KOL_MCK}
uses Windows, Messages, KOL {$IF Defined(KOL_MCK)}{$ELSE}, mirror, Classes, Controls, mckCtrls, mckObjs, Graphics {$IFEND (place your units here->)};
{$ELSE}
{$I uses.inc}
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
{$ENDIF}

type
{$IF Defined(KOL_MCK)}
{$I MCKfakeClasses.inc}
 {$IFDEF KOLCLASSES} {$I TForm1class.inc} {$ELSE OBJECTS} PForm1 = ^TForm1; {$ENDIF CLASSES/OBJECTS}
 {$IFDEF KOLCLASSES}{$I TForm1.inc}{$ELSE} TForm1 = object(TObj) {$ENDIF}
  Form: PControl;
{$ELSE not_KOL_MCK}
 TForm1 = class(TForm)
{$IFEND KOL_MCK}
  KOLProject1: TKOLProject;
  KOLForm1: TKOLForm;
   TabControl1: TKOLTabControl;
   Button1: TKOLButton;
  procedure KOLForm1FormCreate(Sender: PObj);
  procedure SetEditRect(Memo: PControl);
  function Memo1Message(var Msg: tagMSG; var Rslt: Integer): Boolean;
   procedure Button1Click(Sender: PObj);
private
  { Private declarations }
public
  { Public declarations }
end;

var
Form1 {$IFDEF KOL_MCK} : PForm1 {$ELSE} : TForm1 {$ENDIF} ;
Memos:array[1..10]of TKOLMemo;
num:integer;
FGutterWidth: integer;
FLineCount: integer;

{$IFDEF KOL_MCK}
procedure NewForm1( var Result: PForm1; AParent: PControl );
{$ENDIF}

implementation

{$IF Defined(KOL_MCK)}{$ELSE}{$R *.DFM}{$IFEND}

{$IFDEF KOL_MCK}
{$I Unit1_1.inc}
{$ENDIF}

const
WM_MEMOUPD = WM_USER + 100;

procedure TForm1.KOLForm1FormCreate(Sender: PObj);
begin
 num:=0;
 FGutterWidth:=30;
end;

procedure TForm1.SetEditRect(Memo: PControl);
var
//H: HWND;
 Rect: TRect;
begin
 SendMessage( Memo.Handle, EM_GETRECT, 0, LongInt(@Rect));
 Rect.Left:= FGutterWidth;
 SendMessage(Memo.Handle, EM_SETRECT, 0, LongInt(@Rect));
//Memo1.Update;
end;

procedure Memo1Paint(Memo1: PControl; DC: HDC);
var
 i,y,n:integer;
begin
 n:=Memo1.Perform(EM_GETFIRSTVISIBLELINE,0,0);
 y:=1;
 i:=0;
 Memo1.Canvas.Rectangle(0,0,FGutterWidth,Memo1.ClientHeight);
 while (y<Memo1.ClientHeight) do
   begin
     Memo1.Canvas.TextOut(1,y,Int2Str(1+i+n));
     y:=y+16;
     inc(i);
   end;
end;

function TForm1.Memo1Message(var Msg: tagMSG; var Rslt: Integer): Boolean;
var
 j,n:integer;
begin
 for j:=0 to num do
   if (Msg.hwnd = Memos[j].GetWindowHandle)then
     begin
       n:=j;
     end;
if (Msg.message = WM_PAINT) then
  Memos[n].Postmsg(WM_MEMOUPD,0,0)
else if (Msg.message = WM_MEMOUPD) then
  Memo1Paint(Memos[n], GetDC(Memos[n].Handle)) ;
Result := False;  
end;

procedure TForm1.Button1Click(Sender: PObj);
begin
 inc(num);
 TabControl1.TC_Insert(num-1,Int2Str(num),0);
 TabControl1.Pages[num-1].Show;
 Memos[num]:=NewEditBox( TabControl1.Pages[num-1], [ eoMultiline ] );
 Memos[num].Tag:=num;
 Memos[num].CreateWindow;
 Memos[num].Align:=caClient;
 Form1.SetEditRect(Memos[num]);
 Memos[num].OnMessage:=Form1.Memo1Message;
end;

end.



---

← →
L`Autour ©   (2009-04-14 13:03) [13]

Если процедура обработки общая для группы контролов, то вначале нужно в этой процедуре узнать для какого контрола будет вестись обработка сообщения.
а if...then - это я просто из своей проги брал для примера :), но у меня было несколько статических компонентов с общей обработкой.

1) Прикрепление OnMessage - всего лишь назначение своего адреса процедуры обработчика, что и делаем при создании нового контрола.
2) Не ко мне -  я объекты умею только использовать (не умею программировать абстрактно)

---

← →
imp   (2009-04-14 13:04) [14]

Дмитрий - ВЫ ГЕНИЙ, спасибо.

PS: procedure MemoPaint(Dummy, Memo: PControl; DC: HDC);

---

← →
L`Autour ©   (2009-04-14 13:08) [15]

А убивать динамически созданные контролы при выходе не пробовал?

---

← →
imp   (2009-04-14 13:40) [16]

Рано радовался. все равон при закрытии приложения вне иде выдает ошибку.
поставил уничтожение обьектов

procedure TForm1.KOLForm1Close(Sender: PObj; var Accept: Boolean);
var
 i:integer;
begin
 for i:=1 to Length(Memos) do
   if Memos[i]<>nil then
     Memos[i].Free;
end;


- не помогло.

ПОМОГИТЕ НАЙТИ ОШИБКУ !!!

---

← →
imp   (2009-04-14 15:06) [17]

Делаю отдельный модуль (компонент), вроди все нормально до того как в LineNumberDraw не добавляю Canvas.Brush.Color:=FGutterColor; //<<-- Проблема здеся.


unit KOLMyMemo;

interface

uses
 Windows, Messages, KOL;

const
 WM_MEMOUPD = WM_USER + 100;
 
type
 PKOLMyMemo =^TKOLMyMemo;
 TKOLMyMemo_ = PKOLMyMemo;
 TKOLMyMemo = object(TControl)

 FGutterEnabled: boolean;
 FGutterWidth: integer;
 FGutterColor: TColor;
 FLineCount: integer;
 //procedure SetGutterWidth(Value: integer);
 //procedure SetGutterEnabled(Value: boolean);
 procedure SetEditRect;
 //procedure SetAlign(const Value: TControlAlign);
 //procedure SetGutterColor(Value: TColor);
 //function GetGutterColor: TColor;
 procedure LineNumberDraw;
 function KOLMyMemoOnMessage( var Msg: TMsg; var Rslt: Integer ): Boolean;
 private
   { Private declarations }
 protected
   { Protected declarations }
 public
   { Public declarations }
   destructor Destroy; virtual;
   //property GutterEnabled: boolean read FGutterEnabled write SetGutterEnabled;
   //property GutterWidth: integer read FGutterWidth write SetGutterWidth;
   //property GutterColor: TColor read GetGutterColor write SetGutterColor;
   //property Align: TControlAlign read FAlign write SetAlign;
 end;

 function NewKOLMyMemo( AParent: PControl; Options: TEditOptions ): PKOLMyMemo;

implementation

function NewKOLMyMemo( AParent: PControl; Options: TEditOptions ): PKOLMyMemo;
begin
 Result:=PKOLMyMemo(NewEditBox( AParent, Options ));
 //Result.FLineCount:=1;
 //Result.Font.FontName:="Courier New";
 //Result.FGutterEnabled:=True;
 //Result.FGutterWidth:=30;
 Result.FGutterColor:=clSilver;
 Result.Color:=clWindow;
 Result.SetEditRect;
 Result.OnMessage:=Result.KOLMyMemoOnMessage;
end;

destructor TKOLMyMemo.Destroy;
begin
 inherited;
end;

//procedure LineNumberDraw(MM: TKOLMyMemo; DC: HDC);
procedure TKOLMyMemo.LineNumberDraw;
var
 i,y,n,w:integer;
 t:string;
begin
 {n:=MM.Perform(EM_GETFIRSTVISIBLELINE,0,0);
 y:=1;
 i:=0;
 MM.Canvas.Pen.Color:=MM.Color;
 MM.Canvas.Rectangle(0,0,MM.FGutterWidth-1,MM.ClientHeight);
 MM.Canvas.Pen.Color:=clBlack;
 MM.Canvas.MoveTo(MM.FGutterWidth-1,0);
 MM.Canvas.LineTo(MM.FGutterWidth-1,MM.ClientHeight);
 MM.Canvas.Font.FontName:="Courier New";
 while (y<MM.ClientHeight) do
   begin
     t:=Int2Str(1+i+n);
     MM.Canvas.TextOut(1,y,t);
     y:=y+16;
     inc(i);
   end;}

 n:=Perform(EM_GETFIRSTVISIBLELINE,0,0);
 y:=1;
 i:=0;
 Canvas.Pen.Color:=Color;
 Canvas.Brush.Color:=FGutterColor; //<<-- Проблема здеся
 Canvas.Rectangle(0,0,FGutterWidth-1,ClientHeight);
 Canvas.Pen.Color:=clBlack;
 Canvas.MoveTo(FGutterWidth-1,0);
 Canvas.LineTo(FGutterWidth-1,ClientHeight);
 Canvas.Font.FontName:="Courier New";
 while (y<ClientHeight) do
   begin
     t:=Int2Str(1+i+n);
     w:=Canvas.TextWidth(t);
     Canvas.TextOut(FGutterWidth-w-2,y,t);
     y:=y+16;
     inc(i);
   end;
end;

function TKOLMyMemo.KOLMyMemoOnMessage( var Msg: TMsg; var Rslt: Integer ): Boolean;
begin
 Result := False;
 Rslt := 0;
 if (Msg.message = WM_PAINT) then
   Self.Postmsg(WM_MEMOUPD,0,0)
 else if (Msg.message = WM_MEMOUPD) then
   //LineNumberDraw(Self, GetDC(Self.Handle)) ;
   LineNumberDraw;
end;

{procedure TKOLMyMemo.KOLMyMemoOnKeyChar( Sender: PControl; var Key: KOLChar; Shift_: Cardinal );
begin
 {inherited;
 if Key = #13 then
   PKOLMyMemo(Sender).LineNumberDraw(True);
 if Key = #8 then
   PKOLMyMemo(Sender).LineNumberDraw(False);}
 {inherited;
 if Key = #13 then
   begin
     inc(FLineCount);
   end;
 if Key = #8 then
   begin
     if FLineCount>1 then
       dec(FLineCount);
   end;
 //LineNumberDraw(Self,False);
end;}

{procedure TKOLMyMemo.SetAlign(const Value: TControlAlign);
begin
 //Set_Align(Value);
 //SetEditRect;
end;}

procedure TKOLMyMemo.SetEditRect;
var
 Loc: TRect;
begin
 Loc.Left:=0;
 SendMessage(Self.Handle, EM_GETRECT, 0, LongInt(@Loc));
 Loc.Left:=FGutterWidth;
 SendMessage(Self.Handle, EM_SETRECTNP, 0, LongInt(@Loc));
end;

{procedure TKOLMyMemo.SetGutterEnabled(Value: boolean);
begin
 if Value <> FGutterEnabled then
   begin
     FGutterEnabled := Value;
   end;
end;}

{procedure TKOLMyMemo.SetGutterWidth(Value: integer);
begin
 if Value <> FGutterWidth then
   begin
     FGutterWidth := Value;
   end;
end;}

{procedure TKOLMyMemo.SetGutterColor(Value: TColor);
begin
 if Value <> FGutterColor then
   begin
     FGutterColor := Value;
   end;
end;}

{function TKOLMyMemo.GetGutterColor: TColor;
begin
 Result := FGutterColor;
end;}

end.


В чем продлема понять не могу (при закрытии приложение - ошибка)

---

← →
L`Autour ©   (2009-04-14 15:58) [18]

попробуй так (пример без модуля):

procedure TForm1.KOLForm1Close(Sender: PObj; var Accept: Boolean);
var
i:integer;
begin
num := -1; // <- добавил
for i:=1 to Length(Memos) do
  if Memos[i]<>nil then
    Memos[i].Free;
end;

похоже на мессаджи, которые пытается обработать, когда едиторы уже убиты

---

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

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

Наверх

Память: 0.52 MB
Время: 0.004 c