VPF::Чёрно-белая форточка - Форум программистов

DYUMON

Дата 22.3.2007, 21:04 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 321
Регистрация: 17.6.2006
Где: Новосибирск

Репутация: нет
Всего: 3

Народ тут такое дело когда виндовс выключаешь то появляется окошко с выбором что сделать выключить ,перезагрузить или отмена . А изображение на экране становится черно-белым. Кто нибудь знает что за функция отвечает за этот эффект.???

--------------------

Всех программистов надо посадить на целероны, что бы впредь головой думали что пишут.

Snowy

Дата 22.3.2007, 21:10 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 30
Всего: 484

Монопольный захват системы? Затемнение?
Можно сэмулировать можно по типу этого http://forum.vingrad.ru/topic-123470/index.html

DYUMON

Дата 22.3.2007, 21:20 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 321
Регистрация: 17.6.2006
Где: Новосибирск

Репутация: нет
Всего: 3

Пасибо

всё гениальное просто.

--------------------

Всех программистов надо посадить на целероны, что бы впредь головой думали что пишут.

Marsianin

Дата 13.8.2007, 00:42 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Awaiting Authorisation
Сообщений: 48
Регистрация: 24.11.2004

Репутация: нет
Всего: нет

И где это гениальное просто?
В том топике нет нормального ответа.
Нужно сделать систему именно так же, как делается это при выборе выключения компа...чтобы моё окно одно монопольно работало, а всё остальное стало чёрно-белым...видел прогу, которая так делала...
Я так думаю за это что-то из WinAPI отвечает...только как по английски название не могу придумать, чтобы поискать в MSDN.

Sunvas

Дата 13.8.2007, 00:48 (ссылка)

(нет голосов)

Загрузка ...

Соль и сахар

Профиль
Группа: Участник
Сообщений: 3388
Регистрация: 12.3.2006
Где: Тосно

Репутация: нет
Всего: 89

Marsianin, ты действительно думаешь, что есть такая АПИшка? Я вот сомневаюсь. Скорее это как одна из функций той программки, которая позволяет нам перезагрузить компьютер. Тут думаю идет банальный скрин экрана, над которым проводятся фотошоповские действия смены насыщенности цвета.

--------------------

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

Marsianin

Дата 13.8.2007, 00:59 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Awaiting Authorisation
Сообщений: 48
Регистрация: 24.11.2004

Репутация: нет
Всего: нет

Да кто его знает есть оно на самом деле или нет, но хотелось бы ;)
По крайней мере может есть где пример, как это сделать и залочить все остальные программы.
Видел прогу из состава каких-то твикеров под винду, которая так делала так, что от родного не отличить и лочила все остальные проги.
Хотя, не исключено, что это скриншот и форма на весь экран...вот это и пытаемся выяснить тут ;)

P.S. Насколько я помню Ctrl+Alt+Del и Alt+Tab не пашут тоже при этом...

Это сообщение отредактировал(а) Marsianin - 13.8.2007, 01:02

Marsianin

Дата 13.8.2007, 01:27 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Awaiting Authorisation
Сообщений: 48
Регистрация: 24.11.2004

Репутация: нет
Всего: нет

Мда, это не WinAPI. Я нашёл решение (пока не проверял сам):

Код


Drop a TImage and a TBuoon on a form and
set the ButtonClick to this code.


procedure TForm1.Button1Click(Sender: TObject);
procedure Veil;
 var
   BrushBmp: TBitmap;
   X, Y: Integer;
 begin
   BrushBmp := TBitmap.Create;
   with BrushBmp do
   begin
     Width := 8;
     Height := 8;
     for X := 0 to 7 do
       for Y := 0 to 7 do
         if Odd(X + Y) then
           Canvas.Pixels[X, Y] := clWhite
         else
           Canvas.Pixels[X, Y] := clBlack;
   end;
   Image1.Canvas.Brush.Bitmap := BrushBmp;
   (* From the help file:
        The PatBlt function paints the given rectangle
        using the brush that is currently selected into
        the specified device context. The brush color
        and the surface color(s) are combined by using
        the given raster operation.
   *)
   PatBlt(Image1.Canvas.Handle, 0, 0, Image1.Width, Image1.Height, $000A0329);
   BrushBmp.Free;
 end;

var
 ScreenDC : HDC;
 tmpRect : TRect;
 tmpBitmap : TBitmap;
 DesktopHandle: HWND;
begin
 SetBounds(0,0,Screen.Width, Screen.Height); // Set the form bounds
 DesktopHandle := GetDesktopWindow;
 ScreenDC := GetDc(DesktopHandle);
 { get our screen device context }
 // ScreenDC := GetDC(0);
 { create our bitmap }
 tmpBitmap := TBitmap.Create;
 { get the screen area }
 tmpRect := Rect(0,0,Screen.Width,Screen.Height);
 { set the bitmap to the screen area }
 tmpBitmap.Width := tmpRect.Right - tmpRect.Left;
 tmpBitmap.Height := tmpRect.Bottom - tmpRect.Top;
 try
   { transfer the screen pixels to the bitmap }
   BitBlt(tmpBitmap.Canvas.Handle,
          tmpRect.Left,
          tmpRect.Top,
          tmpBitmap.Width,
          tmpBitmap.Height,
          ScreenDC,
          tmpRect.Left,
          tmpRect.Top,
          SRCCOPY );
   { assign the bitmap image to our timage }
   Image1.Picture.Bitmap.Assign(tmpBitmap);
 finally
   { free our bitmap }
   tmpBitmap.Free;
   { release our screen device context }
   ReleaseDC(0, ScreenDC);
 end;
 Veil;
end;

bartram

Дата 13.8.2007, 07:44 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1606
Регистрация: 22.2.2004
Где: Russia, Samara

Репутация: 3
Всего: 29

Вариант Snowy работает лучше

Это сообщение отредактировал(а) bartram - 13.8.2007, 07:44

--------------------

В каждом из нас спит гений, но с каждым днем все крепче ;-)
bartram.ru
Twitter
user posted image

RinOSpro

Дата 12.9.2007, 08:42 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Да пример от Snowy классный но в виндовсе там не таким образом сделано.

откройте диспечтер задач и вызовите окно выкл компьютера как мы видим график стоит на месте, там применяется какойто графический фильтр. Это не апишка ищи MSDN в разделе графика мультимедия

Alexeis

Дата 12.9.2007, 09:42 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 16
Всего: 459

А я предлагаю сделать так. Прозрачность формы которая снизу сделать 1, так чтобы ее не было видно, но она не прокликивалась. Скопировать изображения рабочего стола в битмапку, а затем сделать еще одну битмапку в которой просто менять насыщенность цвета (В хрюше меняется именно насыщенность) и выводить ее прямо на рабочий стол, вот только оба окна должны быть OnTOP.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Alexeis

Дата 12.9.2007, 12:16 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 16
Всего: 459

Кароч вот мой вариантик, сделал более дружественно, просто скопировал рабочий стол на форму которая ниже и меняю ее изображение делая его более серым с каждым тактом. Похоже винда делает аналогичным образом, потому что в винде смайлики при "угасании" перестают двигаться, но окно прячется по Alt+Tab и Windows + D.

Таймер по делфолту отключен и время тика установлено 100 мс. Лучше всего попробовать на приатаченном примере. При запуске даже мелькания не видно smile

. Вторая форма по дефолту имеет прозрачность 1 чтобы не мелькала при появлении, а потом становиться непрозрачной сразу с картинкой. Поскольку она слоистая, то и не нуждается в перерисовке при движении верхнго окна по ней.

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    ListBox1: TListBox;
    Image1: TImage;
    RadioGroup1: TRadioGroup;
    Timer1: TTimer;
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    b : TBitmap;
    Thide : Integer;
  end;

var
  Form1: TForm1;
  bLoaded: Boolean = False;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
begin
  if bLoaded then
    Exit;

  Timer1.Enabled := True;
  with Form2 do
    begin
      Show;
      BorderStyle := bsNone;
      BoundsRect := Screen.WorkAreaRect;
      Form1.Show;
      BitBlt(Form2.Canvas.Handle, 0, 0, b.Width, b.Height, b.Canvas.Handle, 0, 0, SRCCOPY);
      Form2.AlphaBlendValue := 255;
    end;
  bLoaded := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  DDC: HDC;
begin
  b             := TBitmap.Create;
  b.Width       := Screen.Width;
  b.Height      := Screen.Height;
  b.PixelFormat := pf32bit;
  DDC := GetDC(GetDesktopWindow());
  BitBlt(b.Canvas.Handle, 0, 0, b.Width, b.Height, DDC, 0, 0, SRCCOPY);
  ReleaseDC(GetDesktopWindow(), DDC);
  Thide := 30;
end;

type
  TRGBA = packed record
    B,G,R,A : Byte;
  end;

  TpixArr = array [0..32000] of TRGBA;
  PpixArr = ^TpixArr;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  DDC  : HDC;
  i, J : Integer;
  p    : PpixArr;
  max  : Integer;

begin
  if Thide > 0
  then
    Dec(Thide)
  else
    Timer1.Enabled := False;

  For j := 0 to b.Height - 1
  do
    begin
      p := b.ScanLine[j];
      For i := 0 to b.width - 1
      do
        begin
          if (p[i].B > p[i].G)
          then
            if (p[i].B > p[i].R)
            then
              max := p[i].B
            else
              max := p[i].R
          else
            if (p[i].G > p[i].R)
            then
              max := p[i].G
            else
              max := p[i].R;

          Inc(p[i].B, (max - p[i].B) div 5);
          Inc(p[i].G, (max - p[i].G) div 5);
          Inc(p[i].R, (max - p[i].R) div 5);
        end;
    end;
  DDC := GetDC(Form2.Handle);
  BitBlt(DDC, 0, 0, b.Width, b.Height, b.Canvas.Handle, 0, 0, SRCCOPY);
  ReleaseDC(Form2.Handle, DDC);
end;

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

end.

Код


unit Unit2;

interface

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

type
  TForm2 = class(TForm)
  private
    { Private declarations }
    procedure WMMouseActivate(var M: TWMMouseActivate); message WM_MOUSEACTIVATE;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.WMMouseActivate(var M: TWMMouseActivate);
begin
  M.Result := MA_NOACTIVATEANDEAT;
end;

end.

Это сообщение отредактировал(а) Alexeis - 12.9.2007, 12:17

Присоединённый файл ( Кол-во скачиваний: 9 )

Zatemnenie_3__2007.09.12_12.18.rar 26,82 Kb

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »