diff --git a/examples/testallform.pp b/examples/testallform.pp index 2a82476f4e..4a05571f61 100644 --- a/examples/testallform.pp +++ b/examples/testallform.pp @@ -81,10 +81,14 @@ type procedure ConnectStandardEvents(AControl: TControl); function VkToString(Key: Word): String; procedure CreateMainMenu; + // Components tests procedure TestArrow; procedure TestBitBtn; + // Dialog tests + procedure TestMsgDlg; + public { public declarations } end; @@ -138,8 +142,26 @@ begin end; procedure TForm1.DlgMenuClick(Sender: TObject); +var + mi: TMenuItem; + tg: PtrInt; + TagValid: Boolean; begin - + debugln('TForm1.DlgMenuClick A'); + mi := Sender as TMenuItem; + tg := mi.Tag and not tagDlgStart; + TagValid := ((mi.Tag and tagDlgStart) = tagDlgStart) and + (tg >= Ord(Low(taComponents))) and + (tg <= Ord(High(taComponents))); + if not TagValid then + begin + DebugLn(['TForm1.DlgMenuClick: Unexpected Tag from TMenuItem: [',mi.Name,']']); + Exit; + end; + case taDialogs(tg) of + tadTMessageDialog: TestMsgDlg; + end; + debugln('TForm1.DlgMenuClick End'); end; procedure TForm1.GenClick(Sender: TObject); diff --git a/examples/testallform_include.inc b/examples/testallform_include.inc index fe53da275c..8ed258fee4 100644 --- a/examples/testallform_include.inc +++ b/examples/testallform_include.inc @@ -178,7 +178,7 @@ const False, //tadTcolordialog, False, //tadTfinddialog, False, //tadTfontdialog, - False, //tadTMessageDialog, + True, //tadTMessageDialog, False, //tadTopendialog, False, //tadTopenpicturedialog, False, //tadTreplacedialog, diff --git a/examples/testtools.inc b/examples/testtools.inc index a5ef1a24a5..700e1fca26 100644 --- a/examples/testtools.inc +++ b/examples/testtools.inc @@ -141,3 +141,86 @@ begin end; +type + { TMsgDlgDummmy } + TMsgDlgDummmy = class + ed: TEdit; + cg: TCheckGroup; + rg: TRadioGroup; + btn: TButton; + procedure OnBtnClick(Sender: TObject); + end; +{ TMsgDlgDummmy } +procedure TMsgDlgDummmy.OnBtnClick(Sender: TObject); +var + DT: TMsgDlgType; + Btns: TMsgDlgButtons; + i: Integer; + aMsg: TCaption; +begin + DT := TMsgDlgType(rg.ItemIndex); + aMsg := ed.Text; + if (aMsg = '') + then aMsg := 'You did not enter a message'; + Btns := []; + for i := 0 to cg.Items.Count - 1 do + begin + if cg.Checked[i] then + Btns := Btns + [TMsgDlgBtn(i)]; + end; + if (Btns = []) then + Btns := [mbOk]; + MessageDlg('MessageDlg test', aMsg, DT, Btns, 0); +end; + +procedure TForm1.TestMsgDlg; +var + ed: TEdit; + cg: TCheckGroup; + rg: TRadioGroup; + dummy: TMsgDlgDummmy; + btn: TButton; +begin + Clear; + ed := TEdit.Create(nil); + cg := TCheckGroup.Create(nil); + rg := TRadioGroup.Create(nil); + btn := TButton.Create(nil); + dummy := TMsgDlgDummmy.Create; + FObjList.Add(ed); + FObjList.Add(cg); + FObjList.Add(rg); + FObjList.Add(btn); + FObjList.Add(dummy); + dummy.ed := ed; + dummy.cg := cg; + dummy.rg := rg; + btn.OnClick := @dummy.OnBtnClick; + ed.TextHint := 'Type your message here'; + ed.Parent := TestPnl; + cg.Items.AddStrings(['mbYes', 'mbNo', 'mbOK', 'mbCancel', 'mbAbort', 'mbRetry', 'mbIgnore', + 'mbAll', 'mbNoToAll', 'mbYesToAll', 'mbHelp', 'mbClose']); + cg.Caption := 'Buttons'; + cg.AutoSize := True; + rg.Items.AddStrings(['mtWarning', 'mtError', 'mtInformation', 'mtConfirmation', + 'mtCustom']); + cg.Parent := TestPnl; + rg.Caption := 'DialogType'; + rg.AutoSize := True; + rg.ItemIndex := Ord(mtInformation); + ed.Left := 5; + ed.Top := 10; + ed.Width := TestPnl.Width - 2*5; + cg.Left := 5; + cg.Top := ed.Top + ed.Height + 10; + rg.Left := cg.Left + cg.Width + 20; + rg.Top := cg.Top; + rg.Parent := TestPnl; + btn.Caption := 'Show dialog'; + btn.AutoSize := True; + btn.Top := rg.Top + rg.Height + 20; + btn.Left := rg.Left; + btn.Parent := TestPnl; +end; + +