{==============================================================================

  Custom Controls
  Copyright (C) 2000-2001 by Evgeny Kryukov
  All rights reserved

  All contents of this file and all other files included in this archive
  are Copyright (C) 2001 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

===============================================================================}

unit KsMessages;

{$I KsCommonVer.Inc}
{$S-,R-,W-,H+,P+}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons, KsBitmap, KsUtils, KsForms, KsControls, KsEdits,
  KsButtons, KsEffects;

type

{ TKsCustomMessage }

  TKsCustomMessage = class(TComponent)
  private
    FDropShadow: boolean;
    FBlend: boolean;
    FShadowWidth: integer;
    FBlendValue: integer;
    FShowAnimationTime: integer;
    FShowAnimation: TKsAnimation;
    FCanMove: boolean;
    FSimpleDrag: boolean;
    FShowButtonGlyph: boolean;
    FShowIconImage: boolean;
    FPosition: TPosition;
    function CreateMessageDialog(const Msg: string; DlgType: TMsgDlgType;
      Buttons: TMsgDlgButtons): TForm;
    procedure SetCanMove(const Value: boolean);
    procedure SetPosition(const Value: TPosition);
  protected
    function CreateButton(Owner: TComponent): TKsCustomButton; virtual;
    function CreateEdit(Owner: TComponent): TKsCustomEdit; virtual;
    function CreateForm(Owner: TComponent): TKsCustomForm; virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Messages }
    function InputBox(const ACaption, APrompt, ADefault: string): string;
    function InputQuery(const ACaption, APrompt: string;
      var Value: string): Boolean;

    function MessageDlg(const Msg: string; DlgType: TMsgDlgType;
      Buttons: TMsgDlgButtons; HelpCtx: Integer): Integer;
    function MessageDlgPos(const Msg: string; DlgType: TMsgDlgType;
      Buttons: TMsgDlgButtons; HelpCtx, X, Y: Integer): Integer;
    function MessageDlgPosHelp(const Msg: string; DlgType: TMsgDlgType;
      Buttons: TMsgDlgButtons; HelpCtx, X, Y: Integer;
      const HelpFileName: string): Integer;

    procedure ShowMessage(const Msg: string);
    procedure ShowMessageFmt(const Msg: string; Params: array of const);
    procedure ShowMessagePos(const Msg: string; X, Y: Integer);
  published
    property Blend: boolean read FBlend write FBlend;
    property BlendValue: integer read FBlendValue write FBlendValue;
    property CanMove: boolean read FCanMove write SetCanMove;
    property DropShadow: boolean read FDropShadow write FDropShadow;
    property Position: TPosition read FPosition write SetPosition;
    property ShadowWidth: integer read FShadowWidth write FShadowWidth;
    property ShowButtonGlyph: boolean read FShowButtonGlyph write FShowButtonGlyph default true;
    property ShowIconImage: boolean read FShowIconImage write FShowIconImage default true;
    property ShowAnimation: TKsAnimation read FShowAnimation write FShowAnimation;
    property ShowAnimationTime: integer read FShowAnimationTime write FShowAnimationTime;
    property SimpleDrag: boolean read FSimpleDrag write FSimpleDrag;
  end;

implementation {===============================================================}

uses ImgList, ActnList, CommCtrl, KsCommonConst;

var
  Captions: array[TMsgDlgType] of Pointer = (@SMsgDlgWarning, @SMsgDlgError,
    @SMsgDlgInformation, @SMsgDlgConfirm, nil);
  IconIDs: array[TMsgDlgType] of PChar = (IDI_EXCLAMATION, IDI_HAND,
    IDI_ASTERISK, IDI_QUESTION, nil);
  ButtonNames: array[TMsgDlgBtn] of string = (
    'Yes', 'No', 'OK', 'Cancel', 'Abort', 'Retry', 'Ignore', 'All', 'NoToAll',
    'YesToAll', 'Help');
  ButtonCaptions: array[TMsgDlgBtn] of Pointer = (
    @SMsgDlgYes, @SMsgDlgNo, @SMsgDlgOK, @SMsgDlgCancel, @SMsgDlgAbort,
    @SMsgDlgRetry, @SMsgDlgIgnore, @SMsgDlgAll, @SMsgDlgNoToAll, @SMsgDlgYesToAll,
    @SMsgDlgHelp);
  ButtonKinds: array[TMsgDlgBtn] of TBitBtnKind = (
    bkYes, bkNo, bkOK, bkCancel, bkAbort, bkRetry, bkIgnore, bkAll, bkNo,
    bkYes, bkHelp);
  ButtonWidths: array[TMsgDlgBtn] of integer;  { initialized to zero }

type

  TKsMessageForm = class(TForm)
  private
    FForm: TKsCustomForm;
    procedure DoHelpButton(Sender: TObject);
  public
    constructor CreateForm(AOwner: TComponent; AMessageComp: TKsCustomMessage);
  end;

{ TKsMessageForm }

constructor TKsMessageForm.CreateForm(AOwner: TComponent; AMessageComp: TKsCustomMessage);
begin
  inherited CreateNew(AOwner);
  Position := poScreenCenter;
  KeyPreview := true;

  FForm := AMessageComp.CreateForm(Self);
  FForm.BorderStyle := kbsStandard;
  FForm.CanResize := false;
  FForm.CanMove := false;
  FForm.BorderIcons := [kbiClose, kbiSystemMenu];

  with AMessageComp do
  begin
    FForm.Blend := Blend;
    FForm.BlendValue := BlendValue;
    FForm.CanMove := CanMove;
    FForm.DropShadow := DropShadow;
    FForm.ShadowWidth := ShadowWidth;
    FForm.ShowAnimation := ShowAnimation;
    FForm.ShowAnimationTime := ShowAnimationTime;
    FForm.SimpleDrag := FSimpleDrag; 
  end;

  FForm.Active := true;
end;

procedure TKsMessageForm.DoHelpButton(Sender: TObject);
begin
  Application.HelpContext(HelpContext);
end;

{ TKsCustomMessage ============================================================}

constructor TKsCustomMessage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Blend := false;
  BlendValue := 200;
  CanMove := true;
  DropShadow := false;
  Position := poScreenCenter;
  ShadowWidth := 4;
  ShowAnimation := kaNone;
  ShowAnimationTime := 300;
  ShowButtonGlyph := true;
  ShowIconImage := true;
end;

destructor TKsCustomMessage.Destroy;
begin
  inherited Destroy;
end;

function TKsCustomMessage.CreateButton(Owner: TComponent): TKsCustomButton;
begin
  Result := TKsCustomButton.Create(Owner);
end;

function TKsCustomMessage.CreateEdit(Owner: TComponent): TKsCustomEdit;
begin
  Result := TKsCustomEdit.Create(Owner);
end;

function TKsCustomMessage.CreateForm(Owner: TComponent): TKsCustomForm;
begin
  Result := TKsCustomForm.Create(Owner);
end;


function Max(I, J: Integer): Integer;
begin
  if I > J then Result := I else Result := J;
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 TKsCustomMessage.CreateMessageDialog(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons): TForm;
const
  mcHorzMargin = 30;
  mcVertMargin = 15;
  mcHorzSpacing = 10;
  mcVertSpacing = 10;
  mcButtonWidth = 50;
  mcButtonHeight = 14;
  mcButtonSpacing = 4;
var
  DialogUnits: TPoint;
  HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth,
  ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,
  IconTextWidth, IconTextHeight, X, ALeft: Integer;
  B, DefaultButton, CancelButton: TMsgDlgBtn;
  IconID: PChar;
  TextRect: TRect;
begin
  Result := TKsMessageForm.CreateForm(Application, Self);
  with Result do
  begin
    { Standard }
    BiDiMode := Application.BiDiMode;
    Canvas.Font := Font;
    DialogUnits := GetAveCharSize(Canvas);
    HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
    VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
    HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);
    VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
    ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
    begin
      if B in Buttons then
      begin
        if ButtonWidths[B] = 0 then
        begin
          TextRect := Rect(0,0,0,0);
          Windows.DrawText( canvas.handle,
            PChar(LoadResString(ButtonCaptions[B])), -1,
            TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
            DrawTextBiDiModeFlagsReadingOnly);
          with TextRect do ButtonWidths[B] := Right - Left + 8;
        end;
        if ButtonWidths[B] > ButtonWidth then
          ButtonWidth := ButtonWidths[B];
      end;
    end;
    ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8);
    ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
    SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
    DrawText(Canvas.Handle, PChar(Msg), Length(Msg)+1, TextRect,
      DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
      DrawTextBiDiModeFlagsReadingOnly);
    IconID := IconIDs[DlgType];
    IconTextWidth := TextRect.Right;
    IconTextHeight := TextRect.Bottom;
    if (IconID <> nil) and FShowIconImage then
    begin
      Inc(IconTextWidth, 32 + HorzSpacing);
      if IconTextHeight < 32 then IconTextHeight := 32;
    end;
    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);
    ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin * 2;
    ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +
      VertMargin * 2;
    Left := (Screen.Width div 2) - (Width div 2);
    Top := (Screen.Height div 2) - (Height div 2);
    if DlgType <> mtCustom then
      Caption := LoadResString(Captions[DlgType]) else
      Caption := Application.Title;
    if (IconID <> nil) and (FShowIconImage) then
      with TImage.Create(Result) do
      begin
        Name := 'Image';
        Parent := Result;
        Picture.Icon.Handle := LoadIcon(0, IconID);
        SetBounds(HorzMargin, VertMargin, 32, 32);
      end;
    with TLabel.Create(Result) do
    begin
      Name := 'Message';
      Parent := Result;
      WordWrap := True;
      Transparent := true;
      Caption := Msg;
      BoundsRect := TextRect;
      BiDiMode := Result.BiDiMode;
      ALeft := IconTextWidth - TextRect.Right + HorzMargin;
      if UseRightToLeftAlignment then
        ALeft := Result.ClientWidth - ALeft - Width;
      SetBounds(ALeft, VertMargin,
        TextRect.Right, TextRect.Bottom);
    end;
    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 CreateButton(Result) do
        begin
          Name := ButtonNames[B];
          Parent := Result;
          Caption := LoadResString(ButtonCaptions[B]);
          Kind := ButtonKinds[B];
          if not FShowButtonGlyph then
            Glyph := nil;
          if B = DefaultButton then Default := True;
//          if B = CancelButton then Cancel := True;
          SetBounds(X, IconTextHeight + VertMargin + VertSpacing,
            ButtonWidth, ButtonHeight);
          Inc(X, ButtonWidth + ButtonSpacing);
          if B = mbHelp then
            OnClick := (Result as TKsMessageForm).DoHelpButton;
        end;
  end;
end;

function TKsCustomMessage.MessageDlg(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
begin
  Result := MessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, -1, -1, '');
end;

function TKsCustomMessage.MessageDlgPos(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer;
begin
  Result := MessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, X, Y, '');
end;

function TKsCustomMessage.MessageDlgPosHelp(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
  const HelpFileName: string): Integer;
begin
  with CreateMessageDialog(Msg, DlgType, Buttons) do
  begin
    try
      HelpContext := HelpCtx;
      HelpFile := HelpFileName;
      if (Y < 0) and (X < 0) then
        Position := FPosition
      else
        Position := poDefault;
      if X >= 0 then Left := X;
      if Y >= 0 then Top := Y;
      Result := ShowModal;
    finally
      Free;
    end;
  end;
end;

procedure TKsCustomMessage.ShowMessage(const Msg: string);
begin
  ShowMessagePos(Msg, -1, -1);
end;

procedure TKsCustomMessage.ShowMessageFmt(const Msg: string; Params: array of const);
begin
  ShowMessage(Format(Msg, Params));
end;

procedure TKsCustomMessage.ShowMessagePos(const Msg: string; X, Y: Integer);
begin
  MessageDlgPos(Msg, mtCustom, [mbOK], 0, X, Y);
end;

{ Input dialog }

function TKsCustomMessage.InputQuery(const ACaption, APrompt: string;
  var Value: string): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TKsCustomEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
  Result := False;
  Form := TKsMessageForm.CreateForm(Application, Self);
  with Form do
    try
      { Standard }
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4)+30;
      ClientHeight := MulDiv(63, DialogUnits.Y, 8)+20;
      Position := FPosition;
      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Transparent := true;
        Parent := Form;
        AutoSize := True;
        Left := MulDiv(8, DialogUnits.X, 4) + 15;
        Top := MulDiv(8, DialogUnits.Y, 8) + 10;
        Caption := APrompt;
      end;
      Edit := CreateEdit(Form);
      with Edit do
      begin
        Parent := Form;
        Left := Prompt.Left;
        Top := MulDiv(19, DialogUnits.Y, 8) + 10;
        Width := MulDiv(164, DialogUnits.X, 4);
        MaxLength := 255;
        Text := Value;
        SelectAll;
      end;
      ButtonTop := MulDiv(41, DialogUnits.Y, 8);
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with CreateButton(Form) do
      begin
        Parent := Form;
        Caption := SMsgDlgOK;
        Kind := bkOk;
        if not FShowButtonGlyph then
          Glyph := nil;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4)+15, ButtonTop+10, ButtonWidth,
          ButtonHeight);
      end;
      with CreateButton(Form) do
      begin
        Parent := Form;
        Caption := SMsgDlgCancel;
        Kind := bkCancel;
        if not FShowButtonGlyph then
          Glyph := nil;
        SetBounds(MulDiv(92, DialogUnits.X, 4)+15, ButtonTop+10, ButtonWidth,
          ButtonHeight);
        Left := Left + 15;
      end;
      if ShowModal = mrOk then
      begin
        Value := Edit.Text;
        Result := True;
      end;
    finally
      Form.Free;
    end;
end;

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

procedure TKsCustomMessage.SetCanMove(const Value: boolean);
begin
  FCanMove := Value;
end;

procedure TKsCustomMessage.SetPosition(const Value: TPosition);
begin
  FPosition := Value;
end;

initialization
  FillChar(ButtonWidths, SizeOf(ButtonWidths), 0);
end.


