dsamsg.pas

动态提示控件

    exit; // Don't go setting values when we are reading the form.
    
  {$IFDEF DFS_WIN32}
  OldUseReg := UseRegistry;
  UseRegistry := DSA_UseRegistry;
  try
  {$ENDIF}
    if DSA_ID = '' then
      DSAFormSetState(TFormClass(ClassType), Value)
    else
      DSAIdentsSetState(DSA_Filename, DSA_ID, Value);
  {$IFDEF DFS_WIN32}
  finally
    UseRegistry := OldUseReg;
  end;
  {$ENDIF}
end;


function TdfsDSAForm.GetDSAShowable: boolean;
{$IFDEF DFS_WIN32}
var
  OldUseReg: boolean;
{$ENDIF}
begin
  {$IFDEF DFS_WIN32}
  OldUseReg := UseRegistry;
  UseRegistry := DSA_UseRegistry;
  try
  {$ENDIF}
    if DSA_ID = '' then
      Result := DSAFormGetState(TFormClass(ClassType))
    else
      Result := DSAIdentsGetState(DSA_Filename, DSA_ID);
  {$IFDEF DFS_WIN32}
  finally
    UseRegistry := OldUseReg;
  end;
  {$ENDIF}
end;


procedure TdfsDSAForm.DSAShow;
begin
  if (DSA_CheckBox = NIL) or DSA_Showable then
    Show
  else begin
    { Flag it so we don't overwrite with the checkbox value }
    FDSA_NotShowable := TRUE;
    Close;
  end;
end;


function TdfsDSAForm.DSAShowModal: Integer;
begin
  if DSA_CheckBox = NIL then
  begin
    Result := ShowModal;
    exit;
  end;

  if DSA_Showable then
  begin
    Result := ShowModal;
    { Something may have whacked the checkbox, take no chances }
    if DSA_CheckBox <> NIL then
      DSA_Showable := not DSA_CheckBox.Checked;
  end else begin
    { Flag it so we don't overwrite with the checkbox value }
    FDSA_NotShowable := TRUE;
    Close;
    Result := DSA_DefaultResult;
  end;
end;

procedure TdfsDSAForm.DSAClear;
begin
  DSA_Showable := TRUE;
end;




function DSAShowModal(const AForm: TForm; DefaultResult: word): Word;
begin
  Result := DSAIdentsShowModal(AForm, '', '', DefaultResult);
end;



function DSAIdentsShowModal(const AForm: TForm; Filename, ID: string;
   DefaultResult: word): Word;
var
  DSA: TCheckBox;
  EdgeCtl: TControl;
  TopCtl: TControl;
  x: integer;
begin
  Result := DefaultResult;
  if AForm = NIL then exit;

  if ID = '' then
    ID := AForm.ClassName;

  if not DSAIdentsGetState(Filename, ID) then
    exit;

  DSA := NIL;
  { Find left edge of the left-most control on the form }
  EdgeCtl := NIL;
  TopCtl := NIL;
  for x := 0 to AForm.ControlCount-1 do
  begin
    if EdgeCtl = NIL then
      EdgeCtl := AForm.Controls[x]
    else
      if AForm.Controls[x].Left < EdgeCtl.Left then
        EdgeCtl := AForm.Controls[x];
    if TopCtl = NIL then
      TopCtl := AForm.Controls[x]
    else
      if AForm.Controls[x].Top < TopCtl.Top then
        TopCtl := AForm.Controls[x];
  end;
  if (EdgeCtl <> NIL) and (TopCtl <> NIL) then
  begin
    { It's possible that this form has already has the checkbox on it, i.e. it
      has been passed to this function before without being freed.  Find out. }
    DSA := TCheckBox(AForm.FindComponent(DSA_CHECKBOX_NAME));
    if DSA = NIL then
    begin
      DSA := TCheckBox.Create(AForm);
      DSA.Name := DSA_CHECKBOX_NAME;
      DSA.Parent := AForm;
    end;

    DSA.Caption := DontShowMsgText;
    DSA.Width := AForm.Canvas.TextWidth(DontShowMsgText) + 19;

    { Position the checkbox at the bottom }
    DSA.Left := EdgeCtl.Left;
    DSA.Top := AForm.ClientHeight;
    { Make room for the checkbox }
    AForm.ClientHeight := AForm.ClientHeight + DSA.Height + TopCtl.Top;
    { Make sure it's wide enough }
    if (DSA.Width + (EdgeCtl.Left * 2)) > AForm.ClientWidth then
      AForm.ClientWidth := DSA.Width + (EdgeCtl.Left * 2);
    { Recenter it if we should }
    if AForm.Position = poScreenCenter then
      AForm.Top := (Screen.Height div 2) - (AForm.Height div 2);
  end;

  Result := AForm.ShowModal;

  if DSA <> NIL then
    DSAIdentsSetState(Filename, ID, not DSA.Checked);
  { Don't need to free DSA item because it is owned by the form.  It will do it
    when it is freed. }
end;


function DSAMessageDlg(const Msg: string; AType: TMsgDlgType;
   AButtons: TMsgDlgButtons; HelpCtx: Longint; DefaultResult: word): Word;
begin
  Result := DSAIdentsMessageDlg(Msg, AType, AButtons, HelpCtx, '', '',
     DefaultResult);
end;

function DSAIdentsMessageDlg(const Msg: string; AType: TMsgDlgType;
   AButtons: TMsgDlgButtons; HelpCtx: Longint; Filename, ID: string;
   DefaultResult: word): Word;
var
  Dlg: TForm;
  DSA: TCheckBox;
  EdgeCtl: TControl;
begin
  Result := DefaultResult;
  if ID = '' then
    ID := Msg;

  if not DSAIdentsGetState(Filename, ID) then
    exit;

  Dlg := CreateMessageDialog(Msg, AType, AButtons);
  try
    Dlg.HelpContext := HelpCtx;

    { DSA stuff }
    DSA := TCheckBox.Create(Dlg);
    DSA.Name := DSA_CHECKBOX_NAME;
    DSA.Parent := Dlg;
    DSA.Caption := DontShowMsgText;
    DSA.Width := Dlg.Canvas.TextWidth(DontShowMsgText) + 19;
    { Find left edge of a known control }
    EdgeCtl := TControl(Dlg.FindComponent('Image'));
    if EdgeCtl = NIL then { must be mtCustom type }
      EdgeCtl := TControl(Dlg.FindComponent('Message'));
    if EdgeCtl = NIL then begin { I give up }
      DSA.Free;
      DSA := NIL;
    end else begin
      { Position the checkbox at the bottom }
      DSA.Left := EdgeCtl.Left;
      DSA.Top := Dlg.ClientHeight;
      { Make room for the checkbox }
      Dlg.ClientHeight := Dlg.ClientHeight + DSA.Height + EdgeCtl.Top;
      { Make sure it's wide enough }
      if (DSA.Width + (EdgeCtl.Left * 2)) > Dlg.ClientWidth then
        Dlg.ClientWidth := DSA.Width + (EdgeCtl.Left * 2);
      { Recenter it }
      Dlg.Top := (Screen.Height div 2) - (Dlg.Height div 2);
    end;

    Result := Dlg.ShowModal;

    if DSA <> NIL then
      DSAIdentsSetState(Filename, ID, not DSA.Checked);
  finally
    Dlg.Free;
  end;
  { Don't need to free DSA item because it is owned by the form.  It will do it
    when it is freed. }
end;

procedure DSAIdentsClear(Filename, ID: string);
begin
  DSAIdentsSetState(Filename, ID, TRUE);
end;

procedure DSAClear(const Msg: string);
begin
  DSAIdentsSetState('', Msg, TRUE);
end;


procedure DSAFormClear(const AFormClass: TFormClass);
begin
  DSAIdentsSetState('', AFormClass.ClassName, TRUE);
end;


function DSAFormGetState(const AFormClass: TFormClass): boolean;
begin
  Result := DSAGetState(AFormClass.ClassName);
end;


procedure DSAFormSetState(const AFormClass: TFormClass; Value: boolean);
begin
  DSASetState(AFormClass.ClassName, Value);
end;


function DSAGetState(Msg: string): boolean;
begin
  Result := DSAIdentsGetState('', Msg);
end;


procedure DSASetState(Msg: string; Value: boolean);
begin
  DSAIdentsSetState('', Msg, Value);
end;


function DSAIdentsGetState(Filename, ID: string): boolean;
var
  INI: TIniFile;
  {$IFDEF DFS_WIN32}
  Reg: TRegistry;
  {$ENDIF}
begin
  Result := TRUE;

  if Filename = '' then
    Filename := DefaultFilename;

  ID := StripInvalidChars(ID, FALSE);
  Filename := StripInvalidChars(Filename, TRUE);
  if (ID = '') or (Filename = '') then
    raise Exception.Create(SDSAGetSpecifierBlank);

  {$IFDEF DFS_WIN32}
  if UseRegistry then
  begin
    if FileName[Length(Filename)] <> '\' then
      FileName := Filename + '\';
    Filename := Filename + ID;
    Reg := TRegistry.Create;
    try
      Reg.RootKey := RegRootKey;
      if Reg.OpenKey(Filename, FALSE) then
      begin
        try
          Result := not Reg.ReadBool('DontShow');
        except
          Result := TRUE;
        end;
        Reg.CloseKey;
      end;
    finally
      Reg.Free;
    end;
  end else
  {$ENDIF}
  begin
    INI := TIniFile.Create(Filename);
    try
      Result := not INI.ReadBool(ID, 'DontShow', FALSE);
    finally
      INI.Free;
    end;
  end;
end;


procedure DSAIdentsSetState(Filename, ID: string; Value: boolean);
var
  INI: TIniFile;
  {$IFDEF DFS_WIN32}
  Reg: TRegistry;
  {$ENDIF}
begin
  if Filename = '' then
    Filename := DefaultFilename;

  ID := StripInvalidChars(ID, FALSE);
  Filename := StripInvalidChars(Filename, TRUE);
  if (ID = '') or (Filename = '') then
    raise Exception.Create(SDSASetSpecifierBlank);

  {$IFDEF DFS_WIN32}
  if UseRegistry then
  begin
    if FileName[Length(Filename)] <> '\' then
      FileName := Filename + '\';
    Filename := Filename + ID;
    Reg := TRegistry.Create;
    try
      Reg.RootKey := RegRootKey;
      if Reg.OpenKey(Filename, TRUE) then
      begin
        try
          Reg.WriteBool('DontShow', not Value);
        except
          { do nothing };
        end;
        Reg.CloseKey;
      end;
    finally
      Reg.Free;
    end;
  end else
  {$ENDIF}
  begin
    INI := TIniFile.Create(Filename);
    try
      INI.WriteBool(ID, 'DontShow', not Value);
    finally
      INI.Free;
    end;
  end;
end;

procedure InitValidChars;
var
  c: Char;
begin
  for c := #0 to #255 do
    { ask Windows if it is alphanumeric.  This is for international chars }
    if IsCharAlphaNumeric(c) then
      Valid_Key_Chars := Valid_Key_Chars + [c];
end;


initialization
  InitValidChars;
  {$IFDEF DFS_WIN32}
  DefaultFilename := 'Software\' + Application.Title + '\DSADialogs';
  {$ELSE}
  DefaultFilename := ChangeFileExt(Application.EXEName, '.INI');
  {$ENDIF}
end.