Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как заставить PaintBox при скроллинге очищаться полностью [D7, Win95/98, WinXP]


mmb ©   (2004-06-30 19:01:00) 

PaintBox находится внутри ScrollBox. Размер PaintBox больше ScrollBox, поэтому при просмотре используется скроллинг. В окне надо дорисовать оси. Рисуются они в event OnPaint от PaintBox, но оказалось, что Win95/98/XP на экран выводит только ту область, которая испорчена скроллингом, а всё остальное не трогает, и нарисованные оси не рисуются в той части, которая не испорчена. Попытка объявить с помощью функции InvalidateRect всей области испорченной, приводит к вызову перерисовки и соответственно зацикливанию. Помогите решить эту прблему!

wicked   (2004-07-04 23:13:00) [1]

типа так:
-------
... // public поля формы
   OldSBWndProc: TWndMethod;
...

procedure TMyForm.MyFormCreate(Sender: TObject);
begin
   OldSBWndProc := ScrollBox.WindowProc;
   ScrollBox.WindowProc := MySWWndProc;
end;

procedure TMyForm.MyFormDestroy(Sender: TObject);
begin
   ScrollBox.WindowProc := OldSBWndProc;
end;

procedure TMyForm.MySWWndProc(var Message: TMessage);
var doProcessMsg: boolean;
begin
   doProcessMsg := true;
   case Message.Msg of
       WM_ERASEBKGND: begin
           Message.Result := 1;
           doProcessMsg := false;
       end;
       WM_HSCROLL, WM_VSCROLL: begin
           ScrollBox.Invalidate;
       end;
   end;
   if doProcessMsg then OldSBWndProc(Message);
end;
----------
вот в принципе набросок кода - прошу простить ошибки и неточности... ;)

mmb   (2004-07-02 15:13:00) [2]


> [14] wicked ©   (02.07.04 14:21)
> у ScrollBox'а, конечно...

Дорогой wicked, может текстик у тебя найдётся? :)

---
Обнаглевший mmb

wicked   (2004-07-02 14:21:00) [3]

у ScrollBox'а, конечно...

mmb   (2004-07-02 14:06:00) [4]


>  [12] wicked ©   (02.07.04 12:59)


> а кто мешает перехватить WM_ERASEBKGND и просто не выполнять его?...

Дорогой (очень) wicked, спасибо!
Подскажите, у какого из окон лучше перехватить: PaintBox, ScrollBoxили окно формы, внутри которой они находятся?

wicked   (2004-07-02 12:59:00) [5]

а кто мешает перехватить WM_ERASEBKGND и просто не выполнять его?... кстати, это способ избавиться от мерцаний при перерисовке....
а вот WM_NCPAINT/WM_PAINT нужны...

mmb   (2004-07-02 12:02:00) [6]


>  [10] wicked ©   (02.07.04 11:50)


> лучше, думаю, вызвать функцию InvalidateRect - кроме посылки
> сообщений она еще и выставляет нужный update region...

Дорогой wicked, спасибо!
Но нам нужно только увеличить update region до размера всего ClipRect, а сообщения не посылать

wicked   (2004-07-02 11:50:00) [7]

> mmb [6]

> А не ничего не будет плохого если я из перехваченых сообщений
> WM_HSCROLL/WM_VSCROLL пошлю сообщения WM_ERASEBKGND and
> WM_NCPAINT, вед вызов функции InvalidateRect к этому и приводит?

лучше, думаю, вызвать функцию InvalidateRect - кроме посылки сообщений она еще и выставляет нужный update region...

mmb   (2004-07-02 11:41:00) [8]


>  [8] Огромное Кулясищще ©   (02.07.04 00:30)

Вот код, который рисует ось и она нормально перемещается при скролинге.

Дорогой Кулясищще, спасибо!
Но нам нужно немножко другое: при скроллинге ось должна оставаться (рисоваться) всегда у края экрана, т.е. не перемещаться :(

Огромное Кулясищще   (2004-07-02 00:30:00) [9]

Вот код, который рисует ось и она нормально перемещается при скролинге.

unit unitMain;

interface

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

type
 TmainForm = class(TForm)
   ScrollBox: TScrollBox;
   PaintBox: TPaintBox;
   procedure FormCreate(Sender: TObject);
   procedure PaintBoxPaint(Sender: TObject);
 private
   { Private declarations }
 public

 end;

var
 mainForm: TmainForm;

implementation

{$R *.DFM}

procedure TmainForm.FormCreate(Sender: TObject);
begin
 ScrollBox.DoubleBuffered := True;
end;

procedure TmainForm.PaintBoxPaint(Sender: TObject);
begin
 PaintBox.Canvas.Brush.Color := clWhite;
 PaintBox.Canvas.Pen.Color := clBlue;
 PaintBox.Canvas.FillRect(PaintBox.Canvas.ClipRect);
 PaintBox.Canvas.MoveTo(PaintBox.ClientWidth div 2, 0);
 PaintBox.Canvas.LineTo(PaintBox.ClientWidth div 2, PaintBox.ClientHeight);
end;

end.

mmb   (2004-07-01 20:27:00) [10]


>  PVOzerski ©   (01.07.04 16:30)

Не могу использовать TImage.Picture.Bitmap, т.к. не хватает его максимальных размеров :)

mmb   (2004-07-01 20:24:00) [11]

А не ничего не будет плохого если я из перехваченых сообщений WM_HSCROLL/WM_VSCROLLпошлю сообщения WM_ERASEBKGND and WM_NCPAINT, вед вызов функции InvalidateRectк этому и приводит?

mmb   (2004-07-01 20:15:00) [12]


> Amoeba ©   (01.07.04 14:29)

Посылаю упрощённый пример кода, который работает также

unit UnitFormMain;

interface

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

type
 TFormMain = class(TForm)
   ScrollBox1: TScrollBox;
   PaintBox1: TPaintBox;
   procedure PaintBox1Paint(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   { Private declarations }
   Tr: array of TPoint;
   Sc: array of TPoint;
 public
   { Public declarations }
 end;

var
 FormMain: TFormMain;

implementation

uses
 Types;

{$R *.dfm}

procedure TFormMain.FormCreate(Sender: TObject);
var
 L: Integer;
begin
 L := PaintBox1.Width;
 SetLength(Tr, L);
 SetLength(Sc, 5);
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
 Tr := nil;
 Sc := nil;
end;

procedure TFormMain.PaintBox1Paint(Sender: TObject);
var
 I: Integer;
 L: Integer;
 N: Integer;
 R: TRect;
begin
 L := PaintBox1.Width;
 with PaintBox1.Canvas do
 begin
   Pen.Color := clRed;
   for I := 0 to L - 1 do
     with Tr[I] do
     begin
       X := I;
       Y := Round(Sin(I * 0.1) * 10);
     end;
   for N := 1 to 29 do
   begin
     for I := 0 to L - 1 do
       with Tr[I] do
         Inc(Y, 20);
     Polyline(Tr);
   end;
   R := ClipRect;
   InflateRect(R, -10, -10);
   Sc[0] := R.TopLeft;
   Sc[2] := R.BottomRight;
   Sc[1].X := Sc[2].X;
   Sc[1].Y := Sc[0].Y;
   Sc[3].X := Sc[0].X;
   Sc[3].Y := Sc[2].Y;
   Sc[4] := R.TopLeft;
   Polyline(Sc);
 end;
end;

end.

object FormMain: TFormMain
 Left = 311
 Top = 212
 Width = 508
 Height = 327
 Caption = 'Test PaintBox'
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = 'MS Sans Serif'
 Font.Style = []
 OldCreateOrder = False
 OnCreate = FormCreate
 OnDestroy = FormDestroy
 PixelsPerInch = 96
 TextHeight = 13
 object ScrollBox1: TScrollBox
   Left = 0
   Top = 0
   Width = 500
   Height = 300
   Align = alClient
   TabOrder = 0
   object PaintBox1: TPaintBox
     Left = 0
     Top = 0
     Width = 1000
     Height = 600
     OnPaint = PaintBox1Paint
   end
 end
end

program PaintBox;

uses
 Forms,
 UnitFormMain in 'UnitFormMain.pas' {FormMain};

{$R *.res}

begin
 Application.Initialize;
 Application.CreateForm(TFormMain, FormMain);
 Application.Run;
end.

PVOzerski   (2004-07-01 16:30:00) [13]

Это, конечно, годится далеко не всегда, но нередко много головной боли уходит, если использовать вместо TPaintBox TImage.Picture.Bitmap.

wicked   (2004-07-01 15:43:00) [14]

перехватить WM_HSCROLL/WM_VSCROLL в ScrollBox'е и делать ему там Invalidate...
как перехватить - см. св-во WindowProc...

Amoeba   (2004-07-01 14:29:00) [15]

У меня, например, такого никогда не наблюдалось. Так что у тебя какая-то ошибка в твоем коде. Так что не видя кода OnPaint трудно сказать что-нибудь конкретное.

MacroDenS   (2004-06-30 20:08:00) [16]

Мало че понял из вопроса...
Какие испорченные области???
Вообще ты как рисуешь-то хоть бы код выложил,
а то говоришь есть трабла, а сути пока не видно.

Наверх

Титульная страница Поиск, карта сайта Написать письмо