paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

jvcllaz: Add TJvPanel (and related infrastructure).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7001 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2019-06-07 22:25:46 +00:00
parent 6e5f190f01
commit f9f933c01e
16 changed files with 3522 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
components/jvcllaz/design/JvCore/jvcorereg.pas
View File

@ -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.

932
components/jvcllaz/design/JvCore/jvdsgneditors.pas Normal file
View File

@ -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.

1
components/jvcllaz/design/JvStdCtrls/images/images.txt
View File

@ -1,2 +1,3 @@
tjvcheckbox.bmp
tjvpanel.bmp
tjvcalcedit.bmp

BIN
components/jvcllaz/design/JvStdCtrls/images/tjvpanel.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.6 KiB

8
components/jvcllaz/design/JvStdCtrls/jvstdctrlsreg.pas
View File

@ -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.

7
components/jvcllaz/packages/jvcorelazd.lpk
View File

@ -17,9 +17,10 @@
<Description Value="JVCL Core Components (Designtime). Must be compiled before any of the other JvXXX packages can be installed."/>
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
<Version Major="1" Release="6"/>
<Files Count="3">
<Files Count="4">
<Item1>
<Filename Value="..\design\JvCore\jvcorereg.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="JvCoreReg"/>
</Item1>
<Item2>
@ -30,6 +31,10 @@
<Filename Value="..\design\JvCore\jvstringsform.pas"/>
<UnitName Value="JvStringsForm"/>
</Item3>
<Item4>
<Filename Value="..\design\JvCore\jvdsgneditors.pas"/>
<UnitName Value="JvDsgnEditors"/>
</Item4>
</Files>
<RequiredPkgs Count="2">
<Item1>

6
components/jvcllaz/packages/jvcorelazr.lpk
View File

@ -23,7 +23,7 @@
"/>
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
<Version Major="1" Release="6"/>
<Files Count="9">
<Files Count="10">
<Item1>
<Filename Value="..\run\JvCore\jvtypes.pas"/>
<UnitName Value="JvTypes"/>
@ -60,6 +60,10 @@
<Filename Value="..\run\JvCore\jvthemes.pas"/>
<UnitName Value="JvThemes"/>
</Item9>
<Item10>
<Filename Value="..\run\JvCore\jvextcomponent.pas"/>
<UnitName Value="JvExtComponent"/>
</Item10>
</Files>
<RequiredPkgs Count="2">
<Item1>

10
components/jvcllaz/packages/jvstdctrlslazr.lpk
View File

@ -17,7 +17,7 @@ CalcEdit, button, checkbox, linked controls
"/>
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
<Version Major="1" Release="6"/>
<Files Count="4">
<Files Count="6">
<Item1>
<Filename Value="..\run\JvStdCtrls\jvbutton.pas"/>
<UnitName Value="JvButton"/>
@ -34,6 +34,14 @@ CalcEdit, button, checkbox, linked controls
<Filename Value="..\run\JvStdCtrls\jvcheckbox.pas"/>
<UnitName Value="JvCheckBox"/>
</Item4>
<Item5>
<Filename Value="..\run\JvStdCtrls\jvpanel.pas"/>
<UnitName Value="JvPanel"/>
</Item5>
<Item6>
<Filename Value="..\run\JvStdCtrls\jvhottrackpersistent.pas"/>
<UnitName Value="JvHotTrackPersistent"/>
</Item6>
</Files>
<RequiredPkgs Count="2">
<Item1>

BIN
components/jvcllaz/resource/jvstdctrlsreg.res
View File

Binary file not shown.

131
components/jvcllaz/run/JvCore/JvExtComponent.pas Normal file
View File

@ -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.

65
components/jvcllaz/run/JvCore/jvexcontrols.pas
View File

@ -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

373
components/jvcllaz/run/JvCore/jvexextctrls.pas
View File

@ -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;

5
components/jvcllaz/run/JvCore/jvjclutils.pas
View File

@ -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

89
components/jvcllaz/run/JvCore/jvtypes.pas
View File

@ -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;

335
components/jvcllaz/run/JvStdCtrls/jvhottrackpersistent.pas Normal file
View File

@ -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.

1604
components/jvcllaz/run/JvStdCtrls/jvpanel.pas Normal file
View File

File diff suppressed because it is too large Load Diff