imp_graphics.pas

Delphi脚本控件

////////////////////////////////////////////////////////////////////////////
// PAXScript Importing
// Author: Alexander Baranovsky ([e-mail])
// ========================================================================
// Copyright (c) Alexander Baranovsky, 2003. All rights reserved.                                  
// Code Version: 1.5
// ========================================================================
// Unit: IMP_Graphics.pas
// ========================================================================
////////////////////////////////////////////////////////////////////////////

// Imports classes:
//   TBitmap,
//   TBrush,
//   TCanvas,
//   TFont,
//   TGraphic,
//   TGraphicsObject,
//   TIcon,
//   TMetafile
//   TMetafileCanvas
//   TPen,
//   TPicture

unit IMP_Graphics;
interface
uses
  SysUtils,
{$IFDEF WIN32}
  Windows,
{$ENDIF}
{$IFDEF LINUX}
  Types,
  QGraphics,
  QControls,
{$ELSE}
  Graphics,
  Controls,
{$ENDIF}
  PaxScripter;

implementation

type
  TByteArray = class
  private
    P: Pointer;
    procedure Put(I: Integer; Value: Integer);
    function Get(I: Integer): Integer;
  public
    property Items[I: Integer]: Integer read Get write Put; default;
  end;

procedure TByteArray.Put(I: Integer; Value: Integer);
begin
  PByteArray(P)^[I] := Value;
end;

function TByteArray.Get(I: Integer): Integer;
begin
  result := PByteArray(P)^[I];
end;

//-------TBrush-----------------------------------------------------------------

function TBrush_GetBitmap: TBitmap;
begin
 result := TBrush(_Self).Bitmap;
end;

procedure TBrush_SetBitmap(Value: TBitmap);
begin
 TBrush(_Self).Bitmap := Value;
end;

//-------TCanvas----------------------------------------------------------------

function TCanvas_GetClipRect: TRect;
begin
 result := TCanvas(_Self).ClipRect;
end;

function TCanvas_GetLockCount: Integer;
begin
 result := TCanvas(_Self).LockCount;
end;

function TCanvas_GetPenPos: TPoint;
begin
 result := TCanvas(_Self).PenPos;
end;

procedure TCanvas_SetPenPos(Value: TPoint);
begin
 TCanvas(_Self).PenPos := Value;
end;

function TCanvas_GetPixel(X, Y: Integer): TColor;
begin
 result := TCanvas(_Self).Pixels[X,Y];
end;

procedure TCanvas_SetPixel(X, Y: Integer; Value: TColor);
begin
 TCanvas(_Self).Pixels[X,Y] := Value;
end;

//-------TGraphic---------------------------------------------------------------

function TGraphic_GetEmpty: Boolean;
begin
 result := TGraphic(_Self).Empty;
end;

function TGraphic_GetHeight: Integer;
begin
 result := TGraphic(_Self).Height;
end;

procedure TGraphic_SetHeight(Value: Integer);
begin
 TGraphic(_Self).Height := Value;
end;

function TGraphic_GetModified: Boolean;
begin
 result := TGraphic(_Self).Modified;
end;

procedure TGraphic_SetModified(Value: Boolean);
begin
 TGraphic(_Self).Modified := Value;
end;

function TGraphic_GetTransparent: Boolean;
begin
 result := TGraphic(_Self).Transparent;
end;

procedure TGraphic_SetTransparent(Value: Boolean);
begin
 TGraphic(_Self).Transparent := Value;
end;

function TGraphic_GetWidth: Integer;
begin
 result := TGraphic(_Self).Width;
end;

procedure TGraphic_SetWidth(Value: Integer);
begin
 TGraphic(_Self).Width := Value;
end;

{$IFDEF WIN32}
//-------TMetafile--------------------------------------------------------------

function TMetafile_GetAuthor: String;
begin
 result := TMetafile(_Self).CreatedBy;
end;

function TMetafile_GetDesc: String;
begin
 result := TMetafile(_Self).Description;
end;

function TMetafile_GetEnhanced: Boolean;
begin
 result := TMetafile(_Self).Enhanced;
end;

procedure TMetafile_SetEnhanced(Value: Boolean);
begin
 TMetafile(_Self).Enhanced := Value;
end;

function TMetafile_GetHandle: HENHMETAFILE;
begin
 result := TMetafile(_Self).Handle;
end;

procedure TMetafile_SetHandle(Value: HENHMETAFILE);
begin
 TMetafile(_Self).Handle := Value;
end;

function TMetafile_GetMMWidth: Integer;
begin
 result := TMetafile(_Self).MMWidth;
end;

procedure TMetafile_SetMMWidth(Value: Integer);
begin
 TMetafile(_Self).MMWidth := Value;
end;

function TMetafile_GetMMHeight: Integer;
begin
 result := TMetafile(_Self).MMHeight;
end;

procedure TMetafile_SetMMHeight(Value: Integer);
begin
 TMetafile(_Self).MMHeight := Value;
end;

function TMetafile_GetInch: Word;
begin
 result := TMetafile(_Self).Inch;
end;

procedure TMetafile_SetInch(Value: Word);
begin
 TMetafile(_Self).Inch := Value;
end;

{$ENDIF}

//-------TPicture---------------------------------------------------------------

function TPicture_GetBitmap: TBitmap;
begin
 result := TPicture(_Self).Bitmap;
end;

procedure TPicture_SetBitmap(Value: TBitmap);
begin
 TPicture(_Self).Bitmap := Value;
end;

function TPicture_GetGraphic: TGraphic;
begin
 result := TPicture(_Self).Graphic;
end;

procedure TPicture_SetGraphic(Value: TGraphic);
begin
 TPicture(_Self).Graphic := Value;
end;

function TPicture_GetHeight: Integer;
begin
 result := TPicture(_Self).Height;
end;

function TPicture_GetIcon: TIcon;
begin
 result := TPicture(_Self).Icon;
end;

procedure TPicture_SetIcon(Value: TIcon);
begin
 TPicture(_Self).Icon := Value;
end;

function TPicture_GetWidth: Integer;
begin
 result := TPicture(_Self).Width;
end;

//-------TBitmap----------------------------------------------------------------

function TBitmap_GetCanvas: TCanvas;
begin
 result := TBitmap(_Self).Canvas;
end;

function TBitmap_GetMonochrome: Boolean;
begin
 result := TBitmap(_Self).Monochrome;
end;

procedure TBitmap_SetMonochrome(Value: Boolean);
begin
 TBitmap(_Self).Monochrome := Value;
end;

function TBitmap_GetPixelFormat: TPixelFormat;
begin
 result := TBitmap(_Self).PixelFormat;
end;

procedure TBitmap_SetPixelFormat(Value: TPixelFormat);
begin
 TBitmap(_Self).PixelFormat := Value;
end;

function TBitmap_GetScanline(Row: Integer): TByteArray;
var
  P: Pointer;
  Key: TVarRec;
begin
  P := TBitmap(_Self).ScanLine[Row];

  Key.VPointer := P;
  result := TByteArray(_Scripter.FindTempObject(Key));
  if result <> nil then
    Exit;

  result := TByteArray.Create;
  result.P := P;

  _Scripter.AddTempObject(Key, result);
end;

function TBitmap_GetTransparentColor: TColor;
begin
 result := TBitmap(_Self).TransparentColor;
end;

procedure TBitmap_SetTransparentColor(Value: TColor);
begin
 TBitmap(_Self).TransparentColor := Value;
end;

function TBitmap_GetTransparentMode: TTransparentMode;
begin
 result := TBitmap(_Self).TransparentMode;
end;

procedure TBitmap_SetTransparentMode(Value: TTransparentMode);
begin
 TBitmap(_Self).TransparentMode := Value;
end;

type
  TRegClass = class
    procedure  RegColor(const S: string);
  end;

procedure TRegClass.RegColor(const S: string);
var
  C: Integer;
begin
  if IdentToColor(S, C) then
    RegisterConstant(S, C, -1);
end;

procedure RegisterColorValues;
var
  X: TRegClass;
begin
  X := TRegClass.Create;
  GetColorValues(X.RegColor);
  X.Free;
end;

var
  H: Integer;

initialization