Page 1 of 1

Write on Picshow ERROR

PostPosted: January 8th, 2008, 3:14 am
by dinghb2006
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

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;

PostPosted: January 8th, 2008, 2:04 pm
by Kambiz
1. The last while loop's condition must be: intI < intLines
2. You have to write on Screen bitmap inside OnAfterNewFrame event
3. Your code is too complex. You should prepare the text before starting the transition.