home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / Essentials / SETUP.EXE / %MAINDIR% / EsBase.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-28  |  14.8 KB  |  577 lines
  1. {*********************************************************}
  2. {*                   ESBASE.PAS 1.05                     *}
  3. {*      Copyright (c) 1997-98 TurboPower Software Co     *}
  4. {*                 All rights reserved.                  *}
  5. {*********************************************************}
  6.  
  7. {$I ES.INC}
  8.  
  9. {$B-} {Complete Boolean Evaluation}
  10. {$I+} {Input/Output-Checking}
  11. {$P+} {Open Parameters}
  12. {$T-} {Typed @ Operator}
  13. {$W-} {Windows Stack Frame}
  14. {$X+} {Extended Syntax}
  15.  
  16. {$IFDEF WIN32}                                                         {!!.02}
  17.   {$J+} {Writable constants}                                           {!!.02}
  18. {$ENDIF}                                                               {!!.02}
  19.  
  20. {$IFNDEF Win32}
  21.   {$G+} {286 Instructions}
  22.   {$N+} {Numeric Coprocessor}
  23.   {$C MOVEABLE,DEMANDLOAD,DISCARDABLE}
  24. {$ENDIF}
  25.  
  26. unit EsBase;
  27.   {-essentials' base class}
  28.  
  29. interface
  30.  
  31. {$IFDEF Win32}
  32.   {$R ESBASE.R32}
  33. {$ELSE}
  34.   {$R ESBASE.R16}
  35. {$ENDIF Win32}
  36.  
  37. uses
  38.   {$IFDEF Win32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  39.   Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus, Messages,
  40.   StdCtrls, SysUtils,
  41.   EsConst, EsData, EsLabel, EsUtil;
  42.  
  43. type
  44.   TEsLabelPosition = (dlpTopLeft, dlpBottomLeft);
  45.  
  46.   EEssentialsError = class(Exception);
  47.  
  48.   TEsAttachEvent = procedure(Sender : TObject; Value : Boolean)
  49.     of object;
  50.  
  51. type
  52.   {.Z+}
  53.   TEsAttachedLabel = class(TEsCustomLabel)
  54.   private
  55.     FEsControl    : TWinControl;
  56.  
  57.     {internal methods}
  58.     procedure eslSavePosition;
  59.  
  60.   protected
  61.     procedure Loaded;
  62.       override;
  63.  
  64.   public
  65.     constructor Create(AOwner : TComponent);
  66.       override;
  67.     constructor CreateEx(AOwner : TComponent; AControl : TWinControl);
  68.       virtual;
  69.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  70.       override;
  71.  
  72.   published
  73.     {properties from TCustomLabel}
  74.     property Alignment;
  75.     property Caption;
  76.     property Color;
  77.     property FocusControl;
  78.     property Font;
  79.     property Height;
  80.     property Left;
  81.     property Name;
  82.     property ParentColor;
  83.     property ParentFont;
  84.     property ParentShowHint;
  85.     property ShowAccelChar;
  86.     property ShowHint;
  87.     property Tag;
  88.     property Top;
  89.     property Transparent;
  90.     property Width;
  91.     property WordWrap;
  92.  
  93.     {properties from TEsCustomLabel}
  94.     property Appearance
  95.       default apNone;
  96.  
  97.     property ColorScheme
  98.       default csText;
  99.  
  100.     property CustomSettings;
  101.  
  102.     property EsControl : TWinControl
  103.       read FEsControl
  104.       write FEsControl;
  105.   end;
  106.   {.Z-}
  107.  
  108. type
  109.   TEsLabelInfo = class(TPersistent)
  110.   private
  111.     {.Z+}
  112.     {property variables}
  113.     FOffsetX  : Integer;
  114.     FOffsetY  : Integer;
  115.  
  116.     {event variables}
  117.     FOnChange : TNotifyEvent;
  118.     FOnAttach : TEsAttachEvent;
  119.  
  120.     {internal methods}
  121.     procedure DoOnAttach;
  122.     procedure DoOnChange;
  123.  
  124.     {property methods}
  125.     procedure SetOffsetX(Value : Integer);
  126.     procedure SetOffsetY(Value : Integer);
  127.     procedure SetVisible(Value : Boolean);
  128.     {.Z-}
  129.   public
  130.     {.Z+}
  131.     ALabel   : TEsAttachedLabel;
  132.     FVisible : Boolean;
  133.  
  134.     property OnAttach : TEsAttachEvent
  135.       read FOnAttach
  136.       write FOnAttach;
  137.  
  138.     property OnChange : TNotifyEvent
  139.       read FOnChange
  140.       write FOnChange;
  141.  
  142.     procedure SetOffsets(X, Y : Integer);
  143.     {.Z-}
  144.  
  145.   published
  146.     property OffsetX: Integer
  147.       read FOffsetX
  148.       write SetOffsetX
  149.       nodefault;
  150.  
  151.     property OffsetY: Integer
  152.       read FOffsetY
  153.       write SetOffsetY
  154.       nodefault;
  155.  
  156.     property Visible : Boolean
  157.       read FVisible
  158.       write SetVisible
  159.       nodefault;
  160.   end;
  161.  
  162. type
  163.   {$IFDEF NeedMouseWheel}                                      {!!.05}
  164.   TMouseWheelEvent = procedure(Sender : TObject; Shift : TShiftState; Delta, XPos, YPos : Word)
  165.     of object;
  166.   {$ENDIF}                                                     {!!.05}
  167.  
  168.   TEsBase = class(TCustomControl)
  169.   protected {private}
  170.     {.Z+}
  171.     {property variables}
  172.     FEsLabel : TEsLabelInfo;
  173.  
  174.     {event variables}
  175.     {$IFDEF NeedMouseWheel}                                    {!!.05}
  176.     FOnMouseWheel : TMouseWheelEvent;
  177.     {$ENDIF}                                                   {!!.05}
  178.  
  179.     {property methods}
  180.     function GetAttachedLabel : TEsAttachedLabel;
  181.     function GetVersion : string;
  182.     procedure SetVersion(const Value : string);
  183.  
  184.     {internal methods}
  185.     procedure LabelChange(Sender : TObject);
  186.     procedure LabelAttach(Sender : TObject; Value : Boolean);
  187.     procedure PositionLabel;
  188.  
  189.     {private message methods}
  190.     procedure ESAssignLabel(var Msg : TMessage);
  191.       message ES_ASSIGNLABEL;
  192.     procedure ESPositionLabel(var Msg : TMessage);
  193.       message ES_POSITIONLABEL;
  194.     procedure ESRecordLabelPosition(var Msg : TMessage);
  195.       message ES_RECORDLABELPOSITION;
  196.  
  197.     {windows message methods}
  198.     {$IFDEF NeedMouseWheel}                                    {!!.05}
  199.     procedure WMMouseWheel(var Msg : TMessage);
  200.       message WM_MOUSEWHEEL;
  201.     {$ENDIF}                                                   {!!.05}
  202.     {.Z-}
  203.  
  204.   protected
  205.     {descendants can set the value of this variable after calling inherited }
  206.     {create to set the default location and point-of-reference (POR) for the}
  207.     {attached label. if dlpTopLeft, the default location and POR will be at }
  208.     {the top left of the control. if dlpBottomLeft, the default location and}
  209.     {POR will be at the bottom left}
  210.     {.Z+}
  211.     DefaultLabelPosition : TEsLabelPosition;
  212.  
  213.     procedure Notification(AComponent : TComponent; Operation: TOperation);
  214.       override;
  215.  
  216.     {$IFDEF NeedMouseWheel}                                    {!!.05}
  217.     procedure DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
  218.       dynamic;
  219.     {$ENDIF}                                                   {!!.05}
  220.     {.Z-}
  221.     property EsLabelInfo : TEsLabelInfo
  222.       read FEsLabel
  223.       write FEsLabel;
  224.  
  225.     property Version : string
  226.       read GetVersion
  227.       write SetVersion
  228.       stored False;
  229.  
  230.   public
  231.     {.Z+}
  232.     constructor Create(AOwner : TComponent);
  233.       override;
  234.     destructor Destroy;
  235.       override;
  236.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);        {!!.05}
  237.       override;
  238.     {.Z-}
  239.     property AttachedLabel : TEsAttachedLabel
  240.       read GetAttachedLabel;
  241.  
  242.   published
  243.     {$IFDEF NeedMouseWheel}                                    {!!.05}
  244.     property OnMouseWheel : TMouseWheelEvent
  245.       read FOnMouseWheel
  246.       write FOnMouseWheel;
  247.     {$ELSE}                                                    {!!.05}
  248.     {$IFNDEF Windows}                                          {!!.05}
  249.     property OnMouseWheel;                                     {!!.05}
  250.     {$ENDIF}                                                   {!!.05}
  251.     {$ENDIF}                                                   {!!.05}
  252.   end;
  253.  
  254.  
  255. implementation
  256.  
  257.  
  258. {$IFDEF TRIALRUN}
  259. uses
  260.   EsTrial;
  261. {$I ESTRIALF.INC}
  262. {$ENDIF}
  263.  
  264.  
  265. {*** TEsLabelInfo ***}
  266.  
  267. procedure TEsLabelInfo.DoOnAttach;
  268. begin
  269.   if Assigned(FOnAttach) then
  270.     FOnAttach(Self, FVisible);
  271. end;
  272.  
  273. procedure TEsLabelInfo.DoOnChange;
  274. begin
  275.   if Assigned(FOnChange) then
  276.     FOnChange(Self);
  277. end;
  278.  
  279. procedure TEsLabelInfo.SetOffsets(X, Y : Integer);
  280. begin
  281.   if (X <> FOffsetX) or (Y <> FOffsetY) then begin
  282.     FOffsetX := X;
  283.     FOffsetY := Y;
  284.     DoOnChange;
  285.   end;
  286. end;
  287.  
  288. procedure TEsLabelInfo.SetOffsetX(Value : Integer);
  289. begin
  290.   if Value <> FOffsetX then begin
  291.     FOffsetX := Value;
  292.     DoOnChange;
  293.   end;
  294. end;
  295.  
  296. procedure TEsLabelInfo.SetOffsetY(Value : Integer);
  297. begin
  298.   if Value <> FOffsetY then begin
  299.     FOffsetY := Value;
  300.     DoOnChange;
  301.   end;
  302. end;
  303.  
  304. procedure TEsLabelInfo.SetVisible(Value : Boolean);
  305. begin
  306.   if Value <> FVisible then begin
  307.     FVisible := Value;
  308.     DoOnAttach;
  309.   end;
  310. end;
  311.  
  312.  
  313. {*** TEsAttachedLabel ***}
  314.  
  315. constructor TEsAttachedLabel.Create(AOwner : TComponent);
  316. {$IFDEF TRIALRUN}
  317. var
  318.   X : Integer;
  319. {$ENDIF}
  320. begin
  321.   inherited Create(AOwner);
  322.  
  323.   {set new defualts}
  324.   AutoSize    := True;
  325.   ColorScheme := csText;
  326.   Appearance  := apNone;
  327.   ParentFont  := True;
  328.   Transparent := False;
  329.  
  330. {$IFDEF TRIALRUN}
  331.   X := _CC_;
  332.   if (X < ccRangeLow) or (X > ccRangeHigh) then Halt;
  333.   X := _VC_;
  334.   if (X < ccRangeLow) or (X > ccRangeHigh) then Halt;
  335. {$ENDIF}
  336. end;
  337.  
  338. constructor TEsAttachedLabel.CreateEx(AOwner : TComponent; AControl : TWinControl);
  339. begin
  340.   FEsControl := AControl;
  341.  
  342.   Create(AOwner);
  343. end;
  344.  
  345. procedure TEsAttachedLabel.eslSavePosition;
  346. var
  347.   PF : TForm;
  348.   I  : Integer;
  349. begin
  350.   if (csLoading in ComponentState) or (csDestroying in ComponentState) then
  351.     Exit;
  352.  
  353.   {see if our associated control is on the form - save position}
  354.   PF := TForm(GetParentForm(Self));
  355.   if Assigned(PF) then begin
  356.     for I := 0 to Pred(PF.ComponentCount) do begin
  357.       if PF.Components[I] = FEsControl then begin
  358.         SendMessage(FEsControl.Handle, ES_ASSIGNLABEL, 0, LongInt(Self));
  359.         PostMessage(FEsControl.Handle, ES_RECORDLABELPOSITION, 0, 0);
  360.         Break;
  361.       end;
  362.     end;
  363.   end;
  364. end;
  365.  
  366. procedure TEsAttachedLabel.Loaded;
  367. begin
  368.   inherited Loaded;
  369.  
  370.   eslSavePosition;
  371. end;
  372.  
  373. procedure TEsAttachedLabel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  374. begin
  375.   inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  376.  
  377.   eslSavePosition;
  378. end;
  379.  
  380.  
  381. {*** TEsBase ***}
  382.  
  383. constructor TEsBase.Create(AOwner : TComponent);
  384. {$IFDEF TRIALRUN}
  385. var
  386.   X : Integer;
  387. {$ENDIF}
  388. begin
  389.   inherited Create(AOwner);
  390.  
  391.   Height := 25;
  392.   Width  := 75;
  393.  
  394.   {set default position and reference point}
  395.   DefaultLabelPosition := dlpTopLeft;
  396.  
  397.   FEsLabel := TEsLabelInfo.Create;
  398.   FEsLabel.OnChange := LabelChange;
  399.   FEsLabel.OnAttach := LabelAttach;
  400. {$IFDEF TRIALRUN}
  401.   X := _CC_;
  402.   if (X < ccRangeLow) or (X > ccRangeHigh) then Halt;
  403.   X := _VC_;
  404.   if (X < ccRangeLow) or (X > ccRangeHigh) then Halt;
  405. {$ENDIF}
  406. end;
  407.  
  408. destructor TEsBase.Destroy;
  409. begin
  410.   {detatch and destroy label, if any}
  411.   FEsLabel.Visible := False;
  412.  
  413.   {destroy label info}
  414.   FEsLabel.Free;
  415.   FEsLabel := nil;
  416.  
  417.   inherited Destroy;
  418. end;
  419.  
  420. {$IFDEF NeedMouseWheel}                                        {!!.05}
  421. procedure TEsBase.DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
  422. begin
  423.   if Assigned(FOnMouseWheel) then
  424.     FOnMouseWheel(Self, Shift, Delta, XPos, YPos);
  425. end;
  426. {$ENDIF}                                                       {!!.05}
  427.  
  428. procedure TEsBase.ESAssignLabel(var Msg : TMessage);
  429. begin
  430.   FEsLabel.ALabel := TEsAttachedLabel(Msg.lParam);
  431. end;
  432.  
  433. procedure TEsBase.ESPositionLabel(var Msg : TMessage);
  434. const
  435.   DX : Integer = 0;
  436.   DY : Integer = 0;
  437. begin
  438.   if FEsLabel.Visible and Assigned(FEsLabel.ALabel) and (FEsLabel.ALabel.Parent <> nil) and
  439.      not (csLoading in ComponentState) then begin
  440.     if DefaultLabelPosition = dlpTopLeft then begin
  441.       DX := FEsLabel.ALabel.Left - Left;
  442.       DY := FEsLabel.ALabel.Top + FEsLabel.ALabel.Height - Top;
  443.     end else begin
  444.       DX := FEsLabel.ALabel.Left - Left;
  445.       DY := FEsLabel.ALabel.Top - Top - Height;
  446.     end;
  447.     if (DX <> FEsLabel.OffsetX) or (DY <> FEsLabel.OffsetY) then
  448.       PositionLabel;
  449.   end;
  450. end;
  451.  
  452. procedure TEsBase.ESRecordLabelPosition(var Msg : TMessage);
  453. begin
  454.   if Assigned(FEsLabel.ALabel) and (FEsLabel.ALabel.Parent <> nil) then begin
  455.     {if the label was cut and then pasted, this will complete the re-attachment}
  456.     FEsLabel.FVisible := True;
  457.  
  458.     if DefaultLabelPosition = dlpTopLeft then
  459.       FEsLabel.SetOffsets(FEsLabel.ALabel.Left - Left,
  460.         FEsLabel.ALabel.Top + FEsLabel.ALabel.Height - Top)
  461.     else
  462.       FEsLabel.SetOffsets(FEsLabel.ALabel.Left - Left,
  463.         FEsLabel.ALabel.Top - Top - Height);
  464.   end;
  465. end;
  466.  
  467. function TEsBase.GetAttachedLabel : TEsAttachedLabel;
  468. begin
  469.   if not FEsLabel.Visible then
  470.     raise EEssentialsError.Create(StrRes[SCEsLabelNotAttached]);
  471.  
  472.   Result := FEsLabel.ALabel;
  473. end;
  474.  
  475. function TEsBase.GetVersion : string;
  476. begin
  477.   Result := EsVersionStr;
  478. end;
  479.  
  480. procedure TEsBase.LabelAttach(Sender : TObject; Value : Boolean);
  481. var
  482.   PF : TForm;
  483. begin
  484.   if csLoading in ComponentState then
  485.     Exit;
  486.  
  487.   PF := TForm(GetParentForm(Self));
  488.   if Value then begin
  489.     if Assigned(PF) then begin
  490.       FEsLabel.ALabel.Free;
  491.       FEsLabel.ALabel := TEsAttachedLabel.CreateEx(PF, Self);
  492.       FEsLabel.ALabel.Parent := Parent;
  493.       FEsLabel.ALabel.Caption := Name+'Label';
  494.       FEsLabel.SetOffsets(0, 0);
  495.       PositionLabel;
  496.       FEsLabel.ALabel.BringToFront;
  497.       {turn off auto size}
  498.       FEsLabel.ALabel.AutoSize := False;
  499.     end;
  500.   end else begin
  501.     if Assigned(PF) then begin
  502.       FEsLabel.ALabel.Free;
  503.       FEsLabel.ALabel := nil;
  504.     end;
  505.   end;
  506. end;
  507.  
  508. procedure TEsBase.LabelChange(Sender : TObject);
  509. begin
  510.   if not (csLoading in ComponentState) then
  511.     PositionLabel;
  512. end;
  513.  
  514. procedure TEsBase.Notification(AComponent : TComponent; Operation: TOperation);
  515. var
  516.   PF : TForm;
  517. begin
  518.   inherited Notification(AComponent, Operation);
  519.  
  520.   if Operation = opRemove then
  521.     if Assigned(FEsLabel) and (AComponent = FEsLabel.ALabel) then begin
  522.       PF := TForm(GetParentForm(Self));
  523.       if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
  524.         FEsLabel.FVisible := False;
  525.         FEsLabel.ALabel := nil;
  526.       end
  527.     end;
  528. end;
  529.  
  530. procedure TEsBase.PositionLabel;
  531. begin
  532.   if FEsLabel.Visible and Assigned(FEsLabel.ALabel) and (FEsLabel.ALabel.Parent <> nil) and
  533.      not (csLoading in ComponentState) then begin
  534.  
  535.     if DefaultLabelPosition = dlpTopLeft then begin
  536.       FEsLabel.ALabel.SetBounds(Left + FEsLabel.OffsetX,
  537.                          FEsLabel.OffsetY - FEsLabel.ALabel.Height + Top,
  538.                          FEsLabel.ALabel.Width, FEsLabel.ALabel.Height);
  539.     end else begin
  540.       FEsLabel.ALabel.SetBounds(Left + FEsLabel.OffsetX,
  541.                          FEsLabel.OffsetY + Top + Height,
  542.                          FEsLabel.ALabel.Width, FEsLabel.ALabel.Height);
  543.     end;
  544.   end;
  545. end;
  546.  
  547. procedure TEsBase.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  548. begin
  549.   inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  550.  
  551.   if HandleAllocated then
  552.     PostMessage(Handle, ES_POSITIONLABEL, 0, 0);
  553. end;
  554.  
  555. procedure TEsBase.SetVersion(const Value : string);
  556. begin
  557. end;
  558.  
  559. {$IFDEF NeedMouseWheel}                                        {!!.05}
  560. procedure TEsBase.WMMouseWheel(var Msg : TMessage);
  561. begin
  562.   inherited;
  563.  
  564.   with Msg do
  565.     DoOnMouseWheel(KeysToShiftState(LOWORD(wParam)) {fwKeys},
  566.                    HIWORD(wParam) {zDelta},
  567.                    LOWORD(lParam) {xPos},   HIWORD(lParam) {yPos});
  568. end;
  569. {$ENDIF}                                                       {!!.05}
  570.  
  571. initialization
  572.   {register the attached label class}
  573.   if Classes.GetClass(TEsAttachedLabel.ClassName) = nil then
  574.     Classes.RegisterClass(TEsAttachedLabel);
  575.  
  576. end.
  577.