liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

界面库 

整理代码
This commit is contained in:
JianjunLiu 2022-10-12 17:08:17 +08:00
parent 444603eb38
commit b4a34c10eb
3 changed files with 248 additions and 273 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
designer/utslcodeeditor.tsf
View File

@ -4,7 +4,8 @@ unit UtslCodeEditor;
20220520 分离调试器代码 20220520 分离调试器代码
} }
interface interface
uses utslvcldesignerresource,cstructurelib,utslvclauxiliary,utslvclmemstruct,utslvclgdi,tslvcl,UTslmemo,UTslSynMemo,utslvclsyntaxparser,utslvcldebuger; uses utslvcldesignerresource,cstructurelib,utslvclauxiliary,utslvclmemstruct,utslvclgdi,
tslvcl,UTslmemo,UTslSynMemo,utslvclsyntaxparser,utslvcldebuger;
{ {
1. page标签 1. page标签
TPagees; TPageItem TPagees; TPageItem
@ -16,7 +17,7 @@ TPagees; TPageItem
} }
function gettslexe(); function gettslexe();
type TPageItem=class //±êÇ©Ïî type TPageItem=class() //标签项
function Create(AOwner); function Create(AOwner);
begin begin
FCaption := ""; FCaption := "";
@ -29,11 +30,11 @@ type TPageItem=class //
Tag := nil; Tag := nil;
end end
published published
property Caption read FCaption write SetCaption; property Caption read FCaption write SetCaption; //标题
property BitmapA read FBitmapA write SetBitmapA; property BitmapA read FBitmapA write SetBitmapA; //前面的图标
property BitmapB read FBitmapB write SetBitmapB; property BitmapB read FBitmapB write SetBitmapB; //后面的关闭图标
tag; tag; //绑定变量
Rect; Rect; //区域
protected protected
function SetCaption(s); function SetCaption(s);
begin begin
@ -105,7 +106,7 @@ type TPage=class(TCustomControl) //
begin begin
return new TPageItem(self); return new TPageItem(self);
end end
function itemcaptionchenged(it); function itemcaptionchenged(it); //标签等改变
begin begin
if GetItemIndex(it)>= 0 then if GetItemIndex(it)>= 0 then
begin begin
@ -113,15 +114,15 @@ type TPage=class(TCustomControl) //
InValidateRect(nil,false); InValidateRect(nil,false);
end end
end end
function ItemBitmapAChenged(it); function ItemBitmapAChenged(it); //保存改变
begin begin
if GetItemIndex(it)>= 0 then InValidateRect(it.Rect,false); if GetItemIndex(it)>= 0 then InValidateRect(it.Rect,false);
end end
function ItemBitmapBChenged(it); function ItemBitmapBChenged(it); //关闭改变
begin begin
if GetItemIndex(it)>= 0 then InValidateRect(it.Rect,false); if GetItemIndex(it)>= 0 then InValidateRect(it.Rect,false);
end end
function FontChanged();override; function FontChanged();override;//字体改变
begin begin
FLineHeight := font.Height+6; FLineHeight := font.Height+6;
DoControlAlign(); DoControlAlign();
@ -139,7 +140,7 @@ type TPage=class(TCustomControl) //
DoControlAlign(); DoControlAlign();
inherited; inherited;
end end
function GetClientRect();override; function GetClientRect();override; //获得新的区域
begin begin
r := inherited; r := inherited;
FPageRect := R; FPageRect := R;
@ -147,7 +148,7 @@ type TPage=class(TCustomControl) //
FPageRect[3]:= r[1]; FPageRect[3]:= r[1];
return r; return r;
end end
function Paint();override; function Paint();override; //绘制
begin begin
dc := Canvas; dc := Canvas;
ps := PAINTSTRUCT().rcPaint; ps := PAINTSTRUCT().rcPaint;
@ -162,7 +163,7 @@ type TPage=class(TCustomControl) //
if not rc then continue; if not rc then continue;
if Intersectrect(it.Rect,ps)then if Intersectrect(it.Rect,ps)then
begin begin
if FItemIndex=i then if FItemIndex=i then //选中
begin begin
//dc.Brush.Color := rgb(244,205,205); //dc.Brush.Color := rgb(244,205,205);
dc.Brush.Color := 0xFa901E; dc.Brush.Color := 0xFa901E;
@ -204,7 +205,7 @@ type TPage=class(TCustomControl) //
//dc.Stretchdraw(rc,FBmpClose); //dc.Stretchdraw(rc,FBmpClose);
end end
end end
function SetSel(it); function SetSel(it); //选中
begin begin
idx := GetItemIndex(it); idx := GetItemIndex(it);
if idx >= 0 and idx <> FItemIndex then if idx >= 0 and idx <> FItemIndex then
@ -212,7 +213,7 @@ type TPage=class(TCustomControl) //
ItemIndex := idx; ItemIndex := idx;
end end
end end
function CloseAllItem(it); function CloseAllItem(it); //关闭
begin begin
FItemINdex :=-1; FItemINdex :=-1;
FCurrentITem := nil; FCurrentITem := nil;
@ -236,7 +237,7 @@ type TPage=class(TCustomControl) //
DoControlAlign(); DoControlAlign();
InValidateRect(nil,false); InValidateRect(nil,false);
end end
function DeleteItemByIndex(idx);virtual; function DeleteItemByIndex(idx);virtual;//删除序号
begin begin
if idx >= 0 and idx<FPageItems.length()then if idx >= 0 and idx<FPageItems.length()then
begin begin
@ -296,7 +297,7 @@ type TPage=class(TCustomControl) //
_wapi.clipcursor(0); _wapi.clipcursor(0);
end end
end end
function MouseUp(o,e);override; function MouseUp(o,e);override; //鼠标放开
begin begin
if e.button=mbLeft then if e.button=mbLeft then
begin begin
@ -339,7 +340,7 @@ type TPage=class(TCustomControl) //
end end
return inherited; return inherited;
end end
function MouseDown(o,e);override; function MouseDown(o,e);override; //按下
begin begin
if e.button=mbMiddle then if e.button=mbMiddle then
begin begin
@ -407,13 +408,13 @@ type TPage=class(TCustomControl) //
//if 3=PosInCurrentItemSection(e.pos) then FCurrentITem.Caption := datetimetostr(now()); //if 3=PosInCurrentItemSection(e.pos) then FCurrentITem.Caption := datetimetostr(now());
end end
FCanDraged; //修正提示导致修改后提示导致drage 体验问题 FCanDraged; //修正提示导致修改后提示导致drage 体验问题
function PostInCloseRect(ps); function PostInCloseRect(ps); //是否点击关闭
begin begin
rc := ClientRect; rc := ClientRect;
rc := array(rc[2]-25,1,rc[2]-1,19); rc := array(rc[2]-25,1,rc[2]-1,19);
return PointInRect(ps,rc); return PointInRect(ps,rc);
end end
function GetItemIndexByPos(xy); function GetItemIndexByPos(xy); //根据位置获得点击的item
begin begin
for i := 0 to FPageItems.Length()-1 do for i := 0 to FPageItems.Length()-1 do
begin begin
@ -421,7 +422,7 @@ type TPage=class(TCustomControl) //
end end
return -1; return -1;
end end
function posinitembmpb(xy); function posinitembmpb(xy); //点击图标位置
begin begin
for i := 0 to FPageItems.Length()-1 do for i := 0 to FPageItems.Length()-1 do
begin begin
@ -436,7 +437,7 @@ type TPage=class(TCustomControl) //
end end
return -1; return -1;
end end
Function GetItemIndex(it); Function GetItemIndex(it); //获得序号
begin begin
for i := 0 to FPageItems.length()-1 do for i := 0 to FPageItems.length()-1 do
begin begin
@ -458,16 +459,16 @@ type TPage=class(TCustomControl) //
fOnbmpbclick := nil; fOnbmpbclick := nil;
inherited; inherited;
end end
property CurrentItem read FCurrentItem; property CurrentItem read FCurrentItem; //当前的页面
property OnSelChanged read FOnSelChanged write FOnSelChanged; property OnSelChanged read FOnSelChanged write FOnSelChanged; //选择已经改变
property OnSelChanging read FOnSelChanging write FOnSelChanging; property OnSelChanging read FOnSelChanging write FOnSelChanging; //选择正在改变
property OnCloseClick read FOnCloseClick write FOnCloseClick; property OnCloseClick read FOnCloseClick write FOnCloseClick; //关闭
property Onbmpbclick read FOnbmpbclick write fOnbmpbclick; property Onbmpbclick read FOnbmpbclick write fOnbmpbclick;
property MultiLine read FMultiLine write SetMultiLine; property MultiLine read FMultiLine write SetMultiLine;
property CloseBtn read FCloseBtn write SetCloseBtn; property CloseBtn read FCloseBtn write SetCloseBtn; //是否有关闭按钮
property Lines read FLines; property Lines read FLines; //多少行
property PageItems read FPageItems; property PageItems read FPageItems; //页面集合对象
property pageitemcount read getpageitemcount; property pageitemcount read getpageitemcount; //页面数量
property ItemIndex read FItemIndex write SetItemIndex; property ItemIndex read FItemIndex write SetItemIndex;
protected protected
function CallSelChanged();virtual; function CallSelChanged();virtual;
@ -483,7 +484,7 @@ type TPage=class(TCustomControl) //
CallDatafunction(FOnSelchanging,self(true),e); CallDatafunction(FOnSelchanging,self(true),e);
return e.skip; return e.skip;
end end
function CalcPageItemRect(); function CalcPageItemRect(); //计算位置
begin begin
li := 0; li := 0;
cw := Font.Width; cw := Font.Width;
@ -624,7 +625,7 @@ type TEditerAuxiliary=class(TPage) //
FIgnoreSize := true; FIgnoreSize := true;
Ftimer.Enabled := true; Ftimer.Enabled := true;
end end
function BdownTimeOut(o,e); function BdownTimeOut(o,e); //定时器处理
begin begin
if(_wapi.GetAsyncKeyState(VK_LBUTTON).& 0xFF00)>0 then if(_wapi.GetAsyncKeyState(VK_LBUTTON).& 0xFF00)>0 then
begin begin
@ -636,20 +637,6 @@ type TEditerAuxiliary=class(TPage) //
if p then p.DoControlAlign(); if p then p.DoControlAlign();
end end
end end
{function MouseDown(o,e);override;
begin
if CloseBtn then
begin
rc := ClientRect;
rc := rc := array(rc[2]-25,1,rc[2]-1,19);
if PointInRect(e.pos,rc) then
begin
callDatafunction(FOnCloseClick,o,e);
end
end
inherited;
end }
//property OnCloseClick read FOnCloseClick write FOnCloseClick;
function DoControlAlign();override; function DoControlAlign();override;
begin begin
if FIgnoreSize then if FIgnoreSize then
@ -666,7 +653,7 @@ type TEditerAuxiliary=class(TPage) //
if CurrentItem then wnd := CurrentItem.Tag; if CurrentItem then wnd := CurrentItem.Tag;
if wnd then wnd.SetBoundsRect(Rc); if wnd then wnd.SetBoundsRect(Rc);
end end
function ShowPopUp(); function ShowPopUp();//弹出
begin begin
if not WSpOPUp then if not WSpOPUp then
begin begin
@ -675,7 +662,7 @@ type TEditerAuxiliary=class(TPage) //
end end
if not Visible then Visible := true; if not Visible then Visible := true;
end end
function MouseDown(o,e);override; function MouseDown(o,e);override;//点击处理
begin begin
if e.shiftdouble()and e.button()=mbLeft then if e.shiftdouble()and e.button()=mbLeft then
begin begin
@ -706,7 +693,6 @@ type TEditerAuxiliary=class(TPage) //
FFileFindWnd := nil; FFileFindWnd := nil;
FOnCloseClick := nil; FOnCloseClick := nil;
inherited; inherited;
//FOnCloseClick := nil;
end end
function ShowByTag(tg); //显示 function ShowByTag(tg); //显示
begin begin
@ -735,10 +721,10 @@ type TEditerAuxiliary=class(TPage) //
it.tag.Visible := true; it.tag.Visible := true;
caption := it.Tag.Caption; caption := it.Tag.Caption;
end else end else
it.tag.Visible := false; it.tag.Visible := false;
end end
end end
function AddWnd(wnd); function AddWnd(wnd); //加入窗口
begin begin
if wnd is class(TWincontrol)then if wnd is class(TWincontrol)then
begin begin
@ -771,7 +757,7 @@ type TEditerAuxiliary=class(TPage) //
end end
type TExecuteEditer=class(TCustomControl) //执行编辑器 type TExecuteEditer=class(TCustomControl) //执行编辑器
Protected Protected
Type TExecuteMemoComp=class(TSynCompletion) Type TExecuteMemoComp=class(TSynCompletion) //自动完成对象
function Create(AOwner); function Create(AOwner);
begin begin
inherited; inherited;
@ -794,7 +780,7 @@ type TExecuteEditer=class(TCustomControl) //ִ
SetCompData(d); SetCompData(d);
end end
end end
type TListBoxb=class(TListBOx) type TListBoxb=class(TListbox)//选择下拉
function Create(AOwner); function Create(AOwner);
begin begin
inherited; inherited;
@ -803,14 +789,14 @@ type TExecuteEditer=class(TCustomControl) //ִ
begin begin
return ifobj(it); return ifobj(it);
end end
function GetItemText(i);override; function GetItemText(i);override;//获得标签
begin begin
it := GetItem(i); it := GetItem(i);
if it then return it.FCaption; if it then return it.FCaption;
return ""; return "";
end end
function InsureItemVisible(idx); //移动当前的格子 function InsureItemVisible(idx); //移动当前的格子
begin begin
rc := GetIdxRect(idx); rc := GetIdxRect(idx);
c := ClientRect; c := ClientRect;
if rc[1]<c[1]then if rc[1]<c[1]then
@ -822,15 +808,6 @@ type TExecuteEditer=class(TCustomControl) //ִ
SetYpos(1+GetYPos()+(rc[3]-c[3]+1)/GetYScrollDelta()); SetYpos(1+GetYPos()+(rc[3]-c[3]+1)/GetYScrollDelta());
end end
end end
function GetItemIndex();virtual;
begin
return inherited;
end
function SetItemIndex(idx);virtual;
begin
inherited;
FListBox.InsureItemVisible(idx);
end
end end
type TComboBoxb=class(TCombobox) type TComboBoxb=class(TCombobox)
function Create(AOwner); function Create(AOwner);
@ -4588,8 +4565,6 @@ type TFindListWnd=class(TListBox) //
if not ifstring(r)then return ""; if not ifstring(r)then return "";
return r; return r;
end end
Published
private
end end
type TFindWnd=class(TPage) type TFindWnd=class(TPage)
type TFindBtn=class(TBtn) type TFindBtn=class(TBtn)
@ -5007,7 +4982,7 @@ type TGoToLineWnd=class(TVCForm) //
begin begin
show(); show();
FEdit.SetFocus(); FEdit.SetFocus();
FEdit.Text := ""; FEdit.ExecuteCommand("ecselall");
end end
private private
function GotoTextInteger(); function GotoTextInteger();
@ -5019,21 +4994,14 @@ type TGoToLineWnd=class(TVCForm) //
it := Owner.GetCurrentItem(); it := Owner.GetCurrentItem();
Visible := false; Visible := false;
Owner.OpenAndGotoFileByName(it.ScriptPath,id); Owner.OpenAndGotoFileByName(it.ScriptPath,id);
//it.SetFocus();
//return ;
it := Owner.GetCurrentEditer(); it := Owner.GetCurrentEditer();
if not it then return; if not it then return;
//it.ExecuteCommand(it.ecGotoXY,array(id,1));
//Visible := false;
it.SetFocus(); it.SetFocus();
end end
end end
FEdit; FEdit;
FBtn; FBtn;
end end
function filenameIsTheSame(p1,p2); function filenameIsTheSame(p1,p2);
begin begin
if not(ifstring(p1)and ifstring(p2))then return 0; if not(ifstring(p1)and ifstring(p2))then return 0;

223
funcext/tvclib/utslmemo.tsf
View File

@ -4,7 +4,7 @@ unit UTslMemo;
**} **}
interface interface
uses utslvclauxiliary,utslvclgdi,utslvclstdctl; uses utslvclauxiliary,utslvclgdi,utslvclstdctl;
type TMemoLineItem=class type TMemoLineItem=class() //编辑字符串行对象
function Create(s); function Create(s);
begin begin
if ifstring(s)then FStr := s; if ifstring(s)then FStr := s;
@ -18,7 +18,7 @@ type TMemoLineItem=class
FStr; FStr;
end end
TYPE TMemoLineList=class(tnumindexarray) TYPE TMemoLineList=class(tnumindexarray) //编辑器行集合
function Create(Aedit);override; function Create(Aedit);override;
begin begin
FEdit := Aedit; FEdit := Aedit;
@ -31,7 +31,7 @@ TYPE TMemoLineList=class(tnumindexarray)
splices(nil,nil,array(new TMemoLineItem(""))); splices(nil,nil,array(new TMemoLineItem("")));
FRowMaxLength := 1; FRowMaxLength := 1;
end end
function SetStringByIndex(idx,v);virtual; function SetStringByIndex(idx,v);virtual; //设置行
begin begin
if not ifstring(v)then return; if not ifstring(v)then return;
o := GetValueByIndex(idx); o := GetValueByIndex(idx);
@ -51,18 +51,18 @@ TYPE TMemoLineList=class(tnumindexarray)
function GetLineNumByIndex(idx,v);virtual; function GetLineNumByIndex(idx,v);virtual;
begin begin
end end
function SetValueByIndex(idx,v);override; function SetValueByIndex(idx,v);override;//设置行内人
begin begin
if ifstring(v)then return SetStringByIndex(idx,v); if ifstring(v)then return SetStringByIndex(idx,v);
//inherited; //inherited;
//if Flock then FEdit.InvalidateLines(idx+1,idx+1); //if Flock then FEdit.InvalidateLines(idx+1,idx+1);
end end
function GetStringByIndex(idx);virtual; function GetStringByIndex(idx);virtual; //获得行内容
begin begin
o := GetValueByIndex(idx); o := GetValueByIndex(idx);
if o then return o.FStr; if o then return o.FStr;
end end
function LengthChanged(n);override; function LengthChanged(n);override; //长度改变
begin begin
if(Flock)then if(Flock)then
begin begin
@ -79,7 +79,7 @@ TYPE TMemoLineList=class(tnumindexarray)
fRowMaxLength := max(fRowMaxLength,length(vi)); fRowMaxLength := max(fRowMaxLength,length(vi));
end end
end end
function UpDateMaxStringLength(L); function UpDateMaxStringLength(L); //最大宽度改变
begin begin
if FRowMaxLength<L then if FRowMaxLength<L then
begin begin
@ -157,7 +157,7 @@ TYPE TMemoLineList=class(tnumindexarray)
end end
end end
type TMemoGutter=class type TMemoGutter=class() //行号列
function Create(AEdit); function Create(AEdit);
begin begin
FWidth := 60; FWidth := 60;
@ -206,7 +206,7 @@ type TTslMenoUndoList=class() //undolist
begin begin
return fItems.length()>0; return fItems.length()>0;
end end
procedure EnsureMaxEntries(); procedure EnsureMaxEntries(); //达到最大数量处理
begin begin
if fItems.length()>fMaxUndoActions then if fItems.length()>fMaxUndoActions then
begin //mh 2000-10-03 begin //mh 2000-10-03
@ -217,7 +217,7 @@ type TTslMenoUndoList=class() //undolist
end; end;
end; end;
end end
function GetItemCount():integer; function GetItemCount():integer;//数量
begin begin
return fItems.length(); return fItems.length();
end end
@ -260,35 +260,35 @@ type TTslMenoUndoList=class() //undolist
fItems.splices(nil,nil,array()); fItems.splices(nil,nil,array());
fFullUndoImposible := FALSE; fFullUndoImposible := FALSE;
end end
procedure Lock(); procedure Lock();//锁住
begin begin
fLockCount++; fLockCount++;
end end
procedure Unlock(); procedure Unlock(); //解锁
begin begin
if fLockCount>0 then fLockCount--; if fLockCount>0 then fLockCount--;
return fLockCount; return fLockCount;
end end
function PeekItem():TSynEditUndoItem; function PeekItem():TSynEditUndoItem; //取得
begin begin
iLast := fItems.length()-1; iLast := fItems.length()-1;
if iLast >= 0 then return fItems[iLast]; if iLast >= 0 then return fItems[iLast];
return nil; return nil;
end end
function PopItem():TSynEditUndoItem; function PopItem():TSynEditUndoItem;//弹出
begin begin
if fLockCount>0 then return nil; if fLockCount>0 then return nil;
if fItems.length()then return fItems.Pop(); if fItems.length()then return fItems.Pop();
return nil; return nil;
end end
procedure PushItem(Item); procedure PushItem(Item); //插入
begin begin
if fLockCount>0 then return nil; if fLockCount>0 then return nil;
fItems.push(Item); fItems.push(Item);
if datatype(fOnAdded)=7 then call(fOnAdded,Self(true)); if datatype(fOnAdded)=7 then call(fOnAdded,Self(true));
end end
public public
function MergeReplaceItem(); //²Ù×÷ function MergeReplaceItem(); //合并操作
begin begin
if fItems.Length()>= 2 then if fItems.Length()>= 2 then
begin begin
@ -309,7 +309,7 @@ type TTslMenoUndoList=class() //undolist
property MaxUndoActions:integer read fMaxUndoActions write SetMaxUndoActions; property MaxUndoActions:integer read fMaxUndoActions write SetMaxUndoActions;
// property OnAddedUndo: TNotifyEvent read fOnAdded write fOnAdded; // property OnAddedUndo: TNotifyEvent read fOnAdded write fOnAdded;
end; end;
type TCustomMemoCmd=class() type TCustomMemoCmd=class() //编辑器操作码类
{** {**
@explan(说明)编辑器控件操作码类%% @explan(说明)编辑器控件操作码类%%
**} **}
@ -627,51 +627,50 @@ type TCustomMemoCmd=class()
end end
end end
type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //编辑器基类
{** {**
@explan(说明) 带滚动条的编辑控件 %% @explan(说明) 带滚动条的编辑控件 %%
**} **}
private private
fundoing; fundoing; //清空unredo标记
fredoing; fredoing; //清空unredo标记
fselectbkcolor;//rgb(192,192,192); fselectbkcolor;//rgb(192,192,192);
fcurrentLineColor;//rgb(232,232,255); fcurrentLineColor;//rgb(232,232,255);
fguttercolor; fguttercolor;
Fecruningto; //µ÷ÊÔÔËÐе½ Fecruningto; //调试运行到行
FLineInterval; FLineInterval; //行间距
FSetPostioned; FSetPostioned; //位置改变
FIsCaretShow; FIsCaretShow; //光标可见
FCaretCareted; fcaretcreated; //光标已经构造成功
fForceCaret; fForceCaret;
FCharsInWindow; // FCharsInWindow; //
fTextHeight; fTextHeight; //行高
fLinesInWindow; // fLinesInWindow; //能显示的行数
fMaxCharsInRow; fMaxCharsInRow; //行容纳字符数目
FRowHeight; // FCharHeight; //字符高度
FCharHeight; FCharWidth; //字符宽度
FCharWidth; FLeftChar; //左边隐藏的字符数
FLeftChar;
FTopLine; //首行 FTopLine; //首行
FScroolChanged; FScroolChanged; //滚动了
FGutterCharCount; FGutterCharCount; //gutter 字符个数
FGutter; FGutter; //gutter
FMarginTop; FMarginTop;
FLines; FLines;
fLastCaretY; fLastCaretY; //最新y位置
fCaretLineNeedPaint; //fCaretLineNeedPaint;
fCaretX; fCaretX; //光标位置
fCaretY; fCaretY; //光标位置
fBlockBegin:TPoint; fBlockBegin:TPoint; //选中位置
fBlockEnd:TPoint; fBlockEnd:TPoint; //选中位置
FScrollTimer; //FScrollTimer;
FMouseIsDown; FMouseIsDown;
FInPutCache; FInPutCache; //汉字输入缓存
FSelectionMode; FSelectionMode; //选中模式
FCopyer; FCopyer; //剪切板
FReadOnly; FReadOnly; //只读
fUndoList; //撤销 fUndoList; //撤销
fRedoList; //反撤销 fRedoList; //反撤销
//************** //******操作标记********
static crInsert; static crInsert;
static crPaste; static crPaste;
static crDragDropInsert; static crDragDropInsert;
@ -950,26 +949,29 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
FSetPostioned := 0; FSetPostioned := 0;
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
function sinit();override; class function sinit();override;
begin begin
crInsert := 1; if not crInsert then
crPaste := 2; begin
crDragDropInsert := 3; crInsert := 1;
crDeleteAfterCursor := 4; crPaste := 2;
crDelete := 5; crDragDropInsert := 3;
crLineBreak := 6; crDeleteAfterCursor := 4;
crIndent := 6; crDelete := 5;
crUnindent := 7; crLineBreak := 6;
crSilentDelete := 8; crIndent := 6;
crSilentDeleteAfterCursor := 9; crUnindent := 7;
crNothing := 10; crSilentDelete := 8;
smNormal := 0; crSilentDeleteAfterCursor := 9;
smLine := 1; crNothing := 10;
smColumn := 2; smNormal := 0;
InitCommandConst(); smLine := 1;
smColumn := 2;
InitCommandConst();
end
inherited; inherited;
end end
public public //滚动刷新,构造
function IncPaintLock(); function IncPaintLock();
begin begin
BeginUpdate(); BeginUpdate();
@ -1034,14 +1036,14 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
fRedoList := new TTslMenoUndoList(); fRedoList := new TTslMenoUndoList();
end end
function ClipCursor(); function ClipCursor(); //固定光标区域
begin begin
FMouseIsDown := true; FMouseIsDown := true;
crect := ClientRect; crect := ClientRect;
ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3])); ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3]));
_wapi.clipcursor(ps); _wapi.clipcursor(ps);
end end
function UnClipCursor(); function UnClipCursor(); //解除固定区域
begin begin
if FMouseIsDown then if FMouseIsDown then
begin begin
@ -1049,12 +1051,12 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
_wapi.ClipCursor(0); _wapi.ClipCursor(0);
end end
end end
function ComputeAndSelToCaret(y,x); function ComputeAndSelToCaret(y,x);//计算光标位置
begin begin
xy := PixelsToRowColumn(x,y); xy := PixelsToRowColumn(x,y);
ExecuteCommand(ecSelGotoXY,xy); ExecuteCommand(ecSelGotoXY,xy);
end end
function ClearSelBlock(); function ClearSelBlock(); //清楚选中
begin begin
bg := BlockBegin; bg := BlockBegin;
ed := BlockEnd; ed := BlockEnd;
@ -1066,11 +1068,11 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
end end
function TrySetFoucs(); function TrySetFoucs(); //设置focus
begin begin
if not FHasFocus then SetFocus(); if not FHasFocus then SetFocus();
end end
function MouseMoveSel(x,y); function MouseMoveSel(x,y);//移动鼠标选择
begin begin
if FMouseIsDown then if FMouseIsDown then
begin begin
@ -1097,7 +1099,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
return ; return ;
end end
end end
function MouseDown(o,e);override; function MouseDown(o,e);override; //按下鼠标
begin begin
if class(tmemlocker).haslocker then return ; if class(tmemlocker).haslocker then return ;
inherited; inherited;
@ -1128,11 +1130,11 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
end ; end ;
end end
function MouseMove(o,e);override; function MouseMove(o,e);override;//移动
begin begin
return MouseMOVESel(e.xpos,e.ypos); return MouseMOVESel(e.xpos,e.ypos);
end end
function WMIMECHAR(o,e):WM_IME_CHAR; function WMIMECHAR(o,e):WM_IME_CHAR;//imechar处理,无用到
begin begin
return; return;
r := " "; r := " ";
@ -1171,7 +1173,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
UpDateCaret(); UpDateCaret();
end end
end end
function keypress(o,e);override; function keypress(o,e);override; //输入字符
begin begin
if class(tmemlocker).haslocker then return ; if class(tmemlocker).haslocker then return ;
if e.skip then return; if e.skip then return;
@ -1200,7 +1202,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
end end
inherited; inherited;
end end
function InsertChars(s);virtual; function InsertChars(s);virtual;//当前位置插入字符
begin begin
if not(ifstring(s) {and s})then return; if not(ifstring(s) {and s})then return;
if SelAvail then if SelAvail then
@ -1216,19 +1218,19 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
UpdateCaret(); UpdateCaret();
memtextchanged(bb); memtextchanged(bb);
end end
function DoTextChanged(p);virtual; function DoTextChanged(p);virtual;//文本改变
begin begin
//改变 //改变
end end
function DoCaretPosChanged();virtual; function DoCaretPosChanged();virtual;//caret位置改变
begin begin
end end
function ClearUndo(); function ClearUndo(); //清空undo
begin begin
fUndoList.Clear(); fUndoList.Clear();
fRedoList.Clear(); fRedoList.Clear();
end end
function ClearAll(); function ClearAll();//清空
begin begin
fLines.text := ""; fLines.text := "";
FCaretX := FCaretY := 1; FCaretX := FCaretY := 1;
@ -1253,11 +1255,11 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
RedoItem(); RedoItem();
end end
end end
function CharInput(c);virtual; function CharInput(c);virtual;//插入字符
begin begin
if not ReadOnly then return InsertChars(c); if not ReadOnly then return InsertChars(c);
end end
function ExecuteCommand(cmd,data);override; function ExecuteCommand(cmd,data);override;//执行命令
begin begin
{** {**
@explan(说明) 执行操作 %% @explan(说明) 执行操作 %%
@ -1510,7 +1512,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
DecPaintLock(); DecPaintLock();
end; end;
end end
function MoveCaretAndSelection(p1,p2,sel); function MoveCaretAndSelection(p1,p2,sel);//移动选择
begin begin
if not(ifarray(p2)and ifarray(p1)and p2[0]>= 1 and p2[1]>= 1)then return; if not(ifarray(p2)and ifarray(p1)and p2[0]>= 1 and p2[1]>= 1)then return;
SetCaretXY(p2); SetCaretXY(p2);
@ -1539,29 +1541,29 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
DecPaintLock(); DecPaintLock();
end end
published published
property ReadOnly:bool read FReadOnly write setreadolny; property ReadOnly:bool read FReadOnly write setreadolny; //只读
property SelAvail read GetSelAvail; property SelAvail read GetSelAvail;
property Text:text read GetMemoText write SetMemoText; property Text:text read GetMemoText write SetMemoText; //文本
property TopLine read FTopLine write SetTopLine; property TopLine read FTopLine write SetTopLine; //首行
property LeftChar read FLeftChar write SetLeftChar; property LeftChar read FLeftChar write SetLeftChar;
property CharsInWindow:Integer read fCharsInWindow; property CharsInWindow:Integer read fCharsInWindow;
property LinesInWindow:Integer read fLinesInWindow; property LinesInWindow:Integer read fLinesInWindow;
property LineHeight read fTextHeight; property LineHeight read fTextHeight; //行高
property BlockBegin:TPoint read GetBlockBegin write SetBlockBegin; property BlockBegin:TPoint read GetBlockBegin write SetBlockBegin;
property BlockEnd:TPoint read GetBlockEnd write SetBlockEnd; property BlockEnd:TPoint read GetBlockEnd write SetBlockEnd;
property CaretX:Integer read fCaretX write SetCaretX; property CaretX:Integer read fCaretX write SetCaretX;
property CaretY:Integer read fCaretY write SetCaretY; property CaretY:Integer read fCaretY write SetCaretY;
property CaretXY:TPoint read GetCaretXY write SetCaretXY; property CaretXY:TPoint read GetCaretXY write SetCaretXY;
property SelText read GetSelText write SetSelTextExternal; property SelText read GetSelText write SetSelTextExternal; //选中文本
property LineText:AnsiString read GetLineText write SetLineText; property LineText:AnsiString read GetLineText write SetLineText; //当前行
property Lines read fLines; property Lines read fLines; //文本集合
property SelectionMode read FSelectionMode write SetSelectionMode; property SelectionMode read FSelectionMode write SetSelectionMode;
property GutterWidth read GetGutterWidth; property GutterWidth read GetGutterWidth;
property LineInterval read FLineInterval write SetLineInterval; property LineInterval read FLineInterval write SetLineInterval;//行间距
property GutterCharCnt:integer read FGutterCharCount write SetGutterCharCnt; property GutterCharCnt:integer read FGutterCharCount write SetGutterCharCnt;
property currentLineColor:color read fcurrentLineColor write setcurrentLineColor; property currentLineColor:color read fcurrentLineColor write setcurrentLineColor;
property guttercolor:color read fguttercolor write setguttercolor; property guttercolor:color read fguttercolor write setguttercolor; //行标颜色
property selectbkcolor:color read fselectbkcolor write setselectbkcolor; property selectbkcolor:color read fselectbkcolor write setselectbkcolor; //选中的颜色
{** {**
@param(ReadOnly)(bool) 是否只读%% @param(ReadOnly)(bool) 是否只读%%
@param(Text)(string) 文本%% @param(Text)(string) 文本%%
@ -1572,11 +1574,11 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
@param(GutterCharCnt)(integer) 行号的宽度%% @param(GutterCharCnt)(integer) 行号的宽度%%
**} **}
public public
function UpDateCaret(); function UpDateCaret(); //更新光标
begin begin
if IsUpDating()then return fForceCaret := true; if IsUpDating()then return fForceCaret := true;
fForceCaret := false; fForceCaret := false;
if not FCaretCareted then return; if not fcaretcreated then return;
if HandleAllocated()then if HandleAllocated()then
begin begin
if fCaretX >= fLeftChar and(fCaretX<fCharsInWindow+fLeftChar)and FTopLine <= fCaretY and fCaretY<FTopLine+fLinesInWindow then if fCaretX >= fLeftChar and(fCaretX<fCharsInWindow+fLeftChar)and FTopLine <= fCaretY and fCaretY<FTopLine+fLinesInWindow then
@ -1598,7 +1600,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
end end
end end
end end
function InvalidateLines(FirstLine,LastLine:integer);virtual; function InvalidateLines(FirstLine,LastLine:integer);virtual;//刷新行
begin begin
if not HandleAllocated()then return; if not HandleAllocated()then return;
fy :=(FirstLine-FTopLine)* fTextHeight; fy :=(FirstLine-FTopLine)* fTextHeight;
@ -1611,7 +1613,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
r[3]:= min(r[3],ly); r[3]:= min(r[3],ly);
InvalidateRect(r,false); InvalidateRect(r,false);
end end
function DestroyHandle();override; function DestroyHandle();override; //销毁句柄
begin begin
DestroyCaret(); DestroyCaret();
FHasFocus := false; FHasFocus := false;
@ -1674,7 +1676,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
end end
return array(cy,cx+(ci?(0):1)); return array(cy,cx+(ci?(0):1));
end end
private private //属性设置函数
function memtextchanged(p); function memtextchanged(p);
begin begin
if not(fundoing or fredoing) then if not(fundoing or fredoing) then
@ -1986,7 +1988,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
vl := tl+lct; vl := tl+lct;
if fCaretY >= tl and fCaretY <= vl then if fCaretY >= tl and fCaretY <= vl then
begin begin
fCaretLineNeedPaint := false; //fCaretLineNeedPaint := false;
end else end else
begin begin
TopLine := fCaretY; TopLine := fCaretY;
@ -2317,21 +2319,21 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
function CreateCaret(); //构造光标 function CreateCaret(); //构造光标
begin begin
if FReadOnly then return; if FReadOnly then return;
if FCaretCareted then return; if fcaretcreated then return;
h := Font.Height; h := Font.Height;
hd := Handle; hd := Handle;
_wapi.CreateCaret(hd,nil,1,h); _wapi.CreateCaret(hd,nil,1,h);
_wapi.ShowCaret(hd); _wapi.ShowCaret(hd);
FCaretCareted := true; fcaretcreated := true;
end end
function DestroyCaret(); //销毁光标 function DestroyCaret(); //销毁光标
begin begin
if FCaretCareted then if fcaretcreated then
begin begin
_wapi.HideCaret(self.Handle); _wapi.HideCaret(self.Handle);
_wapi.DestroyCaret(); _wapi.DestroyCaret();
end end
FCaretCareted := false; fcaretcreated := false;
FIsCaretShow := false; FIsCaretShow := false;
end end
FHasFocus; FHasFocus;
@ -2441,16 +2443,7 @@ type TSynCompletionList = class(TcustomListBox) //չʾlist
private private
function InsureItemVisible(idx); //移动当前的格子 function InsureItemVisible(idx); //移动当前的格子
begin begin
rc := GetIdxRect(idx); return InsureIdxInClient(idx);
c := ClientRect;
if rc[1]<c[1] then
begin
SetYpos( -1+GetYPos()+(rc[1]-c[1])/GetYScrollDelta());
end else
if rc[3]>c[3] then
begin
SetYpos( 1+GetYPos()+(rc[3]-c[3]+1)/GetYScrollDelta());
end
end end
end end
type TSynCompletion = class(TSynCompletionList) type TSynCompletion = class(TSynCompletionList)

180
funcext/tvclib/utslvclstdctl.tsf
View File

@ -5,19 +5,19 @@ interface
@date(20220509) @date(20220509)
**} **}
uses utslvclauxiliary,utslvclbase,utslvclgdi,utslvclaction,utslvclmenu; uses utslvclauxiliary,utslvclbase,utslvclgdi,utslvclaction,utslvclmenu;
type TcustomClipBoard=class(tcomponent) type TcustomClipBoard=class(tcomponent) //剪切板基类
{** {**
@explan(说明) 剪切板类 %% @explan(说明) 剪切板类 %%
**} **}
private private
private private
FIsopen; FIsopen;
function CloseClipboard(); function CloseClipboard(); //关闭
begin begin
if FIsopen then FIsopen := not _wapi.CloseClipboard(); if FIsopen then FIsopen := not _wapi.CloseClipboard();
return not(FIsopen); return not(FIsopen);
end end
function OpenClipboard(); function OpenClipboard(); //打开
begin begin
{** {**
@explan(说明) 打开剪切板 %% @explan(说明) 打开剪切板 %%
@ -25,14 +25,14 @@ type TcustomClipBoard=class(tcomponent)
IF not(FIsopen)then FIsopen := _wapi.OpenClipboard(0); IF not(FIsopen)then FIsopen := _wapi.OpenClipboard(0);
return FIsopen; return FIsopen;
end end
function EmptyClipboard(); function EmptyClipboard();//清空
begin begin
{** {**
@explan(说明) 清空剪切板 %% @explan(说明) 清空剪切板 %%
**} **}
if FIsopen then _wapi.EmptyClipboard(); if FIsopen then _wapi.EmptyClipboard();
end end
function SetText(s); function SetText(s); //设置字符串
begin begin
{** {**
@explan(说明) 设置字符串到剪切板 %% @explan(说明) 设置字符串到剪切板 %%
@ -41,7 +41,7 @@ type TcustomClipBoard=class(tcomponent)
ret :=-1; ret :=-1;
if not(ifstring(s)and length(s)>0)then if not(ifstring(s)and length(s)>0)then
begin begin
return-1; return -1;
end end
OpenClipboard(); OpenClipboard();
try try
@ -52,7 +52,7 @@ type TcustomClipBoard=class(tcomponent)
end; end;
return ret; return ret;
end end
function GetText(); function GetText(); //获得字符串
begin begin
{** {**
@explan(说明) 获得剪切板字符串 %% @explan(说明) 获得剪切板字符串 %%
@ -69,7 +69,7 @@ type TcustomClipBoard=class(tcomponent)
end; end;
return r; return r;
end end
function SetBitmap(v); function SetBitmap(v); //设置图片
begin begin
if v is class(tcustombitmap)then if v is class(tcustombitmap)then
begin begin
@ -86,7 +86,7 @@ type TcustomClipBoard=class(tcomponent)
end end
end end
end end
function Getbitmap(); function Getbitmap(); //获得图片
begin begin
OpenClipboard(); OpenClipboard();
try try
@ -236,7 +236,7 @@ type TCustomTimer = class(tcomponent)//
{** {**
@explan(说明)启动 %% @explan(说明)启动 %%
**} **}
if not((datatype(FOntimer) = 7 )and FInterval)>0 then return-1; if not((datatype(FOntimer) = 7 )and FInterval)>0 then return -1;
if FStart then return FStart; if FStart then return FStart;
ret := _wapi.SetTimer(nil,Fid,FInterval,getwinprocptr(2)); ret := _wapi.SetTimer(nil,Fid,FInterval,getwinprocptr(2));
_kill0 := ret; _kill0 := ret;
@ -276,7 +276,7 @@ type TCustomTimer = class(tcomponent)//
begin begin
inherited; inherited;
end end
class function _timeproc_(hwnd,message,wparam,lparam); class function _timeproc_(hwnd,message,wparam,lparam); //消息分发
begin begin
{** {**
@explan(说明) 定时回调入接口 %% @explan(说明) 定时回调入接口 %%
@ -293,7 +293,7 @@ type TCustomTimer = class(tcomponent)//
end end
//return _twinproc_(hwnd,message,wparam,lparam); //return _twinproc_(hwnd,message,wparam,lparam);
end end
class function Sinit();override; class function Sinit();override; //初始化
begin begin
{** {**
@explan(说明)初始化定时器全局 %% @explan(说明)初始化定时器全局 %%
@ -305,7 +305,7 @@ type TCustomTimer = class(tcomponent)//
end end
inherited; inherited;
end end
function tproc(e);virtual; function tproc(e);virtual; //分发定时器
begin begin
if e.wparam and(e.wparam=_kill0)then if e.wparam and(e.wparam=_kill0)then
begin begin
@ -313,9 +313,9 @@ type TCustomTimer = class(tcomponent)//
return 1; return 1;
end end
end end
property Interval:integer read FInterval write SetInterval; property Interval:integer read FInterval write SetInterval; //间隔
property Ontimer:eventhandler read FOntimer write FOntimer; property Ontimer:eventhandler read FOntimer write FOntimer; //回调
property Enabled:bool read FStart Write SetEnabled; property Enabled:bool read FStart Write SetEnabled; //启动
property id read FID; property id read FID;
{** {**
@param(Interval)(integer) 设置运行间隔 %% @param(Interval)(integer) 设置运行间隔 %%
@ -323,7 +323,7 @@ type TCustomTimer = class(tcomponent)//
@param(Enabled)(bool) 是否已经启动 %% @param(Enabled)(bool) 是否已经启动 %%
**} **}
end end
type tcustombtn = class(TCustomControl) type tcustombtn = class(TCustomControl) //按钮
{** {**
@explan(说明) 普通按钮 %% @explan(说明) 普通按钮 %%
**} **}
@ -337,14 +337,14 @@ type tcustombtn = class(TCustomControl)
Height:=31; Height:=31;
Color := _wapi.GetSysColor(COLOR_MENUBAR); Color := _wapi.GetSysColor(COLOR_MENUBAR);
end end
function click();virtual; function click();virtual; //点击
begin begin
{** {**
@explan(说明)模拟点击按钮一下的操作%% @explan(说明)模拟点击按钮一下的操作%%
**} **}
if handleAllocated() then _send_(BM_CLICK,0,0); if handleAllocated() then _send_(BM_CLICK,0,0);
end end
function BMCLICK(o,e):BM_CLICK;virtual; function BMCLICK(o,e):BM_CLICK;virtual; //点击消息处理
begin begin
if csDesigning in ComponentState then return ; if csDesigning in ComponentState then return ;
if FdoingClick then return ; if FdoingClick then return ;
@ -359,7 +359,7 @@ type tcustombtn = class(TCustomControl)
FdoingClick := false; FdoingClick := false;
// end; // end;
end end
function WMKEYDOWN(o,e);override; function WMKEYDOWN(o,e);override; //按键enter处理
begin begin
inherited; inherited;
case e.CharCode of case e.CharCode of
@ -370,7 +370,7 @@ type tcustombtn = class(TCustomControl)
end ; end ;
end end
function MouseDown(o,e);override; function MouseDown(o,e);override; //按下
begin begin
if csDesigning in ComponentState then return ; if csDesigning in ComponentState then return ;
if not Fbtnstate then if not Fbtnstate then
@ -380,7 +380,17 @@ type tcustombtn = class(TCustomControl)
end end
inherited; inherited;
end end
function WMLBUTTONUP(o,e):WM_LBUTTONUP;override; function MouseUp(o,e);override;//处理点击事件
begin
if csDesigning in ComponentState then return ;
click();
if Fbtnstate then
begin
Fbtnstate := 0;
InvalidateRect(nil,false);
end
end
{function WMLBUTTONUP(o,e):WM_LBUTTONUP;override;
begin begin
if csDesigning in ComponentState then return ; if csDesigning in ComponentState then return ;
click(); click();
@ -399,8 +409,8 @@ type tcustombtn = class(TCustomControl)
Fbtnstate := 0; Fbtnstate := 0;
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
end end }
function dosetfocus(o,e);override; function dosetfocus(o,e);override;//获得焦点
begin begin
{** {**
@explan(说明) 控件获得焦点 %% @explan(说明) 控件获得焦点 %%
@ -411,7 +421,7 @@ type tcustombtn = class(TCustomControl)
FBtnfocused := true; FBtnfocused := true;
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
function dokillfocus(o,e);override; function dokillfocus(o,e);override;//失掉焦点
begin begin
{** {**
@explan(说明) 控件失去焦点 %% @explan(说明) 控件失去焦点 %%
@ -423,7 +433,7 @@ type tcustombtn = class(TCustomControl)
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
function paint();override; function paint();override;//绘制
begin begin
if Fbtnstate then if Fbtnstate then
begin begin
@ -484,7 +494,7 @@ type tcustombtn = class(TCustomControl)
end end
end end
function FontChanged(o);override; function FontChanged(o);override; //字体改变
begin begin
inherited; inherited;
InvalidateRect(nil,false); InvalidateRect(nil,false);
@ -495,8 +505,8 @@ type tcustombtn = class(TCustomControl)
FonSetFocus := nil; FonSetFocus := nil;
FonKillFocus := nil; FonKillFocus := nil;
end end
property textPos:AlignStyle9 read FtextPosition write setTextPosition; property textPos:AlignStyle9 read FtextPosition write setTextPosition; //文字对齐
property pushLike:bool read FpushLike write setPushLike; property pushLike:bool read FpushLike write setPushLike;
property multiLine:bool read FmultiLine write setMultiLine; property multiLine:bool read FmultiLine write setMultiLine;
{** {**
@param(textPos)(member of TAlignStyle9) 文本位置%% @param(textPos)(member of TAlignStyle9) 文本位置%%
@ -521,7 +531,7 @@ type tcustombtn = class(TCustomControl)
if bs = caption then return ; if bs = caption then return ;
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
function PaintMouseDown();virtual; function PaintMouseDown();virtual; //按下绘制
begin begin
r := ClientRect; r := ClientRect;
dc := Canvas; dc := Canvas;
@ -537,7 +547,7 @@ type tcustombtn = class(TCustomControl)
dc.pen.style := bps; dc.pen.style := bps;
end end
private private
function paintfocus(dc,r); function paintfocus(dc,r); //绘制焦点
begin begin
dc.pen.color := rgb(150,200,230); dc.pen.color := rgb(150,200,230);
dc.pen.width := 1; dc.pen.width := 1;
@ -586,7 +596,7 @@ type tcustombtn = class(TCustomControl)
FtextPosition; FtextPosition;
Fbtnstate; Fbtnstate;
end end
type tcustomcheckbtn=class(tcustombtn) type tcustomcheckbtn=class(tcustombtn) //checkbtn
{** {**
@explan(说明) 复选框 %% @explan(说明) 复选框 %%
**} **}
@ -627,7 +637,7 @@ type tcustomcheckbtn=class(tcustombtn)
FcheckState; FcheckState;
FCheckRect; FCheckRect;
private private
function drawchekd(r);virtual; function drawchekd(r);virtual; //绘制选择按钮
begin begin
if r then if r then
begin begin
@ -637,7 +647,7 @@ type tcustomcheckbtn=class(tcustombtn)
dc.Draw("framecontrol",array(r[0:1],r[2:3]),DFC_BUTTON,(checked)?DFCS_CHECKED:DFCS_BUTTONCHECK); dc.Draw("framecontrol",array(r[0:1],r[2:3]),DFC_BUTTON,(checked)?DFCS_CHECKED:DFCS_BUTTONCHECK);
end end
end end
function setChecked(v);virtual; function setChecked(v);virtual; //设置选择
begin begin
nv := v?true:false; nv := v?true:false;
if nv<>FcheckState then if nv<>FcheckState then
@ -655,7 +665,7 @@ type tcustomcheckbtn=class(tcustombtn)
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
end end
function GetBtnTextRect();virtual; function GetBtnTextRect();virtual; //选择框位置计算
begin begin
r := ClientRect; r := ClientRect;
h := r[3]-r[1]; h := r[3]-r[1];
@ -672,7 +682,7 @@ type tcustomcheckbtn=class(tcustombtn)
return r; return r;
end end
end end
type tcustomradiobtn = class(tcustomcheckbtn) type tcustomradiobtn = class(tcustomcheckbtn) //单选按钮
{** {**
@explan(说明)radiobtn单选按钮控件 @explan(说明)radiobtn单选按钮控件
**} **}
@ -736,7 +746,7 @@ type tcustomradiobtn = class(tcustomcheckbtn)
end end
end end
end end
type teditable=class(TSLUIBASE) type teditable=class(TSLUIBASE) //编辑控件基类
private private
FInsertState; FInsertState;
FReadOnly; FReadOnly;
@ -760,7 +770,7 @@ type teditable=class(TSLUIBASE)
FClientRect; FClientRect;
FFont; FFont;
FVisible; FVisible;
function SetVisible(v); function SetVisible(v); //可见
begin begin
nv := v?true:false; nv := v?true:false;
if nv <> FVisible then if nv <> FVisible then
@ -774,7 +784,7 @@ type teditable=class(TSLUIBASE)
CalcFontSize(); CalcFontSize();
end end
end end
function SetFont(f); function SetFont(f); //字体改变
begin begin
if f then if f then
begin begin
@ -789,14 +799,14 @@ type teditable=class(TSLUIBASE)
updatecaret(); updatecaret();
end end
end end
function InvalidateRect(rec,flg); function InvalidateRect(rec,flg); //刷新
begin begin
if FHost and FHost.HandleAllocated()then if FHost and FHost.HandleAllocated()then
begin begin
FHost.InvalidateRect(rec?rec:FClientRect,flg); FHost.InvalidateRect(rec?rec:FClientRect,flg);
end end
end end
function SetHost(host); function SetHost(host); //设置宿主
begin begin
if FHost=host then return; if FHost=host then return;
ohost := FHost; ohost := FHost;
@ -810,7 +820,7 @@ type teditable=class(TSLUIBASE)
if ohost then ohost.InvalidateRect(GetEntryRect(),false); if ohost then ohost.InvalidateRect(GetEntryRect(),false);
end end
end end
function SetBorder(v); function SetBorder(v); //边框
begin begin
n := v?true:false; n := v?true:false;
if n <> FBorder then if n <> FBorder then
@ -819,7 +829,7 @@ type teditable=class(TSLUIBASE)
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
end end
Function Setplaceholder(p); Function Setplaceholder(p); //提示
begin begin
if p and ifstring(p)and Fplaceholder <> p then if p and ifstring(p)and Fplaceholder <> p then
begin begin
@ -827,7 +837,7 @@ type teditable=class(TSLUIBASE)
if FHost and not(FString)and FHost.HandleAllocated()then InvalidateRect(nil,false); if FHost and not(FString)and FHost.HandleAllocated()then InvalidateRect(nil,false);
end end
end end
function recreateCarete(); function recreateCarete();//重构光标
begin begin
DestroyCaret(); DestroyCaret();
CreateCaret(); CreateCaret();
@ -855,7 +865,7 @@ type teditable=class(TSLUIBASE)
end end
FIsCaretShow := false; FIsCaretShow := false;
end end
function updatecaret(); function updatecaret();//更新光标
begin begin
if FCanShowCaret and FHost and FHost.HandleAllocated()then if FCanShowCaret and FHost and FHost.HandleAllocated()then
begin begin
@ -864,7 +874,7 @@ type teditable=class(TSLUIBASE)
_Wapi.SetCaretPos(cx,FCaretY); _Wapi.SetCaretPos(cx,FCaretY);
end end
end end
function InitSel(); function InitSel();//取消选择
begin begin
FSelBegin := FCaretX; FSelBegin := FCaretX;
FSelLength := 0; FSelLength := 0;
@ -892,7 +902,7 @@ type teditable=class(TSLUIBASE)
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
end end
function setEditText(s); function setEditText(s); //设置文本
begin begin
if ifstring(s)and s <> FString then if ifstring(s)and s <> FString then
begin begin
@ -948,7 +958,7 @@ type teditable=class(TSLUIBASE)
InvalidateRect(nil,false); InvalidateRect(nil,false);
updatecaret(); updatecaret();
end end
function selectall(); function selectall();//全选
begin begin
if FString and(FSelBegin <> 1 or FSelLength <> length(FString))then if FString and(FSelBegin <> 1 or FSelLength <> length(FString))then
begin begin
@ -957,7 +967,7 @@ type teditable=class(TSLUIBASE)
InvalidateRect(nil,false); InvalidateRect(nil,false);
end end
end end
function getselstring(b,e); function getselstring(b,e);//获得选择的
begin begin
if FSelLength <> 0 then if FSelLength <> 0 then
begin begin
@ -969,7 +979,7 @@ type teditable=class(TSLUIBASE)
end end
return ""; return "";
end end
function DeleteSel(); function DeleteSel();//删除选中
begin begin
if FSelLength <> 0 then if FSelLength <> 0 then
begin begin
@ -989,7 +999,7 @@ type teditable=class(TSLUIBASE)
doOnChange(); doOnChange();
end end
end end
function DeletePerfect(); function DeletePerfect();//向前删除
begin begin
if FLeftCharCount>0 then if FLeftCharCount>0 then
begin begin
@ -1004,7 +1014,7 @@ type teditable=class(TSLUIBASE)
end end
end end
end end
function dodelete(); function dodelete();//向后删除
begin begin
if FReadOnly then return; if FReadOnly then return;
if FSelLength <> 0 then return deletesel(); if FSelLength <> 0 then return deletesel();
@ -1030,7 +1040,7 @@ type teditable=class(TSLUIBASE)
doOnChange(); doOnChange();
end end
end end
function BeginUpDate(); function BeginUpDate(); //锁定
begin begin
if FHost and FHost.HandleAllocated()then if FHost and FHost.HandleAllocated()then
begin begin
@ -1044,7 +1054,7 @@ type teditable=class(TSLUIBASE)
FHost.EndUpDate(); FHost.EndUpDate();
end end
end end
function dobackspace(); function dobackspace();//backsapce处理
begin begin
if FReadOnly then return; if FReadOnly then return;
if FSelLength <> 0 then return deletesel(); if FSelLength <> 0 then return deletesel();
@ -1071,7 +1081,7 @@ type teditable=class(TSLUIBASE)
doOnChange(); doOnChange();
end end
end end
function GetCBoard(); function GetCBoard(); //剪切板
begin begin
if not FCopyer then if not FCopyer then
begin begin
@ -1084,7 +1094,7 @@ type teditable=class(TSLUIBASE)
r := getselstring(); r := getselstring();
GetCBoard().text := r; GetCBoard().text := r;
end end
function PasteFromClipBoard(); function PasteFromClipBoard();//粘贴
begin begin
if readonly then return; if readonly then return;
t := GetCBoard().text; t := GetCBoard().text;
@ -1212,7 +1222,7 @@ type teditable=class(TSLUIBASE)
begin begin
ns := c[1:nct+1]; ns := c[1:nct+1];
end else end else
ns := c[1:nct]; ns := c[1:nct];
return InsertChar(ns); return InsertChar(ns);
end end
end end
@ -1383,7 +1393,7 @@ type teditable=class(TSLUIBASE)
r[3]-= 1; r[3]-= 1;
return r; return r;
end end
function WMKEYDOWN(o,e);virtual; function WMKEYDOWN(o,e);virtual;//按键
begin begin
fsft := ssShift in e.shiftstate; fsft := ssShift in e.shiftstate;
fctl := ssCtrl in e.shiftstate; fctl := ssCtrl in e.shiftstate;
@ -1446,8 +1456,9 @@ type teditable=class(TSLUIBASE)
end end
end end
end end
function WMCHAR(o,e);virtual; function WMCHAR(o,e);virtual;//字符
begin begin
if fcanundo then fredolist.clear();//清空
c := e.CharCode; c := e.CharCode;
case c of case c of
VK_BACK: VK_BACK:
@ -1468,9 +1479,11 @@ type teditable=class(TSLUIBASE)
FHafChar := e.char; FHafChar := e.char;
end end
end else end else
InsertChar(e.char); begin
InsertChar(e.char);
end
end end
function FontChanged(o);override; function FontChanged(o);override;//字体
begin begin
if FHost and FHost.HandleAllocated()then if FHost and FHost.HandleAllocated()then
begin begin
@ -1484,7 +1497,7 @@ type teditable=class(TSLUIBASE)
end end
end end
end end
function Paint(); function Paint(); //绘制
begin begin
if not FVisible then return; if not FVisible then return;
if not(FHost and FHost.HandleAllocated()and FHost.Canvas.HandleAllocated())then return; if not(FHost and FHost.HandleAllocated()and FHost.Canvas.HandleAllocated())then return;
@ -1589,7 +1602,7 @@ type teditable=class(TSLUIBASE)
if not FIsCaretShow then return SetFocus(); if not FIsCaretShow then return SetFocus();
end end
end end
function SetFocus(); function SetFocus(); //设置焦点
begin begin
if not FVisible then return; if not FVisible then return;
FSetFocused := true; FSetFocused := true;
@ -1602,7 +1615,7 @@ type teditable=class(TSLUIBASE)
if FFocusBorder then InvalidateRect(nil,false); if FFocusBorder then InvalidateRect(nil,false);
doonsetfocus(); doonsetfocus();
end end
function KillFocus(); function KillFocus();//删除焦点
begin begin
FMouseLbuttonDown := false; FMouseLbuttonDown := false;
_wapi.ClipCursor(0); //添加输入焦点处理 _wapi.ClipCursor(0); //添加输入焦点处理
@ -1927,7 +1940,7 @@ type tVirtualCalender=class(TSLUIBASE)
y := p1-FTop; y := p1-FTop;
pp := array(x,y); pp := array(x,y);
if pointinrect(pp,FIncRect)then return 1; if pointinrect(pp,FIncRect)then return 1;
if pointinrect(pp,FDecRect)then return-1; if pointinrect(pp,FDecRect)then return -1;
end end
end end
"megetbypos": "megetbypos":
@ -2965,7 +2978,7 @@ type TCustomListBoxbase=class(TCustomScrollControl)
begin begin
py := GetYPos(); py := GetYPos();
r := integer(y/GetYScrollDelta())+py; r := integer(y/GetYScrollDelta())+py;
if r >= FItemCount then return-1; if r >= FItemCount then return -1;
return r; return r;
end end
function GetIdxRect(idx);virtual; function GetIdxRect(idx);virtual;
@ -3218,7 +3231,7 @@ type TcustomListBox=class(TCustomListBoxbase)
begin begin
return FSelBegin; return FSelBegin;
end end
return-1; return -1;
end end
function setCurrentSelection(n);virtual; function setCurrentSelection(n);virtual;
begin begin
@ -3318,7 +3331,7 @@ type TcustomListBox=class(TCustomListBoxbase)
class(TCustomListBoxbase).ItemCount := FitemData.length(); class(TCustomListBoxbase).ItemCount := FitemData.length();
return ItemCount-1; return ItemCount-1;
end end
return-1; return -1;
end end
function appendItems(ari);virtual; function appendItems(ari);virtual;
begin begin
@ -3352,7 +3365,7 @@ type TcustomListBox=class(TCustomListBoxbase)
class(TCustomListBoxbase).ItemCount := FitemData.length(); class(TCustomListBoxbase).ItemCount := FitemData.length();
return n; return n;
end end
return-1; return -1;
end end
function insertItems(ari,n);virtual; function insertItems(ari,n);virtual;
begin begin
@ -3371,7 +3384,7 @@ type TcustomListBox=class(TCustomListBoxbase)
class(TCustomListBoxbase).ItemCount := FitemData.length(); class(TCustomListBoxbase).ItemCount := FitemData.length();
return n+length(ari)-1; return n+length(ari)-1;
end else end else
return-1; return -1;
end end
function deleteItem(n);override; function deleteItem(n);override;
begin begin
@ -3445,6 +3458,7 @@ type TcustomListBox=class(TCustomListBoxbase)
function findStrExact(str,b,n);virtual; function findStrExact(str,b,n);virtual;
begin begin
{** {**
@ignore(忽略) %%
@explan(说明)在列表框中指定项之后查找与字符串相同的项，到达末尾即从头开始%% @explan(说明)在列表框中指定项之后查找与字符串相同的项，到达末尾即从头开始%%
@param(str)(string)给定字符串%% @param(str)(string)给定字符串%%
@param(b)(bool)1:不区分大小写，0:区分大小写，默认为0%% @param(b)(bool)1:不区分大小写，0:区分大小写，默认为0%%
@ -3460,7 +3474,7 @@ type TcustomListBox=class(TCustomListBoxbase)
else return findExact(str,n); else return findExact(str,n);
end end
ShowErrorMessage("function findStrExact:ErrorParameter(s)"); ShowErrorMessage("function findStrExact:ErrorParameter(s)");
return-1; return -1;
end end
function setData(ari);virtual; function setData(ari);virtual;
begin begin
@ -3590,25 +3604,25 @@ type TcustomListBox=class(TCustomListBoxbase)
begin begin
len := class(TCustomListBoxbase).ItemCount; len := class(TCustomListBoxbase).ItemCount;
while i++<> len do if AnsiStartsStr(str,getItem((i+n)%len))then return(i+n)%len; while i++<> len do if AnsiStartsStr(str,getItem((i+n)%len))then return(i+n)%len;
return-1; return -1;
end end
function findBeginwithCaseIndepent(str,n); function findBeginwithCaseIndepent(str,n);
begin begin
len := class(TCustomListBoxbase).ItemCount; len := class(TCustomListBoxbase).ItemCount;
while i++<> len do if AnsiStartsText(str,getItem((i+n)%len))then return(i+n)%len; while i++<> len do if AnsiStartsText(str,getItem((i+n)%len))then return(i+n)%len;
return-1; return -1;
end end
function findExact(str,n); function findExact(str,n);
begin begin
len := class(TCustomListBoxbase).ItemCount; len := class(TCustomListBoxbase).ItemCount;
while i++<> len do if getItem((i+n)%len)=str then return(i+n)%len; while i++ <> len do if getItem((i+n)%len)=str then return(i+n)%len;
return-1; return -1;
end end
function findExactCaseIndepent(str,n); function findExactCaseIndepent(str,n);
begin begin
len := class(TCustomListBoxbase).ItemCount; len := class(TCustomListBoxbase).ItemCount;
while i++<> len do if UpperCase(getItem((i+n)%len))=UpperCase(str)then return(i+n)%len; while i++ <> len do if UpperCase(getItem((i+n)%len))=UpperCase(str)then return(i+n)%len;
return-1; return -1;
end end
function SelRange(sel); function SelRange(sel);
begin begin
@ -4550,9 +4564,9 @@ type TcustomToolBar=class(TCustomControl)
@param(btn)(TToolButton) 工具栏项 %% @param(btn)(TToolButton) 工具栏项 %%
@param(idx)(TToolButton | integer) 位置 %% @param(idx)(TToolButton | integer) 位置 %%
**} **}
if not(idx >= 0)then return-1; if not(idx >= 0)then return -1;
cidx := IndexOfBtn(btn); cidx := IndexOfBtn(btn);
if cidx<0 then return-1; if cidx<0 then return -1;
if cidx=idx then return idx; if cidx=idx then return idx;
btnlength := FButtons.Length(); btnlength := FButtons.Length();
if idx>cidx then if idx>cidx then
@ -4607,7 +4621,7 @@ type TcustomToolBar=class(TCustomControl)
@param(btn)(TToolButton) 工具栏项%% @param(btn)(TToolButton) 工具栏项%%
**} **}
idx := IndexOfBtn(btn); idx := IndexOfBtn(btn);
if idx=-1 then return-1; if idx=-1 then return -1;
if btn.willaddBar <>-1986 then if btn.willaddBar <>-1986 then
begin begin
return btn.Parent := nil; return btn.Parent := nil;
@ -5167,7 +5181,7 @@ type TcustomStatusBar=class(TCustomControl)
@param(str)(string) 文本 %% @param(str)(string) 文本 %%
@param(wd)(number) 宽度 ,大于1 表示绝对宽阔 ,小于1 表示相对宽度 %% @param(wd)(number) 宽度 ,大于1 表示绝对宽阔 ,小于1 表示相对宽度 %%
**} **}
if not ifstring(str)then return-1; if not ifstring(str)then return -1;
if not(wd>0)then wd := 100; if not(wd>0)then wd := 100;
Fitems[Length(Fitems)]:= array("text":str,"width":wd); Fitems[Length(Fitems)]:= array("text":str,"width":wd);
if HandleAllocated()then if HandleAllocated()then
@ -5181,7 +5195,7 @@ type TcustomStatusBar=class(TCustomControl)
@explan(说明) 删除项目 %% @explan(说明) 删除项目 %%
@param(id)(integer) 序号 %% @param(id)(integer) 序号 %%
**} **}
if not(itemidok(id))then return-1; if not(itemidok(id))then return -1;
deleteindex(Fitems,id,true); deleteindex(Fitems,id,true);
if HandleAllocated()then if HandleAllocated()then
begin begin
@ -5196,7 +5210,7 @@ type TcustomStatusBar=class(TCustomControl)
@param(id)(integer) 序号 %% @param(id)(integer) 序号 %%
**} **}
if not ifstring(str)then return-1; if not ifstring(str)then return-1;
if not(itemidok(id))then return-1; if not(itemidok(id))then return -1;
Fitems[id,"text"]:= str; Fitems[id,"text"]:= str;
if HandleAllocated()then if HandleAllocated()then
begin begin