解决Delphi开发DLL中窗体按钮显示状态不刷新问题.

版权声明:本文为博主原创文章,遵循 CC 4.0 by-sa 版权协议,转载请附上原文出处链接和本声明。
本文链接:https://blog.csdn.net/u011883102/article/details/49636811

由于DLL中没有消息循环,在DLL的窗体上放一个TSpeedButton控件, Flat属性设置为True. 运行. 当鼠标从TSpeedButton上移过时, TSpeedButton怎么也还原不了,

需要手动接收消息处理,具体操作如下:

1.在窗体上放置一个Timer1组件,
2.间隔时间为1
3.在Timer1Timer事件中写上一行代码:Application.HandleMessage;

 

附上我的窗体完整代码:

unit untBaseForm;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, Buttons, sSpeedButton, ImgList, StdCtrls, ExtCtrls, IniFiles,
   sLabel, untDefine, sSkinManager;

type
   TNowDataUser = record
      UserName:String; {用户名称}
      UserCode:String; {用户帐号}
      UserPass:string; {用户密码}
      UserFlag:Integer;{用户类型}
   end;

   {当前数据}
   TNowData = record
      User: TNowDataUser; {当前用户}
      {...}
   end;
   TBaseForm = class(TForm)
      pnlBody: TPanel;
      pnlTitle: TPanel;
      btnwsClose: TsSpeedButton;
      btnwsMin: TsSpeedButton;
      btnwsMax: TsSpeedButton;
      btnwsNormal: TsSpeedButton;
      btnSkin: TsSpeedButton;
      btnMenu: TsSpeedButton;
      lblTitle: TsLabel;
      sm: TsSkinManager;
      procedure btnwsCloseClick(Sender: TObject);
      procedure btnwsMaxClick(Sender: TObject);
      procedure btnwsMinClick(Sender: TObject);
      procedure pnlTitleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
      procedure FormShow(Sender: TObject);
      procedure btnSkinClick(Sender: TObject);
      procedure FormActivate(Sender: TObject);
      procedure FormCreate(Sender: TObject);
   private
      { Private declarations }
      FDefaultMaxWindows: boolean;
      FShowInTaskbar: Boolean;
      FShowDll: TTimer; {用于解决Dll中窗体没有消息循环造成按钮上移动不刷新问题}
      procedure FShowDllTimer(Sender: TObject);
      procedure CreateParams(var Params: TCreateParams); override;
   protected
      procedure ini_SkinRead; virtual;
      procedure ini_SkinWrite(i: Integer); virtual;
      procedure SetwsMaxorNormal; virtual;
   public
      { Public declarations }
      NowData:TNowData; {当前数据,包括当前登录用户信息等..}
      /// <summary>
      /// 构造函数扩展任务栏是否显示
      /// </summary>
      /// <param name="AOwner"></param>
      /// <param name="ShowTaskbar">True:在任务栏显示(仅在Exe中起作用)</param>
      /// <param name="DefaultMaxWindows">默认打开窗口是否最大化(注:如果调整了继承窗体的大小后,更改属性WindowState会失效,所以增加了此参数)</param>
      constructor CreateSTB(AOwner: TComponent; ShowTaskbar: Boolean = False;DefaultMaxWindows:Boolean=False); virtual;
   published

   end;

var
   BaseForm: TBaseForm;

implementation

{$R *.dfm}

{关闭}
procedure TBaseForm.btnwsCloseClick(Sender: TObject);
begin
   Close;
end;

{最大化}
procedure TBaseForm.btnwsMaxClick(Sender: TObject);
begin
   if (btnwsNormal.Visible = false) and (btnwsMax.Visible = False) then exit;
   if WindowState = wsNormal then
   begin
      WindowState := wsMaximized;
      SetwsMaxorNormal;
   end
   else
   begin
      WindowState := wsNormal;
      Self.Left := (Screen.Width div 2) - (Self.Width div 2);
      Self.Top := (Screen.Height div 2) - (Self.Height div 2);
      SetwsMaxorNormal;
   end;
end;

{最小化}
procedure TBaseForm.btnwsMinClick(Sender: TObject);
begin
   //Application.Minimize;
   WindowState := wsMinimized;
end;

{拖动标题,移动窗体}
procedure TBaseForm.pnlTitleMouseMove(Sender: TObject;
   Shift: TShiftState; X, Y: Integer);
begin
   if WindowState = wsMaximized then exit;
   if ssleft in Shift then ReleaseCapture;
   Perform(WM_SYSCOMMAND, $F012, 0);
end;

{点击标题变色}
procedure TBaseForm.btnSkinClick(Sender: TObject);
begin
   ini_SkinWrite(pnlTitle.Tag + 1);
   ini_SkinRead;
end;

procedure TBaseForm.FormShow(Sender: TObject);
begin
   SetwsMaxorNormal;
   ini_SkinRead;
   Caption := lblTitle.Caption;

   {解决Dll中窗体没有消息循环造成按钮上移动不刷新问题}
   if  Application.MainForm=nil  then
   begin
      if not (fsModal in Self.FormState) then
      begin
         if FShowDll=nil then
         begin
            FShowDll:= TTimer.Create(Self);
            FShowDll.Enabled:=False;
            FShowDll.Interval:=1;
            FShowDll.OnTimer:= FShowDllTimer;
         end;
         if not FShowDll.Enabled then FShowDll.Enabled:=true;
      end;
   end;
end;

{设置最大化一般化按钮状态}
procedure TBaseForm.SetwsMaxorNormal;
begin
   if (btnwsNormal.Visible = false) and (btnwsMax.Visible = False) then exit;
   btnwsMax.Visible := WindowState = wsNormal;
   btnwsNormal.Visible := WindowState = wsMaximized;
   btnwsNormal.Left := btnwsMax.Left;
   btnwsNormal.Top := btnwsMax.Top;
end;

{加载皮肤颜色}
procedure TBaseForm.ini_SkinRead;
var
   ini: TIniFile;
   i: integer;
begin
   ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'skin.dat');
   try
      pnlTitle.Tag := ini.ReadInteger('skin', 'color', 0);
      if pnlTitle.Tag > High(G_FormSkinColor) then pnlTitle.Tag := 0;
   finally
      FreeAndNil(ini);
   end;
   pnlTitle.Color := G_FormSkinColor[pnlTitle.Tag];
   pnlTitle.Refresh;

   for i := 0 to pnlTitle.ControlCount - 1 do
   begin
      if pnlTitle.Controls[i].Visible then
      begin
         pnlTitle.Controls[i].Hide;
         pnlTitle.Controls[i].Show;
      end;
   end;
end;

{保存皮肤颜色}
procedure TBaseForm.ini_SkinWrite(i: Integer);
var
   ini: TIniFile;
begin
   if i > High(G_FormSkinColor) then i := 0;
   ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'skin.dat');
   try
      ini.WriteInteger('skin', 'color', i);
   finally
      FreeAndNil(ini);
   end;
end;

procedure TBaseForm.CreateParams(var Params: TCreateParams);
begin
   inherited;
   if FShowInTaskbar then Params.WndParent := 0; //在任务栏显示标题
end;

constructor TBaseForm.CreateSTB(AOwner: TComponent; ShowTaskbar: Boolean = False;DefaultMaxWindows:Boolean=False);
begin
   if (ShowTaskbar)  and (Application.MainForm<>nil) then FShowInTaskbar := True;
   FDefaultMaxWindows:=DefaultMaxWindows;
   inherited Create(AOwner);
   //if not ShowTaskbar then SetWindowLong(Self.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TBaseForm.FormCreate(Sender: TObject);
begin
   if (WindowState = wsMaximized) or (FDefaultMaxWindows=True) then
   begin
      FDefaultMaxWindows := true;
      WindowState := wsNormal;
      Position := poDefault;
   end;
end;

procedure TBaseForm.FormActivate(Sender: TObject);
begin
   if FDefaultMaxWindows then
   begin
      WindowState := wsMaximized;
      FDefaultMaxWindows := false;
   end;
end;

procedure TBaseForm.FShowDllTimer(Sender: TObject);
begin
   if (Self<>nil ) and (Self.Visible) then
      Application.HandleMessage;
end;

end.






 DLL工程文件:

library Sale;

uses
  SysUtils,
  Classes,
  Forms,
  Controls,
  Windows,
  untBaseDM in '..\Common\untBaseDM.pas' {BaseDM: TDataModule},
  untBaseForm in '..\Common\untBaseForm.pas' {BaseForm},
  untSaleDemo in 'untSaleDemo.pas' {fmSaleDemo},
  untDM in 'untDM.pas' {DM: TDataModule};

{$R *.res}

/// <summary>
/// 获取fmSaleDemo
/// </summary>
/// <param name="Taskbar">是否在任务栏显示(True时不建议ShowModal窗体)</param>
/// <param name="New">是否重新创建</param>
/// <param name="MaxWindows">是否最大化窗体</param>
/// <param name="NowData">当前数据</param>
/// <param name="AHandle">Application.Handle</param>
/// <returns>fmSaleDemo</returns>
function GetFormSaleDemo(Taskbar: Boolean; New: Boolean; MaxWindows:Boolean; NowData:TNowData; AHandle: Thandle=0): TBaseForm; stdcall;
begin
   if Taskbar=False then Application.Handle:= AHandle;
   if (New) and (fmSaleDemo <> nil) then FreeAndNil(fmSaleDemo);
   if fmSaleDemo = nil then fmSaleDemo := TfmSaleDemo.CreateSTB(nil, Taskbar, MaxWindows);
   fmSaleDemo.NowData:=NowData;
   Result := fmSaleDemo;
end;

exports
   GetFormSaleDemo;



begin
end.

 

 

主程序调用:

 

function GetFormSaleDemo(Taskbar: Boolean; New: Boolean; MaxWindows: Boolean; NowData: TNowData; AHandle: Thandle = 0): TBaseForm; stdcall; external 'Sale.dll';

procedure TfmMain.btnSaleOrderClick(Sender: TObject);
var
   frm:TBaseForm;
begin
   frm := GetFormSaleDemo(False, True, False, NowData, Application.Handle);
   frm.ShowModal
end;


展开阅读全文

没有更多推荐了,返回首页