meine progressbar läuft nicht gleichmäßig

elundril · Verfasst: Mo 22.01.07 21:58

Ich hab jetzt eine Komponente programmier auf wunsch meines Bruders. und zwar ganz allein! *stolz sei*

Die Komponente basiert auf TGraphicControl und ist, auch wenn der Name es sagt, keine Progressbar. Es ist eine Komponente die einem Prozente anzeigt. Nur leider funktioniert sie nicht so wie ichs will.

hier mal der Code:

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:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:

unit ExProgressbar;

interface

uses
  SysUtils, Classes, Controls, Graphics, Messages, Forms;

type  
  TSmallPoint = packed record  
    x: SmallInt;  
    y: SmallInt;  
  end;

type
  TWMButtonEvent = packed record
    Msg: Cardinal;
    Keys: Longint;
    case Integer of
      0: (
        XPos: Smallint;
        YPos: Smallint);
      1: (
        Pos: TSmallPoint;
        Result: Longint);
  end;

type    
  TMouseEvent = procedure(Sender: TObject; Button: TMouseButton;    
    Shift: TShiftState; X, Y: Integer) of object;

type
  TExProgressbar = class(TCustomControl)
  private
    cBackColor: TColor;
    cForeColor: TColor;
    iValue: integer;
    iMaxVal: integer;
    Position: integer;
    FOnMouseDown: TMouseEvent;
    FOnMouseUp: TMouseEvent;
    procedure SetForeColor(SColor: TColor);
    procedure SetBackColor(SColor: TColor);
    Function GetForeColor: TColor;
    Function GetBackColor: TColor;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
    procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN;
    procedure WMMButtonUp(var Message: TWMMButtonUp); message WM_MBUTTONUP;
    procedure SetValue(SValue: Integer);
    procedure SetMaxVal(SValue: Integer);
    procedure SetPosition(Pos: Integer);
    { Private declarations }
  protected
    procedure Paint; override;
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    { Public declarations }
  published
    property Value: Integer read iValue write SetValue;
    property MaxValue: Integer read iMaxVal write SetMaxVal default 1;
    property ForeColor: TColor read GetForeColor write SetForeColor;
    property BackColor: TColor read GetBackColor write SetBackColor;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;  
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property Hint;
    property OnClick;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('ExComponents', [TExProgressbar]);
end;

constructor TExProgressbar.Create(AOwner: TComponent);
begin
  inherited;
  Height:=16;
  Width:=150;
  iMaxVal := 100;
  iValue:=1;
  Position:=1;
  cBackColor:=clBlack;
  cForeColor:=clRed;
end;

procedure TExProgressbar.Paint;
begin
  inherited;
  if csDesigning in ComponentState then begin
    Canvas.Brush.Style:= bsSolid;
    Canvas.Pen.style := psClear;
    Canvas.Brush.Color:=cBackColor;
    Canvas.Rectangle(0,0,width,height);
    Canvas.Brush.Color:=cForeColor;
    Canvas.Rectangle(2,2,Position-2,height-2);
    exit;
  end;
  Canvas.Brush.Style:=bsSolid;
  Canvas.Brush.Color:=cBackColor;
  Canvas.Pen.Style:=psClear;
  Canvas.Rectangle(0,0,width,height);
  Canvas.Brush.color:=cForeColor;
  Canvas.Pen.Style:=psClear;
  Canvas.Brush.Style:=bsSolid;
  Canvas.Rectangle(2,2,Position-2,height-2);
end;

procedure TExProgressbar.SetForeColor(SColor: TColor);
begin
  cForeColor:=SColor;
  Paint;
end;

procedure TExProgressbar.SetBackColor(SColor: TColor);
begin
  cBackColor:=SColor;
  Paint;
end;

function TExProgressbar.GetForeColor: TColor;
begin
  result:=cForeColor;
end;

function TExProgressbar.GetBackColor: TColor;
begin
  result:=cBackColor;
end;

procedure TExProgressbar.WMLButtonDown(var Message: TWMLButtonDown);
begin
  inherited;
  if Assigned(FOnMouseDown) then
    with Message do
      FOnMouseDown(Self, mbLeft, KeysToShiftState(Keys), XPos, YPos);
end;

procedure TExProgressbar.WMLButtonUp(var Message: TWMLButtonUp);
begin
  inherited;
  if Assigned(FOnMouseUp) then
    with Message do
      FOnMouseUp(Self, mbLeft, KeysToShiftState(Keys), XPos, YPos);
end;

procedure TExProgressbar.WMRButtonDown(var Message: TWMRButtonDown);
begin
  inherited;
  if Assigned(FOnMouseDown) then
    with Message do
      FOnMouseDown(Self, mbRight, KeysToShiftState(Keys), XPos, YPos);
end;

procedure TExProgressbar.WMRButtonUp(var Message: TWMRButtonUp);
begin
  inherited;
  if Assigned(FOnMouseUp) then
    with Message do
      FOnMouseUp(Self, mbRight, KeysToShiftState(Keys), XPos, YPos);
end;

procedure TExProgressbar.WMMButtonDown(var Message: TWMMButtonDown);
begin
  inherited;
  if Assigned(FOnMouseDown) then
    with Message do
      FOnMouseDown(Self, mbMiddle, KeysToShiftState(Keys), XPos, YPos);
end;

procedure TExProgressbar.WMMButtonUp(var Message: TWMMButtonUp);
begin
  inherited;
  if Assigned(FOnMouseUp) then
    with Message do
      FOnMouseUp(Self, mbMiddle, KeysToShiftState(Keys), XPos, YPos);
end;

procedure TExProgressbar.SetValue(SValue: Integer);
begin
  if SValue<=iMaxVal then begin
    SetPosition(SValue);
    iValue:=position;
    Paint;
  end;
end;
procedure TExProgressbar.SetMaxVal(SValue: Integer);
begin
  if SValue=0 then
    iMaxVal:=1
  else iMaxVal:=SValue;
  SetValue(iValue);
end;

procedure TExProgressbar.SetPosition(Pos: Integer);
var ePosition: Extended;
begin
  eposition:=((Width-2)/iMaxVal)*Pos;
  position:=trunc(ePosition);
end;

end.

Ich hoffe mal es ist nicht allzuschlechter Programmierstil. :oops:

Hier noch ein Programm das mein Problem verdeutlicht:

man kann deutlich sehen das zuerst der Rote Balken verschwindet und danach stark ansteigt. zum schluss ist die Progressbar (mit blauem Balken) auf gleicher höhe mit meiner Komponente aber währenddessen nicht.

ich hoffe ihr könnt mir helfen. :flehan:

lg el

Einloggen, um Attachments anzusehen!

_________________

This Signature-Space is intentionally left blank.
Bei Beschwerden, bitte den Beschwerdebutton (gekennzeichnet mit PN) verwenden.

jaenicke · Verfasst: Di 23.01.07 09:21

Der Fehler ist ganz einfach...

elundril hat folgendes geschrieben:

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:

procedure TExProgressbar.Paint;
begin
  inherited;
  if csDesigning in ComponentState then begin
    Canvas.Brush.Style:= bsSolid;
    Canvas.Pen.style := psClear;
    Canvas.Brush.Color:=cBackColor;
    Canvas.Rectangle(0,0,width,height);
    Canvas.Brush.Color:=cForeColor;
    Canvas.Rectangle(2,2,Position-2,height-2);
    exit;
  end;
  Canvas.Brush.Style:=bsSolid;
  Canvas.Brush.Color:=cBackColor;
  Canvas.Pen.Style:=psClear;
  Canvas.Rectangle(0,0,width,height);
  Canvas.Brush.color:=cForeColor;
  Canvas.Pen.Style:=psClear;
  Canvas.Brush.Style:=bsSolid;
  Canvas.Rectangle(2,2,Position-2,height-2);
end;

procedure TExProgressbar.SetPosition(Pos: Integer);
var ePosition: Extended;
begin
  eposition:=((Width-2)/iMaxVal)*Pos;
  position:=trunc(ePosition);
end;

1. Zur Berechnung: Beispiel: Breite = 150 Pixel, MaxValue = 100
In SetPosition kann maximal für die Position 148 herauskommen:
((150 - 2) / 100) * 100 = 150 - 2 = 148
Minimal jedoch 0, ob wohl du ja erst ab 2 zeichnest:
((150 - 2) / 100) * 0 = 0

Dann ziehst du in Paint jedoch nochmal 2 ab!! Der bereich ist jetzt also -2 bis 146... ;-)

Am besten du berechnest es gleich so, dass der Bereich von 2 bis 148 geht:

markieren

Delphi-Quelltext

1:
2:
3:

  Position := Round(((Width - 4) / iMaxVal) * Pos + 2);

  Canvas.Rectangle(2, 2, Position, Height - 2);

Width - 4, weil du ja an beiden Seiten 2 abziehst, der zu berücksichtigende Bereich also 4 kleiner ist, + 2, weil du ja nicht bei 0 sondern bei 2 anfangen willst...
Round statt Trunc, weil sonst aus bspw. 9,9 Pixeln ja 9 werden, es soll aber ja wohl auf 10 gerundet werden!
Und die Variable eposition brauchts ja auch nicht. ;-)

Noch was anderes: Deine Paint-Methode ist etwas seltsam... ;-)

Du machst doch in if genau das gleiche wie danach! Wofür die Unterscheidung???

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:

procedure TExProgressbar.Paint;
begin
  inherited;
  if csDesigning in ComponentState then begin
    Canvas.Brush.Style:= bsSolid;
    Canvas.Pen.style := psClear;
    Canvas.Brush.Color:=cBackColor;
    Canvas.Rectangle(0,0,width,height);
    Canvas.Brush.Color:=cForeColor;
    Canvas.Rectangle(2,2,Position-2,height-2);
    exit;
  end;
  Canvas.Brush.Style:=bsSolid; // hier weist du Brush.Style ja schon zu
  Canvas.Brush.Color:=cBackColor;
  Canvas.Pen.Style:=psClear;
  Canvas.Rectangle(0,0,width,height);
  Canvas.Brush.color:=cForeColor;
  Canvas.Pen.Style:=psClear;
  Canvas.Brush.Style:=bsSolid; // und hier hast du den Wert doch gar nicht geändert!
    // Brush.Style ist also immer noch bsSolid... 
  Canvas.Rectangle(2,2,Position-2,height-2);
end;

Das gleiche gilt für Pen.Style...
Wenn man die unnötigen befehle weglässt, kommt das bei heraus:

markieren

Delphi-Quelltext

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

procedure TExProgressbar.Paint;
begin
  inherited;
  if csDesigning in ComponentState then begin
    Canvas.Brush.Style:= bsSolid;
    Canvas.Pen.style := psClear;
    Canvas.Brush.Color:=cBackColor;
    Canvas.Rectangle(0,0,width,height);
    Canvas.Brush.Color:=cForeColor;
    Canvas.Rectangle(2,2,Position-2,height-2);
    exit;
  end;
  Canvas.Brush.Style:=bsSolid;
  Canvas.Brush.Color:=cBackColor;
  Canvas.Pen.Style:=psClear;
  Canvas.Rectangle(0,0,width,height);
  Canvas.Brush.color:=cForeColor;
  Canvas.Rectangle(2,2,Position-2,height-2);
end;

Hmm, jetzt noch das Pen.Style vor Brush.Color und es ist nicht nur dasselbe, sondern dann siehsts auch exakt genauso aus. ;-)

Das ist also genau dasselbe wie das:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

procedure TExProgressbar.Paint;
begin
  inherited;
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Style := psClear;
  Canvas.Brush.Color := cBackColor;
  Canvas.Rectangle(0, 0, Width, Height);
  Canvas.Brush.Color := cForeColor;
  Canvas.Rectangle(2, 2, Position - 2, Height - 2);
end;

Gut. Jetzt nur noch ein Problem:
Du setzt Pen.Style auf psClear. Das heißt als Rahmen wird nicht die Rechteck-Farbe gezeichnet! Damit sieht man bei 1 gar nix, obwohl ja eigentlich ein Pixel gezeichnet werden müsste. Nur: Ein Rechteck von nur einem Pixel Breite, wobei das Pixel der Rahmen, also das von Pen gezeichnete ist, sieht man bei psClear halt nicht...

:arrow:

Deshalb: So isses richtig:

markieren

Delphi-Quelltext

1:
2:
3:
4:

procedure TExProgressbar.SetPosition(Pos: Integer);
begin
  Position := Round(((Width - 4) / iMaxVal) * Pos + 2);
end;

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

procedure TExProgressbar.Paint;
begin
  inherited;
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Style := psSolid;
  Canvas.Brush.Color := cBackColor;
  Canvas.Pen.Color := cBackColor;
  Canvas.Rectangle(0, 0, Width, Height);
  Canvas.Brush.Color := cForeColor;
  Canvas.Pen.Color := cForeColor;
  Canvas.Rectangle(2, 2, Position, Height - 2);
end;

elundril · Verfasst: Mi 24.01.07 14:11

ok danke!! beim -2 usw hab ich mir eh sowas in der art gedacht aber auf die Lösung wäre ich nie gekommen! danke!

das mit dem If-hab ich nur obligatorisch drin gelassen weil es so auf DGL-Wiki steht beim Komponenten entwickeln.

das mit dem PenStyle versteh ich nicht. könnt/est man/du mir das nochmal erklären wozu ich das brauche??

lg el

_________________

This Signature-Space is intentionally left blank.
Bei Beschwerden, bitte den Beschwerdebutton (gekennzeichnet mit PN) verwenden.

jaenicke · Verfasst: Mi 24.01.07 14:30

Was das if angeht: Manchmal kann man nicht alles genauso zur Designzeit machen wie wenn das Programm läuft. Aber sonst braucht man es auch nicht.

Pen.Style? Naja, deine Koordinaten für das Rechteck enthalten auch einen Rahmen! Und wenn du den nicht zeichnest (psClear ;-)

), dann ist der halt schwarz. Problem: Wenn du nur ein ein Pixel breites Rechteck hast, dann ist dieser eine Pixel der Rahmen. Und der ist halt schwarz wegen psClear...

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme