unit MainUnit; (* ***** BEGIN LICENSE BLOCK ***** * Version: MPL 1.1 or LGPL 2.1 with linking exception * * 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/ * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License * for the specific language governing rights and limitations under the * License. * * Alternatively, the contents of this file may be used under the terms of the * Free Pascal modified version of the GNU Lesser General Public License * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions * of this license are applicable instead of those above. * Please see the file LICENSE.txt for additional information concerning this * license. * * The Original Code is Graphics32 * * The Initial Developer of the Original Code is * Alex A. Denisov * * Portions created by the Initial Developer are Copyright (C) 2000-2005 * the Initial Developer. All Rights Reserved. * * Contributor(s): * Andre Beckedorf * * ***** END LICENSE BLOCK ***** *) interface {$include GR32.inc} uses {$IFNDEF FPC} Windows, {$ELSE} LCLIntf, LCLType, LResources, {$ENDIF} SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, GR32, GR32_Image, GR32_Resamplers, GR32_RangeBars; type TFormImage32Example = class(TForm) Image: TImage32; PnlImage: TPanel; PnlControl: TPanel; RgpScaleMode: TRadioGroup; RgpKernel: TRadioGroup; RgpBitmapAlign: TRadioGroup; LblScale: TStaticText; SbrScale: TGaugeBar; procedure FormCreate(Sender: TObject); procedure RgpBitmapAlignClick(Sender: TObject); procedure SbrScaleChange(Sender: TObject); procedure RgpScaleModeClick(Sender: TObject); procedure RgpKernelClick(Sender: TObject); public Time: Single; end; var FormImage32Example: TFormImage32Example; implementation {$R *.dfm} uses {$IFDEF Darwin} MacOSAll, {$ENDIF} GR32.ImageFormats.JPG; procedure TFormImage32Example.FormCreate(Sender: TObject); begin Image.Bitmap.LoadFromResourceName(HInstance, 'Delphi', RT_RCDATA); with TKernelResampler.Create(Image.Bitmap) do begin KernelMode := kmTableNearest; TableSize := 16; end; end; procedure TFormImage32Example.RgpBitmapAlignClick(Sender: TObject); const BA_CONSTS: array [0..2] of TBitmapAlign = (baTopLeft, baCenter, baTile); begin Image.BitmapAlign := BA_CONSTS[RgpBitmapAlign.ItemIndex]; end; procedure TFormImage32Example.SbrScaleChange(Sender: TObject); begin SbrScale.Update; Image.Scale := SbrScale.Position * 0.01; end; procedure TFormImage32Example.RgpScaleModeClick(Sender: TObject); const SM_CONSTS: array [0..5] of TScaleMode = (smNormal, smStretch, smScale, smResize, smOptimal, smOptimalScaled); begin Image.ScaleMode := SM_CONSTS[RgpScaleMode.ItemIndex]; SbrScale.Enabled := (Image.ScaleMode in [smScale, smOptimalScaled]); end; procedure TFormImage32Example.RgpKernelClick(Sender: TObject); const K_CONSTS: array [0..4] of TCustomKernelClass = (TBoxKernel, TLinearKernel, TSplineKernel, TLanczosKernel, TMitchellKernel); begin TKernelResampler(Image.Bitmap.Resampler).Kernel := K_CONSTS[RgpKernel.ItemIndex].Create; end; end.