MdWArrowImpl1.pas
上传用户:fh681027
上传日期:2022-07-23
资源大小:1959k
文件大小:4k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit MdWArrowImpl1;
  2. interface
  3. uses
  4.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  5.   ComServ, StdVCL, AXCtrls, XArrow_TLB, MdWArrow;
  6. {$WARN SYMBOL_PLATFORM OFF}
  7. type
  8.   TMdWArrowX = class(TActiveXControl, IMdWArrowX)
  9.   private
  10.     { Private declarations }
  11.     FDelphiControl: TMdWArrow;
  12.     FEvents: IMdWArrowXEvents;
  13.     procedure ArrowDblClickEvent(Sender: TObject);
  14.     procedure ClickEvent(Sender: TObject);
  15.   protected
  16.     { Protected declarations }
  17.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  18.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  19.     procedure InitializeControl; override;
  20.     function Get_ArrowHeight: Integer; safecall;
  21.     function Get_Cursor: Smallint; safecall;
  22.     function Get_Direction: TxMdWArrowDir; safecall;
  23.     function Get_DoubleBuffered: WordBool; safecall;
  24.     function Get_Enabled: WordBool; safecall;
  25.     function Get_Filled: WordBool; safecall;
  26.     function Get_Visible: WordBool; safecall;
  27.     procedure Set_ArrowHeight(Value: Integer); safecall;
  28.     procedure Set_Cursor(Value: Smallint); safecall;
  29.     procedure Set_Direction(Value: TxMdWArrowDir); safecall;
  30.     procedure Set_DoubleBuffered(Value: WordBool); safecall;
  31.     procedure Set_Enabled(Value: WordBool); safecall;
  32.     procedure Set_Filled(Value: WordBool); safecall;
  33.     procedure Set_Visible(Value: WordBool); safecall;
  34.     function Get_FillColor: Integer; safecall;
  35.     procedure Set_FillColor(Value: Integer); safecall;
  36.     function Get_PenColor: Integer; safecall;
  37.     procedure Set_PenColor(Value: Integer); safecall;
  38.   end;
  39. implementation
  40. uses ComObj, XAPPage;
  41. { TMdWArrowX }
  42. procedure TMdWArrowX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  43. begin
  44.   DefinePropertyPage(Class_PropertyPage1);
  45. end;
  46. procedure TMdWArrowX.EventSinkChanged(const EventSink: IUnknown);
  47. begin
  48.   FEvents := EventSink as IMdWArrowXEvents;
  49. end;
  50. procedure TMdWArrowX.InitializeControl;
  51. begin
  52.   FDelphiControl := Control as TMdWArrow;
  53.   FDelphiControl.OnArrowDblClick := ArrowDblClickEvent;
  54.   FDelphiControl.OnClick := ClickEvent;
  55. end;
  56. function TMdWArrowX.Get_ArrowHeight: Integer;
  57. begin
  58.   Result := FDelphiControl.ArrowHeight;
  59. end;
  60. function TMdWArrowX.Get_Cursor: Smallint;
  61. begin
  62.   Result := Smallint(FDelphiControl.Cursor);
  63. end;
  64. function TMdWArrowX.Get_Direction: TxMdWArrowDir;
  65. begin
  66.   Result := Ord(FDelphiControl.Direction);
  67. end;
  68. function TMdWArrowX.Get_DoubleBuffered: WordBool;
  69. begin
  70.   Result := FDelphiControl.DoubleBuffered;
  71. end;
  72. function TMdWArrowX.Get_Enabled: WordBool;
  73. begin
  74.   Result := FDelphiControl.Enabled;
  75. end;
  76. function TMdWArrowX.Get_Filled: WordBool;
  77. begin
  78.   Result := FDelphiControl.Filled;
  79. end;
  80. function TMdWArrowX.Get_Visible: WordBool;
  81. begin
  82.   Result := FDelphiControl.Visible;
  83. end;
  84. procedure TMdWArrowX.ArrowDblClickEvent(Sender: TObject);
  85. begin
  86.   if FEvents <> nil then FEvents.OnArrowDblClick;
  87. end;
  88. procedure TMdWArrowX.ClickEvent(Sender: TObject);
  89. begin
  90.   if FEvents <> nil then FEvents.OnClick;
  91. end;
  92. procedure TMdWArrowX.Set_ArrowHeight(Value: Integer);
  93. begin
  94.   FDelphiControl.ArrowHeight := Value;
  95. end;
  96. procedure TMdWArrowX.Set_Cursor(Value: Smallint);
  97. begin
  98.   FDelphiControl.Cursor := TCursor(Value);
  99. end;
  100. procedure TMdWArrowX.Set_Direction(Value: TxMdWArrowDir);
  101. begin
  102.   FDelphiControl.Direction := TMdWArrowDir(Value);
  103. end;
  104. procedure TMdWArrowX.Set_DoubleBuffered(Value: WordBool);
  105. begin
  106.   FDelphiControl.DoubleBuffered := Value;
  107. end;
  108. procedure TMdWArrowX.Set_Enabled(Value: WordBool);
  109. begin
  110.   FDelphiControl.Enabled := Value;
  111. end;
  112. procedure TMdWArrowX.Set_Filled(Value: WordBool);
  113. begin
  114.   FDelphiControl.Filled := Value;
  115. end;
  116. procedure TMdWArrowX.Set_Visible(Value: WordBool);
  117. begin
  118.   FDelphiControl.Visible := Value;
  119. end;
  120. function TMdWArrowX.Get_FillColor: Integer;
  121. begin
  122.   Result := ColorToRGB (FDelphiControl.Brush.Color);
  123. end;
  124. procedure TMdWArrowX.Set_FillColor(Value: Integer);
  125. begin
  126.   FDelphiControl.Brush.Color := Value;
  127. end;
  128. function TMdWArrowX.Get_PenColor: Integer;
  129. begin
  130.   Result := ColorToRGB (FDelphiControl.Pen.Color);
  131. end;
  132. procedure TMdWArrowX.Set_PenColor(Value: Integer);
  133. begin
  134.   FDelphiControl.Pen.Color := Value;
  135. end;
  136. initialization
  137.   TActiveXControlFactory.Create(
  138.     ComServer,
  139.     TMdWArrowX,
  140.     TMdWArrow,
  141.     Class_MdWArrowX,
  142.     1,
  143.     '',
  144.     0,
  145.     tmApartment);
  146. end.