:: MVP ::
|
|
:: RSS ::
|
|
|
Как вставить содержимое файла в текущую позицию TMemo?
procedure TForm1.Button1Click(Sender: TObject);
var
MStream: TMemoryStream;
Zero: char;
begin
MStream := TMemoryStream.Create;
MStream.LoadFromFile('c:\boot.ini');
MStream.Seek(0, soFromEnd);
Zero := #0;
MStream.Write(Zero, 1);
MStream.Seek(0, soFromBeginning);
Memo1.SetSelTextBuf(MStream.Memory);
MStream.Free;
end;
|
Как выделить строку в TMemo при щелчке на ней?
procedure TForm1.Memo1Click(Sender: TObject);
var
Line: Integer;
begin
with (Sender as TMemo) do
begin
Line := Perform(EM_LINEFROMCHAR, SelStart, 0);
SelStart := Perform(EM_LINEINDEX, Line, 0);
SelLength := Length(Lines[Line]);
end;
end;
|
Как сделать, чтобы слово в TMemo переносилось не целиком, а только та его часть, которая не помещается?
var
Form1: TForm1;
OriginalWordBreakProc: Pointer;
NewWordBreakProc: Pointer;
implementation
function MyWordBreakProc(LPTSTR: PChar; ichCurrent: Integer;
cch: Integer; code: Integer ): Integer;
{$IFDEF WIN32} stdcall; {$ELSE} export; {$ENDIF}
begin
Result := 0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
OriginalWordBreakProc:= Pointer(SendMessage(Memo1.Handle,
EM_GETWORDBREAKPROC, 0, 0));
{$IFDEF WIN32}
NewWordBreakProc := @MyWordBreakProc;
{$ELSE}
NewWordBreakProc := MakeProcInstance(@MyWordBreakProc, hInstance);
{$ENDIF}
SendMessage(Memo1.Handle, EM_SETWORDBREAKPROC, 0,
Longint(NewWordBreakProc));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SendMessage(Memo1.Handle, EM_SETWORDBREAKPROC, 0,
Longint(@OriginalWordBreakProc));
{$IFNDEF WIN32}
FreeProcInstance(NewWordBreakProc);
{$ENDIF}
end;
|
Как изменить шрифт в TMemo на моноширный?
// SYSTEM_FIXED_FONT или ANSI_FIXED_FONT
procedure TForm1.FormCreate(Sender: TObject);
begin
SendMessage(Memo1.Handle, WM_SETFONT,
GetStockObject(SYSTEM_FIXED_FONT), 1);
end;
|
Как запретить показ курсора (каретки) в TMemo?
// На форме должен быть только один компонент,
// имеющий каретку (Edit, Memo и т.п.). Лучше всего
// создать своего потомка, и уже в нем проделать
// все приведенные ниже действия
type
TForm1 = class(TForm)
Memo1: TMemo;
private
{ Private declarations }
public
{ Public declarations }
procedure WMPaint(var Msg: TMessage); message WM_Paint;
procedure WMSetFocus(var Msg: TMessage); message WM_SetFocus;
procedure WMNCHitTest(var Msg: TMessage); message WM_NCHitTest;
end;
implementation
procedure TForm1.WMNCHitTest(var Msg: TMessage);
begin
inherited;
HideCaret(Memo1.Handle);
end;
procedure TForm1.WMPaint(var Msg: TMessage);
begin
inherited;
HideCaret(Memo1.Handle);
end;
procedure TForm1.WMSetFocus(var Msg: TMessage);
begin
inherited;
HideCaret(Memo1.Handle);
end;
|
Как реализовать поиск в TMemo с использованием TFindDialog?
type
TForm1 = class(TForm)
private
{ Private declarations }
FSelPos: integer;
{...}
end;
procedure TForm1.FindDialog1Find(Sender: TObject);
var
s: string;
startpos: Integer;
begin
with TFindDialog(Sender) do
begin
if FSelPos = 0 then
Options := Options - [frFindNext];
if frfindNext in Options then
begin
StartPos := FSelPos + Length(Findtext);
s := Copy(Memo1.Lines.Text, StartPos, MaxInt);
end
else
begin
s := Memo1.Lines.Text;
StartPos := 1;
end;
FSelPos := Pos(FindText, s);
if FSelPos > 0 then
begin
FSelPos := FSelPos + StartPos - 1;
Memo1.SelStart := FSelPos - 1;
Memo1.SelLength := Length(FindText);
Memo1.SetFocus;
end
else
begin
if frfindNext in Options then
s := Concat('There are no further occurences of "', FindText, '" in Memo1.')
else
s := Concat('Could not find "', FindText, '" in Memo1.');
MessageDlg(s, mtError, [mbOK], 0);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FSelPos := 0;
FindDialog1.Execute;
end;
|
При использовании материала - ссылка на сайт обязательна
|
|