Новичок
Профиль
Группа: Участник
Сообщений: 42
Регистрация: 3.5.2008
Репутация: нет
Всего: нет
|
| Код |
function XXX_MessageDlgPosHelp(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; var X, Y: Integer;
const HelpFileName: string): Integer;
begin
with CreateMessageDialog(Msg, DlgType, Buttons, nil, False, '', nil, nil, '') do
try
HelpContext := HelpCtx;
HelpFile := HelpFileName;
if X >= 0 then Left := X;
if Y >= 0 then Top := Y;
if (Y < 0) and (X < 0) then Position := poScreenCenter;
Result := ShowModal;
X := Left;
Y := Top;
finally
Free;
end;
end;
|
| Код |
function CreateMessageDialog(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; ListItems: TStrings; BoolParam: Boolean;
BoolCaption: string; ShowEvent: TExMessageDlgShowEvent;
IniFile: TXXX_IniFile; Section: string; MinWidth: Integer = 200;
MinHeight: Integer = 75): TForm;
const
mcHorzMargin = 8;
mcVertMargin = 6;
mcHorzSpacing = 10;
mcVertSpacing = 10;
mcButtonWidth = 60;
mcButtonHeight = 14;
mcButtonSpacing = 10;
var
DialogUnits: TPoint;
HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth,
ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,
IconTextWidth, IconTextHeight, X, ALeft, I, K, L, CheckHeight: Integer;
B, DefaultButton, CancelButton: TMsgDlgBtn;
IconID: PChar;
TextRect, R: TRect;
S: string;
begin
Result := TMessageForm.CreateNew(Application);
with Result as TMessageForm do
begin
FShowEvent := ShowEvent;
if Assigned(IniFile) and (Section <> '') then
PosRestorerNeeded(IniFile, Section)
else
if (Section <> '') and Assigned(Application.MainForm) then
with Application.MainForm do
for I := 0 to ComponentCount - 1 do
if Components[I] is TXXX_IniFile then
begin
PosRestorerNeeded(TXXX_IniFile(Components[I]), Section);
Break;
end;
if Assigned(ListItems) then
begin
BorderStyle := bsSizeable;
BorderIcons := [biSystemMenu];
if Assigned(FPosRestorer) then
FPosRestorer.RestoreSet := [riLeft, riTop, riWidth, riHeight];
end
else
BorderStyle := bsDialog;
BiDiMode := Application.BiDiMode;
Canvas.Font := Font;
DialogUnits := GetAveCharSize(Canvas);
HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);
VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);
I := 0;
for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
begin
if B in Buttons then
begin
if ButtonWidths[B] = 0 then
begin
TextRect := Rect(0,0,0,0);
case B of
mbYes: S := btncaption_yes;
mbNo: S := btncaption_no;
mbOK: S := btncaption_ok;
mbContinue: S := btncaption_continue;
mbAbort: S := btncaption_abort;
mbRetry: S := btncaption_retry;
mbIgnore: S := btncaption_ignore;
mbAll: S := btncaption_all;
mbNoToAll: S := btncaption_notoall;
mbYesToAll: S := btncaption_yestoall;
mbCancel: S := btncaption_cancel;
mbHelp: S := btncaption_help;
else S := '';
end;
Windows.DrawText( canvas.handle,
PChar(S), -1,
TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
DrawTextBiDiModeFlagsReadingOnly);
with TextRect do ButtonWidths[B] := Right - Left + 8;
end;
if ButtonWidths[B] > ButtonWidth then
ButtonWidth := ButtonWidths[B];
Inc(I);
end;
end;
ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8) * Integer(I > 0);
ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
DrawText(Canvas.Handle, PChar(Msg), Length(Msg), TextRect,
DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
DrawTextBiDiModeFlagsReadingOnly);
if BoolCaption <> '' then
begin
SetRect(R, 0, 0, Screen.Width div 2, 0);
DrawText(Canvas.Handle, PChar(BoolCaption), Length(BoolCaption), R,
DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
DrawTextBiDiModeFlagsReadingOnly);
if R.Right - R.Left > TextRect.Right - TextRect.Left then
TextRect.Right := TextRect.Left + R.Right - R.Left;
CheckHeight := R.Bottom - R.Top;
end
else
CheckHeight := 0;
IconID := IconIDs[DlgType];
IconTextWidth := TextRect.Right;
IconTextHeight := TextRect.Bottom;
if Assigned(IconID) then
begin
Inc(IconTextWidth, 32 + HorzSpacing);
if IconTextHeight < 32 then IconTextHeight := 32;
end;
ButtonCount := 0;
for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
if B in Buttons then Inc(ButtonCount);
ButtonGroupWidth := 0;
if ButtonCount <> 0 then
ButtonGroupWidth := ButtonWidth * ButtonCount +
ButtonSpacing * (ButtonCount - 1);
ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin * 2;
ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +
VertMargin * 2;
Left := (Screen.Width div 2) - (Width div 2);
Top := (Screen.Height div 2) - (Height div 2);
case DlgType of
mtWarning: Caption := caption_warning;
mtError: Caption := caption_error;
mtInformation: Caption := caption_information;
mtConfirmation: Caption := caption_confirm;
mtCustom: Caption := caption_other;
else Caption := '';
end;
if Caption = '' then
Caption := Application.Title;
if Assigned(IconID) then
with TImage.Create(Result) do
begin
Name := 'Image';
Parent := Result;
Picture.Icon.Handle := LoadIcon(0, IconID);
SetBounds(HorzMargin, VertMargin, 32, 32);
end;
with TXXX_Label.Create(Result) do
begin
Name := 'Message';
Parent := Result;
WordWrap := True;
Caption := Msg;
BoundsRect := TextRect;
BiDiMode := Result.BiDiMode;
ALeft := IconTextWidth - TextRect.Right + HorzMargin;
if UseRightToLeftAlignment then
ALeft := Result.ClientWidth - ALeft - Width;
SetBounds(ALeft, VertMargin,
TextRect.Right, TextRect.Bottom);
end;
if mbOk in Buttons then DefaultButton := mbOk else
if mbYes in Buttons then DefaultButton := mbYes else
DefaultButton := mbRetry;
if mbCancel in Buttons then CancelButton := mbCancel else
if mbNo in Buttons then CancelButton := mbNo else
CancelButton := mbOk;
X := (ClientWidth - ButtonGroupWidth) div 2;
for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
if B in Buttons then
with TXXX_Button.Create(Result) do
begin
Name := ButtonNames[B];
Parent := Result;
case B of
mbYes: S := btncaption_yes;
mbNo: S := btncaption_no;
mbOK: S := btncaption_ok;
mbContinue: S := btncaption_continue;
mbAbort: S := btncaption_abort;
mbRetry: S := btncaption_retry;
mbIgnore: S := btncaption_ignore;
mbAll: S := btncaption_all;
mbNoToAll: S := btncaption_notoall;
mbYesToAll: S := btncaption_yestoall;
mbCancel: S := btncaption_cancel;
mbHelp: S := btncaption_help;
else S := '';
end;
Caption := S;
ModalResult := ModalResults[B];
if B = DefaultButton then Default := True;
if B = CancelButton then Cancel := True;
SetBounds(X, IconTextHeight + VertMargin + VertSpacing,
ButtonWidth, ButtonHeight);
Inc(X, ButtonWidth + ButtonSpacing);
if B = mbHelp then
OnClick := TMessageForm(Result).HelpButtonClick;
end;
if Assigned(ListItems) then
begin
ListBoxNeeded(ListItems);
R.Top := IconTextHeight + VertMargin + VertSpacing;
R.Left := HorzMargin;
I := Max(ClientWidth, HorzMargin * 2 + MinWidth);
R.Right := (I - 2 * HorzMargin);
K := (I - ClientWidth) div 2;
ClientWidth := I;
R.Bottom := Max(50, MinHeight);
L := R.Bottom + VertMargin;
ClientHeight := ClientHeight + L;
Result.Constraints.MinHeight := Height;
Result.Constraints.MinWidth := Width;
for X := 0 to ControlCount - 1 do
if Controls[X] is TXXX_Button then
with Controls[X] do
begin
Top := Top + L;
Left := Left + K;
end;
with R do
FListBox.SetBounds(Left, Top, Right, Bottom);
end;
if BoolCaption <> '' then
begin
CheckBoxNeeded(BoolCaption, BoolParam);
I := -1;
FCheckBox.Height := Max(FCheckBox.Height, CheckHeight);
L := mcVertMargin + FCheckBox.Height;
for X := 0 to ControlCount - 1 do
if Controls[X] is TXXX_Button then
with Controls[X] do
begin
I := Top;
Top := Top + L;
end;
if I < 0 then
I := ClientHeight;
ClientHeight := ClientHeight + L;
FCheckBox.SetBounds(mcHorzMargin, I, ClientWidth - 2 * mcHorzMargin,
FCheckBox.Height);
FCheckBoxY := mcVertMargin;
end;
if Assigned(FListBox) then
LockListBoxBounds;
end;
end;
|
|
Модальное окно оказывается позади, Delphi 7 
Загрузка ...
Дата 29.8.2013, 05:50 (
