Discussion :

[mennix]

Il y a quelque temps, une personne avait soulevé un souci sous BP7,
tout les bitmaps ne pouvaient etre imprimer, effectivmeent la fonction Strech et bilbit ne sont pas compatible avec tout les drivers d'imprimante!

J'ai trouvé sur le net, une source que j'ai adapté, ainsi desormais, un bitmap peut etre imprimé sans soucis!

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
procedure BitmapPrn(DCimp:HDC;Bmp:HBITMAP;X,Y,Zx,ZY:word;rop:longint);
var
 dc: HDC;
 isDcPalDevice : BOOL;
 MemDc,memdc2 :hdc;
 MemBitmap : hBitmap;
 OldMemBitmap,oldbmp : hBitmap;
 hDibHeader : Thandle;
 pDibHeader : pointer;
 hBits : Thandle;
 pBits : pointer;
 ScaleX : Double;
 ScaleY : Double;
 ppal : PLOGPALETTE;
 pal : hPalette;
 Oldpal : hPalette;
 i : integer;
 B:TBITMAP;
begin
 
 {Get the screen dc}
 dc := GetDc(0);
 GetObject(BMP,Sizeof(B), @B);
 {Create a compatible dc}
 MemDc := CreateCompatibleDc(dc);
 MemDc2 := CreateCompatibleDc(dc);
 {create a bitmap}
 MemBitmap := CreateCompatibleBitmap(Dc,B.bmwidth,B.bmheight);
 {select the bitmap into the dc}
 OldMemBitmap := SelectObject(MemDc, MemBitmap);
 Oldbmp:=SelectObject(MemDc2, bmp);
 {Lets prepare to try a fixup for broken video drivers}
 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;
 {copy from the screen to the memdc/bitmap}
 
 BitBlt(MemDc,0, 0,b.bmwidth,b.bmheight,MemDc2,0,0,SrcCopy);
 
 
 if isDcPalDevice = true then
 begin
  SelectPalette(MemDc, OldPal, false);
  DeleteObject(Pal);
 end;
 {unselect the bitmap}
 SelectObject(MemDc, OldMemBitmap);
 {delete the memory dc}
 DeleteDc(MemDc);
 {Allocate memory for a DIB structure}
 hDibHeader := GlobalAlloc(GHND, sizeof(TBITMAPINFO) +(sizeof(TRGBQUAD) * 256));
 
 {get a pointer to the alloced memory}
 pDibHeader := GlobalLock(hDibHeader);
 {fill in the dib structure with info on the way we want the 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 := b.bmwidth;
 PBITMAPINFOHEADER(pDibHeader)^.biHeight := B.bmheight;
 PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;
 {find out how much memory for the bits}
 GetDIBits(Memdc2,MemBitmap,0,B.Bmheight,nil,TBitmapInfo(pDibHeader^),DIB_RGB_COLORS);
 
 {Alloc memory for the bits}
 hBits := GlobalAlloc(GHND,PBitmapInfoHeader(pDibHeader)^.BiSizeImage);
 {Get a pointer to the bits}
 pBits := GlobalLock(hBits);
 {Call fn again, but this time give us the bits!}
 GetDIBits(Memdc2,MemBitmap,0,b.Bmheight,pBits,PBitmapInfo(pDibHeader)^,DIB_RGB_COLORS);
 
 {Lets try a fixup for broken video drivers}
 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;
 {Release the screen dc}
 ReleaseDc(0, dc);
 {Delete the bitmap}
 DeleteObject(MemBitmap);
 {Start print job}
(* Printer.BeginDoc;
 {Scale print size}
 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;
 *)
 {Just incase the printer drver is a palette device}
 isDcPalDevice := false;
 if GetDeviceCaps(Dcimp, RASTERCAPS) and RC_PALETTE = RC_PALETTE
then
 begin
  {Create palette from 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(Dcimp, Pal, false);
  isDcPalDevice := true
 end;
 
 {send the bits to the printer}
 StretchDiBits(Dcimp,impx(x),impy(y),impx(zx), ImpY(zy),0,
0,b.bmWidth, B.bmHeight,pBits,
  PBitmapInfo(pDibHeader)^,DIB_RGB_COLORS,ROP);
 
 {Just incase you printer drver is a palette device}
 if isDcPalDevice = true then
 begin
  SelectPalette(DCimp, oldPal, false);
  DeleteObject(Pal);
 end;
 
 {Clean up allocated memory}
 GlobalUnlock(hBits);
 GlobalFree(hBits);
 GlobalUnlock(hDibHeader);
 GlobalFree(hDibHeader);
  {End the print job}
 deletedc(memdc2);
end;

[Balise [code] rajoutée par Nono40]


ps:les fonctions Impx, et impy servent a redimensionner mon bitmap lors d'une impression, ce module me sert aussi pour faire des previews, (donc a vous de recalculer votre ratio)

a plus tard !!!

[Alcatîz]

Hello !

C'est moi qui avais (et qui ai toujours) un problème pour imprimer une image monochrome sur imprimante... monochrome. Merci pour ce code, que je vais essayer de mon côté.

P.S. N'oublie pas les balises code et /code : ce sera beaucoup plus clair.

[mennix]

je ne connaissais pas ses fonctions code /code
je les utiliserais la prochaine fois !!!

Tiens moi au courant, si cela fonctionne pour toi, chez moi , c'est nickel !!

Je travail bcp ss bp7 window, toute mes sources etants ss bp7!.
J'ai developé des fonctions pour du win32bit, travailler avec des fichiers a long nom, la boite openddialog32, etc !!!! des boutons a la facon XP, des menus avec bitmap intégré, du DDE pour excel(piloter excel), du richedit etc !!!et tout ca sous BP7, j'en ai un peu chié, mais ca marche pas trop mal !!!
Si d'autres personne a des astuces, des petits modules , faites en parts aux copains !!!

bye
Thierry !

[M.Dlb]

Si tu es assez charitable, tu pourrais ajouter tes contributions à ce site !
(Contacte Haypo pour plus de précisions)

a+

[mennix]

j'avais evoqué aussi un souci pour sauver une image Bitmap sur winNT,
et on m'avait repondu que cela provenait du Ahincr, eh bien non, cette fonction marche tres bien sous NT
EN fait, on a du tous avoir la meme source pour le modele en ce qui concerne la sauvegarde d'un Bitmap.. apres une petite etude, il y a une erreur ds la source ,

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
function SaveBitmapFile(FileName: PChar; HBM: HBitmap): Integer;
  var
    BM:   TBitmap;		{ Bitmap information }
    BFH:  TBitmapFileHeader;	{ Bitmap file information }
    BIP:  PBitmapInfo;		{ Part of bitmap file information }
    DC:   HDC;			{ Drawing context }
 
    HMem: THandle;		{ Handle to memory for bitmap }
    Buf:  Pointer;		{ Memory for bitmap }
 
    ColorSize, DataSize: Longint; { Size needed to store Color/Data }
    BitCount: Word;		{ Number of bits per pixel }
    F:FILE;
    cpt:word;
  { Takes the size in bits and returns the (aligned) size in bytes.
    Bitmap data format requires word alignment.
  }
  TempReadSize:longint;
  function bmAlignDouble(Size: Longint): Longint;
  begin
    bmAlignDouble := (Size + 31) div 32 * 4;
  end;
 
Const taille=$8000;
 
 
begin
   SaveBitmapFile := 0;
   { Get the information about the Bitmap }
 
   if GetObject(HBM, SizeOf(TBitmap), @BM) = 0 then Exit;
 
   BitCount := bm.bmPlanes * bm.bmBitsPixel;
 
   if (BitCount <> 24) then
     ColorSize := SizeOf(TRGBQuad) * (1 shl BitCount)
   else
     ColorSize := 0;
   DataSize := bmAlignDouble(bm.bmWidth * BitCount) * bm.bmHeight;
   { Create the file }
   Assign(F, Filename);
  {$I-}ReWrite(F, 1);{$I+}
  if IOResult<>0 then
  begin
(*    LoadBMP := 0;*)
    Exit;
  end;
   { Allocate memory for the bitmap info structure }
   GetMem(BIP, SizeOf(TBitmapInfoHeader) + ColorSize);
   if BIP <> nil then
   begin
     { Fill in the Bitmap info header }
     with BIP^.bmiHeader do
     begin
       biSize := SizeOf(TBitmapInfoHeader);
       biWidth := bm.bmWidth;
       biHeight := bm.bmHeight;
       biPlanes := 1;
       biBitCount := BitCount;
       biCompression := 0;
       biSizeImage := DataSize;
       biXPelsPerMeter := 0;
       biYPelsPerMeter := 0;
       biClrUsed := 0;
       biClrImportant := 0;
     end;
 
     { Fill in the file header }
     with BFH do
     begin
       bfOffBits := SizeOf(BFH) + SizeOf(TBitmapInfo) + ColorSize;
       bfReserved1 := 0;
       bfReserved2 := 0;
       bfSize :=  bfOffBits + DataSize;
       bfType := BMType;
     end;
 
     { Create the memory Bitmap }
     HMem := GlobalAlloc(gmem_Fixed, DataSize);
     if HMem <> 0 then
     begin
       Buf := GlobalLock(HMem);
 
       { Get the bitmap bits in device independent format }
       DC := GetDC(0);
 
       if GetDIBits(DC, hbm, 0, b.bmHeight, Buf, BIP^, dib_rgb_Colors) <> 0 then
       begin
 
         ReleaseDC(0, DC);
 
         { Write to file }
         BlockWrite(F,BFH,SizeOf(BFH));
         BlockWrite(F,BIP^, SizeOf(TBitmapInfo) + ColorSize);
         TempReadSize:=DataSize;
 
         while TempReadSize > 0 do
           begin
           if TempReadSize > Taille then
               begin
               BlockWrite(F, Buf^, Taille);
               if Ofs(Buf^) = Taille then
                 Buf := Ptr(Seg(Buf^) + ofs(Ahincr), 0)
                 else
                 Buf := Ptr(Seg(Buf^), Taille);
               end
           else  BlockWrite(F, Buf^, TempReadSize);
           Dec(TempReadSize, Taille);
           end;
         SaveBitmapFile := 1;
       end;
 
       { Clean up }
       GlobalUnlock(HMem);
       GlobalFree(HMem);
     end;
     FreeMem(BIP, SizeOf(TBitmapInfoHeader) + ColorSize);
   end;
 Close(f);
end;

eh voila, ca marche a tout les coups, ss XP,WIN98 et WInNT.....
pour ceux que cela interresse, j'ai aussi pour Charger une image depuis le Disk... faites le moi savoir !!!

Thierry !.

[Alcatîz]

Ne t'arrête pas en si bon chemin !
Personnellement, ça m'intéresse.