zoukankan      html  css  js  c++  java
  • 窗体动态库

    1、声明

         type
      PtrInt=Integer;

    2、

    function CreateAlarmObject(AppHandle:THandle;WinW,WinH:Integer):PtrInt;
    begin
      if Application.Handle=0 then
      begin
        Application.Initialize;
        Application.CreateHandle;
        Application.CreateForm(TFm_DM,Fm_DM);
        Application.ShowMainForm:=False;
        ShowWindow(Application.Handle, SW_HIDE);
      end;

       Result:=PtrInt(Pointer(TFm_WaringInfo.Create(nil)));
       TFm_WaringInfo(Pointer(Result)).Width:=WinW;
       TFm_WaringInfo(Pointer(Result)).Height:=WinH;
       TFm_WaringInfo(Pointer(Result)).FormStyle:=fsStayOnTop;
    end;

    function DeleteAlarmObject(Handle:PtrInt):Integer;
    begin
      if (Handle<>0) then
        TObject(Pointer(Handle)).Free;
      Result:=0;
    end;

    function ExecuteAlarmObject(Handle:PtrInt;TrainId:Pchar;Oper:Pchar;ALeft,ATop:Integer):integer;
    var
      TrainInfo:TTrainInfo;

    begin
      TrainInfo:=TTrainInfo.Create;
      TrainInfo.TrainID:=TrainId;
      TrainInfo.TrainNum:=Oper;
      TFm_WaringInfo(Pointer(Handle)).TrainInfo:=TrainInfo;
      TFm_WaringInfo(Pointer(Handle)).Top:=ATop;
      TFm_WaringInfo(Pointer(Handle)).Left:=ALeft;
      TFm_WaringInfo(Pointer(Handle)).Show;


      Result:=0;
    end;

    function HideAlarmObject(Handle:PtrInt):integer;
    begin
      TFm_WaringInfo(Pointer(Handle)).Hide;
      Result:=0;
    end;

    exports
      CreateAlarmObject,
      ExecuteAlarmobject,
      DeleteAlarmObject,
      HideAlarmObject;
    end.

    3、第三步:在测试程序中

    {
    跟踪调用方式
    }
    unit TrackAlarm;

    interface

    uses classes,sysutils,forms;

    const
      VIDEOPLUGIN='Alarm.plg';//动态库名称

    type
      PtrInt=integer;
     
      TTrackAlarm=class
      private
        FHandle:PtrInt;
      public
        constructor Create(WinW,WinH:Integer);
        destructor Destroy;override;
        function Execute(const TrainId,Oper:string;ATop,ALeft:Integer):integer;
        function Hide:integer;
        class function Track(const TrainId,Oper:string;ATop,ALeft:Integer):integer;
      end;


    function CreateAlarmObject(Handle:THandle;WinW,WinH:Integer):PtrInt;external VIDEOPLUGIN;
    function DeleteAlarmObject(Handle:PtrInt):Integer;external VIDEOPLUGIN;
    function HideAlarmObject(Handle:PtrInt):Integer;external VIDEOPLUGIN;
    function ExecuteAlarmObject(Handle:PtrInt;TrainId:Pchar;Oper:Pchar;ATop,ALeft:Integer):integer;external VIDEOPLUGIN;

    implementation
    var
      _TrackAlarm:TTrackAlarm;
    { TTrackVideo }

    constructor TTrackAlarm.Create(WinW,WinH:Integer);
    begin
      FHandle:=CreateAlarmObject(Application.Handle,WinW,WinH);
    end;

    destructor TTrackAlarm.Destroy;
    begin
      DeleteAlarmObject(FHandle);
      inherited;
    end;

    function TTrackAlarm.Execute(const TrainId, Oper: string;ATop,ALeft:Integer): integer;
    begin
      Result:=ExecuteAlarmObject(FHandle,Pchar(TrainId),Pchar(Oper),ATop,ALeft);
    end;

    function TTrackAlarm.Hide: integer;
    begin
      Result:=HideAlarmObject(FHandle);
    end;

    class function TTrackAlarm.Track(const TrainId, Oper: string;ATop,ALeft:Integer): integer;
    begin
      if not Assigned(_TrackAlarm) then
        _TrackAlarm:=TTrackAlarm.Create(800,480);

      Result:=_TrackAlarm.Execute(TrainId,Oper,ATop,ALeft);
    end;

    end.

    4、测试窗体

        private
        { Private declarations }
        TrackAlarm:TTrackAlarm;


    procedure TForm3.btn1Click(Sender: TObject);
    begin
       if not Assigned(TrackAlarm) then
       TrackAlarm:=TTrackAlarm.Create(800,480);
       TrackAlarm.Execute(edt1.Text,edt2.Text,300,400);
    end;

  • 相关阅读:
    win10让屏幕壁纸动态变化某文件夹下的图片
    win10查看桌面壁纸路径
    Caused by: com.mysql.cj.exceptions.InvalidConnectionAttributeException: The server time zone value '�й���׼ʱ��' is unrecognized or represents more than one time zone. You must configure either the serv
    将网站发布到阿里云的Linux服务器上(简述)
    图解MySQL 内连接、外连接、左连接、右连接、全连接
    JAVA _____Scanner用法
    JAVA数组翻转
    Lucene 01
    [转载] Relearning to Learn
    二进制包安装Kubernetes集群环境完整版
  • 原文地址:https://www.cnblogs.com/liujicai/p/4685052.html
Copyright © 2011-2022 走看看