DBR Delphi-Ecke

// Per Email erreichte mich die Anfrage, ob man nicht ein Passwort (Zahl)
// ähnlich wie bei einem Tresor eingeben könne. Zum einen wäre das
// grafisch interessanter, zum anderen könne man dann Tastenanschläge
// nicht mehr heimlich auslesen. Also habe ich die unten stehende Bitmap
// genutzt und den folgenden Code geschrieben.
// Die Ziffern links von der 0 gelten als negative Werte und werden durch
// gedrückt gehaltener Maustaste auf dem roten Dreieck erreicht, die
// Ziffern rechts gelten als positiv und werden über das grüne Dreieck
// erreicht. Der im Beispiel benutzte String (6-34-10-2) bedeutet also:
// Rechts auf die 6, dann links auf die 3, dann rechts auf die 4, dann
// links auf die 1, dann auf die 0 und danach links auf die 2.
// Der Einfachheit halber wird in der Prozedur "zeichnen" nicht das ganze
// Bild gedreht, sondern nur ein Strich auf dem zweiten Kranz erzeugt,
// welcher von Zahl zu Zahl springt. Wenn alle Zahlen angewählt wurden,
// werden die Strings "s" und "v" verglichen. Stimmen sie nicht überein,
// wird das Programm beendet.
// Es gilt also, die Maustaste nicht zu früh und nicht zu spät loszulassen.
// Hinweis:
// Die Werte mittex, mittey, clRed, $B400, 54, 40 und 1.6 beziehen sich
// auf die Abbildung und müssen bei andern Grafiken angepasst werden.

// Getestet mit D4 unter XP

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ExtCtrls, StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    Image1: TImage; 
    Timer1: TTimer; 
    procedure FormCreate(Sender: TObject); 
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure Timer1Timer(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure zeichnen; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
var 
  s: string = '6-34-10-2'; 
  v: string = ''; 
  w: double = 0; 
  bm: TBitmap; 
  z: double; 
  tick: integer = 0; 
  t, lg: integer; 
  g: cardinal = 350; 
  mittex: integer = 79; 
  mittey: integer = 81; 
 
function x(w, b: double): integer; 
begin 
  result := trunc(cos((pi / 30) * w - pi / 2) * b + mittex); 
end; 
 
function y(w, h: double): integer; 
begin 
  result := trunc(sin((pi / 30) * w - pi / 2) * h + mittey); 
end; 
 
procedure TForm1.zeichnen; 
const 
  o = 54; 
  u = 40; 
begin 
  Image1.picture.assign(bm); 
  Image1.canvas.moveto(x(w, o), y(w, o)); 
  Image1.canvas.lineto(x(w, u), y(w, u)); 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Timer1.interval := 0; 
  doublebuffered := true; 
  Image1.autosize := true; 
  Image1.transparent := true; 
  bm := TBitmap.create; 
  bm.loadfromfile('tresor.bmp'); 
  lg := length(s); 
  zeichnen; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bm.free; 
end; 
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if Image1.Canvas.pixels[x, y] = $B400 then begin 
    z := 1.6; 
    t := 1; 
    Timer1Timer(Timer1); 
    Timer1.interval := g; 
  end else 
    if Image1.Canvas.pixels[x, y] = clRed then begin 
      z := -1.6; 
      t := -1; 
      Timer1Timer(Timer1); 
      Timer1.interval := g; 
    end; 
end; 
 
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
var ts: string; 
begin 
  if Timer1.interval <> 0 then begin 
    Timer1.interval := 0; 
    ts := inttostr(tick); 
    v := v + ts; 
    dec(lg, length(ts)); 
    if lg < 1 then begin 
      Image1.visible := false; 
      if v <> s then begin 
        showmessage('Falsche Zahl!'); 
        close; 
      end; 
    end; 
  end; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  if (tick = -9) and (t < 0) 
    or (tick = 9) and (t > 0) then exit; 
  w := w + z; 
  inc(tick, t); 
  zeichnen; 
end; 
 
end.