Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2007.03.25;
Скачать: CL | DM;

Вниз

Торможение при перерисовке контрола   Найти похожие ветки 

 
TeCC   (2006-06-16 14:19) [0]

Написал контрол который меняет отображаемую на нем картинку при наведении мыши в общем Сабж порядка - 0.5 - 1 с - как можно исправить и вообще можно ли... я чайник в отрисовке виндозных контролов помогите плиз.
Следом привожу куски исходника
Обработчик событий

function TRBbuttWndProc( Sender: PControl; var Msg: TMsg; var Rslt:Integer ): boolean;
var
 D:PTRButtData;
 k:HDC;
 PaintStruct: TPaintStruct;
begin
 D:=Pointer(Sender.CustomObj);
 Result:=false;
 case msg.message of
 WM_CREATE      : begin
                    If D.Simg[0].Handle<>0 then
                     begin
                      D.Region:=BitmapToRegion(GetDC(Msg.hwnd),D.SImg[0],D.ts_color);
                      SetWindowRgn(Msg.hwnd, D.Region, true);
                     end;
                  end;

 WM_PAINT       : begin
                    k:=Msg.wParam;
                    if k=0 then
                    k:= BeginPaint(Sender.Handle, PaintStruct);
                    if D.State=-1 then D.Image.DrawTransparent(k,0,0,D.ts_color)
                    else D.SImg[D.state].DrawTransparent(k,0,0,D.ts_color);
                    if Msg.wParam=0 then EndPaint(Sender.Handle, PaintStruct);
                    Result:=True;
                  end;
 WM_LBUTTONDBLCLK,
 WM_LBUTTONDOWN : begin
                    //Sender.SetPosition(Sender.Position.X+1,Sender.Position.Y+1);
                    D.State:=2;
                    Sender.OnPaint(Sender,GetDC(Sender.Handle));
                    //Sender.Parent.Update;
                    //Sender.Update;

                  end;
 WM_LBUTTONUP   : begin
                    //Sender.SetPosition(sender.Position.X-1,sender.Position.Y-1);
                    D.State:=1;
                    Sender.OnPaint(Sender,GetDC(Sender.Handle));
                    //Sender.Parent.Update;
                    //Sender.Update;
                  end;
 end;
end;


Отрисовщик контрола


procedure TTRButton.DoPaint(Sender: PControl; DC: HDC);
var D:PTRButtData;
   PaintStruct: TPaintStruct;
   k:HDC;
begin
D:=Pointer(Sender.CustomObj);
if D.Selected then
begin
//  Sender.BeginUpdate;
 InvalidateRgn(Sender.Handle,D.Region,True);
 if D.State=-1 then D.Image.DrawTransparent(DC,0,0,D.ts_color)
 else D.SImg[D.state].DrawTransparent(DC,0,0,D.ts_color);
 RedrawWindow(Sender.Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE +
   RDW_ALLCHILDREN + RDW_NOINTERNALPAINT);
//  Sender.EndUpdate;
end;
end;


 
TeCC   (2006-06-16 15:00) [1]

Похоже знающих ответ на данный вопрос нема ;(


 
ECM ©   (2006-06-16 15:05) [2]

Присутсвует какая-то каша

> Написал контрол который меняет отображаемую на нем картинку
> при наведении мыши

В приведенном коде наведение отсутствует - есть реакция на нажатие мышкой :)
По ходу сразу:
WM_LBUTTONDBLCLK - это лишнее
Отрисовщик контрола?!!!! Отрисовка вся выполняется (должна) при обработке WM_PAINT (что вроде есть). Т.е. DoPaint - тоже лишнее
WM_LBUTTONDOWN : begin
    D.State:=2;
    Sender.Invalidate;(это обертка API-шной InvalidateRect)  либо используйте  тут InvalidateRgn
  end;
WM_LBUTTONUP : begin
   D.State:=1;
   Sender.Invalidate; //? InvalidateRgn(....
 end;


 
TeCC   (2006-06-19 08:22) [3]

Большое спасибо - попробую...


 
TeCC   (2006-06-23 15:07) [4]

Попробовал InvalidateRgn - всеравно на большом разрешении тормозит - разрешение экрана 1152x864.


 
Vladimir Kladov   (2006-06-23 18:27) [5]

А что в OnPaint деалется? Если задержка такая, то ее даже не измеряя на глазок будет видно, если остановиться и по шагам пройти.


 
TeCC   (2006-06-28 14:39) [6]

Высылаю полный код программы.
Возможно это еще связано с перерисовкой основной формы. Там отдельный обработчик который рисует на форме графику.
В итоге программа представляет собой специализированную Shell замену.

Обработчик отрисовки основной формы

procedure TForm1.KOLForm1Paint(Sender: PControl; DC: HDC);
var i:integer;
   DrawRect:TRect;
begin
SetStretchBltMode(DC, halftone);
for i:=0 to topcount do
 begin
  if UpperCase(Res[i].RType)="I" then
   begin
    DrawRect:=Form1.Form.ClientRect;
    if (Res[i].PPTop>0) or (Res[i].PPLeft>0) then
     begin
      DrawRect.Top := Floor(DrawRect.Bottom*(Res[i].PPTop/100));
      DrawRect.Left:= Floor(DrawRect.Right*(Res[i].PPLeft/100));
     end;
    if (Res[i].PTop>0) or (Res[i].PLeft>0) then
     begin
      DrawRect.Top:=Res[i].PTop;
      DrawRect.Left:=Res[i].PLeft;
     end;
    if (Res[i].PPWidth>0) or (Res[i].PPHeight>0) then
     begin
      Res[i].Width:=Floor(Res[i].Bitmap.Width*(Res[i].PPWidth/100));
      Res[i].Height:=Floor(Res[i].Bitmap.Height*(Res[i].PPHeight/100));
     end;
    if (Res[i].Width>0) and (Res[i].Height>0) then
     begin
      DrawRect.Right:= DrawRect.Left+Res[i].Width;
      DrawRect.Bottom:= DrawRect.Top+Res[i].Height;
     end;
    if Res[i].Center then
     begin
      DrawRect.Left   := DrawRect.Left - Res[i].Width div 2;
      DrawRect.Top    := DrawRect.Top -  Res[i].Height div 2;
      DrawRect.Right  := DrawRect.Right - Res[i].Width div 2;
      DrawRect.Bottom := DrawRect.Bottom - Res[i].Height div 2;
     end;
    if Res[i].Tile then FillRect(DC,DrawRect,Res[i].Brush)
    else
    if Res[i].Stretch then Res[i].Bitmap.StretchDrawTransparent(DC, DrawRect, clWhite)
    else Res[i].Bitmap.DrawTransparent(DC,DrawRect.Left,DrawRect.Top,clWhite);
   end;
 end;
end;


 
TeCC   (2006-06-28 14:45) [7]

Код компонента - за основу брался HHC_UNIT

unit KOlTRButton;
interface
uses
 windows, messages, KOL, kolmath;

type
 PTRButton = ^TTRButton;
 TKOLTRButton = PTRButton;
 TTRButton = object(TControl)

 private
   function gettranscolor: Tcolor;
   procedure settranscolor(val: Tcolor);
   procedure setimgcount(val: integer);
   procedure DoEnter(Sender: PObj);
   procedure DoExit(Sender: PObj);

 public
   procedure setBitmap(bitm: Pbitmap);
   property  trans_color :TColor read gettranscolor write settranscolor ;
   property  imgcount:integer write setimgcount;
   procedure update_rgn;
 end;

 PTRButtData = ^TTRButtData;
 TTRButtData = object(TObj)
   Image    : PBitmap;
   SImg     : array [0..5] of PBitmap;
   imgcount : integer;
   Selected : boolean;
   state    : byte;
   ts_color : TColor;
   pos      : TPoint;
   Region   : HRGN;
   destructor Destroy; virtual;
 end;

function NewTRButtonex(AOwner: PControl; Himage:PBITMAP; left,top,imct:integer; ts_cl:TColor): PTRButton;

function NewTRButton(AOwner: PControl): PTRButton;

function BitmapToRegion(DC:HDC; Pmap: PBitmap; TransColor: Cardinal):  HRGN;

implementation

uses Math, Types;

destructor TTRButtData.Destroy;
var i:integer;
begin
DeleteObject(Image.Handle);
for i:=0 to 5 do DeleteObject(SImg[i].Handle);
inherited;
end;

function TRBbuttWndProc( Sender: PControl; var Msg: TMsg; var Rslt:Integer ): boolean;
var
 D:PTRButtData;
 k:HDC;
 PaintStruct: TPaintStruct;
begin
 D:=Pointer(Sender.CustomObj);
 Result:=false;
 case msg.message of
 WM_CREATE      : begin
                    If D.Simg[0].Handle<>0 then
                     begin
                    D.Region:=BitmapToRegion(GetDC(Msg.hwnd),D.SImg[0],D.ts_color);
                      SetWindowRgn(Msg.hwnd, D.Region, true);
                     end;
                  end;

 WM_PAINT       : begin
                    k:=Msg.wParam;
                    if k=0 then
                    k:= BeginPaint(Sender.Handle, PaintStruct);
                    SetStretchBltMode(k, halftone);
                    D.SImg[D.state].DrawTransparent(k,0,0,D.ts_color);
                    if D.State=-1 then D.Image.DrawTransparent(k,0,0,D.ts_color);
                    if Msg.wParam=0 then EndPaint(Sender.Handle, PaintStruct);
                    Result:=True;
                  end;
 WM_LBUTTONDOWN : begin
                    D.State:=2;
                    Sender.Invalidate;
                  end;
 WM_LBUTTONUP   : begin
                    D.State:=0;
                    Sender.Invalidate;
                  end;
 end;
end;

procedure ParseBitmap(D: PTRButtData);
var
   i,HIm:integer;
   SR:TRect;
begin
if assigned(D.Image) then
begin
 if D.imgcount=0 then D.imgcount:=1;
 if D.imgcount>5 then D.imgcount:=5;
 HIm:=D.Image.Height div D.imgcount;
 for i:=0 to 5 do D.SImg[i]:= NewDIBBitmap(D.image.Width,Him,pf24bit);
 SR.Left:=0;
 SR.Top:=0;
 SR.Bottom:=HIm;
 SR.Right:=D.image.Width;
 For i:=0 to D.imgcount-1 do
  begin
    D.SImg[i].Canvas.CopyRect(D.SImg[i].BoundsRect,D.Image.Canvas,SR);
    SR.Top:=SR.Top+HIm;
    SR.Bottom:=SR.Bottom+HIm;
  end;
end;
end;

function NewTRButtonex(AOwner: PControl; Himage:PBITMAP; left,top,imct:integer; ts_cl:TColor): PTRButton;
var D: PTRButtData;
begin
Result:=NewTRButton(AOwner);
D:=Pointer(Result.CustomObj);
D.Image.Assign(HImage);
Result.Left:=Left;
Result.Top:=top;
D.imgcount:=imct;
ParseBitmap(D);
Result.Width:=D.SImg[0].Width;
Result.Height:=D.SImg[0].Height;
D.ts_color:=ts_cl;
end;

function NewTRButton(AOwner: PControl): PTRButton;
var D: PTRButtData;
   i:integer;
begin
Result:=PTRButton(_NewControl( AOwner, "BUTTON",
                     WS_CHILD or WS_VISIBLE or
                     BS_USERBUTTON or BS_CHECKBOX or
                     BS_DEFPUSHBUTTON, False, nil ));
New(D, Create);
Result.CustomObj:=D;
D.Image := NewDIBBitmap(0,0,pf24bit);
for i:=0 to 5 do D.SImg[i]:= NewDIBBitmap(0,0,pf24bit);
D.ts_color:=clWhite;
Result.OnMouseEnter := Result.DoEnter;
Result.OnMouseLeave := Result.DoExit;
Result.AttachProc(TRBbuttWndProc);
end;

procedure TTRButton.DoEnter(Sender: PObj);
var D:PTRButtData;
begin
D:=Pointer(CustomObj);
D.state:=1;
InvalidateRgn(Self.Handle, D.Region, True);
end;

procedure TTRButton.DoExit (Sender: PObj);
var D:PTRButtData;
begin
D:=Pointer(CustomObj);
D.state:=0;
InvalidateRgn(Self.Handle, D.Region, True);
end;

end.


 
TeCC   (2006-06-28 14:46) [8]

Кое что я опустил а то форум не берет код...


 
TeCC   (2006-06-28 15:31) [9]

отключил перерисовку основной формы - кнопки стали быстрее работать теперь встает вопрос как мне сделать быструю отрисовку многокомпонентного фона у формы. Код отрисовки уже приведен выше...


 
TeCC   (2006-06-29 08:42) [10]

Порядок - сам разобрался, решил следующим образом: первый раз фон рисуется из набора множества картинок, затем копирую поучившееся в отдельный битмап - и дальше все рисуется с него, на изменении размера формы повтор полной перерисовки с сохранением фона.



Страницы: 1 вся ветка

Текущий архив: 2007.03.25;
Скачать: CL | DM;

Наверх




Память: 0.51 MB
Время: 0.033 c
11-1142828301
Kealon
2006-03-20 07:18
2007.03.25
KeyPreview


11-1151791408
Александра
2006-07-02 02:03
2007.03.25
dll : вторая форма и выгрузка.


2-1172954302
dreamse
2007-03-03 23:38
2007.03.25
Системные сервисы


15-1172660033
Сергей М.
2007-02-28 13:53
2007.03.25
FreeWare-софт для организации аудиоконференции в LAN


15-1172503751
Programist
2007-02-26 18:29
2007.03.25
Как работает сообщение wm_paint в Delphi7?