bsdialogs.pas

Delphi开发的图象处理软件

    function Execute(const ACaption, APrompt: string; var ValueIndex: Integer): Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property SkinData: TbsSkinData read FSD write FSD;
    property CtrlSkinData: TbsSkinData read FCtrlFSD write FCtrlFSD;
    property ButtonSkinDataName: String read FButtonSkinDataName write FButtonSkinDataName;
    property LabelSkinDataName: String read FLabelSkinDataName write FLabelSkinDataName;
    property ComboboxSkinDataName: String read FSelectSkinDataName write FSelectSkinDataName;
    property SelectValues: TStrings read FSelectValues Write SetSelectValues;
    property DefaultValue: Integer read FDefaultValueIndex Write FDefaultValueIndex;
    property DefaultLabelFont: TFont read FDefaultLabelFont write SetDefaultLabelFont;
    property DefaultButtonFont: TFont read FDefaultButtonFont write SetDefaultButtonFont;
    property DefaultComboBoxFont: TFont read FDefaultSelectFont write SetDefaultSelectFont;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
  end;

  TbsSelectSkinsFromFoldersDlgForm = class(TForm)
  public
    FSkinsFolder: String;
    FIniFileName: String;
    BSF: TbsBusinessSkinForm;
    OpenButton, CancelButton: TbsSkinButton;
    PreviewForm: TForm;
    PreviewBSF: TbsBusinessSkinForm;
    PreviewSkinData: TbsSkinData;
    PreviewButton: TbsSkinButton;
    SkinsListBox: TbsSkinListBox;
    constructor CreateEx(AOwner: TComponent; ASkinsFolder, ADefaultSkinFolder, AIniFileName: String);
    destructor Destroy; override;
    procedure SLBOnChange(Sender: TObject);
    procedure SLBOnDblClick(Sender: TObject);
  end;

  TbsSelectSkinsFromFoldersDialog = class(TComponent)
  private
    FSD: TbsSkinData;
    FCtrlFSD: TbsSkinData;
    FDefaultFont: TFont;
    FTitle: String;
    FDlgFrm: TbsSelectSkinsFromFoldersDlgForm;
    FAlphaBlend: Boolean;
    FAlphaBlendValue: Byte;
    FAlphaBlendAnimation: Boolean;
    FFileName: String;
    FFolderName: String;
    function GetTitle: string;
    procedure SetTitle(const Value: string);
    procedure SetDefaultFont(Value: TFont);
  protected
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute(ASkinsFolder, ADefaultSkinFolder, AIniFileName: String): Boolean;
    property FileName: String read FFileName;
    property FolderName: String read FFolderName;
  published
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property SkinData: TbsSkinData read FSD write FSD;
    property CtrlSkinData: TbsSkinData read FCtrlFSD write FCtrlFSD;
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
    property Title: string read GetTitle write SetTitle;
  end;

implementation

{$R *.res}

Uses bsUtils, bsConst;

// script

const
  ScriptNames: array[0..18] of String =
   ('ANSI_CHARSET', 'DEFAULT_CHARSET', 'SYMBOL_CHARSET', 'SHIFTJIS_CHARSET',
    'HANGEUL_CHARSET', 'GB2312_CHARSET', 'CHINESEBIG5_CHARSET',
    'OEM_CHARSET', 'JOHAB_CHARSET', 'HEBREW_CHARSET', 'ARABIC_CHARSET',
    'GREEK_CHARSET', 'TURKISH_CHARSET', 'VIETNAMESE_CHARSET',
    'THAI_CHARSET', 'EASTEUROPE_CHARSET', 'RUSSIAN_CHARSET',
    'MAC_CHARSET', 'BALTIC_CHARSET');

  ScriptCodes: array[0..18] of TFontCharSet =
   (0, 1, 2, $80, 129, 134, 136, 255, 130, 177, 178, 161, 162, 163,
    222, 238, 204, 77, 186);


function GetIndexFromCharSet(CharSet: TFontCharSet): Integer;
var
  I: Integer;
begin
  Result := 1;
  for I := 0 to 18 do
    if CharSet =  ScriptCodes[I]
    then
      begin
        Result := I;
        Break;
      end;
end;

function GetCharSetFormIndex(Index: Integer): TFontCharSet;
begin
  if Index <> -1
  then
    Result := ScriptCodes[Index]
  else
    Result := 1;  
end;

//

constructor TbsSkinInputDialog.Create;
begin
  inherited Create(AOwner);

  FAlphaBlend := False;
  FAlphaBlendAnimation := False;
  FAlphaBlendValue := 200;

  FButtonSkinDataName := 'button';
  FLabelSkinDataName := 'stdlabel';
  FEditSkinDataName := 'edit';

  FDefaultLabelFont := TFont.Create;
  FDefaultButtonFont := TFont.Create;
  FDefaultEditFont := TFont.Create;

  FUseSkinFont := True;

  with FDefaultLabelFont do
  begin
    Name := 'Arial';
    Style := [];
    Height := 14;
  end;

  with FDefaultButtonFont do
  begin
    Name := 'Arial';
    Style := [];
    Height := 14;
  end;

  with FDefaultEditFont do
  begin
    Name := 'Arial';
    Style := [];
    Height := 14;
  end;
end;

destructor TbsSkinInputDialog.Destroy;
begin
  FDefaultLabelFont.Free;
  FDefaultButtonFont.Free;
  FDefaultEditFont.Free;
  inherited;
end;

procedure TbsSkinInputDialog.EditKeyDown;
begin
  if Key = 27
  then
    Form.ModalResult := mrCancel
  else
  if Key = 13
  then
    Form.ModalResult := mrOk;
end;

procedure TbsSkinInputDialog.SetDefaultLabelFont;
begin
  FDefaultLabelFont.Assign(Value);
end;

procedure TbsSkinInputDialog.SetDefaultEditFont;
begin
  FDefaultEditFont.Assign(Value);
end;

procedure TbsSkinInputDialog.SetDefaultButtonFont;
begin
  FDefaultButtonFont.Assign(Value);
end;

procedure TbsSkinInputDialog.Notification;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
  if (Operation = opRemove) and (AComponent = FCtrlFSD) then FCtrlFSD := nil;
end;


function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
  for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
  for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;

function TbsSkinInputDialog.InputQuery(const ACaption, APrompt: string; var Value: string): Boolean;
var

  BSF: TbsBusinessSkinForm;
  Prompt: TbsSkinStdLabel;
  Edit: TbsSkinEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
  Form := TForm.Create(Application);
  Form.BorderStyle := bsDialog;
  Form.Caption := ACaption;
  Form.Position := poScreenCenter;
  BSF := TbsBusinessSkinForm.Create(Form);
  BSF.BorderIcons := [];
  BSF.SkinData := SkinData;
  BSF.MenusSkinData := CtrlSkinData;
  BSF.AlphaBlend := AlphaBlend;
  BSF.AlphaBlendAnimation := AlphaBlendAnimation;
  BSF.AlphaBlendValue := AlphaBlendValue;

  try

  with Form do
  begin
    Canvas.Font := Font;
    DialogUnits := GetAveCharSize(Canvas);
    ClientWidth := MulDiv(180, DialogUnits.X, 4);
  end;

  Prompt := TbsSkinStdLabel.Create(Form);
  with Prompt do
  begin
    Parent := Form;
    Left := MulDiv(8, DialogUnits.X, 4);
    Top := MulDiv(8, DialogUnits.Y, 8);
    Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
    WordWrap := False;
    DefaultFont := DefaultLabelFont;
    UseSkinFont := Self.UseSkinFont;
    SkinDataName := FLabelSkinDataName;
    SkinData := CtrlSkinData;
    Caption := APrompt;
  end;

  Edit := TbsSkinEdit.Create(Form);
  with Edit do
  begin
    Parent := Form;
    OnKeyDown := EditKeydown;
    DefaultFont := DefaultEditFont;
    UseSkinFont := Self.UseSkinFont;
    Left := Prompt.Left;
    Top := Prompt.Top + Prompt.Height + 5;
    DefaultWidth := MulDiv(164, DialogUnits.X, 4);
    MaxLength := 255;
    Text := Value;
    SelectAll;
    SkinDataName := FEditSkinDataName;
    SkinData := CtrlSkinData;
  end;

  ButtonTop := Edit.Top + Edit.Height + 15;
  ButtonWidth := MulDiv(50, DialogUnits.X, 4);
  ButtonHeight := MulDiv(14, DialogUnits.Y, 8);

  with TbsSkinButton.Create(Form) do
  begin
    Parent := Form;
    DefaultFont := DefaultButtonFont;
    UseSkinFont := Self.UseSkinFont;
    Caption := BS_MSG_BTN_OK;
    ModalResult := mrOk;
    Default := True;
    SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
              ButtonHeight);
    DefaultHeight := ButtonHeight;
    SkinDataName := FButtonSkinDataName;
    SkinData := CtrlSkinData;
  end;

  with TbsSkinButton.Create(Form) do
  begin
    Parent := Form;
    DefaultFont := DefaultButtonFont;
    UseSkinFont := Self.UseSkinFont;
    Caption := BS_MSG_BTN_CANCEL;
    ModalResult := mrCancel;
    Cancel := True;
    SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15,
              ButtonWidth, ButtonHeight);
    DefaultHeight := ButtonHeight;
    SkinDataName := FButtonSkinDataName;
    SkinData := CtrlSkinData;
    Form.ClientHeight := Top + Height + 13;
  end;

  if Form.ShowModal = mrOk
  then
    begin
      Value := Edit.Text;
      Result := True;
    end
  else
    Result := False;

  finally
    Form.Free;
  end;
end;

function TbsSkinInputDialog.InputBox(const ACaption, APrompt, ADefault: string): string;
begin
  Result := ADefault;
  InputQuery(ACaption, APrompt, Result);
end;

constructor TbsSkinPasswordDialog.Create;
begin
  inherited Create(AOwner);

  FAlphaBlend := False;
  FAlphaBlendAnimation := False;
  FAlphaBlendValue := 200;

  LoginMode := False;

  FCaption := 'Password';

  FPasswordCaption := 'Password:';
  FPassword := '';

  FLoginCaption := 'Login name:';
  FLogin := '';

  FButtonSkinDataName := 'button';
  FLabelSkinDataName := 'stdlabel';
  FEditSkinDataName := 'edit';

  FDefaultLabelFont := TFont.Create;
  FDefaultButtonFont := TFont.Create;
  FDefaultEditFont := TFont.Create;

  FUseSkinFont := True;

  with FDefaultLabelFont do
  begin
    Name := 'Arial';
    Style := [];
    Height := 14;
  end;

  with FDefaultButtonFont do
  begin
    Name := 'Arial';
    Style := [];
    Height := 14;
  end;

  with FDefaultEditFont do
  begin
    Name := 'Arial';
    Style := [];
    Height := 14;
  end;
end;

destructor TbsSkinPasswordDialog.Destroy;
begin
  FDefaultLabelFont.Free;
  FDefaultButtonFont.Free;
  FDefaultEditFont.Free;
  inherited;
end;

procedure TbsSkinPasswordDialog.SetDefaultLabelFont;
begin
  FDefaultLabelFont.Assign(Value);
end;

procedure TbsSkinPasswordDialog.SetDefaultEditFont;
begin
  FDefaultEditFont.Assign(Value);
end;

procedure TbsSkinPasswordDialog.SetDefaultButtonFont;
begin
  FDefaultButtonFont.Assign(Value);
end;

procedure TbsSkinPasswordDialog.Notification;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
  if (Operation = opRemove) and (AComponent = FCtrlFSD) then FCtrlFSD := nil;
end;

function TbsSkinPasswordDialog.Execute: Boolean;
var
  Form: TForm;
  BSF: TbsBusinessSkinForm;
  Image: TImage;
  LoginLabel, PasswordLabel: TbsSkinStdLabel;
  LoginEdit:  TbsSkinEdit;
  PasswordEdit: TbsSkinPasswordEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
  LeftOffset: Integer;
begin
  Form := TForm.Create(Application);
  Form.BorderStyle := bsDialog;
  Form.Caption := FCaption;
  Form.Position := poScreenCenter;
  BSF := TbsBusinessSkinForm.Create(Form);
  BSF.BorderIcons := [];
  BSF.SkinData := SkinData;
  BSF.MenusSkinData := CtrlSkinData;
  BSF.AlphaBlend := AlphaBlend;
  BSF.AlphaBlendAnimation := AlphaBlendAnimation;
  BSF.AlphaBlendValue := AlphaBlendValue;

  try

  with Form do
  begin
    Canvas.Font := Font;
    DialogUnits := GetAveCharSize(Canvas);

    Image := TImage.Create(Form);

    with Image do
    begin
      Parent := Form;
      Top := MulDiv(8, DialogUnits.Y, 8);
      Left := MulDiv(8, DialogUnits.X, 4);
      AutoSize := True;
      Transparent := True;
      Picture.Bitmap.Handle := LoadBitMap(HInstance, 'BS_KEY');
    end;