AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Möchte TPanel mit Image von ImageList koppeln

Ein Thema von Jumpy · begonnen am 9. Apr 2013 · letzter Beitrag vom 15. Apr 2013
Antwort Antwort
Jumpy

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

AW: Möchte TPanel mit Image von ImageList koppeln

  Alt 15. Apr 2013, 10: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
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:30 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz