babaev-an/lasarus_compotents
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Стартовый пул

Browse Source
This commit is contained in:
Александр Бабаев
2024-04-02 08:46:59 +03:00
parent fd57fffd3a
commit 3bb34d000b
5591 changed files with 3291734 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
bgracontrols/test/test_checklistbox/project1.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 130 KiB

80
bgracontrols/test/test_checklistbox/project1.lpi Normal file
View File

@@ -0,0 +1,80 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="project1"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="bgracontrols"/>
</Item>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

25
bgracontrols/test/test_checklistbox/project1.lpr Normal file
View File

@@ -0,0 +1,25 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

30
bgracontrols/test/test_checklistbox/unit1.lfm Normal file
View File

@@ -0,0 +1,30 @@
object Form1: TForm1
Left = 285
Height = 240
Top = 31
Width = 320
Caption = 'Form1'
ClientHeight = 240
ClientWidth = 320
OnCreate = FormCreate
LCLVersion = '2.2.6.0'
object CheckListBox1: TCheckListBox
Left = 48
Height = 174
Top = 32
Width = 198
ItemHeight = 32
OnDrawItem = CheckListBox1DrawItem
Style = lbOwnerDrawFixed
TabOrder = 0
end
object BGRAThemeCheckBox1: TBGRAThemeCheckBox
Left = 48
Height = 19
Top = 8
Width = 165
Caption = 'BGRAThemeCheckBox1'
Checked = False
TabOrder = 1
end
end

125
bgracontrols/test/test_checklistbox/unit1.pas Normal file
View File

@@ -0,0 +1,125 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, CheckLst, Types,
StdCtrls, BGRAThemeCheckBox, BGRABitmap, BGRABitmapTypes, BGRATheme;
type
{ TForm1 }
TForm1 = class(TForm)
BGRAThemeCheckBox1: TBGRAThemeCheckBox;
CheckListBox1: TCheckListBox;
procedure CheckListBox1DrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
procedure FormCreate(Sender: TObject);
private
procedure DrawCheckBox(aCaption: string; State: TBGRAThemeButtonState;
aFocused: boolean; Checked: boolean; ARect: TRect;
ASurface: TBGRAThemeSurface);
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.CheckListBox1DrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
var
surface: TBGRAThemeSurface;
parentForm: TCustomForm;
lclDPI: Integer;
begin
parentForm := GetParentForm(Control, False);
if Assigned(parentForm) then
lclDPI := parentForm.PixelsPerInch
else lclDPI := Screen.PixelsPerInch;
surface := TBGRAThemeSurface.Create(ARect, TCheckListBox(Control).Canvas, Control.GetCanvasScaleFactor, lclDPI);
try
DrawCheckBox(TCheckListBox(Control).Items[Index], btbsNormal, False, TCheckListBox(Control).Checked[Index], ARect, surface);
finally
surface.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CheckListBox1.AddItem('Red', nil);
CheckListBox1.AddItem('Green', nil);
CheckListBox1.AddItem('Blue', nil);
CheckListBox1.AddItem('Alpha', nil);
end;
procedure TForm1.DrawCheckBox(aCaption: string; State: TBGRAThemeButtonState;
aFocused: boolean; Checked: boolean; ARect: TRect; ASurface: TBGRAThemeSurface
);
var
Style: TTextStyle;
aColor: TBGRAPixel;
aleft, atop, aright, abottom: integer;
penWidth: single;
begin
with ASurface do
begin
DestCanvas.Font.Color := clBlack;
case State of
btbsHover: aColor := BGRA(0, 120, 215);
btbsActive: aColor := BGRA(0, 84, 153);
btbsDisabled:
begin
DestCanvas.Font.Color := clGray;
aColor := BGRA(204, 204, 204);
end;
else {btbsNormal}
aColor := BGRABlack;
end;
Bitmap.Fill(BGRAWhite);
BitmapRect := ARect;
penWidth := ASurface.ScaleForBitmap(10) / 10;
aleft := round(penWidth);
aright := Bitmap.Height-round(penWidth);
atop := round(penWidth);
abottom := Bitmap.Height-round(penWidth);
Bitmap.RectangleAntialias(aleft-0.5+penWidth/2, atop-0.5+penWidth/2,
aright-0.5-penWidth/2, abottom-0.5-penWidth/2,
aColor, penWidth);
aleft := round(penWidth*2);
aright := Bitmap.Height-round(penWidth*2);
atop := round(penWidth*2);
abottom := Bitmap.Height-round(penWidth*2);
if Checked then
Bitmap.DrawPolyLineAntialias(Bitmap.ComputeBezierSpline(
[BezierCurve(pointF(aleft + 2, atop + 3), PointF((aleft + aright - 1) / 2, abottom - 3)),
BezierCurve(PointF((aleft + aright - 1) / 2, abottom - 3), PointF(
(aleft + aright - 1) / 2, (atop * 2 + abottom - 1) / 3), PointF(aright - 2, atop))]),
Color, penWidth*1.5);
DrawBitmap;
if aCaption <> '' then
begin
fillchar(Style, sizeof(Style), 0);
Style.Alignment := taLeftJustify;
Style.Layout := tlCenter;
Style.Wordbreak := True;
DestCanvas.TextRect(ARect,
ARect.Height, 0, aCaption, Style);
end;
end;
end;
end.