⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 spdialogs.pas

📁 P2P即时通讯源码(DELPHI编写)
💻 PAS
📖 第 1 页 / 共 4 页
字号:
{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       DynamicSkinForm                                             }
{       Version 5.60                                                }
{                                                                   }
{       Copyright (c) 2000-2003 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: support@almdev.com                                 }
{                                                                   }
{*******************************************************************}

unit spDialogs;

interface

uses Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms,
     DynamicSkinForm, SkinData, SkinCtrls, SkinBoxCtrls, Dialogs, StdCtrls, ExtCtrls,
     spSkinShellCtrls;

type
  TspPDShowType = (stStayOnTop, stModal);

  TspSkinProgressDialog = class(TComponent)
  protected
    FShowType: TspPDShowType;
    FOnCancel: TNotifyEvent;
    FOnShow: TNotifyEvent;
    FExecute: Boolean;
    Gauge: TspSkinGauge;
    Form: TForm;
    FSD: TspSkinData;
    FCtrlFSD: TspSkinData;
    FButtonSkinDataName: String;
    FGaugeSkinDataName: String;
    FLabelSkinDataName: String;
    FDefaultLabelFont: TFont;
    FDefaultGaugeFont: TFont;
    FDefaultButtonFont: TFont;
    FAlphaBlend: Boolean;
    FAlphaBlendValue: Byte;
    FAlphaBlendAnimation: Boolean;
    FUseSkinFont: Boolean;
    FMinValue, FMaxValue, FValue: Integer;
    FCaption: String;
    FLabelCaption: String;
    FShowPercent: Boolean;

    procedure SetValue(AValue: Integer);
    procedure SetDefaultLabelFont(Value: TFont);
    procedure SetDefaultButtonFont(Value: TFont);
    procedure SetDefaultGaugeFont(Value: TFont);
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
    procedure CancelBtnClick(Sender: TObject);
    procedure OnFormClose(Sender: TObject; var Action: TCloseAction);
    procedure OnFormShow(Sender: TObject);
  public
    function Execute: Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ShowType: TspPDShowType read FShowType write FShowType;
    property Caption: String read FCaption write FCaption;
    property LabelCaption: String read FLabelCaption write FLabelCaption;
    property ShowPercent: Boolean read FShowPercent write FShowPercent;
    property MinValue: Integer read FMinValue write FMinValue;
    property MaxValue: Integer read FMaxValue write FMaxValue;
    property Value: Integer read FValue write SetValue;
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property SkinData: TspSkinData read FSD write FSD;
    property CtrlSkinData: TspSkinData read FCtrlFSD write FCtrlFSD;
    property ButtonSkinDataName: String
      read FButtonSkinDataName write FButtonSkinDataName;
    property LabelSkinDataName: String
      read FLabelSkinDataName write FLabelSkinDataName;
    property GaugeSkinDataName: String
     read FGaugeSkinDataName write FGaugeSkinDataName;
    property DefaultLabelFont: TFont read FDefaultLabelFont write SetDefaultLabelFont;
    property DefaultButtonFont: TFont read FDefaultButtonFont write SetDefaultButtonFont;
    property DefaultGaugeFont: TFont read FDefaultGaugeFont write SetDefaultGaugeFont;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
    property OnCancel: TNotifyEvent read FOnCancel write FOnCancel;
  end;

  TspSkinInputDialog = class(TComponent)
  protected
    Form: TForm;
    FSD: TspSkinData;
    FCtrlFSD: TspSkinData;
    FButtonSkinDataName: String;
    FEditSkinDataName: String;
    FLabelSkinDataName: String;
    FDefaultLabelFont: TFont;
    FDefaultEditFont: TFont;
    FDefaultButtonFont: TFont;
    FUseSkinFont: Boolean;
    FAlphaBlend: Boolean;
    FAlphaBlendValue: Byte;
    FAlphaBlendAnimation: Boolean;
    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure SetDefaultLabelFont(Value: TFont);
    procedure SetDefaultButtonFont(Value: TFont);
    procedure SetDefaultEditFont(Value: TFont);
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
  public
    function InputBox(const ACaption, APrompt, ADefault: string): string;
    function InputQuery(const ACaption, APrompt: string; var Value: string): 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: TspSkinData read FSD write FSD;
    property CtrlSkinData: TspSkinData read FCtrlFSD write FCtrlFSD;
    property ButtonSkinDataName: String
      read FButtonSkinDataName write FButtonSkinDataName;
    property LabelSkinDataName: String
      read FLabelSkinDataName write FLabelSkinDataName;
    property EditSkinDataName: String
     read FEditSkinDataName write FEditSkinDataName;
    property DefaultLabelFont: TFont read FDefaultLabelFont write SetDefaultLabelFont;
    property DefaultButtonFont: TFont read FDefaultButtonFont write SetDefaultButtonFont;
    property DefaultEditFont: TFont read FDefaultEditFont write SetDefaultEditFont;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
  end;

  TspFontDlgForm = class(TForm)
  public
    DSF: TspDynamicSkinForm;

    FontNameBox: TspSkinFontComboBox;
    FontColorBox: TspSkinColorComboBox;
    FontSizeEdit: TspSkinSpinEdit;
    FontHeightEdit: TspSkinSpinEdit;
    FontExamplePanel: TspSkinPanel;
    FontExampleLabel: TLabel;
    OkButton, CancelButton: TspSkinButton;
    FontNameLabel, FontColorLabel, FontSizeLabel,
    FontHeightLabel, FontStyleLabel, FontExLabel: TspSkinStdLabel;
    BoldButton, ItalicButton,
    UnderLineButton, StrikeOutButton: TspSkinSpeedButton;

    constructor Create(AOwner: TComponent); override;

    procedure FontSizeChange(Sender: TObject);
    procedure FontHeightChange(Sender: TObject);
    procedure FontNameChange(Sender: TObject);
    procedure FontColorChange(Sender: TObject);
    procedure BoldButtonClick(Sender: TObject);
    procedure ItalicButtonClick(Sender: TObject);
    procedure StrikeOutButtonClick(Sender: TObject);
    procedure UnderLineButtonClick(Sender: TObject);
  end;

  TspSkinFontDialog = class(TComponent)
  private
    FSD: TspSkinData;
    FCtrlFSD: TspSkinData;
    FDefaultFont: TFont;
    FTitle: String;
    FDlgFrm: TspFontDlgForm;
    FOnChange: TNotifyEvent;
    FFont: TFont;
    FShowSizeEdit, FShowHeightEdit: Boolean;
    FAlphaBlend: Boolean;
    FAlphaBlendAnimation: Boolean;
    FAlphaBlendValue: Byte;
    function GetTitle: string;
    procedure SetTitle(const Value: string);
    procedure SetFont(Value: TFont);
    procedure SetDefaultFont(Value: TFont);
  protected
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
    procedure Change;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
  published
     property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property SkinData: TspSkinData read FSD write FSD;
    property CtrlSkinData: TspSkinData read FCtrlFSD write FCtrlFSD;
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
    property Font: TFont read FFont write SetFont;
    property Title: string read GetTitle write SetTitle;
    property ShowSizeEdit: Boolean read FShowSizeEdit write FShowSizeEdit;
    property ShowHeightEdit: Boolean read FShowHeightEdit write FShowHeightEdit;
    property OnChange: TnotifyEvent read FOnChange write FOnChange;
  end;

  TspSkinTextDialog = class(TComponent)
  protected
    Memo: TspSkinMemo2;
    FShowToolBar: Boolean;
    FCaption: String;
    FSD: TspSkinData;
    FCtrlFSD: TspSkinData;
    FButtonSkinDataName: String;
    FMemoSkinDataName: String;
    FDefaultMemoFont: TFont;
    FDefaultButtonFont: TFont;
    FUseSkinFont: Boolean;
    FClientWidth: Integer;
    FClientHeight: Integer;
    FLines: TStrings;
    FSkinOpenDialog: TspSkinOpenDialog;
    FSkinSaveDialog: TspSkinSaveDialog;
    FAlphaBlend: Boolean;
    FAlphaBlendAnimation: Boolean;
    FAlphaBlendValue: Byte;
    procedure SetLines(Value: TStrings);
    procedure SetClientWidth(Value: Integer);
    procedure SetClientHeight(Value: Integer);
    procedure SetDefaultButtonFont(Value: TFont);
    procedure SetDefaultMemoFont(Value: TFont);
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
    //
    procedure NewButtonClick(Sender: TObject);
    procedure OpenButtonClick(Sender: TObject);
    procedure SaveButtonClick(Sender: TObject);
    procedure CopyButtonClick(Sender: TObject);
    procedure CutButtonClick(Sender: TObject);
    procedure PasteButtonClick(Sender: TObject);
    procedure DeleteButtonClick(Sender: TObject);
    //
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
  published
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property SkinOpenDialog: TspSkinOpenDialog
      read FSkinOpenDialog write FSkinOpenDialog;
    property SkinSaveDialog: TspSkinSaveDialog
      read FSkinSaveDialog write FSkinSaveDialog;
    property ShowToolBar: Boolean read FShowToolBar write FShowToolBar;
    property Lines: TStrings read FLines write SetLines;
    property ClientWidth: Integer read FClientWidth write SetClientWidth;
    property ClientHeight: Integer read FClientHeight write SetClientHeight;
    property Caption: String read FCaption write FCaption;
    property SkinData: TspSkinData read FSD write FSD;
    property CtrlSkinData: TspSkinData read FCtrlFSD write FCtrlFSD;
    property ButtonSkinDataName: String
      read FButtonSkinDataName write FButtonSkinDataName;
    property MemoSkinDataName: String
     read FMemoSkinDataName write FMemoSkinDataName;
    property DefaultButtonFont: TFont read FDefaultButtonFont write SetDefaultButtonFont;
    property DefaultMemoFont: TFont read FDefaultMemoFont write SetDefaultMemoFont;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
  end;

  TspSkinPasswordDialog = class(TComponent)
  protected
    FLoginMode: Boolean;
    FCaption: String;
    FLogin: String;
    FLoginCaption: String;
    FPasswordCaption: String;
    FPassword: String;
    FPasswordKind: TspPasswordKind;
    FSD: TspSkinData;
    FCtrlFSD: TspSkinData;
    FButtonSkinDataName: String;
    FEditSkinDataName: String;
    FLabelSkinDataName: String;
    FDefaultLabelFont: TFont;
    FDefaultEditFont: TFont;
    FDefaultButtonFont: TFont;
    FAlphaBlend: Boolean;
    FAlphaBlendAnimation: Boolean;
    FAlphaBlendValue: Byte;
    FUseSkinFont: Boolean;
    procedure SetDefaultLabelFont(Value: TFont);
    procedure SetDefaultButtonFont(Value: TFont);
    procedure SetDefaultEditFont(Value: TFont);
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
  published
    property LoginMode: Boolean read FLoginMode write FLoginMode;
    property Login: String read FLogin write FLogin;
    property LoginCaption: String read FLoginCaption write FLoginCaption;
    property Password: String read FPassword write FPassword;
    property PasswordKind: TspPasswordKind read FPasswordKind write FPasswordKind;
    property Caption: String read FCaption write FCaption;
    property PasswordCaption: String read FPasswordCaption write FPasswordCaption;
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property SkinData: TspSkinData read FSD write FSD;
    property CtrlSkinData: TspSkinData read FCtrlFSD write FCtrlFSD;
    property ButtonSkinDataName: String
      read FButtonSkinDataName write FButtonSkinDataName;
    property LabelSkinDataName: String
      read FLabelSkinDataName write FLabelSkinDataName;
    property EditSkinDataName: String
     read FEditSkinDataName write FEditSkinDataName;
    property DefaultLabelFont: TFont read FDefaultLabelFont write SetDefaultLabelFont;
    property DefaultButtonFont: TFont read FDefaultButtonFont write SetDefaultButtonFont;
    property DefaultEditFont: TFont read FDefaultEditFont write SetDefaultEditFont;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
  end;

  TspSkinConfirmDialog = class(TComponent)
  protected
    FCaption: String;
    FPassword1: String;
    FPassword1Caption: String;
    FPassword2: String;
    FPassword2Caption: String;
    FPasswordKind: TspPasswordKind;
    FSD: TspSkinData;
    FCtrlFSD: TspSkinData;
    FButtonSkinDataName: String;
    FEditSkinDataName: String;
    FLabelSkinDataName: String;
    FDefaultLabelFont: TFont;
    FDefaultEditFont: TFont;
    FDefaultButtonFont: TFont;
    FAlphaBlend: Boolean;
    FAlphaBlendAnimation: Boolean;
    FAlphaBlendValue: Byte;
    FUseSkinFont: Boolean;
    procedure SetDefaultLabelFont(Value: TFont);
    procedure SetDefaultButtonFont(Value: TFont);
    procedure SetDefaultEditFont(Value: TFont);
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
  published
    property Password1: String read FPassword1 write FPassword1;
    property Password1Caption: String read FPassword1Caption write FPassword1Caption;
    property Password2: String read FPassword2 write FPassword2;
    property Password2Caption: String read FPassword2Caption write FPassword2Caption;
    property PasswordKind: TspPasswordKind read FPasswordKind write FPasswordKind;
    property Caption: String read FCaption write FCaption;
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property SkinData: TspSkinData read FSD write FSD;
    property CtrlSkinData: TspSkinData read FCtrlFSD write FCtrlFSD;
    property ButtonSkinDataName: String
      read FButtonSkinDataName write FButtonSkinDataName;
    property LabelSkinDataName: String
      read FLabelSkinDataName write FLabelSkinDataName;
    property EditSkinDataName: String
     read FEditSkinDataName write FEditSkinDataName;
    property DefaultLabelFont: TFont read FDefaultLabelFont write SetDefaultLabelFont;
    property DefaultButtonFont: TFont read FDefaultButtonFont write SetDefaultButtonFont;
    property DefaultEditFont: TFont read FDefaultEditFont write SetDefaultEditFont;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
  end;

implementation
  Uses spConst;
{$R *.res}

constructor TspSkinInputDialog.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 TspSkinInputDialog.Destroy;
begin
  FDefaultLabelFont.Free;
  FDefaultButtonFont.Free;
  FDefaultEditFont.Free;
  inherited;
end;

procedure TspSkinInputDialog.EditKeyDown;
begin
  if Key = 27
  then
    Form.ModalResult := mrCancel
  else
  if Key = 13
  then
    Form.ModalResult := mrOk;
end;
procedure TspSkinInputDialog.SetDefaultLabelFont;
begin
  FDefaultLabelFont.Assign(Value);
end;

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

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

procedure TspSkinInputDialog.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 TspSkinInputDialog.InputQuery(const ACaption, APrompt: string; var Value: string): Boolean;
const
  WS_EX_LAYERED = $80000;
  
var
  DSF: TspDynamicSkinForm;
  Prompt: TspSkinStdLabel;
  Edit: TspSkinEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
  Form := TForm.Create(Application);
  Form.BorderStyle := bsDialog;
  Form.Caption := ACaption;
  Form.Position := poScreenCenter;
  DSF := TspDynamicSkinForm.Create(Form);
  DSF.BorderIcons := [];
  DSF.SkinData := SkinData;
  DSF.MenusSkinData := CtrlSkinData;
  DSF.SizeAble := False;
  DSF.AlphaBlend := AlphaBlend;
  DSF.AlphaBlendAnimation := AlphaBlendAnimation;
  DSF.AlphaBlendValue := AlphaBlendValue;
  //

  try

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

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

  Edit := TspSkinEdit.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);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -