rm_jvinterpreter_jvutils.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,132 行 · 第 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_JvUtils.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: 2003-03-10

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

interface

uses
  rm_JvInterpreter;

procedure RegisterJvInterpreterAdapter(JvInterpreterAdapter: TJvInterpreterAdapter);

implementation

uses
  SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls,
  Dialogs, Menus, Math,
  {$IFNDEF COMPILER6_UP}
  FileCtrl,
  {$ENDIF}
  rm_JvUtils, rm_JvStrUtil, rm_JvInterpreter_Windows;

{ function ReplaceAllStrings(S: string; Words, Frases: TStrings): string; }

procedure JvInterpreter_ReplaceAllStrings(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := ReplaceAllStrings(Args.Values[0], V2O(Args.Values[1]) as TStrings, V2O(Args.Values[2]) as TStrings);
end;

{ function ReplaceStrings(S: string; PosBeg, Len: integer; Words, Frases: TStrings; var NewSelStart: integer): string; }

procedure JvInterpreter_ReplaceStrings(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := ReplaceStrings(Args.Values[0], Args.Values[1], Args.Values[2], V2O(Args.Values[3]) as TStrings,
    V2O(Args.Values[4]) as TStrings, TVarData(Args.Values[5]).vInteger);
end;

{ function CountOfLines(const S: string): integer; }

procedure JvInterpreter_CountOfLines(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := CountOfLines(Args.Values[0]);
end;

{ procedure DeleteEmptyLines(Ss: TStrings); }

procedure JvInterpreter_DeleteEmptyLines(var Value: Variant; Args: TJvInterpreterArgs);
begin
  DeleteEmptyLines(V2O(Args.Values[0]) as TStrings);
end;

{ procedure SQLAddWhere(SQL: TStrings; const where: string); }

procedure JvInterpreter_SQLAddWhere(var Value: Variant; Args: TJvInterpreterArgs);
begin
  SQLAddWhere(V2O(Args.Values[0]) as TStrings, Args.Values[1]);
end;

{ function ResSaveToFile(const Typ, Name: string; const Compressed: boolean; const FileName: string): boolean; }

procedure JvInterpreter_ResSaveToFile(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := ResSaveToFile(Args.Values[0], Args.Values[1], Args.Values[2], Args.Values[3]);
end;

{ function ResSaveToFileEx(Instance: HINST; Typ, Name: PChar; const Compressed: boolean; const FileName: string): boolean; }

procedure JvInterpreter_ResSaveToFileEx(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := ResSaveToFileEx(Args.Values[0], PChar(string(Args.Values[1])), PChar(string(Args.Values[2])),
    Args.Values[3], Args.Values[4]);
end;

{ function ResSaveToString(Instance: HINST; const Typ, Name: string; var S: string): boolean; }

procedure JvInterpreter_ResSaveToString(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := ResSaveToString(Args.Values[0], Args.Values[1], Args.Values[2], string(TVarData(Args.Values[3]).vString));
end;

{ function Execute(const CommandLine, WorkingDirectory: string): integer; }

procedure JvInterpreter_Execute(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := Execute(Args.Values[0], Args.Values[1]);
end;

{ function IniReadSection(const IniFileName: TFileName; const Section: string; Ss: TStrings): boolean; }

procedure JvInterpreter_IniReadSection(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := IniReadSection(Args.Values[0], Args.Values[1], V2O(Args.Values[2]) as TStrings);
end;

{ function LoadTextFile(const FileName: TFileName): string; }

procedure JvInterpreter_LoadTextFile(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := LoadTextFile(Args.Values[0]);
end;

{ procedure SaveTextFile(const FileName: TFileName; const Source: string); }

procedure JvInterpreter_SaveTextFile(var Value: Variant; Args: TJvInterpreterArgs);
begin
  SaveTextFile(Args.Values[0], Args.Values[1]);
end;

{ function ReadFolder(const Folder, Mask: TFileName; FileList: TStrings): integer; }

procedure JvInterpreter_ReadFolder(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := ReadFolder(Args.Values[0], Args.Values[1], V2O(Args.Values[2]) as TStrings);
end;

procedure JvInterpreter_ReadFolders(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := ReadFolders(Args.Values[0], V2O(Args.Values[1]) as TStrings);
end;

{$IFDEF COMPILER3_UP}

{ function TargetFileName(const FileName: TFileName): TFileName; }

procedure JvInterpreter_TargetFileName(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TargetFileName(Args.Values[0]);
end;

{ function ResolveLink(const hwnd: HWND; const LinkFile: TFileName; var FileName: TFileName): HRESULT; }

procedure JvInterpreter_ResolveLink(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := ResolveLink(Args.Values[0], Args.Values[1], TFileName(TVarData(Args.Values[2]).vString));
end;

{$ENDIF COMPILER3_UP}

{ procedure LoadIcoToImage(ALarge, ASmall: TImageList; const NameRes: string); }

procedure JvInterpreter_LoadIcoToImage(var Value: Variant; Args: TJvInterpreterArgs);
begin
  LoadIcoToImage(V2O(Args.Values[0]) as TImageList, V2O(Args.Values[1]) as TImageList, Args.Values[2]);
end;

{ procedure RATextOut(Canvas: TCanvas; const R, RClip: TRect; const S: string); }

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

{ function RATextOutEx(Canvas: TCanvas; const R, RClip: TRect; const S: string; const CalcHeight: boolean): integer; }

procedure JvInterpreter_RATextOutEx(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := RATextOutEx(V2O(Args.Values[0]) as TCanvas, Var2Rect(Args.Values[1]), Var2Rect(Args.Values[2]),
    Args.Values[3], Args.Values[4]);
end;

{ function RATextCalcHeight(Canvas: TCanvas; const R: TRect; const S: string): integer; }

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

{ procedure Roughed(ACanvas: TCanvas; const ARect: TRect; const AVert: boolean); }

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

{ function BitmapFromBitmap(SrcBitmap: TBitmap; const AWidth, AHeight, index: integer): TBitmap; }

procedure JvInterpreter_BitmapFromBitmap(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(BitmapFromBitmap(V2O(Args.Values[0]) as TBitmap, Args.Values[1], Args.Values[2], Args.Values[3]));
end;

{ function TextWidth(AStr: string): integer; }

procedure JvInterpreter_TextWidth(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TextWidth(Args.Values[0]);
end;

{ function DefineCursor(Identifier: PChar): TCursor; }

procedure JvInterpreter_DefineCursor(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := DefineCursor(PChar(string(Args.Values[0])));
end;

{ function FindFormByClassName(FormClassName: string): TForm; }

procedure JvInterpreter_FindFormByClassName(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(FindFormByClassName(Args.Values[0]));
end;

{ function FindByTag(WinControl: TWinControl; ComponentClass: TComponentClass; const Tag: integer): TComponent; }

procedure JvInterpreter_FindByTag(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(FindByTag(V2O(Args.Values[0]) as TWinControl, TComponentClass(V2C(Args.Values[1])), Args.Values[2]));
end;

{ function ControlAtPos2(Parent: TWinControl; X, Y: integer): TControl; }

procedure JvInterpreter_ControlAtPos2(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(ControlAtPos2(V2O(Args.Values[0]) as TWinControl, Args.Values[1], Args.Values[2]));
end;

{ function RBTag(Parent: TWinControl): integer; }

procedure JvInterpreter_RBTag(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := RBTag(V2O(Args.Values[0]) as TWinControl);
end;

{ function AppMinimized: boolean; }

procedure JvInterpreter_AppMinimized(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := AppMinimized;
end;

{ function MsgDlg2(const Msg, ACaption: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpContext: integer; Control: TWinControl): Integer; }

procedure JvInterpreter_MsgDlg2(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := MsgDlg2(Args.Values[0], Args.Values[1], Args.Values[2], TMsgDlgButtons(Word(V2S(Args.Values[3]))),
    Args.Values[4], V2O(Args.Values[5]) as TWinControl);
end;

{ function MsgDlgDef(const Msg, ACaption: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; DefButton: TMsgDlgBtn; HelpContext: integer; Control: TWinControl): Integer; }

procedure JvInterpreter_MsgDlgDef(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := MsgDlgDef(Args.Values[0], Args.Values[1], Args.Values[2], TMsgDlgButtons(Word(V2S(Args.Values[3]))),
    Args.Values[4], Args.Values[5], V2O(Args.Values[6]) as TWinControl);
end;

{ procedure Delay(MSec: longword); }

procedure JvInterpreter_Delay(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Delay(Args.Values[0]);
end;

(*
{ procedure CenterHor(Parent: TControl; MinLeft: integer; Controls: array of TControl); }
procedure JvInterpreter_CenterHor(var Value: Variant; Args: TJvInterpreterArgs);