Autor |
Beitrag |
hRb
Beiträge: 267
Erhaltene Danke: 12
|
Verfasst: Do 09.03.17 19:09
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).
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);
begin with Form1.Statusbar1 do begin SimplePanel:=true; Font.Style:= [fsbold]; color:=clRed; Font.Color:=clblack; SimpleText:=Fehlertext; end; alarmF:=true; end;
Procedure DelFehlertext;
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
|
Verfasst: Do 09.03.17 21:03
Siehe hier: www.delphipraxis.net/362705-post2.html
Mit Win8.1, XE7 getestet: geht.
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; BG0, BG1, BG2, BG3 : INTEGER; ... procedure TForm1.FormCreate(Sender: TObject); begin StatusBar1.Panels[0].Style := psOwnerDraw; StatusBar1.Panels[1].Style := psOwnerDraw; StatusBar1.Panels[2].Style := psOwnerDraw; StatusBar1.Panels[3].Style := psOwnerDraw; end;
Procedure PutAlarm ( Fehlertext: string); begin with Form1.Statusbar1 do begin Font.Style:= [fsbold]; Form1.StatusBar1.Panels[0].Text:= 'Panel[0]'; FC0:= 255; BG0:= 0; Form1.StatusBar1.Panels[1].Text:= 'Panel[1]'; FC1:= 65535; BG1:= 16711680; Form1.StatusBar1.Panels[2].Text:= 'Panel[2]'; FC2:= 65280; BG2:= 0; Form1.StatusBar1.Panels[3].Text:= 'Panel[3]'; FC3:= 16777215; BG3:= 16711680; end; Form1.StatusBar1.Repaint; alarmF:=true; end;
Procedure DelFehlertext; begin with Form1.Statusbar1 do begin Form1.StatusBar1.Panels[0].Text:= 'Panel[0]'; FC0:= 16777215; BG0:= 16711680; Form1.StatusBar1.Panels[1].Text:= 'Panel[1]'; FC1:= 16777215; BG1:= 0; Form1.StatusBar1.Panels[2].Text:= 'Panel[2]'; FC2:= 16777215; BG2:= 16711680; Form1.StatusBar1.Panels[3].Text:= 'Panel[3]'; FC3:= 16777215; BG3:= 0; end; Form1.StatusBar1.Repaint; alarmF:=false; end; ... procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); begin if Panel = StatusBar1.Panels[0] then begin with StatusBar.Canvas do begin Brush.Color := BG0; Font.Color:= FC0; FillRect(Rect); TextOut(rect.Left + 2, rect.Top + 2, panel.Text); end; end; if Panel = StatusBar1.Panels[1] then begin with StatusBar.Canvas do begin Brush.Color := BG1; Font.Color:= FC1; FillRect(Rect); TextOut(rect.Left + 2, rect.Top + 2, panel.Text); end; end; if Panel = StatusBar1.Panels[2] then begin with StatusBar.Canvas do begin Brush.Color := BG2; Font.Color:= FC2; FillRect(Rect); TextOut(rect.Left + 2, rect.Top + 2, panel.Text); end; end; if Panel = StatusBar1.Panels[3] then begin with StatusBar.Canvas do begin Brush.Color := BG3; Font.Color:= FC3; FillRect(Rect); TextOut(rect.Left + 2, rect.Top + 2, panel.Text); 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
|
Verfasst: Fr 10.03.17 00:24
Update:
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; 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 public end;
var Form1: TForm1; FC0,FC1,FC2,FC3 : INTEGER; BG0, BG1, BG2, BG3 : INTEGER; PT0, PT1, PT2, PT3 : String; implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject); begin PT0:= 'Panel[000]'; PT1:= 'Panel[111]'; PT2:= 'Panel[222]'; PT3:= 'Panel[333]'; FC0:= 16777215; BG0:= 16711680; FC1:= 16777215; BG1:= 0; FC2:= 16777215; BG2:= 16711680; FC3:= 16777215; BG3:= 0; 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; StatusBar1.Panels[1].Style := psOwnerDraw; StatusBar1.Panels[2].Style := psOwnerDraw; StatusBar1.Panels[3].Style := psOwnerDraw; end;
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); begin if Panel = StatusBar1.Panels[0] then 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 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 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 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
Beiträge: 285
Erhaltene Danke: 33
DX10 Berlin Professional
|
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
|
Verfasst: 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);
begin with Form1, Label1 do begin Panel1.color:=clred; Statusbar1.visible:=false; visible:=true; Caption:=Fehlertext; end; alarmF:=true; end;
Procedure DelFehlertext;
begin if alarmF then with Form1, Label1 do begin visible:=false; Caption:=''; Statusbar1.visible:=true; Panel1.color:=clBtnFace; end; alarmF:=false; end; |
|
|
haentschman
Beiträge: 285
Erhaltene Danke: 33
DX10 Berlin Professional
|
Verfasst: Fr 10.03.17 16:08
Bitte, bitte kein WITH...
Delphi-Quelltext 1: 2: 3:
| with Form1, Label1 do begin visible:=false; Caption:=''; |
...das ist der Grund warum man es nicht mehr verwendet. Es funktioniert nur durch Zufall!
|
|
t.roller
Beiträge: 118
Erhaltene Danke: 34
|
Verfasst: Fr 10.03.17 16:32
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!
|
|
Frühlingsrolle
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Fr 10.03.17 17:29
- Nachträglich durch die Entwickler-Ecke gelöscht -
|
|
haentschman
Beiträge: 285
Erhaltene Danke: 33
DX10 Berlin Professional
|
Verfasst: Fr 10.03.17 17:37
Sehe ich anders. Es gibt genügend Beispiele dafür das es in die Hose gehen kann. Aber das gehört nicht in diesen Beitrag.
|
|
hRb
Beiträge: 267
Erhaltene Danke: 12
|
Verfasst: 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.
|
|
|