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

bgracontrols/test/test_bgra_ribbon_custom/BGRA Ribbon.lpi

@@ -0,0 +1,199 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <CompatibilityMode Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="BGRA Ribbon"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <BuildModes Count="3">
+      <Item1 Name="Debug" Default="True"/>
+      <Item2 Name="Release">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="BGRA_Ribbon"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+              <DebugInfoType Value="dsDwarf2Set"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item2>
+      <Item3 Name="Debug macOS 64">
+        <MacroValues Count="1">
+          <Macro1 Name="LCLWidgetType" Value="cocoa"/>
+        </MacroValues>
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="BGRA_Ribbon"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <IncludeAssertionCode Value="True"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <Checks>
+              <IOChecks Value="True"/>
+              <RangeChecks Value="True"/>
+              <OverflowChecks Value="True"/>
+              <StackChecks Value="True"/>
+            </Checks>
+            <VerifyObjMethodCallValidity Value="True"/>
+            <TargetCPU Value="x86_64"/>
+            <TargetOS Value="darwin"/>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <DebugInfoType Value="dsDwarf2Set"/>
+              <UseHeaptrc Value="True"/>
+              <TrashVariables Value="True"/>
+              <UseExternalDbgSyms Value="True"/>
+            </Debugging>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item3>
+      <SharedMatrixOptions Count="1">
+        <Item1 ID="325839700375" Modes="Debug macOS 64" Type="IDEMacro" MacroName="LCLWidgetType" Value="cocoa"/>
+      </SharedMatrixOptions>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default"/>
+      </Modes>
+    </RunParams>
+    <RequiredPackages Count="5">
+      <Item1>
+        <PackageName Value="SynEdit"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FCL"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="BGRABitmapPack"/>
+      </Item3>
+      <Item4>
+        <PackageName Value="bgracontrols"/>
+      </Item4>
+      <Item5>
+        <PackageName Value="LCL"/>
+      </Item5>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="BGRA Ribbon.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="uMain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="frmMain"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="uRibbon.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="BGRA_Ribbon"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2Set"/>
+        <UseHeaptrc Value="True"/>
+        <TrashVariables Value="True"/>
+        <UseExternalDbgSyms Value="True"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

bgracontrols/test/test_bgra_ribbon_custom/BGRA Ribbon.lpr

@@ -0,0 +1,20 @@
+program BGRARibbon;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, uMain, uRibbon;
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource := True;
+  Application.Initialize;
+  Application.CreateForm(TfrmMain, frmMain);
+  Application.Run;
+end.
+

bgracontrols/test/test_bgra_ribbon_custom/BGRA Ribbon.xml

@@ -0,0 +1,2 @@
+<?xml version="1.0" encoding="utf-8"?>
+<CONFIG FormTop="412" FormLeft="905" FormWidth="366" FormHeight="305"/>

bgracontrols/test/test_bgra_ribbon_custom/BGRA_Ribbon.xml

@@ -0,0 +1,2 @@
+<?xml version="1.0" encoding="utf-8"?>
+<CONFIG FormTop="250" FormLeft="550" FormWidth="600" FormHeight="350"/>

bgracontrols/test/test_bgra_ribbon_custom/uRibbon.pas

@@ -0,0 +1,354 @@
+unit uRibbon;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Controls, Graphics, BCButton, BCTypes, BGRABitmap, BGRABitmapTypes, LResources;
+
+type
+  TBCRibbonStyle = (rsTab, rsButton, rsSeparator, rsMenu);
+
+
+var
+  MainColor,TabFntColor,BtnFntColor:TColor;
+  BtnNormalColor, BtnHoverColor, BtnClickedColor:TColor;
+  TabNormalColor, TabHoverColor, TabClickedColor:TColor;
+  ToolNormalColor,ToolHoverColor,ToolClickedColor:TColor;
+
+{ StyleButtons }
+
+procedure StyleRibbonButtonsSample(AControl: TControl; AStyle: TBCRibbonStyle);
+procedure StyleRibbonBody(AControl: TControl);
+
+{ Drawings }
+
+procedure DrawTabGradient(ABitmap: TBGRABitmap);
+procedure DrawTitleGradient(ABitmap: TBGRABitmap);
+procedure DrawBodyGradient(ABitmap: TBGRABitmap);
+procedure DrawFormGradient(ABitmap: TBGRABitmap);
+
+{ Buttons }
+
+procedure RibbonTab(AButton: TBCButton);
+procedure RibbonTool(AButton: TBCButton);
+procedure RibbonButton(AButton: TBCButton);
+procedure RibbonSeparator(AButton: TBCButton);
+procedure RibbonMenu(AButton: TBCButton);
+
+implementation
+
+  { StyleButtons }
+
+procedure StyleButtons(AControl: TControl; AButton: TBCButton);
+var
+  i, prevNormalFontHeight, prevHoverFontHeight, prevClickedFontHeight: integer;
+  WinControl: TWinControl;
+begin
+  if AControl is TBCButton then
+  begin
+    with TBCButton(AControl) do
+    begin
+      prevNormalFontHeight := StateNormal.FontEx.Height;
+      prevHoverFontHeight := StateHover.FontEx.Height;
+      prevClickedFontHeight := StateClicked.FontEx.Height;
+      AControl.Assign(AButton);
+      StateNormal.FontEx.Height := prevNormalFontHeight;
+      StateHover.FontEx.Height := prevHoverFontHeight;
+      StateClicked.FontEx.Height := prevClickedFontHeight;
+    end;
+  end;
+  if AControl is TWinControl then
+  begin
+    WinControl := TWinControl(AControl);
+    if WinControl.ControlCount = 0 then
+      exit;
+    for i := 0 to WinControl.ControlCount - 1 do
+      StyleButtons(WinControl.Controls[i], AButton);
+  end;
+end;
+
+procedure StyleRibbonButtonsSample(AControl: TControl; AStyle: TBCRibbonStyle);
+var
+  tempBCButton: TBCButton;
+begin
+  tempBCButton := TBCButton.Create(nil);
+  case AStyle of
+    rsTab: RibbonTab(tempBCButton);
+    rsButton: RibbonButton(tempBCButton);
+    rsSeparator: RibbonSeparator(tempBCButton);
+    rsMenu: RibbonMenu(tempBCButton);
+  end;
+  StyleButtons(AControl, tempBCButton);
+  tempBCButton.Free;
+end;
+
+procedure StyleRibbonBody(AControl: TControl);
+var
+  i: integer;
+  WinControl: TWinControl;
+begin
+  if AControl is TWinControl then
+  begin
+    WinControl := TWinControl(AControl);
+    if WinControl.ControlCount = 0 then
+      exit;
+    for i := 0 to WinControl.ControlCount - 1 do
+    begin
+      if WinControl.Controls[i] is TBCButton then
+      begin
+        if WinControl.Controls[i].Caption = '-' then
+        begin
+          StyleRibbonButtonsSample(WinControl.Controls[i], rsSeparator);
+          WinControl.Controls[i].Caption := '';
+        end
+        else
+          StyleRibbonButtonsSample(WinControl.Controls[i], rsButton);
+      end;
+    end;
+  end;
+end;
+
+{ Drawings }
+
+procedure DrawTabGradient(ABitmap: TBGRABitmap);
+var
+  r: TLResource;
+  bmp: TBGRABitmap;
+begin
+  with ABitmap do
+  begin
+    Fill(MainColor);
+    try
+    begin
+//      bmp := TBGRABitmap.Create('back5.png');
+      r:=LazarusResources.Find('ribbon');
+      bmp := TBGRABitmap.Create('back5.png');
+        ABitmap.PutImage(width-220,1,bmp,dmDrawWithTransparency);
+      bmp.Free;
+    end;
+    except
+    end;
+
+//    DrawHorizLine(0, 0, Width - 1, ColorToBGRA(MainColor));
+    DrawHorizLine(1, Height - 1, Width - 2, $00F1F1F1);
+  end;
+end;
+
+procedure DrawTitleGradient(ABitmap: TBGRABitmap);
+var
+  bmp: TBGRABitmap;
+begin
+  with ABitmap do
+  begin
+    Fill(MainColor);
+    try
+    begin
+      bmp := TBGRABitmap.Create('back5.png');
+      ABitmap.PutImage(width-300,-68,bmp,dmDrawWithTransparency);
+      bmp.Free;
+    end;
+    except
+    end;
+  end;
+end;
+
+procedure DrawBodyGradient(ABitmap: TBGRABitmap);
+begin
+  with ABitmap do
+  begin
+{    GradientFill(0, 0, Width, Height, BGRA(247, 251, 255, 255),
+      BGRA(220, 231, 245, 255), gtLinear, PointF(0, 0), PointF(0, Height - 3), dmSet);
+    Rectangle(0, 0, Width, Height - 2, BGRA(255, 255, 255, 75), BGRAPixelTransparent,
+      dmDrawWithTransparency);
+}
+    DrawHorizLine(1, Height - 1, Width - 2, $00D2D2D2); //Top
+//    DrawVertLine(Width-1, 0, Height-1, ColorToBGRA(MainColor));  //Right
+//    DrawVertLine(0, 0, Height-1, ColorToBGRA(MainColor)); //Left
+
+  end;
+end;
+
+procedure DrawFormGradient(ABitmap: TBGRABitmap);
+begin
+  with ABitmap do
+  begin
+//    DrawVertLine(Width-1, 0, Height-1, ColorToBGRA(MainColor));  //Right
+//    DrawHorizLine(0, Height - 1, Width - 1, ColorToBGRA(MainColor)); // Bottom
+//    DrawVertLine(0, 0, Height-1, ColorToBGRA(MainColor)); //Left
+    DrawHorizLine(1, 0, Width - 2, $00E6E6E6); // Top
+//    GradientFill(0, 0, Width, Height, BGRA(197, 207, 223, 255),
+//      BGRA(220, 229, 242, 255), gtLinear, PointF(0, 0), PointF(0, Height), dmSet);
+  end;
+end;
+
+{ Buttons }
+
+procedure RibbonTab(AButton: TBCButton);
+begin
+  with AButton do
+  begin
+    Rounding.RoundX := 0;
+    Rounding.RoundY := 0;
+    BorderSpacing.Top := 4;
+    with StateNormal do
+    begin
+      FontEx.Color := clWhite;
+      Border.Style := bboNone;
+      Background.Color := TabNormalColor;
+      Background.Style := bbsColor;
+    end;
+    with StateHover do
+    begin
+      FontEx.Color := clWhite;
+      Border.Style := bboNone;
+      Background.Color := TabHoverColor;
+      Background.Style := bbsColor;
+    end;
+    with StateClicked do
+    begin
+      FontEx.Color := TabFntColor;
+      Border.Style := bboNone;
+      Background.Color := TabClickedColor;
+      Background.Style := bbsColor;
+    end;
+  end;
+end;
+
+procedure RibbonButton(AButton: TBCButton);
+begin
+  with AButton do
+  begin
+    Rounding.RoundX := 0;
+    Rounding.RoundY := 0;
+    BorderSpacing.Top := 2;
+    BorderSpacing.Left := 2;
+    BorderSpacing.Right := 0;
+    BorderSpacing.Bottom := 16;
+    with StateNormal do
+    begin
+      Border.Style := bboNone;
+      Background.Color := BtnNormalColor;
+      Background.Style := bbsColor;
+      FontEx.Name:='Segoe UI';
+      FontEx.Shadow:=FALSE;
+      FontEx.Color:=BtnFntColor;
+      FontEx.WordBreak:= true;
+      FontEx.TextAlignment := bcaCenterTop;
+      FontEx.Style:=[];
+    end;
+    with StateHover do
+    begin
+      Border.Style := bboNone;
+      Background.Color := BtnHoverColor;
+      Background.Style := bbsColor;
+      FontEx.Name:='Segoe UI';
+      FontEx.Shadow:=FALSE;
+      FontEx.Color:=BtnFntColor;
+      FontEx.WordBreak:= true;
+      FontEx.TextAlignment := bcaCenterTop;
+      FontEx.Style:=[];
+    end;
+    with StateClicked do
+    begin
+      Border.Style := bboNone;
+      Background.Color := BtnClickedColor;
+      Background.Style := bbsColor;
+      FontEx.Name:='Segoe UI';
+      FontEx.Shadow:=FALSE;
+      FontEx.Color:=BtnFntColor;
+      FontEx.WordBreak:= true;
+      FontEx.TextAlignment := bcaCenterTop;
+      FontEx.Style:=[];
+    end;
+  end;
+end;
+
+procedure RibbonTool(AButton: TBCButton);
+begin
+  with AButton do
+  begin
+    Rounding.RoundX := 0;
+    Rounding.RoundY := 0;
+    BorderSpacing.Around := 2;
+    BorderSpacing.Bottom := 2;
+
+    with StateNormal do
+    begin
+      FontEx.Color := clWhite;
+      Border.Style := bboNone;
+      Background.Color := ToolNormalColor;
+      Background.Style := bbsColor;
+    end;
+    with StateHover do
+    begin
+      FontEx.Color := clWhite;
+      Border.Style := bboNone;
+      Background.Color := ToolHoverColor;
+      Background.Style := bbsColor;
+    end;
+    with StateClicked do
+    begin
+      FontEx.Color := clWhite;
+      Border.Style := bboNone;
+      Background.Color := ToolClickedColor;
+      Background.Style := bbsColor;
+    end;
+  end;
+end;
+
+
+procedure RibbonSeparator(AButton: TBCButton);
+begin
+  with AButton do
+  begin
+    StaticButton := True;
+    Color:=clNone;
+    BorderSpacing.Top:=2;
+    BorderSpacing.Bottom:=2;
+    ParentColor:= FALSE;
+    with StateNormal do
+    begin
+      Border.Color := $00D2D0CF;
+      Border.ColorOpacity := 255;
+      Border.Style:=bboSolid;
+      Background.Color := $00d2d2d2;
+      Background.Style := bbsColor;
+
+    end;
+  end;
+end;
+
+procedure RibbonMenu(AButton: TBCButton);
+begin
+  with AButton do
+  begin
+    Rounding.RoundX := 0;
+    Rounding.RoundY := 0;
+    BorderSpacing.Top := 4;
+    with StateNormal do
+    begin
+      FontEx.Color := clWhite;
+      Border.Style := bboNone;
+      Background.Color := TabNormalColor;
+      Background.Style := bbsColor;
+    end;
+    with StateHover do
+    begin
+      FontEx.Color := clWhite;
+      Border.Style := bboNone;
+      Background.Color := TabHoverColor;
+      Background.Style := bbsColor;
+    end;
+    with StateClicked do
+    begin
+      FontEx.Color := $009A572A;
+      Border.Style := bboNone;
+      Background.Color := TabClickedColor;
+      Background.Style := bbsColor;
+    end;
+  end;
+
+end;
+end.

bgracontrols/test/test_bgra_ribbon_custom/uresize.lfm

@@ -0,0 +1,11 @@
+object ResizeForm: TResizeForm
+  Left = 489
+  Height = 240
+  Top = 497
+  Width = 320
+  BorderStyle = bsNone
+  Caption = 'ResizeForm'
+  OnMouseMove = FormMouseMove
+  OnMouseUp = FormMouseUp
+  LCLVersion = '1.4.4.0'
+end

bgracontrols/test/test_bgra_ribbon_custom/uresize.pas

@@ -0,0 +1,105 @@
+unit uResize;
+{
+  Copyright 2014 Michael Thomas Greer
+  Distributed under the Boost Software License, Version 1.0
+  (See accompanying file LICENSE.txt or copy
+   at http://www.boost.org/LICENSE_1_0.txt )
+}
+
+//////////////////////////////////////////////////////////////////////////////
+interface
+//////////////////////////////////////////////////////////////////////////////
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Windows;
+
+const
+  ResizeMaskLeft   = $1;
+  ResizeMaskTop    = $2;
+  ResizeMaskWidth  = $4;
+  ResizeMaskHeight = $8;
+
+type
+
+  { TResizeForm }
+
+  TResizeForm = class( TForm )
+    procedure FormMouseMove( Sender: TObject;      Shift: TShiftState; X, Y: Integer );
+    procedure FormMouseUp(   Sender: TObject;
+                             Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
+  private
+    anchor_g: TRect;
+    anchor_c: TPoint;
+    form_ref: TForm;
+    resize_m: cardinal;
+
+  public
+    procedure SetMouseDown( AForm: TForm; ResizeMask: cardinal );
+  end;
+
+var
+  ResizeForm: TResizeForm;
+
+
+//////////////////////////////////////////////////////////////////////////////
+implementation
+//////////////////////////////////////////////////////////////////////////////
+
+{$R *.lfm}
+
+//----------------------------------------------------------------------------
+procedure TResizeForm.SetMouseDown( AForm: TForm; ResizeMask: cardinal );
+  begin
+  anchor_g.Left   := AForm.Left;
+  anchor_g.Top    := AForm.Top;
+  anchor_g.Right  := AForm.Width;
+  anchor_g.Bottom := AForm.Height;
+  anchor_c        := Mouse.CursorPos;
+  form_ref        := AForm;
+  resize_m        := ResizeMask;
+  SetCapture( Handle )
+  end;
+
+//----------------------------------------------------------------------------
+procedure TResizeForm.FormMouseMove(
+  Sender: TObject;
+  Shift:  TShiftState;
+  X, Y:   Integer
+  );
+  var
+    p: TPoint;
+    r: TRect;
+  begin
+  if Assigned( form_ref ) and (ssLeft in Shift)
+    then begin
+         p := Mouse.CursorPos;
+         Dec( p.x, anchor_c.x );
+         Dec( p.y, anchor_c.y );
+
+         r.Left   := form_ref.Left;
+         r.Top    := form_ref.Top;
+         r.Right  := form_ref.Width;
+         r.Bottom := form_ref.Height;
+
+         if (resize_m and ResizeMaskLeft)   <> 0 then begin r.Left   := anchor_g.Left   + p.x;  p.x := -p.x end;
+         if (resize_m and ResizeMaskTop)    <> 0 then begin r.Top    := anchor_g.Top    + p.y;  p.y := -p.y end;
+         if (resize_m and ResizeMaskWidth)  <> 0 then       r.Right  := anchor_g.Right  + p.x;
+         if (resize_m and ResizeMaskHeight) <> 0 then       r.Bottom := anchor_g.Bottom + p.y;
+
+         with r do form_ref.SetBounds( Left, Top, Right, Bottom )
+         end
+  end;
+
+//----------------------------------------------------------------------------
+procedure TResizeForm.FormMouseUp(
+  Sender: TObject;
+  Button: TMouseButton;
+  Shift:  TShiftState;
+  X, Y:   Integer
+  );
+  begin
+  ReleaseCapture;
+  form_ref := nil
+  end;
+
+end.