AGB  ·  Datenschutz  ·  Impressum  







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

Probleme mit einer eigenen Komponente

Ein Thema von Wal · begonnen am 4. Nov 2006 · letzter Beitrag vom 5. Nov 2006
Antwort Antwort
Wal

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

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
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 15:09 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