wscontrols.pas

Workflow Studio是一款专为商业进程管理（BPM）设计的Delphi VCL框架。通过Workflow Studio你可以轻易地将工作流与BPM功能添加到你的应用程序里。这样能使你或你的最

unit wsControls;

{$I wsdefs.inc}

interface
uses
  Windows, Dialogs, Graphics, Messages, Classes, Forms, StdCtrls, Controls, ComCtrls, wsMain, wsClasses,
  {$IFDEF DELPHI6_LVL}
  Variants,
  {$ENDIF}
  wsDB;

type
  TLVWorkflowDefinitions = class(TWorkflowDefinitions)
  protected
    procedure Update(Item: TCollectionItem); override;
  end;

  TWorkDefListView = class(TListView)
  private
    FWorkDefs: TWorkflowDefinitions;
    procedure UpdateWorkflowItem(AItem: TListItem; AWorkDef: TWorkflowDefinition);
    function GetSelectedWorkDef: TWorkflowDefinition;
    procedure SelectItemByKey(AKey: string);
    procedure UpdateItems;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SelectItemByWorkDef(AWorkDef: TWorkflowDefinition);
    procedure LoadFromDatabase;
    function AddWorkDefItem: TListItem;
    function WorkDefFromItem(AItem: TListItem): TWorkflowDefinition;
    property SelectedWorkDef: TWorkflowDefinition read GetSelectedWorkDef;
    property WorkDefs: TWorkflowDefinitions read FWorkDefs;
  end;

  TTaskStatusCombo = class(TComboBox)
  private
    FTask: TTaskInstance;
    procedure SetTask(const Value: TTaskInstance);
    procedure FillStatusItems;
    procedure SetStatus(AStatus: string);
    function GetStatus: string;
  protected
    procedure Change; override;
  public
    constructor Create(AOwner: TComponent); override;
    property TaskInstance: TTaskInstance read FTask write SetTask;
  published
    property Style default csDropDownList;
  end;

  TTaskListView = class(TListView)
  private
    FTasks: TTaskInstanceList;
    FWorkDefs: TWorkflowDefinitions;
    FFilterType: TTaskFilterType;
    FFilterKey: string;
    FOnlyCompleted: boolean;
    procedure UpdateTaskItem(AItem: TListItem; ATask: TTaskInstance);
    function GetSelectedTask: TTaskInstance;
    procedure SelectItemByTask(ATask: TTaskInstance);
    procedure SelectItemByKey(AKey: string);
    procedure UpdateColumns;
    procedure UpdateDefinitionNames;
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function TaskFromItem(AItem: TListItem): TTaskInstance;
    procedure UpdateItems;
    procedure LoadFromDatabase;
    property SelectedTask: TTaskInstance read GetSelectedTask;
    property TaskInstances: TTaskInstanceList read FTasks;
    property FilterType: TTaskFilterType read FFilterType write FFilterType;
    property FilterKey: string read FFilterKey write FFilterKey;
    property OnlyCompleted: boolean read FOnlyCompleted write FOnlyCompleted;
  published
    property Columns stored false;
  end;

  TLVAttachmentItems = class(TAttachmentItems)
  protected
    procedure Update(Item: TCollectionItem); override;
  end;

  TAttachmentListView = class(TListView)
  private
    FAttachs: TAttachmentItems;
    FLargeImages: TImageList;
    FLargeExts: TStrings;
    FSmallImages: TImageList;
    FSmallExts: TStrings;
    FAllowDropFiles: boolean;
    procedure UpdateAttachmentItem(AItem: TListItem; AAttach: TAttachmentItem);
    function GetSelectedAttachment: TAttachmentItem;
    procedure SetAttachments(const Value: TAttachmentItems);
    procedure DropMsg(var msg: TWMDropFiles); message WM_DROPFILES;

    procedure SelectItemByAttachment(AAttach: TAttachmentItem);
    //function AddAttachmentItem: TListItem;
    function AttachmentFromItem(AItem: TListItem): TAttachmentItem;
    property SelectedAttachment: TAttachmentItem read GetSelectedAttachment;
    function ImageIndexByExt(AExt: string): integer;
    procedure AdjustColumns;
    procedure SetFAllowDropFiles(const Value: boolean);
  protected
    procedure CreateWnd; override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateItems;
    function AddFile(AFileName: string): TAttachmentItem;
    procedure DeleteSelecteds;
    procedure OpenSelecteds(AllowEdit: boolean);
    property Attachments: TAttachmentItems read FAttachs write SetAttachments;
    property AllowDropFiles: boolean read FAllowDropFiles write SetFAllowDropFiles;
  published
    property Columns stored false;
  end;

  TTaskFieldPanel = class;

  TTaskFieldCustomControl = class
  private
    FControl: TWinControl;
    FPanel: TTaskFieldPanel;
    FModified: boolean;
  protected
    procedure SetReadOnly(AValue: boolean); virtual;
    function CreateControl(AOwner: TComponent): TWinControl; virtual; abstract;
    procedure SetValue(AValue: Variant); virtual; abstract;
    function GetValue: Variant; virtual; abstract;
    function IsEmpty: boolean; virtual; abstract;

    procedure Change;
    procedure EditorChange(Sender: TObject);
    property Panel: TTaskFieldPanel read FPanel;
  public
    constructor Create(AOwner: TTaskFieldPanel);
    destructor Destroy; override;
    property Control: TWinControl read FControl;
  end;

  TTaskFieldEdit = class(TTaskFieldCustomControl)
  protected
    procedure SetReadOnly(AValue: boolean); override;
    function CreateControl(AOwner: TComponent): TWinControl; override;
    procedure SetValue(AValue: Variant); override;
    function GetValue: Variant; override;
    function IsEmpty: boolean; override;

    function EditControl: TEdit;
  end;

  TTaskFieldEditor = class(TCollectionItem)
  private
    FLabel: TLabel;
    FEditor: TTaskFieldCustomControl;
    FField: TTaskField;
  public
    destructor Destroy; override;
  end;

  TTaskFieldEditors = class(TCollection)
  private
    function GetItem(Index: integer): TTaskFieldEditor;
  public
    function Add: TTaskFieldEditor;
    property Items[Index: integer]: TTaskFieldEditor read GetItem; default;
  end;

  TFieldErrorInfo = record
    Editor: TTaskFieldEditor;
    msg: string;
  end;

  TTaskFieldPanel = class(TScrollBox)
  private
    FFields: TTaskFields;
    FEditors: TTaskFieldEditors;
    FVertInterspace: integer;
    FVertMargin: integer;
    FHorzInterspace: integer;
    FHorzMargin: integer;
    FUpdatingVars: integer;
    FModified: boolean;
    FErrorInfo: TFieldErrorInfo;
    FReadOnly: boolean;
    procedure SetFields(const Value: TTaskFields);
    procedure UpdateVarControls;
    procedure CreateControl(AField: TTaskField);
    procedure DestroyControls;
    procedure ArrangeControls;
    procedure ArrangeLabelsVertical;
    procedure SetReadOnly(const Value: boolean);
  protected
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadDiagramVariables(ADiagram: TWorkflowDiagram);
    procedure SaveDiagramVariables(ADiagram: TWorkflowDiagram);

    function ValidateValues: boolean;
    procedure FocusLastError;
    property ErrorInfo: TFieldErrorInfo read FErrorInfo;

    property Fields: TTaskFields read FFields write SetFields;
    property HorzMargin: integer read FHorzMargin write FHorzMargin;
    property VertMargin: integer read FVertMargin write FVertMargin;
    property HorzInterSpace: integer read FHorzInterspace write FHorzInterspace;
    property VertInterSpace: integer read FVertInterspace write FVertInterspace;
    property ReadOnly: boolean read FReadOnly write SetReadOnly;
  end;

  TTaskLogListView = class(TListView)
  private
    FTaskInsKey: string;
    FLogItems: TTaskLogItems;
    procedure UpdateLogItem(AItem: TListItem; ALogItem: TTaskLogItem);
    procedure UpdateColumns;
    function LogOperationText(AOperation: TTaskLogOperation): string;
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateItems;
    procedure LoadFromDatabase;
    property TaskInsKey: string read FTaskInsKey write FTaskInsKey;
  published
    property Columns stored false;
  end;

implementation
uses wsRes, sysutils,
  {$WARNINGS OFF}
  FileCtrl,
  {$WARNINGS ON}
  shellapi, imglist, contnrs;

type
  TIconType = (itSmall, itLarge);

function GetExtIcon(const FileName: string; AIconType: TIconType): TIcon;
var
  FileInfo : SHFILEINFO;
  IconFlag: word;
begin
  if AIconType = itLarge then
    IconFlag := SHGFI_LARGEICON
  else
    IconFlag := SHGFI_SMALLICON;
    
  Result := TIcon.Create;
  {$WARNINGS OFF}
  SHGetFileInfo(PChar(FileName),
    FILE_ATTRIBUTE_NORMAL,
    FileInfo,
    SizeOf(FileInfo),
    SHGFI_USEFILEATTRIBUTES or SHGFI_ICON or IconFlag);
  {$WARNINGS ON}
  Result.Handle := FileInfo.hIcon;
end;

{ TWorkDefListView }

function TWorkDefListView.AddWorkDefItem: TListItem;
var
  NewWorkDef: TWorkflowDefinition;
begin
  FWorkDefs.BeginUpdate;
  try
    NewWorkDef := FWorkDefs.Add;
    NewWorkDef.Name := FWorkDefs.FindNewName;
  finally
    FWorkDefs.EndUpdate;
  end;
  SelectItemByWorkDef(NewWorkDef);
  result := Selected;
end;

constructor TWorkDefListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWorkDefs := TLVWorkflowDefinitions.Create(Self);
end;

destructor TWorkDefListView.Destroy;
begin
  FWorkDefs.Free;
  inherited;
end;

function TWorkDefListView.GetSelectedWorkDef: TWorkflowDefinition;
begin
  result := nil;
  if SelCount = 1 then
    result := WorkDefFromItem(Selected);
end;

procedure TWorkDefListView.SelectItemByKey(AKey: string);
var
  c: integer;
begin
  Selected := nil;
  for c := 0 to Items.Count - 1 do
    if Assigned(WorkDefFromItem(Items[c])) and
      (WorkDefFromItem(Items[c]).Key = AKey) then
    begin
      Selected := Items[c];
      break;
    end;
end;

procedure TWorkDefListView.SelectItemByWorkDef(AWorkDef: TWorkflowDefinition);
var
  c: integer;
begin
  Selected := nil;
  for c := 0 to Items.Count - 1 do
    if Assigned(WorkDefFromItem(Items[c])) and
      (WorkDefFromItem(Items[c]) = AWorkDef) then
    begin
      Selected := Items[c];
      break;
    end;
end;

procedure TWorkDefListView.UpdateItems;
var
  c: integer;
  AWorkDef: TWorkflowDefinition;
begin
  Items.BeginUpdate;
  try
    {Save the old selected workflow definition}
    AWorkDef := SelectedWorkDef;

    {clear and recreate the items}
    Items.Clear;
    for c := 0 to FWorkDefs.Count - 1 do
      UpdateWorkflowItem(Items.Add, FWorkDefs[c]);

    {recover the previously selected workflow definition, if it's the same}
    SelectItemByWorkDef(AWorkDef);
  finally
    Items.EndUpdate;
  end;
end;

procedure TWorkDefListView.LoadFromDatabase;
var
  AKey: string;
begin
  AKey := 'xxx';
  if SelectedWorkDef <> nil then
    AKey := SelectedWorkDef.Key;
  FWorkDefs.BeginUpdate;
  try
    WorkflowStudio.WorkflowManager.LoadWorkflowDefinitionList(FWorkDefs);
  finally
    FWorkDefs.EndUpdate;
  end;
  SelectItemByKey(AKey);
end;

procedure TWorkDefListView.UpdateWorkflowItem(AItem: TListItem;
  AWorkDef: TWorkflowDefinition);
begin
  AItem.Caption := AWorkDef.Name;
  {$WARNINGS OFF}
  AItem.Data := AWorkDef;
  {$WARNINGS ON}
end;

function TWorkDefListView.WorkDefFromItem(
  AItem: TListItem): TWorkflowDefinition;
begin
  {$WARNINGS OFF}
  result := TWorkflowDefinition(AItem.Data);
  {$WARNINGS ON}
end;

{ TLVWorkflowDefinitions }

procedure TLVWorkflowDefinitions.Update(Item: TCollectionItem);
begin
  if GetOwner is TWorkDefListView then
    TWorkDefListView(GetOwner).UpdateItems;
end;

{ TTaskStatusCombo }

procedure TTaskStatusCombo.Change;
begin
  if FTask <> nil then
    FTask.Status := GetStatus;
  inherited;
end;

constructor TTaskStatusCombo.Create(AOwner: TComponent);
begin
  inherited;
  Style := csDropDownList;
end;

procedure TTaskStatusCombo.FillStatusItems;
begin
  Items.Clear;
  if FTask <> nil then
    FTask.TaskDef.FillStatusList(Items);
end;

function TTaskStatusCombo.GetStatus: string;
begin
  if ItemIndex >= 0 then
    result := Items[ItemIndex]
  else
    result := '';
end;

procedure TTaskStatusCombo.SetStatus(AStatus: string);
begin
  ItemIndex := Items.IndexOf(AStatus);
end;

procedure TTaskStatusCombo.SetTask(const Value: TTaskInstance);
begin
  FTask := Value;
  FillStatusItems;
  if FTask <> nil then
    SetStatus(FTask.Status)
  else
    SetStatus('');
end;

{ TTaskListView }

constructor TTaskListView.Create(AOwner: TComponent);
begin
  inherited;
  FWorkDefs := TWorkflowDefinitions.Create(Self);
  FTasks := TTaskInstanceList.Create(TTaskInstanceItem);
  FOnlyCompleted := true;
  ViewStyle := vsReport;
  HideSelection := false;
  RowSelect := true;
end;

destructor TTaskListView.Destroy;
begin