sdialogs.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sDialogs;
{$I sDefs.inc}

interface

uses Windows, Dialogs, Forms, Classes, sSkinProvider, SysUtils, Graphics, ExtCtrls,
  Math, sStrings, ExtDlgs, sPanel, sLabel, sSpeedButton, sButton, Controls, sConst, FileCtrl;

type
{$IFNDEF NOTFORHELP}
  TsZipShowing = (zsAsFolder, zsAsFile);
{$ENDIF} // NOTFORHELP

{ TsOpenDialog }
  TsOpenDialog = class(TOpenDialog)
  private
    FZipShowing: TsZipShowing;
{$IFNDEF NOTFORHELP}
  public
    constructor Create(AOwner: TComponent); override;
{$ENDIF} // NOTFORHELP
  published
    property ZipShowing: TsZipShowing read FZipShowing write FZipShowing default zsAsFolder;
  end;

{ TsOpenPictureDialog }
  TsOpenPictureDialog = class(TOpenPictureDialog)
{$IFNDEF NOTFORHELP}
  private
    FPicture: TPicture;
    function IsFilterStored: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoSelectionChange; override;
    procedure DoShow; override;
  published
    property Filter stored IsFilterStored;
{$ENDIF} // NOTFORHELP
  end;

{ TsSaveDialog }
  TsSaveDialog = class(TSaveDialog)
{$IFNDEF NOTFORHELP}
  public
{$ENDIF} // NOTFORHELP
  end;

{ TsSavePictureDialog }
  TsSavePictureDialog = class(TSavePictureDialog)
{$IFNDEF NOTFORHELP}
  private
    FPicture: TPicture;
    function IsFilterStored: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Filter stored IsFilterStored;
{$ENDIF} // NOTFORHELP
  end;

  TsColorDialog = class(TColorDialog)
{$IFNDEF NOTFORHELP}
  private
    FMainColors: TStrings;
    procedure SetMainColors(const Value: TStrings);
  public
    function Execute: Boolean; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoShow; override;
    procedure DoClose; override;
  published
    property Options default [cdFullOpen];
{$ENDIF} // NOTFORHELP
    property MainColors: TStrings read FMainColors write SetMainColors;
  end;

  TsPathDialog = class(TComponent)
{$IFNDEF NOTFORHELP}
  private
    FPath: TsDirectory;
    FRoot: TacRoot;
    FCaption: string;
    FNoChangeDir: boolean;
    FOptions: TSelectDirOpts;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
{$ENDIF} // NOTFORHELP
    function Execute: Boolean;
  published
    property Path : TsDirectory read FPath write FPath;
    property Root : TacRoot read FRoot write FRoot;
    property Caption : string read FCaption write FCaption;
    property NoChangeDir : boolean read FNoChangeDir write FNoChangeDir default False;
{$IFNDEF NOTFORHELP}
    property DialogOptions: TSelectDirOpts read FOptions write FOptions default [sdAllowCreate, sdPerformCreate, sdPrompt];
{$ENDIF} // NOTFORHELP
  end;

{$IFNDEF NOTFORHELP}
{ Message dialog }
function sCreateMessageDialog(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): TForm;
{$ENDIF} // NOTFORHELP

// Overloaded versions added RS 31/10/05 to allow title and message
function sMessageDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: LongInt): Integer; overload;
function sMessageDlg(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: LongInt): Integer; overload;
function sMessageDlgPos(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: LongInt; X, Y: Integer): Integer; overload;
function sMessageDlgPos(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: LongInt; X, Y: Integer): Integer; overload;
function sMessageDlgPosHelp(const Title, Msg: string; DlgType: TMsgDlgType; Buttons:
  TMsgDlgButtons; HelpCtx: LongInt; X, Y: Integer; const HelpFileName: string): Integer;

procedure sShowMessage(const Msg: string); overload;
procedure sShowMessage(const Title, Msg: string); overload;
procedure sShowMessageFmt(const Msg: string; Params: array of const); overload;
procedure sShowMessageFmt(const Title, Msg: string; Params: array of const); overload;
procedure sShowMessagePos(const Msg: string; X, Y: Integer); overload;
procedure sShowMessagePos(const Title, Msg: string; X, Y: Integer); overload;

{ Input dialog }
function sInputBox(const ACaption, APrompt, ADefault: string): string;
function sInputQuery(const ACaption, APrompt: string; var Value: string): Boolean;

implementation

uses sEdit, Consts, sSkinProps, sBitBtn, sOpendialog, acntUtils, sStyleSimply,
  sColorDialog, sFontDialog, acPathDialog, acShellCtrls, sSKinManager, ShlObj, acDials;

var
{.$IFNDEF D2006
  Captions: array[TMsgDlgType] of Pointer = (@SMsgDlgWarning, @SMsgDlgError, @SMsgDlgInformation, @SMsgDlgConfirm, nil);
$ELSE}
  Captions: array[TMsgDlgType] of string = ('Warning', 'Error', 'Information', 'Confirm', '');
{.$ENDIF}

function sCreateMessageDialog(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): TForm;
begin
  Result := CreateMessageDialog(Msg, DlgType, Buttons);
end;

function sMessageDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: LongInt): Integer;
begin
  Result := sMessageDlgPosHelp('', Msg, DlgType, Buttons, HelpCtx, -1, -1, '');
end;

function sMessageDlg(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: LongInt): Integer;
begin
  Result := sMessageDlgPosHelp(Title, Msg, DlgType, Buttons, HelpCtx, -1, -1, '');
end;

function sMessageDlgPos(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: LongInt; X, Y: Integer): Integer;
begin
  Result := sMessageDlgPosHelp('', Msg, DlgType, Buttons, HelpCtx, X, Y, '');
end;

function sMessageDlgPos(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: LongInt; X, Y: Integer): Integer;
begin
  Result := sMessageDlgPosHelp(Title, Msg, DlgType, Buttons, HelpCtx, X, Y, '');
end;

function sMessageDlgPosHelp(const Title, Msg: string; DlgType: TMsgDlgType; Buttons:
  TMsgDlgButtons; HelpCtx: LongInt; X, Y: Integer; const HelpFileName: string): Integer;
const
  MB_HELP = $4000;
  MB_YESTOALL = $A000;
var
  Flags : cardinal;
  Caption : string;
begin
  case DlgType of
    mtWarning : Flags := MB_ICONWARNING;
    mtError : Flags := MB_ICONERROR;
    mtInformation : Flags := MB_ICONINFORMATION;
    mtConfirmation : Flags := MB_ICONQUESTION
    else Flags := 0;
  end;                                    
  Flags := Flags or MB_APPLMODAL;
{.$IFNDEF D2006
  if Title = '' then Caption := LoadResString(Captions[DlgType]) else Caption := Title;
$ELSE}
  if Title = '' then Caption := Captions[DlgType] else Caption := Title;
{.$ENDIF}

  if mbOk in Buttons then begin
    if mbCancel in Buttons then Flags := Flags or MB_OKCANCEL else Flags := Flags or MB_OK;
  end
  else if (mbAbort in Buttons) or (mbIgnore in Buttons) then Flags := MB_ABORTRETRYIGNORE
  else if (mbYes in Buttons) or (mbNo in Buttons) then begin
    if mbCancel in Buttons then Flags := Flags or MB_YESNOCANCEL else Flags := Flags or MB_YESNO;
  end
  else if mbRetry in Buttons then Flags := Flags or MB_RETRYCANCEL;

  if mbHelp in Buttons then Flags := Flags or MB_HELP;

  DlgLeft := X; DlgTop := Y;
  Result := Application.MessageBox({Application.Handle, }PAnsiChar(Msg), PAnsiChar(Caption), Flags);
  DlgLeft := -1; DlgTop := -1;
end;

procedure sShowMessage(const Msg: string);
begin
  sShowMessagePos(Msg, -1, -1);
end;

procedure sShowMessage(const Title, Msg: string);
begin
  sShowMessagePos(Title, Msg, -1, -1);
end;

procedure sShowMessageFmt(const Msg: string; Params: array of const);
begin
  sShowMessage(Format(Msg, Params));
end;

procedure sShowMessageFmt(const Title, Msg: string; Params: array of const);
begin
  sShowMessage(Title, Format(Msg, Params));
end;

procedure sShowMessagePos(const Msg: string; X, Y: Integer);
begin
  sMessageDlgPos(Msg, mtCustom, [mbOK], 0, X, Y);
end;

procedure sShowMessagePos(const Title, Msg: string; X, Y: Integer);
begin
  sMessageDlgPos(Title, Msg, mtCustom, [mbOK], 0, X, Y);
end;

{ Input dialog }

function sInputQuery(const ACaption, APrompt: string; var Value: string): Boolean;
begin
  Result := InputQuery(ACaption, APrompt, Value);
end;

function sInputBox(const ACaption, APrompt, ADefault: string): string;
begin
  Result := ADefault;
  sInputQuery(ACaption, APrompt, Result);
end;

{ TsOpenDialog }

constructor TsOpenDialog.Create(AOwner: TComponent);
begin
  inherited;
  FZipShowing := zsAsFolder;
end;

{ TsOpenPictureDialog }

constructor TsOpenPictureDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Filter := GraphicFilter(TGraphic);
end;

destructor TsOpenPictureDialog.Destroy;
begin
  if Assigned(FPicture) then FreeAndNil(FPicture);
  inherited;
end;

procedure TsOpenPictureDialog.DoSelectionChange;
begin
  if csDestroying in ComponentState then Exit;
  inherited DoSelectionChange;
end;

procedure TsOpenPictureDialog.DoShow;
begin
  inherited DoShow;
end;

function TsOpenPictureDialog.IsFilterStored: Boolean;
begin
  Result := not (Filter = GraphicFilter(TGraphic));
end;

{ TsSavePictureDialog }

constructor TsSavePictureDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Filter := GraphicFilter(TGraphic);
end;

destructor TsSavePictureDialog.Destroy;
begin
  if Assigned(FPicture) then FreeAndNil(FPicture);
  inherited;
end;

function TsSavePictureDialog.IsFilterStored: Boolean;
begin
  Result := not (Filter = GraphicFilter(TGraphic));
end;

{ TsColorDialog }

constructor TsColorDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMainColors := TStringList.Create;
  Options := [cdFullOpen];
end;

destructor TsColorDialog.Destroy;
begin
  FreeAndNil(FMainColors);
  inherited Destroy;
end;

procedure TsColorDialog.DoClose;
begin
  inherited;

end;

procedure TsColorDialog.DoShow;
begin
  inherited;
end;

function TsColorDialog.Execute: Boolean;
{$IFNDEF USESTDDIALOGS}
const
  MaxWidth = 545;
  MinWidth = 235;
var
  sColorDialogForm: TsColorDialogForm;
{$ENDIF}
begin
{$IFNDEF USESTDDIALOGS}
  if Assigned(DefaultManager) {and DefaultManager.SkinData.Active }then begin
    sColorDialogForm := TsColorDialogForm.Create(Application);
    sColorDialogForm.InitLngCaptions;
    sColorDialogForm.Owner := Self;
    if CustomColors.Count > 0 then begin
      sColorDialogForm.AddPal.Colors.Assign(CustomColors);
      sColorDialogForm.AddPal.GenerateColors;
    end;
    if MainColors.Count > 0 then begin
      sColorDialogForm.MainPal.Colors.Assign(MainColors);
      sColorDialogForm.MainPal.GenerateColors;
    end;

    sColorDialogForm.ModalResult := mrCancel;
    sColorDialogForm.BorderStyle := bsSingle;

    sColorDialogForm.sBitBtn4.Enabled := not (cdFullOpen in Options);
    if sColorDialogForm.sBitBtn4.Enabled then sColorDialogForm.Width := MinWidth else sColorDialogForm.Width := MaxWidth;
    if (cdPreventFullOpen in Options) then
      sColorDialogForm.sBitBtn4.Enabled := False;
    sColorDialogForm.sBitBtn5.Visible := (cdShowHelp in Options);

    sColorDialogForm.sSkinProvider1.PrepareForm;
    sColorDialogForm.ShowModal;
    Result := sColorDialogForm.ModalResult = mrOk;
    CustomColors.Assign(sColorDialogForm.AddPal.Colors);
    DoClose;
    if Result then Color := sColorDialogForm.SelectedPanel.Color;

    if sColorDialogForm <> nil then sColorDialogForm.Free;
  end
  else
{$ENDIF}
    Result := inherited Execute;
end;

procedure TsColorDialog.SetMainColors(const Value: TStrings);
begin
  FMainColors.Assign(Value);
end;

{ TsPathDialog }

constructor TsPathDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRoot := SRFDesktop;
  FNoChangeDir := False;
  FOptions := [sdAllowCreate, sdPerformCreate, sdPrompt];
end;

destructor TsPathDialog.Destroy;
begin
  inherited;
end;

function TsPathDialog.Execute: Boolean;
var
  s: string;
begin
  Result := False;
  s := Path;
  if not DirectoryExists(s) or (s = '.') then s := '';//GetAppPath; v4.54
  if not NoChangeDir and (s <> '') then ChDir(s);

  if Assigned(DefaultManager) and DefaultManager.SkinData.Active then begin
    PathDialogForm := TPathDialogForm.Create(Application);
    PathDialogForm.InitLngCaptions;
    PathDialogForm.sBitBtn3.Visible := sdAllowCreate in DialogOptions;
    try
      PathDialogForm.sShellTreeView1.BoundLabel.Caption := Caption;
      PathDialogForm.sShellTreeView1.Root := FRoot;
      if (s = '') then begin // v4.62
        if PathDialogForm.sShellTreeView1.Items.Count > 0 then PathDialogForm.sShellTreeView1.Items[0].Selected := True;
      end
      else begin
        PathDialogForm.sShellTreeView1.Path := s;
      end;
      if PathDialogForm.ShowModal = mrOk then begin
        s := PathDialogForm.sShellTreeView1.Path;
        if (s <> '') and DirectoryExists(s) then Path := s;
        Result := True
      end;
    finally
      FreeAndnil(PathDialogForm);
    end;
  end
  else begin
    if SelectDirectory(Caption, FRoot, s) then begin
      if (s <> '') and DirectoryExists(s) then Path := s;
      Result := True
    end;
  end;
end;

end.