jvdialogs.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDialogs.PAS, released Oct 10, 1999.

The Initial Developer of the Original Code is Petr Vones (petr dott v att mujmail dott cz)
Portions created by Petr Vones are Copyright (C) 1999 Petr Vones.
Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
All Rights Reserved.

Contributor(s): Debbie Gregory <Debbie.Gregory att cmsis dott com>
                Marcel van Brakel <brakelm att bart dott nl>.

Current Version: 0.50

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvDialogs.pas,v 1.22 2005/02/17 10:20:23 marquardt Exp $

unit JvDialogs;

{$I jvcl.inc}
{$I vclonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  JVCLVer;

type
  TJvOpenDialogAC = (acEdit, acListView);
  TJvOpenDialogAS = (asSmallIcon, asReport);
  TDialogErrorEvent = procedure(Sender: TObject; ErrorCode:Cardinal) of object;
  TJvOpenDialog = class(TOpenDialog)
  private
    FAboutJVCL: TJVCLAboutInfo;
    FActiveControl: TJvOpenDialogAC;
    FActiveStyle: TJvOpenDialogAS;
    FActiveSettingDone: Boolean;
    FAutoSize: Boolean;
    FDefBtnCaption: string;
    FFilterLabelCaption: string;
    FInitialSize: TSize;
    FMakeResizeable: Boolean;
    FOriginalRect: TRect;
    FParentWndInstance, FOldParentWndInstance: Pointer;
    FParentWnd: HWND;
    {$IFDEF COMPILER5}
    FShowPlacesBar: Boolean;
    {$ENDIF COMPILER5}
    FOnShareViolation: TCloseQueryEvent;
    FHeight: Integer;
    FWidth: Integer;
    FUseUserSize: Boolean;
    FOnError: TDialogErrorEvent;
    procedure CenterAndSize;
    function DoActiveSetting: Boolean;
    procedure WMNCDestroy(var Msg: TWMNCDestroy); message WM_NCDESTROY;
    procedure SetDefBtnCaption(const Value: string);
    procedure SetFilterLabelCaption(const Value: string);
  protected
    procedure DoFolderChange; override;
    function DoShareViolation: Boolean; dynamic;
    procedure DoShow; override;
    function GetLocalizedSizeCommand: string;
    procedure ParentResize; dynamic;
    procedure ParentWndProc(var Msg: TMessage); virtual;
    function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool; override;
    procedure UpdateCaptions;
    procedure UpdateControlPos; dynamic;
    procedure WndProc(var Msg: TMessage); override;
  protected
    procedure DoError(ErrorCode:Cardinal);virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property ParentWnd: HWND read FParentWnd;
    procedure SelectFolder(const FolderName: string);
    property Template;
  published
    property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
    property ActiveControl: TJvOpenDialogAC read FActiveControl write FActiveControl default acEdit;
    property ActiveStyle: TJvOpenDialogAS read FActiveStyle write FActiveStyle default asSmallIcon;
    property AutoSize: Boolean read FAutoSize write FAutoSize default False;
    property DefBtnCaption: string read FDefBtnCaption write SetDefBtnCaption;
    property FilterLabelCaption: string read FFilterLabelCaption write SetFilterLabelCaption;
    property Height: Integer read FHeight write FHeight;
    {$IFDEF COMPILER5}
    property ShowPlacesBar: Boolean read FShowPlacesBar write FShowPlacesBar default True;
    {$ENDIF COMPILER5}
    property UseUserSize: Boolean read FUseUserSize write FUseUserSize default False;
    property Width: Integer read FWidth write FWidth;
    property OnError: TDialogErrorEvent read FOnError write FOnError;
    property OnShareViolation: TCloseQueryEvent read FOnShareViolation write FOnShareViolation;
  end;

  TJvSaveDialog = class(TJvOpenDialog)
    function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool; override;
  end;

  TJvCDQueryEvent = procedure(Sender: TObject; SelectedColor: TColor; var Accept: Boolean) of object;

  TJvColorDialog = class(TColorDialog)
  private
    FAboutJVCL: TJVCLAboutInfo;
    FColorOkMessage: DWORD;
    FSetRBGMessage: DWORD;
    FOnQueryColor: TJvCDQueryEvent;
    procedure WMNCDestroy(var Msg: TWMNCDestroy); message WM_NCDESTROY;
  protected
    procedure DoClose; override;
    procedure DoShow; override;
    function DoQueryColor(Color: TColor): Boolean; dynamic;
    function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SelectColor(Color: TColor);
  published
    property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
    property OnQueryColor: TJvCDQueryEvent read FOnQueryColor write FOnQueryColor;
  end;

var
  JvDialogsUseFixW2k: Boolean = True;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvDialogs.pas,v $';
    Revision: '$Revision: 1.22 $';
    Date: '$Date: 2005/02/17 10:20:23 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  CommDlg, CommCtrl, Dlgs,
  SysUtils, Math,
  JclSysInfo,
  JvJVCLUtils;

const
  btnOk = 1;
  btnCancel = 2;

type
  POpenFileName2000 = ^TOpenFileName2000;
  TOpenFileName2000 = packed record
    OpenFileName: TOpenFileName;
    pvReserved: Pointer;
    dwReserved: DWORD;
    FlagsEx: DWORD;
  end;

const
  OFN_EX_NOPLACESBAR = 1;

var
  W2kFixMsAcmLibrary: THandle = 0;

function IsWin2kOrAbove: Boolean;
begin
  Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and  (Win32MajorVersion >= 5);
end;

procedure UninstallW2kFix;
begin
  if W2kFixMsAcmLibrary > 0 then
  begin
    FreeLibrary(W2kFixMsAcmLibrary);
    W2kFixMsAcmLibrary := 0;
  end;
end;

procedure InstallW2kFix;
begin
  if JvDialogsUseFixW2k and IsWin2K and (W2kFixMsAcmLibrary = 0) then
    W2kFixMsAcmLibrary := LoadLibrary('msacm32.dll');
end;

//=== { TJvOpenDialog } ======================================================

constructor TJvOpenDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActiveControl := acEdit;
  FActiveStyle := asSmallIcon;
  FMakeResizeable := GetWindowsVersion in [wvWin95, wvWin95OSR2, wvWinNT4];
  FParentWndInstance := JvMakeObjectInstance(ParentWndProc);
  {$IFDEF COMPILER5}
  FShowPlacesBar := True;
  {$ENDIF COMPILER5}
  FParentWndInstance := JvMakeObjectInstance(ParentWndProc);
end;

destructor TJvOpenDialog.Destroy;
begin
  JvFreeObjectInstance(FParentWndInstance);
  inherited Destroy;
end;

procedure TJvOpenDialog.CenterAndSize;
var
  Monitor: TMonitor;
begin
  if UseUserSize then
  begin
    if Application.MainForm <> nil then
      Monitor := Application.MainForm.Monitor
    else
      Monitor := Screen.Monitors[0];
    SetWindowPos(FParentWnd, 0,
      Monitor.Left + ((Monitor.Width - Width) div 2),
      Monitor.Top + ((Monitor.Height - Height) div 3),
      Width, Height,
      SWP_NOACTIVATE or SWP_NOZORDER);
  end;
end;

function TJvOpenDialog.DoActiveSetting: Boolean;
var
  DefViewWnd, ListViewWnd: HWND;
begin
  Result := False;
  if not FActiveSettingDone then
  begin
    DefViewWnd := FindWindowEx(FParentWnd, 0, PChar('SHELLDLL_DefView'), nil);
    ListViewWnd := FindWindowEx(DefViewWnd, 0, PChar('SysListView32'), nil);
    if (DefViewWnd <> 0) and (ListViewWnd <> 0) then
    begin
      if FActiveStyle = asReport then
        SendMessage(DefViewWnd, WM_COMMAND, $702C, 0);
      if FActiveControl = acListView then
      begin
        SetFocus(ListViewWnd);
        PostMessage(ListViewWnd, WM_KEYDOWN, VK_SPACE, 0);
      end;
      FActiveSettingDone := True;
      CenterAndSize;
      Result := True;
    end;
  end;
end;

procedure TJvOpenDialog.DoFolderChange;
begin
  DoActiveSetting;
  inherited DoFolderChange;
end;

function TJvOpenDialog.DoShareViolation: Boolean;
begin
  Result := True;
  if Assigned(FOnShareViolation) then
    FOnShareViolation(Self, Result);
end;

procedure TJvOpenDialog.DoShow;
var
  SysMenu: HMENU;
  R: TRect;
begin
  FParentWnd := GetParent(Handle);
  GetClientRect(FParentWnd, FOriginalRect);
  GetWindowRect(FParentWnd, R);
  FInitialSize.cx := R.Right - R.Left;
  FInitialSize.cy := R.Bottom - R.Top;
  Width := Max(Width, FInitialSize.cx);
  Height := Max(Height, FInitialSize.cy);
  if FMakeResizeable and (ofEnableSizing in Options) then
  begin
    SetWindowLong(ParentWnd, GWL_STYLE, GetWindowLong(ParentWnd, GWL_STYLE) or WS_THICKFRAME);
    SetWindowPos(ParentWnd, 0, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or
      SWP_FRAMECHANGED or SWP_DRAWFRAME or SWP_NOCOPYBITS);
    SysMenu := GetSystemMenu(ParentWnd, False);
    InsertMenu(SysMenu, SC_CLOSE, MF_BYCOMMAND, SC_SIZE, PChar(GetLocalizedSizeCommand));
    FOldParentWndInstance := Pointer(SetWindowLong(FParentWnd, GWL_WNDPROC, Longint(FParentWndInstance)));
    UpdateControlPos;
  end;
  UpdateCaptions;
  inherited DoShow;
end;

function TJvOpenDialog.GetLocalizedSizeCommand: string;
var
  SysMenu: HMENU;
begin
  if not (csDesigning in ComponentState) and Assigned(Application.MainForm) then
  begin
    SysMenu := GetSystemMenu(Application.MainForm.Handle, False);
    SetString(Result, nil, 50);
    GetMenuString(SysMenu, SC_SIZE, PChar(Result), 50, MF_BYCOMMAND);
    Result := PChar(Result);
  end
  else
    Result := '';
  if Result = '' then
    Result := 'Size'; // do not localize
end;

procedure TJvOpenDialog.ParentResize;
begin
  InvalidateRect(ParentWnd, nil, False);
  UpdateControlPos;
end;

procedure TJvOpenDialog.ParentWndProc(var Msg: TMessage);
const
  SizeGripRectSize = 15;

  function SizeGripRect: TRect;
  begin
    GetClientRect(ParentWnd, Result);
    SetRect(Result, Result.Right - SizeGripRectSize, Result.Bottom - SizeGripRectSize,
      Result.Right, Result.Bottom);
  end;

  procedure PaintSizeGrip;
  var
    PS: TPaintStruct;
    DC: HDC;
    R: TRect;
    Pen, SavePen: HPen;
    I: Integer;
  begin
    DC := BeginPaint(ParentWnd, PS);
    R := SizeGripRect;
    Pen := CreatePen(PS_SOLID, 1, ColorToRGB(clBtnShadow));