Перейти к содержанию
Fire Monkey от А до Я

OnePeople

Пользователи
 Профиль  Обзор контента

  • Постов

    326

  • Зарегистрирован

  • Посещение

  • Победитель дней

    57

 Тип контента 

Сообщения, опубликованные OnePeople

    MD5

    в ВКонтакте API

    Опубликовано

    Формирую запрос, отправляю метод на поиск аудиозапесей, добовляю sig
      

    ...

md5param:='&q='+reqest+'&auto_complete=1&lyrics=0&performer_only=0&sort=0&search_own=0';

  with fGeneral.RESTRequest1.Params.AddItem do
    begin
      name:='sig';
      Value:=md5('/method/'+fGeneral.RESTRequest1.Resource+'?v=5.28&https=1'+md5param+'&count=100&offset=1&access_token='+fGeneral.OAuth2Authenticator1.AccessToken+fGeneral.OAuth2Authenticator1.ClientSecret);
    end;

      

    function md5(s: string): string;
begin
Result := '';
with TIdHashMessageDigest5.Create do
try
Result := AnsiLowerCase(HashStringAsHex(s));
finally
Free;
end;
end;

     

    Проблема в том что когда запрос reqest на английском все нормально, а когда на русском пишет что неправильная сумма md5. Что делать с русским?

    Глюк анимации

    в Анимация

    Опубликовано · Изменено пользователем OnePeople

    Вот видео в конце все видно, то нормально все, то вот такое проявление белого цвета, не могу понять от чего?

    Вот код анимации 

    procedure TfGeneral.AnimateLay(TekLay,NewLay:TLayout;lb,fobj:IControl;dtr:Boolean;textdstr,textitle,cat:String);
var
Hpos,Tpos:Single;
begin
TekControlUpr:=fobj;
TekControlLay:=NewLay;
TekControlItemCat:=cat;
perehod:=true;

BlurTransitionEffect1.Parent:=lOsn;
BlurTransitionEffect1.Enabled:=true;
BlurTransitionEffect1.Progress:=0;

Hpos:= lBottom.Position.Y;
Tpos:= lTop.Position.Y;
TAnimator.AnimateFloat(lBottom,'Position.Y',Hpos+120,0.35, TAnimationType.Out, TInterpolationType.Linear);
TAnimator.AnimateFloat(lTop,'Position.Y',TPos-150,0.35, TAnimationType.Out, TInterpolationType.Linear);
TAnimator.AnimateFloatWait(BlurTransitionEffect1,'Progress',100,0.35, TAnimationType.Out, TInterpolationType.Linear);

tTitle.Text:=textitle;
if dtr=true then
  begin
  	tAtrib.Text:=textdstr;
  	tAtrib.Visible:=true;
  end else 
      begin
        tAtrib.Text:='';
        tAtrib.Visible:=false;
      end;

TekLay.Visible:=false;
NewLay.Visible:=true;
NewLay.BringToFront;

  if  (NewLay=lVideo) or (NewLay=lGames) or ((NewLay=lFileChange) and (FileExists(sViewBtn1.Text))) then AddListPotok.Resume;
  
  if NewLay=lMusic then
    begin
        rMusicLeft.Position.X:= -rMusicLeft.Width;
        rMusicRight.Position.X:= rMusicRight.Width+rMusicLeft.Width;
        lbTekPlaylist.ApplyStyleLookup;
        lMiniMusicPlayer.Visible:=false;
        lMiniMusicPlayer.Opacity:=0;
    end else
       begin
         if MusicMode=Playing then
             begin
              lMiniMusicPlayer.Visible:=true;
              TAnimator.AnimateFloat(lMiniMusicPlayer,'Opacity',1,0.35);
             end;
       end;
TAnimator.AnimateFloat(lBottom,'Position.Y',Hpos,0.35, TAnimationType.Out, TInterpolationType.Linear);
TAnimator.AnimateFloat(lTop,'Position.Y',TPos,0.35, TAnimationType.Out, TInterpolationType.Linear);
TAnimator.AnimateFloatWait(BlurTransitionEffect1,'Progress',0,0.35, TAnimationType.Out, TInterpolationType.Linear);BlurTransitionEffect1.Progress:=0;
BlurTransitionEffect1.Enabled:=false;
fobj.SetFocus;
TekControlBox:=lb;
ShowLay:=NewLay;
if AllControlItemIndex>0 then 
	begin
      TekControlItemIndex:=0;
      PredControlItemIndex:=0;
      ChangeControlItem(VNaprControlItemIndex,false,ColumnControlItemIndex);
    end;

perehod:=false;
end;

     

    pyWorld 2016-05-22 16-15-45-302.rar

    IdUDPServer1UDPRead на Андроид

    в TidUDPServer

    Опубликовано · Изменено пользователем OnePeople

    procedure TForm1.IdUDPServer1UDPRead(AThread: TIdUDPListenerThread;
      const AData: TIdBytes; ABinding: TIdSocketHandle);
     
    Ругается на константы. Как заставить работать???
    Добавлял для AData в uses idGlobal;
    Но всё равно с AData ничего не сделать, на все его параметры среда ругается(
     
    Вообще у меня Client нормально всё отрабатывает, а на компе сервер отвечает, может как то клиентом можно отловить ответ сервера?

    Настройки печати

    в Windows

    Опубликовано · Изменено пользователем OnePeople

    Спасибо за помощь, не могу завести( Делаю так

    uses PrinerAPI;

var
MyPrinter:TMyPrinter;
begin
  if (MyPrinter<>NIL)and(not SameText(MyPrinter.PrinterName, Printer.ActivePrinter.Device)) then
    FreeAndNil(MyPrinter);


  MyPrinter:=TMyPrinter.Create(Printer.ActivePrinter.Device,false);
MyPrinter.PrinterProperties;

    Access V в PrinterAPI

     

    procedure TMyPrinter.Get_Printer(DevModePtr:PDeviceMode);
var
  pi:TPrinterInfo9;
  sz:integer;
  buf:PPrinterInfo9;
  r:Cardinal;
  InfoKind:integer;
begin
  sz:=0;
  CheckError();
  pi.pDevMode := DevModePtr;
  if UseDefaultSettings then
    InfoKind := 8
  else
    InfoKind := 9;
  r:=GetLastError;
  if r<>0 then
    RaiseLastOSError;


  if not Winapi.Winspool.GetPrinter(Handle, InfoKind, nil, 0, @sz) then
  begin
    r:=GetLastError;
    if r<>ERROR_INSUFFICIENT_BUFFER then
      RaiseLastOSError
    else
      if sz=8 then
    // shit happens. windows не говорит, каого размера буфер ей надо (((
      sz:=10000;
  end;
  buf:=getmemory(sz);
  try


    if not Winapi.Winspool.GetPrinter(Handle, InfoKind, buf, sz, @sz) then
      RaiseLastOSError
    else
      SetLastError(0);
----------------------------------------------------------------------------------------------------------
    MoveMemory(DevModePtr, buf.pDevMode, buf.pDevMode.dmSize+buf.pDevMode.dmDriverExtra);  --ЗДЕСЬ
----------------------------------------------------------------------------------------------------------
  finally
    freeMemory(buf);
  end;

     

    P.S. Извеняюсь всё работает, просто от администратора нужно запускать, ничего манифест добавлю)))

    Настройки печати

    в Windows

    Опубликовано · Изменено пользователем OnePeople

    Делаю простинькую настройку печати из Memo

    var
m:Single;
i,page,pageall:integer;
DestRect:TRectF;
  textFill: tFillTextFlags;
  stranp:TStringList;
  pt:Boolean;
begin
m:= Memo2.Lines.Count-1;
pageall:=Round(m) div 67;
if Round(m) mod 67>0 then  pageall:=pageall+1;

  textFill := [];
  Printer.Title := Memo2.Lines.Strings[0];
  Printer.Copies := StrToInt(SpinBox1.Text);
 // Printer.Orientation := poLandscape;
  stranp:=TStringList.Create;
  Printer.ActivePrinter:=Printer.Printers[Combobox1.ItemIndex];

  Printer.BeginDoc;

  Printer.Canvas.Font.Size   := 14;
  Printer.Canvas.Font.Family:='Arial';

  page:=1;
  pt:=true;
     while (not Printer.Aborted) and (Printer.Printing) and (pt) do
     begin
     stranp.Clear;
     for I := 0 to 67 do begin
                         if i+((page-1)*67)<=Memo2.Lines.Count-1 then
                         stranp.Add(Memo2.Lines.Strings[i+((page-1)*67)]+' '+IntToStr(pageall));
                         end;
     DestRect := RectF(100,100,(Printer.Pagewidth - 100),(Printer.PageHeight - 100));
     Printer.Canvas.FillText(DestRect,stranp.Text,True,1,textFill,TTextAlign.Center,TTextAlign.Leading);
     Inc(page);
     if (page <= pageall) and (not printer.aborted)
     then begin 
          Printer.NewPage;
          end else begin
                   pt:=false;
                   end;
     end;
  Printer.EndDoc;
  stranp.Free;
end;
    Всё отлично работает, кроме того что я хочу открыть настройки печати самого принтера
    Printer.ActivePrinter.ShowDeviceOptions;

    Не работает( Там даже кода нет( 

     

    И ещё вопрос как узнать состояние принтера готов не готов в WinApi будет GetPrinter(hPrinter, PRINTER_INFO_2... , как в Обезьяне сделать?

    Отключить прокрутку

    в TListBox

    Опубликовано

    Платформа: Windows

    Delphi: Seatle

     

    Есть листбокс прокручивается клавишами с клавиатуры. В XE8 был баг и прокрутки своей небыло, делал так

    scb:=VideoList.FindStyleResource('vscrollbar') as TScrollBar;
posIt:= (VideoList.ItemIndex div vidcolumn) * VideoList.ItemHeight;
posVer:=scb.Value;
posNiz:=scb.Value+VideoList.Height;

if posIt>posNiz-VideoList.ItemHeight then
      begin
      TAnimator.AnimateFloat(scb,'Value',(VideoList.ItemIndex div 5) * VideoList.ItemHeight-VideoList.Height+VideoList.ItemHeight,0.25);
      end;

if posIt<posVer then
      begin
      TAnimator.AnimateFloat(scb,'Value',(VideoList.ItemIndex div 5) * VideoList.ItemHeight,0.25);
      end;

    Сейчас прокрутка есть но не плавная, подскажите пожалуйста как сделать плавную или вообще её отключить!

    P.S. когда не было прокрутки, меня мой вариант устраивал

     

    Контрол внутри ListBox

    в TListBox

    Опубликовано

    Хотел сделать эффект что бы при наведении Item увеличивался, с Item манимуляции ни к чему не привели так как он оказывается за другими Itemами, сделал создание в ListBox контрола. Все работает но как позиция моего контрола становиться большее 1500 контрол исчезает((

    procedure TForm1.VideoListChange(Sender: TObject);
  var
  scb:TScrollBar;
  posVer,posIt,posNiz:Single;
  po:Real;
  bmp:TBitmap;
begin
po:=  (VideoList.ItemIndex div vidcolumn)* VideoList.ItemHeight;
FocusItem.Position.X:=(((VideoList.ItemIndex mod vidcolumn)* VideoList.ItemWidth))*mashX+9;
FocusItem.Position.Y:=(po)*mashY+9;
if VideoList.Items.Count-1>=predit then VideoList.ItemByIndex(predit).Opacity:=1;
scb:=VideoList.FindStyleResource('vscrollbar') as TScrollBar;
posIt:= (VideoList.ItemIndex div vidcolumn) * VideoList.ItemHeight;
posVer:=scb.Value;
posNiz:=scb.Value+VideoList.Height;

if posIt>posNiz-VideoList.ItemHeight then
      begin
      TAnimator.AnimateFloat(scb,'Value',(VideoList.ItemIndex div 5) * VideoList.ItemHeight-VideoList.Height+VideoList.ItemHeight,0.15);
      end;
if posIt<posVer then
      begin
      TAnimator.AnimateFloat(scb,'Value',(VideoList.ItemIndex div 5) * VideoList.ItemHeight,0.15);
      end;



VideoList.ItemByIndex(VideoList.ItemIndex).StylesData['Rectangle2.Fill.Color']:=$CF0C0C0C;
VideoList.ItemByIndex(VideoList.ItemIndex).StylesData['Icon.Opacity']:=1;

 FocusItem.Align:=TAlignLayout.None;
bmp:=TBitmap.Create;
bmp.Assign(VideoList.ItemByIndex(VideoList.ItemIndex).ItemData.Bitmap);

VideoList.ItemByIndex(VideoList.ItemIndex).Opacity:=0;
po:= ( ((VideoList.ItemIndex div vidcolumn)* VideoList.ItemHeight));
FocusItem.Position.X:=(((VideoList.ItemIndex mod vidcolumn)* VideoList.ItemWidth))*mashX+9;
FocusItem.Position.Y:=(po)*mashY+9;

predit:=VideoList.ItemIndex;
ItemIcon.Fill.Bitmap.Bitmap:=Bmp;
ItemText.Text:=VideoList.ItemByIndex(VideoList.ItemIndex).ItemData.Text;
FocusItem.Width:=VideoList.ItemWidth-18;
FocusItem.Height:=VideoList.ItemHeight-18;
FocusItem.Visible:=true;
FocusItem.Opacity:=1;
FocusItem.BringToFront;
TAnimator.AnimateFloat(FocusItem,'Width',FocusItem.Width+(14*(FocusItem.Width/FocusItem.Height)),0.25);
TAnimator.AnimateFloat(FocusItem,'Height',FocusItem.Height+14,0.25);
Title.Text:=FloatToStr(FocusItem.Position.X)+''+FloatToStr(FocusItem.Position.y);
TAnimator.AnimateFloat(FocusItem,'Position.X',FocusItem.Position.X-(7*(FocusItem.Width/FocusItem.Height)),0.25);
TAnimator.AnimateFloat(FocusItem,'Position.Y',FocusItem.Position.Y-7,0.25);
bmp.Free;
end;

    post-1053-0-59521000-1435594572_thumb.jp

    post-1053-0-52316100-1435594606_thumb.jp

    TetheringManager

    в Tethering

    Опубликовано

    Попробуй реализовать отправку внутри нового потока

    Нет ну это само сабой, просто я думал может есть какой нибудь ключ, для отправки вне основного потока. Почему для таких компонентов сразу так не делать?

    TetheringManager

    в Tethering

    Опубликовано

     

    Отправляю список файлов по WiFi, программа стопориться до конца отправки, как этого избежать?(

    if AResource.Hint='GetPlayList' then
   begin
      try
      for p := 0 to TetheringManager1.RemoteProfiles.Count-1 do
      TetheringAppProfile1.SendString(TetheringManager1.RemoteProfiles[p],'MusicClear','1');
      except
      end;

   for i := 0 to PlayList.Items.Count-1 do
      begin
        try
        for p := 0 to TetheringManager1.RemoteProfiles.Count-1 do
        TetheringAppProfile1.SendString(TetheringManager1.RemoteProfiles[p],'AddMusic',IntToStr(i)+'.'+PlayList.Items.Strings[i]);
        except

        end;
      end;


   end;

     

×
×
  • Создать...