Capturer Form et changer format?

**jojo86** · 17/04/2009, 23h45

Bonsoir.
J'aimerais savoir comment faire pour Imprimer une form au format 21x29,7cm...

Merci de votre aide.

Cordialement.

**NABIL74** · 18/04/2009, 09h49

bonjour à toutes et à tous,

pour Imprimer une form affichée à l'écran,tu peux la coder comme ça:

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
 
.
implementation
   uses Printers;
.
.
 
procedure TForm1.Button1Click(Sender: TObject);
var
  DC: HDC;
  isDcPalDevice: Bool;
  MemDC: HDC;
  MemBitmap: HBITMAP;
  OldMemBitmap: HBITMAP;
  hDibHeader: THandle;
  pDibHeader: Pointer;
  hBits: THandle;
  pBits: Pointer;
  ScaleX: Double;
  ScaleY: Double;
  pPal: PLOGPALETTE;
  pal: HPALETTE;
  OldPal: HPALETTE;
  i: Integer;
begin
  {Obtenir l'écran}
  DC := GetDC(0);
  {Créer un compatible dc}
  MemDC := CreateCompatibleDC(DC);
  {Créer bitmap}
  MemBitmap := CreateCompatibleBitmap(DC, Self.Width, Self.Height);
  {sélectionnez l'image bitmap dans le dc}
  OldMemBitmap := SelectObject(MemDC, MemBitmap);
 
  {Permet de se préparer pour essayer un fixup pour les brisures de pilotes vidéo}
  isDcPalDevice := False;
  if GetDeviceCaps(DC, RASTERCAPS) and RC_PALETTE=RC_PALETTE then
  begin
    GetMem(pPal, SizeOf(TLOGPALETTE)+(255*SizeOf(TPALETTEENTRY)));
    FillChar(pPal^, SizeOf(TLOGPALETTE)+(255*SizeOf(TPALETTEENTRY)),
             #0);
    pPal^.palVersion := $300;
    pPal^.palNumEntries := GetSystemPaletteEntries(DC, 0, 256, pPal^.palPalEntry);
    if pPal^.palNumEntries<>0 then
    begin
      pal := CreatePalette(pPal^);
      OldPal := SelectPalette(MemDC, pal, False);
      isDcPalDevice := True
    end
    else
      FreeMem(pPal, SizeOf(TLOGPALETTE)+(255*SizeOf(TPALETTEENTRY)));
  end;
  {cCopier à partir de l'écran à la memdc / bitmap}
  BitBlt(MemDC, 0, 0, Self.Width, Self.Height, DC, Self.Left, Self.Top, SRCCOPY);
 
  if isDcPalDevice=True then
  begin
    SelectPalette(MemDC, OldPal, False);
    DeleteObject(pal);
  end;
  {désélectionner l'image}
  SelectObject(MemDC, OldMemBitmap);
  {éffacer la mémoire dc}
  DeleteDC(MemDC);
  {Allouer la mémoire pour une structure Dib}
  hDibHeader := GlobalAlloc(GHND, SizeOf(TBITMAPINFO)+(SizeOf(TRGBQUAD)*
                            256));
  {obtenir un pointeur vers la mémoire}
  pDibHeader := GlobalLock(hDibHeader);
 
  {remplir le dib structure avec des informations sur la façon dont nous voulons que les DIB}
  FillChar(pDibHeader^, SizeOf(TBITMAPINFO)+(SizeOf(TRGBQUAD)*
           256), #0);
  PBITMAPINFOHEADER(pDibHeader)^.biSize := SizeOf(TBITMAPINFOHEADER);
  PBITMAPINFOHEADER(pDibHeader)^.biPlanes := 1;
  PBITMAPINFOHEADER(pDibHeader)^.biBitCount := 8;
  PBITMAPINFOHEADER(pDibHeader)^.biWidth := Self.Width;
  PBITMAPINFOHEADER(pDibHeader)^.biHeight := Self.Height;
  PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;
 
  {connaître la quantité de mémoire pour les bits}
  GetDIBits(DC, MemBitmap, 0, Self.Height, nil, TBITMAPINFO(pDibHeader^),
            DIB_RGB_COLORS);
 
  hBits := GlobalAlloc(GHND, PBITMAPINFOHEADER(pDibHeader)^.BiSizeImage);
 
  {Obtenir un pointeur sur les bits}
  pBits := GlobalLock(hBits);
 
  {Appel fn, mais cette fois nous donner les bits}
  GetDIBits(DC, MemBitmap, 0, Self.Height, pBits, PBitmapInfo(pDibHeader)^,
            DIB_RGB_COLORS);
 
  {Essayons un fixup pour les brisures de pilotes vidéo}
  if isDcPalDevice=True then
  begin
    for i := 0 to (pPal^.palNumEntries-1) do
    begin
      PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed := pPal^.palPalEntry[i].peRed;
      PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen := pPal^.palPalEntry[i].peGreen;
      PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue := pPal^.palPalEntry[i].peBlue;
    end;
    FreeMem(pPal, SizeOf(TLOGPALETTE)+(255*SizeOf(TPALETTEENTRY)));
  end;
  {L'écran de sortie en courant continu}
  ReleaseDC(0, DC);
  {effacer le bitmap}
  DeleteObject(MemBitmap);
 
  {Commencement du travail d'impression}
  Printer.BeginDoc;
 
  { taille de l'impression }
  ScaleX := Self.Width*3;
  ScaleY := Self.Height*3;
 
  {Juste en cas driver l'imprimante est une palette de dispositifs}
  isDcPalDevice := False;
  if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and RC_PALETTE=RC_PALETTE
                   then
  begin
    {Créer une palette de dib}
    GetMem(pPal, SizeOf(TLOGPALETTE)+(255*SizeOf(TPALETTEENTRY)));
    FillChar(pPal^, SizeOf(TLOGPALETTE)+(255*SizeOf(TPALETTEENTRY)),
             #0);
    pPal^.palVersion := $300;
    pPal^.palNumEntries := 256;
    for i := 0 to (pPal^.palNumEntries-1) do
    begin
      pPal^.palPalEntry[i].peRed := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed;
      pPal^.palPalEntry[i].peGreen := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen;
      pPal^.palPalEntry[i].peBlue := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue;
    end;
    pal := CreatePalette(pPal^);
    FreeMem(pPal, SizeOf(TLOGPALETTE)+(255*SizeOf(TPALETTEENTRY)));
    OldPal := SelectPalette(Printer.Canvas.Handle, pal, False);
    isDcPalDevice := True
  end;
  {envoyer les bits de l'imprimante}
  StretchDiBits(Printer.Canvas.Handle, 0, 0, Round(ScaleX), Round(ScaleY),
                0, 0, Self.Width, Self.Height, pBits, PBitmapInfo(pDibHeader)^,
                DIB_RGB_COLORS, SRCCOPY);
 
  {Juste en cas vous driver imprimante est une palette de dispositifs}
  if isDcPalDevice=True then
  begin
    SelectPalette(Printer.Canvas.Handle, OldPal, False);
    DeleteObject(pal);
  end;
  {Nettoyer la mémoire allouée}
  GlobalUnlock(hBits);
  GlobalFree(hBits);
  GlobalUnlock(hDibHeader);
  GlobalFree(hDibHeader);
 
  {mettre fin à la tâche d'impression}
  Printer.EndDoc;
end;

en cliquant sur le bouton, l'application va faire une capture d'écran de la fiche seulement (l'image bitmap)et elle va être enregistrée au format "tiff" et puis,elle va être imprimée.

bonne chance.

A+

NABIL74

**cincap** · 18/04/2009, 10h05

Bonjour à toutes et à tous,

@ Nabil74

, le simple print du menu fichier de Delphi ne suffit pas dans son cas ?

Sinon correct ton astuce digne du professionnel mais pour les dimensions voulues, comment faire car ici la form est imprimée dans un coin à gauche ou alors agir sur

{ taille de l'impression }
ScaleX := Self.Width*3;
ScaleY := Self.Height*3;

Mon test imprime bien sans la barre de tâche !

@+,

Cincap

**jojo86** · 18/04/2009, 10h05

Effectivement, sa marche sauf que la form est toute petite en haut à gauche...

Comment faire donc pour passer la form en Pleine page???

Merci beaucoup !

**cincap** · 18/04/2009, 10h30

@ jojo86, dans le code de Nabil74 tu remplaces ceci :

Code :

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

1
2
3
4
5
 
 
{Taille de l'impression}
  //ScaleX := Self.Width*3;
 // ScaleY := Self.Height*3;

par ceci :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
 if Printer.PageWidth < Printer.PageHeight then
  begin
    ScaleX := Printer.PageWidth;
    ScaleY := Self.Height*(Printer.PageWidth/Self.Width);
  end
  else
  begin
    ScaleX := Self.Width*(Printer.PageHeight/Self.Height);
    ScaleY := Printer.PageHeight;
  end;

@+,

Cincap

**jojo86** · 18/04/2009, 11h14

Ok sa marche super merci...

Par contre, comment faire pour n'imprimer que la form???

J'ai déjà mis ma form en blanc.

Et au début de la procédure de NABIL74 j'ai ajouté :

Code :

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

Form1.BorderStyle := bsNone;

Puis à la fin de son code :

Code :

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

Form1.BorderStyle := bsSingle;

Mais sa ne fonctionne pas corectement au niveau de l'impression... sa bug en faite...

Par contre si dès le départ je met ma form en BSNONE l'impression est nickel...

J'ai trouvé une solution... Mais elle ne me parait pas corect

Ajout d'un Timer.
Sur le OnClick de mon bouton :

Code :

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

1
2
Form1.BorderStyle := bsNone;
Timer1.Enabled:=True;

Sur le OnTimer :

Code :

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

1
2
PROCEDURE DE NABIL
Timer1.Enabled:=False;

En procédant ainsi sa fonctionne du tonnere !

Mais voyez vous un moyen plus propre?

Merci de m'aider à éclaircir ce probleme...

**jojo86** · 18/04/2009, 11h35

Arf...

J'ai un big probleme...

Sa n'imprime pas les TImage...

Décidement c'est pas mon jour...

**cincap** · 18/04/2009, 12h45

@ jojo86, que veux tu faire exactement ?

Je viens d'essayer avec un Jpeg dans le Timage et c'est correct, l'impression ne contient que la form et les composants posés dessus naturellement.

As tu mis dans le uses Jpeg ?

@+,

Cincap

**jojo86** · 18/04/2009, 13h28

@ Cincap

J'ai bien jpeg dans les uses...

Et je certifi que je n'ai pas d'image sur l'impression...

Mon logo est gris pal je pense qu'il n'est pas reconnu sur la capture...

J'ai mis une autre photo et sa fonctionne mais la résolution est minable et je pense que comme mon logo est gris claire, il n'est pas visible...

Essaye avec mon logo s'il te plait :

http://ts.pilote-fsx.net/LogoFondEchelle.jpg

Merci de me dire s'il existe une solution.

Cordialement,

Mathieu

**jojo86** · 18/04/2009, 14h28

Je suis vraiment satisfait de cette methode, mais la définition à l'impression n'est pas térible... Peut-on augmenter la résolution de la capture pour visualiser moin de pixels???

Et comment faire pour que mon logo gris claire soit visible???

Merci !

**cincap** · 18/04/2009, 14h36

@ jojo86, en effet avec ton logo, il apparait légèrement jaune par rapport à une photo couleur mais il est pris par la capture.

C'est à cause de la palette pal utilisée dans le code.

Essaye ceci clique sur ta fiche dans le projet, dans le menu de Delphi fais fichier, imprimer et choix 2 "Ajuster dans la page" pour vérifier ce que cela donne.

Regarde ce lien si c'est pour imprimer des étiquettes

et c'est gratuit.

http://www.greatis.com/delphicb/printsuite/

@+,

Cincap

**jojo86** · 18/04/2009, 15h14

Gratuit???

C'est curieux je n'ai qu'une version de démo !!!

J'éssaye de cmoprendre le fonctionnement...

Comment fait-on pour dire que c'est FORM1 qu'on veut utiliser?

**cincap** · 18/04/2009, 15h18

As tu fait l'essai sans ce composant ?

**jojo86** · 18/04/2009, 15h26

En faisant Imprimer et Choix deux, la résolution est pas trop moche...

Et je vois bien le logo de fond...

Sais tu comment faire pour utiliser le composant dont tu m'as parlé???

J'ai mis un Preview et un PrintJob sur ma form, j'arrive juste à faire apparaitre tu text en suivant cette methode :
http://www.greatis.com/delphicb/prin...tsuiteuse.html

Mais mon soucis c'est que c'est une form que je veux imprimer...

Merci de ton aide !

**Andnotor** · 18/04/2009, 16h09

Pour imprimer simplement la fiche (zone cliente) en pleine page:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
procedure PrintForm(aForm :TForm);
begin
  with aForm.GetFormImage do
  try
    Printer.BeginDoc;
    StretchBlt(Printer.Canvas.Handle, 0, 0, Printer.PageWidth, Printer.PageHeight, Canvas.Handle, 0, 0, Width, Height, SRCCOPY);
    Printer.EndDoc;
  finally
    Free;
  end;
end;

Pour une impression proportionnelle, ce sera par contre un peu plus compliqué... La fonction à Cincap (que je salue au passage

) ne tient compte que de la taille de la page en pixels et ne fonctionnera parfaitement que dans le cas ou la résolution X = la résolution Y.

Elle ne prend pas non plus en compte l'orientation de l'image par rapport à l'orientation de l'imprimante. L'image pourait donc être plus petite ou plus grande que la page.

**jojo86** · 18/04/2009, 16h23

@ Andnotor

Ca marche sauf que la proportion n'est pas correct...

L'image est étirée...
Je voudrais que mes images soient imprimées proportionellement a celles de mon form.

Merci de ton aide

**cincap** · 18/04/2009, 16h37

Salut Andnotor, toujours aussi simple et efficace

@ jojo86, cette procédure est à placer sur ta fiche et dans le onclick de ton Tbutton tu écris ceci :

Code :

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

1
2
3
4
5
 
procedure TForm1.Button1Click(Sender: TObject);
begin
PrintForm(form1) ;
end;

Je n'ai pas testé !

@+,

Cincap

**Andnotor** · 18/04/2009, 16h41

Pas le temps de tout faire, mais tu dois jouer avec GetDeviceCaps, HORZSIZE, VERTSIZE, HORZRES, VERTRES, LOGPIXELSX, LOGPIXELSY.

...et la taille de ton bitmap bien sûr

.

**cincap** · 18/04/2009, 16h44

@ jojo86, quel est le but final ?

Si tu disposes sur ta fiche plusieurs Timage avec ton logo pour ensuite les imprimer, cela me semble farfelu.

Eclaire nous.

@+,

Cincap

**jojo86** · 18/04/2009, 17h09

C'est poutan Simple.

Une feuille A4 8 étiquette en tout.

4 à gauche 4 à droite chaque étiquettes à une hauteur d'environ
7cm pour une largeur de 10cm.

Mais sur mon form il peut y avoir minimum 1 étiquette et maximum 8 etiquette, donc ma form n'aura pas formcément la Hauteur d'un format A4...

Compris?

Capturer Form et changer format?

Delphi

Discussions similaires

Partager

Partager