[Delphi 7]自己写了两个控件，测试的时候，程序退出会偶尔弹出CPU窗口

Question

由于长度限制，所以分开发了ControlsScroller Part1unit ControlsScroller;interfaceuses
  SysUtils, Classes, Controls, ExtCtrls, DateUtils, Windows, SyncObjs;type
    ScrollOrientation = (Horizontal, Vertica);type
    RegisterInfo = record
        control : TControl;
        width : Integer;
        height : Integer;
        scroll : Boolean;
        pageRollComplete : Boolean;
        rollingCount : Integer;
        lastCompleteTime : TDateTime;
    end;const MAXCONTROLS = 50;type
  TControlsScroller = class(TComponent)
    private
        m_controlsCount : Integer;                      //注册过的控件数量
        m_registerInfos : array [0 .. 49] of RegisterInfo;  //控件信息
        m_Speed : Cardinal;                              //滚动速度
        m_ResidenceTime : Cardinal;                      //停留时间
        m_ScrollOrientation : ScrollOrientation;         //滚动方向        //m_CurrentPast : Boolean;                        //当前滚动方向：过去、回滚
        m_CSRegisterInfos: TCriticalSection ;       //临界区
        m_Enable : Boolean;             //是否滚动        m_Thread : THANDLE;
        m_EixtThread : Boolean;         //是否退出线程
        m_Tid: DWord;
        
    protected
        procedure ScrollingControls();
        procedure HorizontalScrolling();
        procedure VerticalScrolling();        procedure SetSpeed(value:Cardinal);
        procedure SetResidenceTime(value:Cardinal);        procedure SetEnable(value:Boolean);
    public
        constructor Create(AOwner:TComponent);override;
        destructor destroy();override;        function Registration(control:TControl; width:Integer; height:Integer; scroll:Boolean):Boolean;
        procedure ResetRegisterInfo(control:TControl; width:Integer; height:Integer; scroll:Boolean);
        procedure Cancellation(control:TControl);
        
    published
        property Speed : Cardinal read m_Speed write SetSpeed;
        property ResidenceTime:Cardinal read m_ResidenceTime write SetResidenceTime;
        property Enable:Boolean read m_Enable write SetEnable;
        property Orientation : ScrollOrientation read m_ScrollOrientation write m_ScrollOrientation;
    end;procedure TheardFunc(Param: TControlsScroller);stdcall;procedure Register;implementationconstructor TControlsScroller.Create(AOwner:TComponent);
begin
    inherited Create(AOwner);    m_Speed := 2;
    m_ResidenceTime := 5;
    m_controlsCount := 0;
    m_Enable := True;
    m_ScrollOrientation := Horizontal;    m_CSRegisterInfos := TCriticalSection.Create;
    m_Thread := CreateThread(nil, 0, @TheardFunc, Self, 0, m_Tid);end;
destructor TControlsScroller.destroy();
begin
    m_EixtThread := true;
    WaitForSingleObject(m_Thread, 300);    m_CSRegisterInfos.Destroy;    inherited destroy;
end;
function TControlsScroller.Registration(control:TControl;  width:Integer; height:Integer; scroll:Boolean):Boolean;
var
    i : Integer;
begin
    Result := false;
    
    for i := 0 to MAXCONTROLS - 1 do
    begin
        if m_registerInfos[i].control = nil then
        begin
            m_registerInfos[m_controlsCount].control := control;
            m_registerInfos[m_controlsCount].width := width;
            m_registerInfos[m_controlsCount].height := height;
            m_registerInfos[m_controlsCount].scroll := scroll;
            m_registerInfos[m_controlsCount].pageRollComplete := true;
            m_registerInfos[m_controlsCount].rollingCount := 0;
            m_registerInfos[m_controlsCount].lastCompleteTime := Now();
            m_controlsCount := m_controlsCount + 1;
            Result:= True;
            break;
        end;  
    end;
end;

Answer 1

ControlsScroller Part 2procedure TControlsScroller.SetSpeed(value:Cardinal);
begin
    m_Speed := value;
end;procedure TControlsScroller.SetResidenceTime(value:Cardinal);
begin
    m_ResidenceTime:= value;
end;procedure TControlsScroller.ScrollingControls();
begin
    if m_ScrollOrientation = Horizontal then
        HorizontalScrolling()
    else
        VerticalScrolling();
end;procedure TControlsScroller.HorizontalScrolling();
var
    i : Integer;
    tmpPageComplete : Boolean;
    tmpDirectionComplete : Boolean;
begin
    for i := 0 to m_controlsCount -1 do
    begin
        if not ( m_registerInfos[i].control = nil) and (m_registerInfos[i].scroll) then
        begin
            if (not m_registerInfos[i].pageRollComplete)
                or (SecondsBetween(now(), m_registerInfos[i].lastCompleteTime) >= m_ResidenceTime)  then
            begin
                tmpPageComplete := true;
                tmpDirectionComplete := true;
                //当前方向没有滚动完
                if m_registerInfos[i].control.Left > (-m_registerInfos[i].control.Width) then
                begin
                    tmpDirectionComplete := False;
                    //当前页没有滚动完
                    if m_registerInfos[i].control.Left > -(m_registerInfos[i].rollingCount + 1) * m_registerInfos[i].width then
                    begin
                        tmpPageComplete := False;                        try
                            m_CSRegisterInfos.Enter;        //进入临界区
                            if not (m_registerInfos[i].control = nil) then
                                m_registerInfos[i].control.Left := m_registerInfos[i].control.Left - m_Speed;   //关闭窗口会偶尔出问题
                            m_CSRegisterInfos.Leave;        //离开临界区
                        except
                        end;
                    end;
                end;                if tmpPageComplete = True then
                begin
                    m_registerInfos[i].lastCompleteTime := Now();
                    m_registerInfos[i].rollingCount := m_registerInfos[i].rollingCount + 1;
                end;
                if tmpDirectionComplete = True then
                begin
                    m_registerInfos[i].rollingCount := -1;
                    m_registerInfos[i].control.Left := m_registerInfos[i].width + 5;
                end;                m_registerInfos[i].pageRollComplete := tmpPageComplete;            end;
        end;    end;
end;procedure TControlsScroller.VerticalScrolling();
var
    i : Integer;
    tmpPageComplete : Boolean;
    tmpDirectionComplete : Boolean;
begin
    for i := 0 to m_controlsCount -1 do
    begin
        if not ( m_registerInfos[i].control = nil) and (m_registerInfos[i].scroll) then
        begin
            if (not m_registerInfos[i].pageRollComplete)
                or (SecondsBetween(now(), m_registerInfos[i].lastCompleteTime) >= m_ResidenceTime)  then
            begin
                tmpPageComplete := true;
                tmpDirectionComplete := true;
                //当前方向没有滚动完
                if m_registerInfos[i].control.Top > (-m_registerInfos[i].control.Height) then
                begin
                    tmpDirectionComplete := False;
                    //当前页没有滚动完
                    if m_registerInfos[i].control.Top > -(m_registerInfos[i].rollingCount + 1) * m_registerInfos[i].Height then
                    begin
                        tmpPageComplete := False;                        try
                            m_CSRegisterInfos.Enter;        //进入临界区
                            if not (m_registerInfos[i].control = nil) then
                                m_registerInfos[i].control.Top := m_registerInfos[i].control.Top - m_Speed;   //关闭窗口会偶尔出问题
                            m_CSRegisterInfos.Leave;        //离开临界区
                        except
                        end;
                    end;
                end;                if tmpPageComplete = True then
                begin
                    m_registerInfos[i].lastCompleteTime := Now();
                    m_registerInfos[i].rollingCount := m_registerInfos[i].rollingCount + 1;
                end;
                if tmpDirectionComplete = True then
                begin
                    m_registerInfos[i].rollingCount := -1;
                    m_registerInfos[i].control.Top := m_registerInfos[i].Height + 5;
                end;                m_registerInfos[i].pageRollComplete := tmpPageComplete;            end;
        end;    end;
end;procedure TControlsScroller.ResetRegisterInfo(control:TControl;  width:Integer; height:Integer; scroll:Boolean);
var i : Integer;
begin
    for i := 0 to MAXCONTROLS -1 do
    begin
        if m_registerInfos[i].control = control then
        begin
            m_registerInfos[i].width := width;
            m_registerInfos[i].height := height;
            m_registerInfos[i].scroll := scroll;
            break;
        end;
    end;
end;procedure TControlsScroller.SetEnable(value:Boolean);
begin
    m_Enable := value;
end;procedure TControlsScroller.Cancellation(control:TControl);
var i:Integer;
begin
    for i := 0 to MAXCONTROLS -1 do
    begin
        if m_registerInfos[i].control = control then
        begin
          m_CSRegisterInfos.Enter;        //进入临界区
          m_registerInfos[i].control := nil;
          m_CSRegisterInfos.Leave;        //离开临界区
          Break;
        end;      end;
end;procedure TheardFunc(Param: TControlsScroller);stdcall;
var
    ControlsScroller : TControlsScroller;
    startTime, currentTime, frequency, lastRefreshTime, tick: Int64;
    resolution : Double;
begin
    ControlsScroller := Param;    QueryPerformanceFrequency(frequency);
    QueryPerformanceCounter(startTime);
    resolution := 1.0/frequency;
    lastRefreshTime := 0;    while not ControlsScroller.m_EixtThread do
    begin
        try
            QueryPerformanceCounter(tick);
            currentTime := Trunc(( tick - startTime) * resolution * 1000.0);
            
            if (ControlsScroller.Enable) and (currentTime - lastRefreshTime >= 16) then
            begin
                ControlsScroller.ScrollingControls();                QueryPerformanceCounter(tick);
                lastRefreshTime := Trunc(( tick - startTime) * resolution * 1000.0);
            end;
        except        end;
        Sleep(2);
    end;
end;procedure Register;
begin
  RegisterComponents('Standard', [TControlsScroller]);
end;end.

Answer 2

上次修改了版本，某些地方忘记跟着修改了主要是下面几个函数内容：
constructor TControlsScroller.Create(AOwner:TComponent);
begin
    inherited Create(AOwner);    m_Speed := 2;
    m_ResidenceTime := 5;
    m_Enable := True;
    m_ScrollOrientation := Horizontal;    m_CSRegisterInfos := TCriticalSection.Create;
    m_Thread := CreateThread(nil, 0, @TheardFunc, Self, 0, m_Tid);end;
function TControlsScroller.Registration(control:TControl;  width:Integer; height:Integer; scroll:Boolean):Boolean;
var
    i : Integer;
begin
    Result := false;
    
    for i := 0 to MAXCONTROLS - 1 do
    begin
        if m_registerInfos[i].control = nil then
        begin
            m_registerInfos[i].control := control;
            m_registerInfos[i].width := width;
            m_registerInfos[i].height := height;
            m_registerInfos[i].scroll := scroll;
            m_registerInfos[i].pageRollComplete := true;
            m_registerInfos[i].rollingCount := 0;
            m_registerInfos[i].lastCompleteTime := Now();
            Result:= True;
            break;
        end;  
    end;
end;
procedure TControlsScroller.HorizontalScrolling();
var
    i : Integer;
    tmpPageComplete : Boolean;
    tmpDirectionComplete : Boolean;
begin
    for i := 0 to MAXCONTROLS -1 do
    begin
        if not ( m_registerInfos[i].control = nil) and (m_registerInfos[i].scroll) then
        begin
            if (not m_registerInfos[i].pageRollComplete)
                or (SecondsBetween(now(), m_registerInfos[i].lastCompleteTime) >= m_ResidenceTime)  then
            begin
                tmpPageComplete := true;
                tmpDirectionComplete := true;
                //当前方向没有滚动完
                if m_registerInfos[i].control.Left > (-m_registerInfos[i].control.Width) then
                begin
                    tmpDirectionComplete := False;
                    //当前页没有滚动完
                    if m_registerInfos[i].control.Left > -(m_registerInfos[i].rollingCount + 1) * m_registerInfos[i].width then
                    begin
                        tmpPageComplete := False;                        try
                            m_CSRegisterInfos.Enter;        //进入临界区
                            if not (m_registerInfos[i].control = nil) then
                                m_registerInfos[i].control.Left := m_registerInfos[i].control.Left - m_Speed;   //关闭窗口会偶尔出问题
                            m_CSRegisterInfos.Leave;        //离开临界区
                        except
                        end;
                    end;
                end;                if tmpPageComplete = True then
                begin
                    m_registerInfos[i].lastCompleteTime := Now();
                    m_registerInfos[i].rollingCount := m_registerInfos[i].rollingCount + 1;
                end;
                if tmpDirectionComplete = True then
                begin
                    m_registerInfos[i].rollingCount := -1;
                    m_registerInfos[i].control.Left := m_registerInfos[i].width + 5;
                end;                m_registerInfos[i].pageRollComplete := tmpPageComplete;            end;
        end;    end;
end;procedure TControlsScroller.VerticalScrolling();
var
    i : Integer;
    tmpPageComplete : Boolean;
    tmpDirectionComplete : Boolean;
begin
    for i := 0 to MAXCONTROLS -1 do
    begin
        if not ( m_registerInfos[i].control = nil) and (m_registerInfos[i].scroll) then
        begin
            if (not m_registerInfos[i].pageRollComplete)
                or (SecondsBetween(now(), m_registerInfos[i].lastCompleteTime) >= m_ResidenceTime)  then
            begin
                tmpPageComplete := true;
                tmpDirectionComplete := true;
                //当前方向没有滚动完
                if m_registerInfos[i].control.Top > (-m_registerInfos[i].control.Height) then
                begin
                    tmpDirectionComplete := False;
                    //当前页没有滚动完
                    if m_registerInfos[i].control.Top > -(m_registerInfos[i].rollingCount + 1) * m_registerInfos[i].Height then
                    begin
                        tmpPageComplete := False;                        try
                            m_CSRegisterInfos.Enter;        //进入临界区
                            if not (m_registerInfos[i].control = nil) then
                                m_registerInfos[i].control.Top := m_registerInfos[i].control.Top - m_Speed;   //关闭窗口会偶尔出问题
                            m_CSRegisterInfos.Leave;        //离开临界区
                        except
                        end;
                    end;
                end;                if tmpPageComplete = True then
                begin
                    m_registerInfos[i].lastCompleteTime := Now();
                    m_registerInfos[i].rollingCount := m_registerInfos[i].rollingCount + 1;
                end;
                if tmpDirectionComplete = True then
                begin
                    m_registerInfos[i].rollingCount := -1;
                    m_registerInfos[i].control.Top := m_registerInfos[i].Height + 5;
                end;                m_registerInfos[i].pageRollComplete := tmpPageComplete;            end;
        end;    end;
end;

Answer 3

之前测试的时候是专门写了测试日志的，根据日志，定位在
 procedure TControlsScroller.HorizontalScrolling();  的
m_registerInfos[i].control.Top := m_registerInfos[i].control.Top - m_Speed;   //关闭窗口会偶尔出问题和 procedure TControlsScroller.VerticalScrolling(); 的
m_registerInfos[i].control.Top := m_registerInfos[i].control.Top - m_Speed;   //关闭窗口会偶尔出问题这两个地方。
进一步跟踪调试，发现出现问题的时候  TViewLabel 和 TControlsScroller 的析构函数根本就没执行，如果TViewLabel 和 TControlsScroller 的析构函数成功执行了，那么就不会出现这个问题。另外这个问题不一定会出现，会偶尔出现，一次不出现多次  运行 -> 关闭 -> 运行 -> 关闭... 就可以看到这个问题了

Answer 4

m_registerInfos要注意线程同步啊!主线程调用TControlsScroller.Registration的时候写m_registerInfos，而这时候子线程通过TControlsScroller.ScrollingControls在读m_registerInfos...

Answer 5

我以前是有注意这个的，但是这个是写成控件的，在设计界面时，由于delphi本身的原因，会导致界面卡死，你可以想象一下线程，所以取消了那两条代码。而且即使没有使用临界区，这个地方也不会导致重大问题，因为scrolling会判断是否为nil,最多也只是导致一个speed的偏差

Answer 6

不是这个原因 
以前我在Registration 、 HorizontalScrolling 和 VerticalScrolling 的开始处和结尾处加了临界区代码，后来由于卡设计界面的原因就去掉了Registration 的临界区，然后就把HorizontalScrolling 和 VerticalScrolling 的临界区代码改在 m_registerInfos[i].control.Top := m_registerInfos[i].control.Top - m_Speed; 这上面了，卡住的原因在于线程执行频率过高，导致设计界面等待而卡死。
现在这两个控件运行没发现任何问题，只有在进程关闭时才会出现这个问题，而且这个问题是挂在编译器上的，也就是说你单独执行EXE是不会出现这个的。我怀疑是不是早起DELPHI的BUG？

Answer 7

不是这个原因 
以前我在Registration 、 HorizontalScrolling 和 VerticalScrolling 的开始处和结尾处加了临界区代码，后来由于卡设计界面的原因就去掉了Registration 的临界区，然后就把HorizontalScrolling 和 VerticalScrolling 的临界区代码改在 m_registerInfos[i].control.Top := m_registerInfos[i].control.Top - m_Speed; 这上面了，卡住的原因在于线程执行频率过高，导致设计界面等待而卡死。
现在这两个控件运行没发现任何问题，只有在进程关闭时才会出现这个问题，而且这个问题是挂在编译器上的，也就是说你单独执行EXE是不会出现这个的。我怀疑是不是早起DELPHI的BUG？判断ComponentState是csDesigning就不开启线程，他就不卡了。该线程同步的就要同步！

Answer 8

不是这个原因 
以前我在Registration 、 HorizontalScrolling 和 VerticalScrolling 的开始处和结尾处加了临界区代码，后来由于卡设计界面的原因就去掉了Registration 的临界区，然后就把HorizontalScrolling 和 VerticalScrolling 的临界区代码改在 m_registerInfos[i].control.Top := m_registerInfos[i].control.Top - m_Speed; 这上面了，卡住的原因在于线程执行频率过高，导致设计界面等待而卡死。
现在这两个控件运行没发现任何问题，只有在进程关闭时才会出现这个问题，而且这个问题是挂在编译器上的，也就是说你单独执行EXE是不会出现这个的。我怀疑是不是早起DELPHI的BUG？判断ComponentState是csDesigning就不开启线程，他就不卡了。该线程同步的就要同步！
但是这样就没办法直接看到效果了啊 而且我觉得这个地方同不同步没太大影响  
现在的问题是退出程序会偶尔弹CPU窗口 ret 0

Answer 9

抱歉哈，平时都习惯手动创建手动释放没注意是可以执行的。
我试了楼主的代码，点到手都软了都没弹出CPU窗口，我用的是D2007。
建议楼主把这段代码改一下试试，也有可能就不是问题，是编译器的BUG。                        try
                            m_CSRegisterInfos.Enter;        //进入临界区
                            try
                              if not (m_registerInfos[i].control = nil) then
                              begin
                                  control := m_registerInfos[i].control;
                                  control.Left := control.Left - m_Speed;   //关闭窗口会偶尔出问题
                              end;
                            finally
                              m_CSRegisterInfos.Leave;        //离开临界区
                            end;
                        except
                        end;

Answer 10

抱歉哈，平时都习惯手动创建手动释放没注意是可以执行的。
我试了楼主的代码，点到手都软了都没弹出CPU窗口，我用的是D2007。
建议楼主把这段代码改一下试试，也有可能就不是问题，是编译器的BUG。                        try
                            m_CSRegisterInfos.Enter;        //进入临界区
                            try
                              if not (m_registerInfos[i].control = nil) then
                              begin
                                  control := m_registerInfos[i].control;
                                  control.Left := control.Left - m_Speed;   //关闭窗口会偶尔出问题
                              end;
                            finally
                              m_CSRegisterInfos.Leave;        //离开临界区
                            end;
                        except
                        end;
昨天早上又看了一下代码，这段代码确实有问题，m_CSRegisterInfos.Leave;        //离开临界区 这段代码不能放在 finally 这里， 这里 enter leave最好包围这个if。另外 destructor TViewLabel.Destroy();
begin
    if not (m_ControlsScroller = nil) then
        m_ControlsScroller.Cancellation(m_SubLabel);
 
    m_SubLabel.Free;
    inherited Destroy;
end;
 
这里也有问题，当m_ControlsScroller先释放的时候，这里会崩溃。所以在 ResetRegisterInfo 里添加了 msg:pinteger，当ControlsScroller释放的时候，会修改msg的值，另外 Enter、leave 包围了整个ControlsScroller::Cancellation()，m_CSRegisterInfos释放之前添加了 enter 和leave 来保证不运行不出问题。