Files

318 lines
9.0 KiB
ObjectPascal

{*****************************************************************************}
{ }
{ Tnt Delphi Unicode Controls }
{ http://www.tntware.com/delphicontrols/unicode/ }
{ Version: 2.3.0 }
{ }
{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
{ }
{*****************************************************************************}
unit TntExtDlgs;
{$INCLUDE compilers.inc}
interface
uses
Classes, Windows, TntDialogs, TntExtCtrls, TntStdCtrls, TntButtons;
type
{TNT-WARN TOpenPictureDialog}
TTntOpenPictureDialog = class(TTntOpenDialog)
private
FPicturePanel: TTntPanel;
FPictureLabel: TTntLabel;
FPreviewButton: TTntSpeedButton;
FPaintPanel: TTntPanel;
FImageCtrl: TTntImage;
FSavedFilename: WideString;
function IsFilterStored: Boolean;
procedure PreviewKeyPress(Sender: TObject; var Key: Char{TNT-ALLOW Char});
protected
procedure PreviewClick(Sender: TObject); virtual;
procedure DoClose; override;
procedure DoSelectionChange; override;
procedure DoShow; override;
property ImageCtrl: TTntImage read FImageCtrl;
property PictureLabel: TTntLabel read FPictureLabel;
published
property Filter stored IsFilterStored;
public
constructor Create(AOwner: TComponent); override;
function Execute: Boolean; override;
{$IFDEF COMPILER_9_UP}
function Execute(ParentWnd: HWND): Boolean; override;
{$ENDIF}
end;
{TNT-WARN TSavePictureDialog}
TTntSavePictureDialog = class(TTntOpenPictureDialog)
public
function Execute: Boolean; override;
{$IFDEF COMPILER_9_UP}
function Execute(ParentWnd: HWND): Boolean; override;
{$ENDIF}
end;
implementation
uses
ExtDlgs, {ExtDlgs is needed for a linked resource} Dialogs, Consts, Messages,
Graphics, Math, Controls, Forms, SysUtils, CommDlg, TntSysUtils, TntForms;
{ TTntSilentPaintPanel }
type
TTntSilentPaintPanel = class(TTntPanel)
protected
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
end;
procedure TTntSilentPaintPanel.WMPaint(var Msg: TWMPaint);
begin
try
inherited;
except
Caption := SInvalidImage;
end;
end;
{ TTntOpenPictureDialog }
constructor TTntOpenPictureDialog.Create(AOwner: TComponent);
begin
inherited;
Filter := GraphicFilter(TGraphic);
FPicturePanel := TTntPanel.Create(Self);
with FPicturePanel do
begin
Name := 'PicturePanel';
Caption := '';
SetBounds(204, 5, 169, 200);
BevelOuter := bvNone;
BorderWidth := 6;
TabOrder := 1;
FPictureLabel := TTntLabel.Create(Self);
with FPictureLabel do
begin
Name := 'PictureLabel';
Caption := '';
SetBounds(6, 6, 157, 23);
Align := alTop;
AutoSize := False;
Parent := FPicturePanel;
end;
FPreviewButton := TTntSpeedButton.Create(Self);
with FPreviewButton do
begin
Name := 'PreviewButton';
SetBounds(77, 1, 23, 22);
Enabled := False;
Glyph.LoadFromResourceName(FindClassHInstance(TOpenPictureDialog{TNT-ALLOW TOpenPictureDialog}), 'PREVIEWGLYPH');
Hint := SPreviewLabel;
ParentShowHint := False;
ShowHint := True;
OnClick := PreviewClick;
Parent := FPicturePanel;
end;
FPaintPanel := TTntSilentPaintPanel.Create(Self);
with FPaintPanel do
begin
Name := 'PaintPanel';
Caption := '';
SetBounds(6, 29, 157, 145);
Align := alClient;
BevelInner := bvRaised;
BevelOuter := bvLowered;
TabOrder := 0;
FImageCtrl := TTntImage.Create(Self);
Parent := FPicturePanel;
with FImageCtrl do
begin
Name := 'PaintBox';
Align := alClient;
OnDblClick := PreviewClick;
Parent := FPaintPanel;
Proportional := True;
Stretch := True;
Center := True;
IncrementalDisplay := True;
end;
end;
end;
end;
procedure TTntOpenPictureDialog.DoClose;
begin
inherited;
{ Hide any hint windows left behind }
Application.HideHint;
end;
procedure TTntOpenPictureDialog.DoSelectionChange;
var
FullName: WideString;
ValidPicture: Boolean;
function ValidFile(const FileName: WideString): Boolean;
begin
Result := WideFileGetAttr(FileName) <> $FFFFFFFF;
end;
begin
FullName := FileName;
if FullName <> FSavedFilename then
begin
FSavedFilename := FullName;
ValidPicture := WideFileExists(FullName) and ValidFile(FullName);
if ValidPicture then
try
FImageCtrl.Picture.LoadFromFile(FullName);
FPictureLabel.Caption := WideFormat(SPictureDesc,
[FImageCtrl.Picture.Width, FImageCtrl.Picture.Height]);
FPreviewButton.Enabled := True;
FPaintPanel.Caption := '';
except
ValidPicture := False;
end;
if not ValidPicture then
begin
FPictureLabel.Caption := SPictureLabel;
FPreviewButton.Enabled := False;
FImageCtrl.Picture := nil;
FPaintPanel.Caption := srNone;
end;
end;
inherited;
end;
procedure TTntOpenPictureDialog.DoShow;
var
PreviewRect, StaticRect: TRect;
begin
{ Set preview area to entire dialog }
GetClientRect(Handle, PreviewRect);
StaticRect := GetStaticRect;
{ Move preview area to right of static area }
PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left);
Inc(PreviewRect.Top, 4);
FPicturePanel.BoundsRect := PreviewRect;
FPreviewButton.Left := FPaintPanel.BoundsRect.Right - FPreviewButton.Width - 2;
FImageCtrl.Picture := nil;
FSavedFilename := '';
FPaintPanel.Caption := srNone;
FPicturePanel.ParentWindow := Handle;
inherited;
end;
function TTntOpenPictureDialog.Execute: Boolean;
begin
if NewStyleControls and not (ofOldStyleDialog in Options) then
Template := 'DLGTEMPLATE' else
Template := nil;
Result := inherited Execute;
end;
{$IFDEF COMPILER_9_UP}
function TTntOpenPictureDialog.Execute(ParentWnd: HWND): Boolean;
begin
if NewStyleControls and not (ofOldStyleDialog in Options) then
Template := 'DLGTEMPLATE' else
Template := nil;
Result := inherited Execute(ParentWnd);
end;
{$ENDIF}
function TTntOpenPictureDialog.IsFilterStored: Boolean;
begin
Result := not (Filter = GraphicFilter(TGraphic));
end;
procedure TTntOpenPictureDialog.PreviewClick(Sender: TObject);
var
PreviewForm: TTntForm;
Panel: TTntPanel;
begin
PreviewForm := TTntForm.Create(Self);
with PreviewForm do
try
Name := 'PreviewForm';
BorderStyle := bsSizeToolWin; // By doing this first, it will work on WINE.
Visible := False;
Caption := SPreviewLabel;
KeyPreview := True;
Position := poScreenCenter;
OnKeyPress := PreviewKeyPress;
Panel := TTntPanel.Create(PreviewForm);
with Panel do
begin
Name := 'Panel';
Caption := '';
Align := alClient;
BevelOuter := bvNone;
BorderStyle := bsSingle;
BorderWidth := 5;
Color := clWindow;
Parent := PreviewForm;
DoubleBuffered := True;
with TTntImage.Create(PreviewForm) do
begin
Name := 'Image';
Align := alClient;
Stretch := True;
Proportional := True;
Center := True;
Picture.Assign(FImageCtrl.Picture);
Parent := Panel;
end;
end;
if FImageCtrl.Picture.Width > 0 then
begin
ClientWidth := Min(Monitor.Width * 3 div 4,
FImageCtrl.Picture.Width + (ClientWidth - Panel.ClientWidth)+ 10);
ClientHeight := Min(Monitor.Height * 3 div 4,
FImageCtrl.Picture.Height + (ClientHeight - Panel.ClientHeight) + 10);
end;
ShowModal;
finally
Free;
end;
end;
procedure TTntOpenPictureDialog.PreviewKeyPress(Sender: TObject; var Key: Char{TNT-ALLOW Char});
begin
if Key = Char{TNT-ALLOW Char}(VK_ESCAPE) then
(Sender as TTntForm).Close;
end;
{ TSavePictureDialog }
function TTntSavePictureDialog.Execute: Boolean;
begin
if NewStyleControls and not (ofOldStyleDialog in Options) then
Template := 'DLGTEMPLATE' else
Template := nil;
if (not Win32PlatformIsUnicode) then
Result := DoExecute(@GetSaveFileNameA)
else
Result := DoExecuteW(@GetSaveFileNameW);
end;
{$IFDEF COMPILER_9_UP}
function TTntSavePictureDialog.Execute(ParentWnd: HWND): Boolean;
begin
if NewStyleControls and not (ofOldStyleDialog in Options) then
Template := 'DLGTEMPLATE' else
Template := nil;
if (not Win32PlatformIsUnicode) then
Result := DoExecute(@GetSaveFileNameA, ParentWnd)
else
Result := DoExecuteW(@GetSaveFileNameW, ParentWnd);
end;
{$ENDIF}
end.