本例效果图:
代码文件:
代码文件:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls, ExtCtrls; type TForm1 = class(TForm) ColorListBox1: TColorListBox; TrackBar1: TTrackBar; procedure FormCreate(Sender: TObject); procedure FormPaint(Sender: TObject); procedure ColorListBox1Click(Sender: TObject); procedure TrackBar1Change(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} uses GDIPOBJ,GDIPAPI; procedure TForm1.FormCreate(Sender: TObject); begin Self.Position := poDesktopCenter; ColorListBox1.Align := alRight; TrackBar1.ShowSelRange := False; TrackBar1.PageSize := 20; TrackBar1.Min := 0; TrackBar1.Max := 255; TrackBar1.Position := TrackBar1.Max; end; procedure TForm1.FormPaint(Sender: TObject); var g: TGPGraphics; r: TGPRect; sb: TGPSolidBrush; clr: TGPColor; Alpha: Byte; begin g := TGPGraphics.Create(Canvas.Handle); g.Clear(MakeColor(255,255,255)); r := MakeRect(20, 20, 200, 150); clr := ColorRefToARGB(ColorListBox1.Selected); Alpha := TrackBar1.Position; clr := MakeColor(Alpha, GetRed(clr), GetGreen(clr), GetBlue(clr)); sb := TGPSolidBrush.Create(clr); g.FillRectangle(sb, r); sb.Free; g.Free; end; procedure TForm1.ColorListBox1Click(Sender: TObject); begin Repaint; end; procedure TForm1.TrackBar1Change(Sender: TObject); begin Repaint; Text := Format('透明度: %d', [TrackBar1.Position]); end; end.窗体文件:
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 206 ClientWidth = 339 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate OnPaint = FormPaint PixelsPerInch = 96 TextHeight = 13 object ColorListBox1: TColorListBox Left = 248 Top = 0 Width = 91 Height = 206 Align = alRight ItemHeight = 16 TabOrder = 0 OnClick = ColorListBox1Click end object TrackBar1: TTrackBar Left = 0 Top = 184 Width = 249 Height = 45 TabOrder = 1 OnChange = TrackBar1Change end end