VPF::В чем ошибка? - Форум программистов

Gnusss

Дата 7.4.2006, 18:51 (ссылка)

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

Загрузка ...

Бывалый

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

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

Привет всем.

В общем, изучаю Субклассинг (subclassing) и возникла такая проблема.
Я создаю кнопку, с помощью субклассинга пытаюсь нарисовать её своими средствами.
В общем, после первого её перерисовывания, кнопка начинает постоянно перерисовываться, как будь-то её постоянно, шлют WM_PAINT.

Код «проекта» где я всё это делаю, прикреплен к сообщению, подскажите, пожалуйста, в чем у меня ошибка.

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

sub.rar 2,59 Kb

B2_Russia

Дата 7.4.2006, 19:14 (ссылка)

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

Загрузка ...

В доску свой :)

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

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

Скорее всего так и есть, делаешь в обработчике WM_PAINT перерисовку окна (код не смотрел)

Gnusss

Дата 7.4.2006, 20:05 (ссылка)

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

Загрузка ...

Бывалый

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

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

Так проблема в том что кнопка начинает постоянно перерисоваватся.

B2_Russia

Дата 8.4.2006, 11:41 (ссылка)

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

Загрузка ...

В доску свой :)

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

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

Код


Function BtnWinProc(HWnd: THandle; Msg: Cardinal; WParam, LParam: Integer): Cardinal; Stdcall;
Begin
 Case Msg Of
   WM_PAINT:
    begin
     BCanvas.FillRect(BRect);
     BCanvas.Rectangle(BRect);
     BCanvas.MoveTo(0,0);
     BCanvas.LineTo(BRect.Right,BRect.Bottom);
     BCanvas.MoveTo(BRect.Right,0);
     BCanvas.LineTo(0,BRect.Bottom);
     Result:= 0;
     Exit;
    end
 end;
 Result:= CallWindowProc(Pointer(GetWindowLong(HWnd, GWL_USERDATA)), Hwnd, Msg, WParam, LParam);
End;

Тут HWnd проверять не нужно?
Не валятся сюда сообщения от других окон? Хотя вроде не должны но проверь...

Gnusss

Дата 9.4.2006, 06:30 (ссылка)

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

Загрузка ...

Бывалый

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

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

Цитата(B2_Russia @ 8.4.2006, 11:41

)

Тут HWnd проверять не нужно?

Нет не нужно т.к ничто кроме одной кнопки не может вызвать эту процедуру.

Цитата(B2_Russia @ 8.4.2006, 11:41

)

Не валятся сюда сообщения от других окон? Хотя вроде не должны но проверь...

И даже есть сделать проверку будет тоже самое.

tigger

Дата 9.4.2006, 09:14 (ссылка)

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

Загрузка ...

Опытный

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

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

Попробуй так...
smile

...

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

sub_tigger_.rar 7,84 Kb

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

Rrader

Дата 9.4.2006, 10:01 (ссылка)

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

Загрузка ...

Inspired =)

Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

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

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    XPManifest1: TXPManifest;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  Protected
    Procedure WndProc(Var Msg: TMessage); Override;
  public
    { Public declarations }
    HBtn: THandle;
  end;

var
  Form1: TForm1;
  BCanvas: TCanvas;
  BRect: TRect;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  If GetParent(HBtn) <> Handle then
  hBtn := CreateWindowEx(0, 'Button', 'Hello!', WS_CHILD Or WS_VISIBLE
   Or BS_PUSHBUTTON, 8, 52, 50, 50, Handle, 123,
    HInstance, NIL);
end;

Procedure TForm1.Button2Click(Sender: TObject);
Begin 
  SendMessage(HBtn, BM_SETSTYLE, BS_OWNERDRAW, 1);
End;

Procedure TForm1.WndProc(Var Msg: TMessage);
Begin
  Inherited;
  If (Msg.Msg = WM_DRAWITEM) And (Msg.WParam = 123) Then
  Begin  
    BCanvas := TCanvas.Create;
    Try
      BCanvas.Handle := GetWindowDC(HBtn);
      BCanvas.Pen.Color := clBlack;
      BCanvas.Brush.Color := clWhite;
      BRect := BCanvas.ClipRect;
      BCanvas.FillRect(BRect);
      BCanvas.Rectangle(BRect);
      BCanvas.MoveTo(0,0);
      BCanvas.LineTo(BRect.Right,BRect.Bottom);
      BCanvas.MoveTo(BRect.Right,0);
      BCanvas.LineTo(0, BRect.Bottom);
    Finally
      BCanvas.Free;
    End;    
  End;
End;

End.

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

Let's do this quickly!
Rest in peace, Vit!

Gnusss

Дата 9.4.2006, 22:37 (ссылка)

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

Загрузка ...

Бывалый

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

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

tigger, ага очень смешно, зачем тогда вообще на WM_PAINT реагировать.
Rrader, очень интересный вариант, наверно он работает (я честно не проверял), но он очень далеко от того что у меня.

Я просто не могу понять почему, кнопка начинает постоянно перерисовываться.

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