Entwickler-Ecke :: Thema anzeigen - StatusBar ohne Farbe

hRb - Do 09.03.17 19:09
Titel: StatusBar ohne Farbe

Ich habe eine (weitere) Fehlfunktion bei der Umstellung von Delphi7 auf XE3. Man nehme ein TPanel und lege darauf ein TStatusbar (jeweils Align=alBottom). Hinzu zwei Buttons.
Unter D7 liefert mir nachstehende Befehlsfolge das gewünschte Ergebnis, nämlich einen rot unterlegten Fehlertext über die gesamte Breite.
Dieselbe Befehlsfolge unter XE3: es fehlt die Hintergrundfarbe:
Frage: sind bei XE3 die Parameter anders zu setzen bzw der Code anzupassen (wenn ja - wie) oder liegt dies an meiner (gekauften) XE3 Starter-Version, von der ich an anderer Stelle schon hörte, dass diese bestimmte Funktionen nicht kann bzw. "abgespeckt" hat?
Anmerkung: abspecken im Hinblick auf komplett fehlende Objekte wäre ja ok, aber abspecken innerhalb eines Objektes (keine Farbe, obwohl Col-Parameter vorhanden??? schwer vorstellbar).

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:

var alarmF : boolean;

Procedure PutAlarm ( Fehlertext: string);
{Alarmmaske ausgeben =Fehlermeldung}
begin
  with Form1.Statusbar1 do begin
   SimplePanel:=true;
   Font.Style:= [fsbold];
   color:=clRed;  //Hintergrundfarbe
   Font.Color:=clblack;
   SimpleText:=Fehlertext;
//   if vEBell=true then Beep;
  end;
 alarmF:=true;
end;

Procedure DelFehlertext;
{Fehlermeldetextzeile löschen, Multipanel-Anzeige}
begin
  with Form1.Statusbar1 do begin
   SimpleText:='';
   Color:=clBtnFace;
   Font.Color:=clWindowText;
  end;
 alarmF:=false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Putalarm('Fehlermeldung');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DelFehlertext;
end;

t.roller - Do 09.03.17 21:03

Siehe hier: http://www.delphipraxis.net/362705-post2.html
Mit Win8.1, XE7 getestet: geht.

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:

var
  FC0,FC1,FC2,FC3 : INTEGER; // StatusBar.Font.Color
  BG0, BG1, BG2, BG3 : INTEGER; // StatusBar.Color
...
procedure TForm1.FormCreate(Sender: TObject);
begin 
StatusBar1.Panels[0].Style := psOwnerDraw; // Panel selber zeichnen
StatusBar1.Panels[1].Style := psOwnerDraw; // Panel selber zeichnen
StatusBar1.Panels[2].Style := psOwnerDraw; // Panel selber zeichnen
StatusBar1.Panels[3].Style := psOwnerDraw; // Panel selber zeichnen
end;

Procedure PutAlarm ( Fehlertext: string); {Alarmmaske ausgeben =Fehlermeldung}
begin
  with Form1.Statusbar1 do begin
   Font.Style:= [fsbold];
  Form1.StatusBar1.Panels[0].Text:= 'Panel[0]';  FC0:=  255; // clRed;
    BG0:= 0; // clBlack
  Form1.StatusBar1.Panels[1].Text:= 'Panel[1]';  FC1:=  65535; // clYellow;
    BG1:= 16711680;//  clBlue;
  Form1.StatusBar1.Panels[2].Text:= 'Panel[2]';  FC2:=  65280;//clLime;
    BG2:= 0; // clBlack
  Form1.StatusBar1.Panels[3].Text:= 'Panel[3]';  FC3:=  16777215;//clWhite;
    BG3:= 16711680;//  clBlue;
  end;
  Form1.StatusBar1.Repaint;
 alarmF:=true;
end;

Procedure DelFehlertext; {Fehlermeldetextzeile löschen, Multipanel-Anzeige}
begin
  with Form1.Statusbar1 do begin
    Form1.StatusBar1.Panels[0].Text:= 'Panel[0]'; FC0:= 16777215;//clWhite
    BG0:= 16711680;// clBlue
    Form1.StatusBar1.Panels[1].Text:= 'Panel[1]'; FC1:= 16777215;//clWhite
    BG1:= 0;//  clBlack;
    Form1.StatusBar1.Panels[2].Text:= 'Panel[2]'; FC2:= 16777215;//clWhite
    BG2:= 16711680;// clBlue;
    Form1.StatusBar1.Panels[3].Text:= 'Panel[3]'; FC3:= 16777215;//clWhite
    BG3:= 0;//  clBlack;
    end;
    Form1.StatusBar1.Repaint;
 alarmF:=false;
end;
...
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
  const Rect: TRect);
begin
  if Panel = StatusBar1.Panels[0] then //  Panel 0
  begin
    with StatusBar.Canvas do
    begin
      Brush.Color := BG0;//clBlack;
      Font.Color:= FC0; //clRed; //255
      FillRect(Rect); // Mit der Farbe füllen
      TextOut(rect.Left + 2, rect.Top + 2, panel.Text); // Textausgeben
    end;
  end;
  if Panel = StatusBar1.Panels[1] then //  Panel 1
  begin
    with StatusBar.Canvas do
    begin
      Brush.Color := BG1;//clBlue; //16711680
      Font.Color:= FC1;//clYellow; //65535
      FillRect(Rect); // Mit der Farbe füllen
      TextOut(rect.Left + 2, rect.Top + 2, panel.Text); // Textausgeben
    end;
  end;
  if Panel = StatusBar1.Panels[2] then //  Panel 2
  begin
    with StatusBar.Canvas do
    begin
      Brush.Color := BG2;//clBlack; // 0
      Font.Color:= FC2;//clLime;  //65280
      FillRect(Rect); // Mit der Farbe füllen
      TextOut(rect.Left + 2, rect.Top + 2, panel.Text); // Textausgeben
    end;
  end;
  if Panel = StatusBar1.Panels[3] then //  Panel 3
  begin
    with StatusBar.Canvas do
    begin
      Brush.Color := BG3;// clBlue; //16711680
      Font.Color:= FC3;//clWhite;  //16777215
      FillRect(Rect); // Mit der Farbe füllen
      TextOut(rect.Left + 2, rect.Top + 2, panel.Text); // Textausgeben
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Putalarm('Fehlermeldung');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
DelFehlertext;
end;

t.roller - Fr 10.03.17 00:24

Update:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:

unit Unit1;  //20170309

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    Button1: TButton;
    Button2: TButton;
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
      const Rect: TRect);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  FC0,FC1,FC2,FC3 : INTEGER;    // StatusBar.Font.Color
  BG0, BG1, BG2, BG3 : INTEGER; // StatusBar.Color
  PT0, PT1, PT2, PT3 : String;  // StatusBarPanelText

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
    PT0:= 'Panel[000]';
    PT1:= 'Panel[111]';
    PT2:= 'Panel[222]';
    PT3:= 'Panel[333]';
    FC0:= 16777215;//clWhite
    BG0:= 16711680;// clBlue
    FC1:= 16777215;//clWhite
    BG1:= 0;//  clBlack;
    FC2:= 16777215;//clWhite
    BG2:= 16711680;// clBlue;
    FC3:= 16777215;//clWhite
    BG3:= 0;//  clBlack;
  StatusBar1.Repaint;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    PT0:= 'Panel[0]';
    PT1:= 'Panel[1]';
    PT2:= 'Panel[2]';
    PT3:= 'Panel[3]';
    FC0:= clRed;
    BG0:= clYellow;
    FC1:= clYellow;
    BG1:= clRed;
    FC2:= clBlue;
    BG2:= clYellow;
    FC3:= clYellow;
    BG3:= clBlack;
  StatusBar1.Repaint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
StatusBar1.Panels[0].Style := psOwnerDraw; // Panel selber zeichnen
StatusBar1.Panels[1].Style := psOwnerDraw; // Panel selber zeichnen
StatusBar1.Panels[2].Style := psOwnerDraw; // Panel selber zeichnen
StatusBar1.Panels[3].Style := psOwnerDraw; // Panel selber zeichnen
end;

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
  const Rect: TRect);
begin
  if Panel = StatusBar1.Panels[0] then //  Panel 0
  begin
    with StatusBar.Canvas do
    begin
      Brush.Color := BG0;
      Font.Color:= FC0;
      FillRect(Rect);
      TextOut(Rect.left + 2, Rect.top + 2, PT0);
    end;
  end;
  if Panel = StatusBar1.Panels[1] then //  Panel 1
  begin
    with StatusBar.Canvas do
    begin
      Brush.Color := BG1;
      Font.Color:= FC1;
      FillRect(Rect);
      TextOut(Rect.left + 2, Rect.top + 2, PT1);
    end;
  end;
  if Panel = StatusBar1.Panels[2] then //  Panel 2
  begin
    with StatusBar.Canvas do
    begin
      Brush.Color := BG2;
      Font.Color:= FC2;
      FillRect(Rect);
      TextOut(Rect.left + 2, Rect.top + 2, PT2);
    end;
  end;
  if Panel = StatusBar1.Panels[3] then //  Panel 3
  begin
    with StatusBar.Canvas do
    begin
      Brush.Color := BG3;
      Font.Color:= FC3;
      FillRect(Rect);
      TextOut(Rect.left + 2, Rect.top + 2, PT3);
    end;
  end;
end;

end.

hRb - Fr 10.03.17 15:56

Hallo t.roller
Danke, jetzt habe ich auch eine Lösung für mehrere farblich besetzte Felder, bzw um wünschenswerte weitere Anzeigen im Statusbar nicht zu überdecken.
Wenn ich es aber richtig verstehe, funktioniert das Statusbar-Objekt im Hinblick auf Farbe nicht und man muss selbst eine Lösung finden (tricksen).
Wenn es aber ums "Tricksen" geht, kann ich für mein Problem auch eine einfache Lösung bieten: Ich setze auf das Panel an gleicher Stelle sowohl ein TStatusbar als auch ein TLabel. Je nachdem ob Fehlertext sichtbar ist oder nicht, setzte die beiden Objekte jeweils wechselseitig bei visible von true auf false (Vorder- Hintergrund). Nur, schöne Programmierung sieht eben anders aus.

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:

Procedure PutAlarm ( Fehlertext: string);
{Alarmmaske ausgeben =Fehlermeldung}
begin
  with Form1, Label1  do begin
    Panel1.color:=clred;
    Statusbar1.visible:=false;
     visible:=true;
//   Font.Style:= [fsbold]; {vorbesetzen}
     Caption:=Fehlertext;
  end;
 alarmF:=true;
end;

Procedure DelFehlertext;
{Fehlermeldetextzeile löschen, Multipanel-Anzeige}
begin if alarmF then
  with Form1, Label1 do begin
     visible:=false;       {vorbesetzen}
     Caption:='';
    Statusbar1.visible:=true;
    Panel1.color:=clBtnFace;
  end;
 alarmF:=false;
end;

hRb - Mo 13.03.17 22:07

Stimmt, "with .. do" gehört nicht hierher. Ist aber laut Hilfe Delphi 7 ganz sauber geregelt. Man muss nur begin .. end-Schachtelung beachten! Im vorliegenden Fall sind visible und Caption eindeutig dem Label zugeordnet! Die Logik muss natürlich beachtet werden, also kein: with Label1, Form1 do
(nachzulesen in D7-Hilfe unter with-Anweisungen; in XE-Hilfe Text stark verkürzt!).

Zitat:

Wenn auf with mehrere Objekte oder Records folgen, wird die gesamte Anweisung als Folge von verschachtelten with-Anweisungen behandelt. Die Anweisung
with Objekt1, Objekt2, ..., Objektn do Anweisung

ist gleichbedeutend mit

with Objekt1 do
with Objekt2 do //Zeilen sollten optisch alle eingerückt sein, macht "Zitat" aber nicht
...
with Objektn do
Anweisung

Irgenwo in der Hilfe habe ich auch gelesen (finde es derzeit nicht), dass der Compiler (oder das Programm ?) mit with schneller arbeitet.

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2024 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!