Solved

TGraphicControl and TFont Problem (Component Related)

Posted on 1997-05-12
18
590 Views
Last Modified: 2008-03-04
I have a component that uses has a TFont property.  This property is contained in a TTextDisplay (inherited from TPeristent) class which is a property of the larger TSimGaugeDevice (inherited from TGraphicControl) class.

The problem stems when I change font properties.  In one instance it works fine, in another it causes all sorts of errors.

If I click on the "+" symbol next to the TFont property, all of the TFont properties are displayed in the Object Inspector.  It appears that this works flawlessly...that is changing font properties *on* the Object Inspector.

Now...if I click on the "..." that brings up the TFont dialogue box and try to change anything here...well, as soon as I click OK on the dialogue box, nothing happens to the component (the font doesn't get altered like in the method above).  As soon as I click on the component, all sorts of strange errors appear...a lot of "Access violation at address" and a few "Canvas does not allow drawing" and sometimes an "External exception".  To Delphi's credit, these do not crash the system...but it does not allow me to save anything, since on exiting Delphi all of the errors show up once again before Delphi finally closes.

I would like to post code...unfortunately the classes are quite large and I think it would take quite awhile to
wade through them.

If you have ideas/suggestions...please post them as COMMENTS only.  If one of them works, I'll invite that person to again post as an ANSWER and I grade.

The reason I ask for COMMENTS only is because some experts ignore questions awaiting answers.  Any answers will be immediately rejected until I've tested your suggestion.

By the way...I can be trusted to award you your points quickly and with a high grade.
0
Comment
Question by:mheacock
  • 11
  • 4
  • 2
  • +1
18 Comments
 
LVL 2

Expert Comment

by:gysbert1
ID: 1336164
Hi, I like the way you are going about this mheacock. I have suggested to E-E that they should consider officially doing it this way i.e. everybody just posts comments, and the person who asked the question gets to pick one as the answer...

The way I see it, there are two possibilities with your program

1) There is a very serious bug in Delphi. This is not unheard of, but I think unlikely with such a serious bug
2) There is a subtle flaw in your program somewhere. Perhaps (if not already) you should look very very carefully at the read and write method for your font property. Of course, with these kind of access violation bugs, the bug could be at a completely different place...

Anyway, I'm just guessing wildly at the moment. Perhaps you should post your code, so that those of use interested can have a look. Maybe we can spot something you missed, you know how it is when looking through your own code (yup, this must work... I can't see how this bit could have a bug...  I've used this code before, it worked then.. etc.)

0
 
LVL 4

Expert Comment

by:StevenB
ID: 1336165
 Just a thought on the matter:
  I've found that with my components problems are often related to access violations at design time, especially where canvases are concerned. Obviously without seeing your code I can't say whether this is relevant, but it might be worth checking that you've got all your 'If csDesigning in ComponentState' type conditionals opperating correctly.

  Steven.
0
 
LVL 3

Author Comment

by:mheacock
ID: 1336166
I'll see if I can post code tomorrow.  It might be better to
send the code to those interested.  There is quite a lot
of it, in three units...you might want to actually install
the component and try it out.
0
 
LVL 3

Expert Comment

by:sperling
ID: 1336167
When you edit subproperties of the font in the object inspector, you are in fact setting the properties of the already existing Font. When you use the ellipsis, a new font is created, and then your Font is set to this new font.

However, the newly created font is destroyed after assignment, therefore you should not set FFont := AFont in a font propertys write method, but rather do FFont.Assign(AFont).

Sample code follows.
-----------
unit SomeControl;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TSomeControl = class(TGraphicControl)
  private
  protected
    FFont      : TFont;
    procedure SetFont (value : TFont);
  public
    constructor Create(AOwner : TComponent); override;
  published
    property Font : TFont read FFont write SetFont;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TSomeCOntrol]);
end;

procedure TSomeControl.SetFont (value : TFont);
begin
// This line is incorrect. The font object pointed to by
// 'value' will be destroyed after SetFont exits, and FFont
// will point to unallocated memory. This will indeed cause
// Delphi to act funny...

{ FFont := value }

// This line copies all properties of the font object into the
// existing TFont object.
  FFont.Assign (value);

end;


constructor TSomeControl.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FFont := TFont.Create;
end;

----------

There are ofcourse other things that might cause your errors, but this exact mistake is very common...


Regards,

Erik.
0
 
LVL 3

Author Comment

by:mheacock
ID: 1336168
Nope...I've been doing the FFont.Assign(value) thing all along.

Maybe the problem is not TFont related...it might be canvas
related...but since the errors only occur when using the
ellipsis for TFont in the Object Inspector, I'm leaning towards
a problem in my code with the TFont.

BTW, the main class is TGraphicControl...this main class has
a TTextProperties class of TPersistent...it is here where all
the TFont stuff is.  Might it have something to do with TPeresistent??

If anyone want to include their e-mail addresses, I can send
the code to you for inspection.
0
 
LVL 3

Author Comment

by:mheacock
ID: 1336169
--------------------CSimBaseDevice Class and Unit-------------
unit SimBaseDevice;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, SSElement;

{$INCLUDE ..\..\Includes\SSConstants.inc}

type
  SAlarmSignalType = (ast_None, ast_HiHi, ast_Hi, ast_Lo, ast_LoLo, ast_Special);
  SAlarmAckType    = (aat_NA, aat_Acknowledged, aat_Unacknowledged);

  PSingle          = ^Single;

  TTrendElement    = packed record
    Time: TDateTime;
    case Integer of
      0: (IValue: Integer);
      1: (FValue: Single);
  end;

  TDynTrendArray   = array[0..(High(Cardinal) div SizeOf(TTrendElement)) - 1] of TTrendElement;
  PDynTrendArray   = ^TDynTrendArray;

  CKWDData = class(TPersistent)
  private
    fOP:           Single;
    fPV:           Single;
    fSP:           Single;
    fUserData1:    Single;
    fUserData2:    Single;
    fUserData3:    Single;
    fEngMax:       Single;
    fEngMin:       Single;
    nTblIdx:       Integer;
    nDevIdx:       Integer;
    nOPIdx:        Integer;
    nPVIdx:        Integer;
    nSPIdx:        Integer;
    nUserData1Idx: Integer;
    nUserData2Idx: Integer;
    nUserData3Idx: Integer;
    nEngMaxIdx:    Integer;
    nEngMinIdx:    Integer;
    strDevName:    String;
    strTblName:    String;
    strOPName:     String;
    strPVName:     String;
    strSPName:     String;
    strUData1Name: String;
    strUData2Name: String;
    strUData3Name: String;
    strEngMaxName: String;
    strEngMinName: String;
    bDisabled:     Boolean;
    ParentComp:    TComponent;
  public
    constructor    Create(i_ParentComp: TComponent);
    procedure      GetIndexes;
    procedure      RefreshData;
    property       TblIdx: Integer read nTblIdx write nTblIdx;
    property       DevIdx: Integer read nDevIdx write nDevIdx;
    property       OP: Single read fOP write fOP;
    property       PV: Single read fPV write fPV;
    property       SP: Single read fSP write fSP;
    property       UserData1: Single read fUserData1 write fUserData1;
    property       UserData2: Single read fUserData2 write fUserData2;
    property       UserData3: Single read fUserData3 write fUserData3;
    property       EngineerMax: Single read fEngMax write fEngMax;
    property       EngineerMin: Single read fEngMin write fEngMin;
    property       OPIdx: Integer read nOPIdx write nOPIdx;
    property       PVIdx: Integer read nPVIdx write nPVIdx;
    property       SPIdx: Integer read nSPIdx write nSPIdx;
    property       UserData1Idx: Integer read nUserData1Idx write nUserData1Idx;
    property       UserData2Idx: Integer read nUserData2Idx write nUserData2Idx;
    property       UserData3Idx: Integer read nUserData3Idx write nUserData3Idx;
    property       EngineerMaxIdx: Integer read nEngMaxIdx write nEngMaxIdx;
    property       EngineerMinIdx: Integer read nEngMinIdx write nEngMinIdx;
    property       Disabled: Boolean read bDisabled write bDisabled;
  published
    property       TblName: String read strTblName write strTblName;
    property       DevName: String read strDevName write strDevName;
    property       OPName: String read strOPName write strOPName;
    property       PVName: String read strPVName write strPVName;
    property       SPName: String read strSPName write strSPName;
    property       UserData1Name: String read strUData1Name write strUData1Name;
    property       UserData2Name: String read strUData2Name write strUData2Name;
    property       UserData3Name: String read strUData3Name write strUData3Name;
    property       EngineerMaxName: String read strEngMaxName write strEngMaxName;
    property       EngineerMinName: String read strEngMinName write strEngMinName;
  end;

  CTrendData = class(TPersistent)
  private
    bObjEnabled:   Boolean;
    bOPEnabled:    Boolean;
    bPVEnabled:    Boolean;
    bSPEnabled:    Boolean;
    bU1Enabled:    Boolean;
    bU2Enabled:    Boolean;
    bU3Enabled:    Boolean;
    nStartIdx:     Integer;
    nEndIdx:       Integer;
    pafOPArray:    PDynTrendArray;
    pafPVArray:    PDynTrendArray;
    pafSPArray:    PDynTrendArray;
    pafU1Array:    PDynTrendArray;
    pafU2Array:    PDynTrendArray;
    pafU3Array:    PDynTrendArray;
    ParentComp:    TComponent;
    nHistory:      Integer;
    procedure      SetObjEnabled;
    procedure      SetOPEnabled(i_bEnabled: Boolean);
    procedure      SetPVEnabled(i_bEnabled: Boolean);
    procedure      SetSPEnabled(i_bEnabled: Boolean);
    procedure      SetU1Enabled(i_bEnabled: Boolean);
    procedure      SetU2Enabled(i_bEnabled: Boolean);
    procedure      SetU3Enabled(i_bEnabled: Boolean);
  public
    constructor    Create(i_ParentComp: TComponent);
    destructor     Destroy; override;
    procedure      InitTrends(i_nHistory: Integer);
    procedure      UpdateTrends(i_nTime: TDateTime);
    procedure      ResetTrends;
    property       OPArray: PDynTrendArray read pafOPArray;
    property       PVArray: PDynTrendArray read pafPVArray;
    property       SPArray: PDynTrendArray read pafSPArray;
    property       U1Array: PDynTrendArray read pafU1Array;
    property       U2Array: PDynTrendArray read pafU2Array;
    property       U3Array: PDynTrendArray read pafU3Array;
    property       TrendsEnabled: Boolean read bObjEnabled;
    property       History: Integer read nHistory;
    property       StartIndex: Integer read nStartIdx;
    property       EndIndex: Integer read nEndIdx;
  published
    property       OPEnabled: Boolean read bOPEnabled write SetOPEnabled;
    property       PVEnabled: Boolean read bPVEnabled write SetPVEnabled;
    property       SPEnabled: Boolean read bSPEnabled write SetSPEnabled;
    property       U1Enabled: Boolean read bU1Enabled write SetU1Enabled;
    property       U2Enabled: Boolean read bU2Enabled write SetU2Enabled;
    property       U3Enabled: Boolean read bU3Enabled write SetU3Enabled;
  end;

  CAlarmData = class(TPersistent)
  private
    bCollectHist:  Boolean;
    astAlarmSig:   SAlarmSignalType;
    aatAlarmAck:   SAlarmAckType;
  published
    property       CollectHistory: Boolean read bCollectHist write bCollectHist;
    property       AlarmLevel: SAlarmSignalType read astAlarmSig write astAlarmSig;
    property       AckLevel: SAlarmAckType read aatAlarmAck write aatAlarmAck;
  end;

  CSimBaseDevice = class(TGraphicControl)
  private
    kdKWDData:     CKWDData;
    nContainer:    Integer;
    nScope:        Integer;
    nGrouping:     Integer;
    adAlarms:      CAlarmData;
    trdTrends:     CTrendData;
    strDesc:       String;
  public
    { Public Methods }
    constructor    Create(i_ParentComp: TComponent); override;
    destructor     Destroy; override;
    procedure      Redraw; virtual; abstract;
  published
    { Inherit and Publish TGraphicControl Properties }
    property       DragCursor;
    property       DragMode;
    property       Hint;
    property       ShowHint;
    { Inherit and Publish Simulator Specific Properties }
    property       KWDData: CKWDData read kdKWDData write kdKWDData;
    property       Container: Integer read nContainer write nContainer;
    property       Scope: Integer read nScope write nScope;
    property       Grouping: Integer read nGrouping write nGrouping;
    property       Alarms: CAlarmData read adAlarms write adAlarms;
    property       TrendData: CTrendData read trdTrends write trdTrends;
    property       Description: String read strDesc write strDesc;
    { Inherit and Publish TGraphicControl Events }
    property       OnDragDrop;
    property       OnDragOver;
    property       OnEndDrag;
    property       OnMouseDown;
    property       OnMouseMove;
    property       OnMouseUp;
    property       OnClick;
    property       OnDblClick;
  end;

{$INCLUDE ..\..\Includes\SimStorage.inc}

implementation
{*****************************************************************************************************
 *                                         CSimBaseDevice                                            *
 *****************************************************************************************************}
{*****************************************************************************************************
 *                                       PUBLIC METHODS                                              *
 *****************************************************************************************************}

constructor CSimBaseDevice.Create(i_ParentComp: TComponent);
begin
  inherited Create(i_ParentComp);
  { Instantiate CSimBaseDevice Internally-Used Objects }
  kdKWDData := CKWDData.Create(self);
  adAlarms := CAlarmData.Create;
  trdTrends := CTrendData.Create(self);
  { Define Component Related Settings }
  ControlStyle := ControlStyle + [csOpaque];
  { Set Default Values }
  Container := 0;
  Scope := 0;
  Grouping := 0;
end; {constructor CSimBaseDevice.Create}

destructor CSimBaseDevice.Destroy;
begin
  { Free Object Instantiations }
  trdTrends.Free;
  adAlarms.Free;
  kdKWDData.Free;
  inherited Destroy;
end; {destructor CSimBaseDevice.Destroy}

{*****************************************************************************************************
 *                                      PROTECTED METHODS                                            *
 *****************************************************************************************************}

{*****************************************************************************************************
 *                                       PRIVATE METHODS                                             *
 *****************************************************************************************************}


{*****************************************************************************************************
 *                                          CKWDData                                                 *
 *****************************************************************************************************}
{*****************************************************************************************************
 *                                       PUBLIC METHODS                                              *
 *****************************************************************************************************}

constructor CKWDData.Create(i_ParentComp: TComponent);
begin
  inherited Create;
  { Set Default Values }
  fEngMax := 100.0;
  fEngMin := 0.0;
  fOP := 100.0;
  fPV := 100.0;
  fSP := 100.0;
  fUserData1 := 100.0;
  fUserData2 := 100.0;
  fUserData3 := 100.0;
  strTblName := 'DEVICE';
  strOPName := 'OP';
  strPVName := 'PV';
  strSPName := 'SP';
  strUData1Name := '';
  strUData2Name := '';
  strUData3Name := '';
  strEngMaxName := 'ENGMAX';
  strEngMinName := 'ENGMIN';
  nOPIdx := -1;
  nPVIdx := -1;
  nSPIdx := -1;
  nUserData1Idx := -1;
  nUserData2Idx := -1;
  nUserData3Idx := -1;
  bDisabled := True;
  ParentComp := i_ParentComp;
end; {constructor CKWDData.Create}

procedure CKWDData.GetIndexes;
var
  uvTemp: USSElement;
begin
  bDisabled := False;
  if (Trim(strTblName) <> '') then
  begin
    nTblIdx := GetTableIdx(PChar(strTblName));
    if (nTblIdx < 0 ) then
    begin
      MessageDlg(ParentComp.Name + ' does not reference a valid Table (' + strTblName + ')',
                 mtWarning, [mbOK], 0);
      bDisabled := True;
      Exit;
    end;
  end else
  begin
    MessageDlg(ParentComp.Name + ' requires a valid Table name', mtWarning, [mbOK], 0);
    bDisabled := True;
    Exit;
  end;
  SetCurrTable(nTblIdx);
  if (Trim(strDevName) <> '') then
  begin
    nDevIdx :=  GetDeviceIdx(PChar(strDevName));
    if (nDevIdx < 0 ) then
    begin
      MessageDlg(ParentComp.Name + ' does not reference a valid Device (' + strDevName + ')',
                 mtWarning, [mbOK], 0);
      bDisabled := True;
      Exit;
    end;
  end else
  begin
    MessageDlg(ParentComp.Name + ' requires a valid Device name', mtWarning, [mbOK], 0);
    bDisabled := True;
    Exit;
  end;
  if (Trim(strOPName) <> '') then
  begin
    nOPIdx := GetKeywordIdx(PChar(strOPName));
    if (nOPIdx < 0 ) then
    begin
      MessageDlg(ParentComp.Name + ' does not reference a valid OP Keyword', mtWarning, [mbOK], 0);
      bDisabled := True;
      Exit;
    end;
  end;
  if (Trim(strPVName) <> '') then
  begin
    nPVIdx := GetKeywordIdx(PChar(strPVName));
    if (nPVIdx < 0 ) then
    begin
      MessageDlg(ParentComp.Name + ' does not reference a valid PV Keyword', mtWarning, [mbOK], 0);
      bDisabled := True;
      Exit;
    end;
  end;
  if (Trim(strSPName) <> '') then
  begin
    nSPIdx := GetKeywordIdx(PChar(strSPName));
    if (nSPIdx < 0 ) then
    begin
      MessageDlg(ParentComp.Name + ' does not reference a valid SP Keyword', mtWarning, [mbOK], 0);
      bDisabled := True;
      Exit;
    end;
  end;
  if (Trim(strUData1Name) <> '') then
  begin
    nUserData1Idx := GetKeywordIdx(PChar(strUData1Name));
    if (nUserData1Idx < 0 ) then
    begin
      MessageDlg(ParentComp.Name + ' does not reference a valid UserData1 Keyword', mtWarning, [mbOK], 0);
      bDisabled := True;
      Exit;
    end;
  end;
  if (Trim(strUData2Name) <> '') then
  begin
    nUserData2Idx := GetKeywordIdx(PChar(strUData2Name));
    if (nUserData2Idx < 0 ) then
    begin
      MessageDlg(ParentComp.Name + ' does not reference a valid UserData2 Keyword', mtWarning, [mbOK], 0);
      bDisabled := True;
      Exit;
    end;
  end;
  if (Trim(strUData3Name) <> '') then
  begin
    nUserData3Idx := GetKeywordIdx(PChar(strUData3Name));
    if (nUserData3Idx < 0 ) then
    begin
      MessageDlg(ParentComp.Name + ' does not reference a valid UserData3 Keyword', mtWarning, [mbOK], 0);
      bDisabled := True;
      Exit;
    end;
  end;
  if (Trim(strEngMaxName) <> '') then
  begin
    nEngMaxIdx := GetKeywordIdx(PChar(strEngMaxName));
    if (nEngMaxIdx < 0 ) then
    begin
      MessageDlg(ParentComp.Name + ' does not reference a valid EngMax Keyword', mtWarning, [mbOK], 0);
      bDisabled := True;
      Exit;
    end;
    GetNumData(nDevIdx, nEngMaxIdx, uvTemp);
    fEngMax := uvTemp.Float;
  end else
  begin
    MessageDlg(ParentComp.Name + ' requires a valid EngMax Keyword', mtWarning, [mbOK], 0);
    bDisabled := True;
    Exit;
  end;
  if (Trim(strEngMinName) <> '') then
  begin
    nEngMinIdx := GetKeywordIdx(PChar(strEngMinName));
    if (nEngMinIdx < 0 ) then
    begin
      MessageDlg(ParentComp.Name + ' does not reference a valid EngMin Keyword', mtWarning, [mbOK], 0);
      bDisabled := True;
      Exit;
    end;
    GetNumData(nDevIdx, nEngMinIdx, uvTemp);
    fEngMin := uvTemp.Float;
  end else
  begin
    MessageDlg(ParentComp.Name + ' requires a valid EngMin Keyword', mtWarning, [mbOK], 0);
    bDisabled := True;
    Exit;
  end;
end; {procedure CKWDData.GetIndexes}

procedure CKWDData.RefreshData;
var
  uvTemp:     USSElement;
  nErrorCode: Integer;
begin
  if (bDisabled = True) then
    Exit;
  if (SetCurrTable(nTblIdx) <> ERR_NOERROR) then
    Exit;
  if (nOPIdx >= 0) then
  begin
    nErrorCode := GetNumData(nDevIdx, nOPIdx, uvTemp);
    fOP := uvTemp.Float;
  end else
    fOP := 0;
  if (nPVIdx >= 0) then
  begin
    nErrorCode := GetNumData(nDevIdx, nPVIdx, uvTemp);
    fPV := uvTemp.Float;
  end else
    fPV := 0;
  if (nSPIdx >= 0) then
  begin
    nErrorCode := GetNumData(nDevIdx, nSPIdx, uvTemp);
    fSP := uvTemp.Float;
  end else
    fSP := 0;
  if (nUserData1Idx >= 0) then
  begin
    nErrorCode := GetNumData(nDevIdx, nUserData1Idx, uvTemp);
    fUserData1 := uvTemp.Float;
  end else
    fUserData1 := 0;
  if (nUserData2Idx >= 0) then
  begin
    nErrorCode := GetNumData(nDevIdx, nUserData2Idx, uvTemp);
    fUserData2 := uvTemp.Float;
  end else
    fUserData2 := 0;
  if (nUserData3Idx >= 0) then
  begin
    nErrorCode := GetNumData(nDevIdx, nUserData3Idx, uvTemp);
    fUserData3 := uvTemp.Float;
  end else
    fUserData3 := 0;
end; {procedure CKWDData.RefreshData}

{*****************************************************************************************************
 *                                          CTrendData                                               *
 *****************************************************************************************************}
{*****************************************************************************************************
 *                                       PUBLIC METHODS                                              *
 *****************************************************************************************************}

constructor CTrendData.Create(i_ParentComp: TComponent);
begin
  inherited Create;
  bObjEnabled := False;
  bOPEnabled := False;
  bPVEnabled := True;
  bSPEnabled := False;
  bU1Enabled := False;
  bU2Enabled := False;
  bU3Enabled := False;
  pafOPArray := nil;
  pafPVArray := nil;
  pafSPArray := nil;
  pafU1Array := nil;
  pafU2Array := nil;
  pafU3Array := nil;
  nStartIdx := 0;
  nEndIdx := 0;
  nHistory := 0;
  ParentComp := i_ParentComp;
end; {constructor CTrendData.Create}

destructor CTrendData.Destroy;
begin
  if (pafOPArray <> nil) then
    FreeMem(pafOPArray, nHistory * SizeOf(TTrendElement));
  if (pafPVArray <> nil) then
    FreeMem(pafPVArray, nHistory * SizeOf(TTrendElement));
  if (pafSPArray <> nil) then
    FreeMem(pafSPArray, nHistory * SizeOf(TTrendElement));
  if (pafU1Array <> nil) then
    FreeMem(pafU1Array, nHistory * SizeOf(TTrendElement));
  if (pafU2Array <> nil) then
    FreeMem(pafU2Array, nHistory * SizeOf(TTrendElement));
  if (pafU3Array <> nil) then
    FreeMem(pafU3Array, nHistory * SizeOf(TTrendElement));
  inherited Destroy;
end; {destructor CTrendData.Destroy}

procedure CTrendData.InitTrends(i_nHistory: Integer);
begin
  SetObjEnabled;
  if ((i_nHistory >= 0) and (bObjEnabled <> False)) then
  begin
    if (bOPEnabled <> False) then
    begin
      if (pafOPArray <> nil) then
        FreeMem(pafOPArray, nHistory * SizeOf(TTrendElement));
      GetMem(pafOPArray, i_nHistory * SizeOf(TTrendElement));
    end;
    if (bPVEnabled <> False) then
    begin
      if (pafPVArray <> nil) then
        FreeMem(pafPVArray, nHistory * SizeOf(TTrendElement));
      GetMem(pafPVArray, i_nHistory * SizeOf(TTrendElement));
    end;
    if (bSPEnabled <> False) then
    begin
      if (pafSPArray <> nil) then
        FreeMem(pafSPArray, nHistory * SizeOf(TTrendElement));
      GetMem(pafSPArray, i_nHistory * SizeOf(TTrendElement));
    end;
    if (bU1Enabled <> False) then
    begin
      if (pafU1Array <> nil) then
        FreeMem(pafU1Array, nHistory * SizeOf(TTrendElement));
      GetMem(pafU1Array, i_nHistory * SizeOf(TTrendElement));
    end;
    if (bU2Enabled <> False) then
    begin
      if (pafU2Array <> nil) then
        FreeMem(pafU2Array, nHistory * SizeOf(TTrendElement));
      GetMem(pafU2Array, i_nHistory * SizeOf(TTrendElement));
    end;
    if (bU3Enabled <> False) then
    begin
      if (pafU3Array <> nil) then
        FreeMem(pafU3Array, nHistory * SizeOf(TTrendElement));
      GetMem(pafU3Array, i_nHistory * SizeOf(TTrendElement));
    end;
    nHistory := i_nHistory;
    nStartIdx := 0;
    nEndIdx := 0;
  end;
end; {procedure CTrendData.InitTrends}

procedure CTrendData.UpdateTrends(i_nTime: TDateTime);
begin
  if (bObjEnabled <> False) then
  begin
    Inc(nEndIdx);
    if(nEndIdx >= nHistory) then
      nEndIdx := 0;
    if (bOPEnabled <> False) then
    begin
      pafOPArray^[nEndIdx].FValue := (ParentComp as CSimBaseDevice).kwdData.OP;
      pafOPArray^[nEndIdx].Time := i_nTime;
    end;
    if (bPVEnabled <> False) then
    begin
      pafPVArray^[nEndIdx].FValue := (ParentComp as CSimBaseDevice).kwdData.PV;
      pafPVArray^[nEndIdx].Time := i_nTime;
    end;
    if (bSPEnabled <> False) then
    begin
      pafSPArray^[nEndIdx].FValue := (ParentComp as CSimBaseDevice).kwdData.SP;
      pafSPArray^[nEndIdx].Time := i_nTime;
    end;
    if (bU1Enabled <> False) then
    begin
      pafU1Array^[nEndIdx].FValue := (ParentComp as CSimBaseDevice).kwdData.UserData1;
      pafU1Array^[nEndIdx].Time := i_nTime;
    end;
    if (bU2Enabled <> False) then
    begin
      pafU2Array^[nEndIdx].FValue := (ParentComp as CSimBaseDevice).kwdData.UserData2;
      pafU2Array^[nEndIdx].Time := i_nTime;
    end;
    if (bU3Enabled <> False) then
    begin
      pafU3Array^[nEndIdx].FValue := (ParentComp as CSimBaseDevice).kwdData.UserData3;
      pafU3Array^[nEndIdx].Time := i_nTime;
    end;
    if ((nEndIdx - nStartIdx) = 0) then
    begin
      Inc(nStartIdx);
      if (nStartIdx >= nHistory) then
        nStartIdx := 0;
    end;
  end;
end; {procedure CTrendData.UpdateTrends}

procedure CTrendData.ResetTrends;
begin
  nStartIdx := 0;
  nEndIdx := 0;
end; {procedure CTrendData.ResetTrends}

{*****************************************************************************************************
 *                                      PROTECTED METHODS                                            *
 *****************************************************************************************************}

{*****************************************************************************************************
 *                                       PRIVATE METHODS                                             *
 *****************************************************************************************************}

procedure CTrendData.SetObjEnabled;
begin
  bObjEnabled := True;
  if ((bOPEnabled = false) and (bPVEnabled = false) and (bSPEnabled = false) and
      (bU1Enabled = false) and (bU2Enabled = false) and (bU3Enabled = false)) then
    bObjEnabled := False;
end; {procedure CTrendData.SetObjEnabled}

procedure CTrendData.SetOPEnabled(i_bEnabled: Boolean);
begin
  if (csDesigning in ParentComp.ComponentState) then
    bOPEnabled := i_bEnabled;
end; {procedure CTrendData.SetOPEnabled}

procedure CTrendData.SetPVEnabled(i_bEnabled: Boolean);
begin
  if (csDesigning in ParentComp.ComponentState) then
    bPVEnabled := i_bEnabled;
end; {procedure CTrendData.SetPVEnabled}

procedure CTrendData.SetSPEnabled(i_bEnabled: Boolean);
begin
  if (csDesigning in ParentComp.ComponentState) then
    bSPEnabled := i_bEnabled;
end; {procedure CTrendData.SetSPEnabled}

procedure CTrendData.SetU1Enabled(i_bEnabled: Boolean);
begin
  if (csDesigning in ParentComp.ComponentState) then
    bU1Enabled := i_bEnabled;
end; {procedure CTrendData.SetU1Enabled}

procedure CTrendData.SetU2Enabled(i_bEnabled: Boolean);
begin
  if (csDesigning in ParentComp.ComponentState) then
    bU2Enabled := i_bEnabled;
end; {procedure CTrendData.SetU2Enabled}

procedure CTrendData.SetU3Enabled(i_bEnabled: Boolean);
begin
  if (csDesigning in ParentComp.ComponentState) then
    bU3Enabled := i_bEnabled;
end; {procedure CTrendData.SetU3Enabled}

end.

0
 
LVL 3

Author Comment

by:mheacock
ID: 1336170
---------------SimTypes Classes and Unit----------------------
unit SimTypes;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SimBaseDevice;

type
  SDeviceType      = (dt_Indicator, dt_Controller, dt_HandController, dt_MasterController,
                      dt_SlaveController, dt_StateDevice);
  SDeviceMode      = (dm_Automatic, dm_Manual, dm_Cascade);
  SGaugeType       = (gt_Vertical, gt_Horizontal);
  SGaugeRatioType  = (grt_EngMinMax, grt_Percent);
  SInterlockType   = (it_NA, it_On, it_Off);

  PSingle          = ^Single;

  CInterlockData = class(TPersistent)
  private
    itInterlock:   SInterlockType;
  published
    property       InterlockLevel: SInterlockType read itInterlock write itInterlock;
  end;

  CGauge = class(TPersistent)
  private
    bEnabled:      Boolean;
    gtGaugeType:   SGaugeType;
    clColor:       TColor;
    wTop:          Word;
    wLeft:         Word;
    wWidth:        Word;
    wHeight:       Word;
    grtRatioCalc:  SGaugeRatioType;
    ParentComp:    TComponent;
    procedure      SetEnabled(i_bEnabled: Boolean);
    procedure      SetGaugeType(i_gtGaugeType: SGaugeType);
    procedure      SetColor(i_clColor: TColor);
    procedure      SetTop(i_wTop: Word);
    procedure      SetLeft(i_wLeft: Word);
    procedure      SetWidth(i_wWidth: Word);
    procedure      SetHeight(i_wHeight: Word);
    procedure      SetRatioCalc(i_grtRatioCalc: SGaugeRatioType);
  public
    constructor    Create(i_ParentComp: TComponent);
    procedure      DrawGauge(const i_bmpBuff: TBitmap; const i_fData, i_fMin, i_fMax: Single);
  published
    property       Enabled: Boolean read bEnabled write SetEnabled;
    property       GaugeType: SGaugeType read gtGaugeType write SetGaugeType;
    property       Color: TColor read clColor write SetColor;
    property       Top: Word read wTop write SetTop;
    property       Left: Word read wLeft write SetLeft;
    property       Width: Word read wWidth write SetWidth;
    property       Height: Word read wHeight write SetHeight;
    property       RatioCalc: SGaugeRatioType read grtRatioCalc write SetRatioCalc;
  end;

  CGauges = class(TPersistent)
  private
    ggPVGauge:     CGauge;
    ggOPGauge:     CGauge;
    ggSPGauge:     CGauge;
    ggU1Gauge:     CGauge;
    ggU2Gauge:     CGauge;
    ggU3Gauge:     CGauge;
    ParentComp:    TComponent;
  public
    constructor    Create(i_ParentComp: TComponent);
    destructor     Destroy; override;
  published
    property       PVGauge: CGauge read ggPVGauge write ggPVGauge;
    property       OPGauge: CGauge read ggOPGauge write ggOPGauge;
    property       SPGauge: CGauge read ggSPGauge write ggSPGauge;
    property       UserGauge1: CGauge read ggU1Gauge write ggU1Gauge;
    property       UserGauge2: CGauge read ggU2Gauge write ggU2Gauge;
    property       UserGauge3: CGauge read ggU3Gauge write ggU3Gauge;
  end;

  CTextDisplay = class(TPersistent)
  private
    bEnabled:      Boolean;
    bValEnabled:   Boolean;
    nDecPlaces:    Integer;
    wTop:          Word;
    wLeft:         Word;
    fontSettings:  TFont;
    strPrefix:     String;
    strSuffix:     String;
    clBground:     TColor;
    ParentComp:    TComponent;
    procedure      SetEnabled(i_bEnabled: Boolean);
    procedure      SetValEnabled(i_bValEnabled: Boolean);
    procedure      SetDecPlaces(i_nDecPlaces: Integer);
    procedure      SetTop(i_wTop: Word);
    procedure      SetLeft(i_wLeft: Word);
    procedure      SetPrefix(i_strPrefix: String);
    procedure      SetSuffix(i_strSuffix: String);
    procedure      SetBackground(i_clBground: TColor);
    procedure      SetFont(i_fontSettings: TFont);
    procedure      StyleChange(Sender: TObject);
  public
    constructor    Create(i_ParentComp: TComponent);
    destructor     Destroy; override;
    procedure      DrawText(i_bmpBuff: TBitmap; const i_pfData: PSingle);
  published
    property       Enabled: Boolean read bEnabled write SetEnabled;
    property       ValueEnabled: Boolean read bValEnabled write SetValEnabled;
    property       DecimalPlaces: Integer read nDecPlaces write SetDecPlaces;
    property       Top: Word read wTop write SetTop;
    property       Left: Word read wLeft write SetLeft;
    property       Font: TFont read fontSettings write SetFont;
    property       Prefix: String read strPrefix write SetPrefix;
    property       Suffix: String read strSuffix write SetSuffix;
    property       Background: TColor read clBground write SetBackground;
  end;

  CTextDisplays = class(TPersistent)
  private
    dtHeaderText:  CTextDisplay;
    dtFooterText:  CTextDisplay;
    dtOPText:      CTextDisplay;
    dtPVText:      CTextDisplay;
    dtSPText:      CTextDisplay;
    dtU1Text:      CTextDisplay;
    dtU2Text:      CTextDisplay;
    dtU3Text:      CTextDisplay;
    ParentComp:    TComponent;
  public
    constructor    Create(i_ParentComp: TComponent);
    destructor     Destroy; override;
  published
    property       HeaderText: CTextDisplay read dtHeaderText write dtHeaderText;
    property       FooterText: CTextDisplay read dtFooterText write dtFooterText;
    property       OPText: CTextDisplay read dtOPText write dtOPText;
    property       PVText: CTextDisplay read dtPVText write dtPVText;
    property       SPText: CTextDisplay read dtSPText write dtSPText;
    property       UserText1: CTextDisplay read dtU1Text write dtU1Text;
    property       UserText2: CTextDisplay read dtU2Text write dtU2Text;
    property       UserText3: CTextDisplay read dtU3Text write dtU3Text;
  end;

implementation

{*****************************************************************************************************
 *                                           CGauge                                                  *
 *****************************************************************************************************}
{*****************************************************************************************************
 *                                       PUBLIC METHODS                                              *
 *****************************************************************************************************}

constructor CGauge.Create(i_ParentComp: TComponent);
begin
  inherited Create;
  ParentComp := i_ParentComp;
end; {constructor CGauge.Create}

procedure CGauge.DrawGauge(const i_bmpBuff: TBitmap; const i_fData, i_fMin, i_fMax: Single);
var
  rectGauge: TRect;
  fPercent:  Single;
begin
  if ((bEnabled <> True) or (wWidth = 0) or (wHeight = 0)) then
    Exit;
  i_bmpBuff.Canvas.Brush.Color := clColor;
  rectGauge.TopLeft.X := wLeft;
  rectGauge.TopLeft.Y := wTop;
  rectGauge.BottomRight.X := (rectGauge.TopLeft.X + wWidth) - 1;
  rectGauge.BottomRight.Y := (rectGauge.TopLeft.Y + wHeight) - 1;
  try
    if (i_fData <= i_fMin) then
      fPercent := 0
    else
      fPercent := (i_fData - i_fMin) / (i_fMax - i_fMin);
  except on EZeroDivide do
    fPercent := 0;
  end;
  if (gtGaugeType = gt_Vertical) then
    rectGauge.TopLeft.Y := rectGauge.TopLeft.Y +
                          (Round((1 - fPercent) * (rectGauge.BottomRight.Y - rectGauge.TopLeft.Y  + 1)))
  else
    rectGauge.BottomRight.X := rectGauge.BottomRight.X -
                              (Round((1 - fPercent) * (rectGauge.BottomRight.X - rectGauge.TopLeft.X + 1)));
  i_bmpBuff.Canvas.FillRect(rectGauge);
end; {procedure CGauge.DrawGauge}

{*****************************************************************************************************
 *                                       PRIVATE METHODS                                             *
 *****************************************************************************************************}

procedure CGauge.SetEnabled(i_bEnabled: Boolean);
begin
  bEnabled := i_bEnabled;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CGauge.SetEnabled}

procedure CGauge.SetGaugeType(i_gtGaugeType: SGaugeType);
begin
  gtGaugeType := i_gtGaugeType;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CGauge.SetGaugeType}

procedure CGauge.SetColor(i_clColor: TColor);
begin
  clColor := i_clColor;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CGauge.SetColor}

procedure CGauge.SetTop(i_wTop: Word);
begin
  wTop := i_wTop;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CGauge.SetTop}

procedure CGauge.SetLeft(i_wLeft: Word);
begin
  wLeft := i_wLeft;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CGauge.SetLeft}

procedure CGauge.SetWidth(i_wWidth: Word);
begin
  wWidth := i_wWidth;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CGauge.SetWidth}

procedure CGauge.SetHeight(i_wHeight: Word);
begin
  wHeight := i_wHeight;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CGauge.SetHeight}

procedure CGauge.SetRatioCalc(i_grtRatioCalc: SGaugeRatioType);
begin
  grtRatioCalc := i_grtRatioCalc;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CGauge.SetRatioCalc}

{*****************************************************************************************************
 *                                          CGauges                                                  *
 *****************************************************************************************************}
{*****************************************************************************************************
 *                                       PUBLIC METHODS                                              *
 *****************************************************************************************************}

constructor CGauges.Create(i_ParentComp: TComponent);
begin
  inherited Create;
  ParentComp := i_ParentComp;
  { Instantiate CGauges Objects }
  ggPVGauge := CGauge.Create(ParentComp);
  ggOPGauge := CGauge.Create(ParentComp);
  ggSPGauge := CGauge.Create(ParentComp);
  ggU1Gauge := CGauge.Create(ParentComp);
  ggU2Gauge := CGauge.Create(ParentComp);
  ggU3Gauge := CGauge.Create(ParentComp);
end; {constructor CGauges.Create}

destructor CGauges.Destroy;
begin
  { Free Gauge Object Instantiations }
   ggPVGauge.Free;
   ggOPGauge.Free;
   ggSPGauge.Free;
   ggU1Gauge.Free;
   ggU2Gauge.Free;
   ggU3Gauge.Free;
  inherited Destroy;
end; {destructor CGauges.Destroy}

{*****************************************************************************************************
 *                                        CTextDisplay                                               *
 *****************************************************************************************************}
{*****************************************************************************************************
 *                                       PUBLIC METHODS                                              *
 *****************************************************************************************************}

constructor CTextDisplay.Create(i_ParentComp: TComponent);
begin
  inherited Create;
  ParentComp := i_ParentComp;
  { Instantiate TFont Object }
  fontSettings := TFont.Create;
  { Set Default Values }
  bValEnabled := True;
  clBground := clBlack;
  nDecPlaces := 1;
  fontSettings.Color := clWhite;
  fontSettings.Name := 'Arial';
  fontSettings.Size := 6;
  fontSettings.Style := fontSettings.Style + [fsBold];
  fontSettings.OnChange := StyleChange;
end; {constructor CTextDisplay.Create}

destructor CTextDisplay.Destroy;
begin
  { Free TFont Object }
  fontSettings.Free;
  inherited Destroy;
end; {destructor CTextDisplay.Destroy}

procedure CTextDisplay.DrawText(i_bmpBuff: TBitmap; const i_pfData: PSingle);
var
  strTemp: String;
begin
  if (bEnabled <> True) then
    Exit;
  if ((i_pfData <> nil) and (bValEnabled = True))then
  begin
    Str(i_pfData^:5:nDecPlaces, strTemp);
    strTemp := strPrefix + strTemp + strSuffix;
  end else
  begin
    strTemp := strPrefix + strSuffix;
  end;
  i_bmpBuff.Canvas.Brush.Color := clBground;
  if (clBground = clNone) then
    i_bmpBuff.Canvas.Brush.Style := bsClear
  else
    i_bmpBuff.Canvas.Brush.Style := bsSolid;
  i_bmpBuff.Canvas.Font := fontSettings;
  i_bmpBuff.Canvas.TextOut(wLeft, wTop, strTemp);
end; {procedure CTextDisplay.DrawText}

{*****************************************************************************************************
 *                                       PRIVATE METHODS                                             *
 *****************************************************************************************************}

procedure CTextDisplay.SetEnabled(i_bEnabled: Boolean);
begin
  bEnabled := i_bEnabled;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CTextDisplay.SetEnabled}

procedure CTextDisplay.SetValEnabled(i_bValEnabled: Boolean);
begin
  bValEnabled := i_bValEnabled;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CTextDisplay.SetValEnabled}

procedure CTextDisplay.SetDecPlaces(i_nDecPlaces: Integer);
begin
  nDecPlaces := i_nDecPlaces;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CTextDisplay.SetDecPlaces}

procedure CTextDisplay.SetTop(i_wTop: Word);
begin
  wTop := i_wTop;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CTextDisplay.SetTop}

procedure CTextDisplay.SetLeft(i_wLeft: Word);
begin
  wLeft := i_wLeft;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CTextDisplay.SetLeft}

procedure CTextDisplay.SetPrefix(i_strPrefix: String);
begin
  strPrefix := i_strPrefix;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CTextDisplay.SetPrefix}

procedure CTextDisplay.SetSuffix(i_strSuffix: String);
begin
  strSuffix := i_strSuffix;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CTextDisplay.SetSuffix}

procedure CTextDisplay.SetBackground(i_clBground: TColor);
begin
  clBground := i_clBground;
  if (csDesigning in ParentComp.ComponentState) then
    if (ParentComp is CSimBaseDevice) then
      (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CTextDisplay.SetBackground}

procedure CTextDisplay.SetFont(i_fontSettings: TFont);
begin
  if (fontSettings <> i_fontSettings) then
    fontSettings.Assign(i_fontSettings);
end; {procedure CTextDiplay.SetFont}

procedure CTextDisplay.StyleChange(Sender: TObject);
begin
  inherited;
  if (ParentComp is CSimBaseDevice) then
    (ParentComp as CSimBaseDevice).Invalidate;
end; {procedure CTextDisplay.StyleChange}

{*****************************************************************************************************
 *                                        CTextDisplays                                              *
 *****************************************************************************************************}
{*****************************************************************************************************
 *                                       PUBLIC METHODS                                              *
 *****************************************************************************************************}

constructor CTextDisplays.Create(i_ParentComp: TComponent);
begin
  inherited Create;
  ParentComp := i_ParentComp;
  { Instantiate CTextDisplay Objects }
  dtHeaderText := CTextDisplay.Create(ParentComp);
  dtFooterText := CTextDisplay.Create(ParentComp);
  dtOPText := CTextDisplay.Create(ParentComp);
  dtPVText := CTextDisplay.Create(ParentComp);
  dtSPText := CTextDisplay.Create(ParentComp);
  dtU1Text := CTextDisplay.Create(ParentComp);
  dtU2Text := CTextDisplay.Create(ParentComp);
  dtU3Text := CTextDisplay.Create(ParentComp);
end; {constructor CTextDisplays.Create}

destructor CTextDisplays.Destroy;
begin
  { Free CTextDisplay Objects }
  dtHeaderText.Free;
  dtFooterText.Free;
  dtOPText.Free;
  dtPVText.Free;
  dtSPText.Free;
  dtU1Text.Free;
  dtU2Text.Free;
  dtU3Text.Free;
  inherited Destroy;
end; {destructor CTextDisplays.Destroy}

end.

 
0
 
LVL 3

Author Comment

by:mheacock
ID: 1336171
-----------------CSimGaugeDevice Class and Unit-------------
unit SimGaugeDevice;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, SimBaseDevice, SimTypes;

type
  CSimGaugeDevice = class(CSimBaseDevice)
  private
    bmpBG:         TBitmap;
    bmpBuff:       TBitmap;
    ggsGauges:     CGauges;
    tdsDisplays:   CTextDisplays;
    nDevType:      SDeviceType;
    idInterlocks:  CInterlockData;
    procedure      SetBGBmp(i_bmpBG: TBitmap);
    procedure      BmpChanged(Sender: TObject);
  protected
    procedure      Paint; override;
  public
    constructor    Create(aOwner: TComponent); override;
    destructor     Destroy; override;
    procedure      Redraw; override;
  published
    property       DragCursor;
    property       DragMode;
    property       Hint;
    property       ShowHint;
    property       BGBitmap: TBitmap read bmpBG write SetBGBmp;
    property       Gauges: CGauges read ggsGauges write ggsGauges;
    property       TextDisplays: CTextDisplays read tdsDisplays write tdsDisplays;
    property       DevType: SDeviceType read nDevType write nDevType;
    property       Interlocks: CInterlockData read idInterlocks write idInterlocks;
    property       OnDragDrop;
    property       OnDragOver;
    property       OnEndDrag;
    property       OnMouseDown;
    property       OnMouseMove;
    property       OnMouseUp;
  end;

implementation
{*****************************************************************************************************
 *                                         CSimGaugeDevice                                           *
 *****************************************************************************************************}
{*****************************************************************************************************
 *                                       PUBLIC METHODS                                              *
 *****************************************************************************************************}

constructor CSimGaugeDevice.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  { Instantiate CSimGaugeDevice Internally-Used Objects }
  bmpBG := TBitmap.Create;
  bmpBuff := TBitmap.Create;
  ggsGauges := CGauges.Create(self);
  tdsDisplays := CTextDisplays.Create(self);
  idInterlocks := CInterlockData.Create;
  { Define Component Related Settings }
  ControlStyle := ControlStyle + [csOpaque];
  { Define Event Handlers }
  bmpBG.OnChange := BmpChanged;
end; {constructor CSimGaugeDevice.Create}

destructor CSimGaugeDevice.Destroy;
begin
  { Free Object Instantiations }
  idInterlocks.Free;
  tdsDisplays.Free;
  ggsGauges.Free;
  bmpBuff.Free;
  bmpBG.Free;
  inherited Destroy;
end; {destructor CSimGaugeDevice.Destroy}

procedure CSimGaugeDevice.Redraw;
begin
  Repaint;
end; {procedure CSimGaugeDevice.Redraw}


{*****************************************************************************************************
 *                                      PROTECTED METHODS                                            *
 *****************************************************************************************************}

procedure CSimGaugeDevice.Paint;
begin
  if (csDesigning in ComponentState) then
  begin
    Canvas.Pen.Color := clYellow;
    Canvas.Pen.Style := psDot;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(0, 0, Width, Height);
  end;
  bmpBuff.Canvas.Draw(0, 0, bmpBG);
  ggsGauges.OPGauge.DrawGauge(bmpBuff, KWDData.OP, KWDData.EngineerMin, KWDData.EngineerMax);
  ggsGauges.PVGauge.DrawGauge(bmpBuff, KWDData.PV, KWDData.EngineerMin, KWDData.EngineerMax);
  ggsGauges.SPGauge.DrawGauge(bmpBuff, KWDData.SP, KWDData.EngineerMin, KWDData.EngineerMax);
  ggsGauges.UserGauge1.DrawGauge(bmpBuff, KWDData.UserData1, KWDData.EngineerMin, KWDData.EngineerMax);
  ggsGauges.UserGauge2.DrawGauge(bmpBuff, KWDData.UserData2, KWDData.EngineerMin, KWDData.EngineerMax);
  ggsGauges.UserGauge3.DrawGauge(bmpBuff, KWDData.UserData3, KWDData.EngineerMin, KWDData.EngineerMax);
  tdsDisplays.OPText.DrawText(bmpBuff, @KWDData.OP);
  tdsDisplays.PVText.DrawText(bmpBuff, @KWDData.PV);
  tdsDisplays.SPText.DrawText(bmpBuff, @KWDData.SP);
  tdsDisplays.UserText1.DrawText(bmpBuff, @KWDData.UserData1);
  tdsDisplays.UserText2.DrawText(bmpBuff, @KWDData.UserData2);
  tdsDisplays.UserText3.DrawText(bmpBuff, @KWDData.UserData3);
  tdsDisplays.HeaderText.DrawText(bmpBuff, nil);
  tdsDisplays.FooterText.DrawText(bmpBuff, nil);
  Canvas.Draw(0, 0, bmpBuff);
  {BitBlt(Canvas.Handle,
         0, 0,
         bmpBuff.Width - 1, bmpBuff.Height - 1,
         bmpBuff.Canvas.Handle,
         0, 0,
         SRCCOPY);}
  { Ensure that if bitmap not loaded, then component retains user defined Width and Height }
  if ((bmpBG.Width <> 0) and (bmpBG.Height <> 0)) then
  begin
    Width := bmpBG.Width;
    Height := bmpBG.Height;
  end;
end; {procedure CSimGaugeDevice.Paint}

{*****************************************************************************************************
 *                                       PRIVATE METHODS                                             *
 *****************************************************************************************************}

procedure CSimGaugeDevice.SetBGBmp(i_bmpBG: TBitmap);
begin
  { Load the bitmap into the Background and Buffer bitmaps }
  bmpBG.Assign(i_bmpBG);
  bmpBuff.Width := bmpBG.Width;
  bmpBuff.Height := bmpBG.Height;
  bmpBuff.Canvas.Draw(0, 0, bmpBG);
  Width := bmpBG.Width;
  Height := bmpBG.Height;
end; {procedure CSimGaugeDevice.SetBGBmp}

procedure CSimGaugeDevice.BmpChanged(Sender: TObject);
begin
  bmpBuff.Width := bmpBG.Width;
  bmpBuff.Height := bmpBG.Height;
  bmpBuff.Canvas.Draw(0, 0, bmpBG);
  Width := bmpBG.Width;
  Height := bmpBG.Height;
  Repaint;
end; {procedure CSimGaugeDevice.BmpChanged}

end.

0
 
LVL 3

Author Comment

by:mheacock
ID: 1336172
Okay...there's the code....

The CSimGaugeDevice is the actual component.  CSimBaseDevice is simply the base class (I'll be eventually creating a lot of components from this class).

The error is occuring in the TTextDisplays class in the SimTypes unit.  Check out the font property.

You don't have to limit yourself to the question at hand if you have other coments/suggestions.

I told you there was a lot of code.  I'l probably boost points after I receive an answer.  177.5 points may not be enough considering the amount of code there is.

Thanks.
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 2

Expert Comment

by:gysbert1
ID: 1336173
I assume you've checked with a breakpoint, or messagebox or something that your setfont method actually gets called, and that the i_fontsettings is actually valid..  Anyway, I'm going to try and install this code, and see if I can find the error. I must say, from looking through it, everything looks fine.
0
 
LVL 3

Author Comment

by:mheacock
ID: 1336174
This really sucks...the component now works fine...perhaps I changed something without knowing it...I know I made some
changes before I posted here...perhaps I compiled and forgot to
move the .DCU to my components directory (I keep the source
files and (the Reg source and .DCU files) separate...I really
hate the IDE debuggers tendency to try and step through
component source code.

Well, something happened...because I made an unrelated change
today...simply setting some default integer values, compiled,
moved .DCU and all worked GREAT!

So don't try using the code above.

So that the 177.5 points are earned...here are several questions:

1) How do I find out when my mouse button is over a component.
   If I remember correctly, this was a built-in event in VB,
   but dosn't appear to be in Delphi.  I want to make an
   animated button component where the animation will run
   only while the mouse pointer is over the button...so I need
   events (or some method) to tell when mouse has entered the
   button and left the button (to turn animation off).

2) I need to make a component that will contain several labels,
   edit boxes, and scroll bars on a panel.  I as far as the
   panel.  There will be a miximum of six scroll bars, eight
   labels, and six edit boxes.  I'd like to know how I might
   go about creating these in the component.  At design-time
   you'd enable (make visible or not) each grouping (scroll,
   label, and edit).  Since I don't want to Create each of
   these if they are not enabled...how to go about?

3) How can a component as described above, make the events
   for the scroll bars public to the component as a whole...
   perhaps the component would have an event:
       OnPVScrollBarChange
       OnOPScrollBarChange
       ....
       OnU3ScrollBarChange


Thanks for the trouble you guys may have went through on the
previous component problem and all that code.
0
 
LVL 4

Expert Comment

by:StevenB
ID: 1336175
 Glad you've sorted the first problem, even happier that you announced this before I trawled through the above code. Here are some suggestions:

  1) Use these events to catch mouse enter/leave:

    procedure CMMouseEnter(var msg:TMessage); message CM_MouseEnter;
    procedure CMMouseLeave(var msg:TMessage); message CM_MouseLeave;

  yes they should be better documented in delphi, yes they should be standard delphi events.

  2) I'm not sure I fully understand this querry, please try and clarify it for me.

  3) Rather than try and describe this technique, here is some code that does it:


unit Thingy;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls ;

type
  TThingy = class(TPanel)
    constructor Create(AOwner: TComponent);Override;
    destructor Destroy;Override;
  private
    AScroll : TScrollBar;
    FOnChange : TNotifyEvent;
    procedure AScrollChange(Sender: TObject);
  protected
    procedure Change; Dynamic;
  public
  published
    Property OnChange : TNotifyEvent read FOnChange write FOnChange;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Steven', [TThingy]);
end;

constructor TThingy.Create(AOwner: TComponent);
begin
  Inherited;
  AScroll := TScrollBar.Create(Self);
  AScroll.Top := 0;
  AScroll.Left := 0;
  AScroll.OnChange := AScrollChange;
  AScroll.Parent := Self;                // Does this help                                          // regarding Q2 ?
end;

destructor TThingy.Destroy;
begin
  AScroll.Free;
  inherited;
end;

procedure TThingy.AScrollChange(Sender: TObject);
begin
  if not (csdesigning in ComponentState) then Change;
end;

procedure TThingy.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

end.


  I hope all this proves useful.

  Steven.
0
 
LVL 3

Author Comment

by:mheacock
ID: 1336176
But what if I have 3 scroll bars...it seems from the code that
the scroll bars OnChange is referenced via the TThingy's
OnChange event.

Is there anyway to have a separate OnChange for muliple
scroll bars that are independent of the TThingy's OnChange?
0
 
LVL 3

Author Comment

by:mheacock
ID: 1336177
Maybe I just create a bunch of different OnChange events...

   property  OnChangePV: TNotifyEvent read.......
   property  OnChangeOP: TNotifyEvent read.......
   property  OnCHangeSP: TNotifyEvent read.......
   ...and so on...

Never done any real messing with Events before...I'll screw
around and see what I come up with.
0
 
LVL 4

Expert Comment

by:StevenB
ID: 1336178
 Yes, sorry I didn't make it very clear did I. TThingy never had an OnChange Event before it was declared (It was a TPanel). Basically the OnChange event could have been called anything and as you suggest above you can make many events for all your different scroll bars. Obviously all the events for all the different scroll bars will need setting up as per the example above.
  The important aspect is that for an event to apear on the object inspector, then it has to be declared as a published property of an event type (any event, not just TNotifyEvent). There also has to be a protected implementation of this event which is called in your code whenever you want the event to be triggered, in this case the Change Procedure. Any default handling you require of you component should be placed in this procedure (hence the need to call inherited whenever you override these procedures).
  I'm sure you'll be able to figure out how to work all this, Ill be happy to post more code if you like, but I'm sure I once read a comment from you suggesting that you learn more by writing your own code, a sentiment which I fully agree with.
  Have you worked out how to solve the problem regarding your second question, I'm still not exactly sure what the problem is?

  Steven.
0
 
LVL 3

Author Comment

by:mheacock
ID: 1336179
I'd say we have a winner...StevenB...please add a comment saying
"Grade Me!"

0
 
LVL 4

Accepted Solution

by:
StevenB earned 170 total points
ID: 1336180
 O.K. :

  "Grade Me!"

(I presume you meant for me to add this as an answer if you wish to grade it, otherwise appologies for my premature reaction.)
0
 
LVL 3

Author Comment

by:mheacock
ID: 1336181
Sorry...I meant add an ANSWER...you correctly interpreted my
comment.
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now