// Es wird der Anschein erweckt, als würde sich ein TImage umwenden.
// Voraussetzung sind zwei Bitmaps (Vorder- und Rückseite) in gleicher Größe.
// Geschrieben wurde der Code für ein Kartenspiel, um das Umwenden einer
// Karte zu animieren. Die Variable "wenden" gibt dabei an, wie oft sich die
// Karte umwendet. Bei einem negativen Wert dreht sich die Karte ständig,
// bis "stopp" auf True gesetzt wird.
 

// Getestet mit D4 unter XP
// und mit RS 10.4 unter W11

// Variante 1:
// Einfaches Umwenden

var 
  vorn, hinten: TBitmap; 
  w: Integer = 0; // wichtig
  breit, links: Integer; 
  bild: Boolean = True; 
  welches: Boolean = True; // bei False beginnt man mit der Rückseite 
  wenden: Integer = 1; // einmal Vorderseite zu Rückseite 
  zaehler: Word; 
  stopp: Boolean; 
 
procedure TForm1.laden; 
begin 
  if bild then 
  begin 
    if welches then 
      Image1.picture.assign(vorn) 
    else 
      Image1.picture.assign(hinten); 
    welches := not welches; 
    bild := False; 
  end; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Timer1.interval := 0; 
  doublebuffered := True; 
  vorn := TBitmap.Create; 
  hinten := TBitmap.Create; 
  // z.B: 
  vorn.loadfromfile('D:\Embarcadero\Patience\Kart2\2A.bmp'); 
  hinten.loadfromfile('D:\Embarcadero\Patience\Kart2\01.bmp'); 
  // --- 
  with Image1 do 
  begin 
    autosize := False; 
    Width := vorn.Width; 
    Height := vorn.Height; 
    stretch := True; 
  end; 
  links := Image1.Left; 
  breit := Image1.Width; 
  laden; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  vorn.free; 
  hinten.free; 
end; 
 
function TForm1.neu: Integer; 
begin 
  result := round(sin(0.1047197551196598 * w - 1.5707963267948966) * breit); 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  Image1.Width := abs(neu); 
  Image1.Left := round(links + (breit - Image1.Width) / 2); 
  if (w mod 30 = 0) and (Image1.Width = breit) and bild then 
  begin 
    if wenden >= 0 then 
      inc(zaehler); 
    if stopp or (zaehler = wenden) then 
    begin 
      Timer1.interval := 0; 
      zaehler := 0; 
    end; 
  end; 
  inc(w); 
  if (Image1.Width > breit - 2) then 
    bild := True; 
  if (Image1.Width = 0) then 
    laden; 
  if w = 180 then 
    w := 0; 
end; 
 

// Beispielaufrufe
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  stopp := False; 
  zaehler := 0; 
  Timer1.interval := 10; 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  stopp := True; 
end;

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

// Variante 2:
// Nach rechts, links, oben, unten klappen,
// sowie horizontal oder vertikal umwenden

var 
  vorn, hinten: TBitmap; 
  horz, vert, richtung, links, oben, breit, hoch: Integer; 
  w: Integer = 0; // wichtig 
  umschalten: Boolean = False; // wichtig 
  bild: Boolean = True; 
  welches: Boolean = False; // mit Rückseite beginnen 
  stopp: Boolean = False; 
  wenden: Integer = 1; // nur einmal 
  zaehler: Word; 
  horizontal: Boolean; 
 
procedure TForm1.laden; 
begin 
  if bild then 
  begin 
    if welches then 
      Image1.picture.assign(vorn) 
    else 
      Image1.picture.assign(hinten); 
    welches := not welches; 
    bild := False; 
  end; 
end; 
 
function TForm1.neu(was: Integer): Integer; 
begin 
  result := round(sin(0.1047197551196598 * w - 1.5707963267948966) * was); 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  if horizontal then 
  begin 
    horz := abs(neu(breit)); 
    Image1.width := horz; 
    vert := hoch; 
  end 
  else 
  begin 
    vert := abs(neu(hoch)); 
    Image1.height := vert; 
    horz := breit; 
  end; 
  case richtung of 
    1: 
      begin 
        if horizontal then 
          Image1.Left := links + breit - ord(not umschalten) * horz 
        else 
          Image1.Top := oben + hoch - ord(not umschalten) * vert; 
      end; 
    2: 
      begin 
        if horizontal then 
          Image1.Left := links - ord(umschalten) * horz 
        else 
          Image1.Top := oben - ord(umschalten) * vert; 
      end 
  else 
    begin 
      if horizontal then 
        Image1.Left := round(links + (breit - horz) / 2) 
      else 
        Image1.Top := round(oben + (hoch - vert) / 2); 
    end; 
  end; 
  if (w mod 30 = 0) and bild then 
  begin 
    if wenden >= 0 then 
      inc(zaehler); 
    if stopp or (zaehler = wenden) then 
    begin 
      Timer1.interval := 0; 
      zaehler := 0; 
    end; 
    case richtung of 
      1: 
        begin 
          if horizontal then 
            links := links + breit 
          else 
            oben := oben + vert; 
        end; 
      2: 
        begin 
          if horizontal then 
            links := links - breit 
          else 
            oben := oben - vert; 
        end; 
    end; 
    umschalten := False; 
  end; 
  inc(w); 
  bild := True; 
  if (horz = 0) or (vert = 0) then 
  begin 
    umschalten := not umschalten; 
    laden; 
  end; 
  if w = 180 then 
    w := 0; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Timer1.interval := 0; 
  doublebuffered := True; 
  vorn := TBitmap.Create; 
  hinten := TBitmap.Create; 
  // z.B: 
  vorn.loadfromfile('D:\Embarcadero\Patience\Kart2\2A.bmp'); 
  hinten.loadfromfile('D:\Embarcadero\Patience\Kart2\01.bmp'); 
  // --- 
  with Image1 do 
  begin 
    autosize := True; 
    laden; 
    stretch := True; 
    autosize := False; 
  end; 
  breit := Image1.width; 
  hoch := Image1.height; 
  links := Image1.Left; 
  oben := Image1.Top; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  vorn.Free; 
  hinten.Free; 
end; 
 
procedure TForm1.Los; 
begin 
  Image1.height := hoch; 
  Image1.width := breit; 
  stopp := False; 
  zaehler := 0; 
  Timer1.interval := 10; 
end; 
 
procedure TForm1.HLos; 
begin 
  horizontal := True; 
  Los; 
end; 
 
procedure TForm1.VLos; 
begin 
  horizontal := False; 
  Los 
end; 
 
 
// --- Beispielaufrufe --- 
 
// nach rechts klappen 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  richtung := 1; 
  HLos; 
end; 
 
// nach links klappen 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  richtung := 2; 
  HLos; 
end; 
 
// horizontal umwenden 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  richtung := 0; 
  HLos; 
end; 
 
// nach unten klappen 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  richtung := 1; 
  VLos; 
end; 
 
// nach oben klappen 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  richtung := 2; 
  VLos; 
end; 
 
// vertikal umwenden 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  richtung := 0; 
  VLos; 
end; 
 
// Mehrfachdrehung abbrechen 
procedure TForm1.Button7Click(Sender: TObject); 
begin 
  stopp := True; 
end;