Диалог с произвольными кнопками

← →
RealRascal © (2004-06-21 16:51) [0]

Бывает, что кнопок Yes No Cancel не хватает.
А новую форму в проект добавлять не хочется...
Тогда Вам помогут следующие 150 строк.
Просто добавьте их в юнит, а юнит подключите к проекту.
Откомпилировано и проверено в Д5.
Пример применения:
procedure TForm1.Button1Click(Sender: TObject);
begin
ED_Btn("Please Pick Some One",
"This is a sample prompt, that will be centered and word-wrapped automatically",
["First Button",
"Second Button",
"Default Button",
"Caption with"#13"Line Break",
"Button with long long long long long long caption will grow to string width"],3);
end;

← →
RealRascal © (2004-06-21 16:52) [1]

unit ExtraDialogs;
interface
uses
Windows, Classes, Forms, StdCtrls, Buttons;
function ED_Btn(Capt, Prompt: string; const Btns: array of string; DefBtn:
integer): integer; //Extra dialog with buttons
type
TFu = class(TForm)
procedure ExtraRslt(Sender: TObject);
procedure show(Sender: TObject);
end;
var
Fu : TFu;
def : integer;
implementation
procedure TFu.show(Sender: TObject);
var
i : integer;
begin
for i := 1 to (Sender as TFORM).ControlCount - 1 do
with ((Sender as TFORM).controls[i] as TBitbtn) do
if tag = def then SetFocus;
end;
procedure TFu.ExtraRslt(Sender: TObject);
begin
with ((Sender as TBitbtn).Parent as TForm) do
begin
Tag := (Sender as TBitbtn).Tag;
Close;
end;
end;
function ED_Btn(Capt, Prompt: string; const Btns: array of string; DefBtn:
integer): integer;//Extra dialog with buttons
const
DlgMaxW = 480;
var
DBox : TForm;
i,poz,poz1, cheit,cwid: integer;
rect1 : TRect;
begin
poz := 0;
DBox := TForm.Create(nil);
poz1 := 18;
cheit := 0;
cwid := 0;
with DBox do
begin
DBox.OnShow := Fu.show;
for i := 0 to high((Btns)) do
begin
with TBitbtn.Create(DBox) do
begin
tag := i + 1;
Width := 70;
Height := 20;
Rect1 := rect(0, 0, Width, Height);
Height := DrawText(
DBox.Canvas.Handle,
pchar(Btns[i]),
length(Btns[i]),
Rect1,
DT_CENTER +
DT_CALCRECT
);
Width := Rect1.Right;
Width := Width + 12;
Height := Height + 12;
if Width < 75 then Width := 75;
if Height < 23 then Height := 23;
if (poz1 + width + 6) > DlgMaxW then
begin
if (poz1) > cwid then cwid := (poz1);
poz1 := 18;
poz := poz + cheit + 6;
cheit := 0;
end;
if Height > cheit then
cheit := Height;
left := poz1;
top := poz;
Caption := Btns[i];
Parent := Dbox;
poz1 := poz1 + width + 6;
OnClick := Fu.ExtraRslt;
end;
end;
if (poz1) > cwid then cwid := (poz1);
DrawText(
DBox.Canvas.Handle,
pchar(Prompt),
length(Prompt),
Rect1,
DT_CENTER +
DT_CALCRECT
);
if (Rect1.Right > cwid) and (Rect1.Right + 18 < DlgMaxW) then
begin
Width := Rect1.Right + 18;
for i := 0 to ControlCount - 1 do
(controls[i] as TBitBtn).Left := (controls[i] as TBitBtn).Left - 2 +
((ClientWidth - cwid) div 2);
end
else
Width := cwid + 18;
with Tlabel.Create(Dbox) do
begin
Alignment := tacenter;
Layout := tlBottom;
Autosize := False;
Rect1.Right := DBox.ClientWidth;
Height := DrawText(
DBox.Canvas.Handle,
pchar(Prompt),
length(Prompt),
Rect1,
DT_CENTER +
DT_WORDBREAK +
DT_CALCRECT
);
wordwrap := true;
width := Dbox.ClientWidth;
caption := Prompt;
Parent := Dbox;
if Height < 25 then Height := 25;
poz := Height + top + 17;
end;
poz1 := 0;
for i := 0 to ControlCount - 1 do
if (Controls[i] is TBitbtn) then
with Controls[i] do
begin
top := top + poz;
if poz1 < BoundsRect.bottom then poz1 := BoundsRect.bottom;
end;
Height := ClientOrigin.y + poz1 +
17;
BorderIcons := [biSystemMenu];
Caption := Capt;
Position := poDesktopCenter;
Tag := -1;
def := DefBtn;
showmodal;
Result := Tag;
destroy;
end
end;

end.

← →
Игорь Шевченко © (2004-06-21 16:56) [2]

>function ED_Btn

Невнятное название совершенно

← →
Kerk © (2004-06-21 16:56) [3]

Вот если б ты это на АПИ написал, цены бы тебе не было.

← →
RealRascal © (2004-06-21 17:02) [4]

> [2] Игорь Шевченко © (21.06.04 16:56)

Extra dialog with buttons
Если есть предложения получше- милости прошу.

И совсем забыл сказать, все необходимое для написания этого я узнал из статьи "Жизнь и смерть в режиме Run-Time"(кому интересно по поисковику найдет) и из этого форума.

← →
Kerk © (2004-06-21 17:04) [5]

> Extra dialog with buttons
> Если есть предложения получше- милости прошу.

MessageDlgEx ? :)

← →
Nick Denry © (2004-06-21 17:04) [6]

В догонку : пример MessageBox"a со своим значком:

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); var result : LONGBOOL; MSGBIn : TMsgBoxParamsA; res : integer; begin MSGBIn.cbSize := SizeOf(MSGBIn); MSGBIn.hInstance := hInstance; with MSGBIn do begin hwndOwner := Form1.Handle; lpszText := "Do you really want to close application?"; lpszCaption := PChar(Form1.Caption); dwStyle := MB_YESNO or MB_USERICON or MB_APPLMODAL; lpszIcon := MAKEINTRESOURCE(1001); dwContextHelpId := 0; lpfnMsgBoxCallback := nil; end; Res := Integer(MessageBoxIndirectA(MSGBIn)); if res = IDNO then CanClose := FALSE; end;

← →
DiamondShark © (2004-06-21 17:22) [7]

> 150 строк

Не... Я лучше форму добавлю.

← →
Огромное Кулясище (2004-06-21 17:26) [8]

Лучше форму, потому что не хватает чекбокса "Do not show this message next time."

← →
RealRascal © (2004-06-21 17:35) [9]

> [8] Огромное Кулясище (21.06.04 17:26)

А это идея... щас сделаю...
При повторном вызове функции оно сначала будет лезти в реестр, и если такого диалога с такими кнопочками и таким сообщением еще не было, то покажет, иначе возмет в реестре(если, конечно, птичка почекана).
Куда лучше ключик в реестре записать? Понятно, что в Current_User, но куда конкретно? Или свой раздел в реестре создать?

И еще на очереди диалог с радиобатонами вместо кнопок(это раз)
С чекбоксами(это два)
И листбоксами(это три)

Жду дальнейших преложений...

← →
Игорь Шевченко © (2004-06-21 17:39) [10]

> С чекбоксами(это два)
> И листбоксами(это три)
> Жду дальнейших преложений...

Я извиняюсь, а нафига ?

← →
DiamondShark © (2004-06-21 17:41) [11]

> Куда лучше ключик в реестре записать? Понятно, что в Current_User,
> но куда конкретно? Или свой раздел в реестре создать?

А как положено:
HKCU\Software\%CompanyName%\%ProductName%

← →
RealRascal © (2004-06-21 17:45) [12]

> [11] DiamondShark © (21.06.04 17:41)

Универсальность пропадет.
Или надо будет в эту функцию передавать %CompanyName% и %ProductName%.
Я же хочу, чтобы ей можно было пользоваться легко и ненавязчиво: подцепил юнит, и вызывай на здоровье...
Я думал создать раздельчик, и складывать туда всю инфу о вызванных диалогах...

← →
DiamondShark © (2004-06-21 18:24) [13]

> Или надо будет в эту функцию передавать %CompanyName% и
> %ProductName%.

Из version info добывать.
А если нету -- ну тоды ой. Можно и в какой-то фиксированный складывать.

%CompanyName%=RealRascal ©
%ProductName%=ED_Btn
зы - видел компонент добавляет NeverShowAgain к MessageDlg, ShowMessage, ect. - на ВинАПИ! ща поищу.

> [10] Игорь Шевченко © (21.06.04 17:39)

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

> [13] DiamondShark © (21.06.04 18:24)
>
> > Или надо будет в эту функцию передавать %CompanyName%
> и
> > %ProductName%.
>
> Из version info добывать.
> А если нету -- ну тоды ой. Можно и в какой-то фиксированный
> складывать.

VersionInfo? А как его добыть? Есть такие функции чтоли, которые возвращают эти данные? Я в хелпе такого не увидел...
А как хотябы имя экзешника узнать, не объявляя TApplication?
Подумал складывать все в
HKCU\Software\Dialogs\%exename%\
Строковый параметр с названием
%PromptAndButtonsCaptionsCheckSum%
в котором хранится номер кнопки, на которую нажали

>Куда лучше ключик в реестре записать?
В var! А если в реестр, то только с юзерной настройкой.

> Еще
> было бы неплохо сделать окошко(fsStayOnTop) с прогрессбаром,
> чтобы показывать во время исполнения длительных процессов
> (передавать туда ссылки на переменную, которая характеризует
> прогресс, и обновлять окошко по таймеру), и чтоб вызывалось
> одной строкой, и кнопочка "отмена" была...

И придется вызывающей это окошко функции обвязываться нужным интерфейсом, чтобы узнавать, что кнопку "отмена" нажали...А также масса свойств о внешнем виде прогресс-бара, о том, каким образом (по таймеру или из программы) обновлять прогресс...

Я к чему все это говорю - может, не стоит пытаться сделать слишком уж универсальные решения ? Может, лучше несколько решений, ориентированных на более узкий круг задач ?

RealRascal [17]
В implementation. Кстати, у одной проги может быть два раных диалога твоего типа. Значит, они должны сохранятся в разных местах. Делай кастумизируемый CheckBox и возвращай юзеру его состояние.

Диалог с произвольными кнопками Найти похожие ветки