Einzelnen Beitrag anzeigen

Jumpy

Registriert seit: 9. Dez 2010
Ort: Mönchengladbach
1.736 Beiträge
 
Delphi 6 Enterprise
 
#8

AW: Möchte TPanel mit Image von ImageList koppeln

  Alt 15. Apr 2013, 11:35
Hallo,

hier jetzt mal mein fertiges TStatusPanel nach Bummis Anriss, danke aber auch an alle anderen.
- Man kann das Bild als Icon oder Bitmap malen
- Bei MausUp bekommt das Panel den Fokus
- Hintergrund und Font können anders gefärbt werden, wenn es den Fokus hat
- Man kann eine Rahmenfarbe und -Breite definieren
- Man kann eine zweite Rahmenfarbe definieren um das Panel zu "Highlighten".

Delphi-Quellcode:
unit uStatusPanel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,ExtCtrls, StdCtrls, ImgList;

type TImageMode = (Icon,Bitmap);

type
  TStatusPanel=Class(TPanel)
    Procedure Paint;override;
   private
     FOnMouseDown: TNotifyEvent;
     FImageList:TImageList;
     FImageIndex: Integer;
     FImageMode:TImageMode;
     FImageBorder:integer;
     FBorderSize:integer;
     FBackColor:TColor;
     FFontColor:TColor;
     FBorderColor:TColor;
     FShowBorder:Boolean;
     FHighColor:TColor;
     FFontHighColor:TColor;
     FBorderHighColor:TColor;
     FShowBorderHighlighted:Boolean;
     FActive:Boolean;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
    procedure SetImageIndex(const Value: Integer);
    procedure SetImageList(const Value: TImageList);
    function GetBackColor: TColor;
    procedure SetBackColor(const Value: TColor);
    function GetBorderColor: TColor;
    function GetHighColor: TColor;
    function GetShowBorder: Boolean;
    procedure SetBorderColor(const Value: TColor);
    procedure SetHighColor(const Value: TColor);
    procedure SetShowBorder(const Value: Boolean);
    function GetBorderHighColor: TColor;
    procedure SetBorderHighColor(const Value: TColor);
    function GetShowBorderHigh: Boolean;
    procedure SetShowBorderHigh(const Value: Boolean);
    function GetBorderSize: integer;
    procedure SetBorderSize(const Value: integer);
    function GetFontColor: TColor;
    function GetFontHighColor: TColor;
    procedure SetFontColor(const Value: TColor);
    procedure SetFontHighColor(const Value: TColor);
   public
    constructor create(AOwner:TComponent); override;
   published
    Property ImageList:TImageList read FImageList Write SetImageList;
    Property ImageIndex:Integer Read FImageIndex Write SetImageIndex;
    Property ImageMode:TImageMode Read FImageMode Write FImageMode;
    Property ImageBorderSize:integer Read FImageBorder Write FImageBorder;
    Property BackGroundColor:TColor Read GetBackColor Write SetBackColor;
    Property HighlightColor:TColor Read GetHighColor Write SetHighColor;
    Property BorderColor:TColor Read GetBorderColor Write SetBorderColor;
    Property BorderSize:integer Read GetBorderSize Write SetBorderSize;
    Property BorderHighlightColor:TColor Read GetBorderHighColor Write SetBorderHighColor;
    Property FontColor:TColor Read GetFontColor Write SetFontColor;
    Property FontHighlightColor:TColor Read GetFontHighColor Write SetFontHighColor;
    Property ShowBorder:Boolean Read GetShowBorder Write SetShowBorder;
    Property ShowBorderHighlighted:Boolean Read GetShowBorderHigh Write SetShowBorderHigh;
  End;

implementation

{ TStatusPanel }

procedure TStatusPanel.CMFocusChanged(var Message: TCMFocusChanged);
begin
  if Message.Sender is TStatusPanel then
    FActive := Message.Sender = Self
  else
    FActive:=false;
  Repaint;
  inherited;
end;

constructor TStatusPanel.create(AOwner: TComponent);
begin
  inherited;
  FImageIndex:=-1;
  FImageBorder:=5;
  FBackColor:=clBtnFace;
  FHighColor:=clSilver;
  FBorderHighColor:=clRed;
  FBorderColor:=clBlack;
  FShowBorder:=False;
  FShowBorderHighlighted:=False;
  FActive:=false;
  FFontColor:=Font.Color;
  FFontHighColor:=Font.Color;
end;

function TStatusPanel.GetBackColor: TColor;
begin
  Result:=FBAckColor;
end;

function TStatusPanel.GetBorderColor: TColor;
begin
  Result:=FBorderColor;
end;

function TStatusPanel.GetBorderHighColor: TColor;
begin
  Result:=FBorderHighColor;
end;

function TStatusPanel.GetBorderSize: integer;
begin
  Result:=FBorderSize;
end;

function TStatusPanel.GetFontColor: TColor;
begin
  Result:=FFontColor;
end;

function TStatusPanel.GetFontHighColor: TColor;
begin
  Result:=FFontHighColor;
end;

function TStatusPanel.GetHighColor: TColor;
begin
  Result:=FHighColor;
end;

function TStatusPanel.GetShowBorder: Boolean;
begin
  Result:=FShowBorder;
end;

function TStatusPanel.GetShowBorderHigh: Boolean;
begin
  Result:=FShowBorderHighlighted;
end;

procedure TStatusPanel.Paint;
var
 ico:TIcon;
 btm:TBitmap;
 graph:TGraphic;
 Toffs:Integer;
begin
  // inherited; nicht aufrufen
  // Background:
  if FActive then
    Canvas.Brush.Color := HighlightColor
  else
    Canvas.Brush.Color := BackGroundColor;
  Canvas.FillRect(ClientRect);
  // Border:
  if ShowBorder or ShowBorderHighlighted then
  with Canvas do
  begin
    if ShowBorderHighlighted then
      Canvas.pen.color:=BorderHighlightColor
    else
    Canvas.pen.color:=BorderColor;
    Canvas.Pen.Width:=BorderSize;
    Canvas.moveto(0,0);
    Canvas.lineto(width-1,0);
    Canvas.lineto(width-1,height-1);
    Canvas.lineto(0,height-1);
    Canvas.lineto(0,0);
  end;

  // Image:
  Toffs := ImageBorderSize;
  if Assigned(FImageList) and (FImageList.Count>ImageIndex )then
    begin
    Case ImageMode of
      Icon: begin
              ico:=TIcon.Create;
              FImageList.GetIcon(ImageIndex,ico);
              Canvas.Draw(Toffs,(Height - FImageList.Height) div 2,ico);
              ico.Free;
              end;
      Bitmap: begin
              btm:=TBitmap.Create;
              FImageList.GetBitmap(ImageIndex,btm);
              Canvas.Draw(Toffs,(Height - FImageList.Height) div 2,btm);
              btm.Free;
              end;
      end;
    Toffs := Toffs + FImageList.Width + Toffs;
    end;
  // Text ausgeben
  if FActive then
    Canvas.Font.Color:=FontHighlightColor
  else
    Canvas.Font.Color:=FontColor;
  Canvas.TextOut(Toffs,(Height - Canvas.TextHeight('X')) div 2, Caption);
end;

procedure TStatusPanel.SetBackColor(const Value: TColor);
begin
  FBackColor:=value;
  invalidate;
end;

procedure TStatusPanel.SetBorderColor(const Value: TColor);
begin
  FBorderColor:=value;
  invalidate;
end;

procedure TStatusPanel.SetBorderHighColor(const Value: TColor);
begin
  FBorderHighColor:=value;
  invalidate;
end;

procedure TStatusPanel.SetBorderSize(const Value: integer);
begin
  FBorderSize:=value;
end;

procedure TStatusPanel.SetFontColor(const Value: TColor);
begin
  FFontColor:=Value;
  invalidate;
end;

procedure TStatusPanel.SetFontHighColor(const Value: TColor);
begin
  FFontHighColor:=value;
  invalidate;
end;

procedure TStatusPanel.SetHighColor(const Value: TColor);
begin
  FHighColor:=value;
  invalidate;
end;

procedure TStatusPanel.SetImageIndex(const Value: Integer);
begin
  FImageIndex := Value;
  invalidate;
end;

procedure TStatusPanel.SetImageList(const Value: TImageList);
begin
  FImageList := Value;
  invalidate;
end;

procedure TStatusPanel.SetShowBorder(const Value: Boolean);
begin
  FShowBorder:=value;
  invalidate;
end;

procedure TStatusPanel.SetShowBorderHigh(const Value: Boolean);
begin
  FShowBorderHighlighted:=value;
  invalidate;
end;

procedure TStatusPanel.WMLButtonUp(var Message: TWMLButtonUp);
begin
  inherited;
  self.SetFocus;
  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self);
end;

procedure TStatusPanel.WMRButtonUp(var Message: TWMRButtonUp);
begin
  inherited;
  self.SetFocus;
  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self);
end;

end.
Ralph
  Mit Zitat antworten Zitat