StatusBar ohne Farbe

hRb · Beiträge: 267 Erhaltene Danke: 12

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).

markieren

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 · Beiträge: 118 Erhaltene Danke: 34

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

markieren

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;

Einloggen, um Attachments anzusehen!

t.roller · Beiträge: 118 Erhaltene Danke: 34

Update:

markieren

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.

Einloggen, um Attachments anzusehen!

haentschman · Verfasst: Fr 10.03.17 05:14

Moin...

Zitat:

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).

...schwer vorstellbar...das Delphi nicht schuld ist oder?

Das Stichwort ist Theming.

Gleiches Problem mit Progressbar:
www.entwickler-ecke....be+XE4_112065,0.html

hRb · Beiträge: 267 Erhaltene Danke: 12

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.

markieren

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;

haentschman · Verfasst: Fr 10.03.17 16:08

Bitte, bitte kein WITH... :shock:

markieren

Delphi-Quelltext

1:
2:
3:

with Form1, Label1 do begin
  visible:=false; // ist das das visible von Form1 oder Label1?
  Caption:='';  // ist das die Caption von Form1 oder Label1?

...das ist der Grund warum man es nicht mehr verwendet.

Es funktioniert nur durch Zufall!

t.roller · Beiträge: 118 Erhaltene Danke: 34

hRb hat folgendes geschrieben :

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.

Das GAUGE-Object ist auch so ein Kandidat, der sich zum Tricksen eignet: transparente Label drauf, positionieren wie man will, TextColor wie man will - erst heute früh gemacht, um Festplatten-Belegung darzustellen.

Einloggen, um Attachments anzusehen!

Ehemaliges Mitglied Erhaltene Danke: 1

- Nachträglich durch die Entwickler-Ecke gelöscht -

haentschman · Verfasst: Fr 10.03.17 17:37

Zitat:

Quatsch.

Sehe ich anders. Es gibt genügend Beispiele dafür das es in die Hose gehen kann. :roll:

Aber das gehört nicht in diesen Beitrag. :zwinker:

hRb · Beiträge: 267 Erhaltene Danke: 12

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.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme