pubfunction.pas

一款房产中介软件

Unit PUBFunction;

Interface
Uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, Mask, DBGridEh, DBCtrls, DBCtrlsEh, ExtCtrls, EhLibAdo,
   DB, ADODB, DBGridEhImpExp, jpeg;

Procedure FixEhDTBug(EhVCL: TDBDateTimeEditEh);
Function Split(Const Str: String; Const Delimiter: String): TStringlist;
Function ExtFieldInTable(sTname: String; sFname: String): Boolean;
Function GetNextMonths(ADate: TDate; Months: integer): TDate;
Procedure SaveDBGridEhToFile(ADOQuery1: TADOQuery; DBGridEH1: TDBGridEh;
   SaveDialog1: TSaveDialog);
Procedure SaveImage(Image1: TImage; ADOQ: TADOQuery; sFieldname: String);
Procedure LoadImage(Image1: TImage; ADOQ: TADOQuery; sFieldname: String);
Function splitRoom(RoomNo: String; Var sLayer: String): String;
Implementation

Uses MainDM;

Function splitRoom(RoomNo: String;
   Var sLayer: String): String;
Var
   llen             : integer;
Begin
   llen := Length(Trim(RoomNo));
   Case llen Of
      3: Begin
            sLayer := Copy(RoomNo, 0, 1);
            result := Copy(RoomNo, 2, 2);
         End;
      4: Begin
            sLayer := Copy(RoomNo, 0, 2);
            result := Copy(RoomNo, 3, 2);
         End;

   End;

End;

Procedure SaveImage(Image1: TImage; ADOQ: TADOQuery; sFieldname: String);
Var
   JPG              : TJPEGImage;
   MS               : TMemoryStream;
Begin
   JPG := TJPEGImage.create;
   MS := TMemoryStream.create;
   JPG.Assign(Image1.Picture.Graphic);
   JPG.SaveToStream(MS);
   MS.Position := 0;
   TBlobField(ADOQ.fieldbyname(sFieldname)).LoadFromStream(MS);
   MS.Free;
   JPG.Free;
End;

Procedure LoadImage(Image1: TImage; ADOQ: TADOQuery; sFieldname: String);
Var
   JPG              : TJPEGImage;
   MS               : TMemoryStream;
Begin
   JPG := TJPEGImage.create;
   MS := TMemoryStream.create;
   TBlobField(ADOQ.fieldbyname(sFieldname)).SaveToStream(MS);
   MS.Position := 0;
   JPG.LoadFromStream(MS);
   Image1.Picture.Assign(JPG);
End;

Procedure SaveDBGridEhToFile(ADOQuery1: TADOQuery; DBGridEH1: TDBGridEh;
   SaveDialog1: TSaveDialog);
Var
   ExpClass         : TDBGridEhExportClass;
   Ext              : String;
Begin
   If Not (ADOQuery1.Active) Then Exit;
   If ADOQuery1.recordcount = 0 Then Exit;
   SaveDialog1.FileName := 'file1';
   If SaveDialog1.Execute Then Begin
      Case SaveDialog1.FilterIndex Of
         1: Begin
               ExpClass := TDBGridEhExportAsText;
               Ext := 'txt'
            End;
         2: Begin
               ExpClass := TDBGridEhExportAsHTML;
               Ext := 'htm'
            End;
         3: Begin
               ExpClass := TDBGridEhExportAsXLS;
               Ext := 'xls'
            End;
      Else
         ExpClass := Nil;
         Ext := ''
      End;
      If ExpClass <> Nil Then Begin
         If UpperCase(Copy(SaveDialog1.FileName, Length(SaveDialog1.FileName)
            - 2, 3)) <>
            UpperCase(Ext) Then
            SaveDialog1.FileName := SaveDialog1.FileName + '.' + Ext;
         SaveDBGridEhToExportFile(ExpClass, DBGridEH1,
            SaveDialog1.FileName, true);
      End;
   End;

End;

Function GetNextMonths(ADate: TDate; Months: integer): TDate;
Var
   y, M, D          : word;
Begin
   If Months = 0 Then Begin
      result := ADate;
      Exit;
   End;

   DecodeDate(ADate, y, M, D);
   M := M + Months;
   If M > 12 Then Begin
      y := y + (M Div 12);
      M := M Mod 12;
   End;
   If M In [1, 3, 5, 7, 8, 10, 12] Then Begin
      If D > 31 Then D := 31;
   End Else Begin
      If M In [4, 6, 9, 11] Then Begin
         If D > 30 Then D := 30;
      End Else Begin
         If M = 2 Then Begin
            If IsLeapYear(y) Then Begin
               If D > 29 Then D := 29;
            End Else Begin
               If D > 28 Then D := 28;
            End;
         End;
      End;
   End;
   result := EncodeDate(y, M, D);
End;

Function ExtFieldInTable(sTname: String; sFname: String): Boolean;
Var
   slFieldnames     : TStringlist;
Begin
   slFieldnames := TStringlist.create;
   DMMain.ADOConnection1.GetFieldNames(sTname, slFieldnames);
   result := (slFieldnames.IndexOf(sFname) <> -1);

   slFieldnames.Free;
End;

Procedure FixEhDTBug(EhVCL: TDBDateTimeEditEh);
  //修改TDBDateTimeEditEH的BUG
//Var
  // DT               : tdatetime;
Begin
  { DT := StrToDateDef(EhVCL.Text,now);
   EhVCL.Text := '';
   EhVCL.Text := FormatDateTime('yyyy-mm-dd', DT);}
End;

Function Split(Const Str: String; Const Delimiter: String): TStringlist;
Var
   s                : TStringlist;
   i                : integer;
   strtemp          : String;
Begin
   strtemp := Str;
   s := TStringlist.create;
   i := Pos(Delimiter, strtemp);
   While i > 0 Do Begin
      s.Add(Copy(strtemp, 0, i - 1));
      strtemp := Copy(strtemp, i + 1, Length(strtemp) - i);
      i := Pos(Delimiter, strtemp);
   End;
   s.Add(strtemp);
   result := s;
End;

End.