TGraphicControl派生类刚开始可以显示,一段时间后显示不出来。

时间:2021-05-08 19:21:05
写一个体彩走势图的控件
(走势图,各期开奖结果列表)THistory从TCustomControl继承
(开奖结果,也就是红点)THistoryItem是从TGraphicControl继承下来的
(两边显示的“期数”“总和”“距离”等)THistoryText也是从TGraphicControl继承。

走势图根据选择的彩票类型进行动态变化,刚开始的时候都没问题(下面的第一副图),可变化一段时间后就成第二副图的样了,THistoryItem全部看不见了,还有THistoryText除了在最左边的“期数”可以看到,右边的那部分也全看不见了。

调试的时候发现THistoryItem里面PAINT函数都不执行。。。已经两天了都找不出原因。郁闷死了。

[img=http://photo.store.qq.com/http_imgload.cgi?/rurl2=6ab98598e73818d431ddfef82cad2090efeda6fe367cda50c94956d571e601c836ace2eeeffe46123b55627d7b0dd78625d018b8c282200b000cf78990bec07443882687b055fffad9b4fe9f7f216b6b4d33316c][/img]

7 个解决方案

#1


有个要补充的是,中间部分,也就是第二张图中的那些方格是属于THistory(父类:TCustomControl),是THistory画出来的。

也就是说TCustomControl的都正常,而TGraphicControl经过几次动态变化后就出问题了。

//这个函数用来类型变换。
procedure THistory.SetItemInf(const Value: TItemInf);
var
    I: Integer;
begin
    if Value.RecordCount > FItemInf.RecordCount then
    begin
        SetLength(FItems, Value.RecordCount);
        for I := FItemInf.RecordCount to Value.RecordCount-1 do
        begin
            FItems[I] := THistoryItem.Create(self);
        end;
    end;
    if FItemInf.RecordCount > Value.RecordCount then
    begin
        for I := Value.RecordCount to FItemInf.RecordCount-1 do
        begin
            FItems[I].Free;
        end;
        SetLength(FItems, Value.RecordCount);
    end;

    {//////////////////////////////////////
    for I := 0 to FItemInf.RecordCount-1 do
    begin
        FItems[I].Free;
    end;
    SetLength(FItems, Value.RecordCount);
    for I:= 0 to Value.RecordCount-1 do
    begin
        FItems[I] := THistoryItem.Create(self);
    end;
    //////////////////////////////////////// }

    FItemInf.RecordCount := Value.RecordCount;
    for I := 0 to FItemInf.RecordCount-1 do
    begin
        FItemInf.Records[I] := Value.Records[I];
        FItems[I].Number := Value.Records[I];
    end;
    SetPosition;
end;

//这个是用来设置他们的位置的。调试的时候位置都没问题。

procedure THistory.SetPosition;
var
    I: Integer;
    ItemPoint: TPoint;
begin
    FIndex.Width := GetHistoryIndexWidth(FItemWidth);
    FTotal.Width := GetHistoryItemWidth(FItemWidth);
    FParity.Width := FTotal.Width;
    FRepeat.Width := FTotal.Width;
    FDistance.Width := FTotal.Width;
    FIndex.Height := FItemHeight;
    FTotal.Height := FItemHeight;
    FParity.Height := FItemHeight;
    FRepeat.Height := FItemHeight;
    FDistance.Height := FItemHeight;

    FIndex.Left := 0;
    FTotal.Left := FIndex.Width + ItemWidth*FItemCount;
    FParity.Left := FTotal.Left + FTotal.Width -1;
    FRepeat.Left := FParity.Left + FParity.Width -1;
    FDistance.Left := FRepeat.Left + FRepeat.Width -1;

    for I := 0 to ItemInf.RecordCount-1 do
    begin
        FItems[I].Width := FItemWidth-2;
        FItems[I].Height := FItemHeight-2;
        ItemPoint := GetItemPoint(FItems[I].Number);
        FItems[I].Left := ItemPoint.X;
        FItems[I].Top := ItemPoint.Y;
    end;

    Width := FDistance.Left + FDistance.Width;
    Height := ItemHeight;
end;

#2


///这个函数用来画出一个红点还有输出一个数字而已,没做什么其他的。

procedure THistoryItem.Paint;
begin
    inherited;
    if bResetTextPoint then SetTextPoint;
    with Canvas do
    begin
        if Number > 0 then begin
            ColorOld := Brush.Color;
            Brush.Color := clRed;
            FillRgn(Handle, Rgn, Brush.Handle);
            Brush.Color := ColorOld;
            
            StyleOld := Brush.Style;
            Brush.Style := bsClear;
            TextOut(PointText.X, PointText.Y, IntToStr(Number));
            Brush.Style := StyleOld;
        end;
    end;
end;

#3


我有数过,一般差不多变个40次左右就出问题了。

#4


我觉得特别奇怪,左边的表示期数的THistoryText就没问题,而右边的却不行。

#5


我晕。。。都没人回答,自己顶一下

#6


有点晕,帮楼主顶

#7


信息不完整,看不出是啥毛病,楼主再查查程序吧,paint不执行,有两种可能,一是THistoryItem对象创建本身出问题,可能没被创建;二是它的容器出问题,阻止了它的重绘过程。

#1


有个要补充的是,中间部分,也就是第二张图中的那些方格是属于THistory(父类:TCustomControl),是THistory画出来的。

也就是说TCustomControl的都正常,而TGraphicControl经过几次动态变化后就出问题了。

//这个函数用来类型变换。
procedure THistory.SetItemInf(const Value: TItemInf);
var
    I: Integer;
begin
    if Value.RecordCount > FItemInf.RecordCount then
    begin
        SetLength(FItems, Value.RecordCount);
        for I := FItemInf.RecordCount to Value.RecordCount-1 do
        begin
            FItems[I] := THistoryItem.Create(self);
        end;
    end;
    if FItemInf.RecordCount > Value.RecordCount then
    begin
        for I := Value.RecordCount to FItemInf.RecordCount-1 do
        begin
            FItems[I].Free;
        end;
        SetLength(FItems, Value.RecordCount);
    end;

    {//////////////////////////////////////
    for I := 0 to FItemInf.RecordCount-1 do
    begin
        FItems[I].Free;
    end;
    SetLength(FItems, Value.RecordCount);
    for I:= 0 to Value.RecordCount-1 do
    begin
        FItems[I] := THistoryItem.Create(self);
    end;
    //////////////////////////////////////// }

    FItemInf.RecordCount := Value.RecordCount;
    for I := 0 to FItemInf.RecordCount-1 do
    begin
        FItemInf.Records[I] := Value.Records[I];
        FItems[I].Number := Value.Records[I];
    end;
    SetPosition;
end;

//这个是用来设置他们的位置的。调试的时候位置都没问题。

procedure THistory.SetPosition;
var
    I: Integer;
    ItemPoint: TPoint;
begin
    FIndex.Width := GetHistoryIndexWidth(FItemWidth);
    FTotal.Width := GetHistoryItemWidth(FItemWidth);
    FParity.Width := FTotal.Width;
    FRepeat.Width := FTotal.Width;
    FDistance.Width := FTotal.Width;
    FIndex.Height := FItemHeight;
    FTotal.Height := FItemHeight;
    FParity.Height := FItemHeight;
    FRepeat.Height := FItemHeight;
    FDistance.Height := FItemHeight;

    FIndex.Left := 0;
    FTotal.Left := FIndex.Width + ItemWidth*FItemCount;
    FParity.Left := FTotal.Left + FTotal.Width -1;
    FRepeat.Left := FParity.Left + FParity.Width -1;
    FDistance.Left := FRepeat.Left + FRepeat.Width -1;

    for I := 0 to ItemInf.RecordCount-1 do
    begin
        FItems[I].Width := FItemWidth-2;
        FItems[I].Height := FItemHeight-2;
        ItemPoint := GetItemPoint(FItems[I].Number);
        FItems[I].Left := ItemPoint.X;
        FItems[I].Top := ItemPoint.Y;
    end;

    Width := FDistance.Left + FDistance.Width;
    Height := ItemHeight;
end;

#2


///这个函数用来画出一个红点还有输出一个数字而已,没做什么其他的。

procedure THistoryItem.Paint;
begin
    inherited;
    if bResetTextPoint then SetTextPoint;
    with Canvas do
    begin
        if Number > 0 then begin
            ColorOld := Brush.Color;
            Brush.Color := clRed;
            FillRgn(Handle, Rgn, Brush.Handle);
            Brush.Color := ColorOld;
            
            StyleOld := Brush.Style;
            Brush.Style := bsClear;
            TextOut(PointText.X, PointText.Y, IntToStr(Number));
            Brush.Style := StyleOld;
        end;
    end;
end;

#3


我有数过,一般差不多变个40次左右就出问题了。

#4


我觉得特别奇怪,左边的表示期数的THistoryText就没问题,而右边的却不行。

#5


我晕。。。都没人回答,自己顶一下

#6


有点晕,帮楼主顶

#7


信息不完整,看不出是啥毛病,楼主再查查程序吧,paint不执行,有两种可能,一是THistoryItem对象创建本身出问题,可能没被创建;二是它的容器出问题,阻止了它的重绘过程。