Форум: "Начинающим";
Текущий архив: 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.064 c