File: win32wsextdlgs.pp

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (216 lines) | stat: -rw-r--r-- 6,319 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
{ $Id: win32wsextdlgs.pp 51799 2016-03-02 06:41:52Z ondrej $}
{
 *****************************************************************************
 *                             Win32WSExtDlgs.pp                             * 
 *                             -----------------                             * 
 *                                                                           *
 *                                                                           *
 *****************************************************************************

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}
unit Win32WSExtDlgs;

{$mode objfpc}{$H+}
{$I win32defines.inc}

interface

uses
////////////////////////////////////////////////////
// I M P O R T A N T                                
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
  Windows,
////////////////////////////////////////////////////
  WSExtDlgs, WSLCLClasses, Win32WSDialogs, Win32WSControls, Win32Int, Win32Proc,
  Types, Controls, Dialogs, ExtDlgs, LCLType, Graphics, Themes, Win32Extra, ShlObj;

type

  { TWin32WSPreviewFileControl }

  TWin32WSPreviewFileControl = class(TWSPreviewFileControl)
  published
    class function CreateHandle(const AWinControl: TWinControl;
          const AParams: TCreateParams): HWND; override;
  end;

  { TWin32WSPreviewFileDialog }

  TWin32WSPreviewFileDialog = class(TWSPreviewFileDialog)
  published
  end;

  { TWin32WSOpenPictureDialog }

  TWin32WSOpenPictureDialog = class(TWin32WSOpenDialog)
  published
    class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
  end;

  { TWin32WSSavePictureDialog }

  TWin32WSSavePictureDialog = class(TWin32WSSaveDialog)
  published
    class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
  end;

  { TWin32WSCalculatorDialog }

  TWin32WSCalculatorDialog = class(TWSCalculatorDialog)
  published
  end;

  { TWin32WSCalculatorForm }

  TWin32WSCalculatorForm = class(TWSCalculatorForm)
  published
  end;

  { TWin32WSCalendarDialogForm }

  TWin32WSCalendarDialogForm = class(TWSCalendarDialogForm)
  published
  end;

  { TWin32WSCalendarDialog }

  TWin32WSCalendarDialog = class(TWSCalendarDialog)
  published
  end;


implementation

{$R *.res}

function OpenPictureDialogCallBack(hWnd: Handle; uMsg: UINT; wParam: WPARAM;
  lParam: LPARAM): UINT_PTR; stdcall;
var
  OpenFileName: Windows.POPENFILENAME;
  DialogRec: POpenFileDialogRec;
  AControl: TPreviewFileControl;
  stc32Handle: Handle;
  ARect, ADialogRect: TRect;
begin
  Result := OpenFileDialogCallBack(hWnd, uMsg, wParam, lparam);
  if uMsg = WM_INITDIALOG then
  begin
    OpenFileName := Windows.POPENFILENAME(lParam);
    // Our dialog template contains a special control with ID stc32 which
    // tells it how our template will be positioned. We need to place our
    // control at the end of tempate
    stc32Handle := GetDlgItem(hWnd, 1119);
    if stc32Handle <> 0 then
    begin
      DialogRec := POpenFileDialogRec(OpenFileName^.lCustData);
      AControl := TPreviewFileDialog(DialogRec^.Dialog).PreviewFileControl;
      // attach our child to the template window
      AControl.ParentWindow := hWnd;

      GetWindowRect(stc32Handle, ARect);
      ScreenToClient(hWnd, ARect.TopLeft);
      ScreenToClient(hWnd, ARect.BottomRight);
      GetClientRect(hWnd, ADialogRect);

      with ARect do
      begin
        Left := Right;
        Top := 30; // do not know how to get relative coord
        Right := ADialogRect.Right - 4;
        Bottom := ADialogRect.Bottom;
      end;

      AControl.BoundsRect := ARect;
      AControl.Color := clBtnFace;
    end;
  end;
end;

procedure AddPreviewControl(const ACommonDialog: TCommonDialog; OFN: LPOPENFILENAME);
const
  ResName: WideString = 'LAZ_PIC_DIALOG_TEMPLATE';
begin
  if (TPreviewFileDialog(ACommonDialog).PreviewFileControl <> nil) and
     not (ofOldStyleDialog in TPreviewFileDialog(ACommonDialog).Options) then
    with OFN^ do
    begin
      lpTemplateName := AllocMem(Length(ResName) * 2 + 2);
      Move(PChar(ResName)^, lpTemplateName^, Length(ResName) * 2);
      Flags := Flags or OFN_ENABLETEMPLATE;
      lpfnHook := LPOFNHOOKPROC(@OpenPictureDialogCallBack);
    end;
end;

{ TWin32WSOpenPictureDialog }

class function TWin32WSOpenPictureDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle;
var
  Dialog: IFileOpenDialog;
  fos: FILEOPENDIALOGOPTIONS;
begin
  Result := inherited CreateHandle(ACommonDialog);
  if CanUseVistaDialogs(TOpenDialog(ACommonDialog)) then
  begin
    Dialog := IFileOpenDialog(Result);
    if Succeeded(Dialog.GetOptions(@fos)) then
    begin
      fos := fos or FOS_FORCEPREVIEWPANEON;
      Dialog.SetOptions(fos);
    end;
  end
  else
    AddPreviewControl(ACommonDialog, LPOPENFILENAME(Result));
end;

{ TWin32WSPreviewFileControl }

class function TWin32WSPreviewFileControl.CreateHandle(
  const AWinControl: TWinControl; const AParams: TCreateParams): HWND;
var
  Params: TCreateWindowExParams;
begin
  // general initialization of Params
  PrepareCreateWindow(AWinControl, AParams, Params);
  // customization of Params
  with Params do
  begin
    pClassName := @ClsName[0];
    SubClassWndProc := nil;
  end;
  // create window
  FinishCreateWindow(AWinControl, Params, false);
  Result := Params.Window;
end;

{ TWin32WSSavePictureDialog }

class function TWin32WSSavePictureDialog.CreateHandle(
  const ACommonDialog: TCommonDialog): THandle;
var
  Dialog: IFileSaveDialog;
  fos: FILEOPENDIALOGOPTIONS;
begin
  Result := inherited CreateHandle(ACommonDialog);
  if CanUseVistaDialogs(TOpenDialog(ACommonDialog)) then
  begin
    Dialog := IFileSaveDialog(Result);
    if Succeeded(Dialog.GetOptions(@fos)) then
    begin
      fos := fos or FOS_FORCEPREVIEWPANEON;
      Dialog.SetOptions(fos);
    end;
  end
  else
    AddPreviewControl(ACommonDialog, LPOPENFILENAME(Result));
end;

end.