Source/TntExtDlgs.pas

   1
   2 {*****************************************************************************}
   3 {                                                                             }
   4 {    Tnt Delphi Unicode Controls                                              }
   5 {      http://www.tntware.com/delphicontrols/unicode/                         }
   6 {        Version: 2.3.0                                                       }
   7 {                                                                             }
   8 {    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
   9 {                                                                             }
  10 {*****************************************************************************}
  11
  12 unit TntExtDlgs;
  13
  14 {$INCLUDE TntCompilers.inc}
  15
  16 interface
  17
  18 uses
  19   Classes, Windows, TntDialogs, TntExtCtrls, TntStdCtrls, TntButtons;
  20
  21 type
  22 {TNT-WARN TOpenPictureDialog}
  23   TTntOpenPictureDialog = class(TTntOpenDialog)
  24   private
  25     FPicturePanel: TTntPanel;
  26     FPictureLabel: TTntLabel;
  27     FPreviewButton: TTntSpeedButton;
  28     FPaintPanel: TTntPanel;
  29     FImageCtrl: TTntImage;
  30     FSavedFilename: WideString;
  31     function  IsFilterStored: Boolean;
  32     procedure PreviewKeyPress(Sender: TObject; var Key: Char{TNT-ALLOW Char});
  33   protected
  34     procedure PreviewClick(Sender: TObject); virtual;
  35     procedure DoClose; override;
  36     procedure DoSelectionChange; override;
  37     procedure DoShow; override;
  38     property ImageCtrl: TTntImage read FImageCtrl;
  39     property PictureLabel: TTntLabel read FPictureLabel;
  40   published
  41     property Filter stored IsFilterStored;
  42   public
  43     constructor Create(AOwner: TComponent); override;
  44     function Execute: Boolean; override;
  45     {$IFDEF COMPILER_9_UP}
  46     function Execute(ParentWnd: HWND): Boolean; override;
  47     {$ENDIF}
  48   end;
  49
  50 {TNT-WARN TSavePictureDialog}
  51   TTntSavePictureDialog = class(TTntOpenPictureDialog)
  52   public
  53     function Execute: Boolean; override;
  54     {$IFDEF COMPILER_9_UP}
  55     function Execute(ParentWnd: HWND): Boolean; override;
  56     {$ENDIF}
  57   end;
  58
  59 implementation
  60
  61 uses
  62   ExtDlgs, {ExtDlgs is needed for a linked resource} Dialogs, Consts, Messages,
  63   Graphics, Math, Controls, Forms, SysUtils, CommDlg, TntSysUtils, TntForms;
  64
  65 { TTntSilentPaintPanel }
  66
  67 type
  68   TTntSilentPaintPanel = class(TTntPanel)
  69   protected
  70     procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
  71   end;
  72
  73 procedure TTntSilentPaintPanel.WMPaint(var Msg: TWMPaint);
  74 begin
  75   try
  76     inherited;
  77   except
  78     Caption := SInvalidImage;
  79   end;
  80 end;
  81
  82 { TTntOpenPictureDialog }
  83
  84 constructor TTntOpenPictureDialog.Create(AOwner: TComponent);
  85 begin
  86   inherited;
  87   Filter := GraphicFilter(TGraphic);
  88   FPicturePanel := TTntPanel.Create(Self);
  89   with FPicturePanel do
  90   begin
  91     Name := 'PicturePanel';
  92     Caption := '';
  93     SetBounds(204, 5, 169, 200);
  94     BevelOuter := bvNone;
  95     BorderWidth := 6;
  96     TabOrder := 1;
  97     FPictureLabel := TTntLabel.Create(Self);
  98     with FPictureLabel do
  99     begin
 100       Name := 'PictureLabel';
 101       Caption := '';
 102       SetBounds(6, 6, 157, 23);
 103       Align := alTop;
 104       AutoSize := False;
 105       Parent := FPicturePanel;
 106     end;
 107     FPreviewButton := TTntSpeedButton.Create(Self);
 108     with FPreviewButton do
 109     begin
 110       Name := 'PreviewButton';
 111       SetBounds(77, 1, 23, 22);
 112       Enabled := False;
 113       Glyph.LoadFromResourceName(FindClassHInstance(TOpenPictureDialog{TNT-ALLOW TOpenPictureDialog}), 'PREVIEWGLYPH');
 114       Hint := SPreviewLabel;
 115       ParentShowHint := False;
 116       ShowHint := True;
 117       OnClick := PreviewClick;
 118       Parent := FPicturePanel;
 119     end;
 120     FPaintPanel := TTntSilentPaintPanel.Create(Self);
 121     with FPaintPanel do
 122     begin
 123       Name := 'PaintPanel';
 124       Caption := '';
 125       SetBounds(6, 29, 157, 145);
 126       Align := alClient;
 127       BevelInner := bvRaised;
 128       BevelOuter := bvLowered;
 129       TabOrder := 0;
 130       FImageCtrl := TTntImage.Create(Self);
 131       Parent := FPicturePanel;
 132       with FImageCtrl do
 133       begin
 134         Name := 'PaintBox';
 135         Align := alClient;
 136         OnDblClick := PreviewClick;
 137         Parent := FPaintPanel;
 138         Proportional := True;
 139         Stretch := True;
 140         Center := True;
 141         IncrementalDisplay := True;
 142       end;
 143     end;
 144   end;
 145 end;
 146
 147 procedure TTntOpenPictureDialog.DoClose;
 148 begin
 149   inherited;
 150   { Hide any hint windows left behind }
 151   Application.HideHint;
 152 end;
 153
 154 procedure TTntOpenPictureDialog.DoSelectionChange;
 155 var
 156   FullName: WideString;
 157   ValidPicture: Boolean;
 158
 159   function ValidFile(const FileName: WideString): Boolean;
 160   begin
 161     Result := WideFileGetAttr(FileName) <> $FFFFFFFF;
 162   end;
 163
 164 begin
 165   FullName := FileName;
 166   if FullName <> FSavedFilename then
 167   begin
 168     FSavedFilename := FullName;
 169     ValidPicture := WideFileExists(FullName) and ValidFile(FullName);
 170     if ValidPicture then
 171     try
 172       FImageCtrl.Picture.LoadFromFile(FullName);
 173       FPictureLabel.Caption := WideFormat(SPictureDesc,
 174         [FImageCtrl.Picture.Width, FImageCtrl.Picture.Height]);
 175       FPreviewButton.Enabled := True;
 176       FPaintPanel.Caption := '';
 177     except
 178       ValidPicture := False;
 179     end;
 180     if not ValidPicture then
 181     begin
 182       FPictureLabel.Caption := SPictureLabel;
 183       FPreviewButton.Enabled := False;
 184       FImageCtrl.Picture := nil;
 185       FPaintPanel.Caption := srNone;
 186     end;
 187   end;
 188   inherited;
 189 end;
 190
 191 procedure TTntOpenPictureDialog.DoShow;
 192 var
 193   PreviewRect, StaticRect: TRect;
 194 begin
 195   { Set preview area to entire dialog }
 196   GetClientRect(Handle, PreviewRect);
 197   StaticRect := GetStaticRect;
 198   { Move preview area to right of static area }
 199   PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left);
 200   Inc(PreviewRect.Top, 4);
 201   FPicturePanel.BoundsRect := PreviewRect;
 202   FPreviewButton.Left := FPaintPanel.BoundsRect.Right - FPreviewButton.Width - 2;
 203   FImageCtrl.Picture := nil;
 204   FSavedFilename := '';
 205   FPaintPanel.Caption := srNone;
 206   FPicturePanel.ParentWindow := Handle;
 207   inherited;
 208 end;
 209
 210 function TTntOpenPictureDialog.Execute: Boolean;
 211 begin
 212   if NewStyleControls and not (ofOldStyleDialog in Options) then
 213     Template := 'DLGTEMPLATE' else
 214     Template := nil;
 215   Result := inherited Execute;
 216 end;
 217
 218 {$IFDEF COMPILER_9_UP}
 219 function TTntOpenPictureDialog.Execute(ParentWnd: HWND): Boolean;
 220 begin
 221   if NewStyleControls and not (ofOldStyleDialog in Options) then
 222     Template := 'DLGTEMPLATE' else
 223     Template := nil;
 224   Result := inherited Execute(ParentWnd);
 225 end;
 226 {$ENDIF}
 227
 228 function TTntOpenPictureDialog.IsFilterStored: Boolean;
 229 begin
 230   Result := not (Filter = GraphicFilter(TGraphic));
 231 end;
 232
 233 procedure TTntOpenPictureDialog.PreviewClick(Sender: TObject);
 234 var
 235   PreviewForm: TTntForm;
 236   Panel: TTntPanel;
 237 begin
 238   PreviewForm := TTntForm.Create(Self);
 239   with PreviewForm do
 240   try
 241     Name := 'PreviewForm';
 242     BorderStyle := bsSizeToolWin; // By doing this first, it will work on WINE.
 243     Visible := False;
 244     Caption := SPreviewLabel;
 245     KeyPreview := True;
 246     Position := poScreenCenter;
 247     OnKeyPress := PreviewKeyPress;
 248     Panel := TTntPanel.Create(PreviewForm);
 249     with Panel do
 250     begin
 251       Name := 'Panel';
 252       Caption := '';
 253       Align := alClient;
 254       BevelOuter := bvNone;
 255       BorderStyle := bsSingle;
 256       BorderWidth := 5;
 257       Color := clWindow;
 258       Parent := PreviewForm;
 259       DoubleBuffered := True;
 260       with TTntImage.Create(PreviewForm) do
 261       begin
 262         Name := 'Image';
 263         Align := alClient;
 264         Stretch := True;
 265         Proportional := True;
 266         Center := True;
 267         Picture.Assign(FImageCtrl.Picture);
 268         Parent := Panel;
 269       end;
 270     end;
 271     if FImageCtrl.Picture.Width > 0 then
 272     begin
 273       ClientWidth := Min(Monitor.Width * 3 div 4,
 274         FImageCtrl.Picture.Width + (ClientWidth - Panel.ClientWidth)+ 10);
 275       ClientHeight := Min(Monitor.Height * 3 div 4,
 276         FImageCtrl.Picture.Height + (ClientHeight - Panel.ClientHeight) + 10);
 277     end;
 278     ShowModal;
 279   finally
 280     Free;
 281   end;
 282 end;
 283
 284 procedure TTntOpenPictureDialog.PreviewKeyPress(Sender: TObject; var Key: Char{TNT-ALLOW Char});
 285 begin
 286   if Key = Char{TNT-ALLOW Char}(VK_ESCAPE) then
 287     (Sender as TTntForm).Close;
 288 end;
 289
 290 { TSavePictureDialog }
 291 function TTntSavePictureDialog.Execute: Boolean;
 292 begin
 293   if NewStyleControls and not (ofOldStyleDialog in Options) then
 294     Template := 'DLGTEMPLATE' else
 295     Template := nil;
 296
 297   if (not Win32PlatformIsUnicode) then
 298     Result := DoExecute(@GetSaveFileNameA)
 299   else
 300     Result := DoExecuteW(@GetSaveFileNameW);
 301 end;
 302
 303 {$IFDEF COMPILER_9_UP}
 304 function TTntSavePictureDialog.Execute(ParentWnd: HWND): Boolean;
 305 begin
 306   if NewStyleControls and not (ofOldStyleDialog in Options) then
 307     Template := 'DLGTEMPLATE' else
 308     Template := nil;
 309
 310   if (not Win32PlatformIsUnicode) then
 311     Result := DoExecute(@GetSaveFileNameA, ParentWnd)
 312   else
 313     Result := DoExecuteW(@GetSaveFileNameW, ParentWnd);
 314 end;
 315 {$ENDIF}
 316
 317 end.