DBR Delphi-Ecke

// Simpler Code, um Bilder auf einem scheinbar horizontalen Kreis
// zu bewegen.

// Getestet mit D4 unter XP

// Um das Ganze nicht zu komplizieren, wurden Kompromisse geschlossen:
// - Anzahl der Bilder muss mindestens 5 sein und der Vollkreis (360°)
//   muss ohne Rest durch die Anzahl teilbar sein.
// - Der Vollkreis als auch der Teilkreis zwischen den Bildern muss ohne
//   Rest durch die Schrittweite (step) teilbar sein.
// - Die Verkleinerung der hinteren Bilder erfolgt nicht unbedingt
//   proportional zu ihrer Stellung.
// - Die Kantenlänge der Bilder sollte nicht viel größer als
//   200 Pixel sein.
// - Gestartet wird erst beim Klick auf Button1.

// Es ist also noch reichlich Platz, den Code individuell zu überarbeiten.

// Das Aussehen wird durch die Variablen in der Prozedur
// "config" bestimmt:
// Form: Bestimmt das Formular, auf dem das Ganze abläuft.
// Links, Oben: Legt die linke obere Ecke des Vierecks fest, welches den
//              Kreis bei Stauchung=0 (siehe weiter unten) umschreibt.
// Anzahl: Legt fest, wieviel Bilder angezeigt werden.
// Interv: Bestimmt den Intervall des Timers, der für die Bewegung
//         verantwortlich ist.
// Step: Legt die Schrittweite (Winkel) fest, um welche die Bilder in der
//       Bewegung weitergeschoben werden.
// Pause: Bestimmt in Millisekunden, ob das vordere Bild eine Weile
//        stehen bleibt, bevor es weiterwandert.
// Kleiner: Legt den Wert fest, um den die hinteren Bilder
//          kleiner angezeigt
//          werden.
// Loop: Bei TRUE läuft der Kreis, wenn einmal gestartet, ohne
//       Anhalten weiter.
// Versatz: Verschiebt die Bilder etwas, weil das besser aussieht, als
//          wenn sie genau übereinander stehen.


versatz = -3	versatz = 0

// Stauchung: Drückt den Kreis zusammen (ist vom Durchmesser abhängig)


stauchung = 85	stauchung = 0

// Automatik: Bei FALSE wird eine Fehlermeldung ausgegeben, wenn Stauchung
//            größer als der Durchmesser ist. Bei TRUE wird die Stauchung
//            auf den Durchmesser angepasst.
// Abstand: Bestimmt den Abstand zwischen den Bilder und zieht damit
//          den Kreis auseinander


abstand = 0	abstand = 20

//-----------------------------------------------------------------------------------------------

unit Unit1; 
 
interface 
 
uses 
  Windows, Classes, Sysutils, Graphics, Controls, Forms, Dialogs, 
  StdCtrls, ExtCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Timer1: TTimer; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    { Public-Deklarationen } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
const 
  reihe = [5, 6, 8, 9, 10, 12, 15, 18, 20]; 
  stp = [1, 2, 3, 4] + reihe; 
 
var 
  Form: TForm; 
  stop: boolean = true; 
  mitte, durchmesser, teiler, anzahl, stelle, step, 
    start, stck, a2, links, oben, offs, interv: integer; 
  abstand, gut, kleiner: byte; 
  loop, automatik: boolean; 
  stauchung, pause: word; 
  arr: array of TBitmap; 
  ptlr, faktor: single; 
  versatz: shortint; 
  bm: TBitmap; 
 
function ok(ba: array of TBitmap): boolean; 
var 
  x: integer; 
begin 
  result := false; 
  for x := 1 to high(ba) do 
    if (ba[x].width <> ba[0].width) or (ba[x].height <> ba[0].height) 
      then exit; 
  result := true; 
end; 
 
function fx(w, b: double): integer; 
begin 
  result := round(cos((pi / 180) * w - pi / 2) * (b / 2) + mitte); 
end; 
 
function fy(w, h: double): integer; 
begin 
  result := round(sin((pi / 180) * w - pi / 2) * (h / 2) + mitte); 
end; 
 
function arrange(ba: array of TBitmap): byte; 
  function prf(m: integer): boolean; 
  begin 
    result := m - a2 * kleiner < 3; 
  end; 
begin 
  case anzahl of 
    5: ptlr := 6.02; 
    6: ptlr := 6.83; 
    8: ptlr := 7.79; 
    9: ptlr := 8.13; 
    10: ptlr := 8.35; 
    12: ptlr := 8.7; 
    15: ptlr := 9; 
    18: ptlr := 9.17; 
  else ptlr := 9.25; 
  end; 
  durchmesser := abstand + round(arr[0].width * pred(anzahl) * pi / ptlr); 
  inc(durchmesser, ord(not odd(durchmesser))); 
  if not (anzahl in reihe) then begin 
    result := 1; 
    exit; 
  end; 
  if not ok(ba) then begin 
    result := 2; 
    exit; 
  end; 
  if (stauchung > durchmesser) then begin 
    if automatik then 
      stauchung := durchmesser else begin 
      result := 3; 
      exit; 
    end; 
  end; 
  teiler := 360 div anzahl; 
  if not (step in stp) 
    or (frac(teiler / step) <> 0) 
    or (step >= anzahl) 
    then begin 
    result := 4; 
    exit; 
  end; 
  a2 := anzahl div 2; 
  if prf(arr[0].width) 
    or prf(arr[0].height) 
    then begin 
    result := 5; 
    exit; 
  end; 
  faktor := arr[0].width / arr[0].height; 
  mitte := 1 + durchmesser div 2; 
  start := -step; 
  stelle := -step * ord(loop); 
  offs := a2 - ord(loop) * 2; 
  stck := a2 - ord(not odd(anzahl)); 
  bm.width := durchmesser + arr[0].width + 1; 
  bm.height := durchmesser + arr[0].height + 1; 
  bm.canvas.brush.color := Form.color; 
  result := 0; 
end; 
 
procedure config; 
begin 
  Form := Form1; 
  links := 20; 
  oben := 25; 
  anzahl := 6; 
  abstand := 0; 
  interv := 30; 
  step := 5; 
  pause := 2000; 
  kleiner := 0; 
  stauchung := 85; 
  automatik := false; 
  versatz := -3; 
  Loop := false; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  x: integer; 
begin 
  Timer1.interval := 0; 
  bm := TBitmap.create; 
  config; 
  setlength(arr, anzahl); 
  for x := 0 to anzahl - 1 do begin 
    arr[x] := TBitmap.create; 
  // nur zum Testen ---------------------- 
    arr[x].width := 50; 
    arr[x].height := 40; 
    arr[x].canvas.brush.color := clyellow; 
    arr[x].canvas.rectangle(0, 0, arr[x].width, arr[x].height); 
   // ------------------------------------- 
  end; 
  // ansonsten hier Bilder laden 
  // ... 
  // und bei Bedarf beschriften 
  { for x := 0 to anzahl - 1 do 
    arr[x].canvas.textout(25, 18, inttostr(x + 1)); // z.B. } 
  // ------------------------------------- 
  gut := arrange(arr); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
var 
  x: integer; 
begin 
  for x := 0 to high(arr) do arr[x].free; 
  bm.free; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  case gut of 
    0: begin 
        Timer1Timer(self); 
        if not stop or loop then 
          timer1.interval := interv; 
        stop := false; 
      end; 
    1: showmessage('Bilder-Anzahl unzulässig'); 
    2: showmessage('Bilder-Abmaße unterschiedlich'); 
    3: showmessage('Stauchung zu groß'); 
    4: showmessage('Step unzulässig'); 
    5: showmessage('Verkleinerung zu stark'); 
  end; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
var 
  x, i1, i2, w1, w2, y1, y2, x1, x2, st, k, k2, f: integer; 
  zeit: cardinal; 
  procedure weiter; 
  begin 
    inc(stelle, step); 
    st := stelle + step * ord(loop) + start + versatz; 
    if st >= 360 then st := 0; 
    start := 0; 
  end; 
begin 
  with bm.canvas do fillrect(cliprect); 
  i1 := 0; 
  i2 := 360 - teiler; 
  weiter; 
  for x := 0 to stck do begin 
    k := (stck - x) * kleiner; 
    k2 := k div 2; 
    f := trunc((arr[0].width - k) / faktor); 
    w1 := x - offs; 
    if w1 < 0 then 
      w1 := w1 + anzahl; 
    x1 := fx(i1 + st, durchmesser); 
    y1 := fy(i1 + st, durchmesser - stauchung); 
    SetStretchBltMode(bm.canvas.handle, STRETCH_HALFTONE); 
    bm.canvas.stretchdraw(rect(x1 + k2, y1, x1 + arr[0].width - k2, 
      y1 + f), arr[w1]); 
    inc(i1, teiler); 
    w2 := anzahl - 1 - offs - x; 
    if w2 < 0 then 
      w2 := w2 + anzahl; 
    x2 := fx(i2 + st, durchmesser); 
    y2 := fy(i2 + st, durchmesser - stauchung); 
    SetStretchBltMode(bm.canvas.handle, STRETCH_HALFTONE); 
    bm.canvas.stretchdraw(rect(x2 + k2, y2, x2 + arr[0].width - k2, 
      y2 + f), arr[w2]); 
    dec(i2, teiler); 
  end; 
  if stelle mod teiler = 0 then begin 
    if not loop then timer1.interval := 0; 
    stelle := 0; 
    inc(offs); 
    if offs = anzahl then offs := 0; 
    if (pause > 0) and loop then begin 
      if sender = Timer1 then begin 
        timer1.interval := 0; 
        zeit := gettickcount + pause; 
        repeat 
          application.processmessages; 
        until (gettickcount >= zeit) or application.terminated; 
        timer1.interval := interv; 
      end; 
    end; 
  end; 
  Form.canvas.draw(links, oben, bm); 
end; 
 
end.