Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi Zeichnen von CustomPanel funzt nicht! (https://www.delphipraxis.net/93208-zeichnen-von-custompanel-funzt-nicht.html)

.chicken 2. Jun 2007 11:51


Zeichnen von CustomPanel funzt nicht!
 
Also kann mir vielleicht mal wer sagen warum die Bevels in meiner Klasse TMenuButton abgeleitet von CustomPanel nicht gezeichnet werden?

Delphi-Quellcode:
unit MenuButton;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Messages, Graphics, Types;

type
  TBevel = (bNone, bRaised, bLowered, bInside);
  TMenuButton = class(TCustomPanel)
  private
    FHover: Boolean;
    FColor,
    FHighlight,
    FShadow: TColor;
    FGlyph: TPicture;
    FBevel,
    FHoverBevel: TBevel;
    FBevelWidth: Integer;
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure MouseEnter;
    procedure MouseLeave;
    procedure SetColor(Value: TColor);
    procedure SetHighlight(Value: TColor);
    procedure SetShadow(Value: TColor);
    procedure SetGlyph(Value: TPicture);
    procedure SetBevel(Value: TBevel);
    procedure SetHoverBevel(Value: TBevel);
    procedure SetBevelWidth(Value: Integer);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
    property Hover: Boolean read FHover write FHover;
  published
    property Color: TColor read FColor write SetColor;
    property Highlight: TColor read FHighlight write SetHighlight;
    property Shadow: TColor read FShadow write SetShadow;
    property Glyph: TPicture read FGlyph write SetGlyph;
    property Bevel: TBevel read FBevel write SetBevel;
    property HoverBevel: TBevel read FHoverBevel write SetHoverBevel;
    property BevelWidth: Integer read FBevelWidth write FBevelWidth;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Eigene', [TMenuButton]);
end;

constructor TMenuButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Hover := False;
  Color := clBtnFace;;
  Highlight := clBtnHighlight;
  Shadow := clBtnShadow;
  FGlyph := TPicture.Create;
  Bevel := bRaised;
  HoverBevel := bLowered;
  BevelWidth := 1;
end;

procedure TMenuButton.Paint;
var
  ARect: TRect;
begin
  ARect := Rect(0, 0, Width, Height);
  Canvas.Pen.Style := psClear;
  Canvas.Brush.Color := Color;
  Canvas.Rectangle(ARect);
  if Hover = False then
  begin
    case Bevel of
      bRaised: Frame3D(Canvas, ARect, Highlight, Shadow, BevelWidth);
      bLowered: Frame3D(Canvas, ARect, Shadow, Highlight, BevelWidth);
      bInside: begin
                Frame3D(Canvas, ARect, Highlight, Shadow, BevelWidth);
                Frame3D(Canvas, ARect, Shadow, Highlight, BevelWidth);
               end;
    end;
  end
  else
  begin
    case HoverBevel of
      bRaised: Frame3D(Canvas, ARect, Highlight, Shadow, BevelWidth);
      bLowered: Frame3D(Canvas, ARect, Shadow, Highlight, BevelWidth);
      bInside: begin
                Frame3D(Canvas, ARect, Highlight, Shadow, BevelWidth);
                Frame3D(Canvas, ARect, Shadow, Highlight, BevelWidth);
               end;
    end;
  end;
end;

procedure TMenuButton.CMMouseEnter(var Msg: TMessage);
begin
  MouseEnter;
end;
procedure TMenuButton.CMMouseLeave(var Msg: TMessage);
begin
  MouseLeave;
end;

procedure TMenuButton.MouseEnter;
begin
  Hover := True;
  Repaint;
end;
procedure TMenuButton.MouseLeave;
begin
  Hover := False;
  Repaint;
end;

procedure TMenuButton.SetColor(Value: TColor);
begin
  FColor := Value;
  Repaint;
end;
procedure TMenuButton.SetHighlight(Value: TColor);
begin
  FHighlight := Value;
  Repaint;
end;
procedure TMenuButton.SetShadow(Value: TColor);
begin
  FShadow := Value;
  Repaint;
end;
procedure TMenuButton.SetGlyph(Value: TPicture);
begin
  FGlyph.Assign(Value);
  Repaint;
end;
procedure TMenuButton.SetBevel(Value: TBevel);
begin
  FBevel := Value;
  Repaint;
end;
procedure TMenuButton.SetHoverBevel(Value: TBevel);
begin
  FHoverBevel := Value;
  Repaint;
end;
procedure TMenuButton.SetBevelWidth(Value: Integer);
begin
  FBevelWidth := Value;
  Repaint;
end;

end.
Er zeichnet zwar in der Farbe die ich ihm mit Color gebe ein Rectangle aber die 3D-Frames werden nicht gezeichnet, warum?

Hawkeye219 2. Jun 2007 12:29

Re: Zeichnen von CustomPanel funzt nicht!
 
Hallo,

die Rahmen werden nicht gezeichnet, weil du Pen.Style für das Zeichnen des Rechtecks auf den Wert psClear gesetzt hast. Vielleicht solltest du zunächst die Rahmen zeichnen und danach das Innere mit FillRect füllen:

Delphi-Quellcode:
procedure TMenuButton.Paint;
var
  R: TRect;
  ActiveBevel: TBevel;
begin
  R := Rect(0, 0, Width, Height);
  Canvas.Pen.Style := psSolid;

  if Hover
    then ActiveBevel := HoverBevel
    else ActiveBevel := Bevel;

  if (ActiveBevel in [bRaised, bInside]) then
    Frame3D (Canvas, R, Highlight, Shadow, BevelWidth);

  if (ActiveBevel in [bLowered, bInside]) then
    Frame3D (Canvas, R, Shadow, Highlight, BevelWidth);

  Canvas.Brush.Color := Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect (R);
end;
Gruß Hawkeye

.chicken 2. Jun 2007 12:47

Re: Zeichnen von CustomPanel funzt nicht!
 
Stimmt, klingt logisch ;-) danke


Alle Zeitangaben in WEZ +1. Es ist jetzt 08:12 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz