Bugs found in pl_Orca

TD2ComboColorBox doesn't pass value to BindingObj 13 years 1 month ago #3783

RockyLuck Topic Author Visitor	In orca_scene2d_obj_comboboxies.inc the ColorComboBox does not pass its changed value to the binding objects. This is the fix: procedure TD2ComboColorBox.DoColorChange(Sender: TObject); begin FColorText.Text := Color; Repaint; if Assigned(FBindingObjects) then // * DB * ToBindingObjects; // * DB * if Assigned(FOnChange) then FOnChange(Self); end;
	Please Log in or Create an account to join the conversation. Last edit: by RockyLuck.

TD2AngleButton doesn't pass value to BindingObj's 13 years 1 month ago #3784

RockyLuck
Topic Author
Visitor

Same problem. This is the fix:

procedure TD2AngleButton.SetValue(const Value: single);
begin
  if (FFrequency = 0) then
  begin
    if (FValue <> Value) then
    begin
      FValue := Value;
      if Tick <> nil then
        Tick.RotateAngle := -FValue
      else
        Repaint;
      Text;
      if Assigned(FBindingObjects) then           // *** DB ***
        ToBindingObjects;                         // *** DB ***
      if Assigned(FOnChange) and (not FPressing or FTracking) then
        FOnChange(Self);
    end;
  end
  else
  begin
    if FValue <> Round(Value / FFrequency) * FFrequency then
    begin
      FValue := Round(Value / FFrequency) * FFrequency;
      if Tick <> nil then
        Tick.RotateAngle := -FValue
      else
        Repaint;
      Text;
      if Assigned(FBindingObjects) then           // *** DB ***
        ToBindingObjects;                         // *** DB ***
      if Assigned(FOnChange) and (not FPressing or FTracking) then
        FOnChange(Self);
    end;
  end;
end;

Please Log in or Create an account to join the conversation.

TD2ColorButton doesn't pass value to BindingObj's 13 years 1 month ago #3785

RockyLuck
Topic Author
Visitor

Same problem. Now two fixes are needed:

procedure TD2ColorButton.SetColor(const Value: string);
begin
  FColor := Value;
  if FFill <> nil then
    FFill.Fill.Color := FColor;
  if Assigned(FBindingObjects) then           // *** DB ***
    ToBindingObjects;                         // *** DB ***
  if not (csLoading in ComponentState) then
    if Assigned(FOnChange) then
      FOnChange(Self);
end;

function TD2ColorButton.GetData : Variant;  // *** DB ***
begin                                       // *** DB ***
   Result := Color;                         // *** DB ***
end;                                        // *** DB ***

The GetData function must be defined in orca_scene2d.pas:

TD2ColorButton = class(TD2CustomButton)
  private
    FFill: TD2Shape;
    FColor: string;
    FOnChange: TNotifyEvent;
    FUseStandardDialog: boolean;
    procedure SetColor(const Value: string);
  protected
    procedure ApplyStyle; override;
    procedure FreeStyle; override;
    procedure Click; override;
    function GetData: Variant; override;  // *** DB ***
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AutoTranslate default false;
    property CanFocused default true;
    property DisableFocusEffect;
    property TabOrder;
    property Color: string read FColor write SetColor;
    property UseStandardDialog: boolean read FUseStandardDialog write FUseStandardDialog default true;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

Please Log in or Create an account to join the conversation.

Last edit: by RockyLuck. Reason: typo

TD2Spinbox bugs when value is float 13 years 1 month ago #3786

RockyLuck
Topic Author
Visitor

The TD2Spinbox in orca_scene2d_obj_boxies.inc has two bugs. These are the fixes:

procedure TD2SpinBox.Change;
begin
  try
    FValue := StrToFloat(Text);
    if FValue > FMax then FValue := FMax;
    if FValue < FMin then FValue := FMin;
//  if (frac(FValue) = 0) or (FValueType = d2ValueInteger) then // *** DB ***
    if FValueType = d2ValueInteger then    // *** DB ***
      FText := IntToStr(Trunc(FValue))
    else
//    FText := FloattoStr(FValue);         // *** DB *** this makes decimaldigits property inactive
      FText := Format('%.' + IntToStr(FDecimalDigits) + 'f', [FValue]);  // *** DB ***
  except
    if (frac(FValue) = 0) or (FValueType = d2ValueInteger) then
      FText := IntToStr(Trunc(FValue))
    else
      FText := FloattoStr(FValue);
  end;
  Repaint;
  inherited;
end;


procedure TD2SpinBox.SetValue(const AValue: single);
begin
  if FValue <> AValue then
  begin
    FValue := AValue;
    if FValue > FMax then FValue := FMax;
    if FValue < FMin then FValue := FMin;
//  if (frac(FValue) = 0) or (FValueType = d2ValueInteger) then  // *** DB ***
    if FValueType = d2ValueInteger then
      FText := IntToStr(Trunc(FValue))
    else
//    *** DB *** Using decimalseparator is wrong (exception will occur): Format always uses dot (.)
//    FText := Format('%' + DecimalSeparator + IntToStr(FDecimalDigits) + 'f', [FValue]); // *** DB ***
      FText := Format('%.' + IntToStr(FDecimalDigits) + 'f', [FValue]);                   // *** DB ***
    SelLength := 0;
    Repaint;
  end;
end;

Please Log in or Create an account to join the conversation.

Last edit: by RockyLuck.

The name "Canvas"cannot be used in protoypes 13 years 1 month ago #3794

RockyLuck Topic Author Visitor	Because of a bug in fpc, the name "Canvas" in prototypes conflicts with a global Canvas, resulting in syntax errors. Therefore make this change in orca_scene2d_pas: //TD2PaintEvent = procedure (Sender: TObject; const Canvas: TD2Canvas) of object; // * DB * TD2PaintEvent = procedure (Sender: TObject; const ACanvas: TD2Canvas) of object; // * DB *
	Please Log in or Create an account to join the conversation.

TD2NumberBox and TD2SpinBox partly rewritten 13 years 1 month ago #3800

RockyLuck
Topic Author
Visitor

There are so many problems with TD2NumberBox and TD2SpinBox if the ValueType property is d2ValueFloat that I have largely rewritten these components.

First a small patch is needed in orca_scene2d.pas. Both in TD2NumberBox and in TD2SpinBox a private procedure Reformat is added, the SetText procedure with the WideString parameter is overwritten (eliminate the SetText with the String parameter) and in both components the procedure Change is eliminated:

    procedure SetDecimalDigits(const Value: integer);
    procedure Reformat;                                      // *** DB ***
  protected
//  procedure Change; override;                              // *** DB ***
//  procedure SetText(const Value: String); override;        // *** DB ***
    procedure SetText(const Value: WideString); override;    // *** DB ***

Apply this change in both component definitions.

The changes in the source code of TD2SpinBox and TD2NumberBox are so many, I've included their replacement texts:

File Attachment:

File Name: NumberAndS...nges.zip
File Size:2 KB

both components are streamlined in that a change in a property that affects the display of the text will be honored immediately. So if DecimalDigits changes, this is shown in the display immediately.

Thanks ;-}
Dick

NumberAndS...nges.zip

Please Log in or Create an account to join the conversation.

Last edit: by RockyLuck.

When binding values should be properly converted 13 years 1 month ago #3809

RockyLuck
Topic Author
Visitor

There are a number of places in the BindingSource logic, where the following code tries to set the controls value according to another controls value:

procedure TD2<<somecontrol>>.SetData(const Value: Variant);
begin
  if VarIsEvent(Value) then
    OnChange := VariantToEvent(Value)
  else
    if VarIsNumeric(Value) then
      Self.Value := Value
    else
      Self.Value := <<some value>>
end;

This code is wrong, because it does not allow for, say a textbox, to govern the value of, say a trackbar (the text of the textbox may contain all digits, it still does not fulfill the VarIsNumeric test).

The problem can best be illustrated in the C:\codetyphon\CodeOcean\ORCA\samples2d\binding\binding.lpr sample project.
If you run this project you can see the problem in the top leftmost panel. When you move the trackbar, the textbox will reflect its value. However, when you change the value in the textbox, the trackbar resets to 0!

These are the places that need an update:

procedure TD2AngleButton.SetData(const Value: Variant);
procedure TD2ProgressBar.SetData(const Value: Variant);
procedure TD2ScrollBar.SetData(const Value: Variant);
procedure TD2CustomTrack.SetData(const Value: Variant);

The update is this:

procedure TD2<<somecontrol>>.SetData(const Value: Variant);
begin
  if VarIsEvent(Value) then
    OnChange := VariantToEvent(Value)
  else
     Try
        Self.Value := Value;  // Let variant assignement decide if conversion is possible
     Except
        Self.Value := <<some value>>
     end{try};
end;

With these changes in place in the four indicated components, you will find the sample project to run as expected.

Thanks ;-}
Dick

Please Log in or Create an account to join the conversation.

Last edit: by RockyLuck.

When binding values should be properly converted 13 years 1 month ago #3810

Sternas Stefanos Offline Moderator Ex Pilot, M.Sc, Ph.D Posts: 4625 Thank you received: 1132	Thanks Sir PilotLogic Architect and Core Programmer
	Please Log in or Create an account to join the conversation.

When binding values should be properly converted 13 years 1 month ago #3814

RockyLuck
Topic Author
Visitor

sternas wrote: Thanks Sir

Hi Sternas,

The item #3800 is probably correct, but it causes the brush designer to fail. The OnChange event is fired when the text changes of the number box because of a number of factors. However this gives a loop in the brush designer. Apparently it uses the OnChange event of the number box causing it to loop.

I still think the changes are right, so I'll try to fix the problem in the brush designer, because that should not be dependent on the bug that was originally present in the number box (one of the two implementations that I redid).

So, for this moment do not apply #3800 fix yet :side:

Thanks ;-}
Dick

Please Log in or Create an account to join the conversation.

TD2NumberBox and TD2SpinBox partly rewritten 13 years 1 month ago #3815

RockyLuck
Topic Author
Visitor

RockyLuck wrote: both components are streamlined in that a change in a property that affects the display of the text will be honored immediately. So if DecimalDigits changes, this is shown in the display immediately.

Unfortunately the gradient and solid color editors contain an event loop, that came out because of these changes. Just a few small changes were needed there.

First of all, we need a loop blocking variable "InternalChange" to be defined in orca_scene2d.pas:

TD2BrushDesign = class(TForm)
.
.
.
  private
    FBrush: TD2Brush;
    FScene: Id2Scene;
    FComp: TPersistent;
    InternalChange: Boolean;           // *** DB ***
    procedure SetBrush(const Value: TD2Brush);
    procedure SetComp(const Value: TPersistent);
    procedure rebuilResList;
.
.
.

I have rewritten the OnChange logic in TD2NumberBox and TD2SpinBox a bit, so that OnChange only occurs if their Value property changes. I've included the changed code:

File Attachment:

File Name: NumberAndSpinbox.zip
File Size:2 KB

The prototype for the internal procedure Reformat has to be changed in the two places in orca_scene2d.pas as follows:

    procedure Reformat(const ValueChanged: Boolean);         // *** DB ***

The changes needed in the orca_scene2d_designers.inc file are minor:

procedure TD2BrushDesign.solidQuadChange(Sender: TObject);
begin
  if FBrush = nil then Exit;
  InternalChange := True;                                        // *** DB ***
  solidQuad.Alpha := ((FBrush.SolidColor and $FF000000) shr 24) / $FF;
  FBrush.SolidColor := (FBrush.SolidColor and not $FFFFFF) or ($00FFFFFF and d2HSLtoRGB(solidQuad.Hue, solidQuad.Sat, solidQuad.Lum));
  textSolidR.Value := TD2ColorRec(FBrush.SolidColor).R;
  textSolidG.Value := TD2ColorRec(FBrush.SolidColor).G;
  textSolidB.Value := TD2ColorRec(FBrush.SolidColor).B;
  textSolidA.Value := TD2ColorRec(FBrush.SolidColor).A;
  textSolidHex.TextW := d2ColorToStr(FBrush.SolidColor);
  InternalChange := False;                                        // ** DB ***
end;

procedure TD2BrushDesign.textSolidHexChange(Sender: TObject);
begin
  { change solid hex }
  if FBrush = nil then Exit;
  if InternalChange then Exit;                                    // *** DB ***
  FBrush.SolidColor := d2StrToColor(textSolidHex.TextW);
  solidPicker.Color := FBrush.SolidColor;
end;

procedure TD2BrushDesign.textSolidRChange(Sender: TObject);
var
  Color: TD2Color;
begin
  { solid textbox change }
  if FBrush = nil then Exit;
  Color := FBrush.SolidColor;
  TD2ColorRec(Color).R := trunc(textSolidR.Value);
  TD2ColorRec(Color).G := trunc(textSolidG.Value);
  TD2ColorRec(Color).B := trunc(textSolidB.Value);
  TD2ColorRec(Color).A := trunc(textSolidA.Value);
  if InternalChange then Exit;                                    // *** DB ***
  FBrush.SolidColor := Color;
  solidPicker.Color := FBrush.SolidColor;
end;
.
.
.
procedure TD2BrushDesign.gradQuadChange(Sender: TObject);
begin
  { chage color in current point }
  if FBrush = nil then Exit;
  InternalChange := True;                                         // *** DB ***
  gradEditor.Gradient.Points[gradEditor.CurrentPoint].IntColor :=
    (gradEditor.Gradient.Points[gradEditor.CurrentPoint].IntColor and $FF000000) or ($00FFFFFF and d2HSLtoRGB(gradQuad.Hue, gradQuad.Sat, gradQuad.Lum));
  FBrush.Gradient.Assign(gradEditor.Gradient);
  textGradR.Value := TD2ColorRec(gradColorRect.Color).R;
  textGradG.Value := TD2ColorRec(gradColorRect.Color).G;
  textGradB.Value := TD2ColorRec(gradColorRect.Color).B;
  textGradA.Value := TD2ColorRec(gradColorRect.Color).A;
  textGradHex.TextW := d2ColorToStr(gradColorRect.Color);
  gradEditor.Repaint;
  InternalChange := False;                                        // *** DB ***
end;
.
.
.
procedure TD2BrushDesign.textGradRChange(Sender: TObject);
var
  Color: TD2Color;
begin
  { change grad brush alpha }
  if FBrush = nil then Exit;
  Color := gradEditor.Gradient.Points[gradEditor.CurrentPoint].IntColor;
  TD2ColorRec(Color).R := trunc(textGradR.Value);
  TD2ColorRec(Color).G := trunc(textGradG.Value);
  TD2ColorRec(Color).B := trunc(textGradB.Value);
  TD2ColorRec(Color).A := trunc(textGradA.Value);
  gradEditor.Gradient.Points[gradEditor.CurrentPoint].IntColor := Color;
  if InternalChange then Exit;                                    // *** DB ***
  gradEditor.UpdateGradient;
end;
.
.
.
procedure TD2BrushDesign.textGradHexChange(Sender: TObject);
begin
  { change gradient hex }
  if FBrush = nil then Exit;
  gradEditor.Gradient.Points[gradEditor.CurrentPoint].IntColor := d2StrToColor(textGradHex.TextW);
  if InternalChange then Exit;                                    // *** DB ***
  gradEditor.UpdateGradient;
end;

This cures the problem that these two editors had a bug in the form of an event loop.

Thanks ;-}
Dick

NumberAndSpinbox.zip

Please Log in or Create an account to join the conversation.

Last edit: by RockyLuck.

TD2Inspector may use property info that's nil 13 years 1 month ago #3817

RockyLuck
Topic Author
Visitor

I could reproduce this by going into the resource designer, changing some gradient then change its type (through selecting the tab Solid) to solid, then change the color. Upon clicking OK I would get a SIGSEGV violation.

The culprit seems to be in the orca_scene2d_obj_inspector.inc file where a property info may have become nil. This fix solved the problem:

This is procedure TD2Inspector.DoEditorChange where this has to be changed:

if (Sender = FEditBox) and FEditBox.Visible then
    begin
      PropInfo := GetPropInfo(Selected.TagObject, Selected.TagString);
      if PropInfo <> nil then begin                      // *** DB ***
         if PropInfo^.PropType^.Kind = tkMethod then
         begin
           if GvarD2Designer <> nil then
           begin
             M := GvarD2Designer.AddMethod(TD2TextBox(Sender).TextW);
             SetMethodProp(Selected.TagObject, PropInfo, M);
             if (M.Code <> nil) and (TD2Object(Sender).TagObject <> nil) then
               TD2Label(TD2Object(Sender).TagObject).TextW := TD2TextBox(Sender).TextW;
           end;
         end
         else
         begin
           SetPropValue(Selected.TagObject, Selected.TagString, TD2TextBox(Sender).TextW);
           if TD2Object(Sender).TagObject <> nil then
             TD2Label(TD2Object(Sender).TagObject).TextW := TD2TextBox(Sender).TextW;
         end;
      end;                                               // *** DB ***
    end;

Thanks ;-}
Dick

Please Log in or Create an account to join the conversation.

Last edit: by RockyLuck.

TD2Calendar not finished? 13 years 1 month ago #3826

RockyLuck
Topic Author
Visitor

Here's a picture of the old Calendar and the new Calendar after the changes I made:

As you can see, in the old situation the next month, current date and previous month buttons are ridiculously small. Also the month name and the year are almost invisible. If the theme is dark, the buttons are almost invisible. It's not good.

Here are some changes I made (as always, the changes are marked with *** DB ***):

In orca_scene2d.pas a little change is needed in the TD2Calendar definition:

    .
    .
    procedure SetData(const Value: Variant); override;
    procedure MouseWheel(Shift: TShiftState; WheelDelta: integer; var Handled: boolean); override;
    procedure WeekDay0ApplyResource(Sender : TObject);                           // *** DB ***
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    .
    .

The other changes are in orca_scene2d_obj_calendars.inc.

First of all, in order to get buttons that are a little bigger, the stroke with which the graphics on these buttons is drawn should be made visible (it's transparent now). Further, in order to find these shapes later on, I gave them the resourcename 'calendarcontrol'.

This is done in the Create constructor of the TD2Calendar. At that point, you cannot set the appropriate color, because that is determined by the resource manager after the controls are created. It took me over two days to find a usable event that was not too early and also not too late :blink:

I determined that the OnApplyResource event is generated after the resource manager has done its stuff. The color I want for the buttons and the month and year should be the same as that used for showing the week days. So I made an OnApplyResource event for the first label used in the weekdays. This is part of the constructor TD2Calendar.Create in orca_scene2d_obj_calendars.inc:

    FPrev := TD2Button.Create(Self);
    with FPrev do
    begin
      Parent := L;
      Width := 19;
      Locked := true;
      Stored := false;
      Align := vaLeft;
      Padding.Right := 2;
      Resource := 'transparentcirclebuttonstyle';
      OnClick := DoPrevClick;
      RepeatClick := true;
      with TD2ScrollArrowLeft.Create(Self) do
      begin
        Parent := FPrev;
        Width := 5;
        Height := 5;
//      Stroke.Style := d2BrushNone;    // Very, very small arrows    *** DB ***
        Stroke.Style := d2BrushSolid;                              // *** DB ***
        ResourceName := 'calendarcontrol';    // So we can find it    *** DB ***
        Align := vaCenter;
        HitTest := false;
        Stored := false;
        Locked := true;
      end;
    end;
    FToday := TD2Button.Create(Self);
    with FToday do
    begin
      Parent := L;
      Width := 19;
      Locked := true;
      Stored := false;
      Align := vaLeft;
      Position.X := 30;
      Padding.Right := 2;
      Resource := 'transparentcirclebuttonstyle';
      OnClick := DoTodayClick;
//    RepeatClick := true;              // Select today many times?   *** DB ***
      RepeatClick := false;                                        // *** DB ***
      with TD2Ellipse.Create(Self) do
      begin
        Parent := FToday;
        Width := 5;
        Height := 5;                                               
//      Stroke.Style := d2BrushNone;                               // *** DB ***
        Stroke.Style := d2BrushSolid;                              // *** DB ***
        ResourceName := 'calendarcontrol';                         // *** DB ***
        Align := vaCenter;
        HitTest := false;
        Stored := false;
        Locked := true;
      end;
    end;
    FNext := TD2Button.Create(Self);
    with FNext do
    begin
      Parent := L;
      Width := 19;
      Locked := true;
      Stored := false;
      Position.X := 50;
      Align := vaLeft;
      Padding.Right := 2;
      Resource := 'transparentcirclebuttonstyle';
      RepeatClick := true;
      OnClick := DoNextClick;
      with TD2ScrollArrowRight.Create(Self) do
      begin
        Parent := FNext;
        Width := 5;
        Height := 5;
//      Stroke.Style := d2BrushNone;                               // *** DB ***
        Stroke.Style := d2BrushSolid;                              // *** DB ***
        ResourceName := 'calendarcontrol';                         // *** DB ***
        Align := vaCenter;
        HitTest := false;
        Stored := false;
        Locked := true;
      end;
    end;
    FMonths := TD2PopupBox.Create(Self);
    with FMonths do
    begin
      Parent := L;
      Align := vaClient;
      Locked := true;
      Stored := false;
      DisableFocusEffect := true;
      Padding.Left := 5;
      Padding.Right := 5;
      Resource := 'labelstyle';
      for i := 1 to 12 do
        Items.Add(LongMonthNames[i]);
      Font.Style := d2FontBold;
      TextAlign := d2TextAlignFar;
      ItemIndex := AMonth - 1;
      OnChange := DoMonthChange;
    end;
    FYears := TD2PopupBox.Create(Self);
    with FYears do
    begin
      Parent := L;
      Width := 40;
      Align := vaRight;
      Locked := true;
      Stored := false;
      DisableFocusEffect := true;
      Resource := 'labelstyle';
      for i := 1 to 10 do
        Items.Add(IntToStr(AYear - i));
      Items.Add(IntToStr(AYear));
      for i := 1 to 10 do
        Items.Add(IntToStr(AYear + i));
      Font.Style := d2FontBold;
      TextAlign := d2TextAlignNear;
      ItemIndex := 10;
      OnChange := DoYearChange;
    end;
  end;
  FWeek := TD2GridLayout.Create(Self);
  with FWeek do
  begin
    Parent := Self;
    Locked := true;
    Stored := false;
    Height := 19;
    Position.Y := 20;
    ItemHeight := 19;
    Align := vaTop;
    Padding.Bottom := 2;
    for i := 0 to 6 do
      with TD2Label.Create(Self) do
      begin
        Parent := FWeek;
        Locked := true;
        Stored := false;
        TextAlign := d2TextAlignCenter;
        WordWrap := false;
      end;
    TD2Label(Children[0]).OnApplyResource := WeekDay0ApplyResource;// *** DB ***
    ItemWidth := Width / 7;
  end;

So all that's left to do is implemenet the OnApplyResource for week day 0:

procedure TD2Calendar.WeekDay0ApplyResource(Sender : TObject);     // *** DB ***
var
   T: TD2Object;
   B: TD2Brush;

   procedure FillButton(btn: TD2Button);
   var
      T: TD2Object;
   begin
      T := btn.FindResource('calendarcontrol');
      if (T <> nil) and (T is TD2Shape) then begin
         TD2Shape(T).Stroke.Assign(B);
         TD2Shape(T).Fill.Assign(B);
      end{if};
   end;

   procedure FillTxtFont(lbl: TD2TextControl);
   var
      T: TD2Object;
   begin
      T := lbl.FindResource('text');
      if (T <> nil) and (T is TD2Text) then begin
         TD2Text(T).Fill.Assign(B);
      end{if};
   end;

begin
   B := TD2Brush.Create(d2BrushSolid, $FFFFFFFF);
   Try
      T := Sender as TD2Label;
      T := TD2Label(T).FindResource('text');
      if (T <> nil) and (T is TD2Text) then B.Assign(TD2Text(T).Fill)
                                       else Exit;
      FillButton(FPrev);
      FillButton(FToday);
      FillButton(FNext);

      FillTxtFont(FMonths);
      FillTxtFont(FYears);
   finally
      B.Free;
   end{try};
end;                                                               // *** DB ***

That code was not easily made.

For your interest: look at the way you get to the color of the text in the label. That's interesting for others too, if you want to change that color in code.

Cheers ;-}
Dick

...nd_New_Cal.jpg

Please Log in or Create an account to join the conversation.

TD2Calendar not finished? 13 years 1 month ago #3828

RockyLuck
Topic Author
Visitor

RockyLuck wrote:

procedure TD2Calendar.WeekDay0ApplyResource(Sender : TObject);     // *** DB ***
var
   T: TD2Object;
   B: TD2Brush;

   procedure FillButton(btn: TD2Button);
   var
      T: TD2Object;
   begin
      T := btn.FindResource('calendarcontrol');
      if (T <> nil) and (T is TD2Shape) then begin
         TD2Shape(T).Stroke.Assign(B);
         TD2Shape(T).Fill.Assign(B);
      end{if};
   end;

   procedure FillTxtFont(lbl: TD2TextControl);
   var
      T: TD2Object;
   begin
      T := lbl.FindResource('text');
      if (T <> nil) and (T is TD2Text) then begin
         TD2Text(T).Fill.Assign(B);
      end{if};
   end;

begin
   B := TD2Brush.Create(d2BrushSolid, $FFFFFFFF);
   Try
      T := Sender as TD2Label;
      T := TD2Label(T).FindResource('text');
      if (T <> nil) and (T is TD2Text) then B.Assign(TD2Text(T).Fill)
                                       else Exit;
      FillButton(FPrev);
      FillButton(FToday);
      FillButton(FNext);

      FillTxtFont(FMonths);
      FillTxtFont(FYears);
   finally
      B.Free;
   end{try};
end;                                                               // *** DB ***

Hi Sternas,

I really need your help now with this. For a normal calendar, this code works. However, in a TD2CalendarTextBox the code only works after the user has clicked in the calendar :side:

In other words: the controls are not refreshed immediately. I have tried Refresh, Repaint, InvalidateRect, etc. etc. Nothing seems to work. The problem must be in this piece of coding.

Can you shed some light on this?

Thanks ;-}
Dick

Please Log in or Create an account to join the conversation.

TD2Calendar not finished? 13 years 1 month ago #3829

Sternas Stefanos Offline Moderator Ex Pilot, M.Sc, Ph.D Posts: 4625 Thank you received: 1132	Give me time to solve this PilotLogic Architect and Core Programmer
	Please Log in or Create an account to join the conversation.

TD2BitmapEditor aborts 13 years 1 month ago #3832

RockyLuck
Topic Author
Visitor

The TD2BitmapEditor produces a SIGSEGV exception at Create time.
The reason is that during loading of the form, width and height of two TD2NumberBoxes change, producing the newWidthChange and newHeightChange events. These event procedures refer to FBitmap, which has not been created yet.

This is the fix:

procedure TD2BitmapEditor.newWidthChange(Sender: TObject);
begin
  if not (csLoading in ComponentState) then                        // *** DB ***
     newHeight.Value := Round(newWidth.Value * (FBitmap.Height / FBitmap.Width));
end;

procedure TD2BitmapEditor.newHeightChange(Sender: TObject);
begin
  if not (csLoading in ComponentState) then                        // *** DB ***
     newWidth.Value := Round(newHeight.Value * (FBitmap.Width / FBitmap.Height));
end;

Thanks ;-}

Dick

Please Log in or Create an account to join the conversation.

TfrmParticleDesign has never worked like this!! 13 years 1 month ago #3833

RockyLuck
Topic Author
Visitor

I'm really getting a bit annoyed by this.
I had to conclude that TD2BitmapEditor could not work, because of the SIGSEGV exception.
Now I have to find that the particle editor TfrmParticleDesign in module orca_editor_particle.pas can never have worked :angry:

. Just try the example in C:\codetyphon\CodeOcean\ORCA\samples3d\particle. Click the "Show Editor ... " button and that's it.

I'll just give the needed patches:

At the start of the module:

    .
    .
    procedure trackFrictionChange(Sender: TObject);
  private
    InQuad1Edit: Integer;                                          // *** DB ***
    InQuad2Edit: Integer;                                          // *** DB ***
    FParentScene: TD3Scene;
    FMousePressed: boolean;
    { Private declarations }
    procedure RebuildBitmapList;
    procedure SetParentScene(const Value: TD3Scene);
    .
    .

Then further down changes are needed for ColorQuad1 and ColorQuad2:

procedure TfrmParticleDesign.numRChange(Sender: TObject);
var
  Color: TD3Color;
begin
  if csDestroying in ComponentState then Exit;                     // *** DB ***
  Color := ColorPicker1.Color;
  TD3ColorRec(Color).R := trunc(numR.Value);
  TD3ColorRec(Color).G := trunc(numG.Value);
  TD3ColorRec(Color).B := trunc(numB.Value);
  TD3ColorRec(Color).A := trunc(numA.Value);
  textRGBA.Text := d3ColorToStr(ColorBox1.Color);
  if InQuad1Edit = 0 then ColorPicker1.Color := Color;             // *** DB ***
  partGrad.Fill.Gradient.Points[0].Color := textRGBA.Text;
  if InQuad1Edit = 0 then partGrad.Repaint;                        // *** DB ***
end;

procedure TfrmParticleDesign.textRGBAChange(Sender: TObject);
begin
  if InQuad1Edit = 0 then                                          // *** DB ***
          ColorPicker1.Color := d3StrToColor(textRGBA.Text);
end;

procedure TfrmParticleDesign.ColorQuad1Change(Sender: TObject);
begin
  Inc(InQuad1Edit);                             // Prevent Event loop *** DB ***
  Try                                                              // *** DB ***
     Emitter.ColorBegin := d3ColorToStr(ColorBox1.Color);
     numR.Value := TD3ColorRec(ColorBox1.Color).R;
     numG.Value := TD3ColorRec(ColorBox1.Color).G;
     numB.Value := TD3ColorRec(ColorBox1.Color).B;
     numA.Value := TD3ColorRec(ColorBox1.Color).A;
     textRGBA.Text := d3ColorToStr(ColorBox1.Color);
     partGrad.Fill.Gradient.Points[0].Color := textRGBA.Text;
     partGrad.Repaint;
  finally                                                          // *** DB ***
     Dec(InQuad1Edit);                                             // *** DB ***
  end{try};                                                        // *** DB ***
end;
.
.
.
procedure TfrmParticleDesign.numR2Change(Sender: TObject);
var
  Color: TD3Color;
begin
  if csDestroying in ComponentState then Exit;                     // *** DB ***
  Color := ColorPicker2.Color;
  TD3ColorRec(Color).R := trunc(numR2.Value);
  TD3ColorRec(Color).G := trunc(numG2.Value);
  TD3ColorRec(Color).B := trunc(numB2.Value);
  TD3ColorRec(Color).A := trunc(numA2.Value);
  textRGBA2.Text := d3ColorToStr(ColorBox2.Color);
  partGrad.Fill.Gradient.Points[1].Color := textRGBA2.Text;
  if InQuad2Edit = 0 then begin                                    // *** DB ***
     partGrad.Repaint;
     ColorPicker2.Color := Color;
  end{if};                                                         // *** DB ***
end;

procedure TfrmParticleDesign.textRGBA2Change(Sender: TObject);
begin
  if InQuad2Edit = 0 then                                          // *** DB ***
     ColorPicker2.Color := d3StrToColor(textRGBA.Text);
end;

procedure TfrmParticleDesign.ColorQuad2Change(Sender: TObject);
begin
  Inc(InQuad2Edit);                             // Prevent Event loop *** DB ***
  Try                                                              // *** DB ***
     Emitter.ColorEnd := d3ColorToStr(ColorBox2.Color);
     numR2.Value := TD3ColorRec(ColorBox2.Color).R;
     numG2.Value := TD3ColorRec(ColorBox2.Color).G;
     numB2.Value := TD3ColorRec(ColorBox2.Color).B;
     numA2.Value := TD3ColorRec(ColorBox2.Color).A;
     textRGBA2.Text := d3ColorToStr(ColorBox2.Color);
     partGrad.Fill.Gradient.Points[1].Color := textRGBA2.Text;
     partGrad.Repaint;
  finally                                                          // *** DB ***
     Dec(InQuad2Edit);                                             // *** DB ***
  end{try};                                                        // *** DB ***
end;

Please Log in or Create an account to join the conversation.