• Крош (08.02.12 11:08) [0]
    Добрый день, Уважаемые знатоки. Подскажите пожалуйста, как реализовать эффект бесконечных титров (вертикального скроллинга текста). Прокрутка мемо (всем устраивает, если бы не дергались строки, т.е. не плавно прокручиваются), перемещение метки тоже не вариант (дергается). Подскажите как такое сотворить. Пример будет только в радость, который приму с великой благодарностью.
  • Крош (08.02.12 11:12) [1]
    P.S.
    Текст не фиксированный, а подгружается из текстового файла.
  • Vladimyr © (08.02.12 14:19) [2]
    можно рисовать текст на канве...
    конечно, придётся чуток разобраться, как именно, но это несложно
    зато потом можно делать это абсолютно так, как хочется!
  • Крош (10.02.12 00:25) [3]
    Плиз. Подскажите.
    ...
    Timer1: TKOLTimer;
    PB2: TKOLPaintBox;
    ...
    x,y,i:Integer;
    s:PStrList;
    ...
    procedure TForm1.KOLFormFormCreate(Sender: PObj);
    begin
    x:=PB2.Width div 7;
    y:=PB2.Height;
    i:=1;
    PB2.Font.FontName:='Tahoma';
    s:=NewStrList;
    s.LoadFromFile('readme.txt');
    end;

    procedure TForm1.Timer1Timer(Sender: PObj);
    begin
    y:=y-1;
    if y=-10*s.Count then y:=PB2.height+10;
    PB2.Canvas.Font.Color:=$000576DC;
    for i:=1 to s.Count do begin
    PB2.Canvas.TextOut(x,y+10*i, s.Items[i]);
    end;

    Все рисуется, крутится, однако сильно сомневаюсь в правильности сего решения.
    1. немного мерцает (но с прокруткой мемо не сравнить),
    2. Как правильно добиться  вывода текста по центру.
  • Крош (10.02.12 01:28) [4]
    Обнаружил архив форума, если скачать, то как его локально можно смотреть?
  • G-Host © (10.02.12 02:07) [5]
    1. Таймер должен только изменять переменную y и вызывать перерисовку необходимой области. Сама работа с канвой должна проходить в методе OnPaint.
    2. Получай размер строки при помощи TCanvas.TextExtent
  • Vladimyr © (10.02.12 09:17) [6]
    я делал так:
    1. создавал два битмапа
    2. рисовал на одном текст
    3. выводил его на канву
    4. рисовал текст на другом
    5. менял их местами
    ничего не мерцает, работает мухой даже на очень медленных
    процах (КПК)

    чтобы отцентрировать текст, надо исп. ф-цию рисования,
    которая не рисует, но позволяет узнать получившийся размер
    (не помню, как она называется), затем рассчитать новое
    положение текста, уже зная размер, который он займёт...
    и потом рисовать "по-настоящему"
  • Vladimyr © (10.02.12 09:17) [7]
    собссно, TextExtent :))
  • Крош (10.02.12 11:36) [8]
    Спасибо Вам всем. Все переделал.
    Vladimyr, а можно увидеть Ваше решение? Для меня пока все это немного туманно, поэтому буду рад посмотреть как Вы это реализовали.
  • Крош (11.02.12 00:55) [9]
    Под семеркой с аэро, PaintBox почему то становится прозрачным. Под XP все нормально, под 7 с упрощенной темой тоже. Что не так?
  • Крош (11.02.12 11:32) [10]
    При создании формы:
    Bmp2 := NewBitmap( PB2.Width, PB2.Height );
    Bmp2.BkColor:=clBlack;
    В событие отрисовки PaintBox, перед рисованием на канве добавил
    Bmp2.Draw(PB2.Canvas.Handle,0,0);
    Теперь PaintBox не прозрачный, но сильно мерцает :(
  • RusSun © (11.02.12 20:32) [11]
    Всем привет)
    to Vladimir можно посмотреть на Ваше решение )
    у меня тоже простенький вариант получился а вот

    > 5. менял их местаминичего не мерцает, работает мухой даже
    > на очень медленных

    не очень получается.
  • Крош (14.02.12 19:25) [12]
    Вывожу текст:
    DrawText(PaintBox.Canvas.Handle,pchar(s),length(s),r,DT_CENTER);
    Никак не могу изменить шрифт и цвет(рисует черным цветом с белым фоном). Ясен день, что как то просто, но не получается....
  • RusSun © (14.02.12 19:57) [13]
    PaintBox.Font.FontHeight := 30;

    PaintBox.Canvas.Font.Color := TColor(clBlue);

  • Крош (14.02.12 20:03) [14]
    Сорри, как и думал, малость тупанул.
  • Крош (14.02.12 20:08) [15]
    to RusSun
    так почемуто не работает...
    а вот так пашет:
    SetTextColor(PaintBox.Canvas.Handle,clWhite);
  • RusSun © (14.02.12 20:12) [16]
    procedure TimerTimer(Dummy : Pointer;Sender:PControl);
    begin
    y:=y-2;
    if y=-10*s.Count then y:=PB2.height+20;
    //PB2.Canvas.Font.Color:=$008000 ;//$000576DC
    PB2.Font.FontHeight := 30;

    PB2.Canvas.Font.Color := TColor(clBlue);
    //PB2.canvas.font
    for i:=1 to s.Count do begin
    PB2.Canvas.TextOut(x,y+20*i, s.Items[i]);

                            end;

    end;

  • RusSun © (14.02.12 20:17) [17]
  • Крош (14.02.12 20:44) [18]
    Это да, в этом случае без проблем, но если использовать не TextOut, а DrawText (красивее выводится текст):
    ...
    pos: integer;
    R: TRect;
    ...
    pos:=PB2.Top;
    ...
    procedure TForm1.Timer1Timer(Sender: PObj);
    begin
    r.left:=1;
    r.top:=pos;
    r.Right:=PainBox.Width;
    r.Bottom:=PainBox.Height;

    dec(pos);

    PB2.Canvas.Brush.Color:=clBlack; // 1
    PB2.Canvas.Brush.BrushStyle:= bsClear; //2
    DrawText(PB2.Canvas.Handle,pchar(s),length(s),r,DT_CENTER);
    if pos<-PB2.Height then pos:=220;
    end;

    Если без строк 1 и 2 то выводит красиво, но не тем шрифтом и цветом и затирает фон. С 1 и 2 все размазывается.
  • Крош (14.02.12 21:12) [19]
    Млин, напутал.
    Не:
    PB2.Canvas.Brush.Color:=clBlack; // 1
    PB2.Canvas.Brush.BrushStyle:= bsClear; //2
    а
    SetTextColor(PB2.Canvas.Handle,clWhite); //1
    SetBkMode(PB2.Canvas.Handle,TRANSPARENT); //2
  • Vladimir Kladov © (14.02.12 21:38) [20]
    Список демок смотрели?
  • Крош (14.02.12 22:01) [21]
    Спасибо, Smooth scrolling on paint box using thread.
    Буду изучать.
  • RusSun © (16.02.12 20:32) [22]
    program Project1;

    uses
     windows,messages,
     kol;
    type  TOnEvent = procedure( Sender: PObj )of object;
           TOnThreadExecute = function(Sender:PThread): Integer of object;
            TObjectMethod = procedure of object;

    {$R *.res}
    var
    form,PBox,Pan,
    EB1,B1,B2,L1,
    Use_Scroll,Half_pixel:PControl;

    Thread1:PThread;

    OffsetX: Integer;
    //LastTik: DWORD;
    Bmp, Bmp2: PBitmap;

    TextToScroll: String = 'Sample smooth scrolling text';
       Period: DWORD = 16; // better values = N * (1000 / VSync_in_Hertz)
       useScroll: Boolean = TRUE;
       halfPixel: Boolean = TRUE;
       step: Integer;

    //область для процедур
    procedure PBoxPaint(dummy:pointer;Sender: PControl; DC: HDC);
    var R: TRect;
       Big, B: PBitmap;
       h: Integer;
    begin
       if  (Bmp <> nil)
       and (Bmp.Width <> PBox.Width)
       and (Bmp.Height <> PBox.Height) then
           Free_And_Nil( Bmp );
       if  Bmp = nil then
       begin
           Bmp := NewBitmap( PBox.Width, PBox.Height );
           Bmp.Canvas.Brush.Color := clWindow;
           Bmp.Canvas.Font.Assign( PBox.Font );
           Bmp.Canvas.Font.FontQuality := fqAntialiased;
           h := Bmp.Canvas.TextHeight(TextToScroll);
           Bmp.Canvas.TextRect( Bmp.BoundsRect, 0, (Bmp.Height - h) div 2,
               TextToScroll );
           //Bmp.SaveToFile( GetStartDir + 'bmp.bmp' );

           Big := NewDibBitmap( Bmp.Width*2, Bmp.Height, pf32bit );
           Big.Canvas.Brush.Color := clWindow;
           Big.Canvas.FillRect( Big.BoundsRect );
           SetStretchBltMode( Big.Canvas.Handle, halftone );
           Bmp.StretchDraw( Big.Canvas.Handle, MakeRect( 1, 0, Big.Width+1, Big.Height ) );

           Bmp2 := NewDibBitmap( Bmp.Width, Bmp.Height, pf32bit );
           SetStretchBltMode( Bmp2.Canvas.Handle, halftone );
           Big.StretchDraw( Bmp2.Canvas.Handle, Bmp2.BoundsRect );
           //Bmp2.SaveToFile( GetStartDir + 'bmp2.bmp' );
           Big.Free;
       end;

       if  step and 1 = 1 then
           B := Bmp
       else
           B := Bmp2;
       R := PBox.ClientRect;
      //  OffsetRect( R, -OffsetX,0  );
       OffsetRect( R, 0, -OffsetX);
       B.Draw( Sender.Canvas.Handle, R.Left, R.Top );
       // OffsetRect( R, PBox.Width, 0  );
       OffsetRect( R,  0, PBox.Height );
       B.Draw( Sender.Canvas.Handle, R.Left, R.Top );

       if  Thread1.Suspended then
           Thread1.Resume;
    end;
    procedure FormDestroy(dummy:pointer;Sender: PObj);
    begin
       Free_And_Nil( Bmp );
       Free_And_Nil( Bmp2 );
    end;

    procedure EB1Change(dummy:pointer;Sender: PObj);
    var n: Integer;
    begin
       n := Str2Int( EB1.Text );
       if  n > 0 then
           Period := n;
    end;

    procedure B1Click(dummy:pointer;Sender: PObj;var mouse:TMouseEventData);
    var n: Integer;
    begin
       n := Str2Int( EB1.Text ) - 1;
       if  n > 0 then
           EB1.Text := Int2Str( n );
    end;

    procedure B2Click(dummy:pointer;Sender: PObj;var mouse:TMouseEventData);
    var n: Integer;
    begin
       n := Str2Int( EB1.Text ) + 1;
       if  n > 0 then
           EB1.Text := Int2Str( n );
    end;

    function PBoxMessage(dummy:pointer;var Msg: tagMSG;
     var Rslt: Integer): Boolean;
    begin
       Result := FALSE;
       if  Msg.message = WM_ERASEBKGND then
       begin
           Result := TRUE;
           Rslt := 1;
       end;
    end;

    {procedure TForm1.KOLForm1FormCreate(Sender: PObj);
    begin
       //SetThreadPriority( GetCurrentThread, THREAD_PRIORITY_ABOVE_NORMAL );
    end; }


    procedure Use_ScrollClick(dummy:pointer;Sender: PObj);
    begin
       useScroll := Use_Scroll.Checked;
    end;

    function Thread1Execute(dummy:pointer;Sender: PThread): Integer;
    begin
       step := 0;
       while not AppletTerminated do
       begin
           inc( step );
           if  (step and 1 = 0) or not halfPixel then
           begin
               inc( OffsetX );
               if  OffsetX >= PBox.Height then   // PBox.Width
                   OffsetX := 0;
           end;
           if  useScroll
           and (not halfPixel
               or halfPixel and (step and 1 = 0)) then
           begin
               ScrollWindow( PBox.Handle, 0,-1 , nil, nil );
           end
             else
           begin
               PBox.Invalidate;
           end;
           PBox.Update;
           Sleep( Period );

       end;
       Result := 0;
    end;

    procedure PBoxResize(dummy:pointer;Sender: PObj);
    begin
       PBox.Invalidate;
       PBox.Update;
    end;

    procedure Half_pixelClick(dummy:pointer;Sender: PObj);
    begin
       halfPixel := Half_pixel.Checked;
    end;

    Begin
    form:=NewForm(Applet,'Form1').SetClientSize( 431, 71 ).setposition(330,300);
    form.Font.FontHeight := 16;
    form.Font.FontName := 'Arial';
    PBox := NewPaintBox( Form ).SetAlign ( caClient );
    {$IFDEF UNICODE_CTRLS}
    PBox.SetUnicode(TRUE);
    {$ENDIF UNICODE_CTRLS}  //for win7
    PBox.Font.FontStyle := [ fsBold ];
    Pan := NewPanel(Form, esRaised ).SetAlign ( caBottom ).SetSize( 0, 33 );

    {$IFDEF UNICODE_CTRLS}
    Panel1.SetUnicode(TRUE);
    {$ENDIF UNICODE_CTRLS}

    L1 := NewLabel( Pan, 'Period: ' ).SetAlign ( caLeft ).AutoSize( TRUE );

    {$IFDEF UNICODE_CTRLS}
    L1.SetUnicode(TRUE);
    {$ENDIF UNICODE_CTRLS}

    L1.VerticalAlign := KOL.vaCenter;

    EB1 := NewEditBox( Pan, [  ] ).SetAlign ( caLeft ).SetSize( 108, 0 );
    {$IFNDEF UNICODE_CTRLS}EB1.SetUnicode( TRUE );{$ENDIF}
    EB1.Text := '16';
    EB1.Color := TColor(clWindow);  // Цвет окна
    B1 := NewButton( Pan, '<' ).SetAlign ( caLeft ).SetSize( 30, 0 );
    {$IFDEF UNICODE_CTRLS}
    B1.SetUnicode(TRUE);
    {$ENDIF UNICODE_CTRLS}

    B2 := NewButton(Pan, '>' ).SetAlign ( caLeft ).SetSize( 30, 0 );
    {$IFDEF UNICODE_CTRLS}
    B2.SetUnicode(TRUE);
    {$ENDIF UNICODE_CTRLS}

    Use_Scroll := NewCheckBox( Pan, 'Use Scroll' ).SetAlign ( caLeft ).AutoSize( TRUE );
    {$IFDEF UNICODE_CTRLS}
    Use_Scroll.SetUnicode(TRUE);
    {$ENDIF UNICODE_CTRLS}
    Use_Scroll.Checked := TRUE;
       // Result.Half_pixel.TabOrder = 4
    Half_pixel := NewCheckBox( Pan, '1/2 pixel' ).SetAlign ( caLeft );

    {$IFDEF UNICODE_CTRLS}
    Half_pixel.SetUnicode(TRUE);
    {$ENDIF UNICODE_CTRLS}
    Half_pixel.Checked := TRUE;

    //.centeronparent.Tabulate;
    //область для работы
    form.OnDestroy:=TOnEvent(MakeMethod(nil,@FormDestroy));
    Thread1:= NewThreadEx(TOnThreadExecute(MakeMethod(nil,@Thread1Execute)));
    Thread1.Resume;

    EB1.OnChange :=TOnEvent(MakeMethod(nil,@EB1Change));
    B1.OnClick :=TOnEvent(MakeMethod(nil,@B1Click));
    B2.OnClick :=TOnEvent(MakeMethod(nil,@B2Click));
    PBox.OnMessage :=TOnMessage(MakeMethod(nil,@PBoxMessage));
    PBox.OnPaint :=TOnPaint(MakeMethod(nil,@PBoxPaint));
    PBox.OnResize :=TOnEvent(MakeMethod(nil,@PBoxResize));
    Half_pixel.OnClick :=TOnEvent(MakeMethod(nil,@Half_pixelClick));
    Use_Scroll.OnClick :=TOnEvent(MakeMethod(nil,@Use_ScrollClick));
    Run(form);
    end.

  • RusSun © (16.02.12 20:59) [23]
    НЕ
    Panel1.SetUnicode(TRUE);

    -опечатка, а
    Pan.SetUnicode(TRUE);

  • rdnks (18.02.12 18:50) [24]
    http://narod.ru/disk/41126662001/
    ddd.7z.html

    Пример здоровый из-за zlib и grush, так как просто из проекта выдернул.
  • rdnks (18.02.12 18:50) [24]
    http://narod.ru/disk/41126662001/
    ddd.7z.html

    Пример здоровый из-за zlib и grush, так как просто из проекта выдернул.
  • rdnks (18.02.12 18:50) [24]
    http://narod.ru/disk/41126662001/
    ddd.7z.html

    Пример здоровый из-за zlib и grush, так как просто из проекта выдернул.
  • rednakse © (22.09.12 13:36) [27]
    2 RusSun стоит убедится что модуль uFMOD совместим с редакцией Delphi, указатели в параметрах, которые передаются в функции not nil =)

    Вот страница на sourceforge. Была полная документация, вроде как даже русская.
    http://ufmod.sourceforge.net/
Есть новые Нет новых   [118241   +25][b:0][p:0.005]