Начало темы
вообщем доделал компонент
, работает как часики, токо проблема с двойным кликом :KillMe: , сделал doublecliсk мышкой по компоненту и он какогото **** захватывает всю форму(кликаеш по форме а сигнал идет на кнопку), приходится сворачивать форму, а потом разворачивать что б всё стало на место;
как от этого глюка избавится? Помогите
чтоб был ефект перехода в испкторе обектов задайте пиктуре, интервал и количество_шагов а также в формкреате всем кнопкам сделайте reload;
если поможете исправить доделаю компонент полностю(с возможностю смены цвета)
вообщем доделал компонент
, работает как часики, токо проблема с двойным кликом :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.