Module

mTemplateFieldButton

Path

C:\CPRS\CPRS30\Templates\mTemplateFieldButton.pas

Last Modified

7/15/2014 3:26:44 PM

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfraTemplateFieldButton);

end.

Units Used in Interface

Name Comments
uDlgComponents -

Classes

Name Comments
TfraTemplateFieldButton -
TWinControlFriend -

Procedures

Name Owner Declaration Scope Comments
ButtonKeyDown TfraTemplateFieldButton procedure ButtonKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Private -
ButtonKeyUp TfraTemplateFieldButton procedure ButtonKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Private -
FrameEnter TfraTemplateFieldButton procedure FrameEnter(Sender: TObject); Public/Published -
FrameExit TfraTemplateFieldButton procedure FrameExit(Sender: TObject); Public/Published -
pbFocusPaint TfraTemplateFieldButton procedure pbFocusPaint(Sender: TObject); Public/Published -
pnlBtnMouseDown TfraTemplateFieldButton procedure pnlBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
pnlBtnMouseUp TfraTemplateFieldButton procedure pnlBtnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
SetButtonText TfraTemplateFieldButton procedure SetButtonText(const Value: string); Private -

Functions

Name Owner Declaration Scope Comments
GetButtonText TfraTemplateFieldButton function GetButtonText: string; Private -


Module Source

1     unit mTemplateFieldButton;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ExtCtrls, uDlgComponents, VA508AccessibilityManager;
8     
9     type
10      TfraTemplateFieldButton = class(TFrame, ICPRSDialogComponent)
11        pnlBtn: TPanel;
12        lblText: TLabel;
13        pbFocus: TPaintBox;
14        procedure pnlBtnMouseDown(Sender: TObject; Button: TMouseButton;
15          Shift: TShiftState; X, Y: Integer);
16        procedure pnlBtnMouseUp(Sender: TObject; Button: TMouseButton;
17          Shift: TShiftState; X, Y: Integer);
18        procedure FrameEnter(Sender: TObject);
19        procedure FrameExit(Sender: TObject);
20        procedure pbFocusPaint(Sender: TObject);
21      private
22        FCPRSDialogData: ICPRSDialogComponent;
23        FBtnDown: boolean;
24        FItems: TStringList;
25        FOnChange: TNotifyEvent;
26        procedure ButtonKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
27        procedure ButtonKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
28        function GetButtonText: string;
29        procedure SetButtonText(const Value: string);
30      public
31        constructor Create(AOwner: TComponent); override;
32        destructor Destroy; override;
33        property ButtonText: string read GetButtonText write SetButtonText;
34        property Items: TStringList read FItems;
35        property OnChange: TNotifyEvent read FOnChange write FOnChange;
36        property CPRSDialogData: ICPRSDialogComponent read FCPRSDialogData implements ICPRSDialogComponent;
37      end;
38    
39    implementation
40    
41    {$R *.DFM}
42    
43    uses
44      ORFn, VA508AccessibilityRouter;
45    
46    procedure TfraTemplateFieldButton.pnlBtnMouseDown(Sender: TObject; Button: TMouseButton;
47      Shift: TShiftState; X, Y: Integer);
48    var
49      txt: string;
50      i, idx: integer;
51    
52    begin
53      if(not FBtnDown) then
54      begin
55        FBtnDown := TRUE;
56        pnlBtn.BevelOuter := bvLowered;
57        if(FItems.Count > 0) then
58        begin
59          txt := ButtonText;
60          idx := FItems.Count-1;
61          for i := 0 to FItems.Count-1 do
62          begin
63            if(txt = FItems[i]) then
64            begin
65              idx := i;
66              break;
67            end;
68          end;
69          inc(idx);
70          if(idx >= FItems.Count) then
71            idx := 0;
72          ButtonText := FItems[idx];
73          if ScreenReaderSystemActive then
74          begin
75            txt := FItems[idx];
76            if Trim(txt) = '' then
77              txt := 'blank';
78            GetScreenReader.Speak(txt);
79          end;
80          if assigned(FOnChange) then
81            FOnChange(Self);
82        end;
83        SetFocus;
84      end;
85    end;
86    
87    procedure TfraTemplateFieldButton.pnlBtnMouseUp(Sender: TObject; Button: TMouseButton;
88      Shift: TShiftState; X, Y: Integer);
89    begin
90      if(FBtnDown) then
91      begin
92        FBtnDown := FALSE;
93        pnlBtn.BevelOuter := bvRaised;
94      end;
95    end;
96    
97    type
98      TWinControlFriend = class(TWinControl);
99      
100   procedure TfraTemplateFieldButton.FrameEnter(Sender: TObject);
101   begin
102     pbFocus.Invalidate;
103   end;
104   
105   procedure TfraTemplateFieldButton.FrameExit(Sender: TObject);
106   begin
107     pbFocus.Invalidate;
108   end;
109   
110   constructor TfraTemplateFieldButton.Create(AOwner: TComponent);
111   begin
112     inherited Create(AOwner);
113     TabStop := TRUE;
114     FItems := TStringList.Create;
115     OnKeyDown := ButtonKeyDown;
116     OnKeyUp := ButtonKeyUp;
117     Font.Size := MainFontSize;
118     FCPRSDialogData := TCPRSDialogComponent.Create(Self, 'multi value button');
119   end;
120   
121   procedure TfraTemplateFieldButton.ButtonKeyDown(Sender: TObject; var Key: Word;
122     Shift: TShiftState);
123   begin
124     if Key = VK_SPACE then
125       pnlBtnMouseDown(Sender, mbLeft, [], 0, 0);
126   end;
127   
128   procedure TfraTemplateFieldButton.ButtonKeyUp(Sender: TObject; var Key: Word;
129     Shift: TShiftState);
130   begin
131     pnlBtnMouseUp(Sender, mbLeft, [], 0, 0);
132   end;
133   
134   function TfraTemplateFieldButton.GetButtonText: string;
135   begin
136     Result := lblText.Caption;
137   end;
138   
139   procedure TfraTemplateFieldButton.SetButtonText(const Value: string);
140   begin
141     lblText.Caption := Value;
142   end;
143   
144   procedure TfraTemplateFieldButton.pbFocusPaint(Sender: TObject);
145   var
146     R: TRect;
147   begin
148     if(Focused) then
149     begin
150       R := Rect(1, 0, pnlBtn.Width - 3, pnlBtn.Height-2);
151       pbFocus.Canvas.DrawFocusRect(R);
152     end;
153   end;
154   
155   destructor TfraTemplateFieldButton.Destroy;
156   begin
157     FItems.Free;
158     FCPRSDialogData := nil;
159     inherited;
160   end;
161   
162   initialization
163     SpecifyFormIsNotADialog(TfraTemplateFieldButton);
164   
165   end.

Module Calls (2 levels)


mTemplateFieldButton
 └uDlgComponents
   └uCore

Module Called-By (2 levels)


     mTemplateFieldButton
        uTemplateFields┤ 
              uOrders┤ │ 
              dShared┤ │ 
           uTemplates┤ │ 
      fTemplateDialog┤ │ 
           uReminders┤ │ 
      fReminderDialog┤ │ 
 fTemplateFieldEditor┤ │ 
      fTemplateFields┤ │ 
              fODAuto┘ │ 
uVA508CPRSCompatibility┘ 
               fFrame┤   
             fDrawers┤   
               fNotes┤   
            fConsults┤   
              fDCSumm┤   
   fReminderDialog...┤   
           fODConsult┤   
              fODProc┘