// Das Prinzip ist das gleiche wie bei eine Analoguhr programmieren,
// nur dass hier keine Uhr auf eine Form gezeichnet wird, sondern
// die Form selbst die Uhr darstellt. Außerdem wird ein
// vorgefertigtes Zifferblatt benutzt, welches sich in der
// Ressource "AUhr.RES" befindet. Diese müssen Sie hier
// downloaden und in das Projektverzeichnis entpacken. Mit der linken
// Maustaste können Sie die Uhr verschieben, die rechte Maustaste
// schaltet sie aus.

// Getestet mit D4 unter XP

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
  StdCtrls, ExtCtrls; 
 
type 
  TClock = class(TForm) 
    Image1: TImage; 
    Timer1: TTimer; 
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure FormCreate(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure FormShow(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure antialias(b: TBitmap); 
    function x(w, d, b: double): integer; 
    function y(w, d, h: double): integer; 
    procedure zeiger(c: TCanvas; farbe: TColor; wert, diff: double; 
      dicke: integer); 
    procedure readposi; 
    procedure writeposi; 
  end; 
 
var 
  Clock: TClock; 
 
implementation 
 
{$R *.DFM} 
{$R AUhr.RES} 
 
uses Registry; 
 
const
  SZeiger = $2020FF; 
  MZeiger = $444444; 
  HZeiger = $505050; 
  SDicke = 1; 
  MDicke = 3; 
  HDicke = 4; 
 
var 
  Secm: double = 61;
  absts, abstm, absth: double; 
  mass, mitte: integer; 
  bm, hig: TBitmap; 
  Reg: TRegistry; 
 
procedure TClock.antialias(b: TBitmap); 
var 
  w, x, y, z, k, m: integer; 
  p0, p1, p2: PBytearray; 
begin 
  for y := 1 to b.height - 2 do begin 
    p0 := b.ScanLine[y - 1]; 
    p1 := b.scanline[y]; 
    p2 := b.ScanLine[y + 1]; 
    for x := 1 to b.width - 2 do begin 
      z := x * 3; 
      k := (x - 1) * 3; 
      m := (x + 1) * 3; 
      for w := 0 to 2 do begin 
        p1[z + w] := trunc(( 
          p0[z + w] + p0[k + w] + p0[m + w] + 
          p2[z + w] + p2[k + w] + p2[m + w] + 
          p1[k + w] + p1[m + w] + p1[z + w] * 6) / 14); 
      end; 
    end; 
  end; 
end; 
 
procedure TClock.Image1MouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if button = mbleft then begin 
    releaseCapture; 
    perform(WM_SysCommand, $F012, 0); 
  end; 
end; 
 
procedure TClock.FormCreate(Sender: TObject); 
var 
  r: HRgn; 
begin 
  Timer1.interval := 500; 
  borderstyle := bsNone; 
  FormStyle := fsStayOnTop; 
  doublebuffered := true; 
 
  Image1.left := 0; 
  Image1.top := 0; 
  Image1.autosize := true; 
  Image1.picture.bitmap.handle := LoadBitmap(HInstance, 'uhr'); 
 
  clientwidth := Image1.Width; 
  clientheight := Image1.height; 
 
  r := CreateEllipticRgn(-1, -1, width + 1, height + 1); 
  setwindowRgn(handle, r, true); 
  left := screen.width - width - 10; 
  top := 10; 
  readposi; 
 
  mass := round(width * 0.8); 
  mitte := width div 2; 
  absts := (mass * 2) / 31; 
  abstm := (mass * 2) / 24; 
  absth := (mass * 2) / 11; 
 
  bm := TBitmap.Create; 
  bm.pixelformat := pf24bit; 
  bm.width := image1.width; 
  bm.height := image1.height; 
  bm.transparent := true; 
 
  hig := TBitmap.create; 
  hig.assign(Image1.picture.bitmap); 
end; 
 
function TClock.x(w, d, b: double): integer; 
begin 
  b := b / 2 - d; 
  result := trunc(cos((pi / 30) * w - pi / 2) * b + mitte); 
end; 
 
function TClock.y(w, d, h: double): integer; 
begin 
  h := h / 2 - d; 
  result := trunc(sin((pi / 30) * w - pi / 2) * h + mitte + 0.5); 
end; 
 
procedure TClock.zeiger(c: TCanvas; farbe: TColor; wert, diff: double; 
  dicke: integer); 
begin 
  c.pen.color := farbe; 
  c.pen.width := dicke; 
  c.moveto(mitte, mitte); 
  c.lineto(x(wert, diff, mass), y(wert, diff, mass)); 
end; 
 
procedure TClock.Timer1Timer(Sender: TObject); 
var 
  Hour, Min, Sec, MSec: Word; 
  hlp: double; 
 
  procedure stundenhin; 
  begin 
    hlp := hour + (min / 12 + sec / 720); 
    zeiger(bm.canvas, HZeiger, hlp, absth, HDicke); 
  end; 
 
  procedure minutenhin; 
  begin 
    hlp := min + (sec / 60); 
    zeiger(bm.canvas, MZeiger, hlp, abstm, MDicke); 
  end; 
 
begin 
  decodetime(Time, Hour, Min, Sec, MSec); 
  if (sec <> secm) then begin 
    bm.canvas.draw(0, 0, hig); 
    secm := sec; 
    Hour := Hour * 5; 
    stundenhin; 
    minutenhin; 
    zeiger(bm.canvas, SZeiger, sec, absts, SDicke); 
    antialias(bm); 
    image1.canvas.draw(0, 0, bm); 
  end; 
end; 
 
procedure TClock.FormDestroy(Sender: TObject); 
begin 
  writeposi; 
  bm.free; 
  hig.free; 
end; 
 
procedure TClock.Image1MouseUp(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if button = mbright then close; 
end; 
 
procedure TClock.FormShow(Sender: TObject); 
begin 
  showWindow(application.handle, sw_hide); 
  Timer1Timer(Timer1); 
end; 
 
procedure TClock.writeposi; 
begin 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_CURRENT_USER; 
    if Reg.OpenKey('\Software\DBRUHR', True) 
      then begin 
      Reg.WriteInteger('X', left); 
      Reg.WriteInteger('Y', top); 
    end; 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
procedure TClock.readposi; 
begin 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_CURRENT_USER; 
    if Reg.OpenKey('\Software\DBRUHR', False) 
      then begin 
      left := Reg.readInteger('X'); 
      top := Reg.readInteger('Y'); 
    end; 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
end. 

 

Zugriffe seit 6.9.2001 auf Delphi-Ecke