// Wenn man mit
größerer Pen-Breite gestrichelte Rahmen zeichnen will,
// stimmt meist die Strichelung nicht, oder die Ecken sind unsauber.
// Mit dem folgenden Code gehört das der Vergangenheit an.
// Getestet mit D4 unter XP
![](rahmen.gif)
procedure StrichRand(cnv: TCanvas; x1, y1, x2, y2: integer; farbe: TColor; dicke,
lang, abstand: byte);
var
ges, x, y, z, dlr, diff, i, dm2, x1pd, y1pd, x2md, y2md,
x1pdm2, y1pdm2, x2mdm2, y2mdm2: integer;
merk: TColor;
begin
if x1 > x2 then begin
x := x2;
x2 := x1;
x1 := x;
end;
if y1 > y2 then begin
x := y2;
y2 := y1;
y1 := x;
end;
x := dicke * 4 + abstand * 2 + lang;
if (dicke < 1) or (x > x2 - x1) or (x > y2 - y1)
then
raise exception.create('Maßangaben sind unzulässig!');
ges := lang + abstand;
dm2 := dicke + dicke;
y1pd := y1 + dicke;
y2md := y2 - dicke;
x1pd := x1 + dicke;
x2md := x2 - dicke;
x1pdm2 := x1 + dm2;
x2mdm2 := x2 - dm2;
y1pdm2 := y1 + dm2;
y2mdm2 := y2 - dm2;
with cnv do begin
merk := brush.color;
brush.color := farbe;
// --- 4 Ecken ---------
fillrect(rect(x1, y1, x1pdm2, y1pd));
fillrect(rect(x2mdm2, y1, x2, y1pd));
fillrect(rect(x1, y1pd, x1pd, y1pdm2));
fillrect(rect(x2md, y1pd, x2, y1pdm2));
fillrect(rect(x1, y2, x1pdm2, y2md));
fillrect(rect(x1, y2md, x1pd, y2mdm2));
fillrect(rect(x2mdm2, y2, x2, y2md));
fillrect(rect(x2md, y2md, x2, y2mdm2));
// -------- waagerecht -----
diff := x2 - x1 - 2 * dm2 - abstand;
x := (diff div ges);
dlr := round((diff - x * ges) / 2);
if dlr > 0 then begin
y := x1pdm2 + dlr;
z := x2mdm2 - dlr;
fillrect(rect(x1pdm2, y1, y, y1pd));
fillrect(rect(x2mdm2, y1, z, y1pd));
fillrect(rect(x1pdm2, y2, y, y2md));
fillrect(rect(x2mdm2, y2, z, y2md));
end;
for i := 0 to x - 1 do begin
y := x1pdm2 + abstand + i * ges + dlr;
z := y + lang;
fillrect(rect(y, y1, z, y1pd));
fillrect(rect(y, y2, z, y2md));
end;
// --------- senkrecht -------
diff := y2 - y1 - 2 * dm2 - abstand;
x := (diff div ges);
dlr := round((diff - x * ges) / 2);
if dlr > 0 then begin
y := y1pdm2 + dlr;
z := y2mdm2 - dlr;
fillrect(rect(x1, y1pdm2, x1pd, y));
fillrect(rect(x2, y1pdm2, x2md, y));
fillrect(rect(x1, y2mdm2, x1pd, z));
fillrect(rect(x2, y2mdm2, x2md, z));
end;
for i := 0 to x - 1 do begin
y := y1pdm2 + abstand + i * ges + dlr;
z := y + lang;
fillrect(rect(x1, y, x1pd, z));
fillrect(rect(x2, y, x2md, z));
end;
brush.color := merk;
end;
end;
// Beispielaufruf
procedure TForm1.Button1Click(Sender: TObject);
begin
StrichRand(canvas, 200, 100, 355, 200, clblue, 4, 18, 5);
StrichRand(canvas, 200, 210, 355, 310, clblue, 4, 7, 2);
end;
![](zurueck.gif)
|