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

splashabout_component/poweredby/poweredby.lpk

@@ -0,0 +1,63 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <Package Version="4">
+    <PathDelim Value="\"/>
+    <Name Value="poweredby"/>
+    <AddToProjectUsesSection Value="True"/>
+    <Author Value="minesadorada@charcodelvalle.com"/>
+    <CompilerOptions>
+      <Version Value="11"/>
+      <PathDelim Value="\"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <Linking>
+        <Debugging>
+          <GenerateDebugInfo Value="False"/>
+        </Debugging>
+      </Linking>
+      <Other>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Description Value="Method: ShowPoweredBy
+Graphic shown will depend on widgetset"/>
+    <License Value="TPoweredby Component
+
+  Copyright (C)2014 Gordon Bamber minesadorada@charcodelvalle.com
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.   "/>
+    <Version Major="1" Release="3"/>
+    <Files Count="1">
+      <Item1>
+        <Filename Value="upoweredby.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="uPoweredby"/>
+      </Item1>
+    </Files>
+    <Type Value="RunAndDesignTime"/>
+    <RequiredPkgs Count="1">
+      <Item1>
+        <PackageName Value="IDEIntf"/>
+      </Item1>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

splashabout_component/poweredby/poweredby.pas

@@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit poweredby;
+
+interface
+
+uses
+  uPoweredby, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+  RegisterUnit('uPoweredby', @uPoweredby.Register);
+end;
+
+initialization
+  RegisterPackage('poweredby', @Register);
+end.

splashabout_component/poweredby/upoweredby.pas

@@ -0,0 +1,296 @@
+{ TPoweredby Component
+
+  Copyright (C)2014 Gordon Bamber minesadorada@charcodelvalle.com
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit uPoweredby;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, Controls, Dialogs, Forms, Graphics, LResources, SysUtils,
+  ExtCtrls, InterfaceBase, LCLType,LCLVersion;
+
+const
+  C_VERSIONSTRING = '1.0.3.0';
+  C_WIDGETSET_GTK = 'GTK widget set';
+  C_WIDGETSET_GTK2 = 'GTK 2 widget set';
+  C_WIDGETSET_GTK3 = 'GTK 3 widget set';
+  C_WIDGETSET_WIN = 'Win32/Win64 widget set';
+  C_WIDGETSET_WINCE = 'WinCE widget set';
+  C_WIDGETSET_CARBON = 'Carbon widget set';
+  C_WIDGETSET_QT = 'QT widget set';
+  C_WIDGETSET_fpGUI = 'fpGUI widget set';
+  C_WIDGETSET_COCOA = 'Cocoa widget set';
+  C_WIDGETSET_CUSTOM = 'Custom drawn widget set';
+  C_WIDGETSET_OTHER = 'Other gui';
+
+type
+  TPoweredby = class(TComponent)
+  private
+    { Private declarations }
+    fPoweredByForm: TForm;
+    fVersionString: string;
+    fDelayMilliseconds: integer;
+    fFadeInMilliseconds: integer;
+    fShowOnlyOnce,fAlreadyShown:Boolean;
+    // Used by Timer to close the PoweredBy form
+    procedure ClosePoweredByForm(Sender: TObject);
+    // Windows only!
+    procedure FadeInPoweredBy(Sender: TObject);
+    procedure SetDelayMilliSeconds(AValue: integer);
+    function GetWidgetSetString: string;
+    Function GetFPCTargetInfoString: String;
+    Function GetInfoLCLVersion:String;
+    Function GetInfoFPCVersion:String;
+  protected
+    { Protected declarations }
+  public
+    { Public declarations }
+    // Call the method 'ShowPoweredByForm' to show the shaped window
+    procedure ShowPoweredByForm;
+    // Called when component is dropped onto a form
+    constructor Create(AOwner: TComponent); override;
+  published
+    { Published declarations }
+    // Minimum delay=1000msec; Maximum delay=10000msec.  Fade-in time is automatically adjusted
+    property DelayMilliSecs: integer read fDelayMilliSeconds write SetDelayMilliSeconds default 1000;
+    // Call the method 'ShowPoweredByForm' to show the shaped window
+    property Version: string read fVersionString;
+    // Reports the current WidgetSet
+    property InfoWidgetSet: string read GetWidgetSetString;
+    // Reports your current Environment
+    property InfoFPCTarget:String read GetFPCTargetInfoString;
+    // Reports your current Environment
+    property InfoFPCVersion:String read GetInfoFPCVersion;
+    // Reports your current Environment
+    property InfoLCLVersion:String read GetInfoLCLVersion;
+    // Useful if you have ShowPoweredByForm in your TForm.Activate() method
+    property ShowOnlyOnce:boolean read fShowOnlyOnce write fShowOnlyOnce default false;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  {$I upoweredby_icon.lrs}
+  RegisterComponents('Additional', [TPoweredby]);
+end;
+
+constructor TPoweredby.Create(AOwner: TComponent);
+  // Initialise private vars
+begin
+  inherited Create(AOwner);
+  fVersionString := C_VERSIONSTRING;
+  fDelayMilliseconds := 1000;
+  fFadeInMilliseconds := 20;
+  fAlreadyShown:=False;
+  fShowOnlyOnce:=False;
+end;
+Function TPoweredby.GetInfoLCLVersion:String;
+begin
+  result:=lcl_version;
+end;
+Function TPoweredby.GetInfoFPCVersion:String;
+begin
+  Result:={$I %FPCVERSION%};
+end;
+Function TPoweredby.GetFPCTargetInfoString: String;
+begin
+  Result := {$I %FPCTARGETCPU%}+' - '+{$I %FPCTARGETOS%};
+end;
+
+function priv_GetWidgetSetString: string;
+  // This code cannot be a method of TPoweredBy
+begin
+  case WidgetSet.LCLPlatform of
+    lpGtk: Result := C_WIDGETSET_GTK;
+    lpGtk2: Result := C_WIDGETSET_GTK2;
+    lpWin32: Result := C_WIDGETSET_WIN;
+    lpWinCE: Result := C_WIDGETSET_WINCE;
+    lpCarbon: Result := C_WIDGETSET_CARBON;
+    lpCocoa: Result := C_WIDGETSET_COCOA;
+    lpQT: Result := C_WIDGETSET_QT;
+    lpfpGUI: Result := C_WIDGETSET_fpGUI;
+    // When were these first included in InterfaceBase?
+    {$IFDEF FPC_FULLVERSION>24200}
+    lpGtk3: Result := C_WIDGETSET_GTK3;
+    lpCustomDrawn: Result := C_WIDGETSET_CUSTOM;
+    {$ENDIF}
+    else
+      Result := C_WIDGETSET_OTHER;
+  end;
+end;
+
+function TPoweredby.GetWidgetSetString: string;
+begin
+  Result := priv_GetWidgetSetString;
+end;
+
+procedure TPoweredby.SetDelayMilliSeconds(AValue: integer);
+begin
+  if ((fDelayMilliSeconds <> AValue) and (AValue > 0) and (AValue < 11000)) then
+  begin
+    fDelayMilliseconds := AValue;
+    fFadeInMilliseconds := (AValue div 1000) * 20;
+  end;
+
+end;
+
+procedure TPoweredby.ClosePoweredByForm(Sender: TObject);
+// Called by Timer event in ShowPoweredByForm to close Modal window
+// Also the image OnClick event
+begin
+  fPoweredByForm.Close;
+end;
+
+procedure TPoweredby.FadeInPoweredBy(Sender: TObject);
+// Use Alphablend property of TForm
+begin
+  if (fPoweredByForm.AlphaBlendValue < 245) then
+    fPoweredByForm.AlphaBlendValue := fPoweredByForm.AlphaBlendValue + 10;
+end;
+
+function CanShowRoundedGraphic: boolean;
+{
+Check the current WidgetSet, and add to the list that can show the rounded graphic
+Choices are:
+  lpGtk,
+  lpGtk2,
+  lpGtk3,
+  lpWin32,
+  lpWinCE,
+  lpCarbon,
+  lpQT,
+  lpfpGUI,
+  lpNoGUI,
+  lpCocoa,
+  lpCustomDrawn
+  }
+begin
+  case WidgetSet.LCLPlatform of
+    lpWin32, lpQT: Result := True;
+    else
+      Result := False;
+  end;
+end;
+
+procedure TPoweredby.ShowPoweredByForm;
+
+// Graphics are in masks.lrs
+// 1 ) Constructs a new TForm with an image control
+// 2 ) Uses the 'SetShape' method of the form canvas to create a transparent mask
+// 3 ) Paints the Timage over it with a color image
+// 4 ) Sets a timer to fade it in using the Alphablend property
+// 5 ) Sets another timer to close the form
+
+// Note: Windows can fade in a shaped transparent screen
+// But some widgetsets (GTK,Carbon) cannot
+var
+  img_Background: TImage;
+  MyBitmap: TBitMap;
+  DelayTimer: TTimer;
+  FadeInTimer: TTImer;
+begin
+  // Respect the ShowOnlyOnce property setting
+  If ((fShowOnlyOnce=TRUE) AND (fAlreadyShown=TRUE)) then Exit;
+
+  // Try..Finally so we can be sure resources are Freed
+  try
+    try
+      // Create controls
+      fPoweredByForm := TForm.Create(nil);
+      fPoweredByForm.AlphaBlend := True;
+      fPoweredByForm.AlphaBlendValue := 0;
+      img_background := TImage.Create(fPoweredByForm);
+      // Bitmap mask - Load from resource
+      MyBitmap := TBitMap.Create;
+      MyBitmap.LoadFromLazarusResource('powered_by_mask');
+      // Delay Timer
+      Delaytimer := TTimer.Create(fPoweredByForm);
+      delaytimer.Interval := fDelayMilliseconds;
+      delaytimer.OnTimer := @ClosePoweredByForm;
+
+      FadeInTimer := TTimer.Create(fPoweredByForm);
+      FadeInTimer.Interval := fFadeInMilliseconds;
+      FadeInTimer.OnTimer := @FadeInPoweredBy;
+
+      // BackGround image - load from resource
+      with img_background do
+      begin
+        Align := alClient;
+        Stretch := True;
+        Parent := fPoweredByForm;
+        if CanShowRoundedGraphic then
+          Picture.LoadFromLazarusResource('win_powered_by')
+        else
+          Picture.LoadFromLazarusResource('powered_by');
+        OnClick := @ClosePoweredByForm;
+        SendToBack;
+      end;
+      // Set form properties
+      with fPoweredByForm do
+      begin
+        position := poScreenCenter;
+        borderstyle := bsnone;
+        formstyle := fsSystemStayOnTop;
+        OnClick := @ClosePoweredByForm;
+        color := clBlack;
+        Height := MyBitmap.Height;
+        Width := MyBitMap.Width;
+        if CanShowRoundedGraphic then
+        begin
+          MyBitMap.Transparent := True;
+          MyBitMap.TransparentColor := clBlack;
+          Canvas.Draw(0, 0, MyBitMap);
+          // raises Floating Point Error in linux GTK (!??)
+          SetShape(MyBitMap);
+        end
+        else
+        begin
+          // If square graphic, then adjust form size
+             height:=img_background.Picture.Height;
+             width:=img_background.picture.width;
+        end;
+        // Now show the completed form
+        delaytimer.Enabled := True;
+        FadeInTimer.Enabled := True;
+        Application.ProcessMessages;
+        ShowModal; // Closed via the Timer event or a user click
+        fAlreadyShown:=TRUE;
+      end;
+    except
+      On E: Exception do
+        raise Exception.CreateFmt('%s Error: %s', [Name, Exception.ClassName]);
+    end;
+  finally
+    FreeAndNil(img_background);
+    FreeAndNil(MyBitMap);
+    FreeAndNil(delayTimer);
+    FreeAndNil(FadeInTimer);
+    FreeAndNil(fPoweredByForm);
+  end;
+end;
+
+initialization
+  // Load graphics as lazarus resources into the component
+{$I graphics.lrs}
+
+end.