Autor |
Beitrag |
Böser Borstel
Beiträge: 154
|
Verfasst: Do 30.09.04 12:49
hatte bißchen langeweile, habe den forum durch forstet und habe mal gelesen jemand möchte gerne so eine uhr.
bitte hier ist sie.
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:
| TClock = class private FPicture: TPicture; FBrush, FPen : TColor; FBack, FClock, FImage: TImage; FTimer: TTimer; procedure Circle; procedure FOnTimer(Sender: TObject); procedure SetBrush(AValue: TColor); procedure SetPen(AValue: TColor); procedure SetPicture(AValue: TPicture); public constructor Create(const ARect: TRect; const AParent: TWinControl); destructor Destroy; override; published property BrushColor: TColor read FBrush write SetBrush; property PenColor: TColor read FPen write SetPen; property Picture: TPicture read FPicture write SetPicture; end; implementation
constructor TClock.Create(const ARect: TRect; const AParent: TWinControl); begin inherited Create; FPen := clBlack; FBrush := clWhite; FPicture := TPicture.Create; FBack := TImage.Create(AParent); FClock := TImage.Create(AParent); FImage := TImage.Create(AParent); with FBack do begin Parent := AParent; Left := ARect.Left; Top := ARect.Top; Width := ARect.Right - Left; if Width < 50 then Width := 50; Height := ARect.Bottom - Top; if Height < 50 then Height := 50; end; with FClock do begin Parent := AParent; Transparent := TRUE; Left := FBack.Left; Top := FBack.Top; Width := FBack.Width; Height := FBack.Height; Circle; end; with FImage do begin Transparent := TRUE; Parent := AParent; Left := FBack.Left; Top := FBack.Top; Width := FBack.Width; Height := FBack.Height; Canvas.Pen.Width := (Width + Height) div 100; end; FTimer := TTimer.Create(AParent); with FTimer do begin Interval := 1000; OnTimer := FOnTimer; Enabled := TRUE; end; end; procedure TClock.Circle; begin with FClock do with Canvas do begin Pen.Width := (Width + Height) div 100; Pen.Color := Parent.Brush.Color; Brush.Color := Parent.Brush.Color; Font.Style := Font.Style + [fsBold]; Font.Size := (Width + Height) div 30; Font.Color := FPen; Rectangle(Rect(Left, Top, Left + Width, Top + Height)); Pen.Color := FPen; if (FBack.Picture.Graphic = nil) or (FBack.Picture.Graphic.Empty) then Brush.Color := FBrush; Ellipse(Rect(Left, Top, Left + Width, Top + Height)); TextOut((Width - TextWidth('12')) div 2, Pen.Width + 2, '12'); TextOut((Width - TextWidth('6')) div 2, Height - TextHeight('6') - Pen.Width, '6'); TextOut(Left + 2 + Pen.Width, (Height - TextHeight('9')) div 2, '9'); TextOut(Width - TextWidth('3') - 2 - Pen.Width, (Height - TextHeight('3')) div 2, '3'); end; end; procedure TClock.FOnTimer(Sender: TObject); var Default: Integer; Hour, Min, Sec, MSec: Word; begin DecodeTime(Now, Hour, Min, Sec, MSec); Sec := Sec * 6; Min := Min * 6; Hour := Hour * 30; with FImage do begin with Canvas do begin if FPen <> clWhite then CopyMode := cmWhiteness else CopyMode := cmBlackness; CopyRect(FImage.BoundsRect, Canvas, FImage.BoundsRect); Pen.Color := FPen; MoveTo(Width div 2, Height div 2); LineTo(Width div 2 + Trunc(Sin(DegToRad(Sec)) * (Width div 2 - Width div 8)), Height div 2 + Trunc(Cos(DegToRad(Sec)) * - (Height div 2 - Height div 8))); MoveTo(Width div 2, Height div 2); Default := Pen.Width; Pen.Width := Pen.Width + 1; LineTo(Width div 2 + Trunc(Sin(DegToRad(Min)) * (Width div 2 - Width div 8)), Height div 2 + Trunc(Cos(DegToRad(Min)) * - (Height div 2 - Height div 8))); MoveTo(Width div 2, Height div 2); Pen.Width := Pen.Width + 1; LineTo(Width div 2 + Trunc(Sin(DegToRad(Hour)) * (Width div 3)), Height div 2 + Trunc(Cos(DegToRad(Hour)) * - (Height div 3))); Pen.Width := Default; end; end; end; procedure TClock.SetBrush(AValue: TColor); begin if FBrush <> AValue then begin FBrush := AValue; Circle; FOnTimer(FTimer); end; end; procedure TClock.SetPen(AValue: TColor); begin
if FPen <> AValue then begin FPen := AValue; Circle; FOnTimer(FTimer); end; end; procedure TClock.SetPicture(AValue: TPicture); begin FPicture.Assign(AValue); with FBack do begin Width := FImage.Width; Height := FImage.Height; Picture.Assign(FPicture); Stretch := TRUE; Circle; FOnTimer(FTimer); end; end; destructor TClock.Destroy; begin FImage.Free; FPicture.Free; FBack.Free; FClock.Free; FTimer.Free; inherited Destroy; end; |
[meta]
uhr, analog, hintergrundbild
[/meta]
Moderiert von Udontknow: Code- durch Delphi-Tags ersetzt, Thema verschoben.
|
|
Udontknow
Beiträge: 2596
Win7
D2006 WIN32, .NET (C#)
|
Verfasst: Di 05.10.04 15:15
Hallo!
Mach doch aus dem TObject- einen TPanel-Nachfahren und nimm direkt diesen als Parent, so kann man die TClock-Class dann auch als visuelle Komponente per RegisterComponents in der Komponentenleiste einfügen.
Cu,
Udontknow
|
|
Böser Borstel
Beiträge: 154
|
Verfasst: Di 05.10.04 15:27
keine schlechte idee, mal sehen wann ich dazu zeit finde
|
|
Mr Anderson
Hält's aus hier
Beiträge: 5
|
Verfasst: Di 23.11.04 18:59
ích habe eine kleine Frage zu diesem Code:
Nachdem ich ihn eingebunden habe erhalte ich eine Zugriffsverletzung :
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:
| unit mUhr_v2;
interface
uses Forms, Windows, Messages, SysUtils, Variants, Classes, Controls, Dialogs, ExtCtrls, math, Graphics;
type TClock = class (TObject) private FPicture: TPicture; FBrush,FPen : TColor; FBack,FClock,FImage: TImage; FTimer: TTimer; procedure Circle; procedure FOnTimer(Sender: TObject); procedure SetBrush(AValue: TColor); procedure SetPen(AValue: TColor); procedure SetPicture(AValue: TPicture); public constructor Create(const ARect: TRect; const AParent: TWinControl); destructor Destroy; override; published property BrushColor: TColor read FBrush write SetBrush; property PenColor: TColor read FPen write SetPen; property Picture: TPicture read FPicture write SetPicture; end; implementation
constructor TClock.Create(const ARect: TRect; const AParent: TWinControl); begin inherited Create; FPen := clBlack; FBrush := clWhite; FPicture := TPicture.Create; FBack := TImage.Create(AParent); FClock := TImage.Create(AParent); FImage := TImage.Create(AParent); with FBack do begin Parent := AParent; Left := ARect.Left; Top := ARect.Top; Width := ARect.Right - Left; if Width < 50 then Width := 50; Height := ARect.Bottom - Top; if Height < 50 then Height := 50; end; with FClock do begin Parent := AParent; Transparent := TRUE; Left := FBack.Left; Top := FBack.Top; Width := FBack.Width; Height := FBack.Height; Circle; end; with FImage do begin Transparent := TRUE; Parent := AParent; Left := FBack.Left; Top := FBack.Top; Width := FBack.Width; Height := FBack.Height; Canvas.Pen.Width := (Width + Height) div 100; end; FTimer := TTimer.Create(AParent); with FTimer do begin Interval := 1000; OnTimer := FOnTimer; Enabled := TRUE; end; end; procedure TClock.Circle; begin with FClock do with Canvas do begin Pen.Width := (Width + Height) div 100; Pen.Color := Parent.Brush.Color; Brush.Color := Parent.Brush.Color; Font.Style := Font.Style + [fsBold]; Font.Size := (Width + Height) div 30; Font.Color := FPen; Rectangle(Rect(Left, Top, Left + Width, Top + Height)); Pen.Color := FPen; if (FBack.Picture.Graphic = nil) or (FBack.Picture.Graphic.Empty) then Brush.Color := FBrush; Ellipse(Rect(Left, Top, Left + Width, Top + Height)); TextOut((Width - TextWidth('12')) div 2, Pen.Width + 2, '12'); TextOut((Width - TextWidth('6')) div 2, Height - TextHeight('6') - Pen.Width, '6'); TextOut(Left + 2 + Pen.Width, (Height - TextHeight('9')) div 2, '9'); TextOut(Width - TextWidth('3') - 2 - Pen.Width, (Height - TextHeight('3')) div 2, '3'); end; end; procedure TClock.FOnTimer(Sender: TObject); var Default: Integer; Hour, Min, Sec, MSec: Word; begin DecodeTime(Now, Hour, Min, Sec, MSec); Sec := Sec * 6; Min := Min * 6; Hour := Hour * 30; with FImage do begin with Canvas do begin if FPen <> clWhite then CopyMode := cmWhiteness else CopyMode := cmBlackness; CopyRect(FImage.BoundsRect, Canvas, FImage.BoundsRect); Pen.Color := FPen; MoveTo(Width div 2, Height div 2); LineTo(Width div 2 + Trunc(Sin(DegToRad(Sec)) * (Width div 2 - Width div 8)), Height div 2 + Trunc(Cos(DegToRad(Sec)) * - (Height div 2 - Height div 8))); MoveTo(Width div 2, Height div 2); Default := Pen.Width; Pen.Width := Pen.Width + 1; LineTo(Width div 2 + Trunc(Sin(DegToRad(Min)) * (Width div 2 - Width div 8)), Height div 2 + Trunc(Cos(DegToRad(Min)) * - (Height div 2 - Height div 8))); MoveTo(Width div 2, Height div 2); Pen.Width := Pen.Width + 1; LineTo(Width div 2 + Trunc(Sin(DegToRad(Hour)) * (Width div 3)), Height div 2 + Trunc(Cos(DegToRad(Hour)) * - (Height div 3))); Pen.Width := Default; end; end; end; procedure TClock.SetBrush(AValue: TColor); begin if FBrush <> AValue then begin FBrush := AValue; Circle; FOnTimer(FTimer); end; end; procedure TClock.SetPen(AValue: TColor); begin
if FPen <> AValue then begin FPen := AValue; Circle; FOnTimer(FTimer); end; end; procedure TClock.SetPicture(AValue: TPicture); begin FPicture.Assign(AValue); with FBack do begin Width := FImage.Width; Height := FImage.Height; Picture.Assign(FPicture); Stretch := TRUE; Circle; FOnTimer(FTimer); end; end; destructor TClock.Destroy; begin FImage.Free; FPicture.Free; FBack.Free; FClock.Free; FTimer.Free; inherited Destroy; end; end. |
In der Testumgebung deklariere ich eine Variable test : TClock;
Im FormCreate weise ich der Var Kor noch Werte zu und lasse die Uhr sich zeichnen.
Delphi-Quelltext 1: 2: 3: 4: 5:
| kor.Top := 100; kor.Left:= 200; kor.Right:=100; kor.Bottom:=100; test.Create(kor,Form1); |
Nun stürtzt er immer ab. Hab ich die Klasse falsch eingebunden ?
MfG
|
|
Böser Borstel
Beiträge: 154
|
Verfasst: Mi 24.11.04 09:39
so funktioniert es bei mir unter D7.
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: 214: 215: 216: 217: 218: 219: 220: 221:
| unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, Math, jpeg; type
TClock = class private FPicture: TPicture; FBrush, FPen : TColor; FBack, FClock, FImage: TImage; FTimer: TTimer; procedure Circle; procedure FOnTimer(Sender: TObject); procedure SetBrush(AValue: TColor); procedure SetPen(AValue: TColor); procedure SetPicture(AValue: TPicture); public constructor Create(const ARect: TRect; const AParent: TWinControl); destructor Destroy; override; published property BrushColor: TColor read FBrush write SetBrush; property PenColor: TColor read FPen write SetPen; property Picture: TPicture read FPicture write SetPicture; end; TForm1 = class(TForm) Image1: TImage; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private Clock: TClock; public end;
var Form1: TForm1;
implementation
{$R *.dfm}
constructor TClock.Create(const ARect: TRect; const AParent: TWinControl); begin inherited Create; FPen := clBlack; FBrush := clWhite; FPicture := TPicture.Create; FBack := TImage.Create(AParent); FClock := TImage.Create(AParent); FImage := TImage.Create(AParent); with FBack do begin Parent := AParent; Left := ARect.Left; Top := ARect.Top; Width := ARect.Right - Left; if Width < 50 then Width := 50; Height := ARect.Bottom - Top; if Height < 50 then Height := 50; end; with FClock do begin Parent := AParent; Transparent := TRUE; Left := FBack.Left; Top := FBack.Top; Width := FBack.Width; Height := FBack.Height; Circle; end; with FImage do begin Transparent := TRUE; Parent := AParent; Left := FBack.Left; Top := FBack.Top; Width := FBack.Width; Height := FBack.Height; Canvas.Pen.Width := (Width + Height) div 100; end; FTimer := TTimer.Create(AParent); with FTimer do begin Interval := 1000; OnTimer := FOnTimer; Enabled := TRUE; end; end; procedure TClock.Circle; begin with FClock do with Canvas do begin Pen.Width := (Width + Height) div 100; Pen.Color := Parent.Brush.Color; Brush.Color := Parent.Brush.Color; Font.Style := Font.Style + [fsBold]; Font.Size := (Width + Height) div 30; Font.Color := FPen; Rectangle(Rect(Left, Top, Left + Width, Top + Height)); Pen.Color := FPen; if (FBack.Picture.Graphic = nil) or (FBack.Picture.Graphic.Empty) then Brush.Color := FBrush; Ellipse(Rect(Left, Top, Left + Width, Top + Height)); TextOut((Width - TextWidth('12')) div 2, Pen.Width + 2, '12'); TextOut((Width - TextWidth('6')) div 2, Height - TextHeight('6') - Pen.Width, '6'); TextOut(Left + 2 + Pen.Width, (Height - TextHeight('9')) div 2, '9'); TextOut(Width - TextWidth('3') - 2 - Pen.Width, (Height - TextHeight('3')) div 2, '3'); end; end; procedure TClock.FOnTimer(Sender: TObject); var Default: Integer; Hour, Min, Sec, MSec: Word; begin DecodeTime(Now, Hour, Min, Sec, MSec); Sec := Sec * 6; Min := Min * 6; Hour := Hour * 30; with FImage do begin with Canvas do begin if FPen <> clWhite then CopyMode := cmWhiteness else CopyMode := cmBlackness; CopyRect(FImage.BoundsRect, Canvas, FImage.BoundsRect); Pen.Color := FPen; MoveTo(Width div 2, Height div 2); LineTo(Width div 2 + Trunc(Sin(DegToRad(Sec)) * (Width div 2 - Width div 8)), Height div 2 + Trunc(Cos(DegToRad(Sec)) * - (Height div 2 - Height div 8))); MoveTo(Width div 2, Height div 2); Default := Pen.Width; Pen.Width := Pen.Width + 1; LineTo(Width div 2 + Trunc(Sin(DegToRad(Min)) * (Width div 2 - Width div 8)), Height div 2 + Trunc(Cos(DegToRad(Min)) * - (Height div 2 - Height div 8))); MoveTo(Width div 2, Height div 2); Pen.Width := Pen.Width + 1; LineTo(Width div 2 + Trunc(Sin(DegToRad(Hour)) * (Width div 3)), Height div 2 + Trunc(Cos(DegToRad(Hour)) * - (Height div 3))); Pen.Width := Default; end; end; end; procedure TClock.SetBrush(AValue: TColor); begin if FBrush <> AValue then begin FBrush := AValue; Circle; FOnTimer(FTimer); end; end; procedure TClock.SetPen(AValue: TColor); begin if FPen <> AValue then begin FPen := AValue; Circle; FOnTimer(FTimer); end; end; procedure TClock.SetPicture(AValue: TPicture); begin FPicture.Assign(AValue); with FBack do begin Width := FImage.Width; Height := FImage.Height; Picture.Assign(FPicture); Stretch := TRUE; Circle; FOnTimer(FTimer); end; end; destructor TClock.Destroy; begin FImage.Free; FPicture.Free; FBack.Free; FClock.Free; FTimer.Free; inherited Destroy; end; procedure TForm1.FormCreate(Sender: TObject); begin Clock := TClock.Create(Rect(0, 0, 200, 200), Self); with Clock do begin BrushColor := RGB(240, 240, 240); PenColor := clWhite; Picture := Image1.Picture; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin Clock.Free; end; |
Moderiert von matze: Code- durch Delphi-Tags ersetzt.
|
|
|