rm_jvinterpreter_graphics.pas

这是一个功能强大

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: rm_JvInterpreter_Graphics.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <a dott prygounkov att gmx dott de>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description : adapter unit - converts rm_JvInterpreter calls to delphi calls

Known Issues:
-----------------------------------------------------------------------------}
// $Id: rm_JvInterpreter_Graphics.pas 10141 2005-11-27 11:16:55Z ahuser $

unit rm_JvInterpreter_Graphics;

{$I rm_jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  rm_JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  rm_JvInterpreter;

procedure RegisterJvInterpreterAdapter(JvInterpreterAdapter: TJvInterpreterAdapter);

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile$';
    Revision: '$Revision: 10141 $';
    Date: '$Date: 2005-11-27 03:16:55 -0800 (Sun, 27 Nov 2005) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Classes,
  {$IFDEF VCL}
   rm_JvInterpreter_Windows,
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  JvQInterpreter_Types,
  {$ENDIF VisualCLX}
  Windows, Graphics;

{ TFont }

{ constructor Create }

procedure TFont_Create(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TFont.Create);
end;

{ procedure Assign(Source: TPersistent); }

procedure TFont_Assign(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TFont(Args.Obj).Assign(V2O(Args.Values[0]) as TPersistent);
end;

{ property Read Handle: HFont }

procedure TFont_Read_Handle(var Value: Variant; Args: TJvInterpreterArgs);
begin
  {$IFDEF VCL}
  Value := Integer(TFont(Args.Obj).Handle);
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  Value := P2V(TFont(Args.Obj).Handle);
  {$ENDIF VisualCLX}
end;

{ property Write Handle(Value: HFont) }

procedure TFont_Write_Handle(const Value: Variant; Args: TJvInterpreterArgs);
begin
  {$IFDEF VCL}
  TFont(Args.Obj).Handle := Value;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  TFont(Args.Obj).Handle := V2P(Value);
  {$ENDIF VisualCLX}
end;

{ property Read PixelsPerInch: Integer }

procedure TFont_Read_PixelsPerInch(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TFont(Args.Obj).PixelsPerInch;
end;

{ property Write PixelsPerInch(Value: Integer) }

procedure TFont_Write_PixelsPerInch(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TFont(Args.Obj).PixelsPerInch := Value;
end;

{ property Read Charset: TFontCharset }

procedure TFont_Read_Charset(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TFont(Args.Obj).Charset;
end;

{ property Write Charset(Value: TFontCharset) }

procedure TFont_Write_Charset(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TFont(Args.Obj).Charset := Value;
end;

{ property Read Color: TColor }

procedure TFont_Read_Color(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TFont(Args.Obj).Color;
end;

{ property Write Color(Value: TColor) }

procedure TFont_Write_Color(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TFont(Args.Obj).Color := Value;
end;

{ property Read Height: Integer }

procedure TFont_Read_Height(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TFont(Args.Obj).Height;
end;

{ property Write Height(Value: Integer) }

procedure TFont_Write_Height(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TFont(Args.Obj).Height := Value;
end;

{ property Read Name: TFontName }

procedure TFont_Read_Name(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TFont(Args.Obj).Name;
end;

{ property Write Name(Value: TFontName) }

procedure TFont_Write_Name(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TFont(Args.Obj).Name := Value;
end;

{ property Read Pitch: TFontPitch }

procedure TFont_Read_Pitch(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TFont(Args.Obj).Pitch;
end;

{ property Write Pitch(Value: TFontPitch) }

procedure TFont_Write_Pitch(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TFont(Args.Obj).Pitch := Value;
end;

{ property Read Size: Integer }

procedure TFont_Read_Size(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TFont(Args.Obj).Size;
end;

{ property Write Size(Value: Integer) }

procedure TFont_Write_Size(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TFont(Args.Obj).Size := Value;
end;

{ property Read Style: TFontStyles }

procedure TFont_Read_Style(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := S2V(byte(TFont(Args.Obj).Style));
end;

{ property Write Style(Value: TFontStyles) }

procedure TFont_Write_Style(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TFont(Args.Obj).Style := TFontStyles(byte(V2S(Value)));
end;

{ TPen }

{ constructor Create }

procedure TPen_Create(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TPen.Create);
end;

{ procedure Assign(Source: TPersistent); }

procedure TPen_Assign(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TPen(Args.Obj).Assign(V2O(Args.Values[0]) as TPersistent);
end;

{ property Read Handle: HPen }

procedure TPen_Read_Handle(var Value: Variant; Args: TJvInterpreterArgs);
begin
  {$IFDEF VCL}
  Value := Integer(TPen(Args.Obj).Handle);
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  Value := P2V(TPen(Args.Obj).Handle);
  {$ENDIF VisualCLX}
end;

{ property Write Handle(Value: HPen) }

procedure TPen_Write_Handle(const Value: Variant; Args: TJvInterpreterArgs);
begin
  {$IFDEF VCL}
  TPen(Args.Obj).Handle := Value;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  TPen(Args.Obj).Handle := V2P(Value);
  {$ENDIF VisualCLX}
end;

{ property Read Color: TColor }

procedure TPen_Read_Color(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TPen(Args.Obj).Color;
end;

{ property Write Color(Value: TColor) }

procedure TPen_Write_Color(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TPen(Args.Obj).Color := Value;
end;

{ property Read Mode: TPenMode }

procedure TPen_Read_Mode(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TPen(Args.Obj).Mode;
end;

{ property Write Mode(Value: TPenMode) }

procedure TPen_Write_Mode(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TPen(Args.Obj).Mode := Value;
end;

{ property Read Style: TPenStyle }

procedure TPen_Read_Style(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TPen(Args.Obj).Style;
end;

{ property Write Style(Value: TPenStyle) }

procedure TPen_Write_Style(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TPen(Args.Obj).Style := Value;
end;

{ property Read Width: Integer }

procedure TPen_Read_Width(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TPen(Args.Obj).Width;
end;

{ property Write Width(Value: Integer) }

procedure TPen_Write_Width(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TPen(Args.Obj).Width := Value;
end;

{ TBrush }

{ constructor Create }

procedure TBrush_Create(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TBrush.Create);
end;

{ procedure Assign(Source: TPersistent); }

procedure TBrush_Assign(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TBrush(Args.Obj).Assign(V2O(Args.Values[0]) as TPersistent);
end;

{ property Read Bitmap: TBitmap }

procedure TBrush_Read_Bitmap(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TBrush(Args.Obj).Bitmap);
end;

{ property Write Bitmap(Value: TBitmap) }

procedure TBrush_Write_Bitmap(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TBrush(Args.Obj).Bitmap := V2O(Value) as TBitmap;
end;

{ property Read Handle: HBrush }

procedure TBrush_Read_Handle(var Value: Variant; Args: TJvInterpreterArgs);
begin
  {$IFDEF VCL}
  Value := Integer(TBrush(Args.Obj).Handle);
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  Value := P2V(TBrush(Args.Obj).Handle);
  {$ENDIF VisualCLX}
end;

{ property Write Handle(Value: HBrush) }

procedure TBrush_Write_Handle(const Value: Variant; Args: TJvInterpreterArgs);
begin
  {$IFDEF VCL}
  TBrush(Args.Obj).Handle := Value;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  TBrush(Args.Obj).Handle := V2P(Value);
  {$ENDIF VisualCLX}
end;

{ property Read Color: TColor }

procedure TBrush_Read_Color(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TBrush(Args.Obj).Color;
end;

{ property Write Color(Value: TColor) }

procedure TBrush_Write_Color(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TBrush(Args.Obj).Color := Value;
end;

{ property Read Style: TBrushStyle }

procedure TBrush_Read_Style(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TBrush(Args.Obj).Style;
end;

{ property Write Style(Value: TBrushStyle) }

procedure TBrush_Write_Style(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TBrush(Args.Obj).Style := Value;
end;

{ TCanvas }

{ constructor Create }

procedure TCanvas_Create(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TCanvas.Create);
end;

{ procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); }

procedure TCanvas_Arc(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TCanvas(Args.Obj).Arc(Args.Values[0], Args.Values[1], Args.Values[2], Args.Values[3], Args.Values[4], Args.Values[5],
    Args.Values[6], Args.Values[7]);
end;

{ procedure BrushCopy(const Dest: TRect; Bitmap: TBitmap; const Source: TRect; Color: TColor); }

{$IFDEF VCL}
procedure TCanvas_BrushCopy(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TCanvas(Args.Obj).BrushCopy(Var2Rect(Args.Values[0]), V2O(Args.Values[1]) as TBitmap, Var2Rect(Args.Values[2]),
    Args.Values[3]);
end;
{$ENDIF VCL}

{ procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); }

procedure TCanvas_Chord(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TCanvas(Args.Obj).Chord(Args.Values[0], Args.Values[1], Args.Values[2], Args.Values[3], Args.Values[4],
    Args.Values[5], Args.Values[6], Args.Values[7]);
end;

{ procedure CopyRect(const Dest: TRect; Canvas: TCanvas; const Source: TRect); }

procedure TCanvas_CopyRect(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TCanvas(Args.Obj).CopyRect(Var2Rect(Args.Values[0]), V2O(Args.Values[1]) as TCanvas, Var2Rect(Args.Values[2]));
end;

{ procedure Draw(X, Y: Integer; Graphic: TGraphic); }

procedure TCanvas_Draw(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TCanvas(Args.Obj).Draw(Args.Values[0], Args.Values[1], V2O(Args.Values[2]) as TGraphic);
end;

{ procedure DrawFocusRect(const Rect: TRect); }

procedure TCanvas_DrawFocusRect(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TCanvas(Args.Obj).DrawFocusRect(Var2Rect((Args.Values[0])));
end;

{ procedure Ellipse(X1, Y1, X2, Y2: Integer); }

procedure TCanvas_Ellipse(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TCanvas(Args.Obj).Ellipse(Args.Values[0], Args.Values[1], Args.Values[2], Args.Values[3]);
end;

{ procedure FillRect(const Rect: TRect); }

procedure TCanvas_FillRect(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TCanvas(Args.Obj).FillRect(Var2Rect(Args.Values[0]));
end;