dsadialogsmainformu.pas

jvcl driver development envionment

{******************************************************************

                       JEDI-VCL Demo

 Copyright (C) 2002 Project JEDI

 Original author:

 Contributor(s):

 You may retrieve the latest version of this file at the JEDI-JVCL
 home page, located at http://jvcl.sourceforge.net

 The contents of this file are used with permission, subject to
 the Mozilla Public License Version 1.1 (the "License"); you may
 not use this file except in compliance with the License. You may
 obtain a copy of the License at
 http://www.mozilla.org/MPL/MPL-1_1Final.html

 Software distributed under the License is distributed on an
 "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 implied. See the License for the specific language governing
 rights and limitations under the License.

******************************************************************}

unit DSADialogsMainFormU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, JvDSADialogs, Menus, StdCtrls;

type
  TDSADialogsMainForm = class(TForm)
    lvDSAInfo: TListView;
    pmDSAList: TPopupMenu;
    miExecuteDlg: TMenuItem;
    miBreak1: TMenuItem;
    miReset: TMenuItem;
    stbMain: TStatusBar;
    btnClose: TButton;
    procedure lvDSAInfoResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure lvDSAInfoChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure pmDSAListPopup(Sender: TObject);
    procedure miExecuteDlgClick(Sender: TObject);
    procedure miResetClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
  private
    procedure SetStatus(Value: string);
  public
    procedure DoDlg1;
    procedure DoDlg2;
    procedure DoDlg3;
    procedure DoDlg4;
    procedure DoDlg5;
    procedure DoDlg6;
    procedure DoDlg7;
    procedure DoDlg8;
    procedure DoDlg9;
    function DoDlg9Callback(const Position, Max: Integer): Integer;
    procedure DoDlg10;
    function DoDlg10Callback(const Position, Max: Integer): Integer;
    procedure DoExecute(const DlgID: Integer);
    procedure FillListView;
    procedure RefreshDSAState(DlgID: Integer = 0; UpdateStatus: Boolean = False; ResCode: Integer = Integer($80000000); ResStr: string = '');

    property Status: string write SetStatus;
  end;

var
  DSADialogsMainForm: TDSADialogsMainForm;

implementation

{$R *.DFM}

uses
  DSAExamplesCustom1, DSAExamplesCustom2, DSAExamplesProgressDlg,
  JclBase;
  
const
  ctkMyMark: TDSACheckTextKind = 25;

procedure TDSADialogsMainForm.SetStatus(Value: string);
begin
  if Value = '' then
    Value := '(unknown)';
  stbMain.SimpleText := 'Status: ' + Value;
end;

procedure TDSADialogsMainForm.DoDlg1;
begin
  DSAShowMessage(1, 'Test ShowMessage with DSA support.');
  RefreshDSAState(1, True);
end;

procedure TDSADialogsMainForm.DoDlg2;
begin
  RefreshDSAState(2, True, DSAMessageDlg(
    2,
    'Simple warning box, standard title, VCL buttons and image.',
    mtWarning,
    [mbOK],
    0)
  );
end;

procedure TDSADialogsMainForm.DoDlg3;
var
  Pic: TPicture;
  BtnCap: TDynStringArray;
begin
  Pic := TPicture.Create;
  try
    Pic.Icon.Assign(Application.Icon);
    SetLength(BtnCap, 1);
    BtnCap[0] := 'I don''t care!';
    RefreshDSAState(3, True, DSAMessageDlgEx(
      3,
      'Test warning',
      'Extended warning box, custom title, buttons and image.',
      Pic.Graphic,
      BtnCap,
      [50],
      0)
    );
  finally
    Pic.Free;
  end;
end;

procedure TDSADialogsMainForm.DoDlg4;
begin
  RefreshDSAState(4, True, DSAMessageDlg(
    4,
    'Simple confirmation box, standard title, VCL buttons and image.',
    mtConfirmation,
    [mbYes, mbNo],
    0)
  );
end;

procedure TDSADialogsMainForm.DoDlg5;
var
  Pic: TPicture;
  BtnCap: TDynStringArray;
begin
  Pic := TPicture.Create;
  try
    Pic.Icon.Assign(Application.Icon);
    SetLength(BtnCap, 2);
    BtnCap[0] := 'Sure';
    BtnCap[1] := 'No way';
    RefreshDSAState(5, True, DSAMessageDlgEx(
      5,
      'Test warning',
      'Extended confirmation box, custom title, buttons and image.',
      Pic.Graphic,
      BtnCap,
      [10, 20],
      0)
    );
  finally
    Pic.Free;
  end;
end;

procedure TDSADialogsMainForm.DoDlg6;
begin
  DSAShowMessage(6, 'Test ShowMessage with custom checkmark text.');
  RefreshDSAState(6, True);
end;

procedure TDSADialogsMainForm.DoDlg7;
begin
  DoCustomDSA1;
  RefreshDSAState(7, True);
end;

procedure TDSADialogsMainForm.DoDlg8;
var
  ResStr: string;
begin
  ResStr := DoCustomDSA2;
  RefreshDSAState(8, True, Integer($80000000), ResStr);
end;

procedure TDSADialogsMainForm.DoDlg9;
begin
  DoProgress(DoDlg9Callback);
  RefreshDSAState(9, True);
end;

function TDSADialogsMainForm.DoDlg9Callback(const Position, Max: Integer): Integer;
begin
  DSAShowMessageFmt(9, 'Processing %d of %d.', [Position, Max], dckActiveForm);
  Result := mrOK;
end;

procedure TDSADialogsMainForm.DoDlg10;
begin
  DoProgress(DoDlg10Callback);
  RefreshDSAState(10, True);
end;

function TDSADialogsMainForm.DoDlg10Callback(const Position, Max: Integer): Integer;
begin
  Result := DSAMessageDlg(10, Format('About to process %d of %d. Continue?', [Position, Max]),
    mtConfirmation, [mbYes, mbNo], 0, dckActiveForm);
end;

procedure TDSADialogsMainForm.DoExecute(const DlgID: Integer);
begin
  Status := 'Executing...';
  case DlgID of
    1: DoDlg1;
    2: DoDlg2;
    3: DoDlg3;
    4: DoDlg4;
    5: DoDlg5;
    6: DoDlg6;
    7: DoDlg7;
    8: DoDlg8;
    9: DoDlg9;
    10: DoDlg10;
    else Status := 'Error: invalid dialog ID (' + IntToStr(DlgID) + ')';
  end;
end;

procedure TDSADialogsMainForm.FillListView;
var
  I: Integer;
  LI: TListItem;
begin
  lvDSAInfo.Items.BeginUpdate;
  try
    lvDSAInfo.Items.Clear;
    for I := 0 to DSACount - 1 do
    begin
      LI := lvDSAInfo.Items.Add;
      LI.Data := Pointer(DSAItem(I).ID);
      LI.Caption := '';
      LI.Checked := GetDSAState(DSAItem(I).ID);
      LI.SubItems.Add(IntToStr(DSAItem(I).ID));
      LI.SubItems.Add(DSAItem(I).Name);
      LI.SubItems.Add(DSAItem(I).Description);
    end;
  finally
    lvDSAInfo.Items.EndUpdate;
  end;
end;

procedure TDSADialogsMainForm.RefreshDSAState(DlgID: Integer; UpdateStatus: Boolean; ResCode: Integer; ResStr: string);
var
  I: Integer;
  S: string;
begin
  if DlgID <> 0 then
  begin
    I := lvDSAInfo.Items.Count - 1;
    while (I >= 0) and (Integer(lvDSAInfo.Items[I].Data) <> DlgID) do
      Dec(I);
    if I > -1 then
      lvDSAInfo.Items[I].Checked := GetDSAState(DlgID);
    if UpdateStatus then
    begin
      if GetDSAState(DlgID) then
        S := Format('Dialog %d has been suppressed.', [DlgID])
      else
        S := Format('Dialog %d has not been suppressed.', [DlgID]);
      if ResCode <> Integer($80000000) then
        S := S + ' Result value: ' + IntToStr(ResCode) + '.';
      if ResStr <> '' then
        S := S + ' Custom result: ' + ResStr + '.';
      Status := S;
    end;
  end
  else
  begin
    for I := lvDSAInfo.Items.Count - 1 downto 0 do
      lvDSAInfo.Items[I].Checked := GetDSAState(Integer(lvDSAInfo.Items[I].Data));
  end;
end;

procedure TDSADialogsMainForm.lvDSAInfoResize(Sender: TObject);
var
  AvailWidth: Integer;
  I: Integer;
begin
  AvailWidth := lvDSAInfo.ClientWidth;
  for I := 0 to lvDSAInfo.Columns.Count - 2 do
    Dec(AvailWidth, lvDSAInfo.Columns[I].Width);
  with lvDSAInfo.Columns[lvDSAInfo.Columns.Count - 1] do
  begin
    MinWidth := AvailWidth;
    MaxWidth := AvailWidth;
    Width := AVailWidth;
  end;
end;

procedure TDSADialogsMainForm.FormCreate(Sender: TObject);
begin
  // Alter registry location
  DSARegStore.Key := 'Software\JEDI-VCL\DSAExamples';
  
  // Add custom checkmark text
  RegisterDSACheckMarkText(ctkMyMark, 'Check to suppress this dialog');

  // Create DSAShowMessage example
  RegisterDSA(1, 'ShowMessage', 'ShowMessage example', DSARegStore, ctkShow);

  // Create DSAMessageDlg(Ex) examples
  RegisterDSA(2, 'Warning', 'MessageDlg warning', DSARegStore, ctkWarn);
  RegisterDSA(3, 'Warning2', 'MessageDlgEx warning', DSARegStore, ctkWarn);
  RegisterDSA(4, 'Confirm', 'MessageDlg confirmation', DSARegStore, ctkAsk);
  RegisterDSA(5, 'Confirm2', 'MessageDlgEx confirmation', DSARegStore, ctkAsk);
  RegisterDSA(6, 'CustomChk', 'Custom checkmark text', DSARegStore, ctkMyMark);

  // Create TJvDSADialog examples
  RegisterDSA(7, 'TJvDSADialog', 'Simple TJvDSADialog example', DSARegStore, ctkShow);
  RegisterDSA(8, 'TJvDSADialog2', 'TJvDSADialog example with custom data', DSARegStore, ctkAsk);

  // Create Queue tests
  RegisterDSA(9, 'Queue1', 'Simple queue ShowMessage', DSAQueueStore, ctkShow);
  RegisterDSA(10, 'Queue2', 'Queue MessageDlg confirmation', DSAQueueStore, ctkAsk);

  // Fill the user interface.
  FillListview;

  // Unknown status
  Status := '';
end;

procedure TDSADialogsMainForm.FormDestroy(Sender: TObject);
begin
  { It would be better to unregister the dialogs here, but it's not neccessary; the registration is
    removed on application shut down. }
end;

procedure TDSADialogsMainForm.FormShow(Sender: TObject);
begin
  lvDSAInfoResize(lvDSAInfo);
end;

procedure TDSADialogsMainForm.lvDSAInfoChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
var
  DSAState: Boolean;
begin
  if (Item.Data <> nil) and (Change = ctState) then
  begin
    DSAState := GetDSAState(Integer(Item.Data));
    if (Item.Checked <> DSAState) and not Item.Checked then
      SetDSAState(Integer(Item.Data), Item.Checked);
    RefreshDSAState(Integer(Item.Data));
  end;
end;

procedure TDSADialogsMainForm.pmDSAListPopup(Sender: TObject);
begin
  miExecuteDlg.Enabled := lvDSAInfo.ItemFocused <> nil;
  miReset.Enabled := (lvDSAInfo.ItemFocused <> nil) and lvDSAInfo.ItemFocused.Checked;
end;

procedure TDSADialogsMainForm.miExecuteDlgClick(Sender: TObject);
begin
  if lvDSAInfo.ItemFocused <> nil then
    DoExecute(Integer(lvDSAInfo.ItemFocused.Data));
end;

procedure TDSADialogsMainForm.miResetClick(Sender: TObject);
begin
  if (lvDSAInfo.ItemFocused <> nil) and lvDSAInfo.ItemFocused.Checked then
    lvDSAInfo.ItemFocused.Checked := False;
end;

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

end.