Jednym z najczęściej używanych w programach obiektów jest przycisk tButton. Ma on jednak dwie dość irytujące wady. Po pierwsze, nie pozwala na skonstruowanie przycisku zawierającego więcej niż jedną linię tekstu. Po drugie, nie daje możliwości wyłączenia cienia pojawiającego się zawsze przy przycisku.
Obie te niedogodności likwiduje skonstruowany przeze mnie obiekt - tShadeButton. Prawie wszystkie jego metody zostały żywcem zciągnięte ze źródeł zawartych w RTL. Jest to konieczne ze względu na nieopłacalność konstruowania obiektu dziedziczącego po tButton. Winić trzeba za to niewirtualną (a więc nie do nadpisania) metodę DrawState, wywoływaną m.in. przez Draw i HandleEvent przycisku. Jeśli mimo wszystko zdecydowałbym się na dziedziczenie, byłbym zmuszony do nadpisania tych dwóch metod i zastąpienia w nich wywołania metody DrawState zupełnie inną, np. o nazwie MyDrawState. Metoda DrawState była by martwa (nigdzie nie wywoływana), zajmując tylko miejsce w pamięci. Dziedziczenie nie jest zatem takie uniwersalne; często bardziej opłaca się modyfikować kod źródłowy, a właściwie tworzyć nowe obiekty na podstawie kodu źródłowego poprzednich obiektów, niż korzystać z dziedziczenia.
tShadeButton.DrawState(Down: Boolean) jest najważniejszą metodą obiektu. Odpowiada ona za narysowanie przycisku na ekranie, przy czym parametr Down określa, czy ma on być rysowany jako wciśnięty, czy zwolniony. Pisząc tą metodę zaczynałem od zera. Skoro bowiem przycisk ma zawierać kilka linii tekstu, to można posłużyć się gotowym obiektem wypisującym tekst na ekran - tStaticText ! pozostało mi tylko przeanalizować działanie metody tStaticText.Draw i połączyć ją odpowiednio z tButton.DrawState. W efekcie uzyskałem stosunkowo małym nakładem pracy tShadeButton.DrawState. Jeśli zatem chcemy mieć w przycisku kilka linii tekstu, musimy w jego konstruktorze jako parametr aTitle podać łańcuch sformatowany tak, jak dla tStaticText. W przypadku, gdy tekst ma być rysowany centralnie, należy w sposób tradycyjny dla tStaticText na początku każdej nowej linii dodać znak #3. Nowy przycisk zachowuje się tak samo jak StaticText, co można sprawdzić, zmieniając wymiary przycisku. Dodatkowo nie ma wady tButton, polegającej na zamazywaniu cienia z prawej strony w przypadku podania zbyt długiego tytułu.
Do typowych flag przycisku bfXXXX dodaem nową bfShadow. Jest ona ustawiana standardowo w konstruktorze - częściej zależy nam na tym, by przycisk miał cień, niż by go nie miał. Jeśli cień ma zniknąć, należy tę flagę wyzerować. Na wydruku 1 znajduje się prosty przykład wykorzystania właściwości nowych przycisków. Wydruk 2 zawiera w formie Unitu definicję obiektu tShadeButton.
Wydruk 1
{
Unit : Definicja objektu TShadeButton
Autor : Jarosław Chochowski, Lublin 1994/08/28
}
Unit Button; Interface Uses Objects, Drivers, Views, Validate, Dialogs;
Const bfShadow = 16;
cmGrabDefault = 61;
cmReleaseDefault = 62;
Type pShadeButton = ^tShadeButton;
tShadeButton = Object(tView)
Title : pString;
Command : Word;
Flags : Byte;
AmDefault : Boolean;
Constructor Init(Var Bounds: tRect; aTitle: tTitleStr;
aCommand: Word; aFlags: Word);
Constructor Load(Var S: tStream);
Function GetPalette: pPalette; Virtual;
Procedure GetText(Var S: String);
Procedure Draw; Virtual;
Procedure DrawState(Down: Boolean);
Procedure Press; Virtual;
Procedure HandleEvent(Var Event: tEvent); Virtual;
Procedure MakeDefault(Enable : Boolean);
Procedure SetState(AState : Word; Enable : Boolean); Virtual;
Procedure Store(Var S : tStream);
Destructor Done; Virtual;
End;
Implementation
Function HotKey(Const S: String): Char;
Var P: Word;
Begin
P := Pos('~',S);
If P <> 0
Then HotKey := UpCase(S[P+1])
Else HotKey := #0;
End;
Constructor tShadeButton.Init(Var Bounds: tRect; aTitle: tTitleStr;
aCommand: Word; aFlags: Word);
Begin
tView.Init(Bounds);
Options := Options Or (ofSelectable + ofFirstClick +
ofPreProcess + ofPostProcess);
EventMask := EventMask Or evBroadcast;
If Not CommandEnabled(aCommand)
Then State := State Or sfDisabled;
Flags := aFlags Or bfShadow;
If aFlags And bfDefault <> 0
Then amDefault := True
Else amDefault := False;
Title := NewStr(aTitle);
Command := aCommand;
End;
Constructor tShadeButton.Load(Var S: tStream);
Begin
tView.Load(S);
Title := S.ReadStr;
S.Read(Command, SizeOf(Word) + SizeOf(Byte) + SizeOf(Boolean));
If Not CommandEnabled(Command) Then State := State Or sfDisabled
Else State := State And Not sfDisabled;
End;
Procedure tShadeButton.GetText(Var S: String);
Begin
If Title <> Nil Then S := Title^
Else S := '';
End;
Procedure tShadeButton.Draw;
Begin
DrawState(False);
End;
Procedure tShadeButton.DrawState(Down: Boolean);
Var Color : Byte;
Center : Boolean;
LiczTydli,Przes,Szer,I,J,L,P,Y : Integer;
B : tDrawBuffer;
S,PomocStr : String;
CButton,CShadow : Word;
Ch : Char;
T : Integer;
{}
Procedure SrodkowaLinia;
Var L,SCOFF : Integer;
Begin
If ShowMarkers And Not Down Then
Begin
If State And sfSelected <> 0 Then SCOFF := 0
Else If AmDefault Then SCOFF := 2 Else SCOFF := 4;
WordRec(B[0]).Lo := Byte(SpecialChars[SCOFF]);
WordRec(B[Szer]).Lo := Byte(SpecialChars[SCOFF+1]);
End;
End;
{}
Begin
Color := GetColor(1);
GetText(S);
L := Length(S);
P := 1; Y := 0;
Center := False;
If State And sfDisabled <> 0
Then CButton := GetColor($0404)
Else Begin
Cbutton := GetColor($0501);
If State And sfActive <> 0
Then If State And sfSelected <> 0
Then CButton := GetColor($0703)
Else If AmDefault
Then CButton := GetColor($0602);
End;
T := Size.Y div 2-1;
CShadow := GetColor(8);
Szer := Size.X-1;
If Down Then Przes := 1 Else Przes := 0;
LiczTydli := Length(S) - CStrLen(S);
While Y < (Size.Y-1)
Do Begin
MoveChar(B,' ',Byte(CButton),Size.X);
If P <= L Then
Begin
If S[P] = #13 Then
Begin
Center := True;
Inc(P);
End;
I := P;
Repeat
J := P;
While (P <= L) And (S[P] = ' ')
Do Inc(P);
While (P <= L) And (S[P] <> ' ') And (S[P] <> #13)
Do Inc(P);
Until (P > L) Or (P >= I+Size.X-4+LiczTydli) Or (S[P] = #13);
If P > I + Size.X-4 + LiczTydli
Then If J > I Then P := J
Else P := I + Size.X-4 + LiczTydli;
If Center Then
Begin
PomocStr := Copy(S,I,P-I);
J := (Size.X - CStrLen(PomocStr)) Div 2;
If J < 2 Then J := 2;
End Else J := 2;
PomocStr := Copy(S,I,P-I);
MoveCStr(B[J+Przes],PomocStr,CButton);
While (P <= L) And (S[P] = ' ')
Do Inc(P);
If (P <= L) And (S[P] = #13)
Then Begin
Center := False;
Inc(P);
If (P <= L) And (S[P] = #10)
Then Inc(P);
End;
End;
WordRec(B[0]).Hi := CShadow;
If Down Then
Begin
WordRec(B[1]).Hi := CShadow;
Ch := ' ';
End Else
Begin
WordRec(B[Szer]).Hi := Byte(CShadow);
If (ShowMarkers Or (Flags and bfShadow = 0)) Then Ch := ' '
Else Begin
If Y = 0 {'_'}
Then WordRec(B[Szer]).Lo := Byte(#220)
Else WordRec(B[Szer]).Lo := Byte(#219);
Ch := #223; {'_'}
End;
End;
If (Y = T) Then SrodkowaLinia;
If ShowMarkers And Not Down
Then Begin
WordRec(B[1]).Lo := Byte('[');
WordRec(B[Szer-1]).Lo := Byte(']');
End;
WriteLine(0,Y,Size.X,1,B);
Inc(Y);
End;
MoveChar(B[0],' ',Byte(CShadow),2);
MoveChar(B[2],Ch,Byte(CShadow),Szer-1);
WriteLine(0,Size.Y-1,Size.X,1,B);
End;
Function tShadeButton.GetPalette: pPalette;
Const P: String[Length(CButton)] = CButton;
Begin
GetPalette := @P;
End;
Procedure tShadeButton.Press;
Var E : tEvent;
Begin
Message(Owner, evBroadCast, cmRecordHistory, Nil);
If Flags And bfBroadcast <> 0
Then Message(Owner, evBroadcast, Command, @Self)
Else Begin
E.What := evCommand;
E.Command := Command;
E.InfoPtr := @Self;
PutEvent(E);
End;
End;
Procedure tShadeButton.HandleEvent(Var Event: tEvent);
Var Down : Boolean;
C : Char;
Mouse : tPoint;
ClickRect: tRect;
Begin
GetExtent(ClickRect);
Inc(ClickRect.A.X);
Dec(ClickRect.B.X);
Dec(ClickRect.B.Y);
If Event.What = evMouseDown
Then Begin
MakeLocal(Event.Where,Mouse);
If Not ClickRect.Contains(Mouse)
Then ClearEvent(Event);
End;
If Flags And bfGrabFocus <> 0
Then tView.HandleEvent(Event);
Case Event.What Of
evMouseDown : Begin
If State And sfDisabled = 0
Then Begin
Inc (ClickRect.B.X);
Down := False;
Repeat
MakeLocal(Event.Where, Mouse);
If Down <> ClickRect.Contains(Mouse)
Then Begin
Down := Not Down;
DrawState(Down);
End;
Until Not MouseEvent(Event,evMouseMove);
If Down Then
Begin
Press;
DrawState(False);
End;
End;
ClearEvent(Event);
End;
evKeyDown : Begin
C := HotKey(Title^);
If (Event.KeyCode = GetAltCode(C)) Or
(Owner^.Phase = phPostProcess) And
(C <> #0) And (UpCase(Event.CharCode) = C) Or
(State and sfFocused <> 0) And (Event.CharCode = ' ')
Then Begin
Press;
ClearEvent(Event);
End;
End;
evBroadCast : {}
Case Event.Command Of
cmDefault : {}
If AmDefault Then
Begin
Press;
ClearEvent(Event);
End;
{}
cmGrabDefault, cmReleaseDefault : {}
If Flags And bfDefault <> 0
Then Begin
AmDefault := Event.Command = cmReleaseDefault;
DrawView;
End;
{}
cmCommandSetChanged : Begin
SetState(sfDisabled, Not CommandEnabled(Command));
DrawView;
End;
End;
{}
End;
End;
Procedure tShadeButton.MakeDefault(Enable: Boolean);
Var C : Word;
Begin
If Flags And bfDefault = 0 Then
Begin
If Enable Then C := cmGrabDefault
Else C := cmReleaseDefault;
Message(Owner, evBroadCast, C, @Self);
AmDefault := Enable;
DrawView;
end;
End;
Procedure tShadeButton.SetState(aState: Word; Enable: Boolean);
Begin
tView.SetState(aState, Enable);
If aState And (sfSelected + sfActive) <> 0
Then DrawView;
If aState And sfFocused <> 0
Then MakeDefault(Enable);
End;
Procedure tShadeButton.Store(Var S: tStream);
Begin
tView.Store(S);
S.WriteStr(Title);
S.Write(Command, SizeOf(Word) + SizeOf(Byte) + SizeOf(Boolean));
End;
Destructor tShadeButton.Done;
Begin
DisposeStr(Title);
tView.Done;
End;
End.
Wydruk 2
{
Program : Demostracja przycisku TShadeButton
Autor : Jarosław Chochowski, Lublin 1994/08/28
}
Program Synchr; Uses Objects, Drivers, Memory, HistList, Views, Menus,
Dialogs, App, Button;
Const cmDemo = 101;
cmKomenda = 102;
Type pMyApp = ^tMyApp;
tMyApp = Object(tApplication)
Procedure InitMenuBar; Virtual;
Procedure HandleEvent(Var Event: tEvent); Virtual;
End;
Function MakeDialog: pDialog;
Var Dlg : pDialog;
R : tRect;
Control : pView;
Begin
R.Assign(11,2,50,19);
New(Dlg,Init(R,'Demo'));
Dlg^.Options := Dlg^.Options Or ofCenterX Or ofCenterY;
R.Assign(4,2,35,4);
Control := New(pButton,Init(R,'Zwykły Przycisk', cmKomenda,
bfNormal + bfGrabFocus));
Dlg^.Insert(Control);
R.Assign(4,7,35,11);
Control := New(pShadeButton,Init(R,'Przycisk '^M+'Wielowierszowy'^M+
'tShadeButton', cmKomenda, bfNormal + bfGrabFocus));
Dlg^.Insert(Control);
R.Assign(4,12,35,16);
Control := New(pShadeButton,Init(R,#3+'Przycisk Wielowierszowy'^M+
+#3+'tShadeButton z centrowanym'^M++#3+'tekstem i bez cienia',
cmKomenda, bfNormal + bfGrabFocus));
pShadeButton(Control)^.Flags := pShadeButton(Control)^.Flags and
not bfShadow;
Dlg^.Insert(Control);
Dlg^.SelectNext(False);
MakeDialog := Dlg;
End;
Procedure tMyApp.HandleEvent(Var Event: tEvent);
Var R : tRect;
DemoDlg : pDialog;
A : Word;
S : String;
Begin
Inherited HandleEvent(Event);
Case Event.What Of
evCommand : Begin
Case Event.Command Of
cmDemo : Begin
DemoDlg := MakeDialog;
ExecuteDialog(DemoDlg, Nil);
End;
Else Exit;
End;
ClearEvent(Event);
End;
End;
End;
Procedure tMyApp.InitMenuBar;
Var R : tRect;
Begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(pMenuBar, Init(R,NewMenu(
NewItem('Demo...','',kbNoKey,cmDemo,hcNoContext,Nil)))
);
End;
Var MyApp : tMyApp;
Begin
MyApp.Init;
MyApp.Run;
MyApp.Done;
End.
Jarosław Chochowski - PC Kurier 01/1996r.