dnekrasov

Пользователи
  • Публикации

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

  • Посещение

  • Days Won

    6

dnekrasov last won the day on 16 ноября 2016

dnekrasov had the most liked content!

О dnekrasov

  • Звание
    Продвинутый пользователь
  • День рождения 21.02.1974

Информация

  • Пол
    Мужчина
  • Город
    Минск

Посетители профиля

438 просмотров профиля
  1. Вот код, который вернёт путь к исполняемому файлу (тот, который деплоится в "Contents\MacOS\") function GetModuleFName(AModule: Cardinal): string; begin SetLength(Result, MAX_PATH); GetModuleFileName(AModule, @Result[1], MAX_PATH); SetLength(Result, StrLen(PChar(Result))); end; function GetModuleFolder: string; begin Result := IncludeTrailingPathDelimiter(ExtractFilePath(GetModuleFolder(HInstance))); end; :
  2. Лучше использовать System.IOUtils.TPath.GetLibraryPath Встроенный Zip тоже может разбивать по томам. Например команда "zip -r -s 50 ArchiveName.zip FolderName/" упакует всю папку "FolderName" и разобьёт архив по файлам весом 50Mb
  3. По 1-му вопросу для MacOS: function CheckRunning: Boolean; var sl: TStringList; iCount: Integer; s: String; begin sl := TStringList.Create; try GetRunningAplications(sl); iCount := 0; for s in sl do if SameText(s, APP_BundleID) then // APP_BundleID - константа с BundleID приложения Inc(iCount); Exit(iCount < 2) finally sl.Free; end; end; procedure GetRunningAplications(AList: TStrings); var WorkSpace: NSWorkSpace; App: NSRunningApplicationEx; i: Integer; list: NSArray; begin WorkSpace := TNsWorkspace.Wrap(TNsWorkSpace.OCClass.SharedWorkspace); list := Workspace.runningApplications; if (list <> nil) and (list.count > 0) then begin for i := 0 to list.count-1 do begin App := TNSRunningApplicationEx.Wrap(list.objectAtIndex(i)); if App.bundleIdentifier <> nil then AList.Add(string(App.bundleIdentifier.UTF8String)) else AList.Add(String(App.executableURL.path.UTF8String)); end; end; end; Ответ на 3-ий вопрос сам уже долго ищу
  4. EqualRect(Control1.BoundsRect.Intersect(Control2.BoundsRect), Control2.BoundsRect) Если True, то Control2 не вышел за пределы Control1, иначе - вышел
  5. Конечно будет очень мелкое, ведь Вы устанавливаете 1200 точек на дюйм и ширина листа А4 в портретном режиме у Вас получается чуть меньше 100000 точек. Исходя из этого просто задайте адекватные значения для h, w, x0, y0, x, y и все у Вас будет в порядке. Например, для печати битмапки, я ипользую такой код: var bmp: TBitmap; SrcRect, DestRect: TRectF; DPI: TPoint; cx, cy: Extended; begin Printer.ActivePrinter.SelectDPI(1200, 1200); DPI := Printer.ActivePrinter.DPI[Printer.ActivePrinter.ActiveDPIIndex]; {$IFDEF MSWINDOWS} cx := DPI.X / GetDeviceCaps(GetDC(GetDesktopWindow), LOGPIXELSX); cy := DPI.Y / GetDeviceCaps(GetDC(GetDesktopWindow), LOGPIXELSY); {$ENDIF} bmp := TBitmap.Create(0, 0); try FEditor.GetAsBitmap(bmp); SrcRect := TRectF.Create(0, 0, bmp.Width * cx, bmp.Height * cy); DestRect := TRectF.Create(0, 0, Printer.PageWidth, Printer.PageHeight); if SrcRect.Width / SrcRect.Height > DestRect.Width / DestRect.Height then Printer.Orientation := TPrinterOrientation.poLandscape else Printer.Orientation := TPrinterOrientation.poPortrait; if (SrcRect.Width < DestRect.Width) and (SrcRect.Height < DestRect.Height) then begin DestRect.Left := (DestRect.Width - SrcRect.Width) / 2; DestRect.Width := SrcRect.Width; DestRect.Top := (DestRect.Height - SrcRect.Height) / 2; DestRect.Height := SrcRect.Height; end else begin SrcRect.Fit(DestRect); DestRect := SrcRect; end; Printer.BeginDoc; try Printer.Canvas.DrawBitmap(bmp, TRectF.Create(0, 0, bmp.Width, bmp.Height), DestRect, 1); finally Printer.EndDoc; end; except Printer.Abort; end; FreeAndNil(bmp); end;
  6. А можно еще просто использовать встроенную команду Windows "MSG" Например, команда msg * /server:192.168.0.2 "Тестовое сообщение " отправит сообщение, написанное в кавычках всем пользователям компьютера с адресом 192.168.0.2 В XP/2000 еще была команда net send, но начиная с Висты она больше не поддерживается
  7. Плохо смотрели. Только он не TObjectList а TObjectList<T: class>, к тому же есть еще и TObjectQueue<T: class>, TObjectStack<T: class> и TObjectDictionary<TKey,TValue>
  8. Вот пример как у меня идет добавление в архив используя zip в MacOS: function ZipAdd(AArchName, AFileName: String): boolean; {$IFDEF MACOS} var s, sRoot, sFileName, sArchName: String; {$ENDIF} begin Result := False; {$IFDEF MACOS} try if DirectoryExists(AFileName) then begin if AFileName[AFileName.Length] = PathDelim then System.Delete(AFileName, AFileName.Length, 1); sRoot := ExtractFilePath(AFileName); AFileName := AFileName.Remove(0, sRoot.Length); s := Format('pushd "%s"; zip -r "%s" "%s"; popd', [sRoot, AArchName, AFileName]); _system(PAnsiChar(UTF8String(s))); end else begin s := Format('zip -j "%s" "%s"', [AArchName, AFileName]); _system(PAnsiChar(UTF8String(s))); end; Result := FileExists(AArchName); except Result := False; end; {$ENDIF} end; Замените зиповские команды архивирования на раровские разархивирования, добавьте необходимую Вам логику и наслаждайтесь
  9. Вообще-то TFixedMultiResBitmap предназначена для совместимости с HDPI-мониторами и TImage будет отображать ту битмапку, которую отдаст TFixedMultiResBitmap для текущего масштаба, установленного в системе.
  10. Есть замечательный модуль System.IOUtils. В нем есть класс TPath, а у него есть набор методов для получения стандартных путей. Для Temp, например, TPath.GetTempPath. И зачем давать пользователю вводить путь руками - не лучше ли использовать функцию FMX.Dialogs.SelectDirectory?
  11. Очень советовал бы обратить своё внимание на TTask из System.Threading - ну ооччеень полезный класс Можете посмотреть запись вебинара где про него подробно рассказывают
  12. Попробуйте в его событии OnWork просто вызвать Abort (при определенном условии, конечно) А вообще у меня прекрасно отрабатывает следующее: if Assigned(FIdFTP) and FIdFTP.Connected then begin // Cancel FTP upload FIdFTP.Abort; FIdFTP.DisconnectNotifyPeer; FIdFTP.Disconnect; end; if Assigned(FIdHTTP) and FIdHTTP.Connected then begin // Cancel HTTP upload FIdHTTP.DisconnectNotifyPeer; FIdHTTP.Disconnect; end;
  13. Здесь проблема не в размытии а в используемом алгоритме ресамплинга. Delphi, похоже, использует "по соседним пикселям". Вам же надо - бикубический. Единственное что можно посоветовать - найдите какой-нибудь пакет компонент для работы с графикой или сами реализуйте этот алгоритм.
  14. Выложите куда-нибудь картинку, которую вы ресайзите, а лучше проект
  15. Все просто: bmpDest.Canvas.BeginScene; try bmpDest.Canvas.DrawBitmap(bmpSource, RectF(0, 0, bmpSource.Width, bmpSource.Height), RectF(0, 0, bmpDest.Width, bmpDest.Height), 1, False); finally bmpDest.Canvas.EndScene; end; и в bmpDest вы получите Вашу битмапку сглаженную и с новыми размерами