Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Anwendung grau werden lassen? Wie bei WinXP beenden! (https://www.delphipraxis.net/42186-anwendung-grau-werden-lassen-wie-bei-winxp-beenden.html)

dragi 15. Mär 2005 13:15


Anwendung grau werden lassen? Wie bei WinXP beenden!
 
Hallo,

wie kann man denn seine Applikation so "Grau" werden lassen wie es WindowsXP macht beim erscheinen des Beenden-Dialogs? EMule macht dies auch wenn der Beenden Dialog aufpoppt verliert die Applikation die gesamte Farbe?! Das find ich irgendwie cool :)

Gruss

Dragi

Matze 15. Mär 2005 13:24

Re: Anwendung grau werden lassen? Wie bei WinXP beenden!
 
Benutze einmal die Suche.

Es geht, soweit ich weiß, nur über ein Bitmap, dessen Farb-Sättigung du änderst.

Stevie 15. Mär 2005 13:35

Re: Anwendung grau werden lassen? Wie bei WinXP beenden!
 
Zitat:

Zitat von dragi
EMule macht dies auch wenn der Beenden Dialog aufpoppt verliert die Applikation die gesamte Farbe?!

:shock: Kenn ich nicht, was ist das für ein Programm? :roll: :lol:
Aber Scherz beiseite, du musst quasi selber das Zeichnen übernehmen, am besten indem du das so machst, wie Matze schon erwähnte.

whiteshark 15. Mär 2005 13:36

Re: Anwendung grau werden lassen? Wie bei WinXP beenden!
 
Wie wäre es,wenn du über einen Timer die RGB-Werte des Backgrounds immer mehr ins graue gehen lässt.
Und die Farbänderung packst du in eine Schleife.
Delphi-Quellcode:
function farbe(var i:integer):integer;
begin
for i:=1 to 255 do
   begin
   form1.color:=RGB(45,67,i);
   end;
end; //end of function

himitsu 15. Mär 2005 13:51

Re: Anwendung grau werden lassen? Wie bei WinXP beenden!
 
Also, um es zusammenzufassen, was ddie anderen meinen ...


Du nimmst ein Bild von deinem Programm (z.B. machst du kurz zuvor ein Screenshot),
und zeichnest es direckt über dein Programm,
dann veränderst du die Farbe etwas und zeichnest es nochmal darüber
und so weiter, bis es Greu ist

(PS: Windows XP macht es vermutlich genauso, nur halt mit dem gesamtem Bildschirm)

dragi 15. Mär 2005 14:02

Re: Anwendung grau werden lassen? Wie bei WinXP beenden!
 
Vielen Dank,

dann weiss ich jetzt wie ich es zu machen habe.

Vielen Dank

Dragi

moritz 15. Mär 2005 14:13

Re: Anwendung grau werden lassen? Wie bei WinXP beenden!
 
Zitat:

Zitat von whiteshark
Wie wäre es,wenn du über einen Timer die RGB-Werte des Backgrounds immer mehr ins graue gehen lässt.
Und die Farbänderung packst du in eine Schleife.
Delphi-Quellcode:
function farbe(var i:integer):integer;
begin
for i:=1 to 255 do
   begin
   form1.color:=RGB(45,67,i);
   end;
end; //end of function

Halt, dadurch wird es nicht grau, sondern nur weniger blau. Die Funktion muss im Prinzip so aussehen:
Delphi-Quellcode:
procedure Blur(var blurColor: TColor; const MaxGrey: Byte {0 means Black}; const Delay: Byte);
var
  cRGB: Longint;
  Red, Green, Blue: Byte;
  I: Byte;
  Steps: Byte;
begin
  cRGB := ColorToRGB(blurColor);
  Red := Byte(cRGB); Green := Byte(cRGB shr 8); Blue := Byte(cRGB shr 16);
  Steps := 255-MaxGrey;
  for I:=0 to Steps do
  begin
    blurColor := RGB(Red-Round(I*(Steps/Red)), Green-Round(I*(Steps/Green)), Blue-Round(I*(Steps/Blue)));
    Application.ProcessMessages;
    Sleep(Delay);
  end;
end;
(Passiert allerdings noch ne hässliche Division durch Null)

Gruß

sniper_w 15. Mär 2005 15:26

Re: Anwendung grau werden lassen? Wie bei WinXP beenden!
 
So, ich schlage dir etwas konkretes vor :wink:
Delphi-Quellcode:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    ListBox1: TListBox;
    ScrollBar1: TScrollBar;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    LabeledEdit1: TLabeledEdit;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    slika : tbitmap;
  end;

var
  Form1: TForm1;
  Scale : byte;

implementation

{$R *.dfm}

procedure ConverToGrayStep(const Bitmap:TBitmap; const Progress, MaxSteps : Byte);//---------SNIPER_W
type
  PPixelRec = ^TPixelRec;
  TPixelRec = packed record
    B: Byte;
    G: Byte;
    R: Byte;
    Reserved: Byte;
  end;
var
  X: Integer;
  Y: Integer;
  P: PPixelRec;
  Gray: Byte;
begin
  Assert(Bitmap.PixelFormat = pf32Bit);
  for Y := 0 to (Bitmap.Height - 1) do
  begin
    P := Bitmap.ScanLine[Y];
    for X := 0 to (Bitmap.Width - 1) do
    begin
      Gray := (P.R + P.G + P.B) div 3;

//---------SNIPER_W
      P.R := P.R + BYTE(Round((Gray-P.R) * Progress / MaxSteps));
      P.G := P.G + BYTE(Round((Gray-P.G) * Progress / MaxSteps));
      P.B := P.B + BYTE(Round((Gray-P.B) * Progress / MaxSteps));
//---------SNIPER_W

      Inc(P);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
 var ddc: cardinal;
begin
 slika := TBitmap.Create;
 slika.PixelFormat := pf32bit;
 slika.Width := Width;
 slika.Height := Height;
 ddc := GetWindowDC(handle);
 BitBlt(slika.Canvas.Handle,0,0,slika.Width,slika.Height,ddc,0,0,SRCCOPY);
 ReleaseDC(handle,ddc);
 Scale := 0;
 Timer1.Interval := 100; // <<-- die Geschwidigkeit, was Timer betrifft
 Timer1.Enabled := True;
end;

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

procedure TForm1.Timer1Timer(Sender: TObject);
 var ddc: cardinal;
begin //
 if Scale < 255 then
 begin
 ConverToGrayStep(slika,Scale,255);
 Inc(Scale,3); // Progress pro 1 Timer Proc (durchlauf)
 ddc := GetWindowDC(handle);

 BitBlt(ddc,0,0,width,height,slika.Canvas.Handle,0,0,SRCCOPY);

 ReleaseDC(handle,ddc);
 end
        else Timer1.Enabled := False;
end;

end.

whiteshark 15. Mär 2005 19:45

Re: Anwendung grau werden lassen? Wie bei WinXP beenden!
 
Zitat:

Halt, dadurch wird es nicht grau, sondern nur weniger blau.
Ja das stimmt. :wall:
Aber ich wollte nur mein Prinzip oder meinen Ansatz erklären.


Alle Zeitangaben in WEZ +1. Es ist jetzt 12:54 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz