返回
{***************************************************************}
{*** FVision Unit Version1.0 ***}
{*** 蓝蚂蚁工作室 ***}
{***************************************************************}
{*** 列表对象单元 ***}
{***************************************************************}
{$F+,O+,X+,S-,D-}
Unit FList;
Interface
Uses
FTool,Graph,FGraph,FMouse,FWrite,FView,FEvent,FControl;
Const
stHScroll = $01;
stVScroll = $02;
stSaveBack = $10;
Const
ListLength = 60;
Type
StrList = string[ListLength];
List_Type = Array[1..1] of StrList;
PLister=^TLister;
TLister=Object(TView)
Rec:TRect;
Style:Byte;
Size_,Pos,Mark:TPoint;
Num,Current:Integer;
HScrollBar,VScrollBar:PScrollBar;
List:^List_Type;
NorCol,HigCol:ColType;
BackImg,IntPtr:Pointer;
BackSize:Word;
HideLister,SetDataFlag,SetIntFlag:Boolean;
Constructor Init(x,y,w,h,N:Integer;Sty:Byte);
Destructor Done;virtual;
Procedure SetData;virtual;
Procedure SetInt(P:Pointer);
Function GetText(Item:Integer):string;virtual;
Function GetCurText:string;
Function GetIndex(St:string):Integer;
Procedure SetIndex(N:Integer);
Procedure Reset;
Procedure Hide;virtual;
Procedure Show;
Procedure Delete;
Procedure Insert(S:string);
Procedure InsertFront(S:string);
Procedure InsertNext(S:string);
Procedure Modify(S:string);
Procedure GotoEnd;
Procedure Prev;
Procedure Next;
Procedure Paint;virtual;
Procedure Draw;virtual;
Procedure MoveTo(x,y:Integer);virtual;
Procedure HandleEvent(var Event:TEvent);virtual;
Procedure Run(var Event:TEvent);virtual;
end;
PWinList=^TWinList;
TWinList=object(TWindow)
Lister:PLister;
Constructor Init(N:Integer);
Procedure InsertStr(St:string);
Procedure HandleEvent(var Event:TEvent);virtual;
end;
PSelectListWin=^TSelectListWin;
TSelectListWin=object(TWindow)
SList,DList:PLister;
SelectList:Pointer;
Constructor Init(Tit:string;N:Integer;P:Pointer);
Procedure InsertSouStr(St:string);
Procedure InsertDesStr(St:string);
Procedure HandleEvent(var Event:TEvent);virtual;
end;
Implementation
Constructor TLister.Init;
var
R:TRect;
i:Integer;
begin
Inherited Init;
for i:=1 to StrLong do
begin
NorCol[i]:=$F0;{9E;}
HigCol[i]:=$1F;{4F;}
end;
Style:=Sty;
Origin.x:=x;
Origin.y:=y;
Size_.x:=w;
Size_.y:=h;
Size.x:=w*8;
Size.y:=h*16;
Pos.x:=0;
Pos.y:=0;
Mark.x:=1;
Mark.y:=1;
Num:=N;
Current:=0;
SetIntFlag:=False;
HScrollBar:=nil;
VScrollBar:=nil;
if (Style and stHScroll)<>0 then
begin
Inc(Size.y,16);
AssignRect(R,Origin.x,Origin.y+Size_.y*16-15,Size_.x*8-1,15);
HScrollBar:=New(PScrollBar,Init(sbHor,R,0));
end;
if (Style and stVScroll)<>0 then
begin
Inc(Size.x,16);
AssignRect(R,Origin.x+Size_.x*8,Origin.y,15,Size_.y*16-1);
VScrollBar:=New(PScrollBar,Init(sbVer,R,0));
end;
AssignRect(Rec,Origin.x,Origin.y,Origin.x+Size.x,Origin.y+Size.y);
List:=Nil;
GetMem(List,SizeOf(List_Type)*Num);
BackImg:=nil;
end;
Destructor TLister.Done;
var
i:Integer;
begin
Hide;
if List<>nil then
FreeMem(List,SizeOf(List_Type)*Num);
if HScrollBar<>nil then
Dispose(HScrollBar,Done);
if VScrollBar<>nil then
Dispose(VScrollBar,Done);
Inherited Done;
end;
Procedure TLister.SetData;
begin
if SetIntFlag then
Integer(IntPtr^):=Pos.y+Mark.y;
end;
Procedure TLister.SetInt;
var
Temp:Integer;
begin
SetIntFlag:=True;
IntPtr:=P;
Temp:=Integer(IntPtr^);
if Temp>Current then
Temp:=Current;
Pos.y:=0;
Mark.y:=Temp;
if Mark.y>Size_.y then
begin
Mark.y:=Size_.y;
Pos.y:=Temp-Mark.y;
end;
end;
Function TLister.GetText;
begin
if (List=nil) or (Item>Current) then
begin
GetText:='';
Exit;
end;
GetText:=List^[Item];
end;
Function TLister.GetCurText;
begin
if (List=nil) or (Current=0) then
GetCurText:=''
else
GetCurText:=List^[Pos.y+Mark.y];
end;
Function TLister.GetIndex;
var
i:Integer;
begin
GetIndex:=-1;
if List=nil then Exit;
for i:=1 to Current do
if List^[i]=St then
begin
GetIndex:=i;
Exit;
end;
end;
Procedure TLister.SetIndex;
begin
Pos.y:=0;
Mark.y:=N;
if Mark.y>Size_.y then
begin
Mark.y:=Size_.y;
Pos.y:=N-Mark.y;
end;
end;
Procedure TLister.Reset;
begin
Pos.x:=0;
Pos.y:=0;
Mark.x:=1;
Mark.y:=1;
Current:=0;
end;
Procedure TLister.Delete;
var
i:Integer;
begin
if (List=nil)or(Current=0) then Exit;
Dec(Current);
if Pos.y+Mark.y>Current then
begin
if Mark.y>1 then
Dec(Mark.y)
else
if Pos.y>0 then
Dec(Pos.y);
end else
begin
for i:=Pos.y+Mark.y to Current do
List^[i]:=List^[i+1];
end;
end;
Procedure TLister.Insert;
begin
if (List=nil) or (Current>=Num) then Exit;
Inc(Current);
List^[Current]:=Copy(S,1,ListLength);
end;
Procedure TLister.GotoEnd;
begin
if List=nil then Exit;
if Current<Size_.y then
Mark.y:=Current+1
else
begin
Mark.y:=Size_.y;
Pos.y:=Current-Size_.y+1;
end;
Message(Owner^.Owner,cmChange,nil);
end;
Procedure TLister.Prev;
begin
if (List=nil)or(Current<=1) then Exit;
if Mark.y>1 then
Dec(Mark.y)
else
if Pos.y>0 then
Dec(Pos.y);
Message(Owner^.Owner,cmChange,nil);
end;
Procedure TLister.Next;
begin
if (List=nil)or(Current<=Pos.y+Mark.y) then Exit;
if Mark.y<Size_.y then
Inc(Mark.y)
else
Inc(Pos.y);
Message(Owner^.Owner,cmChange,nil);
end;
Procedure TLister.InsertFront;
var
i:Integer;
begin
if (List=nil) or (Current>=Num) then Exit;
Inc(Current);
for i:=Current downto Pos.y+Mark.y+1 do
List^[i]:=List^[i-1];
List^[Pos.y+Mark.y]:=Copy(S,1,ListLength);
Next;
end;
Procedure TLister.InsertNext;
var
i:Integer;
begin
if (List=nil) or (Current>=Num) then Exit;
Inc(Current);
for i:=Current downto Pos.y+Mark.y+2 do
List^[i]:=List^[i-1];
if Current=1 then
List^[1]:=S
else
List^[Pos.y+Mark.y+1]:=Copy(S,1,ListLength);
Next;
end;
Procedure TLister.Modify;
begin
if (List=nil) or (Pos.y+Mark.y>Current) then Exit;
List^[Pos.y+Mark.y]:=Copy(S,1,ListLength);
end;
Procedure TLister.Hide;
begin
if (Style and stSaveBack)=0 then Exit;
if BackImg<>nil then
begin
HideMouse;
PutImage(Rec.a.x-2,Rec.a.y-2,BackImg^,CopyPut);
ShowMouse;
FreeMem(BackImg,BackSIze);
BackImg:=nil;
end;
end;
Procedure TLister.Show;
begin
if (Style and stSaveBack)=0 then Exit;
if Rec.a.y<0 then
MoveTo(Rec.a.x,Rec.b.y+20)
else
if Rec.b.y>GetMaxy then
MoveTo(Rec.a.x,Rec.a.y-20-Size.y);
HideMouse;
BackImg:=SaveImage(Rec.a.x-2,Rec.a.y-2,Rec.b.x+2,Rec.b.y+2,BackSize);
Paint;
end;
Procedure TLister.Paint;
begin
if ((Style and stSaveBack)<>0)and(BackImg=nil) then Exit;
HideMouse;
if (Style and stSaveBack)<>0 then
Full(Rec.a.x-2,Rec.a.y-2,Rec.b.x+1,Rec.b.y+1,0)
else
DrawBroadC(Rec.a.x-2,Rec.a.y-2,Rec.b.x+2,Rec.b.y+2,0,9);
if HScrollBar<>nil then
HScrollBar^.Paint;
if VScrollBar<>nil then
VScrollBar^.Paint;
Draw;
end;
Procedure TLister.Draw;
var
i,j:Integer;
S:string;
begin
if List=nil then Exit;
HideMouse;
for i:=1 to Size_.y do
begin
if Pos.y+i<=Current then
S:=List^[Pos.y+i]
else
S:='';
InsSpace(S,ListLength);
if Mark.y<>i then
CWrite16(Origin.x div 8,Origin.y+(i-1)*16,Pos.x+1,Size_.x,S,NorCol)
else
CWrite16(Origin.x div 8,Origin.y+(i-1)*16,Pos.x+1,Size_.x,S,HigCol)
end;
if HScrollBar<>nil then
HScrollBar^.NewPos(Pos.x/(ListLength-Size_.x));
if VScrollBar<>nil then
begin
if Current<>1 then
VScrollBar^.NewPos((Pos.y+Mark.y-1)/(Current-1))
else
VScrollBar^.NewPos(0);
end;
ShowMouse;
end;
Procedure TLister.MoveTo;
begin
Origin.x:=x;
Origin.y:=y;
AssignRect(Rec,Origin.x,Origin.y,Origin.x+Size.x,Origin.y+Size.y);
if HScrollBar<>nil then
HScrollBar^.MoveTo(Origin.x,Origin.y+Size_.y*16);
if VScrollBar<>nil then
VScrollBar^.MoveTo(Origin.x+Size_.x*8,Origin.y);
end;
Procedure TLister.HandleEvent;
var
Temp:Integer;
begin
if ((Style and stSaveBack)<>0)and(BackImg=nil) then Exit;
Inherited HandleEvent(Event);
if HScrollBar<>nil then
HScrollBar^.HandleEvent(Event);
if VScrollBar<>nil then
VScrollBar^.HandleEvent(Event);
case Event.What of
evMouseDown:if IsIn(Event.Where,Rec) and (Event.Buttons=mbLeftButton) then
begin
Temp:=(Event.Where.y-Rec.a.y) div 16;
if (Pos.y+Temp<Current) then
begin
if (Temp=Mark.y-1) then
begin
Event.What:=evCommand;
Event.Command:=cmOk;
Event.InfoPtr:=@Self;
HideLister:=True;
SetDataFlag:=True;
Exit;
end;
Mark.y:=Temp+1;
Draw;
Message(Owner^.Owner,cmChange,nil);
end else Exit;
end else
if ((Style and stSaveBack)<>0) and (BackImg<>nil) and
(not IsIn(Event.Where,Rec)) then
HideLister:=True
else Exit;
evKeyDown:if ((Style and stSaveBack)<>0)and(BackImg<>nil) then
case Event.KeyCode of
kbEsc:HideLister:=True;
kbEnter:begin
HideLister:=True;
SetDataFlag:=True;
end;
else Exit;
end else Exit;
evCommand:case Event.Command of
cmLeft:if Pos.x>0 then
begin
Dec(Pos.x);
Draw;
end;
cmRight:if Pos.x<ListLength-Size_.x then
begin
Inc(Pos.x);
Draw;
end;
cmUp:if Pos.y+Mark.y>1 then begin Prev;Draw; end;
cmDown:if Pos.y+Mark.y<Current then begin Next;Draw; end;
cmInterHor:begin
Temp:=Round(Event.InfoReal*(ListLength-Size_.x));
if Temp<>Pos.x then
begin
Pos.x:=Temp;
Draw;
end;
end;
cmInterVer:begin
Temp:=Round(Event.InfoReal*Current);
if (Temp<Current) and (Temp<>Pos.y+Mark.y-1) then
begin
Mark.y:=Temp-Pos.y+1;
if Mark.y>Size_.y then
begin
Mark.y:=Size_.y;
Pos.y:=Temp-Mark.y+1;
end else
if Mark.y<1 then
begin
Mark.y:=1;
Pos.y:=Temp-Mark.y+1;
end;
Draw;
Message(Owner^.Owner,cmChange,nil);
end;
end;
else Exit;
end;
else Exit;
end;
ClearEvent(Event);
end;
Procedure TLister.Run;
begin
HideLister:=False;
SetDataFlag:=False;
Show;
repeat
ClearEvent(Event);
GetEvent(Event);
HandleEvent(Event);
until HideLister;
Hide;
if SetDataFlag then
begin
Event.What:=evCommand;
Event.Command:=cmOk;
Event.InfoInt:=Pos.y+Mark.y;
end;
end;
{----------------object TFileList----------------}
Constructor TWinList.Init;
var
R:TRect;
begin
AssignRect(R,0,0,350,240);
Inherited Init(R,'Window List',True);
Option:=Option or opAligen8;
Insert(New(PStaticText,Init(stNormal,14,30,'Windows:',0)));
Lister:=New(PLister,Init(16,50,30,10,N,stHScroll+stVScroll));
Insert(Lister);
Insert(New(PButton,Init(280 ,50 ,340,70,'~O~K',kbAltO,cmOk)));
Insert(New(PButton,Init(280 ,80 ,340,100,'Insert',kbIns,cmInsert)));
Insert(New(PButton,Init(280 ,110 ,340,130,'Delete',kbDel,cmDelete)));
Insert(New(PButton,Init(280 ,140,340,160,'Cancel',kbEsc,cmCancel)));
Insert(New(PButton,Init(280 ,170,340,190,'Help',kbF1,cmHelp)));
Next;
Next;
Center;
end;
Procedure TWinList.InsertStr;
begin
Lister^.Insert(St);
end;
Procedure TWinList.HandleEvent;
begin
Inherited HandleEvent(Event);
case Event.What of
evCommand:case Event.Command of
cmOk,cmInsert,cmDelete:
begin
if Lister^.Current>0 then
Event.InfoInt:=Lister^.Pos.y+Lister^.Mark.y;
Exit;
end;
else Exit;
end;
else Exit;
end;
ClearEvent(Event);
end;
Constructor TSelectListWin.Init;
var
R:TRect;
begin
AssignRect(R,0,0,460,240);
Inherited Init(R,Tit,True);
Option:=Option or opAligen8;
SelectList:=P;
Insert(New(PStaticText,Init(stNormal,14,30,'源列表:',0)));
SList:=New(PLister,Init(16,50,20,10,N,stHScroll+stVScroll));
Insert(SList);
Insert(New(PStaticText,Init(stNormal,262,30,'目的列表:',0)));
DList:=New(PLister,Init(264,50,20,10,N,stHScroll+stVScroll));
Insert(DList);
Insert(New(PButton,Init(205 ,50 ,250,70,'',kbAltR,cmEditRight)));
Insert(New(PButton,Init(205 ,75 ,250,95,'',kbAltL,cmEditLeft)));
Insert(New(PButton,Init(205 ,100,250,120,'全选',kbAltS,cmSelect)));
Insert(New(PButton,Init(205 ,125,250,145,'全清',kbAltC,cmClear)));
Insert(New(PButton,Init(205 ,160,250,180,'确定',kbAltO,cmOK)));
Insert(New(PButton,Init(205 ,185,250,205,'放弃',kbEsc,cmCancel)));
Insert(New(PButton,Init(205 ,210,250,230,'帮助',kbF1,cmHelp)));
Next;
Next;
Center;
end;
Procedure TSelectListWin.InsertSouStr;
begin
SList^.Insert(St);
end;
Procedure TSelectListWin.InsertDesStr;
begin
DList^.Insert(St);
end;
Procedure TSelectListWin.HandleEvent;
var
i:Integer;
begin
Inherited HandleEvent(Event);
case Event.What of
evCommand:case Event.Command of
cmEditRight:begin
DList^.InsertNext(SList^.GetCurText);
SList^.Next;
SList^.Draw;
DList^.Draw;
end;
cmEditLeft :begin
DList^.Delete;
DList^.Draw;
end;
cmSelect:begin
DList^.Reset;
for i:=1 to SList^.Current do
DList^.Insert(SList^.GetText(i));
DList^.Draw;
end;
cmClear:begin
DList^.Reset;
DList^.Draw;
end;
cmOk:if (Event.InfoPtr<>SList)and(Event.InfoPtr<>DList) then
begin
Event.InfoInt:=DList^.Current;
for i:=0 to DList^.Current-1 do
ArrIntType(SelectList^)[i]:=SList^.GetIndex(DList^.GetText(i+1));
Exit;
end;
else Exit;
end;
else Exit;
end;
ClearEvent(Event);
end;
end.