Вызов Wm_erasebkgnd

Тема в разделе "Delphi - Multimedia, Графика, Игры", создана пользователем Dock1100, 5 авг 2010.

  1. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    В WM_EraseBkgnd запоминаю то что находится под формой, а в FormPaint рисую то что запомнил, но это работает при появлении форми и при сворачивании\развертывании. Но как сделать что б WM_EraseBkgnd выполнялось при перемещении формы(перемещается вручную) ?
     
  2. EdgarWine

    EdgarWine Гость

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

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0

    Добавлено :
    Код (Text):
    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.
     
  4. EdgarWine

    EdgarWine Гость

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

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

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Это удобно если форма на месте стоит, а вот с тасканием формы посложнее
     
  6. EdgarWine

    EdgarWine Гость

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

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    PngForm. Просто пишу плеер, подошол к визуальной части.
     
  8. EdgarWine

    EdgarWine Гость

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

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Можно, но для прозрачных рисунков(а точнее полу-прозрачных) нужна канва, а рисовать сверху на форме не совсем удобно.
     
  10. EdgarWine

    EdgarWine Гость

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

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    контролы непроблема.

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

    EdgarWine Гость

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

    Вот тут один из лучших примеров по 3-му пункту: http://antonn.ru/index.php?forum=4&th=122&comments
     
  13. evg2108

    evg2108 Гость

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

    Код (Text):
    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.
     
  14. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Спосибо, работает :D
     
  15. EdgarWine

    EdgarWine Гость

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

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

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Работает, токо сначала подправить код пришлось и форму.
     
  17. evg2108

    evg2108 Гость

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

    EdgarWine Гость

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

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Windows 7 Ultimate Версия 6.1 сборка 7600
    А вот код:
    Код (Delphi):
    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.
     
  20. EdgarWine

    EdgarWine Гость

    У меня Win7BlackEdition 64bit... Как-то странно работает, подозрительные баги какие-то...
    То GetClientRect не работает, то ClientToScreen сдвинуто куда-то...
    Но не дёргается... А в XP дёргается по-страшному... %)
     
Загрузка...
Похожие Темы - Вызов Wm_erasebkgnd
  1. k85
    Ответов:
    0
    Просмотров:
    360
  2. alexas1
    Ответов:
    0
    Просмотров:
    506
  3. Sanchezz86
    Ответов:
    1
    Просмотров:
    587
  4. vln1981
    Ответов:
    0
    Просмотров:
    707
  5. JohnLemon
    Ответов:
    2
    Просмотров:
    854

Поделиться этой страницей