How to copy content of timage from form1 to form2?

Question

This is a continuation on my previous question. Step 1 was copying a timage to another on the same form. See the link below. text

Now I want to copy that same timage to a timage in a different form. I have created a sample program too illustrate what i am stuck on. In this program i am trying to copy the timage from the main form named SrcImage to the timage named image on the imageview form

The main

unit Main;

interface

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

type
  TMainFrm = class(TForm)
    OpenDialog: TOpenDialog;
    EditFnd: TEdit;
    FileSelectBtn: TButton;
    SrcImage: TImage;
    CopyImage: TImage;
    ViewImageBtn: TButton;
    Refline: TLabel;
    procedure FileSelectClick(Sender: TObject);
    procedure ViewImageBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function GetText(Img:TImage;v:string):boolean;
  end;

var
  MainFrm: TMainFrm;

implementation

uses Params, ImageView;

{$R *.DFM}

procedure TMainFrm.FileSelectClick(Sender: TObject);
var
  s: string;
begin
  OpenDialog := TOpenDialog.Create(self);
  if OpenDialog.Execute then begin
    s := OpenDialog.FileName;
    EditFnd.text := s; 
    SrcImage.Visible := GetText(SrcImage, s);
    CopyImage.picture := SrcImage.picture;
    CopyImage.visible := true;
  end;
end;

function TMainFrm.GetText(Img: TImage; v: string): boolean;
  var 
    p:timage;
    fl: textfile;
    s, t:string;
    crect:Trect;
    ds: Longint;
    ws: widestring;
begin
  try
    p := img;

    AssignFile(fl, v);
    reset(fl);
    crect                := p.ClientRect;
    p.canvas.Font        := Refline.font;
    p.canvas.Brush.Style := bsClear;
    p.canvas.Brush.Color := clBtnFace;
    p.Canvas.Font.Size   := 8;
    p.canvas.FillRect(crect);

    ds                   := DT_NOPREFIX or DT_EXPANDTABS or DT_WORDBREAK;
    while not eof(fl) do begin
        Readln(fl, s);
        t := t + s;
    end;
    ws := StrToWide(t);
    DrawTextW(p.canvas.Handle, pwidechar(ws), length(ws), crect, ds);
    result := true;
  except
    result := false;
  end;
end;



procedure TMainFrm.ViewImageBtnClick(Sender: TObject);
begin
  ImageForm.Image.picture := SrcImage.Picture;
  imageform.DoImage;
end;

end.

the imageform

unit ImageView;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, math, OleCtrls, SHDocVw;

type
  TImageForm = class(TForm)
    BtnOk: TBitBtn;
    Imagebox: TScrollBox;
    Image: TImage;
    mTicket: TMemo;
    Web: TWebBrowser;
    procedure FormResize(Sender: TObject);
    procedure ImageboxMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure ImageboxMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure BtnOkClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ImageDblClick(Sender: TObject);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    ox,
    oy: integer;
    mv: boolean;
    md: double;
    procedure DoImage;
    procedure Ticket(s:string);
    procedure DoHtml(fl:string);
    procedure Zoom(i:boolean);
    { Public declarations }
  end;

var
  ImageForm: TImageForm;

implementation

uses Params;

{$R *.DFM}

procedure TImageForm.Ticket(s:string);
begin
  if visible then
    hide;
  image.visible   := false;
  mticket.visible := true;
  web.visible     := false;
  mticket.text    := s;
  showmodal;
end;

procedure TImageForm.DoImage;
begin
  if visible then
    hide;
  Image.width     := imagebox.clientWidth;
  Image.Height    := imagebox.clientHeight;
  image.visible   := true;
  mticket.visible := false;
  web.visible     := false;
  show;
end;

procedure TImageForm.DoHtml(fl:string);
begin
  if visible then
    hide;
  image.visible   := false;
  mticket.visible := false;
  web.visible     := true;
  web.Navigate(fl);
  //while web.readystate <> readystate_complete do begin
  //  application.processmessages;
  //end;
  showmodal;
end;

procedure TImageForm.FormResize(Sender: TObject);
begin
  Imagebox.width  := Width - ScaleDpi(25);
  Imagebox.Height := clientHeight - ScaleDPI(40);
  Image.width     := imagebox.clientWidth;
  Image.Height    := imagebox.clientHeight;
  mticket.Top     := 0;
  mticket.left    := 0;
  mticket.width   := image.width;
  mticket.height  := image.height;
  web.Top         := 0;
  web.left        := 0;
  web.width       := image.width;
  web.Height      := image.height;
  BtnOk.Top       := clientheight - ScaleDPI(30);
  BtnOk.Left      := (clientwidth - btnok.width) div 2;
end;

procedure TImageForm.ImageboxMouseWheelDown(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  Imagebox.VertScrollBar.Position := Imagebox.VertScrollBar.Position + 10;
  handled := true;
end;

procedure TImageForm.ImageboxMouseWheelUp(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  Imagebox.VertScrollBar.Position := Imagebox.VertScrollBar.Position - 10;
  handled := true;
end;

procedure TImageForm.BtnOkClick(Sender: TObject);
begin
  Imageform.close;
end;

procedure TImageForm.FormShow(Sender: TObject);
var s:string;
begin
  try
    md     := 0;
    mv     := false;
    s      := ParameterString('General', 'ImageSize', '0001000103400300');
    top    := strtoint(copy(s,  1, 4));
    left   := strtoint(copy(s,  5, 4));
    Width  := strtoint(copy(s,  9, 4));
    Height := strtoint(copy(s, 13, 4));
  except
  end;
end;

procedure TImageForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  image.visible   := true;
  mticket.visible := false;
  SaveParameter('General', 'ImageSize', MakeStr(top, 4, false) +
                                        MakeStr(left, 4, false) +
                                        MakeStr(width, 4, false) +
                                        MakeStr(height, 4, false));
end;

procedure TImageForm.Zoom(i:boolean);
begin
  if i and (image.width < 4 * imagebox.width) then begin
    image.width  := 2 * image.width;
    image.height := 2 * image.height;
    ox           := ox * 2;
    oy           := oy * 2;
  end
  else if not i and (image.width > imagebox.width div 4) then begin
    image.width  := trunc(image.width / 2);
    image.height := trunc(image.height / 2);
    ox           := ox div 2;
    oy           := oy div 2;
  end;
  if image.width > imagebox.width then begin
    imagebox.horzscrollbar.position := max(0, trunc(ox / image.width * (imagebox.horzscrollbar.Range)) - (imagebox.width div 2));
    imagebox.vertscrollbar.position := max(0, trunc(oy / image.height * (imagebox.vertscrollbar.Range)) - (imagebox.height div 2));
  end
end;

procedure TImageForm.ImageDblClick(Sender: TObject);
begin
  Image.width     := imagebox.clientWidth;
  Image.Height    := imagebox.clientHeight;
end;

procedure TImageForm.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ox := x;
  oy := y;
  mv := false;
  if button = mbleft then
    md := now;
end;

procedure TImageForm.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if md > 0 then begin
    if abs(y - oy) > 5 then begin
      imagebox.VertScrollBar.Position := imagebox.VertScrollBar.Position + (oy - y);
      mv := true;
    end;
    if abs(x - ox) > 5 then begin
      imagebox.HorzScrollBar.Position := imagebox.HorzScrollBar.Position + (ox - x);
      mv := true;
    end;
  end;
end;

procedure TImageForm.ImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not mv and (button = mbleft) then begin
    if now - md > 0.5 / 86400 then
      Zoom(false)
    else
      Zoom(true);
  end;
  if button = mbright then
    zoom(false);
  mv := false;
  md := 0;
end;

end.

params.pas

unit Params;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Registry, IniFiles, Menus, Math, FileCtrl;

const
  CrLf      = #13#10;
  UTF16BOM  = chr(255) + chr(254);
  UTF8BOM   = chr(239) + chr(187) + chr(191);


function  ScaleDPI(i:integer):integer;
function  StrToWide(s:string):widestring;
function  StrAsWide(s:string):widestring;
function  ConvToWide(const Source: String;cp:integer): widestring;
function  ParameterString (section,ident,default: string): string;
procedure SaveParameter (section,ident,value: string);
function  ReadWholeFile(fn:string;p:integer=0):string;
function  CmdParam(p:string;gn:boolean):string;
function  MakeStr(i,l:integer;s:boolean): string;
function MakeLength(s:string;l:integer;n:boolean):string;

var
  curdir,
  iniFile: string;

implementation

function ScaleDPI(i:integer):integer;
begin
  //SetProcessDPIAware()
  if (screen.PixelsPerInch <> 96) then
    result := round(i / 96 * screen.PixelsPerInch)
  else
    result := i;
end;

function StrToWide(s:string):widestring;
begin
  if copy(s, 1, 2) = UTF16BOM then
    result := StrAsWide(copy(s, 3, length(s)))
  else if copy(s, 1, 3) = UTF8BOM then //1.0.2.0 Added
    result := ConvToWide(copy(s, 4, length(s)), CP_UTF8)
  else
    result := s;
end;

function StrAsWide(s:string):widestring;
begin
  if length(s) > 0 then begin
    setlength(result, length(s) div 2);
    copymemory(@result[1], @s[1], length(s));
  end
  else
    result := '';
end;

function ConvToWide(const Source: String;cp:integer): widestring;
var
    DestLen: Integer;
begin
  DestLen := MultiByteToWideChar(cp, 0, PChar(Source), length(source), nil, 0);
  if DestLen > 0 then begin
    SetLength(result, DestLen);
    MultiByteToWideChar(cp, 0, PChar(Source), length(source), PWideChar(result), DestLen);
    if (length(result) > 0) and (result[length(result)] = chr(0)) then
      setlength(result, length(result) - 1);
  end
  else
    result := '';
end;

function ParameterString (section,ident,default: string): string;
var save: boolean;
    ini : TIniFile;
begin
  if (copy(section, 1, 1) = '#') then begin
    save    := false;
    section := copy(section, 2, length(section));
  end
  else
    save    := true;
  ini       := TIniFile.Create (inifile);
  result    := ini.ReadString (section,ident, '!@#$%');
  if result = '!@#$%' then begin
    result  := default;
    if save then try
      ini.WriteString (section,ident,result);
    except
    end;
  end
  else if copy(result, 1, 3) = '#@#' then
    result := ReadWholeFile(copy(result, 4, maxint));
  ini.Free;
end;

procedure SaveParameter (section,ident,value: string);
var
   ini: TIniFile;
begin
  if ParameterString(section, ident, value) <> value then begin //1.0.2.0 Added only save when needed
    ini:=TIniFile.Create (inifile);
    ini.WriteString (section,ident,value);
    ini.Free;
  end;
end;

function ReadWholeFile(fn:string;p:integer=0):string;
var fs,h:integer;
begin
  result := '';
  if fileexists(fn) then try
    h  := fileopen(fn, fmOpenRead);
    fs := fileseek(h, 0, 2);
    if p > 0 then begin
      p := min(fs, p);
      setlength(result, fs - p);
      fileseek(h, p, 0);
    end
    else if p < 0 then begin
      p := min(fs, abs(p));
      setlength(result, p);
      fileseek(h, 0-p, 2);
    end
    else begin
      setlength(result, fs);
      fileseek(h, 0, 0);
    end;
    fileread(h, result[1], length(result));
    if (p <> 0) and (p <> fs) then
      result := '...' + copy(result, pos(crlf, result), maxint);
    fileclose(h);
  except
  end
end;

function CmdParam(p:string;gn:boolean):string;
var i:integer;
    l:integer;
begin
  result := '';
  i := 1;
  l := length(p);
  while i <= paramcount do begin
    if p = '' then begin
      if copy(paramstr(i), 1, 1) = '-' then
        inc(i)
      else
        result := result + paramstr(i);
    end
    else if ansilowercase(copy(paramstr(i), 1, l)) = ansilowercase(p) then begin
      if gn then
        result := Paramstr(i+1)
      else begin
        result := copy(paramstr(i), l+1, 100);
        if result = '' then
          result := ' ';
      end;
    end;
    inc(i);
  end;
end;

function MakeLength(s:string;l:integer;n:boolean):string;
begin
  if abs(l) > 0 then begin
    if n or (l > 0) then
      s   := trim(s);
    if n and (copy(s, 1, 1) = '-') then
      result := '-' + stringofchar('0', abs(l)-length(s)) + copy(s, 2, length(s))
    else if n then
      result := stringofchar('0', abs(l)-length(s)) + s
    else if l < 0 then
      result := stringofchar(' ', abs(l)-length(s)) + s
    else
      result := s + stringofchar(' ', abs(l)-length(s));
    result   := copy(result,1,abs(l));
  end
  else
    result := s;
end;

function MakeStr(i,l:integer;s:boolean): string;
begin
  if s then
    l := 0-l;
  result := MakeLength(inttostr(i), l, not s);
end;

procedure InitIniFile;
var
//  i : integer;
  sk: string;
begin
  //1.0.2.4 Added
  sk := cmdParam('-key', true);
  if sk = '' then
    sk := ExtractFilename(extractfiledir(application.exename));
  inifile := cmdParam('-ini', true);
  curdir  := cmdParam('-dir', true);
  if (curdir = '') then
    curdir := ExtractFileDir(ParamStr(0));
  if inifile = '' then begin
    inifile := curdir + '\' + ExtractFilename(ChangeFileExt(Application.ExeName, '.ini'));
    //1.0.1.8 Added this check
    if not fileexists(inifile) and fileexists(ChangeFileExt(Application.ExeName, '.ini')) then
      inifile := ChangeFileExt(Application.ExeName, '.ini');
  end; 
end;

begin
  InitIniFile;
end.

This is an example of my first attempt copy a timage from 1 form to another.

In the Main I use the function getText to draw text to the timage SrcImage. Then i copy that on the same form to the timage CopyImage. This works.

Then I have a button Image Form which copies the Timage from SrvImage to the timage named image on the ImageForm. Then I use the function DoImage to show the Imageform. But this results in a white form.

My guess is that even though the Imageform is created, but not shown the components are not yet available for me too add my already created timage to the timage on the imageform.

But i have also tried to first show the ImageForm and then copy the timage from SrcImage to the timage on the imageform. This also didn't work.

What am I doing wrong here?

And yes a delphi 5 book might be helpful since I am self taught by using debugging other peoples code, a lot of trial and error, helpfiles from delphi and some other components and ofcourse google will always be your best friend...

Answer 1

I am not sure why it's not working for you.

Try to see if it works for you outside of your main application. Create a blank application, drop 2 TImage objects on the form, so now you have blank Image1 and blank Image2 on the form. Position them side by side. Load any graphic into Image1. Now drop a TButton on the form and in its OnClick event, do an Assign like this:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Image2.Picture.Assign(Image1.Picture);
end;

Run the application and press the button. Image2 should now display the same graphic as Image1.

By the way, you have the following code:

  Image.width     := imagebox.clientWidth;
  Image.Height    := imagebox.clientHeight;

Have you tried using the Align property? Like this:

Image.Align := alClient;

Happy coding.