TIPS

How to draw background image in a MDI master form.....
How to Launch External EXE's.....
Get Computer name.....
Get connected user.....
How to capture output of a DOS application...
How to send PCL escape code in Quick Report....
How to save/load object properties to/from registry....


=========================================================================
How to draw background image in a MDI master form.....    Top
Add this code to your form definition

 private
     OldWndProc: TFarProc;
     NewWndProc: Pointer;
     PROCEDURE ClientWndProc(VAR Message: TMessage);

Add this code to your form create method

procedure TForm1.FormCreate(Sender: TObject);
  begin
   ...
     NewWndProc := MakeObjectInstance(ClientWndProc);
     OldWndProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
     SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(NewWndProc));
   ...
  end;
  

Drop a Timage Component on your form, assign a picture to it, then add this method

   
PROCEDURE TForm1.ClientWndProc(VAR Message: TMessage);
VAR
  MyDC : hDC;
  W, H : Word;
begin
  with Message do
    case Msg of
      WM_ERASEBKGND:
        begin
          MyDC := TWMEraseBkGnd(Message).DC;
          H := (ClientHeight -Image1.Picture.Height ) div 2;
          W := (clientWidth  -Image1.Picture.Width  ) div 2;
          Canvas.Brush.Color:=clBtnFace;
          FillRgn(mydc,CreateRECTrgn(0,0,clientWidth,ClientHeight),Canvas.Brush.Handle);
          BitBlt(MyDC, W,H,
                Image1.Picture.Width, Image1.Picture.Height,
                Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
          Result := 1;
     end
  else
      Result := CallWindowProc(OldWndProc, ClientHandle, Msg, wParam, lParam);
 end;
end;

The image will be drawn on center of the MDI master form;

How to Launch External EXE's.....     Top
This function permit to launch an external Exe and eventually wait for termination

Function LaunchExtEXE(Pgm:string;Params:string;Wait:Boolean): Cardinal;
var
    t:pchar;
    st:_STARTUPINFOa;
    pi:_PROCESS_INFORMATION;
    res:Boolean;
begin
zeromemory(@st,sizeof(st));
t:=pchar(pgm+' '+parametri);
 
res:=CreateProcess(
            nil,	      // pointer to name of executable module
            t,                // pointer to command line string

            nil,	      // pointer to process security attributes
            nil,	      // pointer to thread security attributes
            true,	      // handle inheritance flag
            0,	              // creation flags
            nil,	      // pointer to new environment block
            nil,              // pointer to current directory name
            st,	              // pointer to STARTUPINFO
            pi 	              // pointer to PROCESS_INFORMATION
           );
If not Res then
   begin
      Result:=GetLastError;
      showmessage('ERR "'+inttostr(result)+'" -> '+t);
   end
else
   Result:=0;

if Wait then
   begin
       WaitforSingleObject(PI.hProcess,INFINITE);
       GetExitCodeProcess(Pi.hProcess,Result);
       CloseHandle( Pi.hProcess);
       CloseHandle( Pi.hThread);
   end;

end; 

Get Computer name.....    Top

function GetCompName: string;
var
  buf: array[ 0 .. 31 ] of char;
  i: Cardinal;
begin
  i := 31;
  GetComputerName( @buf, i );
  Result := buf;
end;

Get connected user.....    Top

   
function GetNetUser: string;
var
  buf: array[ 0 .. 31 ] of char;
  i: Cardinal;
begin
  i := 31;
  GetUserName( @buf, i );
  Result := buf;
end;

How to capture output of a DOS application....     Top
This function run a CommandLine App (like DOS app) and return the output of the program as a String

Function RunDosApp(Pgm:string;Parms:string;Wait:Boolean): String;
var
    t:pchar;
    st:_STARTUPINFOa;
    pi:_PROCESS_INFORMATION;
    res:Boolean;
    sec:_SECURITY_ATTRIBUTES;
    ReadHandle,WriteHandle:Cardinal;
    Read:Cardinal;
    Buffer:array[0..8191] of char;
begin
t:=pchar(pgm+' '+Parms);
sec.nLength:=SIZEOF(sec);
sec.lpSecurityDescriptor:=Nil;
sec.bInheritHandle:=true;

CreatePipe(ReadHandle,WriteHandle,@sec,8192);

FillChar(St, SizeOf(St), #0);
St.cb          := SizeOf(St);
St.dwFlags     := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
St.wShowWindow := SW_HIDE;
St.hStdOutput  := WriteHandle;

res:=CreateProcess(
            nil,	      // pointer to name of executable module
            t,                // pointer to command line string

            nil,	      // pointer to process security attributes
            nil,	      // pointer to thread security attributes
            true,	      // handle inheritance flag
            0,	              // creation flags
            nil,	      // pointer to new environment block
            nil,              // pointer to current directory name
            st,	              // pointer to STARTUPINFO
            pi 	              // pointer to PROCESS_INFORMATION
           );
If not Res then
   begin
      Result:='ERR "'+Inttostr(GetLastError)+'" -> '+t;
      exit;
   end;

if Wait then
   begin
       WaitforSingleObject(PI.hProcess,INFINITE);
       GetExitCodeProcess(Pi.hProcess,Read);
       CloseHandle( Pi.hProcess);
       CloseHandle( Pi.hThread);
   end;

ReadFile(ReadHandle,Buffer,8192,read,nil);
result:=StrPas(Buffer);
end;

How to send PCL escape code in Quick Report....     Top

This function send PCL codes to the printer in Quick Report. Good place to put call in is in the StartPage event

procedure SendPclCode(Report:TCustomQuickRep;ToSend:String);
type
  TPrnBuffRec = Record
      BuffLength: Word;
      Buffer: Array[0..255] Of Char;
   End;
var
   Buff : TPrnBuffRec;

   function CheckPrinter : boolean;
     var
        TestInt: integer;
     begin
     { Test to see if the "PASSTHROUGH" escape is supported }
      TestInt := PASSTHROUGH;
      Result:=Escape(Report.QRPrinter.Canvas.Handle, QUERYESCSUPPORT,sizeof(TestInt), @TestInt, Nil) > 0);
     end;

begin
   {If Api is unsupported, then exit}
   if not CheckPrinter then Exit;

   StrPCopy(Buff.Buffer,#27+ToSend);
   { Set the buffer length }
   Buff.BuffLength := StrLen(Buff.Buffer);
   { Make the escape}
   Escape(Report.QRPrinter.Canvas.Handle,
  		PASSTHROUGH,
  		0,
  		@Buff,
  		Nil);
end;

How to save/load object properties to/from registry....     Top

This two procedure permit to save object properties to the registry and then reload it.
First add this to your source code:

  ....
  uses typinfo;
  ....

Procedure SaveObj(BaseName:String;Obj:TPersistent;Reg:Tregistry);
Var i:integer;
    plist:PPropList;
    j:integer;
Begin
j:=GetPropList(Obj,plist);
for i:=0 to j -1  Do
   Reg.WriteString(BaseName+'.'+plist^[i].Name,Vartostr(GetPropValue(obj,plist^[i].Name)));
End;

Procedure LoadObj(BaseName:String;Obj:TPersistent;Reg:Tregistry);
Var i:integer;
    plist:PPropList;
    v:variant;
    j:integer;
Begin
j:=GetPropList(obj,plist);
for i:=0 to j -1  Do
   Begin
    Try
     v:=Reg.ReadString(BaseName+'.'+plist^[i].Name);
     SetPropValue(Obj,plist^[i].Name,v);
    Except
    End;
   End;
End;

Then you can call function as :

Procedure TMyForm.SaveParms;
Var
  Reg: TRegistry;
Begin
  Reg := TRegistry.Create;
  Try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    If Reg.OpenKey('\Software\Myprogram', True) Then
   Begin
     SaveObj('MyFont',MyComponent.Font,reg);
    End;
  Finally
    Reg.Free;
  End;
End;
 
Procedure TMyForm.RetrieveParms;
Var
  Reg: TRegistry;
Begin
  Reg := TRegistry.Create;
  Try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    If Reg.OpenKey('\Software\Myprogram', True) Then
   Begin
     LoadObj('MyFont',MyComponent.Font,reg);
    End;
  Finally
    Reg.Free;
  End;
End;









Home Page  
Download page  
C/C++ Language  
Delphi  
Cobol  
AS400Expert  
More about me  
 E-Mail me !