rm_pgtfunction.pas

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

PAS
862 行
字号
12

{*****************************************}
{                                         }
{          Report Machine v2.0            }
{          PGT Addin Function             }
{                                         }
{    感谢 网友PGT提供  amirery@163.net    }
{*****************************************}

unit RM_PGTFunction;

interface

{$I RM.inc}

uses
  SysUtils, Windows, Classes, Controls, Forms, Dialogs, RM_Class, RM_Common, RM_Parser
{$IFDEF Delphi6}, Variants{$ENDIF};

type
  TRMAddInFunctionLib = class(TComponent);

 { TPGTAddinFunction }
  TRMPGTAddinFunction = class(TRMFunctionLibrary)
  public
    constructor Create; override;
    procedure DoFunction(aParser: TRMParser; FNo: Integer; p: array of Variant; var val: Variant); override;
  end;

function RMPGTGetINI(const KeyName: string; const SubName: string; IniFile: string): string;
{function CutInt(v: Variant): Variant; //提取小数点左边数值
function LeftUpper(S: Variant): Variant; //首字大写
function NumToEn(V: Variant): string; //数字转换为英文大写
function NumToMoney(V: Variant; Dollar: string; Cent: string): string; //数字转换为美元大写
function NumToCn(V: Variant): string; //数字转换为中文大写
function SmallNum(V: Integer): string; //小数字转换为英文大写
function LeftStr(SouStr: string; LeftLen: Word): string; //取左边n位字符
function RightStr(SouStr: string; RightLen: Word): string; //取右边n位字符
function DateToShortStr(V: Variant; StrLx: Integer): string; //英文短日期格式
function DateToLongStr(V: Variant): string; //英文长日期格式
function MyFormatDate(Format: string; DateTime: TDateTime): string; //自定义日期转换为字符串
function Ascii(const Keychr: string): Byte;
function PicExists(var v: string): Boolean; //检查图片文件是否存在
function DayofShortWeek(D: TdateTime): string; //返回短星期格式
function DayofLongWeek(D: TdateTime): string; //返回长星期格式
function myfunction(Name: string; p1, p[1], p[2]: Variant): variant;
function CutRootDir(var v: string): Boolean; //把文件名转换为相对路径
}

{$IFDEF DM_ADO}
(* 注意：此单元请在搜索路径中指定 Sv_Data的路径  *)
function RMPGTInitConnectstring: string; //初始化数据连接字符串 ;
function RMPGTGetFieldValue(TableName: string; WhereCode: string; ReturnFld: string): Variant;
  {例：GetFieldValue('CKHT','合同号=SAMPLE','总金额')  }
{$ENDIF}

var
  ExePath: string; //可执行程序路径
  ReportDir: string; //存放报表文件的目录
  RmRegistOK: Boolean; //程序是否已经注册
  CurOpenFile: string; //当前打开的报表文件
  PrintBase: Boolean = True; //报表打印是否打印背景图
  PrintFrame: Boolean = True; //文本框打印边条
  AllowSetFrame: Boolean = False; //允许设置边条是否打印
  HasBasePic: Boolean; //报表是否带有背景图
  ReportTitle: string = '报表标题'; //报表标题
  ReportSubTitle1: string = '报表子标题一'; //报表子标题1
  ReportSubTitle2: string = '报表子标题二'; //报表子标题2
{$IFDEF DM_ADO}
  SvSetFile: string = 'SerVerConfig.Dll';
{$ENDIF}

implementation

uses Inifiles{$IFDEF DM_ADO}, DB, Clipbrd, Adodb{$ENDIF};

const
  ShortMon: array[0..11] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  LongMon: array[0..11] of string = ('January', 'February', 'March', 'April',
    'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December');
  CnNum: array[0..11] of string = ('一', '二', '三', '四', '五', '六', '七', '八', '九', '十', '十一', '十二');
  ShortWeek: array[0..6] of string = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
  LongWeek: array[0..6] of string = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday');

{$IFDEF DM_ADO}
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ADO Function}

function RMPGTGetFieldValue(TableName: string; WhereCode: string; ReturnFld: string): Variant;
var
  Adoc: TAdoConnection;
  tbl: TadoDataSet;
  SqlStr: string;
  i: integer;
  s: string;
begin
  Screen.Cursor := crHourGlass;
  Adoc := TAdoConnection.Create(Application);
  Adoc.LoginPrompt := False;
  Adoc.Provider := 'MSDASQL';
  if Trim(Adoc.ConnectionString) = '' then
  begin
    Adoc.ConnectionString := RMPGTInitConnectstring;
    Adoc.Open;
  end;
  TableName := Trim(TableName);
  WhereCode := Trim(WhereCode);
  ReturnFld := Trim(ReturnFld);
  if (TableName = '') or (ReturnFld = '') then
  begin
    Result := 'GetFieldValue 函数参数缺少';
    Adoc.Close;
    Adoc.Free;
    Screen.Cursor := CrDefault;
    Exit;
  end;
  s := '';
  for i := 1 to Length(WhereCode) do
  begin
    if WhereCode[i] <> '"' then
      s := s + WhereCode[i]
    else
      s := s + '''';
  end;
  WhereCode := S;
  if WhereCode <> '' then
  begin
    if Pos('WHERE', UpperCase(WhereCode)) = 0 then
      WhereCode := 'Where ' + WhereCode;
  end;
  WhereCode := ' ' + WhereCode + ' ';
  tbl := TadoDataSet.Create(nil);
  tbl.Connection := AdoC;
  SQLStr := 'Select * From ' + TableName + WhereCode;
  Tbl.CommandText := SQLStr;
  Tbl.CommandType := cmdText;
  try
    Tbl.Open;
  except
    Clipboard.AsText := SQLstr;
    Result := '表' + TableName + '不能打开!';
    Adoc.Close;
    Adoc.Free;
    Screen.Cursor := CrDefault;
    Exit;
  end;
  if Tbl.FindField(ReturnFld) = nil then
  begin
    Result := '没有发现字段[' + ReturnFld + ']';
    Screen.Cursor := CrDefault;
    Exit;
  end;
  case Tbl.FieldByName(ReturnFld).DataType of
    FtString, FtMemo, ftFixedChar, ftWideString:
      Result := Trim(Tbl.FieldByName(ReturnFld).AsString);
    ftDate, ftTime, ftDateTime:
      Result := Tbl.FieldByName(ReturnFld).AsDateTime;
    ftBoolean:
      Result := Tbl.FieldByName(ReturnFld).AsBoolean;
    ftSmallint, ftInteger, ftWord, ftLargeint,
      ftFloat, ftCurrency, ftBCD, ftBytes, ftVarBytes:
      Result := Tbl.FieldByName(ReturnFld).AsFloat;
  else
    Result := Tbl.FieldValues[ReturnFld];
  end;
  Tbl.Close;
  Tbl.free;
  Adoc.Close;
  Adoc.Free;
  Screen.Cursor := CrDefault;
end;

function RMPGTInitConnectstring: string; //初始化数据连接字符串 ;
var
  SaveFile: string;
  Tstr: TStringList;
  SaveStr: string;
  SysPath: PChar;
begin
  GetMem(SysPath, 255);
  GetSystemDirectory(SysPath, 255); //获取WINDOWS 系统SYSTEM 目录
  SaveFile := SysPath + '\' + SvSetFile;
  SaveStr := '';
  if FileExists(SaveFile) then
  begin
    TStr := TStringList.Create;
    TStr.LoadFromFile(SaveFile);
    SaveStr := Tstr.Text;
    TStr.Free;
  end;
  SaveStr := Trim(SaveStr);
  Result := SaveStr;
end;
{$ENDIF}

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{Other Function}

function RMPGTGetINI(const KeyName: string; const SubName: string; IniFile: string): string; // 从INI文件中提取数据
var
  MyIni: TiniFile;
begin
  if IniFile = '' then
    IniFile := 'System.Ini';
  if Pos(UpperCase('.'), UpperCase(IniFile)) = 0 then
    IniFile := IniFile + '.ini';
  if Pos('\', IniFile) = 0 then
    IniFile := ExtractFilePath(Application.ExeName) + IniFile;
  if FileExists(IniFile) then
  begin
    MyIni := TiniFile.Create(IniFile);
    if MyIni.ValueExists(KeyName, SubName) then
      Result := MyIni.ReadString(KeyName, SubName, '')
    else
      Result := '不存在关键字[' + KeyName + '][' + SubName + ']';
    MyIni.Free;
  end
  else
  begin
    Result := Inifile + '不存在!';
  end;
end;

function LeftStr(SouStr: string; LeftLen: Word): string; //取左边n位字符
begin
  Result := Copy(SouStr, 1, LeftLen);
end;

function RightStr(SouStr: string; RightLen: Word): string; //取右边n位字符
begin
  Result := Copy(SouStr, Length(SouStr) - RightLen + 1, RightLen);
end;

function LeftUpper(S: Variant): Variant; //首字大写
var
  i: Integer;
  BeginUpper: Boolean;
  TmpStr, Restr: string;
begin
  try
    TmpStr := VarAsType(s, VarString);
  except
    Result := S;
    Exit;
  end;
  BeginUpper := True; ReStr := '';
  for I := 1 to Length(TmpStr) do
  begin
    if BeginUpper = True then
      ReStr := ReStr + UpperCase(TmpStr[i])
    else
      ReStr := ReStr + LowerCase(TmpStr[i]);
    if Pos(TmpStr[i], ' \/`~!@#$%^&*()_+-=|{}[]: ; "" '' <> ?') <> 0 then
      BeginUpper := True
    else
      BeginUpper := False;
  end;
  Result := ReStr;
end;

function SmallNum(V: Integer): string; //小数字转换为英文大写
var
  I_Str: string;
  R_Str: string;
  H_str: string;
begin
  if V > 999 then
  begin
    Result := '数据太大' + FormatFloat('##0', V);
    Exit;
  end;
  R_Str := '';
  I_str := Trim(FormatFloat('##0', V));
  I_str := RightStr('000' + I_str, 3);
  case StrToInt(RightStr(I_str, 2)) of
    0: R_str := '';
    1: R_str := 'ONE';
    2: R_str := 'TWO';
    3: R_str := 'THREE';
    4: R_str := 'FOUR';
    5: R_str := 'FIVE';
    6: R_str := 'SIX';
    7: R_str := 'SEVEN';
    8: R_str := 'EIGHT';
    9: R_str := 'NINE';
    10: R_str := 'TEN';
    11: R_str := 'ELEVEN';
    12: R_str := 'TWELVE';
    13: R_str := 'THIRTEEN';
    14: R_str := 'FOURTEEN';
    15: R_str := 'FIFTEEN';
    16: R_str := 'SIXTEEN';
    17: R_str := 'SEVENTEEN';
    18: R_str := 'EIGHTEEN';
    19: R_str := 'NINETEEN';
    20: R_str := 'TWENTY';
    30: R_str := 'THIRTY';
    40: R_str := 'FORTY';
    50: R_str := 'FIFTY';
    60: R_str := 'SIXTY';
    70: R_str := 'SEVENTY';
    80: R_str := 'EIGHTY';
    90: R_str := 'NINETY';
  else
    case StrToInt(Copy(I_str, 2, 1)) of
      0: R_str := '';
      1: R_str := '';
      2: R_str := 'TWENTY-';
      3: R_str := 'THIRTY-';
      4: R_str := 'FORTY-';
      5: R_str := 'FIFTY-';
      6: R_str := 'SIXTY-';
      7: R_str := 'SEVENTY-';
      8: R_str := 'EIGHTY-';
      9: R_str := 'NINETY-';
    end;
    case StrToInt(Copy(I_str, 3, 1)) of
      0: R_str := R_str + '';
      1: R_str := R_str + 'ONE';
      2: R_str := R_str + 'TWO';
      3: R_str := R_str + 'THREE';
      4: R_str := R_str + 'FOUR';
      5: R_str := R_str + 'FIVE';
      6: R_str := R_str + 'SIX';
      7: R_str := R_str + 'SEVEN';
      8: R_str := R_str + 'EIGHT';
      9: R_str := R_str + 'NINE';
    end;
  end;
  H_Str := '';
  case StrToInt(Copy(I_str, 1, 1)) of
    0: H_str := '';
    1: H_str := 'ONE';
    2: H_str := 'TWO';
    3: H_str := 'THREE';
    4: H_str := 'FOUR';
    5: H_str := 'FIVE';
    6: H_str := 'SIX';
    7: H_str := 'SEVEN';
    8: H_str := 'EIGHT';
    9: H_str := 'NINE';
  else
    ShowMessage('不可预料的情况');
  end;
  if (H_Str <> '') and (R_Str <> '') then
    I_str := H_Str + ' HUNDRED AND ' + R_Str
  else if (H_Str <> '') and (R_Str = '') then
    I_str := H_Str + ' HUNDRED ' + R_Str
  else if (H_Str = '') and (R_Str <> '') then
    I_str := R_Str
  else if (H_Str = '') and (R_Str = '') then
    I_str := '';
  Result := I_Str;
end;

function DayofShortWeek(D: TdateTime): string; //返回短星期格式
begin
  Result := ShortWeek[DayOfWeek(d) - 1];
end;

function DayofLongWeek(D: TdateTime): string; //返回长星期格式
begin
  Result := LongWeek[DayOfWeek(d) - 1];
end;

function CutRootDir(var v: string): Boolean; //把文件名转换为相对路径
var
  sv, RootDir: string;
begin
  sv := v;
  RootDir := ExtractFileDir(Application.ExeName) + '\';
  if CompareText(RootDir, LeftStr(sv, Length(RootDir))) = 0 then
  begin
    v := Copy(sv, Length(RootDir) + 1, 255);
    Result := True;
  end
  else
    Result := False;
end;

function PicExists(var V: string): Boolean; //检查图片文件是否存在
var
  S, Sdir, Sname, PicDir: string;
begin
  s := V;
  Result := True;
  if FileExists(s) then
    Exit;
  if Trim(CurOpenFile) <> '' then
  begin //首先在报表所在目录中查找
    SName := ExtractFileName(s);
    Sdir := ExtractFileDir(CurOpenFile);
    if FileExists(Sdir + '\' + sName) then
    begin
      v := Sdir + '\' + sName;
      Exit;
    end;
    Sdir := ExtractFileDir(Sdir); //再一次减去子目录+\BitMaps
    if FileExists(Sdir + '\BitMaps\' + sName) then
    begin
      v := Sdir + '\BitMaps\' + sName;
      Exit;
    end;
    if FileExists(Sdir + '\BitBmps\' + sName) then
    begin
      v := Sdir + '\BitBmps\' + sName;
      Exit;
    end;
  end;
  if not FileExists(s) then
  begin //其次在程序运行的目录中查找
    Sdir := Trim(ExtractFileDir(S));
    SName := ExtractFileName(S);
    if (Pos('\', Sdir) = 0) and (Sdir <> '') then
      PicDir := ExtractFileDir(Application.ExeName) + '\' + Sdir + '\'
    else
      PicDir := ExtractFileDir(Application.ExeName) + '\BitMaps\';
    if FileExists(Picdir + sName) then
      V := PicDir + sName
    else
    begin
      PicDir := ExtractFileDir(Application.ExeName) + '\BitBmps\';
      if FileExists(Picdir + s) then
        V := PicDir + s
      else
        Result := False;
    end;
  end;
end;
12

rm_pgtfunction.pas - 源码说明

本页面展示了「胜天进销存源码,国产优秀的进销存」中的 rm_pgtfunction.pas 源码文件，采用 PAS 编程语言编写，共 862 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与进销相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?