"Flackern" durch SetWindowRgn?

[JayBee]

Hallo ihrs da,

ich habe ein Problem mit einer selbstgeschriebenen "Binäruhr".
Diese Zeigt in Form von Kreisen die für 1, 2, 4,... stehen die aktuelle Uhrzeit an.
Der Code ist (warscheinlich) sehr Umständlich, aber mir ist nichts besseres eingefallen.

Über einen Timer wird jede Sekunde die Uhrzeit abgefragt und in drei Variablen gespeichert (h, m und s)
Danach wird für jeden zu erscheinenden Punkt über eine if-Abfrage ein Region kreiert und zu guter letzt per CombineRgn und SetWindowRgn die Form auf die Punktwe zurechtgestuzt.
Allerdings habe ich das Problem, das nach einiger Zeit (manchmal 20 Sekunden, manchmal 2 Minuten) mein Bildschirm im Sekundentakt anfängt zu "flackern" (Der desktop erschein und alle fenster werden neu geladen). Für abhilfe wäre ich sehr dankbar, da dieses geflacker doch arg stört, und ich auch gerne mal wissen würde woran es liegt.

mFg
JayBee


PS: Hier noch der Quellcode

Code:

procedure TForm1.FormCreate(Sender: TObject);
begin
 Form1.Top := 300;
 Form1.Width := 169;
 Form1.Height := 100;
 Form1.Left := 1111;
 Form1.Timer1Timer(self); // Direkt nach dem Start das Timer-Event aufrufen um nicht für kurze Zeit die komplette Form zu zeigen
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
 t: String;
 h, m, s: Integer;
 s1, s2, s4, s8, s16, s32, m1, m2, m4, m8, m16, m32, h1, h2, h4, h8, h16, NewRgn: HRGN;
begin
 DateTimeToString(t, 'h', Now);
 h := StrToInt(t);
 DateTimeToString(t, 'n', Now);
 m := StrToInt(t);
 DateTimeToString(t, 's', Now);
 s := StrToInt(t);

 NewRgn := CreateRectRgn(0,0,0,0);
 if (s div 32 >= 1) then begin
  s32 := CreateEllipticRgn(5, 60, 25, 80);
  s := s-32;
 end else
  s32 := CreateEllipticRgn(0, 0, 0, 0);
 if (s div 16 >= 1) then begin
  s16 := CreateEllipticRgn(30, 60, 50, 80);
  s := s-16;
 end else
  s16 := CreateEllipticRgn(0, 0, 0, 0);
 if (s div 8 >= 1) then begin
  s8 := CreateEllipticRgn(55, 60, 75, 80);
  s := s-8;
 end else
  s8 := CreateEllipticRgn(0, 0, 0, 0);
 if (s div 4 >= 1) then begin
  s4 := CreateEllipticRgn(80, 60, 100, 80);
  s := s-4;
 end else
  s4 := CreateEllipticRgn(0, 0, 0, 0);
 if (s div 2 >= 1) then begin
  s2 := CreateEllipticRgn(105, 60, 125, 80);
  s := s-2;
 end else
  s2 := CreateEllipticRgn(0, 0, 0, 0);
 if (s div 1 >= 1) then begin
  s1 := CreateEllipticRgn(130, 60, 150, 80);
 end else
  s1 := CreateEllipticRgn(0, 0, 0, 0);

 CombineRgn(NewRgn, s32, s16, RGN_OR);
 CombineRgn(NewRgn, s8, NewRgn, RGN_OR);
 CombineRgn(NewRgn, s4, NewRgn, RGN_OR);
 CombineRgn(NewRgn, s2, NewRgn, RGN_OR);
 CombineRgn(NewRgn, s1, NewRgn, RGN_OR);

 if (m div 32 >= 1) then begin
  m32 := CreateEllipticRgn(5, 35, 25, 55);
  m := m-32;
 end else
  m32 := CreateEllipticRgn(0, 0, 0, 0);
 if (m div 16 >= 1) then begin
  m16 := CreateEllipticRgn(30, 35, 50, 55);
  m := m-16;
 end else
  m16 := CreateEllipticRgn(0, 0, 0, 0);
 if (m div 8 >= 1) then begin
  m8 := CreateEllipticRgn(55, 35, 75, 55);
  m := m-8;
 end else
  m8 := CreateEllipticRgn(0, 0, 0, 0);
 if (m div 4 >= 1) then begin
  m4 := CreateEllipticRgn(80, 35, 100, 55);
  m := m-4;
 end else
  m4 := CreateEllipticRgn(0, 0, 0, 0);
 if (m div 2 >= 1) then begin
  m2 := CreateEllipticRgn(105, 35, 125, 55);
  m := m-2;
 end else
  m2 := CreateEllipticRgn(0, 0, 0, 0);
 if (m div 1 >= 1) then begin
  m1 := CreateEllipticRgn(130, 35, 150, 55);
 end else
  m1 := CreateEllipticRgn(0, 0, 0, 0);

 CombineRgn(NewRgn, m32, NewRgn, RGN_OR);
 CombineRgn(NewRgn, m16, NewRgn, RGN_OR);
 CombineRgn(NewRgn, m8, NewRgn, RGN_OR);
 CombineRgn(NewRgn, m4, NewRgn, RGN_OR);
 CombineRgn(NewRgn, m2, NewRgn, RGN_OR);
 CombineRgn(NewRgn, m1, NewRgn, RGN_OR);

 if (h div 16 >= 1) then begin
  h16 := CreateEllipticRgn(30, 10, 50, 30);
  h := h-16;
 end else
  h16 := CreateEllipticRgn(0, 0, 0, 0);
 if (h div 8 >= 1) then begin
  h8 := CreateEllipticRgn(55, 10, 75, 30);
  h := h-8;
 end else
  h8 := CreateEllipticRgn(0, 0, 0, 0);
 if (h div 4 >= 1) then begin
  h4 := CreateEllipticRgn(80, 10, 100, 30);
  h := h-4;
 end else
  h4 := CreateEllipticRgn(0, 0, 0, 0);
 if (h div 2 >= 1) then begin
  h2 := CreateEllipticRgn(105, 10, 125, 30);
  h := h-2;
 end else
  h2 := CreateEllipticRgn(0, 0, 0, 0);
 if (h div 1 >= 1) then begin
  h1 := CreateEllipticRgn(130, 10, 150, 30);
 end else
  h1 := CreateEllipticRgn(0, 0, 0, 0);

 CombineRgn(NewRgn, h16, NewRgn, RGN_OR);
 CombineRgn(NewRgn, h8, NewRgn, RGN_OR);
 CombineRgn(NewRgn, h4, NewRgn, RGN_OR);
 CombineRgn(NewRgn, h2, NewRgn, RGN_OR);
 CombineRgn(NewRgn, h1, NewRgn, RGN_OR);

 SetWindowRgn(Handle, NewRgn, true);
 SetWindowPos(Handle, HWND_TOPMOST, Left,Top, Width, Height, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE); 
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
 ShowWindow(Application.Handle, SW_Hide);
end;

[Luckie]

Warum arbeitest du da mit Regions? Zeichen doch einfach Kreise. Oder nimm Images, die du entsprechend sichtbar machst.

[JayBee]

Zitat von Luckie:

Warum arbeitest du da mit Regions? Zeichen doch einfach Kreise. Oder nimm Images, die du entsprechend sichtbar machst.

Wie schon gesagt ist mir zum einen grade nichts besseres eingefallen und zum anderen habe ich noch keine (funktionierende) Funktion gefunden, um in Delphi 5 die Form unsichtbar zu machen, aber einzelne Komponenten (bzw. Kreise) sichtbar zu lassen.

[Luckie]

Hm stimmt, das könnte ein Problem sein. Aber so wie es jetzt ist, würde es mir auch nicht gefallen. Vor grauem Hintergrund sieht man nämlich nichts. Und da die meisten fenster grau sind, wirst du immer das Problem haben, dass man bei machen Konstellationen nichst sieht. Deswegen würde ich die Form nicht unsichtbar machen, sondern höchstens transparent und auf dem Form-Hintergrund zeichnen.

[JayBee]

zZt ist als Form-Hintergrund-Farbe ein Babyblau eingestellt, was dann auch die Farbe der Kreise ist. Und Blau ist doch schon gut zu erkennen auf meiner grauen SideBar.
Und da es auch mehr ein Anwendung nur für mich ist, sollte die Farbe weniger ein Problem darstellen.
(Falls ich das ganze mal veröffentlichen sollte - danke für den Tipp

Habe jetzt mal noch bischen mit Canvas rumexperimentiert, aber wenn ich in die Form zeichne und sie transparent mache, sehe ich nichts von meinen schönen Kreisen, und wenn ich versuche, auf die SideBar direkt zu zeichnen, zeichnet er nur "dahinter" (Die Sidebar steht auf "Immer im Vordergrund" und "Andocken", also praktisch ähnlich wie die Taskleiste)

[stoxx]

http://www.pjh2.de/delphi/units/index.php?l=de

[Luckie]

Zitat von stoxx:

http://www.pjh2.de/delphi/units/index.php?l=de

Es wäre eventuell ganz hilfreich noch ein paar Worte zu deinem Link zu schreiben, da nicht unbedigt gleich ersichtlich ist, was du meinst.

[turboPASCAL]

Du musst die erstellten Regionen wieder freigeben (CreateRectRgn DeleteObject).

Das würde dann in etwas formatierter Version so ausschauen: (siehe Anhang)

[JayBee]

Höhöh... tjaja, die Sache mit dem Freigeben...
Hab deine Unit jetzt ca. ne halbe Stunde am laufen ohne flackern

Nur was mir jetzt auffällt ist, dass die Zeit nicht richtig Angezeigt wird
Wir haben auf meine Uhr hier 12:13, ich sehe in der ersten "Zeile" einen Punkt bei 8 und 2 (macht 10) und in der zweiten Zeile bei 8, 4 und 1 (13). Also stimmt irgendwas mit den Stunden nicht.

Wenn ich statt deines dt.wHour meine formatierung über den String nehme, funktioniert hingegen alles Richtig.

mFg

//Edit: Das wird wohl da dran liegen, das bei mir die Systemzeit nicht gleich der Windowszeit ist. Problem isoliert und gelöst: ich nehm einfach meine Routine zum setzen der Zeitvariablen

Danke an alle, die geholfen haben

[turboPASCAL]

Besser ist es wohl die Regionen nur einmal zu erstellen. die Gesammte If-Abfragerei und das Erstellen
der Regionen können drastisch vereinfacht werden.
Damit die Lesbarkeit des Binärsystems besser erhalten bleibt kann doch die Anzeige im "Auszustand"
eine Abgedunkelte Fläche darstellen.

Eine Neue und kürzere Version die auch das Darstellen auf dem Desktop (als Kindfenster) untersützt
könnte zb: so aussehen:

Delphi-Quellcode:

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    PopupMenu1: TPopupMenu;
    Beenden1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
  private
    { Private-Deklarationen }
      dt: TSystemTime;
      WinRGN: HRGN;
      procedure CreateRegions;
      procedure DrawBinTime;
  public
    { Public-Deklarationen }
    procedure CreateParams(var Params: TCreateParams); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  Radius =  5;
  XYStep = (Radius * 2) + 2;
  Digits =  6;

  SetToDesktop = TRUE;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  if SetToDesktop then
  begin
    Params.Style := WS_POPUP;
    Params.ExStyle := WS_EX_NOACTIVATE;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  ShowHint := TRUE;

  Width  := Digits * XYStep;
  Height := 3 * XYStep;

  Top := 10;
  Left := Screen.Width - Width - 10;

  WinRGN := CreateRectRGN(0, 0, 0, 0);

  CreateRegions;

  GetSystemTime(dt);

  SetWindowRgn(Handle, WinRGN, TRUE);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  DeleteObject(WinRGN);
  
  Action := caFree;
end;

procedure TForm1.CreateRegions;
var
  i, n, x , y: Integer;
  RGN : HRGN;
begin
  y := Radius;
  for n := 1 to 3 do
  begin
    x := clientwidth - Radius;
    for i := Digits downto 1 do
    begin
      RGN := CreateEllipticRgn(x - Radius,
                               y - Radius,
                               x + Radius + 1,
                               y + Radius + 1);
      CombineRgn(WinRgn, RGN, WinRgn, RGN_OR);
      DeleteObject(RGN);
      dec(x, XYStep);
    end;
    inc(y, XYStep);
  end;
end;

function IntToBin(Int, Digits: Integer): String;
var
  i : Integer;
begin
  Result := '';
  for i := Digits - 1 downto 0 do
    Result := Result + IntToStr((Int shr i) and 1);
end;

procedure TForm1.DrawBinTime;
var
  i, n, x , y: Integer;
  s: string;
begin
  y := Radius;
  for n := 1 to 3 do
  begin
    case n of
      1: s := IntToBin(dt.wHour, Digits);
      2: s := IntToBin(dt.wMinute, Digits);
      3: s := IntToBin(dt.wSecond, Digits);
    end;

    x := clientwidth - Radius;
    for i := length(s) downto 1 do
    begin
      if s[i] <> '0' then
      begin
        Canvas.Pen.Color   := RGB(128, 0, 0);
        Canvas.Brush.Color := RGB(255, 0, 0);
      end else
      begin
        Canvas.Brush.Color := RGB(64, 0, 0);
        Canvas.Pen.Color   := RGB(32, 0, 0);
      end;

      Canvas.Ellipse(x - Radius, y - Radius, x + Radius, y + Radius);

      dec(x, XYStep);
    end;
    inc(y, XYStep);
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
  // inlinefunction
  function ItS(V: integer): String; begin str(V:2, Result); end;
  //
begin
  GetLocalTime(dt);
  Hint := ItS(dt.wHour) + ':' + ItS(dt.wMinute) + ':' + ItS(dt.wSecond);

  DrawBinTime;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  DrawBinTime;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  if SetToDesktop then
  begin
    ShowWindow(Application.Handle, SW_Hide);
    SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);

    Windows.SetParent(Handle, GetDesktopWindow);
    SetWindowPos(Handle, HWND_BOTTOM, 0, 0, 0, 0,
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  end else
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0,
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
end;

procedure TForm1.Beenden1Click(Sender: TObject);
begin
  Close;
end;

end.