olexform.pas

是一个delphi的流程制作软件

//--- Xform Utilities ----------------------------------------------------------
//
// These functions translate sizes (length and rectangles) between pixels
// and himetric/
//
// Grahame Marsh
// Freeware for UNDU - you get it for free I make no promises
// [e-mail]
//------------------------------------------------------------------------------

unit OleXForm;

interface

uses
  Windows, Classes;

function  XformWidthInPixelsToHiMetric  (DC : hDC; Width : integer) : integer;
function  XformWidthInHiMetricToPixels  (DC : hDC; Width : integer) : integer;
function  XformHeightInPixelsToHiMetric (DC : hDC; Height : integer) : integer;
function  XformHeightInHiMetricToPixels (DC : hDC; Height : integer) : integer;
procedure XformSizeInHiMetricToPixels   (DC : hDC; HiMetricSize : TPoint; var PixelSize : TPoint);
procedure XformSizeInPixelsToHiMetric   (DC : hDC; PixelSize : TPoint; var HiMetricSize : TPoint);
procedure XformRectInPixelsToHiMetric   (DC : hDC; PixelRect : TRect; var HiMetricRect : TRect);
procedure XformRectInHiMetricToPixels   (DC : hDC; HiMetricRect : TRect; var PixelRect : TRect);


implementation

//=== TRANSFORMATIONS ==========================================================

const
  HiMetricPerInch = 2540;  // Number HiMetric units per inch

function MapPixelsToLogHiMetric (a, b : integer) : integer;
begin
  Result := MulDiv (HiMetricPerInch, a, b)
end;

function MapLogHiMetricToPixels (a, b : integer) : integer;
begin
  Result := MulDiv (b, a, HiMetricPerInch)
end;

// Functions to convert an integer between a device coordinate system and
// logical HiMetric units.
//
// Parameters:
//  hDC             HDC providing reference to the pixel mapping.  If
//                  NULL, a screen DC is used.
//  (others)        Values to convert
//
// NOTE:
//  When displaying on the screen, Window apps display everything enlarged
//  from its actual size so that it is easier to read. For example, if an
//  app wants to display a 1in. horizontal line, that when printed is
//  actually a 1in. line on the printed page, then it will display the line
//  on the screen physically larger than 1in. This is described as a line
//  that is "logically" 1in. along the display width. Windows maintains as
//  part of the device-specific information about a given display device:
//      LOGPIXELSX -- no. of pixels per logical in along the display width
//      LOGPIXELSY -- no. of pixels per logical in along the display height
//
//  The following formula converts a distance in pixels into its equivalent
//  logical HiMetric units:
//
//      DistInHiMetric = (HiMetric_PER_INCH * DistInPix)
//                       -------------------------------
//                           PIXELS_PER_LOGICAL_IN
//
//

function XformWidthInPixelsToHiMetric (DC : hDC; Width : integer) : integer;
var
  SystemDC : boolean;
  PixelsPerInch : integer;
begin
  SystemDC := DC = 0;
  if SystemDC then
    DC := GetDC (0);
  try
    PixelsPerInch := GetDeviceCaps (DC, LOGPIXELSX);
    Result := MapPixelsToLogHiMetric (Width, PixelsPerInch)
  finally
    if SystemDC then
      ReleaseDC (0, DC)
  end
end;

function XformWidthInHiMetricToPixels (DC : hDC; Width : integer) : integer;
var
  SystemDC : boolean;
  PixelsPerInch : integer;
begin
  SystemDC := DC = 0;
  if SystemDC then
    DC := GetDC (0);
  try
    PixelsPerInch := GetDeviceCaps (DC, LOGPIXELSX);
    Result := MapLogHiMetricToPixels (Width, PixelsPerInch)
  finally
    if SystemDC then
      ReleaseDC (0, DC)
  end
end;


function XformHeightInPixelsToHiMetric (DC : hDC; Height : integer) : integer;
var
  SystemDC : boolean;
  PixelsPerInch : integer;
begin
  SystemDC := DC = 0;
  if SystemDC then
    DC := GetDC (0);
  try
    PixelsPerInch := GetDeviceCaps (DC, LOGPIXELSY);
    Result := MapPixelsToLogHiMetric (Height, PixelsPerInch)
  finally
    if SystemDC then
      ReleaseDC (0, DC)
  end
end;

function XformHeightInHiMetricToPixels (DC : hDC; Height : integer) : integer;
var
  SystemDC : boolean;
  PixelsPerInch : integer;
begin
  SystemDC := DC = 0;
  if SystemDC then
    DC := GetDC (0);
  try
    PixelsPerInch := GetDeviceCaps (DC, LOGPIXELSY);
    Result := MapLogHiMetricToPixels (Height, PixelsPerInch)
  finally
    if SystemDC then
      ReleaseDC (0, DC)
  end
end;

// XformSizeInPixelsToHiMetric
// XformSizeInHiMetricToPixels
//
// Functions to convert a SIZEL structure (Size functions) or
// an int (Width functions) between a device coordinate system and
// logical HiMetric units.
//
// Parameters:
//  hDC             HDC providing reference to the pixel mapping.  If
//                  NULL, a screen DC is used.
//  pSizeInPix      LPSIZEL containing the size to convert.
//  pSizeInHiMetric
//
// NOTE:
//  When displaying on the screen, Window apps display everything enlarged
//  from its actual size so that it is easier to read. For example, if an
//  app wants to display a 1in. horizontal line, that when printed is
//  actually a 1in. line on the printed page, then it will display the line
//  on the screen physically larger than 1in. This is described as a line
//  that is "logically" 1in. along the display width. Windows maintains as
//  part of the device-specific information about a given display device:
//      LOGPIXELSX -- no. of pixels per logical in along the display width
//      LOGPIXELSY -- no. of pixels per logical in along the display height
//
//  The following formula converts a distance in pixels into its equivalent
//  logical HiMetric units:
//
//      DistInHiMetric=(HiMetric_PER_INCH * DistInPix)
//                       -------------------------------
//                           PIXELS_PER_LOGICAL_IN
//

procedure XformSizeInHiMetricToPixels (DC : hDC; HiMetricSize : TPoint; var PixelSize : TPoint);
var
  XPixelsPerInch,
  YPixelsPerInch : integer;
  SystemDC : boolean;
begin
  SystemDC := DC = 0;
  if SystemDC then
    DC := GetDC (0);
  try
    XPixelsPerInch := GetDeviceCaps (DC, LOGPIXELSX);
    YPixelsPerInch := GetDeviceCaps (DC, LOGPIXELSY);
    with PixelSize do
    begin
      X  := MapLogHiMetricToPixels (HiMetricSize.X, XPixelsPerInch);
      Y  := MapLogHiMetricToPixels (HiMetricSize.Y, YPixelsPerInch)
    end
  finally
    if SystemDC then
      ReleaseDC (0, DC)
  end
end;

procedure XformSizeInPixelsToHiMetric (DC : hDC; PixelSize : TPoint; var HiMetricSize : TPoint);
var
  XPixelsPerInch,
  YPixelsPerInch : integer;
  SystemDC : boolean;
begin
  SystemDC := DC = 0;
  if SystemDC then
    DC := GetDC (0);
  try
    XPixelsPerInch := GetDeviceCaps (DC, LOGPIXELSX);
    YPixelsPerInch := GetDeviceCaps (DC, LOGPIXELSY);
    with HiMetricSize do
    begin
      X  := MapPixelsToLogHiMetric (PixelSize.X, XPixelsPerInch);
      Y  := MapPixelsToLogHiMetric (PixelSize.Y, YPixelsPerInch)
    end
  finally
    if SystemDC then
      ReleaseDC (0, DC)
  end
end;

//
// XformRectInPixelsToHiMetric
// XformRectInHiMetricToPixels
//
// Purpose:
//  Convert a rectangle between pixels of a given hDC and HiMetric units
//  as manipulated in OLE.  If the hDC is NULL, then a screen DC is used
//  and assumes the MM_TEXT mapping mode.
//
// Parameters:
//  hDC             HDC providing reference to the pixel mapping.  If
//                  NULL, a screen DC is used.
//  prcPix          LPRECT containng the rectangles to convert.
//  prcHiMetric
//
// Return Value:
//  None
//
// NOTE:
//  When displaying on the screen, Window apps display everything enlarged
//  from its actual size so that it is easier to read. For example, if an
//  app wants to display a 1in. horizontal line, that when printed is
//  actually a 1in. line on the printed page, then it will display the line
//  on the screen physically larger than 1in. This is described as a line
//  that is "logically" 1in. along the display width. Windows maintains as
//  part of the device-specific information about a given display device:
//      LOGPIXELSX -- no. of pixels per logical in along the display width
//      LOGPIXELSY -- no. of pixels per logical in along the display height
//
//  The following formula converts a distance in pixels into its equivalent
//  logical HiMetric units:
//
//      DistInHiMetric=(HiMetric_PER_INCH * DistInPix)
//                      -------------------------------
//                            PIXELS_PER_LOGICAL_IN
//
// Rect in Pixels (MM_TEXT):
//
//              0---------- X
//              |
//              |       1) ------------------ ( 2   P1=(rc.left, rc.top)
//              |       |                     |     P2=(rc.right, rc.top)
//              |       |                     |     P3=(rc.left, rc.bottom)
//              |       |                     |     P4=(rc.right, rc.bottom)
//                      |                     |
//              Y       |                     |
//                      3) ------------------ ( 4
//
//              NOTE:   Origin  =(P1x, P1y)
//                      X extent=P4x - P1x
//                      Y extent=P4y - P1y
//
//
// Rect in HiMetric (MM_HiMetric):
//
//
//                      1) ------------------ ( 2   P1=(rc.left, rc.top)
//              Y       |                     |     P2=(rc.right, rc.top)
//                      |                     |     P3=(rc.left, rc.bottom)
//              |       |                     |     P4=(rc.right, rc.bottom)
//              |       |                     |
//              |       |                     |
//              |       3) ------------------ ( 4
//              |
//              0---------- X
//
//              NOTE:   Origin  =(P3x, P3y)
//                      X extent=P2x - P3x
//                      Y extent=P2y - P3y
//

procedure XformRectInPixelsToHiMetric (DC : hDC; PixelRect : TRect; var HiMetricRect : TRect);
var
  TopRight : TPoint;
begin
  with PixelRect do
    XformSizeInPixelsToHiMetric (DC, Point (Right - Left, Bottom - Top), TopRight);
  with HiMetricRect do
  begin
    Left   := 0;
    Bottom := 0;
    Right  := TopRight.X;
    Top    := TopRight.Y
  end
end;

procedure XformRectInHiMetricToPixels (DC : hDC; HiMetricRect : TRect; var PixelRect : TRect);
var
  TopRight : TPoint;
begin
  with HiMetricRect do
    XformSizeInHiMetricToPixels (DC, Point (Right - Left, Bottom - Top), TopRight);
  with PixelRect do
  begin
    Left   := 0;
    Bottom := 0;
    Right  := TopRight.X;
    Top    := TopRight.Y
  end
end;


end.