返回
{***************************************************************}
{*** FVision Unit Version1.0 ***}
{*** 蓝蚂蚁工作室 ***}
{***************************************************************}
{*** 附加对象单元 ***}
{***************************************************************}
{$F+,O+,X+,S-,D-}
Unit FExtDrv;
Interface
Uses
Dos,Graph,FTool,FMouse,FView,FEvent,FGraph,FWrite,
FControl,FDialog,FList;
Const
SMG_MIN = $00;
SMG_SMALL = $01;
SMG_MIDDLE = $02;
SMG_LARGE = $03;
SMG_MAX = $04;
SMG_BROAD = $10;
SMG_DOT = $20;
pbBroad = $0001;
pbSaveBack = $0002;
MaxColorItem = 40;
scFront = $01;
scBack = $02;
Type
PRealTimer=^TRealTimer;
TRealTimer=Object(TView)
Color:Byte;
OldH,OldM,OldS,OldSe:Word;
NowH,NowM,NowS,NowSe:Word;
constructor Init(X,Y:Integer;C:Byte);
procedure UpDate;virtual;
procedure DecTime;
procedure Paint;virtual;
end;
PSmg=^TSmg;
TSmg=object(TView)
R:TRect;
Style:Byte;
Mid,Rad:Integer;
Xing:Byte;
constructor Init(X,Y:Integer;Xi:Byte;W,H:Integer;Si:Byte);
procedure SetXing(Xi:Byte);
procedure MoveTo(X,Y:Integer);virtual;
procedure Paint;virtual;
end;
PMulSmg=^TMulSmg;
TMulSmg=object(TView)
R:TRect;
Style:Byte;
Wid,Hig,Jg,TotNum,BkColor:Integer;
Smg:array[0..7] of TSmg;
Xi:array[0..7] of Byte;
Number:Longint;
constructor Init(X,Y,N:Integer;Num:LongInt;Si,Col:Byte);
procedure MoveTo(X,Y:Integer);virtual;
procedure Paint;virtual;
procedure Draw;virtual;
procedure Modify(Num:LongInt);
end;
PTrackBar=^TTrackBar;
TTrackBar=object(TView)
PosL,PosR:Integer;
Dlt:Integer;
constructor Init(R:TRect;D:Integer);
procedure Paint;virtual;
procedure Draw;virtual;
end;
PProgressBar=^TProgressBar;
TProgressBar=object(TView)
Style:Word;
Img:Pointer;
ImgSize:Word;
Loc:Integer;
Constructor Init(X,Y,Wid,Hig:Integer;Sty:Word);
Procedure Paint;virtual;
Procedure Draw;virtual;
Procedure Hide;virtual;
Procedure Modify(L:Real);
end;
PInstallWin=^TInstallWin;
TInstallWin=object(TWindow)
Total,Finish:Integer;
ShowStr,DStr:PStaticText;
LRec:TRect;
constructor Init(T,S:string;F:Real);
procedure Paint;virtual;
procedure Draw;virtual;
procedure DrawBlock(i:Integer);
procedure MoveTo(X,Y:Integer);virtual;
procedure SetBlock(R:Real);
procedure Reset;
end;
PSetFileWin=^TSetFileWin;
TSetFileWin=object(TWindow)
Inp:PInput;
constructor Init(Tit:string;var Str:string);
procedure HandleEvent(var Event:TEvent);virtual;
end;
PInputWin=^TInputWin;
TInputWin=object(TWindow)
constructor Init(Tit,T:string;var Str:string);
end;
PPassWordWin=^TPassWordWin;
TPassWordWin=object(TWindow)
Inp1,Inp2:PInput;
constructor Init(Tit:string;var Name,Pass:string);
procedure HandleEvent(var Event:TEvent);virtual;
end;
PSelectColor=^TSelectColor;
TSelectColor=object(TView)
SampleText:PStaticText;
ColorPtr:Pointer;
Wid,Hig:Integer;
Mode:Byte;
Constructor Init(R:TRect;M:Byte);
Procedure Paint;virtual;
Procedure HideView;virtual;
Procedure DrawMark;
Procedure SetSampleText(Str:PStaticText);
Procedure SetColorPtr(var P:Byte);
Function GetColor:Byte;
Procedure SetColor(Col:Byte);
Procedure HandleEvent(var Event:TEvent);virtual;
end;
PSetColorWin=^TSetColorWin;
TSetColorWin=object(TWindow)
List:PLister;
Str:PStaticText;
ColSel,BColSel:PSelectColor;
Color:array[1..MaxColorItem] of Byte;
ColorPtr:array[1..MaxColorItem] of Pointer;
ColorStyle:array[1..MaxColorItem] of Byte;
ColorIndex:Integer;
Constructor Init(Tit:string;N:Integer);
Procedure InsertColor(St:string;var C:Byte;Op:Byte);
Procedure HandleEvent(var Event:TEvent);virtual;
Procedure SetData;virtual;
end;
PDacSelect=^TDacSelect;
TDacSelect=object(TView)
Wid,Hig:Integer;
CurPos:Integer;
Constructor Init(R:TRect);
Procedure SetBroad(R:TRect);virtual;
Procedure Paint;virtual;
Procedure DrawMark(Mode:Integer);
Procedure SetCurrent(Pos:Integer);
Procedure HandleEvent(var Event:TEvent);virtual;
end;
PDiagramWin=^TDiagramWin;
TDiagramWin=object(TWindow)
ArrPtr:Pointer;
ArrNum:Integer;
IndexStr,NumStr:PStaticText;
Constructor Init(Tit:string;var Arr;Num:Integer);
Procedure Paint;virtual;
Procedure HandleEvent(var Event:TEvent);virtual;
end;
Implementation
const
Zm:array[0..9] of Byte=($40,$79,$24,$30,$19,$12,$02,$78,$00,$18);
DecNum:array[1..8] of LongInt=(0,10,100,1000,10000,100000,1000000,10000000);
constructor TRealTimer.Init;
begin
Inherited Init;
Option:=opCantSelect;
GrowMode:=gfGrowLoX+gfGrowHiX;
Origin.X:=X;
Origin.Y:=Y;
Color:=C;
GetTime(OldH,OldM,OldS,OldSe);
Dec(OldH);
Dec(OldM);
Dec(OldS);
end;
procedure TRealTimer.UpDate;
begin
GetTime(NowH,NowM,NowS,NowSe);
if (NowH<>OldH) then
begin
Full(Origin.x,Origin.y,Origin.x+23,Origin.y+15,Color shr 4);
WritecMap(Origin.x,Origin.y,Int_Str(NowH,2)+':',0,15);
OldH:=NowH;
end;
if (NowM<>OldM) then
begin
Full(Origin.x+24,Origin.y,Origin.x+47,Origin.y+15,Color shr 4);
WritecMap(Origin.x+24,Origin.y,Int_Str(NowM,2)+':',0,15);
OldM:=NowM;
end;
if (NowS<>OldS) then
begin
Full(Origin.x+48,Origin.y,Origin.x+63,Origin.y+15,Color shr 4);
WritecMap(Origin.x+48,Origin.y,Int_Str(NowS,2),0,15);
OldS:=NowS;
end;
end;
procedure TRealTimer.DecTime;
begin
Dec(OldH);
Dec(OldM);
Dec(OldS);
end;
procedure TRealTimer.Paint;
begin
UpDate;
end;
constructor TSmg.Init;
begin
Inherited Init;
Option:=Option or opCantSelect;
Size.x:=W;
Size.y:=H;
MoveTo(X,Y);
Xing:=Xi;
Style:=Si;
Rad:=3;
end;
procedure TSmg.SetXing;
begin
Xing:=Xi;
end;
procedure TSmg.MoveTo;
begin
Origin.x:=X;
Origin.y:=Y;
AssignRect(R,X,Y,X+Size.x,Y+Size.y);
Mid:=Y+Size.y div 2;
end;
procedure TSmg.Paint;
procedure DrawOne(Duan:Byte;Col:Byte);
begin
SetColor(Col);
case Duan of
$01:begin line(r.a.x+3,r.a.y+2,r.b.x-3,r.a.y+2);
line(r.a.x+4,r.a.y+1,r.b.x-4,r.a.y+1);
line(r.a.x+5,r.a.y,r.b.x-5,r.a.y);
line(r.a.x+4,r.a.y+3,r.b.x-4,r.a.y+3);
line(r.a.x+5,r.a.y+4,r.b.x-5,r.a.y+4);
end;
$02:begin line(r.b.x-2,r.a.y+3,r.b.x-2,mid-1);
line(r.b.x-1,r.a.y+4,r.b.x-1,mid-2);
line(r.b.x,r.a.y+5,r.b.x,mid-3);
line(r.b.x-3,r.a.y+4,r.b.x-3,mid-2);
line(r.b.x-4,r.a.y+5,r.b.x-4,mid-3);
end;
$04:begin line(r.b.x-2,mid+1,r.b.x-2,r.b.y-3);
line(r.b.x-1,mid+2,r.b.x-1,r.b.y-4);
line(r.b.x,mid+3,r.b.x,r.b.y-5);
line(r.b.x-3,mid+2,r.b.x-3,r.b.y-4);
line(r.b.x-4,mid+3,r.b.x-4,r.b.y-5);
end;
$08:begin line(r.a.x+3,r.b.y-2,r.b.x-3,r.b.y-2);
line(r.a.x+4,r.b.y-1,r.b.x-4,r.b.y-1);
line(r.a.x+5,r.b.y,r.b.x-5,r.b.y);
line(r.a.x+4,r.b.y-3,r.b.x-4,r.b.y-3);
line(r.a.x+5,r.b.y-4,r.b.x-5,r.b.y-4);
end;
$10:begin line(r.a.x+2,mid+1,r.a.x+2,r.b.y-3);
line(r.a.x+1,mid+2,r.a.x+1,r.b.y-4);
line(r.a.x,mid+3,r.a.x,r.b.y-5);
line(r.a.x+3,mid+2,r.a.x+3,r.b.y-4);
line(r.a.x+4,mid+3,r.a.x+4,r.b.y-5);
end;
$20:begin line(r.a.x+2,r.a.y+3,r.a.x+2,mid-1);
line(r.a.x+1,r.a.y+4,r.a.x+1,mid-2);
line(r.a.x,r.a.y+5,r.a.x,mid-3);
line(r.a.x+3,r.a.y+4,r.a.x+3,mid-2);
line(r.a.x+4,r.a.y+5,r.a.x+4,mid-3);
end;
$40:begin line(r.a.x+3,mid,r.b.x-3,mid);
line(r.a.x+4,mid-1,r.b.x-4,mid-1);
line(r.a.x+5,mid-2,r.b.x-5,mid-2);
line(r.a.x+4,mid+1,r.b.x-4,mid+1);
line(r.a.x+5,mid+2,r.b.x-5,mid+2);
end;
$80:if (Style and SMG_DOT)<>0 then
begin
SetFillStyle(1,Col);
FillEllipse(r.b.x+rad+2,r.b.y-rad-2,rad,rad);
end;
end;
end;
var
i:Integer;
begin
SetLineStyle(0,0,1);
PutPixel(0,0,0);
for i:=0 to 7 do
if (Xing and (1 shl i))=0 then
DrawOne(1 shl i,4)
else
DrawOne(1 shl i,8);
end;
constructor TMulSmg.Init;
var i:Integer;
begin
Inherited Init;
Option:=Option or opCantSelect;
Style:=Si;
case Style and $0F of
0:begin Wid:=16;Hig:=20;Jg:=3; end;
1:begin Wid:=18;Hig:=30;Jg:=3; end;
2:begin Wid:=20;Hig:=35;Jg:=3; end;
3:begin Wid:=30;Hig:=54;Jg:=3; end;
4:begin Wid:=40;Hig:=60;Jg:=3; end;
end;
if (Style and SMG_DOT)<>0 then Inc(Jg,7);
TotNum:=N;
Number:=Num;
BkColor:=Col;
for i:=0 to TotNum-2 do
Xi[i]:=(Num div DecNum[TotNum-i]) mod 10;
Xi[TotNum-1]:=Num mod 10;
for i:=0 to TotNum-1 do
Smg[i].Init(0,0,Zm[Xi[i]],Wid,Hig,Style);
MoveTo(X,Y);
end;
procedure TMulSmg.MoveTo;
var
i:Integer;
begin
Origin.X:=X;
Origin.Y:=Y;
AssignRect(R,X,Y,X+(Wid+Jg)*TotNum,Y+Hig);
for i:=0 to TotNum-1 do
Smg[i].MoveTo(X+i*(Wid+Jg),Y);
end;
procedure TMulSmg.Paint;
begin
if (Style and SMG_BROAD)<>0 then
begin
HideMouse;
DrawBroadc(R.a.x-3,R.a.y-3,R.b.x,R.b.y+3,0,BkColor);
end;
Draw;
end;
procedure TMulSmg.Draw;
var
i:Integer;
begin
HideMouse;
for i:=0 to TotNum-1 do Smg[i].Paint;
ShowMouse;
end;
procedure TMulSmg.Modify;
var
i:Integer;
begin
if Num=Number then Exit;
Number:=Num;
if Number<0 then Number:=0;
for i:=0 to TotNum-2 do
Xi[i]:=(Number div DecNum[TotNum-i]) mod 10;
Xi[TotNum-1]:=Number mod 10;
for i:=0 to TotNum-1 do
Smg[i].SetXing(Zm[Xi[i]]);
Draw;
end;
Constructor TTrackBar.Init;
begin
Inherited Init;
Size.X:=R.B.X-R.A.X;
Size.Y:=R.B.Y-R.A.Y;
MoveTo(R.A.X,R.A.Y);
Dlt:=D;
end;
Procedure TTrackBar.Paint;
begin
HideMouse;
DrawBroad(Broad.A.X,Broad.A.Y,Broad.B.X,Broad.B.Y,0);
Draw;
end;
Procedure TTrackBar.Draw;
begin
HideMouse;
ShowMouse;
end;
Constructor TProgressBar.Init;
begin
Inherited Init;
Style:=Sty;
Size.X:=Wid;
Size.Y:=Hig;
MoveTo(X,Y);
Loc:=0;
Img:=nil;
end;
Procedure TProgressBar.Paint;
begin
HideMouse;
if (Style and pbSaveBack)<>0 then
Img:=SaveImage(Broad.A.X,Broad.A.y,Broad.B.X,Broad.B.Y,ImgSize);
if (Style and pbBroad)<>0 then
SignBroadc(Broad.A.X,Broad.A.Y,Broad.B.X,Broad.B.Y,0,$0A);
Draw;
end;
Procedure TProgressBar.Draw;
var
Temp:Integer;
begin
HideMouse;
Temp:=Loc*(Size.X-2) div 100;
Full(Broad.A.X+1,Broad.A.Y+1,Broad.A.X+1+Temp,Broad.B.Y-1,4);
ShowMouse;
end;
Procedure TProgressBar.Hide;
begin
if Img=nil then Exit;
HideMouse;
PutImage(Origin.X,Origin.Y,Img^,CopyPut);
FreeMem(Img,ImgSize);
ShowMouse;
end;
Procedure TProgressBar.Modify;
begin
if (L>1)or(Trunc(L*100)=Loc) then Exit;
Loc:=Trunc(L*100);
Draw;
end;
constructor TInstallWin.Init;
begin
AssignRect(LRec,0,0,320,120);
Inherited Init(LRec,T,True);
Total:=25;
Finish:=Round(F*Total);
ShowStr:=New(PStaticText,Init(stNormal,20,30,S,0));
Insert(ShowStr);
DStr:=New(PStaticText,Init(stNormal,280,60,IntStr(Round(F*100))+'%',0));
Insert(DStr);
AssignRect(LRec,20,55,20+10*Total,75);
Insert(New(PButton,Init(120,90,180,110,'中止',0,cmCancel)));
Center;
end;
procedure TInstallWin.Paint;
begin
TWindow.Paint;
HideMouse;
DrawBroad(LRec.a.x-3,LRec.a.y-3,LRec.b.x+3,LRec.b.y+3,0);
Draw;
ShowMouse;
end;
procedure TInstallWin.Reset;
begin
Finish:=0;
HideMouse;
DrawBroad(LRec.a.x-3,LRec.a.y-3,LRec.b.x+3,LRec.b.y+3,0);
DStr^.Modify('0%');
end;
procedure TInstallWin.DrawBlock(i:Integer);
begin
HideMouse;
Full(LRec.a.x+(i-1)*10,LRec.a.y,LRec.a.x+(i-1)*10+8,LRec.b.y,1);
ShowMouse;
end;
procedure TInstallWin.Draw;
var
i:Integer;
begin
for i:=1 to Finish do DrawBlock(i);
end;
procedure TInstallWin.MoveTo;
begin
TWindow.MoveTo(X,Y);
AssignRect(LRec,X+20,Y+55,X+20+10*Total,Y+75);
end;
procedure TInstallWin.SetBlock;
var
Temp,i:Integer;
begin
if R>1 then R:=1;
Temp:=Round(R*Total);
if Temp>Finish then
begin
for i:=Finish+1 to Temp do
DrawBlock(i);
DStr^.Modify(IntStr(Round(R*100))+'%');
Finish:=Temp;
end else
if (1-R)<0.01 then
DStr^.Modify(IntStr(Round(R*100))+'%');
end;
{-------------TSetPathWin-------------------}
constructor TSetFileWin.Init;
var
R:TRect;
begin
AssignRect(R, 0, 0, 340, 130);
TWindow.Init(R,Tit,True);
Insert(New(PStaticText,Init(stNormal,20,35,'File Name:',4)));
Inp:=New(PInput,Init(20,55,Str,38,ipBroad));
Insert(Inp);
Insert(New(PButton,Init(20, 90,80, 110,'确定',0,cmOk)));
Insert(New(PButton,Init(100,90,160,110,'放弃',0,cmCancel)));
Insert(New(PButton,Init(180,90,240,110,'帮助',kbF1,cmHelp)));
Insert(New(PButton,Init(260,90,320,110,'浏览',kbAltS,cmOpenFile)));
Next;
Next;
Center;
end;
procedure TSetFileWin.HandleEvent;
var
FName:PathStr;
begin
Inherited HandleEvent(Event);
case Event.What of
evCommand:case Event.Command of
cmOpenFile:if OpenFile(FName,'Search File','*.*') then
begin
Inp^.SetStr(FName);
Group^.GetThis^.Active;
Group^.Select(Inp);
Group^.GetThis^.Active;
end;
else Exit;
end;
else Exit;
end;
ClearEvent(Event);
end;
{---------TInputWin--------------------}
constructor TInputWin.Init;
var
R:TRect;
begin
AssignRect(R, 0, 0, 260, 100);
Inherited Init(R,Tit,True);
Insert(New(PStaticText,Init(stNormal,20,40,T,4)));
Insert(New(PInput,Init(30+Length(T)*8,40,Str,25-Length(T),ipBroad)));
Insert(New(PButton,Init(20, 70,80, 90,'确定',0,cmOk)));
Insert(New(PButton,Init(100,70,160,90,'放弃',0,cmCancel)));
Insert(New(PButton,Init(180,70,240,90,'帮助',kbF1,cmHelp)));
Next;
Next;
Center;
end;
{-------------TPassWordWin-------------------}
constructor TPassWordWin.Init;
var
R:TRect;
begin
AssignRect(R, 0, 0, 250, 130);
Inherited Init(R,Tit,True);
Insert(New(PStaticText,Init(stNormal,20,40,'用户名:',0)));
Inp1:=New(PInput,Init(80,40,Name,18,ipBroad));
Insert(Inp1);
Insert(New(PStaticText,Init(stNormal,20,70,' 口令:',0)));
Inp2:=New(PInput,Init(80,70,Pass,18,ipBroad+ipPassWord));
Insert(Inp2);
Insert(New(PButton,Init( 80, 100, 140, 120,'确定',0,cmOk)));
Insert(New(PButton,Init(160, 100, 220, 120,'放弃',0,cmCancel)));
Next;
Next;
Center;
end;
procedure TPassWordWin.HandleEvent;
begin
Inherited HandleEvent(Event);
case Event.What of
evCommand:case Event.Command of
cmOk:if Event.InfoPtr=Inp1 then
begin
if Length(string(Inp1^.GetStr^))>0 then
begin
Group^.GetThis^.Active;
Group^.Select(Inp2);
Group^.GetThis^.Active;
end;
end else
if Length(string(Inp1^.GetStr^))=0 then
begin
Group^.GetThis^.Active;
Group^.Select(Inp1);
Group^.GetThis^.Active;
end else
if Length(string(Inp2^.GetStr^))=0 then
begin
Group^.GetThis^.Active;
Group^.Select(Inp2);
Group^.GetThis^.Active;
end else Exit;
else Exit;
end;
else Exit;
end;
ClearEvent(Event);
end;
Constructor TSelectColor.Init;
begin
Inherited Init;
Size.x:=R.b.x-R.a.x;
Size.y:=R.b.y-R.a.y;
MoveTo(R.a.x,R.a.y);
ColorPtr:=nil;
Wid:=Size.x div 8;
Hig:=Size.y div 2;
Mode:=M;
end;
Procedure TSelectColor.Paint;
var
i,j:Integer;
begin
if not IsShow then Exit;
Inherited Paint;
HideMouse;
for i:=0 to 1 do
for j:=0 to 7 do
SignBroadc(Origin.x+j*Wid,Origin.y+i*Hig,
Origin.x+j*Wid+Wid-1,Origin.y+i*Hig+Hig-1,0,i*8+j);
ShowMouse;
DrawMark;
end;
Procedure TSelectColor.HideView;
begin
Inherited HideView;
HideMouse;
Full(Broad.a.x,Broad.a.y,Broad.b.x,Broad.b.y,7);
ShowMouse;
end;
Procedure TSelectColor.DrawMark;
var
i,Col:Byte;
begin
if ColorPtr=nil then Exit;
Col:=GetColor;
PutPixel(0,0,0);
HideMouse;
SetWriteMode(1);
Graph.SetColor(2);
for i:=Hig div 2-2 to Hig div 2+2 do
Line(Origin.x+(Col mod 8)*Wid+Wid div 2-2,Origin.y+(Col div 8)*Hig+i,
Origin.x+(Col mod 8)*Wid+Wid div 2+2,Origin.y+(Col div 8)*Hig+i);
SetWriteMode(0);
ShowMouse;
SampleText^.ModifyColor(Byte(ColorPtr^));
end;
Procedure TSelectColor.SetSampleText;
begin
SampleText:=Str;
end;
Procedure TSelectColor.SetColorPtr;
begin
ColorPtr:=@P;
end;
Function TSelectColor.GetColor;
begin
if Mode=0 then
GetColor:=Byte(ColorPtr^) and $0F
else
GetColor:=Byte(ColorPtr^) shr 4;
end;
Procedure TSelectColor.SetColor;
begin
if Mode=0 then
Byte(ColorPtr^):=(Byte(ColorPtr^) and $F0) or (Col and $0F)
else
Byte(ColorPtr^):=(Byte(ColorPtr^) and $0F) or (Col shl 4);
end;
Procedure TSelectColor.HandleEvent;
var
Temp:Integer;
begin
if not IsShow then Exit;
case Event.What of
evKeyDown:case Event.KeyCode of
kbLeft:begin
DrawMark;
SetColor((GetColor-1) mod 16);
DrawMark;
end;
kbRight:begin
DrawMark;
SetColor((GetColor+1) mod 16);
DrawMark;
end;
else Exit;
end;
evMouseDown:if IsIn(Event.Where,Broad) and (Event.Buttons=mbLeftButton) then
begin
Temp:=((Event.Where.y-Origin.y) div Hig) *8 +
((Event.Where.x-Origin.x) div Wid);
if Temp<>GetColor then
begin
DrawMark;
SetColor(Temp);
DrawMark;
end;
end
else Exit;
else Exit;
end;
ClearEvent(Event);
end;
Constructor TSetColorWin.Init;
var
R:TRect;
begin
AssignRect(R,0,0,400,240);
Inherited Init(R,Tit,True);
Option:=Option or opAligen8;
Insert(New(PStaticText,Init(stNormal,14,30,'颜色列表:',0)));
if N>MaxColorItem then N:=MaxColorItem;
List:=New(PLister,Init(16,50,20,10,N,stHScroll+stVScroll));
Insert(List);
AssignRect(R,210,40,380,75);
Insert(New(PShape,Init(gcTBroad+gcHideMouse,R,0,0,0,0,'示例:')));
AssignRect(R,210,90,380,140);
Insert(New(PShape,Init(gcTBroad+gcHideMouse,R,0,0,0,0,'前景色:')));
AssignRect(R,210,150,380,200);
Insert(New(PShape,Init(gcTBroad+gcHideMouse,R,0,0,0,0,'背景色:')));
Str:=New(PStaticText,Init(stNormal+stFColor,230,52,'『蓝蚂蚁工作室』',$F0));
Insert(Str);
AssignRect(R,220,100,370,135);
ColSel:=New(PSelectColor,Init(R,0));
Insert(ColSel);
AssignRect(R,220,160,370,195);
BColSel:=New(PSelectColor,Init(R,1));
Insert(BColSel);
ColSel^.SetSampleText(Str);
BColSel^.SetSampleText(Str);
ColorIndex:=1;
ColSel^.SetColorPtr(Color[ColorIndex]);
BColSel^.SetColorPtr(Color[ColorIndex]);
Insert(New(PButton,Init(210 ,210,260,230,'确定',kbAltO,cmOK)));
Insert(New(PButton,Init(270 ,210,320,230,'放弃',kbEsc,cmCancel)));
Insert(New(PButton,Init(330 ,210,380,230,'帮助',kbF1,cmHelp)));
Next;
Next;
Center;
end;
Procedure TSetColorWin.InsertColor;
begin
List^.Insert(St);
ColorPtr[List^.Current]:=@C;
Color[List^.Current]:=C;
ColorStyle[List^.Current]:=Op;
end;
Procedure TSetColorWin.HandleEvent;
begin
Inherited HandleEvent(Event);
case Event.What of
evCommand:case Event.Command of
cmChange:begin
ColorIndex:=List^.Pos.y+List^.Mark.y;
if (ColorStyle[ColorIndex] and scFront)<>0 then
begin
ColSel^.DrawMark;
ColSel^.SetColorPtr(Color[ColorIndex]);
ColSel^.DrawMark;
if not ColSel^.IsShow then
begin
ColSel^.ShowView;
ColSel^.Paint;
end;
end else
ColSel^.HideView;
if (ColorStyle[ColorIndex] and scBack)<>0 then
begin
BColSel^.DrawMark;
BColSel^.SetColorPtr(Color[ColorIndex]);
BColSel^.DrawMark;
if not BColSel^.IsShow then
begin
BColSel^.ShowView;
BColSel^.Paint;
end;
end else
BColSel^.HideView;
end;
cmOk:if Event.InfoPtr<>List then Exit;
else Exit;
end;
else Exit;
end;
ClearEvent(Event);
end;
Procedure TSetColorWin.SetData;
var
i:Integer;
begin
Inherited SetData;
for i:=1 to List^.Current do
Byte(ColorPtr[i]^):=Color[i];
end;
Constructor TDacSelect.Init;
begin
Inherited Init;
SetBroad(R);
CurPos:=0;
end;
Procedure TDacSelect.SetBroad;
begin
Wid:=(R.b.x-R.a.x) div 16;
Hig:=(R.b.y-R.a.y) div 16;
Size.x:=Wid*16;
Size.y:=Hig*16;
MoveTo(R.a.x,R.a.y);
end;
Procedure TDacSelect.Paint;
var
i,j:Integer;
begin
HideMouse;
for i:=0 to 15 do
for j:=0 to 15 do
SignBroadc(Origin.x+j*Wid,Origin.y+i*Hig,
Origin.x+j*Wid+Wid-1,Origin.y+i*Hig+Hig-1,0,i*16+j);
DrawMark(1);
end;
Procedure TDacSelect.DrawMark;
begin
HideMouse;
SignBroadc(Origin.x+(CurPos mod 16)*Wid,Origin.y+(CurPos div 16)*Hig,
Origin.x+(CurPos mod 16)*Wid+Wid-1,
Origin.y+(CurPos div 16)*Hig+Hig-1,Mode,CurPos);
ShowMouse;
end;
Procedure TDacSelect.SetCurrent;
begin
if Pos=CurPos then Exit;
DrawMark(0);
CurPos:=Pos;
DrawMark(1);
end;
Procedure TDacSelect.HandleEvent;
var
Temp:Integer;
begin
Inherited HandleEvent(Event);
case Event.What of
evMouseDown:if IsIn(Event.Where,Broad) then
begin
Temp:=((Event.Where.y-Broad.a.y) div Hig)*16+
(Event.Where.x-Broad.a.x) div Wid;
if Temp<>CurPos then
begin
DrawMark(0);
CurPos:=Temp;
DrawMark(1);
Event.What:=evCommand;
Event.Command:=cmChange;
Event.InfoPtr:=@Self;
end;
end;
end;
end;
Constructor TDiagramWin.Init;
var
R:TRect;
begin
AssignRect(R,0,0,320,230);
Inherited Init(R,Tit,True);
ArrPtr:=@Arr;
ArrNum:=Abs(Num);
if ArrNum>256 then ArrNum:=256;
AssignRect(R,20,35,300,190);
Insert(New(PShape,Init(gcBroad+gcHideMouse,R,0,0,7,0,'')));
AssignRect(R,20,200,185,220);
Insert(New(PShape,Init(gcBroad+gcHideMouse,R,0,0,$0A,0,'')));
Insert(New(PStaticText,Init(stNormal,22,202,'序号: 值:',$A0)));
IndexStr:=New(PStaticText,Init(stNormal+stFColor,62,202,'',$A4));
NumStr:=New(PStaticText,Init(stNormal+stFColor,120,202,'',$A4));
Insert(IndexStr);
Insert(NumStr);
Insert(New(PButton,Init(195,200,245,220,'确定',0,cmOk)));
Insert(New(PButton,Init(250,200,300,220,'帮助',kbF1,cmHelp)));
Next;
Center;
end;
Procedure TDiagramWin.Paint;
var
i,Len:Integer;
begin
Inherited Paint;
HideMouse;
PutPixel(0,0,0);
SetColor(4);
Line(Origin.x+30,Origin.y+181,Origin.x+290,Origin.y+181);
Line(Origin.x+29,Origin.y+45,Origin.x+29,Origin.y+181);
SetColor(1);
for i:=0 to ArrNum-1 do
begin
Len:=ArrIntType(ArrPtr^)[i];
if Len<0 then Len:=0;
if Len>150 then Len:=150;
Line(Origin.x+30+i,Origin.y+180,Origin.x+30+i,Origin.y+180-Len);
end;
ShowMouse;
end;
Procedure TDiagramWin.HandleEvent;
begin
Inherited HandleEvent(Event);
case Event.What of
evMouseMove:if PosIn(Event.Where.x,Event.Where.y,Origin.x+30,
Origin.y+35,Origin.x+30+ArrNum-1,Origin.y+190) then
begin
IndexStr^.Modify(IntStr(Event.Where.x-Origin.x-30));
NumStr^.Modify(IntStr(ArrIntType(ArrPtr^)[Event.Where.x-Origin.x-30]));
end else Exit;
else Exit;
end;
ClearEvent(Event);
end;
end.