Jak wybrać programowo przycisk TAK w Messagebox

0

Mam taki kod :

 if Application.Messagebox('Jak wybrać programowo przycisk TAK ?','Pytanie ?',Mb_YesNo+Mb_IconInformation)= IDYes then
 Caption := 'TAK' else Caption := 'NIE';

Drugie pytanie komponentu XPManifest jak go programowo wyłączyć. Jest dodany do aplikacji. Wiem, że mógłbym dołączyć go osobno w pliku do aplikacji wówczas gdyby znajdował się obok aplikacji byłby styl XP a gdyby go nie było byłby surowy widok aplikacji. Czy jest możliwość wyłączenia w stylu XPManifes.Active := True. W necie podają jednak dla tego komponentu nie ma Active.

1
  1. Po co chcesz programowo "naciskać przycisk" w MessageBox?
    Jeżeli chcesz aby wywołany MessageBox automatycznie wyłączył się po zadanym czasie użyj MessageBoxTimeOut http://edn.embarcadero.com/print/32736

uses
  UxTheme;

procedure DisableThemesApp;
begin
  SetThemeAppProperties(0);
  SendMessage(Application.Handle,WM_THEMECHANGED,0,0);
  SendMessage(Application.MainForm.Handle,CM_RECREATEWND,0,0);
end;

procedure EnableThemesApp;
begin
  SetThemeAppProperties(STAP_ALLOW_NONCLIENT or STAP_ALLOW_CONTROLS or STAP_ALLOW_WEBCONTENT);
  SendMessage(Application.Handle,WM_THEMECHANGED,0,0);
  SendMessage(Application.MainForm.Handle,CM_RECREATEWND,0,0);
end;
0

Chodzi pewnie o zasymulowanie kliknięcia przycisku;

Z tego co pamiętam były tutaj już wątki na ten temat - pobranie uchwytu do okna MessageBox i obliczenie jego współrzędnych na ekranie, przesunięcie kursora nad przycisk (także po obliczeniach) i kliknięcie; Trzeba tylko poszukać; Chyba że chodzi o inny sposób, ale mało informacji pytacz podał; Równie dobrze można to załatwić symulacją wciśnięcia odpowiednich klawiszy (lub jednego), bo przyciski mają ustawione skróty literowe.

0

W kombinacji Mb_YesNo zawsze No jest domyślne.
Co zrobić? Odwrócić pytanie.

 if Application.Messagebox('Jak wybrać programowo przycisk nie ten z nazwą TAK ?','Pytanie ?',Mb_YesNo+Mb_IconInformation)= IDYes then
 Caption := 'TAK' else Caption := 'NIE';

Owszem da się zrobić by domyślnym było <Tak> ale to nie jest hop-siup.

1

Pokażę poniżej dwa rozwiązania. Z zastosowanem VCL oraz WinAPI. Ponieważ mozna rozwiązać to tak, jak opisał @kAzek. Jednak ta funkcja nie instnieje raczej w starszych wersjach IDE. Poza tym z tego co googlowałem, to jest nieudokumentowana raczej. Także pewnie i tak trzeba by się pobawić w dodawanie własnych deklaracji funkcji i ładowania jej z dllek systemowych.

Dodam tylko, że jeśłi chodzi o rozwiązanie WinAPI, to jeżeli mielibyśmy pokazywać MessageBox, ktory normalnie da się zamknąć klawiszem Escape (na przykład z samym przyciskiem "OK". To należało by subclassować w taki sposób jak dla formatki, okienko MessageBoxa i dodać tam obsługę wykrywania klawisza Escape przez GetAsyncKeyState. Po stwierdzeniu naciśnięcia Escape po prostu wykonać EndDialog i tyle. Myślę, że wszystko teraz powinno być jasne.

I na przyszłość prośba do pytającego. Najpierw googlujesz, kombinujesz sam "do bólu", a dopiero w ostateczności smarujesz post na forum. Ja nie jestem geniuszem programistycznym, a wszystkie podstawy tego kodu ustaliłem kiedyś tylko dzięki googlowaniu. Także da się, jeżeli się tylko chce wykazać samodzielnością :)

//...
var
  Btn : TButton;

function ShowPolishMsgDlg(Msg : string; DlgType : TMSgDlgType; Buttons : TMsgDlgButtons) : TModalResult;
var
  Dlg : TForm;
begin
  Dlg := CreateMessageDialog(Msg, DlgType, Buttons);
  Dlg.BorderIcons := [];
  Dlg.Caption := Application.Title;
  TButton(Dlg.FindComponent('Ok')).Caption := 'OK';
  TButton(Dlg.FindComponent('No')).Caption := '&Nie';
  TButton(Dlg.FindComponent('Yes')).Caption := '&Tak';
  Btn := TButton(Dlg.FindComponent('Yes'));
  TButton(Dlg.FindComponent('Help')).Caption := 'Pomoc';
  TButton(Dlg.FindComponent('Retry')).Caption := 'Ponów';
  TButton(Dlg.FindComponent('All')).Caption := 'Wszystko';
  TButton(Dlg.FindComponent('Cancel')).Caption := 'Anuluj';
  TButton(Dlg.FindComponent('Ignore')).Caption := 'Ignoruj';
  TButton(Dlg.FindComponent('NoToAll')).Caption := 'Nie na wszystko';
  TButton(Dlg.FindComponent('YesToAll')).Caption := 'Tak na wszystko';
  Dlg.ShowModal;
  Result := Dlg.ModalResult;
end;

procedure TForm1.Button1Click(Sender : TObject);
begin
  Timer1.Enabled := True;
  ShowPolishMsgDlg('Test', mtConfirmation, [mbYes, mbNo]);
end;

procedure TForm1.Timer1Timer(Sender : TObject);
begin
  Btn.Click;
end;

const
  WM_CHANGEMSGBOX = WM_USER + 2013;

var
  POldFormProc : Pointer;

function MsgBox(AHWnd : HWND; Text, Title : string; UType : UINT) : integer;
begin
  PostMessage(Form1.Handle, WM_CHANGEMSGBOX, 0, 0);
  Result := MessageBox(AHWnd, PChar(Text), PChar(Title), UType);
end;

var
  BtnHandle : HWND;

function NewFormProc(AHWnd : HWND; Msg : UINT; AWParam : WParam; ALParam : LParam) : LResult; stdcall;
var
  H : HWND;
begin
  if Msg = WM_CHANGEMSGBOX then
  begin
    H := FindWindow(WC_DIALOG, nil);
    if GetParent(H) = Form1.Handle then
    begin
      SetDlgItemText(H, IDTRYAGAIN, '&Try again');
      SetDlgItemText(H, IDCONTINUE, 'Contin&ue');
      SetDlgItemText(H, ID_CANCEL, '&Cancel');
      SetDlgItemText(H, ID_RETRY, '&Retry');
      SetDlgItemText(H, IDIGNORE, '&Ignore');
      SetDlgItemText(H, IDABORT, '&Abort');
      SetDlgItemText(H, ID_HELP, '&Help');
      SetDlgItemText(H, ID_YES, '&Yes');
      SetDlgItemText(H, ID_NO, '&No');
      BtnHandle := GetDlgItem(H, ID_YES);
    end;
  end;
  Result := CallWindowProc(POldFormProc, AHWnd, Msg, AWParam, ALParam);
end;

procedure TForm1.FormCreate(Sender : TObject);
begin
  Timer1.Enabled := False;
  Timer1.Interval := 3000;
  Timer2.Enabled := False;
  Timer2.Interval := 3000;
  POldFormProc := Pointer(SetWindowLong(Self.Handle, GWL_WNDPROC, Integer(@NewFormProc)));
end;

procedure TForm1.Button2Click(Sender : TObject);
begin
  Timer2.Enabled := True;
  MsgBox(Self.Handle, 'Googluj zanim zapytasz o cokolwiek na forum!', 'Test', MB_ICONQUESTION + MB_YESNO);
end;

procedure TForm1.Timer2Timer(Sender : TObject);
begin
  SendMessage(BtnHandle, BM_CLICK, 0, 0);
end;
0

KAzek jeśli chodzi o wyłączenie komponentu manifest działa wszystko dobrze. Pracuje na Windows 7 wiem, że dla tego systemu jak i Visty są inne manifesty.
Kiedyś już poruszałem ten temat. Kiedy załaduję dużą ilość elementów do ListBox w ten sposób:

  MojaLista := TStringList.Create;
  MojaLista.LoadFromFile('1.txt');
  
  ListBox1.Style := lbVirtual;
  ListBox1.Count := MojaLista.Count 

procedure Form1.ListBox1Data(Control: TWinControl; Index: Integer;
  var Data: String);
begin
  Data := MojaLista[Index];
end; 

Kiedy przesuwam suwak listy schodzi w dół i wraca do góry. Korzystam z unita zaczerpniętego w necie VistaAltFix i nadal problem jest ten sam. Dlatego właśnie
pytałem o wyłączenie komponentu manifest. Kiedy go całkowicie usunę z formatki czy też z uses. Suwak zachowuje się normalnie. Próbowałem dołączyć różne manifesty
dla Windows 7 i nadal suwak podczas przesuwania w dół po puszczeniu wraca do góry. Tak jakby nie było odświeżania. Jak ten problem rozwiązać dla 7.

0

Powinieneś obsłużyć również ListBox1DataFind

0

Olesio nie wiem dlaczego ale drugi przykład dla Timera2 nie działa

0

Właśnie @Bruno(M): co znaczy nie działa? Powinieneś będąc już jakiś czas na forum, wiedzieć że jeżeli nie zaznacze inaczej, to moje kody są wcześniej pisane pod IDE, kompilowane i testowane. Także nie podał bym Tobie niesprawdzonego kodu. U mnie ten kod działa. Ewentualnie można zamienić SendMessage na PostMessage. Jeżeli MessageBox nie zamyka się sam po trzech sekundach, to sprawdź:
Czy na pewno Timer jest włączony.
Czy MessageBox jaki wyświetlasz jest z przyciskiem Yes.
Czy subclasowałeś kod obsługi komunikatów dla Formatki, tak jak zrobiłem to w OnCreate.

Działanie wstępne widać po tym, że na polsko języcznym systemie - etykiety przycisków będą takie, jak zdefiniowałem. Jeżeli jednak piszesz pod Lazarusem, o czym oczywiście może nie wspomniałeś, bo i po co :/ To może @furious programming doradzi jak tam subclassować. Bo tak kiedyś @payl wychwalał te środowisko, a cholera wie jak tam subclassować formatkę żeby nie otrzymywać błędu o kodzie 1413. Przykłady z googla nie spowodowały daleszego działania. A i oczywiscie wtedy WC_DIALOG pewnie trzeba zastapić ''#32770', ze stałych komunikatów usunąc _ i dodać do sekcji uses moduły Windows, Messages, jwawinuser. Dodatkowo jeszcze pewnie dyrektywę {$MODE Delphi}{$H+}. Jednak nadal nie ogarniam tam subclassingu. Fajnie, IDE darmowe, ale żeby były cyrki pod LCL z tak prostą rzeczą jak subclassing to nieporozumienie według mnie.

A wszystko robiłem według http://wiki.freepascal.org/Win32/64_Interface/ja#Processing_non-user_message i nie chce się skompilować plując mi o błedach konwersji typów i że nie są portable. A może problemem jest to, że używam Lazarusa 64 bitowego? Anyway, na pewno poprzedni podany przeze mnie kod pod Delphi raczej powinien zadziałać. Ale kompilowałem go i testowałem pod starszym Delphi 7, którego używam ze względu na to, że często piszę w WinAPI i wolę mieć mniejsze exeki niż opasłe krówska po pare MB dla exeka, który nie ma w sobie grama kodu ;)

0

Olesio z całym szacunkiem dla Ciebie i dla Twojej wiedzy. Chodzi mi o to, że jak korzystam np. z takiego kodu

 if Application.Messagebox('Jak wybrać programowo przycisk TAK ?','Pytanie ?',Mb_YesNo+Mb_IconInformation)= IDYes then
 Caption := 'TAK' else Caption := 'NIE';

Przyciski są oznaczone Tak i Nie. I problem w tym, że okno nie zamyka się.

1 użytkowników online, w tym zalogowanych: 0, gości: 1