Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

Это было два месяца тому назад. Я нашел это на одном из Delphi-сайтов. Не очень сложно и понятно.

UNITLbox;

INTERFACE

USESSysUtils, WinTypes, Messages, Classes, Controls, Graphics, Forms,Menus, StdCtrls;

TypeTCngListBox = Class(TListBox)

private

FOnChange : TNotifyEvent;

FLastSel : integer;

procedureClick; override;

protected

procedureChange; Virtual;

published

propertyOnChange : TNotifyEvent readFOnChange writeFOnChange;

public

constructorcreate(AOwner : TComponent); override;

End;

Procedure Register;

IMPLEMENTATION

procedureTCngListBox.Change;

begin

FLastSel := ItemIndex;

ifassigned(FOnChange) thenFOnChange(self);

end;

procedureTCngListBox.Click;

begin

inheritedClick;

ifFLastSel <> ItemIndex thenChange;

end;

constructorTCngListBox.Create;

begin

InheritedCreate(AOwner);

FLastSel := –1;

end;

procedure Register;

begin

RegisterComponents('FreeWare',[TCngListBox]);

end;

END.

Nomadicсоветует:

Смотри пример:

unitDN_Win;

interface

usesSysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Menus, StdCtrls,

typeTDNForm = class(TForm)

MainMenu1: TMainMenu;

cm_MainExit: TMenuItem;

procedureFormCreate(Sender: TObject);

procedurecm_MainExitClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

BM:TBitmap;

ProcedureWMDrawItem( varMsg:TWMDrawItem); messagewm_DrawItem;

ProcedureWMMeasureItem( varMsg:TWMMeasureItem); messagewm_MeasureItem;

end;

varDNForm : TDNForm;

implementation

{$R *.DFM}

varComm, yMenu : word;

procedureTDNForm.FormCreate(Sender: TObject);

begin

{картинку в меню}

yMenu:=GetSystemMetrics(SM_CYMENU);

comm:=cm_MainExit.Command;

ModifyMenu(MainMenu1.Handle, 0, mf_ByPosition ormf_OwnerDraw, comm, 'Go');

end;{TDNForm.FormCreate}

procedureTDNForm.cm_MainExitClick(Sender: TObject);

begin

DNForm.Close;

end;{TDNForm.cmExitClick}

{для прорисовки меню}

ProcedureTDNForm.WMMeasureItem( varMsg:TWMMeasureItem);

Begin

withMsg.MeasureItemStruct^ do begin

ifItemID=comm then begin

ItemWidth:=yMenu;

Itemheight:=yMenu;

end;

end;

End;{WMMeasureItem}

{}

ProcedureTDNForm.WMDrawItem( varMsg:TWMDrawItem);

var

MemDC:hDC;

BM:hBitMap;

mtd:longint;

Begin

withMsg.DrawItemStruct^ do begin

ifItemID=comm then begin

BM:=LoadBitMap(hInstance,'dver');

MemDC:=CreateCompatibleDC(hDC); {hDC входит в структуру TDrawItemStruct}

SelectObject(MemDC,BM);

{rcItem входит в структуру TDrawItemStruct}

ifItemState=ods_Selected thenmtd:=NotSrcCopy

elsemtd:=SrcCopy;

StretchBlt(hDC, rcItem.left, rcItem.top, yMenu, yMenu, MemDC, 0, 0, 24, 23, mtd);

DeleteDC(MemDC);

DeleteObject(BM);

end;

end{with}

End;{TDNForm.WMDrawItem}

end.

Для получения содержимого буфера используйте метод GetTextBuf, или воспользуйтесь приведенным ниже кодом (естественно, откорректируйте его под себя).

procedureTForm1.SpeedButton1Click(Sender: TObject);

var

LineNo : integer;

ColNo : integer;

begin

LineNo:=SendMessage(Memo1.Handle, EM_LINEFROMCHAR, Memo1.SelStart, 0);

ColNo:=Memo1.SelStart;

ifLineNo>0 then begin

WhileSendMessage(Memo1.Handle, EM_LINEFROMCHAR, ColNo, 0) = LineNo doColNo:=ColNo-1;

ColNo:=Memo1.SelStart-ColNo-1;

end elseColNo:=Memo1.SelStart;

Panel1.Caption:='Строка '+IntToStr(LineNo)+' ; Колонка '+IntToStr(ColNo);

{Здесь вы можете получить текст через Memo1.Lines[LineNo].Text[ColNo] …}

end;

Предупреждение! Данный код был написан в среде WinNT/D2 с использованием элемента управления richedit. Я тестировал то же самое, но с компонентом Memo и в D1, но этот код я забыл дома. Код выше написан по памяти и не тестировался, но я думаю он должен работать. Если вы переберетесь на D2, измените вызов sendmessage на следующий:

SendMessage(Memo1.Handle, EM_EXLINEFROMCHAR, 0, ColNo)

Просто меняю обработчик Memo OnKeyDown следующим образом:

ifKey = VK_DELETE then begin

здесь делайте все, что вы хотите

end;

ifKey = VK_BACK then begin

аналогично

end;

Вероятно, лучшим решением было бы использование конструкции CASE, но я не уверен, что она поймет как нужно VK_??. Возможно, после обработки нужно вызвать унаследованный обработчик, т.е. дать поработать обработчику верхнего уровня, у которого мы стырили управление. Не хотите подумать над этим?

Чтобы понять, где мы сейчас находимся, используйте SelStart, например, так:

var

Lpos, Cpos : Integer;

Lpos := SendMessage(memo1.Handle, EM_LINEFROMCHAR, Memo1.SelStart, 0);

Cpos := SendMessage(memo1.Handle, EM_LINEINDEX, Lpos, 0);

CPos := Memo1.SelStart-CPos;

Ответ: поскольку vk_? имеет целочисленный тип, то это будет работать:

caseKey of

VK_DELETE :

begin

Key := 0; {этим мы не позволяем сообщению keydown передаваться дальше,

например, форме или компонентам}

выполняем нужный код;

end;

VK_BACK:

begin

Key := 0; {этим мы не позволяем сообщению keydown передаваться дальше,

например, форме или компонентам}

выполняем нужный код;

end;

end;

Используйте сообщение Windows API EM_REPLACESEL:

EM_REPLACESEL

wParam = 0; /* не используется, должен быть ноль */

lParam = (LPARAM) (LPCSTR) lpszReplace; /* адрес новой строки */

Для замены текущего выбранного текста в поле редактирования, приложение должно послать сообщение EM_REPLACESEL, где параметр lpszReplace содержит новый текст.

Возвращаемое значение