Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник
Коллекция курьезных вопросов из форумов
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

Painbox,RadioGroup вопросы [Delphi, Windows]


RusSun ©   (04.05.11 20:47

Доброе время суток. Уважаемые форумчане вот несколько вопросов.
Чтобы не создавать несколько отдельных тем по графике ( рисованию и выводу изображении).
Delphi 7, Win XP.

1 Из ресурса проекта вывожу на PaintBox jpeg изображения.
procedure clickbutton(dummy:pointer;Sender:PControl; var mouse:TMouseEventData);
var ResStream: pstream;
begin
if pb<>nil then pb.Free;                    
ResStream:= NewMemoryStream;
resource2stream(ResStream,Hinstance,'1F','RCD');
ResStream.Position := 0;
jpg:=NewJpeg;
jpg.Loadfromstream(ResStream);//загружаем  if PB = nil then begin

PB := NewPaintBox(form);
PB.OnPaint := TOnPaint( MakeMethod( nil, @DrawPaint ) );

PB.Width := jpg.Width-2;
PB.Height:= jpg.Height-2;
PB.SetPosition(56,34);
PB.Show;//должен быть показан
ResStream.Free;

end;

Вопрос можно ли выводить изображение не уничтожая каждый раз Paintbox? просто перерисовывая область?

2 В проекте мне нужно рисовать платоново тело (тетраэдр,гексаэдр и тд до Додекаэдр)
рисую в Painbox'се мне надо подцепить события мыши чтобы делать вращение, но возникает ошибка  216 целый ворох.

Как правильно прикреплять события мыши к Painbox'су чтобы работало?

procedure FormMouseMove(Dummy: Pointer;Sender:pControl;  var Mouse: TMouseEventData;X,Y: Integer);
var a, b: real;
begin
 if drawing then begin
   a:=x-form.Width div 2; b:=y-form.Height div 2;
//|---------------------------------------------------|
//|Здесь тоже пришлось сделать checked хотя это не    |
//|правильно. Но другого варианта я пока не придумал  |
//|Раньше в этом месте был Case **index of            |
//|---------------------------------------------------|
   if RadioBox8.Checked then begin
          Alf:=ArcTan2(b,a);
          Bet:=Sqrt(Sqr(a/10)+Sqr(b/10));
        end;
   if RadioBox9.Checked then begin
          Alf1:=ArcTan2(b,a);
          Bet1:=Sqrt(Sqr(a/10)+Sqr(b/10));
        end;
   end;
   Draw(sender);
   DrawPaint(nil, Sender, PB.Canvas.Handle);
end;
//|-----------------------------------------------------|
//|FormMouseDown - не работает. Пытаюсь прикрутить к    |
//|PB'су тогда получаю E 216.                                     |
//|-----------------------------------------------------|
procedure FormMouseDown(Dummy: Pointer;Sender:pControl;var Mouse: TMouseEventData);
begin
 Drawing:=True;
end;
//|-----------------------------------------------------------|
//|FormMouseUp - не работает. Пытаюсь прикрутить к            |
//|PaintBox'су тогда получаю E 216.                                     |
//|-----------------------------------------------------------|
procedure FormMouseUp(Dummy: Pointer;Sender:pControl; var Mouse: TMouseEventData);
begin
 Drawing:=false;
end;

Если нужно могу кинуть код целиком.

3 Надо было сделать RadioGroup посмотрел статьи и сделал так:

RgBody:=NewGroupBox(form2, 'Плат-овы тела' ).SetPosition(2,3).SetSize(105,124);

   RadioBox1 := NewRadioBox( RgBody, 'Тетраэдр' ).SetPosition( 2, 16 ).SetSize( 85, 20 );
   RadioBox1.Tag:=1;
   RadioBox2 := NewRadioBox( RgBody, 'Гексаэдр' ).SetPosition( 2, 36 ).SetSize( 85, 20 );
   RadioBox2.Tag:=2;
   RadioBox3 := NewRadioBox( RgBody, 'Октаэдр' ).SetPosition( 2, 56 ).SetSize( 85, 20 );
   RadioBox3.Tag:=3;
   RadioBox4 := NewRadioBox( RgBody, 'Икосаэдр').SetPosition( 2, 76 ).SetSize( 85, 20 );
   RadioBox4.Tag:=4;
   RadioBox5 := NewRadioBox( RgBody, 'Додэкаэдр').SetPosition(2, 96 ).SetSize( 96, 20 );
   RadioBox5.Tag:=5;


//|----------------------------------------------------|
//|RadiogrClick это процедура прикручена к RadioBox'сам|
//|таким образом как это было в статье на форуме.      |
//|Через свойство tag. Замечание: правда с другими     |
//|двумя GroupBox'сами такой фокус не прошел:(         |
//|----------------------------------------------------|
procedure RadiogrClick(Dummy: Pointer;Sender:pControl);
begin
case sender.Tag of
  1: Body:=Tetraedr(SizeBody);
  2: Body:=Hexaedr(SizeBody);
  3: Body:=Octaedr(SizeBody);
  4: Body:=Icosahedron(SizeBody);
  5: Body:=Dodecahedron(SizeBody);
end;{case}
Draw(sender);
DrawPaint(nil, Sender, PB.Canvas.Handle);
end;

Вопрос: Каким образом вызвать RadiogrClick() из другой процедуры (может есть другой вариант обработки RadioBox'сов)?


Jon ©   (04.05.11 23:54[1]


> 1 Из ресурса проекта вывожу на PaintBox jpeg изображения.



program Test;

{$R *.res}

uses
 Windows, Messages, KOL, JPegObj;

var
 PB: PControl;
 JPG: PJpeg;

procedure DoPaint(Dummy: Pointer; Sender: PControl; DC: HDC);
begin
 JPG.StretchDraw(Sender.Canvas.Handle, Sender.ClientRect);
end;

procedure btn1Click(Dummy: Pointer; Sender: PObj);
var
 ResStream: PStream;
begin
 ResStream := NewMemoryStream;
 Resource2Stream(ResStream, Hinstance, 'Z1', RT_RCDATA);
 ResStream.Position := 0;
 JPG.LoadFromStream(ResStream);
 ResStream.Free;
 PB.Invalidate;
end;

begin
 Applet := NewForm(nil, '');
 with NewButton(Applet, 'Load')^ do
   OnClick := TOnEvent(MakeMethod(nil, @btn1Click));
 JPG := NewJpeg;
 JPG.Bitmap := NewBitmap(1, 1);
 Applet.Add2AutoFree(JPG);
 PB := NewPaintbox(Applet);
 PB.BoundsRect := MakeRect(40, 40, 200, 200);
 PB.OnPaint := TOnPaint(MakeMethod(nil, @DoPaint));
 Run(Applet);
end.


RusSun ©   (05.05.11 21:15[2]

to Jon Thank you, again, help me!

насчет пункта 3 можно сделать так перебрать состояния NewRadioBox на Checked. И снять и поставить флажок. Тогда должно получится:)


RusSun ©   (06.05.11 18:04[3]

3 Точнее

var i:integer;
... for i:=0 to Pred(RgBody.childcount) do
if RgBody.Children[i].checked=true then RgBody.children[i].SetRadioChecked

И будет клик по RadioBox'су ;)


Jon ©   (09.05.11 00:34[4]

Sorry, I do not understand. SetRadioChecked should work:


program Test;

uses KOL;

var rb1, rb2, rb3, rb4: PControl;

procedure RadioClick(Dummy: Pointer; Sender: PObj);
begin
 Applet.Caption := PControl(Sender).Text;
end;

procedure ButtonClick(Dummy: Pointer; Sender: PObj);
begin
 rb1.SetRadioChecked;
end;

begin
 Applet := NewForm(nil, '');
 rb1 := NewRadiobox(Applet, '111');
 rb2 := NewRadiobox(Applet, '222').PlaceDown;
 rb3 := NewRadiobox(Applet, '333').PlaceDown;
 rb4 := NewRadiobox(Applet, '444').PlaceDown;
 rb1.Tag := 1;
 rb2.Tag := 2;
 rb3.Tag := 3;
 rb4.Tag := 4;
 rb1.OnClick := TOnEvent(MakeMethod(nil, @RadioClick));
 rb2.OnClick := TOnEvent(MakeMethod(nil, @RadioClick));
 rb3.OnClick := TOnEvent(MakeMethod(nil, @RadioClick));
 rb4.OnClick := TOnEvent(MakeMethod(nil, @RadioClick));
 with NewButton(Applet, '111').PlaceDown^ do
   OnClick := TOnEvent(MakeMethod(nil, @ButtonClick));
 rb3.SetRadioChecked;
 Run(Applet);
end.


RusSun ©   (09.05.11 07:29[5]

to Jon. Когда запускаешь твой пример то нет черных кружков :)
нужно добавить

...
OnClick := TOnEvent(MakeMethod(nil, @ButtonClick));
rb3.GetWindowHandle;
rb3.SetRadioChecked;
...


И небольшой пример он все объясняет.
program Project1;

uses
 kol;

var
form,RgBody,
RadioBox1,RadioBox2,RadioBox3,
RadioBox4,RadioBox5,
Button:PControl;

//область для процедур
procedure RadiogrClick(Dummy: Pointer;Sender:pControl);
begin
case sender.Tag of
  1: showmessage('Tetrahedron');
  2: showmessage('Hexahedron');
  3: showmessage('Octahedron');
  4: showmessage('Icosahedron');
  5: showmessage('Dodecahedron');
end;{case}
end;

procedure clickbutton(dummy:pointer;Sender:PControl; var mouse:TMouseEventData);
var i:integer;
begin
for i:=0 to Pred(RgBody.childcount) do
if RgBody.Children[i].checked=true then RgBody.children[i].SetRadioChecked
end;
Begin
form:=NewForm(Applet,'Radiogroup').SetSize(300,200).setposition(330,300);
RgBody:=NewGroupBox(form, 'Platonov tela' ).SetPosition(2,3).SetSize(105,124);

   RadioBox1 := NewRadioBox( RgBody, 'Tetrahedron' ).SetPosition( 2, 16 ).SetSize( 90, 20 ); //.SetAlign(caTop)
   RadioBox1.Tag:=1;
   RadioBox2 := NewRadioBox( RgBody, 'Hexahedron' ).SetPosition( 2, 36 ).SetSize( 90, 20 );
   RadioBox2.Tag:=2;
   RadioBox3 := NewRadioBox( RgBody, 'Octahedron' ).SetPosition( 2, 56 ).SetSize( 90, 20 );
   RadioBox3.Tag:=3;
   RadioBox4 := NewRadioBox( RgBody, 'Icosahedron').SetPosition( 2, 76 ).SetSize( 90, 20 );
   RadioBox4.Tag:=4;
   RadioBox5 := NewRadioBox( RgBody, 'Dodecahedron').SetPosition( 2, 96 ).SetSize( 96, 20 );
   RadioBox5.Tag:=5;

RadioBox3.GetWindowHandle;
RadioBox3.SetRadioChecked;

//область для работы
Button:=NewButton(form,'Click').SetPosition(158,143 ).SetSize(80,25);
 (*RgBodyClick*)
RadioBox1.OnClick := TOnEvent(MakeMethod(nil, @RadiogrClick));
RadioBox2.OnClick := TOnEvent(MakeMethod(nil, @RadiogrClick));
RadioBox3.OnClick := TOnEvent(MakeMethod(nil, @RadiogrClick));
RadioBox4.OnClick := TOnEvent(MakeMethod(nil, @RadiogrClick));
RadioBox5.OnClick := TOnEvent(MakeMethod(nil, @RadiogrClick));

Button.OnClick:=TonEvent(MakeMethod(nil,@clickbutton));

Run(form);
end.



Если нужно могу послать на мыло.


Jon ©   (11.05.11 02:52[6]


> to Jon. Когда запускаешь твой пример то нет черных кружков
> :)
> нужно добавить
>
> ...
> OnClick := TOnEvent(MakeMethod(nil, @ButtonClick));
> rb3.GetWindowHandle;
> rb3.SetRadioChecked;
> ...


That is strange - it works correctly for me. Radio marks are shown.
I am using Delphi 7 with KOL v3.14159265358979 on Windows XP.

I still do not understand the problem. Maybe this is what you need:


program Test;

uses KOL;

var
 Form, RgBody, RadioBox1, RadioBox2, RadioBox3, RadioBox4, RadioBox5, Button: PControl;

procedure RadioAction(Sender: PControl);
begin
 case Sender.Tag of
   1: ShowMessage('Tetrahedron');
   2: ShowMessage('Hexahedron');
   3: ShowMessage('Octahedron');
   4: ShowMessage('Icosahedron');
   5: ShowMessage('Dodecahedron');
 end;
end;

procedure ClickButton(Dummy: Pointer; Sender: PControl; var Mouse: TMouseEventData);
var
 i: Integer;
begin
 for i := 0 to Pred(RgBody.ChildCount) do
   if RgBody.Children[i].Checked = True then
     RadioAction(RgBody.Children[i]);
end;

begin
 Form := NewForm(Applet, 'Radiogroup').SetSize(300, 200).SetPosition(330, 300);
 RgBody := NewGroupBox(Form, 'Platonov tela').SetPosition(2, 3).SetSize(105, 124);

 RadioBox1 := NewRadioBox(RgBody, 'Tetrahedron').SetPosition(2, 16).SetSize(90, 20);
 RadioBox1.Tag := 1;
 RadioBox2 := NewRadioBox(RgBody, 'Hexahedron').SetPosition(2, 36).SetSize(90, 20);
 RadioBox2.Tag := 2;
 RadioBox3 := NewRadioBox(RgBody, 'Octahedron').SetPosition(2, 56).SetSize(90, 20);
 RadioBox3.Tag := 3;
 RadioBox4 := NewRadioBox(RgBody, 'Icosahedron').SetPosition(2, 76).SetSize(90, 20);
 RadioBox4.Tag := 4;
 RadioBox5 := NewRadioBox(RgBody, 'Dodecahedron').SetPosition(2, 96).SetSize(96, 20);
 RadioBox5.Tag := 5;

//  RadioBox3.GetWindowHandle;
 RadioBox3.SetRadioChecked;

 Button := NewButton(Form, 'Click').SetPosition(158, 143).SetSize(80, 25);
 Button.OnClick := TOnEvent(MakeMethod(nil, @ClickButton));

 Run(Form);
end.


Now just the button performs the event when clicked.
We can discuss this further on email - then post results here.


RusSun ©   (11.05.11 16:34[7]

All true in version 3.5 was 3.14 RadioBox3.GetWindowHandle; not necessary.


RusSun ©   (27.05.11 17:57[8]

Пункт 2 Проблема подключения событий. Решение показал Jon.

procedure FormMouseMove(Dummy: Pointer;Sender:pControl;  var Mouse: TMouseEventData);
var a, b: real;
begin
 if drawing then begin
   a:=Mouse.X-Sender.Width div 2; b:=Mouse.y-Sender.Height div 2;

   case RgRIndex of
   1:begin
          Alf:=ArcTan2(b,a);
          Bet:=Sqrt(Sqr(a/10)+Sqr(b/10));
        end;
   0:begin
          Alf1:=ArcTan2(b,a);
          Bet1:=Sqrt(Sqr(a/10)+Sqr(b/10));
        end;
   end;
   end;//Case
 PB.Invalidate;
end;


RusSun ©   (27.05.11 18:03[9]

Целиком здесь
http://zalil.ru/31135068


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо