Delphi: Создание простого цветного TMemo или TEdit - [79] :: Прикладное программирование

Код:

(**
* Highlight with TMemo Impossible? try this...
* by Gon Perez-Jimenez May'04
*
* This is a sample how to work with highlighting within TMemo component by
* using interjected class technique.
*
* Of course, this code is still uncompleted but it works fine for my
* purposes, so, hope you can improve it and use it.
*
*)

unit Unit1;
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
// Interjected Class
TMemo = class(stdctrls.TMemo)
private
StartCaretPos :TSize;
FocusLost :boolean;
function HScrollPos:integer;
procedure CharToCaret(CharPos:integer; var Row,Column:integer);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
procedure WMCHAR(var Message: TWMCHAR); message WM_CHAR;
procedure WMPrintClient(var Message: TWMPaint); message WM_PRINTCLIENT;
procedure WMERASEBKGND(var Message: TWMERASEBKGND); message WM_ERASEBKGND;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMMove(var Message: TWMMove); message WM_MOVE;
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
procedure WMMousewheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
procedure PaintLine(Canvas:TCanvas; LineText:string;CurLine:integer; TxtRect:TRect);
protected
procedure Change; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
PosLabel : TLabel;
procedure Update_label;
procedure GetTextStart;
function Line : Integer;
function Col : Integer;
function TopLine : Integer;
function VisibleLines: Integer;
constructor Create(AOwner: TComponent);
end;

TForm1 = class(TForm)
Memo1: TMemo;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
KeywordList: TListBox;
Label6: TLabel;
Memo2: TMemo;
procedure FormCreate(Sender: TObject);
procedure Memo1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Memo1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation

{$R *.DFM}

procedure SetRedraw(Handle:THandle; Flag: boolean);
begin
SendMessage(Handle,WM_SETREDRAW, Ord(Flag), 0);
end;

////////////////////////////////////////////////////////////////////////////////
// functions for managing keywords and numbers of each line of TMemo ///////////
////////////////////////////////////////////////////////////////////////////////
function IsSeparator(Car:char):Boolean;
begin
Case Car of
'.', ';', ',', ':', '¡', '!', '·', '"', '''', '^', '+', '-', '*', '/', '\', '¨',' ',
'`', '[', ']', '(', ')', 'º', 'ª', '{', '}', '?', '¿', '%','=', '<','>': result := true;
else
result := false;
end;
end;
////////////////////////////////////////////////////////////////////////////////
function NextWord ( var s: String): String;
begin
result := '';
// PrevWord := '';
if s='' then Exit;
if IsSeparator(s[1]) then begin
result := result+s[1];
delete(s,1,1);
end else

{ while(s<>'')and IsSeparator(s[1]) do begin
PrevWord := PrevWord + s[1];
delete(s,1,1);
end;}
while(s<>'') and not IsSeparator(s[1]) do begin
result := result+s[1];
delete(s,1,1);
end;
end;
////////////////////////////////////////////////////////////////////////////////
function IsKeyWord ( s: String ):Boolean;
begin
result := False;
if s='' then Exit;
result := Form1.KeywordList.Items.IndexOf( lowercase(s) ) <> -1;
end;
////////////////////////////////////////////////////////////////////////////////
function IsNumber ( s: String ):Boolean;
var i: Integer;
begin
result := False;
for i:=1 to length(s) do
Case s[i] of
'0'..'9':;
else Exit;
end;
result := True;
end;
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
// New or overrided methods and properties for TMemo using Interjected Class ///
// Technique ///////////////////////////////////////////////////////////////////
function TMemo.VisibleLines: Integer;
begin
result := Height div ( Abs(Self.Font.Height)+2);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.GetTextStart;
var
Focus : THandle;
begin
Focus:=GetFocus;
Self.SetFocus;
SelStart:=0;
SelLength:=0;
Windows.GetCaretPos(TPoint(StartCaretPos));
Windows.SetFocus(Focus);
end;
////////////////////////////////////////////////////////////////////////////////
constructor TMemo.Create(AOwner: TComponent);
begin
FocusLost:=False;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.Update_label;
begin
if PosLabel=nil then Exit;
PosLabel.Caption := '('+IntToStr(Line+1)+','+IntToStr(Col)+')';
end;
////////////////////////////////////////////////////////////////////////////////
function TMemo.TopLine : Integer;
begin
Result := SendMessage(Self.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
end;
////////////////////////////////////////////////////////////////////////////////
function TMemo.Line : Integer;
begin
Result := SendMessage(Self.Handle, EM_LINEFROMCHAR, Self.SelStart, 0);
end;
////////////////////////////////////////////////////////////////////////////////
function TMemo.Col : Integer;
begin
Result := Self.SelStart - SendMessage(Self.Handle, EM_LINEINDEX, SendMessage(Self.Handle,
EM_LINEFROMCHAR, Self.SelStart, 0), 0);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMVScroll(var Message: TWMVScroll);
{var
Locked : boolean;}
begin
// Locked:=LockWindowUpdate(Handle);
inherited;
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
// if Locked then LockWindowUpdate(0);
end;
////////////////////////////////////////////////////////////////////////////////
function TMemo.HScrollPos:integer;
var
ScrollInfo : TScrollInfo;
begin
FillChar(ScrollInfo,SizeOf(TScrollInfo),0);
ScrollInfo.cbSize:=SizeOf(TScrollInfo);
ScrollInfo.fMask:=SIF_POS;
GetScrollInfo(Handle,SB_HORZ, ScrollInfo);
Result:=ScrollInfo.nPos;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMHScroll(var Message: TWMHScroll);
begin
inherited;
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMSize(var Message: TWMSize);
begin
Update_label;
// Locked:=LockWindowUpdate(Handle);
inherited;
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
// if Locked then LockWindowUpdate(0);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMEraseBKGND(var Message: TWMERASEBKGND);
begin
// íå óäàëÿòü äàííóþ ïóñòóþ ïðîöåäóðó, èíà÷å áóäóò ãëþêè ñ èçîáðàæåíèåì
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMMove(var Message: TWMMove);
begin
Invalidate;
inherited;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.CharToCaret(CharPos:integer; var Row,Column:integer);
begin
Row := SendMessage(Self.Handle, EM_LINEFROMCHAR, CharPos, 0)+1;
Column := CharPos - SendMessage(Self.Handle, EM_LINEINDEX, SendMessage(Self.Handle,
EM_LINEFROMCHAR, CharPos, 0), 0);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMLButtonUp(var Message: TWMLButtonUp);
var
Locked : boolean;
begin
Locked:=False;
try
Locked:=LockWindowUpdate(Handle);
inherited;
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
finally
if Locked then LockWindowUpdate(0);
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure Tmemo.WMKillFocus(var Message: TWMKillFocus);
begin
try
SetRedraw(Handle,False);
inherited;
// RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
FocusLost:=True;
finally
SetRedraw(Handle,True);
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure Tmemo.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMLButtonDown(var Message: TWMLButtonDown);
var
Locked : boolean;
begin
Locked:=False;
if FocusLost then begin
SetRedraw(Handle,False);
inherited;
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
SetRedraw(Handle,True);
end
else
try
Locked:=LockWindowUpdate(Handle);
inherited;
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
finally
if Locked then LockWindowUpdate(0);
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMLButtonDblClk(var Message: TWMLButtonDblClk);
var
Locked : boolean;
begin
Locked:=False;
try
Locked:=LockWindowUpdate(Handle);
inherited;
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
finally
if Locked then LockWindowUpdate(0);
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMMouseMove(var Message: TWMMouseMove);
var
Locked : boolean;
begin
Locked:=False;
if (Message.Keys and MK_LBUTTON)=0 then inherited else begin
try
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
if NOT FocusLost then
Locked:=LockWindowUpdate(Handle)
else
FocusLost:=False;
inherited;
finally
if Locked and NOT FocusLost then LockWindowUpdate(0);
end;
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMMousewheel(var Message: TWMMouseWheel);
var
Locked : boolean;
begin
Locked:=False;
try
Locked:=LockWindowUpdate(Handle);
inherited;
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
finally
if Locked then LockWindowUpdate(0);
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.Change;
begin
Update_label;
inherited Change;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMCHAR(var Message: TWMCHAR);
var
Locked : boolean;
begin
Locked:=False;
try
Locked:=LockWindowUpdate(Handle);
inherited;
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
finally
if Locked then LockWindowUpdate(0);
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMKeyDown(var Message: TWMKeyDown);
var
Locked : boolean;
begin
Locked:=False;
try
Locked:=LockWindowUpdate(Handle);
inherited;
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
finally
if Locked then LockWindowUpdate(0);
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMKeyUp(var Message: TWMKeyUp);
var
Locked : boolean;
begin
Locked:=False;
try
Locked:=LockWindowUpdate(Handle);
inherited;
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
finally
if Locked then LockWindowUpdate(0);
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.KeyDown(var Key: Word; Shift: TShiftState);
begin
Update_label;
inherited KeyDown(Key,Shift);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.KeyUp(var Key: Word; Shift: TShiftState);
begin
Update_label;
inherited KeyUp(Key,Shift);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Update_label;
inherited MouseDown(Button,Shift,X,Y);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Update_label;
inherited MouseUp(Button,Shift,X,Y);
// invalidate;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.PaintLine(Canvas:TCanvas; LineText:string; CurLine:integer; TxtRect:TRect);
const
HilightFont = clNavy;
HilightBack = clSilver;
type
TxtAttr = record
FontColor, BckColor :TColor;
end;
var
i, j, px :integer;
LineSt,ColSt,LineEnd,ColEnd :integer;
LastFont, LastBck :TColor;
Size :TSize;
t, CurWord :string;
CharsColor :array of TxtAttr;
begin
try
CharToCaret(Self.SelStart,LineSt,ColSt);
CharToCaret(Self.SelStart+Self.SelLength,LineEnd,ColEnd);
with Canvas do begin
px:=TxtRect.Left;
t:=LineText+' ';
SetLength(CharsColor,Length(LineText)+1);
for i:=0 to High(CharsColor) do begin
CharsColor[i].FontColor:=clBlack;
CharsColor[i].BckColor:=Self.Color;
end;
i:=0;
repeat
CurWord:=NextWord(t);
if CurWord<>'' then
if CurWord=' ' then begin
CharsColor[i].FontColor:=clBlack;
CharsColor[i].BckColor:=Self.Color;
Inc(i);
end
else
if IsKeyWord(CurWord) then begin
for j:=1 to Length(CurWord) do begin
CharsColor[i+j-1].FontColor:=clWhite;
CharsColor[i+j-1].BckColor:=Self.Color;
end;
Inc(i,Length(CurWord));
end
else
if IsSeparator(CurWord[1]) then begin
CharsColor[i].FontColor:=clYellow;
CharsColor[i].BckColor:=Self.Color;
Inc(i);
end
else
if IsNumber(CurWord) then begin
for j:=1 to Length(CurWord) do begin
CharsColor[i+j-1].FontColor:=clFuchsia;
CharsColor[i+j-1].BckColor:=Self.Color;
end;
Inc(i,Length(CurWord));
end
else begin
for j:=1 to Length(CurWord) do begin
CharsColor[i+j-1].FontColor:=clLime;
CharsColor[i+j-1].BckColor:=Self.Color;
end;
Inc(i,Length(CurWord));
end;
until CurWord='';
if (CurLine=LineSt) and (ColSt<>ColEnd) and (LineSt=LineEnd) then
for i:=ColSt+1 to ColEnd do begin
CharsColor[i-1].FontColor:=HilightFont;
CharsColor[i-1].BckColor:=HilightBack;
end;
if (CurLine>LineSt) and (CurLine<LineEnd) then
for i:=1 to Length(LineText) do begin
CharsColor[i-1].FontColor:=HilightFont;
CharsColor[i-1].BckColor:=HilightBack;
end;
if (CurLine=LineSt) and (LineSt<LineEnd) then
for i:=ColSt+1 to Length(LineText) do begin
CharsColor[i-1].FontColor:=HilightFont;
CharsColor[i-1].BckColor:=HilightBack;
end;
if (CurLine=LineEnd) and (LineSt<LineEnd) then
for i:=1 to ColEnd do begin
CharsColor[i-1].FontColor:=HilightFont;
CharsColor[i-1].BckColor:=HilightBack;
end;
CurWord:=LineText[1];
LastFont:=CharsColor[0].FontColor;
LastBck:=CharsColor[0].BckColor;
if Length(LineText)=1 then begin
Size:=TextExtent(CurWord);
SetBkMode(Handle, TRANSPARENT);
if LastBck<>Self.Color then begin
Brush.Color:=LastBck;
FillRect(Rect(px,TxtRect.Top,px+Size.cx,TxtRect.Top+Size.cy));
end;
Font:=Self.Font;
Font.Color:=LastFont;
TextOut(px,TxtRect.Top, CurWord);
end;
for i:=2 to Length(LineText) do begin
t:=LineText[i];
if (LastFont<>CharsColor[i-1].FontColor) or (LastBck<>CharsColor[i-1].BckColor) then begin
Size:=TextExtent(CurWord);
SetBkMode(Handle, TRANSPARENT);
if LastBck<>Self.Color then begin
Brush.Color:=LastBck;
FillRect(Rect(px,TxtRect.Top,px+Size.cx,TxtRect.Top+Size.cy));
end;
Font:=Self.Font;
Font.Color:=LastFont;
TextOut(px,TxtRect.Top, CurWord);
Inc(px,Size.cx);
CurWord:='';
LastFont:=CharsColor[i-1].FontColor;
LastBck:=CharsColor[i-1].BckColor;
end;
CurWord:=CurWord+LineText[i];
if px>TxtRect.Right then Break;
if i=Length(LineText) then begin
Size:=TextExtent(CurWord);
SetBkMode(Handle, TRANSPARENT);
if LastBck<>Self.Color then begin
Brush.Color:=LastBck;
FillRect(Rect(px,TxtRect.Top,px+Size.cx,TxtRect.Top+Size.cy));
end;
Font:=Self.Font;
Font.Color:=LastFont;
TextOut(px,TxtRect.Top, CurWord);
end;
end;
end;
finally
SetLength(CharsColor,0);
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TMemo.WMPaint(var Message: TWMPaint);
var
PS :TPaintStruct;
DC :HDC;
hbmNew :HBITMAP;
hbmOld :HBITMAP;
Canvas :TCanvas;
i :Integer;
X,Y :Integer;
psRect :TRect;
Size :TSize;
Max, LineFirst,
LineLast :Integer;
s : String;
begin
if StartCaretPos.cx=0 then GetTextStart;
BeginPaint(Handle, PS);
psRect:=Self.ClientRect;
DC:=CreateCompatibleDC(ps.hdc);
hbmNew := CreateCompatibleBitmap(PS.hdc, psRect.Right - psRect.Left, psRect.Bottom - psRect.Top);
hbmOld := SelectObject(DC, hbmNew);
Canvas:=TCanvas.Create;
try
Canvas.Handle:=DC;
Canvas.Font:=Self.Font;
with Canvas do begin
Max := TopLine+VisibleLines;
if Max>Pred(Lines.Count)then Max := Pred(Lines.Count);
Brush.Color := Self.Color;
FillRect( Self.ClientRect );
Size:=TextExtent(' ');
if GetForegroundWindow=Self.Parent.Handle then begin
LineFirst:= TopLine+(PS.rcPaint.Top div Size.cy);
LineLast:=TopLine+(PS.rcPaint.Bottom div Size.cy);
Y:=StartCaretPos.cy+(PS.rcPaint.Top div Size.cy)*Size.cy;
end
else begin
LineFirst:= TopLine;
LineLast:=Max;
Y:=StartCaretPos.cy;
end;
for i:=LineFirst to LineLast do begin
x:=StartCaretPos.cx;
s:=Lines[i];
if s='' then s:=' ';
Size:=TextExtent(s);
if Y+Size.cy<=psRect.Bottom then PaintLine(Canvas,s,i+1,Rect(x-HScrollPos,y,Self.ClientRect.Right,y+Size.cy));
Inc(Y, Size.cy);
end;
end;
finally
BitBlt(PS.hdc, psRect.Left, psRect.Top, psRect.Right - psRect.Left, psRect.Bottom - psRect.Top, dc, 0, 0, SRCCOPY);
SelectObject(DC, hbmOld);
DeleteObject(hbmNew);
DeleteDC(DC);
EndPaint(Handle, PS);
end;
Canvas.Free;
end;

procedure TMemo.WMPrintClient(var Message: TWMPaint);
var
PS :TPaintStruct;
DC :HDC;
hbmNew :HBITMAP;
hbmOld :HBITMAP;
Canvas :TCanvas;
i :Integer;
X,Y :Integer;
psRect :TRect;
Size :TSize;
Max, LineFirst,
LineLast :Integer;
s : String;
begin
if StartCaretPos.cx=0 then GetTextStart;
BeginPaint(Handle, PS);
psRect:=Self.ClientRect;
DC:=CreateCompatibleDC(ps.hdc);
hbmNew := CreateCompatibleBitmap(PS.hdc, psRect.Right - psRect.Left, psRect.Bottom - psRect.Top);
hbmOld := SelectObject(DC, hbmNew);
Canvas:=TCanvas.Create;
try
Canvas.Handle:=DC;
Canvas.Font:=Self.Font;
with Canvas do begin
Max := TopLine+VisibleLines;
if Max>Pred(Lines.Count)then Max := Pred(Lines.Count);
Brush.Color := Self.Color;
FillRect( Self.ClientRect );
Size:=TextExtent(' ');
if GetForegroundWindow=Self.Parent.Handle then begin
LineFirst:= TopLine+(PS.rcPaint.Top div Size.cy);
LineLast:=TopLine+(PS.rcPaint.Bottom div Size.cy);
Y:=StartCaretPos.cy+(PS.rcPaint.Top div Size.cy)*Size.cy;
end
else begin
LineFirst:= TopLine;
LineLast:=Max;
Y:=StartCaretPos.cy;
end;
for i:=LineFirst to LineLast do begin
x:=StartCaretPos.cx;
s:=Lines[i];
if s='' then s:=' ';
Size:=TextExtent(s);
if Y+Size.cy<=psRect.Bottom then PaintLine(Canvas,s,i+1,Rect(x-HScrollPos,y,Size.cx,y+Size.cy));
Inc(Y, Size.cy);
end;
end;
finally
BitBlt(PS.hdc, psRect.Left, psRect.Top, psRect.Right - psRect.Left, psRect.Bottom - psRect.Top, dc, 0, 0, SRCCOPY);
SelectObject(DC, hbmOld);
DeleteObject(hbmNew);
DeleteDC(DC);
EndPaint(Handle, PS);
end;
Canvas.Free;
end;

////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Procedures for Form1 ////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.PosLabel := Label1;
Memo1.Update_label;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
Point : TPoint;
begin
if Key=VK_F1 then Memo1.Invalidate;
if Key=VK_F2 then begin
Windows.GetCaretPos(Point);
ShowMessage(Format('%d:%d',[Point.x,Point.y]));
end;
if Key=VK_F3 then Windows.SetCaretPos(20,2);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TForm1.Memo1Click(Sender: TObject);
begin
if Memo1.SelLength=0 then Memo1.invalidate;
end;

end.

----------
И создал Бог женщину... Существо получилось злобное, но забавное...

Модерирует : ShIvADeSt
Версия для печати • Подписаться • Добавить в закладки
На первую страницу • к этому сообщению • к последнему сообщению