Mas o codigo não veio pois é proibido via Lista. Mas valeu assim mesmo.
Obrigado
Clovito
Que a Paz do Grande Arquiteto do Universo nos Ampare
[EMAIL PROTECTED]
Msn-> [EMAIL PROTECTED]
Dourado SP
----- Original Message -----
From: "Luiz Escobar" <[EMAIL PROTECTED]>
To: <delphi-br@yahoogrupos.com.br>
Sent: Wednesday, May 31, 2006 9:01 PM
Subject: RES: [delphi-br] Botões redondos... codigo fontebotão de
bitmap´s...
>
> bom sei que vc quer um botão redondo, e isso parece dificil.. bom aqui tem
> um exemplo de um botão
> feito atravez de um bitmap, qualquer bitmap vira um botão...
> ele cria o efeito de Lighter, quando passa o mouse encima, Darker, quando
> clica, acertei esta parte, comia um pedaçinho da imagem quando era justa,
> Disabled, (essa eu implementei, ehehhehe), quando vc disabilita o botão...
> talvez ajude...
>
> como não sabia o endereço postei o código....
> se alguem gostar e implementar algo novo, posta ai....
>
> Luiz Escobar
>
>
>
> //==============================================================
> //jvBitmapButton.pas
> // versão 2.1c modify by Luiz Escobar
> //---------------------------------------------------------------------------------------------------------------
> unit jvBitmapButton;
>
> interface
>
> uses
> Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
>
> type
> TjvBitmapButton = class(TGraphicControl)
> private
> FBitmap: TBitmap;
> FLighter: TBitmap;
> FDarker: Tbitmap;
> FDisabled: Tbitmap; // by Luiz Escobar
> FPushDown:boolean;
> FMouseOver:boolean;
> FLatching: boolean;
> FDown: boolean;
> FHotTrack: boolean;
> Fenable: boolean; // by Luiz Escobar
> procedure SetBitmap(const Value: TBitmap);
> procedure MakeDarker;
> procedure MakeLighter;
> procedure MakeDisabled; // by Luiz Escobar
> procedure SetLatching(const Value: boolean);
> procedure SetDown(const Value: boolean);
> procedure SetHotTrack(const Value: boolean);
> function GetEnabled : Boolean; // by Luiz Escobar
> procedure SetEnabled( const Value: boolean); // by Luiz Escobar
> { Private declarations }
> protected
> { Protected declarations }
> procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
> Integer);override;
> procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
> Integer);override;
> procedure MouseMove(Shift: TShiftState; X, Y: Integer);override;
> procedure Click;override;
> procedure CMMouseLeave(var Message:TMessage); message CM_MouseLeave;
> procedure Loaded;override;
> procedure Resize;override;
> public
> { Public declarations }
> constructor Create(AOwner:TComponent);override;
> destructor Destroy;override;
> procedure Paint; override;
> published
> { Published declarations }
> property Bitmap:TBitmap read FBitmap write SetBitmap;
> property Down:boolean read FDown write SetDown;
> property Latching:boolean read FLatching write SetLatching;
> property HotTrack:boolean read FHotTrack write SetHotTrack;
> property Enable:boolean read GetEnabled write SetEnabled; // by Luiz
> Escobar
> property onclick;
> property onmousedown;
> property onmouseup;
> end;
>
> procedure Register;
>
> implementation
>
> procedure Register;
> begin
> RegisterComponents('ESC_UTIL', [TjvBitmapButton]);
> end;
>
> { TjvBitmapButton }
>
> function TjvBitmapButton.GetEnabled: boolean; // by Luiz Escobar
> begin
> result := enabled;
> end;
>
> procedure TjvBitmapButton.SetEnabled( const Value : boolean ); // by Luiz
> Escobar
> begin
> enabled := value;
> fenable := enabled;
> Paint;
> end ;
>
> procedure TjvBitmapButton.Click;
> begin
> inherited;
> if FPushDown then
> if assigned(onclick) then
> onclick(self);
> end;
>
> constructor TjvBitmapButton.Create(AOwner: TComponent);
> begin
> inherited;
> width:=24;
> height:=24;
> FPushDown:=false;
> FMouseOver:=false;
> FLatching:=false;
> FHotTrack:=true;
> FDown:=false;
> FBitmap:=TBitmap.create;
> Fbitmap.width:=24;
> Fbitmap.Height:=24;
> Fbitmap.canvas.brush.color:=clgray;
> FBitmap.canvas.FillRect (rect(1,1,23,23));
> FLighter:=Tbitmap.create;
> FDarker:=Tbitmap.create;
> FDisabled:=Tbitmap.create; // by Luiz Escobar
> Fenable := enabled; // by Luiz Escobar
> end;
>
> destructor TjvBitmapButton.Destroy;
> begin
> FBitmap.free;
> FLighter.free;
> FDarker.free;
> FDisabled.free; // by Luiz Escobar
> inherited;
> end;
>
> procedure TjvBitmapButton.MouseDown(Button: TMouseButton;
> Shift: TShiftState; X, Y: Integer);
> begin
> inherited;
> if FBitmap.canvas.pixels[x,y]<>Fbitmap.canvas.pixels[0,FBitmap.height-1]
> then
> FPushDown:=true
> else
> FPushDown:=false;
> Paint;
> if assigned(onmousedown) then
> onmousedown(self,button,shift,x,y);
> end;
>
> procedure TjvBitmapButton.MouseUp(Button: TMouseButton; Shift:
> TShiftState;
> X, Y: Integer);
> begin
> inherited;
> FPushDown:=false;
> if Latching then
> FDown:= not FDown
> else
> FDown:=false;
> Paint;
> if assigned(onmouseup) then
> onmouseup(self,button,shift,x,y);
> end;
>
> procedure TjvBitmapButton.Paint;
> var Acolor:TColor;
> begin
> inherited;
> if assigned(FBitmap) then
> begin
> AColor:=FBitmap.canvas.pixels[0,FBitmap.height-1];
> Fbitmap.transparent:=true;
> Fbitmap.transparentcolor:=Acolor;
> FLighter.transparent:=true;
> Flighter.TransparentColor :=AColor;
> FDarker.transparent:=true;
> FDarker.TransparentColor :=AColor;
> AColor:=FDisabled.canvas.pixels[0,FDisabled.height-1];
> FDisabled.transparent:=true;
> FDisabled.TransparentColor :=AColor;
> if enabled then begin // by Luiz Escobar
> if FPushdown then begin
> canvas.draw(1,1,FDarker)
> end else begin
> if Down then
> canvas.Draw(1,1,FDarker)
> else if (FMouseOver and FHotTrack) then
> canvas.draw(0,0,FLighter)
> else canvas.Draw (0,0,FBitmap);
> end;
> end else canvas.Draw(0,0,FDisabled); // by Luiz Escobar
> end;
> end;
>
> procedure TjvBitmapButton.SetBitmap(const Value: TBitmap);
> begin
> FBitmap.assign(Value);
> FBitmap.transparent:=true;
> FBitmap.TransparentColor :=FBitmap.Canvas.pixels[0,FBitmap.Height-1];
> width:=FBitmap.Width ;
> height:=FBitmap.Height ;
> MakeLighter;
> MakeDarker;
> MakeDisabled;
> end;
>
> procedure TjvBitmapButton.MakeDisabled; // procedure by Luiz Escobar
> var
> c, x, y: Integer;
> PxlColor: TColor;
> R: TRect;
> Offset, Flags: Integer;
> DrawPressed: Boolean;
> Image: TBitmap;
> Bitmap: TBitmap;
> begin
> FDisabled.Width := FBitmap.Width;
> FDisabled.Height := FBitmap.Height;
> FDisabled.PixelFormat := FBitmap.PixelFormat;
> FDisabled.Assign( FBitmap );
> for x := 0 to FBitmap.Width - 1 do
> for y := 0 to FBitmap.Height - 1 do
> begin
> PxlColor := ColorToRGB(FBitmap.Canvas.Pixels[x, y]);
> c := Round((((PxlColor shr 16) + ((PxlColor shr 8) and $00FF) +
> (PxlColor and $0000FF)) div 3)) div 2 + 96;
> FDisabled.Canvas.Pixels[x, y] := RGB(c, c, c);
> end;
>
> end;
>
> procedure TjvBitmapButton.MakeLighter;
> var p1,p2:Pbytearray;
> x,y:integer;
> rt,gt,bt:byte;
> r,g,b:byte;
> AColor:TColor;
> begin
> FLighter.Width :=FBitmap.Width ;
> FLighter.Height :=FBitmap.height;
> Acolor:=colortorgb(FBitmap.canvas.pixels[0,FBitmap.height-1]);
> rt:=GetRValue(Acolor);
> gt:=GetGValue(AColor);
> bt:=getBValue(AColor);
> FBitmap.PixelFormat :=pf24bit;
> FLighter.PixelFormat :=pf24bit;
> for y:=0 to Fbitmap.height-1 do
> begin
> p1:=Fbitmap.ScanLine [y];
> p2:=FLighter.ScanLine [y];
> for x:=0 to FBitmap.width-1 do
> begin
> if (p1[x*3]=bt)and (p1[x*3+1]=gt)and (p1[x*3+2]=rt) then
> begin
> p2[x*3]:=p1[x*3];
> p2[x*3+1]:=p1[x*3+1];
> p2[x*3+2]:=p1[x*3+2];
> end
> else
> begin
> p2[x*3]:=$FF-round(0.8*abs($FF-p1[x*3]));
> p2[x*3+1]:=$FF-round(0.8*abs($FF-p1[x*3+1]));
> p2[x*3+2]:=$FF-round(0.8*abs($FF-p1[x*3+2]));
> end;
> end;
> end;
> end;
>
> procedure TjvBitmapButton.MakeDarker;
> var p1,p2:Pbytearray;
> x,y:integer;
> rt,gt,bt:byte;
> r,g,b:byte;
> AColor:TColor;
> begin
> FDarker.Width :=FBitmap.Width ;
> FDarker.Height :=FBitmap.height;
> Acolor:=colortorgb(FBitmap.canvas.pixels[0,FBitmap.height-1]);
> rt:=GetRValue(Acolor);
> gt:=GetGValue(AColor);
> bt:=getBValue(AColor);
> FBitmap.PixelFormat :=pf24bit;
> FDarker.PixelFormat :=pf24bit;
> for y:=0 to Fbitmap.height-1 do
> begin
> p1:=Fbitmap.ScanLine [y];
> p2:=FDarker.ScanLine [y];
> for x:=0 to FBitmap.width-1 do
> begin
> if (p1[x*3]=bt)and (p1[x*3+1]=gt)and (p1[x*3+2]=rt) then
> begin
> p2[x*3]:=p1[x*3];
> p2[x*3+1]:=p1[x*3+1];
> p2[x*3+2]:=p1[x*3+2];
> end
> else
> begin
> p2[x*3]:=round(0.7*p1[x*3]);
> p2[x*3+1]:=round(0.7*p1[x*3+1]);
> p2[x*3+2]:=round(0.7*p1[x*3+2]);
> end
> end;
> end;
> end;
>
>
>
>
> procedure TjvBitmapButton.CMMouseLeave(var Message: TMessage);
> begin
> FMouseOver:=false;
> Paint;
> end;
>
> procedure TjvBitmapButton.Loaded;
> begin
> inherited;
> if not FBitmap.Empty then
> begin
> MakeDarker;
> MakeLighter;
> MakeDisabled;
> end;
> end;
>
> procedure TjvBitmapButton.SetLatching(const Value: boolean);
> begin
> FLatching := Value;
> if not FLatching then
> begin
> FDown:=false;
> paint;
> end;
> end;
>
> procedure TjvBitmapButton.SetDown(const Value: boolean);
> begin
> if FLatching then
> begin
> FDown := Value;
> paint;
> end
> else
> begin
> FDown:=false;
> paint;
> end;
> end;
>
> procedure TjvBitmapButton.Resize;
> begin
> inherited;
> if assigned(Fbitmap) then
> begin
> width:=FBitmap.width+1;
> height:=FBitmap.Height+1;
> end
> else
> begin
> width:=24;
> height:=24;
> end;
> end;
>
>
> procedure TjvBitmapButton.SetHotTrack(const Value: boolean);
> begin
> FHotTrack := Value;
> end;
>
> procedure TjvBitmapButton.MouseMove(Shift: TShiftState; X, Y: Integer);
> var Value:boolean;
> begin
> inherited;
> Value:=
> FBitmap.canvas.pixels[x,y]<>Fbitmap.canvas.pixels[0,FBitmap.height-1];
> if value<>FMouseOver then
> begin
> FMouseOver:=value;
> Paint;
> end;
> if assigned(onmousemove) then
> onmousemove(self,shift,x,y);
> end;
>
> end.
>
>
>
> --
> <<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
>
>
>
> Links do Yahoo! Grupos
>
>
>
>
>
>
>
>
>
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
<*> Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
<*> Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED]
| Yahoo! Grupos, um serviço oferecido por: | |
|
Links do Yahoo! Grupos
- Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
- Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
- O uso que você faz do Yahoo! Grupos está sujeito aos Termos do Serviço do Yahoo!.
