BlobField as a Bitmap

Question

I have a record that has a bitmap in a TBlobField.
I have a TImage component on the form and I want to show the BlobField as
a bitmap in my Image component.

Answer

A:
** Storing of Bitmap into dbase field called Icon. Icon is a binary Blob
field.

procedure ....
var IconStream : TMemoryStream;
..
..
begin
  .
  .
  IconStream := TMemoryStream.Create;
  Image1.picture.icon.savetostream(IconStream);
  (Table1.fieldbyname('Icon') as TBlobField).LoadFromStream(IconStream);
  Table1.post;
  IconStream.Free;
  .
  .
end;

** Reading of Bitmap into Timage from dbase field called Icon.
procedure .....
var IconStream : TMemoryStream;
..
..
begin
  .
  .
  IconStream := TMemoryStream.Create;
  (Table1.fieldbyname('Icon') as TBlobField).SaveToStream(IconStream);
  {you must set the stream to position one so you have something to write!}
  IconStream.Position := 0;
  appointment.iconimage.picture.icon.loadfromstream(iconstream);
  IconStream.Free;
end;

Hope that helps, as it was a real hard to find information on this within
the helpfiles. I tried a number of methods to get this to work including
the use of a TBlobField and TBlobStream but was unable to get them to work
(maybe due to the pathetic documentation by borland?).

Drawing to a metafile

Question

How to draw to a metafile?

Answer

unit Metaform;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    Image1: TImage;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TMetafileCanvas = class(TCanvas)
  private
    FClipboardHandle: THandle;
    FMetafileHandle: HMetafile;
    FRect: TRect;
  protected
    procedure CreateHandle; override;
    function GetMetafileHandle: HMetafile;
  public
    constructor Create;
    destructor Destroy; override;
    property Rect: TRect read FRect write FRect;
    property MetafileHandle: HMetafile read GetMetafileHandle;
  end;

constructor TMetafileCanvas.Create;
begin
  inherited Create;
  FClipboardHandle := GlobalAlloc(
    GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TMetafilePict));
end;

destructor TMetafileCanvas.Destroy;
begin
  DeleteMetafile(CloseMetafile(Handle));
  if Bool(FClipboardHandle) then GlobalFree(FClipboardHandle);
  if Bool(FMetafileHandle) then DeleteMetafile(FMetafileHandle);
  inherited Destroy;
end;

procedure TMetafileCanvas.CreateHandle;
var
  MetafileDC: HDC;
begin
  { Create a metafile DC in memory }
  MetafileDC := CreateMetaFile(nil);
  if Bool(MetafileDC) then
  begin
    { Map the top,left corner of the displayed rectangle to the
top,left of the
      device context. Leave a border of 10 logical units around the
picture. }
    with FRect do SetWindowOrg(MetafileDC, Left - 10, Top - 10);
    { Set the extent of the picture with a border of 10 logical units.
}
    with FRect do SetWindowExt(MetafileDC, Right - Left + 20, Bottom -
Top + 20);
    { Play any valid metafile contents to it. }
    if Bool(FMetafileHandle) then
    begin
      PlayMetafile(MetafileDC, FMetafileHandle);
    end;
  end;
  Handle := MetafileDC;
end;

function TMetafileCanvas.GetMetafileHandle: HMetafile;
var
  MetafilePict: PMetafilePict;
  IC: HDC;
  ExtRect: TRect;
begin
  if Bool(FMetafileHandle) then DeleteMetafile(FMetafileHandle);
  FMetafileHandle := CloseMetafile(Handle);
  Handle := 0;
  { Prepair metafile for clipboard display. }
  MetafilePict := GlobalLock(FClipboardHandle);
  MetafilePict^.mm := mm_AnIsoTropic;
  IC := CreateIC('DISPLAY', nil, nil, nil);
  SetMapMode(IC, mm_HiMetric);
  ExtRect := FRect;
  DPtoLP(IC, ExtRect, 2);
  DeleteDC(IC);
  MetafilePict^.xExt := ExtRect.Right - ExtRect.Left;
  MetafilePict^.yExt := ExtRect.Top - ExtRect.Bottom;
  MetafilePict^.HMF :=  FMetafileHandle;
  GlobalUnlock(FClipboardHandle);
  { I'm giving you this handle, but please do NOT eat it. }
  Result := FClipboardHandle;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  MetafileCanvas : TMetafileCanvas;
begin
  MetafileCanvas := TMetafileCanvas.Create;
  MetafileCanvas.Rect := Rect(0,0,500,500);
  MetafileCanvas.Ellipse(10,10,400,400);
  Image1.Picture.Metafile.LoadFromClipboardFormat(
    cf_MetafilePict, MetafileCanvas.MetafileHandle, 0);
  MetafileCanvas.Free;
end;

end.

Painting a form with a bitmap

Question

How do I paint the background of my form with a bitmap as tiles?

Answer

unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Bitmap: TBitmap;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Bitmap := TBitmap.Create;
  Bitmap.LoadFromFile('C:\WINDOWS\cars.BMP');
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  X, Y, W, H: LongInt;
begin
  with Bitmap do begin
    W := Width;
    H := Height;
  end;
  Y := 0;
  while Y < Height do begin
    X := 0;
    while X < Width do begin
      Canvas.Draw(X, Y, Bitmap);
      Inc(X, W);
    end;
    Inc(Y, H);
  end;
end;

end.



DISCLAIMER: You have the right to use this technical information
subject to the terms of the No-Nonsense License Statement that
you received with the Borland product to which this information
pertains.

Using an icon as a glyph

Question

How to use an icon as a glyph?

Answer

unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Button1: TButton;
    Bevel1: TBevel;
    BitBtn2: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    SpeedButton1: TSpeedButton;
    procedure BitBtn2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
close; {Close application}
end;

procedure TForm1.Button1Click(Sender: TObject);
var Image1 : TImage;  {Declare variable type}
begin
  try  {Incase of error, release memory}
   Image1 := TImage.Create(Self); {Create temp}
   Image1.Picture.LoadFromFile('\Delphi\Images\Icons\Earth.ico'); {Load file}
  with BitBtn1.Glyph do  {Deal with BitBtn first}
   begin
    Width := 32;  {Standard icon width and height}
    Height := 32;
    Canvas.Brush.Color := clBtnFace; {Check for true button color}
    Canvas.Rectangle(0,0,32,32); {Declare image area}
    Canvas.Draw(0,0,Image1.Picture.Icon); {Draw image area}
   end;
  with SpeedButton1.Glyph do  {Now do the same for the SpeedButton}
   begin
    Width := 32;
    Height := 32;
    Canvas.Brush.Color := clBtnFace;
    Canvas.Rectangle(0,0,32,32);
    Canvas.Draw(0,0,Application.Icon); {Grab the icon from our app.}
   end;
  finally {End of Try statement}
   Image1.Free; {Free the temporary image we created for BitBtn1}
   Button1.Enabled := False; {Make sure this process is run only once}
  end; {End of error checking}
end;   {End of Button1's procedure}

end.

Cut images to clipboard

Question

How to CUT a part of image and place it into CLIPBOARD using delphi?

Answer

Below is some code to copy a Panel. To cut a part of an image, you need
to know the rectangle to be cut, and replace the width's and height's below,
as well as the left and top values. If you really want to cut rather than copy
you will need to fillrect the area.

Var
  BitMap : TBitmap;
begin
  BitMap:=TBitMap.Create;
  BitMap.Height:=BaseKeyPanel.Height;
  BitMap.Width:=BaseKeyPanel.Width;
  BitBlt(BitMap.Canvas.Handle, 0 {Left}, 0{Top}, 
         BaseKeyPanel.Width, BaseKeyPanel.Height,
         GetDC(BaseKeyPanel.Handle), 0, 0, SRCCOPY);
  Clipboard.Assign(BitMap);
  BitMap.Free
End;