返回
{***************************************************************}
{*** FVision Unit Version1.0 ***}
{*** 蓝蚂蚁工作室 ***}
{***************************************************************}
{*** 数据库单元 ***}
{***************************************************************}
{$O+,F+,X+,I-,P+}
Unit FBase;
Interface
Uses
Dos,Strings,FTool,FView,FMouse,FEvent,FWrite,FDialog,
Graph,FGraph,FControl,FList,FExtDrv,FXmsDrv;
Const
cmAdd = 210;
cmModify = 211;
cmUndelete = 212;
cmModifyStruct = 213;
cmShowStru = 214;
cmPack = 215;
cmZap = 216;
cmGotoRecord = 218;
cmSelectViewZD = 219;
cmShowAll = 220;
cmSort = 221;
cmCloseDBF = 222;
cmList = 223;
Const
DBFMinMemory = 150000;
DBFMinXms = 500;
MaxWorkArea = 5;
MaxDBaseSize = 500000;
MaxRecordNumber = 20000;
MaxDBaseType = 5;
MaxCreatZiDuan = 256;
MaxViewZD = 256;
MaxRecordView = 10;
MaxRecordLength = 2048;
MaxSortZD = 10;
Type
DbfHeader=Record
Sign:Byte; {标志,无备注为03,有备注为F5}
Year:Byte; {最后一次更新的日期}
Month:Byte;
Day:Byte;
TotalRecord:Longint; {记录总数}
LengthOfStruct:Word; {结构描述部分的长度}
RecordLength:Word; {记录长度}
Reserved:array[0..19] of Byte;
end;
Zi_Duan=Record
Name:Array[1..10] of Char; {字段名}
Reserved1:Byte; {0}
TypeOfZiDuan:Char; {字段名类型(C,N,D,L,M)}
DataAddr:Longint; {数据域地址}
Length:Byte; {字段长度}
DotNumber:Byte; {小数点位数}
Reserved2:Word;
NewSign:Byte; {最后一次更新的工作区标志符}
Reserved3:array[0..10] of Byte;
end;
MemoHeader=record
BlockNumber:array[0..3] of Byte;
Reserved:array[0..2] of Byte;
BlockSize:Byte;
end;
ZiDuanType=Array[1..1] of Zi_Duan;
CharArray=Array[0..MaxRecordLength-1] of Char;
RecordType=Array[1..MaxRecordView] of CharArray;
RecIndexType=Array[0..MaxRecordNumber-1] of Integer;
{ PMemoEdit=^TMemoEdit;
TMemoEdit=object(TEditWin)
Function ReadFile:Boolean;virtual;
Function SaveFile:Boolean;virtual;
end;
}
PDataBase=^TDataBase;
TDataBase=Object(TView)
Rect:TRect;
Fp:File;
FileName:PathStr;
Result:Word;
Head:DbfHeader;
MemoHead:MemoHeader;
ZiDuan:^ZiDuanType;
Recor:RecordType;
BufGood,MemoSign,ModifyFlag:Boolean;
Length,Number,ZiDuanNumber,MemoBlockNumber:Longint;
Pos,Mark:TPoint;
RecordLength:Word;
XmsDBHandle:Word;
BufSize,MaxItem,ViewRecNumber,RecCount:Longint;
ViewZDNumber,ViewZDTotLength:Integer;
ViewZD:array[0..MaxViewZD-1] of Integer;
ViewZDLen:array[0..MaxViewZD-1] of Integer;
ViewZDTrueLen:array[0..MaxViewZD-1] of Integer;
ViewRec:RecIndexType;
CurPos,EndPos:Integer;
SortSerial:Integer;
Constructor Init(X,Y,L,N:Integer;F:PathStr);
Destructor Done;virtual;
Procedure MoveTo(X,Y:Integer);virtual;
Procedure SetBufSize(S:Longint);
Procedure AddViewZD(ZD:Integer);
Procedure SetViewList;virtual;
Procedure AddViewRec(Rec:Integer);
Procedure SetViewIndex;virtual;
Procedure CloseDBF;
Procedure SaveFile;
Procedure SaveAsFile(F:PathStr;Mode:Byte);
Procedure SaveToFile(F:PathStr;Mode:Byte);
Procedure CreatMemoFile;
Procedure LoadSaveMemoFile(Mode:Integer);
Procedure LoadFile(F:PathStr);
Procedure CreatFile(F:PathStr);
Procedure ReLoad;
Procedure ReStore;
Procedure QuickSort(L,R:Integer);
Function Sort:Boolean;
Function Search(Mode:Word):Boolean;
Function Find(Mode:Word):Boolean;
Function Insert:Boolean;
Function GetZDType(Index:Integer):Char;
Function GetTrueStart(Index:Integer):Integer;
Function GetStart(Index:Integer):Integer;
Function GetStartDot(Index:Integer):Integer;
Function GetDlt(XIndex:Integer):Integer;
Function GetStr(XIndex,YIndex:Integer):string;
Procedure SetStr(XIndex,YIndex:Integer;Str:string);
Function GetHorNumber:Integer;
Function GetIndex(x:Integer):Integer;
Function GetZDIndex(Name:string):Integer;
Function GetZDStart(Index:Integer):Integer;
Function GetRecStr(Index:array of Integer;P:Longint):string;
Procedure Paint;virtual;
Procedure DrawIndex;
Procedure DrawZDName;
Procedure DrawData1;
Procedure DrawData2;
Procedure Draw;virtual;
Procedure DrawOneZD(Mode,XIndex,YIndex:Integer);
Function PrevRecord:Boolean;
Function NextRecord:Boolean;
Function PrevZiDuan:Boolean;
Function NextZiDuan:Boolean;
Function LocateRecord(Num:Integer):Boolean;
Function LocateZiDuan(Num:Integer):Boolean;
Procedure DeleteRecord(DMode:Integer;SNum,ENum:Longint);
Procedure ReStruct;
Function Pack:Boolean;
Procedure Zap;
Procedure HandleEvent(var Event:TEvent);virtual;
end;
PBaseInfo=^TBaseInfo;
TBaseInfo=object(TWindow)
Lister:PLister;
Constructor Init(N:Integer;S1,S2,S3,S4,S5:string);
Procedure InsertStr(St:string);
end;
PCreatStru=^TCreatStru;
TCreatStru=object(TWindow)
Pos:Integer;
Lister:PLister;
ListStr:string;
Str1,Str2:PStaticText;
Constructor Init(Tit:string);
Procedure HandleEvent(var Event:TEvent);virtual;
Procedure SetInfo;
Procedure InitData(Mode:Integer);
Procedure ResetData(Mode:Integer);
end;
PBaseWin=^TBaseWin;
TBaseWin=Object(TWindow)
Rec:TRect;
HScrollBar,VScrollBar:PScrollBar;
Base:PDataBase;
WorkArea:array[0..MaxWorkArea-1] of PDataBase;
CurWorkArea:Integer;
Str1,Str2,Str3,Str4,ShowStr:PStaticText;
Constructor Init(F:PathStr);
Procedure CloseWorkArea(Num:Integer;Mode:Byte);
Procedure CloseSelf;virtual;
Procedure SetInfo;
Procedure SetScrollBar;
Procedure InsertRecord;
Procedure DeleteRecord(Mode:Integer);
Procedure GotoRecord;
Procedure ShowStruct;
Procedure ModifyStruct;
Procedure CloseDBF;
Procedure OpenDBF(Name:PathStr);
Procedure NewDBF(Name:PathStr);
Procedure SaveAsDBF(Name:PathStr);
Procedure InputZiDuan(x,y:Integer);
Procedure PackFile;
Procedure ZapFile;
Procedure SelectZD;
Procedure ShowAll;
Function DBFFindWin:PWindow;
Function DBFReplaceWin:PWindow;
Procedure DoSearch(Mode:Word);
Function DBFSortWin:PWindow;
Procedure DoSort;
Procedure SelectWorkArea(Num:Integer);
Procedure ListWorkArea;
Procedure HandleEvent(var Event:TEvent);virtual;
end;
Function SetupDBFPara:PWindow;
Function SetColorWin:PWindow;
Implementation
Type
LessFunc = Function(X, Y:string): Boolean;
Const
dbAsk = 0;
dbDestroy = 1;
dbViewMode1 = 1;
dbViewMode2 = 2;
dbSearch = 1;
dbReplace = 2;
dbAscending = 1;
dbDescending = 2;
dbSaveAllRec = 1;
dbSaveCurRec = 2;
Const
MemoShowNone : string[10]='备注[空] ';
MemoShowHave : string[10]='备注 ';
WordChars : set of Char=['0'..'9', 'A'..'Z', '_', 'a'..'z',#$A1..#$F4];
MemoStr : array[False..True] of string[2]=('无','有');
ZiDuan_Type : array[0..MaxDBaseType-1] of Char=('C','N','D','L','M');
TypeStr : array[0..MaxDBaseType-1] of String[4]=('字符','数字','日期','逻辑','备注');
DefaultBufSize : Longint = 50000;
DBViewMode : Byte = dbViewMode2;
DBFSaveMode : Byte = dbSaveCurRec;
CreatDBFBakFile : Boolean = True;
ShowTrueIndex : Boolean = True;
StartNumber : Integer = 1;
EndNumber : Integer = 1;
DBFFindStr : string = '';
DBFReplaceStr : string = '';
dbSearchZD : string = '';
dbSearchZDIndex : Integer = 1;
dbSensitive : Boolean = False;
dbWholeWord : Boolean = False;
dbScopeAll : Boolean = True;
dbPrompt : Boolean = True;
dbSortOrder : Byte = dbAscending;
Const
dbViewColor1 : Byte = $F0;
dbViewColor21 : Byte = $DF;
dbViewColor22 : Byte = $9F;
dbCurColor1 : Byte = $9E;
dbCurColor2 : Byte = $A0;
dbIndexColor11 : Byte = $CF;
dbIndexColor12 : Byte = $C8;
Var
ZDName:string;
ZDType:Byte;
ZDLength:Integer;
ZDDotNum:Integer;
CommZiDuanNum:Integer;
CommZiDuan:Array[1..MaxCreatZiDuan] of Zi_Duan;
LessDBF : LessFunc;
{$F+}
Function LessUp(X, Y:string): Boolean;
begin
LessUp := X < Y;
end;
Function LessDown(X, Y:string): Boolean;
begin
LessDown := X > Y;
end;
Function GotoRecordWin(Tit:string;Mode:Integer):PWindow;
var
R:TRect;
P:PWindow;
Inp:PInput;
begin
AssignRect(R, 0, 0, 260, 100);
P:=New(PWindow,Init(R,Tit,True));
P^.Insert(New(PStaticText,Init(stNormal,20,40,'起始记录号:',4)));
Inp:=New(PDigInput,Init(110,40,@StartNumber,8,ipBroad+ipDigital,dtInteger));
Inp^.SetRange('记录号',1,$7FFF);
P^.Insert(Inp);
if Mode=1 then
begin
P^.Insert(New(PStaticText,Init(stNormal,20,70,'终止记录号:',4)));
Inp:=New(PDigInput,Init(110,70,@EndNumber,8,ipBroad+ipDigital,dtInteger));
Inp^.SetRange('记录号',1,$7FFF);
P^.Insert(Inp);
end;
P^.Insert(New(PButton,Init(190, 38,240, 58,'确定',kbAltO,cmOk)));
P^.Insert(New(PButton,Init(190, 68,240, 88,'放弃',kbAltC,cmCancel)));
P^.Next;
P^.Next;
P^.Center;
GotoRecordWin:=P;
end;
Function ZDToStr(C:Char):string;
var
i:Integer;
begin
ZDToStr:=C;
for i:=0 to MaxDBaseType-1 do
if C=ZiDuan_Type[i] then
ZDToStr:=TypeStr[i];
end;
Function ZDToByte(C:Char):Byte;
var
i:Integer;
begin
ZDToByte:=0;
for i:=0 to MaxDBaseType-1 do
if C=ZiDuan_Type[i] then
ZDToByte:=i+1;
end;
{
Function TMemoEdit.ReadFile;
begin
end;
Function TMemoEdit.SaveFile;
begin
end;
}
Constructor TDataBase.Init;
begin
Inherited Init;
if not XmsCanUse then IsValid:=False;
BufGood:=False;
ModifyFlag:=False;
ViewZDNumber:=0;
Length:=L;
Number:=N;
MoveTo(X,Y);
FileName:='';
ZiDuan:=nil;
XmsDBHandle:=0;
Pos.x:=0;Pos.y:=0;
Mark.x:=0;Mark.y:=0;
if F<>'' then LoadFile(F);
end;
Destructor TDataBase.Done;
begin
CloseDBF;
Inherited Done;
end;
Procedure TDataBase.MoveTo;
begin
Origin.X:=(X div 8)*8;
Origin.Y:=Y;
AssignRect(Rect,Origin.x,Origin.y,Origin.x+Length,Origin.y+Number*19-2);
end;
Procedure TDataBase.SetBufSize;
begin
BufSize:=S;
if Head.RecordLength<=0 then Exit;
MaxItem:=BufSize div Head.RecordLength;
if MaxItem>MaxRecordNumber then
MaxItem:=MaxRecordNumber;
end;
Procedure TDataBase.AddViewZD;
var
TempStr:string;
begin
dbSearchZDIndex:=1;
if ZD>ZiDuanNumber then Exit;
if ViewZDNumber>=MaxViewZD then Exit;
ViewZD[ViewZDNumber]:=ZD;
Byte(TempStr[0]):=10;
System.Move(ZiDuan^[ZD].Name[1],TempStr[1],10);
DelNull(TempStr);
ViewZDTrueLen[ViewZDNumber]:=ZiDuan^[ZD].Length;
ViewZDLen[ViewZDNumber]:=ZiDuan^[ZD].Length;
if ViewZDLen[ViewZDNumber]<System.Length(TempStr) then
ViewZDLen[ViewZDNumber]:=System.Length(TempStr);
if ViewZDTotLength+ViewZDLen[ViewZDNumber]>MaxRecordLength then Exit;
Inc(ViewZDTotLength,ViewZDLen[ViewZDNumber]);
Inc(ViewZDNumber);
end;
Procedure TDataBase.SetViewList;
var
i:Integer;
begin
ViewZDTotLength:=0;
ViewZDNumber:=0;
for i:=1 to ZiDuanNumber do
AddViewZD(i);
end;
Procedure TDataBase.AddViewRec;
begin
if Rec>=Head.TotalRecord then Exit;
if ViewRecNumber>=MaxRecordNumber then Exit;
ViewRec[ViewRecNumber]:=Rec;
Inc(ViewRecNumber);
end;
Procedure TDataBase.SetViewIndex;
var
i:Integer;
begin
ViewRecNumber:=0;
for i:=0 to Head.TotalRecord-1 do
AddViewRec(i);
Pos.x:=0;Pos.y:=0;
Mark.x:=0;Mark.y:=0;
end;
Procedure TDataBase.CloseDBF;
begin
if FileName='' then Exit;
if ZiDuan<>nil then FreeMem(ZiDuan,Head.LengthOfStruct-33);
ZiDuan:=nil;
if (XmsDBHandle<>0) then FreeXms(XmsDBHandle);
XmsDBHandle:=0;
FileName:='';
end;
Procedure TDataBase.SaveFile;
begin
SaveToFile(FileName,dbSaveAllRec);
ModifyFlag:=False;
end;
Procedure TDataBase.SaveAsFile;
begin
SaveToFile(F,Mode);
LoadFile(F);
ModifyFlag:=False;
end;
Procedure TDataBase.SaveToFile;
var
Fp1:File;
Sign:Byte;
Y,M,D,Dow:Word;
TempNum,i:Longint;
begin
if ZiDuan=nil then Exit;
if CreatDBFBakFile then
ReNameFile(F,Ch_Name(F,'BAK'));
GetDate(Y,M,D,Dow);
Head.Year:=Y mod 100;
Head.Month:=M;
Head.Day:=D;
Assign(Fp1,F);
ReWrite(Fp1,1);
TempNum:=Head.TotalRecord;
if Mode=dbSaveCurRec then Head.TotalRecord:=ViewRecNumber;
BlockWrite(Fp1,Head,Sizeof(DbfHeader),Result);
Head.TotalRecord:=TempNum;
BlockWrite(Fp1,ZiDuan^,Head.LengthOfStruct-33,Result);
Sign:=$0D;
BlockWrite(Fp1,Sign,1,Result);
Close(Fp1);
case Mode of
dbSaveAllRec:WriteXmsToFile(XmsDBHandle,F,0,Head.TotalRecord*Head.RecordLength,wxAppend);
dbSaveCurRec:for i:=0 to ViewRecNumber-1 do
WriteXmsToFile(XmsDBHandle,F,ViewRec[i]*Head.RecordLength,
Head.RecordLength,wxAppend);
end;
Assign(Fp1,F);
Reset(Fp1,1);
Seek(Fp1,FileSize(Fp1));
Sign:=$1A;
BlockWrite(Fp1,Sign,1,Result);
Close(Fp1);
end;
Procedure TDataBase.CreatMemoFile;
var
Fm:File;
TempMem:Pointer;
begin
if not MemoSign then Exit;
FillChar(MemoHead,8,0);
MemoHead.BlockNumber[3]:=8;
MemoHead.BlockSize:=$40;
MemoBlockNumber:=8;
Assign(Fm,Ch_Name(FileName,'FPT'));
ReWrite(Fm,1);
GetMem(TempMem,$200);
FillChar(TempMem^,$200,0);
System.Move(MemoHead,TempMem^,8);
BlockWrite(Fm,TempMem^,$200,Result);
FreeMem(TempMem,$200);
Close(Fm);
end;
Procedure TDataBase.LoadSaveMemoFile;
var
Fm:File;
begin
if not MemoSign then Exit;
if not Exist_Fi(Ch_Name(FileName,'FPT')) then
begin
CreatMemoFile;
Exit;
end;
Assign(Fm,Ch_Name(FileName,'FPT'));
Reset(Fm,1);
if Mode=0 then
begin
BlockRead(Fm,MemoHead,8,Result);
MemoBlockNumber:=Longint(MemoHead.BlockNumber[3])+
Longint(MemoHead.BlockNumber[2]) shl 8+
Longint(MemoHead.BlockNumber[1]) shl 16+
Longint(MemoHead.BlockNumber[0]) shl 24;
end else
begin
MemoHead.BlockNumber[3]:=LongByteType(MemoBlockNumber)[0];
MemoHead.BlockNumber[2]:=LongByteType(MemoBlockNumber)[1];
MemoHead.BlockNumber[1]:=LongByteType(MemoBlockNumber)[2];
MemoHead.BlockNumber[0]:=LongByteType(MemoBlockNumber)[3];
BlockWrite(Fm,MemoHead,8,Result);
end;
Close(Fm);
end;
Procedure TDataBase.LoadFile;
var
Sign:Byte;
begin
CloseDBF;
Pos.x:=0;Pos.y:=0;
Mark.x:=0;Mark.y:=0;
FileName:=F;
Assign(Fp,FileName);
Reset(Fp,1);
IsValid:=(IoResult=0);
if not IsValid then Exit;
BlockRead(Fp,Head,Sizeof(DbfHeader),Result);
if not (Head.Sign in [$03,$8B,$F5]) then IsValid:=False;
SetBufSize(DefaultBufSize);
if FileSize(Fp)>BufSize then SetBufSize(FileSize(Fp)+20480);
if FileSize(Fp)>MaxDBaseSize then IsValid:=False;
if not IsValid then
begin
Close(Fp);
Exit;
end;
MemoSign:=(Head.Sign=$F5);
LoadSaveMemoFile(0);
ZiDuanNumber:=(Head.LengthOfStruct-33) div 32;
GetMem(ZiDuan,Head.LengthOfStruct-33);
BlockRead(Fp,ZiDuan^,ZiDuanNumber*32,Result);
BlockRead(Fp,Sign,1,Result);
if (Sign<>$0D)or
((FileSize(Fp)-Head.LengthOfStruct) div Head.RecordLength > Head.TotalRecord) then
IsValid:=False;
Close(Fp);
if not IsValid then
begin
if ZiDuan<>nil then
FreeMem(ZiDuan,Head.LengthOfStruct-33);
ZiDuan:=nil;
Exit;
end;
BufGood:=True;
RecordLength:=Head.RecordLength;
if RecordLength>MaxRecordLength then
begin
RecordLength:=MaxRecordLength;
BufGood:=False;
end;
XmsDBHandle:=ReadFileToXms(FileName,Head.LengthOfStruct,BufSize,rxUser);
SetViewList;
SetViewIndex;
ReLoad;
ModifyFlag:=False;
end;
Procedure TDataBase.CreatFile;
var
Temp,i:Integer;
Sign:Byte;
begin
CloseDBF;
ModifyFlag:=True;
Pos.x:=0;Pos.y:=0;
Mark.x:=0;Mark.y:=0;
FileName:=F;
ZiDuanNumber:=CommZiDuanNum;
FillChar(Head,Sizeof(DbfHeader),0);
Head.Sign:=$03;
Head.TotalRecord:=0;
Head.LengthOfStruct:=33+ZiDuanNumber*32;;
for i:=1 to ZiDuanNumber do
if CommZiDuan[i].TypeOfZiDuan='M' then
Head.Sign:=$F5;
Temp:=1;
for i:=1 to ZiDuanNumber do
Inc(Temp,CommZiDuan[i].Length);
Head.RecordLength:=Temp;
MemoSign:=(Head.Sign=$F5);
LoadSaveMemoFile(0);
GetMem(ZiDuan,Head.LengthOfStruct-33);
Temp:=1;
for i:=1 to ZiDuanNumber do
begin
ZiDuan^[i]:=CommZiDuan[i];
ZiDuan^[i].DataAddr:=Temp;
Inc(Temp,ZiDuan^[i].Length);
end;
BufGood:=True;
RecordLength:=Head.RecordLength;
if RecordLength>MaxRecordLength then
begin
RecordLength:=MaxRecordLength;
BufGood:=False;
end;
SetBufSize(DefaultBufSize);
XmsDBHandle:=MallocXms((BufSize-1) div 1024 +1);
SetViewList;
SetViewIndex;
ReLoad;
end;
Function TDataBase.GetZDType;
begin
GetZDType:=ZiDuan^[ViewZD[Index]].TypeOfZiDuan;
end;
Function TDataBase.GetTrueStart;
var
i,Temp:Integer;
begin
Temp:=1;
for i:=1 to Index-1 do
Inc(Temp,ZiDuan^[i].Length);
GetTrueStart:=Temp;
end;
Function TDataBase.GetStart;
var
i,Temp:Integer;
begin
Temp:=1;
for i:=0 to Index-1 do
Inc(Temp,ViewZDLen[i]);
GetStart:=Temp;
end;
Function TDataBase.GetStartDot;
var
i,Temp,Dlt:Integer;
begin
case DBViewMode of
dbViewMode1:Dlt:=4;
dbViewMode2:Dlt:=0;
end;
Temp:=Origin.x;
for i:=Pos.x to Index-1 do
Inc(Temp,ViewZDLen[i]*8+Dlt);
GetStartDot:=Temp;
end;
Function TDataBase.GetDlt;
begin
if ZiDuan^[ViewZD[XIndex]].TypeOfZiDuan in ['N','F'] then
GetDlt:=ViewZDLen[XIndex]-ViewZDTrueLen[XIndex]
else
GetDlt:=0;
end;
Function TDataBase.GetHorNumber;
var
i,Temp:Integer;
begin
GetHorNumber:=ViewZDNumber-Pos.x;
Temp:=0;
for i:=Pos.x to ViewZDNumber-1 do
begin
case DBViewMode of
dbViewMode1:Inc(Temp,ViewZDLen[i]*8+4);
dbViewMode2:Inc(Temp,ViewZDLen[i]*8);
end;
if Temp>=Length-7 then
begin
GetHorNumber:=i-Pos.x+1;
Exit;
end;
end;
end;
Function TDataBase.GetStr;
var
TempStr:string;
begin
Byte(TempStr[0]):=ViewZDTrueLen[XIndex];
System.Move(Recor[YIndex,GetStart(XIndex)+GetDlt(XIndex)],TempStr[1],Byte(TempStr[0]));
GetStr:=TempStr;
end;
Procedure TDataBase.SetStr;
begin
InsSpace(Str,ViewZDLen[XIndex]);
System.Move(Str[1],Recor[YIndex,GetStart(XIndex)+GetDlt(XIndex)],ViewZDTrueLen[XIndex]);
end;
Function TDataBase.GetIndex;
var
Temp,i,Dlt:Integer;
begin
case DBViewMode of
dbViewMode1:Dlt:=4;
dbViewMode2:Dlt:=0;
end;
Temp:=0;
for i:=Pos.x to ViewZDNumber-1 do
if Temp<Length then
begin
if (x>=Origin.x+Temp)and(x<Origin.x+Temp+ViewZDLen[i]*8+Dlt) then
begin
GetIndex:=i;
Exit;
end;
Inc(Temp,ViewZDLen[i]*8+Dlt);
end;
GetIndex:=-1;
end;
Function TDataBase.GetZDIndex;
var
i:Integer;
TempStr:string;
begin
GetZDIndex:=0;
for i:=1 to ZiDuanNumber do
begin
Byte(TempStr[0]):=10;
System.Move(ZiDuan^[i].Name,TempStr[1],10);
DelNull(TempStr);
if Name=TempStr then
begin
GetZDIndex:=i;
Exit;
end;
end;
end;
Function TDataBase.GetZDStart;
var
i,Temp:Integer;
begin
Temp:=1;
for i:=1 to Index-1 do
Inc(Temp,ZiDuan^[i].Length);
GetZDStart:=Temp;
end;
Function TDataBase.GetRecStr;
var
i,Len,LenCount,TempLen:Integer;
TempMem:Pointer;
Str:string;
begin
TempLen:=Head.RecordLength;
if Odd(TempLen) then Inc(TempLen);
GetMem(TempMem,TempLen);
MoveXms(TempMem,0,Pointer(ViewRec[P]*Head.RecordLength),XmsDBHandle,TempLen);
LenCount:=0;
for i:=0 to High(Index) do
begin
Len:=ZiDuan^[Index[i]].Length;
if LenCount+Len>255 then Len:=255-LenCount;
System.Move(ArrCharType(TempMem^)[GetZDStart(Index[i])],Str[LenCount+1],Len);
Inc(LenCount,Len);
if LenCount>=255 then Break;
end;
Byte(Str[0]):=LenCount;
FreeMem(TempMem,TempLen);
GetRecStr:=Str;
end;
{
Function TDataBase.LoadRecArr;
var
i,Len,LenCount,TempLen:Integer;
TempMem:Pointer;
Str:string;
begin
TempLen:=Head.RecordLength;
if Odd(TempLen) then Inc(TempLen);
GetMem(TempMem,TempLen);
MoveXms(TempMem,0,Pointer(ViewRec[P]*Head.RecordLength),XmsDBHandle,TempLen);
LenCount:=0;
for i:=0 to High(Index) do
begin
Len:=ZiDuan^[Index[i]].Length;
if LenCount+Len>255 then Len:=255-LenCount;
System.Move(ArrCharType(TempMem^)[GetZDStart(Index[i])],Str[LenCount+1],Len);
Inc(LenCount,Len);
if LenCount>=255 then Break;
end;
Byte(Str[0]):=LenCount;
FreeMem(TempMem,TempLen);
GetRecStr:=Str;
end;
}
Procedure TDataBase.ReLoad;
var
i,j,Temp:Integer;
TempMem:Pointer;
TempLen:Longint;
begin
if not IsValid then Exit;
TempLen:=Head.RecordLength;
if Odd(TempLen) then Inc(TempLen);
GetMem(TempMem,TempLen);
FillChar(Recor,Sizeof(Recor),$20);
for i:=0 to Number-1 do
if Pos.y+i<ViewRecNumber then
begin
MoveXms(TempMem,0,Pointer(ViewRec[Pos.y+i]*Head.RecordLength),
XmsDBHandle,TempLen);
Recor[i+1,0]:=ArrCharType(TempMem^)[0];
Temp:=1;
for j:=0 to ViewZDNumber-1 do
begin
case GetZDType(j) of
'M':if StrsInt(GetRecStr(ViewZD[j],Pos.y+i))=0 then
System.Move(MemoShowNone[1],Recor[i+1,Temp],10)
else
System.Move(MemoShowHave[1],Recor[i+1,Temp],10);
else System.Move(ArrCharType(TempMem^)[GetTrueStart(ViewZD[j])],
Recor[i+1,Temp+GetDlt(j)],ViewZDTrueLen[j]);
end;
Inc(Temp,ViewZDLen[j]);
end;
end;
FreeMem(TempMem,TempLen);
end;
Procedure TDataBase.ReStore;
var
i,j,Temp:Integer;
TempMem:Pointer;
TempLen:Longint;
begin
if not IsValid then Exit;
TempLen:=Head.RecordLength;
if Odd(TempLen) then Inc(TempLen);
GetMem(TempMem,TempLen);
for i:=0 to Number-1 do
if Pos.y+i<ViewRecNumber then
begin
MoveXms(TempMem,0,Pointer(ViewRec[Pos.y+i]*Head.RecordLength),
XmsDBHandle,TempLen);
Temp:=1;
for j:=0 to ViewZDNumber-1 do
begin
if GetZDType(j)<>'M' then
System.Move(Recor[i+1,Temp+GetDlt(j)],
ArrCharType(TempMem^)[GetTrueStart(ViewZD[j])],ViewZDTrueLen[j]);
Inc(Temp,ViewZDLen[j]);
end;
MoveXms(Pointer(ViewRec[Pos.y+i]*Head.RecordLength),XmsDBHandle,
TempMem,0,TempLen);
end;
FreeMem(TempMem,TempLen);
ModifyFlag:=True;
end;
Function TDataBase.Search;
var
i,P,TempStart,TempLen:Integer;
TempStr:string;
Dlg:PMsgDialog;
begin
Search:=False;
TempStart:=1;
for i:=1 to ViewZD[dbSearchZDIndex-1]-1 do
Inc(TempStart,ZiDuan^[i].Length);
TempLen:=ViewZDTrueLen[dbSearchZDIndex-1];
Byte(TempStr[0]):=TempLen;
if TempLen>254 then TempLen:=254;
if Odd(TempLen) then Inc(TempLen);
for i:=CurPos to EndPos do
if i<ViewRecNumber then
begin
if CtrlBreakHit then Exit;
MoveXms(@TempStr[1],0,Pointer(ViewRec[i]*Head.RecordLength+TempStart),
XmsDBHandle,TempLen);
if dbSensitive then
P:=System.Pos(DBFFindStr,TempStr)
else
P:=System.Pos(Upcases(DBFFindStr),Upcases(TempStr));
if P<>0 then
begin
if (not dbWholeWord) or
not (((P>1) and (TempStr[P-1] in WordChars)) or
((P+System.Length(DBFFindStr)<=System.Length(TempStr)) and
(TempStr[P+System.Length(DBFFindStr)] in WordChars))) then
begin
Search:=True;
CurPos:=i;
if Mode=dbReplace then
begin
if dbPrompt then
begin
Mark.x:=0;Mark.y:=0;
if LocateRecord(i) and LocateZiDuan(dbSearchZDIndex-1) then Draw;
Dlg:=New(PMsgDialog,Init('替换','是否替换此记录? ',mbYesNo+mbQuestion));
Dlg^.Owner:=@Self;
Dlg^.Paint;
Dlg^.Run(Event);
Dispose(Dlg,Done);
if Event.Command=cmCancel then Search:=False;
if Event.Command<>cmYes then Exit;
end;
DelSpaceTail(TempStr);
System.Delete(TempStr,P,System.Length(DBFFindStr));
System.Insert(DBFReplaceStr,TempStr,P);
InsSpace(TempStr,ViewZDTrueLen[dbSearchZDIndex-1]);
MoveXms(Pointer(ViewRec[i]*Head.RecordLength+TempStart),
XmsDBHandle,@TempStr[1],0,TempLen);
ModifyFlag:=True;
end;
Exit;
end;
end;
end;
end;
Function TDataBase.Find;
var
i:Integer;
TempRec:Pointer;
begin
Find:=False;
if (ZiDuan=nil) or (DBFFindStr='') then Exit;
CurPos:=StartNumber-1;
if dbScopeAll then CurPos:=0;
EndPos:=EndNumber-1;
if dbScopeAll then EndPos:=ViewRecNumber-1;
RecCount:=0;
GetMem(TempRec,Sizeof(RecIndexType));
while (not CtrlBreakHit) and Search(Mode) do
begin
RecIndexType(TempRec^)[RecCount]:=ViewRec[CurPos];
Inc(CurPos);
Inc(RecCount);
end;
if (not CtrlBreakHit) and (Mode=dbSearch) and (RecCount<>0) then
begin
ViewRecNumber:=0;
for i:=0 to RecCount-1 do
AddViewRec(RecIndexType(TempRec^)[i]);
Pos.x:=0;Pos.y:=0;
Mark.x:=0;Mark.y:=0;
end;
FreeMem(TempRec,Sizeof(RecIndexType));
if CtrlBreakHit or (RecCount=0) then Exit;
ReLoad;
Find:=True;
end;
Procedure TDataBase.QuickSort(L, R: Integer);
var
I, J, Temp: Integer;
X: string;
begin
I := L;
J := R;
X := GetRecStr(SortSerial,(L + R) div 2);
repeat
if CtrlBreakHit then Exit;
while LessDBF(GetRecStr(SortSerial,I), X) do Inc(I);
while LessDBF(X, GetRecStr(SortSerial,J)) do Dec(J);
if I <= J then
begin
Temp := ViewRec[I];
ViewRec[I] := ViewRec[J];
ViewRec[J] := Temp;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then QuickSort(L, J);
if I < R then QuickSort(I, R);
end;
Function TDataBase.Sort;
begin
Sort:=False;
if ZiDuan=nil then Exit;
CurPos:=StartNumber-1;
if dbScopeAll then CurPos:=0;
EndPos:=EndNumber-1;
if dbScopeAll then EndPos:=ViewRecNumber-1;
if EndPos<CurPos then Exit;
case dbSortOrder of
dbAscending :LessDBF:=LessUp;
dbDescending:LessDBF:=LessDown;
end;
SortSerial:=ViewZD[dbSearchZDIndex-1];
QuickSort(CurPos,EndPos);
ReLoad;
Sort:=True;
end;
Function TDataBase.Insert;
var
TempMem:Pointer;
TempLength:Longint;
begin
Insert:=False;
if ZiDuan=nil then Exit;
if Head.TotalRecord>=MaxItem then Exit;
TempLength:=Head.RecordLength;
if Odd(TempLength) then Inc(TempLength);
GetMem(TempMem,TempLength);
FillChar(TempMem^,Head.RecordLength,$20);
MoveXms(Pointer(Head.TotalRecord*Head.RecordLength),XmsDBHandle,TempMem,0,TempLength);
FreeMem(TempMem,TempLength);
Inc(Head.TotalRecord);
AddViewRec(Head.TotalRecord-1);
if ViewRecNumber>Number then
Pos.y:=ViewRecNumber-Number;
ReLoad;
ModifyFlag:=True;
Insert:=True;
end;
Procedure TDataBase.Paint;
begin
HideMouse;
Full(Origin.x-46,Origin.y-23,Origin.x-2,Origin.y+Number*19,0);
Full(Origin.x-44,Origin.y-21,Origin.x-4,Origin.y-3,10);
Full(Origin.x-44,Origin.y-1,Origin.x-4,Origin.y+Number*19-2,12);
Full(Origin.x-1,Origin.y-21,Origin.x+Length+1,Origin.y-4,10);
Full(Origin.x,Origin.y,Origin.x+Length,Origin.y+Number*19-2,7);
SetColor(0);
Line(Origin.x-1,Origin.y-23,Origin.x+Length+2,Origin.y-23);
Line(Origin.x-1,Origin.y-22,Origin.x+Length+2,Origin.y-22);
Line(Origin.x-44,Origin.y-3,Origin.x+Length+2,Origin.y-3);
Line(Origin.x-44,Origin.y-2,Origin.x+Length+2,Origin.y-2);
Line(Origin.x-1,Origin.y+Number*19-1,Origin.x+Length+2,Origin.y+Number*19-1);
Line(Origin.x-1,Origin.y+Number*19,Origin.x+Length+2,Origin.y+Number*19);
Line(Origin.x+Length+2,Origin.y-23,Origin.x+Length+2,Origin.y+Number*19);
Line(Origin.x+Length+3,Origin.y-23,Origin.x+Length+3,Origin.y+Number*19);
Writecs(Origin.x-40,Origin.y-20,'序号',0);
ShowMouse;
if not IsValid then Exit;
Draw;
end;
Procedure TDataBase.DrawIndex;
var
j,Serial,Color:Integer;
begin
for j:=0 to Number-1 do
begin
if Recor[j+1,0]=' ' then
Color:=dbIndexColor11
else
Color:=dbIndexColor12;
if ShowTrueIndex then
Serial:=ViewRec[Pos.y+j]+1
else
Serial:=Pos.y+j+1;
if Pos.y+j<ViewRecNumber then
Writec16((Origin.x-40) div 8,Origin.y+j*19,Int_Str(Serial,4),Color)
else
Full(Origin.x-40,Origin.y+j*19,Origin.x-7,Origin.y+j*19+15,12);
end;
end;
Procedure TDataBase.DrawZDName;
var
i,Temp,Len,Dlt,Color:Integer;
begin
case DBViewMode of
dbViewMode1:Dlt:=4;
dbViewMode2:Dlt:=0;
end;
Full(Origin.x-1,Origin.y-21,Origin.x+Length+1,Origin.y-4,10);
Temp:=0;
for i:=Pos.x to ViewZDNumber-1 do
if Temp<Length then
begin
if Odd(i) then Color:=$A1 else Color:=$A4;
Len:=StrLen(@ZiDuan^[ViewZD[i]].Name);
if Temp+Len*8>Length then Len:=(Length-Temp) div 8;
case DBViewMode of
dbViewMode1:Writecs(Origin.x+Temp,Origin.y-20,Copy(ZiDuan^[ViewZD[i]].Name,1,Len),1);
dbViewMode2:Writec16((Origin.x+Temp) div 8,Origin.y-20,Copy(ZiDuan^[ViewZD[i]].Name,1,Len),Color);
end;
Inc(Temp,ViewZDLen[i]*8+Dlt);
end;
end;
Procedure TDataBase.DrawData1;
var
i,j,Temp,Len:Integer;
begin
for j:=0 to Number-1 do
begin
Full(Origin.x,Origin.y+j*19,Origin.x+Length+1,Origin.y+j*19+16,7);
if Pos.y+j<ViewRecNumber then
begin
Temp:=0;
for i:=Pos.x to ViewZDNumber-1 do
if Temp<Length then
begin
if Temp+ViewZDLen[i]*8<Length then
begin
Len:=ViewZDLen[i];
Full(Origin.x+Temp,Origin.y+j*19,Origin.x+Temp+Len*8+1,Origin.y+j*19+16,0);
end else
begin
Len:=(Length-Temp) div 8;
Full(Origin.x+Temp,Origin.y+j*19,Origin.x+Temp+Len*8,Origin.y+j*19+16,0);
end;
Full(Origin.x+Temp,Origin.y+j*19,Origin.x+Temp+Len*8,Origin.y+j*19+15,dbViewColor1 shr 4);
Writecs(Origin.x+Temp+GetDlt(i)*8,Origin.y+j*19,Copy(GetStr(i,j+1),1,Len-GetDlt(i)),dbViewColor1 and $0F);
Inc(Temp,ViewZDLen[i]*8+4);
end;
end;
end;
end;
Procedure TDataBase.DrawData2;
var
TempStr:string;
TempCol:ColType;
i,j,Temp,Len:Integer;
Color:Byte;
begin
Len:=Length div 8;
if Len>ViewZDTotLength-GetStart(Pos.x)+1 then
Len:=ViewZDTotLength-GetStart(Pos.x)+1;
Byte(TempStr[0]):=Length div 8+1;
FillChar(TempStr[1],Length div 8,' ');
FillChar(TempCol[1],Length div 8,$70);
Temp:=0;
for i:=Pos.x to ViewZDNumber-1 do
if Temp<Len then
begin
if Odd(i) then Color:=dbViewColor21 else Color:=dbViewColor22;
if Temp+ViewZDLen[i]<Len then
FillChar(TempCol[Temp+1],ViewZDLen[i],Color)
else
FillChar(TempCol[Temp+1],Len-Temp,Color);
Inc(Temp,ViewZDLen[i]);
end;
if Len=Length div 8 then Inc(Len);
for j:=0 to Number-1 do
begin
if Pos.y+j<ViewRecNumber then
begin
System.Move(Recor[j+1,GetStart(Pos.x)],TempStr[1],Len);
CWrite16(Origin.x div 8,Origin.y+j*19,1,Length div 8,TempStr,TempCol);
end else
begin
FillChar(TempStr[1],Length div 8,' ');
FillChar(TempCol[1],Length div 8,$70);
CWrite16(Origin.x div 8,Origin.y+j*19,1,Length div 8,TempStr,TempCol);
end;
end;
end;
Procedure TDataBase.Draw;
begin
if ZiDuan=nil then Exit;
HideMouse;
DrawIndex;
DrawZDName;
case DBViewMode of
dbViewMode1:DrawData1;
dbViewMode2:DrawData2;
end;
DrawOneZD(1,Pos.x+Mark.x,Mark.y);
end;
Procedure TDataBase.DrawOneZD;
var
Temp,Len:Integer;
Color:Byte;
Procedure Draw1;
begin
if Mode=1 then Color:=dbCurColor1 else Color:=dbViewColor1;
if GetStartDot(XIndex+1)<Origin.x+Length then
begin
Len:=ViewZDLen[XIndex];
Full(Temp,Origin.y+YIndex*19,Temp+Len*8+1,Origin.y+YIndex*19+16,0);
end else
begin
Len:=(Origin.x+Length-Temp) div 8;
Full(Temp,Origin.y+YIndex*19,Temp+Len*8,Origin.y+YIndex*19+16,0);
end;
Full(Temp,Origin.y+YIndex*19,Temp+Len*8,Origin.y+YIndex*19+15,Color shr 4);
Writecs(Temp+GetDlt(XIndex)*8,Origin.y+YIndex*19,
Copy(GetStr(XIndex,YIndex+1),1,Len-GetDlt(XIndex)),Color and $0F);
end;
Procedure Draw2;
begin
if Odd(XIndex) then Color:=dbViewColor21 else Color:=dbViewColor22;
if Mode=1 then Color:=dbCurColor2;
if GetStartDot(XIndex+1)<Origin.x+Length then
Len:=ViewZDLen[XIndex]
else
Len:=(Origin.x+Length-Temp) div 8;
Writec16(Temp div 8+GetDlt(XIndex),Origin.y+YIndex*19,
Copy(GetStr(XIndex,YIndex+1),1,Len-GetDlt(XIndex)),Color);
end;
begin
if ZiDuan=nil then Exit;
if XIndex<Pos.x then Exit;
if Pos.y+YIndex>=ViewRecNumber then Exit;
if GetStartDot(XIndex)>Origin.x+Length then Exit;
Temp:=GetStartDot(XIndex);
HideMouse;
case DBViewMode of
dbViewMode1:Draw1;
dbViewMode2:Draw2;
end;
ShowMouse;
end;
Function TDataBase.PrevRecord;
begin
PrevRecord:=False;
if not IsValid then Exit;
if Mark.y>0 then
begin
DrawOneZD(0,Pos.x+Mark.x,Mark.y);
Dec(Mark.y);
DrawOneZD(1,Pos.x+Mark.x,Mark.y);
end else
if Pos.y>0 then
begin
Dec(Pos.y);
ReLoad;
PrevRecord:=True;
end;
end;
Function TDataBase.NextRecord;
begin
NextRecord:=False;
if not IsValid then Exit;
if (Mark.y<Number-1)and(Pos.y+Mark.y<ViewRecNumber-1) then
begin
DrawOneZD(0,Pos.x+Mark.x,Mark.y);
Inc(Mark.y);
DrawOneZD(1,Pos.x+Mark.x,Mark.y);
end else
if Pos.y+Number<ViewRecNumber then
begin
Inc(Pos.y);
ReLoad;
NextRecord:=True;
end;
end;
Function TDataBase.LocateRecord;
begin
LocateRecord:=False;
if not IsValid then Exit;
if (Num>=0) and (Num<ViewRecNumber) then
begin
Pos.y:=Num;
if Pos.y+Mark.y>ViewRecNumber-1 then
Mark.y:=ViewRecNumber-Pos.y-1;
ReLoad;
LocateRecord:=True;
end;
end;
Function TDataBase.PrevZiDuan;
begin
PrevZiDuan:=False;
if not IsValid then Exit;
if Mark.x>0 then
begin
DrawOneZD(0,Pos.x+Mark.x,Mark.y);
Dec(Mark.x);
DrawOneZD(1,Pos.x+Mark.x,Mark.y);
end else
if Pos.x>0 then
begin
Dec(Pos.x);
PrevZiDuan:=True;
end;
end;
Function TDataBase.NextZiDuan;
begin
NextZiDuan:=False;
if not IsValid then Exit;
if Mark.x<GetHorNumber-1 then
begin
DrawOneZD(0,Pos.x+Mark.x,Mark.y);
Inc(Mark.x);
DrawOneZD(1,Pos.x+Mark.x,Mark.y);
end else
if Pos.x<ViewZDNumber-1 then
begin
Inc(Pos.x);
if Mark.x>GetHorNumber-1 then Mark.x:=GetHorNumber-1;
NextZiDuan:=True;
end;
end;
Function TDataBase.LocateZiDuan;
begin
LocateZiDuan:=False;
if not IsValid then Exit;
if (Num>=0) and (Num<ViewZDNumber) then
begin
Pos.x:=Num;
if Mark.x>GetHorNumber-1 then Mark.x:=GetHorNumber-1;
LocateZiDuan:=True;
end;
end;
Procedure TDataBase.DeleteRecord;
var
i:Integer;
Temp:array[0..1] of Char;
begin
if IsValid and (SNum<=Head.TotalRecord) and (SNum<=ENum) then
begin
if ENum>Head.TotalRecord then ENum:=Head.TotalRecord;
for i:=SNum to ENum do
begin
MoveXms(@Temp,0,Pointer((i-1)*Head.RecordLength),XmsDBHandle,2);
if DMode=1 then
Temp[0]:='*'
else
Temp[0]:=' ';
MoveXms(Pointer((i-1)*Head.RecordLength),XmsDBHandle,@Temp,0,2);
end;
ModifyFlag:=True;
ReLoad;
end;
end;
Procedure TDataBase.ReStruct;
var
TempHandle:Word;
TempMem:Pointer;
i,Len1,Len2,TempLength,OldLength,TempTotRecord:Longint;
begin
OldLength:=Head.RecordLength;
TempTotRecord:=Head.TotalRecord;
TempHandle:=XmsDBHandle;
XmsDBHandle:=0;
CreatFile(FileName);
if TempTotRecord>MaxItem then TempTotRecord:=MaxItem;
Len1:=OldLength;
if Odd(Len1) then Inc(Len1);
Len2:=Head.RecordLength;
if Odd(Len2) then Inc(Len2);
TempLength:=Max(Len1,Len2);
GetMem(TempMem,TempLength);
FillChar(TempMem^,TempLength,$20);
{ GetMem(ConMem,TempLength);
FillChar(ConMem^,TempLength,$20);
}
for i:=1 to TempTotRecord do
begin
MoveXms(TempMem,0,Pointer((i-1)*OldLength),TempHandle,Len1);
if Odd(OldLength) then ArrCharType(TempMem^)[OldLength]:=' ';
MoveXms(Pointer((i-1)*Head.RecordLength),XmsDBHandle,TempMem,0,Len2);
end;
Head.TotalRecord:=TempTotRecord;
FreeMem(TempMem,TempLength);
FreeXms(TempHandle);
ReLoad;
end;
Function TDataBase.Pack;
var
TempHandle:Word;
TempMem:Pointer;
TempLength:Longint;
i,Count:Longint;
begin
Pack:=False;
TempLength:=Head.RecordLength;
TempHandle:=MallocXms((BufSize-1) div 1024 +1);
if TempHandle=0 then Exit;
if Odd(TempLength) then Inc(TempLength);
GetMem(TempMem,TempLength);
Count:=0;
for i:=1 to Head.TotalRecord do
begin
MoveXms(TempMem,0,Pointer((i-1)*Head.RecordLength),XmsDBHandle,TempLength);
if Char(TempMem^)=' ' then
begin
MoveXms(Pointer(Count*Head.RecordLength),TempHandle,TempMem,0,TempLength);
Inc(Count);
end;
end;
FreeMem(TempMem,TempLength);
FreeXms(XmsDBHandle);
XmsDBHandle:=TempHandle;
Head.TotalRecord:=Count;
ModifyFlag:=True;
Pos.x:=0;Pos.y:=0;
Mark.x:=0;Mark.y:=0;
SetViewIndex;
ReLoad;
Pack:=True;
end;
Procedure TDataBase.Zap;
begin
Head.TotalRecord:=0;
ModifyFlag:=True;
SetViewIndex;
ReLoad;
end;
Procedure TDataBase.HandleEvent;
begin
if (ZiDuan=nil) or (ViewZDNumber=0) or (ViewRecNumber=0) then Exit;
case Event.What of
evMouseDown:if (Event.Buttons=mbLeftButton) and IsIn(Event.Where,Rect) then
begin
if (GetIndex(Event.Where.x)=-1) or
(Pos.y+(Event.Where.y-Rect.a.y) div 19>ViewRecNumber-1) then
Exit;
DrawOneZD(0,Pos.x+Mark.x,Mark.y);
Mark.x:=GetIndex(Event.Where.x)-Pos.x;
Mark.y:=(Event.Where.y-Rect.a.y) div 19;
DrawOneZD(1,Pos.x+Mark.x,Mark.y);
if Event.Double then
begin
Event.What:=evCommand;
Event.Command:=cmInputS;
end;
end;
evKeyDown:case Event.KeyCode of
kbEnter:begin
Event.What:=evCommand;
Event.Command:=cmInputS;
end;
end;
end;
end;
{--------------TBaseInfo------------------------}
constructor TBaseInfo.Init;
var
R:TRect;
begin
AssignRect(R,0,0,290,260);
Inherited Init(R,'数据库信息',True);
Option:=Option or opAligen8;
Insert(New(PStaticText,Init(stNormal,16,30,'字段名 类型 长度 小数点',0)));
Lister:=New(PLister,Init(16,50,30,8,N,stVScroll));
Insert(Lister);
Insert(New(PStaticText,Init(stNormal,16,190,'记录总数:'+S1,0)));
Insert(New(PStaticText,Init(stNormal,16,210,'记录长度:'+S2,0)));
Insert(New(PStaticText,Init(stNormal,16,230,'字段总数:'+S3,0)));
Insert(New(PStaticText,Init(stNormal,140,190,'更改日期:'+S4,0)));
Insert(New(PStaticText,Init(stNormal,140,210,S5,0)));
Insert(New(PButton,Init(210 ,230 ,270,250,'关闭',kbEnter,cmOk)));
Center;
end;
procedure TBaseInfo.InsertStr;
begin
Lister^.Insert(St);
end;
{--------------TCreatStru------------------------}
Function ModifyWin(Tit:string):PWindow;
var
R:TRect;
P:PWindow;
Inp:PInput;
Rad:PRadioButton;
List:PLister;
i:Integer;
begin
AssignRect(R, 0, 0, 260, 180);
P:=New(PWindow,Init(R,Tit,True));
P^.Insert(New(PStaticText,Init(stNormal,20,40,'字段名:',0)));
Inp:=New(PInput,Init(80,40,ZDName,11,ipBroad));
P^.Insert(Inp);
Rad:=New(PRadioButton,Init(20,70,170,140,'字段类型:',ZDType));
Rad^.Insert('字符');
Rad^.Insert('数字');
Rad^.Insert('日期');
Rad^.Insert('逻辑');
Rad^.Insert('备注');
P^.Insert(Rad);
P^.Insert(New(PStaticText,Init(stNormal,20,150,'长度:',0)));
Inp:=New(PDigInput,Init(70,150,@ZDLength,6,ipBroad+ipDigital,dtInteger));
Inp^.SetRange('长度',1,$FE);
P^.Insert(Inp);
P^.Insert(New(PStaticText,Init(stNormal,130,150,'点位:',0)));
Inp:=New(PDigInput,Init(180,150,@ZDDotNum,6,ipBroad+ipDigital,dtInteger));
Inp^.SetRange('小数点位数',0,$FD);
P^.Insert(Inp);
P^.Insert(New(PButton,Init(180, 40,240, 60,'确定',kbAltO,cmOk)));
P^.Insert(New(PButton,Init(180, 70,240, 90,'放弃',kbAltC,cmCancel)));
P^.Next;
P^.Next;
P^.Center;
ModifyWin:=P;
end;
constructor TCreatStru.Init;
var
T:TRect;
i,TempLen:Integer;
begin
AssignRect(T,0,0,350,220);
Inherited Init(T,Tit,True);
Option:=Option or opAligen8;
for i:=CommZiDuanNum+1 to MaxCreatZiDuan do
FillChar(CommZiDuan[i],Sizeof(Zi_Duan),0);
Insert(New(PStaticText,Init(stNormal,16,30,'字段名 类型 长度 小数点',0)));
Lister:=New(PLister,Init(16,50,30,8,MaxCreatZiDuan,stVScroll));
TempLen:=0;
for i:=1 to CommZiDuanNum do
begin
Pos:=i;
InitData(0);
ResetData(0);
Lister^.Insert(ListStr);
Inc(TempLen,CommZiDuan[i].Length);
end;
Insert(Lister);
Insert(New(PButton,Init(285,45 ,335,65 ,'增加',kbAltA,cmAdd)));
Insert(New(PButton,Init(285,70 ,335,90 ,'插入',kbIns,cmInsert)));
Insert(New(PButton,Init(285,95 ,335,115,'删除',kbDel,cmDelete)));
Insert(New(PButton,Init(285,120,335,140,'修改',kbAltM,cmModify)));
Insert(New(PButton,Init(285,150,335,170,'确定',kbAltO,cmOk)));
Insert(New(PButton,Init(285,175,335,195,'放弃',kbEsc,cmCancel)));
AssignRect(T,15,190,275,210);
Insert(New(PShape,Init(gcBroad,T,0,0,7,0,'')));
Insert(New(PStaticText,Init(stNormal,16,192,'字段数:',0)));
Insert(New(PStaticText,Init(stNormal,130,192,'记录长度:',0)));
Str1:=New(PStaticText,Init(stNormal,75,192,IntStr(CommZiDuanNum),15));
Str2:=New(PStaticText,Init(stNormal,205,192,IntStr(TempLen),15));
Insert(Str1);
Insert(Str2);
Next;
Center;
end;
Procedure TCreatStru.HandleEvent;
var
TempStr:string;
i:Integer;
begin
Inherited HandleEvent(Event);
case Event.What of
evCommand:case Event.Command of
cmAdd:if Lister^.Current<MaxCreatZiDuan then
begin
Pos:=Lister^.Current+1;
InitData(1);
RunView(ModifyWin('增加字段'),Event);
if Event.Command=cmOk then
begin
ResetData(1);
Lister^.Insert(ListStr);
Lister^.GotoEnd;
Lister^.Draw;
SetInfo;
end;
end;
cmInsert:if Lister^.Current<MaxCreatZiDuan then
begin
Pos:=Lister^.Pos.y+Lister^.Mark.y;
InitData(1);
RunView(ModifyWin('插入字段'),Event);
if Event.Command=cmOk then
begin
for i:=Lister^.Current downto Pos do
CommZiDuan[i+1]:=CommZiDuan[i];
ResetData(1);
Lister^.InsertFront(ListStr);
Lister^.Draw;
SetInfo;
end;
end;
cmDelete:if Lister^.Current>0 then
begin
Dec(CommZiDuanNum);
if Lister^.Pos.y+Lister^.Mark.y<Lister^.Current then
for i:=Lister^.Pos.y+Lister^.Mark.y to Lister^.Current-1 do
CommZiDuan[i]:=CommZiDuan[i+1];
Lister^.Delete;
Lister^.Draw;
SetInfo;
end;
cmOk,cmModify:if (Event.InfoPtr=Lister)or(Event.Command=cmModify) then
begin
if Lister^.Pos.y+Lister^.Mark.y<=Lister^.Current then
begin
Pos:=Lister^.Pos.y+Lister^.Mark.y;
InitData(0);
RunView(ModifyWin('修改字段'),Event);
if Event.Command=cmOk then
begin
ResetData(0);
Lister^.Modify(ListStr);
Lister^.Draw;
SetInfo;
end;
end;
end else Exit;
else Exit;
end;
else Exit;
end;
ClearEvent(Event);
end;
Procedure TCreatStru.SetInfo;
var
i,TempLen:Integer;
begin
TempLen:=0;
for i:=1 to CommZiDuanNum do
Inc(TempLen,CommZiDuan[i].Length);
Str1^.Modify(IntStr(CommZiDuanNum));
Str2^.Modify(IntStr(TempLen));
end;
Procedure TCreatStru.InitData;
begin
if Mode=1 then
begin
ZDName:='';
ZDType:=1;
ZDLength:=1;
ZDDotNum:=0;
end else
begin
Byte(ZDName[0]):=10;
System.Move(CommZiDuan[Pos].Name[1],ZDName[1],10);
DelSpace(ZDName);
DelNull(ZDName);
ZDType:=ZDToByte(CommZiDuan[Pos].TypeOfZiDuan);
ZDLength:=CommZiDuan[Pos].Length;
ZDDotNum:=CommZiDuan[Pos].DotNumber;
end;
end;
Procedure TCreatStru.ReSetData;
begin
case ZDType of
1:ZDDotNum:=0;
3:begin ZDLength:=8;ZDDotNum:=0; end;
4:begin ZDLength:=1;ZDDotNum:=0; end;
5:begin ZDLength:=10;ZDDotNum:=0; end;
end;
InsNull(ZDName,10);
System.Move(ZDName[1],CommZiDuan[Pos].Name[1],10);
CommZiDuan[Pos].TypeOfZiDuan:=ZiDuan_Type[ZDType-1];
CommZiDuan[Pos].Length:=ZDLength;
CommZiDuan[Pos].DotNumber:=ZDDotNum;
if Mode=1 then Inc(CommZiDuanNum);
ListStr:=ZDName;
InsSpace(ListStr,12);
ListStr:=ListStr+ZDToStr(ZIDuan_Type[ZDType-1]);
InsSpace(ListStr,18);
ListStr:=ListStr+IntStr(ZDLength);
InsSpace(ListStr,24);
ListStr:=ListStr+IntStr(ZDDotNum);
end;
{--------------TBaseWin----------------------------}
Constructor TBaseWin.Init;
var
R:TRect;
i:Integer;
begin
AssignRect(R,0,0,580,300);
Inherited Init(R,'数据库['+F+']',False);
Option:=Option +opAligen8 +opCantClose - opCanMove;
Base:=New(PDataBase,Init(56,55,490,10,''));
Insert(Base);
AssignRect(R,470,250,80,16);
HScrollBar:=New(PScrollBar,Init(sbHor,R,0));
AssignRect(R,555,53,15,190);
VScrollBar:=New(PScrollBar,Init(sbVer,R,0));
Insert(HScrollBar);
Insert(VScrollBar);
AssignRect(R,10,250,460,270);
Insert(New(PShape,Init(gcBroad+gcHideMouse,R,0,0,7,0,'')));
Insert(New(PStaticText,Init(stNormal,11,252,
'总记录: 操作记录: 记录长度: 字段数:',0)));
Str1:=New(PStaticText,Init(stNormal,70,252,'',15));
Str2:=New(PStaticText,Init(stNormal,205,252,'',15));
Str3:=New(PStaticText,Init(stNormal,340,252,'',15));
Str4:=New(PStaticText,Init(stNormal,435,252,'',15));
Insert(Str1);
Insert(Str2);
Insert(Str3);
Insert(Str4);
AssignRect(R,350,275,570,295);
Insert(New(PShape,Init(gcBroad+gcHideMouse,R,0,0,7,0,'')));
ShowStr:=New(PStaticText,Init(stNormal,355,277,'',4));
Insert(ShowStr);
Next;
Center;
AssignRect(Rec,Base^.Origin.x,Base^.Origin.y,Base^.Origin.x+490,Base^.Origin.y+190);
OpenDBF(F);
for i:=0 to MaxWorkArea-1 do
WorkArea[i]:=nil;
CurWorkArea:=0;
WorkArea[CurWorkArea]:=Base;
end;
Procedure TBaseWin.SetInfo;
begin
if Base^.ZiDuan<>nil then
begin
Str1^.Modify(IntStr(Base^.Head.TotalRecord));
Str2^.Modify(IntStr(Base^.ViewRecNumber));
Str3^.Modify(IntStr(Base^.Head.RecordLength));
Str4^.Modify(IntStr(Base^.ZiDuanNumber));
end else
begin
Str1^.Modify('');
Str2^.Modify('');
Str3^.Modify('');
Str4^.Modify('');
end;
end;
Procedure TBaseWin.SetScrollBar;
begin
if not Base^.Valid then Exit;
Base^.Draw;
if Base^.ViewZDNumber>1 then
HScrollBar^.NewPos(Base^.Pos.x/(Base^.ViewZDNumber-1))
else
HScrollBar^.NewPos(0);
if Base^.ViewRecNumber-Base^.Number>0 then
VScrollBar^.NewPos(Base^.Pos.y/(Base^.ViewRecNumber-Base^.Number))
else
VScrollBar^.NewPos(0);
SetInfo;
end;
Procedure TBaseWin.InsertRecord;
begin
if Base^.ZiDuan=nil then Exit;
Base^.Insert;
SetScrollBar;
end;
Procedure TBaseWin.DeleteRecord;
begin
if Base^.ZiDuan=nil then Exit;
if Mode=1 then
RunView(GotoRecordWin('删除记录',1),Event)
else
RunView(GotoRecordWin('恢复删除记录',1),Event);
if (Event.What=evCommand)and(Event.Command=cmOk) then
begin
Base^.DeleteRecord(Mode,StartNumber,EndNumber);
SetScrollBar;
end;
end;
Procedure TBaseWin.GotoRecord;
begin
if Base^.ZiDuan=nil then Exit;
RunView(GotoRecordWin('记录跳转',0),Event);
if (Event.What=evCommand)and(Event.Command=cmOk) then
begin
Base^.LocateRecord(StartNumber-1);
SetScrollBar;
end;
end;
Procedure TBaseWin.ShowStruct;
var
TempStr:string;
Info:PBaseInfo;
i:Integer;
begin
if Base^.ZiDuan=nil then Exit;
Info:=New(PBaseInfo,Init(Base^.ZiDuanNumber,
IntStr(Base^.Head.TotalRecord),
IntStr(Base^.Head.RecordLength),
IntStr(Base^.ZiDuanNumber),
Int_Str(Base^.Head.Year,2)+'/'+
Int_Str(Base^.Head.Month,2)+'/'+
Int_Str(Base^.Head.Day,2),
MemoStr[Base^.MemoSign]+'备注字段'));
for i:=1 to Base^.ZiDuanNumber do
begin
TempStr:=Base^.ZiDuan^[i].Name;
DelNull(TempStr);
InsSpace(TempStr,12);
TempStr:=TempStr+ZDToStr(Base^.ZiDuan^[i].TypeOfZiDuan);
InsSpace(TempStr,18);
TempStr:=TempStr+IntStr(Base^.ZiDuan^[i].Length);
InsSpace(TempStr,24);
TempStr:=TempStr+IntStr(Base^.ZiDuan^[i].DotNumber);
Info^.InsertStr(TempStr);
end;
RunView(Info,Event);
end;
Procedure TBaseWin.ModifyStruct;
var
i:Integer;
begin
if (Base^.ZiDuan=nil) or (Base^.ZiDuanNumber>MaxCreatZiDuan) then Exit;
CommZiDuanNum:=Base^.ZiDuanNumber;
for i:=1 to Base^.ZiDuanNumber do
CommZiDuan[i]:=Base^.ZiDuan^[i];
if Base^.Head.TotalRecord>0 then
begin
RunView(New(PMsgDialog,Init('警告',
'当前数据库中记录非空,'#13+
'修改数据库结构可能会丢失数据!',
mbOkCancel+mbExcalamation)),Event);
if Event.Command=cmCancel then Exit;
end;
RunView(New(PCreatStru,Init('修改数据库结构')),Event);
if Event.Command=cmOk then
begin
Base^.ReStruct;
SetScrollBar;
end;
end;
Procedure TBaseWin.CloseWorkArea;
begin
ShowStr^.Modify('');
if SureToCloseWin and (WorkArea[Num]<>nil)
and WorkArea[Num]^.ModifyFlag then
begin
RunView(New(PMsgDialog,Init('保存文件',
'文件'+WorkArea[Num]^.FileName+'已改动'#13+
',是否要保存?',mbYesNo+mbQuestion)),Event);
if Event.Command=cmYes then
WorkArea[Num]^.SaveFile
else if Event.Command=cmCancel then
SureToCloseWin:=False;
end;
if SureToCloseWin and (Mode=dbDestroy) and (WorkArea[Num]<>nil) then
begin
Dispose(WorkArea[Num],Done);
WorkArea[Num]:=nil;
end;
end;
Procedure TBaseWin.CloseSelf;
var
i:Integer;
begin
for i:=0 to MaxWorkArea-1 do
if i<>CurWorkArea then
CloseWorkArea(i,dbDestroy);
CloseWorkArea(CurWorkArea,dbAsk);
end;
Procedure TBaseWin.CloseDBF;
begin
if Base^.ZiDuan=nil then Exit;
SureToCloseWin:=True;
CloseWorkArea(CurWorkArea,dbAsk);
if not SureToCloseWin then Exit;
Base^.CloseDBF;
Base^.Paint;
SetScrollBar;
ModifyTitle('数据库[]');
end;
Procedure TBaseWin.OpenDBF;
begin
if not Exist_Fi(Name) then Exit;
SureToCloseWin:=True;
CloseWorkArea(CurWorkArea,dbAsk);
if not SureToCloseWin then Exit;
Base^.LoadFile(Name);
ChangePath(Name);
Base^.Paint;
SetScrollBar;
ModifyTitle('数据库['+Name+']');
if Base^.Valid then
ShowStr^.Modify('')
else
ShowStr^.Modify('文件有错误!');
end;
Procedure TBaseWin.NewDBF;
begin
SureToCloseWin:=True;
CloseWorkArea(CurWorkArea,dbAsk);
if not SureToCloseWin then Exit;
CommZiDuanNum:=0;
RunView(New(PCreatStru,Init('新建数据库')),Event);
if Event.Command=cmOk then
begin
Base^.CreatFile(Name);
ChangePath(Name);
SetScrollBar;
ModifyTitle('数据库['+Name+']');
ShowStr^.Modify('');
end;
end;
Procedure TBaseWin.SaveAsDBF;
begin
Base^.SaveAsFile(Name,DBFSaveMode);
ChangePath(Name);
SetScrollBar;
ModifyTitle('数据库['+Name+']');
ShowStr^.Modify('');
end;
Procedure TBaseWin.InputZiDuan;
var
Inp:PInput;
TempStr:string;
Len:Integer;
begin
Len:=Base^.ViewZDTrueLen[X];
if Len>65 then Len:=65;
TempStr:=Copy(Base^.GetStr(X,Y+1),1,Len);
case Base^.GetZDType(X) of
'L':begin
if TempStr='T' then
TempStr:='F'
else
TempStr:='T';
Base^.SetStr(X,Y+1,TempStr);
Base^.ReStore;
Base^.DrawOneZD(1,X,Y);
Exit;
end;
'N','F':DelSpace(TempStr);
'M':Exit;
else
DelSpaceTail(TempStr);
end;
Inp:=New(PInput,Init(Base^.GetStartDot(X)+Base^.GetDlt(X)*8,
Rec.a.y+Y*19,TempStr,Len+1,opSaveBack));
if Inp^.Broad.b.x>Rec.b.x+10 then
Inp^.MoveTo(Rec.b.x-Len*8,Rec.a.y+Y*19);
RunView(Inp,Event);
if Event.Command=cmOk then
begin
if Base^.GetZDType(X) in ['N','F'] then
InsSpaceFront(TempStr,Len)
else
InsSpace(TempStr,Len);
Base^.SetStr(X,Y+1,TempStr);
Base^.ReStore;
Base^.DrawOneZD(1,X,Y);
end;
end;
Procedure TBaseWin.PackFile;
begin
if Base^.ZiDuan=nil then Exit;
RunView(New(PMsgDialog,Init('警告',
'整理文件将使删除的记录不能恢复,'#13+
'确定要整理么?',mbOkCancel+mbExcalamation)),Event);
if Event.Command=cmCancel then Exit;
Base^.Pack;
SetScrollBar;
end;
Procedure TBaseWin.ZapFile;
begin
if Base^.ZiDuan=nil then Exit;
RunView(New(PMsgDialog,Init('警告',
'文件全清将使所有记录永久删除,'#13+
'确定要继续么?',mbOkCancel+mbExcalamation)),Event);
if Event.Command=cmCancel then Exit;
Base^.Zap;
SetScrollBar;
end;
Procedure TBaseWin.SelectZD;
var
i:Integer;
List:PSelectListWin;
ZD:array[0..MaxViewZD-1] of Integer;
begin
if Base^.ZiDuan=nil then Exit;
List:=New(PSelectListWin,Init('选择显示字段',Base^.ZiDuanNumber,@ZD));
for i:=1 to Base^.ZiDuanNumber do
List^.InsertSouStr(Base^.ZiDuan^[i].Name);
for i:=0 to Base^.ViewZDNumber-1 do
List^.InsertDesStr(Base^.ZiDuan^[Base^.ViewZD[i]].Name);
RunView(List,Event);
if (Event.What=evCommand) and (Event.Command=cmOk) then
begin
Base^.ViewZDTotLength:=0;
Base^.ViewZDNumber:=0;
for i:=0 to Event.InfoInt-1 do
Base^.AddViewZD(ZD[i]);
Base^.ReLoad;
Base^.LocateZiDuan(0);
Base^.Draw;
end;
end;
Procedure TBaseWin.ShowAll;
begin
if Base^.ZiDuan=nil then Exit;
Base^.SetViewIndex;
Base^.ReLoad;
Base^.Draw;
ShowStr^.Modify('');
end;
Function TBaseWin.DBFFindWin:PWindow;
var
i:Integer;
TempStr:string;
R:TRect;
P:PWindow;
Inp:PInput;
Lst:PLister;
Chk:PCheckBox;
begin
AssignRect(R, 0, 0, 370, 180);
P:=New(PWindow,Init(R,'查找字符串',True));
P^.Option:=P^.Option + opAligen8;
P^.Insert(New(PStaticText,Init(stNormal,20,35,'待查字串:',0)));
P^.Insert(New(PInput,Init(100,35,DBFFindStr,30,ipBroad)));
Chk:=New(PCheckBox,Init(20,65,160,140,'设置:'));
Chk^.Insert('分辨大小写',dbSensitive);
Chk^.Insert('整个字串匹配',dbWholeword);
Chk^.Insert('全部选择',dbScopeAll);
P^.Insert(Chk);
AssignRect(R,170,65,345,110);
P^.Insert(New(PShape,Init(gcDBroad+gcHideMouse,R,0,0,0,0,'')));
P^.Insert(New(PStaticText,Init(stNormal,180,82,'字段:',0)));
dbSearchZD:=Base^.ZiDuan^[Base^.ViewZD[dbSearchZDIndex-1]].Name;
DelNull(dbSearchZD);
Inp:=New(PInput,Init(224,82,dbSearchZD,13,ipBroad+ipSelect));
Lst:=New(PLister,Init(224,100,11,4,Base^.ViewZDNumber,stVScroll+stSaveBack));
Lst^.Option:=Lst^.Option + opCantSelect;
for i:=0 to Base^.ViewZDNumber-1 do
begin
TempStr:=Base^.ZiDuan^[Base^.ViewZD[i]].Name;
Lst^.Insert(DelNull(TempStr));
end;
Lst^.SetInt(@dbSearchZDIndex);
Inp^.SetLister(Lst);
P^.Insert(Inp);
P^.Insert(Lst);
P^.Insert(New(PStaticText,Init(stNormal,170,120,'从',0)));
Inp:=New(PDigInput,Init(190,120,@StartNumber,8,ipBroad+ipDigital,dtInteger));
Inp^.SetRange('起始记录',1,Base^.ViewRecNumber);
P^.Insert(Inp);
P^.Insert(New(PStaticText,Init(stNormal,260,120,'到',0)));
Inp:=New(PDigInput,Init(280,120,@EndNumber,8,ipBroad+ipDigital,dtInteger));
Inp^.SetRange('中止记录',1,Base^.ViewRecNumber);
P^.Insert(Inp);
P^.Insert(New(PButton,Init(180 ,150,230,170,'确定',kbAlto,cmOk)));
P^.Insert(New(PButton,Init(240 ,150,290,170,'放弃',kbAltc,cmCancel)));
P^.Insert(New(PButton,Init(300 ,150,350,170,'帮助',kbF1,cmHelp)));
P^.Next;
P^.Next;
P^.Center;
DBFFindWin:=P;
end;
Function TBaseWin.DBFReplaceWin:PWindow;
var
i:Integer;
TempStr:string;
R:TRect;
P:PWindow;
Inp:PInput;
Lst:PLister;
Chk:PCheckBox;
begin
AssignRect(R, 0, 0, 370, 200);
P:=New(PWindow,Init(R,'替换字符串',True));
P^.Option:=P^.Option + opAligen8;
P^.Insert(New(PStaticText,Init(stNormal,20,35,'原字串:',0)));
P^.Insert(New(PInput,Init(90,35,DBFFindStr,32,ipBroad)));
P^.Insert(New(PStaticText,Init(stNormal,20,60,'新字串:',0)));
P^.Insert(New(PInput,Init(90,60,DBFReplaceStr,32,ipBroad)));
Chk:=New(PCheckBox,Init(20,90,160,180,'设置:'));
Chk^.Insert('分辨大小写',dbSensitive);
Chk^.Insert('整个字串匹配',dbWholeword);
Chk^.Insert('全部选择',dbScopeAll);
Chk^.Insert('替换时提示',dbPrompt);
P^.Insert(Chk);
AssignRect(R,170,90,345,135);
P^.Insert(New(PShape,Init(gcDBroad+gcHideMouse,R,0,0,0,0,'')));
P^.Insert(New(PStaticText,Init(stNormal,180,107,'字段:',0)));
dbSearchZD:=Base^.ZiDuan^[Base^.ViewZD[dbSearchZDIndex-1]].Name;
DelNull(dbSearchZD);
Inp:=New(PInput,Init(224,107,dbSearchZD,13,ipBroad+ipSelect));
Lst:=New(PLister,Init(224,125,11,4,Base^.ViewZDNumber,stVScroll+stSaveBack));
Lst^.Option:=Lst^.Option + opCantSelect;
for i:=0 to Base^.ViewZDNumber-1 do
begin
TempStr:=Base^.ZiDuan^[Base^.ViewZD[i]].Name;
Lst^.Insert(DelNull(TempStr));
end;
Lst^.SetInt(@dbSearchZDIndex);
Inp^.SetLister(Lst);
P^.Insert(Inp);
P^.Insert(Lst);
P^.Insert(New(PStaticText,Init(stNormal,170,145,'从',0)));
Inp:=New(PDigInput,Init(190,145,@StartNumber,8,ipBroad+ipDigital,dtInteger));
Inp^.SetRange('起始记录',1,Base^.ViewRecNumber);
P^.Insert(Inp);
P^.Insert(New(PStaticText,Init(stNormal,260,145,'到',0)));
Inp:=New(PDigInput,Init(280,145,@EndNumber,8,ipBroad+ipDigital,dtInteger));
Inp^.SetRange('中止记录',1,Base^.ViewRecNumber);
P^.Insert(Inp);
P^.Insert(New(PButton,Init(180 ,170,230,190,'确定',kbAlto,cmOk)));
P^.Insert(New(PButton,Init(240 ,170,290,190,'放弃',kbAltc,cmCancel)));
P^.Insert(New(PButton,Init(300 ,170,350,190,'帮助',kbF1,cmHelp)));
P^.Next;
P^.Next;
P^.Center;
DBFReplaceWin:=P;
end;
Procedure TBaseWin.DoSearch;
begin
if Base^.ZiDuan=nil then Exit;
case Mode of
dbSearch :RunView(DBFFindWin,Event);
dbReplace:RunView(DBFReplaceWin,Event);
end;
if Event.Command=cmOk then
begin
ShowStr^.Modify('正在查找【Ctrl+Break中止】');
CtrlBreakHit:=False;
if Base^.Find(Mode) then
begin
SetScrollBar;
ShowStr^.Modify('找到记录:'+IntStr(Base^.RecCount));
end else
begin
ShowStr^.Modify('');
if not CtrlBreakHit then
RunView(New(PMsgDialog,Init('错误',
'未找到符合条件的记录!',mbOKOnly+mbInformation)),Event);
end;
CtrlBreakHit:=False;
end;
end;
Function TBaseWin.DBFSortWin:PWindow;
var
i:Integer;
TempStr:string;
R:TRect;
P:PWindow;
Inp:PInput;
Lst:PLister;
Rad:PRadioButton;
begin
AssignRect(R, 0, 0, 330, 150);
P:=New(PWindow,Init(R,'排序',True));
P^.Option:=P^.Option + opAligen8;
Rad:=New(PRadioButton,Init(20,35,120,90,'顺序:',dbSortOrder));
Rad^.Insert('升序');
Rad^.Insert('降序');
P^.Insert(Rad);
P^.Insert(New(PCluster,Init(30,100,'全部选择',dbScopeAll,stChkBox)));
AssignRect(R,130,35,305,80);
P^.Insert(New(PShape,Init(gcDBroad+gcHideMouse,R,0,0,0,0,'')));
P^.Insert(New(PStaticText,Init(stNormal,140,52,'字段:',0)));
dbSearchZD:=Base^.ZiDuan^[Base^.ViewZD[dbSearchZDIndex-1]].Name;
DelNull(dbSearchZD);
Inp:=New(PInput,Init(184,52,dbSearchZD,13,ipBroad+ipSelect));
Lst:=New(PLister,Init(184,70,11,4,Base^.ViewZDNumber,stVScroll+stSaveBack));
Lst^.Option:=Lst^.Option + opCantSelect;
for i:=0 to Base^.ViewZDNumber-1 do
begin
TempStr:=Base^.ZiDuan^[Base^.ViewZD[i]].Name;
Lst^.Insert(DelNull(TempStr));
end;
Lst^.SetInt(@dbSearchZDIndex);
Inp^.SetLister(Lst);
P^.Insert(Inp);
P^.Insert(Lst);
P^.Insert(New(PStaticText,Init(stNormal,130,90,'从',0)));
Inp:=New(PDigInput,Init(150,90,@StartNumber,8,ipBroad+ipDigital,dtInteger));
Inp^.SetRange('起始记录',1,Base^.ViewRecNumber);
P^.Insert(Inp);
P^.Insert(New(PStaticText,Init(stNormal,220,90,'到',0)));
Inp:=New(PDigInput,Init(240,90,@EndNumber,8,ipBroad+ipDigital,dtInteger));
Inp^.SetRange('中止记录',1,Base^.ViewRecNumber);
P^.Insert(Inp);
P^.Insert(New(PButton,Init(140 ,120,190,140,'确定',kbAlto,cmOk)));
P^.Insert(New(PButton,Init(200 ,120,250,140,'放弃',kbAltc,cmCancel)));
P^.Insert(New(PButton,Init(260 ,120,310,140,'帮助',kbF1,cmHelp)));
P^.Next;
P^.Center;
DBFSortWin:=P;
end;
Procedure TBaseWin.DoSort;
begin
if Base^.ZiDuan=nil then Exit;
RunView(DBFSortWin,Event);
if Event.Command=cmOk then
begin
ShowStr^.Modify('正在排序【Ctrl+Break中止】');
CtrlBreakHit:=False;
Base^.Sort;
SetScrollBar;
ShowStr^.Modify('');
CtrlBreakHit:=False;
end;
end;
Procedure TBaseWin.SelectWorkArea;
begin
if Num=CurWorkArea then Exit;
if (WorkArea[Num]=nil) and
((MemAvail<DBFMinMemory)or(GetXmsSize<DBFMinXms)) then Exit;
if WorkArea[Num]=nil then
WorkArea[Num]:=New(PDataBase,Init(Origin.x+56,Origin.y+55,490,10,''));
CurWorkArea:=Num;
Group^.ReplaceView(Base,WorkArea[CurWorkArea]);
Base:=WorkArea[CurWorkArea];
end;
Procedure TBaseWin.ListWorkArea;
var
List:PWinList;
i:Integer;
St:string;
begin
List:=New(PWinList,Init(MaxWorkArea));
for i:=0 to MaxWorkArea-1 do
if WorkArea[i]<>nil then
begin
St:=WorkArea[i]^.FileName;
if St='' then St:='空';
List^.Lister^.Insert('工作区'+IntStr(i)+':'+St);
end else
List^.Lister^.Insert('工作区'+IntStr(i)+':未用');
List^.Lister^.SetIndex(CurWorkArea+1);
RunView(List,Event);
if (Event.What=evCommand) and (Event.Command=cmOk) then
begin
if Event.InfoInt-1=CurWorkArea then Exit;
SelectWorkArea(Event.InfoInt-1);
Base^.Paint;
SetScrollBar;
end;
end;
Procedure TBaseWin.HandleEvent;
var
Name:PathStr;
begin
Inherited HandleEvent(Event);
case Event.What of
evCommand:case Event.Command of
cmInputS:InputZiDuan(Base^.Pos.x+Base^.Mark.x,Base^.Mark.y);
cmLeft :if Base^.PrevZiDuan then SetScrollBar;
cmRight:if Base^.NextZiDuan then SetScrollBar;
cmUp :if Base^.PrevRecord then SetScrollBar;
cmDown :if Base^.NextRecord then SetScrollBar;
cmPgUp :if Base^.LocateRecord(Base^.Pos.y-Base^.Number+1) then SetScrollBar;
cmPgDn :if Base^.LocateRecord(Base^.Pos.y+Base^.Number-1) then SetScrollBar;
cmHome :if Base^.LocateZiDuan(0) then SetScrollBar;
cmEnd :if Base^.LocateZiDuan(Base^.ViewZDNumber-1) then SetScrollBar;
cmCtrlHome:if Base^.LocateRecord(0) then SetScrollBar;
cmCtrlEnd :if Base^.LocateRecord(Base^.ViewRecNumber-1) then SetScrollBar;
cmInterHor:if Base^.LocateZiDuan(Round(Event.InfoReal*Base^.ViewZDNumber)) then
SetScrollBar;
cmInterVer:if Base^.LocateRecord(Round(Event.InfoReal*(Base^.ViewRecNumber-Base^.Number))) then
SetScrollBar;
cmShowAll:ShowAll;
cmGotoRecord:GotoRecord;
cmInsert:InsertRecord;
cmDelete:DeleteRecord(1);
cmUnDelete:DeleteRecord(0);
cmCloseDBF:CloseDBF;
cmNew:if OpenFile(Name,'新建数据库','*.DBF') then NewDBF(Name);
cmOpen:if OpenFile(Name,'打开数据库','*.DBF') then OpenDBF(Name);
cmSaveAs:if OpenFile(Name,'数据库另存为','*.DBF') then SaveAsDBF(Name);
cmSave:Base^.SaveFile;
cmModifyStruct:ModifyStruct;
cmShowStru:ShowStruct;
cmPack:PackFile;
cmZap:ZapFile;
cmSelectViewZD:SelectZD;
cmSearch:DoSearch(dbSearch);
cmReplace:DoSearch(dbReplace);
cmSort:DoSort;
cmList:ListWorkArea;
else Exit;
end;
else Exit;
end;
ClearEvent(Event);
end;
Function SetupDBFPara:PWindow;
var
T:TRect;
P:PWindow;
Inp:PDigInput;
Q:PRadioButton;
R:PCheckBox;
begin
AssignRect(T,0,0,340,220);
P:=New(PWindow,Init(T,'设置数据库环境',True));
P^.Insert(New(PStaticText,Init(stNormal,20,40,'缓冲区:',0)));
Inp:=New(PDigInput,Init(80,40,@DefaultBufSize,10,ipBroad+ipDigital,dtLongint));
Inp^.SetRange('缓冲区',10240,102400);
P^.Insert(Inp);
Q:=New(PRadioButton,Init(20,70,160,120,'显示方式:',DBViewMode));
Q^.Insert('分隔字段方式');
Q^.Insert('连续字段方式');
P^.Insert(Q);
Q:=New(PRadioButton,Init(20,130,160,180,'存盘方式:',DBFSaveMode));
Q^.Insert('保存所有记录');
Q^.Insert('保存当前记录');
P^.Insert(Q);
R:=New(PCheckBox,Init(170,40,320,180,'选项:'));
R^.Insert('产生后备文件',CreatDBFBakFile);
R^.Insert('显示真实序号',ShowTrueIndex);
P^.Insert(R);
P^.Insert(New(PButton,Init(120,190,180,210,'确定',0,cmOk)));
P^.Insert(New(PButton,Init(190,190,250,210,'放弃',0,cmCancel)));
P^.Insert(New(PButton,Init(260,190,320,210,'帮助',kbF1,cmHelp)));
P^.Next;
P^.Next;
P^.Center;
SetupDBFPara:=P;
end;
Function SetColorWin:PWindow;
var
P:PSetColorWin;
begin
P:=New(PSetColorWin,Init('设置颜色',10));
P^.InsertColor('文字颜色[间隔模式]',dbViewColor1,scFront+scBack);
P^.InsertColor('文字颜色1[连续模式]',dbViewColor21,scFront+scBack);
P^.InsertColor('文字颜色2[连续模式]',dbViewColor22,scFront+scBack);
P^.InsertColor('光标颜色[间隔模式]',dbCurColor1,scFront+scBack);
P^.InsertColor('光标颜色[连续模式]',dbCurColor2,scFront+scBack);
P^.InsertColor('序号颜色[正常记录]',dbIndexColor11,scFront);
P^.InsertColor('序号颜色[已删除记录]',dbIndexColor12,scFront);
SetColorWin:=P;
end;
end.