diff --git a/components/jvcllaz/design/JvCore/jvcorereg.pas b/components/jvcllaz/design/JvCore/jvcorereg.pas index 002a4c6c3..99113a234 100644 --- a/components/jvcllaz/design/JvCore/jvcorereg.pas +++ b/components/jvcllaz/design/JvCore/jvcorereg.pas @@ -4,10 +4,18 @@ unit JvCoreReg; interface -uses - SysUtils; +procedure Register; implementation +uses + PropEdits, + JvTypes, JvDsgnEditors; + +procedure Register; +begin + RegisterPropertyEditor(TypeInfo(TJvPersistentProperty), nil, '', TJvPersistentPropertyEditor); +end; + end. diff --git a/components/jvcllaz/design/JvCore/jvdsgneditors.pas b/components/jvcllaz/design/JvCore/jvdsgneditors.pas new file mode 100644 index 000000000..d7c06541f --- /dev/null +++ b/components/jvcllaz/design/JvCore/jvdsgneditors.pas @@ -0,0 +1,932 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvDsgnEditors.PAS, released on 2002-05-26. + +The Initial Developer of the Original Code is Peter Thörnqvist [peter3 att users dott sourceforge dott net] +Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist. +All Rights Reserved. + +Contributor(s): + +Added editors for JvFooter and JvGroupHeader + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvDsgnEditors; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, PropEdits; + { + Windows, Forms, Controls, Graphics, ExtCtrls, Dialogs, + ExtDlgs, Menus, StdCtrls, ImgList, Tabs, + ImgEdit, TypInfo, DsnConst, + RTLConsts, DesignIntf, DesignEditors, DesignMenus, VCLEditors, + FiltEdit, + Classes, SysUtils; + } + +type + // Special TJvPersistent property editor, that allow show event properties + // This is useful with version 5 and up --created by dejoy + TJvPersistentPropertyEditor = class(TPersistentPropertyEditor) //ComponentProperty) + private + FInstance: TPersistent; + protected + function GetInstance: TPersistent; virtual; //d5/d6 + public + procedure Initialize; override; //d5/d6 + function GetValue: string; override; //d5/d6 + property Instance: TPersistent read GetInstance; + end; + +(********************** NOT CONVERTED **** + TJvHintProperty = class(TStringProperty) + public + function GetAttributes: TPropertyAttributes; override; + procedure Edit; override; + end; + + TJvFilenameProperty = class(TStringProperty) + protected + procedure OnDialogShow(Sender: TObject); virtual; + function GetFilter: string; virtual; + function GetOptions: TOpenOptions; virtual; + public + procedure Edit; override; + function GetAttributes: TPropertyAttributes; override; + function GetValue: string; override; + end; + + TJvExeNameProperty = class(TJvFilenameProperty) + protected + function GetFilter: string; override; + end; + + TJvDirectoryProperty = class(TStringProperty) + public + procedure Edit; override; + function GetAttributes: TPropertyAttributes; override; + function GetValue: string; override; + end; + + TJvStringsProperty = class(TStringProperty) + public + function GetAttributes: TPropertyAttributes; override; + procedure Edit; override; + end; + + TJvBasePropertyEditor = class(TDefaultEditor) + protected + procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; + function GetEditPropertyName: string; virtual; abstract; + public + procedure ExecuteVerb(Index: Integer); override; + function GetVerb(Index: Integer): string; override; + function GetVerbCount: Integer; override; + end; + + TJvStringsEditor = class(TJvBasePropertyEditor) + protected + function GetEditPropertyName: string; override; + end; + + TJvItemsEditor = class(TJvBasePropertyEditor) + protected + function GetEditPropertyName: string; override; + end; + + TJvDateTimeExProperty = class(TDateTimeProperty) + public + procedure Edit; override; + function GetAttributes: TPropertyAttributes; override; + end; + + TJvDateExProperty = class(TDateProperty) + public + procedure Edit; override; + function GetAttributes: TPropertyAttributes; override; + end; + + TJvTimeExProperty = class(TTimeProperty) + public + procedure Edit; override; + function GetAttributes: TPropertyAttributes; override; + end; + + TJvShortCutProperty = class(TIntegerProperty) + public + function GetAttributes: TPropertyAttributes; override; + procedure GetValues(Proc: TGetStrProc); override; + function GetValue: string; override; + procedure SetValue(const Value: string); override; + end; + + TJvDefaultImageIndexProperty = class(TIntegerProperty, ICustomPropertyDrawing, ICustomPropertyListDrawing) + protected + function ImageList: TCustomImageList; virtual; + public + function GetAttributes: TPropertyAttributes; override; + procedure GetValues(Proc: TGetStrProc); override; + function GetValue: string; override; + procedure SetValue(const Value: string); override; + procedure ListMeasureWidth(const Value: string; + ACanvas: TCanvas; var AWidth: Integer); virtual; + procedure ListMeasureHeight(const Value: string; + ACanvas: TCanvas; var AHeight: Integer); virtual; + procedure ListDrawValue(const Value: string; + ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); virtual; + procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; + ASelected: Boolean); + procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; + ASelected: Boolean); + end; + + TJvNosortEnumProperty = class(TEnumProperty) + public + function GetAttributes: TPropertyAttributes; override; + end; + + TJvIntegerProperty = class(TIntegerProperty) + public + function GetValue: string; override; + procedure SetValue(const Value: string); override; + end; + + TJvFloatProperty = class(TFloatProperty) + public + function GetValue: string; override; + procedure SetValue(const Value: string); override; + end; + + TJvImageListEditor = class(TComponentEditor) + private + procedure SaveAsBitmap(ImageList: TImageList); + public + procedure ExecuteVerb(Index: Integer); override; + function GetVerb(Index: Integer): string; override; + function GetVerbCount: Integer; override; + end; + + TJvWeekDayProperty = class(TEnumProperty) + function GetAttributes: TPropertyAttributes; override; + end; + + TJvComponentFormProperty = class(TComponentProperty) + public + procedure GetValues(Proc: TGetStrProc); override; + procedure SetValue(const Value: string); override; + end; +********************************) + +implementation + +uses + TypInfo, + JvDsgnConsts, JvTypes; +(* + Math, FileCtrl, //Consts, + Registry, + Dlgs, JvDateTimeForm, + JvTypes, JvStringsForm, JvDsgnConsts, JvConsts; + *) + +function ValueName(E: Extended): string; +begin + if E = High(Integer) then + Result := RsMaxInt + else + if E = Low(Integer) then + Result := RsMinInt + else + if E = High(Longint) then + Result := RsMaxLong + else + if E = Low(Longint) then + Result := RsMinLong + else + if E = High(Shortint) then + Result := RsMaxShort + else + if E = Low(Shortint) then + Result :=RsMinShort + else + if E = High(Word) then + Result := RsMaxWord + else + Result := ''; +end; + +function StrToValue(const S: string): Longint; +begin + if CompareText(S, RsMaxLong) = 0 then + Result := High(Longint) + else + if CompareText(S, RsMinLong) = 0 then + Result := Low(Longint) + else + if CompareText(S, RsMaxInt) = 0 then + Result := High(Integer) + else + if CompareText(S, RsMinInt) = 0 then + Result := Low(Integer) + else + if CompareText(S, RsMaxShort) = 0 then + Result := High(Shortint) + else + if CompareText(S, RsMinShort) = 0 then + Result := Low(Shortint) + else + if CompareText(S, RsMaxWord) = 0 then + Result := High(Word) + else + Result := 0; +end; + +//=== { TJvPersistentPropertyEditor } ================================================ + +function TJvPersistentPropertyEditor.GetInstance: TPersistent; +var + LInstance: TPersistent; + LPersistentPropertyName: string; +begin + if not Assigned(FInstance) then + begin + LInstance := GetComponent(0); + LPersistentPropertyName := GetName; + if IsPublishedProp(LInstance, LPersistentPropertyName) then + begin + FInstance := TPersistent(GetObjectProp(LInstance, LPersistentPropertyName)); + end; + end; + Result := FInstance; +end; + + //Set property name in property editor procedure "Initialize" dynamically, + //Do't set property name in property constructor Create,that will raise a + //SDuplicateName error if + //you have more then one TJvPersistent property in a component. + //Like this 'A component named xx already exists' +procedure TJvPersistentPropertyEditor.Initialize; +var + LInstance: TPersistent; + LPersistentPropertyName: string; +begin + inherited Initialize; + LInstance := Instance; + LPersistentPropertyName := GetName; + if LInstance is TComponent then + begin + if (TComponent(LInstance).Name = '') and + (TComponent(LInstance).Name <> LPersistentPropertyName) then + begin + TComponent(LInstance).Name := LPersistentPropertyName; + end; + end else + if LInstance is TJvPersistent then + begin + if (TJvPersistent(LInstance).Name = '') and + (TJvPersistent(LInstance).Name <> LPersistentPropertyName) then + begin + TJvPersistent(LInstance).Name := LPersistentPropertyName; + end; + end; +end; + +function TJvPersistentPropertyEditor.GetValue:string; +begin + FmtStr(Result, '(%s)', [GetPropType^.Name]); +end; + + +(************************** NOT CONVERTED ************************************** + +//=== { TJvFilenameProperty } ================================================ + +procedure TJvFilenameProperty.Edit; +begin + with TOpenDialog.Create(nil) do + try + FileName := GetStrValue; + Filter := GetFilter; + Options := GetOptions; + OnShow := OnDialogShow; + if Execute then + SetStrValue(FileName); + finally + Free; + end; +end; + +function TJvFilenameProperty.GetAttributes: TPropertyAttributes; +begin + Result := [paDialog, paRevertable]; +end; + +function TJvFilenameProperty.GetFilter: string; +begin + Result := RsAllFilesFilter; +end; + +function TJvFilenameProperty.GetOptions: TOpenOptions; +begin + Result := [ofHideReadOnly, ofEnableSizing]; +end; + +function TJvFilenameProperty.GetValue: string; +begin + Result := inherited GetValue; + if Result = '' then + Result := RsFileName; +end; + +//=== { TJvDirectoryProperty } =============================================== + +procedure TJvDirectoryProperty.Edit; +var + AName: string; + FolderName: THintString; // (ahuser) TCaption is "type Xxxstring", THintString is "Xxxstring" + C: TPersistent; +begin + C := GetComponent(0); + if C is TComponent then + AName := TComponent(C).Name + else + if C is TCollectionItem then + AName := TCollectionItem(C).GetNamePath + else + AName := C.ClassName; + if SelectDirectory(AName + '.' + GetName, '', FolderName) then + SetValue(FolderName); +end; + +function TJvDirectoryProperty.GetAttributes: TPropertyAttributes; +begin + Result := [paDialog, paRevertable]; +end; + +function TJvDirectoryProperty.GetValue: string; +begin + Result := inherited GetValue; + if Result = '' then + Result := RsDirectory; +end; + +//=== { TJvHintProperty } ==================================================== + +function TJvHintProperty.GetAttributes: TPropertyAttributes; +begin + Result := {inherited GetAttributes +} [paDialog]; +end; + +procedure TJvHintProperty.Edit; +var + Temp: string; + Comp: TPersistent; +begin + with TJvStrEditDlg.Create(Application) do + try + Comp := GetComponent(0); + if Comp is TComponent then + Caption := TComponent(Comp).Name + '.' + GetName + else + Caption := GetName; + Temp := GetStrValue; + Memo.Lines.Text := Temp; + UpdateStatus(nil); + if ShowModal = mrOk then + begin + Temp := Memo.Text; + while (Length(Temp) > 0) and (Temp[Length(Temp)] < ' ') do + System.Delete(Temp, Length(Temp), 1); + SetStrValue(Temp); + end; + finally + Free; + end; +end; + +//=== { TJvStringsProperty } ================================================= + +procedure TJvStringsProperty.Edit; +var + Temp: string; + Comp: TPersistent; +begin + with TJvStrEditDlg.Create(Application) do + try + Comp := GetComponent(0); + if Comp is TComponent then + Caption := TComponent(Comp).Name + '.' + GetName + else + Caption := GetName; + Temp := GetStrValue; + Memo.Lines.Text := Temp; + UpdateStatus(nil); + if ShowModal = mrOk then + begin + Temp := Memo.Text; + while (Length(Temp) > 0) and (Temp[Length(Temp)] < ' ') do + System.Delete(Temp, Length(Temp), 1); + SetStrValue(Temp); + end; + finally + Free; + end; +end; + +function TJvStringsProperty.GetAttributes: TPropertyAttributes; +begin + Result := [paDialog, paRevertable]; +end; + +//=== { TJvBasePropertyEditor } ============================================== + +procedure TJvBasePropertyEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); +var + PropName: string; +begin + PropName := Prop.GetName; + if SameText(PropName, GetEditPropertyName) then + begin + Prop.Edit; + Continue := False; + end; +end; + +procedure TJvBasePropertyEditor.ExecuteVerb(Index: Integer); +begin + if Index = 0 then + Edit + else + inherited ExecuteVerb(Index); +end; + +function TJvBasePropertyEditor.GetVerb(Index: Integer): string; +begin + if Index = 0 then + Result := Format(RsFmtEditEllipsis, [GetEditPropertyName]) + else + Result := ''; +end; + +function TJvBasePropertyEditor.GetVerbCount: Integer; +begin + Result := 1; +end; + +//=== { TJvDateTimeExProperty } ============================================== + +procedure TJvDateTimeExProperty.Edit; +var + D: TDateTime; +begin + D := GetFloatValue; + if D = 0.0 then + D := Now; + if TFrmSelectDateTimeDlg.SelectDateTime(D, dstDateTime) then + begin + SetFloatValue(D); + Designer.Modified; + end; +end; + +function TJvDateTimeExProperty.GetAttributes: TPropertyAttributes; +begin + Result := inherited GetAttributes + [paDialog]; +end; + +//=== { TJvDateExProperty } ================================================== + +procedure TJvDateExProperty.Edit; +var + D: TDateTime; +begin + D := GetFloatValue; + if D = 0.0 then + D := Now; + if TFrmSelectDateTimeDlg.SelectDateTime(D, dstDate) then + begin + SetFloatValue(D); + Designer.Modified; + end; +end; + +function TJvDateExProperty.GetAttributes: TPropertyAttributes; +begin + Result := inherited GetAttributes + [paDialog]; +end; + +//=== { TJvTimeExProperty } ================================================== + +procedure TJvTimeExProperty.Edit; +var + D: TDateTime; +begin + D := GetFloatValue; + if D = 0.0 then + D := Now + else // (p3) we need the date part or we might get a "Must be in ShowCheckBox mode" error + D := SysUtils.Date + Frac(D); + if TFrmSelectDateTimeDlg.SelectDateTime(D, dstTime) then + begin + SetFloatValue(Frac(D)); // (p3) only return the time portion + Designer.Modified; + end; +end; + +function TJvTimeExProperty.GetAttributes: TPropertyAttributes; +begin + Result := inherited GetAttributes + [paDialog]; +end; + +//=== { TJvDefaultImageIndexProperty } ======================================= + +function TJvDefaultImageIndexProperty.ImageList: TCustomImageList; +const + cImageList = 'ImageList'; + cImages = 'Images'; +begin + if TypInfo.GetPropInfo(GetComponent(0), cImageList) <> nil then + Result := TCustomImageList(TypInfo.GetObjectProp(GetComponent(0), cImageList)) + else + if TypInfo.GetPropInfo(GetComponent(0), cImages) <> nil then + Result := TCustomImageList(TypInfo.GetObjectProp(GetComponent(0), cImages)) + else + Result := nil; +end; + +function TJvDefaultImageIndexProperty.GetAttributes: TPropertyAttributes; +begin + Result := [paValueList, paMultiSelect, paRevertable]; +end; + +function TJvDefaultImageIndexProperty.GetValue: string; +begin + Result := IntToStr(GetOrdValue); +end; + +procedure TJvDefaultImageIndexProperty.SetValue(const Value: string); +var + XValue: Integer; +begin + try + XValue := StrToInt(Value); + SetOrdValue(XValue); + except + inherited SetValue(Value); + end; +end; + +procedure TJvDefaultImageIndexProperty.GetValues(Proc: TGetStrProc); +var + Tmp: TCustomImageList; + I: Integer; +begin + Tmp := ImageList; + if Assigned(Tmp) then + for I := 0 to Tmp.Count - 1 do + Proc(IntToStr(I)); +end; + +procedure TJvDefaultImageIndexProperty.ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer); +var + Tmp: TCustomImageList; +begin + Tmp := ImageList; + if Assigned(Tmp) then + AWidth := Tmp.Width + ACanvas.TextHeight(Value) + 4; +end; + +procedure TJvDefaultImageIndexProperty.ListMeasureHeight(const Value: string; ACanvas: TCanvas; var AHeight: Integer); +var + Tmp: TCustomImageList; +begin + Tmp := ImageList; + if Assigned(Tmp) then + AHeight := Max(Tmp.Height + 2, ACanvas.TextHeight(Value) + 2); +end; + +procedure TJvDefaultImageIndexProperty.ListDrawValue(const Value: string; ACanvas: + TCanvas; const ARect: TRect; ASelected: Boolean); +var + Tmp: TCustomImageList; + R: TRect; +begin + DefaultPropertyListDrawValue(Value, ACanvas, ARect, ASelected); + Tmp := ImageList; + if Tmp <> nil then + begin + R := ARect; + ACanvas.FillRect(ARect); + Tmp.Draw(ACanvas, ARect.Left, ARect.Top, StrToInt(Value)); + OffsetRect(R, Tmp.Width + 2, 0); + DrawText(ACanvas.Handle, PChar(Value), -1, R, 0); + end; +end; + +procedure TJvDefaultImageIndexProperty.PropDrawName(ACanvas: TCanvas; + const ARect: TRect; ASelected: Boolean); +begin + DefaultPropertyDrawName(Self, ACanvas, ARect); +end; + +procedure TJvDefaultImageIndexProperty.PropDrawValue(ACanvas: TCanvas; + const ARect: TRect; ASelected: Boolean); +var + Tmp: TCustomImageList; +begin + Tmp := ImageList; + if (GetVisualValue <> '') and Assigned(Tmp) then + ListDrawValue(GetVisualValue, ACanvas, ARect, ASelected) + else + DefaultPropertyDrawValue(Self, ACanvas, ARect); +end; + +//=== { TJvShortCutProperty } ================================================ + +function TJvShortCutProperty.GetAttributes: TPropertyAttributes; +begin + Result := [paValueList, paMultiSelect, paRevertable]; +end; + +function TJvShortCutProperty.GetValue: string; +begin + try + Result := ShortCutToText(GetOrdValue); + if Result = '' then + Result := RsNone; + except + Result := inherited GetValue; + end; +end; + +procedure TJvShortCutProperty.GetValues(Proc: TGetStrProc); +var + Key: Word; + Shift: TShiftState; +begin + Proc(RsNone); + + Shift := [ssCtrl]; + for Key := Ord('A') to Ord('Z') do + Proc(ShortCutToText(ShortCut(Key, Shift))); + + Shift := [ssAlt, ssCtrl]; + for Key := Ord('A') to Ord('Z') do + Proc(ShortCutToText(ShortCut(Key, Shift))); + + Shift := []; + for Key := VK_F1 to VK_F10 do + Proc(ShortCutToText(ShortCut(Key, Shift))); + + Shift := [ssCtrl]; + for Key := VK_F1 to VK_F10 do + Proc(ShortCutToText(ShortCut(Key, Shift))); + + Shift := [ssShift]; + for Key := VK_F1 to VK_F10 do + Proc(ShortCutToText(ShortCut(Key, Shift))); + + Shift := [ssShift, ssCtrl]; + for Key := VK_F1 to VK_F10 do + Proc(ShortCutToText(ShortCut(Key, Shift))); + + Shift := [ssShift, ssAlt, ssCtrl]; + for Key := VK_F1 to VK_F10 do + Proc(ShortCutToText(ShortCut(Key, Shift))); + + Proc(ShortCutToText(ShortCut(VK_INSERT, []))); + Proc(ShortCutToText(ShortCut(VK_INSERT, [ssShift]))); + Proc(ShortCutToText(ShortCut(VK_INSERT, [ssCtrl]))); + + Proc(ShortCutToText(ShortCut(VK_DELETE, []))); + Proc(ShortCutToText(ShortCut(VK_DELETE, [ssShift]))); + Proc(ShortCutToText(ShortCut(VK_DELETE, [ssCtrl]))); + + Proc(ShortCutToText(ShortCut(VK_BACK, [ssAlt]))); + Proc(ShortCutToText(ShortCut(VK_BACK, [ssAlt, ssShift]))); +end; + +procedure TJvShortCutProperty.SetValue(const Value: string); +begin + try + SetOrdValue(TextToShortCut(Value)); + except + inherited SetValue(Value); + end; +end; + +//=== { TJvNosortEnumProperty } ============================================== + +function TJvNosortEnumProperty.GetAttributes: TPropertyAttributes; +begin + Result := inherited GetAttributes - [paSortList]; +end; + +procedure TJvFilenameProperty.OnDialogShow(Sender: TObject); +begin + SetDlgItemText(GetParent(TOpenDialog(Sender).Handle), chx1, PChar(RsStripFilePath)); +end; + +//=== { TJvExeNameProperty } ================================================= + +function TJvExeNameProperty.GetFilter: string; +begin + Result := RsExecutableFilesExeExeAllFiles; +end; + +//=== { TJvIntegerProperty } ================================================= + +function TJvIntegerProperty.GetValue: string; +begin + Result := ValueName(GetOrdValue); + if Result = '' then + Result := IntToStr(GetOrdValue); +end; + +procedure TJvIntegerProperty.SetValue(const Value: string); +var + L: Longint; +begin + L := StrToValue(Value); + if L = 0 then + L := StrToInt(Value); + inherited SetValue(IntToStr(L)); +end; + +//=== { TJvFloatProperty } =================================================== + +function TJvFloatProperty.GetValue: string; +const + Precisions: array [TFloatType] of Integer = (7, 15, 18, 18, 18); +begin + Result := ValueName(GetFloatValue); + if Result = '' then + Result := FloatToStrF(GetFloatValue, ffGeneral, + Precisions[GetTypeData(GetPropType)^.FloatType], 0); +end; + +procedure TJvFloatProperty.SetValue(const Value: string); +var + L: Longint; +begin + L := StrToValue(Value); + if L <> 0 then + SetFloatValue(L) + else + SetFloatValue(StrToFloat(Value)); +end; + +procedure TJvImageListEditor.SaveAsBitmap(ImageList: TImageList); +var + Bitmap: TBitmap; + SaveDlg: TOpenDialog; + I: Integer; +begin + if ImageList.Count > 0 then + begin + SaveDlg := TSavePictureDialog.Create(Application); + with SaveDlg do + try + Options := [ofHideReadOnly, ofOverwritePrompt]; + DefaultExt := GraphicExtension(TBitmap); + Filter := GraphicFilter(TBitmap); + if Execute then + begin + Bitmap := TBitmap.Create; + try + with Bitmap do + begin + Width := ImageList.Width * ImageList.Count; + Height := ImageList.Height; + if ImageList.BkColor <> clNone then + Canvas.Brush.Color := ImageList.BkColor + else + Canvas.Brush.Color := clWindow; + Canvas.FillRect(Bounds(0, 0, Width, Height)); + for I := 0 to ImageList.Count - 1 do + ImageList.Draw(Canvas, ImageList.Width * I, 0, I); + HandleType := bmDIB; + if PixelFormat in [pf15bit, pf16bit] then + try + PixelFormat := pf24bit; + except + end; + end; + Bitmap.SaveToFile(FileName); + finally + Bitmap.Free; + end; + end; + finally + Free; + end; + end + else + Beep; +end; + +procedure TJvImageListEditor.ExecuteVerb(Index: Integer); +begin + { The hard typecast to TImageList is necessary because EditImageList does + not want a TCustomImageList but the component could be one. This seems to + be ok because TListView.SmallImages is also a TCustomImageList and not a + TImageList. So the Component Editor for TCustomImageList must also use a + hard typecast. } + if Designer <> nil then + case Index of + 0: + if EditImageList(TImageList(Component)) then + Designer.Modified; + 1: + SaveAsBitmap(TImageList(Component)); + end; +end; + +function TJvImageListEditor.GetVerb(Index: Integer): string; +begin + case Index of + 0: + Result := SImageListEditor; + 1: + Result := RsSaveImageList; + else + Result := ''; + end; +end; + +function TJvImageListEditor.GetVerbCount: Integer; +begin + Result := 2; +end; + +//=== { TJvWeekDayProperty } ================================================= + +function TJvWeekDayProperty.GetAttributes: TPropertyAttributes; +begin + Result := [paMultiSelect, paValueList]; +end; + +//=== { TJvComponentFormProperty } =========================================== + +procedure TJvComponentFormProperty.GetValues(Proc: TGetStrProc); +var + Form: TComponent; +begin + inherited GetValues(Proc); + Form := Designer.Root; + if (Form is GetTypeData(GetPropType)^.ClassType) and (Form.Name <> '') then + Proc(Form.Name); +end; + +procedure TJvComponentFormProperty.SetValue(const Value: string); +var + Component: TComponent; + Form: TComponent; +begin + Component := Designer.GetComponent(Value); + Form := Designer.Root; + if ((Component = nil) or not (Component is GetTypeData(GetPropType)^.ClassType)) and + (CompareText(Form.Name, Value) = 0) then + begin + if not (Form is GetTypeData(GetPropType)^.ClassType) then + raise EPropertyError.CreateRes(@SInvalidPropertyValue); + SetOrdValue(NativeInt(Form)); + end + else + inherited SetValue(Value); +end; + +//=== { TJvStringsEditor } =================================================== + +function TJvStringsEditor.GetEditPropertyName: string; +begin + Result := 'Strings'; +end; + +//=== { TJvItemsEditor } ===================================================== + +function TJvItemsEditor.GetEditPropertyName: string; +begin + Result := 'Items'; +end; +*******************************************************************************) +end. + diff --git a/components/jvcllaz/design/JvStdCtrls/images/images.txt b/components/jvcllaz/design/JvStdCtrls/images/images.txt index 8ec115250..0488aceeb 100644 --- a/components/jvcllaz/design/JvStdCtrls/images/images.txt +++ b/components/jvcllaz/design/JvStdCtrls/images/images.txt @@ -1,2 +1,3 @@ tjvcheckbox.bmp +tjvpanel.bmp tjvcalcedit.bmp diff --git a/components/jvcllaz/design/JvStdCtrls/images/tjvpanel.bmp b/components/jvcllaz/design/JvStdCtrls/images/tjvpanel.bmp new file mode 100644 index 000000000..96f0831f2 Binary files /dev/null and b/components/jvcllaz/design/JvStdCtrls/images/tjvpanel.bmp differ diff --git a/components/jvcllaz/design/JvStdCtrls/jvstdctrlsreg.pas b/components/jvcllaz/design/JvStdCtrls/jvstdctrlsreg.pas index c834ead19..c5fb62ee5 100644 --- a/components/jvcllaz/design/JvStdCtrls/jvstdctrlsreg.pas +++ b/components/jvcllaz/design/JvStdCtrls/jvstdctrlsreg.pas @@ -14,12 +14,14 @@ implementation {$R ../../resource/jvstdctrlsreg.res} uses - Classes, Controls, JvDsgnConsts, JvButton, JvCheckbox, JvBaseEdits; + Classes, Controls, PropEdits, + JvDsgnConsts, //JvDsgnEditors, + JvButton, JvCheckbox, JvBaseEdits, JVPanel; procedure Register; begin - //RegisterComponents(RsPaletteButton, [TJvButton]); - RegisterComponents(RsPaletteJvcl, [TJvCheckbox, TJvCalcEdit]); + RegisterComponents(RsPaletteJvcl, [TJvCheckbox, TJvPanel, TJvCalcEdit]); +// RegisterPropertyEditor(TypeInfo(TJvArrangeSettings), nil, '', TJvPersistentPropertyEditor); end; end. diff --git a/components/jvcllaz/packages/jvcorelazd.lpk b/components/jvcllaz/packages/jvcorelazd.lpk index 6777273f1..e61240fb9 100644 --- a/components/jvcllaz/packages/jvcorelazd.lpk +++ b/components/jvcllaz/packages/jvcorelazd.lpk @@ -17,9 +17,10 @@ - + + @@ -30,6 +31,10 @@ + + + + diff --git a/components/jvcllaz/packages/jvcorelazr.lpk b/components/jvcllaz/packages/jvcorelazr.lpk index 90b713ed8..c16945eea 100644 --- a/components/jvcllaz/packages/jvcorelazr.lpk +++ b/components/jvcllaz/packages/jvcorelazr.lpk @@ -23,7 +23,7 @@ "/> - + @@ -60,6 +60,10 @@ + + + + diff --git a/components/jvcllaz/packages/jvstdctrlslazr.lpk b/components/jvcllaz/packages/jvstdctrlslazr.lpk index 10077d6fc..50dc73c43 100644 --- a/components/jvcllaz/packages/jvstdctrlslazr.lpk +++ b/components/jvcllaz/packages/jvstdctrlslazr.lpk @@ -17,7 +17,7 @@ CalcEdit, button, checkbox, linked controls "/> - + @@ -34,6 +34,14 @@ CalcEdit, button, checkbox, linked controls + + + + + + + + diff --git a/components/jvcllaz/resource/jvstdctrlsreg.res b/components/jvcllaz/resource/jvstdctrlsreg.res index 0e716ea20..a8209d66c 100644 Binary files a/components/jvcllaz/resource/jvstdctrlsreg.res and b/components/jvcllaz/resource/jvstdctrlsreg.res differ diff --git a/components/jvcllaz/run/JvCore/JvExtComponent.pas b/components/jvcllaz/run/JvCore/JvExtComponent.pas new file mode 100644 index 000000000..d91e40838 --- /dev/null +++ b/components/jvcllaz/run/JvCore/JvExtComponent.pas @@ -0,0 +1,131 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvExtComponent.pas, released on 2006-03-11. + +The Initial Developer of the Original Code is Joe Doe . +Portions created by Joe Doe are Copyright (C) 1999 Joe Doe. +All Rights Reserved. + +Contributor(s): - + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvExtComponent; + +{$mode objfpc}{$H+} + +interface + +uses + Types, + Classes, Graphics, ExtCtrls, + JvExExtCtrls; +// JvExComCtrls; + +type + TJvPaintPanelContentEvent = procedure(Sender: TObject; Canvas: TCanvas; R: TRect) of object; + + TJvCustomPanel = class(TJvExCustomPanel) + private + FOnPaintContent: TJvPaintPanelContentEvent; + protected + (******************** NOT CONVERTED *** + function GetFlat: Boolean; + procedure ReadCtl3D(Reader: TReader); + procedure ReadParentCtl3D(Reader: TReader); + procedure SetFlat(const Value: Boolean); + function GetParentFlat: Boolean; + procedure SetParentFlat(const Value: Boolean); + **************************************) + + procedure Paint; override; + procedure PaintContent(const R: TRect); virtual; + + procedure DefineProperties(Filer: TFiler); override; + + (******************* NOT CONVERTED **** + property Flat: Boolean read GetFlat write SetFlat default False; + property ParentFlat: Boolean read GetParentFlat write SetParentFlat default True; + **************************************) + + property OnPaintContent: TJvPaintPanelContentEvent read FOnPaintContent write FOnPaintContent; + end; + +(*************** NOT CONVERTED ********* + TJvPubCustomPanel = TJvExPubCustomPanel; + TJvCustomTreeView = TJvExCustomTreeView; +***************************************) + + +implementation + +{ TJvCustomPanel } + + +(***************** NOT CONVERTED *** +function TJvCustomPanel.GetFlat: Boolean; +begin + Result := not Ctl3D; +end; + +function TJvCustomPanel.GetParentFlat: Boolean; +begin + Result := ParentCtl3D; +end; + +procedure TJvCustomPanel.SetFlat(const Value: Boolean); +begin + Ctl3D := not Value; +end; + +procedure TJvCustomPanel.SetParentFlat(const Value: Boolean); +begin + ParentCtl3D := Value; +end; + +procedure TJvCustomPanel.ReadCtl3D(Reader: TReader); +begin + Flat := not Reader.ReadBoolean; +end; + +procedure TJvCustomPanel.ReadParentCtl3D(Reader: TReader); +begin + ParentFlat := Reader.ReadBoolean; +end; +************************) + +procedure TJvCustomPanel.Paint; +begin + inherited Paint; + PaintContent(ClientRect); +end; + +procedure TJvCustomPanel.PaintContent(const R: TRect); +begin + if Assigned(FOnPaintContent) then + FOnPaintContent(Self, Canvas, R); +end; + +procedure TJvCustomPanel.DefineProperties(Filer: TFiler); +begin + inherited DefineProperties(Filer); + (**************** NOT CONVERTED **** + Filer.DefineProperty('Ctl3D', ReadCtl3D, nil, False); + Filer.DefineProperty('ParentCtl3D', ReadParentCtl3D, nil, False); + ***********************************) +end; + +end. diff --git a/components/jvcllaz/run/JvCore/jvexcontrols.pas b/components/jvcllaz/run/JvCore/jvexcontrols.pas index a448e64fa..dfd475ec4 100644 --- a/components/jvcllaz/run/JvCore/jvexcontrols.pas +++ b/components/jvcllaz/run/JvCore/jvexcontrols.pas @@ -64,7 +64,9 @@ const ******************** NOT CONVERTED *) type + (********************** NOT CONVERTED **** TJvHotTrackOptions = class; + *****************************************) { IJvExControl is used for the identification of an JvExXxx control. } IJvExControl = interface @@ -79,6 +81,7 @@ type end; + (***************************** NOT CONVERTED **** { IJvHotTrack is Specifies whether Control are highlighted when the mouse passes over them} IJvHotTrack = interface ['{8F1B40FB-D8E3-46FE-A7A3-21CE4B199A8F}'] @@ -118,6 +121,7 @@ type property FrameVisible: Boolean read FFrameVisible write SetFrameVisible default False; property FrameColor: TColor read FFrameColor write SetFrameColor default $006A240A; end; + ***********************) type TStructPtrMessage = class(TObject) @@ -133,8 +137,11 @@ type procedure DrawDotNetControl(Control: TWinControl; AColor: TColor; InControl: Boolean); procedure HandleDotNetHighlighting(Control: TWinControl; const Msg: TLMessage; MouseOver: Boolean; Color: TColor); -function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: PtrInt): TLMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF} -function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: TControl): TLMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF} + +procedure CreateWMMessage(var Mesg: TLMessage; Msg: Cardinal; WParam: WPARAM; LParam: LPARAM); overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF} +//function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: PtrInt): TLMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF} +//function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: TControl): TLMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF} + function SmallPointToLong(const Pt: TSmallPoint): LongInt; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF} function ShiftStateToKeyData(Shift: TShiftState): Longint; @@ -153,6 +160,11 @@ type //******************** NOT CONVERTED //WINCONTROL_DECL_DEFAULT(WinControl) + TJvDoEraseBackgroundMethod = function(Canvas: TCanvas; Param: LPARAM): Boolean of object; + +function IsDefaultEraseBackground(Method: TJvDoEraseBackgroundMethod; MethodPtr: Pointer): Boolean; + +type TJvExCustomControl = class(TCustomControl) private // TODO: @@ -163,9 +175,9 @@ type FOnMouseEnter: TNotifyEvent; FOnMouseLeave: TNotifyEvent; FOnParentColorChanged: TNotifyEvent; - function BaseWndProc(Msg: Integer; WParam: PtrInt = 0; LParam: Longint = 0): Integer; overload; - function BaseWndProc(Msg: Integer; WParam: Ptrint; LParam: TControl): Integer; overload; - function BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer; + function BaseWndProc(Msg: Integer; WParam: PtrInt = 0; LParam: Longint = 0): LRESULT; overload; + function BaseWndProc(Msg: Integer; WParam: Ptrint; LParam: TControl): LRESULT; overload; + function BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): LRESULT; protected procedure WndProc(var Msg: TLMessage); override; procedure FocusChanged(AControl: TWinControl); dynamic; @@ -348,6 +360,15 @@ end; begin end; +procedure CreateWMMessage(var Mesg: TLMessage; Msg: Cardinal; WParam: WPARAM; LParam: LPARAM); +begin + Mesg.Msg := Msg; + Mesg.WParam := WParam; + Mesg.LParam := LParam; + Mesg.Result := 0; +end; + +{ --- replaced by newer version above function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: PtrInt): TLMessage; begin Result.Msg := Msg; @@ -360,6 +381,7 @@ function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: TControl): TLMess begin Result := CreateWMMessage(Msg, WParam, Ptrint(LParam)); end; +} { TStructPtrMessage } constructor TStructPtrMessage.Create(AMsg: Integer; WParam: Integer; var LParam); @@ -483,6 +505,7 @@ begin end; end; +(**************************** NOT CONVERTED *** //=== { TJvHotTrackOptions } ====================================== @@ -561,6 +584,8 @@ begin end; end; +*********************************) + //============================================================================ //******************** NOT CONVERTED @@ -579,18 +604,14 @@ function TJvExGraphicControl.BaseWndProc(Msg: Integer; WParam: Integer = 0; LPar var Mesg: TLMessage; begin - Mesg := CreateWMMessage(Msg, WParam, LParam); + CreateWMMessage(Mesg, Msg, WParam, LParam); inherited WndProc(Mesg); Result := Mesg.Result; end; function TJvExGraphicControl.BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer; -var - Mesg: TLMessage; begin - Mesg := CreateWMMessage(Msg, WParam, LParam); - inherited WndProc(Mesg); - Result := Mesg.Result; + Result := BaseWndProc(Msg, WParam, LCLType.LPARAM(LParam)); end; function TJvExGraphicControl.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer; @@ -758,31 +779,35 @@ end; //============================================================================ +function IsDefaultEraseBackground(Method: TJvDoEraseBackgroundMethod; + MethodPtr: Pointer): Boolean; +begin + Result := TMethod(Method).Code = MethodPtr; +end; + +//============================================================================ + constructor TJvExCustomControl.Create(AOwner: TComponent); begin inherited Create(AOwner); FHintColor := clDefault; end; -function TJvExCustomControl.BaseWndProc(Msg: Integer; WParam: PtrInt = 0; LParam: Longint = 0): Integer; +function TJvExCustomControl.BaseWndProc(Msg: Integer; WParam: PtrInt = 0; LParam: Longint = 0): LRESULT; var Mesg: TLMessage; begin - Mesg := CreateWMMessage(Msg, WParam, LParam); + CreateWMMessage(Mesg, Msg, WParam, LParam); inherited WndProc(Mesg); Result := Mesg.Result; end; -function TJvExCustomControl.BaseWndProc(Msg: Integer; WParam: PtrInt; LParam: TControl): Integer; -var - Mesg: TLMessage; +function TJvExCustomControl.BaseWndProc(Msg: Integer; WParam: PtrInt; LParam: TControl): LRESULT; begin - Mesg := CreateWMMessage(Msg, WParam, LParam); - inherited WndProc(Mesg); - Result := Mesg.Result; + Result := BaseWndProc(Msg, WParam, LCLType.LPARAM(LParam)); end; -function TJvExCustomControl.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer; +function TJvExCustomControl.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): LRESULT; var Mesg: TStructPtrMessage; begin diff --git a/components/jvcllaz/run/JvCore/jvexextctrls.pas b/components/jvcllaz/run/JvCore/jvexextctrls.pas index 42f680314..27cf51902 100644 --- a/components/jvcllaz/run/JvCore/jvexextctrls.pas +++ b/components/jvcllaz/run/JvCore/jvexextctrls.pas @@ -44,7 +44,9 @@ unit JvExExtCtrls; interface uses - Classes, Controls, ExtCtrls, Forms, Graphics, JvExControls, LCLIntf, LMessages; + LCLIntf, LCLType, LMessages, + Classes, Controls, ExtCtrls, Forms, Graphics, + JvExControls; type //******************** NOT CONVERTED @@ -62,6 +64,66 @@ type //******************** NOT CONVERTED //WINCONTROL_DECL_DEFAULT(CustomPanel) + TJvExCustomPanel = class(TCustomPanel, IJvExControl) + private + FHintColor: TColor; + FMouseOver: Boolean; + FHintWindowClass: THintWindowClass; + FOnMouseEnter: TNotifyEvent; + FOnMouseLeave: TNotifyEvent; + FOnParentColorChanged: TNotifyEvent; + function BaseWndProc(Msg: Cardinal; WParam: WPARAM = 0; LParam: LPARAM = 0): LRESULT; overload; + function BaseWndProc(Msg: Cardinal; WParam: WPARAM; LParam: TObject): LRESULT; overload; + function BaseWndProcEx(Msg: Cardinal; WParam: WPARAM; var StructLParam): LRESULT; + protected + procedure WndProc(var Msg: TLMessage); override; + procedure FocusChanged(AControl: TWinControl); dynamic; + procedure VisibleChanged; reintroduce; dynamic; + procedure EnabledChanged; reintroduce; dynamic; + procedure TextChanged; reintroduce; virtual; + procedure ColorChanged; reintroduce; dynamic; + procedure FontChanged; reintroduce; dynamic; + procedure ParentFontChanged; reintroduce; dynamic; + procedure ParentColorChanged; reintroduce; dynamic; + procedure ParentShowHintChanged; reintroduce; dynamic; + function WantKey(Key: Integer; Shift: TShiftState): Boolean; virtual; + function HintShow(var HintInfo: THintInfo): Boolean; reintroduce; dynamic; + function HitTest(X, Y: Integer): Boolean; reintroduce; virtual; + procedure MouseEnter; override; + procedure MouseLeave; override; + property MouseOver: Boolean read FMouseOver write FMouseOver; + property HintColor: TColor read FHintColor write FHintColor default clDefault; + property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter; + property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave; + property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged; + public + constructor Create(AOwner: TComponent); override; + property HintWindowClass: THintWindowClass read FHintWindowClass write FHintWindowClass; + private + FDotNetHighlighting: Boolean; + protected + procedure BoundsChanged; reintroduce; virtual; + procedure CursorChanged; reintroduce; dynamic; + procedure ShowingChanged; reintroduce; dynamic; + procedure ShowHintChanged; reintroduce; dynamic; + procedure ControlsListChanging(Control: TControl; Inserting: Boolean); reintroduce; dynamic; + procedure ControlsListChanged(Control: TControl; Inserting: Boolean); reintroduce; dynamic; + procedure GetDlgCode(var Code: TDlgCodes); virtual; + procedure FocusSet(PrevWnd: THandle); virtual; + procedure FocusKilled(NextWnd: THandle); virtual; + function DoEraseBackground(ACanvas: TCanvas; AParam: LPARAM): Boolean; virtual; + {$IFDEF JVCLThemesEnabledD6} + private + function GetParentBackground: Boolean; + protected + procedure SetParentBackground(Value: Boolean); virtual; + property ParentBackground: Boolean read GetParentBackground write SetParentBackground; + {$ENDIF JVCLThemesEnabledD6} + published + property DotNetHighlighting: Boolean read FDotNetHighlighting write FDotNetHighlighting default False; + end; + + (******************** NOT CONVERTED TJvExPubCustomPanel = class(TJvExCustomPanel) COMMON_PUBLISHED @@ -185,6 +247,307 @@ uses //******************** NOT CONVERTED //WINCONTROL_IMPL_DEFAULT(Panel) +constructor TJvExCustomPanel.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FHintColor := clDefault; +end; + +function TJvExCustomPanel.BaseWndProc(Msg: Cardinal; WParam: WPARAM = 0; LParam: LPARAM = 0): LRESULT; +var + Mesg: TLMessage; +begin + CreateWMMessage(Mesg, Msg, WParam, LParam); + inherited WndProc(Mesg); + Result := Mesg.Result; +end; + +function TJvExCustomPanel.BaseWndProc(Msg: Cardinal; WParam: WPARAM; LParam: TObject): LRESULT; +begin + Result := BaseWndProc(Msg, WParam, LCLType.LPARAM(LParam)); +end; + +function TJvExCustomPanel.BaseWndProcEx(Msg: Cardinal; WParam: WPARAM; var StructLParam): LRESULT; +begin + Result := BaseWndProc(Msg, WParam, LCLType.LPARAM(@StructLParam)); +end; + +procedure TJvExCustomPanel.VisibleChanged; +begin + BaseWndProc(CM_VISIBLECHANGED); +end; + +procedure TJvExCustomPanel.EnabledChanged; +begin + BaseWndProc(CM_ENABLEDCHANGED); +end; + +procedure TJvExCustomPanel.TextChanged; +begin + BaseWndProc(CM_TEXTCHANGED); +end; + +procedure TJvExCustomPanel.FontChanged; +begin + BaseWndProc(CM_FONTCHANGED); +end; + +procedure TJvExCustomPanel.ColorChanged; +begin + BaseWndProc(CM_COLORCHANGED); +end; + +procedure TJvExCustomPanel.ParentFontChanged; +begin + BaseWndProc(CM_PARENTFONTCHANGED); +end; + +procedure TJvExCustomPanel.ParentColorChanged; +begin + BaseWndProc(CM_PARENTCOLORCHANGED); + if Assigned(OnParentColorChange) then + OnParentColorChange(Self); +end; + +procedure TJvExCustomPanel.ParentShowHintChanged; +begin + BaseWndProc(CM_PARENTSHOWHINTCHANGED); +end; + +function TJvExCustomPanel.WantKey(Key: Integer; Shift: TShiftState): Boolean; +begin + Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0; +end; + +function TJvExCustomPanel.HitTest(X, Y: Integer): Boolean; +begin + Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0; +end; + +function TJvExCustomPanel.HintShow(var HintInfo: THintInfo): Boolean; +begin + GetHintColor(HintInfo, Self, FHintColor); + if FHintWindowClass <> nil then + HintInfo.HintWindowClass := FHintWindowClass; + Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0; +end; + +procedure TJvExCustomPanel.MouseEnter; +begin + inherited; + FMouseOver := True; + { --not needed + if Assigned(FOnMouseEnter) then + FOnMouseEnter(Self); + BaseWndProc(CM_MOUSEENTER, 0, AControl); + ------} +end; + +procedure TJvExCustomPanel.MouseLeave; +begin + FMouseOver := False; + inherited; + { ------ not needed in LCL + BaseWndProc(CM_MOUSELEAVE, 0, AControl); + if Assigned(FOnMouseLeave) then + FOnMouseLeave(Self); + ------------- } +end; + +procedure TJvExCustomPanel.FocusChanged(AControl: TWinControl); +begin + BaseWndProc(CM_FOCUSCHANGED, 0, AControl); +end; + +procedure TJvExCustomPanel.BoundsChanged; +begin +end; + +procedure TJvExCustomPanel.CursorChanged; +begin + BaseWndProc(CM_CURSORCHANGED); +end; + +procedure TJvExCustomPanel.ShowingChanged; +begin + BaseWndProc(CM_SHOWINGCHANGED); +end; + +procedure TJvExCustomPanel.ShowHintChanged; +begin + BaseWndProc(CM_SHOWHINTCHANGED); +end; + +{ VCL sends CM_CONTROLLISTCHANGE and CM_CONTROLCHANGE in a different order than + the CLX methods are used. So we must correct it by evaluating "Inserting". } +procedure TJvExCustomPanel.ControlsListChanging(Control: TControl; Inserting: Boolean); +begin + if Inserting then + BaseWndProc(CM_CONTROLLISTCHANGE, WPARAM(Control), LPARAM(Inserting)) + else + BaseWndProc(CM_CONTROLCHANGE, WPARAM(Control), LPARAM(Inserting)); +end; + +procedure TJvExCustomPanel.ControlsListChanged(Control: TControl; Inserting: Boolean); +begin + if not Inserting then + BaseWndProc(CM_CONTROLLISTCHANGE, WPARAM(Control), LPARAM(Inserting)) + else + BaseWndProc(CM_CONTROLCHANGE, WPARAM(Control), LPARAM(Inserting)); +end; + +procedure TJvExCustomPanel.GetDlgCode(var Code: TDlgCodes); +begin +end; + +procedure TJvExCustomPanel.FocusSet(PrevWnd: THandle); +begin + BaseWndProc(LM_SETFOCUS, WPARAM(PrevWnd), 0); +end; + +procedure TJvExCustomPanel.FocusKilled(NextWnd: THandle); +begin + BaseWndProc(LM_KILLFOCUS, WPARAM(NextWnd), 0); +end; + +function TJvExCustomPanel.DoEraseBackground(ACanvas: TCanvas; AParam: LPARAM): Boolean; +begin + Result := BaseWndProc(LM_ERASEBKGND, ACanvas.Handle, AParam) <> 0; +end; + +{$IFDEF JVCLThemesEnabledD6} +function TJvExCustomPanel.GetParentBackground: Boolean; +begin + Result := JvThemes.GetParentBackground(Self); +end; + +procedure TJvExCustomPanel.SetParentBackground(Value: Boolean); +begin + JvThemes.SetParentBackground(Self, Value); +end; +{$ENDIF JVCLThemesEnabledD6} + +procedure TJvExCustomPanel.WndProc(var Msg: TLMessage); +var + IdSaveDC: Integer; + DlgCodes: TDlgCodes; + lCanvas: TCanvas; +begin + if not DispatchIsDesignMsg(Self, Msg) then + begin + case Msg.Msg of + (*********** NOT CONVERTED **** + CM_DENYSUBCLASSING: + Msg.Result := LRESULT(Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil)); + *******************************) + CM_DIALOGCHAR: + with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do + Result := LRESULT(Ord(WantKey(CharCode, KeyDataToShiftState(KeyData)))); + CM_HINTSHOW: + with TCMHintShow(Msg) do + Result := LRESULT(HintShow(HintInfo^)); + CM_HITTEST: + with TCMHitTest(Msg) do + Result := LRESULT(HitTest(XPos, YPos)); + { -------------- not needed in LCL ---------- + CM_MOUSEENTER: + MouseEnter(TControl(Msg.LParam)); + CM_MOUSELEAVE: + MouseLeave(TControl(Msg.LParam)); + --------------------------------------------} + CM_VISIBLECHANGED: + VisibleChanged; + CM_ENABLEDCHANGED: + EnabledChanged; + CM_TEXTCHANGED: + TextChanged; + CM_FONTCHANGED: + FontChanged; + CM_COLORCHANGED: + ColorChanged; + CM_FOCUSCHANGED: + FocusChanged(TWinControl(Msg.LParam)); + CM_PARENTFONTCHANGED: + ParentFontChanged; + CM_PARENTCOLORCHANGED: + ParentColorChanged; + CM_PARENTSHOWHINTCHANGED: + ParentShowHintChanged; + CM_CURSORCHANGED: + CursorChanged; + CM_SHOWINGCHANGED: + ShowingChanged; + CM_SHOWHINTCHANGED: + ShowHintChanged; + CM_CONTROLLISTCHANGE: + if Msg.LParam <> 0 then + ControlsListChanging(TControl(Msg.WParam), True) + else + ControlsListChanged(TControl(Msg.WParam), False); + CM_CONTROLCHANGE: + if Msg.LParam = 0 then + ControlsListChanging(TControl(Msg.WParam), False) + else + ControlsListChanged(TControl(Msg.WParam), True); + LM_SETFOCUS: + FocusSet(THandle(Msg.WParam)); + LM_KILLFOCUS: + FocusKilled(THandle(Msg.WParam)); + LM_SIZE, LM_MOVE: + begin + inherited WndProc(Msg); + BoundsChanged; + end; + LM_ERASEBKGND: + if (Msg.WParam <> 0) and not IsDefaultEraseBackground(@DoEraseBackground, @TJvExCustomPanel.DoEraseBackground) then + begin + IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against Stock-Objects from Canvas + lCanvas := TCanvas.Create; + try + lCanvas.Handle := HDC(Msg.WParam); + Msg.Result := Ord(DoEraseBackground(lCanvas, Msg.LParam)); + finally + lCanvas.Handle := 0; + lCanvas.Free; + RestoreDC(HDC(Msg.WParam), IdSaveDC); + end; + end + else + inherited WndProc(Msg); + (*************************** NOT CONVERTED *** + {$IFNDEF DELPHI2007_UP} + LM_PRINTCLIENT, LM_PRINT: // VCL bug fix + begin + IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against changes + try + inherited WndProc(Msg); + finally + RestoreDC(HDC(Msg.WParam), IdSaveDC); + end; + end; + {$ENDIF ~DELPHI2007_UP} + *********************************************) + LM_GETDLGCODE: + begin + inherited WndProc(Msg); + DlgCodes := [dcNative] + DlgcToDlgCodes(Msg.Result); + GetDlgCode(DlgCodes); + if not (dcNative in DlgCodes) then + Msg.Result := DlgCodesToDlgc(DlgCodes); + end; + else + inherited WndProc(Msg); + end; + case Msg.Msg of // precheck message to prevent access violations on released controls + CM_MOUSEENTER, CM_MOUSELEAVE, LM_KILLFOCUS, LM_SETFOCUS, LM_NCPAINT: + if DotNetHighlighting then + HandleDotNetHighlighting(Self, Msg, MouseOver, Color); + end; + end; +end; + + + //******************** NOT CONVERTED //WINCONTROL_IMPL_DEFAULT(RadioGroup) @@ -222,18 +585,14 @@ function TJvExSplitter.BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Lo var Mesg: TLMessage; begin - Mesg := CreateWMMessage(Msg, WParam, LParam); + CreateWMMessage(Mesg, Msg, WParam, LParam); inherited WndProc(Mesg); Result := Mesg.Result; end; function TJvExSplitter.BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer; -var - Mesg: TLMessage; begin - Mesg := CreateWMMessage(Msg, WParam, LParam); - inherited WndProc(Mesg); - Result := Mesg.Result; + Result := BaseWndProc(Msg, WParam, LCLType.LPARAM(LParam)); end; function TJvExSplitter.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer; diff --git a/components/jvcllaz/run/JvCore/jvjclutils.pas b/components/jvcllaz/run/JvCore/jvjclutils.pas index 183ca09ea..36f43db49 100644 --- a/components/jvcllaz/run/JvCore/jvjclutils.pas +++ b/components/jvcllaz/run/JvCore/jvjclutils.pas @@ -1234,12 +1234,14 @@ type property OnChange: TIntegerListChange read FOnChange write FOnChange; end; +***************************) type TCollectionSortProc = function(Item1, Item2: TCollectionItem): Integer; procedure CollectionSort(Collection: Classes.TCollection; SortProc: TCollectionSortProc); +(********************* NOT CONVERTED {$IFDEF COMPILER5} function SecondsBetween(const Now: TDateTime; const FTime: TDateTime): Integer; {$ENDIF COMPILER5} @@ -9851,6 +9853,8 @@ end; {$ENDIF COMPILER5} {$ENDIF !BCB} +**********************) + procedure CollectionQuickSort(List: Classes.TCollection; L, R: Integer; SortProc: TCollectionSortProc); var I, J, pix: Integer; @@ -9902,6 +9906,7 @@ begin CollectionQuickSort(Collection, 0, Collection.Count - 1, SortProc); end; +(********************* NOT CONVERTED {$IFDEF COMPILER5} function SecondsBetween(const Now: TDateTime; const FTime: TDateTime): Integer; begin diff --git a/components/jvcllaz/run/JvCore/jvtypes.pas b/components/jvcllaz/run/JvCore/jvtypes.pas index 3806f8667..2e3f6d896 100644 --- a/components/jvcllaz/run/JvCore/jvtypes.pas +++ b/components/jvcllaz/run/JvCore/jvtypes.pas @@ -104,14 +104,19 @@ type // Base class for persistent properties that can show events. // By default, Delphi and BCB don't show the events of a class // derived from TPersistent unless it also derives from - // TComponent. However, up until version 5, you couldn't have - // a Component as a Sub Component of another one, thus preventing - // from having events for a sub property. + // TComponent. // The design time editor associated with TJvPersistent will display // the events, thus mimicking a Sub Component. TJvPersistent = class(TComponent) + private + FOwner: TPersistent; + function _GetOwner: TPersistent; + protected + function GetOwner: TPersistent; override; public - constructor Create(AOwner: TComponent); override; + constructor Create(AOwner: TPersistent); reintroduce; virtual; + function GetNamePath: string; override; + property Owner: TPersistent read _GetOwner; end; // Added by dejoy (2005-04-20) @@ -120,13 +125,13 @@ type // and property change notify. TJvPropertyChangeEvent = procedure(Sender: TObject; const PropName: string) of object; - TJvPersistentProperty = class(TPersistent) // ?? TJvPersistent) + TJvPersistentProperty = class(TJvPersistent) private FUpdateCount: Integer; FOnChanging: TNotifyEvent; - FOnChange: TNotifyEvent; + FOnChanged: TNotifyEvent; FOnChangingProperty: TJvPropertyChangeEvent; - FOnChangeProperty: TJvPropertyChangeEvent; + FOnChangedProperty: TJvPropertyChangeEvent; protected procedure Changed; virtual; procedure Changing; virtual; @@ -137,9 +142,9 @@ type public procedure BeginUpdate; virtual; procedure EndUpdate; virtual; - property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; - property OnChangeProperty: TJvPropertyChangeEvent read FOnChangeProperty write FOnChangeProperty; + property OnChangedProperty: TJvPropertyChangeEvent read FOnChangedProperty write FOnChangedProperty; property OnChangingProperty: TJvPropertyChangeEvent read FOnChangingProperty write FOnChangingProperty; end; @@ -351,8 +356,8 @@ const CenturyOffset: Byte = 60; NullDate: TDateTime = 0; {-693594} -(*********** NOT CONVERTED type +(*********** NOT CONVERTED // JvDriveCtrls / JvLookOut TJvImageSize = (isSmall, isLarge); TJvImageAlign = (iaLeft, iaCentered); @@ -361,8 +366,7 @@ type TJvDriveTypes = set of TJvDriveType; ********************) -type - // Defines how a property (like a HotTrackFont) follows changes in the component's normal Font +// Defines how a property (like a HotTrackFont) follows changes in the component's normal Font TJvTrackFontOption = ( hoFollowFont, // makes HotTrackFont follow changes to the normal Font hoPreserveCharSet, // don't change HotTrackFont.Charset @@ -370,11 +374,16 @@ type hoPreserveHeight, // don't change HotTrackFont.Height (affects Size as well) hoPreserveName, // don't change HotTrackFont.Name hoPreservePitch, // don't change HotTrackFont.Pitch - hoPreserveStyle); // don't change HotTrackFont.Style + hoPreserveStyle, // don't change HotTrackFont.Style + hoPreserveOrientation, // don't change HotTrackFont.Orientation + hoPreserveQuality // don't change HotTrackFont.Quality + ); TJvTrackFontOptions = set of TJvTrackFontOption; const DefaultTrackFontOptions = [hoFollowFont, hoPreserveColor, hoPreserveStyle]; + DefaultHotTrackColor = $00D2BDB6; + DefaultHotTrackFrameColor = $006A240A; (******************** type @@ -685,14 +694,52 @@ type implementation -constructor TJvPersistent.Create(AOwner: TComponent); -begin - inherited Create(AOwner); +{ TJvPersistent } +constructor TJvPersistent.Create(AOwner: TPersistent); +begin + if AOwner is TComponent then + inherited Create(AOwner as TComponent) + else + inherited Create(nil); SetSubComponent(True); - Name := 'SubComponent'; + + FOwner := AOwner; end; +type + TPersistentAccessProtected = class(TPersistent); + +function TJvPersistent.GetNamePath: string; +var + S: string; + lOwner: TPersistent; +begin + Result := inherited GetNamePath; + lOwner := GetOwner; //Resturn Nested NamePath + if (lOwner <> nil) + and ( (csSubComponent in TComponent(lOwner).ComponentStyle) + or (TPersistentAccessProtected(lOwner).GetOwner <> nil) + ) + then + begin + S := lOwner.GetNamePath; + if S <> '' then + Result := S + '.' + Result; + end; +end; + +function TJvPersistent.GetOwner: TPersistent; +begin + Result := FOwner; +end; + +function TJvPersistent._GetOwner: TPersistent; +begin + Result := GetOwner; +end; + + { TJvPersistentProperty } procedure TJvPersistentProperty.BeginUpdate; @@ -704,14 +751,14 @@ end; procedure TJvPersistentProperty.Changed; begin - if (FUpdateCount = 0) and Assigned(FOnChange) then - FOnChange(Self); + if (FUpdateCount = 0) and Assigned(FOnChanged) then + FOnChanged(Self); end; procedure TJvPersistentProperty.ChangedProperty(const PropName: string); begin - if Assigned(FOnChangeProperty) then - FOnChangeProperty(Self, PropName); + if Assigned(FOnChangedProperty) then + FOnChangedProperty(Self, PropName); end; procedure TJvPersistentProperty.Changing; diff --git a/components/jvcllaz/run/JvStdCtrls/jvhottrackpersistent.pas b/components/jvcllaz/run/JvStdCtrls/jvhottrackpersistent.pas new file mode 100644 index 000000000..7821c8e5e --- /dev/null +++ b/components/jvcllaz/run/JvStdCtrls/jvhottrackpersistent.pas @@ -0,0 +1,335 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvButtonPersistent.PAS, released on 2007-11-20. + +The Initial Developer of the Original Code is dejoy den [dejoybbs att gmail dott com] +All Rights Reserved. + +Contributor(s): dejoy. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvHotTrackPersistent; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, Graphics, + JvTypes; + +type + TJvHotTrackOptionsClass = class of TJvHotTrackOptions; + + TJvHotTrackOptions = class(TJvPersistentProperty) + private + FEnabled: Boolean; + FFrameVisible: Boolean; + FColor: TColor; + FFrameColor: TColor; + procedure SetColor(Value: TColor); + procedure SetEnabled(Value: Boolean); + procedure SetFrameColor(Value: TColor); + procedure SetFrameVisible(Value: Boolean); + public + constructor Create(AOwner: TPersistent); override; + procedure Assign(Source: TPersistent); override; + published + property Enabled: Boolean read FEnabled write SetEnabled default False; + property Color: TColor read FColor write SetColor default DefaultHotTrackColor; + property FrameVisible: Boolean read FFrameVisible write SetFrameVisible default False; + property FrameColor: TColor read FFrameColor write SetFrameColor default DefaultHotTrackFrameColor; + end; + + { IJvHotTrack specifies whether Controls are highlighted when the mouse passes over them } + IJvHotTrack = interface + ['{8F1B40FB-D8E3-46FE-A7A3-21CE4B199A8F}'] + + function GetHotTrack: Boolean; + function GetHotTrackFont: TFont; + function GetHotTrackFontOptions: TJvTrackFontOptions; + function GetHotTrackOptions: TJvHotTrackOptions; + + procedure SetHotTrack(Value: Boolean); + procedure SetHotTrackFont(Value: TFont); + procedure SetHotTrackFontOptions(Value: TJvTrackFontOptions); + procedure SetHotTrackOptions(Value: TJvHotTrackOptions); + procedure Assign(Source: IJvHotTrack); + + property HotTrack: Boolean read GetHotTrack write SetHotTrack; + property HotTrackFont: TFont read GetHotTrackFont write SetHotTrackFont; + property HotTrackFontOptions: TJvTrackFontOptions read GetHotTrackFontOptions write SetHotTrackFontOptions; + property HotTrackOptions: TJvHotTrackOptions read GetHotTrackOptions write SetHotTrackOptions; + end; + + TJvCustomHotTrackPersistent = class(TJvPersistentProperty, IJvHotTrack) + private + FHotTrack: Boolean; + FHotTrackFont: TFont; + FHotTrackFontOptions: TJvTrackFontOptions; + FHotTrackOptions:TJvHotTrackOptions; + + {IJvHotTrack} + function GetHotTrack: Boolean; + function GetHotTrackFont: TFont; + function GetHotTrackFontOptions: TJvTrackFontOptions; + function GetHotTrackOptions: TJvHotTrackOptions; + procedure SetHotTrack(Value: Boolean); + procedure SetHotTrackFont(Value: TFont); + procedure SetHotTrackFontOptions(Value: TJvTrackFontOptions); + procedure SetHotTrackOptions(Value: TJvHotTrackOptions); + + procedure IJvHotTrack_Assign(Source: IJvHotTrack); + procedure IJvHotTrack.Assign = IJvHotTrack_Assign; + protected + class function GetHotTrackOptionsClass: TJvHotTrackOptionsClass; virtual; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TPersistent); override; + destructor Destroy; override; + + procedure Assign(Source: TPersistent); override; + + property HotTrack: Boolean read GetHotTrack write SetHotTrack default False; + property HotTrackFont: TFont read GetHotTrackFont write SetHotTrackFont; + property HotTrackFontOptions: TJvTrackFontOptions read GetHotTrackFontOptions write SetHotTrackFontOptions + default DefaultTrackFontOptions; + property HotTrackOptions: TJvHotTrackOptions read GetHotTrackOptions write SetHotTrackOptions; + end; + + TJvHotTrackPersistent = class(TJvCustomHotTrackPersistent) + published + property HotTrack; + property HotTrackFont; + property HotTrackFontOptions; + property HotTrackOptions; + end; + + +implementation + +uses + SysUtils; + + +{ TJvHotTrackOptions } + +constructor TJvHotTrackOptions.Create(AOwner: TPersistent); +begin + inherited ; + FEnabled := False; + FFrameVisible := False; + FColor := DefaultHotTrackColor; + FFrameColor := DefaultHotTrackFrameColor; +end; + +procedure TJvHotTrackOptions.Assign(Source: TPersistent); +begin + if Source is TJvHotTrackOptions then + begin + BeginUpdate; + try + Enabled := TJvHotTrackOptions(Source).Enabled; + Color := TJvHotTrackOptions(Source).Color; + FrameVisible := TJvHotTrackOptions(Source).FrameVisible; + FrameColor := TJvHotTrackOptions(Source).FrameColor; + finally + EndUpdate; + end; + end + else + inherited Assign(Source); +end; + +procedure TJvHotTrackOptions.SetColor(Value: TColor); +begin + if FColor <> Value then + begin + Changing; + ChangingProperty('Color'); + FColor := Value; + ChangedProperty('Color'); + Changed; + end; +end; + +procedure TJvHotTrackOptions.SetEnabled(Value: Boolean); +begin + if FEnabled <> Value then + begin + Changing; + ChangingProperty('Enabled'); + FEnabled := Value; + ChangedProperty('Enabled'); + Changed; + end; +end; + +procedure TJvHotTrackOptions.SetFrameVisible(Value: Boolean); +begin + if FFrameVisible <> Value then + begin + Changing; + ChangingProperty('FrameVisible'); + FFrameVisible := Value; + ChangedProperty('FrameVisible'); + Changed; + end; +end; + +procedure TJvHotTrackOptions.SetFrameColor(Value: TColor); +begin + if FFrameColor <> Value then + begin + Changing; + ChangingProperty('FrameColor'); + FFrameColor := Value; + ChangedProperty('FrameColor'); + Changed; + end; +end; + + +{ TJvCustomHotTrackPersistent } + +constructor TJvCustomHotTrackPersistent.Create(AOwner: TPersistent); +begin + inherited Create(AOwner); + + FHotTrack := False; + FHotTrackFont := TFont.Create; + FHotTrackFontOptions := DefaultTrackFontOptions; + FHotTrackOptions :=GetHotTrackOptionsClass.Create(Self); +end; + +destructor TJvCustomHotTrackPersistent.Destroy; +begin + FHotTrackFont.Free; + FHotTrackOptions.Free; + inherited Destroy; +end; + +class function TJvCustomHotTrackPersistent.GetHotTrackOptionsClass: TJvHotTrackOptionsClass; +begin + Result := TJvHotTrackOptions; +end; + +procedure TJvCustomHotTrackPersistent.Assign(Source: TPersistent); +var + Intf: IJvHotTrack; +begin + if Supports(Source, IJvHotTrack, Intf) then + IJvHotTrack(Self).Assign(Intf) + else + inherited Assign(Source); +end; + +procedure TJvCustomHotTrackPersistent.AssignTo(Dest: TPersistent); +var + Intf: IJvHotTrack; +begin + if Supports(Dest, IJvHotTrack, Intf) then + Intf.Assign(Self) + else + inherited AssignTo(Dest); +end; + +procedure TJvCustomHotTrackPersistent.SetHotTrackFont(Value: TFont); +begin + if (FHotTrackFont<>Value) and (Value <> nil) then + begin + Changing; + ChangingProperty('HotTrackFont'); + FHotTrackFont.Assign(Value); + ChangedProperty('HotTrackFont'); + Changed; + end; +end; + +procedure TJvCustomHotTrackPersistent.SetHotTrack(Value: Boolean); +begin + if FHotTrack <> Value then + begin + Changing; + ChangingProperty('HotTrack'); + FHotTrack := Value; + ChangedProperty('HotTrack'); + Changed; + end; +end; + +procedure TJvCustomHotTrackPersistent.SetHotTrackFontOptions(Value: TJvTrackFontOptions); +begin + if FHotTrackFontOptions <> Value then + begin + Changing; + ChangingProperty('HotTrackFontOptions'); + FHotTrackFontOptions := Value; + ChangedProperty('HotTrackFontOptions'); + Changed; + end; +end; + +function TJvCustomHotTrackPersistent.GetHotTrack: Boolean; +begin + Result := FHotTrack; +end; + +function TJvCustomHotTrackPersistent.GetHotTrackFont: TFont; +begin + Result := FHotTrackFont; +end; + +function TJvCustomHotTrackPersistent.GetHotTrackFontOptions: TJvTrackFontOptions; +begin + Result := FHotTrackFontOptions; +end; + +function TJvCustomHotTrackPersistent.GetHotTrackOptions: TJvHotTrackOptions; +begin + Result := FHotTrackOptions; +end; + +procedure TJvCustomHotTrackPersistent.SetHotTrackOptions(Value: TJvHotTrackOptions); +begin + if (FHotTrackOptions <> Value) and (Value <> nil) then + begin + Changing; + ChangingProperty('HotTrackOptions'); + FHotTrackOptions.Assign(Value); + ChangedProperty('HotTrackOptions'); + Changed; + end; +end; + +procedure TJvCustomHotTrackPersistent.IJvHotTrack_Assign(Source: IJvHotTrack); +begin + if (Source <> nil) and (IJvHotTrack(Self) <> Source) then + begin + BeginUpdate; + try + HotTrack := Source.HotTrack; + HotTrackFont := Source.HotTrackFont; + HotTrackFontOptions := Source.HotTrackFontOptions; + HotTrackOptions := Source.HotTrackOptions; + finally + EndUpdate; + end; + end; +end; + +end. diff --git a/components/jvcllaz/run/JvStdCtrls/jvpanel.pas b/components/jvcllaz/run/JvStdCtrls/jvpanel.pas new file mode 100644 index 000000000..3690b7182 --- /dev/null +++ b/components/jvcllaz/run/JvStdCtrls/jvpanel.pas @@ -0,0 +1,1604 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvPanel.pas, released on 2001-02-28. + +The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com] +Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse. +All Rights Reserved. + +Contributor(s): +Michael Beck [mbeck att bigfoot dott com]. +pongtawat +Peter Thornqvist [peter3 at sourceforge dot net] +Jens Fudickar [jens dott fudickar att oratool dott de] +dejoy den [dejoy att ynl dott gov dott cn] + +Changes: + +>> dejoy --2005-04-28 + - Change TJvArrangeSettings to inherited from TJvPersistentProperty. + - TJvCustomArrangePanel implemented interface of IJvHotTrack. + - Renamed HotColor property to HotTrackOptions.Color. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvPanel; + +{$mode objfpc}{$H+} + +interface + +uses + LCLType, LCLIntf, LMessages, Types, + SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, + JvTypes, JvExtComponent, JvExControls, JvHotTrackPersistent; + +type + TJvPanelResizeParentEvent = procedure(Sender: TObject; nLeft, nTop, nWidth, nHeight: Integer) of object; + TJvPanelChangedSizeEvent = procedure(Sender: TObject; ChangedSize: Integer) of object; + TJvAutoSizePanel = (asNone, asWidth, asHeight, asBoth); + TJvArrangeSettingsVAlignment = (asTop, asVCenter, asBottom); + TJvArrangeSettingsHAlignment = (asLeft, asCenter, asRight); + + TJvArrangeSettings = class(TJvPersistentProperty) + private + FAutoArrange: Boolean; + FAutoSize: TJvAutoSizePanel; + FWrapControls: Boolean; + FBorderLeft: Integer; + FBorderTop: Integer; + FDistanceVertical: Integer; + FDistanceHorizontal: Integer; + FShowNotVisibleAtDesignTime: Boolean; + FMaxWidth: Integer; + FVerticalAlignment: TJvArrangeSettingsVAlignment; + FHorizontalAlignment: TJvArrangeSettingsHAlignment; + FMaxControlsPerLine: Integer; + FHorizontalAlignLines: Boolean; + procedure SetWrapControls(Value: Boolean); + procedure SetAutoArrange(Value: Boolean); + procedure SetAutoSize(Value: TJvAutoSizePanel); + procedure SetBorderLeft(Value: Integer); + procedure SetBorderTop(Value: Integer); + procedure SetDistanceVertical(Value: Integer); + procedure SetDistanceHorizontal(Value: Integer); + procedure SetMaxWidth(Value: Integer); + procedure SetHorizontalAlignment(const Value: TJvArrangeSettingsHAlignment); + procedure SetVerticalAlignment(const Value: TJvArrangeSettingsVAlignment); + procedure SetMaxControlsPerLine(const Value: Integer); + procedure SetHorizontalAlignLines(const Value: Boolean); + public + constructor Create(AOwner: TPersistent); override; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + published + property WrapControls: Boolean read FWrapControls write SetWrapControls default True; + property BorderLeft: Integer read FBorderLeft write SetBorderLeft default 0; + property BorderTop: Integer read FBorderTop write SetBorderTop default 0; + property DistanceVertical: Integer read FDistanceVertical write SetDistanceVertical default 0; + property DistanceHorizontal: Integer read FDistanceHorizontal write SetDistanceHorizontal default 0; + property ShowNotVisibleAtDesignTime: Boolean read FShowNotVisibleAtDesignTime write FShowNotVisibleAtDesignTime default True; + property AutoSize: TJvAutoSizePanel read FAutoSize write SetAutoSize default asNone; + property AutoArrange: Boolean read FAutoArrange write SetAutoArrange default False; + property MaxWidth: Integer read FMaxWidth write SetMaxWidth default 0; + { MaxControlsPerLine specifies the max. number of controls that fit into a line. The following + controls are moved to the next line. A value of zero means no limit. WrapControls is still + considered. } + property MaxControlsPerLine: Integer read FMaxControlsPerLine write SetMaxControlsPerLine default 0; + { VerticalAlignment aligns the arranged control-block. in the panel unless AutoSize is asBoth or asHeight. } + property VerticalAlignment: TJvArrangeSettingsVAlignment read FVerticalAlignment write SetVerticalAlignment default asTop; + { HorizontalAlignment aligns the arranged control-block in the panel unless AutoSize is asBoth or asWidth. } + property HorizontalAlignment: TJvArrangeSettingsHAlignment read FHorizontalAlignment write SetHorizontalAlignment default asLeft; + { HorizontalAlignLines aligns the control-lines. This only works if WrapControls or MaxControlsPerLine is enabled } + property HorizontalAlignLines: Boolean read FHorizontalAlignLines write SetHorizontalAlignLines default False; + end; + + IJvArrangePanel = interface + ['{8EE63749-CDDC-4436-9067-4EF0434B43C2}'] + procedure ArrangeControls; + procedure DisableArrange; + procedure EnableArrange; + function GetArrangeSettings: TJvArrangeSettings; + procedure SetArrangeSettings(const Value: TJvArrangeSettings); + property ArrangeSettings: TJvArrangeSettings read GetArrangeSettings write SetArrangeSettings; + end; + + TJvPanelHotTrackOptions = class(TJvHotTrackOptions) + public + constructor Create(AOwner: TPersistent); override; + published + property Color default clBtnFace; + end; + + TJvPanelMoveEvent = procedure(Sender: TObject; X, Y: Integer; var Allow: Boolean) of object; + + TJvCustomArrangePanel = class(TJvCustomPanel, IJvHotTrack, IJvArrangePanel) //, IJvDenySubClassing, IJvHotTrack, IJvArrangePanel) + private + FTransparent: Boolean; + FFlatBorder: Boolean; + FFlatBorderColor: TColor; + FMultiLine: Boolean; + FSizeable: Boolean; + FDragging: Boolean; + FLastPos: TPoint; + FEnableArrangeCount: Integer; + FArrangeControlActive: Boolean; + FArrangeWidth: Integer; + FArrangeHeight: Integer; + FArrangeSettings: TJvArrangeSettings; + FOnResizeParent: TJvPanelResizeParentEvent; + FOnChangedWidth: TJvPanelChangedSizeEvent; + FOnChangedHeight: TJvPanelChangedSizeEvent; + FOnPaint: TNotifyEvent; + FMovable: Boolean; + FWasMoved: Boolean; + FOnAfterMove: TNotifyEvent; + FOnBeforeMove: TJvPanelMoveEvent; + FHotTrack: Boolean; + FHotTrackFont: TFont; + FHotTrackFontOptions: TJvTrackFontOptions; + FHotTrackOptions: TJvHotTrackOptions; + FLastScreenCursor: TCursor; + FLastBoundsRect: TRect; + FPainting: Integer; + FLayout: TTextLayout; + function GetArrangeSettings: TJvArrangeSettings; + function GetHeight: Integer; + procedure SetHeight(Value: Integer); + function GetWidth: Integer; + procedure SetWidth(Value: Integer); + procedure SetArrangeSettings(const Value: TJvArrangeSettings); + (******************** NOT CONVERTED **** + procedure SetTransparent(const Value: Boolean); + ***************************************) + procedure SetFlatBorder(const Value: Boolean); + procedure SetFlatBorderColor(const Value: TColor); + procedure SetLayout(const Value: TTextLayout); + procedure SetMultiLine(const Value: Boolean); + procedure SetSizeable(const Value: Boolean); + + {IJvHotTrack} //added by dejoy 2005-04-28 + function GetHotTrack: Boolean; + function GetHotTrackFont: TFont; + function GetHotTrackFontOptions: TJvTrackFontOptions; + function GetHotTrackOptions: TJvHotTrackOptions; + procedure SetHotTrack(Value: Boolean); + procedure SetHotTrackFont(Value: TFont); + procedure SetHotTrackFontOptions(Value: TJvTrackFontOptions); + procedure SetHotTrackOptions(Value: TJvHotTrackOptions); + procedure IJvHotTrack_Assign(Source: IJvHotTrack); + procedure IJvHotTrack.Assign = IJvHotTrack_Assign; + function IsHotTrackFontStored: Boolean; + protected + procedure DrawCaption; dynamic; + procedure DrawCaptionTo(ACanvas: TCanvas ); dynamic; + procedure DrawBorders; dynamic; + + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + (************************* NOT CONVERTED **** + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure ParentColorChanged; override; + ********************************************) + procedure TextChanged; override; + procedure Paint; override; + function DoEraseBackground(ACanvas: TCanvas; AParam: LPARAM): Boolean; override; + procedure CreateParams(var Params: TCreateParams); override; + procedure WMNCHitTest(var Msg: TLMNCHitTest); message LM_NCHITTEST; + (************** NOT CONVERTED *** + procedure WMExitSizeMove(var Msg: TLMessage); message LM_EXITSIZEMOVE; + ********************************) + function DoBeforeMove(X, Y: Integer): Boolean; dynamic; + procedure DoAfterMove; dynamic; + procedure Loaded; override; + procedure Resize; override; + procedure Rearrange; + procedure DoArrangeSettingsPropertyChanged(Sender: TObject; const PropName: string); virtual; + procedure AlignControls(AControl: TControl; var Rect: TRect); override; + function GetNextControlByTabOrder(ATabOrder: Integer): TWinControl; + procedure SetSizeableCursor; + procedure RestoreSizeableCursor; + function GetControlSize(Control: TControl): TSize; + procedure SetControlBounds(Control: TControl; const R: TRect); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; + procedure ArrangeControls; + procedure EnableArrange; + procedure DisableArrange; + function ArrangeEnabled: Boolean; + property ArrangeWidth: Integer read FArrangeWidth; + property ArrangeHeight: Integer read FArrangeHeight; + property DockManager; + property Canvas; + + property HotTrack: Boolean read GetHotTrack write SetHotTrack default False; + property HotTrackFont: TFont read GetHotTrackFont write SetHotTrackFont stored IsHotTrackFontStored; + property HotTrackFontOptions: TJvTrackFontOptions read GetHotTrackFontOptions write SetHotTrackFontOptions default + DefaultTrackFontOptions; + property HotTrackOptions: TJvHotTrackOptions read GetHotTrackOptions write SetHotTrackOptions; + + property Layout: TTextLayout read FLayout write SetLayout default tlCenter; + property Movable: Boolean read FMovable write FMovable default False; + property Sizeable: Boolean read FSizeable write SetSizeable default False; + (*************** NOT CONVERTED *** + property Transparent: Boolean read FTransparent write SetTransparent default False; + *********************************) + property MultiLine: Boolean read FMultiLine write SetMultiLine default False; + //FlatBorder used the BorderWidth to draw the border + property FlatBorder: Boolean read FFlatBorder write SetFlatBorder default False; + property FlatBorderColor: TColor read FFlatBorderColor write SetFlatBorderColor default clBtnShadow; + property OnBeforeMove: TJvPanelMoveEvent read FOnBeforeMove write FOnBeforeMove; + property OnAfterMove: TNotifyEvent Read FOnAfterMove write FOnAfterMove; + property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; + + property ArrangeSettings: TJvArrangeSettings read GetArrangeSettings write SetArrangeSettings; + property Width: Integer read GetWidth write SetWidth; + property Height: Integer read GetHeight write SetHeight; + property OnResizeParent: TJvPanelResizeParentEvent read FOnResizeParent write FOnResizeParent; + property OnChangedWidth: TJvPanelChangedSizeEvent read FOnChangedWidth write FOnChangedWidth; + property OnChangedHeight: TJvPanelChangedSizeEvent read FOnChangedHeight write FOnChangedHeight; + end; + + TJvPanel = class(TJvCustomArrangePanel) + private + FFilerTag: string; + procedure ReadData(Reader: TReader); + protected + procedure DefineProperties(Filer: TFiler); override; + published + property HotTrack; + property HotTrackFont; + property HotTrackFontOptions; + property HotTrackOptions; + property Layout; + property Movable; + property Sizeable; + (******************** NOT CONVERTED *** + property HintColor; + property Transparent; + **************************************) + property MultiLine; + property FlatBorder; + property FlatBorderColor; + property OnMouseEnter; + property OnMouseLeave; + property OnBeforeMove; + property OnAfterMove; + (********************** NOT CONVERTED *** + property OnParentColorChange; + ****************************************) + property OnPaint; + + property ArrangeSettings; + property Width; + property Height; + property OnResizeParent; + property OnChangedWidth; + property OnChangedHeight; + + property Align; + property Alignment; + property Anchors; + property AutoSize; + property BiDiMode; + property UseDockManager default True; + property DockSite; + property DragCursor; + property DragKind; + property FullRepaint; + (************************** NOT CONVERTED **** + property Locked; + *********************************************) + property ParentBiDiMode; + (************************* NOT CONVERTED *** + property OnCanResize; + *******************************************) + property OnDockDrop; + property OnDockOver; + property OnEndDock; + property OnGetSiteInfo; + property OnStartDock; + property OnUnDock; + // property BevelEdges; + property BevelInner; + property BevelOuter; + property BevelWidth; + property BorderSpacing; + property BorderWidth; + property BorderStyle; + property Caption; + property Color; + property Constraints; + property DoubleBuffered; + property DragMode; + property Enabled; + property Font; + {$IFDEF DELPHI2006_UP} + property Padding; + {$ENDIF DELPHI2006_UP} + {$IFDEF JVCLThemesEnabled} + property ParentBackground default True; + {$ENDIF JVCLThemesEnabled} + property ParentColor; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + {$IFDEF DELPHI2010_UP} + property Touch; + {$ENDIF DELPHI2010_UP} + property Visible; + property OnClick; + property OnConstrainedResize; + property OnContextPopup; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnResize; + property OnStartDrag; + end; + + +implementation + +uses + JvThemes, JvJCLUtils, JvJVCLUtils, JvResources; + +const + BkModeTransparent = TRANSPARENT; + + +{ TJvArrangeSettings } + +constructor TJvArrangeSettings.Create(AOwner: TPersistent); +begin + inherited Create(AOwner); + FMaxWidth := 0; + FBorderLeft := 0; + FBorderTop := 0; + FDistanceVertical := 0; + FDistanceHorizontal := 0; + FMaxControlsPerLine := 0; + FWrapControls := True; + FShowNotVisibleAtDesignTime := True; + FAutoSize := asNone; + AutoArrange := False; +end; + +destructor TJvArrangeSettings.Destroy; +begin + if (GetOwner is TJvPanel) and not (csDestroying in TJvPanel(GetOwner).ComponentState) then + begin + // User code tried to destroy the TJvPanel.ArrangeSettings + // objects leaving the panel in a broken state. Please fix your code by adding + // + // if not ((Components[I] is TJvArrangeSettings) or + // (Components[I] is TJvPanelHotTrackOptions)) then + // + // or by using the Controls[] array property if possible. + + raise EJVCLException.CreateRes(@RsDestroyingArrangeSettingsNotAllowed); + end; + inherited Destroy; +end; + +procedure TJvArrangeSettings.SetWrapControls(Value: Boolean); +begin + + if Value <> FWrapControls then + begin + Changing; + ChangingProperty('WrapControls'); + FWrapControls := Value; + ChangedProperty('WrapControls'); + Changed; + end; +end; + +procedure TJvArrangeSettings.SetAutoArrange(Value: Boolean); +begin + if Value <> FAutoArrange then + begin + Changing; + ChangingProperty('AutoArrange'); + FAutoArrange := Value; + ChangedProperty('AutoArrange'); + Changed; + end; +end; + +procedure TJvArrangeSettings.SetAutoSize(Value: TJvAutoSizePanel); +begin + if Value <> FAutoSize then + begin + Changing; + ChangingProperty('AutoSize'); + FAutoSize := Value; + ChangedProperty('AutoSize'); + Changed; + end; +end; + +procedure TJvArrangeSettings.SetBorderLeft(Value: Integer); +begin + if Value <> FBorderLeft then + begin + Changing; + ChangingProperty('BorderLeft'); + FBorderLeft := Value; + ChangedProperty('BorderLeft'); + Changed; + end; +end; + +procedure TJvArrangeSettings.SetBorderTop(Value: Integer); +begin + if Value <> FBorderTop then + begin + Changing; + ChangingProperty('BorderTop'); + FBorderTop := Value; + ChangedProperty('BorderTop'); + Changed; + end; +end; + +procedure TJvArrangeSettings.SetMaxControlsPerLine(const Value: Integer); +begin + if Value <> FMaxControlsPerLine then + begin + Changing; + ChangingProperty('MaxControlsPerLine'); + FMaxControlsPerLine := Value; + ChangedProperty('MaxControlsPerLine'); + Changed; + end; +end; + +procedure TJvArrangeSettings.SetDistanceVertical(Value: Integer); +begin + if Value <> FDistanceVertical then + begin + Changing; + ChangingProperty('DistanceVertical'); + FDistanceVertical := Value; + ChangedProperty('DistanceVertical'); + Changed; + end; +end; + +procedure TJvArrangeSettings.SetHorizontalAlignment(const Value: TJvArrangeSettingsHAlignment); +begin + if Value <> FHorizontalAlignment then + begin + Changing; + ChangingProperty('HorizontalAlignment'); + FHorizontalAlignment := Value; + ChangedProperty('HorizontalAlignment'); + Changed; + end; +end; + +procedure TJvArrangeSettings.SetDistanceHorizontal(Value: Integer); +begin + if Value <> FDistanceHorizontal then + begin + Changing; + ChangingProperty('DistanceHorizontal'); + FDistanceHorizontal := Value; + ChangedProperty('DistanceHorizontal'); + Changed; + end; +end; + +procedure TJvArrangeSettings.SetMaxWidth(Value: Integer); +begin + if Value <> FMaxWidth then + begin + Changing; + ChangingProperty('MaxWidth'); + FMaxWidth := Value; + ChangedProperty('MaxWidth'); + Changed; + end; +end; + +procedure TJvArrangeSettings.SetHorizontalAlignLines(const Value: Boolean); +begin + if Value <> FHorizontalAlignLines then + begin + Changing; + ChangingProperty('HorizontalAlignLines'); + FHorizontalAlignLines := Value; + ChangedProperty('HorizontalAlignLines'); + Changed; + end; +end; + +procedure TJvArrangeSettings.SetVerticalAlignment(const Value: TJvArrangeSettingsVAlignment); +begin + if Value <> FVerticalAlignment then + begin + Changing; + ChangingProperty('VerticalAlignment'); + FVerticalAlignment := Value; + ChangedProperty('VerticalAlignment'); + Changed; + end; +end; + +procedure TJvArrangeSettings.Assign(Source: TPersistent); +var + A: TJvArrangeSettings; +begin + if Source is TJvArrangeSettings then + begin + BeginUpdate; + try + A := TJvArrangeSettings(Source); + AutoArrange := A.AutoArrange; + AutoSize := A.AutoSize; + WrapControls := A.WrapControls; + BorderLeft := A.BorderLeft; + BorderTop := A.BorderTop; + DistanceVertical := A.DistanceVertical; + DistanceHorizontal := A.DistanceHorizontal; + ShowNotVisibleAtDesignTime := A.ShowNotVisibleAtDesignTime; + MaxWidth := A.MaxWidth; + MaxControlsPerLine := A.MaxControlsPerLine; + VerticalAlignment := A.VerticalAlignment; + HorizontalAlignment := A.HorizontalAlignment; + HorizontalAlignLines := A.HorizontalAlignLines; + finally + EndUpdate; + end; + end + else + inherited Assign(Source); +end; + + +{ TJvPanelHotTrackOptions } + +constructor TJvPanelHotTrackOptions.Create(AOwner: TPersistent); +begin + inherited; + Color := clBtnFace; +end; + + +{ TJvCustomArrangePanel } + +constructor TJvCustomArrangePanel.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + IncludeThemeStyle(Self, [csNeedsBorderPaint, csParentBackground]); + ControlStyle := ControlStyle - [csSetCaption]; + FMultiLine := False; + FTransparent := False; + FFlatBorder := False; + FFlatBorderColor := clBtnShadow; + FHotTrack := False; + FHotTrackFont := TFont.Create; + FHotTrackFontOptions := DefaultTrackFontOptions; + FHotTrackOptions := TJvPanelHotTrackOptions.Create(Self); + FArrangeSettings := TJvArrangeSettings.Create(Self); // "Self" is a must, otherwise the ObjectInspector has problems + FArrangeSettings.OnChangedProperty := @DoArrangeSettingsPropertyChanged; + FLastBoundsRect.Left := -1; + FLayout := tlCenter; +end; + +destructor TJvCustomArrangePanel.Destroy; +begin + inherited Destroy; + FreeAndNil(FHotTrackFont); +end; + +procedure TJvCustomArrangePanel.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + if FTransparent then + begin + Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT; + ControlStyle := ControlStyle - [csOpaque]; + end + else + begin + Params.ExStyle := Params.ExStyle and not WS_EX_TRANSPARENT; + ControlStyle := ControlStyle + [csOpaque]; + end; +end; + +procedure TJvCustomArrangePanel.WMNCHitTest(var Msg: TLMNCHitTest); +var + P: TPoint; +begin + inherited; + if not (csDesigning in ComponentState) and Movable then + begin + P := ScreenToClient(SmallPointToPoint(Msg.Pos)); + if (P.X > 5) and (P.Y > 5) and (P.X < Width - 5) and (P.Y < Height - 5) and DoBeforeMove(P.X,P.Y) then + begin + Msg.Result := HTCAPTION; + FWasMoved := True; + end; + end; +end; + +(****************************** NOT CONVERTED **** +procedure TJvCustomArrangePanel.WMExitSizeMove(var Msg: TLMessage); +begin + inherited; + if not (csDesigning in ComponentState) then + begin + if FWasMoved then + DoAfterMove; + FWasMoved := False; + end; +end; +*************************************************) + +function TJvCustomArrangePanel.DoBeforeMove(X,Y: Integer): Boolean; +begin + Result := True; + if Assigned(FOnBeforeMove) then + FOnBeforeMove(Self, X, Y, Result); +end; + +procedure TJvCustomArrangePanel.DoAfterMove; +begin + if Assigned(FOnAfterMove) then + FOnAfterMove(Self); +end; + +procedure TJvCustomArrangePanel.Paint; +var + X, Y: Integer; + R: TRect; + OldPenColor:TColor; + OldPenWidth: Integer; + ControlIndex: Integer; + CurControl: TControl; +begin + if Assigned(FOnPaint) then + begin + FOnPaint(Self); + Exit; + end; + + Inc(FPainting); + try + // must force child controls to redraw completely, even their non client areas (Mantis 4406) + if FTransparent and (FPainting = 1) then + begin + for ControlIndex := 0 to ControlCount - 1 do + begin + CurControl := Controls[ControlIndex]; + if CurControl is TWinControl then + begin + CurControl.Invalidate; + RedrawWindow(TWinControl(CurControl).Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); + // Must update here so that the invalidate message is processed immediately + // If not, there is a very strong risk of creating a refresh loop + CurControl.Update; + end; + end; + end; + + if MouseOver and HotTrack then + begin + Canvas.Font := Self.HotTrackFont; + if HotTrackOptions.Enabled then + begin + Canvas.Brush.Color := HotTrackOptions.Color; + if HotTrackOptions.FrameVisible then + begin + Canvas.Brush.Style := bsSolid; + OldPenColor := Canvas.Pen.Color; + Canvas.Pen.Color := HotTrackOptions.FrameColor; + Canvas.Rectangle(0, 0, Width, Height); + Canvas.Pen.Color := OldPenColor; + end + else + begin + R := ClientRect; + InflateRect(R, -BevelWidth, -BevelWidth); + Canvas.FillRect(R); + end; + end; + end + else + begin + Canvas.Font := Self.Font; + Canvas.Brush.Color := Color; + if not FTransparent then + DrawThemedBackground(Self, Canvas, ClientRect) + else + Canvas.Brush.Style := bsClear; + if FFlatBorder then + begin + if BorderWidth > 0 then + begin + OldPenWidth:= Canvas.Pen.Width; + OldPenColor := Canvas.Pen.Color; + Canvas.Pen.Width := BorderWidth; + Canvas.Pen.Color := FFlatBorderColor; + Canvas.Brush.Style := bsClear; + + R := ClientRect; + X := (BorderWidth div 2); + if Odd(BorderWidth) then + Y := X + else + Y := X - 1; + + Inc(R.Left,X); + Inc(R.Top,X); + Dec(R.Bottom,Y); + Dec(R.Right,Y); + + Canvas.Rectangle(R); + + Canvas.Pen.Width := OldPenWidth; + Canvas.Pen.Color := OldPenColor; + end; + end + else + DrawBorders; + end; + + DrawCaption; + if Sizeable then + begin + {$IFDEF JVCLThemesEnabled} + if StyleServices.Enabled then + StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tsGripper), + Rect(ClientWidth - GetSystemMetrics(SM_CXVSCROLL) - BevelWidth - 2, + ClientHeight - GetSystemMetrics(SM_CYHSCROLL) - BevelWidth - 2, + ClientWidth - BevelWidth - 2, ClientHeight - BevelWidth - 2)) + else + {$ENDIF JVCLThemesEnabled} + begin + Canvas.Font.Name := 'Marlett'; + Canvas.Font.Charset := DEFAULT_CHARSET; + Canvas.Font.Size := 12; + Canvas.Font.Style := []; + Canvas.Brush.Style := bsClear; + X := ClientWidth - GetSystemMetrics(SM_CXVSCROLL) - BevelWidth - 2; + Y := ClientHeight - GetSystemMetrics(SM_CYHSCROLL) - BevelWidth - 2; + // (rom) bsClear takes care of that already + //if Transparent then + // SetBkMode(Handle, BkModeTransparent); + Canvas.Font.Color := clBtnHighlight; + Canvas.TextOut(X, Y, 'o'); + Canvas.Font.Color := clBtnShadow; + Canvas.TextOut(X, Y, 'p'); + end; + end; + finally + Dec(FPainting); + end; +end; + +procedure TJvCustomArrangePanel.DrawBorders; +var + Rect: TRect; + TopColor, BottomColor: TColor; + + procedure AdjustColors(Bevel: TPanelBevel); + begin + TopColor := clBtnHighlight; + if Bevel = bvLowered then + TopColor := clBtnShadow; + BottomColor := clBtnShadow; + if Bevel = bvLowered then + BottomColor := clBtnHighlight; + end; + +begin + Rect := ClientRect; + if BevelOuter <> bvNone then + begin + AdjustColors(BevelOuter); + Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth); + end; + Frame3D(Canvas, Rect, Color, Color, BorderWidth); + if BevelInner <> bvNone then + begin + AdjustColors(BevelInner); + Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth); + end; +end; + +procedure TJvCustomArrangePanel.DrawCaption; +begin + DrawCaptionTo(Self.Canvas); +end; + +procedure TJvCustomArrangePanel.DrawCaptionTo(ACanvas: TCanvas ); +const + ALIGNMENTS: array [TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER); + WORDWRAPS: array [Boolean] of Longint = (DT_SINGLELINE, DT_WORDBREAK); +var + ATextRect: TRect; + BevelSize: Integer; + Flags: Longint; + w, h: Integer; +begin + with ACanvas do + begin + if Caption <> '' then + begin + if (MouseOver or FDragging) and HotTrack then + ACanvas.Font := Self.HotTrackFont + else + ACanvas.Font := Self.Font; + + SetBkMode(Handle, BkModeTransparent); + Font := Self.Font; + ATextRect := GetClientRect; + InflateRect(ATextRect, -BorderWidth, -BorderWidth); + BevelSize := 0; + if BevelOuter <> bvNone then + Inc(BevelSize, BevelWidth); + if BevelInner <> bvNone then + Inc(BevelSize, BevelWidth); + InflateRect(ATextRect, -BevelSize, -BevelSize); + Flags := DT_EXPANDTABS or WORDWRAPS[MultiLine] or ALIGNMENTS[Alignment]; + (*************** NOT CONVERTED *** + Flags := DrawTextBiDiModeFlags(Flags); + *********************************) + + //calculate required rectangle size + DrawText(ACanvas.Handle, PChar(Caption), -1, ATextRect, Flags or DT_CALCRECT); + w := ATextRect.Right - ATextRect.Left; + h := ATextRect.Bottom - ATextRect.Top; + + // adjust the rectangle placement + case FLayout of + tlCenter: + OffsetRect(ATextRect, 0, (Self.Height - h) div 2); + tlBottom: + Offsetrect(ATextRect, 0, Self.Height - BorderWidth - Bevelsize - h); + end; + case Alignment of + taRightJustify: + OffsetRect(ATextRect, Self.Width - BorderWidth - BevelSize - w, 0); + taCenter: + OffsetRect(ATextRect, (Self.Width - w) div 2, 0); + end; + if not Enabled then + Font.Color := clGrayText; + + //draw text + if FTransparent then + SetBkMode(ACanvas.Handle, BkModeTransparent); + DrawText(ACanvas.Handle, PChar(Caption), -1, ATextRect, Flags); + end; + end; +end; + +(******************** NOT CONVERTED **** +procedure TJvCustomArrangePanel.ParentColorChanged; +begin + Invalidate; + inherited ParentColorChanged; +end; +**************************************) + +(********************** NOT CONVERTED **** +procedure TJvCustomArrangePanel.MouseEnter; +var + NeedRepaint: Boolean; + OtherDragging: Boolean; +begin + if csDesigning in ComponentState then + Exit; + + if not MouseOver and Enabled and (Control = nil) then + begin + OtherDragging := Mouse.IsDragging; + NeedRepaint := not Transparent and + ((FHotTrack and Enabled and not FDragging and not OtherDragging)); + inherited MouseEnter(Control); // set MouseOver + if NeedRepaint then + Repaint; + end + else + inherited; +end; + +procedure TJvCustomArrangePanel.MouseLeave; +var + NeedRepaint: Boolean; + OtherDragging:Boolean; +begin + if csDesigning in ComponentState then + Exit; + OtherDragging := Mouse.IsDragging; + if MouseOver and Enabled and (Control = nil) then + begin + NeedRepaint := not Transparent and + ((FHotTrack and (FDragging or (Enabled and not OtherDragging)))); + inherited MouseLeave(Control); // set MouseOver + + if Sizeable then + RestoreSizeableCursor;; + + if NeedRepaint then + Repaint; + end + else + inherited; +end; +**********************************) + +procedure TJvCustomArrangePanel.SetSizeableCursor; +begin + if Screen.Cursor <> crSizeNWSE then + begin + FLastScreenCursor := Screen.Cursor; + Screen.Cursor := crSizeNWSE; + end; +end; + +procedure TJvCustomArrangePanel.RestoreSizeableCursor; +begin + if Screen.Cursor = crSizeNWSE then + Screen.Cursor := FLastScreenCursor; +end; + +function TJvCustomArrangePanel.GetControlSize(Control: TControl): TSize; +begin + {$IFDEF COMPILER10_UP} // Delphi 2006+ + Result.cx := Control.Margins.ControlWidth; + Result.cy := Control.Margins.ControlHeight; + {$ELSE} + Result.cx := Control.Width; + Result.cy := Control.Height; + {$ENDIF COMPILER10_UP} +end; + +procedure TJvCustomArrangePanel.SetControlBounds(Control: TControl; const R: TRect); +begin + {$IFDEF COMPILER10_UP} // Delphi 2006+ + Control.Margins.SetControlBounds(R); + {$ELSE} + Control.BoundsRect := R; + {$ENDIF COMPILER10_UP} +end; + +(********************* NOT CONVERTED *** +procedure TJvCustomArrangePanel.SetTransparent(const Value: Boolean); +begin + if Value <> FTransparent then + begin + FTransparent := Value; + RecreateWnd; + end; +end; +****************************************) + +procedure TJvCustomArrangePanel.SetFlatBorder(const Value: Boolean); +begin + if Value <> FFlatBorder then + begin + FFlatBorder := Value; + Invalidate; + end; +end; + +procedure TJvCustomArrangePanel.SetFlatBorderColor(const Value: TColor); +begin + if Value <> FFlatBorderColor then + begin + FFlatBorderColor := Value; + Invalidate; + end; +end; + +function TJvCustomArrangePanel.DoEraseBackground(ACanvas: TCanvas; + AParam: LPARAM): Boolean; +begin + // Mantis 3624: Draw our parent's image first if we are transparent. + // This might not seem useful at first as we have removed the csOpaque + // from our style and the API is doing the drawing just fine. But this + // is required for other transparent controls placed on us. This way, + // they call us with their own canvas into which we draw what we are + // placed on. This way, there is an automatic chain of transparency up + // to the controls at the bottom that are not transparent. + if FTransparent then + begin + CopyParentImage(Self, ACanvas); + Result := True; + end + else + Result := inherited DoEraseBackground(ACanvas, AParam); +end; + +procedure TJvCustomArrangePanel.SetLayout(const Value: TTextLayout); +begin + if FLayout <> Value then + begin + FLayout := Value; + Invalidate; + end; +end; + +procedure TJvCustomArrangePanel.SetMultiLine(const Value: Boolean); +begin + if FMultiLine <> Value then + begin + FMultiLine := Value; + Invalidate; + end; +end; + +procedure TJvCustomArrangePanel.TextChanged; +begin + inherited TextChanged; + Invalidate; +end; + +procedure TJvCustomArrangePanel.SetSizeable(const Value: Boolean); +begin + if FSizeable <> Value then + begin + if FDragging and FSizeable then + MouseCapture := False; + FSizeable := Value; + Invalidate; + end; +end; + +procedure TJvCustomArrangePanel.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + if Sizeable and (Button = mbLeft) and ((Width - X) < 12) and ((Height - Y) < 12) then + begin + FDragging := True; + FLastPos := Point(X, Y); + MouseCapture := True; + SetSizeableCursor; + end + else + inherited MouseDown(Button, Shift, X, Y); +end; + +procedure TJvCustomArrangePanel.MouseMove(Shift: TShiftState; X, Y: Integer); +var + R: TRect; + X1, Y1: Integer; + lChanged : Boolean; +begin + if FDragging and Sizeable then + begin + R := BoundsRect; + X1 := R.Right - R.Left + X - FLastPos.X; + Y1 := R.Bottom - R.Top + Y - FLastPos.Y; + if (X1 > 1) and (Y1 > 1) then + begin + if (Constraints.MinWidth > 0) and (X1 < Constraints.MinWidth) then + X1 := Constraints.MinWidth; + if (Constraints.MinHeight > 0) and (Y1 < Constraints.MinHeight) then + Y1 := Constraints.MinHeight; + if (Constraints.MaxWidth > 0) and (X1 > Constraints.MaxWidth) then + X1 := Constraints.MaxWidth; + if (Constraints.MaxHeight > 0) and (Y1 > Constraints.MaxHeight) then + Y1 := Constraints.MaxHeight; + lChanged := False; + if (X1 >= 0) and (X1 <> Width) then + begin + FLastPos.X := X; + lChanged:= True; + end; + if (Y1 >= 0) and (Y1 <> Height) then + begin + FLastPos.Y := Y; + lChanged := True; + end; + if lChanged then + begin + SetBounds(Left, Top, X1, Y1); + Refresh; + end; + end; + end + else + inherited MouseMove(Shift, X, Y); + if Sizeable then + begin + if ((Width - X) < 12) and ((Height - Y) < 12) then + SetSizeableCursor + else + RestoreSizeableCursor; + end; +end; + +procedure TJvCustomArrangePanel.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + if FDragging and Sizeable then + begin + FDragging := False; + MouseCapture := False; + RestoreSizeableCursor; + Refresh; + end + else + inherited MouseUp(Button, Shift, X, Y); +end; + +procedure TJvCustomArrangePanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); +begin + + inherited SetBounds(ALeft, ATop, AWidth, AHeight); + if FTransparent then + Invalidate; +end; + +procedure TJvCustomArrangePanel.Resize; +begin + if not EqualRect(FLastBoundsRect, BoundsRect) then + if Assigned(FArrangeSettings) then // (asn) + if FArrangeSettings.AutoArrange then + ArrangeControls; + inherited Resize; + FLastBoundsRect := BoundsRect; +end; + +procedure TJvCustomArrangePanel.EnableArrange; +begin + EnableAlign; + if FEnableArrangeCount > 0 then + Dec(FEnableArrangeCount); +end; + +procedure TJvCustomArrangePanel.DisableArrange; +begin + Inc(FEnableArrangeCount); + DisableAlign; +end; + +function TJvCustomArrangePanel.ArrangeEnabled: Boolean; +begin + Result := FEnableArrangeCount <= 0; +end; + +procedure TJvCustomArrangePanel.Loaded; +begin + inherited Loaded; + if FArrangeSettings.AutoArrange then + ArrangeControls; +end; + +procedure TJvCustomArrangePanel.AlignControls(AControl: TControl; var Rect: TRect); +begin + inherited AlignControls(AControl, Rect); + if FArrangeSettings.AutoArrange then + ArrangeControls; +end; + +function TJvCustomArrangePanel.GetNextControlByTabOrder(ATabOrder: Integer): TWinControl; +var + I: Integer; +begin + Result := nil; + for I := 0 to ControlCount - 1 do + if Controls[I] is TWinControl then + if TWinControl(Controls[I]).TabOrder = ATabOrder then + begin + Result := TWinControl(Controls[I]); + Break; + end; +end; + +procedure TJvCustomArrangePanel.ArrangeControls; +type + TControlRect = record + Control: TControl; + BoundsRect: TRect; + LineBreak: Boolean; + end; +var + AktX, AktY, NewX, NewY, MaxY, NewMaxX: Integer; + ControlMaxX, ControlMaxY: Integer; + TmpWidth, TmpHeight: Integer; + LastTabOrder: Integer; + CurrControl: TWinControl; + I: Integer; + OldHeight, OldWidth: Integer; + OffsetX, OffsetY: Integer; + NumControlsPerLine: Integer; + ControlRects: array of TControlRect; + LineOffsets: array of Integer; + LineCount, Len: Integer; + ArrS: TJvArrangeSettings; + ControlSize: TSize; +begin + if not ArrangeEnabled or FArrangeControlActive or (ControlCount = 0) or + ([csLoading, csReading] * ComponentState <> []) then + Exit; + FArrangeWidth := 0; + FArrangeHeight := 0; + FArrangeControlActive := True; + ArrS := FArrangeSettings; + try + OldHeight := Height; + OldWidth := Width; + TmpHeight := Height; + TmpWidth := Width; + AktY := ArrS.BorderTop; + AktX := ArrS.BorderLeft; + LastTabOrder := -1; + MaxY := -1; + if (ArrS.AutoSize in [asWidth, asBoth]) then + ControlMaxX := TmpWidth - 2 * ArrS.BorderLeft + else + ControlMaxX := -1; + if (ArrS.AutoSize in [asHeight, asBoth]) then + ControlMaxY := TmpHeight - 2 * ArrS.BorderTop + else + ControlMaxY := -1; + + SetLength(ControlRects, ControlCount); + for I := 0 to ControlCount - 1 do + if Controls[I] is TWinControl then + begin + if Controls[I] is TJvCustomArrangePanel then + TJvCustomArrangePanel(Controls[I]).Rearrange; + ControlSize := GetControlSize(Controls[I]); + if (ControlSize.cx + 2 * ArrS.BorderLeft > TmpWidth) then + TmpWidth := ControlSize.cx + 2 * ArrS.BorderLeft; + end; + + if (TmpWidth > ArrS.MaxWidth) and (ArrS.MaxWidth > 0) then + TmpWidth := ArrS.MaxWidth; + CurrControl := GetNextControlByTabOrder(LastTabOrder + 1); + I := 0; + NumControlsPerLine := 0; + LineCount := 0; + while Assigned(CurrControl) do + begin + LastTabOrder := CurrControl.TabOrder; + ControlRects[I].Control := nil; + ControlRects[I].LineBreak := False; + if CurrControl.Visible or + ((csDesigning in ComponentState) and ArrS.ShowNotVisibleAtDesignTime) then + begin + ControlSize := GetControlSize(CurrControl); + NewMaxX := AktX + ControlSize.cx + ArrS.DistanceHorizontal + ArrS.BorderLeft; + if ((ArrS.MaxControlsPerLine > 0) and (NumControlsPerLine >= ArrS.MaxControlsPerLine)) or + ((((NewMaxX > TmpWidth) and not (ArrS.AutoSize in [asWidth, asBoth])) or + ((NewMaxX > ArrS.MaxWidth) and (ArrS.MaxWidth > 0))) and + (AktX > ArrS.BorderLeft) and // Only Valid if there is one control in the current line + ArrS.WrapControls) then + begin + AktX := ArrS.BorderLeft; + AktY := AktY + MaxY + ArrS.DistanceVertical; + MaxY := -1; + NewX := AktX; + NewY := AktY; + NumControlsPerLine := 1; + ControlRects[I].LineBreak := True; + Inc(LineCount); + end + else + begin + NewX := AktX; + NewY := AktY; + Inc(NumControlsPerLine); + end; + AktX := AktX + ControlSize.cx; + if AktX > ControlMaxX then + ControlMaxX := AktX; + AktX := AktX + ArrS.DistanceHorizontal; + ControlRects[I].Control := CurrControl; + ControlRects[I].BoundsRect := Rect(NewX, NewY, NewX + ControlSize.cx, NewY + ControlSize.cy); + if CurrControl.Height > MaxY then + MaxY := ControlSize.cy; + ControlMaxY := AktY + MaxY; + end; + CurrControl := GetNextControlByTabOrder(LastTabOrder + 1); + Inc(I); + end; + if (Length(ControlRects) > 0) and not ControlRects[High(ControlRects)].LineBreak then + Inc(LineCount); + + { Vertical/Horizontal alignment } + OffsetX := 0; + OffsetY := 0; + if not (ArrS.AutoSize in [asBoth, asHeight]) then + case ArrS.VerticalAlignment of + asVCenter: + OffsetY := (ClientHeight - ControlMaxY) div 2; + asBottom: + OffsetY := ClientHeight - ControlMaxY; + end; + if not (ArrS.AutoSize in [asBoth, asWidth]) then + case ArrS.HorizontalAlignment of + asCenter: + OffsetX := (ClientWidth - ControlMaxX) div 2; + asRight: + OffsetX := ClientWidth - ControlMaxX; + end; + + { Calculate the horizontal line alignment } + if Arrs.HorizontalAlignLines then + begin + SetLength(LineOffsets, LineCount); + Len := Length(ControlRects); + I := 0; + LineCount := 0; + while I < Len do + begin + { Skip unused slots } + while (I < Len) and (ControlRects[I].Control = nil) do + Inc(I); + if I < Len then + begin + LineOffsets[LineCount] := ControlRects[I].BoundsRect.Left; + { Find last control in the line } + while (I + 1 < Len) and not ControlRects[I + 1].LineBreak do + Inc(I); + LineOffsets[LineCount] := (ControlMaxX - (ControlRects[I].BoundsRect.Right - LineOffsets[LineCount])) div 2; + Inc(LineCount); + end; + Inc(I); + end; + end; + + { Apply the new BoundRects to the controls } + LineCount := 0; + for I := 0 to High(ControlRects) do + begin + if ControlRects[I].Control <> nil then + begin + OffsetRect(ControlRects[I].BoundsRect, OffsetX, OffsetY); + if ArrS.HorizontalAlignLines then + begin + if ControlRects[I].LineBreak then + Inc(LineCount); + OffsetRect(ControlRects[I].BoundsRect, LineOffsets[LineCount], 0); + end; + SetControlBounds(ControlRects[I].Control, ControlRects[I].BoundsRect); + end; + end; + + { Adjust panel bounds } + if not (csLoading in ComponentState) then + begin + if ArrS.AutoSize in [asWidth, asBoth] then + if ControlMaxX >= 0 then + if (ArrS.MaxWidth > 0) and (ControlMaxX >= ArrS.MaxWidth) then + TmpWidth := ArrS.MaxWidth + else + TmpWidth := ControlMaxX + ArrS.BorderLeft + else + TmpWidth := 0; + if ArrS.AutoSize in [asHeight, asBoth] then + if ControlMaxY >= 0 then + TmpHeight := ControlMaxY + ArrS.BorderTop + else + TmpHeight := 0; + if Width <> TmpWidth then + Width := TmpWidth; + if Height <> TmpHeight then + Height := TmpHeight; + end; + FArrangeWidth := ControlMaxX + 2 * ArrS.BorderLeft; + FArrangeHeight := ControlMaxY + 2 * ArrS.BorderTop; + if (OldWidth <> TmpWidth) or (OldHeight <> Height) then + UpdateWindow(Handle); + finally + FArrangeControlActive := False; + end; +end; + +procedure TJvCustomArrangePanel.SetWidth(Value: Integer); +var + lChanged: Boolean; +begin + lChanged := inherited Width <> Value; + inherited Width := Value; + if lChanged then + begin + if Assigned(FOnChangedWidth) then + FOnChangedWidth (Self, Value); + if Assigned(FOnResizeParent) then + FOnResizeParent(Self, Left, Top, Value, Height) + else + if Parent is TJvCustomArrangePanel then + TJvCustomArrangePanel(Parent).Rearrange; + end; +end; + +function TJvCustomArrangePanel.GetWidth: Integer; +begin + Result := inherited Width; +end; + +procedure TJvCustomArrangePanel.SetHeight(Value: Integer); +var + lChanged: Boolean; +begin + lChanged := inherited Height <> Value; + inherited Height := Value; + if lChanged then + begin + if Assigned(FOnChangedHeight) then + FOnChangedHeight (Self, Value); + if Assigned(FOnResizeParent) then + FOnResizeParent(Self, Left, Top, Width, Value) + else + if Parent is TJvCustomArrangePanel then + TJvCustomArrangePanel(Parent).Rearrange; + end; +end; + +function TJvCustomArrangePanel.GetHeight: Integer; +begin + Result := inherited Height; +end; + +procedure TJvCustomArrangePanel.SetArrangeSettings( + const Value: TJvArrangeSettings); +begin + if (Value <> nil) and (Value <> FArrangeSettings) then + begin + try + DisableArrange; + FArrangeSettings.Assign(Value); + finally + EnableArrange; + ArrangeControls; + end; + end; +end; + +function TJvCustomArrangePanel.GetHotTrack: Boolean; +begin + Result := FHotTrack; +end; + +function TJvCustomArrangePanel.GetHotTrackFont: TFont; +begin + Result := FHotTrackFont; +end; + +function TJvCustomArrangePanel.GetHotTrackFontOptions: TJvTrackFontOptions; +begin + Result := FHotTrackFontOptions; +end; + +function TJvCustomArrangePanel.GetHotTrackOptions: TJvHotTrackOptions; +begin + Result := FHotTrackOptions; +end; + +procedure TJvCustomArrangePanel.SetHotTrack(Value: Boolean); +begin + FHotTrack := Value; +end; + +procedure TJvCustomArrangePanel.SetHotTrackFont(Value: TFont); +begin + if (FHotTrackFont<>Value) and (Value <> nil) then + FHotTrackFont.Assign(Value); +end; + +procedure TJvCustomArrangePanel.SetHotTrackFontOptions(Value: TJvTrackFontOptions); +begin + if FHotTrackFontOptions <> Value then + begin + FHotTrackFontOptions := Value; + UpdateTrackFont(HotTrackFont, Font, FHotTrackFontOptions); + end; +end; + +procedure TJvCustomArrangePanel.SetHotTrackOptions(Value: TJvHotTrackOptions); +begin + if (FHotTrackOptions <> Value) and (Value <> nil) then + FHotTrackOptions.Assign(Value); +end; + +procedure TJvCustomArrangePanel.IJvHotTrack_Assign( + Source: IJvHotTrack); +begin + if (Source <> nil) and (IJvHotTrack(Self) <> Source) then + begin + HotTrack := Source.HotTrack; + HotTrackFont :=Source.HotTrackFont; + HotTrackFontOptions := Source.HotTrackFontOptions; + HotTrackOptions := Source.HotTrackOptions; + end; +end; + +function TJvCustomArrangePanel.IsHotTrackFontStored: Boolean; +begin + Result := IsHotTrackFontDfmStored(HotTrackFont, Font, HotTrackFontOptions); +end; + +procedure TJvCustomArrangePanel.Rearrange; +begin + if FArrangeSettings.AutoArrange then + ArrangeControls; +end; + +procedure TJvCustomArrangePanel.DoArrangeSettingsPropertyChanged(Sender: TObject; + const PropName: string); +begin + if SameText(PropName, 'AutoArrange') then + begin + if ArrangeSettings.AutoArrange then + Rearrange; + end + else + if SameText(PropName, 'AutoSize') then + begin + if ArrangeSettings.AutoSize <> asNone then + Rearrange; + end + else //otherwise call Rearrange + Rearrange; +end; + +function TJvCustomArrangePanel.GetArrangeSettings: TJvArrangeSettings; +begin + Result := FArrangeSettings; +end; + + +{ TJvPanel } + +procedure TJvPanel.DefineProperties(Filer: TFiler); +begin + inherited DefineProperties(Filer); + { For backward compatibility } + FFilerTag := 'HotColor'; + Filer.DefineProperty(FFilerTag, @ReadData, nil, False); +end; + +procedure TJvPanel.ReadData(Reader: TReader); +var + C: Integer; +begin + if SameText(FFilerTag, 'HotColor') then + begin + if Reader.NextValue = vaIdent then + begin + if IdentToColor(Reader.ReadIdent, C) then + HotTrackOptions.Color := C; + end + else + HotTrackOptions.Color := Reader.ReadInteger; + end; +end; + +end. +