MESSAGEBOX MAKER - GÉNÉRATEUR DE MESSAGEBOX EN DELPHI

Signaler
Messages postés
117
Date d'inscription
samedi 4 janvier 2003
Statut
Membre
Dernière intervention
19 juin 2009
-
freetai
Messages postés
14
Date d'inscription
jeudi 31 mars 2005
Statut
Membre
Dernière intervention
25 septembre 2005
-
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/33152-messagebox-maker-generateur-de-messagebox-en-delphi

freetai
Messages postés
14
Date d'inscription
jeudi 31 mars 2005
Statut
Membre
Dernière intervention
25 septembre 2005

Cirec>>
oui merci je l'ai recu, vraiment désolé de ne pas t'avoir repondu!!!! je suis très pris en ce moment et je ne pense malheureusement pas pouvoir faire avancer ce source pour le moment... En attendant si tu as le temps de le faire de ton coté, poste-le sur ce site et je retirerai le mieux qui est loin d'être parfait... en tout cas merci pour ta proposition d'aide, c'est très aimable à toi ;)

allez @bientôt j'espere!

ps: au fait à propos du bug sur le message de plus de 3 lignes, ne serait-ce pas plutot une histoire de nombre de caracteres? (256 max ou un truc de ce genre??)
cirec
Messages postés
3809
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
25 janvier 2020
35
Bonjour freetai
as tu recu le correctif de t'on MessageBox Maker que je t'ai envoyer il y a trois semaine.(Boite privé )
Voilà donc depuis j'attend :-).

Et si tu es toujours interessé je peut envoyer la suite .
j'ai débusqué d'autres erreurs:
si le message comporte plus d'une ligne il est impossible d'utiliser le code généré directement
(sans correction)
et d'autres petites chose ...
voilà @+

ps : loin de moi l'idée de te critiquer où autre, non,
ma seul intention est de de t'aider a améliorer t'on
Prog qui je pense une fois terminé sera très utile.

@+ Cirec
cirec
Messages postés
3809
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
25 janvier 2020
35
Bonjour freetai
as tu recu le correctif de t'on MessageBox Maker que je t'ai envoyer il y a trois semaine.(Boite privé )
Voilà donc depuis j'attend :-).

Et si tu es toujours interessé je peut envoyer la suite .
j'ai débusqué d'autres erreurs:
si le message comporte plus d'une ligne il est impossible d'utiliser le code généré directement
(sans correction)
et d'autres petites chose ...
voilà @+

ps : loin de moi l'idée de te critiquer où autre, non,
ma seul intention est de de t'aider a améliorer t'on
Prog qui je pense une fois terminé sera très utile.

@+ Cirec
assemple
Messages postés
72
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
16 décembre 2011

Ne cherche pas, je l'ai fait.
Je l'ai mis sur code source, mais ça a planté à un moment donc je lme copie ici :

le PAS :
unit UBM;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, Buttons, StdCtrls;

Const LargeurBouton = 120 ;
HauteurBouton = 27 ;

type
TFBM = class(TForm)
LabelMessage: TLabel;
procedure LesSpeedButtonsClick(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Déclarations privées }
public
{ Déclarations publiques }
BoutonChoisi : integer ;
Raccourcis : ShortString ;
end;

Function BM(LeTitre, LeMessage : String ; ListeDesBoutons : String = 'Ok' ) : integer ;
var
FBM: TFBM;

implementation

{$R *.dfm}
// pour CODESOURCE
uses DDU ; // Supprimer cette clause et la ligne Remplace...


Function BM(LeTitre, LeMessage : String ; ListeDesBoutons : String) : integer ;
Var S : String ;
BN : ShortString ;
Count : integer ;
I, X, Y : Integer ;
UnSB : TSpeedButton ;
Ok : Boolean ;
Begin
// Init
X := 10 ;
Y := 72 ;
Count := 1 ;
// Premier appel à BM
If FBM=Nil then FBM := TFBM.Create(application) ;
// Titre
FBM.Caption := LeTitre ;
// Message
FBM.LabelMessage.Caption := LeMessage ;
// Liste des Boutons
S := ListeDesBoutons ;
Remplace('#13',#13,S) ; // Supprimer cette ligne et la clause Uses DDU ;
//----------------------------------------------------------------------------
// Boucle de création des boutons
While S<>'' do
Begin
//--------------------------------------------------------------------------
// Détermination du Nom du Bouton (BN : Button Name)
If Pos(#13,S)>0 then
Begin
BN := Copy(S,1,Pos(#13,S)-1) ;
Delete(S,1,Pos(#13,S)) ;
End Else
Begin
BN := S ;
S := '' ;
End ;
While Copy(BN,1,1)=' ' do BN := Copy(BN,2,255) ;
While Copy(BN,Length(BN),1)=' ' do BN := Copy(BN,1,Length(BN)-1) ;
If BN<>'' then
Begin
If X>FBM.Width-LargeurBouton-10 then
Begin
X := 10 ;
Inc(Y,HauteurBouton+3) ;
FBM.LabelMessage.Height := FBM.LabelMessage.Height - HauteurBouton - 3 ;
For I := 1 to FBM.ComponentCount do
Begin
If FBM.Components[i-1] is TSpeedButton then TSpeedButton(FBM.Components[i-1]).Top := TSpeedButton(FBM.Components[i-1]).Top - HauteurBouton - 3 ;
End ;
FBM.Height := FBM.Height + HauteurBouton + 3 ;
End ;
UnSB := TSpeedButton.Create(FBM) ;
UnSB.Parent := FBM ;
If Pos('&',BN)=0 then
Begin
FBM.Raccourcis := FBM.Raccourcis + upcase(BN[1]) ;
BN := '&'+BN ;
End Else FBM.Raccourcis := FBM.Raccourcis + upcase(BN[Pos('&',BN)+1]) ;
UnSB.Caption := BN ;
UnSB.Name := 'B'+IntToStr(Count) ;
Inc(Count) ;
UnSB.Anchors := [akLeft,akBottom] ;
UnSB.Left := X ;
UnSB.Top := Y ;
UnSB.Width := LargeurBouton ;
UnSB.Height := HauteurBouton ;
UnSB.OnClick := FBM.LesSpeedButtonsClick ;
// GLYPH !!!!!!
If FileExists(BN+'.BMP') then UnSB.Glyph.LoadFromFile(BN+'.BMP') ;
Inc(X,largeurBouton + 10 ) ;
End ;
End ;
// Boucle de création des boutons
//----------------------------------------------------------------------------

// Init resultat (BoutonChoisi) à AUCUN
FBM.BoutonChoisi := 0 ;

// Affichage de la Boîte de Message (FBM) en MODAL
FBM.ShowModal ;

// Report du Résultat
Result := FBM.BoutonChoisi ;

// Réinit : Dimension initiale
FBM.ClientHeight := 100 ;
FBM.LabelMessage.Height := 50 ;
// Réinit : suppression des speedbuttons
// Double boucle "breakée" car button.free décale les indices de FBM.Component
// mais je viens de me rendre compte qu'un DOWNTO aurait p'têt fait l'affaire
While Not OK do
Begin
Ok := True ;
For I := 1 to FBM.ComponentCount do
Begin
If FBM.Components[i-1] is TSpeedButton then
Begin
TSpeedButton(FBM.Components[i-1]).Free ;
Ok := False ;
BREAK ;
End ;
End ;
End ;
End ;



procedure TFBM.LesSpeedButtonsClick(Sender: TObject);
var s : ShortString ;
begin
If Sender is TSpeedButton then
Begin
S := TSpeedButton(sender).Name ;
BoutonChoisi := StrtoInt(S[2]) ;
End ;
ModalResult := mrOk ;
end;

procedure TFBM.FormKeyPress(Sender: TObject; var Key: Char);
begin
Key := UpCase(key) ;
BoutonChoisi := Pos(Key,raccourcis) ;
If BoutonChoisi<>0 then Modalresult := mrOk ;
end;

procedure TFBM.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If Key=13 then
Begin
BoutonChoisi := 1 ;
ModalResult := mrOk ;
End ;
If Key=27 then
Begin
BoutonChoisi := 1 ;
ModalResult := mrOk ;
End ;
end;

end.

le DFM :
object FBM: TFBM
Left = 291
Top = 314
Width = 418
Height = 127
Caption = 'FBM'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnKeyDown = FormKeyDown
OnKeyPress = FormKeyPress
PixelsPerInch = 96
TextHeight = 13
object LabelMessage: TLabel
Left = 0
Top = 15
Width = 410
Height = 50
Align = alCustom
Alignment = taCenter
Anchors = [akLeft, akTop, akRight, akBottom]
AutoSize = False
Caption = 'LabelMessage'
end
end