📄 bsmessages.pas
字号:
{*******************************************************************}
{ }
{ Almediadev Visual Component Library }
{ BusinessSkinForm }
{ Version 1.99 }
{ }
{ Copyright (c) 2000-2003 Almediadev }
{ ALL RIGHTS RESERVED }
{ }
{ Home: http://www.almdev.com }
{ Support: support@almdev.com }
{ }
{*******************************************************************}
unit bsMessages;
interface
uses Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms,
BusinessSkinForm, bsSkinData, bsSkinCtrls, bsSkinBoxCtrls, Dialogs,
StdCtrls, ExtCtrls, bsSkinShellCtrls,registry;
type
TbsMessageForm = class(TForm)
protected
procedure HelpButtonClick(Sender: TObject);
public
BSF: TbsBusinessSkinForm;
Message: TbsSkinStdLabel;
constructor Create(AOwner: TComponent); override;
end;
TbsSkinMessage = class(TComponent)
protected
FSD: TbsSkinData;
FCtrlFSD: TbsSkinData;
FButtonSkinDataName: String;
FMessageLabelSkinDataName: String;
FDefaultFont: TFont;
FDefaultButtonFont: TFont;
FAlphaBlend: Boolean;
FAlphaBlendAnimation: Boolean;
FAlphaBlendValue: Byte;
FUseSkinFont: Boolean;
procedure SetDefaultFont(Value: TFont);
procedure SetDefaultButtonFont(Value: TFont);
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
function MessageDlg(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
property AlphaBlendAnimation: Boolean
read FAlphaBlendAnimation write FAlphaBlendAnimation;
property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
property SkinData: TbsSkinData read FSD write FSD;
property CtrlSkinData: TbsSkinData read FCtrlFSD write FCtrlFSD;
property ButtonSkinDataName: String
read FButtonSkinDataName write FButtonSkinDataName;
property MessageLabelSkinDataName: String
read FMessageLabelSkinDataName write FMessageLabelSkinDataName;
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property DefaultButtonFont: TFont read FDefaultButtonFont write SetDefaultButtonFont;
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
end;
TbsSkinProgressDialog = class(TComponent)
protected
FExecute: Boolean;
Gauge: TbsSkinGauge;
Form: TForm;
FSD: TbsSkinData;
FCtrlFSD: TbsSkinData;
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;
public
function Execute: Boolean;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
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: 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 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;
end;
TbsSkinInputDialog = class(TComponent)
protected
FSD: TbsSkinData;
FCtrlFSD: TbsSkinData;
FButtonSkinDataName: String;
FEditSkinDataName: String;
FLabelSkinDataName: String;
FDefaultLabelFont: TFont;
FDefaultEditFont: TFont;
FDefaultButtonFont: TFont;
FAlphaBlend: Boolean;
FAlphaBlendValue: Byte;
FAlphaBlendAnimation: Boolean;
FUseSkinFont: Boolean;
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: 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 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;
TbsSkinPasswordDialog = class(TComponent)
protected
FLoginMode: Boolean;
FCaption: String;
FLogin: String;
FLoginCaption: String;
FPasswordCaption: String;
FPassword: String;
FPasswordChar: Char;
FSD: TbsSkinData;
FCtrlFSD: TbsSkinData;
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 PasswordChar: Char read FPasswordChar write FPasswordChar;
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: 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 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;
TbsFontDlgForm = class(TForm)
public
BSF: TbsBusinessSkinForm;
FontNameBox: TbsSkinFontComboBox;
FontColorBox: TbsSkinColorComboBox;
FontSizeEdit: TbsSkinSpinEdit;
FontHeightEdit: TbsSkinSpinEdit;
FontExamplePanel: TbsSkinPanel;
FontExampleLabel: TLabel;
OkButton, CancelButton: TbsSkinButton;
FontNameLabel, FontColorLabel, FontSizeLabel,
FontHeightLabel, FontStyleLabel, FontExLabel: TbsSkinStdLabel;
BoldButton, ItalicButton,
UnderLineButton, StrikeOutButton: TbsSkinSpeedButton;
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;
TbsSkinFontDialog = class(TComponent)
private
FSD: TbsSkinData;
FCtrlFSD: TbsSkinData;
FDefaultFont: TFont;
FTitle: String;
FDlgFrm: TbsFontDlgForm;
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: TbsSkinData read FSD write FSD;
property CtrlSkinData: TbsSkinData 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;
TbsSkinTextDialog = class(TComponent)
protected
Memo: TbsSkinMemo2;
FShowToolBar: Boolean;
FCaption: String;
FSD: TbsSkinData;
FCtrlFSD: TbsSkinData;
FButtonSkinDataName: String;
FMemoSkinDataName: String;
FDefaultMemoFont: TFont;
FDefaultButtonFont: TFont;
FAlphaBlend: Boolean;
FAlphaBlendAnimation: Boolean;
FAlphaBlendValue: Byte;
FUseSkinFont: Boolean;
FClientWidth: Integer;
FClientHeight: Integer;
FLines: TStrings;
FSkinOpenDialog: TbsSkinOpenDialog;
FSkinSaveDialog: TbsSkinSaveDialog;
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 SkinOpenDialog: TbsSkinOpenDialog
read FSkinOpenDialog write FSkinOpenDialog;
property SkinSaveDialog: TbsSkinSaveDialog
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 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 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;
implementation
{$R *.res}
Uses bsUtils;
var
ButtonNames: array[TMsgDlgBtn] of string = (
'Yes', 'No', 'OK', 'Cancel', 'Abort', 'Retry', 'Ignore', 'All', 'NoToAll',
'YesToAll', 'Help');
ButtonCaptions: array[TMsgDlgBtn] of string = (
'是(&Y)', '否(&N)', '确定', '取消', '终止(&A)', '重试(&R)', '忽略(&I)', '全部(&A)', '全否(&O)',
'全是(&Y)', '帮助(&H)');
Captions: array[TMsgDlgType] of string = ('警告', '错误',
'信息', '确认', '');
ModalResults: array[TMsgDlgBtn] of Integer = (
mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
mrYesToAll, 0);
IconIDs: array[TMsgDlgType] of PChar = (IDI_EXCLAMATION, IDI_HAND,
IDI_ASTERISK, IDI_QUESTION, nil);
const
MSGFORMBUTTONWIDTH = 40;
function CreateMessageDialog(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; ASkinData, ACtrlSkinData: TbsSkinData;
AButtonSkinDataName: String; AMessageLabelSkinDataName: String;
ADefaultFont: TFont; ADefaultButtonFont: TFont; AUseSkinFont: Boolean;
AAlphaBlend, AAlphaBlendAnimation: Boolean; AAlphaBlendValue: Byte): TbsMessageForm;
var
BI, ButtonWidth,
ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth, X: Integer;
B, DefaultButton, CancelButton: TMsgDlgBtn;
IconID: PChar;
begin
Result := TbsMessageForm.Create(Application);
with Result do
begin
with BSF do
begin
SkinData := ASkinData;
MenusSkinData := ACtrlSkinData;
AlphaBlend := AAlphaBlend;
AlphaBlendAnimation := AAlphaBlendAnimation;
AlphaBlendValue := AAlphaBlendValue;
end;
ButtonWidth := 60;
//
if (ACtrlSkinData <> nil) and (not ACtrlSkinData.Empty)
then
begin
BI := ACtrlSkinData.GetControlIndex(AButtonSkinDataName);
if (BI <> -1) and
(TbsDataSkinControl(ACtrlSkinData.CtrlList.Items[BI]) is TbsDataSkinButtonControl)
then
begin
with TbsDataSkinButtonControl(ACtrlSkinData.CtrlList.Items[BI]) do
ButtonHeight := SkinRect.Bottom - SkinRect.Top;
end
else
ButtonHeight := 25;
end
else
ButtonHeight := 25;
//
ButtonSpacing := 10;
ButtonCount := 0;
for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
if B in Buttons then Inc(ButtonCount);
ButtonGroupWidth := 0;
if ButtonCount <> 0 then
ButtonGroupWidth := ButtonWidth * ButtonCount +
ButtonSpacing * (ButtonCount - 1);
Left := (Screen.Width div 2) - (Width div 2);
Top := (Screen.Height div 2) - (Height div 2);
if DlgType <> mtCustom
then Caption := Captions[DlgType]
else Caption := Application.Title;
// add icon
IconID := IconIDs[DlgType];
with TImage.Create(Result) do
begin
Name := 'Image';
Parent := Result;
Picture.Icon.Handle := LoadIcon(0, IconID);
SetBounds(5, 5, 32, 32);
end;
// add label
Result.Message := TbsSkinStdLabel.Create(Result);
with Result.Message do
begin
Font := ADefaultFont;
DefaultFont := ADefaultFont;
UseSkinFont := AUseSkinFont;
SkinDataName := AMessageLabelSkinDataName;
SkinData := ACtrlSkinData;
Name := 'Message';
Parent := Result;
AutoSize := True;
Caption := Msg;
Left := 50;
Top := 10;
X := Left + Width;
end;
ClientHeight := 45 + ButtonHeight + Result.Message.Height;
if ButtonGroupWidth < X
then
ClientWidth := X + 40
else
ClientWidth := ButtonGroupWidth + 40;
if Width > Result.BSF.GetMaxWidth
then
Width := Result.BSF.GetMaxWidth
else
if Width < Result.BSF.GetMinWidth
then
Width := Result.BSF.GetMinWidth;
// add buttons
if mbOk in Buttons then DefaultButton := mbOk else
if mbYes in Buttons then DefaultButton := mbYes else
DefaultButton := mbRetry;
if mbCancel in Buttons then CancelButton := mbCancel else
if mbNo in Buttons then CancelButton := mbNo else
CancelButton := mbOk;
X := (ClientWidth - ButtonGroupWidth) div 2;
for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
if B in Buttons then
with TbsSkinButton.Create(Result) do
begin
Parent := Result;
Name := ButtonNames[B];
CanFocused := True;
Caption := ButtonCaptions[B];
ModalResult := ModalResults[B];
if B = DefaultButton then Default := True;
if B = CancelButton then Cancel := True;
DefaultHeight := ButtonHeight;
SetBounds(X, Result.ClientHeight - ButtonHeight - 10,
ButtonWidth, ButtonHeight);
DefaultFont := ADefaultButtonFont;
UseSkinFont := AUseSkinFont;
Inc(X, ButtonWidth + ButtonSpacing);
if B = mbHelp then
OnClick := Result.HelpButtonClick;
SkinDataName := AButtonSkinDataName;
SkinData := ACtrlSkinData;
end;
end;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -