能用嗎?
unit VGViewer;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TViewMode = ( vmDesign, vmRun );
TVGViewer = class(TCustomPanel)
private
hLib : THandle;
Buffer : array[0..4096] of char;
_CreateDoc : procedure( wnd : HWND; filename : PChar ); cdecl;
_DestroyDoc : procedure( wnd : HWND ); cdecl;
_SetViewerWindow : procedure( wnd, viewer : HWND ); cdecl;
_Execute : function( wnd : HWND; buffer : PChar ) : Integer; cdecl;
_GetVarible : function( wnd : HWND; name : PChar; buffer : PChar ) : Integer; cdecl;
_AddFunction : procedure( name, lstrHelp, param : PChar; ret : Integer; proc : Pointer ); cdecl;
FWindowHandle: HWND;
FFileName: string;
FViewMode: TViewMode;
procedure SetFileName(const Value: string);
procedure SetViewMode(const Value: TViewMode);
procedure CNKeyDown(var Message: TWMKeyDown); Message CN_KEYDOWN;
function GetZoom: Integer;
procedure SetZoom(const Value: Integer);
function GetInt: Integer;
function GetString: String;
procedure SetFontName(const Value: TFontName);
function GetFontName: TFontName;
function GetUnitId: Integer;
procedure SetUnitId(const Value: Integer);
function GetFontSize: Integer;
procedure SetFontSize(const Value: Integer);
function GetFontColor: Integer;
procedure SetFontColor(const Value: Integer);
function GetFontStyle: Integer;
procedure SetFontStyle(const Value: Integer);
function GetUnitHeight: Integer;
function GetUnitLeft: Integer;
function GetUnitTop: Integer;
function GetUnitWidth: Integer;
procedure SetUnitHeight(const Value: Integer);
procedure SetUnitLeft(const Value: Integer);
procedure SetUnitTop(const Value: Integer);
procedure SetUnitWidth(const Value: Integer);
function GetPropInt(Command: String): Integer;
function GetPropStr(Command: String): String;
function GetUnitBackColor: TColor;
procedure SetUnitBackColor(const Value: TColor);
function GetBackGroundColor: TColor;
procedure SetBackGroundColor(const Value: TColor);
function GetEndAngle: Integer;
function GetStartAngle: Integer;
procedure SetEndAngle(const Value: Integer);
procedure SetStartAngle(const Value: Integer);
function GetFontAlign: Integer;
procedure SetFontAlign(const Value: Integer);
function GetFontAngle: Integer;
procedure SetFontAngle(const Value: Integer);
function GetFontUnderLine: Integer;
procedure SetFontUnderLine(const Value: Integer);
function GetFontUnderLineColor: Integer;
function GetLineArrow: Integer;
procedure SetLineArrow(const Value: Integer);
function GetLineColor: TColor;
function GetLineType: Integer;
procedure SetLineColor(const Value: TColor);
procedure SetLineType(const Value: Integer);
function GetLineWidth: Integer;
procedure SetLineWidth(const Value: Integer);
procedure SetFontUnderLineColor(const Value: Integer);
function GetUnitName: String;
function GetNumberAttr: Integer;
procedure SetNumberAttr(const Value: Integer);
function GetNumberDigital: Integer;
procedure SetNumberDigital(const Value: Integer);
function GetNumberPostFix: String;
function GetNumberPreFix: String;
procedure SetNumberPostFix(const Value: String);
procedure SetNumberPreFix(const Value: String);
function GetPattern: Integer;
procedure SetPattern(const Value: Integer);
function GetPatternColor1: Integer;
function GetPatternColor2: Integer;
procedure SetPatternColor1(const Value: Integer);
procedure SetPatternColor2(const Value: Integer);
function GetRectRadius: Integer;
procedure SetRectRadius(const Value: Integer);
function GetUnitText: string;
procedure SetUnitText(const Value: string);
function GetUnitVisible: Boolean;
procedure SetUnitVisible(const Value: Boolean);
function GetBoolean: Boolean;
function GetPropBool(Command: String): Boolean;
function GetMultiLine: Boolean;
function GetUnitReadOnly: Boolean;
procedure SetMultiLine(const Value: Boolean);
procedure SetUnitReadOnly(const Value: Boolean);
function GetSelectionCount : Integer;
function GetSelection( Index : Integer ) : Integer;
function GetUnitCount : Integer;
function GetUnits( Index : Integer ) : Integer;
protected
procedure CreateParams(var Params: TCreateParams);override;
procedure CreateWnd; override;
procedure Loaded; override;
procedure ViewerWindowProc(var Message: TMessage);
procedure WMNCHitTest(var Message: TMessage); message WM_NCHITTEST;
public
constructor Create( AOwner : TComponent );override;
destructor Destroy; override;
procedure ZoomFit;
procedure ZoomFitWidth;
procedure Print;
procedure Save;
procedure SaveAs( FileName : String );
procedure AddUnit( AClassName : String; ALeft, ATop, AWidth, AHeight : Integer );
procedure BringToFront;
procedure SendToBack;
procedure CopySelection( NewLeft, NewTop : Integer );
procedure DeleteSelection;
procedure MoveTo( NewLeft, NewTop : Integer );
procedure SelectAll;
procedure SelectGroup( GroupName : String );
procedure ShowSelection;
function UnitAtPoint( XPos, YPos : Integer ) : Integer;
function UnitAtCursor : Integer;
function GetCursorPoint : TPoint;
procedure SetSelection( n : Integer );
function IsVaribleExist( VarName : String ) : Boolean;
property UnitCount : Integer read GetUnitCount;
property Units[Index : Integer] : Integer read GetUnits;
property SelectionCount : Integer read GetSelectionCount;
property Selection[Index : Integer] : Integer read GetSelection;
function ExecuteScript(Command: String) : Integer;
function GetVaribleInteger( name : string ) : Integer;
function GetVaribleString( name : string ) : String;
function GetVaribleBoolean( name : String ) : Boolean;
function GetVaribleDouble( name : String ) : Double;
procedure AddFunction( name, lstrHelp, param : string; ret : Integer; proc : Pointer );
published
property Align;
property Anchors;
property UnitBackColor : TColor read GetUnitBackColor write SetUnitBackColor;
property BackGroundColor : TColor read GetBackGroundColor write SetBackGroundColor;
property StartAngle : Integer read GetStartAngle write SetStartAngle;
property EndAngle : Integer read GetEndAngle write SetEndAngle;
property LineColor : TColor read GetLineColor write SetLineColor;
property LineType : Integer read GetLineType write SetLineType;
property FontAlign : Integer read GetFontAlign write SetFontAlign;
property FontAngle : Integer read GetFontAngle write SetFontAngle;
property FontUnderLine : Integer read GetFontUnderLine write SetFontUnderLine;
property FontUnderLineColor : Integer read GetFontUnderLineColor write SetFontUnderLineColor;
property LineArrow : Integer read GetLineArrow write SetLineArrow;
property LineWidth : Integer read GetLineWidth write SetLineWidth;
property UnitName : String read GetUnitName;
property NumberAttr : Integer read GetNumberAttr write SetNumberAttr;
property NumberDigital : Integer read GetNumberDigital write SetNumberDigital;
property NumberPostFix : String read GetNumberPostFix write SetNumberPostFix;
property NumberPreFix : String read GetNumberPreFix write SetNumberPreFix;
property Pattern : Integer read GetPattern write SetPattern;
property PatternColor1 : Integer read GetPatternColor1 write SetPatternColor1;
property PatternColor2 : Integer read GetPatternColor2 write SetPatternColor2;
property RectRadius : Integer read GetRectRadius write SetRectRadius;
property UnitVisible : Boolean read GetUnitVisible write SetUnitVisible;
property UnitMultiline : Boolean read GetMultiLine write SetMultiLine;
property UnitReadOnly : Boolean read GetUnitReadOnly write SetUnitReadOnly;
property UnitText : string read GetUnitText write SetUnitText;
property UnitId : Integer read GetUnitId write SetUnitId;
property FontName : TFontName read GetFontName write SetFontName;
property FontSize : Integer read GetFontSize write SetFontSize;
property FontColor : Integer read GetFontColor write SetFontColor;
property FontStyle : Integer read GetFontStyle write SetFontStyle;
property FileName : string read FFileName write SetFileName;
property UnitLeft : Integer read GetUnitLeft write SetUnitLeft;
property UnitTop : Integer read GetUnitTop write SetUnitTop;
property UnitWidth : Integer read GetUnitWidth write SetUnitWidth;
property UnitHeight : Integer read GetUnitHeight write SetUnitHeight;
property ViewMode : TViewMode read FViewMode write SetViewMode;
property Zoom : Integer read GetZoom write SetZoom;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TVGViewer]);
end;
{ TVGViewer }
constructor TVGViewer.Create(AOwner: TComponent);
begin
inherited;
BevelInner := bvNone;
BevelOuter := bvNone;
BorderStyle := bsNone;
Color := clWhite;
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
FViewMode := vmDesign;
StrPCopy( @Buffer, 'run.dll' );
hLib := LoadLibrary( @Buffer );
@_CreateDoc := GetProcAddress( hLib, '_CreateDoc' );
@_DestroyDoc := GetProcAddress( hLib, '_DestroyDoc' );
@_Execute := GetProcAddress( hLib, '_Execute' );
@_GetVarible := GetProcAddress( hLib, '_GetVarible' );
@_SetViewerWindow := GetProcAddress( hLib, '_SetViewerWindow' );
@_AddFunction := GetProcAddress( hLib, '_AddFunction' );
FWindowHandle := AllocateHWnd(ViewerWindowProc);
end;
destructor TVGViewer.Destroy;
begin
DeallocateHWnd(FWindowHandle);
if( hLib <> 0 )then
FreeLibrary( hLib );
Inherited;
end;
procedure TVGViewer.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams( Params );
with Params do
begin
Style := Style or WS_TABSTOP;
Style := Style or WS_VSCROLL;
Style := Style or WS_HSCROLL;
WindowClass.style := CS_DBLCLKS;
if BorderStyle = bsSingle then
if NewStyleControls and Ctl3D then
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
end
else
Style := Style or WS_BORDER;
end;
end;
procedure TVGViewer.WMNCHitTest(var Message: TMessage);
begin
DefaultHandler(Message);
end;
procedure TVGViewer.CNKeyDown(var Message: TWMKeyDown);
begin
end;
function TVGViewer.ExecuteScript( Command : String ) : Integer;
begin
Result := 0;
if GetWindowLong( Handle, GWL_USERDATA ) <> 0 then
Result := _Execute( Handle, PChar( Command ) );
end;
procedure TVGViewer.SetFileName(const Value: string);
begin
FFileName := Value;
if not ( csLoading in ComponentState ) then
begin
_DestroyDoc( Handle );
StrPCopy( @Buffer, Value );
_CreateDoc( Handle, @Buffer );
_SetViewerWindow( Handle, FWindowHandle );
SetViewMode( FViewMode );
end;
end;
procedure TVGViewer.SetViewMode(const Value: TViewMode);
begin
FViewMode := Value;
if FViewMode = vmDesign then
ExecuteScript( 'Design( 1 )' )
else
ExecuteScript( 'Design( 0 )' )
end;
function TVGViewer.GetZoom: Integer;
begin
ExecuteScript( 'VgViewer__Temp=GetZoom()' );
Result := GetInt;
end;
procedure TVGViewer.SetZoom(const Value: Integer);
begin
ExecuteScript( 'SetZoom(' + IntToStr( Value ) + ')' );
end;
procedure TVGViewer.ZoomFit;
begin
ExecuteScript( 'ZoomFit()' );
end;
procedure TVGViewer.ZoomFitWidth;
begin
ExecuteScript( 'ZoomFitWidth()' );
end;
procedure TVGViewer.Print;
begin
ExecuteScript( 'Print()' );
end;
procedure TVGViewer.SetSelection(n: Integer);
begin
ExecuteScript( 'SetSelection(' + IntToStr( n ) + ')' );
end;
function TVGViewer.GetInt : Integer;
begin
Result := GetVaribleInteger( 'VgViewer__Temp' );
end;
function TVGViewer.GetBoolean : Boolean;
begin
Result := GetVaribleBoolean( 'VgViewer__Temp' );
end;
function TVGViewer.GetString : String;
begin
Result := GetVaribleString( 'VgViewer__Temp' );
end;
procedure TVGViewer.SetFontName(const Value: TFontName);
begin
ExecuteScript( 'SetFontName(0,"' + Value + '")' );
end;
function TVGViewer.GetFontName: TFontName;
begin
Result := GetPropStr( 'GetFontName' );
end;
function TVGViewer.GetUnitId: Integer;
begin
ExecuteScript( 'VgViewer__Temp=SelectionCount()' );
Result := GetInt;
if Result > 1 then
Result := 0
else
begin
ExecuteScript( 'VgViewer__Temp=GetSelection(0)' );
Result := GetInt;
end;
end;
procedure TVGViewer.SetUnitId(const Value: Integer);
begin
SetSelection( Value );
end;
function TVGViewer.GetFontSize: Integer;
begin
Result := GetPropInt( 'GetFontSize' );
end;
procedure TVGViewer.SetFontSize(const Value: Integer);
begin
ExecuteScript( 'SetFontSize(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetFontColor: Integer;
begin
Result := GetPropInt( 'GetFontColor' );
end;
procedure TVGViewer.SetFontColor(const Value: Integer);
begin
ExecuteScript( 'SetFontColor(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetFontStyle: Integer;
begin
Result := GetPropInt( 'GetFontStyle' );
end;
procedure TVGViewer.SetFontStyle(const Value: Integer);
begin
ExecuteScript( 'SetFontStyle(0,7,0)' );
ExecuteScript( 'SetFontStyle(0,' + IntToStr( Value ) + ',1)' );
end;
procedure TVGViewer.CreateWnd;
begin
inherited;
_DestroyDoc( Handle );
StrPCopy( @Buffer, '' );
_CreateDoc( Handle, @Buffer );
_SetViewerWindow( Handle, FWindowHandle );
SetViewMode( FViewMode );
end;
procedure TVGViewer.Loaded;
begin
inherited;
_DestroyDoc( Handle );
StrPCopy( @Buffer, FFileName );
_CreateDoc( Handle, @Buffer );
_SetViewerWindow( Handle, FWindowHandle );
SetViewMode( FViewMode );
end;
procedure TVGViewer.ViewerWindowProc(var Message: TMessage);
const
VGM_RecordChanged = WM_USER + 1;
VGM_ZoomChanged = WM_USER + 2;
VGM_SetMessage = WM_USER + 3;
VGM_SetEditStatus = WM_USER + 4;
VGM_SetCursor = WM_USER + 5;
VGM_SelectChanged = WM_USER + 6;
VGM_RButtonDown = WM_USER + 7;
VGM_EditChange = WM_USER + 8;
VGM_UnitsBaseAdd = WM_USER + 9;
VGM_UnitsBaseDelete = WM_USER + 10;
begin
if csDesigning in ComponentState then
begin
if Message.Msg = VGM_UnitsBaseAdd then
GetParentForm( Self ).Designer.Modified
else if Message.Msg = VGM_UnitsBaseDelete then
GetParentForm( Self ).Designer.Modified
else if Message.Msg = VGM_SelectChanged then
GetParentForm( Self ).Designer.Modified
else if Message.Msg = VGM_ZoomChanged then
GetParentForm( Self ).Designer.Modified;
end;
Message.Result := DefWindowProc(FWindowHandle, Message.Msg, Message.wParam, Message.lParam);
end;
function TVGViewer.GetPropStr( Command : String ) : String;
var
i, Id, n : Integer;
s : String;
begin
Result := '';
ExecuteScript( 'VgViewer__Temp=SelectionCount()' );
n := GetInt;
for i := 0 to n - 1 do
begin
ExecuteScript( 'VgViewer__Temp=GetSelection(' + IntToStr( i ) + ')' );
Id := GetInt;
ExecuteScript( 'VgViewer__Temp=' + Command + '(' + IntToStr( Id ) + ')' );
s := GetString;
if i = 0 then
Result := s
else if s <> Result then
Result := '';
end;
end;
function TVGViewer.GetPropInt( Command : String ) : Integer;
var
i, Id, n : Integer;
s : Integer;
begin
Result := 0;
ExecuteScript( 'VgViewer__Temp=SelectionCount()' );
n := GetInt;
for i := 0 to n - 1 do
begin
ExecuteScript( 'VgViewer__Temp=GetSelection(' + IntToStr( i ) + ')' );
Id := GetInt;
ExecuteScript( 'VgViewer__Temp=' + Command + '(' + IntToStr( Id ) + ')' );
s := GetInt;
if i = 0 then
Result := s
else if s <> Result then
Result := 0;
end;
end;
function TVGViewer.GetPropBool( Command : String ) : Boolean;
var
i, Id, n : Integer;
s : Boolean;
begin
Result := False;
ExecuteScript( 'VgViewer__Temp=SelectionCount()' );
n := GetInt;
for i := 0 to n - 1 do
begin
ExecuteScript( 'VgViewer__Temp=GetSelection(' + IntToStr( i ) + ')' );
Id := GetInt;
ExecuteScript( 'VgViewer__Temp=' + Command + '(' + IntToStr( Id ) + ')' );
s := GetBoolean;
if i = 0 then
Result := s
else if s <> Result then
Result := False;
end;
end;
function TVGViewer.GetUnitHeight: Integer;
begin
Result := GetPropInt( 'GetHeight' );
end;
function TVGViewer.GetUnitLeft: Integer;
begin
Result := GetPropInt( 'GetLeft' );
end;
function TVGViewer.GetUnitTop: Integer;
begin
Result := GetPropInt( 'GetTop' );
end;
function TVGViewer.GetUnitWidth: Integer;
begin
Result := GetPropInt( 'GetWidth' );
end;
procedure TVGViewer.SetUnitHeight(const Value: Integer);
begin
ExecuteScript( 'SetHeight(0,' + IntToStr( Value ) + ')' );
end;
procedure TVGViewer.SetUnitLeft(const Value: Integer);
begin
ExecuteScript( 'VgViewer__Temp=GetTop(0)' );
ExecuteScript( 'MoveTo(0,' + IntToStr( Value ) + ',' + IntToStr( GetInt ) + ')' );
end;
procedure TVGViewer.SetUnitTop(const Value: Integer);
begin
ExecuteScript( 'VgViewer__Temp=GetLeft(0)' );
ExecuteScript( 'MoveTo(0,' + IntToStr( GetInt ) + ',' + IntToStr( Value ) + ')' );
end;
procedure TVGViewer.SetUnitWidth(const Value: Integer);
begin
ExecuteScript( 'SetWidth(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetUnitBackColor: TColor;
begin
Result := GetPropInt( 'GetBackColor' );
end;
procedure TVGViewer.SetUnitBackColor(const Value: TColor);
begin
ExecuteScript( 'SetBackColor(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetBackGroundColor: TColor;
begin
ExecuteScript( 'VgViewer__Temp=GetBackGroundColor()' );
Result := GetInt;
end;
procedure TVGViewer.SetBackGroundColor(const Value: TColor);
begin
ExecuteScript( 'SetBackGroundColor(' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetEndAngle: Integer;
begin
Result := GetPropInt( 'GetEndAngle' );
end;
function TVGViewer.GetStartAngle: Integer;
begin
Result := GetPropInt( 'GetStartAngle' );
end;
procedure TVGViewer.SetEndAngle(const Value: Integer);
begin
ExecuteScript( 'SetEndAngle(0,' + IntToStr( Value ) + ')' );
end;
procedure TVGViewer.SetStartAngle(const Value: Integer);
begin
ExecuteScript( 'SetStartAngle(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetFontAlign: Integer;
begin
Result := GetPropInt( 'GetFontAlign' );
end;
procedure TVGViewer.SetFontAlign(const Value: Integer);
begin
ExecuteScript( 'SetFontAlign(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetFontAngle: Integer;
begin
Result := GetPropInt( 'GetFontAngle' );
end;
procedure TVGViewer.SetFontAngle(const Value: Integer);
begin
ExecuteScript( 'SetFontAngle(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetFontUnderLine: Integer;
begin
Result := GetPropInt( 'GetFontUnderLine' );
end;
procedure TVGViewer.SetFontUnderLine(const Value: Integer);
begin
ExecuteScript( 'SetFontUnderLine(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetFontUnderLineColor: Integer;
begin
Result := GetPropInt( 'GetFontUnderLineColor' );
end;
procedure TVGViewer.SetFontUnderLineColor(const Value: Integer);
begin
ExecuteScript( 'SetFontUnderLineColor(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetLineArrow: Integer;
begin
Result := GetPropInt( 'GetLineArrow' );
end;
procedure TVGViewer.SetLineArrow(const Value: Integer);
begin
ExecuteScript( 'SetLineArrow(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetLineColor: TColor;
begin
Result := GetPropInt( 'GetLineColor' );
end;
function TVGViewer.GetLineType: Integer;
begin
Result := GetPropInt( 'GetLineType' );
end;
procedure TVGViewer.SetLineColor(const Value: TColor);
begin
ExecuteScript( 'SetLineColor(0,' + IntToStr( Value ) + ')' );
end;
procedure TVGViewer.SetLineType(const Value: Integer);
begin
ExecuteScript( 'SetLineType(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetLineWidth: Integer;
begin
Result := GetPropInt( 'GetLineWidth' );
end;
procedure TVGViewer.SetLineWidth(const Value: Integer);
begin
ExecuteScript( 'SetLineWidth(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetUnitName: String;
begin
Result := GetPropStr( 'GetUnitName' );
end;
function TVGViewer.GetNumberAttr: Integer;
begin
Result := GetPropInt( 'GetNumberAttr' );
end;
procedure TVGViewer.SetNumberAttr(const Value: Integer);
begin
ExecuteScript( 'SetNumberAttr(0,$FF,0)' );
ExecuteScript( 'SetNumberAttr(0,' + IntToStr( Value ) + ',$FF)' );
end;
function TVGViewer.GetNumberDigital: Integer;
begin
Result := GetPropInt( 'GetNumberDigital' );
end;
procedure TVGViewer.SetNumberDigital(const Value: Integer);
begin
ExecuteScript( 'SetNumberDigital(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetNumberPostFix: String;
begin
Result := GetPropStr( 'GetNumberPostFix' );
end;
function TVGViewer.GetNumberPreFix: String;
begin
Result := GetPropStr( 'GetNumberPreFix' );
end;
procedure TVGViewer.SetNumberPostFix(const Value: String);
begin
ExecuteScript( 'SetNumberPostFix(0,"' + Value + '")' );
end;
procedure TVGViewer.SetNumberPreFix(const Value: String);
begin
ExecuteScript( 'SetNumberPreFix(0,"' + Value + '")' );
end;
function TVGViewer.GetPattern: Integer;
begin
Result := GetPropInt( 'GetPattern' );
end;
procedure TVGViewer.SetPattern(const Value: Integer);
begin
ExecuteScript( 'SetPattern(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetPatternColor1: Integer;
begin
Result := GetPropInt( 'GetPatternColor1' );
end;
function TVGViewer.GetPatternColor2: Integer;
begin
Result := GetPropInt( 'GetPatternColor2' );
end;
procedure TVGViewer.SetPatternColor1(const Value: Integer);
begin
ExecuteScript( 'SetPatternColor1(0,' + IntToStr( Value ) + ')' );
end;
procedure TVGViewer.SetPatternColor2(const Value: Integer);
begin
ExecuteScript( 'SetPatternColor2(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetRectRadius: Integer;
begin
Result := GetPropInt( 'GetRectRadius' );
end;
procedure TVGViewer.SetRectRadius(const Value: Integer);
begin
ExecuteScript( 'SetRectRadius(0,' + IntToStr( Value ) + ')' );
end;
function TVGViewer.GetUnitText: string;
begin
Result := GetPropStr( 'GetText' );
end;
procedure TVGViewer.SetUnitText(const Value: string);
begin
ExecuteScript( 'SetText(0,"' + Value + '")' );
end;
function TVGViewer.GetUnitVisible: Boolean;
begin
Result := GetPropBool( 'IsVisible' );
end;
procedure TVGViewer.SetUnitVisible(const Value: Boolean);
var
i, Id, vis, n : Integer;
begin
if Value then
vis := 1
else
vis := 0;
ExecuteScript( 'VgViewer__Temp=SelectionCount()' );
n := GetInt;
for i := 0 to n - 1 do
begin
ExecuteScript( 'VgViewer__Temp=GetSelection(' + IntToStr( i ) + ')' );
Id := GetInt;
ExecuteScript( 'SetVisible(' + IntToStr( Id ) + ',' + IntToStr( vis ) + ')' );
end;
end;
function TVGViewer.GetMultiLine: Boolean;
begin
Result := GetPropBool( 'IsMultiLine' );
end;
function TVGViewer.GetUnitReadOnly: Boolean;
begin
Result := GetPropBool( 'IsReadOnly' );
end;
procedure TVGViewer.Save;
begin
ExecuteScript( 'Save()' );
end;
procedure TVGViewer.SaveAs(FileName: String);
begin
ExecuteScript( 'SaveAs("' + FileName + '")' );
end;
procedure TVGViewer.SetMultiLine(const Value: Boolean);
begin
if Value then
ExecuteScript( 'SetMultiLine(0,1)' )
else
ExecuteScript( 'SetMultiLine(0,0)' );
end;
procedure TVGViewer.SetUnitReadOnly(const Value: Boolean);
begin
if Value then
ExecuteScript( 'SetReadOnly(0,1)' )
else
ExecuteScript( 'SetReadOnly(0,0)' );
end;
procedure TVGViewer.AddUnit(AClassName: String; ALeft, ATop, AWidth,
AHeight: Integer);
begin
ExecuteScript( 'AddUnit("' + AClassName + '",' + IntToStr( ALeft ) + ',' + IntToStr( ATop ) + ',' + IntToStr( AWidth ) + ',' + IntToStr( AHeight ) + ')' )
end;
procedure TVGViewer.BringToFront;
begin
ExecuteScript( 'BringToFront()' )
end;
procedure TVGViewer.CopySelection(NewLeft, NewTop: Integer);
begin
ExecuteScript( 'CopySelection(' + IntToStr( NewLeft ) + ',' + IntToStr( NewTop ) + ')' )
end;
procedure TVGViewer.DeleteSelection;
begin
ExecuteScript( 'DeleteSelection()' )
end;
function TVGViewer.GetCursorPoint: TPoint;
begin
ExecuteScript( 'VgViewer__Temp=GetCursorX()' );
Result.x := GetInt;
ExecuteScript( 'VgViewer__Temp=GetCursorY()' );
Result.y := GetInt;
end;
function TVGViewer.GetSelection(Index: Integer): Integer;
begin
ExecuteScript( 'VgViewer__Temp=GetSelection(' + IntToStr( Index ) + ')' );
Result := GetInt;
end;
function TVGViewer.GetSelectionCount: Integer;
begin
ExecuteScript( 'VgViewer__Temp=SelectionCount()' );
Result := GetInt;
end;
function TVGViewer.GetUnitCount: Integer;
begin
ExecuteScript( 'VgViewer__Temp=UnitCount()' );
Result := GetInt;
end;
function TVGViewer.GetUnits(Index: Integer): Integer;
begin
ExecuteScript( 'VgViewer__Temp=GetUnit(' + IntToStr( Index ) + ')' );
Result := GetInt;
end;
function TVGViewer.IsVaribleExist(VarName: String): Boolean;
begin
ExecuteScript( 'VgViewer__Temp=IsVaribleExist(' + VarName + ')' );
Result := GetBoolean;
end;
procedure TVGViewer.MoveTo(NewLeft, NewTop: Integer);
begin
ExecuteScript( 'MoveTo( 0, ' + IntToStr( NewLeft ) + ',' + IntToStr( NewTop ) + ')' )
end;
procedure TVGViewer.SelectAll;
begin
ExecuteScript( 'SelectAll()' )
end;
procedure TVGViewer.SelectGroup(GroupName: String);
begin
ExecuteScript( 'SelectGroup("' + GroupName + '")' )
end;
procedure TVGViewer.SendToBack;
begin
ExecuteScript( 'SendToBack()' )
end;
procedure TVGViewer.ShowSelection;
begin
ExecuteScript( 'ShowSelection()' )
end;
function TVGViewer.UnitAtCursor: Integer;
begin
ExecuteScript( 'VgViewer__Temp=UnitAtCursor()' );
Result := GetInt;
end;
function TVGViewer.UnitAtPoint(XPos, YPos: Integer): Integer;
begin
ExecuteScript( 'VgViewer__Temp=UnitAtPoint(' + IntToStr( XPos ) + ',' + IntToStr( YPos ) + ')' );
Result := GetInt;
end;
procedure TVGViewer.AddFunction(name, lstrHelp, param: string;
ret: Integer; proc: Pointer);
begin
_AddFunction( PChar( name ), PChar( lstrHelp ), PChar( param ), ret, proc );
end;
function TVGViewer.GetVaribleBoolean(name: String): Boolean;
begin
Result := False;
if GetWindowLong( Handle, GWL_USERDATA ) <> 0 then
if _GetVarible( Handle, PChar( name ), @Buffer ) = 3 then
begin
if StrPas( @Buffer ) = '.T.' then
Result := True
else
Result := False;
end;
end;
function TVGViewer.GetVaribleInteger(name: string): Integer;
begin
Result := 0;
if GetWindowLong( Handle, GWL_USERDATA ) <> 0 then
if _GetVarible( Handle, PChar( name ), @Buffer ) = 1 then
Result := StrToInt( StrPas( @Buffer ) );
end;
function TVGViewer.GetVaribleString(name: string): String;
begin
Result := '';
if GetWindowLong( Handle, GWL_USERDATA ) <> 0 then
if _GetVarible( Handle, PChar( name ), @Buffer ) = 4 then
Result := StrPas( @Buffer );
end;
function TVGViewer.GetVaribleDouble(name: String): Double;
begin
Result := 0;
if GetWindowLong( Handle, GWL_USERDATA ) <> 0 then
if _GetVarible( Handle, PChar( name ), @Buffer ) = 2 then
Result := StrToFloat( StrPas( @Buffer ) );
end;
end.
]
]