listbox := TListBox.Create(self);
listbox.Parent := self;
listbox.Top := 0;
listbox.Left := 0;
listbox.Width := self.Width div 2;
listbox.Height := self.Height div 2;
listbox.items.add('тест 1');
listbox.items.add('тест 2');
{ и т.д, и т.п. … }
end;
procedure TForm1.FormResize(Sender: TObject);
begin
listbox.Width := self.Width div 2 ;
listbox.Height := self.Height div 2 ;
end;
end.
Двойной ListBox
Я расположил на форме два компонента Listbox, и с помощью следующего кода заполнил один из них данными из таблицы:
tableName.Refresh; {в вашем случае это может и не понадобится}
tableName.First; {Убедимся, что мы смотрим первую запись}
while not tableName.Eof do {проходим в цикле таблицу}
begin
listbox1.items.add(tableName.FieldByName('USRID').AsString); {добавляем элемент в listbox1}
tableName.Next; {переходим к следующей записи}
end;
ниже я привел процедуру из моего рабочего кода, в котором я использую эту технологию. Я передаю ей в качестве параметров имя таблицы и имена компонентов listbox1 и listbox2. Я пользуюсь этой процедурой, поскольку у меня есть несколько таблиц с полями одинакового типа:
procedure TTemplateFrm.buildList(tableName: TTable; SelBox, AvailBox: TListBox);
begin
{в этой процедуре мы собираемся добавить данные в listbox'ы}
{получаем любые новые данные}
tableName.Refresh;
{Убедимся, что мы смотрим первую запись}
tableName.First;
{Теперь очищаем ListBox'ы}
SelBox.Clear;
AvailBox.Clear;
{Теперь добавляем элементы}
while not tableName.EOF do begin
AvailBox.Items.Add(tableName.fieldByName('USRID').AsString + ' ' + tableName.fieldByName('DESCRIPTION').AsString);
tableName.Next;
end;
end;
Как перемещать данные между этими двумя списками? Если вы хотите использовать технологию «drag and drop» (перетащи и брось), то в обработчике mousedown вашей исходной таблицы воспользуйтесь процедурой begindrag:
if Button = mbLeft then Tlistbox(sender).BeginDrag(false);
Затем, в вашем другом ListBox, для «опознания» и получения данных создайте следующий обработчик DragOver:
if Source = ListBox1 then Accept := true
else Accept := false;
Не используйте «Accept := (Source is TListbox)», как это показано в большинстве примеров. У вас имеется два компонента ListBox, следовательно, вам нужно сослаться на имя объекта, а не на его тип, а иначе программа просто не поймет кто есть кто.
Затем в обработчике dragDrop поместите следующий код, добавляющий данные в ListBox2 и удаляющий их из ListBox1.
Listbox2.Items.Add(Listbox1.Items[Listbox1.ItemIndex]);
Listbox1.Items.Delete(Listbox1.ItemIndex);
И, наконец, добавьте кнопку «Сохранить», если вы хотите сохранить содержимое ListBox2 в базе данных.
Я надеюсь, что это именно то, что вы искали, и что это окажется вам полезным. Если вы хотите также перемещать данные из ListBox2 в ListBox1, вам необходимо будет создать тот же код, но реверсировать его для получения в коде правильных ссылок на компоненты ListBox.
ListBox — OnChange
Delphi 1
Это было два месяца тому назад. Я нашел это на одном из Delphi-сайтов. Не очень сложно и понятно.
UNIT Lbox;
INTERFACE
USES SysUtils, WinTypes, Messages, Classes, Controls, Graphics, Forms,Menus, StdCtrls;
Type TCngListBox = Class(TListBox)
private
FOnChange : TNotifyEvent;
FLastSel : integer;
procedure Click; override;
protected
procedure Change; Virtual;
published
property OnChange : TNotifyEvent read FOnChange write FOnChange;
public
constructor create(AOwner : TComponent); override;
End;
Procedure Register;
IMPLEMENTATION
procedure TCngListBox.Change;
begin
FLastSel := ItemIndex;
if assigned(FOnChange) then FOnChange(self);
end;
procedure TCngListBox.Click;
begin
inherited Click;
if FLastSel <> ItemIndex then Change;
end;
constructor TCngListBox.Create;
begin
Inherited Create(AOwner);
FLastSel := –1;
end;
procedure Register;
begin
RegisterComponents('FreeWare',[TCngListBox]);
end;
END.
MainManu
Как рисовать картинки в пунктах меню (через OwnerDraw)?
Nomadic советует:
Смотри пример:
unit DN_Win;
interface
uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Menus, StdCtrls,
type TDNForm = class(TForm)
MainMenu1: TMainMenu;
cm_MainExit: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure cm_MainExitClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
BM:TBitmap;
Procedure WMDrawItem(var Msg:TWMDrawItem); message wm_DrawItem;
Procedure WMMeasureItem(var Msg:TWMMeasureItem); message wm_MeasureItem;
end;
var DNForm : TDNForm;
implementation
{$R *.DFM}
var Comm, yMenu : word;
procedure TDNForm.FormCreate(Sender: TObject);
begin
{картинку в меню}
yMenu:=GetSystemMetrics(SM_CYMENU);
comm:=cm_MainExit.Command;
ModifyMenu(MainMenu1.Handle, 0, mf_ByPosition or mf_OwnerDraw, comm, 'Go');
end;{TDNForm.FormCreate}
procedure TDNForm.cm_MainExitClick(Sender: TObject);
begin
DNForm.Close;
end;{TDNForm.cmExitClick}
{для прорисовки меню}
Procedure TDNForm.WMMeasureItem(var Msg:TWMMeasureItem);
Begin
with Msg.MeasureItemStruct^ do begin
if ItemID=comm then begin
ItemWidth:=yMenu;
Itemheight:=yMenu;
end;
end;
End;{WMMeasureItem}
{}
Procedure TDNForm.WMDrawItem(var Msg:TWMDrawItem);
var
MemDC:hDC;
BM:hBitMap;
mtd:longint;
Begin
with Msg.DrawItemStruct^ do begin
if ItemID=comm then begin
BM:=LoadBitMap(hInstance,'dver');
MemDC:=CreateCompatibleDC(hDC); {hDC входит в структуру TDrawItemStruct}
SelectObject(MemDC,BM);
{rcItem входит в структуру TDrawItemStruct}
if ItemState=ods_Selected then mtd:=NotSrcCopy
else mtd:=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.
Memo
Получение данных из компонента Memo
Delphi 1
Для получения содержимого буфера используйте метод GetTextBuf, или воспользуйтесь приведенным ниже кодом (естественно, откорректируйте его под себя).
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
LineNo : integer;
ColNo : integer;
begin
LineNo:=SendMessage(Memo1.Handle, EM_LINEFROMCHAR, Memo1.SelStart, 0);
ColNo:=Memo1.SelStart;
if LineNo>0 then begin
While SendMessage(Memo1.Handle, EM_LINEFROMCHAR, ColNo, 0) = LineNo do ColNo:=ColNo-1;
ColNo:=Memo1.SelStart-ColNo-1;
end else ColNo:=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)
