Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Вниз

Как избавится от мерцания?   Найти похожие ветки 

 
Jimmy   (2012-04-06 14:46) [0]

Подскажите как избавиться от мерцания при нажатии на следующую кнопку? Заранее спасибо!
unit DiDSuperButton;

interface

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

type
 TDrawButtonEvent = procedure(Control: TWinControl; Rect: TRect; State: TOwnerDrawState) of object;

 TDiDSuperButton = class(TButton)
 private
   FCanvas: TCanvas;
   IsFocused: Boolean;
   FColorMouse:TColor;
   FLight   :Boolean;
   FOnDrawButton: TDrawButtonEvent;

 protected
   procedure CreateParams(var Params: TCreateParams); override;
   procedure SetButtonStyle(ADefault: Boolean); override;
   procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
   procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
   procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
   procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
   procedure WMLButtonDown  (var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
   procedure WMLButtonUp    (var Message: TWMLButtonUp); message WM_LBUTTONUP;
//    procedure WMLPaint       (var Message: TWMPaint); message WM_PAINT;
//    procedure WMLEraseBKGND  (var Message: TWMERASEBKGND); message WM_ERASEBKGND;
   procedure DrawButton(Rect: TRect; State: UINT);
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   property Canvas: TCanvas read FCanvas;

 published
   property OnDrawButton: TDrawButtonEvent read FOnDrawButton write FOnDrawButton;
   property Color;
   property ColorMouse:TColor read FColorMouse write FColorMouse;
   property Light  :Boolean read FLight    write FLight;

 end;

procedure Register;

implementation

{------------------------------------------------------------------------------}
procedure Register;
begin
 RegisterComponents("DiD", [TDiDSuperButton]);
end;
{------------------------------------------------------------------------------}
constructor TDiDSuperButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FCanvas := TCanvas.Create;
 ControlStyle := ControlStyle + [csOpaque];
end;
{------------------------------------------------------------------------------}
destructor TDiDSuperButton.Destroy;
begin
 inherited Destroy;
 FCanvas.Free;
end;
{------------------------------------------------------------------------------}
procedure TDiDSuperButton.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);
 with Params do Style := Style or BS_OWNERDRAW;
end;
{------------------------------------------------------------------------------}
procedure TDiDSuperButton.SetButtonStyle(ADefault: Boolean);
begin
 if ADefault <> IsFocused then
 begin
   IsFocused := ADefault;
   Refresh;
 end;
end;
{------------------------------------------------------------------------------}
procedure TDiDSuperButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
 with Message.MeasureItemStruct^ do
 begin
   itemWidth  := Width;
   itemHeight := Height;
 end;
end;
{------------------------------------------------------------------------------}
procedure TDiDSuperButton.CNDrawItem(var Message: TWMDrawItem);
var
 SaveIndex: Integer;
begin
 with Message.DrawItemStruct^ do
 begin
   SaveIndex := SaveDC(hDC);
   FCanvas.Lock;
   try
     FCanvas.Handle := hDC;
     FCanvas.Font := Font;
     FCanvas.Brush := Brush;
     DrawButton(rcItem, itemState);
   finally
     FCanvas.Handle := 0;
     FCanvas.Unlock;
     RestoreDC(hDC, SaveIndex);
   end;
 end;
 Message.Result := 1;
end;
{------------------------------------------------------------------------------}
procedure TDiDSuperButton.CMEnabledChanged(var Message: TMessage);
begin
 inherited;
 Invalidate;
end;
{------------------------------------------------------------------------------}
procedure TDiDSuperButton.CMFontChanged(var Message: TMessage);
begin
 inherited;
 Invalidate;
end;
{------------------------------------------------------------------------------}
procedure TDiDSuperButton.WMLButtonDown(var Message: TWMLButtonDown);
begin
 inherited;
 Invalidate;
end;
{------------------------------------------------------------------------------}
procedure TDiDSuperButton.WMLButtonUp(var Message: TWMLButtonUp);
begin
 inherited;
 Invalidate;
end;
{------------------------------------------------------------------------------}
{procedure TDiDSuperButton.WMLPaint(var Message: TWMPaint);
begin
//
end;
{------------------------------------------------------------------------------}
{procedure TDiDSuperButton.WMLERASEBKGND(var Message: TWMERASEBKGND);
begin
//
end;
{------------------------------------------------------------------------------}
procedure TDiDSuperButton.DrawButton(Rect: TRect; State: UINT);
var
 IsDown: Boolean;
 TB:TBitmap;
 TR1:TRect;
begin
 IsDown := State and ODS_SELECTED <> 0;
 TB:=TBitmap.Create;
 TB.Width :=Rect.Right -Rect.Left;
 TB.Height:=Rect.Bottom-Rect.Top;
 TB.Transparent:=True;
 TR1.Left:=0;  TR1.Right:=Rect.Right;  TR1.Top:=0;  TR1.Bottom:=Rect.Bottom;
 TB.Canvas.CopyRect(TR1,FCanvas,TR1);
 //Тут будет хитрый рисунок. Пока просто прямоугольник...
 TB.Canvas.RoundRect(0,0,Width,Height-1,7,7);
 if IsDown=False then FCanvas.Draw(0,0,TB) else FCanvas.Draw(1,1,TB);
 //BitBlt(FCanvas.Handle, Rect.Left, Rect.Top, Rect.Right, Rect.Bottom,
 //       TB.Canvas.Handle, 0, 0, SrcCopy);
 TB.Free;
end;
{------------------------------------------------------------------------------}
end.


 
Jimmy   (2012-04-06 15:23) [1]

Вроде помогло одновременно три вещи:

DoubleBuffered := true;
ControlState := ControlState + [csOpaque];
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
begin
Message.Result := 1;
end;

Из ветки
http://delphimaster.net/view/5-1173025943/
Всем спасибо!



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

Форум: "Начинающим";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.071 c
15-1338898180
Owner111
2012-06-05 16:09
2013.03.22
LPVOID &amp; LPCVOID


2-1329889858
теркин
2012-02-22 09:50
2013.03.22
Как отчистить StringGrid от записей


15-1345840202
Юрий
2012-08-25 00:30
2013.03.22
С днем рождения ! 25 августа 2012 суббота


4-1258536064
mambo
2009-11-18 12:21
2013.03.22
Градиентный прогрес в отдельном потоке


15-1354048202
Юрий
2012-11-28 00:30
2013.03.22
С днем рождения ! 28 ноября 2012 среда





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский