/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 810
от 15.05.2007, 07:35

Вопрос № 86.156

Уважаемые эксперты, у меня есть на форме некоторый физуальный объект, Button1, например, как мне создать новый объект на форме, который бы унаследовалал все свойства исходного Button1? По задумке код в приложении должен делать следующее:при нажатии на кнопку Button1 должна появиться под ней ее точная копия, однако исходная кнопка просто исчезает. Как исправить ситуацию? Приложение: ... var NewButt:TButton; procedure TForm1.Button1Click(Sender: TObject); begin NewButt:=TButton.Create(Form1); NewButt:=Button1; NewButt.top:=NewButt.top+Button1.height; end; end.

Отправлен: 09.05.2007, 15:17 Вопрос задал: Werebear (статус: 1-ый класс) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Denisss Здравствуйте, Werebear! См. пример в приложении. Небольшое замечание к Вашему коду: NewButt:= Button1; - данная операция не производит копирования свойств кнопки Button1 в NewButt. Копировать свойства, в данном случае, придется вручную. В Delphi, на "физическом" уровне, объекты представляют собой ссылки на область памяти, где размещена реализация нужного объекта. При подобном копировании, Вы замещаете ссылку к объекту NewButt на ссылку к объекту Button1. Т.о., выполняемая далее операция NewButt.top:=NewButt.top+Button1.height; приводит к тому, что Вы компоненту Button1 устанавливаете свойство Top равное сумме Top и Height, поэтому она у Вас и исчезает, а если точнее, то она просто куда-то перемещается. PS Может стоит использовать другое название объекту NewButt, а то перевод слова Butt не совсем цензурный. ;-) Удачи! Приложение: ... type TForm1 = class(TForm) ... private procedure CopyProperties(Source, Dest: TButton); ... end; ... // Процедура копирования свойств кнопки // Source - исходная кнопка // Dest - кнопка, в которую копируются // свойства procedure TForm1.CopyProperties(Source, Dest: TButton); begin with Source do begin Dest.Parent:= Parent; Dest.Width:= Width; Dest.Height:= Height; Dest.Top:= Top; Dest.Left:= Left; // Далее можно вписать остальные свойства, // которые нужно скопировать end; end; // Button1.OnClick procedure TForm1.Button1Click(Sender: TObject); begin // Перед созданием очередной кнопки // неплохо бы проверить, а не была // ли она создана ранее if Assigned(NewButt) then Exit; // Создание кнопки NewButt:= TButton.Create(Form1); // Копируем свойства CopyProperties(Button1, NewButt); // Переносим кнокпу наверх NewButt.BringToFront; // Устанавливаем текст кнопки NewButt.Caption:= 'NewButt'; NewButt.Top:= Button1.Height + Button1.Top; end;

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ICQ: 281599577 ---- Ответ отправлен: 09.05.2007, 16:25 Оценка за ответ: 2

Отвечает: Coupler Здравствуйте, Werebear! Я предлагаю читать и копировать компонент именно как память, используя TMemoryStream. Но при этом способе приходится на время менять имя кнопки-источника. Приложение: procedure TForm1.Button1Click(Sender: TObject); var ms: TMemoryStream; s: string; p, temp: TButton; x, y: Integer; begin temp := form1.Button1; ms := TMemoryStream.Create; ms.WriteComponent(form1.Button1); ms.Position := 0; p := TButton.Create(self); s := form1.Button1.Name; form1.Button1.Name := 'temp'; ms.ReadComponent(p); with p do begin x := temp.Left + temp.Width; y := temp.Top; SetBounds(x, y, Width, Height); Parent := Self; Name := s + '_1'; ; end; temp.Name := s; ms.Free; end;

Ответ отправил: Coupler (статус: Студент) Ответ отправлен: 09.05.2007, 16:48 Оценка за ответ: 5

Отвечает: Gh0stik Здравствуйте, Werebear! Предлагаю еще один способ. Смотрите приложение, по нажатию на кнопку создается копия текущей, но только немного ниже. Good Luck!!! Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; newBtn:TButton; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var fs:TFileStream; begin fs:=TFileStream.Create('obj',fmCreate); fs.WriteComponent(Button1); fs.Free; RegisterClass(TButton); newBtn:=TButton.Create(self); fs:=TFileStream.Create('obj',fmOpenRead); newBtn:=fs.ReadComponent(nil) as TButton; newBtn.Parent:=Form1; newBtn.Top:=newBtn.Top+50; //немного смещаем кнопку чтобы ее было видно fs.Free; end; end. --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессионал) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 09.05.2007, 18:07 Оценка за ответ: 4

Отвечает: Вадим Викторович Витомский Здравствуйте, Werebear! Для копирования ВСЕХ свойств любого обьекта используется метод Assign. В Вашем случае можно попробовать следующий код (см. приложение). Приложение: var NewButt:TButton; procedure TForm1.Button1Click(Sender: TObject); begin NewButt:=TButton.Create(Form1); NewButtAssign(Button1); NewButt.top:=NewButt.top+40; end; end.

Ответ отправил: Вадим Викторович Витомский (статус: 7-ой класс) Ответ отправлен: 10.05.2007, 09:27 Оценка за ответ: 2 Комментарий оценки: Convert Error

Вопрос № 86.189

Уважаемые эксперты, помогите пожайлуста разобраться. Необходимо создавать несколько дочерних форм (кол-во неизвестно). Они будут показывать изображение получаемое через TMemoryStream. Привожу код тестового примера. Формы и потоки создаются, но фомы обрабатывают один и тот же поток. Никак не могу понять как каждой форме подсунуть свой. Или нужно идти другим путём? Подскажите тогда как это сделать. Приложение: unit Unit1; //главная форма interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Unit2; type TForm1 = class(TForm) Button1: TButton; Timer1: TTimer; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Button1Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); private public end; type TMystream= array of TMemoryStream; type TMyForm2= array of TForm2; var Form1: TForm1; i:integer; Mystream: TMyStream; MyForm2:TMyForm2; ik:integer=0; implementation {$R *.dfm} procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin Mystream:=nil; MyForm2:=nil; end; procedure TForm1.Button1Click(Sender: TObject); begin SetLength(Mystream,i+1); SetLength(MyForm2,i+1); MyForm2[i]:= TForm2.Create(nil); Mystream[i]:=TMemoryStream.Create; try MyForm2[i].Tag:= i; MyForm2[i].Caption:='Tag: '+IntTostr(i); MyForm2[i].Show; MyForm2[i].Timer1.Enabled:=true; except MyForm2[i].Free; Mystream[i].Free; end; inc(i); end; procedure TForm1.Timer1Timer(Sender: TObject); begin Timer1.Enabled:=false; ShowMessage('Form: '+ IntToStr(Timer1.Tag)); end; end. ----------------------------------------------------------------------- unit Unit2; //динамически создаваемая interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm2 = class(TForm) Timer1: TTimer; Image1: TImage; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Timer1Timer(Sender: TObject); procedure FormCreate(Sender: TObject); private public end; var Form2:TForm2; rt:integer; implementation uses unit1; {$R *.dfm} procedure TForm2.FormCreate(Sender: TObject); begin //rt:=MyForm2[i].Tag; //тут ошибка end; procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction); begin Form1.Timer1.Tag:=rt; Timer1.Enabled:=false; Form1.Timer1.Enabled:=true; end; procedure TForm2.Timer1Timer(Sender: TObject); var bmp: TBitmap; DC: HDC; begin bmp:=TBitmap.Create; try DC:=GetDC(0); //дескpиптоp экpана + копируем экран bmp.Height:=GetDeviceCaps(DC, VERTRES); //ширина высота экрана bmp.Width:=GetDeviceCaps(DC, HORZRES); bitblt(bmp.Canvas.Handle, 0, 0,bmp.Width,bmp.Height,DC, 0, 0, SRCCOPY); ReleaseDC(0, DC); //освобождаем дескриптор bmp.SaveToStream(Mystream[rt]); //сохр в поток Mystream[rt].Position:=0; Image1.Picture.Bitmap.LoadFromStream(Mystream[rt]); finally Mystream[rt].Clear; bmp.Free; end; end; end.

Отправлен: 10.05.2007, 00:15 Вопрос задал: Мартов С.Е. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Denisss Здравствуйте, Мартов С.Е.! Строчка, где Вы пишете "Тут ошибка", по сути, не нужна вовсе. Вместо rt нужно использовать Tag - Вы в него уже записали нужное Вам значение. И так во всем коде. А вообще, глобальных переменных лучше либо не использовать, либо использовать как можно меньше. Заодно, лучше очищать память не с помощью MyStream:= nil, а с помощью освобождения каждого элемента, входящего в данный массив. Приложение: unit Unit1; //главная форма interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Unit2; type TMystream= array of TMemoryStream; TMyForm2= array of TForm2; TForm1 = class(TForm) Button1: TButton; Timer1: TTimer; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Button1Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); private i: integer; Mystream: TMyStream; MyForm2: TMyForm2; public end; var Form1: TForm1; // ik:integer=0; implementation {$R *.dfm} procedure TForm1.FormClose(Sender: TObject); begin i:= 0; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); var i: Integer; begin for i:= 0 to High(MyStream) do if Assigned(MyStream[i]) then MyStream[i].Free; for i:= 0 to High(MyForm2) do if Assigned(MyForm2[i]) then MyForm2[i].Free; end; procedure TForm1.Button1Click(Sender: TObject); begin SetLength(Mystream, Succ(i)); SetLength(MyForm2, Succ(i)); MyForm2[i]:= TForm2.Create(nil); Mystream[i]:=TMemoryStream.Create; try MyForm2[i].Tag:= i; MyForm2[i].Caption:='Tag: '+IntTostr(i); MyForm2[i].SetStream(Mystream[i]); MyForm2[i].Show; MyForm2[i].Timer1.Enabled:=true; except MyForm2[i].Free; Mystream[i].Free; end; inc(i); end; procedure TForm1.Timer1Timer(Sender: TObject); begin Timer1.Enabled:=false; ShowMessage('Form: '+ IntToStr(Timer1.Tag)); end; end. ----------------------------------------------------------------------- unit Unit2; //динамически создаваемая interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm2 = class(TForm) Timer1: TTimer; Image1: TImage; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Timer1Timer(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } fStream: TStream; public { Public declarations } procedure SetStream(aStream: TStream); end; var Form2: TForm2; implementation uses unit1; {$R *.dfm} procedure TForm2.SetStream(aStream: TStream); begin fStream:= aStream; end; procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction); begin Form1.Timer1.Tag:= Tag; Timer1.Enabled:=false; Form1.Timer1.Enabled:=true; end; procedure TForm2.Timer1Timer(Sender: TObject); var bmp: TBitmap; DC: HDC; begin bmp:=TBitmap.Create; try DC:=GetDC(0); //дескpиптоp экpана + копируем экран bmp.Height:=GetDeviceCaps(DC, VERTRES); //ширина высота экрана bmp.Width:=GetDeviceCaps(DC, HORZRES); bitblt(bmp.Canvas.Handle, 0, 0,bmp.Width,bmp.Height,DC, 0, 0, SRCCOPY); ReleaseDC(0, DC); //освобождаем дескриптор bmp.SaveToStream(fStream); //сохр в поток fStream.Position:=0; Image1.Picture.Bitmap.LoadFromStream(fStream); finally fStream.Clear; bmp.Free; end; end; end.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ICQ: 281599577 ---- Ответ отправлен: 10.05.2007, 01:01 Оценка за ответ: 5 Комментарий оценки: Есть небольшие неточности. Но всё легко исправить.

Вопрос № 86.195

Доброго времени суток, Уважаемые эксперты. а) есть Image1 (TImage) б) реализуем два обработчика события Image1Click и Image1DblClick для него. Думаю вы уже догадываетесь в чем проблема: если реализован только один из этих обработчиков, то он работает, а если оба одновременно, то выполняется только Image1Click (т.к. по сути Image1DblClick - это два события Image1Click). Каким образом можно "разделить" эти методы? Спасибо. type TForm1 = class(TForm) Image1: TImage; ... procedure TForm1.Image1Click(Sender: TObject); begin ShowMessage('click'); end; procedure TForm1.Image1DblClick(Sender: TObject); begin ShowMessage('dblclick'); end;

Отправлен: 10.05.2007, 00:50 Вопрос задал: Ренат Байрамгулов (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Denisss Здравствуйте, Ренат Байрамгулов! Как вариант, можно использовать таймер для отлова двойного нажатия (см. пример в приложении). Для того, чтобы код заработал, достаточно на форму разместить таймер TTimer со вкладки "System". Удачи! Приложение: type TForm1 = class(TForm) Image1: TImage; Timer1: TTimer; ... procedure FormCreate(Sender: TObject); procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Timer1Timer(Sender: TObject); ... // Form1.OnCreate procedure TForm1.FormCreate(Sender: TObject); begin // Таймер должен быть отключен // В принципе, данная строчка лишняя, // если вручную установить // Timer.Enabled = False // в инспекторе свойств Timer2.Enabled:= False; // Устанавливаем интервал // таймера, равный системному // интервалу для двойного клика Timer2.Interval:= GetDoubleClickTime; end; // Image1.OnMouseUp procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // Если нажата не левая кнопка, // то выходим if not (Button = mbLeft) then Exit; with TImage(Sender) do // Если кнопка мыши отжата вне Image, // то нужно уходить if not ((X < Width) and (Y < Height)) and ((X >= 0) and (Y >= 0)) then Exit; // Изменяем состояние таймера Timer1.Enabled:= not Timer1.Enabled; // Если таймер отключен, значит нажатие // произошло дважды if not Timer1.Enabled then ShowMessage('dblclick'); end; // Timer1.OnTimer procedure TForm1.Timer1Timer(Sender: TObject); begin // Сначала отключаем таймер Timer1.Enabled:= False; // Потом выдаем сообщение, что // была нажата кнопка ShowMessage('click'); end; ... end.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ICQ: 281599577 ---- Ответ отправлен: 10.05.2007, 02:00 Оценка за ответ: 5 Комментарий оценки: То что надо!

Отвечает: Gh0stik Здравствуйте, Ренат Байрамгулов! Предложу Вам просто немного "подождать" и посмотреть если было событие DblClick - то выполнять его, а если нет то продолжаем выполнять OneClick. Вот код соответствующих прощедур: procedure TForm1.Image3Click(Sender: TObject); var ms:TMsg; tm:Cardinal; begin tm:=GetTickCount+GetDoubleClickTime; {вычисляем время для второго клика} repeat if PeekMessage(ms,0,WM_LBUTTONDBLCLK,WM_LBUTTONDBLCLK,PM_NOREMOVE) then begin Image3DblClick(Sender);exit;end; {если все-таки нажали дважды то передаем обработку на двойное нажатие и по возвращению сразу обрываем работу одиночного клика} until GetTickCount > tm; {если не уложились во время значит нажатие был "одиночным"} ShowMessage('One clicked!!!!!!'); end; procedure TForm1.Image3DblClick(Sender: TObject); begin ShowMessage('Double clicked!!!!!!'); end; Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессионал) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 10.05.2007, 03:03 Оценка за ответ: 5 Комментарий оценки: Спасибо. Потрясающе простой код!

Отвечает: Werewolf Здравствуйте, Ренат Байрамгулов! Дело в том, что события OnClick и OnDoubleClick вызываются при получении наследниками TControl сообщений WM_LBUTTONUP и WM_LBUTTONDBLCLK cоответственно при чем сообщение WM_LBUTTONUP посылается при каждом отпускании левой кнопки мыши а сообщение WM_LBUTTONDBLCLK посылается если интервал времени между предыдущим и последним отпусканием мыши меньше или равен параметру, который можно задать в настройках мыши в панели управления. при одном нажатии ваша форма получит сообщение WM_LBUTTONUP при двойном нажатии ваша форма получит сообщения в следующем порядке WM_LBUTTONUP WM_LBUTTONDBLCLK WM_LBUTTONUP если в вашем обработчике нет показа модального окна иначе ваше форма просто не получит сообщение второго нажатия, т.к. после первого нажатия откроется другое окно в данном случае проще убрать обработку OnClick добавить к рисунку PopupMenu в него добавить все необходимые действия написать обработчик OnDblClick Удачи. =)

Ответ отправил: Werewolf (статус: Студент) Ответ отправлен: 10.05.2007, 12:06

© 2001-2007, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Email: support@rusfaq.ru, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.52 от 02.05.2007