2 Star 1 Fork 0

wyrover/FlatStyle

加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
该仓库未声明开源许可证文件(LICENSE),使用请关注具体项目描述及其代码上游依赖。
克隆/下载
FlatSingle.pas 1.55 KB
一键复制 编辑 原始数据 按行查看 历史
wyrover 提交于 2015-06-17 17:38 . + Init FlatStyle
unit FlatSingle;
interface
{$I FlatStyle.inc}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TFlatSingle = class(TComponent)
private
{ Private declarations }
FActive: boolean;
hmutex: Thandle;
FTitle: string;
procedure SetActive(Value: boolean);
protected
{ Protected declarations }
procedure Loaded; override;
procedure RunSingle(Single:Boolean);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
property Active: boolean read FActive write SetActive default True;
property Title: string read FTitle write FTitle;
end;
implementation
constructor TFlatSingle.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FActive := True;
FTitle := 'The program already run!';
end;
procedure TFlatSingle.Loaded;
begin
inherited Loaded;
RunSingle(Active);
end;
procedure TFlatSingle.RunSingle(Single: Boolean);
begin
if (Single)and(not(csDesigning in ComponentState)) then
begin
with Application do
begin
try
hmutex := OpenMutex(MUTEX_ALL_ACCESS, False, pchar(Title));
if hmutex = 0 then
begin
inherited;
hmutex := CreateMutex(nil, False, pchar(Title));
ReleaseMutex(hmutex);
end
else
begin
ShowMainForm := False;
ShowMessage(FTitle);
Terminate;
end;
finally
end;
end;
end;
end;
procedure TFlatSingle.SetActive(Value: boolean);
begin
FActive := Value;
RunSingle(FActive);
end;
end.
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
Pascal
1
https://gitee.com/wyrover/FlatStyle.git
git@gitee.com:wyrover/FlatStyle.git
wyrover
FlatStyle
FlatStyle
master

搜索帮助