?? 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 DM;
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;
DM.DataModule2.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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -