Einzelnen Beitrag anzeigen

BenjaminHelbig

Registriert seit: 23. Okt 2003
Ort: Mannheim
80 Beiträge
 
Delphi 5 Professional
 
#4

Re: Komponente wird nur zur Designzeit gezeichnet

  Alt 3. Okt 2006, 18:50
Hier der Code des Komponente:

Delphi-Quellcode:
unit PanelWrapper;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, PanelSplitter, Highlightning, PanelCollection;

type
  // The Panel Wrapper
  TPanelState = (psDefault, psUp, psDown);
  TPanelNumbers = (spnNone, spnCenter, spnLeft, spnRight);
  TPanelWrapper = class(TPanel)
  private
    { Private-Deklarationen }
    FTmpColor: TColor;
    FPanelSplitter: TPanelSplitter;
    FPanelState: TPanelState;
    FPanelNumbers: TPanelNumbers;
    FHighlight: THighlightning;
    FpcPanels: TPanels;

    { Event Variables }
    FMouseEnter: TNotifyEvent;
    FMouseLeave: TNotifyEvent;
    FMouseWheel: TNotifyEvent;

    procedure SetPanels(const NewPanels: TPanels);
    procedure SetPanelSplitter(const NewPanelSplitter: TPanelSplitter);
    procedure SetPanelState(const NewPanelState: TPanelState);
    procedure SetPanelNumbers(const NewPanelNumbers: TPanelNumbers);
    procedure SetHighlight(const NewHighlight: THighlightning);

    { Event Procedures }
    procedure CMMouseEnter(var Message : TMessage); Message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message : TMessage); Message CM_MOUSELEAVE;
    procedure CMMouseWheel(var Message : TMessage); Message CM_MOUSEWHEEL;
  protected
    { Protected-Deklarationen }
    procedure Paint; override;
  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published-Deklarationen }
    { Properties }
    property AutoSize default true;
    property Panels: TPanels read FpcPanels write SetPanels;
    property PanelSplitter: TPanelSplitter read FPanelSplitter write SetPanelSplitter;
    property PanelState: TPanelState read FPanelState write SetPanelState Default psDefault;
    property ShowPanelNumbers: TPanelNumbers read FPanelNumbers write SetPanelNumbers Default spnNone;
    property Highlight: THighlightning read FHighlight write SetHighlight;

    { Events }
    property OnMouseEnter: TNotifyEvent read FMouseEnter Write FMouseEnter;
    property OnMouseLeave: TNotifyEvent read FMouseLeave Write FMouseLeave;
    property OnMouseWheel: TNotifyEvent read FMouseWheel Write FMouseWheel;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TPanelWrapper]);
end;

{ TPanelWrapper }

constructor TPanelWrapper.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AutoSize := true;
  FpcPanels := TPanels.Create(self, TPanelCollectionItem);
  FPanelSplitter := TPanelSplitter.Create();
  FHighlight := THighlightning.Create();
end;

destructor TPanelWrapper.Destroy;
begin
  FpcPanels.Free;
  FPanelSplitter.Free;
  FHighlight.Free;
  inherited Destroy;
end;



procedure TPanelWrapper.SetPanels(const NewPanels: TPanels);
begin
  if (NewPanels <> FPcPanels) then
  begin
    FPcPanels.Assign(NewPanels);
  end;
end;

procedure TPanelWrapper.SetPanelSplitter(const NewPanelSplitter: TPanelSplitter);
begin
  if (NewPanelSplitter <> FPanelSplitter) then
  begin
    FPanelSplitter.Assign(NewPanelSplitter);
    Invalidate;
  end;
end;

procedure TPanelWrapper.SetPanelState(const NewPanelState: TPanelState);
begin
  if NewPanelState <> FPanelState then
  begin
    FPanelState := NewPanelState;
    Invalidate;
  end;
end;

procedure TPanelWrapper.SetPanelNumbers(const NewPanelNumbers: TPanelNumbers);
begin
  if NewPanelNumbers <> FPanelNumbers then
  begin
    FPanelNumbers := NewPanelNumbers;
    Invalidate;
  end;
end;

procedure TPanelWrapper.SetHighlight(const NewHighlight: THighlightning);
begin
  if NewHighlight <> FHighlight then
  begin
    FHighlight.Assign(NewHighlight);
    Invalidate;
  end;
end;

procedure TPanelWrapper.Paint;
begin
  inherited;

  case FPanelState of
       psUp:
         begin
           Self.BevelInner := bvRaised;
           Self.BevelOuter := bvRaised;
         end;
       psDown:
         begin
           Self.BevelInner := bvLowered;
           Self.BevelOuter := bvLowered;
         end;
       psDefault:
         begin
           Self.BevelInner := bvNone;
           Self.BevelOuter := bvRaised;
         end;
  end;
end;



{ Events }
procedure TPanelWrapper.CMMOUSEENTER(var Message : TMessage);
begin
 if Message.Msg = CM_MOUSEENTER then
 begin
   if enabled then
   begin
    // Highlight
    if FHighlight.Highlight then
    begin
      // Do Highlightning
      FTmpColor := Self.Color;
      Self.Color := FHighlight.HighlightColor;
      Invalidate;
    end;
    if assigned(OnMouseEnter) then
    begin
      OnMouseEnter(Self);
    end;
   end;
 end;
end;

procedure TPanelWrapper.CMMouseLeave(var Message : TMessage);
begin
 if enabled then
 begin
   // Highlight
   if FHighlight.Highlight then
   begin
     // Do stop Highlightning
     Self.Color := FTmpColor;
     Invalidate;
   end;
   if assigned(OnMouseLeave) then
   begin
     OnMouseLeave(Self);
   end;
 end;
end;

procedure TPanelWrapper.CMMOUSEWheel(var Message : TMessage);
begin
 if Message.Msg = CM_MOUSEWHEEL then
 begin
   if enabled then
   begin
     if assigned(OnMouseWheel) then OnMouseWheel(Self);
   end;
 end;
end;

end.
Danke für eure Hilfe.
--------
Es ist schon über so viele Dinge Gras gewachsen, dass ich keinem Rasen mehr traue.
  Mit Zitat antworten Zitat