override del paint dei TBGRAButton

[Blue1987]

ciao a tutti, spiego subito qui il mio problema...

... vorrei modificare la procedura paint dei TBGRAButton in modo che quando un BGRAButton è disabilitato, allora il pulsante sia disegnato con un global alpha = 100 (semitrasparente invece che in scala di grigi; o anche semitrasparente E grigio)...

la cosa importante è che il codice deve stare nella unit... l'obiettivo è non creare alcun nuovo componente, cosicché quando un utente vuole modificare il codice, sia sufficiente installare CodeTyphon ed editare il listato, senza dover installare nuovi componenti...


con il TLabel l'ho già fatto così...

Codice: [Seleziona]

Tlabel = class(StdCtrls.TLabel)
public
  FromTop: integer; {distance from top}
  FCHeight: integer; {font client height}
  procedure Paint; override;
end; 



..



implementation



..



Procedure TLabel.Paint;
var
  TR : TTextStyle;
  R : TRect;
  TextLeft, TextTop: integer;
  LabelText: string;
  OldFontColor: TColor;
  stringlist: TstringList;
  ii: integer;
begin
  stringlist := TStringList.Create;
  R := Rect(0,0,Width,Height);

  with Canvas do
  begin
    if Enabled then
      Brush.Color := Self.Color
    else
      Brush.Color := clNone;
    Font := Self.Font;
    font.size:=abs(font.size);
    if (Color<>clNone) and not Transparent then
    begin
      Brush.Style:=bsSolid;
      FillRect(R);
    end else
      Brush.Style:=bsClear;
    FillChar(TR,SizeOf(TR),0);
    with TR do
    begin
      Alignment := BidiFlipAlignment(Self.Alignment, UseRightToLeftAlignment);
      WordBreak := wordWrap;
      SingleLine:= not WordWrap and not HasMultiLine;
      Clipping := True;
      ShowPrefix := ShowAccelChar;
      SystemFont := False;
      RightToLeft := UseRightToLeftReading;
      ExpandTabs := True;
    end;
    DoMeasureTextPosition(TextTop, TextLeft);
    LabelText:=GetLabelText;
    StringList.text := LabelText;

    OldFontColor := Font.Color;
    if not Enabled then
    begin
      Font.Color := clBtnHighlight;
      if (fcheight = 0) then TextRect(R, TextLeft + 1, fromtop + TextTop + 1 , LabelText, TR) else for ii:=1 to StringList.count do TextRect(R, TextLeft + 1, (ii-1)*(fcheight) + fromtop + TextTop + 1, StringList[ii-1], TR);
      Font.Color := clBtnShadow;
    end;
    if (fcheight = 0) then TextRect(R, TextLeft, fromtop + TextTop, LabelText, TR) else for ii:=1 to StringList.count do TextRect(R, TextLeft,(ii-1)*(fcheight) + fromtop + TextTop, StringList[ii-1], TR);
    Font.Color := OldFontColor;
  end;

end;

come faccio a fare lo stesso col TBGRAButton?


grazie mille,
Paolo

[xinyiman]

Faccio delle prove e ti faccio sapere se ci riesco.

[xinyiman]

Ho fatto un po di prove, come mi ha fatto notare anche legolas qui:

http://www.lazarus.freepascal.org/index.php/topic,14992.0.html

La procedura Paint dovrebbe essere nella zona public per poter far quello che vuoi tu, diversamente mi sa che per come è stato scritto l'oggetto padre non è possibile fare quello che chiedi se non riscrivendo l'oggetto. Se trovi un modo faccelo sapere.

[Blue1987]

Ho fatto un po di prove, come mi ha fatto notare anche legolas qui:

http://www.lazarus.freepascal.org/index.php/topic,14992.0.html

La procedura Paint dovrebbe essere nella zona public per poter far quello che vuoi tu, diversamente mi sa che per come è stato scritto l'oggetto padre non è possibile fare quello che chiedi se non riscrivendo l'oggetto. Se trovi un modo faccelo sapere.

ottimo, innanzitutto perché ho imparato una cosa nuova!
appena ho un secondo faccio due prove e vedo che riesco ad inventarmi...

[xinyiman]

Perfetto