From 13e96a6e1b2bb7902522ee6b4c19366ba38eb2a3 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 7 Dec 2016 16:17:41 +0000 Subject: [PATCH] jvcllaz: Move unit JvButton.pas to new package JvStdCtrls (like in Delphi version). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5442 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../jvcllaz/design/JvCtrls/JvCtrlsReg.pas | 4 +- .../design/JvStdCtrls/JvStdCtrlsReg.pas | 24 + .../JvNavigationPane/JvNavPaneDemo.lpi | 12 +- components/jvcllaz/packages/JvCtrlsLazR.lpk | 12 +- components/jvcllaz/packages/JvPageCompsR.lpk | 4 +- .../jvcllaz/packages/JvStdCtrlsLazD.lpk | 44 + .../jvcllaz/packages/JvStdCtrlsLazR.lpk | 43 + components/jvcllaz/packages/JvXPCtrlsLazR.lpk | 4 +- components/jvcllaz/run/JvCore/JvConsts.pas | 3 + .../jvcllaz/run/JvCore/JvExControls.pas | 8 +- components/jvcllaz/run/JvCore/JvJCLUtils.pas | 66 +- components/jvcllaz/run/JvCore/JvJVCLUtils.pas | 143 +-- components/jvcllaz/run/JvCore/JvTypes.pas | 15 +- components/jvcllaz/run/JvCtrls/JvButton.pas | 923 ------------------ 14 files changed, 263 insertions(+), 1042 deletions(-) create mode 100644 components/jvcllaz/design/JvStdCtrls/JvStdCtrlsReg.pas create mode 100644 components/jvcllaz/packages/JvStdCtrlsLazD.lpk create mode 100644 components/jvcllaz/packages/JvStdCtrlsLazR.lpk delete mode 100644 components/jvcllaz/run/JvCtrls/JvButton.pas 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. -