Hallo,
ich habe eine Komponente von TCustomPanel abgeleitet und möchte in der Paint-Methode Rahmen zeichnen. Für jeden Rahmen habe ich eine Eigenschaft definiert und in der jeweiligen Setter-Methode wird Invalidate aufgerufen um den Rahmen zu zeichnen (ich habe dort auch schon Refresh, Repaint, Paint versucht). Zur Laufzeit funktioniert alles wunderbar, zur Designtime wird wenn ich in einer Rahmen-Eigenschaft einen Wert verändere der Rahmen nicht richtig gezeichnet (nur 3 Punkte und keine ganze Linie, siehe Screenshot im Anhang). Klicke ich auf das Objekt auf dem Formular wird der Rahmen korrekt gezeichnet. Ich kann mir das nicht erklären. Habt ihr eine Idee was ich falsch mache?
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:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
| unit CsPanels;
interface
uses
SysUtils, Classes, Controls, ExtCtrls, Graphics, Forms, Types;
type
TCsBorderPosition = (cbpTop, cbpBottom, cbpLeft, cbpRight);
TCsCustomPanel = class;
TCsPanel = class;
TCsBorderStyle = class;
TCsCustomPanel = class(TCustomPanel)
private
FBorderLeft: TCsBorderStyle;
FBorderRight: TCsBorderStyle;
FBorderTop: TCsBorderStyle;
FBorderBottom: TCsBorderStyle;
protected
procedure SetBorderLeft(Value: TCsBorderStyle);
procedure SetBorderRight(Value: TCsBorderStyle);
procedure SetBorderBottom(Value: TCsBorderStyle);
procedure SetBorderTop(Value: TCsBorderStyle);
procedure DrawBorder(Style: TCsBorderStyle; Position: TCsBorderPosition);
function GetBorderStartPosition(Position: TCsBorderPosition): TPoint;
function GetBorderEndPosition(Position: TCsBorderPosition): TPoint;
property BorderLeft: TCsBorderStyle read FBorderLeft write SetBorderLeft;
property BorderRight: TCsBorderStyle read FBorderRight write SetBorderRight;
property BorderTop: TCsBorderStyle read FBorderTop write SetBorderTop;
property BorderBottom: TCsBorderStyle read FBorderBottom write SetBorderBottom;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Loaded; override;
procedure Paint; override;
published
end;
TCsPanel = class(TCsCustomPanel)
published
property BorderLeft;
property BorderRight;
property BorderTop;
property BorderBottom;
property Color;
property Align;
property ParentBackground;
property Font;
end;
TCsBorderStyle = class(TPersistent)
private
FColor: TColor;
FWidth: Byte;
FVisible: Boolean;
public
procedure Assign(Source: TPersistent); override;
procedure AssignTo(Dest: TPersistent); override;
published
property Color: TColor read FColor write FColor;
property Width: Byte read FWidth write FWidth;
property Visible: Boolean read FVisible write FVisible;
end;
implementation
constructor TCsCustomPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
BevelInner := bvNone;
BevelOuter := bvNone;
BorderStyle := bsNone;
ShowCaption := False;
FBorderLeft := TCsBorderStyle.Create;
FBorderRight := TCsBorderStyle.Create;
FBorderTop := TCsBorderStyle.Create;
FBorderBottom := TCsBorderStyle.Create;
Repaint;
end;
destructor TCsCustomPanel.Destroy;
begin
FreeAndNil(FBorderLeft);
FreeAndNil(FBorderRight);
FreeAndNil(FBorderTop);
FreeAndNil(FBorderBottom);
inherited Destroy;
end;
procedure TCsCustomPanel.SetBorderLeft(Value: TCsBorderStyle);
begin
FBorderLeft.Assign(Value);
Invalidate;
end;
procedure TCsCustomPanel.SetBorderRight(Value: TCsBorderStyle);
begin
FBorderRight.Assign(Value);
Invalidate;
end;
procedure TCsCustomPanel.SetBorderBottom(Value: TCsBorderStyle);
begin
FBorderBottom.Assign(Value);
Invalidate;
end;
procedure TCsCustomPanel.SetBorderTop(Value: TCsBorderStyle);
begin
FBorderTop.Assign(Value);
Invalidate;
end;
procedure TCsCustomPanel.Loaded;
begin
inherited Loaded;
end;
procedure TCsCustomPanel.DrawBorder(Style: TCsBorderStyle;
Position: TCsBorderPosition);
var
Coord: TPoint;
begin
if Style.Visible then
begin
Canvas.Pen.Color := Style.Color;
Canvas.Pen.Width := Style.Width;
Canvas.PenPos := GetBorderStartPosition(Position);
Coord := GetBorderEndPosition(Position);
Canvas.LineTo(Coord.X, Coord.Y);
end;
end;
function TCsCustomPanel.GetBorderStartPosition(Position: TCsBorderPosition): TPoint;
begin
case Position of
cbpTop:
begin
Result.X := 0;
Result.Y := 0;
end;
cbpBottom:
begin
Result.X := 0;
Result.Y := Height;
end;
cbpLeft:
begin
Result.X := 0;
Result.Y := 0;
end;
cbpRight:
begin
Result.X := Width;
Result.Y := 0;
end;
end;
end;
function TCsCustomPanel.GetBorderEndPosition(Position: TCsBorderPosition): TPoint;
begin
case Position of
cbpTop:
begin
Result.X := Width;
Result.Y := 0;
end;
cbpBottom:
begin
Result.X := Width;
Result.Y := Height;
end;
cbpLeft:
begin
Result.X := 0;
Result.Y := Height;
end;
cbpRight:
begin
Result.X := Width;
Result.Y := Height;
end;
end;
end;
procedure TCsCustomPanel.Paint;
begin
inherited Paint;
DrawBorder(FBorderLeft, cbpLeft);
DrawBorder(FBorderRight, cbpRight);
DrawBorder(FBorderTop, cbpTop);
DrawBorder(FBorderBottom, cbpBottom);
end;
procedure TCsBorderStyle.Assign(Source: TPersistent);
begin
if Source is TCsBorderStyle then
begin
FColor := TCsBorderStyle(Source).Color;
FWidth := TCsBorderStyle(Source).Width;
FVisible := TCsBorderStyle(Source).Visible;
end
else
inherited Assign(Source);
end;
procedure TCsBorderStyle.AssignTo(Dest: TPersistent);
begin
if Dest is TCsBorderStyle then
begin
TCsBorderStyle(Dest).Color := FColor;
TCsBorderStyle(Dest).Width := FWidth;
TCsBorderStyle(Dest).Visible := FVisible;
end
else
inherited AssignTo(Dest);
end;
end. |
Schönen Abend,
Andreas
Cross-Post:
www.delphipraxis.net...ert.html#post1102317
