zoukankan      html  css  js  c++  java
  • 再学 GDI+[63]: 路径画刷(3) SetFocusScales、GetFocusScales

    本例效果图:



    代码文件:
    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, CheckLst, ExtCtrls, TeCanvas, ComCtrls;
    
    type
      TForm1 = class(TForm)
        TrackBar1: TTrackBar;
        TrackBar2: TTrackBar;
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure FormPaint(Sender: TObject);
        procedure TrackBar1Change(Sender: TObject);
        procedure TrackBar2Change(Sender: TObject);
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    uses GDIPOBJ, GDIPAPI;
    
    var
      rect: TGPRect;
      pb: TGPPathGradientBrush;
    
    procedure TForm1.FormCreate(Sender: TObject);
    var
      path: TGPGraphicsPath;
      ColorSurround: TGPColor;
      num: Integer;
    begin
      rect := MakeRect(10, 10, ClientWidth-40, ClientHeight-40);
      path := TGPGraphicsPath.Create;
      path.AddEllipse(rect);
    
      pb := TGPPathGradientBrush.Create(path);
      pb.SetCenterColor(aclLime);
    
      ColorSurround := aclBlack;
      num := 1;
      pb.SetSurroundColors(@ColorSurround, num);
    
      path.Free;
    
      DoubleBuffered := True;
    
      TrackBar1.Max := 100;
      TrackBar2.Max := 100;
    end;
    
    procedure TForm1.FormDestroy(Sender: TObject);
    begin
      pb.Free;
    end;
    
    procedure TForm1.FormPaint(Sender: TObject);
    var
      g: TGPGraphics;
      p: TGPPen;
      x,y: Single;
    begin
      g := TGPGraphics.Create(Canvas.Handle);
      p := TGPPen.Create(aclRed);
    
      g.FillEllipse(pb, rect);
    
      pb.SetCenterPoint(MakePoint(rect.X + rect.Width div 2, rect.Y + rect.Height div 2));
    
      {SetFocusScales}
      pb.SetFocusScales(TrackBar1.Position / 100, TrackBar2.Position / 100);
    
      {GetFocusScales}
      pb.GetFocusScales(x, y);
      Text := Format('%f,%f',[x,y]);
    
      p.Free;
      g.Free;
    end;
    
    procedure TForm1.TrackBar1Change(Sender: TObject);
    begin
      Repaint;
    end;
    
    procedure TForm1.TrackBar2Change(Sender: TObject);
    begin
      Repaint;
    end;
    
    end.
    
    窗体文件:
    object Form1: TForm1
      Left = 0
      Top = 0
      Caption = 'Form1'
      ClientHeight = 164
      ClientWidth = 208
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      OldCreateOrder = False
      Position = poDesktopCenter
      OnCreate = FormCreate
      OnDestroy = FormDestroy
      OnPaint = FormPaint
      PixelsPerInch = 96
      TextHeight = 13
      object TrackBar1: TTrackBar
        Left = 0
        Top = 143
        Width = 200
        Height = 23
        ShowSelRange = False
        TabOrder = 0
        OnChange = TrackBar1Change
      end
      object TrackBar2: TTrackBar
        Left = 185
        Top = 0
        Width = 23
        Height = 156
        Orientation = trVertical
        ShowSelRange = False
        TabOrder = 1
        OnChange = TrackBar2Change
      end
    end
    
  • 相关阅读:
    Linux NFS服务器的安装与配置
    mysql 批量更新的四种方法
    解决 RHEL 7/ CentOS 7/Fedora 出现Unit iptables.service failed to load
    linux 搭建svn
    MYSQL的慢查询两个方法
    Apache 配置虚拟主机三种方式
    MYSQL explain详解
    php操作memcache的使用【转】
    PHPExcel中open_basedir restriction in effect的解决方法
    微信浏览器禁止app下载链接的两种处理方法
  • 原文地址:https://www.cnblogs.com/del/p/1230369.html
Copyright © 2011-2022 走看看