Зацикливается OnPaint

← →
elected (2004-11-22 03:36) [0]

Пишу компонент
отображения текста на основе имеющихся картинок-букв
Проблема в том что когда компонент лежит на форме все нормально
а когда в работающем приложении зацикливается OnPaint
Помогите что делать ?

unit GraphicLabel;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;

type

TGraphicLabel = class(TPaintBox)
private
FCaption:TCaption;
FRowInterval:integer;
FCharInterval:Integer;
FAlignment:TAlignment;
FAutoSize:Boolean;
FOnPaint: TNotifyEvent;

procedure SetCaption(value:TCaption);
{ Private declarations }
protected
{ Protected declarations }
procedure Paint; override;
public
FontPicture:array[0..255] of TPicture;
procedure DrawImageBlock(DrawObject:TPaintBox; ImArray:array of TPicture; ImString:String; ImStringShift, ImShift:Integer; Alignment:TAlignment; AutoSize:Boolean);
procedure AssignFontPicture(FPicture: array of TPicture);
destructor Destroy; override;
constructor Create(aowner:Tcomponent);override;
{ Public declarations }
published
property Caption:TCaption read FCaption write SetCaption ;
property RowInterval:integer read FRowInterval write FRowInterval default -5 ;
property CharInterval:integer read FCharInterval write FCharInterval default 22;
property Alignment:TAlignment read FAlignment write FAlignment default taLeftJustify;
property AutoSize:Boolean read FAutoSize write FAutoSize default true;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;

{ Published declarations }
end;

implementation

procedure TGraphicLabel.AssignFontPicture(FPicture: array of TPicture);
var f:integer;
begin
for f:=0 to length(FPicture) do
begin
if f>length(FontPicture) then Break;
if assigned(FPicture[f]) then
begin
FontPicture[f]:=TPicture.Create;
FontPicture[f].Assign(FPicture[f].Graphic);
end;
end;

end;

procedure TGraphicLabel.SetCaption(value:TCaption);
begin
FCaption:=value;
Self.Repaint;
end;

procedure TGraphicLabel.Paint;
begin
if Assigned(FOnPaint) then FOnPaint(Self);
DrawImageBlock(self, FontPicture,FCaption,FRowInterval,FCharInterval, FAlignment,FAutoSize);
inherited Paint;
end;

destructor TGraphicLabel.Destroy;
var
f:integer;
begin
for f :=0 to length(FontPicture)-1 do
begin
if assigned(FontPicture[f]) then FontPicture[f].destroy;
FreeMemory(FontPicture[f]);
end;

inherited Destroy;
end;

constructor TGraphicLabel.Create(Aowner:Tcomponent);
begin

RowInterval:=-5 ;
CharInterval:=22;
Alignment:=taLeftJustify;
AutoSize:=true;

inherited Create(Aowner);
end;

procedure TGraphicLabel.DrawImageBlock(DrawObject:TPaintBox; ImArray:array of TPicture; ImString:String; ImStringShift, ImShift:Integer; Alignment:TAlignment; AutoSize:Boolean);
var
i:Integer;
ImLetterNum:Integer;
ImHeight:Integer;
ImAllTop:Integer;
ImStringCount:Integer;
CurrentImString:Integer;
MaxImWidth:Integer;
ImPosX:array of Integer;
ImTop:array of Integer;
AllImWidth:array of Integer;
begin
if ImString="" then Exit;

exit;

ImStringCount:=1;
SetLength(AllImWidth,1);
SetLength(ImPosX,1);
SetLength(ImTop,1);

for i:=1 to Length(ImString) do
begin

ImLetterNum:=ord(ImString[i]);
if ImLetterNum=13 then
begin
Inc(ImStringCount);
SetLength(AllImWidth,ImStringCount);
SetLength(ImPosX,ImStringCount);
SetLength(ImTop,ImStringCount);
end;
end;

CurrentImString:=0;
AllImWidth[CurrentImString]:=0;

for i:=1 to Length(ImString) do
begin

ImLetterNum:=ord(ImString[i]);
if (assigned(ImArray[ImLetterNum]) and (ImArray[ImLetterNum].Graphic<>nil)) or (ImLetterNum=13) then
begin
if ImLetterNum=13 then
begin
Inc(CurrentImString);
AllImWidth[CurrentImString]:=0;
end else
begin
AllImWidth[CurrentImString]:=AllImWidth[CurrentImString]+ImArray[ImLetterNum].Graphic.Width-ImShift;
ImHeight:=ImArray[ImLetterNum].Graphic.Height;
end;
end;
end;

for i:=0 to ImStringCount-1 do AllImWidth[i]:=AllImWidth[i]+ImShift;

if AutoSize then
begin
MaxImWidth:=0;
for i:=0 to ImStringCount-1 do if AllImWidth[i]>MaxImWidth then MaxImWidth:=AllImWidth[i];
if DrawObject.Width<>MaxImWidth then DrawObject.Width:=MaxImWidth;
if DrawObject.Height<>ImHeight*ImStringCount-ImStringShift*(ImStringCount-1) then DrawObject.Height:=ImHeight*ImStringCount-ImStringShift*(ImStringCount-1);

end;

if not Visible then Exit;

ImAllTop:=DrawObject.ClientRect.Top+(DrawObject.ClientRect.Bottom-DrawObject.ClientRect.Top-ImHeight*ImStringCount-ImStr ingShift*(ImStringCount-1)) div 2;

for i:=0 to ImStringCount-1 do
begin

if Alignment=taLeftJustify then ImPosX[i]:=0;
if Alignment=taCenter then ImPosX[i]:=DrawObject.ClientRect.Left+(DrawObject.ClientRect.Right-DrawObject.ClientRect.Left-AllImWidth[i]) div 2;
if Alignment=taRightJustify then ImPosX[i]:=DrawObject.Width-AllImWidth[i];
ImTop[i]:=ImAllTop+(ImHeight+ImStringShift)*i;
end;

CurrentImString:=0;

for i:=1 to Length(ImString) do
begin

ImLetterNum:=ord(ImString[i]);
if (assigned(ImArray[ImLetterNum]) and (ImArray[ImLetterNum].Graphic<>nil)) or (ImLetterNum=13) then
begin
if ImLetterNum=13 then Inc(CurrentImString)
else begin
DrawObject.Canvas.Draw(ImPosX[CurrentImString],ImTop[CurrentImString],ImArray[ImLetterNum].Graphic);
ImPosX[CurrentImString]:=ImPosX[CurrentImString]+ImArray[ImLetterNum].Graphic.Width-ImShift;
end;
end;
end;

end;

end.

← →
jack128 © (2004-11-22 04:03) [1]

elected (22.11.04 3:36)
TGraphicLabel = class(TPaintBox)
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;

У пайтбокса уже есть событие OnPaint, на что тебе второе??

> procedure TGraphicLabel.DrawImageBlock

Ты серьезно полагаешь, что кто то будет анализировать метод таких размеров? ;-)
Навскидку обилие слов Height, Top вызывает вопрос: а не меняешь ли ты размеры своей метки в этом методе?? Если да, то очевидно будет бесконечная рекурсия.

← →
elected (2004-11-22 04:09) [2]

>>У пайтбокса уже есть событие OnPaint, на что тебе второе??
Паинтбокс стирает изображение при изменении любого параметра

На простой форме этот кусок кода работает же

← →
elected (2004-11-22 04:20) [3]

Зацикливается OnPaint Найти похожие ветки