2016年1月 – QDAC数据访问组件网站

[Delphi] FMXUI布局组件简介

2016-01-302016-01-30 • Android、Delphi • 2 条评论 • 爱音乐的孩子是小白 •浏览 6,926 次

终于熬过了今年的最后一天班，哥们怀着兴奋，下班了赶紧去放松了一下，再吃碗热呼呼的牛肉面，回来洗个热水澡，感觉太舒服了。当然了，这么重要的日了，不能忘了写篇文章，介绍下最近整的这个基础UI库，不能顾着自个儿舒服了，要让大家也开开心心才对吧？哈，顺便各位走过路过的满天神佛拜个早年，祝大家新春快乐，恭喜发财！（好吧，我还想

[FMX] 使用 TLine 做参考线来实现复杂布局控制

2016-01-262016-01-26 • Android、C++ Builder、Delphi、杂谈 • 暂无评论 • swish •浏览 2,691 次

昨天有朋友看到FMX 布局策略一文中下图的布局，想知道如何设计这种复杂的布局。实际上，这种布局确实比较复杂，设计时确实比较费劲的。 1、钟表环的设计这个比较简单，用两个 TCircle，假设分别命名为clOuter、clInner，我们将 clInner 的父设置为 clOuter，然后设置 clInner 的 M

[译]FMX 布局策略

2016-01-252016-01-25 • Android、C++ Builder、Delphi、杂谈 • 2 条评论 • swish •浏览 3,852 次

【注】本文虽是翻译，但老外写的太啰嗦，在保持含义不变的情况下，行文会进行精简。原文来自于官方帮助。 FireMonkey 布局是其它图形对象的容器，可用来构建复杂的可视界面。FireMonkey 布局扩展了 TControl 的功能来控制子控件的对齐、大小、缩放以及成组控制控件的可能。就象 Position、Align

[QJSON+QMsgPack] 修正了 TQHashedJSON 和 TQHashedMsgPack 释放时的Bug

2016-01-25 • C++ Builder、Delphi、QDAC、QJSON、QMsgPack、更新 • 暂无评论 • swish •浏览 2,084 次

【问题描述】该问题是由于先释放了内部的哈希表对象，而父类再释放时调用 Clear 时再次引用该对象造成的。【严重级别】高【推荐程度】中【特别感谢】 QQ

[QJson+QWorker] 更新：两点小更新

2016-01-23 • C++ Builder、Delphi、QDAC、QJSON、QWorker • 暂无评论 • swish •浏览 2,049 次

【更新说明】 1、QWorker 将 MsgWaitForEvent 函数公开出来，以便其它模块使用； 2、QJson 将 SetValue.DetectValue 函数的检测方式做了下变更，直接调用 TryParseValue 而不是 ParseValue ，以避免在调试时由于检测不到合适的类型而抛出异常。【更新级

[QWorker] 制作多线程日志输出查看Demo

2016-01-222016-01-22 • Delphi、QWorker • 暂无评论 • 爱音乐的孩子是小白 •浏览 3,576 次

要解决的问题：有多个线程输出日志，日志内容需要在列表框中显示出来，不管日志输出的频率快慢，界面不能卡，不能闪烁。超过10万行日志时，自动删除最开始的1万行日志。此问题涉及多线程编程，多线程输出时要更新界面的显示。多线程的东西，当然不能忘了QWorker这样的神器，下面我们就来使用QWorker解决问题，哦，不对，

DFM->JSON 格式转换

2016-01-222016-02-26 • C++ Builder、Delphi、QJSON、杂谈 • 1 条评论 • swish •浏览 2,779 次

应群友的要求，编写了一个解析 DFM 文件格式，将其转换为 JSON 格式的函数，需要引用 QJSON 和 QString 单元。代码分享给大家，供大家参考：

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;

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;

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

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;

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;

用法：

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;

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;

一个转换结果示例：

[技巧] 解决 Windows 8 / 10 无法通过 Screen 的 Imes 正确获取当前安装的输入法列表的问题

2016-01-222016-01-23 • C++ Builder、Delphi • 暂无评论 • swish •浏览 4,459 次

【问题原因】该问题是由于微软从 Windows 8 开始，GetKeyboadLayouts 函数不再有效，而 VCL 中仍然是通过该方法获取输入法列表造成的。希望下个版本的 Delphi/C++ Builder 能够解决。【解决办法】如果是 Win8+，则自己从注册表读，如果是Win 7 等以前的版本，则直接

[FMX] 使用 FMX 开发 Android 程序的一点小体会

2016-01-222016-01-22 • Android、C++ Builder、Delphi、杂谈 • 暂无评论 • swish •浏览 4,307 次

1、FMX 开发 Android 程序，你可以利用现有的控件组合出复杂的控件效果，这点很强大。比如，我们都知道默认 FMX 的 SpeedButton 和 Button 等都没有图标，没有关系，我们可以有100种方法让它拥有图标，最简单的莫过于直接放一个 TImage 和 TLabel 上去，然后调整下 TImage

[FMX] Android 下为你的程序开启抗锯齿

2016-01-212016-03-01 • Android、C++ Builder、Delphi • 2 条评论 • swish •浏览 4,572 次

先看一张图：HQ-0 是简单设置 Form 的 Quality 为 HighQuality 的结果，HQ-1 是做了进一步设置的结果，DQ 是默认的效果，大家可以看到，HQ-0 和默认的没有抗锯齿的效果没啥区别。那么，问题的关键在那里呢？问题的关键就在你设置完品质选项后，还需要调用一个函数，缺少它，更改品质的代码不

[FMX] 使用 TabControl 实现页面滑动效果之二

2016-01-202016-01-21 • Android、C++ Builder、Delphi、杂谈 • 3 条评论 • swish •浏览 3,315 次

之前的文章写法自己要写的东西多一些，实际上，FMX 的Standard Actions 里提供了两个标准的动作，可以方便的实现。 1、老规矩，放上 TabControl，添加几页，然后随便放点内容。 2、添加 TGuestureManager 和 TActionList，然后设置 TabControl.Touch.G

[教程] FMX-实现简单的环形进度条

2016-01-20 • Android、C++ Builder、Delphi • 3 条评论 • swish •浏览 3,549 次

谁说进度条一定要是长长的一条？太三俗，特三俗！今天，利用 FMX 我们来做一个环形的进度条。 1、创建一个空白的 FMX 应用（这个步骤略过了，New->Project->Delphi Project->Multi-Device Application）； 2、放一个TCircle，我们命名为clBa

[Android]Delphi/C++ Builder 开发 Android 程序启动画面简单完美解决方案

2016-01-192016-01-19 • Android、C++ Builder、Delphi、杂谈 • 4 条评论 • swish •浏览 5,284 次

前面和音儿一起研究 Android 下启动画面的问题，虽然问题得到了解决，但是，总是感觉太麻烦，主要的问题： 1、需要手工去修改XML文件； 2、而且需要对系统本身做出修改； 3、方案还不够完善，需要较多的步骤；现在，经常不断的折腾，终于找到了一个相对简单的解决方案： 1、先创建一个470×320像素的空白

[QWorker] 更新：修正了WaitJob 函数可能陷入死循环的问题

2016-01-19 • Android、C++ Builder、Delphi、QDAC、QWorker • 暂无评论 • swish •浏览 1,850 次

【问题描述】由于 WaitJob 函数中循环遍历简单作业时，指针未跳转下一个作业，造成可能陷入死循环。【严重级别】中【更新级别】推荐【特别感谢】小朱发现并报告此问题

[FMX] Android APP 启动黑屏优化补丁

2016-01-172016-01-17 • Android、Delphi • 暂无评论 • 爱音乐的孩子是小白 •浏览 4,198 次

使用说明 *************************************************** Android APP 启动黑屏优化补丁作者： Swish, YangYxd 2016.01.16 Version: 1.0.0 QDAC官方群: 250530692 ******************

[杂谈] 一个整数转其二进制表示的小函数

2016-01-16 • Delphi、杂谈 • 暂无评论 • swish •浏览 1,744 次

应群友的要求写的一个小函数，将一个32位整数转换为其二进制表示：

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;

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就好了。

月度归档： 2016年1月

[Delphi] FMXUI布局组件简介

[FMX] 使用 TLine 做参考线来实现复杂布局控制

[译]FMX 布局策略

[QJSON+QMsgPack] 修正了 TQHashedJSON 和 TQHashedMsgPack 释放时的Bug

[QJson+QWorker] 更新：两点小更新

[QWorker] 制作多线程日志输出查看Demo

DFM->JSON 格式转换

[技巧] 解决 Windows 8 / 10 无法通过 Screen 的 Imes 正确获取当前安装的输入法列表的问题

[FMX] 使用 FMX 开发 Android 程序的一点小体会

[FMX] Android 下为你的程序开启抗锯齿

[FMX] 使用 TabControl 实现页面滑动效果之二

[教程] FMX-实现简单的环形进度条

[Android]Delphi/C++ Builder 开发 Android 程序启动画面简单完美解决方案

[QWorker] 更新：修正了WaitJob 函数可能陷入死循环的问题

[FMX] Android APP 启动黑屏优化补丁

[杂谈] 一个整数转其二进制表示的小函数

[教程] QPlugins 插件引擎教程 – 让 QPlugins 协助你解耦程序

[FMX] 步步惊心 – FMX Canvas 研究笔记

[QJSON]更新：合并、交集和差异比较

[QJSON] 更新:保存 JSON 中的注释

登录