Write on Picshow ERROR

Please post bug reports, feature requests, or any question regarding the DELPHI AREA projects here.

Write on Picshow ERROR

Postby dinghb2006 » January 8th, 2008, 3:14 am

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;
dinghb2006
Member
Member
 
Posts: 1
Joined: January 8th, 2008, 2:51 am

Postby Kambiz » January 8th, 2008, 2:04 pm

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.
Kambiz
User avatar
Kambiz
Administrator
Administrator
 
Posts: 2429
Joined: March 7th, 2003, 7:10 pm


Return to DELPHI AREA Projects

Who is online

Users browsing this forum: No registered users and 5 guests

cron