getviewportorgexu.pas

DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.

unit GetViewportOrgExU;

interface

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

type
  TForm1 = class(TForm)
    TrackBarSWOX: TTrackBar;
    TrackBarSWOY: TTrackBar;
    Panel1: TPanel;
    TrackBarSVOX: TTrackBar;
    TrackBarSWEX: TTrackBar;
    TrackBarSVEX: TTrackBar;
    TrackBarSVOY: TTrackBar;
    TrackBarSWEY: TTrackBar;
    TrackBarSVEY: TTrackBar;
    RadioGroup1: TRadioGroup;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    LabelGMMprompt: TLabel;
    LabelGMMResult: TLabel;
    LabelGetDCOrgExPrompt: TLabel;
    LabelGetDCOrgExResult: TLabel;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ReportPosition;
    procedure ReadUserRequest;

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

var
  Form1: TForm1;
  WOrigin: TPoint;        // holds the window origin
  VOrigin: TPoint;        // holds the viewport origin
  WExt: TPoint;           // holds the window extent
  VExt: TPoint;           // holds the viewport extent
  MyDisplayDC: HDC;       // holds the device context
  MyMapMode: Integer;     // holds the mapping mode

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  {set the scale of the origin trackbars}
  TrackbarSWOX.Max := Panel1.Width;
  TrackbarSWOY.Max := Panel1.Height;
  TrackbarSVOX.Max := Panel1.Width;
  TrackbarSVOY.Max := Panel1.Height;

  {initialize the trackbars to their midpoints}
  TrackbarSWOX.Position := TrackbarSWOY.Max div 2;
  TrackbarSWOY.Position := TrackbarSWOX.Max div 2;
  TrackbarSVOX.Position := TrackbarSVOY.Max div 2;
  TrackbarSVOY.Position := TrackbarSVOX.Max div 2;
  TrackbarSWEX.Position := TrackbarSWEY.Max div 2;
  TrackbarSWEY.Position := TrackbarSWEX.Max div 2;
  TrackbarSVEX.Position := TrackbarSVEY.Max div 2;
  TrackbarSVEY.Position := TrackbarSVEX.Max div 2;
end;

procedure TForm1.ReportPosition;
var
  ReturnValue: TPoint;          // holds the window and viewport origins
  ReturnSize: TSize;            // holds the window and viewport extents
  ReadMapMode: Integer;         // holds the mapping mode
  ReadFinalOrigin: TPoint;      // holds the device origin
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);

  {display the current mapping mode}
  ReadMapMode := GetMapMode(MyDisplayDC);
  case ReadMapMode of
    MM_TEXT:       LabelGMMresult.Caption := 'MM_TEXT';
    MM_ANISOTROPIC:LabelGMMresult.Caption := 'MM_ANISOTROPIC';
    MM_ISOTROPIC:  LabelGMMresult.Caption := 'MM_ISOTROPIC';
    MM_HIENGLISH:  LabelGMMresult.Caption := 'MM_HIENGLISH';
    MM_HIMETRIC:   LabelGMMresult.Caption := 'MM_HIMETRIC';
    MM_LOENGLISH:  LabelGMMresult.Caption := 'MM_LOENGLISH';
    MM_LOMETRIC:   LabelGMMresult.Caption := 'MM_LOMETRIC';
    MM_TWIPS:      LabelGMMresult.Caption := 'MM_TWIPS';
  end;

  {display the final translation origin for the device context}
  GetDCOrgEx(MyDisplayDC, ReadFinalOrigin);
  LabelGetDCOrgExResult.Caption := IntToStr(ReadFinalOrigin.X) + ', ' +
                                   IntToStr(ReadFinalOrigin.Y);
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;

  {set the origin and extent values according to the trackbar positions}
  WOrigin.x := TrackBarSWOX.Position;
  WOrigin.y := TrackBarSWOY.Position;
  VOrigin.x := TrackBarSVOX.Position;
  VOrigin.y := TrackBarSVOY.Position;
  WExt.x    := TrackBarSWEX.Position;
  WExt.y    := TrackBarSWEY.Position;
  VExt.x    := TrackBarSVEX.Position;
  VExt.y    := TrackBarSVEY.Position;
end;

procedure TForm1.PaintImage;
begin
  {retrieve a device context for the panel}
  MyDisplayDC := GetDC(Panel1.Handle);

  {erase the current image}
  Panel1.Repaint;

  {retrieve the user defined values}
  ReadUserRequest;

  {set the mapping mode to the selected value}
  SetMapMode(MyDisplayDC, MyMapMode);
  if Checkbox1.Checked
    then SetWindowOrgEx(MyDisplayDC, WOrigin.x, WOrigin.y, nil);
  if Checkbox2.Checked
    then SetViewportOrgEx(MyDisplayDC, VOrigin.x, VOrigin.y, nil);
  if Checkbox3.Checked
    then SetWindowExtEx(MyDisplayDC, WExt.x, WExt.y, nil);
  if Checkbox4.Checked
    then SetViewportExtEx(MyDisplayDC, VExt.x, VExt.y, nil);

  {draw the image. note that the image is drawn to the same, hard coded
   coordinates. this demonstrates how changing the viewport and window
   origin and extents can affect drawn objects}
  Windows.Rectangle(MyDisplayDC,0,0,50,50);
  Windows.Rectangle(MyDisplayDC,-25,24,75,26);
  Windows.Rectangle(MyDisplayDC,24,-25,26,75);

  {display the current settings}
  ReportPosition;

  {release the device context}
  ReleaseDC(Panel1.Handle, MyDisplayDC);
end;

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

end.