|
:: MVP ::
|
|
|
:: RSS ::
|
|
|
Как измененить величину табуляции в TMemo?
// Для этого надо послать сообщение EM_SETTABSTOPS компоненту TMemo, в котором необходимо указать два параметра:
// количество передаваемых значений и величины табуляций.
// Если первый параметр равняется нулю, то второй параметр игнорируется и величина табуляции сбрасывается в значение
// по умолчанию (32). Иначе, устанавливается величина указанная во втором параметре, причем, при единичном значении
// все величины табуляций будут равны, а при большем значении величины берутся из переданного массива.
{Установка одной величины табуляции}
procedure TForm1.Button1Click(Sender: TObject);
const
TabInc: Longint = 40;
begin
SendMessage(Memo1.Handle, EM_SETTABSTOPS, 1, Longint(@TabInc));
Memo1.Lines.Add('1'^I'Иванов'^I'Иван');
Memo1.Lines.Add('2'#9'Терещенко'#9'Илья');
end;
{Установка двух величин табуляции}
procedure TForm1.Button2Click(Sender: TObject);
const
TabInc: array [1..2] of Longint = (10, 30);
begin
SendMessage(Memo1.Handle, EM_SETTABSTOPS, 2, Longint(@TabInc));
Memo1.Lines.Add('1'^I'Иванов'^I'Иван');
Memo1.Lines.Add('2'#9'Терещенко'#9'Илья');
end;
|
Как вставить текст в позицию курсора (или вместо выделенного текста) в TMemo?
// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(Memo1.Handle, EM_REPLACESEL, 0, NativeInt(PChar('текст')));
end;
// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Perform(EM_REPLACESEL, 0, NativeInt(PChar('текст')));
end;
// Способ третий
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.SetSelText('текст');
end;
|
Как посимвольно напечатать текст в TMemo?
type
PThreadData = ^TThreadData;
TThreadData = record
Handle: THandle;
Text: string;
end;
var
ThreadHandle: THandle;
threadvar
ThreadData: TThreadData;
function PrintText(Parameter: Pointer): Integer;
procedure Print(Wnd: THandle; Text: string);
var
i: Integer;
begin
for i := 1 to Length(Text) do
begin
SendMessage(Wnd, WM_CHAR, Ord(Text[i]), 0);
Sleep(100);
end;
end;
var
lpThreadData: PThreadData;
begin
lpThreadData := Parameter;
Print(lpThreadData^.Handle, lpThreadData^.Text);
EndThread(0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ThreadId, WaitResult: DWORD;
begin
ThreadData.Handle := Memo1.Handle;
ThreadData.Text := 'procedure Print(Wnd: THandle; Text: string);' + Chr(13) +
'var' + Chr(13) +
' i: Integer;' + Chr(13) +
'begin' + Chr(13) +
' for i := 1 to Length(Text) do' + Chr(13) +
' begin' + Chr(13) +
' SendMessage(Wnd, WM_CHAR, Ord(Text[i]), 0);' + Chr(13) +
' Sleep(100);' + Chr(13) +
' end;' + Chr(13) +
'end;';
ThreadHandle := BeginThread(nil, 0, @PrintText, @ThreadData, 0, ThreadId);
repeat
WaitResult := WaitForSingleObject(ThreadHandle, 10);
Application.ProcessMessages;
until WaitResult = WAIT_OBJECT_0;
CloseHandle(ThreadHandle);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TerminateThread(ThreadHandle, 0);
end;
|
Как менять размера шрифта в TMemo с помощью скрола мыши?
type
TMemo = class(Vcl.StdCtrls.TMemo)
private
procedure WMMouseWheel(var Msg: TWMMouseWheel); message WM_MOUSEWHEEL;
end;
{...}
implementation
{...}
procedure TMemo.WMMouseWheel(var Msg: TWMMouseWheel);
function CtrlDown: Boolean;
begin
Result := (GetAsyncKeyState(VK_CONTROL) shr 16) and 1 = 1;
end;
begin
if CtrlDown then
if Msg.WheelDelta > 0 then
Font.Size := Font.Size + 2
else
if Font.Size > 2 then
Font.Size := Font.Size - 2
else
else
inherited;
end;
|
Как заменить вставку символ Tab пробелами?
type
TForm1 = class(TForm)
Memo1: TMemo;
ApplicationEvents1: TApplicationEvents;
end;
{...}
implementation
{...}
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
function CtrlDown: Boolean;
begin
Result := (GetAsyncKeyState(VK_CONTROL) shr 16) and 1 = 1;
end;
begin
case Msg.message of
WM_KEYDOWN:
if (ActiveControl = Memo1) and (Msg.wParam = VK_TAB) and CtrlDown then
begin
Memo1.SetSelText(' ');
Handled := True;
end;
end;
end;
|
Как получить абсолютную позицию курсора в TMemo в пикселях?
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
lResult: Integer;
aCaretPos: TPoint;
i: Integer;
CharIndex: Integer;
begin
aCaretPos := Memo1.CaretPos;
CharIndex := 0;
for i := 0 to aCaretPos.Y - 1 do
CharIndex := CharIndex + Length(Memo1.Lines[i]) + 2 {CRLF};
CharIndex := CharIndex + aCaretPos.X;
lResult := Memo1.Perform(EM_POSFROMCHAR, WPARAM(CharIndex), 0);
if lResult = -1 then
Caption := 'Error'
else
Caption := Format('X=%d Y=%d', [LoWord(lResult), HiWord(lResult)]);
// Для проверки корректности можно перемещать
// указатель мыши в позицию вычисленных координат
// Memo1.Cursor := crArrow;
// aCaretPos.X := LoWord(lResult);
// aCaretPos.Y := HiWord(lResult) + Abs(Memo1.Font.Height * Screen.PixelsPerInch div 72);
// aCaretPos := Form1.ClientToScreen(aCaretPos);
// Inc(aCaretPos.X, Memo1.Left);
// Inc(aCaretPos.Y, Memo1.Top);
// SetCursorPos(aCaretPos.X, aCaretPos.Y);
end;
|
Как перейти к определенной строке и отцентрировать ее?
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
procedure SetMemoPos(Line: Integer; Ch: Integer = 0);
end;
implementation
procedure TForm1.SetMemoPos(Line: Integer; Ch: Integer = 0);
function LinesVisible( Memo: TMemo ): Integer;
var
OldFont: HFont;
Hand: THandle;
TM: TTextMetric;
Rect: TRect;
TempInt: Integer;
begin
Hand := GetDC(Memo.Handle);
try
OldFont := SelectObject(Hand, Memo.Font.Handle);
try
GetTextMetrics(Hand, TM);
Memo.Perform(EM_GETRECT, 0, Longint(@Rect));
TempInt := (Rect.Bottom - Rect.Top) div (TM.tmHeight + TM.tmExternalLeading);
finally
SelectObject(Hand, OldFont);
end;
finally
ReleaseDC(Memo.Handle, Hand);
end;
Result := TempInt;
end;
var
p: TPoint;
FirstVisible: LongInt;
LnCnt: LongInt;
begin
p.X := 0;
p.Y := Line;
Memo1.CaretPos := p;
// Определяем номер первой видимой строки
FirstVisible := SendMessage(Memo1.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
// Определяем количество видимых в Memo строк
LnCnt := LinesVisible(Memo1);
// устанавливаем линию с курсором с центрированием по вертикали
SendMessage(Memo1.Handle, EM_LINESCROLL, 0, p.Y - FirstVisible - (LnCnt div 2));
Memo1.SetFocus;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetMemoPos(StrToInt(Edit1.Text));
end;
|
|
При использовании материала - ссылка на сайт обязательна
|
|
