Ignore:
Timestamp:
May 7, 2015, 12:34:29 PM (10 years ago)
Author:
healthsevak
Message:

Updating the working copy to CPRS version 28

File:
1 edited

Legend:

Unmodified
Added
Removed

  • cprs/trunk/CPRS-Chart/Orders/fOCSession.pas

    r829 r1679  
    44
    55uses
    6   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    7   fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls, VA508AccessibilityManager;
     6  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fOCMonograph,
     7  fAutoSz, StdCtrls, ORFn, uConst, ORCtrls, ExtCtrls, VA508AccessibilityManager,
     8  Grids, strUtils, uDlgComponents, VAUtils, VA508AccessibilityRouter;
    89
    910type
    1011  TfrmOCSession = class(TfrmAutoSz)
    11     lstChecks: TCaptionListBox;
    1212    pnlBottom: TPanel;
    1313    lblJustify: TLabel;
    … …  
    1717    btnReturn: TButton;
    1818    memNote: TMemo;
     19    cmdMonograph: TButton;
     20    grdchecks: TCaptionStringGrid;
     21    lblInstr: TVA508StaticText;
     22    pnlTop: TORAutoPanel;
     23    lblHover: TLabel;
    1924    procedure cmdCancelOrderClick(Sender: TObject);
    2025    procedure cmdContinueClick(Sender: TObject);
    21     procedure lstChecksMeasureItem(Control: TWinControl; Index: Integer;
    22       var Height: Integer);
    23     procedure lstChecksDrawItem(Control: TWinControl; Index: Integer;
    24       Rect: TRect; State: TOwnerDrawState);
    2526    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    2627    procedure FormShow(Sender: TObject);
    … …  
    3031    procedure btnReturnClick(Sender: TObject);
    3132    procedure memNoteEnter(Sender: TObject);
     33    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
     34    procedure cmdMonographClick(Sender: TObject);
     35    procedure grdchecksDrawCell(Sender: TObject; ACol, ARow: Integer;
     36      Rect: TRect; State: TGridDrawState);
     37    function CheckBoxRect(poRect: TRect): TRect;
     38    function GetCheckState(grid: TStringGrid; ACol, ARow: integer): boolean;
     39    function InCheckBox(Grid: TStringGrid; X, Y, ACol, ARow: integer): boolean;
     40    procedure SetCheckState(grid: TStringGrid; ACol, ARow: integer; State: boolean);
     41    procedure grdchecksMouseDown(Sender: TObject; Button: TMouseButton;
     42      Shift: TShiftState; X, Y: Integer);
     43    procedure grdchecksSelectCell(Sender: TObject; ACol, ARow: Integer;
     44      var CanSelect: Boolean);
     45    procedure GridDeleteRow(RowNumber: Integer; Grid: TstringGrid);
     46    procedure grdchecksEnter(Sender: TObject);
     47    procedure FormCreate(Sender: TObject);
     48    procedure grdchecksKeyDown(Sender: TObject; var Key: Word;
     49      Shift: TShiftState);
     50    procedure grdchecksMouseWheelDown(Sender: TObject; Shift: TShiftState;
     51      MousePos: TPoint; var Handled: Boolean);
     52    procedure grdchecksMouseWheelUp(Sender: TObject; Shift: TShiftState;
     53      MousePos: TPoint; var Handled: Boolean);
     54    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
     55      MousePos: TPoint; var Handled: Boolean);
     56    procedure grdchecksMouseMove(Sender: TObject; Shift: TShiftState; X,
     57      Y: Integer);
     58   // procedure memNoteSetText(str: string);
    3259  private
    3360    FCritical: Boolean;
    … …  
    112139function ExecuteSessionOrderChecks(OrderList: TStringList) : Boolean;
    113140var
    114   i, j: Integer;
    115   LastID, NewID: string;
    116   CheckList: TStringList;
     141  i, j, k, l, m, rowcnt: Integer;
     142  LastID, NewID, gridtext: string;
     143  CheckList,remOC: TStringList;
    117144  OCRec: TOCRec;
    118   //AChangeItem: TChangeItem;
    119145  frmOCSession: TfrmOCSession;
    120   x: string;
     146  x,substring: string;
    121147begin
    122148  Result := True;
    … …  
    129155    begin
    130156      frmOCSession := TfrmOCSession.Create(Application);
     157      //frmOCSession.grdchecks.RowCount := frmOCSession.grdchecks.RowCount + 1; *)
     158      //rowcnt := frmOCSession.grdchecks.RowCount;
     159      //if RowCnt > frmOCSession.grdchecks.RowCount then frmOCSession.grdchecks.RowCount := RowCnt;
     160      rowcnt := 1;
     161      frmOCSession.grdchecks.canvas.Font.Name := 'Courier New';
     162      frmOCSession.grdchecks.Canvas.Font.Size := MainFontSize;
     163      frmOCSession.cmdMonograph.Enabled := false;
     164      if IsMonograph then frmOCSession.cmdMonograph.Enabled := true;
    131165      try
    132166        ResizeFormToFont(TForm(frmOCSession));
    … …  
    148182          x := TextForOrder(OCRec.OrderID);
    149183          OCRec.OrderText := x;
     184          frmOCSession.grdchecks.Cells[2,rowcnt] := OCRec.OrderID + '^O^0^';
     185          frmOCSession.grdchecks.Cells[1,rowcnt] := OCRec.OrderText;
     186          RowCnt := RowCnt + 1;
     187          if RowCnt > frmOCSession.grdchecks.RowCount then frmOCSession.grdchecks.RowCount := RowCnt;
     188          l := 0;
     189          m := 0;
     190          for j := 0 to CheckList.Count - 1 do
     191            if Piece(CheckList[j], U, 1) = OCRec.OrderID then m := m+1;
     192
    150193          for j := 0 to CheckList.Count - 1 do
    151194            if Piece(CheckList[j], U, 1) = OCRec.OrderID then
    152195            begin
    153               OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 4));
    154               x := x + CRLF + Piece(CheckList[j], U, 4);
     196              l := l+1;
     197              gridText := '';
     198              substring := Copy(Piece(CheckList[j], U, 4),0,2);
     199              if substring='||' then
     200              begin
     201                remOC := TStringList.Create;
     202                substring := Copy(Piece(CheckList[j], U, 4),3,Length(Piece(CheckList[j], U, 4)));
     203                GetXtraTxt(remOC,Piece(substring,'&',1),Piece(substring,'&',2));
     204                for k := 0 to remOC.Count - 1 do
     205                begin
     206                  //add each line to x and OCRec.Checks
     207                  if k=remOC.Count-1 then
     208                  begin
     209                    OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 3)+'^'+'      '+RemOC[k]);
     210                    x := x + CRLF + RemOC[k];
     211                    if gridText = '' then gridText := RemOC[k]
     212                    else gridText := gridText + CRLF + '      ' +RemOC[k];
     213                  end
     214                  else if k=0 then
     215                  begin
     216                    OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 3)+'^'+RemOC[k]);
     217                    x := x + CRLF + '('+inttostr(l)+' of '+inttostr(m)+')  ' + RemOC[k];
     218                    if gridText = '' then gridText := '('+inttostr(l)+' of '+inttostr(m)+')  ' + RemOC[k]
     219                    else gridText := gridText + CRLF + RemOC[k];
     220                  end
     221                  else
     222                  begin
     223                    OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 3)+'^'+'      '+RemOC[k]);
     224                    x := x + CRLF + RemOC[k];
     225                    if gridText = '' then gridText := RemOC[k]
     226                    else gridText := gridText + CRLF + '      ' + RemOC[k];
     227                  end;
     228                end;
     229                x := x + CRLF + '        ';
     230                    if gridText = '' then gridText := '      '
     231                    else gridText := gridText + CRLF + '      ';
     232                remOC.free;
     233              end
     234              else
     235              begin
     236                OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 4));
     237                x := x + CRLF + '('+inttostr(l)+' of '+inttostr(m)+')  ' + Piece(CheckList[j], U, 4);
     238                gridText := '('+inttostr(l)+' of '+inttostr(m)+')  ' + Piece(CheckList[j], U, 4);
     239              end;
     240             if (Piece(CheckList[j], U, 3) = '1') then frmOCSession.grdchecks.Cells[1,rowcnt] := '*Order Check requires Reason for Override' + CRLF +  gridText
     241             else frmOCSession.grdchecks.Cells[1,rowcnt] := gridText;
     242              frmOCSession.grdchecks.Cells[2,rowcnt] := OCRec.OrderID + '^I^'+Piece(CheckList[j], U, 3);
     243              //frmOCSession.grdchecks.Objects[2, rowcnt] := OCRec;
     244              rowcnt := rowcnt +1;
     245              if RowCnt > frmOCSession.grdchecks.RowCount then frmOCSession.grdchecks.RowCount := RowCnt;
    155246            end;
    156           //AChangeItem := Changes.Locate(CH_ORD, OCRec.OrderID);
    157           //if AChangeItem <> nil then OCRec.OrderText := AChangeItem.Text;
    158           frmOCSession.lstChecks.Items.Add(x);
    159247        end; {with...for i}
    160248        frmOCSession.FOrderList := OrderList;
    … …  
    170258            frmFrame.SetActiveTab(CT_ORDERS);
    171259        end;
     260          if ScreenReaderActive = True then
     261            begin
     262              frmOCSession.lblInstr.TabStop := true;
     263              frmOCSession.memNote.TabStop := true;
     264              frmOCSession.memNote.TabOrder := 2;
     265            end
     266          else
     267          begin
     268            frmOCSession.lblInstr.TabStop := false;
     269            frmOCSession.memNote.TabStop := false;
     270          end;
    172271      finally
    173272        with uCheckedOrders do for i := 0 to Count - 1 do TOCRec(Items[i]).Free;
    … …  
    178277    CheckList.Free;
    179278  end;
     279end;
     280
     281
     282procedure TfrmOCSession.SetCheckState(grid: TStringGrid; ACol, ARow: integer;
     283  State: boolean);
     284var
     285  temp: string;
     286begin
     287  temp := grid.Cells[2, ARow];
     288  if State = True then SetPiece(temp, U, 3, '1')
     289  else SetPiece(temp, U, 3, '0');
     290  grid.Cells[2, ARow] := temp;
     291  grid.Repaint;
    180292end;
    181293
    … …  
    195307  txtJustify.Visible := FCritical;
    196308  memNote.Visible := FCritical;
    197 
    198 end;
    199 
    200 procedure TfrmOCSession.lstChecksMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
    201 var
    202   i, AHt, TotalHt: Integer;
    203   x: string;
    204   ARect: TRect;
    205   OCRec: TOCRec;
    206 begin
    207   inherited;
    208 
    209   with lstChecks do
    210      begin
    211        if Index >= uCheckedOrders.Count then Exit;
    212        OCRec := TOCRec(uCheckedOrders.Items[Index]);
    213        ARect := ItemRect(Index);
    214        ARect.Left := ARect.Left + 2;
    215        AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect, DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING) + 2; //CQ7178: added DT_EXTERNALLEADING
    216        TotalHt := AHt;
    217 
    218        for i := 0 to OCRec.Checks.Count - 1 do
     309end;
     310
     311function TfrmOCSession.CheckBoxRect(poRect: TRect): TRect;
     312const ciCheckBoxDim = 20;
     313begin
     314  with poRect do begin
     315    Result.Top := Top + FontHeightPixel(Font.Handle);
     316    Result.Left   := Left - (ciCheckBoxDim div 2) + (Right - Left) div 2;
     317    Result.Right  := Result.Left + ciCheckBoxDim;
     318    Result.Bottom := Result.Top + ciCheckBoxDim;
     319  end
     320end;
     321
     322procedure TfrmOCSession.cmdCancelOrderClick(Sender: TObject);
     323var
     324  cnt, i, j, already: Integer;
     325  AnOrderID: string;
     326  DeleteOrderList, DeleteRowList: TstringList;
     327  StillCritical: boolean;
     328begin
     329  inherited;
     330  DeleteOrderList := TStringList.Create;
     331  DeleteRowList := TStringList.Create;
     332  for I := 0 to grdChecks.RowCount do
     333    if (Piece(grdChecks.Cells[2, i], U, 3) = '1') and (Piece(grdChecks.Cells[2, i], U, 2) = 'O') then
     334      begin
     335        AnOrderID := Piece(grdChecks.Cells[2, i], U, 1);
     336        already := DeleteOrderList.IndexOf(AnOrderID);
     337        if (already>=0) or (DeleteCheckedOrder(AnOrderID)) then
    219338          begin
    220             ARect := ItemRect(Index);
    221             ARect.Left := ARect.Left + 10;
    222             x := Piece(OCRec.Checks[i], U, 3);
    223             AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING); //CQ7178: added DT_EXTERNALLEADING
    224             TotalHt := TotalHt + AHt;
     339             for j := FCheckList.Count - 1 downto 0 do
     340             if Piece(FCheckList[j], U, 1) = AnOrderID then FCheckList.Delete(j);
     341             DeleteOrderList.Add(AnOrderId);
     342             for j := FOrderList.Count - 1 downto 0 do
     343             if Piece(FOrderList[j], U, 1) = AnOrderID then FOrderList.Delete(j);
     344             for j := uCheckedOrders.Count - 1 downto 0 do
     345               if TOCRec(uCheckedOrders.Items[j]).OrderID = AnOrderId then
     346
    225347          end;
    226      end;
    227   Height := TotalHt + 2; // add 2 for focus rectangle
    228   if Height > 255 then Height := 255; //CQ7178
    229 end;
    230 
    231 procedure TfrmOCSession.lstChecksDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    232 var
    233   i, AHt: Integer;
    234   x: string;
    235   ARect: TRect;
    236   OCRec: TOCRec;
    237 begin
    238   inherited;
    239 
    240   with lstChecks do
    241      begin
    242        if Index >= uCheckedOrders.Count then Exit;
    243        OCRec := TOCRec(uCheckedOrders.Items[Index]);
    244        ARect := ItemRect(Index);
    245        AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING) + 2; //CQ7178: added DT_EXTERNALLEADING
    246        ARect.Left := ARect.Left + 10;
    247        ARect.Top  := ARect.Top + AHt;
    248        for i := 0 to OCRec.Checks.Count - 1 do
     348      end;
     349    if DeleteOrderList.Count = 0 then
     350      begin
     351        infoBox('No orders are marked to cancel. Check the Cancel box by the orders to cancel. ', 'Error', MB_OK);
     352      end;
     353
     354    for i := 0 to DeleteOrderList.Count - 1 do
     355      begin
     356        AnOrderId := DeleteORderList.Strings[i];
     357        for j := 0 to grdChecks.RowCount do
     358          if Piece(grdChecks.Cells[2, j], u, 1) = AnOrderId then
     359            begin
     360              //grdChecks.Rows[j].Clear;
     361              DeleteRowList.Add(InttoStr(j));
     362            end;
     363      end;
     364    if (grdChecks.RowCount - 1) = DeleteRowList.Count then Close;
     365    cnt := 0;
     366    for i := 0 to DeleteRowList.Count - 1 do
     367      begin
     368        GridDeleteRow(((StrtoInt(DeleteRowList.Strings[i])) - cnt), grdChecks);
     369        cnt := cnt +1;
     370      end;
     371    //check if the remaining order checks are not high level and thus don't require justification
     372    if FCritical then
     373    begin
     374      StillCritical := false;
     375      for I := 0 to grdChecks.RowCount do
     376      begin
     377        if ((Piece(grdChecks.cells[2,I],U,3) = '1') and not(Piece(grdChecks.Cells[2, i], U, 2) = 'O')) then
    249378          begin
    250             x := Piece(OCRec.Checks[i], U, 3);
    251             if not (odSelected in State) then
    252                begin
    253                  if (Piece(OCRec.Checks[i], U, 2) = '1') then
    254                    begin
    255                      Canvas.Font.Color := Get508CompliantColor(clBlue);
    256                      Canvas.Font.Style := [fsUnderline];
    257                    end
    258                  else Canvas.Font.Color := clWindowText;
    259                end;
    260             AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DT_EXTERNALLEADING); //CQ7178: added DT_EXTERNALLEADING
    261             ARect.Top  := ARect.Top + AHt;
    262         end;
    263      end;
    264 
    265 end;
    266 
    267 procedure TfrmOCSession.cmdCancelOrderClick(Sender: TObject);
    268 var
    269   i, j: Integer;
    270   AnOrderID: string;
    271   OCRec: TOCRec;
    272 begin
    273   inherited;
    274   for i := lstChecks.Items.Count - 1 downto 0 do if lstChecks.Selected[i] then
    275   begin
    276     OCRec := TOCRec(uCheckedOrders.Items[i]);
    277     AnOrderID := OCRec.OrderID;
    278     if DeleteCheckedOrder(AnOrderID) then
    279     begin
    280       for j := FCheckList.Count - 1 downto 0 do
    281         if Piece(FCheckList[j], U, 1) = AnOrderID then FCheckList.Delete(j);
    282       for j := FOrderList.Count - 1 downto 0 do
    283         if Piece(FOrderList[j], U, 1) = AnOrderID then FOrderList.Delete(j);
    284       OCRec.Free;
    285       uCheckedOrders.Delete(i);
    286       lstChecks.Items.Delete(i);
     379            StillCritical := true;
     380            break;
     381          end;
     382      end;
     383      if StillCritical = false then
     384      begin
     385        FCritical := false;
     386        lblJustify.Visible := FCritical;
     387        txtJustify.Visible := FCritical;
     388        memNote.Visible := FCritical;
     389      end;
    287390    end;
    288   end;
    289   if uCheckedOrders.Count = 0 then Close;
     391    grdChecks.Repaint;
    290392end;
    291393
    292394procedure TfrmOCSession.cmdContinueClick(Sender: TObject);
    293 begin
    294   inherited;
     395var
     396i: integer;
     397Cancel: boolean;
     398begin
     399  inherited;
     400  Cancel := False;
    295401  if FCritical and ((Length(txtJustify.Text) < 2) or not ContainsVisibleChar(txtJustify.Text)) then
    296402  begin
    … …  
    299405    Exit;
    300406  end;
     407   
     408  if FCritical and (ContainsUpCarretChar(txtJustify.Text)) then
     409  begin
     410     InfoBox('The justification may not contain the ^ character.',
     411            'Justification Required', MB_OK);
     412    Exit;
     413  end;
     414
     415  for i := 0 to grdChecks.RowCount do
     416     if (Piece(grdChecks.Cells[2, i], U, 3) = '1') and (Piece(grdChecks.Cells[2, i], U, 2) = 'O') then
     417       begin
     418         Cancel := True;
     419         Break;
     420       end;
     421  if Cancel = True then
     422    begin
     423      InfoBox('One or more orders have been marked to cancel!' + CRLF + CRLF +
     424        'To cancel these orders, click the "Cancel Checked Order(s)" button.' + CRLF + CRLF +
     425        'To place these orders, uncheck the Cancel box beside the order you wish to keep and then click the "Accept Order(s)" button again.',
     426        'Error', MB_OK);
     427      Exit;
     428    end;
     429
    301430  StatusText('Saving Order Checks...');
    302431  SaveOrderChecksForSession(txtJustify.Text, FCheckList);
    … …  
    305434end;
    306435
     436procedure TfrmOCSession.cmdMonographClick(Sender: TObject);
     437var
     438  monoList: TStringList;
     439begin
     440  inherited;
     441  monoList := TStringList.Create;
     442  GetMonographList(monoList);
     443  ShowMonographs(monoList);
     444  monoList.Free;
     445end;
     446
     447
    307448procedure TfrmOCSession.FormClose(Sender: TObject;
    308449  var Action: TCloseAction);
    … …  
    310451  inherited;
    311452  SaveUserBounds(Self); //Save Position & Size of Form
     453  DeleteMonograph;
     454end;
     455
     456procedure TfrmOCSession.FormCreate(Sender: TObject);
     457begin
     458  inherited;
     459   grdChecks.Cells[0, 0] := 'Cancel';
     460   grdChecks.Cells[1, 0] := 'Order/Order Check Text';
     461   //cmdMonograph.Font.Size := MainFontSize;
     462   //cmdMonograph.Width :=  TextWidthByFont(cmdMonograph.Font.Handle, cmdMonograph.Caption);
    312463end;
    313464
    314465procedure TfrmOCSession.FormShow(Sender: TObject);
     466
    315467begin
    316468  inherited;
    317469  SetFormPosition(Self); //Get Saved Position & Size of Form
    318470  FCancelSignProcess := False;
    319 end;
    320 
     471  if ScreenReaderActive = True then lblInstr.SetFocus
     472  else
     473    begin
     474      lblInstr.TabStop := false;
     475      grdChecks.SetFocus;
     476    end;
     477  self.lblInstr.Font.Size := mainFontSize + 1;
     478  //self.lblJustify.Height := self.lblJustify.Height + 20;
     479 (*if self.lblJustify.Visible = true then
     480     begin
     481       self.lblJustify.top := self.txtJustify.Top +  self.lblJustify.Height + 50;
     482     end; *)
     483
     484  //if mainFontSize < 12 then inc := 90
     485  //else if mainFontSize < 18 then inc := 130
     486  //else inc := 155;
     487  //self.constraints.MinWidth := self.lblInstr.Left +  TextWidthByFont(self.lblInstr.Font.Handle, self.lblInstr.Caption) + inc;
     488end;
     489
     490procedure TfrmOCSession.grdchecksDrawCell(Sender: TObject; ACol, ARow: Integer;
     491  Rect: TRect; State: TGridDrawState);
     492var
     493 Wrap: boolean;
     494 format, str, cdl, temp, colorText: string;
     495 IsBelowOrder, isSelected: boolean;
     496 chkRect, DrawRect, colorRect: TRect;
     497 ChkState: Cardinal;
     498begin
     499  inherited;
     500  temp := grdChecks.Cells[2, ARow];
     501  format := Piece(grdChecks.Cells[2, ARow], U, 2);
     502  cdl := Piece(grdChecks.Cells[2, ARow], U, 3);
     503  colorText := '*Order Check requires Reason for Override';
     504  grdChecks.Canvas.Brush.Color := Get508CompliantColor(clWhite);
     505  grdChecks.Canvas.Font.Color := Get508CompliantColor(clBlack);
     506  grdChecks.Canvas.Font.Style := [];
     507  isSelected := false;
     508
     509  if ARow = 0 then
     510    begin
     511      grdChecks.Canvas.Brush.Color := Get508CompliantColor(clbtnFace);
     512      grdChecks.Canvas.Font.Style := [fsBold];
     513    end;
     514
     515  //change commented out code to handle different font color this code may not be needed anymore
     516  if (format = '') and (ARow > 0) then
     517    grdchecks.Canvas.Font.Color := Get508CompliantColor(clBlue)
     518  else
     519    grdChecks.Canvas.Font.Color := Get508CompliantColor(clBlack);
     520  if cdl = '1' then grdChecks.Canvas.Font.Color := Get508CompliantColor(clBlue);
     521
     522  //controls highlighting cell when focused in on the cell
     523  if State = [gdSelected..gdFocused] then
     524    begin
     525      isSelected := true;  //use to control colors for high order checks
     526      grdChecks.Canvas.Font.Color := Get508CompliantColor(clWhite);
     527      grdChecks.Canvas.Brush.Color := clHighlight;
     528      grdChecks.Canvas.Font.Color := clHighlightText;
     529      grdChecks.Canvas.Font.Style := [fsBold];
     530      grdChecks.Canvas.MoveTo(Rect.Left,Rect.top);
     531    end
     532  //if not an order than blanked out lines seperating the order check
     533  else if (format = 'I') then
     534    begin
     535      if (Arow < grdChecks.RowCount) and (Piece(grdChecks.Cells[2, Arow + 1], U, 2) = 'O') then IsBelowOrder := True
     536      else IsBelowOrder := False;
     537      grdChecks.Canvas.MoveTo(Rect.Left,Rect.Bottom);
     538      grdChecks.Canvas.Pen.Color := Get508CompliantColor(clwhite);
     539      grdChecks.Canvas.LineTo(Rect.Left, Rect.Top);
     540      grdChecks.Canvas.LineTo(Rect.Right, Rect.Top);
     541      grdChecks.Canvas.LineTo(Rect.Right, Rect.Bottom);
     542     if (isBelowOrder = False) or (ARow = (grdChecks.RowCount -1)) then grdChecks.Canvas.LineTo(Rect.left, Rect.Bottom);
     543    end;
     544  Str:= grdChecks.Cells[ACol, ARow];
     545  //determine if the cell needs to wrap
     546  if ACol = 1 then Wrap := true
     547  else wrap := false;
     548  //Blank out existing Cell to prevent overlap after resize
     549  grdChecks.Canvas.FillRect(Rect);
     550  //get existing cell
     551  DrawRect:= Rect;
     552  if (ACol = 0) and (format = 'O') and (ARow > 0) then
     553     begin
     554        if Piece(grdChecks.Cells[2, ARow], U, 4) = '' then
     555          begin
     556            DrawRect.Bottom := DrawRect.Bottom + FontHeightPixel(Font.Handle) + 5;
     557            setPiece(temp, U, 4, 'R');
     558            grdChecks.Cells[2, ARow] := temp;
     559          end;
     560        if GetCheckState(grdChecks, ACol, ARow) = True then chkState := DFCS_CHECKED
     561        else chkState := DFCS_BUTTONCHECK;
     562        chkRect := CheckBoxRect(DrawRect);
     563        DrawFrameControl(grdChecks.Canvas.Handle, chkRect, DFC_BUTTON, chkState);
     564        DrawText(grdChecks.Canvas.Handle, PChar('Cancel?'), length('Cancel?'), DrawRect, DT_SINGLELINE or DT_Top or DT_Center);
     565        if ((DrawRect.Bottom - DrawRect.Top) > grdChecks.RowHeights[ARow]) or
     566            ((DrawRect.Bottom - DrawRect.Top) < grdChecks.RowHeights[ARow]) then
     567            begin
     568              grdChecks.RowHeights[ARow]:= (DrawRect.Bottom - DrawRect.Top);
     569            end;
     570     end;
     571  //If order check than indent the order check text
     572  if (ACol = 1) and (format = 'I') then DrawRect.Left := DrawRect.Left + 10;
     573  //colorRect use to create Rect for Order Check Label
     574  colorRect := DrawRect;
     575  if Wrap then
     576     begin
     577      if (cdl = '1') and (format = 'I') then
     578       begin
     579          if isSelected = false then
     580            begin
     581              grdChecks.Canvas.Font.Color := Get508CompliantColor(clRed);
     582              grdChecks.Canvas.Font.Style := [fsBold];
     583            end;
     584          //determine rect size for order check label
     585          DrawText(grdChecks.Canvas.Handle, PChar(colorText), length(colorText), colorRect, dt_calcrect or dt_wordbreak);
     586          DrawRect.Top := ColorRect.Bottom;
     587          //determine rect size for order check text
     588          DrawText(grdChecks.Canvas.Handle, PChar(str), length(str), DrawRect, dt_calcrect or dt_wordbreak);
     589          str := copy(str, length(colorText + CRLF) + 1, length(str));
     590          if isSelected = false then
     591            begin
     592              grdChecks.Canvas.Font.Color := Get508CompliantColor(clblue);
     593              grdChecks.Canvas.Font.Style := [];
     594            end;
     595       end
     596       //determine size for non-high order check text
     597       else DrawText(grdChecks.Canvas.Handle, PChar(str), length(str), DrawRect, dt_calcrect or dt_wordbreak);
     598       DrawRect.Bottom := DrawRect.Bottom + 2;
     599       //Resize the Cell height if the height does not match the Rect Height
     600       if ((DrawRect.Bottom - DrawRect.Top) > grdChecks.RowHeights[ARow]) then
     601          begin
     602            grdChecks.RowHeights[ARow]:= (DrawRect.Bottom - DrawRect.Top);
     603          end
     604       else
     605          begin
     606            //if cell doesn't need to grow reset the cell
     607            DrawRect.Right:= Rect.Right;
     608            if (cdl = '1') and (format = 'I') then
     609              begin
     610                //DrawRect.Top := ColorRect.Bottom;
     611                if isSelected = false then
     612                  begin
     613                    grdChecks.Canvas.Font.Color := Get508CompliantColor(clRed);
     614                    grdChecks.Canvas.Font.Style := [fsBold];
     615                  end;
     616                DrawText(grdChecks.Canvas.Handle, PChar(colorText), length(colorText), colorRect, dt_wordbreak);
     617                if isSelected = false then
     618                  begin
     619                    grdChecks.Canvas.Font.Color := Get508CompliantColor(clBlue);
     620                    grdChecks.Canvas.Font.Style := [];
     621                  end;
     622              end;
     623            DrawText(grdChecks.Canvas.Handle, PChar(Str), length(Str), DrawRect, dt_wordbreak);
     624            //reset height
     625            if format = 'I' then grdChecks.RowHeights[ARow]:= (DrawRect.Bottom - DrawRect.Top);
     626          end;
     627      end
     628  else
     629    //if not wrap than grow just draw the cell
     630    DrawText(grdChecks.Canvas.Handle, PChar(Str), length(Str), DrawRect, dt_wordbreak);
     631end;
     632
     633procedure TfrmOCSession.grdchecksEnter(Sender: TObject);
     634begin
     635  inherited;
     636  if ScreenReaderActive then
     637    begin
     638      grdChecks.Row := 1;
     639      grdChecks.Col := 0;
     640      GetScreenReader.Speak('Navigate through the grid to reviews the orders and the order checks');
     641      if GetCheckState(grdchecks, 0, 1) = true then
     642        GetScreenReader.Speak('Cancel checkbox is checked press spacebar to uncheck it')
     643      else GetScreenReader.Speak('Cancel checkbox Not Checked press spacebar to check it to cancel the ' + grdChecks.Cells[1,1] + ' Order');
     644    end;
     645  grdChecks.Row := 1;
     646  grdChecks.Col := 0;
     647end;
     648
     649procedure TfrmOCSession.grdchecksKeyDown(Sender: TObject; var Key: Word;
     650  Shift: TShiftState);
     651begin
     652  inherited;
     653     if key = VK_TAB then
     654      begin
     655       if ssCtrl        in Shift then
     656         begin
     657            if txtJustify.Visible = TRUE then  ActiveControl := txtJustify
     658            else ActiveControl := cmdContinue;
     659            Key := 0;
     660            Exit;
     661         end;
     662      end;
     663      if grdchecks.Col = 0 then
     664       begin
     665         Case Key of
     666            VK_Tab:
     667              begin
     668                if (ssShift in Shift) and (grdChecks.Row > 1) then
     669                     begin
     670                       grdChecks.Col := 1;
     671                       grdChecks.Row := grdChecks.Row - 1;
     672                     end;
     673                end;
     674           VK_Space:
     675             begin
     676               if Piece(grdChecks.Cells[2, grdChecks.Row], U, 2) = 'O' then
     677                 begin
     678                   if GetCheckState(grdChecks, 2, grdChecks.Row) = True then
     679                       SetCheckState(grdChecks, 2, grdChecks.Row, False)
     680                      else SetCheckState(grdChecks, 2, grdChecks.Row, True);
     681                   if ScreenReaderActive then
     682                     begin
     683                       if GetCheckState(grdchecks, 0, grdChecks.Row) = true then
     684                          GetScreenReader.Speak('Cancel checkbox checked')
     685                        else GetScreenReader.Speak('Cancel checkbox unChecked');
     686                     end;
     687                 end;
     688             end;
     689       (*    VK_Down:
     690              begin
     691                 if (grdChecks.Row < grdChecks.RowCount) and (Piece(grdChecks.Cells[2, grdChecks.Row + 1], U, 2) <> 'O') then
     692                   begin
     693                      for I := grdChecks.Row + 1 to grdChecks.RowCount do
     694                        begin
     695                          if (Piece(grdChecks.Cells[2, i], U, 2) <> 'O') or (grdChecks.Cells[2, i] = '') then continue
     696                          else
     697                            begin
     698                              grdChecks.Row := i;
     699                              exit;
     700                            end;
     701
     702                        end;
     703                   end;
     704              end;
     705           VK_Up:
     706             Begin
     707               if ((grdChecks.Row - 1) > 1) and (Piece(grdChecks.Cells[2, grdChecks.Row - 1], U, 2) <> 'O') then
     708                 begin
     709                   for i := grdChecks.Row - 1 downto 0 do
     710                     begin
     711                       if (Piece(grdChecks.Cells[2, i], U, 2) <> 'O') or (grdChecks.Cells[2, i] = '') then continue
     712                       else
     713                         begin
     714                           grdChecks.Row := i;
     715                           exit;
     716                         end;
     717                     end;
     718                 end;
     719             End; *)
     720         End;
     721       end;
     722    if grdChecks.Col = 1 then
     723       begin
     724       // needed to add control for tab key to handle the blank cells that should not have focus.
     725         if key = VK_Tab then
     726           begin
     727             if ssShift in Shift then
     728                begin
     729                  if Piece(grdChecks.Cells[2, grdChecks.Row], U, 2) = 'O' then grdChecks.Col := 0
     730                  else if grdChecks.Row > 1 then
     731                     begin
     732                       grdChecks.Col := 1;
     733                       grdChecks.Row := grdChecks.Row - 1;
     734                     end;
     735                 end
     736             else
     737               begin
     738                 if grdChecks.Row = (grdChecks.RowCount - 1) then
     739                   begin
     740                     if ScreenReaderActive = True then ActiveControl := memNote
     741                     else if txtJustify.Visible = TRUE then  ActiveControl := txtJustify
     742                     else ActiveControl := cmdContinue;
     743                     Key := 0;
     744                   end
     745                 else
     746                   begin
     747                     grdChecks.Row := grdChecks.Row + 1;
     748                     if Piece(grdChecks.Cells[2, grdChecks.Row], U, 2) = 'O' then grdChecks.Col := 0
     749                     else grdChecks.Col := 2;
     750                   end;
     751               end;
     752             Key := 0;
     753           end;
     754       end;
     755end;
     756
     757procedure TfrmOCSession.grdchecksMouseDown(Sender: TObject;
     758  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     759var
     760 Row, Col: integer;
     761begin
     762  inherited;
     763     grdChecks.MouseToCell(X, Y, Col, Row);
     764     if Col <> 0 then exit;
     765     if Piece(grdChecks.Cells[2,row], U, 2) <> 'O' then exit;
     766     if InCheckBox(grdChecks, X, Y, Col, Row) = false then exit;
     767     if GetCheckState(grdChecks, Col, Row) = True then SetCheckState(grdChecks, Col, Row, False)
     768     else SetCheckState(grdChecks, Col, Row, True);
     769end;
     770
     771
     772
     773procedure TfrmOCSession.grdchecksMouseMove(Sender: TObject; Shift: TShiftState;
     774  X, Y: Integer);
     775var
     776acol , arow: integer;
     777//P : Tpoint;
     778//Rect: TRect;
     779begin
     780//Rect :=  grdChecks.CellRect(ACol, ARow);
     781//P.X := Rect.Left;
     782//P.Y := Rect.Top;
     783
     784grdChecks.MouseToCell(X,y,acol , arow);
     785//check to see if hint should show
     786if ARow > grdChecks.RowCount then Exit;
     787if ACol <> 1 then exit;
     788if grdChecks.RowHeights[Arow] < grdChecks.Height then Exit;
     789
     790
     791
     792grdChecks.Hint := grdChecks.Cells[ACol, ARow];
     793Application.HintHidePause := 20000; //20 Sec
     794if grdChecks.Hint <> '' then grdCHecks.ShowHint := true;
     795
     796//Application.HintColor := clYellow;
     797//Application.ActivateHint(P);
     798
     799end;
     800
     801procedure TfrmOCSession.grdchecksMouseWheelDown(Sender: TObject;
     802  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
     803begin
     804  inherited;
     805(*  if grdChecks.Col = 0 then
     806    begin
     807      if (grdChecks.Row < grdChecks.RowCount) and (Piece(grdChecks.Cells[2, grdChecks.Row + 1], U, 2) <> 'O') then
     808        begin
     809          for I := grdChecks.Row + 1 to grdChecks.RowCount do
     810            begin
     811              if (Piece(grdChecks.Cells[2, i], U, 2) <> 'O') or (grdChecks.Cells[2, i] = '') then continue
     812              else
     813                begin
     814                  grdChecks.Row := i;
     815                  exit;
     816                end;
     817            end;
     818        end;
     819    end; *)
     820end;
     821
     822procedure TfrmOCSession.grdchecksMouseWheelUp(Sender: TObject;
     823  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
     824begin
     825  inherited;
     826 (* if grdChecks.Col = 0 then
     827    begin
     828      if ((grdChecks.Row - 1) > 1) and (Piece(grdChecks.Cells[2, grdChecks.Row - 1], U, 2) <> 'O') then
     829        begin
     830          for i := grdChecks.Row - 1 downto 0 do
     831            begin
     832              if (Piece(grdChecks.Cells[2, i], U, 2) <> 'O') or (grdChecks.Cells[2, i] = '') then continue
     833              else
     834                begin
     835                  grdChecks.Row := i;
     836                  exit;
     837                end;
     838            end;
     839        end;
     840    end;   *)
     841end;
     842
     843procedure TfrmOCSession.grdchecksSelectCell(Sender: TObject; ACol,
     844  ARow: Integer; var CanSelect: Boolean);
     845begin
     846  inherited;
     847      CanSelect := True;
     848      if ARow = 0 then CanSelect := false
     849      else if (ACol = 2) then CanSelect := False
     850      else if (ACol = 1) and (grdChecks.Cells[Acol, Arow] = '') then CanSelect := False;
     851      //else if (ACol = 0) and (Piece(grdChecks.cells[2,ARow], U, 2) <> 'O') then CanSelect := false;
     852      if (CanSelect = True) and (ACol = 0) and (Piece(grdChecks.cells[2,ARow], U, 2) = 'O') and (ScreenReaderActive) then
     853        begin
     854           if GetCheckState(grdchecks, ACol, ARow) = true then
     855             GetScreenReader.Speak('Cancel checkbox is checked press spacebar to uncheck it')
     856           else GetScreenReader.Speak('Cancel checkbox Not Checked press spacebar to check it to cancel the ' + grdChecks.Cells[1,Arow] + ' Order');
     857        end;
     858end;
     859
     860procedure TfrmOCSession.GridDeleteRow(RowNumber: Integer; Grid: TstringGrid);
     861var
     862  i: Integer;
     863begin
     864  Grid.Row := RowNumber;
     865  if (Grid.Row = Grid.RowCount - 1) then
     866    { On the last row}
     867    Grid.RowCount := Grid.RowCount - 1
     868  else
     869  begin
     870    { Not the last row}
     871    for i := RowNumber to Grid.RowCount - 1 do
     872      Grid.Rows[i] := Grid.Rows[i + 1];
     873    Grid.RowCount := Grid.RowCount - 1;
     874  end;
     875end;
     876
     877function TfrmOCSession.InCheckBox(Grid: TStringGrid; X, Y, ACol,
     878  ARow: integer): boolean;
     879var
     880  Rect: TRect;
     881begin
     882  Result := False;
     883  Rect := CheckBoxRect(grid.CellRect(ACol, ARow));
     884  if Y < Rect.Top then Exit;
     885  if Y > Rect.Bottom then Exit;
     886  if X < Rect.Left then exit;
     887  if X > Rect.Right then exit;
     888  Result := True;
     889end;
     890
     891function TfrmOCSession.GetCheckState(grid: TStringGrid; ACol, ARow: integer): boolean;
     892begin
     893   if Piece(grid.Cells[2, ARow], U, 3) = '1' then Result := True
     894   else Result := false;
     895end;
    321896
    322897procedure TfrmOCSession.FormResize(Sender: TObject);
    … …  
    324899  //TfrmAutoSz has defect must call inherited Resize for the resize to function.
    325900  inherited;
     901    grdChecks.ColWidths[0] := round(grdChecks.Width * 0.08);
     902    grdChecks.ColWidths[1] := round(grdChecks.Width * 0.88);   //Order Text
     903    grdChecks.ColWidths[2] := 0;     //OrderID^Format^IsCheck
     904    grdChecks.tabStops[2] := false;
     905    if grdChecks.RowCount > 1 then grdChecks.Refresh;
     906    self.pnlBottom.Top := self.pnlTop.Top + self.pnlTop.Height;
    326907end;
    327908
    … …  
    352933end;
    353934
     935
     936procedure TfrmOCSession.FormKeyDown(Sender: TObject; var Key: Word;
     937   Shift: TShiftState);
     938 begin
     939   inherited;
     940   if (Key = VK_F4) and (ssAlt in Shift) then Key := 0;
     941end;
     942procedure TfrmOCSession.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
     943  MousePos: TPoint; var Handled: Boolean);
     944begin
     945  inherited;
     946  if self.grdchecks.Focused = false then
     947    begin
     948    end;
     949end;
     950
    354951end.
Note: See TracChangeset for help on using the changeset viewer.