foptions.pas

FlexGraphics是一套创建矢量图形的VCL组件

unit fOptions;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Buttons, IniFiles;

type
  TZoneCaptionShow = ( zsNone, zsSelected, zsAll );
  TLampsEffect = ( leNone, leRunning, leFlashing );

  PAccessOptions = ^TAccessOptions;
  TAccessOptions = record
   // General
   ShowHints: boolean;
   ShowZoneCaptions: TZoneCaptionShow;
   SelFrameWidth: integer;
   LampsEffect: TLampsEffect;
   // Access
   Emulation: boolean;
   ShowPersonsCards: boolean;
   ShowCardsInFlex: boolean;
  end;

  TfmOptions = class(TForm)
    bbOk: TBitBtn;
    bbCancel: TBitBtn;
    pgOptPages: TPageControl;
    tsGeneral: TTabSheet;
    chShowHints: TCheckBox;
    GroupBox1: TGroupBox;
    rbZoneCapDontShow: TRadioButton;
    rbZoneCapShowSel: TRadioButton;
    rbZoneCaptShowAll: TRadioButton;
    Label1: TLabel;
    GroupBox2: TGroupBox;
    rbLampsNone: TRadioButton;
    rbLampsRunning: TRadioButton;
    rbLampsFlashing: TRadioButton;
    tsAccess: TTabSheet;
    chShowPersonsCards: TCheckBox;
    chAccessEmulation: TCheckBox;
    edSelFrameWidth: TEdit;
    rbAsForms: TRadioButton;
    rbAsFlex: TRadioButton;
    procedure FormCreate(Sender: TObject);
    procedure chShowHintsClick(Sender: TObject);
    procedure rbZoneCapClick(Sender: TObject);
    procedure edSelFrameWidthChange(Sender: TObject);
    procedure rbLampsNoneClick(Sender: TObject);
    procedure chShowPersonsCardsClick(Sender: TObject);
    procedure chAccessEmulationClick(Sender: TObject);
    procedure rbCardsClick(Sender: TObject);
  private
    { Private declarations }
    FChanged: boolean;
    FOptions: TAccessOptions;
  public
    { Public declarations }
  end;

var
  fmOptions: TfmOptions;
  Options: TAccessOptions;

function  EditOptions: boolean;
procedure SetDefaultOptions(var Options: TAccessOptions);

procedure AssignOptions(const Source: TAccessOptions; var Dest: TAccessOptions);
procedure SaveOptions;
procedure LoadOptions;

implementation

{$R *.DFM}

uses
  dMain;

procedure SetDefaultOptions(var Options: TAccessOptions);
begin
 Options.ShowHints := false;
 Options.ShowZoneCaptions := zsSelected;
 Options.SelFrameWidth := 1;
 Options.Emulation := true;
 Options.ShowPersonsCards := False;
 Options.ShowCardsInFlex := True;
end;

procedure AssignOptions(const Source: TAccessOptions; var Dest: TAccessOptions);
begin
 with Dest do begin
  ShowHints := Source.ShowHints;
  ShowZoneCaptions := Source.ShowZoneCaptions;
  SelFrameWidth := Source.SelFrameWidth;
  LampsEffect := Source.LampsEffect;
  Emulation := Source.Emulation;
  ShowPersonsCards := Source.ShowPersonsCards;
  ShowCardsInFlex := Source.ShowCardsInFlex;
 end;
end;

procedure SaveOptions;
begin
 with dmMain.Ini do begin
  WriteBool(isOptions, 'ShowHints', Options.ShowHints);
  WriteInteger(isOptions, 'ShowZoneCaptions', integer(Options.ShowZoneCaptions));
  WriteInteger(isOptions, 'SelFrameWidth', integer(Options.SelFrameWidth));
  WriteInteger(isOptions, 'LampsEffect', integer(Options.LampsEffect));
  WriteBool(isOptions, 'ShowPersonsCards', Options.ShowPersonsCards);
  WriteBool(isOptions, 'Emulation', Options.Emulation);
  WriteBool(isOptions, 'ShowCardsInFlex', Options.ShowCardsInFlex);
 end;
end;

procedure LoadOptions;
begin
 with dmMain.Ini do begin
  Options.ShowHints := ReadBool(isOptions, 'ShowHints', False);
  Options.ShowZoneCaptions :=
   TZoneCaptionShow(ReadInteger(isOptions, 'ShowZoneCaptions', 2));
  Options.SelFrameWidth := ReadInteger(isOptions, 'SelFrameWidth', 1);
  Options.LampsEffect :=
   TLampsEffect(ReadInteger(isOptions, 'LampsEffect', 1));
  Options.ShowPersonsCards := ReadBool(isOptions, 'ShowPersonsCards', False);
  Options.Emulation := ReadBool(isOptions, 'Emulation', True);
  Options.ShowCardsInFlex := ReadBool(isOptions, 'ShowCardsInFlex', True);
 end;
end;

function EditOptions: boolean;
begin
 if Assigned(fmOptions) then begin
  Result := false;
  exit;
 end;
 fmOptions := TfmOptions.Create(Nil);
 try
  Result := fmOptions.ShowModal = mrOk;
  if Result and fmOptions.FChanged then
   // Store changes in global variable Options
   AssignOptions(fmOptions.FOptions, Options);
 finally
  fmOptions.Free;
  fmOptions := Nil;
 end;
end;

// TfmOptions /////////////////////////////////////////////////////////////////

procedure TfmOptions.FormCreate(Sender: TObject);
begin
 // Copy global Options in private FOptions for editing
 AssignOptions(Options, FOptions);
 // Initialize form controls
 chShowHints.Checked := FOptions.ShowHints;
 case FOptions.ShowZoneCaptions of
  zsNone     : rbZoneCapDontShow.Checked := true;
  zsSelected : rbZoneCapShowSel.Checked := true;
  zsAll      : rbZoneCaptShowAll.Checked := true;
 end;
 edSelFrameWidth.Text := IntToStr(FOptions.SelFrameWidth);
 case FOptions.LampsEffect of
  leNone     : rbLampsNone.Checked := true;
  leRunning  : rbLampsRunning.Checked := true;
  leFlashing : rbLampsFlashing.Checked := true;
 end;
 chAccessEmulation.Checked := FOptions.Emulation;
 chShowPersonsCards.Checked := FOptions.ShowPersonsCards;
 if FOptions.ShowCardsInFlex
  then rbAsFlex.Checked := true
  else rbAsForms.Checked := true;
 // Reset changed flag
 FChanged := false;
end;

procedure TfmOptions.chShowHintsClick(Sender: TObject);
begin
 FOptions.ShowHints := chShowHints.Checked;
 FChanged := true;
end;

procedure TfmOptions.chShowPersonsCardsClick(Sender: TObject);
begin
 FOptions.ShowPersonsCards := chShowPersonsCards.Checked;
 rbAsForms.Enabled := FOptions.ShowPersonsCards;
 rbAsFlex.Enabled := FOptions.ShowPersonsCards;
 FChanged := true;
end;

procedure TfmOptions.rbCardsClick(Sender: TObject);
begin
 FOptions.ShowCardsInFlex := rbAsFlex.Checked;
 FChanged := true;
end;

procedure TfmOptions.chAccessEmulationClick(Sender: TObject);
begin
 FOptions.Emulation := chAccessEmulation.Checked;
 FChanged := true;
end;

procedure TfmOptions.rbZoneCapClick(Sender: TObject);
begin
 if rbZoneCapDontShow.Checked then FOptions.ShowZoneCaptions := zsNone else
 if rbZoneCapShowSel.Checked then FOptions.ShowZoneCaptions := zsSelected else
 if rbZoneCaptShowAll.Checked then FOptions.ShowZoneCaptions := zsAll
                              else exit;
 FChanged := true;
end;

procedure TfmOptions.rbLampsNoneClick(Sender: TObject);
begin
 if rbLampsNone.Checked then FOptions.LampsEffect := leNone else
 if rbLampsRunning.Checked then FOptions.LampsEffect := leRunning else
 if rbLampsFlashing.Checked then FOptions.LampsEffect := leFlashing
                            else exit;
 FChanged := true;
end;

procedure TfmOptions.edSelFrameWidthChange(Sender: TObject);
var Value: integer;
begin
 Value := StrToIntDef(edSelFrameWidth.Text, 1);
 if Value > 9 then Value := 9 else
 if Value < 1 then Value := 1;
 FOptions.SelFrameWidth := Value;
 FChanged := true;
end;

initialization
  SetDefaultOptions(Options);

end.