Dcbutton

09.11.2009
665
1
#1
Начало темы

вообщем доделал компонент ;) , работает как часики, токо проблема с двойным кликом :KillMe: , сделал doublecliсk мышкой по компоненту и он какогото **** захватывает всю форму(кликаеш по форме а сигнал идет на кнопку), приходится сворачивать форму, а потом разворачивать что б всё стало на место;

как от этого глюка избавится? Помогите ;)

чтоб был ефект перехода в испкторе обектов задайте пиктуре, интервал и количество_шагов а также в формкреате всем кнопкам сделайте reload;

если поможете исправить доделаю компонент полностю(с возможностю смены цвета)

Код:
unit DcButton;

interface

uses
Windows, SysUtils,Messages , forms, Classes, Controls, ExtCtrls, Graphics, Graphutil;


type
TDcButton = class(TImage)
private
Ftimer:TTimer;
fImg,fimgdown,fimgenter:Tbitmap;
fTimInt,fKolHag,FK:integer;

protected
procedure wmlbuttondown(var message:twmmouse); message wm_lbuttondown;
procedure wmlbuttonup(var message:twmmouse); message wm_lbuttonup;
procedure cmmouseenter(var message:twmmouse); message cm_mouseenter;
procedure cmmouseleave(var message:twmmouse); message cm_mouseleave;
function MixBytes(FG, BG, TRANS: byte): byte;
function MixColors(FG, BG: TColor; T: byte): TColor;
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Reload;
procedure TimerEvent(Sender: TObject);
published
{ Published declarations }
property Interval: integer read FTimInt write FTimInt;
property Kolichestvo_shagov: integer read fkolhag write fkolhag;

end;



procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Media by Dock1100', [TDcButton]);
end;

function TDcButton.MixBytes(FG, BG, TRANS: byte): byte;
asm
push bx // push some regs 
push cx
push dx
mov DH,TRANS // remembering Transparency value (or Opacity - as you like) 
mov BL,FG	// filling registers with our values 
mov AL,DH	// BL = ForeGround (FG) 
mov CL,BG	// CL = BackGround (BG) 
xor AH,AH	// Clear High-order parts of regs 
xor BH,BH
xor CH,CH
mul BL	  // AL=AL*BL 
mov BX,AX	// BX=AX 
xor AH,AH
mov AL,DH
xor AL,$FF  // AX=(255-TRANS) 
mul CL	  // AL=AL*CL 
add AX,BX	// AX=AX+BX 
shr AX,8	 // Fine! Here we have mixed value in AL 
pop dx	  // Hm... No rubbish after us, ok? 
pop cx
pop bx	  // Bye, dear Assembler - we go home to Delphi! 
end;

// Here we mix R,G and B channels of our colors separately. 
// The value of T is between 0 and 255 as described above. 

// As you know, TColor value is 4 bytes length integer value where 
// low byte is red channel, 2nd byte is green and 3rd byte is blue 

function TDcButton.MixColors(FG, BG: TColor; T: byte): TColor;
var r,g,b:byte;
begin
R := MixBytes(FG and 255,BG and 255,T); // extracting and mixing Red 
G := MixBytes((FG shr 8) and 255,(BG shr 8) and 255,T); // the same with green 
B := MixBytes((FG shr 16) and 255,(BG shr 16) and 255,T); // and blue, of course 
Result := r+g*256+b*65536; // finishing with combining all channels together 
end;


constructor TDcButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Ftimer:=TTimer.create(self);
fimg:=Tbitmap.Create;
fimgenter:=Tbitmap.Create;
fimgdown:=Tbitmap.Create;
parent:=Tform(Aowner);
parent.DoubleBuffered:=true;
end;

destructor TDcButton.Destroy;
begin
fimg.Destroy;
fimgenter.Destroy;
fimgdown.Destroy;
ftimer.Free;
inherited Destroy;
end;

procedure TDcButton.cmmouseenter;
var
i: Integer;
j: Integer;
begin
inherited;
ftimer.Enabled:=false;
fk:=0;
for i := 0 to width - 1 do
for j := 0 to height - 1 do
Canvas.Pixels[i,j]:=fimgenter.canvas.Pixels[i,j];
end;

procedure TDcButton.cmmouseleave;
begin
inherited;
ftimer.Enabled:=false;
fk:=0;
ftimer.Enabled:=true;
end;

procedure TDcButton.TimerEvent(Sender: TObject);
var i,j:integer;
begin
inherited;
fk:=fk+1;
if fk<=fkolhag then begin
for i:=0 to width-1 do
for j := 0 to Height - 1 do
Canvas.Pixels[i,j]:=mixcolors(fimg.Canvas.Pixels[i,j],fimgenter.Canvas.Pixels[i,j],round((fk*255)/fkolhag));
end;
if fk>=Fkolhag then ftimer.Enabled:=false;
end;

procedure TDcButton.wmlbuttondown;
var i,j:integer;
begin
inherited;
for I := 0 to width-1 do
for j:= 0 to Height - 1 do
canvas.pixels[i,j]:=fimgdown.canvas.Pixels[i,j];
end;

procedure TDcButton.wmlbuttonup;
var i,j:integer;
begin
inherited;
for i := 0 to width - 1 do
for j := 0 to height - 1 do
Canvas.Pixels[i,j]:=fimgenter.canvas.Pixels[i,j];
end;

procedure TDcButton.Reload;
var fi,fj:integer;
begin
inherited;
ftimer.interval:=FtimInt;
ftimer.Enabled:=false;
ftimer.ontimer:=TimerEvent;
height:=Picture.Bitmap.height;
width:=trunc(Picture.Bitmap.width/3);
fimg.Width:=Width;
fimgdown.Width:=Width;
fimgenter.Width:=Width;
fimg.Height:=Height;
fimgdown.Height:=Height;
fimgenter.Height:=Height;
for fi:=0 to trunc(Picture.Bitmap.width/3-1) do
for fj :=0 to Picture.Bitmap.height-1 do
begin
canvas.pixels[fi,fj]:=Picture.Bitmap.canvas.Pixels[fi,fj];
fimg.canvas.Pixels[fi,fj]:=Picture.Bitmap.canvas.pixels[fi,fj];
fimgdown.canvas.Pixels[fi,fj]:=Picture.Bitmap.canvas.pixels[trunc(2*Picture.Bitmap.width/3)+fi,fj];
fimgenter.canvas.Pixels[fi,fj]:=Picture.Bitmap.canvas.pixels[trunc(Picture.Bitmap.width/3)+fi,fj];
end;
end;



end.
 

vital

Больной Компом Детектед
29.01.2006
2 432
33
#2
Пример бы.. Скрин как минимум.
 
09.11.2009
665
1
#3
вообщем исправил даблклик, но появилась другая проблемка, если выстроить в ряд штук 20 таких кнопок, то если провести по всем сразу ефект идет более медлено чем на одной отдельно. Как исправить этот баг?
 

Вложения