6  Interesting QA from various newsgroups
unsorted, uncommented, simply copied from NG - mails (without written permission of the authors)
Please mail me if you do not agree - want to have removed your mail here.


last updated: Dec-23-1998    Index 1QA


   Subject: Re: Sets of more than 256 elements?
      Date: Sun, 22 Nov 1998 17:21:57 GMT
      From: horst.kraemer@snafu.de (Horst Kraemer)
 Organization:[Posted via] Interactive Networx
 Newsgroups: comp.lang.pascal.borland

On Sun, 22 Nov 1998 08:50:24 -0600, Mathew Moe <mmoe@delete.eot.com>
wrote:

> I posted this in a Delphi group but realized this was more a language
> problem/question. I need to do set operations on a large number of
> elements. Minimum of 3,000 and prefer up to 10,000 elements. In addition
> to a large number of elements the operations are repeated many times so
> speed is critical.  It seems this need should have arisen many times
> before and has probably already been coded, tested and debugged. Any
> suggestions or directions?
> Thanks!

Here is a frame:

>-------------------------------------------<

{$G+}
const
  SIZE=4096; { up to 65536 set elements }
type
  TBigSet = array[0..pred(SIZE)] of word;

{
  You have in general SIZE*16 set elements.
  If the array is bigger than 4096 words
  you have to use the *L versions.
}

const
  Mask : array[0..15] of word = (
             $1,   $2,   $4,   $8,
            $10,  $20,  $40,  $80,
           $100, $200, $400, $800,
          $1000,$2000,$4000,$8000
         );
var
  BigSet : TBigSet;

procedure AddSet(n:word);
assembler;
asm
  mov bx, n
  and bx, 15
  shl bx, 1
  mov dx, word ptr Mask[bx]
  mov bx, n
  shr bx, 4
  shl bx, 1
  or  word ptr BigSet[bx], dx
end;
(*
var
  i:word;
begin
  i:= n div 16;
  BigSet[i]:=BigSet[i] or Mask[n and 15]
end;
*)

procedure SubSet(n:word);
assembler;
asm
  mov bx, n
  and bx, 15
  shl bx, 1
  mov dx, word ptr Mask[bx]
  not dx
  mov bx, n
  shr bx, 4
  shl bx, 1
  and word ptr BigSet[bx], dx
end;
(*
var
  i:word;
begin
  i:= n div 16;
  BigSet[i]:=BigSet[i] and not Mask[n and 15]
end;
*)

function InSet(n:word):boolean;
assembler;
asm
  mov bx, n
  and bx, 15
  shl bx, 1
  mov dx, word ptr Mask[bx]
  mov bx, n
  shr bx, 4
  shl bx, 1
  xor al,al
  test word ptr BigSet[bx], dx
  jz @Exit
  inc al
@Exit:
end;
(*
begin
  inSet := BigSet[n div 16] and Mask[n and 15] <> 0
end;
*)

{ Longint versions }

procedure AddSetL(n:longint);
assembler;
asm
  mov bx, word ptr n
  and bx, 15
  shl bx, 1
  mov dx, word ptr Mask[bx]
  db $66 ; mov bx, word ptr n  { mov ebx, n }
  db $66 ; shr bx, 4           { shr ebx, 4 }
  shl bx, 1
  or  word ptr BigSet[bx], dx
end;

procedure SubSetL(n:longint);
assembler;
asm
  mov bx, word ptr n
  and bx, 15
  shl bx, 1
  mov dx, word ptr Mask[bx]
  not dx
  db $66 ; mov bx, word ptr n  { mov ebx, n }
  db $66 ; shr bx, 4           { shr ebx, 4 }
  shl bx, 1
  and word ptr BigSet[bx], dx
end;

function InSetL(n:longint):boolean;
assembler;
asm
  mov bx, word ptr n
  and bx, 15
  shl bx, 1
  mov dx, word ptr Mask[bx]
  db $66 ; mov bx, word ptr n  { mov ebx, n }
  db $66 ; shr bx, 4           { shr ebx, 4 }
  shl bx, 1
  xor al,al
  test word ptr BigSet[bx], dx
  jz @Exit
  inc al
@Exit:
end;

begin
  fillchar(BigSet,sizeof(BigSet),0); { empty }
  fillchar(BigSet,sizeof(BigSet),$FF); { full }
  writeln(InSetL(3456));
  SubSetL(3456);
  writeln(InSetL(3456));
  AddSetL(3456);
  writeln(InSetL(3456));
end.



   Subject: Re: Whaddaya think of this?  Pascal SET performance comparison
      Date: Mon, 30 Nov 1998 09:34:01 +0100
      From: Clemens Lehnert <clemens.lehnert@fh-ingolstadt.de>
 Organization: FH Ingolstadt - Rechenzentrum
 Newsgroups: borland.public.turbopascal

Louis wrote:

> Hi!
> This could be faster?
> Type
>    TBitList = Word;
>
> function IsBitSet (const Body: TBitList; const I: Byte): Boolean;
> begin
>         Result := (Body and ($0001 shl I)) <> 0
> end;
>
> Bye
> Louis
> www.gcs.co.za/mbs/mbs.htm

Hi,
I wrote a little test program for all 3 routines.
The results on my INTEL 486DX2-66 are:
Routine 1 (Set)     : 2647 ms
Routine 2 (And)     : 2626 ms
Routine 3 (Function): 14276 ms

Hint: Use the true DOS-mode for more accurate results.
 

Program SpeedComp;
Uses
  DOS;

Const
  MAXCOUNT = 1000000;{Use a higher value on fast machines}

Type
  TAlpha = Set of 0..15;
  TBitList = Word;

Var
  OldInt8 : Procedure;
  Milliseconds, Timer1, Timer2, Timer3 : LongInt;
  i : LongInt;
  Dummy1 : Integer;
  Dummy2 : Boolean;

  wo : Word;
  ck : TAlpha absolute wo;
 

  Function IsBitSet (const Body : TBitList; const I : Byte) : Boolean;
    Begin
      IsBitSet := (Body AND ($0001 SHL I)) <> 0
    End;
 

  Procedure NewInt8; Interrupt;
    Begin
      Inline ($FA);{CLI}
      Inc (Milliseconds);
      IF ((Milliseconds mod 55{1000 / 18.2}) = 0) THEN
        Begin
          Inline ($9C / $FB);{PUSHF, STI}
          OldInt8;
        End
      ELSE
        Begin
          Inline ($FB);{STI}
          Port[$20] := $20; {Interrupt-end signal}
        End;
    End;
 

  Procedure SetNewInt8;
    Begin
      GetIntVec ($08, @OldInt8);
      SetIntVec ($08, @NewInt8);
      ASM {Set Timer to 1000 Hz}
        cli
        mov dx, $43
        mov al, $36
        out dx, al
        sub dx, 3
        mov al, 169
        out dx, al
        mov al, 4
        out dx, al
        sti
      End;
    End;
 

  Procedure SetOldInt8;
    Begin
      ASM {Reset Timer to 18.2 Hz}
        cli
        mov dx, $43
        mov al, $36
        out dx, al
        sub dx, 3
        xor ax, ax
        out dx, al
        out dx, al
        sti
      End;
      SetIntVec ($08, @OldInt8);
    End;
 

Begin
  writeln ('Checking speed... (this may take a while)');
  Milliseconds := 0;
  SetNewInt8;{Begin to inc (Milliseconds)}
  {************************* Routine with SET ****************}
  wo := $FFFF;
  Milliseconds := 0;

  For i := 1 to MAXCOUNT do
    Begin
      IF 15 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 14 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 13 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 12 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 11 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 10 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 9 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 8 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 7 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 6 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 5 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 4 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 3 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 2 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 1 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF 0 IN ck THEN Dummy1 := 1 ELSE Dummy1 := 0;
    End;

  Timer1 := Milliseconds;
  {************************* Routine with AND ******************}
  wo := $FFFF;
  Milliseconds := 0;

  For i := 1 to MAXCOUNT do
    Begin
      IF (wo AND 1) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 2) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 4) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 8) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 16) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 32) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 64) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 128) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 256) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 512) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 1024) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 2048) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 4096) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 8192) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 16384) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
      IF (wo AND 32768) <> 0 THEN Dummy1 := 1 ELSE Dummy1 := 0;
    End;

  Timer2 := Milliseconds;
  {************************* Routine with function ***************}
  wo := $FFFF;
  Milliseconds := 0;

  For i := 1 to MAXCOUNT do
    Begin
      Dummy2 := IsBitSet (wo, 0);
      Dummy2 := IsBitSet (wo, 1);
      Dummy2 := IsBitSet (wo, 2);
      Dummy2 := IsBitSet (wo, 3);
      Dummy2 := IsBitSet (wo, 4);
      Dummy2 := IsBitSet (wo, 5);
      Dummy2 := IsBitSet (wo, 6);
      Dummy2 := IsBitSet (wo, 7);
      Dummy2 := IsBitSet (wo, 8);
      Dummy2 := IsBitSet (wo, 9);
      Dummy2 := IsBitSet (wo, 10);
      Dummy2 := IsBitSet (wo, 11);
      Dummy2 := IsBitSet (wo, 12);
      Dummy2 := IsBitSet (wo, 13);
      Dummy2 := IsBitSet (wo, 14);
      Dummy2 := IsBitSet (wo, 15);
    End;

  Timer3 := Milliseconds;
  {######################### Results ##############################}
  SetOldInt8;
  writeln ('Results:');
  writeln ('1. (Set)     : ', Timer1, ' ms');
  writeln ('2. (And)     : ', Timer2, ' ms');
  writeln ('3. (Function): ', Timer3, ' ms');
End.
 
 



   Subject: Re: Intellectual Property
      Date: Wed, 02 Dec 1998 08:05:40 -0700
      From: Sundial Services <info@sundialservices.com>
 Organization:Sundial Services
 Newsgroups: comp.lang.pascal.delphi.misc
 

Matt Harding wrote:
>
> I have written a Delphi app that I would like to demo as a
> potential product to sales folks, but I know absolutely nothing about
> protecting my
> work or setting up a business and am concerned about blindly looking for
>
> customers.  I know there is demand for this software because I used it
> as an engineer and I know it works.  Can anybody point me to a good
> reference that would identitfy a good strategies for creating a product
> or even selling the technology to a larger software house??  Sharing any
>
> firsthand experiences would be greatly appreciated as well.
>
> Thanks in advance for your response,
>
> Matt
 

Setting up and running a software business is a very unusual proposition; I can say honestly that I didn't know what I was getting into all those years ago.

The first thing you should do is to -register- your copyright.  You can download the form and the application-fee is about $25.  Registering a trademark, if you choose to do that, costs more.  But once you do that your rights are quite securely protected.

Then you should survey the market.  Once again you can do a lot of that from your living room.  Who is selling products similar to yours?  Where are the web sites that people like your customers might be interested in?  What paper magazines do they read?  Who are the players in this market?

Then you have a decision to make:  do you actually want to publish the thing, or do you really just want royalty checks?  You can set up a corporation, try to make a presence on the web etc. etc. etc, or you can be "an author in search of a publisher."

Looking back, sometimes I wonder if I should have, and sometimes I wonder if I -should-, choose the latter route!  Authors don't get as
large a share but what they do get is pure gravy.

If you're in a niche market, look for a strong publisher who's working in that market.  Secure your copyright and your trademark, then begin to peddle your wares to those sources, just like people who publish books and magazines do.  Be certain (a) that the product works flawlessly (or as nearly as you can make it); and (b) that you can clearly describe what the product does and why it would be beneficial, and to whom.

Good luck!  It's quite a ride!

/mr/



   Subject:    So geht's: Icons der Dateitypen holen   fetch icons of file types
      Date:    Thu, 3 Dec 1998 02:28:37 +0100
      From:    "Markus Hahn" <hahn@flix.de>
 Organization: InterNetNews at News.BelWue.DE (Stuttgart, Germany)
 Newsgroups:   de.comp.lang.pascal.delphi
 

Hurra, endlich geschafft und hier der Code:

--------------------------------------------------
var
 i : tshfileinfo;
 x : THandle;
begin
  x:=
  SHGetFileInfo('*.txt', 0, i,
    sizeof(i),
    SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX or
    SHGFI_USEFILEATTRIBUTES) ;

  ImageList1.Handle:=x;
  listview1.Items[0].imageindex:=i.iIcon;
end;
--------------------------------------------------
Dieses lumpige "SHGFI_USEFILEATTRIBUTES" macht's!
Lob & Tadel bitte an mich mailen.
Markus



   Subject: Re: Taskbar und Startbutton abschaltbar?
      Date: Thu, 3 Dec 1998 09:54:19 +0100
      From: "Wolfgang Koranda" <wkoranda@csi.com>
 Organization: Customer of EUnet Austria
 Newsgroups: de.comp.lang.pascal.delphi

Hi!

Probier es damit.

   var NoUse : Integer;
         hTBar,hSBtn : HWnd;

     (* Alt+TAB,Strg+Esc,Win95-Taste,Strg+Alt+Entf abschalten: *)
     SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @NoUse, 0);

     (* hide Taskbar *)
     ShowWindow(FindWindow('Shell_TrayWnd', nil),SW_HIDE);

     (* hide StartBtn *)
     hTBar:=FindWindow('Shell_TrayWnd',nil);
     hSBtn:=GetWindow(hTBar,gw_Child);
     ShowWindow(hsBtn,SW_HIDE);
 

mfG
Wolfgang Koranda
Tel.: +43 1 40104 1057   Fax: +43 1 40104 9035
BBS:+43 1 40104 1058     e-mail: wkoranda@csi.com

Mike schrieb in Nachricht <36663b87.405499@news.wunsch.com>...
>Hallo Delphi-Freunde!
>
>Kann mir jemand sagen,ob und wie die Taskbar oder auch nur der
>Startbutton unter D3 abzuschalten ist?



   Subject: Re: Direktdruck ohne Druckertreiber? PRINTING WITH OLD LINE PRINTER
      Date: Thu, 3 Dec 1998 10:43:05 +0100
      From: "Hans-Georg Rickers" <h.rickers@zr-online.de>
 Organization: IPF.Net - welcome to the world.
 Newsgroups: de.comp.lang.pascal.delphi

Hallo Christian,

Installiere unter Win95 oder NT4 einen    'Generic'-Drucker printer(Text only).

Dann kannst du zB. mit :
var
  MyFile: TextFile;
begin
  AssignPrn(MyFile);
  Rewrite(MyFile);
  Writeln(MyFile, 'Dieser Text wird gedruckt.');
  System.CloseFile(MyFile);
end;

sehr einfach einen Text ausgeben.

Huggy Rickers
h.rickers@zr-online.de
 

Rosner schrieb in Nachricht <36663B7F.87E7EE95@privat.go-on.net>...
>Ich habe die Aufgabe, eine Uralt-DOS-Anwendung für einen
>Uralt-Spezial-Drucker, für den es keine Druckertreiber mehr gibt, auf
>Windows 95 zu portieren.
My job is porting a very old DOS application to Win95, where a special
printer must be used without any printer drivers available.
>Das Problem - ich habe zwar alle Steuercodes für den Drucker, muß jedoch
>mangels Druckertreiber direkt auf die parallele Schnittstelle schreiben,
>genauer eine Alternative zu dem DOS-Interrupt 14 finden, über den damals
>der Druck lief.
>Gibt es da einen Ansatz ? Oder gibt es einen Druckertreiber, der nichts
>anderes macht, als die Daten, die man ihm übergibt, 1:1 an die
>Druckerschnittstelle weiterzuleiten ?
>Gruss Christian



   Subject: Re: Printer  USING CONTROL CODE
      Date: 7 Dec 1998 17:37:45 +0200
      From: ronkanen@cc.helsinki.fi (Osmo Ronkanen)
 Organization: University of Helsinki
Newsgroups: comp.lang.pascal.borland

>Esc(s3B to begin Boldface
>Esc(s0B to end Boldface
>
>For example:
>
>Write(LST,#27,'(s3B',StringToWrite,#27,'(s0B');
              ^                        ^
Note one can omit the marked commas. Also a good practice is not to put
the commands in that way but to define constants:

Const BoldOn=#27'(s3B';
      BoldOff=#27'(s0B';

and preferably in a separate unit. That makes modifying the program
easier.  Here is such an unit. For example to move to dot position 1200
(center of line) one can do

write(lst,wp(MoveToDotX,1200));

unit pclconst;

interface

const

  resetprt=#27'E';
  selftest=#27'z';

  Landscape=#27'&l1O';
  Portrait=#27'&l0O';

  {attributes }

  Underline=#27'&d3D';
  Doubleunderline=#27'&d4D';
  FixedUnderline=#27'&d1D';
  FixedDoubleunderline=#27'&d2D';
  UnderlineOff=#27'&d@';
  Bold=#27'(s3B';
  Italics=#27'(s1S';
  BoldOff=#27'(s0B';
  ItalicsOff=#27'(s0S';
  BIoff=#27'(s0s0B';

  Fixed=#27's0P';
  proportional=#27's1P';
  UniDirectional=#27'&k0W';
  Bidirectional=#27'&k1W';

  Cpi=#27'(s#H';
  Height=#27's#V';

  Draft=#27'(s1Q'#27'*r1Q';   { first for text second for graphics }
  LQ=#27'(s2Q'#27'*r2Q';
 

  { Character sets }

  PC8=#27'(10U';    { Standard PC char set }
  PC850=#27'(12U';  { PC multinational }
  Roman8=#27'(8U';
  Latin1=#27'(0N';

  lpi=#27'&l#D';               { Send this group in the order presented }
  PaperDefault=#27'&l0A';      { That is first lpi, then paper, then }
  PaperLetter=#27'&l1A';       { margins etc. }
  PaperLegal=#27'&l2A';
  PaperA4=#27'&l3A';           { To get different spacing within page }
  Pagelen=#27'&l#P';           { Use VMI or MoveDown }
  PerfSkipOff=#27'&l1L';
  PerfSkipOn=#27'&l0L';
  LeftMargin=#27'&a#L';
  RightMargin=#27'&a#M';
  ClearMargins=#27'9';
  Topmargin=#27'l#E';
  TextLength=#27'&l#F';
 

  VMI=#27'&l#C';               { Vertical motion index #/48" }
  HMI=#27'&k#H';               { Horizontal motion index #/120" }

  { Moving the cursor }

  MovetoRow=#27'&a#R';
  MoveToCol=#27'&a#C';
  MoveDownRows=#27'&a+#R';
  MoveRightCols=#27'&a+#C';
  MoveUpRows=#27'&a-#R';     { use with caution. }
  MoveLeftCols=#27'&a-#C';

  MoveToDotY=#27'*p#Y';
  MoveToDotX=#27'*p#X';
  MoveDownDots=#27'*p+#Y';
  MoveRightDots=#27'*p+#X';
  MoveUpDots=#27'*p-#Y';           { use with caution }
  MoveLeftDots=#27'*p-#X';

  MoveToDecipointY=#27'&a#V';
  MoveToDecipointX=#27'&a#H';
  MoveDownDecipoints=#27'&a+#V';
  MoveRightDecipoints=#27'&a+#H';
  MoveUpDecipoints=#27'&a-#V';     { use with caution }
  MoveLeftDecipoints=#27'&a-#H';

  { Graphics }

  GraphicsResol=#27'*t#R';         { 75, 100, 150, 300, on some models 600 }
  GraphWidth=#27'*r#S';            { pixels }
  CompactOff=#27'*b0M';
  CompactMode1=#27'*b1M';
  CompactMode2=#27'*b2M';
  StartGraphics=#27'*r1A';         { starts at current position }
  TransferRow=#27'*b#W';
  CloseGraphics=#27'*rB';

  DisplayFunctions=#27'Y';         { Good for debugging }
  DisplayFunctionsOff=#27'Z';

  Transparent=#27'*p#X';           { Print # characters as text }
  Transp1=#27'*p1X';               { print a single control character }
  Wrap=#27'&s0C';                  { in general avoid automatic wrap and do }
  WrapOff=#27'&s1C';               { it manually between words }

  { Line termination }

  LTnorm=#27'&k0G';
  LTUnix=#27'&k2G';                 { CR->CR, LF -> CRLF, FF->CRFF }
                                    { works with both Unix and DOS eol }
  LTCR=#27'&1G';                    { CR->CRLF, LF -> LF, FF-FF }
  LTCRorLF=#27'&3G';                { CR->CRLF, LF -> CRLF, FF-CRFF }

  Eject=#27'&l0H';                  { Does not eject an empty page like FF }
                                    { does }

  { some "macros" }

  HalfHeight=#27's6V';
  FullHeight=#27's12V';
  Cpi10=#27'(s10H';
  Cpi12=#27'(s12H'#27'&k10H'; { Force the font to 12CPI with HMI }
  Cpi17=#27'(s16.67H';
  Cpi20=#27'(s20H';
  Cpi5=#27'(s5H';
  Cpi6=#27'(s6H'#27'&k20H';

type sst=string[25];

Function wp(template:sst; value:word): sst;
Function fxp(template:sst; value:longint): sst; {2 decimals}
Function rp(template:sst; value:real): sst;

implementation

Procedure InsSt(var template:sst;{$ifdef ver70}const{$endif} s:sst);
var i:integer;
begin
  i:=pos('#',template);
  if i>0 then begin
     delete(template,i,1);
     insert(s,template,i);
  End;
end;

Function wp(template:sst; value:word): sst;
var s:string[5];
begin
  str(value,s);
  InsSt(template,s);
  wp:=template;
End;

Function fxp(template:sst; value:longint): sst;
var s:string[12];
    f:string[2];
begin
  str(value div 100,s);
  str(value mod 100:2,f);
  byte(f[1]):=byte(f[1]) or $30;  {convert possible leading space into '0'}
  s:=s+'.'+f;
  while s[length(s)]='0' do dec(byte(s[0]));
  if s[length(s)]='.' then dec(byte(s[0]));
  InsSt(template,s);
  fxp:=template;
End;

Function rp(template:sst; value:real): sst;
var s:string[10];
begin
  str(value:1:3,s);
  while s[length(s)]='0' do dec(byte(s[0]));
  if s[length(s)]='.' then dec(byte(s[0]));
  InsSt(template,s);
  rp:=template;
End;
end.



   Subject: Re: erw. Zugriff auf eine CD   CD door open/close
      Date: 7 Dec 1998 18:20:03 GMT
      From: "Simon Reinhardt" <S.Reinhardt@WTal.de>
 Organization: Klaus Datentechnik
 Newsgroups: de.comp.lang.pascal.delphi

Ich befürchte, Du suchst an der falschen Stelle. Suche mal unter
MCISendString und MCISendCommand. Da steht dann alles. Hier z.B. die Units
aus meinem CD-Manager zum Öffnen und Schließen der Schublade:

procedure TMainForm.SBCDEjectClick(Sender: TObject); {Öffnen}
var Befehl  : string;
    ErrCode : integer;
    ErrStr  : array [0..255] of char;
begin
  Befehl := 'open ' + ComboCDDrives.Items[ComboCDDrives.ItemIndex] + ' type
cdaudio alias geraet';
  MCISendString(PChar(Befehl), nil, 0, 0);
  ErrCode:=MCISendString('set geraet door open wait', nil, 0, 0);
  MCISendString('close geraet', nil, 0, 0);
  if ErrCode<>0 then begin
    MCIGetErrorString(ErrCode,ErrStr,255);
    StatusBar.Panels[1].Text:=ErrStr;
  end;
end;

procedure TMainForm.SBCDLoadClick(Sender: TObject); {Schließen}
var Befehl  : string;
    ErrCode : integer;
    ErrStr  : array [0..255] of char;
begin
  Befehl := 'open ' + ComboCDDrives.Items[ComboCDDrives.ItemIndex] + ' type
cdaudio alias geraet';
  MCISendString(PChar(Befehl), nil, 0, 0);
  ErrCode:=MCISendString('set geraet door closed wait',nil,0,0);
  MCISendString('close geraet', nil, 0, 0);
  if ErrCode<>0 then begin
    MCIGetErrorString(ErrCode,ErrStr,255);
    StatusBar.Panels[1].Text:=ErrStr;
  end;
end;

Simon
Homepage: http://sr-soft.wtal.de
Delphi-FAQ: http://sr-soft.wtal.de/delphi.htm
Delphi-Komponenten: http://sr-soft.wtal.de/compon.htm



   Subject: Re: Printing with Default Printer Fonts
      Date: 07 Dec 1998 20:22:55 GMT
      From: alanglloyd@aol.com (AlanGLLoyd)
 Organization: AOL, http://www.aol.co.uk
 Newsgroups: comp.lang.pascal.delphi.misc

In article <4CVa2.429$vW3.1911@news3.ispnews.com>, "Jesse Castleberry"
<DLG@iThink.net> writes:

>Here's my problem.  when using Windows font's on these printers, it's REALLY
>slow.  If I could just use the printers default fonts, it would speed things
>up tremendiously.  I can do this by opening up LPT1 as a file and
>WriteLn()ing to it, but there are several problems here.  #1, I have no
>error control when doing things this way, and it also doesn't go to the
>Windows spool, which means that the user has to wait for the report to
>finish before they can get their computer back.

The below code will put your file in the spooler queue for you. Basically it
calls AddJob( which returns a spooler filename and a Job ID. You then write
your printer stuff to the file and call ScheduleJob( which releases it to the
spoooler. Look in Win32 for AddJob & ScheduleJob for some more info.

procedure TForm1.PrintToSpooler;
var
  MemStrm : TMemoryStream;
  PtrName : PChar;
  Buffer : array[0..69] of char;
  JobInfo : TAddJobInfo1A absolute Buffer;
  cbNeeded : DWord;
  hPrinter : THandle;
const
  PortSuffix : PChar = ' on ';
begin
  {get printer handle}
  { . . . get printer name}
  GetMem(PtrName, 50);
  StrPCopy(PtrName, Printer.Printers[Printer.PrinterIndex]);
  StrPos(PtrName, PortSuffix)^ := #0;    {remove port suffix from name}
  { . . . open printer to get the handle}
  if not OpenPrinter(PtrName, hPrinter, nil) then
    MessageDlg('Error Opening Printer : '
              + IntToStr(GetLastError),mtError,[mbOK], 0);
  {get path for spooler file}
  {returned path is placed after the TAddJobInfo structure}
  JobInfo.Path := Buffer + SizeOf(TAddJobInfo1A);
  if OpenDialog1.Execute then begin
    if not AddJob(hPrinter, 1, @JobInfo, SizeOf(Buffer), cbNeeded) then
      MessageDlg('Error : ' + IntToStr(GetLastError) + char(13)
                 + 'Buffer : ' + IntToStr(cbNeeded) + '/' +
                 IntToStr(SizeOf(Buffer)),mtError, [mbOK], 0);
    {Copy a file to the spooler file}
    MemStrm := TMemoryStream.Create;
    with MemStrm do begin
      LoadFromFile(OpenDialog1.FileName);
      SaveToFile(string(JobInfo.Path));
      Free;
    end;
    {schedule the print job}
    if not ScheduleJob(hPrinter, JobInfo.JobID) then
      MessageDlg('Error Scheduling Job : '
                 + IntToStr(GetLastError),mtError,[mbOK], 0);
  end;
  ClosePrinter(hPrinter);
  FreeMem(PtrName, 50);
end;

Alan Lloyd   alanglloyd@aol.com



   Subject: Re: StringGrid "Text Rechtsbündig oder Mittig anzeigen" ?? WIE ?
                TStringgrid with right aligned or centered text
      Date: 13 Dec 1998 08:51:38 GMT
      From: "Simon Reinhardt" <S.Reinhardt@WTal.de>
 Organization: Klaus Datentechnik
 Newsgroups: de.comp.lang.pascal.delphi

Hi Giovanni,

Zuerst stelle die Eigenschaft "DefaultDrawing" des StringGrids auf false,
dann schreibe eine Routine für das OnDrawCell-Ereignis. Mit dieser Prozedur
gibst Du Text zentriert oder rechtsbündig aus:

First set the property "DefaultDrawing" to false, then write a routine for
the OnDrawCell event.

procedure AlTextOut(X,Y:word;Text:string;Alignment:TAlignment);
begin
  with StringGrid.Canvas do begin
    if Alignment=taLeftJustify then
      TextOut(X,Y,Text);
    if Alignment=taRightJustify then
      TextOut(X-TextWidth(Text),Y,Text);
    if Alignment=taCenter then
      TextOut(X-(TextWidth(Text) div 2),Y,Text);
  end;
end; {AlTextOut}

--
Simon
Homepage: http://sr-soft.wtal.de
Delphi-FAQ: http://sr-soft.wtal.de/delphi.htm
Delphi-Komponenten: http://sr-soft.wtal.de/compon.htm



   Subject: Re: How to save screenshot as 16-color BMP? <<< TURN THIS INTO A Ti !!!
      Date: Mon, 14 Dec 1998 02:17:48 -0600
      From: "Joe C. Hecht" <joehecht@gte.net>
 Organization:Offshore Technology
        To: Ingvar Nilsen <telcontr@online.no>
 Newsgroups:borland.public.delphi.graphics

Ingvar,

You are absolutly correct!!!

I deserve a good spanking for not looking it over before posting. :o
As Steve Texiera would say "Good Catch"!.

I hacked it together in the in the dark, in the car, driving on a bumpy road.
(lame excuse - but true)

PS: Would you mind looking over my:
"Customer submitted FAQ - How to print raw data!!!" post over in the WinAPI section????

Here is the corrected for shooting screens (and taking palettes into account):

Note: The grayed text was written by Joe C. Hecht because Ingvar Nilsen had alerted
him about a bug in the former listing. Here is the corrected procedure. (Franz Glaser)

procedure ScreenShot(x : integer;
                     y : integer;
                     Width : integer;
                     Height : integer;
                     bm : TBitMap);
var
  dc: HDC;
  lpPal : PLOGPALETTE;
begin
 {test width and height}
  if ((Width = 0) OR
      (Height = 0)) then begin
    exit;
  end;
  bm.Width := Width;
  bm.Height := Height;
 {get the screen dc}
  dc := GetDc(0);
  if (dc = 0) then begin
    exit;
  end;
 {do we have a palette device?}
  if (GetDeviceCaps(dc, RASTERCAPS) AND
      RC_PALETTE = RC_PALETTE) then begin
   {allocate memory for a logical palette}
    GetMem(lpPal,
           sizeof(TLOGPALETTE) +
           (255 * sizeof(TPALETTEENTRY)));
   {zero it out to be neat}
    FillChar(lpPal^,
             sizeof(TLOGPALETTE) +
             (255 * sizeof(TPALETTEENTRY)),
             #0);
   {fill in the palette version}
    lpPal^.palVersion := $300;
   {grab the system palette entries}
    lpPal^.palNumEntries :=
      GetSystemPaletteEntries(dc,
                              0,
                              256,
                              lpPal^.palPalEntry);
    if (lpPal^.PalNumEntries <> 0) then begin
     {create the palette}
      bm.Palette := CreatePalette(lpPal^);
    end;
    FreeMem(lpPal, sizeof(TLOGPALETTE) +
            (255 * sizeof(TPALETTEENTRY)));
  end;
 {copy from the screen to the bitmap}
  BitBlt(bm.Canvas.Handle,
         0,
         0,
         Width,
         Height,
         Dc,
         x,
         y,
         SRCCOPY);
 {release the screen dc}
  ReleaseDc(0, dc);
end;

Joe
--
Joe C. Hecht
http://home1.gte.net/joehecht/index.htm



   Subject: Re: Getting Color Depth of any image
      Date: Fri, 11 Dec 1998 17:39:59 -0600
      From: Harm <harmans@thebaragain.uswest.net>
   Reply-To:harmans@uswest.net
 Newsgroups: borland.public.delphi.graphics

I've had pretty good luck with the TBitmap.PixelFormat, like this:

  if Image1.Picture.Graphic is TBitmap then begin
    case Image1.Picture.Bitmap.PixelFormat of  //Find color depth
      pf1bit : pf := '.  Monochrome';
      pf4bit : pf := '.  16 Colors';
      pf8bit : pf := '.  256 Colors';
      pf15bit: pf := '.  32768 Colors';
      pf16bit: pf := '.  65536 Colors';
      pf24bit: pf := '.  16 Million Colors';
      pf32bit: pf := '.  Gazillions of Colors!';
    else
      pf := '.  Custom color scheme';
    end;
  end;

I believe the TJPEGImage has a similar property.

HTH :)
Note: this is a partial solution only, but the thread was too long to
be displayed here. Look at EFG's computer lab for more information.  (Franz Glaser)



   Subject: A solution for streaming groups of bitmaps
      Date: Sun, 20 Dec 1998 16:56:09 GMT
      From: infocus@swbell.net (Mark Shapiro)
 Organization: SBC Internet Services
 Newsgroups: comp.lang.pascal.delphi.misc
 

Shown below is the process I've now worked out for reading bitmaps
from a database into a container, writing them all as a single binary
file, and later retrieving them for display, one by one, with other
data from a selected organization. The application involves one
program that creates a datafile for use by a second program running in
a remote location. This approach allows the second program to operate
"like" a database application but avoid the use of a database manager
or a database.

The application uses Delphi 3 and MS Access tables. Here are the steps
I've followed:

Step 1: Create a record class to hold the bitmaps and other associated
data that are read from a database.

TNameRecord = class(TObject)
   Provider : string;
   Address1 : string;
   {...more fields...}
   ProviderPicture : TBitmap;
end;

Step 2: Read the bitmaps from a database into NameRecord, a TArray
container (part of a superb collection of freeware containers
available from Interval software -- http://www.cam.org/~mibra/spider).
A TList would work just as well. This occurs within a While Not
DataBase.Eof loop that iterates through all records of the database.
For each iteration, a new NameRecord and a new
NameRecord.ProviderPicture are created.

PictureStream :=
TBlobStream.Create(Agency.FieldByName('providerpicture') as
TBlobField, bmRead);
  try
    MemSize := PictureStream.Size;
    Inc(MemSize); {to allow for null terminator}
    Buffer := AllocMem(MemSize);
    try
      PictureStream.Read(Buffer^, MemSize);
      NameRecord.ProviderPicture.LoadFromStream(PictureStream);
    finally
      FreeMem(Buffer, MemSize);
    end;
  finally
    PictureStream.Free;
  end;

Step 3: Write all of the NameRecord.ProviderPicture bitmaps to a
single disk file for later processing. DataArray is the TArray which
holds NameRecords and ARecord is an instance of NameRecord. Simply for
my ease of use, all of the rest of the NameRecord data are streamed to
a separate disk file using a TFileStream.

DataStream := TFileStream.Create('agypic.dat', fmCreate);
TempStream := TMemoryStream.Create;
try
  for q := 1 to RCount do {the number of records in DataArray}
  begin
    ARecord := DataArray[q] as TNameRecord;
    ARecord.ProviderPicture.SaveToStream(TempStream);
    CT := TempStream.Size; {write the size of the bitmap}
    DataStream.Write(CT, SizeOf(CT));
    DataStream.CopyFrom(TempStream, 0); {write the bitmap}
    TempStream.Clear;
  end;
finally
  TempStream.Free;
  DataStream.Free;
end;

Step 4: A second program streams the agypic.dat file back into memory
when it starts up. All of the bitmaps are read into one MemoryStream
and then are read one by one from the first stream into a second
stream. From there, they are loaded into a PictureRecord structure.
For personal reasons only, the rest of the agency data is stored in a
NameRecord structure while the ProviderPicture bitmaps are stored in a
separate PictureRecord structure.

type
TPictureRecord = class(TObject)
  Code : integer; {associates each bitmap with a specific agency}
  ProviderPicture : TBitMap;
end;

PictureArray := TArray.Create(TPictureRecord, ComparePictureRecord,
100, 10);
DataStream := TMemoryStream.Create;
DataStream.LoadFromFile('agypic.dat');
TempStream := TMemoryStream.Create;
try
  for q := 1 to RCount do {the number of saved bitmaps}
  begin
    DataStream.Read(bmSize, SizeOf(bmSize)); (CT value from step 3}
    TempStream.Clear;
    TempStream.CopyFrom(DataStream, bmSize);
    TempStream.Seek(0,soFromBeginning);

    PictureRecord := TPictureRecord.Create;
    PictureRecord.ProviderPicture := TBitMap.Create;
    PictureRecord.Code := q;
    PictureRecord.ProviderPicture.LoadFromStream(TempStream);
    PictureArray.Insert(PictureRecord);
  end;
finally
  DataStream.Free;
  TempStream.Free;
end;

Step 5: In the program, select an agency and display its data. The
agency's code number is tracked by the variable NameArrayPos. Clicking
a button on the data form, opens a second form which loads the
associated PictureRecord.ProviderPicture bitmap into a TImage. PRecord
is an instance of PictureRecord.

procedure TMoreForm.FormShow(Sender: TObject);
begin
  PRecord := PictureArray[NameArrayPos] as TPictureRecord;
  Image1.Picture.Assign(PRecord.ProviderPicture);
end;



   Subject: Re: Tabulator in Winword
      Date: Thu, 24 Dec 1998 00:34:05 GMT
      From: Anitily@gmx.de (Eisi)
 Organization: ANITILY Computer GbR.
 Newsgroups: de.comp.lang.pascal.delphi

Am 23 Dec 1998 22:33:58 GMT, schrieb "Frank Ahland" <ahland@acmedia.de>:

>wie kann ich über Ole in Winword einen Tabulator einfügen? Einfach #8
>klappt nicht.
>
>Vielen Dank  Frank Ahland
 

WordVariant.Selection.ParagraphFormat.TabStops.Add(Position:=CentimetersToPoints(2.35),
  Alignment:=wdAlignTabDecimal, Leader:=wdTabLeaderDots)

Dabei steht für

CentimetersToPoints:

function CentimetersToPoints(Value: Single): Single;
begin
        ////////////////////////////////////////////////////
        // Rechne Zentimeter in Punkt um. 1cm = 28,34646        //
        ////////////////////////////////////////////////////

        Result:= Value * 28.34646;
end;

wdAlignTabDecimal: Word = 3;
wdTabLeaderDots  : Word = 1;

Dies fügt einen Dezimal-Tabstop bei 2,35 cm ein und füllt die Zeile vom letzten
Zeichen bis zum TabStop mit Punkten.

Gilt allerdings nur für Word 97 (Word 95 versteht nur deutsch).

*Pah* Jetzt schreib ich soviel und wahrscheinlich wolltest Du nur wissen, wie Du
einen Tab schreiben kannst (also nicht setzen). Mit #9, nicht #8.

Bis denne dann .... Sven Eisenkraemer
--
Pointer: engl.= Zeiger/Tip. Für Programmierer: Das ist der TIP
(Pointer), VOR dem Versuch, die Pointer zu verstehen, mit der Pistole
an einen Punkt (Point) der Stirn zu zeigen (to point) und abzudrücken.
Übrigens: Was dieser Signatur fehlt, ist die Pointe :))







tpqa index    tpqa_5 back    tpqa_7 forward
 

Get your own FREE HOMEPAGE