Write on Picshow ERROR
I want to write a dynammic text When the picture slides.
but the my programme cannot run,OR after show several pic the programme does not have the response ,I have to terminate by TASKmgr
my code like this
but the my programme cannot run,OR after show several pic the programme does not have the response ,I have to terminate by TASKmgr
my code like this
- Code: Select all
procedure TMain.DBPicShow1AfterNewFrame(Sender: TObject; Picture,
Screen: TBitmap);
var
W, H,intI,intLineNumber: Integer;
S,TextType,S1,S2: string;
begin
TextType:=QPicPlay.Fieldbyname('HIP_TypeName').AsString;
if TextType='0' then exit;
memo1.Lines.Clear;
if TextType='1' then //RoomPrice
Begin
QRoomInfo.First;
Memo1.Lines.Add('Welcome+_HotelName);
Memo1.Lines.Add('Today Room Price);
intLines:=2;
if QRoomInfo.RecordCount<=10 then
Begin
while not QRoomInfo.Eof Do
Begin
intI:=length(QRoomInfo.fieldbyname('RA_Name').AsString+'¥'+QRoomInfo.Fieldbyname('RA_Price').AsString);;
Memo1.Lines.Add(QRoomInfo.fieldbyname('RA_Name').AsString+stringofChar(' ',20-intI)+'¥'+QRoomInfo.Fieldbyname('RA_Price').AsString);
intLines:=intLines+1;
QRoomInfo.Next;
END;
end
ELSE
BEGIN
WHILE NOT QRoomInfo.Eof Do
Begin
intI:=length(QRoomInfo.fieldbyname('RA_Name').AsString+'¥'+QRoomInfo.Fieldbyname('RA_Price').AsString);;
S1:=QRoomInfo.fieldbyname('RA_Name').AsString+stringofChar(' ',15-intI)+'¥'+QRoomInfo.Fieldbyname('RA_Price').AsString;
QRoomInfo.Next;
S2:=QRoomInfo.fieldbyname('RA_Name').AsString+stringofChar(' ',15-intI)+'¥'+QRoomInfo.Fieldbyname('RA_Price').AsString;
Memo1.Lines.Add(S1+stringofChar(' ',36-length(S1)-LENGTH(S2))+S2);
QRoomInfo.Next;
intLines:=intLines+1;
end;
END;
with Picture.Canvas do
begin
Font.Name := '隶书';
Font.Size := 38;
Font.Color := clBlue;
Brush.Style := bsClear;
end;
intI:=0;
while intI <=intLines dO
Begin
S:=Memo1.Lines[intI];
with Picture.Canvas Do
TextOut((Width- TextWidth(S)) div 2,(intI)*TextHeight(S)+TextHeight(S),S);
intI:=intI+1;
End;
End;
end;