// 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

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;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke