Function TForm1.DialogWnd
(strWndTxt, strTxt: String; wndCalcPos: TForm; booOkBtn: Boolean): String;
Const
MyFont = 'Arial';
Var
Wnd: TForm; Memo: TMemo;
btnYes, btnNo, btnCancel: TButton;
iBtnX, iBtnY, iDlgX, iDlgY, iDlgTop, iDlgLeft,
iWorkAreaX, iWorkAreaY, iWALeft, iWATop: Integer;
Begin
Try
Result:= '';
wnd:= TForm.Create(Nil);
Try
wnd.Color := clBtnFace;
wnd.Caption := strWndTxt;
wnd.BorderStyle := bsSizeable;
wnd.DoubleBuffered:= True;
wnd.BorderIcons := [];
iDlgX:= wndCalcPos.Width;
iDlgY:= wndCalcPos.Height;
If iDlgX < 300 Then iDlgX:= 300;
If iDlgY < 200 Then iDlgY:= 200;
If iDlgX >= 800 Then iDlgX:= iDlgX Div 2;
If iDlgY >= 550 Then iDlgY:= iDlgY Div 2;
iDlgLeft:= wndCalcPos.Left+((wndCalcPos.Width -iDlgX) Div 2);
iDlgTop := wndCalcPos.Top +((wndCalcPos.Height-iDlgY) Div 2);
iWorkAreaX:= Screen.WorkAreaWidth;
iWorkAreaY:= Screen.WorkAreaHeight;
iWALeft := Screen.WorkAreaLeft;
iWATop := Screen.WorkAreaTop;
If iDlgLeft < iWALeft Then iDlgLeft:= iWALeft+40;
If iDlgTop < iWATop Then iDlgTop := iWATop +40;
If iDlgTop > (iWorkAreaY-iDlgY)
Then iDlgTop:= (iWorkAreaY-iDlgY-40);
If iDlgLeft > (iWorkAreaX-iDlgX)
Then iDlgLeft:= (iWorkAreaX-iDlgX-40);
wnd.SetBounds(iDlgLeft, iDlgTop, iDlgX, iDlgY);
wnd.Constraints.MinHeight:= wnd.Height;
wnd.Constraints.MaxHeight:= wnd.Height;
wnd.Constraints.MinWidth := wnd.Width;
wnd.Constraints.MaxWidth := wnd.Width;
btnYes := TButton.Create(wnd);
btnYes.Caption := 'YES';
btnYes.Font.Name := MyFont;
btnYes.Font.Quality := fqAntialiased;
btnYes.Font.Style := [fsBold];
btnYes.DoubleBuffered:= True;
btnYes.ModalResult := mrYes;
btnYes.Parent := wnd;
btnNo := TButton.Create(wnd);
btnNo.Caption := 'NO';
btnNo.Font.Name := MyFont;
btnNo.Font.Quality := fqAntialiased;
btnNo.Font.Style := [fsBold];
btnNo.DoubleBuffered:= True;
btnNo.ModalResult := mrNo;
btnNo.Parent := wnd;
btnCancel := TButton.Create(wnd);
btnCancel.Caption := 'CANCEL';
btnCancel.Font.Name := MyFont;
btnCancel.Font.Quality := fqAntialiased;
btnCancel.Font.Style := [fsBold];
btnCancel.DoubleBuffered:= True;
btnCancel.ModalResult := mrCancel;
btnCancel.Parent := wnd;
iBtnX:= (wnd.ClientWidth-20) Div 3;
iBtnY:= iBtnX Div 5;
btnYes.SetBounds(5, wnd.ClientHeight-iBtnY, iBtnX, iBtnY);
btnNo.SetBounds((wnd.ClientWidth-iBtnX) Div 2, btnYes.Top, iBtnX, iBtnY);
btnCancel.SetBounds(wnd.ClientWidth-iBtnX-5, btnYes.Top, iBtnX, iBtnY);
Canvas.Font.Size := 1;
Canvas.Font.Name := MyFont;
Canvas.Font.Style := btnCancel.Font.Style;
Canvas.Font.Quality:= fqAntialiased;
While Not (Canvas.TextWidth('CANCEL') > iBtnX-20)
Do Canvas.Font.Size:= Canvas.Font.Size+1;
While (Canvas.TextHeight('CANCEL') > btnCancel.ClientHeight)
Do Canvas.Font.Size:= Canvas.Font.Size-1;
btnYes.Font.Size := Canvas.Font.Size;
btnNo.Font.Size := btnYes.Font.Size;
btnCancel.Font.Size:= btnYes.Font.Size;
Memo := TMemo.Create(wnd);
Memo.Font.Name := MyFont;
Memo.Font.Size := wnd.ClientWidth Div 20;
Memo.Font.Style := [fsBold];
Memo.Font.Quality := fqAntialiased;
Memo.Font.Color := clBtnText;
Memo.Color := clBtnFace;
Memo.Alignment := taCenter;
Memo.BorderStyle := bsNone;
Memo.HideSelection := True;
Memo.Text := strTxt;
Memo.ReadOnly := True;
Memo.WordWrap := True;
Memo.WantTabs := False;
Memo.DoubleBuffered:= True;
Memo.WantReturns := False;
Memo.ScrollBars := ssAutoVertical;
Memo.SetBounds (0, 0, wnd.ClientWidth, wnd.ClientHeight-iBtnY-10);
Memo.Parent := wnd;
If booOkBtn
Then
Begin
btnYes.Hide;
btnCancel.Hide;
btnNo.Caption:= 'OK';
wnd.ActiveControl:= btnNo;
End
Else wnd.ActiveControl:= btnYes;
wnd.ShowModal;
Case wnd.ModalResult
Of
mrYes : Result:= 'YES';
mrNo : Result:= 'NO';
mrCancel: Result:= 'CANCEL';
End;
Finally
wnd.Release;
wnd:= Nil;
End;
Except
End;
End;