scaleviewportextexu.pas

Delphi Win32核心API参考光盘源码 本书包含了常用的Windows API函数

unit ScaleViewportExtExU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, Buttons;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    RadioGroup1: TRadioGroup;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    EditOWX: TEdit;
    EditOVX: TEdit;
    EditSWEXM: TEdit;
    EditSVEXM: TEdit;
    EditSWEXD: TEdit;
    EditSVEXD: TEdit;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    EditOWY: TEdit;
    EditOVY: TEdit;
    EditSWEYM: TEdit;
    EditSVEYM: TEdit;
    EditSWEYD: TEdit;
    EditSVEYD: TEdit;
    Button1: TButton;
    Panel2: TPanel;
    EditDevX: TEdit;
    EditDevY: TEdit;
    EditLogX: TEdit;
    EditLogY: TEdit;
    Label21: TLabel;
    Label22: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure FormPaint(Sender: TObject);
    procedure ReportPosition;
    procedure ReadUserRequest;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
    procedure PaintImage;
  end;

var
  Form1: TForm1;
  MyDisplayDC: HDC;               // a handle to the device context
  MyMapMode: Integer;             // holds the mapping mode
  PrevWindowSize: TSize;          // holds the previous window size
  PrevViewportSize: TSize;        // holds the previous viewport size
  PrevWindowPoint: TPoint;        // holds the previous window origin
  PrevViewportPoint: TPoint;      // holds the previous viewport origin

implementation

{$R *.DFM}

procedure TForm1.ReportPosition;
var
  ReturnValue: TPoint;          // holds the window and viewport origin
  ReturnSize: TSize;            // holds teh window and viewport extents
begin
  {display the window origin}
  GetWindowOrgEx(MyDisplayDC,ReturnValue);
  Label9.Caption := IntToStr(ReturnValue.x)
        + ', ' + IntToStr(ReturnValue.y);

  {display the viewport origin}
  GetViewportOrgEx(MyDisplayDC,ReturnValue);
  Label10.Caption := IntToStr(ReturnValue.x)
        + ', ' + IntToStr(ReturnValue.y);

  {display the window extents}
  GetWindowExtEx(MyDisplayDC,ReturnSize);
  Label11.Caption := IntToStr(ReturnSize.cx)
        + ', ' + IntToStr(ReturnSize.cy);

  {display the viewport extents}
  GetViewportExtEx(MyDisplayDC,ReturnSize);
  Label12.Caption := IntToStr(ReturnSize.cx)
        + ', ' + IntToStr(ReturnSize.cy);
end;

procedure TForm1.ReadUserRequest;
begin
  {retrieve the selected mapping mode}
  case RadioGroup1.ItemIndex of
    0: MyMapMode := MM_TEXT;
    1: MyMapMode := MM_ANISOTROPIC;
    2: MyMapMode := MM_ISOTROPIC;
    3: MyMapMode := MM_HIENGLISH;
    4: MyMapMode := MM_HIMETRIC;
    5: MyMapMode := MM_LOENGLISH;
    6: MyMapMode := MM_LOMETRIC;
    7: MyMapMode := MM_TWIPS;
  end;
end;

procedure TForm1.PaintImage;
begin
  {erase the previous image}
  Panel1.Repaint;

  {get the values of the user controls}
  ReadUserRequest;

  {set the Map Mode according to the radiogroup}
  SetMapMode(MyDisplayDC,MyMapMode);

  {offset the window origin by the specified ammount}
  OffsetWindowOrgEx(MyDisplayDC,
    StrToInt(EditOWX.text),StrToInt(EditOWY.text),
    @PrevWindowPoint);

  {offset the viewport origin by the specified amount}
  OffSetViewportOrgEx(MyDisplayDC,
    StrToInt(EditOVX.text),StrToInt(EditOVY.text),
    @PrevViewportPoint);

  {scale the window extents by the specified amount}
  ScaleWindowExtEx(MyDisplayDC,
    StrToInt(EditSWEXM.text),StrToInt(EditSWEXD.text),
    StrToInt(EditSWEYM.text),StrToInt(EditSWEYD.text),
    @PrevWindowSize);

  {scale the viewport extents by the specified amount}
  ScaleViewportExtEx(MyDisplayDC,
    StrToInt(EditSVEXM.text),StrToInt(EditSVEXD.text),
    StrToInt(EditSVEYM.text),StrToInt(EditSVEYD.text),
    @PrevViewportSize);

  {draw the image. note that the coordinates used are hard coded and do not
   change, demonstrating how the window origin and extents affect drawing
   operations}
  Windows.Rectangle(MyDisplayDC, 0, 0, 50, 50);
  Windows.Rectangle(MyDisplayDC, -25, 24, 75, 26);
  Windows.Rectangle(MyDisplayDC, 24, -25, 26, 75);

  {display the new origin and extent values}
  ReportPosition;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  {paint the image}
  PaintImage;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {retrieve a handle to the panel's device context}
  MyDisplayDC := GetDC(Panel1.handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  {release the device context}
  ReleaseDC(Panel1.handle,MyDisplayDC);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  MyPoint: TPoint;   // holds converted points
begin
  {convert device units to logical units with DPtoLP}
  MyPoint.X := StrToInt(EditDevX.text);
  MyPoint.Y := StrToInt(EditDevY.text);

  {check for errors}
  if not DPtoLP(MyDisplayDC,MyPoint,1) then
    ShowMessage('Error in device coordinates')
  else
  begin
    {MyPoint now contains converted logical coordinates}
    EditLogX.text := IntToStr(MyPoint.X);
    EditLogY.text := IntToStr(MyPoint.Y);
  end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var
  MyPoint: TPoint;    // holds converted points
begin
  {convert device units to logical units with DPtoLP}
  MyPoint.X := StrToInt(EditLogX.Text);
  MyPoint.Y := StrToInt(EditLogY.Text);

  {check for errors}
  if not LPtoDP(MyDisplayDC,MyPoint,1) then
    ShowMessage('Error in logical coordinates')
  else
  begin
    {MyPoint now contains converted device coordinates}
    EditDevX.Text := IntToStr(MyPoint.X);
    EditDevY.Text := IntToStr(MyPoint.Y);
  end;
end;

end.