Impression d'écran améliorée

Télécharger le projet
Commenter

Description

Salut tout le monde.
La fonction de mon petit bout de code est tout simple, faire une impression d'écran dans le genre du "Print" dans Delphi qui retouche la fiche de façon à ce qu'elle tienne toujours sur une seul page lors de l'impression.

Source / Exemple : 


unit UFonctions;

interface

uses Classes, SysUtils, windows,  Forms, Printers, Controls, Graphics;

procedure FicheImprime(p_tFiche: TForm);

implementation

procedure FicheImprime(p_tFiche: TForm);
          var
          l_iNewHeight      : Integer;
          l_iNewWidth       : Integer;
          l_tFormBitmap     : TBitMap;
          l_pHeader         : Pointer;
          l_pBits           : Pointer;
          l_dHeaderSize     : DWord;
          l_dBitsSize       : DWord;
          l_tOldOrientation : TPrinterOrientation;
begin

    Screen.Cursor := crHourglass;

    l_tOldOrientation   := Printer.Orientation;
    Printer.Orientation := poLandscape;
    Printer.BeginDoc;
    l_tFormBitmap := nil;

    try
        //Récupération image de la fiche
        l_tFormBitmap := p_tFiche.GetFormImage;
        //Comparaison entre taille
        if ((l_tFormBitmap.Width / l_tFormBitmap.Height) > (Printer.PageWidth / Printer.PageHeight)) then
        begin
            //Calcul taille si agrandissement sur la largeur
            l_iNewWidth := Printer.PageWidth;
            l_iNewHeight := MulDiv(l_tFormBitmap.Height, Printer.PageWidth, l_tFormBitmap.Width);
        end
        else
        begin
            //Calcul taille si agrandissement sur la hauteur
            l_iNewWidth := MulDiv(l_tFormBitmap.Width, printer.PageHeight, l_tFormBitmap.Height);
            l_iNewHeight := Printer.PageHeight;
        end;

        //Recupération de la taille du bitmap recalculé
        GetDIBSizes(l_tFormBitmap.Handle, l_dHeaderSize, l_dBitsSize);
        //On alloue la mémoire nécessaire pour le retaillage du bitmap
        l_pHeader := AllocMem(l_dHeaderSize);
        l_pBits := AllocMem(l_dBitsSize);

        try
            //Rend le bitmap indépendant du périphérique
            GetDIB(l_tFormBitmap.Handle, l_tFormBitmap.Palette, l_pHeader^, l_pBits^);
            //Elargissement du bitmap en fonction des calculs de taille imprimante
            StretchDIBits(Printer.Canvas.Handle,
                Rect(0, 0, l_iNewWidth, l_iNewHeight).Left,
                Rect(0, 0, l_iNewWidth, l_iNewHeight).Top,
                Rect(0, 0, l_iNewWidth, l_iNewHeight).Right,
                Rect(0, 0, l_iNewWidth, l_iNewHeight).Bottom,
                0,
                0,
                l_tFormBitmap.Width,
                l_tFormBitmap.Height,
                l_pBits,
                TBitmapInfo(l_pHeader^),
                DIB_RGB_COLORS,
                SRCCOPY);
        finally
            FreeMem(l_pHeader, l_dHeaderSize);
            FreeMem(l_pBits, l_dBitsSize);
        end;

    finally
        l_tFormBitmap.Free;
        Printer.EndDoc;
        Printer.Orientation := l_tOldOrientation;
        Screen.Cursor := crDefault;
    end;

end;

end.

Conclusion :


N'hésitez pas à commenter ma source si besoin. (Bug, amélioration, etc...)
Pour le niveau j'ai mit initié, mais c'est difficile de mettre quelque chose de juste sur ce point.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Lassal)