| Autor |
Beitrag |
Gothicware
  
Beiträge: 77
Win 98, Win 2000, Win XP, BeOs-R5, Zeta 1.0(war nicht gut, also verkauft), KnoppiX, VM-Ware
D4 Client/Server, Turbo Basic, QBasic, Atari-Basic
|
Verfasst: Mi 18.08.04 23:34
Ohne Viele Worte, "Take it, or leave it!"
Mach damit was ihr wollt. Ich habs nur gemacht, weil ich nicht einschlafen konnte. 
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:
| unit GW_LodeBar;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TGW_LodeBar = class(TGraphicControl)
private
FColor: TColor;
FBorderColor: TColor;
FFaceColor: TColor;
FBorderSize: Integer;
FSpace:Integer;
FPercent: Integer;
procedure SetColor(Value: TColor);
procedure SetBorderColor(Value: TColor);
procedure SetFaceColor(Value: TColor);
procedure SetBorderSize(Value: Integer);
procedure SetSpace(Value: Integer);
procedure SetPercent(Value: Integer);
protected
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
public
published
property Color: TColor read FColor write SetColor;
property BorderColor: TColor read FBorderColor write SetBorderColor;
property FaceColor: TColor read FFaceColor write SetFaceColor;
property BorderSize: Integer read FBorderSize write SetBorderSize;
property Space: Integer read FSpace write SetSpace;
property Percent: Integer read FPercent write SetPercent;
end;
procedure Register;
implementation
constructor TGW_LodeBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 100;
Height := 22;
end;
destructor TGW_LodeBar.Destroy;
begin
inherited Destroy;
end;
function CanvastoBitmap(Canvas: TCanvas; Width,Height: Integer):TBitmap;
var hRect: TRect;
begin
result := TBitmap.Create;
result.Width := Width;
result.Height := Height;
hRect := Rect(0,0,Width,Height);
result.Canvas.CopyRect(hRect,Canvas,hRect);
end;
function ColorFade(fecolor, fbcolor: TColor; State: Integer):TColor;
var
i, j, h, w, fcolors: Integer;
R, G, B: Longword;
beginRGBvalue, RGBdifference: array[0..2] of Longword;
begin
beginRGBvalue[0] := GetRvalue(colortoRGB(FBcolor));
beginRGBvalue[1] := GetGvalue(colortoRGB(FBcolor));
beginRGBvalue[2] := GetBvalue(colortoRGB(FBcolor));
RGBdifference[0] := GetRvalue(colortoRGB(FEcolor)) - beginRGBvalue[0];
RGBdifference[1] := GetGvalue(colortoRGB(FEcolor)) - beginRGBvalue[1];
RGBdifference[2] := GetBvalue(colortoRGB(FEcolor)) - beginRGBvalue[2];
j := 0;
fcolors := 10;
for i := 10 downto State do
begin
if fcolors > 1 then
begin
R := beginRGBvalue[0] + muldiv(j, RGBDifference[0], fcolors);
G := beginRGBvalue[1] + muldiv(j, RGBDifference[1], fcolors);
B := beginRGBvalue[2] + muldiv(j, RGBDifference[2], fcolors);
end;
result := RGB(R, G, B);
Inc(j);
end;
end;
procedure TGW_LodeBar.SetColor(Value: TColor);
begin
if Value <> FColor then
begin
FColor := Value;
Invalidate;
end;
end;
procedure TGW_LodeBar.SetBorderColor(Value: TColor);
begin
if Value <> FBorderColor then
begin
FBorderColor := Value;
Invalidate;
end;
end;
procedure TGW_LodeBar.SetFaceColor(Value: TColor);
begin
if Value <> FFaceColor then
begin
FFaceColor := Value;
Invalidate;
end;
end;
procedure TGW_LodeBar.SetBorderSize(Value: Integer);
begin
if Value <> FBorderSize then
if Value > -1 then
if (Value < (Width div 2)) or (Value < (Height div 2)) then
begin
FBorderSize := Value;
Invalidate;
end
else application.MessageBox(PChar('Value must be smaller then 50% of Height and Width!'),PChar('Warrning'),$00000030)
else application.MessageBox(PChar('Value must be 0 or bigger!'),PChar('Warrning'),$00000030);
end;
procedure TGW_LodeBar.SetSpace(Value: Integer);
begin
if Value <> FSpace then
if (Value > (0 - (Width div 2))) or (Value > (0 - (Height div 2))) then
if (Value < (Width div 2)) or (Value < (Height div 2)) then
begin
FSpace := Value;
Invalidate;
end
else application.MessageBox(PChar('Value must be smaller then 50% of Height and Width!'),PChar('Warrning'),$00000030)
else application.MessageBox(PChar('Value must be bigger then 0 - 50% of Height and Width!'),PChar('Warrning'),$00000030);
end;
procedure TGW_LodeBar.SetPercent(Value: Integer);
begin
if Value <> FPercent then
if Value > -1 then
if (Value < 101) then
begin
FPercent := Value;
Invalidate;
end
else application.MessageBox(PChar('Value must be 100 or smaller!'),PChar('Warrning'),$00000030)
else application.MessageBox(PChar('Value must be 0 or bigger!'),PChar('Warrning'),$00000030);
end;
procedure TGW_LodeBar.Paint;
var i,c,cS,cX,CY: Integer;
begin
Canvas.Pen.Color := Color;
Canvas.Brush.Color := Color;
Canvas.Brush.Style := bsSolid;
Canvas.Rectangle(0,0,width,height);
Canvas.Pen.Color := BorderColor;
Canvas.Brush.Style := bsClear;
if BorderSize > 0 then for i := 0 to BorderSize do Canvas.Rectangle(i -1,i -1,Width -i +1,Height -i +1);
Canvas.Pen.color := BorderColor;
Canvas.Brush.Color := FaceColor;
Canvas.Brush.Style := bsSolid;
if (Height - (BorderSize * 2)) > ((Width div 10) - (BorderSize *2)) then cS := ((Width div 10)- (BorderSize *2))
else cS := (Height - (BorderSize *2));
if (percent div 10) > 0 then
for c := 1 to (percent div 10) do
begin
cX := ((Width - (cS * 10)) div 2) + BorderSize + (cS * c) - cS;
cY := (Height div 2) - (cS div 2);
Canvas.Pen.Color := BorderColor;
canvas.Ellipse(cX,cY + (Space div 2),cX + cS - Space,cY + cS - (Space div 2));
end;
if (percent - ((Percent div 10)*10)) > 0 then
begin
c := (percent div 10) +1;
Canvas.Brush.Color := ColorFade(Color,FaceColor,(percent - ((Percent div 10)*10)));
Canvas.Pen.Color := ColorFade(Color,BorderColor,(percent - ((Percent div 10)*10)));
cX := ((Width - (cS * 10)) div 2) + BorderSize + (cS * c) - cS;
cY := (Height div 2) - (cS div 2);
canvas.Ellipse(cX,cY + (Space div 2),cX + cS - Space,cY + cS - (Space div 2));
end;
end;
procedure Register;
begin
RegisterComponents('Gothicware', [TGW_LodeBar]);
end;
end. |
Moderiert von  Tino: Code- durch Delphi-Tags ersetzt.
|
|
MathiasSimmack
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Do 19.08.04 12:39
| Gothicware hat folgendes geschrieben: | | Ohne Viele Worte |
Eigentlich schade. Man sollte schon wissen worauf man sich einlässt, ohne vorher den Quellcode analysieren zu müssen.
| Zitat: | | Mach damit was ihr wollt. Ich habs nur gemacht, weil ich nicht einschlafen konnte. |
Merkt man. Ist nicht mal böse gemeint.
1. Deine englischen Meldungen lassen doch zu wünschen übrig. "Warning" mit zwei R, "than" mit E anstelle von A.
2. Unterbricht dein ... was ist das eigentlich? (tja, keine Beschreibung vorhanden) ... den Programmablauf mit einer unschönen Meldung, wenn der User versehentlich nicht passende Werte benutzt hat. Wenn du die Werte schon prüfst und merkst, dass sie nicht zusammenpassen, warum korrigierst du sie nicht kurzerhand anstelle eine ohnehin falsch geschriebene englische Meldung anzuzeigen?
|
|
Gothicware 
Beiträge: 77
Win 98, Win 2000, Win XP, BeOs-R5, Zeta 1.0(war nicht gut, also verkauft), KnoppiX, VM-Ware
D4 Client/Server, Turbo Basic, QBasic, Atari-Basic
|
Verfasst: Do 19.08.04 13:14
Naja, mein Deutsch ist auch nicht besser! 
Ok, das ganze ist ein Progressbar, der 10 Kreisse bei 100% Anzeigt. [oooooooooo]
Die Messages sind ja dafür da, das der Benutzer weiss, wo sein Fehler liegt.
Und wiegesagt, mir war langweilig, ich konnte nicht Einschlafen, und hatte keine wirklichen Ideen. 
Take it! Or leave it!
|
|
MathiasSimmack
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Do 19.08.04 13:56
| Gothicware hat folgendes geschrieben: | | Naja, mein Deutsch ist auch nicht besser! |
Das mag ja sein, aber warum besserst du nicht einfach mal deinen Quellcode aus? Wozu habe ich dich denn sonst darauf hingewiesen? Etwa weil es mir Spaß macht? ... Ja, das auch ...
| Zitat: | | Die Messages sind ja dafür da, das der Benutzer weiss, wo sein Fehler liegt. |
Das habe ich schon begriffen. Aber wie gesagt, der Programmablauf wird dadurch u.U. unterbrochen. Solange der User im Objektinspektor falsche Werte angibt, solange mag es ja okay sein, ihm dann eine Meldung zu zeigen (die dann aber korrekt sein sollte). Wenn aber der User aber die Werte im Programm ändert, vllt. sogar durch eine Berechnung, die evtl. falsche Werte erzeugt (Bugs lauern bekanntlich überall), dann ist es für den Anwender (der das Programm dann benutzen muss) sicher nicht besonders schön, ständig Boxen wegklicken zu müssen.
| Zitat: | | Take it! Or leave it! |
Ich tendiere eher zu leave it. Aber das liegt auch daran, dass mir der normale Progressbar reicht. Aber sei´s drum, ich wollte dich nur auf zwei Stolperfallen aufmerksam machen, die du ausbessern kannst wenn dir an deiner Komponente ein bisschen was liegt.
Außerdem macht es keinen besonders guten Eindruck, wenn man dich (als Entwickler) auf kleine Probleme hinweist und du nur schreibst: "Ich konnte nicht einschlafen." Das hört sich so an wie: "Die Komponente entstand nur nebenbei. Sie ist völlig idiotisch. Ich hatte nur nichts besseres mit meiner Zeit zu tun. Es sind Fehler drin? Mir doch egal."
Fazit: Ich mache um solche Komponenten, die ich selbst ausbessern muss, einen Bogen.
|
|
|
