// 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. Wenn die Variable "nurwenden" auf "True" steht,
// wird die Karte nur einmal gewendet
(von Vorder- auf Rückseite bzw.
// von Rück- auf Vorderseite)
, ansonsten dreht sie sich ständig.
// Hinweis:
// Der Code ist so geschrieben, dass zu Anfang die Karte offen daliegt.
// Die Rückseite muss gespiegelt genauso aussehen wie ungespiegelt,
// ansonsten muss der Block "des besseren Aussehens wegen" gelöscht werden.

// Getestet mit D4 unter XP

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls, ExtCtrls; 
 
type 
  TForm1 = class(TForm) 
    Image1: TImage; 
    Timer1: TTimer; 
    Button1: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure laden; 
    function neu: integer; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
var 
  vorn, hinten: TBitmap; 
  w: integer = 0; 
  breit, links: integer; 
  bild: boolean = true; 
  welches: boolean = true; 
 
  nurwenden: boolean = true; 
 
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; 
  vorn.loadfromfile('C:\herz9.bmp'); 
  hinten.loadfromfile('C:\ruecken.bmp'); 
  with image1 do begin 
    autosize := false; 
    width := vorn.width; 
    height := vorn.height; 
    stretch := true; 
  end; 
  links := image1.left; 
  breit := image1.width; 
  laden; 
end; 
 
function TForm1.neu: integer; 
begin 
  result := trunc(sin(0.1047197551196598 * w - 1.5707963267948966) * -breit); 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  image1.width := neu; 
  image1.left := links + (breit - image1.width) div 2; 
  if (w mod 30 = 0) and (abs(image1.width) = breit) and bild 
    then begin 
    if nurwenden then 
      timer1.interval := 0; 
    // ----- des besseren Aussehens wegen ------
    if welches then begin 
      image1.width := abs(image1.width); 
      image1.left := image1.left - image1.width; 
    end; 
    // -----------------------------------------
  end; 
  inc(w); 
  if (abs(image1.width) > breit - 2) then bild := true; 
  if (abs(image1.width) = 0) then laden; 
  if w = 180 then w := 0; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  vorn.free; 
  hinten.free; 
end; 
 
// Start 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Timer1.interval := 10; 
end; 
 
end. 



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke