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.
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.
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/
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
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?
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
>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.
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
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
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
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
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)
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;
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 :))
Get your
own FREE HOMEPAGE