Einzelnen Beitrag anzeigen

Angel4585

Registriert seit: 4. Okt 2005
Ort: i.d.N.v. Freiburg im Breisgau
2.199 Beiträge
 
Delphi 2010 Professional
 
#2

Re: Komponenten auf MDI-Form in Hintergrund

  Alt 27. Mär 2006, 16:08
Ich hab grad ne Kompo gefunden die ich mal selbst gemacht hab und die lustigerweise HINTER den Childs liegt, hier der Source:
Delphi-Quellcode:
unit UASBKomps;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Windows, Graphics, Messages, Dialogs,
  Forms, ContNrs;

const MAIN_COLOR = clSkyBlue;
type

  TASBButtonStates = (bsMouseDown,bsMouseUp,bsMouseMove,bsMouseLeave);
  TASBButtonColors = array[TASBButtonStates] of TColor;
  TASBBOOLColors = array[Boolean] of TColor;

  TASBColor = class(TObject)
   private
    FASBList : TObjectList;
    FColor: TColor;
    FFont : TFont;
    procedure SetColor(const Value: TColor);
    procedure SetFont(const Value: TFont);
   public
    constructor Create;
    property Color : TColor read FColor write SetColor;
    property Font : TFont read FFont write SetFont;
   end;

  TASBComp = class(TGraphicControl)
   private
    FPenColors : TASBButtonColors;
    FBrushColors : TASBButtonColors;
    FColor : TColor;
    FFont : TFont;
    function GetColor: TColor;
    procedure SetColor(const Value: TColor);
   public
    constructor Create(AOwner : TComponent);override;
    destructor Destroy;override;
   published
    property Color : TColor read GetColor write SetColor;

   end;

  TASBButton = class(TASBComp)
  private
    { Private-Deklarationen }
    FState : TASBButtonStates;
    FlastState : TASBButtonStates;
    FCaption : TCaption;
    FAlphaVal : Byte;
    FOnMouseLeave : TNotifyEvent;
    procedure SetCaption(const Value: TCaption);
    procedure FSetAlphaVal(AAlpha: Byte);
  protected
    { Protected-Deklarationen }
    procedure Paint;override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  public
    { Public-Deklarationen }
    constructor Create(AOwner : TComponent);override;
  published
    { Published-Deklarationen }
    property Caption : TCaption read FCaption write SetCaption;
    property Height;
    property Width;
    property AlphaVal : Byte read FAlphaVal write FSetAlphaVal;
    property OnClick;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnMouseLeave : TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

var
 ASBColor : TASBColor ;
procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('ASBKomps', [TASBButton]);
end;

procedure SetASBColor(AControl : TControl);
begin
if not Assigned(ASBColor) then
 ASBColor:=TASBColor.Create;
ASBColor.FASBList.Add(AControl);
end;

procedure RemASBColor(AControl : TControl);
begin
ASBColor.FASBList.Extract(AControl);
if ASBColor.FASBList.Count = 0 then
 FreeAndNil(ASBColor);
end;
{ TASBButton }

procedure TASBButton.CMMouseLeave(var Msg: TMessage);
begin
if FState <> bsMouseLeave then
 begin
 FLastState:=FState;
 FState:=bsMouseLeave;
 end;
Invalidate;
if Assigned(FOnMouseLeave) then
 FOnMouseLeave(Self);
end;

constructor TASBButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Parent:=TWinControl(AOwner);
Width:=90;
Height:=25;
fAlphaVal := 255;
FPenColors[bsMouseDown]:=TColor($888888);
FPenColors[bsMouseUp]:=TColor($999999);
FPenColors[bsMouseMove]:=TColor($999999);
FPenColors[bsMouseLeave]:=TColor($afafaf);
FBrushColors[bsMouseDown]:=Color;
FBrushColors[bsMouseUp]:=Color;
FBrushColors[bsMouseMove]:=Color;
FBrushColors[bsMouseLeave]:=Color;
FState:=bsMouseLeave;
end;

procedure TASBButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift,x,y);
if (FState = bsMouseDown)or(FState = bsMouseMove) then
 exit;
if FState <> bsMouseMove then
 begin
 FLastState:=FState;
 FState:=bsMouseMove;
 Invalidate;
 end;
end;

procedure TASBButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited MouseUp(Button,shift,x,y);
if FState <> bsMouseUp then
 begin
 FLastState:=FState;
 FState:=bsMouseUp;
 end;
Invalidate;
end;

procedure TASBButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited MouseDown(Button,Shift,X,Y);
if FState <> bsMouseDOwn then
 begin
 FLastState:=FState;
 FState:=bsMouseDown;
 end;
Invalidate;
end;

procedure TASBButton.Paint;
type
 PCanvas = ^TCanvas;
var LBitmap: TBitmap;
 LOldCanvas: TCanvas;
 LBlendFunc: TBlendFunction;
 i : integer;
begin
if (FLastState <> FState )then
 if fAlphaVal = 255 then
  with Canvas do
   begin
   Pen.Color:=FPenColors[FState];
   Brush.Color:=FBrushColors[FState];
   for i:= 0 to 2 do
    RoundRect(i,i,Width-1-i,Height-1-i,10,10);
   TextOut((Width div 2)-(TextWidth(Caption)div 2),(Height div 2)-(TextHeight(Caption)div 2),Caption);
   end
 else
  begin
  LBitmap := TBitmap.Create;
  LBitmap.Width := Width;
  LBitmap.Height := Height;
  BitBlt(LBitmap.Canvas.Handle, 0, 0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
  LOldCanvas := Canvas;
  PCanvas(@Canvas)^ := LBitmap.Canvas;
  with Canvas do
   begin
   Pen.Color:=FPenColors[FState];
   Brush.Color:=FBrushColors[FState];
   for i:= 0 to 2 do
    RoundRect(i,i,Width-1-i,Height-1-i,10,10);
   TextOut((Width div 2)-(TextWidth(Caption)div 2),(Height div 2)-(TextHeight(Caption)div 2),Caption);
   end;
  PCanvas(@Canvas)^ := LOldCanvas;
  LBlendFunc.BlendOp := AC_SRC_OVER;
  LBlendFunc.BlendFlags := 0;
  LBlendFunc.SourceConstantAlpha := fAlphaVal;
  LBlendFunc.AlphaFormat := 0;
  windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, LBitmap.Canvas.Handle,
  0, 0, Width, Height, LBlendFunc);
  LBitmap.Free;
  end;
end;

procedure TASBButton.FSetAlphaVal(AAlpha: Byte);
begin
if AAlpha <> fAlphaVal then
 begin
 fAlphaVal := AAlpha;
 Invalidate;
 end;
end;

procedure TASBButton.SetCaption(const Value : TCaption);
begin
FCaption := Value;
Invalidate;
end;

{ TASBColor }

procedure TASBColor.SetColor(const Value: TColor);
var
 i : integer;
begin
FColor:=Value;
for i:= 0 to Pred(FASBList.Count)do
 begin
 TASBComp(FASBList.Items[i]).FColor:=FColor;
 TASBComp(FASBList.Items[i]).FBrushColors[bsMouseDown]:=FColor;
 TASBComp(FASBList.Items[i]).FBrushColors[bsMouseUp]:=FColor;
 TASBComp(FASBList.Items[i]).FBrushColors[bsMouseMove]:=FColor;
 TASBComp(FASBList.Items[i]).FBrushColors[bsMouseLeave]:=FColor;
 TASBComp(FASBList.Items[i]).Invalidate;
 end;
end;

constructor TASBColor.Create;
begin
 inherited Create;
FASBList:=TObjectList.Create;
fcolor:=MAIN_COLOR;
end;

procedure TASBColor.SetFont(const Value: TFont);
var
 i : integer;
begin
FFont:=Value;
for i:= 0 to Pred(FASBList.Count)do
 begin
 TASBComp(FASBList.Items[i]).Canvas.Font:=FFont;
 TASBComp(FASBList.Items[i]).Invalidate;
 end;
end;

{ TASBComp }

constructor TASBComp.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
SetASBColor(Self);
end;

destructor TASBComp.Destroy;
begin
RemASBColor(Self);
  inherited Destroy;
end;

function TASBComp.GetColor: TColor;
begin
Result:=ASBColor.Color;
end;

procedure TASBComp.SetColor(const Value: TColor);
begin
ASBColor.Color:=Value;
end;

end.
Ich weis ist bissl viel... aber wieso funzt das mit der Kompo und mit TButtons nicht?
Martin Weber
Ich bin ein Rüsselmops
  Mit Zitat antworten Zitat