selecttracktype.pas

群星医药系统源码

unit SelectTrackType;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, RzButton, ExtCtrls, RzPanel, RzRadGrp, RzBckgnd, ceGlobal;

type
  TFmSelectTrackType = class(TForm)
    cgTrackTypes: TRzCheckGroup;
    btnOK: TRzBitBtn;
    btnCancel: TRzBitBtn;
    Label1: TLabel;
    RzSeparator1: TRzSeparator;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnCancelClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FTrackTypes: String;
    function TrackTypeIsValid(sTrackType: string) :boolean;
    procedure SetTrackTypes(const Value: string);
  public
    { Public declarations }
    property TrackTypes: string read FTrackTypes write SetTrackTypes;
  end;

var
  FmSelectTrackType: TFmSelectTrackType;

implementation

{$R *.dfm}

procedure TFmSelectTrackType.FormShow(Sender: TObject);
var i: integer;
begin
  Color := FormBackColor;
  for i:=0 to Length(FTrackTypes)-1 do
  case Copy(FTrackTypes,i+1,1)[1] of
  'A': cgTrackTypes.ItemChecked[0]:=true;
  'B': cgTrackTypes.ItemChecked[1]:=true;
  'C': cgTrackTypes.ItemChecked[2]:=true;
  'D': cgTrackTypes.ItemChecked[3]:=true;
  end;
end;

procedure TFmSelectTrackType.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if not TrackTypeIsValid(FTrackTypes) then begin
    MessageBox(Handle,'错误的日志跟踪方式设置！',nil,MB_ICONHAND);
    CanClose :=false;
  end;
end;

function TFmSelectTrackType.TrackTypeIsValid(sTrackType: string): boolean;
begin
  Result := true;
  if sTrackType = '' then exit;
  if Pos('A',sTrackType)=0 then begin Result :=false; exit end;
  if (Pos('D',sTrackType)<>0)and(Pos('C',sTrackType)=0) then Result :=false;
end;

procedure TFmSelectTrackType.btnCancelClick(Sender: TObject);
begin
  FTrackTypes :='';
end;

procedure TFmSelectTrackType.btnOKClick(Sender: TObject);
var i: integer;
begin
  FTrackTypes := '';
  with cgTrackTypes do
  for i:=0 to Items.Count -1 do
    if ItemChecked[i] then
    case i of
    0: FTrackTypes := 'A';
    1: FTrackTypes := FTrackTypes + 'B';
    2: FTrackTypes := FTrackTypes + 'C';
    3: FTrackTypes := FTrackTypes + 'D';
    end;
end;

procedure TFmSelectTrackType.SetTrackTypes(const Value: string);
begin
  FTrackTypes := Value;
end;

end.