Discussion :

[Droïde Système7]

Bonjour,

J'ai trouvé un compo : PageSetup, mais à la compil il me manque l'indicateur hInstance non déclaré.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
(*****************************************
 Sorry, no comments.
 Any question, feel free to e-mail me :
 Cezar Lenci
 sintesis@dglnet.com.br
******************************************)
unit PageSetup;

interface

Uses
    Windows,Forms,CommDlg,Printers,SysUtils,Messages,Dialogs,Classes;

Type

TPageSetupFlags = (poDefaultMinMargins,poDisableMargins,poMargins,poMinMargins,
                   poDisableOrientation,poDisablePaper,poDisablePrinter,
                   poHundredthsOfMillimeters,poThousandthsOfInches);
TPageOptions    = Set Of TPageSetupFlags;

TPageSetupDialog = class(TCommonDialog)
private
    FOptions : TPageOptions;
    FFlags   : Longint;
    FMarginLeft,
    FMarginTop,
    FMarginRight,
    FMarginBottom,
    FMinMarginLeft,
    FMinMarginTop,
    FMinMarginRight,
    FMinMarginBottom : Integer;
    FPaperLength,
    FPaperWidth      : Short;
    procedure SetOptions(Value : TPageOptions);
    procedure SetLeft(Value : Integer);
    procedure SetTop(Value : Integer);
    procedure SetRight(Value : Integer);
    procedure SetBottom(Value : Integer);
    procedure SetMinLeft(Value : Integer);
    procedure SetMinTop(Value : Integer);
    procedure SetMinRight(Value : Integer);
    procedure SetMinBottom(Value : Integer);
public
    constructor Create(AOwner : TComponent); override;
    procedure Execute;
    procedure GetDefaults;
Published
    Property Options : TPageOptions     Read FOptions         Write SetOptions;
    Property MarginLeft      : Integer  Read FMarginLeft      Write SetLeft;
    Property MarginTop       : Integer  Read FMarginTop       Write SetTop;
    Property MarginRight     : Integer  Read FMarginRight     Write SetRight;
    Property MarginBottom    : Integer  Read FMarginBottom    Write SetBottom;
    Property MinMarginLeft   : Integer  Read FMinMarginLeft   Write SetMinLeft;
    Property MinMarginTop    : Integer  Read FMinMarginTop    Write SetMinTop;
    Property MinMarginRight  : Integer  Read FMinMarginRight  Write SetMinRight;
    Property MinMarginBottom : Integer  Read FMinMarginBottom Write SetMinBottom;
    Property PaperLength     : Short    Read FPaperLength;
    Property PaperWidth      : Short    Read FPaperWidth;
end;

Procedure Register;

implementation

procedure CenterWindow(Wnd: HWnd);
var
  Rect: TRect;
begin
  GetWindowRect(Wnd, Rect);
  SetWindowPos(Wnd, 0,
    (GetSystemMetrics(SM_CXSCREEN) - Rect.Right + Rect.Left) div 2,
    (GetSystemMetrics(SM_CYSCREEN) - Rect.Bottom + Rect.Top) div 3,
    0, 0, SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
end;

function DialogHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
begin
  Result := 0;
  case Msg of
    WM_INITDIALOG:
      begin
        CenterWindow(Wnd);
        Result := 1;
      end;
  end;
end;

function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
type
    TDialogFunc = function(var DialogData): Bool stdcall;
var
    ActiveWindow: HWnd;
    WindowList: Pointer;
begin
    ActiveWindow := GetActiveWindow;
    WindowList := DisableTaskWindows(0);
    try
        Result := TDialogFunc(DialogFunc)(DialogData);
    finally
        EnableTaskWindows(WindowList);
        SetActiveWindow(ActiveWindow);
    end;
end;

procedure GetPrinter(var DeviceMode, DeviceNames: THandle);
var
  Device, Driver, Port: array[0..79] of char;
  DevNames: PDevNames;
  Offset: PChar;
begin
  Printer.GetPrinter(Device, Driver, Port, DeviceMode);
  if DeviceMode <> 0 then
  begin
    DeviceNames := GlobalAlloc(GHND, SizeOf(TDevNames) +
     StrLen(Device) + StrLen(Driver) + StrLen(Port) + 3);
    DevNames := PDevNames(GlobalLock(DeviceNames));
    try
      Offset := PChar(DevNames) + SizeOf(TDevnames);
      with DevNames^ do
      begin
        wDriverOffset := Longint(Offset) - Longint(DevNames);
        Offset := StrECopy(Offset, Driver) + 1;
        wDeviceOffset := Longint(Offset) - Longint(DevNames);
        Offset := StrECopy(Offset, Device) + 1;
        wOutputOffset := Longint(Offset) - Longint(DevNames);;
        StrCopy(Offset, Port);
      end;
    finally
      GlobalUnlock(DeviceNames);
    end;
  end;
end;


function CopyData(Handle: THandle): THandle;
var
  Src, Dest: PChar;
  Size: Integer;
begin
  if Handle <> 0 then
  begin
    Size := GlobalSize(Handle);
    Result := GlobalAlloc(GHND, Size);
    if Result <> 0 then
      try
        Src := GlobalLock(Handle);
        Dest := GlobalLock(Result);
        if (Src <> nil) and (Dest <> nil) then Move(Src^, Dest^, Size);
      finally
        GlobalUnlock(Handle);
        GlobalUnlock(Result);
      end
  end
  else Result := 0;
end;

constructor TPageSetupDialog.Create(AOwner : TComponent); 
begin
    inherited Create(AOwner);
    FOptions := [poDefaultMinMargins,poHundredthsOfMillimeters];
End;

procedure TPageSetupDialog.Execute;
var
  PageDlgRec: TPageSetupDlg;
  DevHandle: THandle;
begin
  FillChar(PageDlgRec, SizeOf(PageDlgRec), 0);
  with PageDlgRec do
  begin
    lStructSize := SizeOf(PageDlgRec);
    hInstance   := System.HInstance;
    GetPrinter(DevHandle,hDevNames);
    hDevMode    := CopyData(DevHandle);
    rtMargin    := Rect(MarginLeft,MarginTop,MarginRight,MarginBottom);
    rtMinMargin := Rect(MinMarginLeft,MinMarginTop,MinMarginRight,MinMarginBottom);
    Flags       := PSD_ENABLEPAGESETUPHOOK or FFlags;
    hWndOwner   := Application.Handle;
    lpfnPageSetupHook := DialogHook;
  End;
  TaskModalDialog(@PageSetupDlg, PageDlgRec);
  with PageDlgRec do
  begin
    MarginLeft   := rtMargin.Left;
    MarginTop    := rtMargin.Top;
    MarginRight  := rtMargin.Right;
    MarginBottom := rtMargin.Bottom;
  End;
end;

procedure TPageSetupDialog.GetDefaults;
var
  PageDlgRec: TPageSetupDlg;
  DevHandle: THandle;
begin
  FillChar(PageDlgRec, SizeOf(PageDlgRec), 0);
  with PageDlgRec do
  begin
    lStructSize := SizeOf(PageDlgRec);
   hInstance   := System.HInstance;
    GetPrinter(DevHandle,hDevNames);
    rtMargin    := Rect(MarginLeft,MarginTop,MarginRight,MarginBottom);
    rtMinMargin := Rect(MinMarginLeft,MinMarginTop,MinMarginRight,MinMarginBottom);
    Flags       := PSD_RETURNDEFAULT or PSD_ENABLEPAGESETUPHOOK or FFlags;
    hWndOwner   := Application.Handle;
    lpfnPageSetupHook := DialogHook;
  End;
  TaskModalDialog(@PageSetupDlg, PageDlgRec);
  with PageDlgRec do
  begin
    MarginLeft   := rtMargin.Left;
    MarginTop    := rtMargin.Top;
    MarginRight  := rtMargin.Right;
    MarginBottom := rtMargin.Bottom;
  End;
end;


procedure TPageSetupDialog.SetOptions(Value : TPageOptions);
Begin
    If (poDefaultMinMargins in Value) And Not (poDefaultMinMargins in FOptions) Then
        Value := Value - [poMinMargins];
    If (poMinMargins in Value) And Not (poMinMargins in FOptions) Then
        Value := Value - [poDefaultMinMargins];
    If (poHundredthsOfMillimeters in Value) And Not (poHundredthsOfMillimeters in FOptions) Then
        Value := Value - [poThousandthsOfInches];
    If (poThousandthsOfInches in Value) And Not (poThousandthsOfInches in FOptions) Then
        Value := Value - [poHundredthsOfMillimeters];
    FOptions := Value;
    FFlags := 0;
    If poDefaultMinMargins in FOptions then
        FFlags := FFlags or PSD_DEFAULTMINMARGINS;
    If poDisableMargins in FOptions then
        FFlags := FFlags or PSD_DISABLEMARGINS;
    If poMargins in FOptions then
        FFlags := FFlags or PSD_MARGINS;
    If poMinMargins in FOptions then
        FFlags := FFlags or PSD_MINMARGINS;
    If poDisableOrientation in FOptions then
        FFlags := FFlags or PSD_DISABLEORIENTATION;
    If poDisablePaper in FOptions then
        FFlags := FFlags or PSD_DISABLEPAPER;
    If poDisablePrinter in FOptions then
        FFlags := FFlags or PSD_DISABLEPRINTER;
    If poHundredthsOfMillimeters in FOptions then
        FFlags := FFlags or PSD_INHUNDREDTHSOFMILLIMETERS;
    If poThousandthsOfInches in FOptions then
        FFlags := FFlags or PSD_INTHOUSANDTHSOFINCHES;
End;

procedure TPageSetupDialog.SetLeft(Value : Integer);
Begin
    If Value > FMinMarginLeft Then
        FMarginLeft := Value;
End;

procedure TPageSetupDialog.SetTop(Value : Integer);
Begin
    If Value >= FMinMarginTop Then
        FMarginTop := Value;
End;

procedure TPageSetupDialog.SetRight(Value : Integer);
Begin
    If Value >= FMinMarginRight Then
        FMarginRight := Value;
End;

procedure TPageSetupDialog.SetBottom (Value : Integer);
Begin
    If Value >= FMinMarginBottom Then
        FMarginBottom := Value;
End;

procedure TPageSetupDialog.SetMinLeft(Value : Integer);
Begin
    If Value <= FMarginLeft Then
        FMinMarginLeft := Value;
End;

procedure TPageSetupDialog.SetMinTop(Value : Integer);
Begin
    If Value <= FMarginTop Then
        FMinMarginTop := Value;
End;

procedure TPageSetupDialog.SetMinRight(Value : Integer);
Begin
    If Value <= FMarginRight Then
        FMinMarginRight := Value;
End;

procedure TPageSetupDialog.SetMinBottom (Value : Integer);
Begin
    If Value <= FMarginBottom Then
        FMinMarginBottom := Value;
    Self.GetDefaults;
End;

Procedure Register;
Begin
    RegisterComponents('Dialogs',[TPageSetupDialog]);
End;


end.

Que me manque t-il donc pour terminer la compil ?

Merci de vos idées.

[Cl@udius]

Salut JP

D'emblée je dirais que HInstance est définie sans SysInit.

Donc il suffit de remplacer:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
  hInstance := System.HInstance;

par:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
  hInstance := SysInit.HInstance;

@+ Claudius

[Jipété]

Yep !

Salut JP

Ah non, jp c'est moi !

à la compil il me manque l'indicateur hInstance

Dis donc, le Droïde, tu galèges ou quoi ? Je te l'ai signalé hier ! ! !
Mais c'est bien, tu avances pas mal sur l'autre post.
On va bientôt pouvoir copier/coller tout ça, au poil !

Tchô,
--
jp

[Droïde Système7]

Salut les copains

Cl@udius, tu es toujours égal à toi même = un as !

jp, en ce moment je disjoncte un peu (pas de vacances si si...), mais en (tentant) d'installer ce compo qui m'a viré les 90% de mes compos installés, j'ai tout de suite pensé à tes conseils que je n'avais en effet pas ciblé sur ce point précis ; j'en suis désolé

Je vais peut-être retenter le coup un de ces jours avec le fameux compo en question, mais j'ai eu des sueurs froides à l'idée de presque réinstaller tous mes compos.

Mais Delphi est bien fait, j'ai compris un peu tard qu'une fois le compo (register... je sais désormais...), que le compo en question dis-je viré, tout devrait rentrer dans l'ordre.

Mieux que ça même puisqu'à la réinstalle d'un compo, tout le paquet est retourné direct aux bercails = ouffffffffffff !!!

Merci à vous @+

[Droïde Système7]

Fais voir quand même...

Sinon, les modifs que je lui ai faites :

1. le renommer en TPageSetupDialog2 pour éviter la grouille ;
2. changer hInstance := System.HInstance; en hInstance := Sysinit.HInstance; 2 fois ;
3. interdire la proc "Register" comme ça je suis tranquille et dans FormCreate : psd := TPageSetupDialog2.Create(self);

Quant à bidouiller dans le compo, ou bidouiller les retours du compo, de toute façon va falloir bidouiller !
Et donc trouver les infos qui vont bien, à propos de ces histoires de Scale...

Bon courage !
--
jp

[Edit] Je viens de voir le lien que tu cites, il en cite un autre que je trouve plus simple. À toi de voir... [/edit]

jp, au fait avec ce compo, je serais très très curieux de savoir : est-ce que ça fonctionne parfaitement ?

Je suis en train de me bastonner en relisant tes explications très détaillées, honte à moi j'avais la tête ailleurs...

Voici le fond de ma pensée : si ce compo est impec, pas la peine de continuer le code sur l'autre topic alors.

@+

[Jipété]

jp, au fait avec ce compo, je serais très très curieux de savoir : est-ce que ça fonctionne parfaitement ?

On se comprend pas, là... : le compo que tu as trouvé fonctionne à partir du moment où je modifie 2-3 trucs comme expliqué dans le post n° 9 de l'autre topic, mais il fonctionne comme le TPageSetupDialog de Delphi (qui a copié qui ?), c'est-à-dire qu'il faut ensuite adapter les résultats qu'il renvoie avec GetDeviceCaps et tout le fourbi des marges à calculer et tout ça...

Voici le fond de ma pensée : si ce compo est impec, pas la peine de continuer le code sur l'autre topic alors.
@+

Ce compo fonctionne peut-être mieux que celui de Delphi (rappelle-toi mon commentaire à propos des inches et des millimètres, avec le compo Delphi -- mon problème c'est que j'ai une version perso, et donc pas les sources de Dialogs.pas pour comparer, grrr !), mais j'aurais plutôt dit qu'on continue sur l'autre topic, justement -- celui-ci ne sert à rien puisque la réponse à ta question d'origine avait sa réponse là-bas.

Et je trouve que tu as très bien avancé (même si je n'ai encore rien testé).
Amicalement,
--
jp

[Droïde Système7]

Re jp, pour le compo en question, je te demandais si une fois bidouillé (bien entendu ) ce dernier fonctionnait impec.

A la lecture de tes dires, je reste sur ma faim alors (question bonnet blanc et blanc bonnet) entres ces 2 compos.

Remarque cela va m'éviter de me rebattre avec ce dernier aller, ainsi que tu le subodores ; je l'oublie et me rabats vers le code en cours suivant tes conseils.

Après tout, question conversions en millimètres et manips en ce genre, cela ne me fera pas de mal de continuer, car des choses encore à apprendre là-dessus.

Encore merci de me soutenir

@+ et amicalement