Вызов Wm_erasebkgnd

  • Автор темы Dock1100
  • Дата начала
D

Dock1100

В WM_EraseBkgnd запоминаю то что находится под формой, а в FormPaint рисую то что запомнил, но это работает при появлении форми и при сворачивании\развертывании. Но как сделать что б WM_EraseBkgnd выполнялось при перемещении формы(перемещается вручную) ?
 
E

EdgarWine

Это как же вы запоминаете то что под формой? Это же невозможно...
Винда не хранит перекрытую часть изображения окон...
 
D

Dock1100

http://www.firststeps.ru/mfc/winapi/pict/r.php?32 сказал(а):
Прикладная программа отправляет сообщение WM_ERASEBKGND, когда фон окна должен быть стерт (например, когда окно изменяет размеры). Сообщение отправляется, чтобы приготовить аннулированную часть окна для перекрашивания.
Нажмите, чтобы раскрыть...


Добавлено :
Код: 
var
Form4: TForm4;
C : TCanvas;
H : THandle;
R : TRect;

implementation

{$R *.dfm}


procedure TForm4.FormCreate(Sender: TObject);
begin
C := TCanvas.Create;
end;

procedure TForm4.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform (WM_SYSCOMMAND,SC_MOVE+2,0);
FormPaint(self);
end;

procedure TForm4.FormPaint(Sender: TObject);
begin
Self.Canvas.CopyRect(Rect(0,0,Width,Height),C,bounds(left,top,width,height));
end;

procedure TForm4.WMEraseBkgnd(var Message: TMessage);
begin
H := GetDesktopWindow;
C.Handle := GetWindowDC(H);
R := Rect(0,0,Screen.Width,Screen.Height);
If H <> 0 Then GetWindowRect(H,R);
end;

end.
 
E

EdgarWine

У меня не работает... 'Canvas does not allow drawing'...
Попытался чуть подправить - иногда рисует на себе кусок себя...
Можно попробовать как в Glassy сделали - делать форме Hide, потом Sleep, скриншот, Show и уже тогда рисовать.....

Шайтан комбинация... %)
 
D

Dock1100

Это удобно если форма на месте стоит, а вот с тасканием формы посложнее
 
E

EdgarWine

И всё же у Glassy это довольно неплохо получается... Практически вообще не дёргается... Даже получше чем мой читерский метод...
А какова сама цель? ;)
 
D

Dock1100

PngForm. Просто пишу плеер, подошол к визуальной части.
 
E

EdgarWine

Хм... А просто Layered-окно нельзя делать?
 
D

Dock1100

Можно, но для прозрачных рисунков(а точнее полу-прозрачных) нужна канва, а рисовать сверху на форме не совсем удобно.
 
E

EdgarWine

Dock1100 сказал(а):
Можно, но для прозрачных рисунков(а точнее полу-прозрачных) нужна канва, а рисовать сверху на форме не совсем удобно.
Нажмите, чтобы раскрыть...
Ничего не понял..... Какая канва, зачем? На полупрозрачных изображениях только через указатели можно нормально рисовать, а gdi тупо затирает альфу...
И что значит сверху формы? Вот контролы придётся вручную отрисовывать - это да, не удобно... :)
 
D

Dock1100

EdgarWine сказал(а):
Вот контролы придётся вручную отрисовывать - это да, не удобно... :)
Нажмите, чтобы раскрыть...
контролы непроблема.

Ничего не понял..... Какая канва, зачем?
И что значит сверху формы?
Нажмите, чтобы раскрыть...

Рисунок PNG, он же прозрачность вроде токо на канву выводит
 
E

EdgarWine

Layered-окно бывает 3-х видов:
  • По цветовому ключу (Form1.TransparentColor:=True);
  • Общая полупрозрачность (Form1.AlphaBlend:=True);
  • И 1:1 по 32битному битмапу...

Вот тут один из лучших примеров по 3-му пункту:
Ссылка скрыта от гостей
 
E

evg2108

Давно писал такую программку. Сначала выставь AlphaBlend в true, а иначе перерисовываться не будет. Вот посмотри, только что потестировал:

Код: 
unit Unit1;

interface

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

type
TForm1 = class(TForm)
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
procedure WMERASEBKGND(var Mes:TMessage); message WM_ERASEBKGND;
procedure WMMOVE(var Mes:TMessage); message WM_MOVE;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMErasebkgnd(var Mes:TMessage);
begin
Mes.Result:=1;
end;

procedure TForm1.WMMOVE(var Mes:TMessage);
begin
Repaint;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
DeltaX,DeltaY : integer;
Bit : TBitmap;
begin
Bit := TBitmap.Create;
Bit.Width := Form1.Width;
Bit.Height := Form1.Height;
Bit.PixelFormat := pf24bit;
DeltaX := 0;
DeltaY := 0;
BitBlt(Bit.Canvas.Handle,2,2,Form1.Width-4,Form1.Height-4,GetDC(0),Form1.Left+DeltaX+2,Form1.Top+DeltaY+2,SRCCOPY);
Form1.Canvas.Draw(-4,-25,bit);
end;

end.

Здесь перерисовывание осуществляется по перехвату сообщения WM_MOVE для окна формы. Но не забудь выставить AlphaBlend в true.
 
E

EdgarWine

Похоже на мой способ (хотя многие до него сами рано или поздно доходят), но вот пара нюансов:
  • GetDC(0) неправильно используется - утечка памяти будет... Нужно через переменную, которую потом освобождать ReleaseDC()...
  • где Bit.Free; ?
  • и зачем каждый раз создавать новый битмап? это лишнее время и ресурсы...
  • если рисунок под формой изменится - на форме он останется старый... Так что лучше через таймер...
  • но всё равно будет дёргаться...
  • в Win7 эта фича не работает... ;)(

Чем нормальное слоёное окно не подходит если отрисовка контролов вручную не проблема? Так и Миранда сделана и ОбъектДок...
 
E

evg2108

EdgarWine сказал(а):
GetDC(0) неправильно используется - утечка памяти будет... Нужно через переменную, которую потом освобождать ReleaseDC()...
где Bit.Free; ?
и зачем каждый раз создавать новый битмап? это лишнее время и ресурсы...
Нажмите, чтобы раскрыть...

Это да. Просто код старый, в те далёкие времена только начинал кодить, поэтому многое забывал, в т. ч. освобождать ресурсы и т. д. А сейчас просто не подумав скопировал код. ;) Прошу простить.
 
D

Dock1100

Windows 7 Ultimate Версия 6.1 сборка 7600
А вот код:
Код: 
unit Unit9;

interface

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

type
TForm9 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
procedure WMERASEBKGND(var Mes:TMessage); message WM_ERASEBKGND;
procedure WMMOVE(var Mes:TMessage); message WM_MOVE;
{ Private declarations }
public
{ Public declarations }
end;

var
Form9: TForm9;
Bit : TBitmap;

implementation

{$R *.dfm}

procedure TForm9.FormCreate(Sender: TObject);
begin
Bit := TBitmap.Create;
Bit.Width := Form9.Width;
Bit.Height := Form9.Height;
Bit.PixelFormat := pf24bit;
form9.TransparentColor:=true;
form9.TransparentColorValue:=clFuchsia;
form9.Color:=clFuchsia;
end;

procedure TForm9.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform (WM_SYSCOMMAND,SC_MOVE+2,0);
end;

procedure TForm9.FormPaint(Sender: TObject);
begin
form9.Canvas.Brush.Color:=clFuchsia;
form9.Canvas.Rectangle(bounds(1,1,Form9.Width-2,Form9.Height-2));
BitBlt(Bit.Canvas.Handle,0,0,Form9.Width,Form9.Height,GetDC(0),Form9.Left,Form9.Top,SRCCOPY);
Form9.Canvas.Draw(0,0,bit);
end;

procedure TForm9.WMERASEBKGND(var Mes: TMessage);
begin
Mes.Result:=1;
end;

procedure TForm9.WMMOVE(var Mes: TMessage);
begin
Repaint;
end;

end.
 
E

EdgarWine

У меня Win7BlackEdition 64bit... Как-то странно работает, подозрительные баги какие-то...
То GetClientRect не работает, то ClientToScreen сдвинуто куда-то...
Но не дёргается... А в XP дёргается по-страшному... %)
 
Для ответа нужно войти/зарегистрироваться
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!

Верх Низ