rm_jvinterpreter_graphics.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,837 行 · 第 1/4 页

{-----------------------------------------------------------------------------
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: JvInterpreter_Graphics.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <[e-mail]>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.

Contributor(s):

Last Modified: 2002-07-04

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 JvInterpreter calls to delphi calls

Known Issues:
-----------------------------------------------------------------------------}

{$I rm_JVCL.INC}

unit rm_JvInterpreter_Graphics;

interface

uses
  rm_JvInterpreter;

procedure RegisterJvInterpreterAdapter(JvInterpreterAdapter: TJvInterpreterAdapter);

implementation

uses
  {$IFDEF COMPLIB_VCL}
  Windows, Classes, Graphics, rm_JvInterpreter_Windows;
  {$ENDIF COMPLIB_VCL}
  {$IFDEF COMPLIB_CLX}
  Types, Classes, QGraphics, rm_JvInterpreter_Types;
  {$ENDIF COMPLIB_CLX}

{ 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 COMPLIB_VCL}
  Value := Integer(TFont(Args.Obj).Handle);
  {$ENDIF COMPLIB_VCL}
  {$IFDEF COMPLIB_CLX}
  Value := P2V(TFont(Args.Obj).Handle);
  {$ENDIF COMPLIB_CLX}
end;

{ property Write Handle(Value: HFont) }

procedure TFont_Write_Handle(const Value: Variant; Args: TJvInterpreterArgs);
begin
  {$IFDEF COMPLIB_VCL}
  TFont(Args.Obj).Handle := Value;
  {$ENDIF COMPLIB_VCL}
  {$IFDEF COMPLIB_CLX}
  TFont(Args.Obj).Handle := V2P(Value);
  {$ENDIF COMPLIB_CLX}
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;

{$IFDEF COMPILER3_UP}

{ 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;

{$ENDIF COMPILER3_UP}

{ 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 COMPLIB_VCL}
  Value := Integer(TPen(Args.Obj).Handle);
  {$ENDIF COMPLIB_VCL}
  {$IFDEF COMPLIB_CLX}
  Value := P2V(TPen(Args.Obj).Handle);
  {$ENDIF COMPLIB_CLX}
end;

{ property Write Handle(Value: HPen) }

procedure TPen_Write_Handle(const Value: Variant; Args: TJvInterpreterArgs);
begin
  {$IFDEF COMPLIB_VCL}
  TPen(Args.Obj).Handle := Value;
  {$ENDIF COMPLIB_VCL}
  {$IFDEF COMPLIB_CLX}
  TPen(Args.Obj).Handle := V2P(Value);
  {$ENDIF COMPLIB_CLX}
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 COMPLIB_VCL}
  Value := Integer(TBrush(Args.Obj).Handle);
  {$ENDIF COMPLIB_VCL}
  {$IFDEF COMPLIB_CLX}
  Value := P2V(TBrush(Args.Obj).Handle);
  {$ENDIF COMPLIB_CLX}
end;

{ property Write Handle(Value: HBrush) }

procedure TBrush_Write_Handle(const Value: Variant; Args: TJvInterpreterArgs);
begin
  {$IFDEF COMPLIB_VCL}
  TBrush(Args.Obj).Handle := Value;
  {$ENDIF COMPLIB_VCL}
  {$IFDEF COMPLIB_CLX}
  TBrush(Args.Obj).Handle := V2P(Value);
  {$ENDIF COMPLIB_CLX}
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 COMPLIB_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 COMPLIB_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;

{$IFDEF COMPLIB_VCL}

{ procedure FloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle); }

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