Вызов Wm_erasebkgnd

[Dock1100]

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

 

[EdgarWine]

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

 

[Dock1100]

Прикладная программа отправляет сообщение 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.

 

[EdgarWine]

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

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

 

[Dock1100]

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

 

[EdgarWine]

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

 

[Dock1100]

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

 

[EdgarWine]

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

 

[Dock1100]

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

 

[EdgarWine]

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

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

 

[Dock1100]

Вот контролы придётся вручную отрисовывать - это да, не удобно...

контролы непроблема.

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

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

 

[EdgarWine]

Layered-окно бывает 3-х видов:

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

Вот тут один из лучших примеров по 3-му пункту:

Ссылка скрыта от гостей

 

[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.

 

[Dock1100]

Спосибо, работает

 

[EdgarWine]

Похоже на мой способ (хотя многие до него сами рано или поздно доходят), но вот пара нюансов:

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

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

 

[Dock1100]

в Win7 эта фича не работает... (

Работает, токо сначала подправить код пришлось и форму.

 

[evg2108]

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

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

 

[EdgarWine]

Хм... Какая у вас версия Win7?

 

[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.

 

[EdgarWine]

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