Einzelnen Beitrag anzeigen

Wal

Registriert seit: 22. Sep 2006
57 Beiträge
 
#7

Re: Probleme mit einer eigenen Komponente

  Alt 5. Nov 2006, 13:22
So habe das Teil soweit fertig, evtl. könnte ein Profi mal drüberschauen ob noch was zu verbessern ist.
Ich möchte noch ein paar Kleinigkeiten einbauen, da wäre es gut wenn ich nicht mehr so viel ändern müßte.
Delphi-Quellcode:
unit cPosCompo;

interface

uses
  Classes, Graphics, Controls, Messages, Jpeg;

type
  TcPosCompo = class(TGraphicControl)
  private
    FUpPic : TJpegImage;
    FDownPic : TJpegImage;
    FOverPic : TJpegImage;
    FBoolTruePic : TBitmap;
    FBoolFalsePic : TBitmap;
    FShowBoolPic : Boolean;
    FButtonDown : Boolean;
    FLabelXPos : Integer;
    FLabelYPos : Integer;
    FEntered : Boolean;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMMouseEnter( var Message : TWMMouse ); message CM_MOUSEENTER;
    procedure WMMouseLeave( var Message : TWMMouse ); message CM_MOUSELEAVE;
    procedure SetDownPic(const Value: TJpegImage);
    procedure SetUpPic(const Value: TJpegImage);
    procedure SetOverPic(const Value: TJpegImage);
    procedure SetBoolTruePic(const Value: TBitmap);
    procedure SetBoolFalsePic(const Value: TBitmap);
    procedure SetText(const Value: TCaption); reintroduce;
    procedure SetShowBoolPic(const Value: Boolean);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Caption write SetText;
    property UpPicture: TJpegImage read FUpPic write SetUpPic;
    property DownPicture: TJpegImage read FDownPic write SetDownPic;
    property OverPicture: TJpegImage read FOverPic write SetOverPic;
    property BoolTruePicture: TBitmap read FBoolTruePic write SetBoolTruePic;
    property BoolFalsePicture: TBitmap read FBoolFalsePic write SetBoolFalsePic;
    property ShowBoolPic: Boolean read FShowBoolPic write SetShowBoolPic;
    property OnMouseDown;
    property OnMouseUp;
    property OnClick;
  end;

procedure Register;

implementation

  procedure Register;
begin
  RegisterComponents('cPOS_Live', [TcPosCompo]);
end;

{ TcPosCompo }

constructor TcPosCompo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FUpPic := TJpegImage.Create();
  FDownPic := TJpegImage.Create();
  FOverPic := TJpegImage.Create();
  FBoolTruePic := TBitmap.Create();
  FboolTruePic.TransparentColor := clblack;
  FboolTruePic.Transparent := True;
  FBoolFalsePic := TBitmap.Create();
  FboolFalsePic.TransparentColor := clblack;
  FboolFalsePic.Transparent := True;
  FButtonDown := False;
  FEntered := False;
  FShowBoolPic := False;
  FLabelXPos := 0;
  FLabelYPos := 0;
  Canvas.Brush.Style := bsClear;
end;

destructor TcPosCompo.Destroy;
begin
  FUpPic.Free();
  FDownPic.Free();
  FOverPic.Free();
  FBoolTruePic.Free();
  FBoolFalsePic.Free();
  inherited;
end;

procedure TcPosCompo.Paint;
begin
  if FButtonDown then
  begin
    Canvas.Draw(0, 0, FDownPic);
    if FShowBoolPic then Canvas.Draw(5, 4, FBoolTruePic) else Canvas.Draw(5, 4, FBoolFalsePic);
    Canvas.Font.Color := clWhite;
    Canvas.TextOut(FLabelXPos + 1, FLabelYPos + 1, Caption);
    Canvas.Font.Color := clBlack;
    Canvas.TextOut(FLabelXPos, FLabelYPos, Caption);
  end else
  begin
    if FEntered then Canvas.Draw(0, 0, FOverPic) else
    Canvas.Draw(0, 0, FUpPic);
    if FShowBoolPic then Canvas.Draw(5, 4, FBoolTruePic) else Canvas.Draw(5, 4, FBoolFalsePic);
    Canvas.Font.Color := clBlack;
    Canvas.TextOut(FLabelXPos + 1, FLabelYPos + 1, Caption);
    Canvas.Font.Color := clWhite;
    Canvas.TextOut(FLabelXPos, FLabelYPos, Caption);
  end;
end;

procedure TcPosCompo.SetBoolTruePic(const Value: TBitmap);
begin
  FBoolTruePic.Assign(Value);
end;

procedure TcPosCompo.SetBoolFalsePic(const Value: TBitmap);
begin
  FBoolFalsePic.Assign(Value);
end;

procedure TcPosCompo.SetOverPic(const Value: TJpegImage);
begin
  FOverPic.Assign(Value);
end;

procedure TcPosCompo.SetDownPic(const Value: TJpegImage);
begin
  FDownPic.Assign(Value);
end;

procedure TcPosCompo.SetUpPic(const Value: TJpegImage);
begin
  FUpPic.Assign(Value);
end;

procedure TcPosCompo.WMLButtonDown(var Message: TWMLButtonDown);
begin
  FButtonDown := True;
  Repaint();
  inherited;
end;

procedure TcPosCompo.WMLButtonUp(var Message: TWMLButtonUp);
begin
  FButtonDown := False;
  Repaint();
  inherited;
end;

procedure TcPosCompo.WMMouseEnter( var Message: TWMMouse );
begin
  FEntered := True;
  Repaint();
  inherited;
end;

procedure TcPosCompo.WMMouseLeave( var Message: TWMMouse );
begin
  FEntered := False;
  Repaint();
  inherited;
end;

procedure TcPosCompo.SetText(const Value: TCaption);
begin
  if Caption <> Value then
  begin
    SetTextBuf(PChar(Value));
    Repaint();
  end;
end;

procedure TcPosCompo.SetShowBoolPic(const Value: Boolean);
begin
  if ShowBoolPic <> Value then
  begin
    FShowBoolPic := Value;
    Repaint();
  end;
end;

end.
Funktion:
Es sollen 3 Jpeg-Bilder eingebunden werden, für: up,down,over. Eine Bitmap für den Status des Buttons, wenn er als Schalter und nicht als Taster benutzt wird.
Eine Beschriftung soll angezeigt werden.
Das ganze funzt auch soweit.
Die Status und Beschriftungskoordinaten muß ich noch einbinden.

Wal
  Mit Zitat antworten Zitat