DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡
DELPHI技术
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡
发布代码
发布控件
文档资料
经典工具
≡事务区≡
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入: g929959149
今日帖子: 25
在线用户: 6
导航: 论坛 -> DELPHI技术 斑竹:liumazi,sephil  
作者:
男 sxqwhxq (步惊云) ★☆☆☆☆ -
普通会员
2022/5/14 16:55:34
标题:
为何这段FMX代码有错误? 浏览:560
加入我的收藏
楼主:  TFrCount是一个TFrame,现在想改变它上面的stringGrid1的背景色,照着delphi11. 1的示例,编译为fmxlinux,运行后居然让ubuntu崩溃死机了:
procedure TFrCount.FramePaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
   R : TRectangle;
begin
   R:=StringGrid1.FindStyleResource('background') as TRectangle;
   if Assigned(r) then
   R.Fill.Color:=TAlphaColors.Darkblue; //这个代码有问题
end;
----------------------------------------------
-
作者:
男 wenyue0811 (wenyue0811) ★☆☆☆☆ -
普通会员
2022/5/14 17:36:39
1楼: 一: 看你用的 R : TRectangle; 说明用的是类似 DARK 的风格, 而不是 win... 的风格的.
二: 这段代码不应放在 OnPaint 中使用 (你能保证在不停的重绘时不出问题?), 这应放在
    控件的 OnApplyStyleLookup 事件中.
三: 如果你要换风格的话, 你就不要写死
var  R : TRectangle;
而应写成 var  R : TFMXObject;

begin
   R:=StringGrid1.FindStyleResource('background');
   if R <> NIL then
    begin
        if R is TRectangle  then
          TRectangle  (R).Fill.Color:=TAlphaColors.Darkblue; 
      
      if R is TStyleObject then
      begin
  // 其它的处理方式 (比如新增一个 矩形来作为背景.
      end;
   end;
end;

四: 你应该在主窗体上放一个 TFrCount 的, 这样上面的代码改一下, 放在主窗体上那个 Frame 中的
stringgrid 的 OnApplyStyleLookup  事件中.
procedure TForm2.frmstrg1ApplyStyleLookup(Sender: TObject);
    var R: TFMXObject;
    begin
        R := FRM.strg1.FindStyleResource('background');
        if R <> NIL then
        begin
          if R is TRectangle then
          TRectangle(R).Fill.Color := TAlphaColors.Gold;
        end;
    end;
这样就OK了.
----------------------------------------------


美国国务卿蓬佩奥回答大学生提问时说,“我曾担任美国中央情报局(CIA)的局长。我们撒谎、我们欺骗、我们偷窃。我们还有一门课程专门来教这些。这才是美国不断探索进取的荣耀
作者:
男 sxqwhxq (步惊云) ★☆☆☆☆ -
普通会员
2022/5/14 18:21:16
2楼: 谢谢楼上,我这样写,没有起作用:
procedure TFrCount.StringGrid1ApplyStyleLookup(Sender: TObject);
var R: TFMXObject;
 begin
    R := StringGrid1.FindStyleResource('background');
    if R <> NIL then
    begin
      if R is TRectangle then
      TRectangle(R).Fill.Color := TAlphaColors.Gold;
    end;
end;
考虑到程序模块化设计,这个TFrCount是在主窗口创建的:
 Frame:= TFrCount.Create(self);
 Frame.Parent:=Panel1;
----------
在delphi 11.1可以找得到这个示例,
FMXTStringGridBackgroundColor (Delphi)

procedure TForm1.ColorComboBox1Change(Sender: TObject);
var r : TRectangle;
begin
  //Identifies the TRectangle that serves as background for the TStringGrid.
  r:=StringGrid1.FindStyleResource('background') as TRectangle;
  //Changes the color.
  if Assigned(r) then
     r.Fill.Color:=ColorComboBox1.Color;
end;
我估计这个 TRectangle(R).Fill.Color := TAlphaColors.Gold;导致linux死机,也许是颜色常量系列不对。
----------------------------------------------
-
作者:
男 wenyue0811 (wenyue0811) ★☆☆☆☆ -
普通会员
2022/5/14 19:02:39
3楼: 你还是没理解一些技巧.

type
    TForm2 = class(TForm)
        styb1: TStyleBook;
        pnl1: TPanel;
        procedure FormCreate(Sender: TObject);
    private
    { Private declarations }
        Frame: TFrCount;
        procedure AssingStyleLookupStrg(Sender: TObject);
    public
    { Public declarations }
    end;

var
    Form2: TForm2;

implementation

{$R *.fmx}


procedure TForm2.AssingStyleLookupStrg(Sender: TObject);
    var R: TFMXObject;
    begin
        R := Frame.strg1.FindStyleResource('background');
        if (R <> nil) and (R is TRectangle) then
        begin
          TRectangle(R).Fill.Color := TAlphaColors.Gold;
        end;
    end;

procedure TForm2.FormCreate(Sender: TObject);
    begin
        Frame := uFrCount.TFrCount.Create(self);
        Frame.Parent := pnl1;
        Frame.Align := TAlignLayout.Client;
        Frame.strg1.OnApplyStyleLookup := AssingStyleLookupStrg;  // 关键在这. 这个框架控件是后面创建的,那么事件也要在后面自个来关联上 .
    end;


你再看下:
----------------------------------------------


美国国务卿蓬佩奥回答大学生提问时说,“我曾担任美国中央情报局(CIA)的局长。我们撒谎、我们欺骗、我们偷窃。我们还有一门课程专门来教这些。这才是美国不断探索进取的荣耀
作者:
男 sxqwhxq (步惊云) ★☆☆☆☆ -
普通会员
2022/5/14 19:26:11
4楼:  private
    { Private declarations }
  public
    { Public declarations }
     FRame:TFrame;
     procedure AssingStyleLookupStrg(Sender: TObject);
  end;

仍然没有效果:
procedure TMainFM.AssingStyleLookupStrg(Sender: TObject);
var R: TFMXObject;
begin
    R :=  TFrCount(Frame).StringGrid1.FindStyleResource('background');
    if (R <> nil) and (R is TRectangle) then
    begin
      TRectangle(R).Fill.Color := TAlphaColors.Gold;
    end;
end;

if Aitem.Index=1 then  begin
    Frame:= TFrCount.Create(self);
    Frame.Parent:=Panel1;
    TFrCount(Frame).StringGrid1.OnApplyStyleLookup := AssingStyleLookupStrg;
    (frame as TFrCount).init;
  end;
----------------------------------------------
-
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/14 21:58:22
5楼: hi people

try this... it's more easy and works!

--- 1 FMX project
------- 2 buttons for tests...
------- 2 Rectangles (for this case) with FILL = blue and red color or any other
----------  rect1.STYLENAME = 'rectblue'; 
----------  rect2.STYLENAME = 'rectred';

--- 1 FMX frame with a StringGrid or any others for apply the changes...

add your Frame into your Form1, and:

...
var
   Form1:TForm1;

implementation
...
procedure TForm1.Button1Click(Sender: TObject);
begin
  Frame21.StringGrid1.StyleLookup := 'rectblue';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Frame21.StringGrid1.StyleLookup := 'rectred';
end;
此帖子包含附件:
PNG 图像
大小:20.0K
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/14 22:01:09
6楼: R:=StringGrid1.FindStyleResource('background') as TRectangle;

--> FindStyleResource() == TFmxObject  not necessary a "Rectangle"

if the resulted is "NIL"?
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/15 0:59:07
7楼: screenshot in Linux Ubuntu v20
此帖子包含附件:
PNG 图像
大小:141.9K
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/15 1:31:55
8楼: dont forget:  HITTEST = FALSE in rectangle!!!
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/15 1:36:07
9楼: procedure TForm1.ColorComboBox1Change(Sender: TObject);
var
  MyNewStyleName: string;
begin
  // on create for example:
  // Rectangle1.HitTest := false; // not interferences on click-mouse!
  //
  MyNewStyleName          := IntToHex(ColorComboBox1.Color);
  Rectangle1.Fill.Color          := ColorComboBox1.Color;
  Rectangle1.StyleName          := MyNewStyleName;
  Frame21.StringGrid1.StyleLookup := MyNewStyleName;
end;
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 wenyue0811 (wenyue0811) ★☆☆☆☆ -
普通会员
2022/5/15 10:39:24
10楼: ????

private
    { Private declarations }
        Frame: TFrCount;


直接指向这个架框, 而不是 
private
    { Private declarations }
        Frame: TFrame;



你看下,

附件中有源码, 反正在我机子上 10.4下是正常的.

其中整合了 emailx45 的方法.
此帖子包含附件:wenyue0811_2022515104948.rar 大小:346.2K
----------------------------------------------


美国国务卿蓬佩奥回答大学生提问时说,“我曾担任美国中央情报局(CIA)的局长。我们撒谎、我们欺骗、我们偷窃。我们还有一门课程专门来教这些。这才是美国不断探索进取的荣耀
作者:
男 sxqwhxq (步惊云) ★☆☆☆☆ -
普通会员
2022/5/15 13:28:49
11楼: 用11.1现成的,两行代码搞定,无须使用复杂的办法,贴出代码供同仁们少走弯路:
procedure TFrCount.StringGrid1DrawColumnBackground(Sender: TObject;
  const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
  const Row: Integer; const Value: TValue; const State: TGridDrawStates);
begin
    Canvas.Fill.Color := TAlphaColors.Silver;
    Canvas.FillRect(Bounds, 0, 0, AllCorners, 1, TCornerType.Round);
   // Canvas.Fill.Color := TAlphaColors.Black;
   // Canvas.FillText(Bounds,  Value.ToString, False, 100, [TFillTextFlag.RightToLeft],
   // TTextAlign.Center, TTextAlign.Center);
end;
----------------------------------------------
-
作者:
男 pcplayer (pcplayer) ★☆☆☆☆ -
普通会员
2022/5/15 13:32:09
12楼: 运行后居然让ubuntu崩溃死机了:

之前有在 windows 上测试过吗?
----------------------------------------------
-
作者:
男 sxqwhxq (步惊云) ★☆☆☆☆ -
普通会员
2022/5/15 14:54:26
13楼: 试了,差不多。
怎样让stringgrid有MouseLeave事件呢?这个在桌面系统有时要用的。
----------------------------------------------
-
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/15 22:25:42
14楼: honestly, you are trying to invent a wheel!

...I wonder what a new framework would be like in your conceptions!.

There's a lot of water in this rain... I think the plant is going to overflow at any moment.
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/15 22:36:30
15楼: the "Styles" is based in "Proxy Pattern":
--- Object-Source --> Rectangle -> receive the values by programmer
--- Proxy  // class to working --> "TStyledControl" --> a "proxy" analise  the values
--- Object Target  -> StringGrid --> use the values if ok

summary:
--- say "what you need", and let the OOP do it!
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/15 23:11:50
16楼: implementation

{$R *.fmx}

type
  TMyHackToStringGrid = class(TStringGrid); // StringGrid!

function WhoAmI(ASender: TObject; AText: string = ''): string;
begin
  result := ASender.ClassName + ' [' + DateTimeToStr(now) + '] ' + AText;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TMyHackToStringGrid(StringGrid1).OnEnter      := MyProcEnter;
  TMyHackToStringGrid(StringGrid1).OnExit       := MyProcExit;
  TMyHackToStringGrid(StringGrid1).OnMouseEnter := MyProcMouseEnter;
  TMyHackToStringGrid(StringGrid1).OnMouseLeave := MyProcMouseLeave;
end;

procedure TForm1.MyProcEnter(Sender: TObject);
begin
  Memo1.Lines.Add(WhoAmI(Sender, '...Entrying: '));
end;

procedure TForm1.MyProcExit(Sender: TObject);
begin
  Memo1.Lines.Add(WhoAmI(Sender, '...Exiting: '));
end;

procedure TForm1.MyProcMouseEnter(Sender: TObject);
begin
  Memo1.Lines.Add(WhoAmI(Sender, '...Mouse entrying: '));
end;

procedure TForm1.MyProcMouseLeave(Sender: TObject);
begin
  Memo1.Lines.Add(WhoAmI(Sender, '...Mouse leaving: '));
end;

end.
此帖子包含附件:
PNG 图像
大小:36.9K
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/15 23:27:05
17楼: ubuntu
此帖子包含附件:
PNG 图像
大小:319.5K
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/16 5:44:56
18楼: of course, the Style in StringGrid is a "complex" of properties to changing (try see on "Edit Style"), and when looking in simple-way it's not so easy to change it.

Then, it's better have a "BookStyle" with your preferences!
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 sxqwhxq (步惊云) ★☆☆☆☆ -
普通会员
2022/5/16 11:48:41
19楼: @ emailx45 (emailx45):谢谢,管用,原来很多fmx控件都有OnMouseLeave事件。
----------------------------------------------
-
作者:
男 sxqwhxq (步惊云) ★☆☆☆☆ -
普通会员
2022/5/16 13:31:12
20楼: @emailx45(emailx45):大神,Edti Custom style无法添加linux平台,修改的组件样式没有效果,怎么办呢?
----------------------------------------------
-
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/16 21:20:06
21楼: basically, your project should beggin in MSWindows like your platform-base. after create your project and test, change to Linux or any other.

of course, choice components/classes accepted in Linux. Else, it will dont compile! 
use the "compiler Diretives" when possible, like:
{$IFDEF xxxxx} .... command ..... {$ENDIF} ==> see on HELP SYSTEM.

the Styles FMX basic, works in all platforms. of course, some "bug" can happens! 

what you really needs to do in your project? this is the question.

my tip: 
--- Create a functional project ( the software should works )
--- if all works, now you can think about "appearance" (styles, skin, etc...)
--- tests, tests, tests....
--- dont lost your time with "little things" (focus on mandatory)
--- the big error for begginers is lost your time with appearance, create a new wheel, etc... 

FOCUS, FOCUS, FOCUS... in only the necessary and functional at first time!
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/16 21:25:29
22楼: if you need have a software "powerful", think "powerful".
if you need have a software "beautful", think "beautful".
if you need have these two quality, so, study a lot before starting!
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/16 21:28:42
23楼: @emailx45(emailx45):大神,Edti Custom style无法添加linux平台,修改的组件样式没有效果,怎么办呢?

-- what dont works? exactly!
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/17 2:58:53
24楼: Linux and Styles:
--- you can use MSWindows styles files ( *.Styles in Public folder)! Not problem!
--- you can use TStyleMananger (FMX.Styles.pas) to apply your styles

uses
  System.IOUtils,
  FMX.Styles;

var
{$IFDEF LINUX}
  MyStylesDirectory: string = './MyStyles';
{$ELSE}
  MyStylesDirectory: string = '.\MyStyles';
{$ENDIF}
  MyStyleFileNames: TArray<string> = [];

  // if needs privilegies... Try...Except...End for help!

procedure MyGetMyStyleFilesOn(AStyleFilePath: string);
begin
  if TDirectory.Exists(MyStylesDirectory) then
    MyStyleFileNames := TDirectory.GetFiles(MyStylesDirectory);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyGetMyStyleFilesOn(MyStylesDirectory);
  //
  for var MyItem in MyStyleFileNames do
    ListBox1.Items.Add(TPath.GetFileNameWithoutExtension(MyItem));
  //
  ListBox1.ItemIndex := (ListBox1.Count - 1);
end;

procedure TForm1.ListBox1Change(Sender: TObject);
begin
  TStyleManager.SetStyleFromFile(MyStyleFileNames[ListBox1.ItemIndex]);
end;

end.

//
NOTE:
--- Menu Deployment ---> add all files (*.Styles) in your target folder (ex. ./MyStyles )
此帖子包含附件:
PNG 图像
大小:96.3K
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 sxqwhxq (步惊云) ★☆☆☆☆ -
普通会员
2022/5/17 11:40:12
25楼: @ emailx45 (emailx45):
我直接用edit custom style修改button,把text放在左边,图标放在右边,图标大小改为28*28,在win下有效果,在ubuntu下没有作用。
现在我在form下这样写代码,可以改变speedbutton图标大小:
procedure TMainFM.FormPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
   FObjIcon: TFmxObject;
begin
    FObjIcon := SpeedButton1.FindStyleResource('glyphstyle');
    if (FObjIcon <> nil) and (FObjIcon.InheritsFrom(TGlyph)) then
    begin
        TGlyph(FObjIcon).Height := 28;
        TGlyph(FObjIcon).Width := 28;
    end;
end;
现在我想去除speedbutton的外框,该怎么办呢?
此帖子包含附件:
PNG 图像
大小:19.9K
----------------------------------------------
-
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/17 22:19:59
26楼: ...
    TGlyph(FObjIcon).Align  := TAlignLayout.Right;  // <--- Anchor
    TGlyph(FObjIcon).Height := 28;
    TGlyph(FObjIcon).Width  := 28;
...

by default, some objects are not "anchored" at any position in the container. So you need to explicitly define this.

The easiest way is to use "alignment", but you can use the component's "anchor" options (top, left, bottom and/or right).
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/17 22:20:59
27楼: REMEMBER: Events like this are called many times during the canvas painting process.
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/18 0:58:40
28楼: to remove the "border-line", just change the "STROKE" property to "NONE" if you are using a Rectangle as background!

by default, SpeedButton use a "Bitmap" transparent like your background
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 sxqwhxq (步惊云) ★☆☆☆☆ -
普通会员
2022/5/18 8:28:40
29楼: 谢谢 emailx45 (emailx45):下面的语句有效果。
TGlyph(FObjIcon).Align  := TAlignLayout.Right;
speedbutton在设计时没有边框,编译为win没边框,可是编译到linux就自动添加了边框,不知道怎么消除?
----------------------------------------------
-
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/18 10:58:53
30楼: in fact, there is not any border on SpeedButtons.
this component dont receive "focus", then, dont have it!

try a new project FMX (empty) and put just 1 speedbutton and compile to Linux!

Review your StyleBook in your project!
此帖子包含附件:
PNG 图像
大小:24.7K
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 sxqwhxq (步惊云) ★☆☆☆☆ -
普通会员
2022/5/18 11:24:34
31楼: 在fmx frame无法使用edit custom style
----------------------------------------------
-
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/18 12:43:49
32楼: you can:

1 - use any FORM to edit your StyleBooks

ex.:
 "Edit Custom Style" to all SpeedButtons, Panels, Buttons, Edits, etc...
 all your components in your project!

  See above my pictures:
  a) I have on SpeedButton1Style1:
      SpeedButton1Style1.STYLENAME = myspeedbuttonstyle (for example)  

2 - copy this StylesBooks for a DATAMODULE 

3 - now, just "use" this "DATAMODULE" in your "FORMS or FRAMES"

Form1  uses "MyDataModule"
Frame1 uses "MyDataModule"
此帖子包含附件:
PNG 图像
大小:66.8K
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
注册会员
2022/5/18 12:48:38
33楼: sorry, I'll go to sleep ... 01:45hrs AM
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!
作者:
男 tuhemm (刀锋土禾) ▲△△△△ -
注册会员
2022/5/20 1:12:05
34楼: 进来看看,支持一下
----------------------------------------------
自闭症训练机构|语言矫正中心|儿童康复中心|语言康复机构|儿童发音矫正|
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v2.1 版权所有 页面执行46.875毫秒 RSS