判斷圖片是否全白

function BMPisWhite(Bmp: TBitmap): Boolean;
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..32767] of TRGBTriple;
var
  x, y:   integer;
  p0  :   PRGBTripleArray;
begin
  Result:=True;
  Bmp.PixelFormat := pf24bit;
  for y:=0 to Bmp.Height-1 do
  begin
    p0 := Bmp.ScanLine[y];
    for x:=0 to Bmp.Width-1 do
    begin
      if (p0[x].rgbtBlue <> 255) or (p0[x].rgbtGreen <> 255) or (p0[x].rgbtRed <> 255) then
      begin
        Result := False;
        Exit;
      end;
    end;
  end;
end;

圖片掌形拖曳工具 (圖片中間有小手)

首先新增
1個TScrollBox; AutoScroll屬性False;
1個TImage; Cursor屬性crHandPoint; Pitcher屬性加入自己的圖片;
1個TScrollBar; Min屬性1; LargeChange屬性10;
1個TScrollBar; Min屬性1; LargeChange屬性10; Kind屬性sbVertical

事件
在兩個TScrollBar物件都點兩下。
TImage的OnMouseDown、OnMouseMove及OnMouseUp都點兩下
TForm的OnCreate

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure ScrollBar2Change(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var CanMove:boolean;
    OldX,OldY:Integer;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  temp:Integer;
begin
  if CanMove then //可以開始移動
  begin

    //往左右移判斷
    temp:=Image1.Left+X-OldX;
    if temp > -1  then
      Image1.Left := -1
    else if temp < ScrollBox1.Width-Image1.Width then
      Image1.Left := ScrollBox1.Width-Image1.Width
    else
      Image1.Left := temp;
    ScrollBar1.Position:=-Image1.Left;

    //往上下移判斷
    temp:=Image1.Top+Y-OldY;
    if temp > -1  then
      Image1.Top := -1
    else if temp < ScrollBox1.Height-Image1.Height then
      Image1.Top := ScrollBox1.Height-Image1.Height
    else
      Image1.Top := temp;
    ScrollBar2.Position:=-Image1.Top;

  end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  CanMove:=true; //設定可以開始
  OldX:=X;  //OldX為滑鼠點下去的X位置
  OldY:=Y;  //OldX為滑鼠點下去的Y位置

end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  CanMove:=False; //設定不可以開始
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ScrollBox1.DoubleBuffered:=True;

  ScrollBar1.Max:=Image1.Width-ScrollBox1.Width+(ScrollBox1.Width*ScrollBox1.Width div Image1.Width);
  ScrollBar1.Pagesize:=ScrollBox1.Width*ScrollBox1.Width div Image1.Width;

  ScrollBar2.Max:=Image1.Height-ScrollBox1.Height+(ScrollBox1.Height*ScrollBox1.Height div Image1.Height);
  ScrollBar2.Pagesize:=ScrollBox1.Height*ScrollBox1.Height div Image1.Height;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
  if ScrollBar1.Position > Image1.Width-ScrollBox1.Width then
    ScrollBar1.Position:=Image1.Width-ScrollBox1.Width;
  Image1.Left:=-ScrollBar1.Position;
end;

procedure TForm1.ScrollBar2Change(Sender: TObject);
begin
  if ScrollBar2.Position > Image1.Height-ScrollBox1.Height then
    ScrollBar2.Position:=Image1.Height-ScrollBox1.Height;
  Image1.Top:=-ScrollBar2.Position;
end;

end.

簡單的MP3、WAV、MID播放器

新增5個TButton按鈕，Caption分別為：
&Open
>
■
&Back
&Next
再新增1個TProgressBar，1個TListBox，1個TMediaPlayer且屬性Visible = False。
1個TOpenDialog且屬性Filter = 所有音樂格式*.wav;*.mp3;*.mid
1個TTimer

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, MPlayer, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    ProgressBar1: TProgressBar;
    ListBox1: TListBox;
    MediaPlayer1: TMediaPlayer;
    Timer1: TTimer;
    OpenDialog1: TOpenDialog;
    procedure ListBox1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    procedure PlayAudio;
    procedure NextTrack;
    procedure BackTrack;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ss: String;
  PlayIndex: integer = 0;

implementation

{$R *.dfm}
procedure TForm1.PlayAudio;
begin
  try
    if ListBox1.Items.Count > 0 then //歌大於1首才可
    begin
      if ListBox1.ItemIndex = -1 then //未選擇就0 指第一首
        ListBox1.ItemIndex := 0;
      ss := ListBox1.Items.Strings[ListBox1.ItemIndex]; //取到檔名
      MediaPlayer1.FileName := ss;
      MediaPlayer1.Open;
      MediaPlayer1.Play;
    end;
  except;
  end;
end;

procedure TForm1.NextTrack;
begin
  try
    PlayIndex := ListBox1.ItemIndex;
    Inc(PlayIndex); //加1
    if PlayIndex = ListBox1.Items.Count then
      PlayIndex := 0; //跳到第一首
    ListBox1.ItemIndex := PlayIndex;

    ss := ListBox1.Items.Strings[PlayIndex];
    MediaPlayer1.FileName := ss;
    MediaPlayer1.Open;
    if MediaPlayer1.FileName = '' then
      PlayAudio
    else
      MediaPlayer1.Resume;
  except;
  end;
end;

procedure TForm1.BackTrack;
begin
  try
    PlayIndex := ListBox1.ItemIndex;
    Dec(PlayIndex); //減1
    if PlayIndex < filename =" ''" filename =" ''" caption =" '">' then
    begin
      MediaPlayer1.Resume;
      button2.caption:='';
    end else
    begin
      MediaPlayer1.Pause;
      button2.caption:='>';
    end;
  except;
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  try
    BackTrack
  except
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  try
    NextTrack
  except
  end;
end;

procedure TForm1.ListBox1Click(Sender: TObject); //連點兩下
begin
  PlayAudio;
  button2.caption:='';
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if MediaPlayer1.FileName <> '' then
    try
      ProgressBar1.Max := MediaPlayer1.Length; //MediaPlayer1.Length音樂長度
      ProgressBar1.Position := MediaPlayer1.Position; //MediaPlayer1.Position播放位置
      ProgressBar1.Update;
      MediaPlayer1.Update;
      if MediaPlayer1.Position >= MediaPlayer1.Length then
        NextTrack;
    except;
    end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  MediaPlayer1.stop; //停止播放
  MediaPlayer1.FileName := ''; //名稱為''是為了跑PlayAudio
  button2.caption:='>'; //按鈕圖示變
  ProgressBar1.Position := 0; //手控狀態bar
end;

end.

TGifImage 的重要屬性

重要的屬性(Property)介紹

1	AnimationSpeed	Determines the relative speed of the GIF animation.
2	AspectRatio	Pixel Aspect Ratio.
3	BackgroundColor	Specifies the background color of an animated GIF.
4	BackgroundColorIndex	Specifies the background color index of an animated GIF.
5	Bitmap	Provides access to the bitmap representation of the GIF.
6	BitsPerPixel	Determines the maximum color depth of the GIF.
7	ColorReduction	Specifies the color reduction method used when importing images with more than 256 colors.
8	ColorResolution	Determines the maximum color depth of the GIF.
9	Compression	gcLZW gcRLE
10	DitherMode	dmNearest dmFloydSteinberg dmStucki dmSierra dmJaJuNI dmSteveArche dmBurkes dmOrdered
11	DrawBackgroundColor	Specifies a custom background color of an animated GIF.
12	DrawOptions	Controls how the GIF is displayed.
13	GlobalColorMap	Gives access to the GIFs Global Color Map.
14	Header	Gives access to the GIF file header.
15	Images	Lists the individual frames of the GIF image.
16	IsTransparent	Determines if the GIF uses transparency.The IsTransparent property can be used to determine if the GIF uses transparency.
17	Painters	Maintains a list of paint threads used by the GIF object.
18	ReductionBits	Specifies the palette size when importing images with more than 256 colors using the Quantization method. rmNone rmWindows20 rmWindows256 rmWindowsGray rmMonochrome rmGrayScale rmNetscape rmQuantize rmQuantizeWindows rmPalette
19	ThreadPriority	Specifies the priority of the GIF's paint threads.
20	Version	Specifies the GIF version level.

TJpegImage 的重要屬性

重要的屬性(Property)介紹

1	CompressionQuality	當你要儲存jpeg時，這個屬性決定的壓縮品質，範圍是1到100，1表示壓縮最大品質最差，100表示壓縮最小，品質最高
2	Grayscale	1.用來得知載入的影像是不是8bits的灰階影像 2.輸出將原本的彩色影像變成8bits灰階
3	SaveToFile	影像的高度(尺寸大小)
4	Palette	該屬性可以取得或設定新的色盤，當影像是不需要色盤時，該屬性為0
5	Performance	決定載入影像的品質 jpBestQuality表示以最佳品質方式載入 jpBestSpeed 表示以最快的速度方式載入
6	PixelFormat	像素的顏色深度 jf8Bit表示該影像為8位元的影像 jf24Bit 表示該影像為24位元的影像，一般的jpeg都是24位元的影像
7	ProgressiveDisplay	當jpeg顯示來源是從網路等緩慢的下載方式時，你可以考慮將它設為true。從硬碟等快速的裝置載入時如果將設為true時只是降低顯示的速度而已。
8	ProgressiveEncoding	在存檔壓縮時，將它設為true可以讓影像在載入的時候慢慢的先顯示出來，建議設為false
9	Scale	決定載入圖片的尺寸大小，這個可以方便讓你顯示縮圖，當你設成jsHalf到jsEighth時你會發顯載入的速度加快了。 jsFullSize：顯示完整的尺寸 jsHalf： 顯示1/2的尺寸 jsQuarter：顯示1/4的尺寸 jsEighth：顯示1/8的尺寸
10	Smoothing	這個屬性只有當ProgressiveDisplay為true時才有用 當設為true時，載入當中的影像區塊顯示，會先以以柔和模糊的區塊代替
11	Width	影像的高度(尺寸大小)

重要的方法(Method)介紹

1	Assign	可以拷貝一個Bitmap進來
2	LoadFromFile	從檔案中載入jpeg檔
3	SaveToFile	儲存jpeg至檔案中

重要的事件(Event)介紹

1	OnProgress	你可以利用這個事件監控影像載入的進度
2	OnChange	當影像內容有變化時，就會產生這個事件

讀取Gif檔案

首先可到此下載 http://finn.mobilixnet.dk/delphi/ Gif所需用到的GIFImage.pas檔案(依Delphi的版本去下載)

uses GIFImage;

procedure TForm1.Button1Click(Sender: TObject);
var
  gif: TGifImage;
begin
  gif := TGifImage.Create;
  try
    gif.Assign(Bmp);
    gif.SaveToFile('test.gif');
  finally
    gif.Free;
  end;
end;

擷取畫面並存成BMP及JPG檔案

uses Windows, Graphics, Jpeg;

procedure TForm1.Button1Click(Sender: TObject);
var
  dc:hdc;
  MyCanvas:TCanVas;
  Bmp:TBitmap;
  Jpg: TJpegImage;
begin
  application.Minimize; //視窗最小化
  application.ProcessMessages; //視窗取得控制
  //可能要delay一下，不然抓到空白東東
  Jpg := TJpegImage.Create;
  MyCanvas:=TCanvas.Create;
  Bmp:=tbitmap.Create;
  dc:=getdc(0);
  try
    MyCanvas.Handle := DC;

    Bmp.Width := Width;
    Bmp.Height := Height;
    Bmp.Canvas.CopyRect(Rect(0,0,Screen.Width,Screen.Height),MyCanvas,Rect    (0,0,Screen.Width,Screen.Height));
    Image1.Picture.Bitmap.Assign(Bmp);
    Bmp.SaveToFile('test.Bmp');

    Jpg.Assign(Bmp);
    Jpg.Performance:=jpBestQuality;
    Jpg.CompressionQuality := 30; //你想要的壓縮品質
    Jpg.Compress;     
    Jpg.SaveToFile('test.jpg');   
  finally     
    releasedc(0,dc);     
    MyCanvas.Free;     
    Bmp.Free;   
  end;   
  application.Restore; //視窗回復 
end;