Entwickler-Ecke :: Thema anzeigen

FinnO - So 26.04.09 20:28
Titel: PaintboxButtons

Hi Leute,

jaenicke hat neulich ja mal ein Periodensytem auf der Paintbox gezeichnet. Da habe ich mir gedacht, man könnte ja eigentlich auch mal Buttons und so für die Paintbox entwerfen. Daraufhin habe ich mal sofort angefangen, mit Canvas mal drauflos zu programmieren. Herausgekommen ist dabei ein (grafisch noch nicht wirklich zumutbarer) TpbButton - ein Button für die Paintbox.

benutzt wird er wie folgt:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:

procedure TForm2.FormCreate(Sender: TObject);
begin
  Pb := TPbButton.Create(Paintbox1);
  Pb.Height := 25;
  Pb.Width  := 50;
end;

Man erkennt hoffentlich die Ähnlichkeit zu einem normalen Button. Der Unterschied: Es muss kein Parent angegeben werden. An die Stelle von TComponent als Owner tritt TPaintbox.

Die Ereignisse, wie Click und Hover werden so gehandled.

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

procedure TForm2.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Pb.HandleMouseDown(X,Y);
end;

procedure TForm2.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Pb.HandleMouseMove(X,Y);
end;

procedure TForm2.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Pb.HandleMouseUp(X,Y);
end;

Dazu muss gesagt werden, dass der Button noch nicht wirklich fertig ist, und leider OnClick nicht funktioniert. (wäre aber nur ein Aufwand von 3 Zeilen, nämlich das entsprechende Ereignis in HandleMouseDown einzutragen. Auch grafisch fehlt noch das OnMouseDown, was mir leider grafisch nicht gelingen will. (ist aber nur auskommentiert, da hässlich).

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:

unit pbButton;

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

type TPbBtnMode = (pbmDown,pbmHover,pbmDefault,pbmSelected,pbmDisabled);

type
  TPbButton = class

    private


      FTop, FLeft     : Integer;
      FWidth, FHeight : Integer;

      FOwner          : TPaintbox;
      FMode           : TPbBtnMode;



    public

      constructor Create(AOwner : TPaintBox); overload;

      procedure Draw;

      procedure HandleMouseMove(X,Y : Integer);
      procedure HandleMouseDown(X,Y : Integer);
      procedure HandleMouseUp(X,Y : Integer);

      property Left   : Integer read FLeft    write FLeft;
      property Top    : Integer read FTop     write FTop;
      property Width  : Integer read FWidth   write FWidth;
      property Height : Integer read FHeight  write FHeight;

      property Owner  : TPaintbox   read FOwner write FOwner;
      property Mode   : TPbBtnMode  read FMode  write FMode;
  end;

const
  DefGradientLightcol : TColor = $ECECEC;         //Hellste Farbe in Farbverlauf !!!ACHTUNG!!! DefGradientLightV muss erstem Byte von DefGradientLightCol entsprechen!!!
  DefGradientLightV   : TColor = $EC;             //Hellster Wert des Farbverlaufs in Modus pbmDefault
  DefGradientDarkV    : TColor = $BB;             //Dunkelster Wert des Farbverlaufs in Modus pbmDefault
  DefBorderCol        : TColor = cl3dDkShadow;    //Randfarbe in Modus pbmDefault
  DefHighlightCol     : TColor = clBtnHighlight;  //Innere Randfarbe in Modus pbmDefault

  HovGradientLightCol : TColor = $FFEECC;         //Hellste Farbe in Farverlauf in Modus Hover
  HovBorderCol        : TColor = $DD8800; //Innere Randfarbe in Modus pbmHover
  HovBaseCol          : TColor = $FFEFDD;

  DownBorderCol       : TColor = clMenuHighlight; // Randfarbe in MouseDown
  DownGradientLightCol: TColor = $EEDDBB;
  DownBaseCol         : TColor = $FFDECC;
  DownHighlightCol    : TColor = $AAAAAA;
implementation

constructor TPbButton.Create(AOwner : TPaintBox);
begin
  Owner := AOwner;

  Left := 0;
  Top := 0;
  Width := 75;
  Height := 25;

  
  Mode := pbmDefault;
end;

procedure TPbButton.Draw;
var
  i: Integer;
  delta : integer;
begin
  case FMode of
    pbmDefault:
    
    with Owner.Canvas do
    begin
      Pen.Color := DefBorderCol;
      RoundRect(Left,Top,Left + Width, Top + Height, Left - 5, Top - 5);
      Pen.Width := 1;
      Pen.Color := DefHighlightCol;
      RoundRect(Left+1,Top+1,Left + Width-1, Top + Height-1, Left - 5, Top - 5);

{      Pen.Color := DefHighlightCol;
      MoveTo(Left + 1,Top+height div 2);
      lineto(Left + Width - 1,Top + height div 2);}

      pen.Color := DefGradientLightCol;
      delta := round((DefGradientLightV - DefGradientDarkV) / round(height /2));


      for i := 0 to height div 2 - 2 do
      begin
        moveTo(left+2, height div 2 + i);
        lineTo(left+width - 2, height div 2 + i);
        pen.Color := RGB(getRValue(pen.Color)- delta,getGValue(pen.Color)- delta,getBValue(pen.color) - delta)
      end;
    end; {with}

    pbmHover:

    with Owner.Canvas do
    begin
      Pen.Color := HovBorderCol;
      RoundRect(Left,Top,Left + Width, Top + Height, Left - 5, Top - 5);
      Pen.Width := 1;
      Pen.Color := DefHighlightCol;
      Pen.Width := 1;
      RoundRect(Left+1,Top+1,Left + Width-1, Top + Height-1, Left - 5, Top - 5);

{      Pen.Color := HovHighlightCol;
      Pen.Width := 2;
      MoveTo(Left + 2,Top+height div 2);
      lineto(Left + Width - 2,Top + height div 2);   }

      pen.Color := HovGradientLightCol;
      delta := round((DefGradientLightV - DefGradientDarkV) / round(height /2));

      for i := 0 to height div 2 - 2 do
      begin
        moveTo(left+2, top + height div 2 + i);
        lineTo(left+width - 2, height div 2 + i);
        pen.Color := RGB(getRValue(pen.Color)-delta,getGValue(pen.Color)-delta,getBValue(pen.color))
      end;
     for i := 1 to height div 2 - 1  do
      begin
        moveTo(left+2, i);
        lineTo(left+width - 2, i);
        pen.Color := HovBaseCol;
      end;
    end; {with}

    pbmDown:   // Momentan eine Grafische zumutung...

 {   with Owner.Canvas do
    begin
      Pen.Color := HovBorderCol;
      RoundRect(Left,Top,Left + Width, Top + Height, Left - 5, Top - 5);
      Pen.Width := 1;
      Pen.Color := DownHighlightCol;
      Pen.Width := 3;
      RoundRect(Left+3,Top+3,Left + Width-3, Top + Height-3, Left - 5, Top - 5);


      pen.Color := DownGradientLightCol;
      delta := round((DefGradientLightV - DefGradientDarkV) / round(height /2));

      for i := 0 to height div 2 - 2 do
      begin
        moveTo(left+2, height div 2 + i);
        lineTo(left+width - 2, height div 2 + i);
        pen.Color := RGB(getRValue(pen.Color)-delta,getGValue(pen.Color)-delta,getBValue(pen.color))
      end;
     for i := 1 to height div 2 - 1  do
      begin
        moveTo(left+2, i);
        lineTo(left+width - 2, i);
        pen.Color := DownBaseCol;
      end;
    end; {with}

  end;{case}
end;

procedure TPbButton.HandleMouseMove(X,Y : Integer);
begin
  if (X in [Left..Left+Width]) and
     (Y in [Top..Top+Height]) then
  begin
    if not (Mode = pbmHover) then
    begin
      Mode := pbmHover;
      Draw;
    end;
    Mode := pbmHover;
  end
  else
  begin
    if Mode = pbmHover then
    begin
      Mode := pbmDefault;
      Draw;
    end;
      Mode := pbmDefault;
  end;
end;
procedure TPbButton.HandleMouseDown(X: Integer; Y: Integer);
begin
  if (X in [Left..Left+Width]) and
     (Y in [Top..Top+Height]) then
  begin
    Mode := pbmDown;
    Draw;
  end;
end;
procedure TPbButton.HandleMouseUp(X: Integer; Y: Integer);
begin
  if Mode = pbmDown then
  begin
    //OnClick auslösen
    Mode := pbmHover;
  end
  else
  Mode := pbmDefault;
  Draw;
end;
end.

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!