pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

jvcllaz: Make available some "trivial" functions of unit JvJVCLUtils.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8073 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-08-14 13:45:29 +00:00
parent 06d8559a46
commit e2cb8dd822
1 changed files with 47 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

75
components/jvcllaz/run/JvCore/jvjvclutils.pas
View File

@ -37,8 +37,8 @@ uses
{$IFDEF WINDOWS}
Windows, // before Types!
{$ENDIF}
Classes, Graphics, Controls, ImgList,
LCLType, LCLProc, LCLVersion, LMessages, Types,
Classes, Graphics, Controls, ImgList, Menus, Forms, Types,
LCLType, LCLProc, LCLVersion, LMessages,
JvTypes;
(******************** NOT CONVERTED
@ -360,8 +360,10 @@ function ToRightOf(const pc: TControl; piSpace: Integer = 0): Integer;
{ sets the top of pc to be in the middle of pcParent }
procedure CenterHeight(const pc, pcParent: TControl);
procedure CenterHor(Parent: TControl; MinLeft: Integer; Controls: array of TControl);
*)
procedure EnableControls(Control: TWinControl; const Enable: Boolean);
procedure EnableMenuItems(MenuItem: TMenuItem; const Tag: Integer; const Enable: Boolean);
(*
procedure ExpandWidth(Parent: TControl; MinWidth: Integer; Controls: array of TControl);
function PanelBorder(Panel: TCustomPanel): Integer;
function Pixels(Control: TControl; APixels: Integer): Integer;
@ -420,10 +422,10 @@ procedure SaveGridLayout(Grid: TCustomGrid; const AppStorage: TJvCustomAppStorag
function StrToIniStr(const Str: string): string;
function IniStrToStr(const Str: string): string;
*)
// Ini Utilitie Functions
// Ini Utility Functions
// Added by RDB
function FontStylesToString(Styles: TFontStyles): string;
function StringToFontStyles(const Styles: string): TFontStyles;
@ -434,7 +436,7 @@ function RectToStr(Rect: TRect): string;
function StrToRect(const Str: string; const Def: TRect): TRect;
function PointToStr(P: TPoint): string;
function StrToPoint(const Str: string; const Def: TPoint): TPoint;
(************* NOT CONVERTED
{
function IniReadString(IniFile: TObject; const Section, Ident,
Default: string): string;
@ -472,9 +474,9 @@ procedure InternalRestoreMDIChildren(MainForm: TForm; const AppStorage: TJvCusto
type
TMappingMethod = (mmHistogram, mmQuantize, mmTrunc784, mmTrunc666,
mmTripel, mmGrayscale);
*)
function GetBitmapPixelFormat(Bitmap: TBitmap): TPixelFormat;
(************** NOT CONVERED ***
function GetPaletteBitmapFormat(Bitmap: TBitmap): TPixelFormat;
{$IFNDEF CLR}
procedure SetBitmapPixelFormat(Bitmap: TBitmap; PixelFormat: TPixelFormat;
@ -719,18 +721,18 @@ function GetAppHandle: THandle;
// Direction defines the direction of the arrow. If Direction is akLeft, the arrow point is
// pointing to the left
procedure DrawArrow(Canvas: TCanvas; Rect: TRect; Color: TColor = clBlack; Direction: TAnchorKind = akBottom);
***********)
function IsPositiveResult(Value: TModalResult): Boolean;
function IsNegativeResult(Value: TModalResult): Boolean;
function IsAbortResult(const Value: TModalResult): Boolean;
function StripAllFromResult(const Value: TModalResult): TModalResult;
// returns either BrightColor or DarkColor depending on the luminance of AColor
// This function gives the same result (AFAIK) as the function used in Windows to
// calculate the desktop icon text color based on the desktop background color
{ Returns either BrightColor or DarkColor depending on the luminance of AColor
This function gives the same result (AFAIK) as the function used in Windows to
calculate the desktop icon text color based on the desktop background color }
function SelectColorByLuminance(AColor, DarkColor, BrightColor: TColor): TColor;
// (peter3) implementation moved from JvHTControls.
************)
type
TJvHTMLCalcType = (htmlShow, htmlCalcWidth, htmlCalcHeight, htmlHyperLink);
@ -864,7 +866,7 @@ function Scale96ToForm(ASize: Integer): Integer;
implementation
uses
sysutils, LCLIntf, GraphType, Math, Forms,
sysutils, LCLIntf, GraphType, GraphUtil, Math,
{$IFDEF MSWINDOWS}
CommCtrl,
{$ENDIF}
@ -889,12 +891,17 @@ const
RC_TileWallpaper = 'TileWallpaper';
RC_RunCpl = 'rundll32.exe shell32,Control_RunDLL ';
{$ENDIF MSWINDOWS}
**********************)
const
SInvalidBitmap = 'Invalid bitmap';
function GetAppHandle: THandle;
begin
Result := Application.Handle;
end;
(***************** NOT CONVERTED ***
type
TWaitCursor = class(TInterfacedObject, IInterface)
private
@ -2253,9 +2260,6 @@ begin
end;
function PointInPolyRgn(const P: TPoint; const Points: array of TPoint):
Boolean;
{$IFNDEF CLR}
@ -3534,6 +3538,7 @@ begin
for I := Low(Controls) to High(Controls) do
Controls[I].Left := Max(MinLeft, (Parent.Width - Controls[I].Width) div 2);
end;
***************)
procedure EnableControls(Control: TWinControl; const Enable: Boolean);
var
@ -3552,6 +3557,7 @@ begin
MenuItem[I].Enabled := Enable;
end;
(************** NOT CONVERTED
procedure ExpandWidth(Parent: TControl; MinWidth: Integer; Controls: array of TControl);
var
I: Integer;
@ -4456,6 +4462,9 @@ end;
{ end JvAppUtils }
******************)
{ begin JvGraph }
// (rom) moved here to make JvMaxMin obsolete
@ -4471,11 +4480,7 @@ end;
procedure InvalidBitmap;
begin
{$IFDEF CLR}
raise EInvalidGraphic.Create(SInvalidBitmap);
{$ELSE}
raise EInvalidGraphic.CreateRes(@SInvalidBitmap);
{$ENDIF CLR}
end;
function WidthBytes(I: Longint): Longint;
@ -4498,7 +4503,7 @@ begin
end;
(************************* NOT CONVERTED
function ScreenPixelFormat: TPixelFormat;
var
DC: HDC;
@ -5612,13 +5617,14 @@ begin
end;
end;
end;
*****)
function GetBitmapPixelFormat(Bitmap: TBitmap): TPixelFormat;
begin
Result := Bitmap.PixelFormat;
end;
(*************** NOT CONVERTED ***
function BytesPerScanLine(PixelsPerScanline, BitsPerPixel,
Alignment: Longint): Longint;
begin
@ -6624,6 +6630,7 @@ begin
except
end;
end;
*************)
const
Lefts = ['[', '{', '('];
@ -6657,8 +6664,6 @@ begin
Include(Result, fsStrikeOut);
end;
function FontToString(Font: TFont): string;
begin
with Font do
@ -6667,15 +6672,28 @@ begin
end;
function StringToFont(const Str: string): TFont;
{
const
Delims = [',', ';'];
}
var
{
Pos: Integer;
I: Byte;
S: string;
}
sa: TStringArray;
begin
Result := TFont.Create;
try
sa := Str.Split([',', ';']);
Result.Name := sa[0];
Result.Size := StrToIntDef(sa[1], Result.Size);
Result.Style := StringToFontStyles(sa[2]);
Result.Pitch := TFontPitch(StrToIntDef(sa[3], ord(Result.Pitch)));
Result.Color := StringToColor(sa[4]);
Result.CharSet := TFontCharSet(StrToIntDef(sa[5], Result.CharSet));
{ --- original JVCL code, replaced by above FPC code ---
Pos := 1;
I := 0;
while Pos <= Length(Str) do
@ -6697,6 +6715,7 @@ begin
Result.Charset := TFontCharset(StrToIntDef(S, Result.Charset));
end;
end;
}
finally
end;
end;
@ -6777,6 +6796,7 @@ begin
end;
end;
(************** NOT CONVERTED
procedure DrawArrow(Canvas: TCanvas; Rect: TRect; Color: TColor = clBlack; Direction: TAnchorKind = akBottom);
var
I, Size: Integer;
@ -6820,7 +6840,7 @@ begin
end;
end;
end;
*********)
function IsPositiveResult(Value: TModalResult): Boolean;
begin
Result := Value in [mrOk, mrYes, mrAll, mrYesToAll];
@ -6848,7 +6868,7 @@ begin
else
Result := Value;
end;
end; *)
end;
//=== { TJvPoint } ===========================================================
@ -7069,7 +7089,7 @@ begin
DoChange;
end;
end;
(*
function SelectColorByLuminance(AColor, DarkColor, BrightColor: TColor): TColor;
var
ACol: Longint;
@ -7080,7 +7100,6 @@ begin
else
Result := BrightColor;
end;
***********)
const
cBR = '<BR>';