jvcllaz: New component JvFormWallpaper

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6738 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/jvcllaz/design/JvAppFrm/images/images.txt

@@ -1 +1,2 @@
 tjvformanimatedicon.bmp
+tjvformwallpaper.bmp

components/jvcllaz/design/JvAppFrm/jvappfrmreg.pas

@@ -16,12 +16,12 @@ implementation
 uses
   Classes, //PropEdits, ComponentEditors,
   JvDsgnConsts,
-  JvFormAnimatedIcon;
+  JvFormAnimatedIcon, JvFormWallPaper;
 
 procedure Register;
 begin
   RegisterComponents(RsPaletteJvcl, [
-    TJvFormAnimatedIcon
+    TJvFormAnimatedIcon, TJvFormWallPaper
   ]);
 end;
 

components/jvcllaz/examples/JvFormWallper/JvFormWallpaper_Demo.lpi

@@ -0,0 +1,81 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="JvFormWallpaper_Demo"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="JvAppFrmLazR"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="JvFormWallpaper_Demo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="main.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="JvFormWallpaper_Demo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <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>

components/jvcllaz/examples/JvFormWallper/JvFormWallpaper_Demo.lpr

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

components/jvcllaz/examples/JvFormWallper/main.pas

@@ -0,0 +1,82 @@
+unit main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ActnList,
+  ExtDlgs, Spin, StdCtrls, JvFormWallpaper;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    CbOffsetMode: TComboBox;
+    ImageList1: TImageList;
+    JvFormWallpaper1: TJvFormWallpaper;
+    Label1: TLabel;
+    Label2: TLabel;
+    OpenPictureDialog1: TOpenPictureDialog;
+    EdOffset: TSpinEdit;
+    ToolBar1: TToolBar;
+    ToolButton1: TToolButton;
+    ToolButton2: TToolButton;
+    procedure CbOffsetModeChange(Sender: TObject);
+    procedure EdOffsetChange(Sender: TObject);
+    procedure ToolButton1Click(Sender: TObject);
+    procedure ToolButton2Click(Sender: TObject);
+  private
+    FImageFileName: String;
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.ToolButton2Click(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TForm1.ToolButton1Click(Sender: TObject);
+var
+  pic: TPicture;
+begin
+  with OpenPictureDialog1 do begin
+    InitialDir := ExtractFileDir(FImageFileName);
+    FileName := '';
+    if Execute then begin
+      FImageFileName := FileName;
+      pic := TPicture.Create;
+      try
+        pic.LoadfromFile(FImageFileName);
+        JvFormWallpaper1.Image.Assign(pic);
+      finally
+        pic.Free;
+      end;
+    end;
+  end;
+end;
+
+procedure TForm1.EdOffsetChange(Sender: TObject);
+begin
+  JvFormWallPaper1.Offset := EdOffset.Value;
+end;
+
+procedure TForm1.CbOffsetModeChange(Sender: TObject);
+begin
+  JvFormWallPaper1.OffsetMode := TJvOffsetMode(CbOffsetMode.ItemIndex);
+end;
+
+end.
+

components/jvcllaz/packages/jvappfrmlazr.lpk

@@ -17,11 +17,15 @@
 "/>
     <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
     <Version Major="1" Release="4"/>
-    <Files Count="1">
+    <Files Count="2">
       <Item1>
         <Filename Value="..\run\JvAppFrm\JvFormAnimatedIcon.pas"/>
         <UnitName Value="JvFormAnimatedIcon"/>
       </Item1>
+      <Item2>
+        <Filename Value="..\run\JvAppFrm\JvFormWallpaper.pas"/>
+        <UnitName Value="JvFormWallpaper"/>
+      </Item2>
     </Files>
     <RequiredPkgs Count="2">
       <Item1>

components/jvcllaz/run/JvAppFrm/JvFormAnimatedIcon.pas

@@ -32,7 +32,6 @@ interface
 uses
   SysUtils, Classes, Controls, Forms, ExtCtrls,
   ImgList, Graphics;
-//  JvComponentBase;
 
 type
   TJvFormAnimatedIcon = class(TComponent)  //JvComponent)

components/jvcllaz/run/JvAppFrm/JvFormWallpaper.pas

@@ -0,0 +1,159 @@
+{-----------------------------------------------------------------------------
+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: JvFormWallpaper.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.delphi-jedi.org
+
+Known Issues:
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvFormWallpaper;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, Classes, Graphics, Controls;
+
+type
+  TJvOffsetMode = (omRows, omColumns);
+
+  TJvFormWallpaper = class(TGraphicControl)
+  private
+    FImage: TPicture;
+    FOffset: Integer;
+    FOffsetMode: TJvOffsetMode;
+    procedure SetImage(Value: TPicture);
+    procedure FormPaint(Sender: TObject);
+    procedure SetOffset(const Value: Integer);
+    procedure SetOffsetMode(const Value: TJvOffsetMode);
+    procedure ValidateOffset;
+  protected
+    procedure Paint; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property Align default alClient;
+    property Image: TPicture read FImage write SetImage;
+    property Offset: Integer read FOffset write SetOffset default 0;
+    property OffsetMode: TJvOffsetMode read FOffsetMode write SetOffsetMode default omRows;
+  end;
+
+
+implementation
+
+uses
+  Forms;
+
+constructor TJvFormWallpaper.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FImage := TPicture.Create;
+  FImage.OnChange := @FormPaint;
+  Align := alClient;
+end;
+
+destructor TJvFormWallpaper.Destroy;
+begin
+  FImage.Free;
+  inherited Destroy;
+end;
+
+procedure TJvFormWallpaper.SetImage(Value: TPicture);
+begin
+  FImage.Assign(Value);
+  ValidateOffset;
+  Invalidate;
+end;
+
+procedure TJvFormWallpaper.ValidateOffset;
+begin
+  case OffsetMode of
+    omRows:
+      if FOffset > FImage.Width then
+        FOffset := FImage.Width;
+    omColumns:
+      if FOffset > FImage.Height then
+        FOffset := FImage.Height;
+  end;
+end;
+
+procedure TJvFormWallpaper.SetOffset(const Value: Integer);
+begin
+  FOffset := Value;
+  ValidateOffset;
+  Invalidate;
+end;
+
+procedure TJvFormWallpaper.SetOffsetMode(const Value: TJvOffsetMode);
+begin
+  FOffsetMode := Value;
+  ValidateOffset;
+  Invalidate;
+end;
+
+procedure TJvFormWallpaper.Paint;
+var
+  X, Y, OX, OY: Integer;
+  Bmp: TBitmap;
+begin
+  if (FImage <> nil) and (FImage.Width > 0) and (FImage.Height > 0) then
+  begin
+    Bmp := TBitmap.Create;
+    try
+      Bmp.Width := Width;
+      Bmp.Height := Height;
+      OX := 0;
+      OY := 0;
+      for X := 0 to (Width + Abs(FOffset - FImage.Width)) div FImage.Width do
+      begin
+        if OffsetMode = omColumns then
+          if X mod 2 = 0 then
+            OY := 0
+          else
+            OY := FOffset - FImage.Height;
+        for Y := 0 to (Height + Abs(OY)) div FImage.Height do
+        begin
+          if OffsetMode = omRows then
+            if Y mod 2 = 0 then
+              OX := 0
+            else
+              OX := FOffset - FImage.Width;
+          Bmp.Canvas.Draw(X * FImage.Width + OX, Y * FImage.Height + OY, FImage.Graphic);
+        end;
+      end;
+      Canvas.Draw(0, 0, Bmp);
+    finally
+      Bmp.Free;
+    end;
+  end;
+end;
+
+procedure TJvFormWallpaper.FormPaint(Sender: TObject);
+begin
+  if (Parent is TForm) and (TForm(Parent).FormStyle = fsMDIForm) then
+    RequestAlign // Invalidate DOES NOT work here (Mantis 5689)
+  else
+    Invalidate;
+end;
+
+
+end.