diff --git a/components/jvcllaz/design/JvCtrls/JvCtrlsReg.pas b/components/jvcllaz/design/JvCtrls/JvCtrlsReg.pas
index d8f819cce..7bb69c104 100644
--- a/components/jvcllaz/design/JvCtrls/JvCtrlsReg.pas
+++ b/components/jvcllaz/design/JvCtrls/JvCtrlsReg.pas
@@ -14,12 +14,12 @@ implementation
{$R ../../resource/JvHTControlsReg.res}
uses
- Classes, JvDsgnConsts, JvHtControls, {JvDBHTLabel,} JvHint, JvHTHintForm,
+ Classes, JvDsgnConsts,
+ JvHtControls, {JvDBHTLabel,} JvHint, JvHTHintForm,
PropEdits, Controls;
procedure Register;
begin
-// RegisterComponents(RsPaletteButton, [TJvHTButton]);
RegisterComponents(RsPaletteLabel, [TJvHTLabel]);
RegisterComponents(RsPaletteListComboTree, [TJvHTListBox, TJvHTComboBox]);
RegisterComponents(RsPaletteNonVisual, [TJvHint]);
diff --git a/components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas b/components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas
new file mode 100644
index 000000000..590b82d85
--- /dev/null
+++ b/components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas
@@ -0,0 +1,24 @@
+unit JvStdCtrlsReg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ SysUtils;
+
+procedure Register;
+
+implementation
+
+uses
+ Classes, JvDsgnConsts, JvButton,
+ Controls;
+
+procedure Register;
+begin
+ //RegisterComponents(RsPaletteButton, [TJvButton]);
+end;
+
+end.
+
diff --git a/components/jvcllaz/examples/JvNavigationPane/JvNavPaneDemo.lpi b/components/jvcllaz/examples/JvNavigationPane/JvNavPaneDemo.lpi
index 321f68eb7..2e811e40c 100644
--- a/components/jvcllaz/examples/JvNavigationPane/JvNavPaneDemo.lpi
+++ b/components/jvcllaz/examples/JvNavigationPane/JvNavPaneDemo.lpi
@@ -36,7 +36,7 @@
-
+
@@ -51,7 +51,6 @@
-
@@ -83,6 +82,15 @@
+
+
+
+
+
+
+
+
+
diff --git a/components/jvcllaz/packages/JvCtrlsLazR.lpk b/components/jvcllaz/packages/JvCtrlsLazR.lpk
index 333ea3aec..a3614af39 100644
--- a/components/jvcllaz/packages/JvCtrlsLazR.lpk
+++ b/components/jvcllaz/packages/JvCtrlsLazR.lpk
@@ -19,19 +19,15 @@
- Listboxes, Comboboxes, TreeViews"/>
-
+
-
-
-
-
-
-
+
+
-
+
diff --git a/components/jvcllaz/packages/JvPageCompsR.lpk b/components/jvcllaz/packages/JvPageCompsR.lpk
index 56fae3c4b..f00a17c78 100644
--- a/components/jvcllaz/packages/JvPageCompsR.lpk
+++ b/components/jvcllaz/packages/JvPageCompsR.lpk
@@ -8,7 +8,7 @@
-
+
@@ -27,7 +27,7 @@
-
+
diff --git a/components/jvcllaz/packages/JvStdCtrlsLazD.lpk b/components/jvcllaz/packages/JvStdCtrlsLazD.lpk
new file mode 100644
index 000000000..582cf196b
--- /dev/null
+++ b/components/jvcllaz/packages/JvStdCtrlsLazD.lpk
@@ -0,0 +1,44 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/jvcllaz/packages/JvStdCtrlsLazR.lpk b/components/jvcllaz/packages/JvStdCtrlsLazR.lpk
new file mode 100644
index 000000000..59f8cea9a
--- /dev/null
+++ b/components/jvcllaz/packages/JvStdCtrlsLazR.lpk
@@ -0,0 +1,43 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/jvcllaz/packages/JvXPCtrlsLazR.lpk b/components/jvcllaz/packages/JvXPCtrlsLazR.lpk
index d87ce4880..234df81d7 100644
--- a/components/jvcllaz/packages/JvXPCtrlsLazR.lpk
+++ b/components/jvcllaz/packages/JvXPCtrlsLazR.lpk
@@ -9,7 +9,7 @@
-
+
@@ -43,7 +43,7 @@
-
+
diff --git a/components/jvcllaz/run/JvCore/JvConsts.pas b/components/jvcllaz/run/JvCore/JvConsts.pas
index fece89303..995f8220d 100644
--- a/components/jvcllaz/run/JvCore/JvConsts.pas
+++ b/components/jvcllaz/run/JvCore/JvConsts.pas
@@ -205,6 +205,9 @@ const
AF_ICON = $00000001;
AF_SEQUENCE = $00000002;
+ DT_PATH_ELLIPSIS = $4000;
+
+
const
KeyboardShiftStates = [ssShift, ssAlt, ssCtrl];
MouseShiftStates = [ssLeft, ssRight, ssMiddle, ssDouble];
diff --git a/components/jvcllaz/run/JvCore/JvExControls.pas b/components/jvcllaz/run/JvCore/JvExControls.pas
index 765b0b5c6..e27101fc5 100644
--- a/components/jvcllaz/run/JvCore/JvExControls.pas
+++ b/components/jvcllaz/run/JvCore/JvExControls.pas
@@ -44,7 +44,8 @@ unit JvExControls;
interface
uses
- Classes, types, Controls, Graphics, LCLIntf, LCLType, LMessages, Forms;
+ Classes, types, Controls, Graphics, LCLIntf, LCLType, LMessages, Forms,
+ JvTypes;
type
TDlgCode =
@@ -67,6 +68,7 @@ const
CM_DENYSUBCLASSING = JvThemes.CM_DENYSUBCLASSING;
CM_PERFORM = CM_BASE + $500 + 0; // LParam: "Msg: ^TMessage"
CM_SETAUTOSIZE = CM_BASE + $500 + 1; // WParam: "Value: Boolean"
+ ******************** NOT CONVERTED *)
type
TJvHotTrackOptions = class;
@@ -123,7 +125,6 @@ type
property FrameVisible: Boolean read FFrameVisible write SetFrameVisible default False;
property FrameColor: TColor read FFrameColor write SetFrameColor default $006A240A;
end;
-******************** NOT CONVERTED *)
type
TStructPtrMessage = class(TObject)
@@ -491,7 +492,7 @@ begin
end;
end;
-(******************** NOT CONVERTED
+
//=== { TJvHotTrackOptions } ======================================
constructor TJvHotTrackOptions.Create;
@@ -568,7 +569,6 @@ begin
Changed;
end;
end;
-******************** NOT CONVERTED *)
//============================================================================
diff --git a/components/jvcllaz/run/JvCore/JvJCLUtils.pas b/components/jvcllaz/run/JvCore/JvJCLUtils.pas
index 60344317f..bf13c62b2 100644
--- a/components/jvcllaz/run/JvCore/JvJCLUtils.pas
+++ b/components/jvcllaz/run/JvCore/JvJCLUtils.pas
@@ -46,10 +46,10 @@ interface
// the JCL has the same problem with CLX it should not make any difference.
uses
- Classes, Graphics, LCLIntf, LCLType;
+ Classes, Graphics, LCLIntf, LCLType, LMessages;
-(******************** NOT CONVERTED
const
+(******************** NOT CONVERTED
{$IFDEF MSWINDOWS}
PathDelim = '\';
DriveDelim = ':';
@@ -61,8 +61,10 @@ const
AllFilesMask = '*';
{$ENDIF UNIX}
// Note: the else is on purpose, VCL is not defined for a console application
+******************** NOT CONVERTED *)
NullHandle = 0;
+(******************** NOT CONVERTED
{$IFDEF UNIX}
type
TFileTime = Integer;
@@ -854,6 +856,7 @@ const
function DateIsNull(const pdtValue: TDateTime; const pdtKind: TdtKind): Boolean;
// Replacement for Win32Check to avoid platform specific warnings in D6
function OSCheck(RetVal: Boolean): Boolean;
+******************** NOT CONVERTED *)
{ Shortens a fully qualified Path name so that it can be drawn with a specified length limit.
Same as FileCtrl.MinimizeName in functionality (but not implementation). Included here to
@@ -863,6 +866,7 @@ function MinimizeText(const Text: string; Canvas: TCanvas; MaxWidth: Integer): s
{ MinimizeString trunactes long string, S, and appends
'...' symbols, if Length of S is more than MaxLen }
function MinimizeString(const S: string; const MaxLen: Integer): string;
+(******************** NOT CONVERTED
{$IFNDEF CLR}
{$IFDEF MSWINDOWS}
@@ -962,8 +966,10 @@ function WindowClassName(Wnd: THandle): string;
procedure SwitchToWindow(Wnd: THandle; Restore: Boolean);
procedure ActivateWindow(Wnd: THandle);
procedure ShowWinNoAnimate(Handle: THandle; CmdShow: Integer);
+******************** NOT CONVERTED *)
procedure KillMessage(Wnd: THandle; Msg: Cardinal);
+(******************** NOT CONVERTED
{ SetWindowTop put window to top without recreating window }
procedure SetWindowTop(const Handle: THandle; const Top: Boolean);
procedure CenterWindow(Wnd: THandle);
@@ -1192,6 +1198,10 @@ function SecondsBetween(const Now: TDateTime; const FTime: TDateTime): Integer;
implementation
+uses
+ Math,
+ JvConsts;
+
(******************** NOT CONVERTED
uses
{$IFDEF HAS_UNIT_RTLCONSTS}
@@ -2083,17 +2093,6 @@ begin
Result := S2 + Result;
end;
-function MinimizeString(const S: string; const MaxLen: Integer): string;
-begin
- if Length(S) > MaxLen then
- if MaxLen < 3 then
- Result := Copy(S, 1, MaxLen)
- else
- Result := Copy(S, 1, MaxLen - 3) + '...'
- else
- Result := S;
-end;
-
function TrueInflateRect(const R: TRect; const I: Integer): TRect;
begin
with R do
@@ -8180,27 +8179,19 @@ begin
Result := RetVal;
end;
+******************** NOT CONVERTED *)
+
function MinimizeFileName(const FileName: string; Canvas: TCanvas; MaxLen: Integer): string;
var
- {$IFDEF CLR}
- sb: StringBuilder;
- {$ENDIF CLR}
R: TRect;
+ flags: Word;
begin
Result := FileName;
R := Rect(0, 0, MaxLen, Canvas.TextHeight('Wq'));
- {$IFDEF CLR}
- sb := StringBuilder.Create(Result);
- // DrawText() doesn't exist with StringBuilder parameter (2005)
- if DrawTextEx(Canvas.Handle, sb, sb.Length, R,
- DT_SINGLELINE or DT_MODIFYSTRING or DT_PATH_ELLIPSIS or DT_CALCRECT or
- DT_NOPREFIX, nil) <= 0 then
- {$ELSE}
UniqueString(Result);
- if DrawText(Canvas.Handle, PChar(Result), Length(Result), R,
- DT_SINGLELINE or DT_MODIFYSTRING or DT_PATH_ELLIPSIS or DT_CALCRECT or
- DT_NOPREFIX) <= 0 then
- {$ENDIF CLR}
+ flags := DT_SINGLELINE or DT_MODIFYSTRING or DT_PATH_ELLIPSIS or
+ DT_CALCRECT or DT_NOPREFIX;
+ if DrawText(Canvas.Handle, PChar(Result), Length(Result), R, flags) <= 0 then
Result := FileName;
end;
@@ -8218,6 +8209,18 @@ begin
end;
end;
+function MinimizeString(const S: string; const MaxLen: Integer): string;
+begin
+ if Length(S) > MaxLen then
+ if MaxLen < 3 then
+ Result := Copy(S, 1, MaxLen)
+ else
+ Result := Copy(S, 1, MaxLen - 3) + '...'
+ else
+ Result := S;
+end;
+
+(******************** NOT CONVERTED
{$IFNDEF CLR}
{$IFDEF MSWINDOWS}
@@ -8950,7 +8953,7 @@ begin
SetWindowPos(Wnd, 0, R.Left, R.Top, 0, 0, SWP_NOACTIVATE or
SWP_NOSIZE or SWP_NOZORDER);
end;
-
+******************** NOT CONVERTED *)
{ Delete the requested message from the queue, but throw back }
{ any WM_QUIT msgs that PeekMessage may also return. }
@@ -8960,11 +8963,14 @@ var
M: TMsg;
begin
M.Message := 0;
- if PeekMessage(M, Wnd, Msg, Msg, PM_REMOVE) and (M.Message = WM_QUIT) then
+ { wp ---- PostQuitMessage does not exist in Lazarus
+
+ if PeekMessage(M, Wnd, Msg, Msg, PM_REMOVE) and (M.Message = LM_QUIT) then
PostQuitMessage(M.WParam);
+ }
end;
-
+(******************** NOT CONVERTED
procedure SetWindowTop(const Handle: THandle; const Top: Boolean);
const
TopFlag: array [Boolean] of Longword = (HWND_NOTOPMOST, HWND_TOPMOST);
diff --git a/components/jvcllaz/run/JvCore/JvJVCLUtils.pas b/components/jvcllaz/run/JvCore/JvJVCLUtils.pas
index 29140c1e9..646174ebc 100644
--- a/components/jvcllaz/run/JvCore/JvJVCLUtils.pas
+++ b/components/jvcllaz/run/JvCore/JvJVCLUtils.pas
@@ -26,13 +26,20 @@ Known Issues:
// Conversion is done in incremental way: as types / classes / routines
// are needed they are converted.
-{$mode objfpc}{$H+}
+{$MODE DELPHI}
+//{$mode objfpc}{$H+}
unit JvJVCLUtils;
interface
+
uses
- Classes, Graphics, JvTypes, ImgList, LCLType, Types;
+ {$IFDEF WIN32}
+ Windows,
+ {$ENDIF}
+ Classes, Graphics, Controls, ImgList,
+ LCLType, LCLProc, LMessages, Types,
+ JvTypes;
(******************** NOT CONVERTED
// Transform an icon to a bitmap
@@ -86,6 +93,7 @@ function CaptureScreen(WndHandle: Longword): TBitmap; overload;
{$ENDIF MSWINDOWS}
procedure RGBToHSV(R, G, B: Integer; var H, S, V: Integer);
+******************** NOT CONVERTED *)
{ from JvVCLUtils }
@@ -93,6 +101,7 @@ procedure CopyParentImage(Control: TControl; Dest: TCanvas);
{ Windows resources (bitmaps and icons) VCL-oriented routines }
procedure DrawBitmapTransparent(Dest: TCanvas; DstX, DstY: Integer;
Bitmap: TBitmap; TransparentColor: TColor);
+(******************** NOT CONVERTED
procedure DrawBitmapRectTransparent(Dest: TCanvas; DstX, DstY: Integer;
SrcRect: TRect; Bitmap: TBitmap; TransparentColor: TColor);
procedure StretchBitmapRectTransparent(Dest: TCanvas; DstX, DstY, DstW,
@@ -102,6 +111,8 @@ function MakeBitmap(ResID: PChar): TBitmap;
function MakeBitmapID(ResID: Word): TBitmap;
function MakeModuleBitmap(Module: THandle; ResID: PChar): TBitmap;
{$ENDIF !CLR}
+******************** NOT CONVERTED *)
+function AllocPatternBitmap(BkColor, FgColor: TColor): TBitmap;
function CreateTwoColorsBrushPattern(Color1, Color2: TColor): TBitmap;
function CreateDisabledBitmap_NewStyle(FOriginal: TBitmap; BackColor: TColor):
TBitmap;
@@ -109,12 +120,15 @@ function CreateDisabledBitmapEx(FOriginal: TBitmap; OutlineColor, BackColor,
HighLightColor, ShadowColor: TColor; DrawHighlight: Boolean): TBitmap;
function CreateDisabledBitmap(FOriginal: TBitmap; OutlineColor: TColor):
TBitmap;
+(******************** NOT CONVERTED
procedure AssignBitmapCell(Source: TGraphic; Dest: TBitmap; Cols, Rows,
Index: Integer);
function ChangeBitmapColor(Bitmap: TBitmap; Color, NewColor: TColor): TBitmap;
+******************** NOT CONVERTED *)
procedure ImageListDrawDisabled(Images: TCustomImageList; Canvas: TCanvas;
X, Y, Index: Integer; HighLightColor, GrayColor: TColor;
DrawHighlight: Boolean);
+(******************** NOT CONVERTED
{$IFNDEF CLR}
function MakeIcon(ResID: PChar): TIcon;
@@ -166,7 +180,11 @@ function GetControlPanelApplet(const AFileName: string; Strings: TStrings;
{$ENDIF !CLR}
function PointInPolyRgn(const P: TPoint; const Points: array of TPoint): Boolean;
+******************** NOT CONVERTED *)
+
function PaletteColor(Color: TColor): Longint;
+
+(******************** NOT CONVERTED
procedure PaintInverseRect(const RectOrg, RectEnd: TPoint);
procedure DrawInvertFrame(ScreenRect: TRect; Width: Integer);
@@ -212,9 +230,12 @@ function LoadAniCursor(Instance: THandle; ResID: PChar): HCURSOR;
{ Windows API level routines }
+******************** NOT CONVERTED *)
+
procedure StretchBltTransparent(DstDC: HDC; DstX, DstY, DstW, DstH: Integer;
SrcDC: HDC; SrcX, SrcY, SrcW, Srch: Integer;
Palette: HPALETTE; TransparentColor: TColorRef);
+(******************** NOT CONVERTED
procedure DrawTransparentBitmap(DC: HDC; Bitmap: HBITMAP;
DstX, DstY: Integer; TransparentColor: TColorRef);
function PaletteEntries(Palette: HPALETTE): Integer;
@@ -279,8 +300,10 @@ function FindFormByClass(FormClass: TFormClass): TForm;
function FindFormByClassName(const FormClassName: string): TForm;
{ AppMinimized returns True, if Application is minimized }
function AppMinimized: Boolean;
+******************** NOT CONVERTED *)
function IsForegroundTask: Boolean;
+(******************** NOT CONVERTED
{ MessageBox is Application.MessageBox with string (not PChar) parameters.
if Caption parameter = '', it replaced with Application.Title }
function MessageBox(const Msg, Caption: string; const Flags: Integer): Integer;
@@ -832,7 +855,11 @@ function ReplaceImageListReference(This: TComponent; NewReference: TCustomImageL
implementation
uses
- sysutils, LCLIntf, math;
+ sysutils, LCLIntf,
+ {$IFDEF MSWINDOWS}
+ CommCtrl,
+ {$ENDIF}
+ math, JvConsts, JvJCLUtils;
(********************
SysConst,
Consts,
@@ -1500,14 +1527,12 @@ begin
else
Result := pcItem.SubItems[piIndex - 1];
end;
+******************** NOT CONVERTED *)
{from JvVCLUtils }
{ Bitmaps }
-
-
-
// see above for VisualCLX version of CopyParentImage
type
TJvParentControl = class(TWinControl);
@@ -1531,7 +1556,7 @@ begin
// calls it as well. Best example is a TJvSpeeButton in a TJvPanel,
// both with Transparent set to True (discovered while working on
// Mantis 3624)
- GetViewPortOrgEx(DC, ViewPortOrg);
+ GetViewPortOrgEx(DC, @ViewPortOrg);
with Control do
begin
@@ -1555,7 +1580,7 @@ begin
{$ELSE}
with TJvParentControl(Control.Parent) do
begin
- Perform(WM_ERASEBKGND, DC, 0);
+ Perform(LM_ERASEBKGND, DC, 0);
PaintWindow(DC);
end;
{$ENDIF CLR}
@@ -1583,7 +1608,7 @@ begin
try
SetViewPortOrgEx(DC, Left + ViewPortOrg.X, Top + ViewPortOrg.Y, nil);
IntersectClipRect(DC, 0, 0, Width, Height);
- Perform(WM_PAINT, DC, 0);
+ Perform(LM_PAINT, DC, 0);
finally
RestoreDC(DC, SaveIndex);
ControlState := ControlState - [csPaintCopy];
@@ -1597,6 +1622,7 @@ begin
ControlState := ControlState - [csPaintCopy];
end;
end;
+(******************** NOT CONVERTED
@@ -1672,11 +1698,11 @@ begin
Dest.Transparent := Source.Transparent;
end;
end;
+******************** NOT CONVERTED *)
+
{ Transparent bitmap }
-
-
procedure StretchBltTransparent(DstDC: HDC; DstX, DstY, DstW, DstH: Integer;
SrcDC: HDC; SrcX, SrcY, SrcW, Srch: Integer; Palette: HPALETTE;
TransparentColor: TColorRef);
@@ -1763,7 +1789,7 @@ begin
DeleteDC(SaveDC);
end;
-
+(******************** NOT CONVERTED
procedure DrawTransparentBitmapRect(DC: HDC; Bitmap: HBITMAP; DstX, DstY,
DstW, DstH: Integer; SrcRect: TRect; TransparentColor: TColorRef);
@@ -1794,6 +1820,7 @@ begin
DrawTransparentBitmapRect(DC, Bitmap, DstX, DstY, BM.bmWidth, BM.bmHeight,
Rect(0, 0, BM.bmWidth, BM.bmHeight), TransparentColor);
end;
+******************** NOT CONVERTED*)
procedure StretchBitmapTransparent(Dest: TCanvas; Bitmap: TBitmap;
TransparentColor: TColor; DstX, DstY, DstW, DstH, SrcX, SrcY,
@@ -1866,6 +1893,7 @@ begin
Bitmap.Width, Bitmap.Height, 0, 0, Bitmap.Width, Bitmap.Height);
end;
+
{ CreateDisabledBitmap. Creating TBitmap object with disable button glyph
image. You must destroy it outside by calling TBitmap.Free method. }
@@ -1979,6 +2007,8 @@ begin
clBtnFace, clBtnHighlight, clBtnShadow, True);
end;
+(******************** NOT CONVERTED
+
{ ChangeBitmapColor. This function create new TBitmap object.
You must destroy it outside by calling TBitmap.Free method. }
@@ -2006,6 +2036,8 @@ begin
end;
end;
+******************** NOT CONVERTED *)
+
procedure ImageListDrawDisabled(Images: TCustomImageList; Canvas: TCanvas;
X, Y, Index: Integer; HighLightColor, GrayColor: TColor;
DrawHighlight: Boolean);
@@ -2022,7 +2054,11 @@ begin
begin
Brush.Color := clWhite;
FillRect(Rect(0, 0, Images.Width, Images.Height));
+ {$IFDEF MSWINDOWS}
ImageList_Draw(Images.Handle, Index, Handle, 0, 0, ILD_MASK);
+ {$ELSE}
+ ImageList_Draw ????
+ {$ENDIF}
end;
Bmp.Monochrome := True;
if DrawHighlight then
@@ -2044,6 +2080,7 @@ begin
end;
end;
+
{ Brush Pattern }
function CreateTwoColorsBrushPattern(Color1, Color2: TColor): TBitmap;
@@ -2065,6 +2102,19 @@ begin
end;
end;
+{ A function existing in Delphi's graphics, but missing in LCL.
+ According to Delphi help:
+ "AllocPatternBitmap returns a reference to an 8 by 8 pixel TBitmap that
+ is filled with a pattern. Pixels alternate between BkColor and FgColor colors
+ horizontally and vertically in a quilt pattern." - this is exactly what
+ CreateTwoColorsBrushPattern does... }
+function AllocPatternBitmap(BkColor, FgColor: TColor): TBitmap;
+begin
+ Result := CreateTwoColorsBrushPattern(BkColor, FgColor);
+end;
+
+(******************** NOT CONVERTED
+
{ Icons }
{$IFNDEF CLR}
@@ -2198,14 +2248,14 @@ begin
DeleteObject(Rgn);
end;
end;
-
+******************** NOT CONVERTED *)
function PaletteColor(Color: TColor): Longint;
begin
Result := ColorToRGB(Color) or PaletteMask;
end;
-
+(******************** NOT CONVERTED
function CreateRotatedFont(Font: TFont; Angle: Integer): HFONT;
var
LogFont: TLogFont;
@@ -3000,75 +3050,50 @@ function AppMinimized: Boolean;
begin
Result := IsIconic(GetAppHandle);
end;
+******************** NOT CONVERTED *)
{$IFDEF MSWINDOWS}
-
{ Check if this is the active Windows task }
-{ Copied from implementation of FORMS.PAS }
type
- {$IFNDEF CLR}
PCheckTaskInfo = ^TCheckTaskInfo;
- {$ENDIF !CLR}
TCheckTaskInfo = record
- FocusWnd: Windows.HWND;
+ FocusWnd: HWND;
Found: Boolean;
end;
-{$IFDEF CLR}
- PCheckTaskInfo = TCheckTaskInfo;
-var
- CheckTaskHashLock: TObject = nil;
- CheckTaskInfo: PCheckTaskInfo;
-{$ENDIF CLR}
-
-function CheckTaskWindow(Window: HWND; Data: Longint): LongBool; {$IFNDEF CLR}stdcall;{$ENDIF}
+function CheckTaskWindow(Window: HWND; Data: PtrInt): LongBool; stdcall;
begin
Result := True;
- {$IFDEF CLR}
- if CheckTaskInfo.FocusWnd = Window then
+ if PCheckTaskInfo(Data)^.FocusWnd = Window then
begin
- CheckTaskInfo.Found := True;
- {$ELSE}
- if PCheckTaskInfo(Data).FocusWnd = Window then
- begin
- PCheckTaskInfo(Data).Found := True;
- {$ENDIF CLR}
+ PCheckTaskInfo(Data)^.Found := True;
Result := False;
end;
end;
+{$ENDIF}
function IsForegroundTask: Boolean;
+{$IFDEF MSWINDOWS}
var
Info: TCheckTaskInfo;
+{$ENDIF}
begin
- Info.FocusWnd := Windows.GetActiveWindow;
+{$IFDEF MSWINDOWS}
+ Info.FocusWnd := GetActiveWindow;
Info.Found := False;
-
- {$IFDEF CLR}
- if CheckTaskHashLock = nil then
- CheckTaskHashLock := TObject.Create;
- Monitor.Enter(CheckTaskHashLock);
- try
- CheckTaskInfo := Info;
- EnumThreadWindows(GetCurrentThreadId, CheckTaskWindow, 0);
- Info := CheckTaskInfo;
- finally
- Monitor.Exit(CheckTaskHashLock);
- end;
- {$ELSE}
- EnumThreadWindows(GetCurrentThreadId, @CheckTaskWindow, Longint(@Info));
- {$ENDIF CLR}
+ EnumThreadWindows(GetCurrentThreadID, @CheckTaskWindow, PtrInt(@Info));
Result := Info.Found;
-end;
-
-{$ENDIF MSWINDOWS}
-
-{$IFDEF UNIX}
-function IsForegroundTask: Boolean;
-begin
+{$ELSE}
+ {$IFDEF UNIX}
Result := Application.Active;
+ {$ELSE}
+ Result := true;
+ {$ENDIF}
+{$ENDIF}
end;
-{$ENDIF UNIX}
+
+
+(******************** NOT CONVERTED
function MessageBox(const Msg, Caption: string; const Flags: Integer): Integer;
{$IFDEF CLR}
diff --git a/components/jvcllaz/run/JvCore/JvTypes.pas b/components/jvcllaz/run/JvCore/JvTypes.pas
index 31ff1bf9d..d074d3ee3 100644
--- a/components/jvcllaz/run/JvCore/JvTypes.pas
+++ b/components/jvcllaz/run/JvCore/JvTypes.pas
@@ -31,7 +31,8 @@ Known Issues:
// Conversion is done in incremental way: as types / classes / routines
// are needed they are converted.
-{$mode objfpc}{$H+}
+//{$mode objfpc}{$H+}
+{$MODE DELPHI}
unit JvTypes;
@@ -98,6 +99,7 @@ type
{$IFDEF CLR}
IUnknown = IInterface;
{$ENDIF CLR}
+ ********************)
// Base class for persistent properties that can show events.
// By default, Delphi and BCB don't show the events of a class
@@ -107,14 +109,10 @@ type
// from having events for a sub property.
// The design time editor associated with TJvPersistent will display
// the events, thus mimicking a Sub Component.
- {$IFDEF COMPILER6_UP}
TJvPersistent = class(TComponent)
public
constructor Create(AOwner: TComponent); override;
end;
- {$ELSE}
- TJvPersistent = class(TPersistent);
- {$ENDIF COMPILER6_UP}
// Added by dejoy (2005-04-20)
// A lot of TJVxxx control persistent properties used TPersistent,
@@ -122,7 +120,7 @@ type
// and property change notify.
TJvPropertyChangeEvent = procedure(Sender: TObject; const PropName: string) of object;
- TJvPersistentProperty = class(TPersistent)//?? TJvPersistent
+ TJvPersistentProperty = class(TPersistent) // ?? TJvPersistent)
private
FUpdateCount: Integer;
FOnChanging: TNotifyEvent;
@@ -145,6 +143,7 @@ type
property OnChangingProperty: TJvPropertyChangeEvent read FOnChangingProperty write FOnChangingProperty;
end;
+ (********************
TJvRegKey = (hkClassesRoot, hkCurrentUser, hkLocalMachine, hkUsers,
hkPerformanceData, hkCurrentConfig, hkDynData);
TJvRegKeys = set of TJvRegKey;
@@ -675,8 +674,6 @@ type
implementation
-(***************
-{$IFDEF COMPILER6_UP}
constructor TJvPersistent.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@@ -684,7 +681,6 @@ begin
SetSubComponent(True);
Name := 'SubComponent';
end;
-{$ENDIF COMPILER6_UP}
{ TJvPersistentProperty }
@@ -733,7 +729,6 @@ begin
else
Changed;
end;
-***************)
end.
diff --git a/components/jvcllaz/run/JvCtrls/JvButton.pas b/components/jvcllaz/run/JvCtrls/JvButton.pas
deleted file mode 100644
index 7f14b12ec..000000000
--- a/components/jvcllaz/run/JvCtrls/JvButton.pas
+++ /dev/null
@@ -1,923 +0,0 @@
-{-----------------------------------------------------------------------------
-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: JvButton.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].
-
-You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
-located at http://jvcl.sourceforge.net
-
-Known Issues:
------------------------------------------------------------------------------}
-// $Id: JvButton.pas 11400 2007-06-28 21:24:06Z ahuser $
-
-// Initial port to Lazarus by Sergio Samayoa - september 2007.
-// Conversion is done in incremental way: as types / classes / routines
-// are needed they are converted.
-
-{$mode objfpc}{$H+}
-
-unit JvButton;
-
-interface
-
-uses
- Classes, Controls, Graphics, JvComponent, JvConsts, JvTypes, LMessages, Menus;
-
-type
- TJvButtonMouseState = (bsMouseInside, bsMouseDown);
- TJvButtonMouseStates = set of TJvButtonMouseState;
-
- TJvCustomGraphicButton = class(TJvGraphicControl)
- private
- FStates: TJvButtonMouseStates;
- FBuffer: TBitmap;
- FFlat: Boolean;
- FDropDownMenu: TPopupMenu;
- FDown: Boolean;
- FForceSameSize: Boolean;
- FAllowAllUp: Boolean;
- FGroupIndex: Integer;
- FHotTrack: Boolean;
- FHotFont: TFont;
- FHotTrackFontOptions: TJvTrackFontOptions;
- FOnDropDownMenu: TContextPopupEvent;
- FDropArrow: Boolean;
- FOnDropDownClose: TNotifyEvent;
- function GetPattern: TBitmap;
- procedure SetFlat(const Value: Boolean);
- procedure SetDown(Value: Boolean);
- procedure CMButtonPressed(var Msg: TCMButtonPressed); message CM_JVBUTTONPRESSED;
- procedure CMForceSize(var Msg: TCMForceSize); message CM_FORCESIZE;
- procedure CMSysColorChange(var Msg: TLMessage); message CM_SYSCOLORCHANGE;
- procedure SetForceSameSize(const Value: Boolean);
- procedure SetAllowAllUp(const Value: Boolean);
- procedure SetGroupIndex(const Value: Integer);
- procedure SetHotFont(const Value: TFont);
- procedure SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
- procedure SetDropArrow(const Value: Boolean);
- procedure SetDropDownMenu(const Value: TPopupMenu);
- protected
- procedure ButtonPressed(Sender: TJvCustomGraphicButton; AGroupIndex: Integer); virtual;
- procedure ForceSize(Sender: TControl; AWidth, AHeight: Integer);
- function DoDropDownMenu(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean; virtual;
- procedure DropDownClose;
- procedure UpdateExclusive;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- 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;
- procedure MouseEnter(Control: TControl); override;
- procedure MouseLeave(Control: TControl); override;
- procedure Paint; override;
- procedure PaintButton(ACanvas: TCanvas); virtual;
- procedure PaintFrame(ACanvas: TCanvas); virtual;
- function InsideBtn(X, Y: Integer): Boolean; virtual;
- function WantKey(Key: Integer; Shift: TShiftState;
- const KeyText: WideString): Boolean; override;
- procedure EnabledChanged; override;
- procedure FontChanged; override;
- procedure RepaintBackground; virtual;
- procedure TextChanged; override;
- property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
- property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
- property MouseStates: TJvButtonMouseStates read FStates write FStates default [];
- property ForceSameSize: Boolean read FForceSameSize write SetForceSameSize default False;
- property Pattern: TBitmap read GetPattern;
- property Flat: Boolean read FFlat write SetFlat default False;
- property HotTrack: Boolean read FHotTrack write FHotTrack default False;
- property HotTrackFont: TFont read FHotFont write SetHotFont;
- property HotTrackFontOptions: TJvTrackFontOptions read FHotTrackFontOptions write SetHotTrackFontOptions default
- DefaultTrackFontOptions;
- property Down: Boolean read FDown write SetDown default False;
- property DropDownMenu: TPopupMenu read FDropDownMenu write SetDropDownMenu;
- property DropArrow: Boolean read FDropArrow write SetDropArrow default False;
- property OnDropDownMenu: TContextPopupEvent read FOnDropDownMenu write FOnDropDownMenu;
- property OnDropDownClose: TNotifyEvent read FOnDropDownClose write FOnDropDownClose;
- public
- procedure Click; override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure DrawDropArrow(ACanvas: TCanvas; ArrowRect: TRect); virtual;
- end;
-
-(******************** NOT CONVERTED
- TJvCustomButton = class(TJvExButton)
- private
- FDropDownMenu: TPopupMenu;
- FHotTrack: Boolean;
- FHotFont: TFont;
- FFontSave: TFont;
- FWordWrap: Boolean;
- FForceSameSize: Boolean;
- FHotTrackFontOptions: TJvTrackFontOptions;
- FOnDropDownMenu: TContextPopupEvent;
- FDropArrow: Boolean;
- procedure SetHotFont(const Value: TFont);
- procedure SetWordWrap(const Value: Boolean);
- procedure SetForceSameSize(const Value: Boolean);
- procedure CMForceSize(var Msg: TCMForceSize); message CM_FORCESIZE;
- procedure SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
- procedure SetDropArrow(const Value: Boolean);
- procedure SetDropDownMenu(const Value: TPopupMenu);
- protected
- function DoDropDownMenu(X, Y: Integer): Boolean; virtual;
- procedure ForceSize(Sender: TControl; AWidth, AHeight: Integer);
- procedure MouseEnter(Control: TControl); override;
- procedure MouseLeave(Control: TControl); override;
- procedure FontChanged; override;
- procedure CreateParams(var Params: TCreateParams); override;
- function GetRealCaption: string; dynamic;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
- property ForceSameSize: Boolean read FForceSameSize write SetForceSameSize default False;
- property DropArrow: Boolean read FDropArrow write SetDropArrow default False;
- property DropDownMenu: TPopupMenu read FDropDownMenu write SetDropDownMenu;
- property HotTrack: Boolean read FHotTrack write FHotTrack default False;
- property HotTrackFont: TFont read FHotFont write SetHotFont;
- property HotTrackFontOptions: TJvTrackFontOptions read FHotTrackFontOptions write SetHotTrackFontOptions default
- DefaultTrackFontOptions;
- property HintColor;
- property OnParentColorChange;
- property OnDropDownMenu: TContextPopupEvent read FOnDropDownMenu write FOnDropDownMenu;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure Click;override;
- procedure DrawDropArrow(Canvas: TCanvas; ArrowRect: TRect); virtual;
- procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
- end;
-
- // TJvDropDownButton draws a DropDown button with the DropDown glyph
- // (also themed). It ignores the properties Glyph and Flat
- TJvDropDownButton = class(TSpeedButton)
- protected
- procedure Paint; override;
- public
- constructor Create(AOwner: TComponent); override;
- end;
-******************** NOT CONVERTED *)
-
-implementation
-
-uses
- Forms, JvJVCLUtils, LCLIntf, LCLType, SysUtils;
-
-(******************** NOT CONVERTED
-const
- JvBtnLineSeparator = '|';
-******************** NOT CONVERTED *)
-
-var
- GlobalPattern: TBitmap = nil;
-
-function CreateBrushPattern: TBitmap;
-var
- X, Y: Integer;
-begin
- if GlobalPattern = nil then
- begin
- GlobalPattern := TBitmap.Create;
- try
- GlobalPattern.Width := 8; { must have this size }
- GlobalPattern.Height := 8;
- with GlobalPattern.Canvas do
- begin
- Brush.Style := bsSolid;
- Brush.Color := clBtnFace;
- FillRect(Rect(0, 0, GlobalPattern.Width, GlobalPattern.Height));
- for Y := 0 to 7 do
- for X := 0 to 7 do
- if (Y mod 2) = (X mod 2) then { toggles between even/odd pixels }
- Pixels[X, Y] := clWhite; { on even/odd rows }
- end;
- except
- FreeAndNil(GlobalPattern);
- end;
- end;
- Result := GlobalPattern;
-end;
-
-//=== { TJvCustomGraphicButton } =============================================
-
-constructor TJvCustomGraphicButton.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- ControlStyle := ControlStyle -
- [csOpaque, csDoubleClicks ];
- FStates := [];
- SetBounds(0, 0, 40, 40);
- FBuffer := TBitmap.Create;
- FFlat := False;
- FDropArrow := False;
- FForceSameSize := False;
- FHotFont := TFont.Create;
- FHotTrackFontOptions := DefaultTrackFontOptions;
-end;
-
-destructor TJvCustomGraphicButton.Destroy;
-begin
- FBuffer.Free;
- FHotFont.Free;
- inherited Destroy;
-end;
-
-procedure TJvCustomGraphicButton.DrawDropArrow(ACanvas: TCanvas; ArrowRect: TRect);
-var
- I: Integer;
-begin
- if not Enabled then
- ACanvas.Pen.Color := clInactiveCaption
- else
- ACanvas.Pen.Color := clWindowText;
- for I := 0 to 3 do
- begin
- if ArrowRect.Left + I <= ArrowRect.Right - I then
- begin
- ACanvas.MoveTo(ArrowRect.Left + I, ArrowRect.Top + I);
- ACanvas.LineTo(ArrowRect.Right - I, ArrowRect.Top + I);
- end;
- end;
-end;
-
-{ Handle speedkeys (Alt + key) }
-
-function TJvCustomGraphicButton.WantKey(Key: Integer; Shift: TShiftState;
- const KeyText: WideString): Boolean;
-begin
- Result := IsAccel(Key, Caption) and Enabled and (Shift * KeyboardShiftStates = [ssAlt]);
- if Result then
- Click
- else
- Result := inherited WantKey(Key, Shift, KeyText);
-end;
-
-procedure TJvCustomGraphicButton.EnabledChanged;
-begin
- inherited EnabledChanged;
- if not Enabled then
- FStates := [];
- RepaintBackground;
-end;
-
-procedure TJvCustomGraphicButton.MouseEnter(Control: TControl);
-begin
- if csDesigning in ComponentState then
- Exit;
- if Enabled and not MouseOver then
- begin
- Include(FStates, bsMouseInside);
- inherited MouseEnter(Control);
- if Flat then
- RepaintBackground;
- if HotTrack then
- Repaint;
- end;
-end;
-
-procedure TJvCustomGraphicButton.MouseLeave(Control: TControl);
-begin
- if Enabled and MouseOver then
- begin
- Exclude(FStates, bsMouseInside);
- inherited MouseLeave(Control);
- if Flat then
- RepaintBackground;
- if HotTrack then
- Repaint;
- end;
-end;
-
-procedure TJvCustomGraphicButton.Paint;
-var
- ArrowRect: TRect;
-begin
-// FBuffer.Width := Width;
-// FBuffer.Height := Height;
- PaintFrame(Canvas);
- PaintButton(Canvas);
- if DropArrow and Assigned(DropDownMenu) then
- begin
- ArrowRect := Rect(Width - 16, Height div 2, Width - 9, Height div 2 + 9);
- if bsMouseDown in FStates then
- OffsetRect(ArrowRect, 1, 1);
- DrawDropArrow(Canvas, ArrowRect);
- end;
-// BitBlt(Canvas.Handle, 0, 0, Width,Height, FBuffer.Canvas.Handle, 0, 0, SRCCOPY);
-end;
-
-procedure TJvCustomGraphicButton.PaintFrame(ACanvas: TCanvas);
-begin
- // do nothing
-end;
-
-procedure TJvCustomGraphicButton.PaintButton(ACanvas: TCanvas);
-begin
- if (bsMouseInside in FStates) and HotTrack then
- ACanvas.Font := FHotFont
- else
- ACanvas.Font := Font;
-end;
-
-function TJvCustomGraphicButton.InsideBtn(X, Y: Integer): Boolean;
-begin
- Result := PtInRect(Rect(0, 0, Width, Height), Point(X, Y));
-end;
-
-procedure TJvCustomGraphicButton.MouseDown(Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-var
- Tmp: TPoint;
-begin
- if not Enabled then
- Exit;
-
- inherited MouseDown(Button, Shift, X, Y);
-
- if InsideBtn(X, Y) then
- begin
- FStates := [bsMouseDown, bsMouseInside];
- RepaintBackground;
- end;
- SetCaptureControl(Self);
- Tmp := ClientToScreen(Point(0, Height));
- DoDropDownMenu(Button, Shift, Tmp.X, Tmp.Y);
-end;
-
-procedure TJvCustomGraphicButton.MouseMove(Shift: TShiftState;
- X, Y: Integer);
-begin
- inherited MouseMove(Shift, X, Y);
- if MouseCapture then
- begin
- if not InsideBtn(X, Y) then
- begin
- if bsMouseInside in FStates then
- begin
- Exclude(FStates, bsMouseInside);
- RepaintBackground;
- end;
- end
- else
- begin
- if not (bsMouseInside in FStates) then
- begin
- Include(FStates, bsMouseInside);
- RepaintBackground;
- end;
- end;
- end;
-end;
-
-procedure TJvCustomGraphicButton.MouseUp(Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-begin
- if GetCaptureControl = Self then
- ReleaseCapture;
- if not Enabled then
- Exit;
- inherited MouseUp(Button, Shift, X, Y);
- Exclude(FStates, bsMouseDown);
-
- // 26.09.2007 - SESS:
- // Update bsMouseInside flag also.
- if not InsideBtn(X, Y) and (bsMouseInside in FStates) then
- Exclude(FStates, bsMouseInside);
-
- RepaintBackground;
-end;
-
-function TJvCustomGraphicButton.DoDropDownMenu(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean;
-var
- Msg: TMsg;
- Handled: Boolean;
-begin
- Result := (Button = mbLeft) and (DropDownMenu <> nil);
- if Result then
- begin
- DropDownMenu.PopupComponent := Self;
- Handled := False;
- if Assigned(FOnDropDownMenu) then
- FOnDropDownMenu(Self, Point(X, Y), Handled);
- if not Handled then
- DropDownMenu.Popup(X, Y)
- else
- Exit;
- { wait 'til menu is done }
- while PeekMessage(Msg, 0, LM_MOUSEFIRST, LM_MOUSELAST, PM_REMOVE) do
- {nothing};
- { release button }
- MouseUp(Button, Shift, X, Y);
- DropDownClose;
- end;
-end;
-
-procedure TJvCustomGraphicButton.SetFlat(const Value: Boolean);
-begin
- if FFlat <> Value then
- begin
- FFlat := Value;
- if FFlat then
- ControlStyle := ControlStyle - [csOpaque]
- else
- ControlStyle := ControlStyle + [csOpaque];
- RepaintBackground;
- end;
-end;
-
-procedure TJvCustomGraphicButton.Notification(AComponent: TComponent;
- Operation: TOperation);
-begin
- inherited Notification(AComponent, Operation);
- if (Operation = opRemove) and (AComponent = DropDownMenu) then
- DropDownMenu := nil;
-end;
-
-procedure TJvCustomGraphicButton.SetDown(Value: Boolean);
-begin
- if GroupIndex = 0 then
- Value := False;
- if FDown <> Value then
- begin
- if FDown and not AllowAllUp then
- Exit;
- FDown := Value;
- UpdateExclusive;
- Invalidate;
- end;
-end;
-
-procedure TJvCustomGraphicButton.SetForceSameSize(const Value: Boolean);
-begin
- if FForceSameSize <> Value then
- begin
- FForceSameSize := Value;
- if FForceSameSize then
- SetBounds(Left, Top, Width, Height);
- end;
-end;
-
-procedure TJvCustomGraphicButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
-var
- Form: TCustomForm;
- Msg: TCMForceSize;
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
- if ForceSameSize then
- begin
- Form := GetParentForm(Self);
- if Assigned(Form) then
- begin
- Msg.Msg := CM_FORCESIZE;
- Msg.Sender := Self;
- Msg.NewSize.X := AWidth;
- Msg.NewSize.Y := AHeight;
- Form.Broadcast(Msg);
- end;
- end;
-end;
-
-procedure TJvCustomGraphicButton.CMForceSize(var Msg: TCMForceSize);
-begin
- with Msg do
- ForceSize(Sender, NewSize.x, NewSize.y);
-end;
-
-function TJvCustomGraphicButton.GetPattern: TBitmap;
-begin
- Result := CreateBrushPattern;
-end;
-
-procedure TJvCustomGraphicButton.SetAllowAllUp(const Value: Boolean);
-begin
- if FAllowAllUp <> Value then
- begin
- FAllowAllUp := Value;
- UpdateExclusive;
- end;
-end;
-
-procedure TJvCustomGraphicButton.SetGroupIndex(const Value: Integer);
-begin
- if FGroupIndex <> Value then
- begin
- FGroupIndex := Value;
- UpdateExclusive;
- end;
-end;
-
-procedure TJvCustomGraphicButton.UpdateExclusive;
-var
- Msg: TCMButtonPressed;
-begin
- if (GroupIndex <> 0) and (Parent <> nil) then
- begin
- Msg.Msg := CM_JVBUTTONPRESSED;
- Msg.Index := GroupIndex;
- Msg.Control := Self;
- Msg.Result := 0;
- Parent.Broadcast(Msg);
- end;
-end;
-
-procedure TJvCustomGraphicButton.CMButtonPressed(var Msg: TCMButtonPressed);
-begin
- ButtonPressed(TJvCustomGraphicButton(Msg.Control), Msg.Index);
-end;
-
-procedure TJvCustomGraphicButton.SetHotFont(const Value: TFont);
-begin
- FHotFont.Assign(Value);
-end;
-
-procedure TJvCustomGraphicButton.SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
-begin
- if FHotTrackFontOptions <> Value then
- begin
- FHotTrackFontOptions := Value;
- UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
- end;
-end;
-
-procedure TJvCustomGraphicButton.SetDropArrow(const Value: Boolean);
-begin
- if FDropArrow <> Value then
- begin
- FDropArrow := Value;
- Invalidate;
- end;
-end;
-
-procedure TJvCustomGraphicButton.SetDropDownMenu(const Value: TPopupMenu);
-begin
- if FDropDownMenu <> Value then
- begin
- FDropDownMenu := Value;
- if DropArrow then
- Invalidate;
- end;
-end;
-
-procedure TJvCustomGraphicButton.CMSysColorChange(var Msg: TLMessage);
-begin
- inherited;
- RepaintBackground;
-end;
-
-procedure TJvCustomGraphicButton.FontChanged;
-begin
- inherited FontChanged;
- UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
-end;
-
-procedure TJvCustomGraphicButton.TextChanged;
-begin
- inherited TextChanged;
- RepaintBackground;
-end;
-
-procedure TJvCustomGraphicButton.Click;
-begin
- if GroupIndex <> 0 then
- begin
- if AllowAllUp then
- Down := not Down
- else
- Down := True;
- end;
- try
- inherited Click;
- except
- // Mantis 3097: In case there is an exception, we ensure here that the
- // button is not left "down", and we reraise the exception as we can't
- // handle it and don't want to ignore it.
- Exclude(FStates, bsMouseDown);
- RepaintBackground;
- raise;
- end;
-end;
-
-procedure TJvCustomGraphicButton.ButtonPressed(Sender: TJvCustomGraphicButton;
- AGroupIndex: Integer);
-begin
- if AGroupIndex = GroupIndex then
- if Sender <> Self then
- begin
- if Sender.Down and Down then
- begin
- FDown := False;
- Exclude(FStates, bsMouseDown);
- RepaintBackground;
- end;
- FAllowAllUp := Sender.AllowAllUp;
- end;
-end;
-
-procedure TJvCustomGraphicButton.ForceSize(Sender: TControl; AWidth, AHeight: Integer);
-begin
- if Sender <> Self then
- inherited SetBounds(Left, Top, AWidth, AHeight);
-end;
-
-(******************** NOT CONVERTED
-//=== { TJvCustomButton } ====================================================
-
-constructor TJvCustomButton.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- FDropArrow := False;
- FHotTrack := False;
- FHotFont := TFont.Create;
- FFontSave := TFont.Create;
- // ControlStyle := ControlStyle + [csAcceptsControls];
- FWordWrap := True;
- FForceSameSize := False;
- FHotTrackFontOptions := DefaultTrackFontOptions;
-end;
-
-destructor TJvCustomButton.Destroy;
-begin
- FHotFont.Free;
- FFontSave.Free;
- inherited Destroy;
-end;
-
-procedure TJvCustomButton.Click;
-var
- Tmp: TPoint;
-begin
- // Call ClientToScreen before the inherited Click as the OnClick handler might
- // reset the parent, which is needed by ClientToScreen.
- Tmp := ClientToScreen(Point(0, Height));
- inherited Click;
- DoDropDownMenu(Tmp.X, Tmp.Y);
-end;
-
-procedure TJvCustomButton.DrawDropArrow(Canvas: TCanvas; ArrowRect: TRect);
-var
- I: Integer;
-begin
- if not Enabled then
- Canvas.Pen.Color := clInactiveCaption
- else
- Canvas.Pen.Color := clWindowText;
- for I := 0 to (ArrowRect.Bottom - ArrowRect.Top) do
- begin
- if ArrowRect.Left + I <= ArrowRect.Right - I then
- begin
- Canvas.MoveTo(ArrowRect.Left + I, ArrowRect.Top + I);
- Canvas.LineTo(ArrowRect.Right - I, ArrowRect.Top + I);
- end;
- end;
-end;
-
-procedure TJvCustomButton.CreateParams(var Params: TCreateParams);
-begin
- inherited CreateParams(Params);
- Params.Style := Params.Style or BS_MULTILINE;
-end;
-
-procedure TJvCustomButton.SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
-begin
- if FHotTrackFontOptions <> Value then
- begin
- FHotTrackFontOptions := Value;
- UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
- end;
-end;
-
-procedure TJvCustomButton.SetDropArrow(const Value: Boolean);
-begin
- if FDropArrow <> Value then
- begin
- FDropArrow := Value;
- Invalidate;
- end;
-end;
-
-procedure TJvCustomButton.SetHotFont(const Value: TFont);
-begin
- FHotFont.Assign(Value);
-end;
-
-procedure TJvCustomButton.SetDropDownMenu(const Value: TPopupMenu);
-begin
- if FDropDownMenu <> Value then
- begin
- FDropDownMenu := Value;
- if DropArrow then
- Invalidate;
- end;
-end;
-
-procedure TJvCustomButton.MouseEnter(Control: TControl);
-begin
- if not MouseOver then
- begin
- if FHotTrack then
- begin
- FFontSave.Assign(Font);
- Font.Assign(FHotFont);
- end;
- inherited MouseEnter(Control);
- end;
-end;
-
-procedure TJvCustomButton.MouseLeave(Control: TControl);
-begin
- if MouseOver then
- begin
- if FHotTrack then
- Font.Assign(FFontSave);
- inherited MouseLeave(Control);
- end;
-end;
-
-procedure TJvCustomButton.FontChanged;
-begin
- inherited FontChanged;
- UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
-end;
-
-function TJvCustomButton.GetRealCaption: string;
-begin
- if WordWrap then
- Result := StringReplace(Caption, JvBtnLineSeparator, Lf, [rfReplaceAll])
- else
- Result := Caption;
-end;
-
-procedure TJvCustomButton.SetWordWrap(const Value: Boolean);
-begin
- if FWordWrap <> Value then
- begin
- FWordWrap := Value;
- Invalidate;
- end;
-end;
-
-procedure TJvCustomButton.SetForceSameSize(const Value: Boolean);
-begin
- if FForceSameSize <> Value then
- begin
- FForceSameSize := Value;
- if FForceSameSize then
- SetBounds(Left, Top, Width, Height);
- end;
-end;
-
-procedure TJvCustomButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
-var
- Form: TCustomForm;
- Msg: TCMForceSize;
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
- if ForceSameSize then
- begin
- Form := GetParentForm(Self);
- if Assigned(Form) then
- begin
- Msg.Msg := CM_FORCESIZE;
- Msg.Sender := Self;
- Msg.NewSize.X := AWidth;
- Msg.NewSize.Y := AHeight;
- Form.Broadcast(Msg);
- end;
- end;
-end;
-
-procedure TJvCustomButton.CMForceSize(var Msg: TCMForceSize);
-begin
- with Msg do
- ForceSize(Sender, NewSize.x, NewSize.y);
-end;
-
-procedure TJvCustomButton.Notification(AComponent: TComponent;
- Operation: TOperation);
-begin
- inherited Notification(AComponent, Operation);
- if (Operation = opRemove) and (AComponent = FDropDownMenu) then
- DropDownMenu := nil;
-end;
-******************** NOT CONVERTED *)
-
-procedure TJvCustomGraphicButton.RepaintBackground;
-var
- R: TRect;
-begin
- if (Parent <> nil) and Parent.HandleAllocated then
- begin
- R := BoundsRect;
- InvalidateRect(Parent.Handle, @R, True);
- end;
- Repaint;
-end;
-
-(******************** NOT CONVERTED
-procedure TJvCustomButton.ForceSize(Sender: TControl; AWidth, AHeight: Integer);
-begin
- if Sender <> Self then
- inherited SetBounds(Left, Top, AWidth, AHeight);
-end;
-
-function TJvCustomButton.DoDropDownMenu(X, Y: Integer): Boolean;
-var
- Msg: TMsg;
- Handled: Boolean;
-begin
- Result := (DropDownMenu <> nil);
- if Result then
- begin
- DropDownMenu.PopupComponent := Self;
- case DropDownMenu.Alignment of
- paRight:
- Inc(X, Width);
- paCenter:
- Inc(X, Width div 2);
- end;
- Handled := False;
- if Assigned(FOnDropDownMenu) then
- FOnDropDownMenu(Self, Point(X, Y), Handled);
- if not Handled then
- DropDownMenu.Popup(X, Y)
- else
- Exit;
- { wait 'til menu is done }
- while PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do
- {nothing};
- end;
-end;
-
-//=== { TJvDropDownButton } ==================================================
-
-constructor TJvDropDownButton.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- Width := 16;
- Height := 16;
-end;
-
-procedure TJvDropDownButton.Paint;
-var
- PaintRect: TRect;
- DrawFlags: Integer;
- DC: HDC;
- Bmp: TBitmap;
-begin
- // adjust FState and FDragging
- DC := Canvas.Handle;
- Bmp := TBitmap.Create;
- try
- Bmp.Width := 1;
- Bmp.Height := 1;
- Canvas.Handle := Bmp.Canvas.Handle;
- try
- inherited Paint;
- finally
- Canvas.Handle := DC;
- end;
- finally
- Bmp.Free;
- end;
-
- PaintRect := Rect(0, 0, Width, Height);
- DrawFlags := DFCS_SCROLLCOMBOBOX or DFCS_ADJUSTRECT;
- if FState in [bsDown, bsExclusive] then
- DrawFlags := DrawFlags or DFCS_PUSHED;
-
- {$IFDEF JVCLThemesEnabled}
- if ThemeServices.ThemesEnabled then
- DrawThemedFrameControl(Self, Canvas.Handle, PaintRect, DFC_SCROLL, DrawFlags)
- else
- {$ENDIF JVCLThemesEnabled}
- begin
- DrawFrameControl(Canvas.Handle, PaintRect, DFC_SCROLL, DrawFlags);
-
- end;
-end;
-******************** NOT CONVERTED *)
-
-procedure TJvCustomGraphicButton.DropDownClose;
-begin
- if Assigned(FOnDropDownClose) then
- FOnDropDownClose(Self);
-end;
-
-finalization
- FreeAndNil(GlobalPattern);
-
-end.
-