如何显示进度条?

2023-12-07

我创建了一个隐写术(隐藏位图中的文本)应用程序,我想添加一个进度条来显示该过程的运行时间。

procedure TForm1.Button2Click(Sender: TObject);
var
   x,y,i,currentBit,bitInChar,currentChar,currentPixel,newPixelValue,pixelsToSkip,skippedPixels: integer;
   pixels: PByteArray;
   bmp: TBitmap;
   stringToHide: string;
begin
if Image1.Picture.Bitmap=nil then
showmessage('gambar belum dipilih')
else
   memo1.lines.clear;
   stringToHide := AntiKeyLoggerMemo1.text;

   stringToHide:= stringToHide + chr(terminator); // add terminator to indicate end of text
   Image2.Picture.Assign(Image1.Picture.Bitmap);
   bmp := Image2.Picture.Bitmap;
   x := 0;
   y := 0;
   pixels := bmp.ScanLine[y];

   // iterate over the chars in the string we want to hide
   for i := 1 to length(stringToHide) do
   begin
      currentChar := ord(stringToHide[i]);
      memo1.lines.append('');
      memo1.lines.append('Sembunyikan ' + stringToHide[i] + ' - Ascii ' + inttostr(currentChar) + ' (biner ' + toBinary(currentChar) + ')');
      // iterate over the bits in the current char
      for currentBit := 7 downto 0 do
      begin
         begin
            if (i = 1) and (currentBit = 7) then
               pixelsToSkip := 0
            else
               pixelsToSkip := 1;
         end;
         for skippedPixels := 1 to pixelsToSkip do
         begin
            inc(x);
            if x = bmp.width then
            begin
               x := 0;
               inc(y);
               if (y = bmp.height) and (i < length(stringToHide)) then raise Exception.create('gambar terlalu kecil');
               pixels := bmp.ScanLine[y];
            end;
         end;
         bitInChar := getBit(currentChar, currentBit);
         // get the value of the pixel at x,y
         currentPixel := pixels[x];
         // set the least significant bit of the pixel to the bit we read from the char
         newPixelValue := setBit(currentPixel, 0, bitInChar);
         pixels[x] := newPixelValue;
         memo1.lines.append('Bit karakter ' + inttostr(currentBit) + '=' + inttostr(bitInChar) +
            ', pixel ke ' + inttostr(x) + ',' + inttostr(y) + ' desimal ' + inttostr(currentPixel) + ' (biner ' + toBinary(currentPixel) + ') ' +
            ' desimal baru ' + inttostr(newPixelValue) + ' (biner ' + toBinary(newPixelValue) + ')');

            end;
         end;
   memo1.lines.append('All done!');
   Button4.Enabled :=True;
   Button2.Enabled:=False ;
   Button5.Enabled:=True;
   Button1.Enabled:=False;
   AntiKeyLoggerMemo1.ReadOnly:=True;
     end;   

如何为该过程制作进度条?我必须把命令进度条放在哪里?


首先,您需要将代码移至其自己的线程。否则 GUI 将不会响应。您还必须确保代码是线程安全的。

不管怎样,在线程内部,你需要时不时地更新进度条。如果碰巧您有一个外循环和一个内循环,其中外循环每秒左右迭代一次,您可以更新该位置的进度条。如果您只有一个大循环,您可能不想在每次迭代时更新进度条;例如,一次迭代可能只需几毫秒即可完成。

相反,您可以确保每秒更新一次进度条,或者以此类推。要实现此目的,您可以使用GetTickCount:

tc := GetTickCount;
if Terminated then Exit;
if tc - oldtc > 1000 then
begin
  PostMessage(FProgressBarHandle, PBM_SETPOS, TheNewPosition, 0);
  oldtc := tc;
end;

这也展示了一种更新进度条的方法——只需向其发布一条消息即可!您还可以定义自己的消息并将其发送到主要来源。

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

如何显示进度条? 的相关文章

  • delphi检查ini文件是否存在

    如何检查 INI 文件是否存在 在特定路径和特定名称下 比如这样 if FileExists c yourinifile ini then ShowMessage c yourinifile ini exists
  • 是否有适用于 >= Delphi 2007 的 Delphi 混淆器

    我曾经使用 Pythia 来混淆我的 D6 程序 但 Pythia 似乎不再适用于我的 D2007 这是 Pythia 的链接 自 2007 年初以来没有更新 http www the interweb com serendipity in
  • 在 Delphi 中强制非阻塞临时提示窗口

    我一直在寻找 但找不到解决方案 所以我想也许我应该简单地发布它 这是我想要在 Delphi 2009 中做的事情 在我的应用程序中的某个时刻 我想向用户显示一条消息 这应该是正常的提示窗口 在正常应用程序定义的提示暂停后自动消失 并带有自定
  • AppWidget 中的进度条

    我在应用程序小部件中使用 ProgressBar 时遇到了一个有趣的情况 文档 http developer android com guide topics appwidgets index html http developer and
  • 在 Inno Setup 中使用 StringToColor

    我想为表单上的标签 TNewStaticText 属性颜色 TColor 读写 分配一些颜色 我将颜色存储为 RRGGBB 字符串 我想使用 Delphi 函数 StringToColor 将其转换为 TColor 但如果我在脚本中使用此函
  • 如何更新Delphi对象检查器?

    继我最近发布的这个问题之后 组件编辑器可以在多个组件上执行吗 https stackoverflow com questions 14802371 can a component editor be executed on multiple
  • 如何以编程方式安排任务

    如何使用 delphi 7 像 Google updater 一样安排任务 我没有使用注册表 因为它被卡巴斯基防病毒软件检测为误报 我在注册表中作为启动项添加的任何内容都会被检测为特洛伊木马 因此我决定使用任务计划 下面的代码展示了如何删除
  • 如何在Delphi XE中通过名称获取类类型引用?

    我实际上正在尝试使用 Rtti 来实现通用方法调用程序 它应该像这样工作 我将提供类名 方法名和参数 调用者将通过调用此类的指定方法来完成其工作 因此 我需要类引用才能获取其 Rtti 信息并寻找我想要调用的方法 有没有办法在不实现我想要使
  • 如何仅在调试模式下激活 ReportMemoryLeaksOnShutdown?

    我需要激活ReportMemoryLeaksOnShutdown报告应用程序内存泄漏的功能 但仅限于调试模式 当 Delphi IDE 运行时 我怎样才能做到这一点 如果您的意思是使用调试构建配置 D2007 编译的 调试模式 则您将定义
  • 如何避免使用 WinApi.Windows 的 Delphi 应用程序中的 dll 劫持

    Delphi 最新版本使用各种系统 dll 的静态链接 例如 WinApi Windows 单元中的 version dll 这会导致在单元初始化之前加载 version dll 这会打开一个安全漏洞 可以通过将受感染的 version d
  • 如何在滚动框上创建缓慢的滚动效果?

    我喜欢在滚动框中平移图像后创建平滑的减慢滚动效果 就像平移地图一样谷歌地图 http maps google com 我不确定它是什么类型 但行为完全相同 当快速移动地图时 当您释放鼠标时它不会立即停止 而是开始减慢速度 有什么想法 组件
  • Delphi - 自XE8以来如何正确注册图形类?

    我正在编写一个 Delphi 包 它提供了一个新的自定义 TGraphic 对象 允许读取 VCL 组件 如 TImage 中的新图像格式 我最初使用 RAD Studio XE7 开发了这个包 并且运行良好 然而 我最近迁移到了较新的 R
  • 开源 Delphi 包可使用哪些项目选项?

    我写了一些 Delphi 代码 想在 GitHub 上分享 所有代码都根据需要包含在运行时和设计时包中 每个项目有许多项目选项需要设置 输出目录 搜索路径 编译选项等 我设法找到了一些适合我的情况的默认选项 但阅读此处的其他问答很明显有多个
  • Async InputQuery 不处理“取消”按钮

    我正在使用一个简单的调用TDialogServiceAsync InputQuery 使用单个输入 它只是忽略了Cancel按钮和窗口的X关闭按钮 But the Ok按钮工作正常 这是我的代码 uses FMX DialogService
  • 德尔福数据结构

    我可能需要在 Delphi 中做一个项目 并且是该领域的初学者 目前 我正在网上搜索资源 但由于资源站点太少而感到困惑 首先 你能给我一些好的网站 其中包含我迄今为止错过的 Delphi 资源吗 我也在 Delphi 中搜索数据结构 想知道
  • 如何遍历任意给定集合中的枚举?

    我有很多枚举类型 它们与相应的集合相结合 例如 type TMyEnum meOne meTwo meThree TMyEnums set of TMyEnum 我正在尝试提出一组可以运行的函数any枚举集 而不是为每个枚举编写单独的函数
  • 如何在Delphi中下载一个非常简单的HTTPS页面?

    我尝试了在这里看到的代码 但它不适用于 HTTPS 我需要将此页面作为字符串下载 并在其上添加一些换行符 以便将信息按顺序放入 TMemo 中 怎么做 我尝试使用 Indy 但由于 SSL 问题而失败 我尝试了此页面的解决方案 如何将网页下
  • TDictionary 上的 GetItem 由链接器消除

    我正在使用一个TDictionary of
  • TOpenDialog/NSOpenPanel 无法在沙盒 Delphi 应用程序中工作

    Firemonkey 应用程序中的 TOpenDialog 似乎存在问题 该应用程序已针对 Mac Appstore 进行沙箱处理 我使用XE3 但它也存在于XE2中 我其实在这里找到了一份QC报告 但仍然没有解决 http qc emba
  • Android ProgressBar:如何以编程方式设置辅助颜色

    我需要设置辅助进度条颜色以编程方式 我只看到方法 ProgressBar setProgressDrawable drawable 用于设置主色 但没有设置辅助色的方法 我怎样才能做到呢 ProgressBar getProgressDra

随机推荐

  • MapReduce问题

    我有一个奇怪的 MapReduce 问题 地图功能 gt mp function emit this ContractID qty this Qty qtybs this QtyBs 减少功能 gt red function key val
  • Swift 中的“advancedBy”不可用

    我不确定如何解决上述错误消息 我尝试将其转换为索引 但它似乎不接受字符串 我不知道如何advancedBy也有效 非常感谢帮助 在斯威夫特 3 中 advancedBy 已更名为advanced by Int 此外 substringWit
  • 会话超时后自动重定向到登录

    我试图在会话超时后自动重定向到我的登录页面 我尝试在我的 Main Master 页面中添加此代码 所有其他页面都连接到此母版页 protected void Page Load object sender EventArgs e Redi
  • WCF中服务应用的架构

    我需要一些有关 WCF 应用程序架构的帮助 这将是许多应该可用于服务许多不同客户的服务 例如 ASP Net 应用程序 JavaScript 和 或 Silverlight iPhone 视窗手机 Android 有些服务需要身份验证 有些
  • 总结为每组赋予相同的值

    使用代码获取每个物种的平均花瓣长度 group sp lt group by iris iris Species mean plength lt summarise group sp mean iris Petal Length mean
  • Spring MVC Java 配置

    我想从 Spring Web 应用程序设置一个简单的响应主体 我的问题很简单 就是出现网络错误 我的 POM xml 是
  • SQL Server 数据库项目构建期间使用错误的编译器

    我在使用 Visual Studio 2015 编译 SSDT SQL Server 数据库项目时遇到问题 我想在我的数据库项目中使用 C 6 功能 但它似乎不受支持 例如 我在我的数据库项目中添加了下一个类 namespace Datab
  • JSR303 复合注释

    我创建了一个由 Digits 和 Min 组成的复合注释 Digits integer 12 fraction 0 Min value 0 ReportAsSingleViolation Documented Retention Reten
  • 在 AS3 中设置属性是否会阻止时间线补间?

    如果我有一个分配有类的影片剪辑 并且我在代码中更改了该影片剪辑的属性 则该属性似乎无法再在时间轴上进行补间 例如 如果我的类设置 this x 100 并且稍后在时间轴上补间对象的位置 则不会发生该时间轴补间 更改scaleX或scaleY
  • 将 DateTime 分组为 5、15、30 和 60 分钟间隔

    我尝试将一些记录分组为 5 分钟 15 分钟 30 分钟和 60 分钟间隔 SELECT AVG value as AvgValue sample date 5 60 as TimeFive FROM DATA WHERE id 123 A
  • ConfBridge:当管理员用户退出时结束会议

    这几天我在做一些关于ConfBridge的事情 当管理员用户退出时 我使用 confbridge kick all 结束会议 但会议中的其他人会听到 您已被踢出此会议 这不是结束会议的好方法 是否有任何配置或命令可以设置会议在管理员用户退出
  • javascript 中有没有一种好方法可以从 javascript 对象(而不是数组)中删除 Falsy 值?

    在 JavaScript 中 您可以使用很好的 filter 方法从数组中删除 null 或 false 值 到目前为止 我还没有找到从 JavaScript 对象中删除相同内容的方法 为什么会这样呢 目前 您可以为数组创建一个函数 例如
  • 管理 FCM 设备组

    我试图弄清楚如何使用 REST API 从应用程序服务器管理 FCM 设备组 AFAIK 这些是更新的文档 https firebase google com docs cloud messaging android device grou
  • jQuery:如何创建元素然后将其包装在另一个现有元素周围?

    所以我知道如何使用 wrap wrapInner and wrapAll但我想知道如何将 jQuery 1 4 中引入的快速创建语法和包装函数一起使用 基本上我希望能够使用 var targetUl this would be popula
  • 阻止谷歌翻译翻译日期选择器

    http jsfiddle net tkRaQ 51 这里的 addClass datepicker datepicker addClass notranslate 没有修复它 谷歌翻译停止工作日期的选择 由于某种原因 其他代码修复了它 f
  • 没有窗口的 Windows 应用程序中的窗口消息

    我有一个应用程序想要在后台运行 没有可见的窗口或控制台 为了实现这一点 我创建了一个 Windows 应用程序 但不创建窗口 当请求关闭时 即当用户注销时 应用程序需要进行一些清理 如何确定何时关闭 我可以简单地创建一个处理 WM CLOS
  • JS,数组矩阵和forEach行为的区别

    我正在为我的 JS 课程做一些培训任务 我得到一个必须实现一个函数的函数 该函数接受正整数 n 并返回如下所示的矩阵 已传递 5 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 我能够使用
  • 为 Fortran 数组操作指定冒号

    Fortran 允许更轻松地使用数组操作 例如 double precision a 3 3 b 3 3 c 3 3 Given a and b已初始化 我知道一个简单的c a b将导致矩阵加法 使用同样可以实现c a b 我知道第二种方法
  • 前端 Ajax 和 WordPress - 数据库未更新

    所以我正在开发一个 WordPress 网站 我在获取用户输入来更新数据库方面遇到了一些困难 JS var ID this attr id var name name input ID val var createDate created
  • 如何显示进度条?

    我创建了一个隐写术 隐藏位图中的文本 应用程序 我想添加一个进度条来显示该过程的运行时间 procedure TForm1 Button2Click Sender TObject var x y i currentBit bitInChar