?? publicfunction.~pa
字號:
unit PublicFunction;
interface
uses windows, messages, sysutils, dialogs, forms, Graphics, ExtCtrls, db, adodb, StdCtrls,
registry, classes, controls, ComCtrls, ComObj, IniFiles, Math, Grids, PublicParameter;
//connect with database.
function connect_DB(ADO: TADOConnection; ConnStr: string): bool;
//Get ID from a string;
function GetIDFromChar(ASecStr: string; Achar: string): string;
function FormCenter(AForm: TForm): bool;
function GetPYIndexChar(hzchar: string): char;
function RemoveFrontZeroFromStr(sec: string): string;
function selectDB(Aform: TForm): string;
function GetCfgValue(const key: string; cfgFileName: string): string;
function SetCfgValue(const key: string; Value: string; cfgFileName: string): bool;
function GetValueTostr(ATable: string; AFile: string; AFlagField: string; Avalue: string): string;
function checkValue(ATable: string; AFile: string; Avalue: string): bool;
//返回下一個ID取最大值(整型)
function GetNextRecNoMax(ADOConnection: TADOConnection; TableName, Fieldstr, Condition, DesFieldstr: string; FieldLen: integer): longint;
function GetBlobToStream(Table: TDataSet; const FieldName: string; var ResultStream: TmemoryStream): Bool;
function GetBlobFileToStream(ADOTable1: TAdoQuery; Name: string): TStream;
function blobcontenttostring(const fileName: string; ADOTable1: TDataSet; FiledName: string): bool;
//去掉字符串中的某一字符除去空格
function checkFilename(tempchar: string; SourceStr: string): string; //去掉filemae中的s除去空格
procedure deleteRec(var Connection: TADOConnection; TableName, Condition: string);
function NumClear(Num: string): string; //去掉數(shù)字中的','等
function formatfloat(s: string): string;
procedure gridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
function GetValueToCMB(ATable: string; AFile: string; Avalue: string): TStrings;
//讀寫ini文件
procedure WriteIniFile(Section, KeyName: AnsiString; KeyValue: AnsiString);
function ReadIniFile(Section, KeyName: AnsiString): AnsiString;
//導(dǎo)出到Excel
function ExportToExcel(adorecordset: TAdoQuery): Boolean;
implementation
uses StockDataModel;
//add combox as a list item
//導(dǎo)出到Excel
function ExportToExcel(adorecordset: TAdoQuery): Boolean;
var
xlApp, xlBook, xlSheet, xlQuery: Variant;
begin
xlApp := CreateOleObject('Excel.Application');
xlBook := xlApp.Workbooks.Add;
xlSheet := xlBook.Worksheets['sheet1'];
xlApp.Visible := True;
//把查詢結(jié)果導(dǎo)入EXCEL數(shù)據(jù)
xlQuery := xlSheet.QueryTables.Add(adoRecordset.Recordset, xlSheet.Range['A1']); //關(guān)鍵是這一句
xlQuery.FieldNames := True;
xlQuery.RowNumbers := False;
xlQuery.FillAdjacentFormulas := False;
xlQuery.PreserveFormatting := True;
xlQuery.RefreshOnFileOpen := False;
xlQuery.BackgroundQuery := True;
//xlQuery.RefreshStyle := xlInsertDeleteCells;
xlQuery.SavePassword := True;
xlQuery.SaveData := True;
xlQuery.AdjustColumnWidth := True;
xlQuery.RefreshPeriod := 0;
xlQuery.PreserveColumnInfo := True;
xlQuery.FieldNames := True;
xlQuery.Refresh;
end;
//導(dǎo)出到Excel
procedure WriteIniFile(Section, KeyName: AnsiString; KeyValue: AnsiString);
begin
if not Assigned(iniFile) then
iniFile := TIniFile.Create(gCurrDirectory + 'Incomcfg.ini');
try
iniFile.WriteString(Section, KeyName, KeyValue);
except
end;
end;
function ReadIniFile(Section, KeyName: AnsiString): AnsiString;
begin
if not Assigned(iniFile) then
iniFile := TIniFile.Create(gCurrDirectory + 'Incomcfg.ini');
try
Result := iniFile.ReadString(Section, KeyName, '');
except
end;
end;
function GetValueToCMB(ATable: string; AFile: string; Avalue: string): TStrings;
var
test: string;
begin
Result := TStringList.Create;
// With TAdoQuery.Create(nil) do
with TAdoQuery.Create(nil) do
begin
try
connection := StockDM.ADOConn;
Sql.Clear;
if UpperCase(Avalue) = 'ALL' then
begin
//test:='SELECT * FROM '+ATable+'';
//henry modify 2007-2-7 15:04
test := 'SELECT ' + AFile + ' FROM ' + ATable + '';
end
else
begin
//test:='SELECT * FROM '+ATable+' where '+AFile+'='#39 + Avalue +#39'';
//henry modify 2007-2-7 15:04
test := 'SELECT ' + AFile + ' FROM ' + ATable + ' where ' + AFile + '='#39 + Avalue + #39'';
end;
sql.Text := test;
open;
if not Isempty then
begin
while not eof do
begin
if pos(',', AFile) <= 0 then
Result.Add(fieldbyname(AFile).AsString)
else Result.Add(fieldbyname(copy(AFile, 1, pos(',', AFile) - 1)).AsString + ',' + fieldbyname(copy(AFile, pos(',', AFile) + 1, MaxInt)).AsString);
next;
end;
end;
finally
close;
Free;
end;
end;
end;
//add combox as a list item
procedure gridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var cy, cx: integer;
txt: string;
style: string;
i, j, k: integer;
R, D, L, U: integer;
TxtLeft, TxtTop, TxtBottom, TxtRight: integer;
MyREct: Trect;
function GetCol(Acol, Arow: integer): string;
var i: integer;
Mypos: integer;
MyString: string;
begin
MyString := TSTringGrid(Sender).cells[acol, 0];
for i := 0 to Arow do
begin
myPos := pos('|', MyString) - 1;
if Mypos < 0 then
begin
REsult := MyString;
exit;
end;
if pos('|', MyString) <> 1 then
Result := copy(MyString, 1, Mypos);
Mystring := copy(Mystring, Mypos + 2, length(MyString));
end;
end;
procedure Line3d(canvas: Tcanvas; x, y, x1, y1: integer; light, an: Tcolor);
begin
with canvas do
begin
pen.Color := light;
MOVETO(x, y1);
lineto(x, y);
lineto(x1, y);
pen.Color := an;
lineto(x1, y1);
lineto(x, y1);
end;
end;
begin
with TSTringGrid(Sender) do
begin
canvas.Font.Name := Font.Name;
canvas.font.Size := Font.Size;
Canvas.Font.Color := font.Color;
txt := Trim(cells[acol, arow]);
if arow < fixedrows then
txt := getcol(acol, arow);
if ((state = [gdSelected, gdFocused]) and (arow >= fixedrows)) or
((goRowselect in Options) and (arow = row))
then
Canvas.Brush.Color := $0099FFFF
else
if state = [gdfixed] then
canvas.Brush.Color := $00CCCCCC
else
if (arow mod 2) = 0 then
Canvas.Brush.Color := $00F3D5B1 //clGradientActiveCaption //$00F0F0ff
else
Canvas.Brush.Color := $00F7E0CC; //$00e0e0ff;
cy := 3;
if ((state = [gdfixed]) and (arow <= fixedrows - 1)) then
begin
if pos('$$', txt) > 0 then
txt := copy(txt, 1, pos('$$', txt) - 1);
cy := (rect.Right - rect.left - Canvas.TextWidth(txt)) div 2;
end else
begin
Style := cells[acol, 0];
if pos('$$', Style) > 0 then
begin
style := uppercase(copy(style, pos('$$', style), length(style)));
if pos('N', style) > 0 then
begin
txt := formatfloat(numclear(txt));
if txt = '0.0' then txt := '';
end;
if pos('R', style) > 0 then
cy := rect.right - Canvas.TextWidth(txt) - rect.left - 3;
if pos('M', Style) > 0 then
cy := (rect.Right - rect.left - Canvas.TextWidth(txt)) div 2;
if pos('L', style) > 0 then
cy := 3;
end;
end;
if {state=[gdfixed]} arow < fixedrows then
begin //多列頭處理....
R := 0;
TxtLeft := rect.Left;
TxtTop := rect.Top;
TxtBottom := rect.Bottom;
TxtRight := Rect.Right;
for r := Acol to colcount - 1 do
begin
if Getcol(Acol, Arow) <> Getcol(R, Arow) then Break;
if r <> acol then //補
TxtRight := TxtRight + ColWidths[r];
end;
k := 0;
for D := Arow to fixedrows - 1 do
begin
for i := acol to R - 1 do
if Getcol(Acol, Arow) <> getcol(i, D) then
begin
k := -1;
Break;
end;
if k = -1 then Break;
TxtBottom := TxtBottom + RowHeights[d];
end;
//If Acol>0 then
begin
k := 0;
for l := Acol downto 0 do
begin
for i := Arow to D - 1 do
if getcol(l, i) <> Getcol(acol, Arow) then
begin
k := -1;
Break;
end;
if K = -1 then Break;
TxtLeft := TxtLeft - ColWidths[l];
end; // for l:=Acol-1 downto 0 do
end; // if Acol >0 then
if Arow > 0 then
begin
k := 0;
for U := Arow - 1 downto 0 do
begin
for i := l + 1 to r - 1 do
begin
if Getcol(i, u) <> getcol(acol, arow) then
begin
k := -1;
Break;
end;
if k = -1 then Break;
TxtTop := TxtTop - RowHeights[u];
end;
if k = -1 then Break;
end; // for u:=arow-1 downto 0 do
end; // if Arow>0 then
cy := ((txtbottom - txttop) div 2) + txttop - rowheights[arow];
Cx := ((txtright - Txtleft + colwidths[acol] - canvas.TextWidth(txt)) div 2) + txtleft;
Myrect := rect;
if txtright <> rect.Right then rect.Right := rect.Right + 1;
if (txtleft + colwidths[acol]) <> rect.Left then
rect.Left := rect.Left - 1;
if txttop <> rect.top then rect.Top := rect.Top - 1;
if (txtbottom - Myrect.Bottom) <> rowheights[arow] then
rect.Bottom := rect.Bottom + 1;
with canvas do
begin
if txtright = Myrect.Right then
begin
pen.Color := ClGray;
Moveto(rect.Right - 1, rect.Top - 1);
lineto(rect.Right - 1, rect.Bottom + 1);
end;
if (txtleft + colwidths[acol]) = rect.Left then
begin
pen.Color := ClWhite;
Moveto(rect.left, rect.Top);
lineto(rect.left, rect.Bottom - 1);
end;
if txttop = Myrect.top then
begin
pen.Color := ClWhite;
Moveto(rect.left, rect.Top);
lineto(rect.Right - 1, rect.Top);
end;
if (txtbottom - Myrect.Bottom) = rowheights[arow] then
begin
pen.Color := ClGray;
Moveto(Myrect.left, rect.bottom - 1);
lineto(Myrect.Right + 2, rect.bottom - 1);
end;
end;
rect.Top := rect.Top + 1;
rect.Left := rect.Left + 1;
rect.Bottom := rect.Bottom - 1;
rect.Right := rect.Right - 1;
Canvas.TextRect(Rect, cx, cy + 4, Txt);
end
else
begin
cx := (rect.Bottom - rect.Top - canvas.TextHeight(txt)) div 2;
Canvas.TextRect(Rect, Rect.Left + cy, Rect.Top + cx, txt);
rect.Top := rect.Top;
rect.Left := rect.Left;
rect.Bottom := rect.Bottom - 1;
rect.Right := rect.Right - 1;
if state = [gdfixed] then
line3d(canvas, rect.Left, rect.Top, rect.Right, rect.Bottom, clwhite, clGray)
else
line3d(canvas, rect.Left, rect.Top, rect.Right, rect.Bottom, clwhite, clSilver);
end;
end; // with grid1;end;
end;
function formatfloat(s: string): string;
var
I, MaxSym, MinSym, Group: Integer;
IsSign: Boolean;
Thousands: Boolean;
begin
Thousands := True;
Result := '';
MaxSym := Length(S);
IsSign := (MaxSym > 0) and (S[1] in ['-', '+']);
if IsSign then MinSym := 2
else MinSym := 1;
I := Pos(DecimalSeparator, S);
if I > 0 then MaxSym := I - 1;
I := Pos('E', AnsiUpperCase(S));
if I > 0 then MaxSym := Min(I - 1, MaxSym);
Result := Copy(S, MaxSym + 1, MaxInt);
Group := 0;
for I := MaxSym downto MinSym do begin
Result := S[I] + Result;
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -