Forum > LCL
how to set a button color in IDE?
blackangel:
I have set a button color and font,and it's font is changed,but it's color is not changed.
who can tell me why?
Handoko:
Hello blackangel,
Welcome to the forum.
It is OS dependent behavior. Windows does not allow changing button's color, on Linux and other OSes button's color can be changed.
There are several solutions if you want to have custom button's color on Windows. You can write your own button, for example using TPanel. You can search the forum, there were many discussions showing how to use TPanel to behave like a button. Alternatively you can use third party components for example ATButton:
https://wiki.lazarus.freepascal.org/ATButton
blackangel:
thks,i think i know how to do it
Joanna from IRC:
Use tcdbutton
Onur2x:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---Type TExButtonState = (obshover, obspressed, obsnormal); TExampleButton = class(TButton) private Fstate: TExButtonState; FCanvas : TCanvas; Fresim,FBGDisable,FBGHover,FBGNormal,FBGPress:TBGRABitmap; procedure WMEraseBkGnd(var Message:TWMEraseBkGnd); protected procedure MouseEnter; override; procedure MouseLeave; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: integer; Y: integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: integer; Y: integer); override; procedure WMPaint(var Msg: TLMPaint); message LM_PAINT; procedure Paint; virtual; procedure PaintWindow(DC: HDC); override; property Canvas: TCanvas read FCanvas; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; implementation procedure TExampleButton.MouseEnter;begin if (csDesigning in ComponentState) then exit; if (Enabled=false) or (Fstate = obshover) then Exit; inherited MouseEnter; Fstate := obshover; Invalidate;end; procedure TExampleButton.MouseLeave;begin if (csDesigning in ComponentState) then exit; if (Enabled=false) or (Fstate = obsnormal) then Exit; inherited MouseLeave; Fstate := obsnormal; Invalidate;end;procedure TExampleButton.MouseDown(Button:TMouseButton;Shift:TShiftState;X: integer;Y:integer);begin if (csDesigning in ComponentState) then exit; if (Enabled=false) or (Fstate = obspressed) then Exit; inherited MouseDown(Button, Shift, X, Y); if Button = mbLeft then begin Fstate := obspressed; Invalidate; end;end; procedure TExampleButton.MouseUp(Button:TMouseButton;Shift:TShiftState;X:integer; Y:integer);begin inherited MouseUp(Button, Shift, X, Y); Fstate := obsnormal; Invalidate;end; procedure TExampleButton.WMEraseBkGnd(var Message: TWMEraseBkGnd);begin Message.Result := - 1;end; constructor TExampleButton.Create(AOwner:TComponent);begin inherited Create(AOwner); self.Width := 100; self.Height := 30; Fstate := obsNormal; FCanvas := TControlCanvas.Create; TControlCanvas(FCanvas).Control := Self; FResim := TBGRABitmap.Create(self.ClientWidth,self.ClientHeight); FBGDisable := TBGRABitmap.Create(self.ClientWidth,self.ClientHeight); FBGHover := TBGRABitmap.Create(self.ClientWidth,self.ClientHeight); FBGNormal := TBGRABitmap.Create(self.ClientWidth,self.ClientHeight); FBGPress := TBGRABitmap.Create(self.ClientWidth,self.ClientHeight); FBGDisable.LoadFromFile('disable.png'); FBGHover.LoadFromFile('Hover.png'); FBGNormal.LoadFromFile('Normal.png'); FBGPress.LoadFromFile('press.png'); end; destructor TExampleButton.Destroy;begin FreeAndNil(Fcanvas); FreeAndNil(FBGDisable); FreeAndNil(FBGHover); FreeAndNil(FBGNormal); FreeAndNil(FBGPress); FreeAndNil(Fresim); inherited Destroy; end; procedure TExampleButton.WMEraseBkGnd(var Message: TWMEraseBkGnd);begin Message.Result := - 1;end; procedure TExampleButton .WMPaint(var Msg:TLMPaint);begin ControlState := ControlState+[csCustomPaint]; inherited; ControlState := ControlState-[csCustomPaint];end; procedure TExampleButton.Paint;var rc:TRect; x, y: integer; hdc1, SpanRgn: hdc; WindowRgn: HRGN; p: PBGRAPixel;begin if not Assigned(fresim) then exit; if fresim.Width<0 then exit; if not Visible then exit; fresim.SetSize(0,0); fresim.SetSize(clientWidth,clientHeight); fresim.Fill(BGRAPixelTransparent); if Enabled = True then begin case Fstate of obsNormal : begin fresim.PutImage(0,0,FBGNormal,dmDrawWithTransparency); self.font.Color:=FNormalC.Fontcolor end; obshover : begin fresim.PutImage(0,0,FBGHover,dmDrawWithTransparency); self.font.Color:=FHoverC.Fontcolor end; obspressed : begin fresim.PutImage(0,0,FBGPress,dmDrawWithTransparency); self.font.Color:=FPressC.Fontcolor end; else begin fresim.PutImage(0,0,FBGNormal,dmDrawWithTransparency); self.font.Color:=FNormalC.Fontcolor end; end; end else begin fresim.PutImage(0,0,FBGDisable,dmDrawWithTransparency); self.font.Color:=FDisableC.Fontcolor; end; if fresim.Width>0 then begin /// if crop to image { WindowRgn := CreateRectRgn(0, 0, fresim.Width, fresim.Height); for Y := 0 to fresim.Height - 1 do begin p := fresim.Scanline[Y]; for X := fresim.Width - 1 downto 0 do begin if p^.Alpha < 20 then//<255 then begin p^ := BGRAPixelTransparent; SpanRgn := CreateRectRgn(x, y, x + 1, y + 1); CombineRgn(WindowRgn, WindowRgn, SpanRgn, RGN_DIFF); DeleteObject(SpanRgn); end; Inc(p); end; end; fresim.InvalidateBitmap; SetWindowRgn(self.Handle, WindowRgn, True); hdc1 := GetDC(self.Handle); ReleaseDC(self.Handle, hdc1); DeleteObject(WindowRgn); DeleteObject(hdc1); } // Crop to image rc:=ClientRect; fresim.Canvas.Brush.Style:=bsClear; DrawText(fresim.Canvas.Handle,Pchar(Caption),Length(Caption),rc,DT_CENTER or DT_VCENTER or DT_SINGLELINE); fresim.Draw(fCanvas,0,0); end; end; procedure TExampleButton.PaintWindow(DC:HDC);begin FCanvas.Lock; try FCanvas.Handle := DC; try Paint; finally FCanvas.Handle := 0; end; finally FCanvas.Unlock; end;end;
Navigation
[0] Message Index
[#] Next page