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

• Название: Советы по Delphi. Версия 1.4.3 от 1.1.2001
• Автор: Валентин Озеров
• Жанр: Программирование

…начиная с 1001. Смотрите другие файлы…

---

 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)