Impression d'écran améliorée

Soyez le premier à donner votre avis sur cette source.

Vue 8 829 fois - Téléchargée 1 202 fois

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.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
27
Date d'inscription
jeudi 7 novembre 2002
Statut
Membre
Dernière intervention
21 mai 2008

Il y a pas de souci, je m'en doutais bien.
Je suis du même avis que toi.
Pour moi on devrait pas pouvoir noter sans mettre de commentaire.
Ne serait ce que par correction. :-)
Messages postés
418
Date d'inscription
mardi 3 janvier 2006
Statut
Membre
Dernière intervention
26 novembre 2013
3
Salut Lassal,

Je tiens à préciser que cette note ne vient pas de moi.
De plus, je trouve inconcevable de mettre une note assez basse sans faire le moindre commentaire !

Thierry
Messages postés
27
Date d'inscription
jeudi 7 novembre 2002
Statut
Membre
Dernière intervention
21 mai 2008

Avis perso, une note n'est valable que si elle est un minimum justifier.
On est ici pour apprendre et partager.
J'accepte la critique, faut il encore qu'il y en ai une.
5... Ok mais pourquoi?
Qu'est ce qui cloche sur mon code?
J'aimerais le savoir afin de pouvoir optimiser, faire évoluer celui ci.

Merci
Messages postés
27
Date d'inscription
jeudi 7 novembre 2002
Statut
Membre
Dernière intervention
21 mai 2008

Merci. :-)
A l'avenir j'essayerais de mettre plus souvent des sources sur le site.
Le problème c'est que je travail à 95% du temps avec une base ORACLE et donc c'est pas simple de mettre ici ce genre de source.
Mais j'ai surement quelques autres choses du genre qui tourne sans base de données.

++
Messages postés
418
Date d'inscription
mardi 3 janvier 2006
Statut
Membre
Dernière intervention
26 novembre 2013
3
Salut Lassal,

Très beau résultat.

A +
Thierry

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.