messagedlgeditormain.pas

jvcl driver development envionment

  Result := Result + '(';

  if cxIsDSADialog.Checked then
    Result := Result + Trim(edDSA_ID.Text) + ', ';

  if cxCustomTitle.Checked then
    Result := Result + QuotedStr(edCustomTitle.Text) + ', ';

  Result := Result + MsgToSource(mmMessage.Lines) + ', ';

  if rbWarning.Checked then
    Result := Result + 'mtWarning, ';
  if rbError.Checked then
    Result := Result + 'mtError, ';
  if rbInformation.Checked then
    Result := Result + 'mtInformation, ';
  if rbConfirmation.Checked then
    Result := Result + 'mtConfirmation, ';
  if rbCustom.Checked then
  begin
    if HasGraphic then
      Result := Result + 'Pic, '
    else
      Result := Result + 'mtCustom, ';
  end;

  if not rbCustomButtons.Checked then
    Result := Result + StdBtnsToSource(clbStdButtons) + ', '
  else
    Result := Result + CustomButtonsToSource(mmCustomButtons.Lines) + ', ';

  Result := Result + edHelpCtx.Text;

  if RequireCenter then
    Result := Result + ', ' + GetCenterName;

  if RequireAutoClose then
    Result := Result + ', ' + GetTimeoutValue;

  if RequireDefaultButton then
    Result := Result + ', ' + DefaultButtonName;

  if RequireCancelButton then
    Result := Result + ', ' + CancelButtonName;

  if RequireHelpButton then
    Result := Result + ', ' + HelpButtonName;

  Result := Result + ')';

  if HasGraphic then
    Result := Result + ';' + #13#10 + 'finally'+ #13#10 + '  Pict.Free;';
end;

function TfrmMessageDlgEditor.GetCenter: TDlgCenterKind;
begin
  if rbCenterScreen.Checked then
    Result := dckScreen
  else if rbMainFormCenter.Checked then
    Result := dckMainForm
  else if rbActiveFormCenter.Checked then
    Result := dckActiveForm
  else
    Result := dckScreen;
end;

function TfrmMessageDlgEditor.GetTimeout: Integer;
begin
  if cxAutoClose.Checked then
  begin
    Result := StrToInt(edAutoCloseDelay.Text);
    if not cxAutoCloseShow.Checked then
      Result := -Result;
  end
  else
    Result := 0;
end;

function TfrmMessageDlgEditor.GetTimeoutValue: string;
begin
  Result := IntToStr(GetTimeout);
end;

function TfrmMessageDlgEditor.GetCustomButtonNames: TDynStringArray;
var
  J: Integer;
  I: Integer;
  S: string;
begin
  SetLength(Result, mmCustomButtons.Lines.Count);
  J := 0;
  for I := 0 to mmCustomButtons.Lines.Count - 1 do
  begin
    if (Trim(mmCustomButtons.Lines[I]) <> '') then
    begin
      S := mmCustomButtons.Lines.Names[I];
      if (Trim(mmCustomButtons.Lines.Values[S]) <> '') and (S = Trim(S)) then
      begin
        Result[J] := S;
        Inc(J);
      end;
    end;
  end;
  SetLength(Result, J);
end;

function TfrmMessageDlgEditor.GetCustomButtonResults: TDynIntegerArray;
var
  Names: TDynStringArray;
  I: Integer;
begin
  Names := GetCustomButtonNames;
  SetLength(Result, Length(Names));
  for I := Low(Result) to High(Result) do
    Result[I] := I + 1;
end;

function TfrmMessageDlgEditor.GetCustomCancelButton: Integer;
begin
  Result := cbCancelButton.ItemIndex - 1;
end;

function TfrmMessageDlgEditor.GetCustomDefaultButton: Integer;
begin
  Result := cbDefaultButton.ItemIndex - 1;
end;

function TfrmMessageDlgEditor.GetCustomHelpButton: Integer;
begin
  Result := cbHelpButton.ItemIndex - 1;
end;

function TfrmMessageDlgEditor.GetDlgType: TMsgDlgType;
begin
  if rbWarning.Checked then
    Result := mtWarning
  else if rbError.Checked then
    Result := mtError
  else if rbInformation.Checked then
    Result := mtInformation
  else if rbConfirmation.Checked then
    Result := mtConfirmation
  else if rbCustom.Checked then
    Result := mtCustom
  else
    Result := mtCustom;
end;

function TfrmMessageDlgEditor.GetStdButtons: TMsgDlgButtons;
var
  I: Integer;
begin
  Result := [];
  for I := 0 to clbStdButtons.Items.Count - 1 do
  begin
    if clbStdButtons.Checked[I] then
      Include(Result, TMsgDlgBtn(GetEnumValue(TypeInfo(TMsgDlgBtn), clbStdButtons.Items[I])));
  end;
end;

function TfrmMessageDlgEditor.GetStdCancelButton: TMsgDlgBtn;
begin
  if cbCancelButton.ItemIndex < 2 then
    Result := TMsgDlgBtn(cbCancelButton.ItemIndex - 2)
  else
    Result := TMsgDlgBtn(GetEnumValue(TypeInfo(TMsgDlgBtn), cbCancelButton.Text));
end;

function TfrmMessageDlgEditor.GetStdDefaultButton: TMsgDlgBtn;
begin
  if cbDefaultButton.ItemIndex < 2 then
    Result := TMsgDlgBtn(cbDefaultButton.ItemIndex - 2)
  else
    Result := TMsgDlgBtn(GetEnumValue(TypeInfo(TMsgDlgBtn), cbDefaultButton.Text));
end;

function TfrmMessageDlgEditor.GetStdHelpButton: TMsgDlgBtn;
begin
  if cbHelpButton.ItemIndex < 2 then
    Result := TMsgDlgBtn(cbHelpButton.ItemIndex - 2)
  else
    Result := TMsgDlgBtn(GetEnumValue(TypeInfo(TMsgDlgBtn), cbHelpButton.Text));
end;

procedure TfrmMessageDlgEditor.InitDefaultLists;
var
  SL: TStrings;
  I: Integer;
  CurDefault: string;
  CurCancel: string;
  CurHelp: string;
begin
  SL := TStringList.Create;
  try
    if rbStdButtons.Checked then
    begin
      SL.Add('[VCL default]');
      SL.Add('[none]');
      for I := 0 to clbStdButtons.Items.Count - 1 do
      begin
        if clbStdButtons.Checked[I] then
          SL.Add(clbStdButtons.Items[I]);
      end;
    end
    else
    begin
      SL.Add('[none]');
      for I := 0 to mmCustomButtons.Lines.Count - 1 do
      begin
        if (Trim(mmCustomButtons.Lines[I]) <> '') then
        begin
          CurDefault := mmCustomButtons.Lines.Names[I];
          if (Trim(mmCustomButtons.Lines.Values[CurDefault]) <> '') and (CurDefault = Trim(CurDefault)) then
            SL.Add(Trim(CurDefault));
        end;
      end;
    end;
    CurDefault := cbDefaultButton.Text;
    CurCancel := cbCancelButton.Text;
    CurHelp := cbHelpButton.Text;

    cbDefaultButton.Items.Assign(SL);
    cbCancelButton.Items.Assign(SL);
    cbHelpButton.Items.Assign(SL);

    I := SL.IndexOf(CurDefault);
    if I < 0 then
      I := SL.IndexOf('[VCL default]');
    if I < 0 then
      I := SL.IndexOf('[none]');
    cbDefaultButton.ItemIndex := I;

    I := SL.IndexOf(CurCancel);
    if I < 0 then
      I := SL.IndexOf('[VCL default]');
    if I < 0 then
      I := SL.IndexOf('[none]');
    cbCancelButton.ItemIndex := I;

    I := SL.IndexOf(CurHelp);
    if I < 0 then
      I := SL.IndexOf('[VCL default]');
    if I < 0 then
      I := SL.IndexOf('[none]');
    cbHelpButton.ItemIndex := I;
  finally
    SL.Free;
  end;
end;

procedure TfrmMessageDlgEditor.TempDSARegCreate;
begin
  TmpStorage := TDSAQueueStorage.Create;
  TempDSA_ID := 1;
  try
    TmpStorage.CheckMarkTextSuffix := '';
    RegisterDSA(TempDSA_ID, 'Temp' + IntToStr(TempDSA_ID), 'Temporary DSA dialog', TmpStorage,
      ctkShow);
  except
    TempDSA_ID := 0;
    FreeAndNil(TmpStorage);
    raise;
  end;
end;

procedure TfrmMessageDlgEditor.TempDSARegDestroy;
begin
  if TempDSA_ID <> 0 then
  begin
    UnregisterDSA(TempDSA_ID);
    FreeAndNil(TmpStorage);
    TempDSA_ID := 0;
  end;
end;

procedure TfrmMessageDlgEditor.FormCreate(Sender: TObject);
begin
  imgWarning.Picture.Icon.Handle := LoadIcon(0, IDI_EXCLAMATION);
  imgError.Picture.Icon.Handle := LoadIcon(0, IDI_HAND);
  imgInformation.Picture.Icon.Handle := LoadIcon(0, IDI_ASTERISK);
  imgConfirmation.Picture.Icon.Handle := LoadIcon(0, IDI_QUESTION);
  DlgSettingChanged;
  frmMessageDlgEditor := self; // is needed when loading as part of the MegaDemo
end;

procedure TfrmMessageDlgEditor.imgWarningClick(Sender: TObject);
begin
  rbWarning.Checked := True;
end;

procedure TfrmMessageDlgEditor.rbWarningClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.imgErrorClick(Sender: TObject);
begin
  rbError.Checked := True;
end;

procedure TfrmMessageDlgEditor.rbErrorClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.imgInformationClick(Sender: TObject);
begin
  rbInformation.Checked := True;
end;

procedure TfrmMessageDlgEditor.rbInformationClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.imgConfirmationClick(Sender: TObject);
begin
  rbConfirmation.Checked := True;
end;

procedure TfrmMessageDlgEditor.rbConfirmationClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.imgCustomClick(Sender: TObject);
begin
  rbCustom.Checked := True;
end;

procedure TfrmMessageDlgEditor.rbCustomClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.btnSelectIconClick(Sender: TObject);
var
  Pict: TPicture;
begin
  if DoSelectPicture then
  begin
    Pict := TPicture.Create;
    try
      Pict.Assign(imgCustom.Picture);
      case PicType of
        0:
          imgCustom.Picture.Graphic := nil;
        1 .. 4:
          imgCustom.Picture.Icon.Handle := LoadIcon(0, PicID);
        5:
          try
            imgCustom.Picture.Icon.Handle := LoadIcon(0, PChar(PicName));
          except
            imgCustom.Picture.Graphic := nil;
          end;
        6:
          try
            imgCustom.Picture.Bitmap.Handle := LoadBitmap(0, PChar(PicName));
          except
            imgCustom.Picture.Graphic := nil;
          end;
        7:
          imgCustom.Picture.LoadFromFile(PicName);
      end;
    finally
      Pict.Free;
    end;
    DlgSettingChanged;
  end;
end;

procedure TfrmMessageDlgEditor.edCustomTitleChange(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.rbStdButtonsClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.rbCustomButtonsClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.clbStdButtonsClickCheck(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.mmCustomButtonsChange(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.cbDefaultButtonChange(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.cbCancelButtonChange(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.cbHelpButtonChange(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.rbCenterScreenClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.rbActiveFormCenterClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.rbMainFormCenterClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.edHelpCtxChange(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.cxIsDSADialogClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.edDSA_IDChange(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.mmMessageChange(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.cxCustomTitleClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.btnTestClick(Sender: TObject);
  function IsMessageDlg: Boolean;
  begin
    Result := not cxIsDSADialog.Checked and not rbCustomButtons.Checked;
  end;

  function IsMessageDlgEx: Boolean;
  begin
    Result := not cxIsDSADialog.Checked and rbCustomButtons.Checked;
  end;

  function IsDSAMessageDlg: Boolean;
  begin
    Result := cxIsDSADialog.Checked and not rbCustomButtons.Checked;
  end;

  function IsDSAMessageDlgEx: Boolean;
  begin
    Result := cxIsDSADialog.Checked and rbCustomButtons.Checked;
  end;

begin
  if IsMessageDlg then
    HandleMessageDlg
  else if IsMessageDlgEx then
    HandleMessageDlgEx
  else if IsDSAMessageDlg then
    HandleDSAMessageDlg
  else if IsDSAMessageDlgEx then
    HandleDSAMessageDlgEx;
end;

procedure TfrmMessageDlgEditor.btnCloseClick(Sender: TObject);
begin
  Close
end;

procedure TfrmMessageDlgEditor.cxAutoCloseClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.edAutoCloseDelayChange(Sender: TObject);
begin
  DlgSettingChanged;
end;

procedure TfrmMessageDlgEditor.cxAutoCloseShowClick(Sender: TObject);
begin
  DlgSettingChanged;
end;

end.