//以前写的一个显示图形的控件，运行期间，在图像上点右键，可以出现菜单项unit Unit2;interfaceuses stdctrls, DB, classes, Sysutils, ComCtrls, DBCtrls, Menus, Controls, windows, Dialogs, jpeg, ExtDlgs, ExtCtrls, Graphics, Messages;type TPDPDBImage = class(TImage) private FDataLink: TFieldDataLink; FPopMenu: TPopupMenu; FOpenDlg: TOpenPictureDialog; FSaveDlg: TSaveDialog; FKeepWidth: Boolean; FKeepHeight: Boolean; procedure PopupMenuOnPopup(Sender: TObject); procedure PopMenuClick(Sender: TObject); procedure DataChange(Sender: TObject); function GetField: TField; function GetDataField: string; function GetDataSource: TDataSource; procedure SetDataField(const Value: string); procedure SetDataSource(const Value: TDataSource); protected public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Field: TField read GetField; published property DataField: string read GetDataField write SetDataField; //字段名称 property DataSource: TDataSource read GetDataSource write SetDataSource; property KeepHeight: Boolean read FKeepHeight write FKeepHeight; //保存总高度不变 property KeepWidth: Boolean read FKeepWidth write FKeepWidth; //保持中宽带不变 end;procedure Register;implementationprocedure Register;begin RegisterComponents('ZNXia', [TPDPDBImage]);end;{ TPDPDBImage }constructor TPDPDBImage.Create(AOwner: TComponent);const MenuCaption: array[0..5] of string = ('载入图片', '保存图片', '清除图片', '放大图片', '缩小图片', '恢复原样');var t: TMenuItem; i: integer;begin inherited; FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := DataChange; FPopMenu := TPopupMenu.Create(Self); FPopMenu.OnPopup := PopupMenuOnPopup; for i := 0 to High(MenuCaption) do begin t := TMenuItem.Create(FPopMenu); t.Caption := MenuCaption; t.Tag := i; t.OnClick := PopMenuClick; FPopMenu.Items.Add(t); end; Self.PopupMenu := FPopMenu; FOpenDlg := TOpenPictureDialog.Create(self); FOpenDlg.DefaultExt := 'jpg'; FOpenDlg.Filter := 'JPEG Image File (*.jpg)|*.jpg|JPEG Image File (*.jpeg)|*.jpeg'; FSaveDlg := TSaveDialog.Create(Self); FSaveDlg.DefaultExt := 'jpg'; FSaveDlg.Filter := 'JPEG Image File (*.jpg)|*.jpg';end;procedure TPDPDBImage.DataChange(Sender: TObject);var MS: TMemoryStream; jp: TJPEGImage; bitmap: Graphics.TBitmap; Str: string; iFlag: Integer;begin Self.Picture.Graphic := nil; if Field = nil then Exit; if not Field.IsBlob then Exit; MS := TMemoryStream.Create; bitmap := nil; jp := nil; try Self.Picture.Graphic := nil; Canvas.Pen.Color := ClWhite; Self.Canvas.Brush.Color := Clwhite; Canvas.FillRect(Rect(0, 0, Width, Height)); TBlobField(Field).savetoStream(ms); Str := Copy(Field.AsString, 1, 2); ms.Position := 0; if (ms.Size > 0) and (Str = 'BM') then begin bitmap := TBitmap.Create; bitmap.LoadFromStream(ms); Self.Picture.Graphic := bitmap; end else if (ms.Size > 0) then begin jp := TJPEGImage.Create; jp.LoadFromStream(ms); Self.Picture.Graphic := jp; end; finally FreeAndNil(bitmap); FreeAndNil(jp); FreeAndNil(ms); end; iFlag := 0; if FKeepWidth then iFlag := iFlag + 1; if FKeepHeight then iFlag := iFlag + 2; if Self.Picture.Graphic <> nil then begin case iFlag of 0: begin //长度+宽度＝图象中的信息，保持真实大小，因此Stretch=False, AutoSize=True Self.AutoSize := True; Self.Stretch := False; end; 1: begin //保持宽度不变化，高度自动根据图象中的高宽比例进行计算，因此AutoSize=False, Stretch=True; Self.AutoSize := False; Self.Stretch := True; Self.Height := Trunc(Self.Width / (Self.Picture.Graphic.Width / Self.Picture.Graphic.Height)); end; 2: begin //保持高度不变化，宽度自动根据图象中的宽度比例进行计算，因此AutoSize=False, Stretch=True; Self.AutoSize := False; Self.Stretch := True; Self.Width := Round(Self.Height * Self.Picture.Graphic.Width / Self.Picture.Graphic.Height); end; 3: begin //两者都不变变化，等于设计时期的大小，因此，AutoSize=False,Streatch=True; Self.AutoSize := False; Self.Stretch := True; end; end; end;end;destructor TPDPDBImage.Destroy;begin FPopMenu.Free; FOpenDlg.Free; FSaveDlg.Free; FDataLink.Free; inherited;end;function TPDPDBImage.GetDataField: string;begin Result := FDataLink.FieldName;end;function TPDPDBImage.GetDataSource: TDataSource;begin Result := FDataLink.DataSource;end;function TPDPDBImage.GetField: TField;begin Result := FDataLink.Field;end;procedure TPDPDBImage.PopMenuClick(Sender: TObject);begin //('载入图片','保存图片','清除图片'); if not (Sender is TMenuItem) then Exit; case TMenuItem(Sender).MenuIndex of 0: begin if not Field.IsBlob then Exit; if FOpenDlg.Execute then TBlobField(Field).LoadFromFile(FOpenDlg.FileName); end; 1: begin if FSaveDlg.Execute then Self.Picture.SaveToFile(FSaveDlg.FileName); end; 2: Field.Clear; 3: begin Self.AutoSize := False; Self.Stretch := True; Self.Width := Trunc(Self.Width * 1.2); Self.Height := Trunc(Self.Height * 1.2); end; 4: begin if (Self.Width > Picture.Width * 1.15) and (Self.Height > Picture.Height * 1.15) then begin Self.AutoSize := False; Self.Stretch := True; Self.Width := Trunc(Self.Width * 0.833); Self.Height := Trunc(Self.Height * 0.833); end else begin Self.AutoSize := True; Self.Stretch := False; end; end; 5: begin Self.AutoSize := True; Self.Stretch := False; end; end;end;procedure TPDPDBImage.PopupMenuOnPopup(Sender: TObject);var B: Boolean; //('载入图片','保存图片','清除图片');begin B := True; if Self.Field = nil then B := False else if Self.Field.ReadOnly then B := False; FPopMenu.Items[0].Enabled := B; FPopMenu.Items[1].Enabled := True; FPopMenu.Items[2].Enabled := B; FPopMenu.Items[3].Enabled := Self.Picture.Graphic <> nil; //放大 B := True; if Self.Picture.Graphic <> nil then B := (Self.Picture.Graphic.Width < Self.Width) or (Self.Picture.Graphic.Height < Self.Height); FPopMenu.Items[4].Enabled := B; //缩小 FPopMenu.Items[5].Enabled := True; //恢复原样end;procedure TPDPDBImage.SetDataField(const Value: string);begin FDataLink.FieldName := Value;end;procedure TPDPDBImage.SetDataSource(const Value: TDataSource);begin FDataLink.DataSource := Value;end;end.
