终于熬过了今年的最后一天班,哥们怀着兴奋,下班了赶紧去放松了一下,再吃碗热呼呼的牛肉面,回来洗个热水澡,感觉太舒服了。 当然了,这么重要的日了,不能忘了写篇文章,介绍下最近整的这个基础UI库,不能顾着自个儿舒服了,要让大家也开开心心才对吧?哈,顺便各位走过路过的满天神佛拜个早年,祝大家新春快乐,恭喜发财!(好吧,我还想
月度归档: 2016年1月
[FMX] 使用 TLine 做参考线来实现复杂布局控制
昨天有朋友看到FMX 布局策略 一文中下图的布局,想知道如何设计这种复杂的布局。实际上,这种布局确实比较复杂,设计时确实比较费劲的。 1、钟表环的设计 这个比较简单,用两个 TCircle,假设分别命名为clOuter、clInner,我们将 clInner 的父设置为 clOuter,然后设置 clInner 的 M
[译]FMX 布局策略
【注】本文虽是翻译,但老外写的太啰嗦,在保持含义不变的情况下,行文会进行精简。原文来自于官方帮助。 FireMonkey 布局是其它图形对象的容器,可用来构建复杂的可视界面。FireMonkey 布局扩展了 TControl 的功能来控制子控件的对齐、大小、缩放以及成组控制控件的可能。就象 Position、Align
[QJSON+QMsgPack] 修正了 TQHashedJSON 和 TQHashedMsgPack 释放时的Bug
【问题描述】 该问题是由于先释放了内部的哈希表对象,而父类再释放时调用 Clear 时再次引用该对象造成的。 【严重级别】 高 【推荐程度】 中 【特别感谢】 QQ
[QJson+QWorker] 更新:两点小更新
【更新说明】 1、QWorker 将 MsgWaitForEvent 函数公开出来,以便其它模块使用; 2、QJson 将 SetValue.DetectValue 函数的检测方式做了下变更,直接调用 TryParseValue 而不是 ParseValue ,以避免在调试时由于检测不到合适的类型而抛出异常。 【更新级
[QWorker] 制作多线程日志输出查看Demo
要解决的问题: 有多个线程输出日志,日志内容需要在列表框中显示出来,不管日志输出的频率快慢,界面不能卡,不能闪烁。超过10万行日志时,自动删除最开始的1万行日志。 此问题涉及多线程编程,多线程输出时要更新界面的显示。 多线程的东西,当然不能忘了QWorker这样的神器,下面我们就来使用QWorker解决问题,哦,不对,
DFM->JSON 格式转换
应群友的要求,编写了一个解析 DFM 文件格式,将其转换为 JSON 格式的函数,需要引用 QJSON 和 QString 单元。代码分享给大家,供大家参考:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 |
function DFM2Json(AFileName: String): TQJson; var ADFMStream, ATemp: TMemoryStream; I: Integer; AObjNode: TQJson; const SSpace: PWideChar = ' '#9; SColon: PWideChar = ':'; SNull: WideChar = #0; function IsTextDFM(S: PAnsiChar): Boolean; begin Result := (AnsiStrLComp(S, 'object', 6) = 0) or (AnsiStrLComp(S, 'inherited', 9) = 0); end; procedure DecodeObject(ALine: PWideChar; var AObjName, AObjClass: QStringW); begin SkipUntilW(ALine, SSpace); AObjName := Trim(DecodeTokenW(ALine, SColon, SNull, True)); AObjClass := Trim(ALine); end; function DecodeDFMString(S: QStringW): QStringW; var ps, pd: PWideChar; V: Int64; begin if Length(S) > 0 then begin ps := PWideChar(S); SetLength(Result, Length(S)); pd := PWideChar(Result); while ps^ <> #0 do begin if ps^ = '#' then begin Inc(ps); if ParseInt(ps, V) > 0 then begin pd^ := WideChar(V); Inc(pd); end; end else if ps^ = '''' then begin Inc(ps); while ps^ <> '''' do begin pd^ := ps^; Inc(pd); Inc(ps); end; Inc(ps); end else begin break; end; end; SetLength(Result, pd - PWideChar(Result)); end else Result := ''; end; procedure DecodePropAndChildren(AParent: TQJson; var ps: PWideChar; AIsCollection: Boolean); var ALine, AName, AValue: QStringW; pl, pv: PWideChar; ATemp: TQJson; ACharset: Longint; AProps: TQJson; AChildren: TQJson; const SObject: PWideChar = 'object'; SInline: PWideChar = 'inline'; SEnd: PWideChar = 'end'; SEqual: PWideChar = '='; SNull: WideChar = #0; SItem: PWideChar = 'item'; SBracket: PWideChar = ')'; begin AProps := AParent; AChildren := nil; repeat ALine := DecodeLineW(ps); pl := PWideChar(ALine); SkipSpaceW(pl); SkipSpaceW(ps); if StartWithW(pl, SObject, True) or StartWithW(pl, SInline, True) then begin DecodeObject(pl, AName, AValue); DecodePropAndChildren(AParent.Add(AName, jdtObject), ps, False); end else if StartWithW(pl, SEnd, True) then Exit else // Property line begin AName := Trim(DecodeTokenW(pl, SEqual, SNull, True)); AValue := Trim(pl); pv := PWideChar(AValue); if (pv^ = '''') or (pv^ = '#') then begin AProps.ForcePath(AName).AsString := DecodeDFMString(AValue); end else if pv^ = '<' then begin Inc(pv); SkipSpaceW(pv); if pv^ <> '>' then begin ATemp := TQJson.Create; ATemp.DataType := jdtArray; try SkipSpaceW(ps); while StartWithW(ps, SItem, True) do begin SkipLineW(ps); DecodePropAndChildren(ATemp.Add, ps, True); end; SkipSpaceW(ps); if ps^ = '>' then SkipLineW(ps); finally if ATemp.Count > 0 then AProps.Add(AName).Assign(ATemp); FreeObject(ATemp); end; end; end else if pv^ = '(' then // Strings begin AValue := ''; while ps^ <> #0 do begin ALine := Trim(DecodeLineW(ps)); if Length(AValue) > 0 then AValue := AValue + SLineBreak + DecodeDFMString(ALine) else AValue := DecodeDFMString(ALine); if (ps^ = ')') or EndWithW(ALine, SBracket, True) then break; end; SkipSpaceW(ps); if ps^ = ')' then SkipLineW(ps); SkipSpaceW(ps); if Length(AValue) > 0 then AProps.ForcePath(AName).AsString := AValue; end else AProps.ForcePath(AName).Value := AValue; end; until Length(ALine) = 0; end; procedure DoConvert(AText: QStringW); var p: PWideChar; AObjectName, ARootClass: QStringW; const SObject: PWideChar = 'object '; SInherited: PWideChar = 'inherited '; begin if Length(AText) > 0 then begin p := PWideChar(AText); if StartWithW(p, SObject, True) or StartWithW(p, SInherited, True) then begin Result := TQJson.Create; try DecodeObject(PWideChar(DecodeLineW(p)), AObjectName, ARootClass); DecodePropAndChildren(Result.Add(ARootClass, jdtObject), p, False); finally if Result.Count = 0 then FreeAndNil(Result); end; end; end; end; begin ADFMStream := TMemoryStream.Create; try ADFMStream.LoadFromFile(AFileName); if PCardinal(ADFMStream.Memory)^ = $30465054 then begin ATemp := TMemoryStream.Create; ATemp.CopyFrom(ADFMStream, 0); ATemp.Position := 0; ADFMStream.Size := 0; ObjectBinaryToText(ATemp, ADFMStream); FreeAndNil(ATemp); ADFMStream.Position := 0; DoConvert(LoadTextW(ADFMStream)); end else if IsTextDFM(ADFMStream.Memory) then DoConvert(LoadTextW(ADFMStream)); finally FreeObject(ADFMStream); end; end; |
用法:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
procedure TForm1.Button1Click(Sender: TObject); var AJson: TQJson; begin if OpenDialog1.Execute then begin AJson := DFM2Json(OpenDialog1.FileName); if AJson <> nil then begin Memo1.Lines.Text := AJson.AsString; FreeAndNil(AJson); end; end; end; |
一个转换结果示例:
[技巧] 解决 Windows 8 / 10 无法通过 Screen 的 Imes 正确获取当前安装的输入法列表的问题
【问题原因】 该问题是由于微软从 Windows 8 开始,GetKeyboadLayouts 函数不再有效,而 VCL 中仍然是通过该方法获取输入法列表造成的。希望下个版本的 Delphi/C++ Builder 能够解决。 【解决办法】 如果是 Win8+,则自己从注册表读,如果是Win 7 等以前的版本,则直接
[FMX] 使用 FMX 开发 Android 程序的一点小体会
1、FMX 开发 Android 程序,你可以利用现有的控件组合出复杂的控件效果,这点很强大。比如,我们都知道默认 FMX 的 SpeedButton 和 Button 等都没有图标,没有关系,我们可以有100种方法让它拥有图标,最简单的莫过于直接放一个 TImage 和 TLabel 上去,然后调整下 TImage
[FMX] Android 下为你的程序开启抗锯齿
先看一张图:HQ-0 是简单设置 Form 的 Quality 为 HighQuality 的结果,HQ-1 是做了进一步设置的结果,DQ 是默认的效果,大家可以看到,HQ-0 和默认的没有抗锯齿的效果没啥区别。 那么,问题的关键在那里呢? 问题的关键就在你设置完品质选项后,还需要调用一个函数,缺少它,更改品质的代码不
[FMX] 使用 TabControl 实现页面滑动效果之二
之前的文章 写法自己要写的东西多一些,实际上,FMX 的Standard Actions 里提供了两个标准的动作,可以方便的实现。 1、老规矩,放上 TabControl,添加几页,然后随便放点内容。 2、添加 TGuestureManager 和 TActionList,然后设置 TabControl.Touch.G
[教程] FMX-实现简单的环形进度条
谁说进度条一定要是长长的一条?太三俗,特三俗!今天,利用 FMX 我们来做一个环形的进度条。 1、创建一个空白的 FMX 应用(这个步骤略过了,New->Project->Delphi Project->Multi-Device Application); 2、放一个TCircle,我们命名为clBa
[Android]Delphi/C++ Builder 开发 Android 程序启动画面简单完美解决方案
前面和音儿一起研究 Android 下启动画面的问题,虽然问题得到了解决,但是,总是感觉太麻烦,主要的问题: 1、需要手工去修改XML文件; 2、而且需要对系统本身做出修改; 3、方案还不够完善,需要较多的步骤; 现在,经常不断的折腾,终于找到了一个相对简单的解决方案: 1、先创建一个470×320像素的空白
[QWorker] 更新:修正了WaitJob 函数可能陷入死循环的问题
【问题描述】 由于 WaitJob 函数中循环遍历简单作业时,指针未跳转下一个作业,造成可能陷入死循环。 【严重级别】 中 【更新级别】 推荐 【特别感谢】 小朱 发现并报告此问题
[FMX] Android APP 启动黑屏优化补丁
使用说明 *************************************************** Android APP 启动黑屏优化补丁 作者: Swish, YangYxd 2016.01.16 Version: 1.0.0 QDAC官方群: 250530692 ******************
[杂谈] 一个整数转其二进制表示的小函数
应群友的要求写的一个小函数,将一个32位整数转换为其二进制表示:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
function IntToBinStr(v: Integer): String; var b: array [0 .. 32] of Char; o: Integer; const Chars: array [0 .. 1] of Char = ('0', '1'); begin o := 31; if v <> 0 then begin while v <> 0 do begin b[o] := Chars[v and $1]; v := v shr 1; Dec(o); end; b[32] := #0; Result := PChar(@b[o + 1]); end else Result := '0'; end; |
至于调用方式,则很简单,直接象 IntToBinStr(100) 就可以。如果想要前面保留多少个0,那你在长度上在前面加上n个0就好了。
[教程] QPlugins 插件引擎教程 – 让 QPlugins 协助你解耦程序
程序就是一堆面条,理顺了,好用又好看,如果缠在一起,那就会煮成一坨面疙瘩了。QPlugins 虽然是一个插件引擎,但是记住我们的理念,插件即服务,服务也就是插件一种插接方式。 首先,我们了解的第一个基于 QPlugins 的 Demo 位于 DockForms 里的 InProcess 目录下。它的目标是将不同单元的窗
[FMX] 步步惊心 – FMX Canvas 研究笔记
【注】下面的内容,仅适用于 Delphi/C++ Builder X,至于其它版本,不做任何保证。 研究一个新的东西,难免会将老的观念带进来,也难免会遇到不同的坑,有些坑是自己挖的,有些坑是厂商或作者挖的,一路走来,堪称步步惊心。FMX 目前来说,改进很大,但坑仍然还有很多,慢慢研究,慢慢摸索,希望与大家一同进步。 1
[QJSON]更新:合并、交集和差异比较
QJSON 新版已经支持两个JSON对象的合并、求公共值和差异值。详细的用法,请参考 QJSON 的示例。注意合并时,jmmAppend 方法的结果可能有些解析器无法完整支持。
[QJSON] 更新:保存 JSON 中的注释
QJSON 新版中增加了对注释保存的支持,早先版本的 QJSON 对于注释会自动跳过,不会保存注释的内容。但这一功能在 StrictJson 为 true 时不会支持,以兼容更多的解析器。 QJSON 中,注释的保存通过 CommentStyle 属性来控制: jcsIgnore : 忽略掉注释,保存时不会保存注释的内