Etwas in eine Message Box zeichnen (Canvas)

[isocam]

hallo,

Ich möchte gerne in eine MessageBox etwas zeichnen, zb. einen Farbverlauf.

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  i,f,r,g:Integer;
begin

with CreateMessageDialog('Wie gehts ?',mtquestion,[mbyes,mbno]) do try
 ...
 f:=Round(255/Height);
 r:=0;
 g:=255;
 Canvas.Pen.Color:=RGB(r,g,100);
 FOR i:=0 TO Height do begin
  Canvas.MoveTo(0,i);
  Canvas.LineTo(Width,i);
  Inc(r,f);
  Dec(g,f);
  Canvas.Pen.Color:=RGB(r,g,100);
 end;
 repaint;
 ...
 finally
 ...
end;
end;

Ich habe diesen Code benutzt, um einen Farbverlauf in die MessageBox zu zeichnen. Aber es ist nur dieses schnöde Windowsgrau zu sehen. Keine Fehlermeldung vom Compiler.
Wäre schön, wenn mir jemand helfen könnte.

[Christian Seehase]

Moin isocam,

das Problem wird sein, dass das Grau Standard ist.
Damit der Farbverlauf angezeigt wird, müsstest Du ihn zu dem Zeitpunkt aufbringen, wenn der Dialog gezeichnet wird, also müsstest Du noch eine Methode vom Typ TNotifyEvent einbauen, die dann dem OnPaint des Dialoges zugwiesen wird.
In dieser Methode wird dann der Verlauf gezeichnet.

[Bernhard Geyer]

Dazu müsstest Du die Zeichenroutine im OnPaint-Ereignis unterbringen.

So wird zwar einmal der Farbverlauf temporär auf das Canvas gezeichnet, aber sobald dieser neu gezeichnet werden muß (z.B. wenn Formular angezeigt wird, wird der Cancas gelöscht.

Eine Möglichkeit wäre z.B. im Hintergrund des Formulars ein Image abzulegen, welcher den Farbverlauf beinhaltet.

[isocam]

Und wie mache ich das?
(Ich bin kein Experte.)

[Christian Seehase]

Moin isocam,

mal ein Beispiel:

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    //...
    // OnPaint für den Dialog
    procedure MessageDlgPaint(Sender: TObject);
  private
    { Private-Deklarationen }
    FMessageDlg : TForm;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FMessageDlg         := CreateMessageDialog('Wie gehts ?',mtWarning,[mbyes,mbno]);
  FMessageDlg.OnPaint := MessageDlgPaint;
end;

procedure TForm1.MessageDlgPaint(Sender: TObject);

var
  i,f,r,g:Integer;

begin
  f:=Round(255/Height);
  r:=0;
  g:=255;
  FMessageDlg.Canvas.Pen.Color:=RGB(r,g,100);
  for i:=0 TO FMessageDlg.Height do begin
    FMessageDlg.Canvas.MoveTo(0,i);
    FMessageDlg.Canvas.LineTo(Width,i);
    Inc(r,f);
    Dec(g,f);
    FMessageDlg.Canvas.Pen.Color:=RGB(r,g,100);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if FMessageDlg.Showmodal = mrNo then exit;
end;

[Bernhard Geyer]

Gerade fertig geworden - aber schon wieder zu langsam :wink:

[isocam]

Danke für die Hilfe.
Das verstehe ich aber nicht. (vielleicht morgen wenn ich konzentriert bin)

[Christian Seehase]

Moin isocam,

FMessageDlg ist ein privates Feld des Hauptformulares. Irgenwo muss der Dialog ja gespeichert werden, damit er mehrfach genutzt werden kann.
MessageDlgPaint ist das TNotifyEvent, dass der OnPaint Eigenschaft des Dialoges zugewiesen werden soll.

Beim Erzeugen des Hauptformulares werden dann der Dialog erzeugt, und die OnPaint Routine zugewiesen.

Die MessageDlgPaint Methode enthält dann das, was auf das Dialogformular gezeichnet werden soll, wenn es gezeichnet wird.
Diese Routine wird automatisch immer dann aufgerufen, wenn das Formular neu gezeichnet wird.

Bei der ButtonClick Methode handelt es sich nur um ein Beispiel den Dialog anzuzeigen.

[isocam]

Vielen Dank.
Ich denke, dass ich es jetzt verstanden habe und anwenden kann.

[Jens Schumann]

Hallo Christian,
guter Vorschlag! Nur leider ist das Label nicht transparent.
Das Label ist aber ein privates Feld von TMessageForm. Dummerweise
ist TMessageForm im implementation Abschnit von Dialogs implementiert.
Damit der Compiler nicht zickt habe ich die Deklaration in der
Form-unit einfach wiederholt:

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    FMessageDlg : TForm;
    procedure MessageDlgPaint(Sender: TObject); 
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.MessageDlgPaint(Sender: TObject);
var 
  i,f,r,g:Integer;
begin
  f:=Round(255/Height); 
  r:=0; 
  g:=255; 
  FMessageDlg.Canvas.Pen.Color:=RGB(r,g,100);
  for i:=0 TO FMessageDlg.Height do begin 
    FMessageDlg.Canvas.MoveTo(0,i);
    FMessageDlg.Canvas.LineTo(Width,i); 
    Inc(r,f);
    Dec(g,f); 
    FMessageDlg.Canvas.Pen.Color:=RGB(r,g,100);
  end;
end;

Type
  TMessageForm = class(TForm)
  private
    Message: TLabel;
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FMessageDlg         := CreateMessageDialog('Wie gehts ?',mtWarning,[mbyes,mbno]);
  TMessageForm(FMessageDlg).Message.Transparent:=True;
  FMessageDlg.OnPaint := MessageDlgPaint;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if FMessageDlg.Showmodal = mrNo then exit; 

end;

end.

Komischerweise funktioniert das. Ich weiss aber nicht warum und habe deshalb ein ungutes Gefühl.
Evt. habe ich auch gerade ein Brett vor dem Kopf. Weiss jemand warum das hier klappt?
Oder sollte man soetwas nicht machen?