source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOCSession.pas@ 459

unit fOCSession;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fAutoSz, StdCtrls, ORFn, uConst, ORCtrls;

type
  TfrmOCSession = class(TfrmAutoSz)
    lstChecks: TListBox;
    txtJustify: TCaptionEdit;
    lblJustify: TLabel;
    cmdCancelOrder: TButton;
    cmdContinue: TButton;
    procedure cmdCancelOrderClick(Sender: TObject);
    procedure cmdContinueClick(Sender: TObject);
    procedure lstChecksMeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure lstChecksDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
  private
    FCritical: Boolean;
    FCheckList: TStringList;
    FOrderList: TStringList;
    procedure SetReqJustify;
  public
    { Public declarations }
  end;

procedure ExecuteReleaseOrderChecks(SelectList: TList);
procedure ExecuteSessionOrderChecks(OrderList: TStringList);

implementation

{$R *.DFM}

uses rOrders, uCore;

type
  TOCRec = class
    OrderID: string;
    OrderText: string;
    Checks: TStringList;
    constructor Create(const AnID: string);
    destructor Destroy; override;
  end;

var
  uCheckedOrders: TList;

constructor TOCRec.Create(const AnID: string);
begin
  OrderID := AnID;
  Checks := TStringList.Create;
end;

destructor TOCRec.Destroy;
begin
  Checks.Free;
  inherited Destroy;
end;

procedure ExecuteReleaseOrderChecks(SelectList: TList);
var
  i: Integer;
  AnOrder: TOrder;
  OrderIDList: TStringList;
begin
  OrderIDList := TStringList.Create;
  try
    for i := 0 to SelectList.Count - 1 do
    begin
      AnOrder := TOrder(SelectList.Items[i]);
      OrderIDList.Add(AnOrder.ID + '^^1');  // 3rd pce = 1 means releasing order
    end;
    ExecuteSessionOrderChecks(OrderIDList);
    for i := SelectList.Count - 1 downto 0 do
    begin
      AnOrder := TOrder(SelectList.Items[i]);
      if OrderIDList.IndexOf(AnOrder.ID + '^^1') < 0 then
      begin
        Changes.Remove(CH_ORD, AnOrder.ID);
        SelectList.Delete(i);
      end;
    end;
  finally
    OrderIDList.Free;
  end;
end;

procedure ExecuteSessionOrderChecks(OrderList: TStringList);
var
  i, j: Integer;
  LastID, NewID: string;
  CheckList: TStringList;
  OCRec: TOCRec;
  //AChangeItem: TChangeItem;
  frmOCSession: TfrmOCSession;
  x: string;
begin
  CheckList := TStringList.Create;
  try
    StatusText('Order Checking...');
    OrderChecksForSession(CheckList, OrderList);
    StatusText('');
    if CheckList.Count > 0 then
    begin
      frmOCSession := TfrmOCSession.Create(Application);
      try
        ResizeFormToFont(TForm(frmOCSession));
        uCheckedOrders := TList.Create;
        LastID := '';
        for i := 0 to CheckList.Count - 1 do
        begin
          NewID := Piece(CheckList[i], U, 1);
          if NewID <> LastID then
          begin
            OCRec := TOCRec.Create(NewID);
            uCheckedOrders.Add(OCRec);
            LastID := NewID;
          end; {if NewID}
        end; {for i}
        with uCheckedOrders do for i := 0 to Count - 1 do
        begin
          OCRec := TOCRec(Items[i]);
          x := TextForOrder(OCRec.OrderID);
          OCRec.OrderText := x;
          for j := 0 to CheckList.Count - 1 do
            if Piece(CheckList[j], U, 1) = OCRec.OrderID then
            begin
              OCRec.Checks.Add(Pieces(CheckList[j], U, 2, 4));
              x := x + CRLF + Piece(CheckList[j], U, 4);
            end;
          //AChangeItem := Changes.Locate(CH_ORD, OCRec.OrderID);
          //if AChangeItem <> nil then OCRec.OrderText := AChangeItem.Text;
          frmOCSession.lstChecks.Items.Add(x);
        end; {with...for i}
        frmOCSession.FOrderList := OrderList;
        frmOCSession.FCheckList := CheckList;
        frmOCSession.SetReqJustify;
        MessageBeep(MB_ICONASTERISK);
        frmOCSession.ShowModal;
      finally
        with uCheckedOrders do for i := 0 to Count - 1 do TOCRec(Items[i]).Free;
        frmOCSession.Free;
      end; {try}
    end; {if CheckList}
  finally
    CheckList.Free;
  end;
end;

procedure TfrmOCSession.SetReqJustify;
var
  i, j: Integer;
  OCRec: TOCRec;
begin
  FCritical := False;
  with uCheckedOrders do for i := 0 to Count - 1 do
  begin
    OCRec := TOCRec(Items[i]);
    for j := 0 to OCRec.Checks.Count - 1 do
      if Piece(OCRec.Checks[j], U, 2) = '1' then FCritical := True;
  end;
  lblJustify.Visible := FCritical;
  txtJustify.Visible := FCritical;
end;

procedure TfrmOCSession.lstChecksMeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
var
  i, AHt, TotalHt: Integer;
  x: string;
  ARect: TRect;
  OCRec: TOCRec;
begin
  inherited;
  with lstChecks do
  begin
    if Index >= uCheckedOrders.Count then Exit;
    OCRec := TOCRec(uCheckedOrders.Items[Index]);
    ARect := ItemRect(Index);
    ARect.Left := ARect.Left + 2;
    AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect,
                    DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK) + 2;
    TotalHt := AHt;
    for i := 0 to OCRec.Checks.Count - 1 do
    begin
      ARect := ItemRect(Index);
      ARect.Left := ARect.Left + 10;
      x := Piece(OCRec.Checks[i], U, 3);
      AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect,
                      DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
      TotalHt := TotalHt + AHt;
    end;
  end;
  Height := TotalHt + 2; // add 2 for focus rectangle
end;

procedure TfrmOCSession.lstChecksDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  i, AHt: Integer;
  x: string;
  ARect: TRect;
  OCRec: TOCRec;
begin
  inherited;
  with lstChecks do
  begin
    if Index >= uCheckedOrders.Count then Exit;
    OCRec := TOCRec(uCheckedOrders.Items[Index]);
    ARect := ItemRect(Index);
    AHt := DrawText(Canvas.Handle, PChar(OCRec.OrderText), Length(OCRec.OrderText), ARect,
                    DT_LEFT or DT_NOPREFIX or DT_WORDBREAK) + 2;
    ARect.Left := ARect.Left + 10;
    ARect.Top  := ARect.Top + AHt;
    for i := 0 to OCRec.Checks.Count - 1 do
    begin
      x := Piece(OCRec.Checks[i], U, 3);
      if not (odSelected in State) then
      begin
        if (Piece(OCRec.Checks[i], U, 2) = '1')
          then
          begin
            if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
              Canvas.Font.Color := clBlue;
            Canvas.Font.Style := [fsUnderline];
          end
          else Canvas.Font.Color := clWindowText;
      end;
      AHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect,
                      DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
      ARect.Top  := ARect.Top + AHt;
    end;
  end;
end;

procedure TfrmOCSession.cmdCancelOrderClick(Sender: TObject);
var
  i, j: Integer;
  AnOrderID: string;
  OCRec: TOCRec;
begin
  inherited;
  for i := lstChecks.Items.Count - 1 downto 0 do if lstChecks.Selected[i] then
  begin
    OCRec := TOCRec(uCheckedOrders.Items[i]);
    AnOrderID := OCRec.OrderID;
    if DeleteCheckedOrder(AnOrderID) then
    begin
      for j := FCheckList.Count - 1 downto 0 do
        if Piece(FCheckList[j], U, 1) = AnOrderID then FCheckList.Delete(j);
      for j := FOrderList.Count - 1 downto 0 do
        if Piece(FOrderList[j], U, 1) = AnOrderID then FOrderList.Delete(j);
      OCRec.Free;
      uCheckedOrders.Delete(i);
      lstChecks.Items.Delete(i);
    end;
  end;
  if uCheckedOrders.Count = 0 then Close;
end;

procedure TfrmOCSession.cmdContinueClick(Sender: TObject);
begin
  inherited;
  if FCritical and ((Length(txtJustify.Text) < 2) or not ContainsVisibleChar(txtJustify.Text)) then
  begin
    InfoBox('A justification for overriding critical order checks is required.',
            'Justification Required', MB_OK);
    Exit;
  end;
  StatusText('Saving Order Checks...');
  SaveOrderChecksForSession(txtJustify.Text, FCheckList);
  StatusText('');
  Close;
end;

end.