// Ein Formular erhält einen umlaufenden Rand. Im Gegensatz zu
// anderen Anwendungen wird die Formgröße so angepasst, dass auch
// in den Ecken ein gleichmäßiger Umlauf gewährleistet ist.


// Getestet mit D4 unter XP

type 
  TForm1 = class(TForm) 
    Timer1: TTimer; 
    Button1: TButton; 
    Button2: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure FormPaint(Sender: TObject); 
    procedure FormResize(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure makelines; 
    procedure rand; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
const 
  dick = 2; 
  lang = 16; 
 
var 
  lg2, lg4, waagerecht, senkrecht: integer; 
  Uhrzeigersinn: boolean = true; 
  farbe2: TColor = clyellow; 
  farbe1: TColor = clred; 
  bwaag, bsenk: TBitmap; 
  fase: integer = 0; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  doublebuffered := true; 
  // kein Maximieren wegen Ecken angleichen: 
  bordericons := [biSystemMenu, biMinimize]; 
  BorderWidth := 0; 
  bwaag := TBitmap.create; 
  bsenk := TBitmap.create; 
  lg2 := lang div 2; 
  lg4 := lang div 4; 
  makelines; 
  Timer1.interval := 55; 
end; 
 
procedure TForm1.makelines; 
begin 
  bwaag.width := lang; 
  bwaag.height := dick; 
  bsenk.width := dick; 
  bsenk.height := lang; 
  with bwaag.canvas do begin 
    brush.color := farbe1; 
    fillrect(rect(0, 0, lg2, dick)); 
    brush.color := farbe2; 
    fillrect(rect(lg2, 0, lang, dick)); 
  end; 
  with bsenk.canvas do begin 
    brush.color := farbe1; 
    fillrect(rect(0, 0, dick, lg2)); 
    brush.color := farbe2; 
    fillrect(rect(0, lg2, dick, lang)); 
  end; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bwaag.free; 
  bsenk.free; 
end; 
 
procedure TForm1.rand; 
var x: integer; 
begin 
  for x := 0 to waagerecht + 1 do begin 
    canvas.draw((x - 1) * lang + fase, 0, bwaag); 
    canvas.draw(x * lang - lg4 - dick - fase, clientheight - dick, bwaag); 
  end; 
  for x := 0 to senkrecht + 1 do begin 
    canvas.draw(clientwidth - dick, (x - 1) * lang - lg4 + fase + dick * 2, bsenk); 
    canvas.draw(0, x * lang - lg4 - dick - fase, bsenk); 
  end; 
end; 
 
procedure TForm1.FormPaint(Sender: TObject); 
begin 
  if not Timer1.enabled then rand; 
end; 
 
procedure TForm1.FormResize(Sender: TObject); 
begin 
  waagerecht := clientwidth div lang; 
  senkrecht := clientheight div lang; 
  refresh; 
  // Ecken angleichen: 
  clientwidth := lang * waagerecht + dick; 
  clientheight := lang * senkrecht + dick; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  rand; 
  if Uhrzeigersinn then begin 
    inc(fase); 
    if fase >= lang then fase := 0; 
  end else begin 
    dec(fase); 
    if fase <= 0 then fase := lang; 
  end; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  // anhalten / fortsetzen 
  Timer1.enabled := not Timer1.enabled; 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  // Richtung ändern 
  Uhrzeigersinn := not Uhrzeigersinn; 
end;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke