Autor |
Beitrag |
Benjie
Beiträge: 55
Win 98 SE / Win XP / xubuntu Linux / Mac OS 9.2
D6 Enterprise
|
Verfasst: So 13.04.08 16:52
Hey Leute
ich bastle immer wieder gerne Dinge nach. So auch die Progressbar wie sie in OS X Leopard vorkommt. Die sieht nämlich massiv schöner aus, als die in Windows. Sie ist recht gut gelungen und ich dachte mir, vielleicht nützt sie ja mal jemandem. Deshalb hab ich hier mal ein Beispiel mit dokumentierter Source hochgeladen.
Man braucht für die Progressbar eine paintbox und einen timer. Viel spass damit, wer's brauchen kann!
P.s.: sollte es bei jemandem nicht funktionieren, bitte melden.
Grietz, Benjie
Moderiert von Christian S.: Topic aus Multimedia / Grafik verschoben am So 13.04.2008 um 19:05
Moderiert von Benjie: Neue Version hochgeladen
Moderiert von Narses: BMP in JPG konvertiert
Einloggen, um Attachments anzusehen!
Zuletzt bearbeitet von Benjie am Do 17.04.08 21:24, insgesamt 1-mal bearbeitet
|
|
Fabian E.
Beiträge: 554
Windows 7 Ultimate
Visual Studio 2008 Pro, Visual Studion 2010 Ultimate
|
Verfasst: So 13.04.08 18:41
ja das sieht doch schon ganz nett aus.
vielleicht kannst du ja eine eigene komponente daraus machen, dann kann man es einfacher benutzen.
gruß
|
|
matze
Beiträge: 4613
Erhaltene Danke: 24
XP home, prof
Delphi 2009 Prof,
|
Verfasst: So 13.04.08 19:00
Ganz meine Meinung. Es wäre cool, wenn du eine Komponente daraus bauen könntest und diese dann in der OpenSource Units Sektion vorstellen könntest.
_________________ In the beginning was the word.
And the word was content-type: text/plain.
|
|
Benjie
Beiträge: 55
Win 98 SE / Win XP / xubuntu Linux / Mac OS 9.2
D6 Enterprise
|
Verfasst: So 13.04.08 19:03
Jo! Danke für den Tipp! Das hatte ich mir auch schon gedacht. Nur: ich hab noch nie selber eine Komponente gemacht und weiss deshalb nich ganz, wie das läuft. Wie krieg ich denn die Paintbox und den TImer zusammen? Wäre voll cool, wenn jemand von euch mir da n bissl helfen könnte. Die eigene Komponente wäre nämlich mal was.
Grietz, Benjie
|
|
Fabian E.
Beiträge: 554
Windows 7 Ultimate
Visual Studio 2008 Pro, Visual Studion 2010 Ultimate
|
Verfasst: Mo 14.04.08 19:49
ich hab zwar selber noch nie eine Koponente entwickelt, aner ich denke ich würde eine klasse machen und diese von der paintbox ableiten. die ist dann zum zeichen da. evtl auch einfach nur ne klassenvariable als paintbox. den timer würde ich genau in der klasse als vairable deklarieren.
gruß
|
|
Heiko
Beiträge: 3169
Erhaltene Danke: 11
|
Verfasst: Mo 14.04.08 20:18
Oder die Timer-API selber nutzten. Dann kannste den Delphi-Timer dir sonst wohin schieben .
|
|
Andreas L.
Beiträge: 1703
Erhaltene Danke: 25
Windows Vista / Windows 10
Delphi 2009 Pro (JVCL, DragDrop, rmKlever, ICS, EmbeddedWB, DEC, Indy)
|
Verfasst: Mo 14.04.08 20:41
Folgendes ist wahrscheinlich ziemlich buggy und auf jedenfall erweiterbar. Naja, soll dir ja nur als kleinen Denkanstoß dienen.
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:
| unit AppleProgressBar;
interface
uses SysUtils, Classes, Controls, ExtCtrls, Graphics;
type TAppleProgressBar = class(TPaintBox) private FEnabled: Boolean; FAnim: Integer; FPosition: Integer; FAnimated: Boolean; FTimer: TTimer; FBar: TBitmap; FInactiveBar: TBitmap; FBarBGLeft: TBitmap; FBarBGRight: TBitmap; FBarBG: TBitmap; protected procedure SetEnabled(Value: Boolean); procedure SetPosition(Value: Integer); procedure SetAnimated(Value: Boolean); procedure DoTimer(Sender: TObject); procedure SetBar(Value: TBitmap); procedure SetInactiveBar(Value: TBitmap); procedure SetBarBGLeft(Value: TBitmap); procedure SetBarBgRight(Value: TBitmap); procedure SetBarBG(Value: TBitmap); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Repaint; override; published property Enabled: Boolean read FEnabled write SetEnabled; property Position: Integer read FPosition write SetPosition; property Animated: Boolean read FAnimated write SetAnimated; property Bar: TBitmap read FBar write SetBar; property InactiveBar: TBitmap read FInactiveBar write SetInactiveBar; property BarBGLeft: TBitmap read FBarBGLeft write SetBarBGLeft; property BarBGRight: TBitmap read FBarBGRight write SetBarBGRight; property BarBG: TBitmap read FBarBG write SetBarBG; end;
procedure Register;
implementation
procedure Register; begin RegisterComponents('CapSystems', [TAppleProgressBar]); end;
constructor TAppleProgressBar.Create(AOwner: TComponent); begin inherited Create(AOwner); FEnabled := True; FPosition := 0; FAnimated := False; FTimer := TTimer.Create(Self); with FTimer do begin OnTimer := DoTimer; Enabled := False; Interval := 50; end; FAnim := 0; FBar := TBitmap.Create; FInactiveBar := TBitmap.Create; FBarBGLeft := TBitmap.Create; FBarBGRight := TBitmap.Create; FBarBG := TBitmap.Create; end;
destructor TAppleProgressBar.Destroy; begin FTimer.Free; FBar.Free; FBarBGLeft.Free; FBarBGRight.Free; FBarBG.Free; FInactiveBar.Free; inherited Destroy; end;
procedure TAppleProgressBar.Repaint; var i, p: Integer; tmpImage: TBitmap; begin p := 0; Canvas.Draw(0, 0, FBarBGLeft); Canvas.Draw(Width - 3, 0, FBarBGRight); tmpImage := TBitmap.Create; if FEnabled then tmpImage.Assign(FBar) else tmpImage.Assign(FInactiveBar);
for i := Width downto 1 do begin if (i - 8 - p * 7 - FAnim) > -16 then Canvas.Draw(i - 8 - p * 7 - FAnim, 0, tmpImage) else FAnim := FAnim - 8; Inc(p); if p = 8 then p := 0; end; tmpImage.Free; Canvas.StretchDraw(Rect(Round(Width div 100 * FPosition), 0, Width, 12), FBarBG); end;
procedure TAppleProgressBar.SetEnabled(Value: Boolean); begin FEnabled := Value; Repaint; end;
procedure TAppleProgressBar.SetPosition(Value: Integer); begin FPosition := Value; Repaint; end;
procedure TAppleProgressBar.SetAnimated(Value: Boolean); begin FAnimated := Value; FTimer.Enabled := Value; Repaint; end;
procedure TAppleProgressbar.DoTimer(Sender: TObject); begin if FAnimated then begin Inc(FAnim); Refresh; end; end;
procedure TAppleProgressbar.SetBar(Value: TBitmap); begin FBar.Assign(Value); end;
procedure TAppleProgressbar.SetInactiveBar(Value: TBitmap); begin FInactiveBar.Assign(Value); end;
procedure TAppleProgressbar.SetBarBGLeft(Value: TBitmap); begin FBarBGLeft.Assign(Value); end;
procedure TAppleProgressbar.SetBarBgRight(Value: TBitmap); begin FBarBGRight.Assign(Value); end;
procedure TAppleProgressbar.SetBarBG(Value: TBitmap); begin FBarBG.Assign(Value); end;
end. |
Wie man Komponenten installiert weiß tu ja?!?
|
|
Benjie
Beiträge: 55
Win 98 SE / Win XP / xubuntu Linux / Mac OS 9.2
D6 Enterprise
|
Verfasst: Mo 14.04.08 21:48
Cool! Danke für "Denkanstoss" Andreas. Ich werd mich dransetzten, sobald ich mal Zeit habe. Wahrscheinlich zwar nicht vor Mittwoch, weil wir dann eine riesige Geologie-Prüfung schreiben müssen. Oh es gibt nichts spannenderes und wichtigeres als Gesteinsschichten auswendig zu lernen!
Danke nochmal! Grietz, Benjie
|
|
Benjie
Beiträge: 55
Win 98 SE / Win XP / xubuntu Linux / Mac OS 9.2
D6 Enterprise
|
Verfasst: Mi 16.04.08 20:00
Titel: Komponente Fertig!
Also. Ich habe nach dem Beispiel von Andreas die Komponente fertiggestellt. Es funktioniert alles und sie sieht auch ordentlich aus. Einzige Bedingung für das Ding ist, dass Doublebuffered im Parent auf true gestellt wird, sonst gibt's so ein hässliches Geflacker. Obwohl ich (fast) den ganzen Tag dran rumgebastelt hab, hab ich's nicht geschafft das Geflacker ohne doublebuffered wegzukriegen.
Ja. Probiert die Kompo doch mal aus und meldet es mir, wenn was nicht funktionieren sollte (oder eine Datei fehlt: ich war mir nicht ganz sicher, was ich alles mitreinpacken muss). Ich hab sie zusammen mit den Bildern in ein Ziparchiv gepackt. Selbstverständlich kann man aber auch andere Bilder nehmen.
Danke nochmal für die Tipps!
Grietz, Benjie
Einloggen, um Attachments anzusehen!
|
|
Heiko
Beiträge: 3169
Erhaltene Danke: 11
|
Verfasst: Mi 16.04.08 20:15
Hallo Benjie,
ich hab mal kurz in den Code reingeguckt bzgl. DoubleBuffering. Die Ursache liegt in deiner Paint-Methode.
Zur Behebung (sollte man bei Canvas immer nehmen, egal mit welchem Ziel): Nimm ein Zwichenbitmap auf dem du alles zeichnest. Aber wirklich alles. Übertrage es anschließend in einem Schwung.
|
|
Benjie
Beiträge: 55
Win 98 SE / Win XP / xubuntu Linux / Mac OS 9.2
D6 Enterprise
|
Verfasst: Mi 16.04.08 21:35
Hallo Heiko,
danke für deinen Tipp. Ich hab's mit nem Bitmap probiert, aber es flackert immer noch ohne doublebuffered. Mach ich da was falsch?
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:
| procedure TAppleProgressBar.paint; var i,p:integer; tmpImage:TBitmap; begin p:=0; tmpcanvas.width := width; tmpcanvas.height := FbarBG.Height; tmpcanvas.canvas.Draw(0,0,FbarBGleft); tmpcanvas.canvas.Draw(Width-3,0,FbarBGRight); tmpImage := TBitmap.Create; if FColorMode=Blue then tmpImage.Assign(FBar) else tmpImage.Assign(FInactiveBar);
for i:=Width downto 1 do BEGIN if (i-bar.Width-p*(bar.Width-1)-FAnim)>-bar.Width*2 then tmpcanvas.canvas.Draw(i-bar.Width-p*(bar.Width-1)-FAnim,0,tmpimage) else FAnim:=FAnim-bar.Width; inc(p); if p=bar.Width then p:=0; end;
tmpImage.Free; tmpcanvas.Canvas.StretchDraw(rect(round(Width/100*FPosition),0,Width,12),FbarBG); Canvas.Draw(0,0,tmpcanvas); end; |
Grietz, Benjie
|
|
Heiko
Beiträge: 3169
Erhaltene Danke: 11
|
Verfasst: Mi 16.04.08 21:44
Hallo Benjie,
auf den ersten Blick nicht. Es könnte noch an der Delphi-Kapselung liegen. Ich werde am Wochenende mir es vlt. mal genauer anschauen. Jetzt habe ich wahrscheinlich nicht genug Nerven dafür.
PS: Sollte ichs vergessen, erinnere mich mal (hab Monatg meinen letzten Schultag, wes wegen ich soetwas ggf. erfolgreich verdränge )
|
|
Benjie
Beiträge: 55
Win 98 SE / Win XP / xubuntu Linux / Mac OS 9.2
D6 Enterprise
|
Verfasst: Do 17.04.08 13:17
Ich hab vielleicht heute noch ein bissl Zeit, um dran runmzubasteln. Vielleicht krieg ich es ja hin. Wenn nicht, werde ich dich dran erinnern, wenn du's vergisst!
was denkt ihr, könnte das Geflacker an der Procedur-art liegen (TAppleProgressBar.paint;)? Man könnte sie ja auch zu einem anderen Ereignis aufrufen...
Grietz, Benjie
|
|
Benjie
Beiträge: 55
Win 98 SE / Win XP / xubuntu Linux / Mac OS 9.2
D6 Enterprise
|
Verfasst: Do 17.04.08 21:20
Also. Ich hab's es flackert jetzt auch ohne doublebuffered nicht mehr. Es lag tatsächlich an der Procedur-art: Ich hab sie vom Paint- Ereignis zum Repaint-Ereignis geändert - Fertig! Hab die neue Version gleich mal hochgeladen. Bei mir läufts, bin gespannt, ob es bei auch tut.
Grietz, Benjie
|
|
Heiko
Beiträge: 3169
Erhaltene Danke: 11
|
Verfasst: Fr 18.04.08 07:09
Du kannst die Message hier abfangen:
Delphi-Quelltext 1: 2: 3: 4:
| procedure TSBControl.WMEraseBkgnd(var Msg: TWMEraseBkgnd); begin Msg.Result:=1; end; |
Diese eine Zeile fügt man bei OpenGL-Apps meistens ein.
|
|
Benjie
Beiträge: 55
Win 98 SE / Win XP / xubuntu Linux / Mac OS 9.2
D6 Enterprise
|
Verfasst: Sa 19.04.08 13:17
Hallo Heiko.
Sorry, aber ich blick grad nicht mehr durch: Welche Message soll ich mit dieser Procedur Abfangen?
Und wiese OpenGL? Ich hab echt keine Ahnung, was du damit meinst.
Grietz, Benjie
|
|
Heiko
Beiträge: 3169
Erhaltene Danke: 11
|
Verfasst: Sa 19.04.08 14:06
Zur Message siehe MSDN.
@OpenGl: Da fängt man die Message standardmäßig ab, wenn man nur beim OnPaint-Ereignis was zeichnet, um die CPU zu entlasten, da dieser Nachricht immer OnPaint folgt, weswegen man diese ingorieren kann .
|
|
Fabian E.
Beiträge: 554
Windows 7 Ultimate
Visual Studio 2008 Pro, Visual Studion 2010 Ultimate
|
Verfasst: Sa 19.04.08 15:03
Also ich habe mir das jetzt schonmal angeschaut. Sieht alles schon recht gut aus, das die einzigen zwei sachen die mich stören sind, dass man die grafiken per hand aussuchen muss und dass man die größe der paintbox zwar verändern kann die bar aber genauso bleibt. also entweder das anpassen oder die größe unveränderbar machen.
zu der sache mit den grafiken... diese könntest du ja in einer res datei speichern und dann auch im lib verzeichnis von delphi kopieren lassen. dann wäre das erledigt.
gruß
|
|
Karlson
Beiträge: 2088
|
Verfasst: So 20.04.08 17:57
Toll! Gefällt mir sehr gut!
|
|
Benjie
Beiträge: 55
Win 98 SE / Win XP / xubuntu Linux / Mac OS 9.2
D6 Enterprise
|
Verfasst: Mi 23.04.08 18:26
Hallo ihr. Ich war in einem Musiklager, daher schreib ich erst heute wieder...
Ein paar Antworten auf eure posts:
@ Fabian E.: Das mit den Grafiken wäre sehr schön in der res-datei, nur sind die bei mir maximal 256 farben, was echt sch...lecht aussieht. Deshalb das umständliche gesuche. Aber wenn man mal eine Progressbar gemacht hat, kann man sie ja einfach kopieren.
Das mit der Höhe: Die ist natürlich immer genau so hoch, wie die Grafik des hintergrundes. Nur weiss ich nicht, wie man Eigenschaften von vorgängerkomponenten enfernen kann. Wenn mir das jemand schreiben könnte, würd ich es sofort ändern.
@ Karlson: Danke!
Grietz, Benjie
|
|